Require Import RefProofDeps.
Require Import RData.
Require Import EventReplay.
Require Import MoverTypes.
Require Import Constants.
Require Import CommonLib.
Require Import RefTactics.
Require Import TableDataOpsIntro.Spec.
Require Import TableDataOpsRef2.Spec.
Require Import TableDataOpsRef3.Specs.table_destroy3.
Require Import TableDataOpsRef3.LowSpecs.table_destroy3.
Require Import TableDataOpsRef3.RefProof.RefRel.

Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Opaque Z.add Z.mul Z.div Z.shiftl Z.shiftr Z.land Z.lor.

Section Refine.

  Hint Unfold
       table_destroy_spec
       table_destroy2_spec
    .

  Lemma table_destroy3_spec_exists:
    forall habd habd'  labd g_rd map_addr rtt_addr level res
      (Hspec: table_destroy3_spec g_rd map_addr rtt_addr level habd = Some (habd', res))
      (Hrel: relate_RData habd labd),
    exists labd', table_destroy3_spec0 g_rd map_addr rtt_addr level labd = Some (labd', res) /\ relate_RData habd' labd'.
  Proof.
    Local Opaque peq ptr_eq granule_fill_table.fill_table.
    intros. duplicate Hrel. destruct D. clear hrepl lrepl. destruct g_rd.
    unfold table_destroy3_spec, table_destroy3_spec0 in *.
    unfold Assertion in *. rm_bind Hspec; rm_bind'. simpl in *.
    unfold Assertion; rm_bind'; grewrite.
    repeat simpl_hyp Hspec; extract_prop_dec; simpl_query_oracle; rm_bind'; grewrite.
    - rewrite_oracle_rel rel_oracle C12.
      repeat (grewrite; try simpl_htarget; simpl).
      unfold destroy_table, table_destroy.destroy_table in *. simpl in *. autounfold in *. simpl in *. grewrite.
      repeat simpl_hyp Hspec; simpl; inversion Hspec; extract_prop_dec; simpl_query_oracle.
      autounfold. unfold query_oracle. autounfold. simpl.
      destruct Hrel. grewrite. destruct valid_lo0. erewrite Hright_log_nil. simpl.
      repeat (grewrite; try simpl_htarget; simpl). rewrite <- H1, <- H0. simpl.
      (eexists; split; [reflexivity| constructor; simpl; try assumption; try reflexivity]).
      eapply RightLogMover.
      apply walk_right. omega. omega. apply RightLogOracle.
      (eexists; split; [reflexivity| constructor; destruct Hrel; simpl; try assumption; try reflexivity]).
    - rewrite_oracle_rel rel_oracle C12.
      repeat (grewrite; try simpl_htarget; simpl).
      unfold destroy_table, table_destroy.destroy_table in *. simpl in *. autounfold in *. simpl in *. grewrite.
      repeat simpl_hyp Hspec; simpl; inversion Hspec; extract_prop_dec; simpl_query_oracle.
      autounfold. unfold query_oracle. autounfold. simpl.
      destruct Hrel. grewrite. destruct valid_lo0. erewrite Hright_log_nil. simpl.
      repeat (grewrite; try simpl_htarget; simpl). rewrite <- H1, <- H0. simpl.
      (eexists; split; [reflexivity| constructor; simpl; try assumption; try reflexivity]).
      eapply RightLogMover.
      apply walk_right. omega. omega. apply RightLogOracle.
      (eexists; split; [reflexivity| constructor; destruct Hrel; simpl; try assumption; try reflexivity]).
    - rewrite_oracle_rel rel_oracle C12.
      repeat (grewrite; try simpl_htarget; simpl).
      unfold destroy_table, table_destroy.destroy_table in *. simpl in *. autounfold in *. simpl in *. grewrite.
      repeat simpl_hyp Hspec; simpl; inversion Hspec; extract_prop_dec; simpl_query_oracle.
      autounfold. unfold query_oracle. autounfold. simpl.
      destruct Hrel. grewrite. destruct valid_lo0. erewrite Hright_log_nil. simpl.
      repeat (grewrite; try simpl_htarget; simpl). rewrite <- H1, <- H0. simpl.
      (eexists; split; [reflexivity| constructor; simpl; try assumption; try reflexivity]).
      eapply RightLogMover.
      apply walk_right. omega. omega. apply RightLogOracle.
      autounfold. unfold query_oracle. autounfold. simpl.
      destruct Hrel. grewrite. destruct valid_lo0. erewrite Hright_log_nil. simpl.
      repeat (grewrite; try simpl_htarget; simpl). rewrite <- H1, <- H0. simpl.
      (eexists; split; [reflexivity| constructor; simpl; try assumption; try reflexivity]).
      eapply RightLogMover.
      apply walk_right. omega. omega. apply RightLogOracle.
      (eexists; split; [reflexivity| constructor; destruct Hrel; simpl; try assumption; try reflexivity]).
    - rewrite_oracle_rel rel_oracle C12.
      repeat (grewrite; try simpl_htarget; simpl).
      inversion Hspec; (eexists; split; [reflexivity| constructor; destruct Hrel; simpl; try assumption; try reflexivity]).
    - rewrite_oracle_rel rel_oracle C12.
      repeat (grewrite; try simpl_htarget; simpl).
      inversion Hspec; (eexists; split; [reflexivity| constructor; destruct Hrel; simpl; try assumption; try reflexivity]).
  Qed.

End Refine.


(* Contribution to the Coq Library   V6.3 (July 1999)                    *)
Require Import securite.

Lemma POinvprel5 :
 forall (l l0 : list C) (k k0 k1 k2 : K) (c c0 c1 c2 : C)
   (d d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12 d13 d14 d15 d16 d17 d18 d19
    d20 : D),
 inv0
   (ABSI (MBNaKab d7 d8 d9 k0) (MANbKabCaCb d4 d5 d6 k c c0)
      (MABNaNbKeyK d d0 d1 d2 d3) l) ->
 inv1
   (ABSI (MBNaKab d7 d8 d9 k0) (MANbKabCaCb d4 d5 d6 k c c0)
      (MABNaNbKeyK d d0 d1 d2 d3) l) ->
 invP
   (ABSI (MBNaKab d7 d8 d9 k0) (MANbKabCaCb d4 d5 d6 k c c0)
      (MABNaNbKeyK d d0 d1 d2 d3) l) ->
 rel5
   (ABSI (MBNaKab d7 d8 d9 k0) (MANbKabCaCb d4 d5 d6 k c c0)
      (MABNaNbKeyK d d0 d1 d2 d3) l)
   (ABSI (MBNaKab d18 d19 d20 k2) (MANbKabCaCb d15 d16 d17 k1 c1 c2)
      (MABNaNbKeyK d10 d11 d12 d13 d14) l0) ->
 invP
   (ABSI (MBNaKab d18 d19 d20 k2) (MANbKabCaCb d15 d16 d17 k1 c1 c2)
      (MABNaNbKeyK d10 d11 d12 d13 d14) l0).

Proof.
do 32 intro.
unfold inv1, invP, rel5 in |- *. intros Inv0 know_Kas_Kbs know_Kab and1.
elim know_Kas_Kbs; intros know_Kas know_Kbs.
elim and1; intros eq_l0 t1.
clear Inv0 know_Kas_Kbs and1 t1.
rewrite eq_l0.
unfold triple in |- *.
apply D2.
simpl in |- *.
repeat apply C3 || apply C4.
elim (D_dec d0 d1).

(* (d0, d1) = (Aid, Bid) *)
intros eq_d0_d1; elim eq_d0_d1; intros eq_d0 eq_d1.
rewrite eq_d0.
rewrite eq_d1.
apply C1. apply C1.
apply D1.
apply EP1 with rngDDKKeyAB.
apply equivnknown1 with (B2C (K2B (KeyX Bid))) (l ++ rngDDKKeyAB).
apply equivS4 with (l ++ rngDDKKeyABminusKab ++ rngDDKKeyAB).
elim l; simpl in |- *; auto with otway_rees.
exact rngs.
rewrite (app_ass l rngDDKKeyABminusKab rngDDKKeyAB).
elim l; elim rngDDKKeyABminusKab; elim rngDDKKeyAB; simpl in |- *;
 auto with otway_rees.
auto with otway_rees.
assumption.
discriminate.
discriminate.

(* (d0, d1) <> (Aid, Bid) *)
intros not_eq_d0_d1.
repeat apply C2 || apply C3 || apply C4.
apply
 equivncomp
  with
    (Encrypt (Pair (B2C (D2B d3)) (B2C (K2B (KeyAB d0 d1)))) (KeyX d1)
     :: B2C (K2B (KeyAB d0 d1)) :: l ++ rngDDKKeyABminusKab).
apply equivS2.
repeat apply C2 || apply C3 || apply C4.
apply equivncomp with (B2C (K2B (KeyAB d0 d1)) :: l ++ rngDDKKeyABminusKab).
apply AlreadyIn1; unfold In in |- *; left; auto with otway_rees.
apply equivncomp with (l ++ rngDDKKeyABminusKab).
apply AlreadyIn1; apply in_or_app; right.
apply rngDDKKeyABminusKab1; apply KeyAB1.
tauto.
apply D1; assumption.
discriminate.
discriminate.
discriminate.
discriminate.
discriminate.
discriminate.
discriminate.
discriminate.
discriminate.
Qed.


Require Import Program Equality Ring Lia Omega.
From Coq Require Import ssreflect ssrfun ssrbool.
From mathcomp Require Import seq eqtype ssrnat.
From istari Require Import lemmas0
     source subst_src rules_src basic_types0 basic_types
     help subst_help0 subst_help trans derived_rules embedded_lemmas proofs.
From istari Require Import Sigma Tactics
     Syntax Subst SimpSub Promote Hygiene
     ContextHygiene Equivalence Equivalences.
From istari Require Import Rules Defined DefsEquiv.

Theorem total G E A: of_m G E A ->
                exists ebar, trans G E A ebar.
  intros He. induction He.
  {exists (lam (lam (gamma_nth (var 0) i))). constructor. assumption.
  }
  { exists (lam (lam nzero)). constructor.
  }
  {
    destruct IHHe as [mbar Hm].
    exists (lam (lam (nsucc (app (app (subst (sh 2) mbar) (var 1)) (var 0))))).
    constructor. assumption.
  }
  { destruct IHHe as [Et Hm].
    exists
      (lam (lam (lam (lam (lam
                             (app (app (shift 5 Et) (var 2))
                                        (ppair (var 0) (move_gamma G (var 4) (var 2)
                                                                   (var 1) (var 3)))

            )))))). constructor. assumption.
  }
  { destruct IHHe1 as [Et1 Het1]. destruct IHHe2 as [Et2 Het2].
    exists ( lam (lam
                   (let Et1 := shift 2 Et1 in
                   let Et2 := shift 2 Et2 in
                   let l := (var 1) in
                   let g := (var 0) in
                   let arg := (app (app Et2 l) g) in
                   (app (app (app (app (app Et1 l) g) l) (make_subseq_refl l)) arg)
                ))). eapply t_ap. apply Het1. assumption.
  }
  { destruct IHHe as [Et Het].
    exists
          (lam (lam (lam (lam (lam
                                 (let l1 := var 4 in
                                  let g := var 3 in
                                  let l := var 2 in
                            let m := var 1 in
                            let s := var 0 in
                            let e := move_app A l1 l m (app (app (shift 5 Et) l1) g) in
                            inl (
                                (ppair
                                   l
                                   (ppair (ppair (make_subseq_refl l) s) e))
                            )

          )))))). apply t_ret. assumption.
  }
  { destruct IHHe1 as [Et1 Het1]. destruct IHHe2 as [Et2 Het2].
exists ( lam (lam ( lam ( (*l1 : = 2, g: Gamma_at G = 1 l :=0 *) lam ( (*l1 := 3, l := 1, m := 0*)
                           lam ( (*l1 := 4, l := 2, m := 1, s := 0*)
                               let l1 := (var 4) in
                               let g := (var 3) in
                               let l := (var 2) in
                               let m := (var 1) in
                               let s := (var 0) in
let btarg := app (app (app (app (app (shift 5 Et1) l1) g) l) m) s in
make_bind btarg ( lam (*l1 := 5, l := 3, m := 2, s := 1, z1 := 0*)
              (
                               let z1 := (var 0) in (*basically added 6 vars to my context*)
                               let lv := (picomp1 z1) in
                               let mv := (picomp2 z1) in
                               let sv := (picomp3 z1) in
                               let x' := (picomp4 z1) in
                               let l := (shift 1 l) in (*l = 3*)
                                                                        (*
in the context (A :: G) Et2 is a function which wants a length
in the context G, Et2 has var 0 free. In context G, (lam Et2) is a function which wants an
x, then a length
make the lambda first before you introduce other variables and it's still the first var
that. you want to bind
                                                                         *)
                               (*x' lam, floating around in the context as var 0*)
(*et2's var 0 is the x.
 maybe plan is bring the subst outside the lamda so that you type check the lamda in the
 weakened context*)

                               let btarg :=
                                   (*Et2 Gamma@V lv*)
                                   app (app (shift 6 Et2)
                                           lv
                                            )
                                            (*5: Gamma_at G w
                                              move 5: Gamma_at G v
                                          <x, 5> : Gamma_at A::G v*)
                       (ppair x' (move_gamma G
                                             (var 5) lv
                       (make_subseq_trans (var 5) (var 3) lv (var 2) mv)
                       (var 4)))                                                 in
                               let e2bar' := app (app (app btarg lv) (make_subseq_refl lv) )
                                                 (*v, z1 <= v, z1*)
                                                 sv in
                               make_bind e2bar' (lam ( (*l = var 4*)
                                                    let z2 := (var 0) in
                                                    ret_a (ppair (picomp1 z2)
                                                                 (ppair (ppair
             (make_subseq_trans (shift 1 l) (shift 1 lv) (picomp1 z2) (picomp2 (shift 1 z1)) (picomp2 z2))
                                                                           (*z2 \circ z1*)
                                                      (picomp3 z2)) (picomp4 z2))
                                                        )
                                               ))
              )

          )

    ))
  )))). eapply t_bind. apply Het1. assumption.
}
  {
    destruct IHHe as [Et Het].
    exists (lam (lam (lam (lam ( lam ( (*l1, g, l, m, s*)
         let l := var 2 in
         let m1 := (make_consb_subseq l) in (*u <= u1, consb subseq*)
         let p1 := (ppair m1
                         (lam (lam ( lam ( (*making a value of type store U1, lambdas go l2, m2, i*)
                                         let l1 := var 7 in
                                         let g := var 6 in
                                         let l := var 5 in
                                         let m := var 4 in
                                         let s := var 3 in
                                         let l2 := var 2 in
                                         let m2 := var 1 in
                                         let i := var 0 in
                                         let x := app (app (shift 8 Et) l1) g in
                                         let m12 := (make_subseq_trans l (nsucc l)
                                                                      l2 (subst (sh 3) m1) m2) (*U <=  U1 <= U2*)
                                         in
                                         let m02 := make_subseq_trans l1 l l2 m m12 in (*W <= U + U <= U2 = W <= U2*)

                                         (*m12 o m : W <= U2*)
                                         bite (ltb_app i l)
                                              (app (app (app s l2) m12) i) (*move value in s:store(U) to U2*)
                                              (next (move_app A
                                                              l1 l2
                                                              m02 x)) (*move x to be : |> A @ U2*)
                                               ))
                         ))
         ) in
             ret_a (ppair (nsucc l) (*length of new world*)
                          (ppair p1 (*new word is accessible from current world, *)
                                 (ppair l (ppair (app leq_refl_fn (nsucc l)) (lam triv)) (*ref A @ new world*)
                                 )
                          )
                   ))))))). constructor. assumption.

  }
  { destruct IHHe1 as [Et Het1]. destruct IHHe2 as [Rt Het2].
    exists
            (lam (lam (lam (lam ( lam ( (*l = 4, g = 3, l1 = 2, m = 1, s1 = 0*)
                                      let l := var 4 in
                                      let m := var 1 in
                                      let l1 := var 2 in
                                      let g := var 3 in
                                      let s1 := var 0 in
                                      let ref := move_app (reftp_m T)
                                                          (var 4) (var 2)
                                                          m (app (app (shift 5 Rt) l) g) in
                                      let i := ppi1 ref in
                                      let p := ppi2 ref in
                                      let store_u1  := lam (lam (lam (*l2 = 2, m1 = 1,j = 0*)
                                                                  (
                                                                    let j := (var 0) in
                                                                    let l2 := var 2 in
                                                                    let m1 := var 1 in
                                                                    let i := shift 3 i in
                                                                    let l := shift 3 l in
                                                                    let l1 := shift 3 l1 in
                                                                    let g := shift 3 g in
                                                                    let m := shift 3 m in
                                                                    bite
                                                                      (app (eq_b j) i)
                                                                      (next (move_app T
                                                                                l
                                                                                l2
   (make_subseq_trans l l1 l2 m m1)
                                                                    (app (app (shift 8 Et) l) g)))
                                                                      (app (app (app (shift 3 s1) l2) m1) j)
                                                                 ))) in
                                      ret_a (ppair l1
                                                   (ppair
                                                      (ppair (make_subseq_refl l1) (*refl u1*)
                                                             store_u1)
                                                      triv))
            )))))).
    constructor. assumption. assumption. }
  { destruct IHHe as [Rt Het].
    exists (lam (lam (lam (lam ( lam (                                       let l := var 4 in
                                      let g := var 3 in
                                      let l1 := var 2 in
                                      let m := var 1 in
                                      let s := var 0 in
                                      let ref := move_app (reftp_m T) l l1
                                                          m (app (app (shift 5 Rt) l) g) in
                                      let i := ppi1 ref in
                                      let e := prev (app (app (app s l1)
                                                (make_subseq_refl l1)) i) in
                                     (inr (next (inl (ppair
                                                                            l1
                                                                            (ppair (
                                                                                ppair (make_subseq_refl l1)
                                                                                s)
                                                                                e)
                                                                               )
                                    ))))
            ))))). constructor. assumption.
  }
  { exists (lam (lam triv)). constructor. } Qed.


