Qcert.DNNRC.Lang.DNNRC


Section DNNRC.



  Context {fruntime:foreign_runtime}.

Named Nested Relational Calculus

  Definition var := string.

  Section plug.
    Context {plug_type:Set}.

    Definition coll_bindings := list (string × (list data)).

    Definition bindings_of_coll_bindings (cb:coll_bindings) : bindings :=
      map (fun xy(fst xy, dcoll (snd xy))) cb.

    Class AlgPlug :=
      mkAlgPlug {
          plug_eval : brand_relation_t coll_bindings plug_type option data
          ; plug_normalized :
             (h:brand_relation_t) (op:plug_type), (constant_env:coll_bindings) (o:data),
                Forall (fun xdata_normalized h (snd x)) (bindings_of_coll_bindings constant_env)
                plug_eval h constant_env op = Some o data_normalized h o;

        }.

  End plug.

  Section GenDNNRC.
    Context {A plug_type:Set}.


    Inductive dnnrc : Set :=
    | DNNRCVar : A var dnnrc
    | DNNRCConst : A data dnnrc
    | DNNRCBinop : A binOp dnnrc dnnrc dnnrc
    | DNNRCUnop : A unaryOp dnnrc dnnrc
    | DNNRCLet : A var dnnrc dnnrc dnnrc
    | DNNRCFor : A var dnnrc dnnrc dnnrc
    | DNNRCIf : A dnnrc dnnrc dnnrc dnnrc
    | DNNRCEither : A dnnrc var dnnrc var dnnrc dnnrc
    | DNNRCGroupBy : A string list string dnnrc dnnrc
    | DNNRCCollect : A dnnrc dnnrc
    | DNNRCDispatch : A dnnrc dnnrc
    | DNNRCAlg : A plug_type list (string × dnnrc) dnnrc.


Induction principles used as backbone for inductive proofs on dnnrc

    Definition dnnrc_rect (P : dnnrc Type)
               (fdvar : a, v, P (DNNRCVar a v))
               (fdconst : a, d : data, P (DNNRCConst a d))
               (fdbinop : a, b, n1 n2 : dnnrc, P n1 P n2 P (DNNRCBinop a b n1 n2))
               (fdunop : a, u, n : dnnrc, P n P (DNNRCUnop a u n))
               (fdlet : a, v, n1 n2 : dnnrc, P n1 P n2 P (DNNRCLet a v n1 n2))
               (fdfor : a, v, n1 n2 : dnnrc, P n1 P n2 P (DNNRCFor a v n1 n2))
               (fdif : a, n1 n2 n3 : dnnrc, P n1 P n2 P n3 P (DNNRCIf a n1 n2 n3))
               (fdeither : a, n0 n1 n2, v1 v2,
                       P n0 P n1 P n2 P (DNNRCEither a n0 v1 n1 v2 n2))
               (fdgroupby : a, g, sl, n : dnnrc, P n P (DNNRCGroupBy a g sl n))
               (fdcollect : a, n : dnnrc, P n P (DNNRCCollect a n))
               (fddispatch : a, n : dnnrc, P n P (DNNRCDispatch a n))
               (fdalg : a, op:plug_type, r : list (string×dnnrc), Forallt (fun nP (snd n)) r P (DNNRCAlg a op r))
      :=
        fix F (n : dnnrc) : P n :=
          match n as n0 return (P n0) with
          | DNNRCVar a vfdvar a v
          | DNNRCConst a dfdconst a d
          | DNNRCBinop a b n1 n2fdbinop a b n1 n2 (F n1) (F n2)
          | DNNRCUnop a u nfdunop a u n (F n)
          | DNNRCLet a v n1 n2fdlet a v n1 n2 (F n1) (F n2)
          | DNNRCFor a v n1 n2fdfor a v n1 n2 (F n1) (F n2)
          | DNNRCIf a n1 n2 n3fdif a n1 n2 n3 (F n1) (F n2) (F n3)
          | DNNRCEither a n0 v1 n1 v2 n2fdeither a n0 n1 n2 v1 v2 (F n0) (F n1) (F n2)
          | DNNRCGroupBy a g sl nfdgroupby a g sl n (F n)
          | DNNRCCollect a nfdcollect a n (F n)
          | DNNRCDispatch a nfddispatch a n (F n)
          | DNNRCAlg a op r
            fdalg a op r ((fix F3 (r : list (string × dnnrc)) : Forallt (fun nP (snd n)) r :=
                             match r as c0 with
                             | nilForallt_nil _
                             | cons n c0 ⇒ @Forallt_cons _ _ _ _ (F (snd n)) (F3 c0)
                             end) r)
          end.

