octalgo.octalgo.projection


Require Import syntax.
Require Import subs.
Require Import pmatch.
Require Import bSemantics.
Require Import monotonicity.
Require Import soundness.
Require Import fixpoint.
Require Import completeness.


Require Import bigop_aux.
Require Import utils.
Require Import finseqs.

Set Implicit Arguments.

Projection over a Datalog program

Section Projection.

Base hypotheses

a safe program p, an interpretation i

and def a default constant
Variable p : program.
Hypothesis psafe : prog_safe p.

Variable i : interp.
Hypothesis isafe : safe_edb i.

Variable def : syntax.constant.

an intensional predicate and an argument index to project over

Variable f : symtype.
Hypothesis ftype : predtype f = Idb.
Variable ind : 'I_(arity f).

The predicate is always defined with a constant at the given index

A function to build new value-indexed predicates

the cloned predicates are not f, different from one another and have the right arity
Hypothesis pnotf : [ c, pclone c != f].
Hypothesis pinj : injective pclone.
Hypothesis parity : [ c, arity f == (arity (pclone c)).+1].

There are enough variables for the P(..,c,..) :- P_c(...) rules
Hypothesis arity_vars : arity f < n.+1.
Rule can have at least one element in their bodies
Hypothesis bn_not_zero : 0 < bn.

Checking if a predicate or a ground atom is a clone

Definition is_clone_pred (g : symtype) : bool :=
 [ c, g == pclone c].

Lemma is_clone_clone_pred c :
 is_clone_pred (pclone c).

Definition is_clone_ga (ga : gatom) : bool :=
  is_clone_pred (sym_gatom ga).

Hypotheses: no clone in the original program or the EDB
Hypothesis pfresh : [ c, pclone c \notin sym_prog p].
Hypothesis ifresh : ~~ [ x in i, is_clone_ga x].

more usable version of pfresh
no clone in the original semantic

Computing the set of constants used in the definition of f

Definition ind_terms :=
  pmap (fun clnth_error (arg_atom (head_cl cl)) ind) [seq cl <- p | hsym_cl cl == f].

Definition ind_vals :=
  pmap (fun tif t is Val c then Some c else None) ind_terms.

Lemma always_cons_in_vals :
     [ cl in p, ((hsym_cl cl) == f)
==> [ c in ind_vals, nth_error (arg_atom (head_cl cl)) ind == (Some (Val c))]].

Cloning the different elements of the program

Atoms