(** This file implements an interface to [expr] that
 ** makes star, emp, and pure assertions apparent.
 **)
(* Require Import ExtLib.Data.Positive. *)
Require Import ExtLib.Data.Fun.
Require Import ExtLib.Data.List.
Require Import ExtLib.Data.Option.
Require Import ExtLib.Structures.Traversable.
Require Import ExtLib.Tactics.
Require Import BILogic Pure.
Require Import MirrorCore.EnvI.
Require Import MirrorCore.SymI.
Require Import MirrorCore.TypesI.
Require Import MirrorCore.ExprI.
Require Import MirrorCore.Lambda.Expr.
Require Import MirrorCore.Lambda.AppN.
Require Import MirrorCore.Lambda.TypedFoldApp.

Set Implicit Arguments.
Set Strict Implicit.

(** NOTE: This could work on arbitrary expr's **)
Section seplog_fold.
  Variable typ : Type.
  Variable RType_typ : RType typ.
  Variable Typ2_Fun : Typ2 _ Fun.
  Variable sym : Type.
  Variable RSym_sym : RSym sym.

  Let tyArr : typ -> typ -> typ := @typ2 _ _ _ _.

  Let Expr_expr := @Expr_expr typ sym _ _ _.
  Local Existing Instance Expr_expr.

  Variable T : Type.
  Variable SL : typ.

  Record SepLogArgs : Type :=
  { do_other : expr typ sym -> list (expr typ sym * T) -> T
  ; do_pure : expr typ sym -> T
  ; do_emp : T
  ; do_star : T -> T -> T
  }.

  Record SepLogSpec : Type :=
  { is_pure : expr typ sym -> bool
  ; is_emp : expr typ sym -> bool
  ; is_star : expr typ sym -> bool
  }.

  Variable sla : SepLogArgs.
  Variable sls : SepLogSpec.

  Record SepLogSpecOk (sls : SepLogSpec)
         (OPS : ILogic.ILogicOps (typD SL))
         (BI : BILOperators (typD SL)) : Type :=
  { _PureOp : @PureOp (typD SL)
  ; _Pure : @Pure _ OPS BI _PureOp
  ; His_pure : forall e,
                 sls.(is_pure) e = true ->
                 forall us vs val,
                   exprD us vs e SL = Some val ->
                   pure val
  ; His_emp : forall e,
                sls.(is_emp) e = true ->
                forall us vs,
                  exprD us vs e SL = Some empSP
  ; His_star : forall e,
                 sls.(is_star) e = true ->
                 forall us vs,
                   exprD us vs e (tyArr SL (tyArr SL SL)) =
                   Some match eq_sym (typ2_cast SL (tyArr SL SL)) in _ = t
                              return t
                        with
                          | eq_refl =>
                            match eq_sym (typ2_cast SL SL) in _ = t
                                  return _ -> t
                            with
                              | eq_refl => sepSP
                            end
                        end
  }.

  Record SepLogArgsOk (R_t : expr typ sym -> T -> tenv typ -> tenv typ -> Prop) :=
  { otherOk
    : forall e es tus tvs,
        @typeof_apps typ sym _ _ _ tus tvs e (List.map fst es) = Some SL ->
        (forall x y,
           In (x,y) es ->
           typeof_expr tus tvs x = Some SL ->
           R_t x y tus tvs) ->
        R_t (apps e (List.map fst es)) (sla.(do_other) e es) tus tvs
  ; pureOk
    : forall e tus tvs,
        typeof_expr tus tvs e = Some SL ->
        sls.(is_pure) e = true ->
        R_t e (sla.(do_pure) e) tus tvs
  ; empOk
    : forall e tus tvs,
        typeof_sym e = Some SL ->
        sls.(is_emp) (Inj e) = true ->
        R_t (Inj e) sla.(do_emp) tus tvs
  ; starOk
    : forall e l r l_res r_res tus tvs,
        typeof_sym e = Some (tyArr SL (tyArr SL SL)) ->
        typeof_expr tus tvs l = Some SL ->
        typeof_expr tus tvs r = Some SL ->
        sls.(is_star) (Inj e) = true ->
        R_t l l_res tus tvs ->
        R_t r r_res tus tvs ->
        R_t (apps (Inj e) (l :: r :: nil)) (sla.(do_star) l_res r_res) tus tvs
  }.

  Require Import ExtLib.Structures.Applicative.
  Instance Applicative_Lazy : Applicative Lazy :=
  { ap := fun _ _ f x z =>
            match f z , x z with
              | Some f , Some x => Some (f x)
              | _ , _ => None
            end
  ; pure := fun _ x => fun _ => Some x }.

  (** NOTE: This does not need to be typed! **)
  Definition AppFullFoldArgs_SepLogArgs
  : AppFullFoldArgs typ sym T.
  refine
    match sla , sls with
      | {| do_other := do_other
         ; do_pure := do_pure
         ; do_star := do_star
         ; do_emp := do_emp |}
      , {| is_pure := is_pure
         ; is_star := is_star
         ; is_emp := is_emp |} =>
        @Build_AppFullFoldArgs
          typ sym T
          (fun v _ _ =>
             if is_pure (Var v) then
               Some (do_pure (Var v))
             else
               if is_emp (Var v) then
                 Some do_emp
               else
                 Some (do_other (Var v) nil))
          (fun u _ _ =>
             if is_pure (UVar u) then
               Some (do_pure (UVar u))
             else
               if is_emp (UVar u) then
                 Some do_emp
               else
                 Some (do_other (UVar u) nil))
          (fun i _ _ =>
             if is_emp (Inj i) then
               Some do_emp
             else
               if is_pure (Inj i) then
                 Some (do_pure (Inj i))
               else
                 Some (do_other (Inj i) nil))
          (fun tus tvs t f fres args z =>
             if is_star f then
               match args with
                 | (_,_,l) :: (_,_,r) :: nil =>
                   match l z , r z with
                     | Some l , Some r =>
                       Some (do_star l r)
                     | _ , _ => None
                   end
                 | _ => Some do_emp
               end
             else
               let original := apps f (map (fun x => snd (fst x)) args) in
               if is_pure original then
                 Some (do_pure original)
               else
                 ap (pure (do_other f))
                    (mapT (fun tev => let '(t,e,v) := tev in
                                      match v tt with
                                        | None => None
                                        | Some v => Some (e,v)
                                      end) args))
          (fun tus tvs t _ e eres _ =>
             if is_pure (Abs t e) then
               Some (do_pure (Abs t e))
             else
               if is_emp (Abs t e) then
                 Some do_emp
               else
                 Some (do_other (Abs t e) nil))
    end.
  Defined.

(* TODO(gmalecha): Port the proof!
  Section sound.
    Hypothesis BILOps : BILOperators (typD nil SL).
    Context R_t `{slaok : SepLogArgsOk R_t}.

    Lemma atomic_ok
    : forall ts (tus tvs : tenv typ) e (t : typ),
        typeof_expr ts tus tvs e = Some t ->
        t = SL ->
        R_t e (sla.(do_other) e nil) tus tvs.
    Proof.
      destruct slaok. simpl; intros. subst.
      change e with (apps e nil) at 1.
      eapply (otherOk0 ts e nil tus tvs); simpl.
      { unfold typeof_apps. simpl. rewrite H. reflexivity. }
      { intuition. }
    Qed.

    Hypothesis is_starOk
    : forall i,
        sls.(is_star) (Inj i) = true ->
        typeof_sym i = Some (tyArr SL (tyArr SL SL)).

    Lemma lem_other
    : forall ts0 t rs tus tvs l_res do_atomic_app0,
        Forall2
          (fun (t0 : typ) (x : expr sym * (tenv typ -> tenv typ -> T)) =>
             typeof_expr tus tvs (fst x) = Some t0 /\
             (t0 = SL -> R_t (fst x) (snd x tus tvs) tus tvs)) ts0 rs ->
        forall e : expr sym,
          typeof_expr tus tvs (apps e (map fst rs)) = Some t ->
          (fold_right tyArr t ts0 = SL -> R_t e (l_res tus tvs) tus tvs) ->
          typeof_apps RSym_sym tus tvs e (map fst rs) = Some SL ->
          (forall (e0 : expr sym) (es : list (expr sym * T)) (tus0 tvs0 : tenv typ),
             typeof_apps RSym_sym tus0 tvs0 e0 (map fst es) = Some SL ->
             (forall (x : expr sym) (y : T),
                In (x, y) es -> typeof_expr tus0 tvs0 x = Some SL -> R_t x y tus0 tvs0) ->
             R_t (apps e0 (map fst es)) (do_atomic_app0 e0 es) tus0 tvs0) ->
          R_t (apps e (map fst rs))
              (do_atomic_app0 e
                              (map
                                 (fun x : expr sym * (tenv typ -> tenv typ -> T) =>
                                    (fst x, snd x tus tvs)) rs)) tus tvs.
    Proof.
      intros.
      specialize (H3 e (map
                          (fun x : expr sym * (tenv typ -> tenv typ -> T) =>
                             (fst x, snd x tus tvs)) rs) tus tvs).
      rewrite map_map in *. simpl in *.
      eapply H3; eauto.
      clear - H. induction H; simpl; intuition.
      inv_all. subst. rewrite H1 in *. inv_all; subst.
      eauto.
    Qed.

    Definition AppFullFoldArgsOk_SepLogsOk
    : AppFullFoldArgsOk _ (AppFullFoldArgs_SepLogArgs sla)
                        (fun t e res tus tvs =>
                           t = SL ->
                           R_t e res tus tvs).
    Proof.
      remember sla as s; destruct s; simpl; remember sls as s; destruct s.
      constructor.
      { simpl; intros.
        replace do_other0 with (sla.(do_other)).
        eapply atomic_ok; eauto. rewrite <- Heqs; reflexivity. }
      { simpl; intros.
        replace do_other0 with (sla.(do_other)).
        eapply atomic_ok; eauto. rewrite <- Heqs; reflexivity. }
      { simpl; intros.
        consider (is_emp0 v); intros.
        { replace do_emp0 with (sla.(do_emp)).
          eapply (@empOk _ slaok); eauto.
          Cases.rewrite_all_goal. auto.
          rewrite <- Heqs0. simpl. auto.
          rewrite <- Heqs. reflexivity. }
        { replace do_other0 with (sla.(do_other)).
          eapply atomic_ok; eauto. rewrite <- Heqs; reflexivity. } }
      { simpl; intros.
        replace do_other0 with (sla.(do_other)).
        eapply atomic_ok; eauto. rewrite <- Heqs; reflexivity. }
      { intros. subst ft. simpl.
        assert (typeof_apps RSym_sym tus tvs l (map fst rs) = Some SL).
        { rewrite <- typeof_expr_apps. congruence. }
        generalize (otherOk slaok). rewrite <- Heqs. simpl.
        destruct l; eauto using lem_other.
        consider (is_star0 s); eauto using lem_other; intros.
        { generalize H4. eapply is_starOk in H4.
          unfold typeof_apps in H3.
          simpl in H3. rewrite H4 in *.
          inversion H1; clear H1; try subst.
          { subst rs ts0; intros.
            simpl in *. clear - H3. inv_all.
            symmetry in H3. eapply tyArr_circ_L in H3. intuition. }
          { subst rs ts0. inversion H7; clear H7.
            { subst l l'; intros; simpl in *.
              rewrite H4 in *. forward.
              intuition. inv_all. subst y t0.
              clear - H8. symmetry in H8.
              eapply tyArr_circ_L in H8. intuition. }
            { subst l l'. inversion H8; clear H8.
              { subst l0 l'0. intuition. subst t.
                destruct y, y0; simpl in *.
                rewrite H8 in *. rewrite H6 in *. rewrite H4 in *.
                unfold type_of_apply in *. forward.
                inv_all.
                subst x0 x t1 t2 t3 p0 p.
                replace do_star0 with (sla.(do_star));
                  [ | rewrite <- Heqs; reflexivity ].
                eapply (starOk slaok); eauto.
                rewrite <- Heqs0. auto. }
              { exfalso. clear Heqs Heqs0. subst.
                simpl in H3. intuition.
                rewrite H2 in *. rewrite H6 in *. rewrite H1 in *.
                forward. inv_all; try subst.
                clear H15 H13. subst x x0 x1.
                clear - H14.
                eapply type_of_applys_circle_False in H14. auto. } } } } }
    Qed.

    Definition seplog_fold (sla : SepLogArgs) : expr sym -> tenv typ -> tenv typ -> T :=
      app_fold_args (AppFullFoldArgs_SepLogArgs sla).

    Theorem seplog_fold_sound
    : forall e tus tvs result,
        seplog_fold sla e tus tvs = result ->
        typeof_expr tus tvs e = Some SL ->
        R_t e result tus tvs.
    Proof.
      intros.
      eapply (app_fold_args_sound AppFullFoldArgsOk_SepLogsOk) in H; eauto.
    Qed.
  End sound.
*)

(*
  Variable OPS : ILogic.ILogicOps (typD ts nil SL).
  Variable BI : BILOperators (typD ts nil SL).
  Variable slsok : SepLogSpecOk sls OPS BI.

  Require Import Relations.
  Require Import ExtLib.Data.HList.

  Record SepLogArgsSemOk
         (TD : T -> forall tus tvs, tenv typ -> tenv typ -> option (typD ts nil SL))
         (R : forall tus tvs,
                relation (hlist (typD ts nil) tus ->
                          hlist (typD ts nil) tvs ->
                          typD ts nil SL)) :=
  { atomic_appOk
    : forall e es tus tvs val,
        exprD' tus tvs (apps e es) SL = Some val ->
        R tus tvs val (TD (sla.(do_other) e es))
  ; pureOk
    : forall e tus tvs,
        typeof_expr tus tvs e = Some SL ->
        sls.(is_pure) e = true ->
        R_t e (sla.(do_pure) e) tus tvs
  ; empOk
    : forall e tus tvs,
        typeof_sym e = Some SL ->
        sls.(is_emp) e = true ->
        R_t (Inj e) sla.(do_emp) tus tvs
  ; starOk
    : forall e l r l_res r_res tus tvs,
        typeof_sym e = Some (tyArr SL (tyArr SL SL)) ->
        typeof_expr tus tvs l = Some SL ->
        typeof_expr tus tvs r = Some SL ->
        sls.(is_star) e = true ->
        R_t l l_res tus tvs ->
        R_t r r_res tus tvs ->
        R_t (apps (Inj e) (l :: r :: nil)) (sla.(do_star) l_res r_res) tus tvs
  }.
*)

End seplog_fold.


Require Import logic.
From iris.base_logic Require Import soundness gen_heap.
From iris.base_logic Require Export big_op.
From iris.algebra Require Import dra gmap agree auth frac.
From iris.base_logic.lib Require Import wsat fancy_updates.
From iris.base_logic.lib Require Export namespaces invariants.
From iris.proofmode Require Import tactics.
From iris_c.clang.lib Require Export spec refine.
From iris_c.lib Require Import pair refine_ra.
Set Default Proof Using "Type".
Import uPred.

Section sound.
  Context `{refineG Σ, clangG Σ} {N: namespace}.

  Inductive simulate: expr → spec.spec_code → Prop :=
  | SimVal: ∀ v, simulate (Evalue v) (SCdone (Some v))
  | SimStep:
      ∀ σ σ' l l' (Σ Σ': spec.spec_state) e c e' c' efs,
        cstep e l σ e' σ' l' efs →
        spec_step_star c Σ c' Σ →
        simulate e c.

  Local Hint Constructors simulate.

  From iris_c.program_logic Require Import language adequacy.

  Notation world σ := (wsat ∗ ownE ⊤ ∗ state_interp σ)%I.
  Notation wptp t := ([∗ list] ef ∈ t, WP ef {{ _, True }})%I.

Lemma wp_step R e1 l1 σ1 e2 l2 σ2 efs Φ :
  (R ⊢ |==> ▷ R) →
  prim_step e1 l1 σ1 e2 l2 σ2 efs →
  world σ1 ∗ R ∗ WP (e1, l1) {{ Φ }} ==∗ ▷ |==> ◇ (world σ2 ∗ R ∗ WP (e2, l2) {{ Φ }} ∗ wptp (map (,([], semp)) efs)).
Proof.
  rewrite {1}wp_unfold /wp_pre.
  iIntros (HR Hstep) "[(Hw & HE & Hσ) [HR [H|[_ H]]]]".
  { iDestruct "H" as (v) "[% _]". apply val_stuck in Hstep.
    simpl in *. simplify_eq. }
  rewrite fupd_eq /fupd_def.
  iMod ("H" $! σ1 with "Hσ [$Hw $HE]") as ">(Hw & HE & _ & H)".
  iModIntro; iNext. simpl.
  iMod ("H" $! (e2, l2) σ2 efs with "[%] [$Hw $HE]") as ">($ & $ & $ & $ & ?)"=>//.
  iFrame.
  iDestruct (@big_sepL_fmap _ (expr clang_lang) (expr clang_lang * local_state clang_lang)
                            (,([], semp)) (fun _ x => (WP x {{ _, True }})%I) efs with "~") as "?".
  auto.
Qed.

  Lemma wptp_step' R e1 t1 t2 σ1 σ2 Φ :
    (R ⊢ |==> ▷ R) →
    step (e1 :: t1,σ1) (t2, σ2) →
    world σ1 ∗ R ∗ WP e1 {{ Φ }} ∗ wptp t1
    ==∗ ∃ e2 t2', ⌜t2 = e2 :: t2'⌝ ∗ ▷ |==> ◇ (world σ2 ∗ R ∗ WP e2 {{ Φ }} ∗ wptp t2').
  Proof.
    iIntros (HR Hstep) "(HW & HR & He & Ht)".
    destruct Hstep as [e1' l1' σ1' e2' l2' σ2' efs [|? t1'] t2' ?? Hstep]; simplify_eq/=.
    - iExists (e2', l2'), (t2' ++ map (,([], semp)) efs); iSplitR; first eauto.
      rewrite big_sepL_app. iFrame "Ht". iApply wp_step; try iFrame; eauto.
    - iExists p, (t1' ++ (e2', l2') :: t2' ++ map (,([], semp)) efs); iSplitR; first eauto.
      rewrite !big_sepL_app !big_sepL_cons big_sepL_app.
      iDestruct "Ht" as "($ & He' & $)"; iFrame "He".
      iApply wp_step; try iFrame; eauto.
  Qed.

  Lemma wptp_steps' R n e1 t1 t2 σ1 σ2 Φ :
    (R ⊢ |==> ▷ R) →
    nsteps (@step clang_lang) n (e1 :: t1, σ1) (t2, σ2) →
    world σ1 ∗ R ∗ WP e1 {{ Φ }} ∗ wptp t1 ⊢
    Nat.iter (S n) (λ P, |==> ▷ P) (∃ e2 t2',
    ⌜t2 = e2 :: t2'⌝ ∗ world σ2 ∗ R ∗ WP e2 {{ Φ }} ∗ wptp t2').
  Proof.
    revert e1 t1 t2 σ1 σ2; simpl; induction n as [|n IH]=> e1 t1 t2 σ1 σ2 /=.
    { intros HR. inversion_clear 1. iIntros "?". eauto 10. }
    iIntros (HR Hsteps) "H". inversion_clear Hsteps as [|?? [t1' σ1']].
    iMod (wptp_step' with "H") as (e1' t1'') "[% H]";
      first eauto; simplify_eq. apply H1.
    iModIntro; iNext; iMod "H" as ">?". iApply IH=>//.
    subst. done.
  Qed.

  Lemma bar' ss sc:
    (inv N spec_inv ∗ own_sstate ss ∗ own_scode sc)
    ⊢ |==> ▷ (inv N spec_inv ∗ own_sstate ss ∗ own_scode sc).
  Proof. iIntros "?". iModIntro. by iNext. Qed.

  Lemma soudness n e1 l2 t1 σ1 t2 σ2 c1 Σ1 Σ2 v2:
    nsteps step n (e1 :: t1, σ1) ((of_val v2, l2) :: t2, σ2) →
    world σ1 ∗ (inv N spec_inv ∗ own_sstate Σ1 ∗ own_scode c1) ∗
    WP e1 {{ v, own_sstate Σ2 ∗ own_scode (SCdone (Some v)) }} ∗ wptp t1 ⊢
    Nat.iter (S (S n)) (λ P, |==> ▷ P) ⌜simulate (Evalue v2) c1⌝.
  Proof.
    intros. rewrite wptp_steps' //; last by apply bar'.
    rewrite (Nat_iter_S_r (S n)). apply bupd_iter_mono.
    iDestruct 1 as (e2 t2') "(% & (Hw & HE & _) & (?&?&?) & [H _])"; simplify_eq.
    iDestruct (wp_value_inv with "H") as "H". rewrite fupd_eq /fupd_def.
    iMod ("H" with "[Hw HE]") as ">(_ & _ & (?&?))"; first iFrame.
    iModIntro. iNext.
    iDestruct (@own_pair_agree spec_state with "[~2 ~1]") as "%"; first iFrame.
    iDestruct (@own_pair_agree spec_code with "[~3 ~4]") as "%"; first iFrame.
    iPureIntro. by simplify_eq.
  Qed.

End sound.


From stdpp Require Import strings.
From iris.si_logic Require Import bi.
Unset Mangle Names.

Check "unseal_test".
Lemma unseal_test (P Q : siProp) (Φ : nat → siProp) :
  P ∧ ▷ Q ∧ (∃ x, Φ x) ⊣⊢ ∃ x, P ∗ ▷ Q ∧ emp ∨ Φ x.
Proof.
  siProp.unseal.
  Show.
Abort.

(** Make sure that [siProp]s are parsed in [bi_scope]. *)
Definition test : siProp := ▷ True.
Definition testI : siPropI := ▷ True.


(* *********************************************************************)
(*                                                                     *)
(*              The Compcert verified compiler                         *)
(*                                                                     *)
(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
(*                                                                     *)
(*  Copyright Institut National de Recherche en Informatique et en     *)
(*  Automatique.  All rights reserved.  This file is distributed       *)
(*  under the terms of the INRIA Non-Commercial License Agreement.     *)
(*                                                                     *)
(* *********************************************************************)

(** Compile-time evaluation of initializers for global C variables. *)

Require Import Coqlib.
Require Import Maps.
Require Import Errors.
Require Import Integers.
Require Import Floats.
Require Import Values.
Require Import AST.
Require Import Memory.
Require Import Globalenvs.
Require Import Ctypes.
Require Import Cop.
Require Import Csyntax.

Open Scope error_monad_scope.

(** * Evaluation of compile-time constant expressions *)

(** To evaluate constant expressions at compile-time, we use the same [value]
  type and the same [sem_*] functions that are used in CompCert C's semantics
  (module [Csem]).  However, we interpret pointer values symbolically:
  [Vptr id ofs] represents the address of global variable [id]
  plus byte offset [ofs]. *)

(** [constval a] evaluates the constant expression [a].

If [a] is a r-value, the returned value denotes:
- [Vint n], [Vfloat f]: the corresponding number
- [Vptr id ofs]: address of global variable [id] plus byte offset [ofs]
- [Vundef]: erroneous expression

If [a] is a l-value, the returned value denotes:
- [Vptr id ofs]: global variable [id] plus byte offset [ofs]
*)

Definition do_cast (v: val) (t1 t2: type) : res val :=
  match sem_cast v t1 t2 Mem.empty with
  | Some v' => OK v'
  | None => Error(msg "undefined cast")
  end.

Definition lookup_composite (ce: composite_env) (id: ident) : res composite :=
  match ce!id with
  | Some co => OK co
  | None => Error (MSG "Undefined struct or union " :: CTX id :: nil)
  end.

Fixpoint constval (ce: composite_env) (a: expr) : res val :=
  match a with
  | Eval v ty =>
      match v with
      | Vint _ | Vfloat _ | Vsingle _ | Vlong _ => OK v
      | Vptr _ _ | Vundef => Error(msg "illegal constant")
      end
  | Evalof l ty =>
      match access_mode ty with
      | By_reference | By_copy => constval ce l
      | _ => Error(msg "dereferencing of an l-value")
      end
  | Eaddrof l ty =>
      constval ce l
  | Eunop op r1 ty =>
      do v1 <- constval ce r1;
      match sem_unary_operation op v1 (typeof r1) Mem.empty with
      | Some v => OK v
      | None => Error(msg "undefined unary operation")
      end
  | Ebinop op r1 r2 ty =>
      do v1 <- constval ce r1;
      do v2 <- constval ce r2;
      match sem_binary_operation ce op v1 (typeof r1) v2 (typeof r2) Mem.empty with
      | Some v => OK v
      | None => Error(msg "undefined binary operation")
      end
  | Ecast r ty =>
      do v1 <- constval ce r; do_cast v1 (typeof r) ty
  | Esizeof ty1 ty =>
      OK (Vint (Int.repr (sizeof ce ty1)))
  | Ealignof ty1 ty =>
      OK (Vint (Int.repr (alignof ce ty1)))
  | Eseqand r1 r2 ty =>
      do v1 <- constval ce r1;
      do v2 <- constval ce r2;
      match bool_val v1 (typeof r1) Mem.empty with
      | Some true => do_cast v2 (typeof r2) type_bool
      | Some false => OK (Vint Int.zero)
      | None => Error(msg "undefined && operation")
      end
  | Eseqor r1 r2 ty =>
      do v1 <- constval ce r1;
      do v2 <- constval ce r2;
      match bool_val v1 (typeof r1) Mem.empty with
      | Some false => do_cast v2 (typeof r2) type_bool
      | Some true => OK (Vint Int.one)
      | None => Error(msg "undefined || operation")
      end
  | Econdition r1 r2 r3 ty =>
      do v1 <- constval ce r1;
      do v2 <- constval ce r2;
      do v3 <- constval ce r3;
      match bool_val v1 (typeof r1) Mem.empty with
      | Some true => do_cast v2 (typeof r2) ty
      | Some false => do_cast v3 (typeof r3) ty
      | None => Error(msg "condition is undefined")
      end
  | Ecomma r1 r2 ty =>
      do v1 <- constval ce r1; constval ce r2
  | Evar x ty =>
      OK(Vptr x Int.zero)
  | Ederef r ty =>
      constval ce r
  | Efield l f ty =>
      match typeof l with
      | Tstruct id _ =>
          do co <- lookup_composite ce id;
          do delta <- field_offset ce f (co_members co);
          do v <- constval ce l;
          OK (Val.add v (Vint (Int.repr delta)))
      | Tunion id _ =>
          constval ce l
      | _ =>
          Error(msg "ill-typed field access")
      end
  | Eparen r tycast ty =>
      do v <- constval ce r; do_cast v (typeof r) tycast
  | _ =>
    Error(msg "not a compile-time constant")
  end.

(** * Translation of initializers *)

Inductive initializer :=
  | Init_single (a: expr)
  | Init_array (il: initializer_list)
  | Init_struct (il: initializer_list)
  | Init_union (f: ident) (i: initializer)
with initializer_list :=
  | Init_nil
  | Init_cons (i: initializer) (il: initializer_list).

(** Translate an initializing expression [a] for a scalar variable
  of type [ty].  Return the corresponding initialization datum. *)

Definition transl_init_single (ce: composite_env) (ty: type) (a: expr) : res init_data :=
  do v1 <- constval ce a;
  do v2 <- do_cast v1 (typeof a) ty;
  match v2, ty with
  | Vint n, Tint (I8|IBool) sg _ => OK(Init_int8 n)
  | Vint n, Tint I16 sg _ => OK(Init_int16 n)
  | Vint n, Tint I32 sg _ => OK(Init_int32 n)
  | Vint n, Tpointer _ _ => OK(Init_int32 n)
  | Vlong n, Tlong _ _ => OK(Init_int64 n)
  | Vsingle f, Tfloat F32 _ => OK(Init_float32 f)
  | Vfloat f, Tfloat F64 _ => OK(Init_float64 f)
  | Vptr id ofs, Tint I32 sg _ => OK(Init_addrof id ofs)
  | Vptr id ofs, Tpointer _ _ => OK(Init_addrof id ofs)
  | Vundef, _ => Error(msg "undefined operation in initializer")
  | _, _ => Error (msg "type mismatch in initializer")
  end.

(** Translate an initializer [i] for a variable of type [ty].
  [transl_init ce ty i] returns the appropriate list of initialization data.
  The intermediate functions [transl_init_rec], [transl_init_array]
  and [transl_init_struct] append initialization data to the given
  list [k], and build the list of initialization data in reverse order,
  so as to remain tail-recursive. *)

Definition padding (frm to: Z) (k: list init_data) : list init_data :=
  if zlt frm to then Init_space (to - frm) :: k else k.

Fixpoint transl_init_rec (ce: composite_env) (ty: type) (i: initializer)
                         (k: list init_data) {struct i} : res (list init_data) :=
  match i, ty with
  | Init_single a, _ =>
      do d <- transl_init_single ce ty a; OK (d :: k)
  | Init_array il, Tarray tyelt nelt _ =>
      transl_init_array ce tyelt il (Zmax 0 nelt) k
  | Init_struct il, Tstruct id _ =>
      do co <- lookup_composite ce id;
      match co_su co with
      | Struct => transl_init_struct ce ty (co_members co) il 0 k
      | Union  => Error (MSG "struct/union mismatch on " :: CTX id :: nil)
      end
  | Init_union f i1, Tunion id _ =>
      do co <- lookup_composite ce id;
      match co_su co with
      | Struct => Error (MSG "union/struct mismatch on " :: CTX id :: nil)
      | Union =>
          do ty1 <- field_type f (co_members co);
          do k1  <- transl_init_rec ce ty1 i1 k;
          OK (padding (sizeof ce ty1) (sizeof ce ty) k1)
      end
  | _, _ =>
      Error (msg "wrong type for compound initializer")
  end

with transl_init_array (ce: composite_env) (ty: type) (il: initializer_list) (sz: Z)
                       (k: list init_data) {struct il} : res (list init_data) :=
  match il with
  | Init_nil =>
      if zeq sz 0 then OK k
      else if zle 0 sz then OK (Init_space (sz * sizeof ce ty) :: k)
      else Error (msg "wrong number of elements in array initializer")
  | Init_cons i1 il' =>
      do k1 <- transl_init_rec ce ty i1 k;
      transl_init_array ce ty il' (sz - 1) k1
  end

with transl_init_struct (ce: composite_env) (ty: type)
                        (fl: members) (il: initializer_list) (pos: Z)
                        (k: list init_data)
                        {struct il} : res (list init_data) :=
  match il, fl with
  | Init_nil, nil =>
      OK (padding pos (sizeof ce ty) k)
  | Init_cons i1 il', (_, ty1) :: fl' =>
      let pos1 := align pos (alignof ce ty1) in
      do k1 <- transl_init_rec ce ty1 i1 (padding pos pos1 k);
      transl_init_struct ce ty fl' il' (pos1 + sizeof ce ty1) k1
  | _, _ =>
      Error (msg "wrong number of elements in struct initializer")
  end.

Definition transl_init (ce: composite_env) (ty: type) (i: initializer)
                       : res (list init_data) :=
  do k <- transl_init_rec ce ty i nil; OK (List.rev' k).


Set Primitive Projections.
Set Implicit Arguments.
Record prod A B := pair { fst : A; snd : B}.

Goal fst (@pair Type Type Type Type).
Set Printing All.
match goal with |- ?f ?x => set (foo := f x) end.
Abort.

Goal forall x : prod Set Set, x = @pair _ _ (fst x) (snd x).
Proof.
  intro x.
  lazymatch goal with
    | [ |- ?x = @pair _ _ (?f ?x) (?g ?x) ] => pose f
  end.
(* Toplevel input, characters 7-44:
Error: No matching clauses for match. *)
Abort.


(** * Push-Button Synthesis of Unsaturated Solinas *)
Require Import Coq.Strings.String.
Require Import Coq.micromega.Lia.
Require Import Coq.ZArith.ZArith.
Require Import Coq.MSets.MSetPositive.
Require Import Coq.Lists.List.
Require Import Coq.QArith.QArith_base Coq.QArith.Qround.
Require Import Coq.derive.Derive.
Require Crypto.TAPSort.
Require Import Crypto.Util.ErrorT.
Require Import Crypto.Util.ListUtil.
Require Import Crypto.Util.ListUtil.FoldBool.
Require Import Crypto.Util.Strings.Decimal.
Require Import Crypto.Util.ZRange.
Require Crypto.Util.Option.
Require Import Crypto.Util.Strings.Show.
Require Import Crypto.Util.ZUtil.Definitions.
Require Import Crypto.Util.ZUtil.Zselect.
Require Import Crypto.Util.ZUtil.Tactics.LtbToLt.
Require Import Crypto.Util.Prod.
Require Import Crypto.Util.Tactics.HasBody.
Require Import Crypto.Util.Tactics.Head.
Require Import Crypto.Util.Tactics.SpecializeBy.
Require Import Crypto.Util.Tactics.SpecializeUnderBindersBy.
Require Import Rewriter.Language.Wf.
Require Import Rewriter.Language.Language.
Require Import Crypto.Language.API.
Require Import Crypto.AbstractInterpretation.AbstractInterpretation.
Require Import Crypto.Stringification.Language.
Require Import Crypto.Arithmetic.Core.
Require Import Crypto.Arithmetic.ModOps.
Require Import Crypto.Arithmetic.Partition.
Require Import Crypto.Arithmetic.Freeze.
Require Import Crypto.BoundsPipeline.
Require Import Crypto.COperationSpecifications.
Require Import Crypto.UnsaturatedSolinasHeuristics.
Require Import Crypto.PushButtonSynthesis.ReificationCache.
Require Import Crypto.PushButtonSynthesis.Primitives.
Require Import Crypto.PushButtonSynthesis.UnsaturatedSolinasReificationCache.
Require Import Crypto.Assembly.Equivalence.
Import Option.Notations.
Import ListNotations.
Local Open Scope string_scope. Local Open Scope bool_scope. Local Open Scope Z_scope. Local Open Scope list_scope.

Import
  Language.Wf.Compilers
  Language.Compilers
  AbstractInterpretation.Compilers
  Stringification.Language.Compilers
  Rewriter.All.Compilers.RewriteRules.
Import Compilers.API.

Import COperationSpecifications.Primitives.
Import COperationSpecifications.Solinas.

Import Associational Positional.

Local Coercion Z.of_nat : nat >-> Z.
Local Coercion QArith_base.inject_Z : Z >-> Q.
Local Coercion Z.pos : positive >-> Z.

Local Set Keyed Unification. (* needed for making [autorewrite] fast, c.f. COQBUG(https://github.com/coq/coq/issues/9283) *)

(* needed for making [autorewrite] not take a very long time *)
Local Opaque
      reified_carry_mul_gen
      reified_carry_square_gen
      reified_carry_scmul_gen
      reified_carry_gen
      reified_add_gen
      reified_sub_gen
      reified_opp_gen
      reified_carry_add_gen
      reified_carry_sub_gen
      reified_carry_opp_gen
      reified_id_gen
      reified_to_bytes_gen
      reified_from_bytes_gen
      reified_encode_gen
      reified_encode_gen
      reified_zero_gen
      reified_one_gen
      reified_eval_gen
      reified_bytes_eval_gen
      reified_prime_gen
      expr.Interp.

Section __.
  Context {output_language_api : ToString.OutputLanguageAPI}
          {pipeline_opts : PipelineOptions}
          {pipeline_to_string_opts : PipelineToStringOptions}
          {synthesis_opts : SynthesisOptions}
          {tight_upperbound_fraction : tight_upperbound_fraction_opt}
          (n : nat)
          (s : Z)
          (c : list (Z * Z))
          (machine_wordsize : machine_wordsize_opt).

  Local Notation limbwidth := (limbwidth n s c).
  Definition idxs : list nat := carry_chains n s c.
  Definition n_bytes := bytes_n s.
  Local Notation prime_upperbound_list := (prime_upperbound_list n s c) (only parsing).
  Definition prime_bytes_upperbound_list : list Z
    := Partition.partition (weight 8 1) n_bytes (s-1).
  Local Notation tight_upperbounds := (tight_upperbounds n s c) (only parsing).
  Local Notation loose_upperbounds := (loose_upperbounds n s c) (only parsing).
  Local Notation tight_bounds := (tight_bounds n s c) (only parsing).
  Local Notation loose_bounds := (loose_bounds n s c) (only parsing).
  Global Instance tight_bounds_typedef : typedef (t:=base.type.list base.type.Z) (Some tight_bounds)
    := { name := "tight_field_element"
         ; description name := (text_before_type_name ++ name ++ " is a field element with tight bounds.")%string }.
  Global Instance loose_bounds_typedef : typedef (t:=base.type.list base.type.Z) (Some loose_bounds)
    := { name := "loose_field_element"
         ; description name := (text_before_type_name ++ name ++ " is a field element with loose bounds.")%string }.
  Definition prime_bound : ZRange.type.interp base.type.Z
    := r[0~>(s - Associational.eval c - 1)]%zrange.
  Definition prime_bounds : list (ZRange.type.option.interp (base.type.Z))
    := List.map (fun v => Some r[0 ~> v]%zrange) prime_upperbound_list.
  Definition prime_bytes_bounds : list (ZRange.type.option.interp base.type.Z)
    := List.map (fun v => Some r[0 ~> v]%zrange) prime_bytes_upperbound_list.
  Local Notation word_bound := (word_bound machine_wordsize).
  Local Notation saturated_bounds := (saturated_bounds n machine_wordsize).
  Local Notation balance := (balance n s c).

  Definition m : Z := s - Associational.eval c.
  (* m_enc needs to be such that, if x is bounded by tight bounds:

     -2*fw[i] <= x[i] - m_enc[i] <= fw[i]

     ...so as to obey the bounds for the sub-with-borrow in
     freeze. fw[i] here is shorthand for (weight (S i) / weight i). To
     obey the upper bound, we need to redistribute m_enc such that:

     tight_upperbounds[i] - fw[i] <= m_enc[i]

     Additionally, we cannot have the minimum be uniformly 0, or else
     we'll encode 0; if this happens, we bump the highest limb to be
     at least 1 *)
  Definition m_enc_min : list Z :=
    let wt := weight (Qnum limbwidth) (Qden limbwidth) in
    let fw := List.map (fun i => wt (S i) / wt i) (seq 0 n) in
    let m_enc_min := map2 Z.sub tight_upperbounds fw in
    if List.forallb (Z.eqb 0) m_enc_min
    then set_nth (n-1) 1 m_enc_min
    else m_enc_min.

  Definition m_enc : list Z :=
    let M := encode (weight (Qnum limbwidth) (Qden limbwidth)) n s c m in
    distribute_balance n s c m_enc_min M.

  Local Notation possible_values := (possible_values_of_machine_wordsize machine_wordsize).
  Local Notation possible_values_with_bytes := (possible_values_of_machine_wordsize_with_bytes machine_wordsize).

  Local Existing Instance default_translate_to_fancy.
  Local Instance no_select_size : no_select_size_opt := no_select_size_of_no_select machine_wordsize.
  Local Instance split_mul_to : split_mul_to_opt := split_mul_to_of_should_split_mul machine_wordsize possible_values.
  Local Instance split_multiret_to : split_multiret_to_opt := split_multiret_to_of_should_split_multiret machine_wordsize possible_values.

  Local Notation weightf := (weight (Qnum limbwidth) (QDen limbwidth)).
  Local Notation evalf := (eval weightf n).

  Lemma length_prime_bytes_upperbound_list : List.length prime_bytes_upperbound_list = n_bytes.
  Proof using Type. cbv [prime_bytes_upperbound_list]; now autorewrite with distr_length. Qed.
  Hint Rewrite length_prime_bytes_upperbound_list : distr_length.
  Lemma length_saturated_bounds : List.length saturated_bounds = n.
  Proof using Type. cbv [saturated_bounds]; now autorewrite with distr_length. Qed.
  Hint Rewrite length_saturated_bounds : distr_length.
  Lemma length_m_enc : List.length m_enc = n.
  Proof using Type. cbv [m_enc]; repeat distr_length. Qed.
  Hint Rewrite length_m_enc : distr_length.
  Lemma eval_list_Z_bounded_by_tight_bounds
        (Hwt : 0 < QDen limbwidth <= Qnum limbwidth)
        x
        (Hx : list_Z_bounded_by tight_bounds x)
    : 0 <= evalf x <= evalf tight_upperbounds.
  Proof using Type.
    Local Opaque UnsaturatedSolinasHeuristics.tight_upperbounds.
    cbv [tight_bounds] in *.
    intros.
    lazymatch goal with
    | [ H1 : list_Z_bounded_by (List.map (fun y => Some (@?f y)) ?b) ?x
        |- context[eval ?wt ?n ?x] ]
      => unshelve epose proof (eval_list_Z_bounded_by wt n (List.map (fun x => Some (f x)) b) (List.map f b) x H1 _ _ (fun A B => Z.lt_le_incl _ _ (weight_positive _ _))); clear H1
    end.
    all: repeat first [ reflexivity
                      | apply wprops
                      | progress rewrite ?map_map in *
                      | progress rewrite ?map_id in *
                      | progress cbn [upper lower] in *
                      | assumption
                      | progress autorewrite with distr_length
                      | lia
                      | match goal with
                        | [ H : context[List.map (fun _ => 0) _] |- _ ] => erewrite <- zeros_ext_map, ?eval_zeros in H by reflexivity; autorewrite with distr_length push_eval in H
                        end ].
    Local Transparent UnsaturatedSolinasHeuristics.tight_upperbounds.
  Qed.

  (** Note: If you change the name or type signature of this
        function, you will need to update the code in CLI.v *)
  Definition check_args {T} (requests : list string) (res : Pipeline.ErrorT T)
    : Pipeline.ErrorT T
    := check_args_of_list
         ((List.map
             (fun v => (true, v))
             (* first, all the ones that should always hold *)
             [((Qle_bool 1 limbwidth)%Q, Pipeline.Value_not_leQ "limbwidth < 1" 1%Q limbwidth)
              ; (n <=? Z.log2_up (s - Associational.eval c), Pipeline.Value_not_leZ "Z.log2_up (s - Associational.eval c) < n" n (Z.log2_up (s - Associational.eval c)))
              ; (Associational.eval c <? s, Pipeline.Value_not_ltZ "s ≤ Associational.eval c" (Associational.eval c) s)
              ; (0 <? s, Pipeline.Value_not_ltZ "s ≤ 0" 0 s)
              ; (negb (n =? 0)%nat, Pipeline.Values_not_provably_distinctZ "n = 0" n 0%nat)
              ; (0 <? machine_wordsize, Pipeline.Value_not_ltZ "machine_wordsize ≤ 0" 0 machine_wordsize)
              ; (let v1 := s - Associational.eval c in
                 let v2 := weight (Qnum limbwidth) (QDen limbwidth) n in
                 (v1 <=? v2, Pipeline.Value_not_leZ "weight n < s - Associational.eval c" v1 v2))

                  (** For bedrock2 *)
              ; (let v1 := List.fold_right Z.max 0 prime_bytes_upperbound_list in
                 let v2 := 2^machine_wordsize-1 in
                 (v1 <=? v2,
                  Pipeline.Value_not_leZ "max(prime_bytes_upperbounds) > 2^machine_wordsize-1" v1 v2))
              ; (let v1 := List.fold_right Z.max 0 tight_upperbounds in
                 let v2 := 2^machine_wordsize-1 in
                 (v1 <=? v2,
                  Pipeline.Value_not_leZ "max(tight_upperbounds) > 2^machine_wordsize-1" v1 v2))
              ; (let v1 := List.fold_right Z.max 0 loose_upperbounds in
                 let v2 := 2^machine_wordsize-1 in
                 (v1 <=? v2,
                  Pipeline.Value_not_leZ "max(loose_upperbounds) > 2^machine_wordsize-1" v1 v2))
          ])
            (* the littany of to_bytes ones *)
            ++ (List.map
                  (fun v => (request_present requests "to_bytes", v))
                  [(0 <? Associational.eval c, Pipeline.Value_not_ltZ "Associational.eval c ≤ 0 (needed for to_bytes)" 0 (Associational.eval c))
                   ; (let v1 := s in
                      let v2 := weight (Qnum limbwidth) (QDen limbwidth) n in
                      (v1 =? v2, Pipeline.Values_not_provably_equalZ "s ≠ weight n (needed for to_bytes)" v1 v2))
                   ; (let v1 := (List.map (Z.land (Z.ones machine_wordsize)) m_enc) in
                      let v2 := m_enc in
                      (list_beq _ Z.eqb v1 v2, Pipeline.Values_not_provably_equal_listZ "map mask m_enc ≠ m_enc (needed for to_bytes)" v1 v2))
                   ; (let v1 := eval (weight (Qnum limbwidth) (QDen limbwidth)) n m_enc in
                      let v2 := s - Associational.eval c in
                      (v1 =? v2, Pipeline.Values_not_provably_equalZ "eval m_enc ≠ s - Associational.eval c (needed for to_bytes)" v1 v2))
                   ; (let v1 := eval (weight (Qnum limbwidth) (QDen limbwidth)) n tight_upperbounds in
                      let v2 := 2 * eval (weight (Qnum limbwidth) (QDen limbwidth)) n m_enc in
                      (v1 <? v2, Pipeline.Value_not_ltZ "2 * eval m_enc ≤ eval tight_upperbounds (needed for to_bytes)" v1 v2))
               ])
            ++ [(request_present requests "from_bytes",
                 (1 <? s, Pipeline.Value_not_ltZ "s ≤ 1 (need for from_bytes)" 1 s))
         ])
         res.

  Local Ltac use_curve_good_t :=
    repeat first [ use_requests_to_prove_curve_good_t_step
                 | assumption
                 | lia
                 | progress autorewrite with distr_length
                 | progress distr_length
                 | progress autorewrite with zsimplify_fast in * ].

  Context (requests : list string)
          (curve_good : check_args requests (Success tt) = Success tt).

  Lemma use_curve_good
    : let eval := eval (weight (Qnum limbwidth) (QDen limbwidth)) n in
      0 < Qden limbwidth <= Qnum limbwidth
      /\ n <= Z.log2_up (s - Associational.eval c)
      /\ 0 < s - Associational.eval c
      /\ 0 < s - Associational.eval c <= weight (Qnum limbwidth) (QDen limbwidth) n
      /\ s - Associational.eval c <> 0
      /\ s <> 0
      /\ 0 < machine_wordsize
      /\ n <> 0%nat
      /\ List.fold_right Z.max 0 prime_bytes_upperbound_list <= 2^machine_wordsize-1
      /\ List.fold_right Z.max 0 tight_upperbounds <= 2^machine_wordsize-1
      /\ List.fold_right Z.max 0 loose_upperbounds <= 2^machine_wordsize-1
      /\ (request_present requests "from_bytes" = true -> 1 < s)
      /\ (request_present requests "to_bytes" = true -> 1 < s)
      /\ (request_present requests "to_bytes" = true -> 0 < Associational.eval c < s)
      /\ (request_present requests "to_bytes" = true -> s = weight (Qnum limbwidth) (QDen limbwidth) n)
      /\ (request_present requests "to_bytes" = true -> List.map (Z.land (Z.ones machine_wordsize)) m_enc = m_enc)
      /\ (request_present requests "to_bytes" = true -> eval m_enc = s - Associational.eval c)
      /\ (request_present requests "to_bytes" = true -> eval tight_upperbounds < 2 * eval m_enc)
      /\ List.length tight_bounds = n
      /\ List.length loose_bounds = n
      /\ List.length prime_bytes_upperbound_list = n_bytes
      /\ List.length saturated_bounds = n
      /\ Datatypes.length m_enc = n.
  Proof using curve_good.
    prepare_use_curve_good ().
    { use_curve_good_t. }
    { use_curve_good_t. }
    { use_curve_good_t. }
    { use_curve_good_t. }
    { use_curve_good_t. }
    { use_curve_good_t. }
    { use_curve_good_t. }
    { use_curve_good_t. }
    { use_curve_good_t. }
    { use_curve_good_t. }
    { use_curve_good_t. }
    { use_curve_good_t. }
    { use_curve_good_t. }
    { use_curve_good_t. }
    { use_curve_good_t. }
    { use_curve_good_t. }
    { use_curve_good_t. }
    { use_curve_good_t. }
  Qed.

  Lemma use_curve_good_extra
    : (request_present requests "to_bytes" = true -> forall x, list_Z_bounded_by tight_bounds x -> 0 <= evalf x < 2 * (s - Associational.eval c)).
  Proof using curve_good.
    pose proof use_curve_good; cbv beta zeta in *; destruct_head'_and.
    pose proof eval_list_Z_bounded_by_tight_bounds.
    repeat match goal with |- _ /\ _ => split end.
    { intros.
      specialize_by auto.
      specialize_all_ways_under_binders_by eassumption.
      lia. }
  Qed.

  Local Notation notations_for_docstring
    := (CorrectnessStringification.dyn_context.cons
          m "m"
          (CorrectnessStringification.dyn_context.cons
             weightf "weight"
             (CorrectnessStringification.dyn_context.cons
                evalf "eval"
                CorrectnessStringification.dyn_context.nil)))%string.
  Local Notation "'docstring_with_summary_from_lemma!' summary correctness"
    := (docstring_with_summary_from_lemma_with_ctx!
          notations_for_docstring
          summary
          correctness)
         (only parsing, at level 10, summary at next level, correctness at next level).

  Definition carry_mul
    := Pipeline.BoundsPipeline
         false (* subst01 *)
         possible_values
         (reified_carry_mul_gen
            @ GallinaReify.Reify (Qnum limbwidth) @ GallinaReify.Reify (Z.pos (Qden limbwidth)) @ GallinaReify.Reify s @ GallinaReify.Reify c @ GallinaReify.Reify n @ GallinaReify.Reify idxs)
         (Some loose_bounds, (Some loose_bounds, tt))
         (Some tight_bounds).

  Definition scarry_mul (prefix : string)
    : string * (Pipeline.M (Pipeline.ExtendedSynthesisResult _))
    := Eval cbv beta in
        FromPipelineToString!
          machine_wordsize prefix "carry_mul" carry_mul
          (docstring_with_summary_from_lemma!
             (fun fname : string => [text_before_function_name ++ fname ++ " multiplies two field elements and reduces the result."]%string)
             (carry_mul_correct weightf n m tight_bounds loose_bounds)).

  Definition carry_square
    := Pipeline.BoundsPipeline
         false (* subst01 *)
         possible_values
         (reified_carry_square_gen
            @ GallinaReify.Reify (Qnum limbwidth) @ GallinaReify.Reify (Z.pos (Qden limbwidth)) @ GallinaReify.Reify s @ GallinaReify.Reify c @ GallinaReify.Reify n @ GallinaReify.Reify idxs)
         (Some loose_bounds, tt)
         (Some tight_bounds).

  Definition scarry_square (prefix : string)
    : string * (Pipeline.M (Pipeline.ExtendedSynthesisResult _))
    := Eval cbv beta in
        FromPipelineToString!
          machine_wordsize prefix "carry_square" carry_square
          (docstring_with_summary_from_lemma!
             (fun fname : string => [text_before_function_name ++ fname ++ " squares a field element and reduces the result."]%string)
             (carry_square_correct weightf n m tight_bounds loose_bounds)).

  Definition carry_scmul_const (x : Z)
    := Pipeline.BoundsPipeline
         false (* subst01 *)
         possible_values
         (reified_carry_scmul_gen
            @ GallinaReify.Reify (Qnum limbwidth) @ GallinaReify.Reify (Z.pos (Qden limbwidth)) @ GallinaReify.Reify s @ GallinaReify.Reify c @ GallinaReify.Reify n @ GallinaReify.Reify idxs @ GallinaReify.Reify x)
         (Some loose_bounds, tt)
         (Some tight_bounds).

  Definition scarry_scmul_const (prefix : string) (x : Z)
    : string * (Pipeline.M (Pipeline.ExtendedSynthesisResult _))
    := Eval cbv beta in
        FromPipelineToString!
          machine_wordsize prefix ("carry_scmul_" ++ Decimal.Z.to_string x)%string (carry_scmul_const x)
          (docstring_with_summary_from_lemma!
             (fun fname : string => [text_before_function_name ++ fname ++ " multiplies a field element by " ++ Decimal.Z.to_string x ++ " and reduces the result."]%string)
             (carry_scmul_const_correct weightf n m tight_bounds loose_bounds x)).

  Definition carry
    := Pipeline.BoundsPipeline
         true (* subst01 *)
         possible_values
         (reified_carry_gen
            @ GallinaReify.Reify (Qnum limbwidth) @ GallinaReify.Reify (Z.pos (Qden limbwidth)) @ GallinaReify.Reify s @ GallinaReify.Reify c @ GallinaReify.Reify n @ GallinaReify.Reify idxs)
         (Some loose_bounds, tt)
         (Some tight_bounds).

  Definition scarry (prefix : string)
    : string * (Pipeline.M (Pipeline.ExtendedSynthesisResult _))
    := Eval cbv beta in
        FromPipelineToString!
          machine_wordsize prefix "carry" carry
          (docstring_with_summary_from_lemma!
             (fun fname : string => [text_before_function_name ++ fname ++ " reduces a field element."]%string)
             (carry_correct weightf n m tight_bounds loose_bounds)).

  Definition add
    := Pipeline.BoundsPipeline
         true (* subst01 *)
         possible_values
         (reified_add_gen
            @ GallinaReify.Reify (Qnum limbwidth) @ GallinaReify.Reify (Z.pos (Qden limbwidth)) @ GallinaReify.Reify n)
         (Some tight_bounds, (Some tight_bounds, tt))
         (Some loose_bounds).

  Definition sadd (prefix : string)
    : string * (Pipeline.M (Pipeline.ExtendedSynthesisResult _))
    := Eval cbv beta in
        FromPipelineToString!
          machine_wordsize prefix "add" add
          (docstring_with_summary_from_lemma!
             (fun fname : string => [text_before_function_name ++ fname ++ " adds two field elements."]%string)
             (add_correct weightf n m tight_bounds loose_bounds)).

  Definition sub
    := Pipeline.BoundsPipeline
         true (* subst01 *)
         possible_values
         (reified_sub_gen
            @ GallinaReify.Reify (Qnum limbwidth) @ GallinaReify.Reify (Z.pos (Qden limbwidth)) @ GallinaReify.Reify n @ GallinaReify.Reify balance)
         (Some tight_bounds, (Some tight_bounds, tt))
         (Some loose_bounds).

  Definition ssub (prefix : string)
    : string * (Pipeline.M (Pipeline.ExtendedSynthesisResult _))
    := Eval cbv beta in
        FromPipelineToString!
          machine_wordsize prefix "sub" sub
          (docstring_with_summary_from_lemma!
             (fun fname : string => [text_before_function_name ++ fname ++ " subtracts two field elements."]%string)
             (sub_correct weightf n m tight_bounds loose_bounds)).

  Definition opp
    := Pipeline.BoundsPipeline
         true (* subst01 *)
         possible_values
         (reified_opp_gen
            @ GallinaReify.Reify (Qnum limbwidth) @ GallinaReify.Reify (Z.pos (Qden limbwidth)) @ GallinaReify.Reify n @ GallinaReify.Reify balance)
         (Some tight_bounds, tt)
         (Some loose_bounds).

  Definition sopp (prefix : string)
    : string * (Pipeline.M (Pipeline.ExtendedSynthesisResult _))
    := Eval cbv beta in
        FromPipelineToString!
          machine_wordsize prefix "opp" opp
          (docstring_with_summary_from_lemma!
             (fun fname : string => [text_before_function_name ++ fname ++ " negates a field element."]%string)
             (opp_correct weightf n m tight_bounds loose_bounds)).

  Definition carry_add
    := Pipeline.BoundsPipeline
         true (* subst01 *)
         possible_values
         (reified_carry_add_gen
            @ GallinaReify.Reify (Qnum limbwidth) @ GallinaReify.Reify (Z.pos (Qden limbwidth)) @ GallinaReify.Reify s @ GallinaReify.Reify c @ GallinaReify.Reify n @ GallinaReify.Reify idxs)
         (Some tight_bounds, (Some tight_bounds, tt))
         (Some tight_bounds).

  Definition scarry_add (prefix : string)
    : string * (Pipeline.M (Pipeline.ExtendedSynthesisResult _))
    := Eval cbv beta in
        FromPipelineToString!
          machine_wordsize prefix "carry_add" carry_add
          (docstring_with_summary_from_lemma!
             (fun fname : string => [text_before_function_name ++ fname ++ " adds two field elements."]%string)
             (carry_add_correct weightf n m tight_bounds)).

  Definition carry_sub
    := Pipeline.BoundsPipeline
         true (* subst01 *)
         possible_values
         (reified_carry_sub_gen
            @ GallinaReify.Reify (Qnum limbwidth) @ GallinaReify.Reify (Z.pos (Qden limbwidth)) @ GallinaReify.Reify s @ GallinaReify.Reify c @ GallinaReify.Reify n @ GallinaReify.Reify idxs @ GallinaReify.Reify balance)
         (Some tight_bounds, (Some tight_bounds, tt))
         (Some tight_bounds).

  Definition scarry_sub (prefix : string)
    : string * (Pipeline.M (Pipeline.ExtendedSynthesisResult _))
    := Eval cbv beta in
        FromPipelineToString!
          machine_wordsize prefix "carry_sub" carry_sub
          (docstring_with_summary_from_lemma!
             (fun fname : string => [text_before_function_name ++ fname ++ " subtracts two field elements."]%string)
             (carry_sub_correct weightf n m tight_bounds)).

  Definition carry_opp
    := Pipeline.BoundsPipeline
         true (* subst01 *)
         possible_values
         (reified_carry_opp_gen
            @ GallinaReify.Reify (Qnum limbwidth) @ GallinaReify.Reify (Z.pos (Qden limbwidth)) @ GallinaReify.Reify s @ GallinaReify.Reify c @ GallinaReify.Reify n @ GallinaReify.Reify idxs @ GallinaReify.Reify balance)
         (Some tight_bounds, tt)
         (Some tight_bounds).

  Definition scarry_opp (prefix : string)
    : string * (Pipeline.M (Pipeline.ExtendedSynthesisResult _))
    := Eval cbv beta in
        FromPipelineToString!
          machine_wordsize prefix "carry_opp" carry_opp
          (docstring_with_summary_from_lemma!
             (fun fname : string => [text_before_function_name ++ fname ++ " negates a field element."]%string)
             (carry_opp_correct weightf n m tight_bounds)).

  Definition relax
    := Pipeline.BoundsPipeline
         true (* subst01 *)
         possible_values
         reified_id_gen
         (Some tight_bounds, tt)
         (Some loose_bounds).

  Definition srelax (prefix : string)
    : string * (Pipeline.M (Pipeline.ExtendedSynthesisResult _))
    := Eval cbv beta in
        FromPipelineToString!
          machine_wordsize prefix "relax" relax
          (docstring_with_summary_from_lemma!
             (fun fname : string => [text_before_function_name ++ fname ++ " is the identity function converting from tight field elements to loose field elements."]%string)
             (relax_correct tight_bounds loose_bounds)).

  Definition to_bytes
    := Pipeline.BoundsPipeline
         false (* subst01 *)
         possible_values_with_bytes
         (reified_to_bytes_gen
            @ GallinaReify.Reify (Qnum limbwidth) @ GallinaReify.Reify (Z.pos (Qden limbwidth)) @ GallinaReify.Reify s @ GallinaReify.Reify n @ GallinaReify.Reify (machine_wordsize:Z) @ GallinaReify.Reify m_enc)
         (Some tight_bounds, tt)
         (Some prime_bytes_bounds).

  Definition sto_bytes (prefix : string)
    : string * (Pipeline.M (Pipeline.ExtendedSynthesisResult _))
    := Eval cbv beta in
        FromPipelineToString!
          machine_wordsize prefix "to_bytes" to_bytes
          (docstring_with_summary_from_lemma!
             (fun fname : string => [text_before_function_name ++ fname ++ " serializes a field element to bytes in little-endian order."]%string)
             (to_bytes_correct weightf n n_bytes m tight_bounds)).

  Definition from_bytes
    := Pipeline.BoundsPipeline
         false (* subst01 *)
         possible_values_with_bytes
         (reified_from_bytes_gen
            @ GallinaReify.Reify (Qnum limbwidth) @ GallinaReify.Reify (Z.pos (Qden limbwidth)) @ GallinaReify.Reify s @ GallinaReify.Reify n)
         (Some prime_bytes_bounds, tt)
         (Some tight_bounds).

  Definition sfrom_bytes (prefix : string)
    : string * (Pipeline.M (Pipeline.ExtendedSynthesisResult _))
    := Eval cbv beta in
        FromPipelineToString!
          machine_wordsize prefix "from_bytes" from_bytes
          (docstring_with_summary_from_lemma!
             (fun fname : string => [text_before_function_name ++ fname ++ " deserializes a field element from bytes in little-endian order."]%string)
             (from_bytes_correct weightf n n_bytes m s tight_bounds)).

  Definition encode
    := Pipeline.BoundsPipeline
         true (* subst01 *)
         possible_values
         (reified_encode_gen
            @ GallinaReify.Reify (Qnum limbwidth) @ GallinaReify.Reify (Z.pos (Qden limbwidth)) @ GallinaReify.Reify s @ GallinaReify.Reify c @ GallinaReify.Reify n)
         (Some prime_bound, tt)
         (Some tight_bounds).

  Definition sencode (prefix : string)
    : string * (Pipeline.M (Pipeline.ExtendedSynthesisResult _))
    := Eval cbv beta in
        FromPipelineToString!
          machine_wordsize prefix "encode" encode
          (docstring_with_summary_from_lemma!
             (fun fname : string => [text_before_function_name ++ fname ++ " encodes an integer as a field element."]%string)
             (encode_correct weightf n m tight_bounds)).

  Definition encode_word
    := Pipeline.BoundsPipeline
         true (* subst01 *)
         possible_values
         (reified_encode_gen
            @ GallinaReify.Reify (Qnum limbwidth) @ GallinaReify.Reify (Z.pos (Qden limbwidth)) @ GallinaReify.Reify s @ GallinaReify.Reify c @ GallinaReify.Reify n)
         (Some word_bound, tt)
         (Some tight_bounds).

  Definition sencode_word (prefix : string)
    : string * (Pipeline.M (Pipeline.ExtendedSynthesisResult _))
    := Eval cbv beta in
        FromPipelineToString!
          machine_wordsize prefix "encode_word" encode_word
          (docstring_with_summary_from_lemma!
             (fun fname : string => [text_before_function_name ++ fname ++ " encodes an integer as a field element."]%string)
             (encode_word_correct machine_wordsize weightf n m tight_bounds)).

  Definition zero
    := Pipeline.BoundsPipeline
         true (* subst01 *)
         possible_values
         (reified_zero_gen
            @ GallinaReify.Reify (Qnum limbwidth) @ GallinaReify.Reify (Z.pos (Qden limbwidth)) @ GallinaReify.Reify s @ GallinaReify.Reify c @ GallinaReify.Reify n)
         tt
         (Some tight_bounds).

  Definition szero (prefix : string)
    : string * (Pipeline.M (Pipeline.ExtendedSynthesisResult _))
    := Eval cbv beta in
        FromPipelineToString!
          machine_wordsize prefix "zero" zero
          (docstring_with_summary_from_lemma!
             (fun fname => [text_before_function_name ++ fname ++ " returns the field element zero."]%string)
             (zero_correct weightf n m tight_bounds)).

  Definition one
    := Pipeline.BoundsPipeline
         true (* subst01 *)
         possible_values
         (reified_one_gen
            @ GallinaReify.Reify (Qnum limbwidth) @ GallinaReify.Reify (Z.pos (Qden limbwidth)) @ GallinaReify.Reify s @ GallinaReify.Reify c @ GallinaReify.Reify n)
         tt
         (Some tight_bounds).

  Definition sone (prefix : string)
    : string * (Pipeline.M (Pipeline.ExtendedSynthesisResult _))
    := Eval cbv beta in
        FromPipelineToString!
          machine_wordsize prefix "one" one
          (docstring_with_summary_from_lemma!
             (fun fname => [text_before_function_name ++ fname ++ " returns the field element one."]%string)
             (one_correct weightf n m tight_bounds)).

  Definition reval (* r for reified *)
    := Pipeline.RepeatRewriteAddAssocLeftAndFlattenThunkedRects
         n
         (Pipeline.PreBoundsPipeline
            true (* subst01 *)
            false (* let_bind_return *)
            (reified_eval_gen
               @ GallinaReify.Reify (Qnum limbwidth) @ GallinaReify.Reify (Z.pos (Qden limbwidth)) @ GallinaReify.Reify n)
            (Some loose_bounds, tt)).

  Definition seval (arg_name : string) (* s for string *)
    := show (invert_expr.smart_App_curried (reval _) (arg_name, tt)).

  Definition rbytes_eval (* r for reified *)
    := Pipeline.RepeatRewriteAddAssocLeftAndFlattenThunkedRects
         n_bytes
         (Pipeline.PreBoundsPipeline
            true (* subst01 *)
            false (* let_bind_return *)
            (reified_bytes_eval_gen
               @ GallinaReify.Reify s)
            (Some prime_bytes_bounds, tt)).

  Definition sbytes_eval (arg_name : string) (* s for string *)
    := show (invert_expr.smart_App_curried (rbytes_eval _) (arg_name, tt)).

  Definition selectznz : Pipeline.ErrorT _ := Primitives.selectznz n machine_wordsize.
  Definition sselectznz (prefix : string)
    : string * (Pipeline.M (Pipeline.ExtendedSynthesisResult _))
    := Primitives.sselectznz n machine_wordsize prefix.

  Definition copy : Pipeline.ErrorT _ := Primitives.copy n machine_wordsize.
  Definition scopy (prefix : string)
    : string * (Pipeline.M (Pipeline.ExtendedSynthesisResult _))
    := Primitives.scopy n machine_wordsize prefix.

  Local Ltac solve_extra_bounds_side_conditions :=
    cbn [lower upper fst snd] in *; Bool.split_andb; Z.ltb_to_lt; lia.

  Hint Rewrite
       eval_carry_mulmod
       eval_carry_squaremod
       eval_carry_scmulmod
       eval_addmod
       eval_submod
       eval_oppmod
       eval_carry_addmod
       eval_carry_submod
       eval_carry_oppmod
       eval_carrymod
       freeze_to_bytesmod_partitions
       eval_to_bytesmod
       eval_from_bytesmod
       eval_encodemod
       using solve [ auto using eval_balance, length_balance | congruence | solve_extra_bounds_side_conditions ] : push_eval.
  Hint Unfold zeromod onemod : push_eval.

  Local Ltac solve_prove_correctness_side_conditions _ :=
    solve [ auto | congruence | now autorewrite with distr_length | solve_extra_bounds_side_conditions ].
  Local Ltac prove_correctness _ :=
    Primitives.prove_correctness (conj use_curve_good use_curve_good_extra);
    try solve_prove_correctness_side_conditions ().

  (** Work around COQBUG(https://github.com/coq/coq/issues/9286) *)
  Local Opaque
        carry_mulmod
        carry_squaremod
        carry_scmulmod
        carrymod
        addmod
        submod
        oppmod
        carry_addmod
        carry_submod
        carry_oppmod
        from_bytesmod
        to_bytesmod
        (* Set Printing Width 100000. Print Rewrite HintDb push_eval. | sed s'/^.*->//g' | grep -o ' eval \(([^)]\+)\|[^ ]*\) \(([^)]\+)\|[^ ]*\) [^ )]*' | grep -o '[A-Za-z0-9_\.][A-Za-z0-9_\.]\+$' | sort | uniq *)
        addmod
        BaseConversion.convert_bases
        BaseConversion.convert_basesmod
        carrymod
        carry_mulmod
        carry_scmulmod
        carry_squaremod
        encodemod
        extend_to_length
        Freeze.from_bytes
        Freeze.to_bytes
        freeze_to_bytesmod
        from_bytesmod
        oppmod
        Partition.partition
        select
        submod
        to_bytesmod
        zeros
        zselect
  .

  Lemma carry_mul_correct res
        (Hres : carry_mul = Success res)
    : carry_mul_correct (weight (Qnum limbwidth) (QDen limbwidth)) n m tight_bounds loose_bounds (Interp res).
  Proof using curve_good. prove_correctness (). Qed.

  Lemma Wf_carry_mul res (Hres : carry_mul = Success res) : Wf res.
  Proof using Type. prove_pipeline_wf (). Qed.

  Lemma carry_square_correct res
        (Hres : carry_square = Success res)
    : carry_square_correct (weight (Qnum limbwidth) (QDen limbwidth)) n m tight_bounds loose_bounds (Interp res).
  Proof using curve_good. prove_correctness (). Qed.

  Lemma Wf_carry_square res (Hres : carry_square = Success res) : Wf res.
  Proof using Type. prove_pipeline_wf (). Qed.

  Lemma carry_scmul_const_correct a res
        (Hres : carry_scmul_const a = Success res)
    : carry_scmul_const_correct (weight (Qnum limbwidth) (QDen limbwidth)) n m tight_bounds loose_bounds a (Interp res).
  Proof using curve_good. prove_correctness (). Qed.

  Lemma Wf_carry_scmul_const a res (Hres : carry_scmul_const a = Success res) : Wf res.
  Proof using Type. prove_pipeline_wf (). Qed.

  Lemma carry_correct res
        (Hres : carry = Success res)
    : carry_correct (weight (Qnum limbwidth) (QDen limbwidth)) n m tight_bounds loose_bounds (Interp res).
  Proof using curve_good. prove_correctness (). Qed.

  Lemma Wf_carry res (Hres : carry = Success res) : Wf res.
  Proof using Type. prove_pipeline_wf (). Qed.

  Lemma add_correct res
        (Hres : add = Success res)
    : add_correct (weight (Qnum limbwidth) (QDen limbwidth)) n m tight_bounds loose_bounds (Interp res).
  Proof using curve_good. prove_correctness (). Qed.

  Lemma Wf_add res (Hres : add = Success res) : Wf res.
  Proof using Type. prove_pipeline_wf (). Qed.

  Lemma sub_correct res
        (Hres : sub = Success res)
    : sub_correct (weight (Qnum limbwidth) (QDen limbwidth)) n m tight_bounds loose_bounds (Interp res).
  Proof using curve_good. prove_correctness (). Qed.

  Lemma Wf_sub res (Hres : sub = Success res) : Wf res.
  Proof using Type. prove_pipeline_wf (). Qed.

  Lemma opp_correct res
        (Hres : opp = Success res)
    : opp_correct (weight (Qnum limbwidth) (QDen limbwidth)) n m tight_bounds loose_bounds (Interp res).
  Proof using curve_good. prove_correctness (). Qed.

  Lemma Wf_opp res (Hres : opp = Success res) : Wf res.
  Proof using Type. prove_pipeline_wf (). Qed.

  Lemma carry_add_correct res
        (Hres : carry_add = Success res)
    : carry_add_correct (weight (Qnum limbwidth) (QDen limbwidth)) n m tight_bounds (Interp res).
  Proof using curve_good. prove_correctness (). Qed.

  Lemma Wf_carry_add res (Hres : carry_add = Success res) : Wf res.
  Proof using Type. prove_pipeline_wf (). Qed.

  Lemma carry_sub_correct res
        (Hres : carry_sub = Success res)
    : carry_sub_correct (weight (Qnum limbwidth) (QDen limbwidth)) n m tight_bounds (Interp res).
  Proof using curve_good. prove_correctness (). Qed.

  Lemma Wf_carry_sub res (Hres : carry_sub = Success res) : Wf res.
  Proof using Type. prove_pipeline_wf (). Qed.

  Lemma carry_opp_correct res
        (Hres : carry_opp = Success res)
    : carry_opp_correct (weight (Qnum limbwidth) (QDen limbwidth)) n m tight_bounds (Interp res).
  Proof using curve_good. prove_correctness (). Qed.

  Lemma Wf_carry_opp res (Hres : carry_opp = Success res) : Wf res.
  Proof using Type. prove_pipeline_wf (). Qed.

  Lemma relax_correct res
        (Hres : relax = Success res)
    : relax_correct tight_bounds loose_bounds (Interp res).
  Proof using curve_good. prove_correctness (). Qed.

  Lemma Wf_relax res (Hres : relax = Success res) : Wf res.
  Proof using Type. prove_pipeline_wf (). Qed.

  Lemma from_bytes_correct res
        (Hres : from_bytes = Success res)
        (Hrequests : request_present requests "from_bytes" = true)
    : from_bytes_correct (weight (Qnum limbwidth) (QDen limbwidth)) n n_bytes m s tight_bounds (Interp res).
  Proof using curve_good. prove_correctness (). Qed.

  Lemma Wf_from_bytes res (Hres : from_bytes = Success res) : Wf res.
  Proof using Type. prove_pipeline_wf (). Qed.

  Lemma relax_valid
    : forall x, list_Z_bounded_by tight_bounds x -> list_Z_bounded_by loose_bounds x.
  Proof using Type. apply relax_list_Z_bounded_by, tight_bounds_tighter. Qed.

  Lemma to_bytes_correct res
        (Hres : to_bytes = Success res)
        (Hrequests : request_present requests "to_bytes" = true)
    : to_bytes_correct (weight (Qnum limbwidth) (QDen limbwidth)) n n_bytes m tight_bounds (Interp res).
  Proof using curve_good.
    prove_correctness (); [].
    erewrite freeze_to_bytesmod_partitions; [ reflexivity | .. ].
    all: try solve_prove_correctness_side_conditions ().
  Qed.

  Lemma Wf_to_bytes res (Hres : to_bytes = Success res) : Wf res.
  Proof using Type. prove_pipeline_wf (). Qed.

  Strategy -1000 [encode]. (* if we don't tell the kernel to unfold this early, then [Qed] seems to run off into the weeds *)
  Lemma encode_correct res
        (Hres : encode = Success res)
    : encode_correct (weight (Qnum limbwidth) (QDen limbwidth)) n m tight_bounds (Interp res).
  Proof using curve_good. prove_correctness (). Qed.

  Lemma Wf_encode res (Hres : encode = Success res) : Wf res.
  Proof using Type. prove_pipeline_wf (). Qed.

  Strategy -1000 [encode_word]. (* if we don't tell the kernel to unfold this early, then [Qed] seems to run off into the weeds *)
  Lemma encode_word_correct res
        (Hres : encode_word = Success res)
    : encode_word_correct machine_wordsize (weight (Qnum limbwidth) (QDen limbwidth)) n m tight_bounds (Interp res).
  Proof using curve_good. prove_correctness (). Qed.

  Lemma Wf_encode_word res (Hres : encode_word = Success res) : Wf res.
  Proof using Type. prove_pipeline_wf (). Qed.

  Strategy -1000 [zero]. (* if we don't tell the kernel to unfold this early, then [Qed] seems to run off into the weeds *)
  Lemma zero_correct res
        (Hres : zero = Success res)
    : zero_correct (weight (Qnum limbwidth) (QDen limbwidth)) n m tight_bounds (Interp res).
  Proof using curve_good. prove_correctness (). Qed.

  Lemma Wf_zero res (Hres : zero = Success res) : Wf res.
  Proof using Type. prove_pipeline_wf (). Qed.

  Strategy -1000 [one]. (* if we don't tell the kernel to unfold this early, then [Qed] seems to run off into the weeds *)
  Lemma one_correct res
        (Hres : one = Success res)
    : one_correct (weight (Qnum limbwidth) (QDen limbwidth)) n m tight_bounds (Interp res).
  Proof using curve_good. prove_correctness (). Qed.

  Lemma Wf_one res (Hres : one = Success res) : Wf res.
  Proof using Type. prove_pipeline_wf (). Qed.

  Lemma copy_correct res
        (Hres : copy = Success res)
    : copy_correct saturated_bounds (Interp res).
  Proof using curve_good. apply Primitives.copy_correct; assumption. Qed.

  Lemma Wf_copy res (Hres : copy = Success res) : Wf res.
  Proof using Type. revert Hres; cbv [copy]; apply Wf_copy. Qed.

  Lemma selectznz_correct res
        (Hres : selectznz = Success res)
    : selectznz_correct saturated_bounds (Interp res).
  Proof using curve_good. apply Primitives.selectznz_correct, Hres. Qed.

  Lemma Wf_selectznz res (Hres : selectznz = Success res) : Wf res.
  Proof using Type. revert Hres; cbv [selectznz]; apply Wf_selectznz. Qed.

  Section ring.
    Context carry_mul_res (Hcarry_mul : carry_mul = Success carry_mul_res)
            add_res       (Hadd       : add       = Success add_res)
            sub_res       (Hsub       : sub       = Success sub_res)
            opp_res       (Hopp       : opp       = Success opp_res)
            carry_res     (Hcarry     : carry     = Success carry_res)
            encode_res    (Hencode    : encode    = Success encode_res)
            zero_res      (Hzero      : zero      = Success zero_res)
            one_res       (Hone       : one       = Success one_res).

    Definition GoodT : Prop
      := GoodT
           (weight (Qnum limbwidth) (QDen limbwidth)) n m tight_bounds
           (Interp carry_mul_res)
           (Interp add_res)
           (Interp sub_res)
           (Interp opp_res)
           (Interp carry_res)
           (Interp encode_res)
           (Interp zero_res)
           (Interp one_res).

    Theorem Good : GoodT.
    Proof using curve_good Hcarry_mul Hadd Hsub Hopp Hcarry Hencode Hzero Hone.
      pose proof use_curve_good; cbv zeta in *; destruct_head'_and.
      eapply Good.
      all: repeat first [ assumption
                        | apply carry_mul_correct
                        | apply add_correct
                        | apply sub_correct
                        | apply opp_correct
                        | apply carry_correct
                        | apply encode_correct
                        | apply zero_correct
                        | apply one_correct
                        | apply relax_valid ].
    Qed.
  End ring.

  Section for_stringification.
    Local Open Scope string_scope.
    Local Open Scope list_scope.

    Definition known_functions
      := [("carry_mul", wrap_s scarry_mul);
            ("carry_square", wrap_s scarry_square);
            ("carry", wrap_s scarry);
            ("add", wrap_s sadd);
            ("sub", wrap_s ssub);
            ("opp", wrap_s sopp);
            ("carry_add", wrap_s scarry_add);
            ("carry_sub", wrap_s scarry_sub);
            ("carry_opp", wrap_s scarry_opp);
            ("relax", wrap_s srelax);
            ("selectznz", wrap_s sselectznz);
            ("to_bytes", wrap_s sto_bytes);
            ("from_bytes", wrap_s sfrom_bytes)].

    Definition valid_names : string
      := Eval compute in String.concat ", " (List.map (@fst _ _) known_functions) ++ ", or 'carry_scmul' followed by a decimal literal".

    Definition extra_special_synthesis (function_name_prefix : string) (name : string)
      : list (option { t : _ & string * Pipeline.M (Pipeline.ExtendedSynthesisResult t) }%type)
      := [if prefix "carry_scmul" name
          then let sc := substring (String.length "carry_scmul") (String.length name) name in
               (scZ <- Decimal.Z.of_string sc;
               if (sc =? Decimal.Z.to_string scZ)%string
               then Some (wrap_s (fun _ => scarry_scmul_const function_name_prefix scZ) tt)
               else None)%option
          else None].

    (** Note: If you change the name or type signature of this
          function, you will need to update the code in CLI.v *)
    Definition Synthesize (comment_header : list string) (function_name_prefix : string) (requests : list string)
      : list (synthesis_output_kind * string * Pipeline.M (list string))
      := Primitives.Synthesize
           machine_wordsize valid_names known_functions (extra_special_synthesis function_name_prefix) all_typedefs!
           check_args
           (ToString.comment_file_header_block
              (comment_header
                 ++ [""
                     ; "Computed values:"]
                 ++ (List.map
                       (fun s => "  " ++ s)%string
                       ((ToString.prefix_and_indent "carry_chain = " [show idxs])
                          ++ (ToString.prefix_and_indent "eval z = " [seval "z"])
                          ++ (ToString.prefix_and_indent "bytes_eval z = " [sbytes_eval "z"])
                          ++ (ToString.prefix_and_indent "balance = " [let show_lvl_Z := Hex.show_lvl_Z in show balance])))))
           function_name_prefix requests.
  End for_stringification.
End __.

Module Export Hints.
#[global]
  Hint Opaque
       carry_mul
       carry_square
       carry_scmul_const
       carry
       add
       sub
       opp
       carry_add
       carry_sub
       carry_opp
       relax
       from_bytes
       to_bytes
       encode
       encode_word
       zero
       one
       copy
       selectznz
  : wf_op_cache.
#[global]
  Hint Immediate
       Wf_carry_mul
       Wf_carry_square
       Wf_carry_scmul_const
       Wf_carry
       Wf_add
       Wf_sub
       Wf_opp
       Wf_carry_add
       Wf_carry_sub
       Wf_carry_opp
       Wf_relax
       Wf_from_bytes
       Wf_to_bytes
       Wf_encode
       Wf_encode_word
       Wf_zero
       Wf_one
       Wf_copy
       Wf_selectznz
  : wf_op_cache.
End Hints.