Induction principles used as backbone for inductive proofs on dnnrc
    Definition dnnrc_ind (P : dnnrc Prop)
               (fdvar : a, v, P (DNNRCVar a v))
               (fdconst : a, d : data, P (DNNRCConst a d))
               (fdbinop : a, b, n1 n2 : dnnrc, P n1 P n2 P (DNNRCBinop a b n1 n2))
               (fdunop : a, u, n : dnnrc, P n P (DNNRCUnop a u n))
               (fdlet : a, v, n1 n2 : dnnrc, P n1 P n2 P (DNNRCLet a v n1 n2))
               (fdfor : a, v, n1 n2 : dnnrc, P n1 P n2 P (DNNRCFor a v n1 n2))
               (fdif : a, n1 n2 n3 : dnnrc, P n1 P n2 P n3 P (DNNRCIf a n1 n2 n3))
               (fdeither : a, n0 n1 n2, v1 v2,
                       P n0 P n1 P n2 P (DNNRCEither a n0 v1 n1 v2 n2))
               (fdgroupby : a, g, sl, n : dnnrc, P n P (DNNRCGroupBy a g sl n))
               (fdcollect : a, n : dnnrc, P n P (DNNRCCollect a n))
               (fddispatch : a, n : dnnrc, P n P (DNNRCDispatch a n))
               (fdalg : a, op:plug_type, r : list (string×dnnrc), Forall (fun nP (snd n)) r P (DNNRCAlg a op r))
      :=
        fix F (n : dnnrc) : P n :=
          match n as n0 return (P n0) with
          | DNNRCVar a vfdvar a v
          | DNNRCConst a dfdconst a d
          | DNNRCBinop a b n1 n2fdbinop a b n1 n2 (F n1) (F n2)
          | DNNRCUnop a u nfdunop a u n (F n)
          | DNNRCLet a v n1 n2fdlet a v n1 n2 (F n1) (F n2)
          | DNNRCFor a v n1 n2fdfor a v n1 n2 (F n1) (F n2)
          | DNNRCIf a n1 n2 n3fdif a n1 n2 n3 (F n1) (F n2) (F n3)
          | DNNRCEither a n0 v1 n1 v2 n2fdeither a n0 n1 n2 v1 v2 (F n0) (F n1) (F n2)
          | DNNRCGroupBy a g sl nfdgroupby a g sl n (F n)
          | DNNRCCollect a nfdcollect a n (F n)
          | DNNRCDispatch a nfddispatch a n (F n)
          | DNNRCAlg a op r
            fdalg a op r ((fix F3 (r : list (string×dnnrc)) : Forall (fun nP (snd n)) r :=
                             match r as c0 with
                             | nilForall_nil _
                             | cons n c0 ⇒ @Forall_cons _ _ _ _ (F (snd n)) (F3 c0)
                             end) r)
          end.

    Definition dnnrc_rec (P:dnnrcSet) := @dnnrc_rect P.

    Lemma dnnrcInd2 (P : dnnrc Prop)
          (fdvar : a, v, P (DNNRCVar a v))
          (fdconst : a, d : data, P (DNNRCConst a d))
          (fdbinop : a, b, n1 n2 : dnnrc, P (DNNRCBinop a b n1 n2))
          (fdunop : a, u, n : dnnrc, P (DNNRCUnop a u n))
          (fdlet : a, v, n1 n2 : dnnrc, P (DNNRCLet a v n1 n2))
          (fdfor : a, v, n1 n2 : dnnrc, P (DNNRCFor a v n1 n2))
          (fdif : a, n1 n2 n3 : dnnrc, P (DNNRCIf a n1 n2 n3))
          (fdeither : a, n0 n1 n2, v1 v2,
                  P (DNNRCEither a n0 v1 n1 v2 n2))
          (fdgroupby : a, g, sl, n : dnnrc, P n P (DNNRCGroupBy a g sl n))
          (fdcollect : a, n : dnnrc, P (DNNRCCollect a n))
          (fddispatch : a, n : dnnrc, P (DNNRCDispatch a n))
          (fdalg : a, op:plug_type, r : list (string×dnnrc), Forall (fun nP (snd n)) r P (DNNRCAlg a op r))