Definition raw_atom_clone (j : 'I_(arity f)) (a : raw_atom) : raw_atom :=
  match a with
  | RawAtom pr args
      
      if (pr == f) then
        match nth_error args j with
          | Some (Val c) ⇒ RawAtom (pclone c) (sremove args j)
          | _RawAtom pr args end
      else RawAtom pr args end.

Lemma wf_clone (j : 'I_(arity f)) (a : atom) : wf_atom (raw_atom_clone j a).

Definition atom_clone (j : 'I_(arity f)) (a : atom) : atom :=
  Atom (wf_clone j a).

Ground atoms

Definition raw_gatom_clone (j : 'I_(arity f)) (a : raw_gatom) : raw_gatom :=
  match a with
  | RawGAtom pr args
      
      if (pr == f) then
        match nth_error args j with
          | Some cRawGAtom (pclone c) (sremove args j)
          | NoneRawGAtom pr args end
      else RawGAtom pr args end.

Lemma wf_gclone (j : 'I_(arity f)) (ga : gatom) : wf_gatom (raw_gatom_clone j ga).

Definition gatom_clone (j : 'I_(arity f)) (ga : gatom) : gatom :=
  GAtom (wf_gclone j ga).

Clauses

Definition tail_clone (j : 'I_(arity f)) (tl : tail) : tail :=
  wmap (atom_clone j) tl.

Definition cl_clone (j : 'I_(arity f)) (cl : clause) : clause :=
  match cl with Clause h tlClause (atom_clone j h) (tail_clone j tl) end.

Rewriting clones

Building the P <- P_c rules

Arguments

X_1, X_2, ..., X_j
Definition gen_vars_j (j : 'I_n.+1): seq term :=
 map (fun xVar x) (map (fun x : 'I_j ⇒ @widen_ord j n (ltn_ord j) x) (dep_iota 0 j)).

X_1, X_2, ..., X_(arity f)

Atoms

Clauses

Projected program

Extracting substitutions for P <- P_c rules

Builds a substitution that matches the variables of args to the values of gargs
Fixpoint extract_sub_seq_c (args : seq term) (gargs : seq syntax.constant)
                           (s : sub) : sub :=
  match gargs with
    [::]s
  | x::l
      match args with
        [::]s | Val x'::l' ⇒ (extract_sub_seq_c l' l s)
      | Var x'::l'add (extract_sub_seq_c l' l s) x' x end end.

Lemma v_in_extract_c (args : seq term) (gargs : seq syntax.constant)
                     (s : sub) (v : 'I_n) :
   size args size gargs
v \in \big[setU (T:=ordinal_finType n)/set0]_(t <- args) term_vars t
v \in dom (extract_sub_seq_c args gargs s).

Lemma in_extract_c_v (args : seq term) (gargs : seq syntax.constant)
                     (v : 'I_n) :
   size args size gargs
(extract_sub_seq_c args gargs emptysub) v
Var v \in args.

Definition extract_sub_ga (a : atom) (ga : gatom) :=
  extract_sub_seq_c (arg_atom a) (arg_gatom ga) emptysub.

Lemma v_in_extract (a : atom) (ga : gatom) :
   arity (sym_atom a) arity (sym_gatom ga)
atom_vars a \subset dom (extract_sub_ga a ga).

Lemma extract_in_v (a : atom) (ga : gatom) :
   arity (sym_atom a) arity (sym_gatom ga)
dom (extract_sub_ga a ga) \subset atom_vars a .

Lemma extract_dom (a : atom) (ga : gatom) :
   arity (sym_atom a) arity (sym_gatom ga)
dom (extract_sub_ga a ga) = atom_vars a.

Lemma var_neq v vb : ((v == vb) = false) ((Var v == Var vb) = false).

Lemma add_seq_gr_def (s : sub) v c (lt : seq term) :
Var v \notin lt
[seq gr_term_def def s i0 | i0 <- lt] = [seq gr_term_def def (add s v c) i0 | i0 <- lt].

Lemma extract_sub_seq_map (lt : seq term) (lc : seq syntax.constant) :
   uniq lt
size lt = size lc
[ t in lt, v, t == Var v]
lc = [seq gr_term_def def (extract_sub_seq_c lt lc emptysub) i0 | i0 <- lt].

Lemma extract_sub_seq_rem_map (lt : seq term) v (lc : seq syntax.constant) (j : 'I_n) c:
j < size lt
size lt = size lc
uniq lt
[ t in lt, vb, t == Var vb]
find (fun yy == Var v) lt = j
nth_error lc j = Some c
lc = [seq gr_term_def def
        (extract_sub_seq_c (rem (Var v) lt) (sremove lc j) emptysub) i
        | i <- set_nth (Val c) lt j (Val c)].

Lemma gr_term_def_seq_add_notin (l : seq term) v c (s:sub) :
   Var v \notin l
[seq gr_term_def def (add s v c) i | i <- l] = [seq gr_term_def def s i | i <- l].

Lemma extract_gr_v (s : sub) (a1 a2 : atom) :
   sym_atom a1 = sym_atom a2
[ t in (arg_atom a1), v:'I_n, t == Var v]
uniq (arg_atom a1)
gr_atom_def def s a2 =
   gr_atom_def def (extract_sub_ga a1 (gr_atom_def def s a2)) a1.

Matching cloned atoms


Lemma match_fold_clone (args : seq term) (gargs : seq syntax.constant) (j : nat) c s :
nth_error args j = Some (Val c) nth_error gargs j = Some c
foldl
  (fun (acc : option {ffun 'I_n option syntax.constant})
     (p0 : syntax.constant × term) ⇒ obind (match_term p0.1 p0.2) acc)
  (Some s) (zip gargs args) =
foldl
  (fun (acc : option {ffun 'I_n option syntax.constant})
     (p0 : syntax.constant × term) ⇒ obind (match_term p0.1 p0.2) acc)
  (Some s) (zip (sremove gargs j) (sremove args j)).

Lemma match_atom_clone_cnone (j : 'I_(arity f)) (s : sub) (a : atom) c (ga : gatom) :
  nth_error (arg_atom a) j = None
       nth_error (arg_atom a) j = Some (Val c)
  sym_atom a = sym_gatom ga
  match_atom s a ga = match_atom s (atom_clone j a) (gatom_clone j ga).

Lemma match_atom_clone_v (j : 'I_(arity f)) (s : sub) (a : atom) (ga : gatom) v :
  nth_error (arg_atom a) j = Some (Var v)
  sym_atom a = sym_gatom ga
  match_atom s a ga = match_atom s (atom_clone j a) ga.

Lemma sym_satom_gatom (a : atom) (ga : gatom) (s : sub) :
  satom a s = to_atom ga sym_atom a = sym_gatom ga.

Lemma match_atom_all_clone_cnone (j : 'I_(arity f)) (k1 k2 : interp) (a : atom) (s : sub) (c : syntax.constant) :
  k1 :|: [set gatom_clone j ga | ga in k1] \subset k2
  nth_error (arg_atom a) j = None nth_error (arg_atom a) j = Some (Val c)
  match_atom_all k1 a s \subset match_atom_all k2 (atom_clone j a) s.

Lemma match_atom_all_clone_v (j : 'I_(arity f)) (k1 k2 : interp) (a : atom) (s : sub) v :
  k1 :|: [set gatom_clone j ga | ga in k1] \subset k2
  nth_error (arg_atom a) j = Some (Var v)
  match_atom_all k1 a s \subset match_atom_all k2 (atom_clone j a) s.

Lemma pmatch_clone (j : 'I_(arity f)) (s : sub) (k1 k2 : interp) c (cl : clause) (ss : {set sub}) :
 k1 :|: [set gatom_clone j ga | ga in k1] \subset k2
nth_error (arg_atom (head_cl cl)) j = Some (Val c)
 s \in match_pbody (body_cl cl) k1 ss
 exists2 s' : sub, s' \in match_pbody (body_cl (cl_clone j cl)) k2 ss &
  (((hsym_cl cl != f) gr_atom_def def s (head_cl cl) =
  gr_atom_def def s' (head_cl (cl_clone j cl)))
((hsym_cl cl = f) gatom_clone j (gr_atom_def def s (head_cl cl)) =
  gr_atom_def def s' (head_cl (cl_clone j cl)))).

Lemma match_clone (j : 'I_(arity f)) (s : sub) (k1 k2 : interp) c (cl : clause) :
 k1 :|: [set gatom_clone j ga | ga in k1] \subset k2
nth_error (arg_atom (head_cl cl)) j = Some (Val c)
 s \in match_body k1 (body_cl cl)
 exists2 s' : sub, s' \in match_body k2 (body_cl (cl_clone j cl)) &
  (((hsym_cl cl != f) gr_atom_def def s (head_cl cl) =
  gr_atom_def def s' (head_cl (cl_clone j cl)))
((hsym_cl cl = f) gatom_clone j (gr_atom_def def s (head_cl cl)) =
  gr_atom_def def s' (head_cl (cl_clone j cl)))).

Lemma pmatch_clone_not_f (j : 'I_(arity f)) (s : sub) (k1 k2 : interp) (cl : clause) (ss : {set sub}) :
(hsym_cl cl != f)
 k1 :|: [set gatom_clone j ga | ga in k1] \subset k2
 s \in match_pbody (body_cl cl) k1 ss
 exists2 s' : sub, s' \in match_pbody (body_cl (cl_clone j cl)) k2 ss &
  gr_atom_def def s (head_cl cl) =
  gr_atom_def def s' (head_cl (cl_clone j cl)).

Lemma match_clone_not_f (j : 'I_(arity f)) (s : sub) (k1 k2: interp) (cl : clause) :
 (hsym_cl cl != f)
 k1 :|: [set gatom_clone j ga | ga in k1] \subset k2
 s \in match_body k1 (body_cl cl)
 exists2 s' : sub, s' \in match_body k2 (body_cl (cl_clone j cl)) &
  gr_atom_def def s (head_cl cl) =
  gr_atom_def def s' (head_cl (cl_clone j cl)).

Lemma atom_vars_clone_c (a : atom) (j : 'I_(arity f)) c :
   nth_error (arg_atom a) j = Some (Val c)
atom_vars a = atom_vars (atom_clone j a).

Lemma clone_bmatch (j : 'I_(arity f)) (s : sub) (k1 k2 : interp) (cl : clause) :
   [ x in k2, ~~ is_clone_ga x]
k1 \subset k2 :|: [set gatom_clone j ga | ga in k2 & sym_gatom ga == f]
s \in match_body k1 (body_cl (cl_clone j cl))
cl \in p
exists2 s' : sub, bmatch def k2 cl s' & ((s \sub s') &&
  (gr_atom_def def s (head_cl cl) == gr_atom_def def s' (head_cl cl))).

Using the P <- P_c rules

If we deduced s(f_c(t1,..,t(ind-1),t(ind+1),...,tn)), we can fire f(...,c,...) <-- f_c(....) to deduce s(f(t1,...,t(ind-1),c,t(ind+1),...,tn))

Adequacy

Completeness

Soundness