: n, P n.

    Definition dnnrc_annotation_get (d:dnnrc) : A
      := match d with
         | DNNRCVar a _a
         | DNNRCConst a _a
         | DNNRCBinop a _ _ _a
         | DNNRCUnop a _ _a
         | DNNRCLet a _ _ _a
         | DNNRCFor a _ _ _a
         | DNNRCIf a _ _ _a
         | DNNRCEither a _ _ _ _ _a
         | DNNRCGroupBy a _ _ _a
         | DNNRCCollect a _a
         | DNNRCDispatch a _a
         | DNNRCAlg a _ _a
         end.

    Definition dnnrc_annotation_update (f:AA) (d:dnnrc) : dnnrc
      := match d with
         | DNNRCVar a vDNNRCVar (f a) v
         | DNNRCConst a cDNNRCConst (f a) c
         | DNNRCBinop a b d₁ d₂DNNRCBinop (f a) b d₁ d₂
         | DNNRCUnop a u d₁DNNRCUnop (f a) u d₁
         | DNNRCLet a x d₁ d₂DNNRCLet (f a) x d₁ d₂
         | DNNRCFor a x d₁ d₂DNNRCFor (f a) x d₁ d₂
         | DNNRCIf a d₀ d₁ d₂DNNRCIf (f a) d₀ d₁ d₂
         | DNNRCEither a d₀ x₁ d₁ x₂ d₂DNNRCEither (f a) d₀ x₁ d₁ x₂ d₂
         | DNNRCGroupBy a g sl d₁DNNRCGroupBy (f a) g sl d₁
         | DNNRCCollect a d₀DNNRCCollect (f a) d₀
         | DNNRCDispatch a d₀DNNRCDispatch (f a) d₀
         | DNNRCAlg a p argsDNNRCAlg (f a) p args
         end .

    Context (h:brand_relation_t).
    Fixpoint dnnrc_eval `{plug: AlgPlug plug_type} (env:dbindings) (e:dnnrc) : option ddata :=
      match e with
      | DNNRCVar _ x
        lookup equiv_dec env x
      | DNNRCConst _ d
        Some (Dlocal (normalize_data h d))
      | DNNRCBinop _ bop e1 e2
        olift2 (fun d1 d2lift Dlocal (fun_of_binop h bop d1 d2))
               (olift checkLocal (dnnrc_eval env e1)) (olift checkLocal (dnnrc_eval env e2))
      | DNNRCUnop _ uop e1
        olift (fun d1lift Dlocal (fun_of_unaryop h uop d1)) (olift checkLocal (dnnrc_eval env e1))
      | DNNRCLet _ x e1 e2
        match dnnrc_eval env e1 with
        | Some ddnnrc_eval ((x,d)::env) e2
        | _None
        end
      | DNNRCFor _ x e1 e2
        match dnnrc_eval env e1 with
        | Some (Ddistr c1) ⇒
          let inner_eval d1 :=
              let env' := (x,Dlocal d1) :: env in olift checkLocal (dnnrc_eval env' e2)
          in
          lift (fun collDdistr coll) (rmap inner_eval c1)
        | Some (Dlocal (dcoll c1)) ⇒
          let inner_eval d1 :=
              let env' := (x,Dlocal d1) :: env in olift checkLocal (dnnrc_eval env' e2)
          in
          lift (fun collDlocal (dcoll coll)) (rmap inner_eval c1)
        | Some (Dlocal _) ⇒ None
        | NoneNone
        end
      | DNNRCIf _ e1 e2 e3
        let aux_if d :=
            match d with
            | dbool b
              if b then dnnrc_eval env e2 else dnnrc_eval env e3
            | _None
            end
        in olift aux_if (olift checkLocal (dnnrc_eval env e1))
      | DNNRCEither _ ed xl el xr er
        match olift checkLocal (dnnrc_eval env ed) with
        | Some (dleft dl) ⇒
          dnnrc_eval ((xl,Dlocal dl)::env) el
        | Some (dright dr) ⇒
          dnnrc_eval ((xr,Dlocal dr)::env) er
        | _None
        end
      | DNNRCGroupBy _ g sl e1
        None
      | DNNRCCollect _ e1
        let collected := olift checkDistrAndCollect (dnnrc_eval env e1) in
        lift Dlocal collected
      | DNNRCDispatch _ e1
        match olift checkLocal (dnnrc_eval env e1) with
        | Some (dcoll c1) ⇒
          Some (Ddistr c1)
        | _None
        end
      | DNNRCAlg _ plug nnrcbindings
        match listo_to_olist (map (fun x
               match dnnrc_eval env (snd x) with
               | Some (Ddistr coll) ⇒ Some (fst x, coll)
               | _None
               end) nnrcbindings) with
        | Some args
          match plug_eval h args plug with
          | Some (dcoll c) ⇒ Some (Ddistr c)
          | _None
          end
        | NoneNone
        end
      end.


    Lemma Forall_dcoll_map_lift l:
      Forall (fun x : string × (list data)data_normalized h (dcoll (snd x))) l
      Forall (fun x : string × datadata_normalized h (snd x))
             (map (fun xy : string × list data(fst xy, dcoll (snd xy))) l).

    Lemma Forall_dcoll_map_lift2 l:
      Forall (fun x : string × datadata_normalized h (snd x))
             (map (fun xy : string × list data(fst xy, dcoll (snd xy))) l)
      Forall (fun x : string × (list data)data_normalized h (dcoll (snd x))) l.

    Lemma Forall_dcoll_map_lift3 l:
      Forall (fun x : string × datadata_normalized h (snd x))
             (map (fun xy : string × list data(fst xy, dcoll (snd xy))) l)
      Forall (fun x : string × (list data)data_normalized h (dcoll (snd x))) l.

    Lemma dnnrc_alg_bindings_normalized {plug:AlgPlug plug_type} denv l r :
      Forall (ddata_normalized h) (map snd denv)
      Forall
        (fun n : string × dnnrc
            (denv : dbindings) (o : ddata),
             dnnrc_eval denv (snd n) = Some o
             Forall (ddata_normalized h) (map snd denv) ddata_normalized h o) r
      rmap
         (fun x : string × dnnrc
          match dnnrc_eval denv (snd x) with
          | Some (Dlocal _) ⇒ None
          | Some (Ddistr coll) ⇒ Some (fst x, coll)
          | NoneNone
          end) r = Some l
      Forall (fun x : string × (list data)data_normalized h (dcoll (snd x))) l.

    Lemma dnnrc_eval_normalized {plug:AlgPlug plug_type} denv e {o} :
      dnnrc_eval denv e = Some o
      Forall (ddata_normalized h) (map snd denv)
      ddata_normalized h o.

    Corollary dnnrc_eval_normalized_local {plug:AlgPlug plug_type} denv e {d} :
      dnnrc_eval denv e = Some (Dlocal d)
      Forall (ddata_normalized h) (map snd denv)
      data_normalized h d.

  End GenDNNRC.

  Section NraEnvPlug.

    Definition nraenv_eval h aconstant_env op :=
      let aenv := drec nil in
      let aid := dcoll ((drec nil)::nil) in
      cnraenv_eval h (bindings_of_coll_bindings aconstant_env) op aenv aid.

    Lemma nraenv_eval_normalized h :
       op:cnraenv, (constant_env:coll_bindings) (o:data),
      Forall (fun xdata_normalized h (snd x)) (bindings_of_coll_bindings constant_env)
      nraenv_eval h constant_env op = Some o
      data_normalized h o.


    Definition dnnrc_cnraenv {A} := @dnnrc A cnraenv.

  End NraEnvPlug.

End DNNRC.


Tactic Notation "dnnrc_cases" tactic(first) ident(c) :=
  first;
  [ Case_aux c "DNNRCVar"%string
  | Case_aux c "DNNRCConst"%string
  | Case_aux c "DNNRCBinop"%string
  | Case_aux c "DNNRCUnop"%string
  | Case_aux c "DNNRCLet"%string
  | Case_aux c "DNNRCFor"%string
  | Case_aux c "DNNRCIf"%string
  | Case_aux c "DNNRCEither"%string
  | Case_aux c "DNNRCGroupBy"%string
  | Case_aux c "DNNRCCollect"%string
  | Case_aux c "DNNRCDispatch"%string
  | Case_aux c "DNNRCAlg"%string ].