From 765f692e0e35b9523689db40469862e6ff155caf Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Tue, 1 Aug 2023 14:04:51 +0200
Subject: [PATCH 01/34] wip

---
 src/Bedrock/Field/Translation/Cmd.v           | 230 ++++++++++++++++--
 src/Bedrock/Field/Translation/Expr.v          |   2 +-
 .../Field/Translation/Parameters/Defaults.v   |  11 +-
 src/Bedrock/Field/Translation/Proofs/Cmd.v    |  70 +++++-
 4 files changed, 281 insertions(+), 32 deletions(-)

diff --git a/src/Bedrock/Field/Translation/Cmd.v b/src/Bedrock/Field/Translation/Cmd.v
index cc1c8fd5cb..1cf63266aa 100644
--- a/src/Bedrock/Field/Translation/Cmd.v
+++ b/src/Bedrock/Field/Translation/Cmd.v
@@ -15,9 +15,18 @@ Import API.Compilers.
 Import Types.Notations.
 
 Section Cmd.
-  Context 
+  Context
     {width BW word mem locals env ext_spec varname_gen error}
-   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+    `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+  (* TODO: move these to DefaultParameters or something *)
+  (* Special function names. These will be translated to bedrock2 function calls
+     instead of all the way into operations. *)
+  Context
+    (* add_carryx should take (x, y, carry_in) as arguments and return (sum, carry_out). *)
+    {add_carryx_funcname : string}
+    (* sub_borrowx should take (x, y, borrow_in) as arguments and return (difference, borrow_out). *)
+    {sub_borrowx_funcname : string}
+    .
   Existing Instance Types.rep.Z.
   Existing Instance Types.rep.listZ_local. (* local list representation *)
 
@@ -68,6 +77,182 @@ Section Cmd.
        | _ => fun _ _ => None
        end.
 
+  (* TODO: move to rewriter/src/Rewriter/Language/Language.v along with
+     invert_AppIdent2_cps and friends. *)
+  Definition invert_AppIdent3_cps
+             {base_type : Type} {ident var : type base_type -> Type}
+             {t Q R S} (e : expr (ident:=ident) (var:=var) t)
+             (F1 : forall t, expr (ident:=ident) (var:=var) t -> Q t)
+             (F2 : forall t, expr (ident:=ident) (var:=var) t -> R t)
+             (F3 : forall t, expr (ident:=ident) (var:=var) t -> S t)
+    : option {argtypes : type base_type * type base_type * type base_type
+                         & (ident (fst (fst argtypes)
+                                   -> snd (fst argtypes)
+                                   -> snd argtypes -> t)%etype
+                            * Q (fst (fst argtypes))
+                            * R (snd (fst argtypes))
+                            * S (snd argtypes))%type }
+    :=
+      (e <- invert_expr.invert_App_cps
+             e (fun _ _ e => invert_expr.invert_AppIdent2_cps e F1 F2) F3;
+      let '(existT t3 (e,x3)) := e in
+      e <- e;
+      let '(existT t12 (f, x1, x2)) := e in
+      Some (existT _ (t12, t3) (f, x1, x2, x3)))%option.
+  Definition invert_AppIdent4_cps
+             {base_type : Type} {ident var : type base_type -> Type}
+             {t Q R S T} (e : expr (ident:=ident) (var:=var) t)
+             (F1 : forall t, expr (ident:=ident) (var:=var) t -> Q t)
+             (F2 : forall t, expr (ident:=ident) (var:=var) t -> R t)
+             (F3 : forall t, expr (ident:=ident) (var:=var) t -> S t)
+             (F4 : forall t, expr (ident:=ident) (var:=var) t -> T t)
+    : option {argtypes : type base_type * type base_type * type base_type * type base_type
+                         & (ident (fst (fst (fst argtypes))
+                                   -> snd (fst (fst argtypes))
+                                   -> snd (fst argtypes)
+                                   -> snd argtypes
+                                   -> t)%etype
+                            * Q (fst (fst (fst argtypes)))
+                            * R (snd (fst (fst argtypes)))
+                            * S (snd (fst argtypes))
+                            * T (snd argtypes))%type }
+    :=
+      (e <- invert_expr.invert_App_cps
+             e (fun _ _ e =>
+                  invert_expr.invert_App_cps
+                    e (fun _ _ e =>
+                         invert_expr.invert_AppIdent2_cps e F1 F2) F3) F4;
+      let '(existT t4 (e,x4)) := e in
+      e <- e;
+      let '(existT t3 (e,x3)) := e in
+      e <- e;
+      let '(existT t12 (f, x1, x2)) := e in
+      Some (existT _ (t12, t3, t4) (f, x1, x2, x3, x4)))%option.
+
+  Check translate_expr.
+  (* End of day braindump:
+
+     - current prototype is probably shortest path to something that works for 3-4 functions
+     - downsides: breaks abstraction a bit to handle the details of casts etc. at the Cmd level
+     - general work to do:
+       - adapt valid_cmd to special-case the set of separate functions with their casts
+       - create specs for them and fix proofs
+       - adapt the computable version of valid_cmd to match and fix equivalence proof
+       - add 4-argument functions
+       - adjust pipeline args in Defaults.v as needed
+
+    Alternatives:
+      1. Unify translate_expr and translate_cmd layers
+         - Cmd handles variable naming and list/tuple assembly
+         - variable naming uses a counter -> introduces state for rec calls
+         - Expr handles most complicated logic; having no rec state is nice
+      2. Make translate_expr return Syntax.cmd.cmd but not handle the counter
+         - have translate_cmd look ahead to see if the expression is a special function
+         - if so, translate_cmd passes enough variable names to translate_expr to bind result
+         - translate_expr fails if wrong number of names
+         - downsides: extra argument to trace through translate_expr, proof complexity
+
+
+    Example add_get_carry occurrence for reference:
+
+                    (eApp
+                      (eApp (eIdent Compilers.ident_Z_cast2)
+                         (eApp
+                            (eApp (eIdent Compilers.ident_pair)
+                               (eIdent
+                                  (Compilers.ident_Literal
+                                     {| ZRange.lower := 0; ZRange.upper := 4294967295 |})))
+                            (eIdent (Compilers.ident_Literal {| ZRange.lower := 0; ZRange.upper := 1 |}))))
+                      (eApp
+                         (eApp
+                            (eApp (eIdent Compilers.ident_Z_add_get_carry)
+                               (eIdent (Compilers.ident_Literal 4294967296%Z)))
+                            (eApp
+                               (eApp (eIdent Compilers.ident_Z_cast)
+                                  (eIdent
+                                     (Compilers.ident_Literal
+                                        {| ZRange.lower := 0; ZRange.upper := 4294967295 |})))
+                               (eApp
+                                  (eApp
+                                     (eApp (eIdent Compilers.ident_List_nth_default)
+                                        (eIdent (Compilers.ident_Literal 0%Z))) 
+                                     (eVar x0)) (eIdent (Compilers.ident_Literal 0)))))
+                         (eApp
+                            (eApp (eIdent Compilers.ident_Z_cast)
+                               (eIdent
+                                  (Compilers.ident_Literal
+                                     {| ZRange.lower := 0; ZRange.upper := 4294967295 |})))
+                            (eApp
+                               (eApp
+                                  (eApp (eIdent Compilers.ident_List_nth_default)
+                                     (eIdent (Compilers.ident_Literal 0%Z))) (eVar x1))
+                               (eIdent (Compilers.ident_Literal 0))))))
+   *)
+
+  (* Translate 3-argument special functions. *)
+  Definition translate_ident_special3 {a b c d} (i : ident (a -> b -> c -> d)) (nextn : nat)
+    : rtype a -> rtype b -> rtype c -> option (nat * ltype d * Syntax.cmd.cmd)
+    := match i in ident t return
+             rtype (type.domain t) ->
+             rtype (type.domain (type.codomain t)) ->
+             rtype (type.domain (type.codomain (type.codomain t))) ->
+             option (nat
+                     * ltype (type.codomain (type.codomain (type.codomain t)))
+                     * Syntax.cmd.cmd) with
+       | ident.Z_add_get_carry =>
+         fun s x y =>
+           if literal_eqb s width
+           then
+             let sum := varname_gen nextn in
+             let carry := varname_gen (S nextn) in
+             Some (2%nat, (sum,carry), Syntax.cmd.call [sum;carry] add_carryx_funcname [x; y; Syntax.expr.literal 0])
+           else None
+       | ident.Z_sub_get_borrow =>
+         fun s x y =>
+           if literal_eqb s width
+           then
+             let diff := varname_gen nextn in
+             let borrow := varname_gen (S nextn) in
+             Some (2%nat, (diff, borrow), Syntax.cmd.call [diff;borrow] sub_borrowx_funcname [x; y; Syntax.expr.literal 0])
+           else None
+       | _ => fun _ _ _ => None
+       end.
+
+  (* Translates 3-argument special operations or returns None. *)
+  Definition translate_if_special3
+           {t} (e : @API.expr ltype t) (nextn : nat)
+    : option (nat * ltype t * Syntax.cmd.cmd)
+    := (ixyz <- invert_AppIdent3_cps e
+                                   (fun t => translate_expr true (t:=t))
+                                   (fun t => translate_expr true (t:=t))
+                                   (fun t => translate_expr true (t:=t));
+       let '(existT _ (i, x, y, z)) := ixyz in
+       translate_ident_special3 i nextn x y z)%option.
+
+  Fixpoint range_base_good {t} : Language.Compilers.base.interp (fun _ => ZRange.zrange) t -> bool :=
+    match t as t0 return Language.Compilers.base.interp (base:=Compilers.base) (fun _ => ZRange.zrange) t0 -> bool with
+    | base.type.type_base t => range_good (width:=width)
+    | base.type.prod A B => fun x => (range_base_good (fst x) && range_base_good (snd x))%bool
+    | _ => fun x => false
+    end.
+  Definition range_type_good {t}
+    : type.interp (Language.Compilers.base.interp (fun _ => ZRange.zrange)) t -> bool :=
+    match t with
+    | type.base b => range_base_good
+    | _ => fun x => false
+    end.
+
+  Definition translate_if_special_function
+             {t} (e : @API.expr ltype t) (nextn : nat)
+    : option (nat * ltype t * Syntax.cmd.cmd) :=
+    (* Expect an outer cast and strip it off. *)
+    (rx <- invert_expr.invert_App_cast e;
+    if range_type_good (fst rx)
+    then
+      (* Translate the rest of the function. *)
+      translate_if_special3 (snd rx) nextn
+    else None)%option.
+
   Fixpoint translate_cmd
            {t} (e : @API.expr ltype t) (nextn : nat)
     : nat (* number of variable names used *)
@@ -82,21 +267,32 @@ Section Cmd.
        snd (fst trf),
        Syntax.cmd.seq (snd trx) (snd trf))
     | expr.App _ _ _ _ as e
-      => let result_if_ident2
-             := (ixy <- invert_expr.invert_AppIdent2_cps e (@translate_cmd) (@translate_cmd);
-                let '(existT _ (i, translate_cmd_x, translate_cmd_y)) := ixy in
-                let trx := translate_cmd_x nextn in
-                let try := translate_cmd_y (fst (fst trx) + nextn)%nat in
-                vars <- translate_ident2_for_cmd i (snd (fst trx)) (snd (fst try));
-                Some ((fst (fst trx) + fst (fst try))%nat,
-                      vars,
-                      Syntax.cmd.seq (snd trx) (snd try)))%option in
-         match result_if_ident2 with
-         | Some res => res
-         | None =>
-           let v := translate_expr true e in
-           assign nextn v
-         end
+      =>
+      (* Special handling for `pair` and `cons` operations, which need to
+         recursively call `translate_cmd` on their arguments; this routine
+         returns `None` for any other identifiers. *)
+      let result_if_ident2
+          := (ixy <- invert_expr.invert_AppIdent2_cps e (@translate_cmd) (@translate_cmd);
+             let '(existT _ (i, translate_cmd_x, translate_cmd_y)) := ixy in
+             let trx := translate_cmd_x nextn in
+             let try := translate_cmd_y (fst (fst trx) + nextn)%nat in
+             vars <- translate_ident2_for_cmd i (snd (fst trx)) (snd (fst try));
+             Some ((fst (fst trx) + fst (fst try))%nat,
+                   vars,
+                   Syntax.cmd.seq (snd trx) (snd try)))%option in
+      (* Special handling for functions that should result in calls to bedrock2
+         functions, e.g. add_carryx. *)
+      let result_if_special := translate_if_special_function e nextn in
+      match result_if_ident2 with
+      | Some res => res
+      | None =>
+        match result_if_special with
+        | Some res => res
+        | None =>
+          let v := translate_expr true e in
+          assign nextn v
+        end
+      end
     | expr.Ident type_listZ (ident.nil _) =>
       (0%nat, [], Syntax.cmd.skip)
     | expr.Ident _ i =>
diff --git a/src/Bedrock/Field/Translation/Expr.v b/src/Bedrock/Field/Translation/Expr.v
index 56e956e416..47ae06d8f8 100644
--- a/src/Bedrock/Field/Translation/Expr.v
+++ b/src/Bedrock/Field/Translation/Expr.v
@@ -10,7 +10,7 @@ Import API.Compilers.
 Import Types.Notations.
 
 Section Expr.
-  Context 
+  Context
     {width BW word mem locals env ext_spec varname_gen error}
    `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
   Context {ok : ok}.
diff --git a/src/Bedrock/Field/Translation/Parameters/Defaults.v b/src/Bedrock/Field/Translation/Parameters/Defaults.v
index 6368951977..8f6212ed18 100644
--- a/src/Bedrock/Field/Translation/Parameters/Defaults.v
+++ b/src/Bedrock/Field/Translation/Parameters/Defaults.v
@@ -18,6 +18,8 @@ Import ListNotations.
 (* use in-memory lists; local ones are only used internally *)
 Global Existing Instances Types.rep.Z Types.rep.listZ_mem.
 
+Print PipelineOptions.
+Search split_multiret_to_opt.
 Global Instance pipeline_opts : PipelineOptions :=
   let _ := default_PipelineOptions in
   {| (* Abstract interpretation options; currently only involving (>>) uint1 bounds, which is not relevant to bedrock2 *)
@@ -25,12 +27,11 @@ Global Instance pipeline_opts : PipelineOptions :=
     {| AbstractInterpretation.shiftr_avoid_uint1 := false (* we need to not avoid uint1 to pass bounds analysis tightness, for some reason? *) |}
   (* Split multiplications into two outputs, not just one huge word *)
   ; should_split_mul := true
-  (* For functions that return multiple values, split into two LetIns (this is
-     because bedrock2 does not support multiple-sets, so they would have to be
-     split anyway) *)
-  ; should_split_multiret := true
+  (* Return two values for carry/borrow operations. *)
+  ; should_split_multiret := false
+  (* Leave carries as 1-bit integers, since these get special handling *)
+  ; widen_carry := false
   (* Make all words full-size, even if they could be smaller *)
-  ; widen_carry := true
   ; widen_bytes := true
   (* Unsigned integers *)
   ; only_signed := false
diff --git a/src/Bedrock/Field/Translation/Proofs/Cmd.v b/src/Bedrock/Field/Translation/Proofs/Cmd.v
index b78c44a159..0d6cd59c3e 100644
--- a/src/Bedrock/Field/Translation/Proofs/Cmd.v
+++ b/src/Bedrock/Field/Translation/Proofs/Cmd.v
@@ -35,6 +35,7 @@ Import Types.Notations.
 Section Cmd.
   Context 
     {width BW word mem locals env ext_spec varname_gen error}
+    {add_carryx_funcname sub_borrowx_funcname : string}
    `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
   Context {ok : ok}.
 
@@ -67,6 +68,25 @@ Section Cmd.
                    (ident.cons (t:=base.type.type_base base.type.Z))) x) l)
   | valid_nil :
       valid_cmd (expr.Ident (ident.nil (t:=base.type.type_base base.type.Z)))
+  | valid_add_get_carry :
+      forall r1 r2 (s : Z) x y,
+        range_good (width:=width) r1 = true ->
+        range_good (width:=width) r2 = true ->
+        s = 2 ^ width ->
+        valid_expr true x ->
+        valid_expr true y ->
+        valid_cmd (expr.App
+                     (expr.App (expr.Ident ident.Z_cast2)
+                               (expr.App
+                                  (expr.App
+                                     (expr.Ident ident.pair)
+                                     (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
+                                  (expr.Ident (ident.Literal (t:=base.type.zrange) r2))))
+                     (expr.App
+                        (expr.App
+                           (expr.App (expr.Ident ident.Z_add_get_carry)
+                                     (expr.Ident (ident.Literal (t:=base.type.Z) s)))
+                           x) y))
   | valid_inner :
       forall {t} e,
         valid_expr (t:=type.base t) true e ->
@@ -294,7 +314,9 @@ Section Cmd.
         G nextn :
     valid_expr true e1 ->
     wf3 G e1 e2 e3 ->
-    translate_cmd e3 nextn = assign nextn (translate_expr true e3).
+    translate_cmd (add_carryx_funcname:=add_carryx_funcname)
+                  (sub_borrowx_funcname:=sub_borrowx_funcname)
+                  e3 nextn = assign nextn (translate_expr true e3).
   Proof.
     inversion 1; cleanup_wf; try reflexivity; intros.
     all: repeat first [ reflexivity
@@ -386,7 +408,9 @@ Section Cmd.
       (* ret := fiat-crypto interpretation of e2 *)
       let ret1 : API.interp_type t := API.interp e2 in
       (* out := translation output for e3 *)
-      let out := translate_cmd e3 nextn in
+      let out := translate_cmd (add_carryx_funcname:=add_carryx_funcname)
+                               (sub_borrowx_funcname:=sub_borrowx_funcname)
+                               e3 nextn in
       let nvars := fst (fst out) in
       let ret2 := rtype_of_ltype _ (snd (fst out)) in
       let body := snd out in
@@ -421,17 +445,19 @@ Section Cmd.
     induction e1_valid; try (inversion 1; [ ]).
 
     (* inversion on wf3 leaves a mess; clean up hypotheses *)
+    Ltac invert_until_exposed H y :=
+      progress match y with
+               | expr.App _ _ => idtac (* don't invert original, already-inverted one *)
+               | _ => inversion H; clear H
+               end.
     all:repeat match goal with
                | _ => progress cleanup_wf
                | _ => progress cbn [varname_set]
                | H : wf3 _ ?x ?y _ |- _ =>
-                 (* for the cons case, repeatedly do inversion until the cons is exposed *)
+                 (* for cons and special functions, repeatedly do inversion until they are exposed *)
                  progress match x with
-                            context [Compilers.ident.cons] =>
-                            progress match y with
-                                     | expr.App _ _ => idtac (* don't invert original, already-inverted one *)
-                                     | _ => inversion H; clear H
-                                     end
+                          | expr.App _ _ =>invert_until_exposed H y
+                          | expr.Ident _ =>invert_until_exposed H y
                           end
                end.
 
@@ -447,7 +473,7 @@ Section Cmd.
                         [ eapply Proper_call | repeat intro
                           | eapply assign_correct; eauto;
                             eapply translate_expr_correct; solve [eauto] ]
-               | _ => progress cbn [invert_expr.invert_pair_cps invert_expr.invert_AppIdent2_cps Option.bind invert_expr.invert_App2_cps invert_expr.invert_App_cps invert_expr.invert_Ident invert_expr.is_pair Compilers.invertIdent Option.bind translate_ident2_for_cmd Crypto.Util.Option.bind]
+               | _ => progress cbn [translate_if_special_function (*translate_if_special3*) invert_AppIdent3_cps invert_AppIdent4_cps invert_expr.invert_pair_cps invert_expr.invert_AppIdent2_cps Option.bind invert_expr.invert_App2_cps invert_expr.invert_App_cps invert_expr.invert_Ident invert_expr.is_pair Compilers.invertIdent Option.bind translate_ident2_for_cmd Crypto.Util.Option.bind]
                end.
 
     { (* let-in (product of base types) *)
@@ -531,6 +557,32 @@ Section Cmd.
       cbv [locally_equivalent equivalent]; simplify; eauto;
         try reflexivity.
       right; reflexivity. }
+    { (* add_get_carry *)
+      eapply Proper_cmd; [ eapply Proper_call | repeat intro | ].
+      2:{
+        straightline.
+        cbn.
+        cbn [translate_expr].
+        Search translate_expr.
+        Print locally_equivalent.
+        Print equivalent.
+        simplify.
+        straightline.
+        econstructor.
+        cleanup.
+        Search translate_expr.
+        repeat match goal with
+               | _ => progress (intros; cleanup)
+               | H : _ |- _ => solve [apply H]
+               | _ => solve [new_context_ok]
+               | _ => congruence
+               end; [ ].
+        eapply only_differ_disjoint_undef_on; eauto with lia; [ ].
+        match goal with H : PropSet.sameset _ _ |- _ =>
+                        rewrite H end.
+        apply used_varnames_disjoint; lia. 
+        
+    }
     { (* valid expr *)
       simplify; subst; eauto; only_differ_ok.
       match goal with H : PropSet.sameset _ _ |- _ =>

From eaefa72b62d0f235d575e7b6a4e04d31fb1db1ab Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Tue, 1 Aug 2023 14:32:26 +0200
Subject: [PATCH 02/34] wip

---
 src/Bedrock/Field/Translation/Cmd.v        |  2 +-
 src/Bedrock/Field/Translation/Proofs/Cmd.v | 31 +++++++++++++++-------
 2 files changed, 23 insertions(+), 10 deletions(-)

diff --git a/src/Bedrock/Field/Translation/Cmd.v b/src/Bedrock/Field/Translation/Cmd.v
index 1cf63266aa..5c0636227f 100644
--- a/src/Bedrock/Field/Translation/Cmd.v
+++ b/src/Bedrock/Field/Translation/Cmd.v
@@ -275,7 +275,7 @@ Section Cmd.
           := (ixy <- invert_expr.invert_AppIdent2_cps e (@translate_cmd) (@translate_cmd);
              let '(existT _ (i, translate_cmd_x, translate_cmd_y)) := ixy in
              let trx := translate_cmd_x nextn in
-             let try := translate_cmd_y (fst (fst trx) + nextn)%nat in
+             let try := translate_cmd_y (nextn + fst (fst trx))%nat in
              vars <- translate_ident2_for_cmd i (snd (fst trx)) (snd (fst try));
              Some ((fst (fst trx) + fst (fst try))%nat,
                    vars,
diff --git a/src/Bedrock/Field/Translation/Proofs/Cmd.v b/src/Bedrock/Field/Translation/Proofs/Cmd.v
index 0d6cd59c3e..045b745878 100644
--- a/src/Bedrock/Field/Translation/Proofs/Cmd.v
+++ b/src/Bedrock/Field/Translation/Proofs/Cmd.v
@@ -59,7 +59,7 @@ Section Cmd.
         valid_cmd (expr.LetIn (A:=type.base (base.type.type_base a)) (B:=type.base b) x f)
   | valid_cons :
       forall x l,
-        valid_expr true x ->
+        valid_cmd x ->
         valid_cmd l ->
         valid_cmd
           (expr.App
@@ -324,7 +324,7 @@ Section Cmd.
                         | [ H : wf3 _ ?x _ _ |- _ ]
                           => assert_fails is_var x; inversion H; clear H; cleanup_wf
                         end ].
-  Qed.
+  Abort. (* TODO: fix *)
 
   Local Ltac simplify :=
     repeat
@@ -461,11 +461,11 @@ Section Cmd.
                           end
                end.
 
+    Print translate_if_special_function.
     (* simplify goals *)
     all:repeat match goal with
                | _ => progress (intros; cleanup)
                | _ => progress cbv [Rewriter.Util.LetIn.Let_In] in *
-               | _ => erewrite translate_cmd_valid_expr by eauto
                | _ => progress cbn [translate_cmd expr.interp type.app_curried
                                                   WeakestPrecondition.cmd
                                                   WeakestPrecondition.cmd_body] in *
@@ -513,7 +513,18 @@ Section Cmd.
     { (* cons *)
       eapply Proper_cmd; [ eapply Proper_call | repeat intro | ].
       2: {
-        eapply IHe1_valid with (G:=G); clear IHe1_valid;
+        eapply IHe1_valid1 with (G:=G); clear IHe1_valid1;
+        repeat match goal with
+               | _ => progress (intros; cleanup)
+               | H : _ |- _ => solve [apply H]
+               | _ => solve [new_context_ok]
+               | _ => congruence
+               end; [ ].
+        eapply only_differ_disjoint_undef_on; eauto with lia; [ apply only_differ_empty | ].
+        apply disjoint_empty_l. }
+      eapply Proper_cmd; [ eapply Proper_call | repeat intro | ].
+      2: {
+        eapply IHe1_valid2 with (G:=G); clear IHe1_valid2;
         repeat match goal with
                | _ => progress (intros; cleanup)
                | H : _ |- _ => solve [apply H]
@@ -521,8 +532,6 @@ Section Cmd.
                | _ => congruence
                end; [ ].
         eapply only_differ_disjoint_undef_on; eauto with lia; [ ].
-        match goal with H : PropSet.sameset _ _ |- _ =>
-                        rewrite H end.
         apply used_varnames_disjoint; lia. }
       { simplify; subst; eauto; [ | | ].
         { (* varnames subset *)
@@ -530,13 +539,17 @@ Section Cmd.
           rewrite PropSet.of_list_cons.
           rewrite add_union_singleton.
           apply subset_union_l;
-            [ apply used_varnames_subset_singleton; lia| ].
+            [ etransitivity; [eassumption|]; apply used_varnames_subset; lia | ].
           rewrite <-varname_set_local.
           etransitivity; [eassumption|].
-          rewrite <-Nat.add_1_r.
           apply used_varnames_shift. }
         { (* only_differ *)
-          rewrite <-(Nat.add_comm nextn 1) in *.
+          remember (@translate_cmd width BW word mem locals env ext_spec varname_gen error
+                               parameters_sentinel add_carryx_funcname sub_borrowx_funcname
+                               (@type.base (Language.Compilers.base.type.type Compilers.base)
+                                  (@base.type.type_base Compilers.base Compilers.Z)) x5 nextn) as A.
+          remember (fst (fst (translate_cmd (add_carryx_funcname:=add_carryx_funcname) (sub_borrowx_funcname:=sub_borrowx_funcname) x5 nextn))) as A.
+          remember (fst (fst (translate_cmd (add_carryx_funcname:=add_carryx_funcname) (sub_borrowx_funcname:=sub_borrowx_funcname) x5 nextn))) as A.
           only_differ_ok. }
         { (* equivalence of output holds *)
           clear IHe1_valid.

From 33f24e1805bf95bc1a7b7dcff77f13be7472eeb9 Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Thu, 3 Aug 2023 14:27:04 +0200
Subject: [PATCH 03/34] pre-sed

---
 src/Bedrock/Field/Common/Types.v              |  20 +-
 .../Field/Synthesis/Examples/p224_64_new.v    |  17 ++
 src/Bedrock/Field/Translation/Cmd.v           |  27 +--
 .../Field/Translation/Parameters/Defaults.v   |   2 +
 .../Field/Translation/Parameters/Defaults32.v |   2 +
 .../Field/Translation/Parameters/Defaults64.v |   2 +
 src/Bedrock/Field/Translation/Proofs/Cmd.v    | 195 ++++++++++--------
 src/Bedrock/Field/Translation/Proofs/Expr.v   |   6 +
 8 files changed, 162 insertions(+), 109 deletions(-)

diff --git a/src/Bedrock/Field/Common/Types.v b/src/Bedrock/Field/Common/Types.v
index f257844d07..d370f9c190 100644
--- a/src/Bedrock/Field/Common/Types.v
+++ b/src/Bedrock/Field/Common/Types.v
@@ -38,13 +38,17 @@ Class parameters
   {env: map.map String.string (list String.string * list String.string * Syntax.cmd)}
   {ext_spec: bedrock2.Semantics.ExtSpec}
   {varname_gen : nat -> String.string}
+  (* add_carryx should take 3 arguments (x,y,carry) and return 2 values (sum, carry) *)
+  {add_carryx_funcname : String.string}
+  (* sub_borrowx should take 3 arguments (x,y,borrow) and return 2 values (difference, borrow) *)
+  {sub_borrowx_funcname : String.string}
   {error : Syntax.expr.expr} := parameters_sentinel : unit.
 
 Section WithParameters.
-  Context 
-    {width BW word mem locals env ext_spec varname_gen error}
+  Context
+    {width BW word mem locals env ext_spec add_carryx sub_borrowx varname_gen error}
    `{parameters_sentinel : @parameters
-     width BW word mem locals env ext_spec varname_gen error}.
+     width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Local Notation parameters := (ltac:(let t := type of parameters_sentinel in exact t)) (only parsing).
   Class ok {parameters_sentinel : parameters} :=
     {
@@ -68,10 +72,10 @@ End WithParameters.
 
 Module rep.
   Section rep.
-    Context 
-      {width BW word mem locals env ext_spec varname_gen error}
+    Context
+      {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
      `{parameters_sentinel : @parameters
-       width BW word mem locals env ext_spec varname_gen error}.
+       width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
     Local Notation parameters := (ltac:(let t := type of parameters_sentinel in exact t)) (only parsing).
 
     Class rep {parameters_sentinel : parameters} (t : base.type) :=
@@ -161,9 +165,9 @@ End rep.
 
 Section defs.
   Context
-    {width BW word mem locals env ext_spec varname_gen error}
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
    `{parameters_sentinel : @parameters
-     width BW word mem locals env ext_spec varname_gen error}.
+     width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Local Notation parameters := (ltac:(let t := type of parameters_sentinel in exact t)) (only parsing).
   Context
           (* list representation -- could be local or in-memory *)
diff --git a/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v b/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
index 25dc8f6ebc..07ccdf320f 100644
--- a/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
+++ b/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
@@ -50,6 +50,23 @@ Section Field.
   Proof using Type. Time constructor; make_computed_op. Defined.
 
 
+  Goal False.
+    Local Notation ttype := Language.Compilers.type.type.
+    Local Notation tbase := Language.Compilers.type.base.
+    Local Notation ttype_base := Language.Compilers.base.type.type_base.
+    Local Notation btype := Language.Compilers.base.type.type.
+    Local Notation blist := Language.Compilers.base.type.list.
+    Require Import IdentifiersBasicGENERATED.
+    Local Notation eAbs := Language.Compilers.expr.Abs.
+    Local Notation eApp := Language.Compilers.expr.App.
+    Local Notation eVar := Language.Compilers.expr.Var.
+    Local Notation eLetIn := Language.Compilers.expr.LetIn.
+    Local Notation eIdent := Language.Compilers.expr.Ident.
+    pose add_op.
+    cbn [add_op p224_ops] in c.
+
+  Qed.
+
   (**** Translate each field operation into bedrock2 and apply bedrock2 backend
         field pipeline proofs to prove the bedrock2 functions are correct. ****)
 
diff --git a/src/Bedrock/Field/Translation/Cmd.v b/src/Bedrock/Field/Translation/Cmd.v
index 5c0636227f..9b31742bb3 100644
--- a/src/Bedrock/Field/Translation/Cmd.v
+++ b/src/Bedrock/Field/Translation/Cmd.v
@@ -18,14 +18,6 @@ Section Cmd.
   Context
     {width BW word mem locals env ext_spec varname_gen error}
     `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
-  (* TODO: move these to DefaultParameters or something *)
-  (* Special function names. These will be translated to bedrock2 function calls
-     instead of all the way into operations. *)
-  Context
-    (* add_carryx should take (x, y, carry_in) as arguments and return (sum, carry_out). *)
-    {add_carryx_funcname : string}
-    (* sub_borrowx should take (x, y, borrow_in) as arguments and return (difference, borrow_out). *)
-    {sub_borrowx_funcname : string}
     .
   Existing Instance Types.rep.Z.
   Existing Instance Types.rep.listZ_local. (* local list representation *)
@@ -261,7 +253,13 @@ Section Cmd.
     match e in expr.expr t0
           return (nat * ltype t0 * Syntax.cmd.cmd) with
     | expr.LetIn (type.base t1) (type.base t2) x f =>
-      let trx := assign nextn (translate_expr true x) in
+      (* Special handling for functions that should result in calls to bedrock2
+         functions, e.g. add_carryx. *)
+      let result_if_special := translate_if_special_function (t:=type.base t1) x nextn in
+      let trx := match result_if_special with
+                 | Some res => res
+                 | None => assign nextn (translate_expr true x)
+                 end in
       let trf := translate_cmd (f (snd (fst trx))) (nextn + fst (fst trx)) in
       ((fst (fst trx) + fst (fst trf))%nat,
        snd (fst trf),
@@ -280,18 +278,11 @@ Section Cmd.
              Some ((fst (fst trx) + fst (fst try))%nat,
                    vars,
                    Syntax.cmd.seq (snd trx) (snd try)))%option in
-      (* Special handling for functions that should result in calls to bedrock2
-         functions, e.g. add_carryx. *)
-      let result_if_special := translate_if_special_function e nextn in
       match result_if_ident2 with
       | Some res => res
       | None =>
-        match result_if_special with
-        | Some res => res
-        | None =>
-          let v := translate_expr true e in
-          assign nextn v
-        end
+        let v := translate_expr true e in
+        assign nextn v
       end
     | expr.Ident type_listZ (ident.nil _) =>
       (0%nat, [], Syntax.cmd.skip)
diff --git a/src/Bedrock/Field/Translation/Parameters/Defaults.v b/src/Bedrock/Field/Translation/Parameters/Defaults.v
index 8f6212ed18..22c1a722d3 100644
--- a/src/Bedrock/Field/Translation/Parameters/Defaults.v
+++ b/src/Bedrock/Field/Translation/Parameters/Defaults.v
@@ -46,6 +46,8 @@ Global Instance tight_upperbound_fraction : tight_upperbound_fraction_opt := def
 (* bedrock2 backend parameters *)
 Global Existing Instances Types.rep.Z Types.rep.listZ_mem.
 
+Local Definition add_carryx := "add_carryx"%string.
+Local Definition sub_borrowx := "sub_borrowx"%string.
 Local Definition ERROR := "ERROR"%string.
 
 Section Defs.
diff --git a/src/Bedrock/Field/Translation/Parameters/Defaults32.v b/src/Bedrock/Field/Translation/Parameters/Defaults32.v
index db5083f213..e436b67e41 100644
--- a/src/Bedrock/Field/Translation/Parameters/Defaults32.v
+++ b/src/Bedrock/Field/Translation/Parameters/Defaults32.v
@@ -27,6 +27,8 @@ Section Defaults_32.
   Instance default_parameters : Types.parameters
     (word := BasicC32Semantics.word)
     (varname_gen := default_varname_gen)
+    (add_carryx_funcname:=Defaults.add_carryx)
+    (sub_borrowx_funcname:=Defaults.sub_borrowx)
     (error := expr.var Defaults.ERROR)
     := tt.
   Instance default_parameters_ok : Types.ok.
diff --git a/src/Bedrock/Field/Translation/Parameters/Defaults64.v b/src/Bedrock/Field/Translation/Parameters/Defaults64.v
index 526883a7e5..ae06c3017b 100644
--- a/src/Bedrock/Field/Translation/Parameters/Defaults64.v
+++ b/src/Bedrock/Field/Translation/Parameters/Defaults64.v
@@ -27,6 +27,8 @@ Section Defaults_64.
   Instance default_parameters : Types.parameters
     (word := BasicC64Semantics.word)
     (varname_gen := default_varname_gen)
+    (add_carryx_funcname:=Defaults.add_carryx)
+    (sub_borrowx_funcname:=Defaults.sub_borrowx)
     (error := expr.var Defaults.ERROR)
     := tt.
   Instance default_parameters_ok : Types.ok.
diff --git a/src/Bedrock/Field/Translation/Proofs/Cmd.v b/src/Bedrock/Field/Translation/Proofs/Cmd.v
index 045b745878..c58ca036d8 100644
--- a/src/Bedrock/Field/Translation/Proofs/Cmd.v
+++ b/src/Bedrock/Field/Translation/Proofs/Cmd.v
@@ -48,7 +48,8 @@ Section Cmd.
       allowed; this is primarily because we don't want lists on the LHS *)
   | valid_LetIn_prod :
       forall {a b c} x f,
-        valid_expr true x -> valid_cmd (f tt) ->
+        valid_expr true x ->
+        valid_cmd (f tt) ->
         valid_cmd (expr.LetIn
                      (A:=type.base (base.type.prod
                                       (base.type.type_base a) (base.type.type_base b)))
@@ -59,7 +60,7 @@ Section Cmd.
         valid_cmd (expr.LetIn (A:=type.base (base.type.type_base a)) (B:=type.base b) x f)
   | valid_cons :
       forall x l,
-        valid_cmd x ->
+        valid_expr true x ->
         valid_cmd l ->
         valid_cmd
           (expr.App
@@ -68,29 +69,33 @@ Section Cmd.
                    (ident.cons (t:=base.type.type_base base.type.Z))) x) l)
   | valid_nil :
       valid_cmd (expr.Ident (ident.nil (t:=base.type.type_base base.type.Z)))
+  | valid_inner :
+      forall {t} e,
+        valid_expr (t:=type.base t) true e ->
+        valid_cmd e
   | valid_add_get_carry :
-      forall r1 r2 (s : Z) x y,
+      forall t r1 r2 (s : Z) x y f,
         range_good (width:=width) r1 = true ->
         range_good (width:=width) r2 = true ->
         s = 2 ^ width ->
         valid_expr true x ->
         valid_expr true y ->
-        valid_cmd (expr.App
-                     (expr.App (expr.Ident ident.Z_cast2)
-                               (expr.App
-                                  (expr.App
-                                     (expr.Ident ident.pair)
-                                     (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
-                                  (expr.Ident (ident.Literal (t:=base.type.zrange) r2))))
-                     (expr.App
-                        (expr.App
-                           (expr.App (expr.Ident ident.Z_add_get_carry)
-                                     (expr.Ident (ident.Literal (t:=base.type.Z) s)))
-                           x) y))
-  | valid_inner :
-      forall {t} e,
-        valid_expr (t:=type.base t) true e ->
-        valid_cmd e
+        valid_cmd (f tt) ->
+        valid_cmd
+          (expr.LetIn
+             (B:=type.base t)
+             (expr.App
+                (expr.App (expr.Ident ident.Z_cast2)
+                          (expr.App
+                             (expr.App
+                                (expr.Ident ident.pair)
+                                (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
+                             (expr.Ident (ident.Literal (t:=base.type.zrange) r2))))
+                (expr.App
+                   (expr.App
+                      (expr.App (expr.Ident ident.Z_add_get_carry)
+                                (expr.Ident (ident.Literal (t:=base.type.Z) s)))
+                      x) y)) f)
   .
 
   Lemma assign_list_correct :
@@ -324,7 +329,7 @@ Section Cmd.
                         | [ H : wf3 _ ?x _ _ |- _ ]
                           => assert_fails is_var x; inversion H; clear H; cleanup_wf
                         end ].
-  Abort. (* TODO: fix *)
+  Qed.
 
   Local Ltac simplify :=
     repeat
@@ -461,11 +466,12 @@ Section Cmd.
                           end
                end.
 
-    Print translate_if_special_function.
     (* simplify goals *)
     all:repeat match goal with
+               | H : range_good ?r = true |- _ => rewrite range_good_eq in H; subst
                | _ => progress (intros; cleanup)
                | _ => progress cbv [Rewriter.Util.LetIn.Let_In] in *
+               | _ => erewrite translate_cmd_valid_expr by eauto
                | _ => progress cbn [translate_cmd expr.interp type.app_curried
                                                   WeakestPrecondition.cmd
                                                   WeakestPrecondition.cmd_body] in *
@@ -477,6 +483,7 @@ Section Cmd.
                end.
 
     { (* let-in (product of base types) *)
+      admit. (*
       eapply Proper_cmd; [ eapply Proper_call | repeat intro | ].
       2: {
         eapply IHe1_valid; clear IHe1_valid;
@@ -492,8 +499,10 @@ Section Cmd.
         apply used_varnames_disjoint; lia. }
       { simplify; subst; eauto; only_differ_ok.
         etransitivity; [ eassumption | ].
-        apply used_varnames_shift. } }
+        apply used_varnames_shift. } *) }
     { (* let-in (base type) *)
+      admit.
+      (*
       eapply Proper_cmd; [ eapply Proper_call | repeat intro | ].
       2: {
         eapply IHe1_valid; clear IHe1_valid;
@@ -509,22 +518,11 @@ Section Cmd.
         apply used_varnames_disjoint; lia. }
       { simplify; subst; eauto; only_differ_ok.
         etransitivity; [ eassumption | ].
-        apply used_varnames_shift. } }
+        apply used_varnames_shift. } } *) }
     { (* cons *)
       eapply Proper_cmd; [ eapply Proper_call | repeat intro | ].
       2: {
-        eapply IHe1_valid1 with (G:=G); clear IHe1_valid1;
-        repeat match goal with
-               | _ => progress (intros; cleanup)
-               | H : _ |- _ => solve [apply H]
-               | _ => solve [new_context_ok]
-               | _ => congruence
-               end; [ ].
-        eapply only_differ_disjoint_undef_on; eauto with lia; [ apply only_differ_empty | ].
-        apply disjoint_empty_l. }
-      eapply Proper_cmd; [ eapply Proper_call | repeat intro | ].
-      2: {
-        eapply IHe1_valid2 with (G:=G); clear IHe1_valid2;
+        eapply IHe1_valid with (G:=G); clear IHe1_valid;
         repeat match goal with
                | _ => progress (intros; cleanup)
                | H : _ |- _ => solve [apply H]
@@ -532,58 +530,93 @@ Section Cmd.
                | _ => congruence
                end; [ ].
         eapply only_differ_disjoint_undef_on; eauto with lia; [ ].
-        apply used_varnames_disjoint; lia. }
-      { simplify; subst; eauto; [ | | ].
-        { (* varnames subset *)
-          rewrite varname_set_local.
-          rewrite PropSet.of_list_cons.
-          rewrite add_union_singleton.
-          apply subset_union_l;
-            [ etransitivity; [eassumption|]; apply used_varnames_subset; lia | ].
-          rewrite <-varname_set_local.
-          etransitivity; [eassumption|].
-          apply used_varnames_shift. }
-        { (* only_differ *)
-          remember (@translate_cmd width BW word mem locals env ext_spec varname_gen error
-                               parameters_sentinel add_carryx_funcname sub_borrowx_funcname
-                               (@type.base (Language.Compilers.base.type.type Compilers.base)
-                                  (@base.type.type_base Compilers.base Compilers.Z)) x5 nextn) as A.
-          remember (fst (fst (translate_cmd (add_carryx_funcname:=add_carryx_funcname) (sub_borrowx_funcname:=sub_borrowx_funcname) x5 nextn))) as A.
-          remember (fst (fst (translate_cmd (add_carryx_funcname:=add_carryx_funcname) (sub_borrowx_funcname:=sub_borrowx_funcname) x5 nextn))) as A.
-          only_differ_ok. }
-        { (* equivalence of output holds *)
-          clear IHe1_valid.
-          simplify. cbv [WeakestPrecondition.dexpr] in *.
-          apply Forall2_cons; [intros | eassumption].
-          sepsimpl.
-          eexists; sepsimpl; [ eassumption | ].
-          eapply (expr_untouched ltac:(eassumption)
-                                        ltac:(eassumption)); eauto; [ ].
-          cbv [used_varnames]. setsimplify.
-          rewrite in_map_iff. intro; cleanup.
-          match goal with H : varname_gen ?x = varname_gen _ |- _ =>
-                          apply varname_gen_unique in H; subst x end.
-          match goal with H : In _ (seq _ _) |- _ =>
-                          apply in_seq in H end.
-          lia. } } }
+        match goal with H : PropSet.sameset _ _ |- _ => rewrite H end.
+        apply used_varnames_disjoint. lia. }
+      simplify; subst; eauto; [ | | ].
+      { (* varnames subset *)
+        rewrite varname_set_local.
+        rewrite PropSet.of_list_cons.
+        rewrite add_union_singleton.
+        apply subset_union_l;
+          [ apply used_varnames_subset_singleton; lia| ].
+        rewrite <-varname_set_local.
+        etransitivity; [eassumption|].
+        apply used_varnames_shift. }
+      { (* only_differ *)
+        only_differ_ok. }
+      { (* equivalence of output holds *)
+        simplify. cbv [WeakestPrecondition.dexpr] in *.
+        apply Forall2_cons; [intros | eassumption].
+        sepsimpl.
+        eexists; sepsimpl; [ eassumption | ].
+        eapply (expr_untouched ltac:(eassumption)
+                                      ltac:(eassumption)); eauto; [ ].
+        cbv [used_varnames]. setsimplify.
+        rewrite in_map_iff. intro; cleanup.
+        match goal with H : varname_gen ?x = varname_gen _ |- _ =>
+                        apply varname_gen_unique in H; subst x end.
+        match goal with H : In _ (seq _ _) |- _ =>
+                        apply in_seq in H end.
+        lia. } }
     { (* nil *)
       cbv [locally_equivalent equivalent]; simplify; eauto;
         try reflexivity.
       right; reflexivity. }
+    { (* valid expr *)
+      simplify; subst; eauto; only_differ_ok.
+      match goal with H : PropSet.sameset _ _ |- _ =>
+                      rewrite H end; reflexivity. }
     { (* add_get_carry *)
       eapply Proper_cmd; [ eapply Proper_call | repeat intro | ].
       2:{
-        straightline.
+        lazymatch goal with
+          |- context [translate_if_special_function ?x ?n] =>
+          remember (translate_if_special_function (add_carryx_funcname:=add_carryx_funcname)
+                                              (sub_borrowx_funcname:=sub_borrowx_funcname)
+                                              x n) as X eqn:HX
+        end.
+        cbv [translate_if_special_function] in HX.
+        cbv [invert_expr.invert_App_cast invert_expr.invert_App_Z_cast2 invert_expr.invert_App invert_expr.invert_App_cps] in HX.
+        lazymatch type of HX with context [invert_expr.invert_Z_cast2 ?x] => pose x as z end.
+        Search range_good.
+        Print range_good.
+        vm_compute in z.
+        cbn in X.
+        cbv [
+            translate_if_special_function
+              invert_expr.invert_App_cast
+              invert_expr.invert_App_Z_cast
+              invert_expr.invert_App_Z_cast2
+              invert_expr.invert_Z_cast2
+              invert_expr.invert_App
+              invert_expr.invert_Ident
+              invert_expr.invert_AppIdent
+              invert_expr.invert_AppIdent_cps
+              invert_expr.invert_AppIdent2_cps
+              invert_expr.invert_App_cps
+              invert_expr.invert_App2_cps
+              invert_expr.invert_Literal
+              invert_expr.invert_pair
+              invert_expr.invert_pair_cps
+              invert_expr.is_pair
+              invert_expr.reflect_smart_Literal
+              Option.bind
+              Crypto.Util.Option.bind
+          ] in X.
+        clear IHe1_valid.
+        cbv [Option.bind Crypto.Util.Option.bind].
+        eapply IHe1_valid with (G:=G); clear IHe1_valid;
+        repeat match goal with
+               | _ => progress (intros; cleanup)
+               | H : _ |- _ => solve [apply H]
+               | _ => solve [new_context_ok]
+               | _ => congruence
+               end; [ ].
+        eapply only_differ_disjoint_undef_on; eauto with lia; [ ].
+        match goal with H : PropSet.sameset _ _ |- _ => rewrite H end.
+        apply used_varnames_disjoint. lia. }
         cbn.
         cbn [translate_expr].
-        Search translate_expr.
-        Print locally_equivalent.
-        Print equivalent.
-        simplify.
-        straightline.
-        econstructor.
-        cleanup.
-        Search translate_expr.
         repeat match goal with
                | _ => progress (intros; cleanup)
                | H : _ |- _ => solve [apply H]
@@ -595,10 +628,6 @@ Section Cmd.
                         rewrite H end.
         apply used_varnames_disjoint; lia. 
         
-    }
-    { (* valid expr *)
-      simplify; subst; eauto; only_differ_ok.
-      match goal with H : PropSet.sameset _ _ |- _ =>
-                      rewrite H end; reflexivity. }
+      }
   Qed.
 End Cmd.
diff --git a/src/Bedrock/Field/Translation/Proofs/Expr.v b/src/Bedrock/Field/Translation/Proofs/Expr.v
index 9b19f359ff..f417463522 100644
--- a/src/Bedrock/Field/Translation/Proofs/Expr.v
+++ b/src/Bedrock/Field/Translation/Proofs/Expr.v
@@ -375,6 +375,12 @@ Section Expr.
     apply Z.pow_pos_nonneg; lia.
   Qed.
 
+  Lemma range_good_eq r : range_good (width:=width) r = true -> r = max_range (width:=width).
+  Proof.
+    cbv [range_good].
+    destruct (ZRange.reflect_zrange_eq r (max_range (width:=width))); congruence.
+  Qed.
+
   (** TODO: Find a better place for this *)
   Hint Rewrite word.testbit_wrap : Ztestbit_full.
   Lemma translate_expr_correct' {t}

From 4c9b91517ccd754fac1643adb1d62f75afc594f9 Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Thu, 3 Aug 2023 14:28:03 +0200
Subject: [PATCH 04/34] post sed

---
 src/Bedrock/Field/Common/Arrays/ByteBounds.v              | 4 ++--
 src/Bedrock/Field/Common/Arrays/MakeAccessSizes.v         | 4 ++--
 src/Bedrock/Field/Common/Arrays/MakeListLengths.v         | 4 ++--
 src/Bedrock/Field/Common/Arrays/MaxBounds.v               | 4 ++--
 src/Bedrock/Field/Common/Names/MakeNames.v                | 4 ++--
 src/Bedrock/Field/Interface/Representation.v              | 4 ++--
 src/Bedrock/Field/Stringification/Stringification.v       | 8 ++++----
 src/Bedrock/Field/Synthesis/New/ComputedOp.v              | 4 ++--
 src/Bedrock/Field/Synthesis/New/Signature.v               | 8 ++++----
 src/Bedrock/Field/Synthesis/New/UnsaturatedSolinas.v      | 4 ++--
 src/Bedrock/Field/Synthesis/New/WordByWordMontgomery.v    | 4 ++--
 src/Bedrock/Field/Translation/Cmd.v                       | 4 ++--
 src/Bedrock/Field/Translation/Expr.v                      | 4 ++--
 src/Bedrock/Field/Translation/Flatten.v                   | 4 ++--
 src/Bedrock/Field/Translation/Func.v                      | 4 ++--
 src/Bedrock/Field/Translation/LoadStoreList.v             | 4 ++--
 src/Bedrock/Field/Translation/Proofs/Cmd.v                | 4 ++--
 src/Bedrock/Field/Translation/Proofs/Equivalence.v        | 8 ++++----
 .../Field/Translation/Proofs/EquivalenceProperties.v      | 8 ++++----
 src/Bedrock/Field/Translation/Proofs/Expr.v               | 4 ++--
 src/Bedrock/Field/Translation/Proofs/Flatten.v            | 4 ++--
 src/Bedrock/Field/Translation/Proofs/Func.v               | 4 ++--
 src/Bedrock/Field/Translation/Proofs/LoadStoreList.v      | 4 ++--
 src/Bedrock/Field/Translation/Proofs/UsedVarnames.v       | 4 ++--
 .../Field/Translation/Proofs/ValidComputable/Cmd.v        | 4 ++--
 .../Field/Translation/Proofs/ValidComputable/Expr.v       | 4 ++--
 .../Field/Translation/Proofs/ValidComputable/Func.v       | 4 ++--
 src/Bedrock/Field/Translation/Proofs/VarnameSet.v         | 4 ++--
 28 files changed, 64 insertions(+), 64 deletions(-)

diff --git a/src/Bedrock/Field/Common/Arrays/ByteBounds.v b/src/Bedrock/Field/Common/Arrays/ByteBounds.v
index e61c8afed6..37dc37b6bb 100644
--- a/src/Bedrock/Field/Common/Arrays/ByteBounds.v
+++ b/src/Bedrock/Field/Common/Arrays/ByteBounds.v
@@ -21,8 +21,8 @@ Import Partition.
 
 Section ByteBounds.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
-   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Context {ok : ok}.
   Context (n : nat).
 
diff --git a/src/Bedrock/Field/Common/Arrays/MakeAccessSizes.v b/src/Bedrock/Field/Common/Arrays/MakeAccessSizes.v
index 62fc258708..5ecfec09e2 100644
--- a/src/Bedrock/Field/Common/Arrays/MakeAccessSizes.v
+++ b/src/Bedrock/Field/Common/Arrays/MakeAccessSizes.v
@@ -23,8 +23,8 @@ Import Types.Notations.
 
 Section __.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
-   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Existing Instances rep.Z rep.listZ_mem.
 
   Let all_access_sizes :=
diff --git a/src/Bedrock/Field/Common/Arrays/MakeListLengths.v b/src/Bedrock/Field/Common/Arrays/MakeListLengths.v
index a6dc4192b1..7077de986f 100644
--- a/src/Bedrock/Field/Common/Arrays/MakeListLengths.v
+++ b/src/Bedrock/Field/Common/Arrays/MakeListLengths.v
@@ -12,8 +12,8 @@ Existing Instances rep.Z rep.listZ_mem.
 
 Section with_parameters.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
-   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
 
   Fixpoint list_lengths_repeat_base (n : nat) t : base_listonly nat t :=
     match t as t0 return base_listonly nat t0 with
diff --git a/src/Bedrock/Field/Common/Arrays/MaxBounds.v b/src/Bedrock/Field/Common/Arrays/MaxBounds.v
index dfab750aa9..4a1196be3e 100644
--- a/src/Bedrock/Field/Common/Arrays/MaxBounds.v
+++ b/src/Bedrock/Field/Common/Arrays/MaxBounds.v
@@ -20,8 +20,8 @@ Import ListNotations.
 
 Section MaxBounds.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
-   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Context {ok : ok}.
   Context (n : nat).
 
diff --git a/src/Bedrock/Field/Common/Names/MakeNames.v b/src/Bedrock/Field/Common/Names/MakeNames.v
index c7cd34a74b..41756dd438 100644
--- a/src/Bedrock/Field/Common/Names/MakeNames.v
+++ b/src/Bedrock/Field/Common/Names/MakeNames.v
@@ -20,8 +20,8 @@ Existing Instances rep.Z rep.listZ_mem.
 
 Section with_parameters.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
-   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Context {inname_gen outname_gen : nat -> string}.
 
   Fixpoint make_names
diff --git a/src/Bedrock/Field/Interface/Representation.v b/src/Bedrock/Field/Interface/Representation.v
index 48c1671281..6cdd77449d 100644
--- a/src/Bedrock/Field/Interface/Representation.v
+++ b/src/Bedrock/Field/Interface/Representation.v
@@ -18,8 +18,8 @@ Require Import Crypto.Util.ZUtil.Tactics.ZeroBounds.
 
 Section Representation.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
-   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Context {field_parameters : FieldParameters}
           {p_ok : Types.ok}.
   Context (n n_bytes : nat) (weight : nat -> Z)
diff --git a/src/Bedrock/Field/Stringification/Stringification.v b/src/Bedrock/Field/Stringification/Stringification.v
index 1614a80e57..7921b2b822 100644
--- a/src/Bedrock/Field/Stringification/Stringification.v
+++ b/src/Bedrock/Field/Stringification/Stringification.v
@@ -29,8 +29,8 @@ Local Open Scope list_scope.
 
 Section with_parameters.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
-   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
 
   Fixpoint make_base_var_data {t}
     : base_ltype t -> list_lengths (type.base t) ->
@@ -114,8 +114,8 @@ Definition bedrock_func_to_lines (f : string * func)
   [c_func f].
 
 Definition wrap_call
-  {width BW word mem locals env ext_spec varname_gen error}
-  `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}
+  {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+  `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
            {t}
            (indata : type.for_each_lhs_of_arrow var_data t)
            (outdata : base_var_data (type.final_codomain t))
diff --git a/src/Bedrock/Field/Synthesis/New/ComputedOp.v b/src/Bedrock/Field/Synthesis/New/ComputedOp.v
index faf87855e9..30b3ae27a2 100644
--- a/src/Bedrock/Field/Synthesis/New/ComputedOp.v
+++ b/src/Bedrock/Field/Synthesis/New/ComputedOp.v
@@ -6,8 +6,8 @@ Require Import Crypto.Language.API.
 Import API.Compilers.
 
 Record computed_op
-      {width BW word mem locals env ext_spec varname_gen error}
-      {parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}
+      {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+      {parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
       {t} {op : Pipeline.ErrorT (API.Expr t)}
       {name : String.string}
       {insizes outsizes inlengths}
diff --git a/src/Bedrock/Field/Synthesis/New/Signature.v b/src/Bedrock/Field/Synthesis/New/Signature.v
index 0e5a567f72..dd5e21392c 100644
--- a/src/Bedrock/Field/Synthesis/New/Signature.v
+++ b/src/Bedrock/Field/Synthesis/New/Signature.v
@@ -37,8 +37,8 @@ Local Open Scope Z_scope.
 
 Section Generic.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
-   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Definition make_bedrock_func {t} insizes outsizes inlengths (res : API.Expr t)
   : func :=
     let innames := make_innames (inname_gen:=default_inname_gen) _ in
@@ -81,8 +81,8 @@ Local Hint Resolve MakeAccessSizes.bits_per_word_le_width
 
 Section WithParameters.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
-   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Context {ok : Types.ok}
           {field_parameters : FieldParameters}.
   Context (n n_bytes : nat) (weight : nat -> Z)
diff --git a/src/Bedrock/Field/Synthesis/New/UnsaturatedSolinas.v b/src/Bedrock/Field/Synthesis/New/UnsaturatedSolinas.v
index a245c75e17..8ed458b005 100644
--- a/src/Bedrock/Field/Synthesis/New/UnsaturatedSolinas.v
+++ b/src/Bedrock/Field/Synthesis/New/UnsaturatedSolinas.v
@@ -27,8 +27,8 @@ Require Import Crypto.Util.Tactics.SpecializeBy.
 Import ListNotations API.Compilers Types.Notations.
 
 Class unsaturated_solinas_ops
-  {width BW word mem locals env ext_spec varname_gen error}
-  {parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}
+  {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+  {parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
   {field_parameters : FieldParameters}
   {n s c} : Type :=
   { mul_op :
diff --git a/src/Bedrock/Field/Synthesis/New/WordByWordMontgomery.v b/src/Bedrock/Field/Synthesis/New/WordByWordMontgomery.v
index 170c39f165..f5868747a4 100644
--- a/src/Bedrock/Field/Synthesis/New/WordByWordMontgomery.v
+++ b/src/Bedrock/Field/Synthesis/New/WordByWordMontgomery.v
@@ -30,8 +30,8 @@ Import ListNotations API.Compilers Types.Notations.
 
 Class word_by_word_Montgomery_ops
   {from_mont to_mont : string}
-  {width BW word mem locals env ext_spec varname_gen error}
-  {parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}
+  {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+  {parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
   {field_parameters : FieldParameters}
   {n m} : Type :=
   { mul_op :
diff --git a/src/Bedrock/Field/Translation/Cmd.v b/src/Bedrock/Field/Translation/Cmd.v
index 9b31742bb3..38ce49e542 100644
--- a/src/Bedrock/Field/Translation/Cmd.v
+++ b/src/Bedrock/Field/Translation/Cmd.v
@@ -16,8 +16,8 @@ Import Types.Notations.
 
 Section Cmd.
   Context
-    {width BW word mem locals env ext_spec varname_gen error}
-    `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+    `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
     .
   Existing Instance Types.rep.Z.
   Existing Instance Types.rep.listZ_local. (* local list representation *)
diff --git a/src/Bedrock/Field/Translation/Expr.v b/src/Bedrock/Field/Translation/Expr.v
index 47ae06d8f8..b644762003 100644
--- a/src/Bedrock/Field/Translation/Expr.v
+++ b/src/Bedrock/Field/Translation/Expr.v
@@ -11,8 +11,8 @@ Import Types.Notations.
 
 Section Expr.
   Context
-    {width BW word mem locals env ext_spec varname_gen error}
-   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Context {ok : ok}.
   Existing Instance Types.rep.Z.
   Existing Instance Types.rep.listZ_local. (* local list representation *)
diff --git a/src/Bedrock/Field/Translation/Flatten.v b/src/Bedrock/Field/Translation/Flatten.v
index cb8fe5f20b..d976f03032 100644
--- a/src/Bedrock/Field/Translation/Flatten.v
+++ b/src/Bedrock/Field/Translation/Flatten.v
@@ -17,8 +17,8 @@ Import Types.Notations.
 
 Section Flatten.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
-   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   (* these conversions should happen before loading arguments and after
        storing return values, so they use in-memory lists *)
   Local Existing Instance rep.listZ_mem.
diff --git a/src/Bedrock/Field/Translation/Func.v b/src/Bedrock/Field/Translation/Func.v
index 738ca7983a..4dfb57a65e 100644
--- a/src/Bedrock/Field/Translation/Func.v
+++ b/src/Bedrock/Field/Translation/Func.v
@@ -15,8 +15,8 @@ Import Types.Notations.
 
 Section Func.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
-   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Existing Instance rep.Z.
 
   (* Feeds arguments to function one by one and then calls translate_cmd *)
diff --git a/src/Bedrock/Field/Translation/LoadStoreList.v b/src/Bedrock/Field/Translation/LoadStoreList.v
index aba10a1f78..36ee422413 100644
--- a/src/Bedrock/Field/Translation/LoadStoreList.v
+++ b/src/Bedrock/Field/Translation/LoadStoreList.v
@@ -28,8 +28,8 @@ Import Types.Notations.
    loading/storing part of that process. *)
 Section Lists.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
-   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Local Existing Instance rep.Z.
 
   Fixpoint extract_listnames {t}
diff --git a/src/Bedrock/Field/Translation/Proofs/Cmd.v b/src/Bedrock/Field/Translation/Proofs/Cmd.v
index c58ca036d8..2a11181ec3 100644
--- a/src/Bedrock/Field/Translation/Proofs/Cmd.v
+++ b/src/Bedrock/Field/Translation/Proofs/Cmd.v
@@ -34,9 +34,9 @@ Import Types.Notations.
 
 Section Cmd.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
     {add_carryx_funcname sub_borrowx_funcname : string}
-   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Context {ok : ok}.
 
   Local Existing Instance Types.rep.Z.
diff --git a/src/Bedrock/Field/Translation/Proofs/Equivalence.v b/src/Bedrock/Field/Translation/Proofs/Equivalence.v
index 7e39d04320..6314a4a2a7 100644
--- a/src/Bedrock/Field/Translation/Proofs/Equivalence.v
+++ b/src/Bedrock/Field/Translation/Proofs/Equivalence.v
@@ -15,9 +15,9 @@ Import Types.Notations.
 
 Section Equivalent.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
    `{parameters_sentinel : @parameters
-     width BW word mem locals env ext_spec varname_gen error}.
+     width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Local Notation parameters := (ltac:(let t := type of parameters_sentinel in exact t)) (only parsing).
   Context {listZ : rep.rep base_listZ}.
   Existing Instance rep.Z.
@@ -120,9 +120,9 @@ End Equivalent.
 (* equivalence with flat lists of words *)
 Section EquivalentFlat.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
    `{parameters_sentinel : @parameters
-     width BW word mem locals env ext_spec varname_gen error}.
+     width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Local Notation parameters := (ltac:(let t := type of parameters_sentinel in exact t)) (only parsing).
   Existing Instances rep.listZ_mem rep.Z.
 
diff --git a/src/Bedrock/Field/Translation/Proofs/EquivalenceProperties.v b/src/Bedrock/Field/Translation/Proofs/EquivalenceProperties.v
index 2496eacfff..4f2e1fe640 100644
--- a/src/Bedrock/Field/Translation/Proofs/EquivalenceProperties.v
+++ b/src/Bedrock/Field/Translation/Proofs/EquivalenceProperties.v
@@ -21,8 +21,8 @@ Import ListNotations Types.Notations.
 
 Section OnlyDiffer.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
-   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Context {ok : ok}.
   Local Existing Instance Types.rep.Z.
 
@@ -342,8 +342,8 @@ Global Hint Resolve
 
 Section ContextEquivalence.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
-   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Context {ok : ok}.
   Local Existing Instance Types.rep.Z.
 
diff --git a/src/Bedrock/Field/Translation/Proofs/Expr.v b/src/Bedrock/Field/Translation/Proofs/Expr.v
index f417463522..fe85243b8d 100644
--- a/src/Bedrock/Field/Translation/Proofs/Expr.v
+++ b/src/Bedrock/Field/Translation/Proofs/Expr.v
@@ -31,8 +31,8 @@ Import Types.Notations.
 
 Section Expr.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
-   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Context {ok : ok}.
 
   Local Existing Instance Types.rep.Z.
diff --git a/src/Bedrock/Field/Translation/Proofs/Flatten.v b/src/Bedrock/Field/Translation/Proofs/Flatten.v
index b1797c5daa..9b283041d3 100644
--- a/src/Bedrock/Field/Translation/Proofs/Flatten.v
+++ b/src/Bedrock/Field/Translation/Proofs/Flatten.v
@@ -30,8 +30,8 @@ Import Types.Notations.
 
 Section Flatten.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
-   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Context {ok : ok}.
   (* these conversions should happen before loading arguments and after
        storing return values, so they use in-memory lists *)
diff --git a/src/Bedrock/Field/Translation/Proofs/Func.v b/src/Bedrock/Field/Translation/Proofs/Func.v
index 86364aabc5..d39f4899f7 100644
--- a/src/Bedrock/Field/Translation/Proofs/Func.v
+++ b/src/Bedrock/Field/Translation/Proofs/Func.v
@@ -37,8 +37,8 @@ Import Types.Notations.
 
 Section Func.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
-   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Context {ok : ok}.
 
   Local Existing Instance rep.Z.
diff --git a/src/Bedrock/Field/Translation/Proofs/LoadStoreList.v b/src/Bedrock/Field/Translation/Proofs/LoadStoreList.v
index 8fb5e655dc..5d8c8513f7 100644
--- a/src/Bedrock/Field/Translation/Proofs/LoadStoreList.v
+++ b/src/Bedrock/Field/Translation/Proofs/LoadStoreList.v
@@ -35,8 +35,8 @@ Import Types.Notations.
 
 Section LoadStoreList.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
-   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Context {ok : ok}.
 
   Local Existing Instance rep.Z.
diff --git a/src/Bedrock/Field/Translation/Proofs/UsedVarnames.v b/src/Bedrock/Field/Translation/Proofs/UsedVarnames.v
index 8c7b93fc75..d4fbab45ca 100644
--- a/src/Bedrock/Field/Translation/Proofs/UsedVarnames.v
+++ b/src/Bedrock/Field/Translation/Proofs/UsedVarnames.v
@@ -24,8 +24,8 @@ Import ListNotations Types.Notations.
 
 Section UsedVarnames.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
-   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Context {ok : ok}.
   Local Existing Instance Types.rep.Z.
   Local Instance varname_eqb_spec x y : BoolSpec _ _ _
diff --git a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v
index f5c26ea960..d6ec00b8cf 100644
--- a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v
+++ b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v
@@ -25,8 +25,8 @@ Import Types.Notations.
 
 Section Cmd.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
-   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Context {ok : ok}.
 
   Local Existing Instance Types.rep.Z.
diff --git a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
index e511e486d3..63ec1234b0 100644
--- a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
+++ b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
@@ -23,8 +23,8 @@ Import Types.Notations.
 
 Section Expr.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
-   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Context {ok : ok}.
 
   Local Existing Instance Types.rep.Z.
diff --git a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Func.v b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Func.v
index 485765a312..8a05b3405a 100644
--- a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Func.v
+++ b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Func.v
@@ -24,8 +24,8 @@ Import Types.Notations.
 
 Section Func.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
-   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen error}.
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
+   `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Context {ok : ok }.
   Local Existing Instance Types.rep.Z.
 
diff --git a/src/Bedrock/Field/Translation/Proofs/VarnameSet.v b/src/Bedrock/Field/Translation/Proofs/VarnameSet.v
index 764bf40d44..2d314b08b0 100644
--- a/src/Bedrock/Field/Translation/Proofs/VarnameSet.v
+++ b/src/Bedrock/Field/Translation/Proofs/VarnameSet.v
@@ -8,9 +8,9 @@ Import Types.Notations.
 
 Section VarnameSet.
   Context 
-    {width BW word mem locals env ext_spec varname_gen error}
+    {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
    `{parameters_sentinel : @parameters
-     width BW word mem locals env ext_spec varname_gen error}.
+     width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Context {listZ : rep.rep base_listZ}.
   Existing Instance rep.Z.
 

From ca6c256022df534be3bd01ecf4cf61745e94d8de Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Mon, 7 Aug 2023 12:34:05 +0200
Subject: [PATCH 05/34] cmd working with add-get-carry

---
 src/Bedrock/Field/Translation/Cmd.v        |  34 +-
 src/Bedrock/Field/Translation/Proofs/Cmd.v | 404 +++++++++++++++++----
 2 files changed, 347 insertions(+), 91 deletions(-)

diff --git a/src/Bedrock/Field/Translation/Cmd.v b/src/Bedrock/Field/Translation/Cmd.v
index 38ce49e542..e2e66a5ae7 100644
--- a/src/Bedrock/Field/Translation/Cmd.v
+++ b/src/Bedrock/Field/Translation/Cmd.v
@@ -18,7 +18,6 @@ Section Cmd.
   Context
     {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
     `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
-    .
   Existing Instance Types.rep.Z.
   Existing Instance Types.rep.listZ_local. (* local list representation *)
 
@@ -182,31 +181,37 @@ Section Cmd.
    *)
 
   (* Translate 3-argument special functions. *)
-  Definition translate_ident_special3 {a b c d} (i : ident (a -> b -> c -> d)) (nextn : nat)
-    : rtype a -> rtype b -> rtype c -> option (nat * ltype d * Syntax.cmd.cmd)
+  Definition translate_ident_special3 {var a b c d} (i : ident (a -> b -> c -> d)) (nextn : nat)
+    : API.expr (var:=var) a -> API.expr b -> API.expr c -> option (nat * ltype d * Syntax.cmd.cmd)
     := match i in ident t return
-             rtype (type.domain t) ->
-             rtype (type.domain (type.codomain t)) ->
-             rtype (type.domain (type.codomain (type.codomain t))) ->
+             API.expr (type.domain t) ->
+             API.expr (type.domain (type.codomain t)) ->
+             API.expr (type.domain (type.codomain (type.codomain t))) ->
              option (nat
                      * ltype (type.codomain (type.codomain (type.codomain t)))
                      * Syntax.cmd.cmd) with
        | ident.Z_add_get_carry =>
          fun s x y =>
-           if literal_eqb s width
+           (s <- invert_expr.invert_Literal s;
+           let x := translate_expr true x in
+           let y := translate_expr true y in
+           if s =? 2 ^ width
            then
              let sum := varname_gen nextn in
              let carry := varname_gen (S nextn) in
-             Some (2%nat, (sum,carry), Syntax.cmd.call [sum;carry] add_carryx_funcname [x; y; Syntax.expr.literal 0])
-           else None
+             Some (2%nat, (sum,carry), Syntax.cmd.call [sum;carry] add_carryx [x; y; Syntax.expr.literal 0])
+           else None)%option
        | ident.Z_sub_get_borrow =>
          fun s x y =>
-           if literal_eqb s width
+           (s <- invert_expr.invert_Literal s;
+           let x := translate_expr true x in
+           let y := translate_expr true y in
+           if s =? 2 ^ width
            then
              let diff := varname_gen nextn in
              let borrow := varname_gen (S nextn) in
-             Some (2%nat, (diff, borrow), Syntax.cmd.call [diff;borrow] sub_borrowx_funcname [x; y; Syntax.expr.literal 0])
-           else None
+             Some (2%nat, (diff, borrow), Syntax.cmd.call [diff;borrow] sub_borrowx [x; y; Syntax.expr.literal 0])
+           else None)%option
        | _ => fun _ _ _ => None
        end.
 
@@ -214,10 +219,7 @@ Section Cmd.
   Definition translate_if_special3
            {t} (e : @API.expr ltype t) (nextn : nat)
     : option (nat * ltype t * Syntax.cmd.cmd)
-    := (ixyz <- invert_AppIdent3_cps e
-                                   (fun t => translate_expr true (t:=t))
-                                   (fun t => translate_expr true (t:=t))
-                                   (fun t => translate_expr true (t:=t));
+    := (ixyz <- invert_AppIdent3_cps e (fun _ x => x) (fun _ x => x) (fun _ x => x);
        let '(existT _ (i, x, y, z)) := ixyz in
        translate_ident_special3 i nextn x y z)%option.
 
diff --git a/src/Bedrock/Field/Translation/Proofs/Cmd.v b/src/Bedrock/Field/Translation/Proofs/Cmd.v
index 2a11181ec3..64c7e11881 100644
--- a/src/Bedrock/Field/Translation/Proofs/Cmd.v
+++ b/src/Bedrock/Field/Translation/Proofs/Cmd.v
@@ -5,11 +5,13 @@ Require Import Coq.Strings.String.
 Require Import bedrock2.ProgramLogic.
 Require Import bedrock2.Map.Separation.
 Require Import bedrock2.Map.SeparationLogic.
+Require Import bedrock2.WeakestPrecondition.
 Require Import bedrock2.WeakestPreconditionProperties.
 Require Import coqutil.Map.Interface.
 Require Import coqutil.Word.Interface.
 Require Import coqutil.Datatypes.List.
 Require Import coqutil.Datatypes.PropSet.
+Require Import coqutil.Z.PushPullMod.
 Require Import Crypto.Bedrock.Field.Common.Types.
 Require Import Crypto.Bedrock.Field.Common.Tactics.
 Require Import Crypto.Bedrock.Field.Common.Util.
@@ -33,9 +35,8 @@ Import Wf.Compilers.expr.
 Import Types.Notations.
 
 Section Cmd.
-  Context 
+  Context
     {width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}
-    {add_carryx_funcname sub_borrowx_funcname : string}
    `{parameters_sentinel : @parameters width BW word mem locals env ext_spec varname_gen add_carryx sub_borrowx error}.
   Context {ok : ok}.
 
@@ -98,6 +99,19 @@ Section Cmd.
                       x) y)) f)
   .
 
+  Local Instance spec_of_add_carryx : spec_of add_carryx :=
+    fnspec! add_carryx x y carry ~> sum carry_out,
+    { (* The required upper bound on `carry` isn't necessary for the
+         current `add_with_carry` to support the `ensures` clause, but
+         it does formalize an expected condition that future
+         implementations should be free to leverage. *)
+      requires t m := word.unsigned carry < 2;
+      ensures T M :=
+        M = m /\ T = t /\
+        word.unsigned sum + 2^width * word.unsigned carry_out =
+        word.unsigned x + word.unsigned carry + word.unsigned y
+    }.
+
   Lemma assign_list_correct :
     forall (rhs : base_rtype base_listZ)
            (xs : base.interp base_listZ)
@@ -319,9 +333,7 @@ Section Cmd.
         G nextn :
     valid_expr true e1 ->
     wf3 G e1 e2 e3 ->
-    translate_cmd (add_carryx_funcname:=add_carryx_funcname)
-                  (sub_borrowx_funcname:=sub_borrowx_funcname)
-                  e3 nextn = assign nextn (translate_expr true e3).
+    translate_cmd e3 nextn = assign nextn (translate_expr true e3).
   Proof.
     inversion 1; cleanup_wf; try reflexivity; intros.
     all: repeat first [ reflexivity
@@ -331,6 +343,230 @@ Section Cmd.
                         end ].
   Qed.
 
+  Lemma max_range_good : range_good (width:=width) (max_range (width:=width)) = true.
+  Proof.
+    cbv [range_good].
+    destruct (ZRange.reflect_zrange_eq (max_range (width:=width))
+                                       (max_range (width:=width))); congruence.
+  Qed.
+
+  Ltac invert_wf3_until_exposed :=
+    repeat match goal with
+           | _ => progress cleanup_wf
+           | H : wf3 _ ?x ?y _ |- _ =>
+             progress match x with
+                      | expr.App _ _ =>
+                        progress match y with
+                                 | expr.App _ _ => idtac (* already inverted *)
+                                 | _ => inversion H; clear H
+                                 end
+                        | expr.Ident _ =>
+                          progress match y with
+                                   | expr.Ident _ _ => idtac (* already inverted *)
+                                   | _ => inversion H; clear H
+                                   end
+                        | expr.Var _ =>
+                          progress match y with
+                                   | expr.Var _ _ => idtac (* already inverted *)
+                                   | _ => inversion H; clear H
+                                   end
+                      end
+           end.
+
+  Lemma valid_expr_not_special3 {t}
+        (e1 : @API.expr (fun _ => unit) t)
+        (e2 : @API.expr API.interp_type t)
+        (e3 : @API.expr ltype t) G :
+    valid_expr false e1 ->
+    wf3 G e1 e2 e3 ->
+    forall nextn, translate_if_special3 e3 nextn = None.
+  Proof.
+    induction 1; intros; invert_wf3_until_exposed; reflexivity.
+  Qed.
+
+
+  Lemma invert_App_Z_cast_Some {var} (x : @API.expr var type_Z) r :
+    invert_expr.invert_App_Z_cast
+      (expr.App (expr.App (expr.Ident ident.Z_cast)
+                          (expr.Ident (ident.Literal r)))
+                x) = Some (r, x).
+  Proof. reflexivity. Qed.
+
+  Lemma invert_App_Z_cast2_Some {var} (x : @API.expr var type_ZZ) r1 r2 :
+    invert_expr.invert_App_Z_cast2
+      (expr.App (expr.App (expr.Ident ident.Z_cast2)
+                          (expr.App (expr.App (expr.Ident ident.pair)
+                                              (expr.Ident (ident.Literal r1)))
+                                              (expr.Ident (ident.Literal r2))))
+                x) = Some (r1, r2, x).
+  Proof. reflexivity. Qed.
+
+  Lemma valid_expr_not_special_function {t}
+        (e1 : @API.expr (fun _ => unit) t)
+        (e2 : @API.expr API.interp_type t)
+        (e3 : @API.expr ltype t) G :
+    valid_expr true e1 ->
+    wf3 G e1 e2 e3 ->
+    forall nextn, translate_if_special_function e3 nextn = None.
+  Proof.
+    induction 1; intros; invert_wf3_until_exposed;
+      try reflexivity; cbv [translate_if_special_function invert_expr.invert_App_cast].
+    { rewrite invert_App_Z_cast_Some.
+      cbn. erewrite valid_expr_not_special3 by eauto. break_innermost_match; reflexivity. }
+    { rewrite invert_App_Z_cast2_Some.
+      cbn. erewrite valid_expr_not_special3 by eauto. break_innermost_match; reflexivity. }
+  Qed.
+
+  (* Convenience lemma for add_with_get_carry case. *)
+  Lemma add_get_carry_full_equiv (x y sum carry_out : @word.rep width word) r1 r2:
+    word.unsigned sum + 2^width * word.unsigned carry_out
+    = word.unsigned x + word.unsigned y ->
+    range_good (width:=width) r1 = true -> range_good (width:=width) r2 = true ->
+    PreExtra.ident.cast2
+      (r1, r2)
+      (Definitions.Z.add_get_carry_full
+         (2 ^ width) (word.unsigned x) (word.unsigned y))
+    = (word.unsigned sum, word.unsigned carry_out).
+  Proof.
+    pose proof word.width_pos. intro Heq. intros.
+    pose proof (Properties.word.unsigned_range x).
+    pose proof (Properties.word.unsigned_range y).
+    pose proof (Properties.word.unsigned_range sum).
+    pose proof (Properties.word.unsigned_range carry_out).
+    repeat lazymatch goal with
+           | H : range_good _ = true |- _ => apply range_good_eq in H; subst
+           end.
+    cbv [Definitions.Z.add_get_carry_full
+           Definitions.Z.add_with_get_carry
+           Definitions.Z.add_with_carry
+           Definitions.Z.add_get_carry
+           Definitions.Z.get_carry
+           PreExtra.ident.cast2
+           Rewriter.Util.LetIn.Let_In
+        ].
+    cbn [fst snd]. rewrite Z.log2_pow2, Z.eqb_refl by lia.
+    cbn [fst snd]. rewrite Z.add_0_l.
+    rewrite !CastLemmas.ident.cast_in_bounds by (apply is_bounded_by_bool_max_range; Z.div_mod_to_equations; nia).
+    rewrite <-Heq. apply f_equal2.
+    { Z.push_mod. rewrite Z.mod_same by lia. Z.push_pull_mod.
+      rewrite Z.mod_small; lia. }
+    { Z.div_mod_to_equations; nia. }
+  Qed.
+
+  (* Convenience lemma for add_with_get_carry case. *)
+  Lemma add_with_get_carry_full_equiv (x y sum carry_in carry_out : @word.rep width word) r1 r2:
+    word.unsigned sum + 2^width * word.unsigned carry_out
+    = word.unsigned carry_in + word.unsigned x + word.unsigned y ->
+    range_good (width:=width) r1 = true -> range_good (width:=width) r2 = true ->
+    PreExtra.ident.cast2
+      (r1, r2)
+      (Definitions.Z.add_with_get_carry_full
+         (2 ^ width) (word.unsigned carry_in) (word.unsigned x) (word.unsigned y))
+    = (word.unsigned sum, word.unsigned carry_out).
+  Proof.
+    pose proof word.width_pos. intro Heq. intros.
+    pose proof (Properties.word.unsigned_range x).
+    pose proof (Properties.word.unsigned_range y).
+    pose proof (Properties.word.unsigned_range carry_in).
+    pose proof (Properties.word.unsigned_range sum).
+    pose proof (Properties.word.unsigned_range carry_out).
+    repeat lazymatch goal with
+           | H : range_good _ = true |- _ => apply range_good_eq in H; subst
+           end.
+    cbv [Definitions.Z.add_with_get_carry_full
+           Definitions.Z.add_with_get_carry
+           Definitions.Z.add_with_carry
+           Definitions.Z.get_carry
+           PreExtra.ident.cast2
+           Rewriter.Util.LetIn.Let_In
+        ].
+    cbn [fst snd]. rewrite Z.log2_pow2, Z.eqb_refl by lia.
+    cbn [fst snd].
+    rewrite !CastLemmas.ident.cast_in_bounds by (apply is_bounded_by_bool_max_range; Z.div_mod_to_equations; nia).
+    rewrite <-Heq. apply f_equal2.
+    { Z.push_mod. rewrite Z.mod_same by lia. Z.push_pull_mod.
+      rewrite Z.mod_small; lia. }
+    { Z.div_mod_to_equations; nia. }
+  Qed.
+
+  (* TODO: move to equivalence *)
+  Lemma locally_equiv_pair l w1 w2 n1 n2 z1 z2 :
+    n1 <> n2 ->
+    word.unsigned w1 = z1 ->
+    word.unsigned w2 = z2 ->
+    locally_equivalent (t:=type_ZZ) (z1, z2)
+                       (Syntax.expr.var n1, Syntax.expr.var n2)
+                       (map.put (map.put l n1 w1) n2 w2).
+  Proof.
+    intros; repeat eexists; cbn [fst snd];
+      repeat lazymatch goal with
+               | |- context [map.putmany map.empty _] =>
+                 rewrite Properties.map.putmany_empty_l
+               | |- context [map.disjoint map.empty _] =>
+                 apply Properties.map.disjoint_empty_l
+               | H : word.unsigned _ = ?z |- word.unsigned _ = ?z => exact H
+               | |- context [map.get (map.put _ ?k _) ?k] =>
+                 rewrite map.get_put_same
+               | |- context [map.get (map.put _ _ _) _] =>
+                 rewrite map.get_put_diff by congruence
+               | _ => reflexivity
+             end.
+  Qed.
+
+  Lemma invert_Literal_Some {var t} (x : Compilers.base_interp t) :
+    invert_expr.invert_Literal (var:=var) (expr.Ident (ident.Literal x)) = Some x.
+  Proof. reflexivity. Qed.
+
+  Lemma invert_AppIdent3_Some {Q R S a b c d var} (i : ident (a -> b -> c -> d))
+        (x : expr a) (y : expr b) (z : expr c)
+        (f1 : forall t x, Q t)
+        (f2 : forall t x, R t)
+        (f3 : forall t x, S t) :
+    invert_AppIdent3_cps (var:=var) (expr.App (expr.App (expr.App (expr.Ident i) x) y) z) f1 f2 f3
+    = Some (existT _ (a, b, c) (i, f1 _ x, f2 _ y, f3 _ z)).
+  Proof. reflexivity. Qed.
+
+  Lemma translate_add_get_carry nextn (x y : API.expr type_Z) r1 r2 :
+    range_good (width:=width) r1 = true ->
+    range_good (width:=width) r2 = true ->
+    let sum := varname_gen nextn in
+    let carry := varname_gen (S nextn) in
+    translate_if_special_function
+      (expr.App
+         (expr.App (expr.Ident ident.Z_cast2)
+                   (expr.App
+                      (expr.App
+                         (expr.Ident ident.pair)
+                         (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
+                      (expr.Ident (ident.Literal (t:=base.type.zrange) r2))))
+         (expr.App
+            (expr.App
+               (expr.App (expr.Ident ident.Z_add_get_carry)
+                         (expr.Ident (ident.Literal (t:=base.type.Z) (2 ^ width))))
+               x) y)) nextn
+    = Some (2%nat, (sum,carry), Syntax.cmd.call [sum;carry] add_carryx [(translate_expr true x); (translate_expr true y); Syntax.expr.literal 0]).
+  Proof.
+    cbv [translate_if_special_function]; intros.
+    repeat lazymatch goal with H : range_good ?r = true |- _ => apply range_good_eq in H; subst end.
+    cbn [invert_expr.invert_App_cast
+           invert_expr.invert_App_Z_cast2
+           invert_expr.invert_App invert_expr.invert_App_cps].
+    lazymatch goal with
+      |- context [invert_expr.invert_Z_cast2 ?x] =>
+      replace (invert_expr.invert_Z_cast2 x) with
+        (Some (max_range (width:=width), max_range (width:=width)))
+        by reflexivity
+    end.
+    cbn [Crypto.Util.Option.bind fst snd range_type_good range_base_good].
+    rewrite !max_range_good. cbn [andb].
+    cbv [translate_if_special3]. rewrite invert_AppIdent3_Some.
+    cbn [Crypto.Util.Option.bind fst snd].
+    cbv [translate_ident_special3].
+    cbn [type.domain]. rewrite invert_Literal_Some.
+    cbn [Crypto.Util.Option.bind fst snd].
+    rewrite Z.eqb_refl. reflexivity.
+  Qed.
+
   Local Ltac simplify :=
     repeat
       first [ progress (intros; cleanup)
@@ -410,12 +646,12 @@ Section Cmd.
     forall functions
            (locals : locals)
            (nextn : nat),
+      (* specifications of bedrock2 functions we might call *)
+      spec_of_add_carryx functions ->
       (* ret := fiat-crypto interpretation of e2 *)
       let ret1 : API.interp_type t := API.interp e2 in
       (* out := translation output for e3 *)
-      let out := translate_cmd (add_carryx_funcname:=add_carryx_funcname)
-                               (sub_borrowx_funcname:=sub_borrowx_funcname)
-                               e3 nextn in
+      let out := translate_cmd e3 nextn in
       let nvars := fst (fst out) in
       let ret2 := rtype_of_ltype _ (snd (fst out)) in
       let body := snd out in
@@ -427,8 +663,7 @@ Section Cmd.
       (forall n nvars,
           (nextn <= n)%nat ->
           map.undef_on locals (used_varnames(varname_gen:=varname_gen) n nvars)) ->
-      forall tr
-             (mem : mem),
+      forall tr (mem : mem),
         (* contexts are equivalent; for every variable in the context list G,
              the fiat-crypto and bedrock2 results match *)
         context_equiv G locals ->
@@ -468,10 +703,10 @@ Section Cmd.
 
     (* simplify goals *)
     all:repeat match goal with
-               | H : range_good ?r = true |- _ => rewrite range_good_eq in H; subst
                | _ => progress (intros; cleanup)
                | _ => progress cbv [Rewriter.Util.LetIn.Let_In] in *
                | _ => erewrite translate_cmd_valid_expr by eauto
+               | _ => erewrite valid_expr_not_special_function by eauto
                | _ => progress cbn [translate_cmd expr.interp type.app_curried
                                                   WeakestPrecondition.cmd
                                                   WeakestPrecondition.cmd_body] in *
@@ -483,7 +718,6 @@ Section Cmd.
                end.
 
     { (* let-in (product of base types) *)
-      admit. (*
       eapply Proper_cmd; [ eapply Proper_call | repeat intro | ].
       2: {
         eapply IHe1_valid; clear IHe1_valid;
@@ -499,10 +733,7 @@ Section Cmd.
         apply used_varnames_disjoint; lia. }
       { simplify; subst; eauto; only_differ_ok.
         etransitivity; [ eassumption | ].
-        apply used_varnames_shift. } *) }
-    { (* let-in (base type) *)
-      admit.
-      (*
+        apply used_varnames_shift. } }
       eapply Proper_cmd; [ eapply Proper_call | repeat intro | ].
       2: {
         eapply IHe1_valid; clear IHe1_valid;
@@ -518,7 +749,7 @@ Section Cmd.
         apply used_varnames_disjoint; lia. }
       { simplify; subst; eauto; only_differ_ok.
         etransitivity; [ eassumption | ].
-        apply used_varnames_shift. } } *) }
+        apply used_varnames_shift. }
     { (* cons *)
       eapply Proper_cmd; [ eapply Proper_call | repeat intro | ].
       2: {
@@ -567,67 +798,90 @@ Section Cmd.
       match goal with H : PropSet.sameset _ _ |- _ =>
                       rewrite H end; reflexivity. }
     { (* add_get_carry *)
+      rewrite translate_add_get_carry by auto. cbn [fst snd].
+      cbn [WeakestPrecondition.cmd WeakestPrecondition.cmd_body].
+      repeat lazymatch goal with
+             | H : valid_expr _ ?e |- _ =>
+               lazymatch goal with
+               | Hwf : wf3 ?G e ?e2 ?e3 |- _ =>
+                 let Htr := fresh in
+                 pose proof translate_expr_correct e e2 e3 ltac:(eassumption) G _ Hwf ltac:(eassumption) as Htr;
+                   destruct Htr; sepsimpl
+               end;
+                 clear H
+             end.
+      eexists; split; [ | ].
+      { (* Argument expressions. *)
+        repeat lazymatch goal with
+               | |- dexprs _ _ (_ :: _) _ => apply dexprs_cons_iff; split
+               | H : dexpr map.empty ?l ?x _ |- WeakestPrecondition.expr ?m ?l ?x _ =>
+                 apply expr_empty; apply H
+               | _ => reflexivity
+               end. }
+      straightline_call; [ rewrite Properties.word.unsigned_of_Z_0; lia | ].
+      sepsimpl; subst; cleanup.
+      eexists; split; [ reflexivity | ].
       eapply Proper_cmd; [ eapply Proper_call | repeat intro | ].
       2:{
-        lazymatch goal with
-          |- context [translate_if_special_function ?x ?n] =>
-          remember (translate_if_special_function (add_carryx_funcname:=add_carryx_funcname)
-                                              (sub_borrowx_funcname:=sub_borrowx_funcname)
-                                              x n) as X eqn:HX
-        end.
-        cbv [translate_if_special_function] in HX.
-        cbv [invert_expr.invert_App_cast invert_expr.invert_App_Z_cast2 invert_expr.invert_App invert_expr.invert_App_cps] in HX.
-        lazymatch type of HX with context [invert_expr.invert_Z_cast2 ?x] => pose x as z end.
-        Search range_good.
-        Print range_good.
-        vm_compute in z.
-        cbn in X.
-        cbv [
-            translate_if_special_function
-              invert_expr.invert_App_cast
-              invert_expr.invert_App_Z_cast
-              invert_expr.invert_App_Z_cast2
-              invert_expr.invert_Z_cast2
-              invert_expr.invert_App
-              invert_expr.invert_Ident
-              invert_expr.invert_AppIdent
-              invert_expr.invert_AppIdent_cps
-              invert_expr.invert_AppIdent2_cps
-              invert_expr.invert_App_cps
-              invert_expr.invert_App2_cps
-              invert_expr.invert_Literal
-              invert_expr.invert_pair
-              invert_expr.invert_pair_cps
-              invert_expr.is_pair
-              invert_expr.reflect_smart_Literal
-              Option.bind
-              Crypto.Util.Option.bind
-          ] in X.
-        clear IHe1_valid.
-        cbv [Option.bind Crypto.Util.Option.bind].
-        eapply IHe1_valid with (G:=G); clear IHe1_valid;
-        repeat match goal with
-               | _ => progress (intros; cleanup)
-               | H : _ |- _ => solve [apply H]
-               | _ => solve [new_context_ok]
-               | _ => congruence
-               end; [ ].
-        eapply only_differ_disjoint_undef_on; eauto with lia; [ ].
-        match goal with H : PropSet.sameset _ _ |- _ => rewrite H end.
-        apply used_varnames_disjoint. lia. }
-        cbn.
-        cbn [translate_expr].
+        eapply IHe1_valid; clear IHe1_valid;
         repeat match goal with
                | _ => progress (intros; cleanup)
-               | H : _ |- _ => solve [apply H]
-               | _ => solve [new_context_ok]
-               | _ => congruence
-               end; [ ].
-        eapply only_differ_disjoint_undef_on; eauto with lia; [ ].
-        match goal with H : PropSet.sameset _ _ |- _ =>
-                        rewrite H end.
-        apply used_varnames_disjoint; lia. 
-        
-      }
+               | H : forall v1 v2 v3, wf3 _ (?f v1) _ _ |- wf3 _ (?f tt) _ _ => solve [apply (H tt)]
+               | H : ?P |- ?P => exact H
+               end; [ | | ].
+        { (* context varname_set *)
+          new_context_ok.
+          lazymatch goal with
+          | H : rep.varname_set _ _ \/ rep.varname_set _ _ |- _ =>
+            cbn  in H; destruct H as [H | H]; apply varname_gen_unique in H; lia
+          end. }
+        { (* undef on *)
+          repeat lazymatch goal with
+                 | |- map.undef_on (map.put _ _ _) _ => apply put_undef_on
+                 | H : forall n nvars, _ -> map.undef_on ?l (used_varnames n nvars)
+                                  |- map.undef_on ?l (used_varnames _ _) =>
+                   apply H; lia
+                 | |- ~ used_varnames _ _ _ => rewrite used_varnames_iff; intro; simplify
+                 | H : varname_gen _ = varname_gen _ |- _ => apply varname_gen_unique in H; lia
+                 end. }
+        { (* context equivalent *)
+          apply Forall_cons;
+            [ apply locally_equiv_pair; eauto; rewrite varname_gen_unique; lia | ].
+          eapply equivalent_not_in_context_forall; eauto;
+            repeat lazymatch goal with
+                   | |- map.only_differ (map.put _ _ _) _ _ =>
+                     eapply only_differ_trans; [ | solve [apply only_differ_put] ]
+                   | |- map.only_differ ?m _ ?m => solve [apply only_differ_empty]
+                   | |- map.only_differ _ _ (map.put _ _ _) =>
+                     apply only_differ_sym
+                   | |- disjoint (union _ _) _ =>
+                     apply disjoint_union_l_iff; split
+                   | |- disjoint empty_set _ =>
+                     solve [apply disjoint_empty_l]
+                   | |- disjoint (singleton_set _) _ =>
+                     symmetry; apply disjoint_singleton_r_iff
+                   | _ => solve [eauto with lia]
+                   end. } }
+      clear IHe1_valid.
+      simplify; subst; eauto; [ | | ].
+      { (* varnames subset *)
+        rewrite <-used_varnames_shift; eauto. }
+      { (* only_differ *)
+        only_differ_ok.
+        eauto using only_differ_succ, only_differ_zero. }
+      { (* equivalence of output holds *)
+        lazymatch goal with
+        | H : equivalent_base ?x1 ?y ?a ?l ?m |- equivalent_base ?x2 ?y ?a ?l ?m =>
+          replace x2 with x1; [ exact H | ]
+        end.
+        lazymatch goal with
+          | H : context [word.unsigned (word.of_Z 0)] |- _ =>
+            rewrite Properties.word.unsigned_of_Z_0 in H
+        end.
+        repeat lazymatch goal with
+               | H : word.unsigned _ = expr.interp ?iinterp ?x |- context [expr.interp ?iinterp ?x] =>
+                 rewrite <-H
+               end.
+        erewrite add_get_carry_full_equiv; eauto with lia. } }
   Qed.
 End Cmd.

From e640bb7306f13cded69727fd566830de4458138c Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Tue, 8 Aug 2023 09:04:48 +0200
Subject: [PATCH 06/34] wip, about to start on expr

---
 src/Bedrock/Field/Translation/Cmd.v        | 130 +++++++------
 src/Bedrock/Field/Translation/Proofs/Cmd.v | 216 +++++++++++++++++++--
 2 files changed, 274 insertions(+), 72 deletions(-)

diff --git a/src/Bedrock/Field/Translation/Cmd.v b/src/Bedrock/Field/Translation/Cmd.v
index e2e66a5ae7..545bd6f1cc 100644
--- a/src/Bedrock/Field/Translation/Cmd.v
+++ b/src/Bedrock/Field/Translation/Cmd.v
@@ -120,66 +120,6 @@ Section Cmd.
       let '(existT t12 (f, x1, x2)) := e in
       Some (existT _ (t12, t3, t4) (f, x1, x2, x3, x4)))%option.
 
-  Check translate_expr.
-  (* End of day braindump:
-
-     - current prototype is probably shortest path to something that works for 3-4 functions
-     - downsides: breaks abstraction a bit to handle the details of casts etc. at the Cmd level
-     - general work to do:
-       - adapt valid_cmd to special-case the set of separate functions with their casts
-       - create specs for them and fix proofs
-       - adapt the computable version of valid_cmd to match and fix equivalence proof
-       - add 4-argument functions
-       - adjust pipeline args in Defaults.v as needed
-
-    Alternatives:
-      1. Unify translate_expr and translate_cmd layers
-         - Cmd handles variable naming and list/tuple assembly
-         - variable naming uses a counter -> introduces state for rec calls
-         - Expr handles most complicated logic; having no rec state is nice
-      2. Make translate_expr return Syntax.cmd.cmd but not handle the counter
-         - have translate_cmd look ahead to see if the expression is a special function
-         - if so, translate_cmd passes enough variable names to translate_expr to bind result
-         - translate_expr fails if wrong number of names
-         - downsides: extra argument to trace through translate_expr, proof complexity
-
-
-    Example add_get_carry occurrence for reference:
-
-                    (eApp
-                      (eApp (eIdent Compilers.ident_Z_cast2)
-                         (eApp
-                            (eApp (eIdent Compilers.ident_pair)
-                               (eIdent
-                                  (Compilers.ident_Literal
-                                     {| ZRange.lower := 0; ZRange.upper := 4294967295 |})))
-                            (eIdent (Compilers.ident_Literal {| ZRange.lower := 0; ZRange.upper := 1 |}))))
-                      (eApp
-                         (eApp
-                            (eApp (eIdent Compilers.ident_Z_add_get_carry)
-                               (eIdent (Compilers.ident_Literal 4294967296%Z)))
-                            (eApp
-                               (eApp (eIdent Compilers.ident_Z_cast)
-                                  (eIdent
-                                     (Compilers.ident_Literal
-                                        {| ZRange.lower := 0; ZRange.upper := 4294967295 |})))
-                               (eApp
-                                  (eApp
-                                     (eApp (eIdent Compilers.ident_List_nth_default)
-                                        (eIdent (Compilers.ident_Literal 0%Z))) 
-                                     (eVar x0)) (eIdent (Compilers.ident_Literal 0)))))
-                         (eApp
-                            (eApp (eIdent Compilers.ident_Z_cast)
-                               (eIdent
-                                  (Compilers.ident_Literal
-                                     {| ZRange.lower := 0; ZRange.upper := 4294967295 |})))
-                            (eApp
-                               (eApp
-                                  (eApp (eIdent Compilers.ident_List_nth_default)
-                                     (eIdent (Compilers.ident_Literal 0%Z))) (eVar x1))
-                               (eIdent (Compilers.ident_Literal 0))))))
-   *)
-
   (* Translate 3-argument special functions. *)
   Definition translate_ident_special3 {var a b c d} (i : ident (a -> b -> c -> d)) (nextn : nat)
     : API.expr (var:=var) a -> API.expr b -> API.expr c -> option (nat * ltype d * Syntax.cmd.cmd)
@@ -215,6 +155,63 @@ Section Cmd.
        | _ => fun _ _ _ => None
        end.
 
+  (* This is based on `translate_cast_exempt` from Expr.v *)
+  Definition translate_carry {t} (e : @API.expr ltype t) : rtype t :=
+    match e in expr.expr t0 return rtype t0 with
+    | expr.Ident type_Z (ident.Literal base.type.Z z) =>
+      if ZRange.is_bounded_by_bool z {| ZRange.lower := 0; ZRange.upper := 1 |}
+      then Syntax.expr.literal z
+      else make_error _
+    | expr.Var type_Z x => Syntax.expr.var x
+    | _ => make_error _
+    end.
+
+  (* Translate 4-argument special functions. *)
+  Definition translate_ident_special4 {var a b c d e} (i : ident (a -> b -> c -> d -> e)) (nextn : nat)
+    : API.expr (var:=var) a -> API.expr b -> API.expr c -> API.expr d -> option (nat * ltype e * Syntax.cmd.cmd)
+    := match i in ident t return
+             API.expr (type.domain t) ->
+             API.expr (type.domain (type.codomain t)) ->
+             API.expr (type.domain (type.codomain (type.codomain t))) ->
+             API.expr (type.domain (type.codomain (type.codomain (type.codomain t)))) ->
+             option (nat
+                     * ltype (type.codomain (type.codomain (type.codomain (type.codomain t))))
+                     * Syntax.cmd.cmd) with
+       | ident.Z_add_with_get_carry =>
+         fun s c x y =>
+           (s <- invert_expr.invert_Literal s;
+           rc <- invert_expr.invert_App_Z_cast c;
+           if ((ZRange.lower (fst rc) =? 0) && (ZRange.upper (fst rc) =? 1))%bool
+           then
+             if s =? 2 ^ width
+             then
+               let c := translate_carry (snd rc) in
+               let x := translate_expr true x in
+               let y := translate_expr true y in
+               let sum := varname_gen nextn in
+               let carry := varname_gen (S nextn) in
+               Some (2%nat, (sum,carry), Syntax.cmd.call [sum;carry] add_carryx [x; y; c])
+             else None
+           else None)%option
+       | ident.Z_sub_with_get_borrow =>
+         fun s b x y =>
+           (s <- invert_expr.invert_Literal s;
+           rb <- invert_expr.invert_App_Z_cast b;
+           if ((ZRange.lower (fst rb) =? 0) && (ZRange.upper (fst rb) =? 1))%bool
+           then
+             if s =? 2 ^ width
+             then
+               let b := translate_carry (snd rb) in
+               let x := translate_expr true x in
+               let y := translate_expr true y in
+               let diff := varname_gen nextn in
+               let borrow := varname_gen (S nextn) in
+               Some (2%nat, (diff, borrow), Syntax.cmd.call [diff;borrow] sub_borrowx [x; y; b])
+             else None
+           else None)%option
+       | _ => fun _ _ _ _ => None
+       end.
+
   (* Translates 3-argument special operations or returns None. *)
   Definition translate_if_special3
            {t} (e : @API.expr ltype t) (nextn : nat)
@@ -223,6 +220,14 @@ Section Cmd.
        let '(existT _ (i, x, y, z)) := ixyz in
        translate_ident_special3 i nextn x y z)%option.
 
+  (* Translates 4-argument special operations or returns None. *)
+  Definition translate_if_special4
+           {t} (e : @API.expr ltype t) (nextn : nat)
+    : option (nat * ltype t * Syntax.cmd.cmd)
+    := (iwxyz <- invert_AppIdent4_cps e (fun _ x => x) (fun _ x => x) (fun _ x => x) (fun _ x => x);
+       let '(existT _ (i, w, x, y, z)) := iwxyz in
+       translate_ident_special4 i nextn w x y z)%option.
+
   Fixpoint range_base_good {t} : Language.Compilers.base.interp (fun _ => ZRange.zrange) t -> bool :=
     match t as t0 return Language.Compilers.base.interp (base:=Compilers.base) (fun _ => ZRange.zrange) t0 -> bool with
     | base.type.type_base t => range_good (width:=width)
@@ -244,7 +249,10 @@ Section Cmd.
     if range_type_good (fst rx)
     then
       (* Translate the rest of the function. *)
-      translate_if_special3 (snd rx) nextn
+      match translate_if_special3 (snd rx) nextn with
+      | Some res => Some res
+      | None => translate_if_special4 (snd rx) nextn
+      end
     else None)%option.
 
   Fixpoint translate_cmd
diff --git a/src/Bedrock/Field/Translation/Proofs/Cmd.v b/src/Bedrock/Field/Translation/Proofs/Cmd.v
index 64c7e11881..e08b13dbbd 100644
--- a/src/Bedrock/Field/Translation/Proofs/Cmd.v
+++ b/src/Bedrock/Field/Translation/Proofs/Cmd.v
@@ -97,6 +97,36 @@ Section Cmd.
                       (expr.App (expr.Ident ident.Z_add_get_carry)
                                 (expr.Ident (ident.Literal (t:=base.type.Z) s)))
                       x) y)) f)
+  | valid_add_with_get_carry :
+      forall t rc r1 r2 (s : Z) c x y f,
+        range_good (width:=width) r1 = true ->
+        range_good (width:=width) r2 = true ->
+        ZRange.lower rc = 0 ->
+        ZRange.upper rc = 1 ->
+        s = 2 ^ width ->
+        valid_expr false c ->
+        valid_expr true x ->
+        valid_expr true y ->
+        valid_cmd (f tt) ->
+        valid_cmd
+          (expr.LetIn
+             (B:=type.base t)
+             (expr.App
+                (expr.App (expr.Ident ident.Z_cast2)
+                          (expr.App
+                             (expr.App
+                                (expr.Ident ident.pair)
+                                (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
+                             (expr.Ident (ident.Literal (t:=base.type.zrange) r2))))
+                (expr.App
+                   (expr.App
+                      (expr.App
+                         (expr.App (expr.Ident ident.Z_add_with_get_carry)
+                                   (expr.Ident (ident.Literal (t:=base.type.Z) s)))
+                         (expr.App (expr.App (expr.Ident ident.Z_cast)
+                                             (expr.Ident (ident.Literal (t:=base.type.zrange) rc)))
+                                   c))
+                      x) y)) f)
   .
 
   Local Instance spec_of_add_carryx : spec_of add_carryx :=
@@ -384,6 +414,16 @@ Section Cmd.
     induction 1; intros; invert_wf3_until_exposed; reflexivity.
   Qed.
 
+  Lemma valid_expr_not_special4 {t}
+        (e1 : @API.expr (fun _ => unit) t)
+        (e2 : @API.expr API.interp_type t)
+        (e3 : @API.expr ltype t) G :
+    valid_expr false e1 ->
+    wf3 G e1 e2 e3 ->
+    forall nextn, translate_if_special4 e3 nextn = None.
+  Proof.
+    induction 1; intros; invert_wf3_until_exposed; reflexivity.
+  Qed.
 
   Lemma invert_App_Z_cast_Some {var} (x : @API.expr var type_Z) r :
     invert_expr.invert_App_Z_cast
@@ -412,9 +452,11 @@ Section Cmd.
     induction 1; intros; invert_wf3_until_exposed;
       try reflexivity; cbv [translate_if_special_function invert_expr.invert_App_cast].
     { rewrite invert_App_Z_cast_Some.
-      cbn. erewrite valid_expr_not_special3 by eauto. break_innermost_match; reflexivity. }
+      cbn. erewrite valid_expr_not_special3, valid_expr_not_special4 by eauto.
+      break_innermost_match; reflexivity. }
     { rewrite invert_App_Z_cast2_Some.
-      cbn. erewrite valid_expr_not_special3 by eauto. break_innermost_match; reflexivity. }
+      cbn. erewrite valid_expr_not_special3, valid_expr_not_special4 by eauto.
+      break_innermost_match; reflexivity. }
   Qed.
 
   (* Convenience lemma for add_with_get_carry case. *)
@@ -526,6 +568,18 @@ Section Cmd.
     = Some (existT _ (a, b, c) (i, f1 _ x, f2 _ y, f3 _ z)).
   Proof. reflexivity. Qed.
 
+  Lemma invert_AppIdent4_Some {P Q R S a b c d e var} (i : ident (a -> b -> c -> d -> e))
+        (w : expr a) (x : expr b) (y : expr c) (z : expr d)
+        (f1 : forall t x, P t)
+        (f2 : forall t x, Q t)
+        (f3 : forall t x, R t)
+        (f4 : forall t x, S t) :
+    invert_AppIdent4_cps (var:=var)
+                         (expr.App (expr.App (expr.App (expr.App (expr.Ident i) w) x) y) z)
+                         f1 f2 f3 f4
+    = Some (existT _ (a, b, c, d) (i, f1 _ w, f2 _ x, f3 _ y, f4 _ z)).
+  Proof. reflexivity. Qed.
+
   Lemma translate_add_get_carry nextn (x y : API.expr type_Z) r1 r2 :
     range_good (width:=width) r1 = true ->
     range_good (width:=width) r2 = true ->
@@ -548,15 +602,8 @@ Section Cmd.
   Proof.
     cbv [translate_if_special_function]; intros.
     repeat lazymatch goal with H : range_good ?r = true |- _ => apply range_good_eq in H; subst end.
-    cbn [invert_expr.invert_App_cast
-           invert_expr.invert_App_Z_cast2
-           invert_expr.invert_App invert_expr.invert_App_cps].
-    lazymatch goal with
-      |- context [invert_expr.invert_Z_cast2 ?x] =>
-      replace (invert_expr.invert_Z_cast2 x) with
-        (Some (max_range (width:=width), max_range (width:=width)))
-        by reflexivity
-    end.
+    cbn [invert_expr.invert_App_cast].
+    rewrite invert_App_Z_cast2_Some.
     cbn [Crypto.Util.Option.bind fst snd range_type_good range_base_good].
     rewrite !max_range_good. cbn [andb].
     cbv [translate_if_special3]. rewrite invert_AppIdent3_Some.
@@ -567,6 +614,61 @@ Section Cmd.
     rewrite Z.eqb_refl. reflexivity.
   Qed.
 
+  Lemma translate_add_with_get_carry nextn (c x y : API.expr type_Z) rc r1 r2 :
+    range_good (width:=width) r1 = true ->
+    range_good (width:=width) r2 = true ->
+    ZRange.lower rc = 0 ->
+    ZRange.upper rc = 1 ->
+    let sum := varname_gen nextn in
+    let carry := varname_gen (S nextn) in
+    translate_if_special_function
+      (expr.App
+         (expr.App (expr.Ident ident.Z_cast2)
+                   (expr.App
+                      (expr.App
+                         (expr.Ident ident.pair)
+                         (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
+                      (expr.Ident (ident.Literal (t:=base.type.zrange) r2))))
+         (expr.App
+            (expr.App
+               (expr.App
+                  (expr.App (expr.Ident ident.Z_add_with_get_carry)
+                            (expr.Ident (ident.Literal (t:=base.type.Z) (2 ^ width))))
+                  (expr.App (expr.App (expr.Ident ident.Z_cast)
+                                      (expr.Ident (ident.Literal (t:=base.type.zrange) rc)))
+                            c))
+                  x) y)) nextn
+    = Some (2%nat, (sum,carry), Syntax.cmd.call [sum;carry] add_carryx [(translate_expr true x); (translate_expr true y); translate_expr false c]).
+  Proof.
+    cbv [translate_if_special_function]; intros.
+    repeat lazymatch goal with H : range_good ?r = true |- _ => apply range_good_eq in H; subst end.
+    cbn [invert_expr.invert_App_cast].
+    rewrite invert_App_Z_cast2_Some.
+    cbn [Crypto.Util.Option.bind fst snd range_type_good range_base_good].
+    rewrite !max_range_good. cbn [andb].
+    lazymatch goal with
+    | |- context [translate_if_special3 ?x ?n] =>
+      lazymatch type of x with
+      | API.expr ?t =>
+        change (translate_if_special3 x n) with (@None (nat * ltype t * Syntax.cmd.cmd))
+      end
+    end.
+    cbn iota. cbv [translate_if_special4].
+    rewrite invert_AppIdent4_Some.
+    cbn [Crypto.Util.Option.bind fst snd].
+    cbv [translate_ident_special4].
+    rewrite invert_App_Z_cast_Some.
+    cbn [Crypto.Util.Option.bind fst snd].
+    cbn [type.domain]. rewrite invert_Literal_Some.
+    cbn [Crypto.Util.Option.bind fst snd].
+    repeat lazymatch goal with
+           | H : ZRange.upper ?r = _ |- context [ZRange.upper ?r] => rewrite H
+           | H : ZRange.lower ?r = _ |- context [ZRange.lower ?r] => rewrite H
+           end.
+    rewrite !Z.eqb_refl. cbn [andb].
+    reflexivity.
+  Qed.
+
   Local Ltac simplify :=
     repeat
       first [ progress (intros; cleanup)
@@ -883,5 +985,97 @@ Section Cmd.
                  rewrite <-H
                end.
         erewrite add_get_carry_full_equiv; eauto with lia. } }
+    { (* add_with_get_carry *)
+      rewrite translate_add_with_get_carry by auto. cbn [fst snd].
+      cbn [WeakestPrecondition.cmd WeakestPrecondition.cmd_body].
+      Check translate_expr_correct.
+      Check translate_expr_correct'.
+      repeat lazymatch goal with
+             | H : valid_expr ?require_cast ?e |- _ =>
+               lazymatch goal with
+               | Hwf : wf3 ?G e ?e2 ?e3 |- _ =>
+                 let Htr := fresh in
+                 pose proof translate_expr_correct' e e2 e3 require_cast ltac:(eassumption) G _ Hwf ltac:(eassumption) as Htr; cbn iota in Htr; simplify
+               end;
+                 clear H
+             | H : Lift1Prop.ex1 _ _ |- _ => destruct H
+             | H : emp _ _ |- _ => destruct H; cleanup
+             end.
+      cbn [locally_equivalent_nobounds locally_equivalent_nobounds_base] in *.
+      eexists; split; [ | ].
+      { (* Argument expressions. *)
+        repeat lazymatch goal with
+               | |- dexprs _ _ (_ :: _) _ => apply dexprs_cons_iff; split
+               | H : dexpr map.empty ?l ?x _ |- WeakestPrecondition.expr ?m ?l ?x _ =>
+                 apply expr_empty; apply H
+               | _ => reflexivity
+               end. }
+      straightline_call.
+      {
+          }
+      sepsimpl; subst; cleanup.
+      eexists; split; [ reflexivity | ].
+      eapply Proper_cmd; [ eapply Proper_call | repeat intro | ].
+      2:{
+        eapply IHe1_valid; clear IHe1_valid;
+        repeat match goal with
+               | _ => progress (intros; cleanup)
+               | H : forall v1 v2 v3, wf3 _ (?f v1) _ _ |- wf3 _ (?f tt) _ _ => solve [apply (H tt)]
+               | H : ?P |- ?P => exact H
+               end; [ | | ].
+        { (* context varname_set *)
+          new_context_ok.
+          lazymatch goal with
+          | H : rep.varname_set _ _ \/ rep.varname_set _ _ |- _ =>
+            cbn  in H; destruct H as [H | H]; apply varname_gen_unique in H; lia
+          end. }
+        { (* undef on *)
+          repeat lazymatch goal with
+                 | |- map.undef_on (map.put _ _ _) _ => apply put_undef_on
+                 | H : forall n nvars, _ -> map.undef_on ?l (used_varnames n nvars)
+                                  |- map.undef_on ?l (used_varnames _ _) =>
+                   apply H; lia
+                 | |- ~ used_varnames _ _ _ => rewrite used_varnames_iff; intro; simplify
+                 | H : varname_gen _ = varname_gen _ |- _ => apply varname_gen_unique in H; lia
+                 end. }
+        { (* context equivalent *)
+          apply Forall_cons;
+            [ apply locally_equiv_pair; eauto; rewrite varname_gen_unique; lia | ].
+          eapply equivalent_not_in_context_forall; eauto;
+            repeat lazymatch goal with
+                   | |- map.only_differ (map.put _ _ _) _ _ =>
+                     eapply only_differ_trans; [ | solve [apply only_differ_put] ]
+                   | |- map.only_differ ?m _ ?m => solve [apply only_differ_empty]
+                   | |- map.only_differ _ _ (map.put _ _ _) =>
+                     apply only_differ_sym
+                   | |- disjoint (union _ _) _ =>
+                     apply disjoint_union_l_iff; split
+                   | |- disjoint empty_set _ =>
+                     solve [apply disjoint_empty_l]
+                   | |- disjoint (singleton_set _) _ =>
+                     symmetry; apply disjoint_singleton_r_iff
+                   | _ => solve [eauto with lia]
+                   end. } }
+      clear IHe1_valid.
+      simplify; subst; eauto; [ | | ].
+      { (* varnames subset *)
+        rewrite <-used_varnames_shift; eauto. }
+      { (* only_differ *)
+        only_differ_ok.
+        eauto using only_differ_succ, only_differ_zero. }
+      { (* equivalence of output holds *)
+        lazymatch goal with
+        | H : equivalent_base ?x1 ?y ?a ?l ?m |- equivalent_base ?x2 ?y ?a ?l ?m =>
+          replace x2 with x1; [ exact H | ]
+        end.
+        lazymatch goal with
+          | H : context [word.unsigned (word.of_Z 0)] |- _ =>
+            rewrite Properties.word.unsigned_of_Z_0 in H
+        end.
+        repeat lazymatch goal with
+               | H : word.unsigned _ = expr.interp ?iinterp ?x |- context [expr.interp ?iinterp ?x] =>
+                 rewrite <-H
+               end.
+        erewrite add_get_carry_full_equiv; eauto with lia. } }
   Qed.
 End Cmd.

From 93324271f4e7ccf500fb82f6f967755d0df9547a Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Thu, 10 Aug 2023 11:42:15 +0200
Subject: [PATCH 07/34] wip, command proof was working before change to fun
 nextn =>

---
 p224.txt                                   | 231 +++++++++++++++++++++
 src/Bedrock/Field/Translation/Cmd.v        |  87 ++++----
 src/Bedrock/Field/Translation/Proofs/Cmd.v |  76 +++++--
 3 files changed, 335 insertions(+), 59 deletions(-)
 create mode 100644 p224.txt

diff --git a/p224.txt b/p224.txt
new file mode 100644
index 0000000000..8d30a8d340
--- /dev/null
+++ b/p224.txt
@@ -0,0 +1,231 @@
+make --no-print-directory -C rewriter
+make --no-print-directory -C rupicola/bedrock2/deps/coqutil
+make --no-print-directory -C coqprime src/Coqprime/PrimalityTest/Zp.vo src/Coqprime/PrimalityTest/PocklingtonCertificat.vo
+Generating Makefile.coq.test
+make -f Makefile.coq.test
+make[1]: 'src/Coqprime/PrimalityTest/Zp.vo' is up to date.
+make[1]: 'src/Coqprime/PrimalityTest/PocklingtonCertificat.vo' is up to date.
+make[3]: Nothing to be done for 'real-all'.
+make --no-print-directory -C rupicola/bedrock2 bedrock2_ex
+make -C /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coqutil
+Generating Makefile.coq.test
+make -f Makefile.coq.test
+echo $COQ_VERSION_INFO (8.15.2) > .coq-version-short
+echo $COQ_VERSION_INFO (8.15.2, compiled with) > .coq-version-short-date
+echo $COQ_VERSION_INFO (8.15.2, OCaml 4.08.1) > .coq-version-compilation-date
+echo $COQ_VERSION_INFO (8.15.2, 4.08.1) > .coq-version-ocaml-version
+echo $COQ_VERSION_INFO (8.15.2, <config>) > .coq-version-config
+echo $COQ_VERSION_INFO (8.15.2, <ocaml config>) > .coq-version-ocaml-config
+etc/machine.sh > .machine
+etc/machine-extended.sh > .machine-extended
+make[4]: Nothing to be done for 'real-all'.
+make -C /home/jadep/fiat-crypto/rupicola/bedrock2/bedrock2 noex
+Generating Makefile.coq.noex
+rm -f .coqdeps.d
+make -f Makefile.coq.noex
+make[4]: Nothing to be done for 'real-all'.
+make -C /home/jadep/fiat-crypto/rupicola/bedrock2/bedrock2
+Generating Makefile.coq.noex
+Generating Makefile.coq.ex
+rm -f .coqdeps.d
+make -f Makefile.coq.noex
+make[4]: Nothing to be done for 'real-all'.
+rm -f .coqdeps.d
+COQFLAGS="-Q src/bedrock2 bedrock2 -Q src/bedrock2Examples bedrock2Examples -Q /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coqutil/src/coqutil coqutil " ../etc/bytedump.py bedrock2.PrintListByte.allBytes > special/BytedumpTest.out.tmp
+COQFLAGS="-Q src/bedrock2 bedrock2 -Q src/bedrock2Examples bedrock2Examples -Q /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coqutil/src/coqutil coqutil " ../etc/bytedump.py bedrock2.ToCStringExprTypecheckingTest.test > special/TypecheckExprToCString.c
+make -f Makefile.coq.ex
+make[4]: Nothing to be done for 'real-all'.
+COQFLAGS="-Q src/bedrock2 bedrock2 -Q src/bedrock2Examples bedrock2Examples -Q /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coqutil/src/coqutil coqutil " ../etc/bytedump.py bedrock2.ToCStringStackallocLoopTest.main_cbytes > special/stackloop.c
+make[2]: Nothing to be done for 'real-all'.
+hexdump < /dev/null && \
+	hexdump -C special/BytedumpTest.golden.bin > special/BytedumpTest.golden.hex && \
+	hexdump -C special/BytedumpTest.out.tmp > special/BytedumpTest.out.hex && \
+	diff -u special/BytedumpTest.golden.hex special/BytedumpTest.out.hex && \
+	rm special/BytedumpTest.golden.hex special/BytedumpTest.out.hex || true
+diff -u special/BytedumpTest.golden.bin special/BytedumpTest.out.tmp
+mv special/BytedumpTest.out.tmp special/BytedumpTest.out
+COQFLAGS="-Q src/bedrock2 bedrock2 -Q src/bedrock2Examples bedrock2Examples -Q /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coqutil/src/coqutil coqutil " ../etc/bytedump.py bedrock2Examples.stackalloc.stacknondet_c > special/stacknondet.c
+cc -fsyntax-only special/TypecheckExprToCString.c
+cc -O0 special/stackloop.c -o special/stackloop
+special/stackloop
+cc special/stacknondet.c -o special/stacknondet
+special/stacknondet
+make --no-print-directory -C rupicola/bedrock2 compiler_noex
+make -C /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coqutil
+make NO_TEST=1 -C /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coq-record-update
+Generating Makefile.coq.test
+make -f Makefile.coq.test
+make[4]: Nothing to be done for 'real-all'.
+make[4]: Nothing to be done for 'real-all'.
+make -C /home/jadep/fiat-crypto/rupicola/bedrock2/deps/riscv-coq all
+make -C /home/jadep/fiat-crypto/rupicola/bedrock2/bedrock2 noex
+Generating Makefile.coq.noex
+Generating Makefile.coq.all
+rm -f .coqdeps.d
+make -f Makefile.coq.noex
+rm -f .coqdeps.d
+make -f Makefile.coq.all
+make[4]: Nothing to be done for 'real-all'.
+make[4]: Nothing to be done for 'real-all'.
+make -C /home/jadep/fiat-crypto/rupicola/bedrock2/compiler noex
+Generating Makefile.coq.noex
+rm -f .coqdeps.d
+make -f Makefile.coq.noex
+make[4]: Nothing to be done for 'real-all'.
+make --no-print-directory -C rupicola all
+make --no-print-directory -C bedrock2/deps/coqutil
+Generating Makefile.coq.test
+make -f Makefile.coq.test
+make[4]: Nothing to be done for 'real-all'.
+make --no-print-directory -C bedrock2/bedrock2 noex
+Generating Makefile.coq
+Generating Makefile.coq.noex
+rm -f .coqdeps.d
+make -f Makefile.coq.noex
+make[4]: Nothing to be done for 'real-all'.
+rm -f .coqdeps.d
+make -f Makefile.coq
+COQDEP VFILES
+make[3]: Nothing to be done for 'real-all'.
+COQDEP VFILES
+make --no-print-directory -C rewriter
+make --no-print-directory -C rupicola/bedrock2/deps/coqutil
+make --no-print-directory -C coqprime src/Coqprime/PrimalityTest/Zp.vo src/Coqprime/PrimalityTest/PocklingtonCertificat.vo
+Generating Makefile.coq.test
+make -f Makefile.coq.test
+make[1]: 'src/Coqprime/PrimalityTest/Zp.vo' is up to date.
+make[1]: 'src/Coqprime/PrimalityTest/PocklingtonCertificat.vo' is up to date.
+make[3]: Nothing to be done for 'real-all'.
+make --no-print-directory -C rupicola/bedrock2 bedrock2_ex
+make -C /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coqutil
+Generating Makefile.coq.test
+make -f Makefile.coq.test
+echo $COQ_VERSION_INFO (8.15.2) > .coq-version-short
+echo $COQ_VERSION_INFO (8.15.2, compiled with) > .coq-version-short-date
+echo $COQ_VERSION_INFO (8.15.2, OCaml 4.08.1) > .coq-version-compilation-date
+echo $COQ_VERSION_INFO (8.15.2, 4.08.1) > .coq-version-ocaml-version
+echo $COQ_VERSION_INFO (8.15.2, <config>) > .coq-version-config
+echo $COQ_VERSION_INFO (8.15.2, <ocaml config>) > .coq-version-ocaml-config
+etc/machine.sh > .machine
+etc/machine-extended.sh > .machine-extended
+make[4]: Nothing to be done for 'real-all'.
+make -C /home/jadep/fiat-crypto/rupicola/bedrock2/bedrock2 noex
+Generating Makefile.coq.noex
+rm -f .coqdeps.d
+make -f Makefile.coq.noex
+make[4]: Nothing to be done for 'real-all'.
+make -C /home/jadep/fiat-crypto/rupicola/bedrock2/bedrock2
+Generating Makefile.coq.noex
+Generating Makefile.coq.ex
+rm -f .coqdeps.d
+make -f Makefile.coq.noex
+make[4]: Nothing to be done for 'real-all'.
+rm -f .coqdeps.d
+COQFLAGS="-Q src/bedrock2 bedrock2 -Q src/bedrock2Examples bedrock2Examples -Q /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coqutil/src/coqutil coqutil " ../etc/bytedump.py bedrock2.PrintListByte.allBytes > special/BytedumpTest.out.tmp
+make -f Makefile.coq.ex
+COQFLAGS="-Q src/bedrock2 bedrock2 -Q src/bedrock2Examples bedrock2Examples -Q /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coqutil/src/coqutil coqutil " ../etc/bytedump.py bedrock2.ToCStringExprTypecheckingTest.test > special/TypecheckExprToCString.c
+make[4]: Nothing to be done for 'real-all'.
+COQFLAGS="-Q src/bedrock2 bedrock2 -Q src/bedrock2Examples bedrock2Examples -Q /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coqutil/src/coqutil coqutil " ../etc/bytedump.py bedrock2.ToCStringStackallocLoopTest.main_cbytes > special/stackloop.c
+make[2]: Nothing to be done for 'real-all'.
+hexdump < /dev/null && \
+	hexdump -C special/BytedumpTest.golden.bin > special/BytedumpTest.golden.hex && \
+	hexdump -C special/BytedumpTest.out.tmp > special/BytedumpTest.out.hex && \
+	diff -u special/BytedumpTest.golden.hex special/BytedumpTest.out.hex && \
+	rm special/BytedumpTest.golden.hex special/BytedumpTest.out.hex || true
+diff -u special/BytedumpTest.golden.bin special/BytedumpTest.out.tmp
+mv special/BytedumpTest.out.tmp special/BytedumpTest.out
+COQFLAGS="-Q src/bedrock2 bedrock2 -Q src/bedrock2Examples bedrock2Examples -Q /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coqutil/src/coqutil coqutil " ../etc/bytedump.py bedrock2Examples.stackalloc.stacknondet_c > special/stacknondet.c
+cc -fsyntax-only special/TypecheckExprToCString.c
+cc -O0 special/stackloop.c -o special/stackloop
+special/stackloop
+cc special/stacknondet.c -o special/stacknondet
+special/stacknondet
+make --no-print-directory -C rupicola/bedrock2 compiler_noex
+make -C /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coqutil
+make NO_TEST=1 -C /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coq-record-update
+Generating Makefile.coq.test
+make -f Makefile.coq.test
+make[4]: Nothing to be done for 'real-all'.
+make[4]: Nothing to be done for 'real-all'.
+make -C /home/jadep/fiat-crypto/rupicola/bedrock2/deps/riscv-coq all
+make -C /home/jadep/fiat-crypto/rupicola/bedrock2/bedrock2 noex
+Generating Makefile.coq.all
+Generating Makefile.coq.noex
+rm -f .coqdeps.d
+make -f Makefile.coq.noex
+rm -f .coqdeps.d
+make -f Makefile.coq.all
+make[4]: Nothing to be done for 'real-all'.
+make[4]: Nothing to be done for 'real-all'.
+make -C /home/jadep/fiat-crypto/rupicola/bedrock2/compiler noex
+Generating Makefile.coq.noex
+rm -f .coqdeps.d
+make -f Makefile.coq.noex
+make[4]: Nothing to be done for 'real-all'.
+make --no-print-directory -C rupicola all
+make --no-print-directory -C bedrock2/deps/coqutil
+Generating Makefile.coq.test
+make -f Makefile.coq.test
+make[4]: Nothing to be done for 'real-all'.
+make --no-print-directory -C bedrock2/bedrock2 noex
+Generating Makefile.coq
+Generating Makefile.coq.noex
+rm -f .coqdeps.d
+make -f Makefile.coq.noex
+make[4]: Nothing to be done for 'real-all'.
+rm -f .coqdeps.d
+make -f Makefile.coq
+COQDEP VFILES
+make[3]: Nothing to be done for 'real-all'.
+COQC src/Bedrock/Field/Translation/Flatten.v
+COQC src/Bedrock/Field/Translation/LoadStoreList.v
+COQC src/Bedrock/Field/Common/Arrays/ByteBounds.v
+COQC src/Bedrock/Field/Translation/Proofs/Cmd.v
+COQC src/Bedrock/Field/Translation/Parameters/Defaults.v
+COQC src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
+COQC src/Bedrock/Field/Translation/Proofs/Flatten.v
+Record PipelineOptions : Set := Build_PipelineOptions
+  { absint_opts : AbstractInterpretation.Options;
+    widen_carry : widen_carry_opt;
+    widen_bytes : widen_bytes_opt;
+    unfold_value_barrier : unfold_value_barrier_opt;
+    should_split_multiret : should_split_multiret_opt;
+    should_split_mul : should_split_mul_opt;
+    output_options : output_options_opt;
+    only_signed : only_signed_opt;
+    no_select : no_select_opt;
+    low_level_rewriter_method : low_level_rewriter_method_opt;
+    debug_rewriting : debug_rewriting_opt }.
+
+Arguments Build_PipelineOptions absint_opts widen_carry 
+  widen_bytes unfold_value_barrier should_split_multiret 
+  should_split_mul output_options only_signed no_select
+  low_level_rewriter_method debug_rewriting
+Pipeline.split_multiret_to:
+  Pipeline.BoundsPipelineOptions -> split_multiret_to_opt
+split_multiret_to:
+  PipelineOptions -> machine_wordsize_opt -> split_multiret_to_opt
+BoundsPipeline.split_multiret_to: split_multiret_to_opt -> option (Z * Z)
+Pipeline.Build_BoundsPipelineOptions:
+  AbstractInterpretation.Options ->
+  low_level_rewriter_method_opt ->
+  only_signed_opt ->
+  no_select_size_opt ->
+  split_mul_to_opt ->
+  split_multiret_to_opt ->
+  unfold_value_barrier_opt ->
+  relax_adc_sbb_return_carry_to_bitwidth_opt ->
+  forall translate_to_fancy : translate_to_fancy_opt,
+  debug_rewriting_opt ->
+  let with_dead_code_elimination := true in
+  let with_let_bind_return := true in
+  let adc_no_carry_to_add :=
+    match translate_to_fancy with
+    | Some _ => false
+    | None => true
+    end in
+  Pipeline.BoundsPipelineOptions
+COQC src/Bedrock/Field/Translation/Func.v
+COQC src/Bedrock/Field/Translation/Parameters/Defaults64.v
+COQC src/Bedrock/Field/Translation/Parameters/Defaults32.v
+COQC src/Bedrock/Field/Translation/Proofs/LoadStoreList.v
diff --git a/src/Bedrock/Field/Translation/Cmd.v b/src/Bedrock/Field/Translation/Cmd.v
index 545bd6f1cc..302b9fa791 100644
--- a/src/Bedrock/Field/Translation/Cmd.v
+++ b/src/Bedrock/Field/Translation/Cmd.v
@@ -121,13 +121,14 @@ Section Cmd.
       Some (existT _ (t12, t3, t4) (f, x1, x2, x3, x4)))%option.
 
   (* Translate 3-argument special functions. *)
-  Definition translate_ident_special3 {var a b c d} (i : ident (a -> b -> c -> d)) (nextn : nat)
-    : API.expr (var:=var) a -> API.expr b -> API.expr c -> option (nat * ltype d * Syntax.cmd.cmd)
+  Definition translate_ident_special3 {var a b c d} (i : ident (a -> b -> c -> d))
+    : API.expr (var:=var) a -> API.expr b -> API.expr c -> option (nat -> nat * ltype d * Syntax.cmd.cmd)
     := match i in ident t return
              API.expr (type.domain t) ->
              API.expr (type.domain (type.codomain t)) ->
              API.expr (type.domain (type.codomain (type.codomain t))) ->
-             option (nat
+             option (nat ->
+                     nat
                      * ltype (type.codomain (type.codomain (type.codomain t)))
                      * Syntax.cmd.cmd) with
        | ident.Z_add_get_carry =>
@@ -137,9 +138,11 @@ Section Cmd.
            let y := translate_expr true y in
            if s =? 2 ^ width
            then
-             let sum := varname_gen nextn in
-             let carry := varname_gen (S nextn) in
-             Some (2%nat, (sum,carry), Syntax.cmd.call [sum;carry] add_carryx [x; y; Syntax.expr.literal 0])
+             Some (fun nextn =>
+                     let sum := varname_gen nextn in
+                     let carry := varname_gen (S nextn) in
+                     (2%nat, (sum,carry),
+                      Syntax.cmd.call [sum;carry] add_carryx [x; y; Syntax.expr.literal 0]))
            else None)%option
        | ident.Z_sub_get_borrow =>
          fun s x y =>
@@ -148,33 +151,25 @@ Section Cmd.
            let y := translate_expr true y in
            if s =? 2 ^ width
            then
-             let diff := varname_gen nextn in
-             let borrow := varname_gen (S nextn) in
-             Some (2%nat, (diff, borrow), Syntax.cmd.call [diff;borrow] sub_borrowx [x; y; Syntax.expr.literal 0])
+             Some (fun nextn =>
+                     let diff := varname_gen nextn in
+                     let borrow := varname_gen (S nextn) in
+                     (2%nat, (diff, borrow),
+                      Syntax.cmd.call [diff;borrow] sub_borrowx [x; y; Syntax.expr.literal 0]))
            else None)%option
        | _ => fun _ _ _ => None
        end.
 
-  (* This is based on `translate_cast_exempt` from Expr.v *)
-  Definition translate_carry {t} (e : @API.expr ltype t) : rtype t :=
-    match e in expr.expr t0 return rtype t0 with
-    | expr.Ident type_Z (ident.Literal base.type.Z z) =>
-      if ZRange.is_bounded_by_bool z {| ZRange.lower := 0; ZRange.upper := 1 |}
-      then Syntax.expr.literal z
-      else make_error _
-    | expr.Var type_Z x => Syntax.expr.var x
-    | _ => make_error _
-    end.
-
   (* Translate 4-argument special functions. *)
-  Definition translate_ident_special4 {var a b c d e} (i : ident (a -> b -> c -> d -> e)) (nextn : nat)
-    : API.expr (var:=var) a -> API.expr b -> API.expr c -> API.expr d -> option (nat * ltype e * Syntax.cmd.cmd)
+  Definition translate_ident_special4 {var a b c d e} (i : ident (a -> b -> c -> d -> e))
+    : API.expr (var:=var) a -> API.expr b -> API.expr c -> API.expr d -> option (nat -> nat * ltype e * Syntax.cmd.cmd)
     := match i in ident t return
              API.expr (type.domain t) ->
              API.expr (type.domain (type.codomain t)) ->
              API.expr (type.domain (type.codomain (type.codomain t))) ->
              API.expr (type.domain (type.codomain (type.codomain (type.codomain t)))) ->
-             option (nat
+             option (nat ->
+                     nat
                      * ltype (type.codomain (type.codomain (type.codomain (type.codomain t))))
                      * Syntax.cmd.cmd) with
        | ident.Z_add_with_get_carry =>
@@ -185,12 +180,15 @@ Section Cmd.
            then
              if s =? 2 ^ width
              then
-               let c := translate_carry (snd rc) in
+               let c := translate_expr false (snd rc) in
+               (* For carries we need to preserve the cast, because the proofs don't track bounds. *)
+               let c := Syntax.expr.op Syntax.bopname.and c (Syntax.expr.literal 1) in
                let x := translate_expr true x in
                let y := translate_expr true y in
-               let sum := varname_gen nextn in
-               let carry := varname_gen (S nextn) in
-               Some (2%nat, (sum,carry), Syntax.cmd.call [sum;carry] add_carryx [x; y; c])
+               Some (fun nextn =>
+                       let sum := varname_gen nextn in
+                       let carry := varname_gen (S nextn) in
+                       (2%nat, (sum,carry), Syntax.cmd.call [sum;carry] add_carryx [x; y; c]))
              else None
            else None)%option
        | ident.Z_sub_with_get_borrow =>
@@ -201,12 +199,15 @@ Section Cmd.
            then
              if s =? 2 ^ width
              then
-               let b := translate_carry (snd rb) in
+               let b := translate_expr false (snd rb) in
+               (* For carries we need to preserve the cast, because the proofs don't track bounds. *)
+               let b := Syntax.expr.op Syntax.bopname.and b (Syntax.expr.literal 1) in
                let x := translate_expr true x in
                let y := translate_expr true y in
-               let diff := varname_gen nextn in
-               let borrow := varname_gen (S nextn) in
-               Some (2%nat, (diff, borrow), Syntax.cmd.call [diff;borrow] sub_borrowx [x; y; b])
+               Some (fun nextn =>
+                       let diff := varname_gen nextn in
+                       let borrow := varname_gen (S nextn) in
+                       (2%nat, (diff, borrow), Syntax.cmd.call [diff;borrow] sub_borrowx [x; y; b]))
              else None
            else None)%option
        | _ => fun _ _ _ _ => None
@@ -214,19 +215,19 @@ Section Cmd.
 
   (* Translates 3-argument special operations or returns None. *)
   Definition translate_if_special3
-           {t} (e : @API.expr ltype t) (nextn : nat)
-    : option (nat * ltype t * Syntax.cmd.cmd)
+           {t} (e : @API.expr ltype t)
+    : option (nat -> nat * ltype t * Syntax.cmd.cmd)
     := (ixyz <- invert_AppIdent3_cps e (fun _ x => x) (fun _ x => x) (fun _ x => x);
        let '(existT _ (i, x, y, z)) := ixyz in
-       translate_ident_special3 i nextn x y z)%option.
+       translate_ident_special3 i x y z)%option.
 
   (* Translates 4-argument special operations or returns None. *)
   Definition translate_if_special4
-           {t} (e : @API.expr ltype t) (nextn : nat)
-    : option (nat * ltype t * Syntax.cmd.cmd)
+           {t} (e : @API.expr ltype t)
+    : option (nat -> nat * ltype t * Syntax.cmd.cmd)
     := (iwxyz <- invert_AppIdent4_cps e (fun _ x => x) (fun _ x => x) (fun _ x => x) (fun _ x => x);
        let '(existT _ (i, w, x, y, z)) := iwxyz in
-       translate_ident_special4 i nextn w x y z)%option.
+       translate_ident_special4 i w x y z)%option.
 
   Fixpoint range_base_good {t} : Language.Compilers.base.interp (fun _ => ZRange.zrange) t -> bool :=
     match t as t0 return Language.Compilers.base.interp (base:=Compilers.base) (fun _ => ZRange.zrange) t0 -> bool with
@@ -242,16 +243,16 @@ Section Cmd.
     end.
 
   Definition translate_if_special_function
-             {t} (e : @API.expr ltype t) (nextn : nat)
-    : option (nat * ltype t * Syntax.cmd.cmd) :=
+             {t} (e : @API.expr ltype t)
+    : option (nat -> nat * ltype t * Syntax.cmd.cmd) :=
     (* Expect an outer cast and strip it off. *)
     (rx <- invert_expr.invert_App_cast e;
     if range_type_good (fst rx)
     then
       (* Translate the rest of the function. *)
-      match translate_if_special3 (snd rx) nextn with
+      match translate_if_special3 (snd rx) with
       | Some res => Some res
-      | None => translate_if_special4 (snd rx) nextn
+      | None => translate_if_special4 (snd rx)
       end
     else None)%option.
 
@@ -265,9 +266,9 @@ Section Cmd.
     | expr.LetIn (type.base t1) (type.base t2) x f =>
       (* Special handling for functions that should result in calls to bedrock2
          functions, e.g. add_carryx. *)
-      let result_if_special := translate_if_special_function (t:=type.base t1) x nextn in
+      let result_if_special := translate_if_special_function (t:=type.base t1) x in
       let trx := match result_if_special with
-                 | Some res => res
+                 | Some res => res nextn
                  | None => assign nextn (translate_expr true x)
                  end in
       let trf := translate_cmd (f (snd (fst trx))) (nextn + fst (fst trx)) in
diff --git a/src/Bedrock/Field/Translation/Proofs/Cmd.v b/src/Bedrock/Field/Translation/Proofs/Cmd.v
index e08b13dbbd..aa4dfc8c28 100644
--- a/src/Bedrock/Field/Translation/Proofs/Cmd.v
+++ b/src/Bedrock/Field/Translation/Proofs/Cmd.v
@@ -409,7 +409,7 @@ Section Cmd.
         (e3 : @API.expr ltype t) G :
     valid_expr false e1 ->
     wf3 G e1 e2 e3 ->
-    forall nextn, translate_if_special3 e3 nextn = None.
+    translate_if_special3 e3 = None.
   Proof.
     induction 1; intros; invert_wf3_until_exposed; reflexivity.
   Qed.
@@ -420,7 +420,7 @@ Section Cmd.
         (e3 : @API.expr ltype t) G :
     valid_expr false e1 ->
     wf3 G e1 e2 e3 ->
-    forall nextn, translate_if_special4 e3 nextn = None.
+    translate_if_special4 e3 = None.
   Proof.
     induction 1; intros; invert_wf3_until_exposed; reflexivity.
   Qed.
@@ -447,7 +447,7 @@ Section Cmd.
         (e3 : @API.expr ltype t) G :
     valid_expr true e1 ->
     wf3 G e1 e2 e3 ->
-    forall nextn, translate_if_special_function e3 nextn = None.
+    translate_if_special_function e3 = None.
   Proof.
     induction 1; intros; invert_wf3_until_exposed;
       try reflexivity; cbv [translate_if_special_function invert_expr.invert_App_cast].
@@ -555,6 +555,35 @@ Section Cmd.
              end.
   Qed.
 
+  Lemma interp_and_carry x :
+    word.unsigned (word:=word)
+                  (Semantics.interp_binop Syntax.bopname.and x (word.of_Z 1)) = (word.unsigned x) mod 2.
+  Proof.
+    cbn [Semantics.interp_binop].
+    rewrite word.unsigned_and, !word.unsigned_of_Z.
+    pose proof word.width_pos.
+    assert (2 <= 2 ^ width) by (apply Pow.Z.pow_pos_le; lia).
+    cbv [word.wrap]. rewrite (Z.mod_small 1) by lia.
+    change 1 with (Z.ones 1). rewrite Z.land_ones by lia.
+    rewrite Z.pow_1_r.
+    lazymatch goal with
+    | |- (?x mod 2) mod _ = _ =>
+      pose proof (Z.mod_pos_bound x 2);
+        rewrite (Z.mod_small (x mod 2)) by lia
+    end.
+    reflexivity.
+  Qed.
+
+  Lemma interp_cast_carry r x :
+    ZRange.lower r = 0 -> ZRange.upper r = 1 -> PreExtra.ident.cast r x = word.wrap x mod 2.
+  Proof.
+    destruct r; cbn [ZRange.lower ZRange.upper]; intros; subst.
+    rewrite CastLemmas.ident.cast_out_of_bounds_simple_0_mod by lia.
+    pose proof word.width_pos. cbv [word.wrap].
+    rewrite Modulo.Z.mod_pow_same_base_smaller with (m:=1); try lia.
+    reflexivity.
+  Qed.
+
   Lemma invert_Literal_Some {var t} (x : Compilers.base_interp t) :
     invert_expr.invert_Literal (var:=var) (expr.Ident (ident.Literal x)) = Some x.
   Proof. reflexivity. Qed.
@@ -638,7 +667,13 @@ Section Cmd.
                                       (expr.Ident (ident.Literal (t:=base.type.zrange) rc)))
                             c))
                   x) y)) nextn
-    = Some (2%nat, (sum,carry), Syntax.cmd.call [sum;carry] add_carryx [(translate_expr true x); (translate_expr true y); translate_expr false c]).
+    = Some (2%nat, (sum,carry), Syntax.cmd.call [sum;carry] add_carryx
+                                              [translate_expr true x
+                                               ; translate_expr true y
+                                               ; Syntax.expr.op
+                                                   Syntax.bopname.and
+                                                   (translate_expr false c)
+                                                   (Syntax.expr.literal 1)]).
   Proof.
     cbv [translate_if_special_function]; intros.
     repeat lazymatch goal with H : range_good ?r = true |- _ => apply range_good_eq in H; subst end.
@@ -988,8 +1023,6 @@ Section Cmd.
     { (* add_with_get_carry *)
       rewrite translate_add_with_get_carry by auto. cbn [fst snd].
       cbn [WeakestPrecondition.cmd WeakestPrecondition.cmd_body].
-      Check translate_expr_correct.
-      Check translate_expr_correct'.
       repeat lazymatch goal with
              | H : valid_expr ?require_cast ?e |- _ =>
                lazymatch goal with
@@ -1009,10 +1042,14 @@ Section Cmd.
                | H : dexpr map.empty ?l ?x _ |- WeakestPrecondition.expr ?m ?l ?x _ =>
                  apply expr_empty; apply H
                | _ => reflexivity
-               end. }
-      straightline_call.
-      {
-          }
+               end; [ ].
+        (* Carry argument is left over. *)
+        cbn [WeakestPrecondition.expr WeakestPrecondition.expr_body].
+        eapply Proper_expr; [ | solve [apply expr_empty; eauto] ].
+        repeat intro; subst. reflexivity. }
+      straightline_call;
+        [ (* carry is < 2 *)
+          rewrite interp_and_carry; apply Z.mod_pos_bound; lia | ].
       sepsimpl; subst; cleanup.
       eexists; split; [ reflexivity | ].
       eapply Proper_cmd; [ eapply Proper_call | repeat intro | ].
@@ -1020,7 +1057,8 @@ Section Cmd.
         eapply IHe1_valid; clear IHe1_valid;
         repeat match goal with
                | _ => progress (intros; cleanup)
-               | H : forall v1 v2 v3, wf3 _ (?f v1) _ _ |- wf3 _ (?f tt) _ _ => solve [apply (H tt)]
+               | H : forall v1 v2 v3, wf3 _ (?f v1) _ _ |- wf3 _ (?f ?v1) _ (_ ?v3) =>
+                 solve [eapply (H v1 _ v3)]
                | H : ?P |- ?P => exact H
                end; [ | | ].
         { (* context varname_set *)
@@ -1068,14 +1106,20 @@ Section Cmd.
         | H : equivalent_base ?x1 ?y ?a ?l ?m |- equivalent_base ?x2 ?y ?a ?l ?m =>
           replace x2 with x1; [ exact H | ]
         end.
-        lazymatch goal with
-          | H : context [word.unsigned (word.of_Z 0)] |- _ =>
-            rewrite Properties.word.unsigned_of_Z_0 in H
-        end.
         repeat lazymatch goal with
                | H : word.unsigned _ = expr.interp ?iinterp ?x |- context [expr.interp ?iinterp ?x] =>
                  rewrite <-H
                end.
-        erewrite add_get_carry_full_equiv; eauto with lia. } }
+        lazymatch goal with
+        | H : context [word.unsigned
+                         (Semantics.interp_binop Syntax.bopname.and (word.of_Z ?x) (word.of_Z 1))]
+          |- context [Definitions.Z.add_with_get_carry_full _ (PreExtra.ident.cast ?r ?c) _ _] =>
+          (* more complex rewrite for the carry *)
+          replace (PreExtra.ident.cast r c)
+            with (word.unsigned (word:=word)
+                                (Semantics.interp_binop Syntax.bopname.and (word.of_Z x) (word.of_Z 1)))
+        end; [ erewrite add_with_get_carry_full_equiv; solve [eauto with lia] | ].
+        rewrite interp_and_carry, interp_cast_carry by auto.
+        rewrite word.unsigned_of_Z. reflexivity. } }
   Qed.
 End Cmd.

From 518afa041708c990b6d8a02a02f01db98e00d498 Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Thu, 10 Aug 2023 11:44:18 +0200
Subject: [PATCH 08/34] cmd proof working again

---
 src/Bedrock/Field/Translation/Proofs/Cmd.v | 28 ++++++++++++----------
 1 file changed, 15 insertions(+), 13 deletions(-)

diff --git a/src/Bedrock/Field/Translation/Proofs/Cmd.v b/src/Bedrock/Field/Translation/Proofs/Cmd.v
index aa4dfc8c28..eeb9029cd4 100644
--- a/src/Bedrock/Field/Translation/Proofs/Cmd.v
+++ b/src/Bedrock/Field/Translation/Proofs/Cmd.v
@@ -609,11 +609,9 @@ Section Cmd.
     = Some (existT _ (a, b, c, d) (i, f1 _ w, f2 _ x, f3 _ y, f4 _ z)).
   Proof. reflexivity. Qed.
 
-  Lemma translate_add_get_carry nextn (x y : API.expr type_Z) r1 r2 :
+  Lemma translate_add_get_carry (x y : API.expr type_Z) r1 r2 :
     range_good (width:=width) r1 = true ->
     range_good (width:=width) r2 = true ->
-    let sum := varname_gen nextn in
-    let carry := varname_gen (S nextn) in
     translate_if_special_function
       (expr.App
          (expr.App (expr.Ident ident.Z_cast2)
@@ -626,8 +624,11 @@ Section Cmd.
             (expr.App
                (expr.App (expr.Ident ident.Z_add_get_carry)
                          (expr.Ident (ident.Literal (t:=base.type.Z) (2 ^ width))))
-               x) y)) nextn
-    = Some (2%nat, (sum,carry), Syntax.cmd.call [sum;carry] add_carryx [(translate_expr true x); (translate_expr true y); Syntax.expr.literal 0]).
+               x) y))
+    = Some (fun nextn =>
+              let sum := varname_gen nextn in
+              let carry := varname_gen (S nextn) in
+              (2%nat, (sum,carry), Syntax.cmd.call [sum;carry] add_carryx [(translate_expr true x); (translate_expr true y); Syntax.expr.literal 0])).
   Proof.
     cbv [translate_if_special_function]; intros.
     repeat lazymatch goal with H : range_good ?r = true |- _ => apply range_good_eq in H; subst end.
@@ -643,13 +644,11 @@ Section Cmd.
     rewrite Z.eqb_refl. reflexivity.
   Qed.
 
-  Lemma translate_add_with_get_carry nextn (c x y : API.expr type_Z) rc r1 r2 :
+  Lemma translate_add_with_get_carry (c x y : API.expr type_Z) rc r1 r2 :
     range_good (width:=width) r1 = true ->
     range_good (width:=width) r2 = true ->
     ZRange.lower rc = 0 ->
     ZRange.upper rc = 1 ->
-    let sum := varname_gen nextn in
-    let carry := varname_gen (S nextn) in
     translate_if_special_function
       (expr.App
          (expr.App (expr.Ident ident.Z_cast2)
@@ -666,14 +665,17 @@ Section Cmd.
                   (expr.App (expr.App (expr.Ident ident.Z_cast)
                                       (expr.Ident (ident.Literal (t:=base.type.zrange) rc)))
                             c))
-                  x) y)) nextn
-    = Some (2%nat, (sum,carry), Syntax.cmd.call [sum;carry] add_carryx
+                  x) y))
+    = Some (fun nextn =>
+              let sum := varname_gen nextn in
+              let carry := varname_gen (S nextn) in
+              (2%nat, (sum,carry), Syntax.cmd.call [sum;carry] add_carryx
                                               [translate_expr true x
                                                ; translate_expr true y
                                                ; Syntax.expr.op
                                                    Syntax.bopname.and
                                                    (translate_expr false c)
-                                                   (Syntax.expr.literal 1)]).
+                                                   (Syntax.expr.literal 1)])).
   Proof.
     cbv [translate_if_special_function]; intros.
     repeat lazymatch goal with H : range_good ?r = true |- _ => apply range_good_eq in H; subst end.
@@ -682,10 +684,10 @@ Section Cmd.
     cbn [Crypto.Util.Option.bind fst snd range_type_good range_base_good].
     rewrite !max_range_good. cbn [andb].
     lazymatch goal with
-    | |- context [translate_if_special3 ?x ?n] =>
+    | |- context [translate_if_special3 ?x] =>
       lazymatch type of x with
       | API.expr ?t =>
-        change (translate_if_special3 x n) with (@None (nat * ltype t * Syntax.cmd.cmd))
+        change (translate_if_special3 x) with (@None (nat -> nat * ltype t * Syntax.cmd.cmd))
       end
     end.
     cbn iota. cbv [translate_if_special4].

From f2c148b9cca212d8c0bf67e08cb6aff7d0ad53d9 Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Thu, 10 Aug 2023 13:07:56 +0200
Subject: [PATCH 09/34] proved stuff about inversion things

---
 src/Bedrock/Field/Translation/Cmd.v           |  18 +-
 src/Bedrock/Field/Translation/Proofs/Cmd.v    | 155 +++++++++++++++---
 .../Translation/Proofs/ValidComputable/Cmd.v  |  84 +++++++++-
 3 files changed, 226 insertions(+), 31 deletions(-)

diff --git a/src/Bedrock/Field/Translation/Cmd.v b/src/Bedrock/Field/Translation/Cmd.v
index 302b9fa791..196e35e828 100644
--- a/src/Bedrock/Field/Translation/Cmd.v
+++ b/src/Bedrock/Field/Translation/Cmd.v
@@ -90,6 +90,8 @@ Section Cmd.
       e <- e;
       let '(existT t12 (f, x1, x2)) := e in
       Some (existT _ (t12, t3) (f, x1, x2, x3)))%option.
+  Definition invert_AppIdent3 {base_type ident var t} e :=
+    @invert_AppIdent3_cps base_type ident var t _ _ _ e (fun _ x => x) (fun _ x => x) (fun _ x => x).
   Definition invert_AppIdent4_cps
              {base_type : Type} {ident var : type base_type -> Type}
              {t Q R S T} (e : expr (ident:=ident) (var:=var) t)
@@ -119,6 +121,9 @@ Section Cmd.
       e <- e;
       let '(existT t12 (f, x1, x2)) := e in
       Some (existT _ (t12, t3, t4) (f, x1, x2, x3, x4)))%option.
+  Definition invert_AppIdent4 {base_type ident var t} e :=
+    @invert_AppIdent4_cps base_type ident var t _ _ _ _ e
+                          (fun _ x => x) (fun _ x => x) (fun _ x => x) (fun _ x => x).
 
   (* Translate 3-argument special functions. *)
   Definition translate_ident_special3 {var a b c d} (i : ident (a -> b -> c -> d))
@@ -162,7 +167,8 @@ Section Cmd.
 
   (* Translate 4-argument special functions. *)
   Definition translate_ident_special4 {var a b c d e} (i : ident (a -> b -> c -> d -> e))
-    : API.expr (var:=var) a -> API.expr b -> API.expr c -> API.expr d -> option (nat -> nat * ltype e * Syntax.cmd.cmd)
+    : API.expr (var:=var) a -> API.expr b -> API.expr c -> API.expr d
+      -> option (nat -> nat * ltype e * Syntax.cmd.cmd)
     := match i in ident t return
              API.expr (type.domain t) ->
              API.expr (type.domain (type.codomain t)) ->
@@ -214,18 +220,16 @@ Section Cmd.
        end.
 
   (* Translates 3-argument special operations or returns None. *)
-  Definition translate_if_special3
-           {t} (e : @API.expr ltype t)
+  Definition translate_if_special3 {t} (e : @API.expr ltype t)
     : option (nat -> nat * ltype t * Syntax.cmd.cmd)
-    := (ixyz <- invert_AppIdent3_cps e (fun _ x => x) (fun _ x => x) (fun _ x => x);
+    := (ixyz <- invert_AppIdent3 e;
        let '(existT _ (i, x, y, z)) := ixyz in
        translate_ident_special3 i x y z)%option.
 
   (* Translates 4-argument special operations or returns None. *)
-  Definition translate_if_special4
-           {t} (e : @API.expr ltype t)
+  Definition translate_if_special4 {t} (e : @API.expr ltype t)
     : option (nat -> nat * ltype t * Syntax.cmd.cmd)
-    := (iwxyz <- invert_AppIdent4_cps e (fun _ x => x) (fun _ x => x) (fun _ x => x) (fun _ x => x);
+    := (iwxyz <- invert_AppIdent4 e;
        let '(existT _ (i, w, x, y, z)) := iwxyz in
        translate_ident_special4 i w x y z)%option.
 
diff --git a/src/Bedrock/Field/Translation/Proofs/Cmd.v b/src/Bedrock/Field/Translation/Proofs/Cmd.v
index eeb9029cd4..9d3d5d51d5 100644
--- a/src/Bedrock/Field/Translation/Proofs/Cmd.v
+++ b/src/Bedrock/Field/Translation/Proofs/Cmd.v
@@ -584,31 +584,142 @@ Section Cmd.
     reflexivity.
   Qed.
 
-  Lemma invert_Literal_Some {var t} (x : Compilers.base_interp t) :
+  Lemma invert_Literal_eq_Some {var t} (x : Compilers.base_interp t) :
     invert_expr.invert_Literal (var:=var) (expr.Ident (ident.Literal x)) = Some x.
   Proof. reflexivity. Qed.
 
-  Lemma invert_AppIdent3_Some {Q R S a b c d var} (i : ident (a -> b -> c -> d))
-        (x : expr a) (y : expr b) (z : expr c)
-        (f1 : forall t x, Q t)
-        (f2 : forall t x, R t)
-        (f3 : forall t x, S t) :
-    invert_AppIdent3_cps (var:=var) (expr.App (expr.App (expr.App (expr.Ident i) x) y) z) f1 f2 f3
-    = Some (existT _ (a, b, c) (i, f1 _ x, f2 _ y, f3 _ z)).
+  (* TODO: move to somewhere appropriate in rewriter *)
+  Lemma invert_AppIdent3_cps_id {base_type ident var t Q R S} {e : expr t}
+        (f1 : forall t x, Q t) (f2 : forall t x, R t) (f3 : forall t x, S t) :
+    @invert_AppIdent3_cps base_type ident var t Q R S e f1 f2 f3
+    = option_map
+        (fun '(@existT _ _ argtypes (i, x, y, z)) =>
+           existT
+             (fun argtypes =>
+                (ident (fst (fst argtypes) -> snd (fst argtypes) -> snd argtypes -> t)%etype
+                 * Q (fst (fst argtypes))
+                 * R (snd (fst argtypes))
+                 * S (snd argtypes))%type)
+             argtypes (i, f1 _ x, f2 _ y, f3 _ z))
+        (invert_AppIdent3 e).
+  Proof.
+    cbv [invert_AppIdent3 invert_AppIdent3_cps].
+    cbv [Crypto.Util.Option.bind].
+    repeat lazymatch goal with
+           | |- context [invert_expr.invert_App_cps ?x] =>
+             rewrite !(Inversion.Compilers.expr.invert_App_cps_id (e:=x));
+               destruct (invert_expr.invert_App x) as [ [? [? ?] ] | ];
+               cbn [option_map]; [ | reflexivity ]
+           | |- context [invert_expr.invert_AppIdent2_cps ?x] =>
+             rewrite !(Inversion.Compilers.expr.invert_AppIdent2_cps_id (e:=x));
+               destruct (invert_expr.invert_AppIdent2 x) as [ [? [ [? ?] ?] ] | ];
+               cbn [option_map]; [ | reflexivity ]
+           end.
+    reflexivity.
+  Qed.
+
+  (* TODO: move to somewhere appropriate in rewriter *)
+  Lemma invert_AppIdent4_cps_id {base_type ident var t Q R S T} {e : expr t}
+        (f1 : forall t x, Q t) (f2 : forall t x, R t) (f3 : forall t x, S t) (f4 : forall t x, T t) :
+    @invert_AppIdent4_cps base_type ident var t Q R S T e f1 f2 f3 f4
+    = option_map
+        (fun '(@existT _ _ argtypes (i, w, x, y, z)) =>
+           existT
+             (fun argtypes =>
+                (ident (fst (fst (fst argtypes)) -> snd (fst (fst argtypes)) -> snd (fst argtypes) -> snd argtypes -> t)%etype
+                 * Q (fst (fst (fst argtypes)))
+                 * R (snd (fst (fst argtypes)))
+                 * S (snd (fst argtypes))
+                 * T (snd argtypes))%type)
+             argtypes (i, f1 _ w, f2 _ x, f3 _ y, f4 _ z))
+        (invert_AppIdent4 e).
+  Proof.
+    cbv [invert_AppIdent4 invert_AppIdent4_cps].
+    cbv [Crypto.Util.Option.bind].
+    repeat lazymatch goal with
+           | |- context [invert_expr.invert_App_cps ?x] =>
+             rewrite !(Inversion.Compilers.expr.invert_App_cps_id (e:=x));
+               destruct (invert_expr.invert_App x) as [ [? [? ?] ] | ];
+               cbn [option_map]; [ | reflexivity ]
+           | |- context [invert_expr.invert_AppIdent2_cps ?x] =>
+             rewrite !(Inversion.Compilers.expr.invert_AppIdent2_cps_id (e:=x));
+               destruct (invert_expr.invert_AppIdent2 x) as [ [? [ [? ?] ?] ] | ];
+               cbn [option_map]; [ | reflexivity ]
+           end.
+    reflexivity.
+  Qed.
+
+  Lemma invert_AppIdent3_eq_Some {base_type ident var a b c d} (i : ident (a -> b -> c -> d)%etype)
+        (x : expr a) (y : expr b) (z : expr c) :
+    @invert_AppIdent3 base_type ident var _ (expr.App (expr.App (expr.App (expr.Ident i) x) y) z)
+    = Some (existT _ (a, b, c) (i, x, y, z)).
   Proof. reflexivity. Qed.
 
-  Lemma invert_AppIdent4_Some {P Q R S a b c d e var} (i : ident (a -> b -> c -> d -> e))
-        (w : expr a) (x : expr b) (y : expr c) (z : expr d)
-        (f1 : forall t x, P t)
-        (f2 : forall t x, Q t)
-        (f3 : forall t x, R t)
-        (f4 : forall t x, S t) :
-    invert_AppIdent4_cps (var:=var)
-                         (expr.App (expr.App (expr.App (expr.App (expr.Ident i) w) x) y) z)
-                         f1 f2 f3 f4
-    = Some (existT _ (a, b, c, d) (i, f1 _ w, f2 _ x, f3 _ y, f4 _ z)).
+  Lemma invert_AppIdent4_eq_Some {base_type ident var a b c d e} (i : ident (a -> b -> c -> d -> e)%etype)
+        (w : expr a) (x : expr b) (y : expr c) (z : expr d):
+    @invert_AppIdent4 base_type ident var _ (expr.App (expr.App (expr.App (expr.App (expr.Ident i) w) x) y) z)
+    = Some (existT _ (a, b, c,d ) (i, w, x, y, z)).
   Proof. reflexivity. Qed.
 
+  Lemma invert_AppIdent3_Some {base_type ident var t} v e :
+    @invert_AppIdent3 base_type ident var t e = Some v ->
+    e = (expr.App (expr.App (expr.App (expr.Ident (fst (fst (fst (projT2 v)))))
+                                      (snd (fst (fst (projT2 v)))))
+                            (snd (fst (projT2 v))))
+                  (snd (projT2 v))).
+  Proof.
+    cbv [invert_AppIdent3 invert_AppIdent3_cps]. cbv [Crypto.Util.Option.bind].
+    repeat lazymatch goal with
+           | |- context [invert_expr.invert_App_cps ?x] =>
+             let H := fresh in
+             rewrite !(Inversion.Compilers.expr.invert_App_cps_id (e:=x));
+               destruct (invert_expr.invert_App x) as [ [? [? ?] ] | ] eqn:H;
+               cbn [option_map]; [ | congruence ]
+           | |- context [invert_expr.invert_AppIdent2_cps ?x] =>
+             let H := fresh in
+             rewrite !(Inversion.Compilers.expr.invert_AppIdent2_cps_id (e:=x));
+               destruct (invert_expr.invert_AppIdent2 x) as [ [? [ [? ?] ?] ] | ] eqn:H;
+               cbn [option_map]; [ | congruence ]
+           | H : invert_expr.invert_App _ = Some _ |- _ =>
+             apply Inversion.Compilers.expr.invert_App_Some in H
+           | H : invert_expr.invert_AppIdent2 _ = Some _ |- _ =>
+             apply Inversion.Compilers.expr.invert_AppIdent2_Some in H
+           end.
+    subst; cbn [fst snd projT2].
+    inversion 1. subst; cbn [fst snd projT2].
+    reflexivity.
+  Qed.
+  Lemma invert_AppIdent4_Some {base_type ident var t} v e :
+    @invert_AppIdent4 base_type ident var t e = Some v ->
+    e = (expr.App (expr.App (expr.App (expr.App
+                                         (expr.Ident (fst (fst (fst (fst (projT2 v))))))
+                                         (snd (fst (fst (fst (projT2 v))))))
+                                      (snd (fst (fst (projT2 v)))))
+                            (snd (fst (projT2 v))))
+                  (snd (projT2 v))).
+  Proof.
+    cbv [invert_AppIdent4 invert_AppIdent4_cps]. cbv [Crypto.Util.Option.bind].
+    repeat lazymatch goal with
+           | |- context [invert_expr.invert_App_cps ?x] =>
+             let H := fresh in
+             rewrite !(Inversion.Compilers.expr.invert_App_cps_id (e:=x));
+               destruct (invert_expr.invert_App x) as [ [? [? ?] ] | ] eqn:H;
+               cbn [option_map]; [ | congruence ]
+           | |- context [invert_expr.invert_AppIdent2_cps ?x] =>
+             let H := fresh in
+             rewrite !(Inversion.Compilers.expr.invert_AppIdent2_cps_id (e:=x));
+               destruct (invert_expr.invert_AppIdent2 x) as [ [? [ [? ?] ?] ] | ] eqn:H;
+               cbn [option_map]; [ | congruence ]
+           | H : invert_expr.invert_App _ = Some _ |- _ =>
+             apply Inversion.Compilers.expr.invert_App_Some in H
+           | H : invert_expr.invert_AppIdent2 _ = Some _ |- _ =>
+             apply Inversion.Compilers.expr.invert_AppIdent2_Some in H
+           end.
+    subst; cbn [fst snd projT2].
+    inversion 1. subst; cbn [fst snd projT2].
+    reflexivity.
+  Qed.
+
   Lemma translate_add_get_carry (x y : API.expr type_Z) r1 r2 :
     range_good (width:=width) r1 = true ->
     range_good (width:=width) r2 = true ->
@@ -636,10 +747,10 @@ Section Cmd.
     rewrite invert_App_Z_cast2_Some.
     cbn [Crypto.Util.Option.bind fst snd range_type_good range_base_good].
     rewrite !max_range_good. cbn [andb].
-    cbv [translate_if_special3]. rewrite invert_AppIdent3_Some.
+    cbv [translate_if_special3]. rewrite invert_AppIdent3_eq_Some.
     cbn [Crypto.Util.Option.bind fst snd].
     cbv [translate_ident_special3].
-    cbn [type.domain]. rewrite invert_Literal_Some.
+    cbn [type.domain]. rewrite invert_Literal_eq_Some.
     cbn [Crypto.Util.Option.bind fst snd].
     rewrite Z.eqb_refl. reflexivity.
   Qed.
@@ -691,12 +802,12 @@ Section Cmd.
       end
     end.
     cbn iota. cbv [translate_if_special4].
-    rewrite invert_AppIdent4_Some.
+    rewrite invert_AppIdent4_eq_Some.
     cbn [Crypto.Util.Option.bind fst snd].
     cbv [translate_ident_special4].
     rewrite invert_App_Z_cast_Some.
     cbn [Crypto.Util.Option.bind fst snd].
-    cbn [type.domain]. rewrite invert_Literal_Some.
+    cbn [type.domain]. rewrite invert_Literal_eq_Some.
     cbn [Crypto.Util.Option.bind fst snd].
     repeat lazymatch goal with
            | H : ZRange.upper ?r = _ |- context [ZRange.upper ?r] => rewrite H
diff --git a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v
index d6ec00b8cf..193f81a6a3 100644
--- a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v
+++ b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v
@@ -64,6 +64,68 @@ Section Cmd.
     | _ => fun _ => false
     end.
 
+  Definition valid_ident_special3 {a b c d} (i : ident (a -> b -> c -> d))
+    : @API.expr (fun _ => unit) a
+      -> @API.expr (fun _ => unit) b
+      -> @API.expr (fun _ => unit) c
+      -> bool
+    := match i in ident t return
+             API.expr (type.domain t) ->
+             API.expr (type.domain (type.codomain t)) ->
+             API.expr (type.domain (type.codomain (type.codomain t))) ->
+             bool with
+       | ident.Z_add_get_carry =>
+         fun s x y =>
+           match invert_expr.invert_Literal s with
+           | None => false
+           | Some s => s =? 2 ^ width
+           end
+       | _ => fun _ _ _ => false
+       end.
+
+  Definition valid_ident_special4 {a b c d e} (i : ident (a -> b -> c -> d -> e))
+    : @API.expr (fun _ => unit) a
+      -> @API.expr (fun _ => unit) b
+      -> @API.expr (fun _ => unit) c
+      -> @API.expr (fun _ => unit) d
+      -> bool
+    := match i in ident t return
+             API.expr (type.domain t) ->
+             API.expr (type.domain (type.codomain t)) ->
+             API.expr (type.domain (type.codomain (type.codomain t))) ->
+             API.expr (type.domain (type.codomain (type.codomain (type.codomain t)))) ->
+             bool with
+       | ident.Z_add_with_get_carry =>
+         fun s c x y =>
+           match invert_expr.invert_Literal s with
+           | None => false
+           | Some s =>
+             match invert_expr.invert_App_Z_cast c with
+             | None => false
+             | Some rc =>
+               if ((ZRange.lower (fst rc) =? 0) && (ZRange.upper (fst rc) =? 1))%bool
+               then s =? 2 ^ width
+               else false
+             end
+           end
+       | _ => fun _ _ _ _ => false
+       end.
+
+  Definition valid_special3_bool {t} (e : @API.expr (fun _ => unit) t) : bool :=
+    match Cmd.invert_AppIdent3_cps e (fun _ x => x) (fun _ x => x) (fun _ x => x) with
+    | Some (existT _ (i, x, y, z)) => valid_ident_special3 i x y z
+    | None => false
+    end.
+
+  Definition valid_special4_bool {t} (e : @API.expr (fun _ => unit) t) : bool :=
+    match Cmd.invert_AppIdent4_cps e (fun _ x => x) (fun _ x => x) (fun _ x => x) (fun _ x => x) with
+    | Some (existT _ (i, w, x, y, z)) => valid_ident_special4 i w x y z
+    | None => false
+    end.
+
+  Definition valid_special_bool {t} (e : @API.expr (fun _ => unit) t) : bool :=
+    valid_special3_bool e || valid_special4_bool e.
+
   Fixpoint valid_cmd_bool
            {t} (e : @API.expr (fun _ => unit) t) : bool :=
     if valid_expr_bool_if_base e
@@ -75,11 +137,11 @@ Section Cmd.
                         (base.type.type_base a)
                         (base.type.type_base b)))
           (type.base c) x f =>
-        valid_cmd_bool (f tt) && valid_expr_bool true x
+        valid_cmd_bool (f tt) && (valid_expr_bool true x || valid_special_bool x)
       | expr.LetIn
           (type.base (base.type.type_base a))
           (type.base b) x f =>
-        valid_cmd_bool (f tt) && valid_expr_bool true x
+        valid_cmd_bool (f tt) && (valid_expr_bool true x || valid_special_bool x)
       | expr.App (type.base s) _ f x =>
         (valid_cons_App1_bool f && valid_cmd_bool x)
       | expr.Ident _ i => is_nil_ident i
@@ -100,6 +162,24 @@ Section Cmd.
     constructor; eauto.
   Qed.
 
+  Lemma valid_special3_valid_cmd {s d} f x :
+    valid_special3_bool (t:=s) x = true ->
+    valid_cmd (t:=d) (f tt) ->
+    valid_cmd (t:=d) (expr.LetIn x f).
+  Proof.
+    cbv [valid_special3_bool].
+    cbv [Cmd.invert_AppIdent3_cps].
+    rewrite Inversion.Compilers.expr.invert_App_cps_id.
+  Qed.
+
+  Lemma valid_special_valid_cmd {s d} f x :
+    valid_special_bool (t:=s) x = true ->
+    valid_cmd (t:=d) (f tt) ->
+    valid_cmd (t:=d) (expr.LetIn x f).
+  Proof.
+    cbv [valid_special_bool].
+  Qed.
+
   Lemma is_nil_ident_valid {t} i :
     @is_nil_ident t i = true ->
     valid_cmd (expr.Ident i).

From 4b40d925e768207b921b2d822d444094df1e7a35 Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Fri, 11 Aug 2023 14:26:17 +0200
Subject: [PATCH 10/34] wip

---
 src/Bedrock/Field/Translation/Cmd.v           | 139 +++++++-------
 src/Bedrock/Field/Translation/Proofs/Cmd.v    | 122 ++++++++----
 .../Translation/Proofs/ValidComputable/Cmd.v  | 174 +++++++++++++-----
 3 files changed, 296 insertions(+), 139 deletions(-)

diff --git a/src/Bedrock/Field/Translation/Cmd.v b/src/Bedrock/Field/Translation/Cmd.v
index 196e35e828..3b380b24fe 100644
--- a/src/Bedrock/Field/Translation/Cmd.v
+++ b/src/Bedrock/Field/Translation/Cmd.v
@@ -125,140 +125,147 @@ Section Cmd.
     @invert_AppIdent4_cps base_type ident var t _ _ _ _ e
                           (fun _ x => x) (fun _ x => x) (fun _ x => x) (fun _ x => x).
 
+
+  Definition is_carry_range (r : ZRange.zrange) : bool :=
+    ZRange.zrange_beq r {| ZRange.lower := 0; ZRange.upper := 1 |}.
+
+  Local Notation range_for_type t :=
+    (type.interp (Language.Compilers.base.interp (fun _ => ZRange.zrange)) t).
+
   (* Translate 3-argument special functions. *)
   Definition translate_ident_special3 {var a b c d} (i : ident (a -> b -> c -> d))
-    : API.expr (var:=var) a -> API.expr b -> API.expr c -> option (nat -> nat * ltype d * Syntax.cmd.cmd)
+    : API.expr (var:=var) a -> API.expr b -> API.expr c
+      -> range_for_type d -> option (nat -> nat * ltype d * Syntax.cmd.cmd)
     := match i in ident t return
              API.expr (type.domain t) ->
              API.expr (type.domain (type.codomain t)) ->
              API.expr (type.domain (type.codomain (type.codomain t))) ->
+             range_for_type (type.codomain (type.codomain (type.codomain t))) ->
              option (nat ->
                      nat
                      * ltype (type.codomain (type.codomain (type.codomain t)))
                      * Syntax.cmd.cmd) with
        | ident.Z_add_get_carry =>
-         fun s x y =>
+         fun s x y out_range =>
            (s <- invert_expr.invert_Literal s;
            let x := translate_expr true x in
            let y := translate_expr true y in
-           if s =? 2 ^ width
+           if (range_good (width:=width) (fst out_range) && is_carry_range (snd out_range))%bool
            then
-             Some (fun nextn =>
-                     let sum := varname_gen nextn in
-                     let carry := varname_gen (S nextn) in
-                     (2%nat, (sum,carry),
-                      Syntax.cmd.call [sum;carry] add_carryx [x; y; Syntax.expr.literal 0]))
+             if s =? 2 ^ width
+             then
+               Some (fun nextn =>
+                       let sum := varname_gen nextn in
+                       let carry := varname_gen (S nextn) in
+                       (2%nat, (sum,carry),
+                        Syntax.cmd.call [sum;carry] add_carryx [x; y; Syntax.expr.literal 0]))
+             else None
            else None)%option
        | ident.Z_sub_get_borrow =>
-         fun s x y =>
+         fun s x y out_range =>
            (s <- invert_expr.invert_Literal s;
            let x := translate_expr true x in
            let y := translate_expr true y in
-           if s =? 2 ^ width
+           if (range_good (width:=width) (fst out_range) && is_carry_range (snd out_range))%bool
            then
-             Some (fun nextn =>
-                     let diff := varname_gen nextn in
-                     let borrow := varname_gen (S nextn) in
-                     (2%nat, (diff, borrow),
-                      Syntax.cmd.call [diff;borrow] sub_borrowx [x; y; Syntax.expr.literal 0]))
+             if s =? 2 ^ width
+             then
+               Some (fun nextn =>
+                       let diff := varname_gen nextn in
+                       let borrow := varname_gen (S nextn) in
+                       (2%nat, (diff, borrow),
+                        Syntax.cmd.call [diff;borrow] sub_borrowx [x; y; Syntax.expr.literal 0]))
+             else None
            else None)%option
-       | _ => fun _ _ _ => None
+       | _ => fun _ _ _ _ => None
        end.
 
   (* Translate 4-argument special functions. *)
   Definition translate_ident_special4 {var a b c d e} (i : ident (a -> b -> c -> d -> e))
     : API.expr (var:=var) a -> API.expr b -> API.expr c -> API.expr d
+      -> range_for_type e
       -> option (nat -> nat * ltype e * Syntax.cmd.cmd)
     := match i in ident t return
              API.expr (type.domain t) ->
              API.expr (type.domain (type.codomain t)) ->
              API.expr (type.domain (type.codomain (type.codomain t))) ->
              API.expr (type.domain (type.codomain (type.codomain (type.codomain t)))) ->
+             range_for_type (type.codomain (type.codomain (type.codomain (type.codomain t))))  ->
              option (nat ->
                      nat
                      * ltype (type.codomain (type.codomain (type.codomain (type.codomain t))))
                      * Syntax.cmd.cmd) with
        | ident.Z_add_with_get_carry =>
-         fun s c x y =>
+         fun s c x y out_range =>
            (s <- invert_expr.invert_Literal s;
            rc <- invert_expr.invert_App_Z_cast c;
-           if ((ZRange.lower (fst rc) =? 0) && (ZRange.upper (fst rc) =? 1))%bool
+           if is_carry_range (fst rc)
            then
-             if s =? 2 ^ width
+             if (range_good (width:=width) (fst out_range) && is_carry_range (snd out_range))%bool
              then
-               let c := translate_expr false (snd rc) in
-               (* For carries we need to preserve the cast, because the proofs don't track bounds. *)
-               let c := Syntax.expr.op Syntax.bopname.and c (Syntax.expr.literal 1) in
-               let x := translate_expr true x in
-               let y := translate_expr true y in
-               Some (fun nextn =>
-                       let sum := varname_gen nextn in
-                       let carry := varname_gen (S nextn) in
-                       (2%nat, (sum,carry), Syntax.cmd.call [sum;carry] add_carryx [x; y; c]))
+               if s =? 2 ^ width
+               then
+                 let c := translate_expr false (snd rc) in
+                 (* For carries we need to preserve the cast, because the proofs don't track bounds. *)
+                 let c := Syntax.expr.op Syntax.bopname.and c (Syntax.expr.literal 1) in
+                 let x := translate_expr true x in
+                 let y := translate_expr true y in
+                 Some (fun nextn =>
+                         let sum := varname_gen nextn in
+                         let carry := varname_gen (S nextn) in
+                         (2%nat, (sum,carry), Syntax.cmd.call [sum;carry] add_carryx [x; y; c]))
+               else None
              else None
            else None)%option
        | ident.Z_sub_with_get_borrow =>
-         fun s b x y =>
+         fun s b x y out_range =>
            (s <- invert_expr.invert_Literal s;
            rb <- invert_expr.invert_App_Z_cast b;
-           if ((ZRange.lower (fst rb) =? 0) && (ZRange.upper (fst rb) =? 1))%bool
+           if is_carry_range (fst rb)
            then
-             if s =? 2 ^ width
+             if (range_good (width:=width) (fst out_range) && is_carry_range (snd out_range))%bool
              then
-               let b := translate_expr false (snd rb) in
-               (* For carries we need to preserve the cast, because the proofs don't track bounds. *)
-               let b := Syntax.expr.op Syntax.bopname.and b (Syntax.expr.literal 1) in
-               let x := translate_expr true x in
-               let y := translate_expr true y in
-               Some (fun nextn =>
-                       let diff := varname_gen nextn in
-                       let borrow := varname_gen (S nextn) in
-                       (2%nat, (diff, borrow), Syntax.cmd.call [diff;borrow] sub_borrowx [x; y; b]))
+               if s =? 2 ^ width
+               then
+                 let b := translate_expr false (snd rb) in
+                 (* For carries we need to preserve the cast, because the proofs don't track bounds. *)
+                 let b := Syntax.expr.op Syntax.bopname.and b (Syntax.expr.literal 1) in
+                 let x := translate_expr true x in
+                 let y := translate_expr true y in
+                 Some (fun nextn =>
+                         let diff := varname_gen nextn in
+                         let borrow := varname_gen (S nextn) in
+                         (2%nat, (diff, borrow), Syntax.cmd.call [diff;borrow] sub_borrowx [x; y; b]))
+               else None
              else None
            else None)%option
-       | _ => fun _ _ _ _ => None
+       | _ => fun _ _ _ _ _ => None
        end.
 
   (* Translates 3-argument special operations or returns None. *)
-  Definition translate_if_special3 {t} (e : @API.expr ltype t)
+  Definition translate_if_special3 {t} (e : @API.expr ltype t) (r : range_for_type t)
     : option (nat -> nat * ltype t * Syntax.cmd.cmd)
     := (ixyz <- invert_AppIdent3 e;
        let '(existT _ (i, x, y, z)) := ixyz in
-       translate_ident_special3 i x y z)%option.
+       translate_ident_special3 i x y z r)%option.
 
   (* Translates 4-argument special operations or returns None. *)
-  Definition translate_if_special4 {t} (e : @API.expr ltype t)
+  Definition translate_if_special4 {t} (e : @API.expr ltype t) (r : range_for_type t)
     : option (nat -> nat * ltype t * Syntax.cmd.cmd)
     := (iwxyz <- invert_AppIdent4 e;
        let '(existT _ (i, w, x, y, z)) := iwxyz in
-       translate_ident_special4 i w x y z)%option.
-
-  Fixpoint range_base_good {t} : Language.Compilers.base.interp (fun _ => ZRange.zrange) t -> bool :=
-    match t as t0 return Language.Compilers.base.interp (base:=Compilers.base) (fun _ => ZRange.zrange) t0 -> bool with
-    | base.type.type_base t => range_good (width:=width)
-    | base.type.prod A B => fun x => (range_base_good (fst x) && range_base_good (snd x))%bool
-    | _ => fun x => false
-    end.
-  Definition range_type_good {t}
-    : type.interp (Language.Compilers.base.interp (fun _ => ZRange.zrange)) t -> bool :=
-    match t with
-    | type.base b => range_base_good
-    | _ => fun x => false
-    end.
+       translate_ident_special4 i w x y z r)%option.
 
   Definition translate_if_special_function
              {t} (e : @API.expr ltype t)
     : option (nat -> nat * ltype t * Syntax.cmd.cmd) :=
     (* Expect an outer cast and strip it off. *)
     (rx <- invert_expr.invert_App_cast e;
-    if range_type_good (fst rx)
-    then
-      (* Translate the rest of the function. *)
-      match translate_if_special3 (snd rx) with
-      | Some res => Some res
-      | None => translate_if_special4 (snd rx)
-      end
-    else None)%option.
+    (* Translate the rest of the function. *)
+    match translate_if_special3 (snd rx) (fst rx) with
+    | Some res => Some res
+    | None => translate_if_special4 (snd rx) (fst rx)
+    end)%option.
 
   Fixpoint translate_cmd
            {t} (e : @API.expr ltype t) (nextn : nat)
diff --git a/src/Bedrock/Field/Translation/Proofs/Cmd.v b/src/Bedrock/Field/Translation/Proofs/Cmd.v
index 9d3d5d51d5..96ab449043 100644
--- a/src/Bedrock/Field/Translation/Proofs/Cmd.v
+++ b/src/Bedrock/Field/Translation/Proofs/Cmd.v
@@ -77,7 +77,7 @@ Section Cmd.
   | valid_add_get_carry :
       forall t r1 r2 (s : Z) x y f,
         range_good (width:=width) r1 = true ->
-        range_good (width:=width) r2 = true ->
+        is_carry_range r2 = true ->
         s = 2 ^ width ->
         valid_expr true x ->
         valid_expr true y ->
@@ -100,9 +100,8 @@ Section Cmd.
   | valid_add_with_get_carry :
       forall t rc r1 r2 (s : Z) c x y f,
         range_good (width:=width) r1 = true ->
-        range_good (width:=width) r2 = true ->
-        ZRange.lower rc = 0 ->
-        ZRange.upper rc = 1 ->
+        is_carry_range r2 = true ->
+        is_carry_range rc = true ->
         s = 2 ^ width ->
         valid_expr false c ->
         valid_expr true x ->
@@ -406,10 +405,10 @@ Section Cmd.
   Lemma valid_expr_not_special3 {t}
         (e1 : @API.expr (fun _ => unit) t)
         (e2 : @API.expr API.interp_type t)
-        (e3 : @API.expr ltype t) G :
+        (e3 : @API.expr ltype t) G r :
     valid_expr false e1 ->
     wf3 G e1 e2 e3 ->
-    translate_if_special3 e3 = None.
+    translate_if_special3 e3 r = None.
   Proof.
     induction 1; intros; invert_wf3_until_exposed; reflexivity.
   Qed.
@@ -417,22 +416,76 @@ Section Cmd.
   Lemma valid_expr_not_special4 {t}
         (e1 : @API.expr (fun _ => unit) t)
         (e2 : @API.expr API.interp_type t)
-        (e3 : @API.expr ltype t) G :
+        (e3 : @API.expr ltype t) G r :
     valid_expr false e1 ->
     wf3 G e1 e2 e3 ->
-    translate_if_special4 e3 = None.
+    translate_if_special4 e3 r = None.
   Proof.
     induction 1; intros; invert_wf3_until_exposed; reflexivity.
   Qed.
 
-  Lemma invert_App_Z_cast_Some {var} (x : @API.expr var type_Z) r :
+  (* TODO: move somewhere appropriate in the rewriter *)
+  Lemma invert_App_Z_cast_Some {var} (e : @API.expr var type_Z) r x :
+    invert_expr.invert_App_Z_cast e = Some (r, x) ->
+    e = (expr.App (expr.App (expr.Ident ident.Z_cast)
+                            (expr.Ident (ident.Literal (t:=Compilers.zrange) r))) x).
+  Proof.
+    cbv [invert_expr.invert_App_Z_cast Crypto.Util.Option.bind].
+    lazymatch goal with
+    | |- context [invert_expr.invert_App ?x] =>
+      let H := fresh in
+      destruct (invert_expr.invert_App x) as [ [? [? ?] ] | ] eqn:H;
+        [ | congruence ];
+        apply Inversion.Compilers.expr.invert_App_Some in H
+    end.
+    cbn [fst snd projT2] in *; subst.
+    break_match; try congruence; [ ]. intros.
+    repeat lazymatch goal with
+           | H : Some _ = Some _ |- _ => inversion H; subst; clear H
+           | H : invert_expr.invert_Z_cast _ = Some _ |- _ =>
+             apply InversionExtra.Compilers.expr.invert_Z_cast_Some_Z in H;
+               subst
+           end.
+    reflexivity.
+  Qed.
+
+  (* TODO: move somewhere appropriate in the rewriter *)
+  Lemma invert_App_Z_cast2_Some {var} (e : @API.expr var type_ZZ) r1 r2 x :
+    invert_expr.invert_App_Z_cast2 e = Some (r1, r2, x) ->
+    e = (expr.App (expr.App (expr.Ident ident.Z_cast2)
+                            (expr.App (expr.App (expr.Ident ident.pair)
+                                                (expr.Ident (ident.Literal (t:=Compilers.zrange) r1)))
+                                      (expr.Ident (ident.Literal (t:=Compilers.zrange) r2)))) x).
+  Proof.
+    cbv [invert_expr.invert_App_Z_cast2 Crypto.Util.Option.bind].
+    lazymatch goal with
+    | |- context [invert_expr.invert_App ?x] =>
+      let H := fresh in
+      destruct (invert_expr.invert_App x) as [ [? [? ?] ] | ] eqn:H;
+        [ | congruence ];
+        apply Inversion.Compilers.expr.invert_App_Some in H
+    end.
+    cbn [fst snd projT2] in *; subst.
+    break_match; try congruence; [ ]. intros.
+    repeat lazymatch goal with
+           | H : Some _ = Some _ |- _ => inversion H; subst; clear H
+           | H : invert_expr.invert_Z_cast2 _ = Some _ |- _ =>
+             apply InversionExtra.Compilers.expr.invert_Z_cast2_Some_ZZ in H;
+               subst
+           end.
+    reflexivity.
+  Qed.
+
+  (* TODO: move somewhere appropriate in the rewriter *)
+  Lemma invert_App_Z_cast_eq_Some {var} (x : @API.expr var type_Z) r :
     invert_expr.invert_App_Z_cast
       (expr.App (expr.App (expr.Ident ident.Z_cast)
                           (expr.Ident (ident.Literal r)))
                 x) = Some (r, x).
   Proof. reflexivity. Qed.
 
-  Lemma invert_App_Z_cast2_Some {var} (x : @API.expr var type_ZZ) r1 r2 :
+  (* TODO: move somewhere appropriate in the rewriter *)
+  Lemma invert_App_Z_cast2_eq_Some {var} (x : @API.expr var type_ZZ) r1 r2 :
     invert_expr.invert_App_Z_cast2
       (expr.App (expr.App (expr.Ident ident.Z_cast2)
                           (expr.App (expr.App (expr.Ident ident.pair)
@@ -451,10 +504,10 @@ Section Cmd.
   Proof.
     induction 1; intros; invert_wf3_until_exposed;
       try reflexivity; cbv [translate_if_special_function invert_expr.invert_App_cast].
-    { rewrite invert_App_Z_cast_Some.
+    { rewrite invert_App_Z_cast_eq_Some.
       cbn. erewrite valid_expr_not_special3, valid_expr_not_special4 by eauto.
       break_innermost_match; reflexivity. }
-    { rewrite invert_App_Z_cast2_Some.
+    { rewrite invert_App_Z_cast2_eq_Some.
       cbn. erewrite valid_expr_not_special3, valid_expr_not_special4 by eauto.
       break_innermost_match; reflexivity. }
   Qed.
@@ -584,6 +637,7 @@ Section Cmd.
     reflexivity.
   Qed.
 
+  (* TODO: move somewhere appropriate in the rewriter *)
   Lemma invert_Literal_eq_Some {var t} (x : Compilers.base_interp t) :
     invert_expr.invert_Literal (var:=var) (expr.Ident (ident.Literal x)) = Some x.
   Proof. reflexivity. Qed.
@@ -649,18 +703,21 @@ Section Cmd.
     reflexivity.
   Qed.
 
+  (* TODO: move somewhere appropriate in the rewriter *)
   Lemma invert_AppIdent3_eq_Some {base_type ident var a b c d} (i : ident (a -> b -> c -> d)%etype)
         (x : expr a) (y : expr b) (z : expr c) :
     @invert_AppIdent3 base_type ident var _ (expr.App (expr.App (expr.App (expr.Ident i) x) y) z)
     = Some (existT _ (a, b, c) (i, x, y, z)).
   Proof. reflexivity. Qed.
 
+  (* TODO: move somewhere appropriate in the rewriter *)
   Lemma invert_AppIdent4_eq_Some {base_type ident var a b c d e} (i : ident (a -> b -> c -> d -> e)%etype)
         (w : expr a) (x : expr b) (y : expr c) (z : expr d):
     @invert_AppIdent4 base_type ident var _ (expr.App (expr.App (expr.App (expr.App (expr.Ident i) w) x) y) z)
     = Some (existT _ (a, b, c,d ) (i, w, x, y, z)).
   Proof. reflexivity. Qed.
 
+  (* TODO: move somewhere appropriate in the rewriter *)
   Lemma invert_AppIdent3_Some {base_type ident var t} v e :
     @invert_AppIdent3 base_type ident var t e = Some v ->
     e = (expr.App (expr.App (expr.App (expr.Ident (fst (fst (fst (projT2 v)))))
@@ -689,6 +746,7 @@ Section Cmd.
     inversion 1. subst; cbn [fst snd projT2].
     reflexivity.
   Qed.
+  (* TODO: move somewhere appropriate in the rewriter *)
   Lemma invert_AppIdent4_Some {base_type ident var t} v e :
     @invert_AppIdent4 base_type ident var t e = Some v ->
     e = (expr.App (expr.App (expr.App (expr.App
@@ -720,9 +778,14 @@ Section Cmd.
     reflexivity.
   Qed.
 
+  Lemma is_carry_range_eq r : is_carry_range r = true -> r = {| ZRange.lower := 0; ZRange.upper := 1 |}.
+  Proof.
+    cbv [is_carry_range]. intro H; apply ZRange.zrange_bl in H. congruence.
+  Qed.
+
   Lemma translate_add_get_carry (x y : API.expr type_Z) r1 r2 :
     range_good (width:=width) r1 = true ->
-    range_good (width:=width) r2 = true ->
+    is_carry_range r2 = true ->
     translate_if_special_function
       (expr.App
          (expr.App (expr.Ident ident.Z_cast2)
@@ -742,24 +805,25 @@ Section Cmd.
               (2%nat, (sum,carry), Syntax.cmd.call [sum;carry] add_carryx [(translate_expr true x); (translate_expr true y); Syntax.expr.literal 0])).
   Proof.
     cbv [translate_if_special_function]; intros.
-    repeat lazymatch goal with H : range_good ?r = true |- _ => apply range_good_eq in H; subst end.
     cbn [invert_expr.invert_App_cast].
-    rewrite invert_App_Z_cast2_Some.
-    cbn [Crypto.Util.Option.bind fst snd range_type_good range_base_good].
-    rewrite !max_range_good. cbn [andb].
+    rewrite invert_App_Z_cast2_eq_Some.
+    cbn [Crypto.Util.Option.bind fst snd].
     cbv [translate_if_special3]. rewrite invert_AppIdent3_eq_Some.
     cbn [Crypto.Util.Option.bind fst snd].
     cbv [translate_ident_special3].
     cbn [type.domain]. rewrite invert_Literal_eq_Some.
     cbn [Crypto.Util.Option.bind fst snd].
+    repeat lazymatch goal with
+           | H : ?x = true |- context [?x] => rewrite H
+           end.
+    cbn [andb].
     rewrite Z.eqb_refl. reflexivity.
   Qed.
 
   Lemma translate_add_with_get_carry (c x y : API.expr type_Z) rc r1 r2 :
     range_good (width:=width) r1 = true ->
-    range_good (width:=width) r2 = true ->
-    ZRange.lower rc = 0 ->
-    ZRange.upper rc = 1 ->
+    is_carry_range r2 = true ->
+    is_carry_range rc = true ->
     translate_if_special_function
       (expr.App
          (expr.App (expr.Ident ident.Z_cast2)
@@ -789,32 +853,28 @@ Section Cmd.
                                                    (Syntax.expr.literal 1)])).
   Proof.
     cbv [translate_if_special_function]; intros.
-    repeat lazymatch goal with H : range_good ?r = true |- _ => apply range_good_eq in H; subst end.
     cbn [invert_expr.invert_App_cast].
-    rewrite invert_App_Z_cast2_Some.
-    cbn [Crypto.Util.Option.bind fst snd range_type_good range_base_good].
-    rewrite !max_range_good. cbn [andb].
+    rewrite invert_App_Z_cast2_eq_Some.
+    cbn [Crypto.Util.Option.bind fst snd].
     lazymatch goal with
-    | |- context [translate_if_special3 ?x] =>
+    | |- context [translate_if_special3 ?x ?r] =>
       lazymatch type of x with
       | API.expr ?t =>
-        change (translate_if_special3 x) with (@None (nat -> nat * ltype t * Syntax.cmd.cmd))
+        change (translate_if_special3 x r) with (@None (nat -> nat * ltype t * Syntax.cmd.cmd))
       end
     end.
     cbn iota. cbv [translate_if_special4].
     rewrite invert_AppIdent4_eq_Some.
     cbn [Crypto.Util.Option.bind fst snd].
     cbv [translate_ident_special4].
-    rewrite invert_App_Z_cast_Some.
+    rewrite invert_App_Z_cast_eq_Some.
     cbn [Crypto.Util.Option.bind fst snd].
     cbn [type.domain]. rewrite invert_Literal_eq_Some.
     cbn [Crypto.Util.Option.bind fst snd].
     repeat lazymatch goal with
-           | H : ZRange.upper ?r = _ |- context [ZRange.upper ?r] => rewrite H
-           | H : ZRange.lower ?r = _ |- context [ZRange.lower ?r] => rewrite H
+           | H : ?x = true |- context [?x] => rewrite H; cbn [andb]
            end.
-    rewrite !Z.eqb_refl. cbn [andb].
-    reflexivity.
+    rewrite !Z.eqb_refl. reflexivity.
   Qed.
 
   Local Ltac simplify :=
diff --git a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v
index 193f81a6a3..60d9fb0a41 100644
--- a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v
+++ b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v
@@ -8,6 +8,7 @@ Require Import coqutil.Word.Interface coqutil.Word.Properties.
 Require Import coqutil.Map.Interface.
 Require Import Crypto.Bedrock.Field.Common.Types.
 Require Import Crypto.Bedrock.Field.Common.Tactics.
+Require Import Crypto.Bedrock.Field.Translation.Cmd.
 Require Import Crypto.Bedrock.Field.Translation.Proofs.Expr.
 Require Import Crypto.Bedrock.Field.Translation.Proofs.Cmd.
 Require Import Crypto.Bedrock.Field.Translation.Proofs.ValidComputable.Expr.
@@ -64,67 +65,71 @@ Section Cmd.
     | _ => fun _ => false
     end.
 
+  Definition is_add_get_carry_ident {t} (i : ident.ident t) : bool :=
+    match i with
+    | ident.Z_add_get_carry => true
+    | _ => false
+    end.
+
+  Definition is_add_with_get_carry_ident {t} (i : ident.ident t) : bool :=
+    match i with
+    | ident.Z_add_with_get_carry => true
+    | _ => false
+    end.
+
   Definition valid_ident_special3 {a b c d} (i : ident (a -> b -> c -> d))
     : @API.expr (fun _ => unit) a
       -> @API.expr (fun _ => unit) b
       -> @API.expr (fun _ => unit) c
-      -> bool
-    := match i in ident t return
-             API.expr (type.domain t) ->
-             API.expr (type.domain (type.codomain t)) ->
-             API.expr (type.domain (type.codomain (type.codomain t))) ->
-             bool with
-       | ident.Z_add_get_carry =>
-         fun s x y =>
-           match invert_expr.invert_Literal s with
-           | None => false
-           | Some s => s =? 2 ^ width
-           end
-       | _ => fun _ _ _ => false
-       end.
+      -> bool :=
+    if is_add_get_carry_ident i
+    then (fun s x y => is_literalz s (2 ^ width))
+    else (fun _ _ _ => false).
+
+  Definition valid_carry_bool {t} : @API.expr (fun _ => unit) t -> bool :=
+    match t with
+    | type_Z =>
+      fun c =>
+        match invert_expr.invert_App_Z_cast c with
+          | Some rc =>
+            if ((ZRange.lower (fst rc) =? 0) && (ZRange.upper (fst rc) =? 1))%bool
+            then valid_expr_bool false (snd rc)
+            else false
+          | None => false
+        end
+    | _ => fun _ => false
+    end.
 
   Definition valid_ident_special4 {a b c d e} (i : ident (a -> b -> c -> d -> e))
     : @API.expr (fun _ => unit) a
       -> @API.expr (fun _ => unit) b
       -> @API.expr (fun _ => unit) c
       -> @API.expr (fun _ => unit) d
-      -> bool
-    := match i in ident t return
-             API.expr (type.domain t) ->
-             API.expr (type.domain (type.codomain t)) ->
-             API.expr (type.domain (type.codomain (type.codomain t))) ->
-             API.expr (type.domain (type.codomain (type.codomain (type.codomain t)))) ->
-             bool with
-       | ident.Z_add_with_get_carry =>
-         fun s c x y =>
-           match invert_expr.invert_Literal s with
-           | None => false
-           | Some s =>
-             match invert_expr.invert_App_Z_cast c with
-             | None => false
-             | Some rc =>
-               if ((ZRange.lower (fst rc) =? 0) && (ZRange.upper (fst rc) =? 1))%bool
-               then s =? 2 ^ width
-               else false
-             end
-           end
-       | _ => fun _ _ _ _ => false
-       end.
+      -> bool :=
+    if is_add_with_get_carry_ident i
+    then (fun s c x y => is_literalz s (2 ^ width) && valid_carry_bool c)
+    else (fun _ _ _ _ => false).
 
   Definition valid_special3_bool {t} (e : @API.expr (fun _ => unit) t) : bool :=
-    match Cmd.invert_AppIdent3_cps e (fun _ x => x) (fun _ x => x) (fun _ x => x) with
+    match invert_AppIdent3 e with
     | Some (existT _ (i, x, y, z)) => valid_ident_special3 i x y z
     | None => false
     end.
 
   Definition valid_special4_bool {t} (e : @API.expr (fun _ => unit) t) : bool :=
-    match Cmd.invert_AppIdent4_cps e (fun _ x => x) (fun _ x => x) (fun _ x => x) (fun _ x => x) with
+    match invert_AppIdent4 e with
     | Some (existT _ (i, w, x, y, z)) => valid_ident_special4 i w x y z
     | None => false
     end.
 
   Definition valid_special_bool {t} (e : @API.expr (fun _ => unit) t) : bool :=
-    valid_special3_bool e || valid_special4_bool e.
+    match invert_expr.invert_App_cast e with
+    | Some rx =>
+      if range_type_good (width:=width) (fst rx)
+      then valid_special3_bool (snd rx) || valid_special4_bool (snd rx)
+      else false
+    | None => false
+    end.
 
   Fixpoint valid_cmd_bool
            {t} (e : @API.expr (fun _ => unit) t) : bool :=
@@ -162,15 +167,74 @@ Section Cmd.
     constructor; eauto.
   Qed.
 
+  Lemma is_add_get_carry_ident_eq {t} i :
+    @is_add_get_carry_ident t i = true ->
+    (match t as t0 return ident.ident t0 -> Prop with
+     | type.arrow type_Z (type.arrow type_Z (type.arrow type_Z type_ZZ)) =>
+       fun i => i = ident.Z_add_get_carry
+     | _ => fun _ => False
+     end) i.
+  Proof.
+    cbv [is_add_get_carry_ident]; break_match; congruence.
+  Qed.
+
+  Lemma is_literalz_eq t (e : API.expr t) (x : Z) :
+    is_literalz e x = true ->
+    (match t as t0 return API.expr t0 -> Prop with
+     | type_Z => fun e => e = expr.Ident (ident.Literal (t:=Compilers.Z) x)
+     | _ => fun _ => False
+     end) e.
+  Proof.
+    cbv [is_literalz]. break_match; try congruence; [ ].
+    rewrite Z.eqb_eq; intros; subst; reflexivity.
+  Qed.
+
+  (*
+  Lemma valid_ident_special3_valid_cmd a b c d t i x y z (f : unit -> API.expr t) :
+    @valid_ident_special3 a b c d i x y z = true ->
+    valid_cmd (t:=t) (f tt) ->
+    valid_cmd (expr_let x := (expr.App (#i @ x @ y @ z) in
+                     f x).
+  Proof.
+    cbv [valid_ident_special3].
+    break_match; intros; [ | congruence ].
+    repeat lazymatch goal with
+           | H : is_add_get_carry_ident _ = true |- _ =>
+             apply is_add_get_carry_ident_eq in H;
+               break_match_hyps; try contradiction; [ ];
+                 subst
+           | H : is_literalz _ _ = true |- _ =>
+             apply is_literalz_eq in H; subst
+           end.
+    apply is_literalz_eq in H.
+  Qed. *)
+
+  (*
   Lemma valid_special3_valid_cmd {s d} f x :
     valid_special3_bool (t:=s) x = true ->
     valid_cmd (t:=d) (f tt) ->
     valid_cmd (t:=d) (expr.LetIn x f).
   Proof.
     cbv [valid_special3_bool].
-    cbv [Cmd.invert_AppIdent3_cps].
-    rewrite Inversion.Compilers.expr.invert_App_cps_id.
-  Qed.
+    break_match; [ | congruence ].
+    lazymatch goal with
+    | H : invert_AppIdent3 _ = Some _ |- _ =>
+      apply invert_AppIdent3_Some in H
+    end.
+    subst; cbn [fst snd projT2].
+    cbv [valid_ident_special3].
+    break_match; intros; [ | congruence ].
+    repeat lazymatch goal with
+           | H : is_add_get_carry_ident _ = true |- _ =>
+             apply is_add_get_carry_ident_eq in H;
+               break_match_hyps; try contradiction; [ ];
+                 subst
+           | H : is_literalz _ _ = true |- _ =>
+             apply is_literalz_eq in H; subst
+           end.
+    destruct i.
+    break_match.
+  Qed. *)
 
   Lemma valid_special_valid_cmd {s d} f x :
     valid_special_bool (t:=s) x = true ->
@@ -178,6 +242,32 @@ Section Cmd.
     valid_cmd (t:=d) (expr.LetIn x f).
   Proof.
     cbv [valid_special_bool].
+    break_match; try congruence; [ ].
+    repeat lazymatch goal with p : _ * _ |- _ => destruct p end; cbn [fst snd] in *.
+    lazymatch goal with
+    | |- (_ || _) = true -> _ =>
+      let H := fresh in intro H; rewrite orb_true_iff in H; destruct H
+    end.
+    { (* valid 3-argument function *)
+      cbv [valid_special3_bool] in *.
+      break_match_hyps; try congruence; [ ].
+      lazymatch goal with
+      | H : invert_AppIdent3 _ = Some _ |- _ =>
+        apply invert_AppIdent3_Some in H
+      end.
+      subst; cbn [fst snd projT2] in *.
+      cbv [valid_ident_special3] in *.
+      break_match_hyps; intros; [ | congruence ].
+      repeat lazymatch goal with
+             | p : _ * _ |- _ => destruct p; cbn [fst snd] in *
+             | H : is_add_get_carry_ident _ = true |- _ =>
+               apply is_add_get_carry_ident_eq in H;
+                 break_match_hyps; try contradiction; [ ];
+                   subst
+             | H : is_literalz _ _ = true |- _ =>
+               apply is_literalz_eq in H; subst
+             end.
+    destruct i.
   Qed.
 
   Lemma is_nil_ident_valid {t} i :

From e62d661fe525d4197680fc6fac6eb79af86ee10a Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Fri, 11 Aug 2023 14:44:24 +0200
Subject: [PATCH 11/34] wip

---
 src/Bedrock/Field/Translation/Proofs/Cmd.v | 39 ++++++++++++++++------
 1 file changed, 28 insertions(+), 11 deletions(-)

diff --git a/src/Bedrock/Field/Translation/Proofs/Cmd.v b/src/Bedrock/Field/Translation/Proofs/Cmd.v
index 96ab449043..197f49d7dc 100644
--- a/src/Bedrock/Field/Translation/Proofs/Cmd.v
+++ b/src/Bedrock/Field/Translation/Proofs/Cmd.v
@@ -512,11 +512,16 @@ Section Cmd.
       break_innermost_match; reflexivity. }
   Qed.
 
+  Lemma is_carry_range_eq r : is_carry_range r = true -> r = {| ZRange.lower := 0; ZRange.upper := 1 |}.
+  Proof.
+    cbv [is_carry_range]. intro H; apply ZRange.zrange_bl in H. congruence.
+  Qed.
+
   (* Convenience lemma for add_with_get_carry case. *)
   Lemma add_get_carry_full_equiv (x y sum carry_out : @word.rep width word) r1 r2:
     word.unsigned sum + 2^width * word.unsigned carry_out
     = word.unsigned x + word.unsigned y ->
-    range_good (width:=width) r1 = true -> range_good (width:=width) r2 = true ->
+    range_good (width:=width) r1 = true -> is_carry_range r2 = true ->
     PreExtra.ident.cast2
       (r1, r2)
       (Definitions.Z.add_get_carry_full
@@ -530,6 +535,7 @@ Section Cmd.
     pose proof (Properties.word.unsigned_range carry_out).
     repeat lazymatch goal with
            | H : range_good _ = true |- _ => apply range_good_eq in H; subst
+           | H : is_carry_range _ = true |- _ => apply is_carry_range_eq in H; subst
            end.
     cbv [Definitions.Z.add_get_carry_full
            Definitions.Z.add_with_get_carry
@@ -542,6 +548,13 @@ Section Cmd.
     cbn [fst snd]. rewrite Z.log2_pow2, Z.eqb_refl by lia.
     cbn [fst snd]. rewrite Z.add_0_l.
     rewrite !CastLemmas.ident.cast_in_bounds by (apply is_bounded_by_bool_max_range; Z.div_mod_to_equations; nia).
+    rewrite CastLemmas.ident.cast_in_bounds.
+    2:{
+      cbv [ZRange.is_bounded_by_bool].
+      rewrite !Zle_imp_le_bool
+              by (cbn [ZRange.upper ZRange.lower];
+                  Z.div_mod_to_equations; nia).
+      reflexivity. }
     rewrite <-Heq. apply f_equal2.
     { Z.push_mod. rewrite Z.mod_same by lia. Z.push_pull_mod.
       rewrite Z.mod_small; lia. }
@@ -552,7 +565,8 @@ Section Cmd.
   Lemma add_with_get_carry_full_equiv (x y sum carry_in carry_out : @word.rep width word) r1 r2:
     word.unsigned sum + 2^width * word.unsigned carry_out
     = word.unsigned carry_in + word.unsigned x + word.unsigned y ->
-    range_good (width:=width) r1 = true -> range_good (width:=width) r2 = true ->
+    0 <= word.unsigned carry_in < 2 ->
+    range_good (width:=width) r1 = true -> is_carry_range r2 = true ->
     PreExtra.ident.cast2
       (r1, r2)
       (Definitions.Z.add_with_get_carry_full
@@ -567,6 +581,7 @@ Section Cmd.
     pose proof (Properties.word.unsigned_range carry_out).
     repeat lazymatch goal with
            | H : range_good _ = true |- _ => apply range_good_eq in H; subst
+           | H : is_carry_range _ = true |- _ => apply is_carry_range_eq in H; subst
            end.
     cbv [Definitions.Z.add_with_get_carry_full
            Definitions.Z.add_with_get_carry
@@ -578,6 +593,13 @@ Section Cmd.
     cbn [fst snd]. rewrite Z.log2_pow2, Z.eqb_refl by lia.
     cbn [fst snd].
     rewrite !CastLemmas.ident.cast_in_bounds by (apply is_bounded_by_bool_max_range; Z.div_mod_to_equations; nia).
+    rewrite CastLemmas.ident.cast_in_bounds.
+    2:{
+      cbv [ZRange.is_bounded_by_bool].
+      rewrite !Zle_imp_le_bool
+              by (cbn [ZRange.upper ZRange.lower];
+                  Z.div_mod_to_equations; nia).
+      reflexivity. }
     rewrite <-Heq. apply f_equal2.
     { Z.push_mod. rewrite Z.mod_same by lia. Z.push_pull_mod.
       rewrite Z.mod_small; lia. }
@@ -627,10 +649,9 @@ Section Cmd.
     reflexivity.
   Qed.
 
-  Lemma interp_cast_carry r x :
-    ZRange.lower r = 0 -> ZRange.upper r = 1 -> PreExtra.ident.cast r x = word.wrap x mod 2.
+  Lemma interp_cast_carry r x : is_carry_range r = true -> PreExtra.ident.cast r x = word.wrap x mod 2.
   Proof.
-    destruct r; cbn [ZRange.lower ZRange.upper]; intros; subst.
+    intro Hrange; apply is_carry_range_eq in Hrange. intros; subst.
     rewrite CastLemmas.ident.cast_out_of_bounds_simple_0_mod by lia.
     pose proof word.width_pos. cbv [word.wrap].
     rewrite Modulo.Z.mod_pow_same_base_smaller with (m:=1); try lia.
@@ -778,11 +799,6 @@ Section Cmd.
     reflexivity.
   Qed.
 
-  Lemma is_carry_range_eq r : is_carry_range r = true -> r = {| ZRange.lower := 0; ZRange.upper := 1 |}.
-  Proof.
-    cbv [is_carry_range]. intro H; apply ZRange.zrange_bl in H. congruence.
-  Qed.
-
   Lemma translate_add_get_carry (x y : API.expr type_Z) r1 r2 :
     range_good (width:=width) r1 = true ->
     is_carry_range r2 = true ->
@@ -1291,7 +1307,8 @@ Section Cmd.
           replace (PreExtra.ident.cast r c)
             with (word.unsigned (word:=word)
                                 (Semantics.interp_binop Syntax.bopname.and (word.of_Z x) (word.of_Z 1)))
-        end; [ erewrite add_with_get_carry_full_equiv; solve [eauto with lia] | ].
+        end; [ erewrite add_with_get_carry_full_equiv; try solve [eauto with lia];
+               rewrite interp_and_carry; apply Z.mod_pos_bound; lia | ].
         rewrite interp_and_carry, interp_cast_carry by auto.
         rewrite word.unsigned_of_Z. reflexivity. } }
   Qed.

From f0a8ad20c39a1b1a07575e4be7a46e101881f126 Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Fri, 11 Aug 2023 15:52:19 +0200
Subject: [PATCH 12/34] func proof works

---
 src/Bedrock/Field/Translation/Proofs/Func.v   |   6 +-
 .../Translation/Proofs/ValidComputable/Cmd.v  | 250 +++++++++++++-----
 2 files changed, 191 insertions(+), 65 deletions(-)

diff --git a/src/Bedrock/Field/Translation/Proofs/Func.v b/src/Bedrock/Field/Translation/Proofs/Func.v
index d39f4899f7..45dd52c5e9 100644
--- a/src/Bedrock/Field/Translation/Proofs/Func.v
+++ b/src/Bedrock/Field/Translation/Proofs/Func.v
@@ -89,6 +89,8 @@ Section Func.
              (locals : locals)
              (mem : mem)
              (functions : list (string*func)),
+        (* specifications of bedrock2 functions we might call *)
+        spec_of_add_carryx (add_carryx:=add_carryx) functions ->
         (* locals doesn't contain variables we could overwrite *)
         (forall n nvars,
             (nextn <= n)%nat ->
@@ -113,7 +115,7 @@ Section Func.
                (listZ:=rep.listZ_local) ret1 ret2 locals').
   Proof.
     revert G. cbv zeta.
-    induction e0_valid; intros *.
+    induction e0_valid; intros *; [ | ].
     { (* Abs *)
       inversion 1; cleanup_wf.
       cbn [translate_func']; intros.
@@ -514,6 +516,8 @@ Section Func.
              (argvalues : list word)
              (functions : list (string*func))
              (R : _ -> Prop),
+        (* specifications of bedrock2 functions we might call *)
+        spec_of_add_carryx (add_carryx:=add_carryx) functions ->
         (* argument values are the concatenation of true argument values
            and output pointer values *)
         argvalues = out_ptrs ++ flat_args ->
diff --git a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v
index 60d9fb0a41..5842fb0c7c 100644
--- a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v
+++ b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v
@@ -65,12 +65,22 @@ Section Cmd.
     | _ => fun _ => false
     end.
 
+  Local Notation range_for_type t :=
+    (type.interp (Language.Compilers.base.interp (base:=Compilers.base) (fun _ => ZRange.zrange)) t).
+
   Definition is_add_get_carry_ident {t} (i : ident.ident t) : bool :=
     match i with
     | ident.Z_add_get_carry => true
     | _ => false
     end.
 
+  Definition is_word_and_carry_range {t} : range_for_type t -> bool :=
+    match t as t0 return range_for_type t0 -> bool with
+    | type_ZZ => fun r : range_for_type type_ZZ =>
+                 Expr.range_good (width:=width) (fst r) && is_carry_range (snd r)
+    | _ => fun _ => false
+    end.
+
   Definition is_add_with_get_carry_ident {t} (i : ident.ident t) : bool :=
     match i with
     | ident.Z_add_with_get_carry => true
@@ -81,10 +91,15 @@ Section Cmd.
     : @API.expr (fun _ => unit) a
       -> @API.expr (fun _ => unit) b
       -> @API.expr (fun _ => unit) c
+      -> range_for_type d
       -> bool :=
     if is_add_get_carry_ident i
-    then (fun s x y => is_literalz s (2 ^ width))
-    else (fun _ _ _ => false).
+    then (fun s x y r =>
+            is_literalz s (2 ^ width)
+            && valid_expr_bool true x
+            && valid_expr_bool true y
+            && is_word_and_carry_range r)
+    else (fun _ _ _ _ => false).
 
   Definition valid_carry_bool {t} : @API.expr (fun _ => unit) t -> bool :=
     match t with
@@ -92,7 +107,7 @@ Section Cmd.
       fun c =>
         match invert_expr.invert_App_Z_cast c with
           | Some rc =>
-            if ((ZRange.lower (fst rc) =? 0) && (ZRange.upper (fst rc) =? 1))%bool
+            if is_carry_range (fst rc)
             then valid_expr_bool false (snd rc)
             else false
           | None => false
@@ -105,29 +120,33 @@ Section Cmd.
       -> @API.expr (fun _ => unit) b
       -> @API.expr (fun _ => unit) c
       -> @API.expr (fun _ => unit) d
+      -> range_for_type e
       -> bool :=
     if is_add_with_get_carry_ident i
-    then (fun s c x y => is_literalz s (2 ^ width) && valid_carry_bool c)
-    else (fun _ _ _ _ => false).
+    then (fun s c x y r =>
+            is_literalz s (2 ^ width)
+            && valid_expr_bool true x
+            && valid_expr_bool true y
+            && valid_carry_bool c
+            && is_word_and_carry_range r)
+    else (fun _ _ _ _ _ => false).
 
-  Definition valid_special3_bool {t} (e : @API.expr (fun _ => unit) t) : bool :=
+  Definition valid_special3_bool {t} (e : @API.expr (fun _ => unit) t) (r : range_for_type t) : bool :=
     match invert_AppIdent3 e with
-    | Some (existT _ (i, x, y, z)) => valid_ident_special3 i x y z
+    | Some (existT _ (i, x, y, z)) => valid_ident_special3 i x y z r
     | None => false
     end.
 
-  Definition valid_special4_bool {t} (e : @API.expr (fun _ => unit) t) : bool :=
+  Definition valid_special4_bool {t} (e : @API.expr (fun _ => unit) t) (r : range_for_type t) : bool :=
     match invert_AppIdent4 e with
-    | Some (existT _ (i, w, x, y, z)) => valid_ident_special4 i w x y z
+    | Some (existT _ (i, w, x, y, z)) => valid_ident_special4 i w x y z r
     | None => false
     end.
 
   Definition valid_special_bool {t} (e : @API.expr (fun _ => unit) t) : bool :=
     match invert_expr.invert_App_cast e with
     | Some rx =>
-      if range_type_good (width:=width) (fst rx)
-      then valid_special3_bool (snd rx) || valid_special4_bool (snd rx)
-      else false
+      valid_special3_bool (snd rx) (fst rx) || valid_special4_bool (snd rx) (fst rx)
     | None => false
     end.
 
@@ -178,6 +197,41 @@ Section Cmd.
     cbv [is_add_get_carry_ident]; break_match; congruence.
   Qed.
 
+  Lemma is_add_with_get_carry_ident_eq {t} i :
+    @is_add_with_get_carry_ident t i = true ->
+    (match t as t0 return ident.ident t0 -> Prop with
+     | type.arrow type_Z (type.arrow type_Z (type.arrow type_Z (type.arrow type_Z type_ZZ))) =>
+       fun i => i = ident.Z_add_with_get_carry
+     | _ => fun _ => False
+     end) i.
+  Proof.
+    cbv [is_add_with_get_carry_ident]; break_match; congruence.
+  Qed.
+
+  Lemma valid_carry_bool_eq {t} e :
+    valid_carry_bool e = true ->
+    (match t as t0 return API.expr t0 -> Prop with
+     | type_Z => fun e =>
+                  exists (r : ZRange.zrange) (x : API.expr type_Z),
+                    e = expr.App (expr.App (expr.Ident ident.Z_cast)
+                                           (expr.Ident (ident.Literal
+                                                          (t:=Compilers.zrange)
+                                                          r)))
+                                 x
+                    /\ valid_expr_bool false x = true
+                    /\ is_carry_range r = true
+     | _ => fun _ => False
+     end) e.
+  Proof.
+    cbv [valid_carry_bool]. break_match; try congruence; [ ].
+    repeat lazymatch goal with
+           | p : _ * _ |- _ => destruct p; cbn [fst snd] in *
+           | H : invert_expr.invert_App_Z_cast _ = Some (_,_) |- _ =>
+             apply invert_App_Z_cast_Some in H; subst
+           end.
+    intros; do 2 eexists; repeat split; try reflexivity; auto.
+  Qed.
+
   Lemma is_literalz_eq t (e : API.expr t) (x : Z) :
     is_literalz e x = true ->
     (match t as t0 return API.expr t0 -> Prop with
@@ -189,57 +243,17 @@ Section Cmd.
     rewrite Z.eqb_eq; intros; subst; reflexivity.
   Qed.
 
-  (*
-  Lemma valid_ident_special3_valid_cmd a b c d t i x y z (f : unit -> API.expr t) :
-    @valid_ident_special3 a b c d i x y z = true ->
-    valid_cmd (t:=t) (f tt) ->
-    valid_cmd (expr_let x := (expr.App (#i @ x @ y @ z) in
-                     f x).
-  Proof.
-    cbv [valid_ident_special3].
-    break_match; intros; [ | congruence ].
-    repeat lazymatch goal with
-           | H : is_add_get_carry_ident _ = true |- _ =>
-             apply is_add_get_carry_ident_eq in H;
-               break_match_hyps; try contradiction; [ ];
-                 subst
-           | H : is_literalz _ _ = true |- _ =>
-             apply is_literalz_eq in H; subst
-           end.
-    apply is_literalz_eq in H.
-  Qed. *)
-
-  (*
-  Lemma valid_special3_valid_cmd {s d} f x :
-    valid_special3_bool (t:=s) x = true ->
-    valid_cmd (t:=d) (f tt) ->
-    valid_cmd (t:=d) (expr.LetIn x f).
+  Lemma is_word_and_carry_range_eq  (r : range_for_type type_ZZ) :
+    is_word_and_carry_range r = true ->
+    Expr.range_good (width:=width) (fst r) = true /\ is_carry_range (snd r) = true.
   Proof.
-    cbv [valid_special3_bool].
-    break_match; [ | congruence ].
-    lazymatch goal with
-    | H : invert_AppIdent3 _ = Some _ |- _ =>
-      apply invert_AppIdent3_Some in H
-    end.
-    subst; cbn [fst snd projT2].
-    cbv [valid_ident_special3].
-    break_match; intros; [ | congruence ].
-    repeat lazymatch goal with
-           | H : is_add_get_carry_ident _ = true |- _ =>
-             apply is_add_get_carry_ident_eq in H;
-               break_match_hyps; try contradiction; [ ];
-                 subst
-           | H : is_literalz _ _ = true |- _ =>
-             apply is_literalz_eq in H; subst
-           end.
-    destruct i.
-    break_match.
-  Qed. *)
+    cbv [is_word_and_carry_range]. rewrite Bool.andb_true_iff. tauto.
+  Qed.
 
   Lemma valid_special_valid_cmd {s d} f x :
     valid_special_bool (t:=s) x = true ->
-    valid_cmd (t:=d) (f tt) ->
-    valid_cmd (t:=d) (expr.LetIn x f).
+    valid_cmd (t:=type.base d) (f tt) ->
+    valid_cmd (t:=type.base d) (expr.LetIn x f).
   Proof.
     cbv [valid_special_bool].
     break_match; try congruence; [ ].
@@ -260,14 +274,54 @@ Section Cmd.
       break_match_hyps; intros; [ | congruence ].
       repeat lazymatch goal with
              | p : _ * _ |- _ => destruct p; cbn [fst snd] in *
+             | H : (_ && _) = true |- _ => apply Bool.andb_true_iff in H; destruct H
+             | H : @is_word_and_carry_range type_ZZ _ = true |- _ =>
+               apply is_word_and_carry_range_eq in H; destruct H
              | H : is_add_get_carry_ident _ = true |- _ =>
                apply is_add_get_carry_ident_eq in H;
                  break_match_hyps; try contradiction; [ ];
                    subst
              | H : is_literalz _ _ = true |- _ =>
                apply is_literalz_eq in H; subst
-             end.
-    destruct i.
+             | H : invert_expr.invert_App_Z_cast2 _ = Some _ |- _ =>
+               apply invert_App_Z_cast2_Some in H; subst
+             | _ => progress cbn [type.interp Language.Compilers.base.interp
+                                             invert_expr.invert_App_cast] in *
+             end; [ ].
+      { (* add_get_carry *)
+        eapply valid_add_get_carry; eauto;
+          apply valid_expr_bool_iff; auto. } }
+    { (* valid 4-argument function *)
+      cbv [valid_special4_bool] in *.
+      break_match_hyps; try congruence; [ ].
+      lazymatch goal with
+      | H : invert_AppIdent4 _ = Some _ |- _ =>
+        apply invert_AppIdent4_Some in H
+      end.
+      subst; cbn [fst snd projT2] in *.
+      cbv [valid_ident_special4] in *.
+      break_match_hyps; intros; [ | congruence ].
+      repeat lazymatch goal with
+             | p : _ * _ |- _ => destruct p; cbn [fst snd] in *
+             | H : (_ && _) = true |- _ => apply Bool.andb_true_iff in H; destruct H
+             | H : @is_word_and_carry_range type_ZZ _ = true |- _ =>
+               apply is_word_and_carry_range_eq in H; destruct H
+             | H : is_add_with_get_carry_ident _ = true |- _ =>
+               apply is_add_with_get_carry_ident_eq in H;
+                 break_match_hyps; try contradiction; [ ];
+                   subst
+             | H : is_literalz _ _ = true |- _ =>
+               apply is_literalz_eq in H; subst
+             | H : invert_expr.invert_App_Z_cast2 _ = Some _ |- _ =>
+               apply invert_App_Z_cast2_Some in H; subst
+             | H : valid_carry_bool _ = true |- _ =>
+               apply valid_carry_bool_eq in H; destruct H as [? [? [? [? ?] ] ] ]
+             | _ => progress cbn [type.interp Language.Compilers.base.interp
+                                             invert_expr.invert_App_cast] in *
+             end; [ ].
+      { (* add_with_get_carry *)
+        eapply valid_add_with_get_carry; eauto;
+          apply valid_expr_bool_iff; auto. } }
   Qed.
 
   Lemma is_nil_ident_valid {t} i :
@@ -350,15 +404,19 @@ Section Cmd.
             apply valid_expr_bool_iff in H
           | H : is_nil_ident _ = true |- _ =>
             apply is_nil_ident_valid in H; apply H
+          | H : _ || _ = true |- _ =>
+            apply Bool.orb_true_iff in H; destruct H
           | H : _ && _ = true |- _ =>
             apply Bool.andb_true_iff in H; destruct H
+          | H : valid_special_bool _ = true |- _ =>
+            apply valid_special_valid_cmd; solve [eauto]
           | H : false = true |- _ =>
             congruence
           | H : valid_cons_App1_bool _ = true |- _ =>
             apply valid_cons_App1_bool_impl1 in H; apply H;
               solve [eauto]
           | _ => constructor; solve [eauto]
-          end.
+             end.
   Qed.
 
   Lemma valid_cmd_bool_valid_expr {t} e :
@@ -369,15 +427,79 @@ Section Cmd.
     break_match; congruence.
   Qed.
 
+  Lemma valid_special_add_get_carry r1 r2 x y:
+    Expr.range_good (width:=width) r1 = true ->
+    is_carry_range r2 = true ->
+    valid_expr_bool (t:=type_Z) true x = true ->
+    valid_expr_bool (t:=type_Z) true y = true ->
+    valid_special_bool
+      (expr.App
+         (expr.App (expr.Ident ident.Z_cast2)
+                   (expr.App
+                      (expr.App
+                         (expr.Ident ident.pair)
+                         (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
+                      (expr.Ident (ident.Literal (t:=base.type.zrange) r2))))
+         (expr.App
+            (expr.App
+               (expr.App (expr.Ident ident.Z_add_get_carry)
+                         (expr.Ident (ident.Literal (t:=base.type.Z) (2 ^ width))))
+               x) y)) = true.
+  Proof.
+    intros. cbv [valid_special_bool]. cbn [invert_expr.invert_App_cast].
+    rewrite invert_App_Z_cast2_eq_Some. cbn [fst snd].
+    cbn. rewrite Z.eqb_refl.
+    repeat lazymatch goal with
+           | H : _?x = true |- context [?x] => rewrite H end.
+    reflexivity.
+  Qed.
+
+  Lemma valid_special_add_with_get_carry r1 r2 rc c x y:
+    Expr.range_good (width:=width) r1 = true ->
+    is_carry_range r2 = true ->
+    is_carry_range rc = true ->
+    valid_expr_bool (t:=type_Z) false c = true ->
+    valid_expr_bool (t:=type_Z) true x = true ->
+    valid_expr_bool (t:=type_Z) true y = true ->
+    valid_special_bool
+      (expr.App
+         (expr.App (expr.Ident ident.Z_cast2)
+                   (expr.App
+                      (expr.App
+                         (expr.Ident ident.pair)
+                         (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
+                      (expr.Ident (ident.Literal (t:=base.type.zrange) r2))))
+         (expr.App
+            (expr.App
+               (expr.App
+                  (expr.App (expr.Ident ident.Z_add_with_get_carry)
+                            (expr.Ident (ident.Literal (t:=base.type.Z) (2 ^ width))))
+                  (expr.App (expr.App (expr.Ident ident.Z_cast)
+                                      (expr.Ident (ident.Literal (t:=base.type.zrange) rc))) c))
+               x) y)) = true.
+  Proof.
+    intros. cbv [valid_special_bool]. cbn [invert_expr.invert_App_cast].
+    rewrite invert_App_Z_cast2_eq_Some. cbn [fst snd].
+    cbn. rewrite Z.eqb_refl.
+    repeat lazymatch goal with
+           | H : _?x = true |- context [?x] => rewrite H end.
+    reflexivity.
+  Qed.
+
   Lemma valid_cmd_bool_impl2 {t} e :
     valid_cmd e -> @valid_cmd_bool t e = true.
   Proof.
     induction 1; intros; subst; cbn;
       repeat match goal with
-             | H : valid_expr true _ |- _ =>
+             | H : valid_expr _ _ |- _ =>
                apply valid_expr_bool_iff in H
+             | |- _ && _ = true => apply Bool.andb_true_iff; split
+             | H : ?x = true |- ?x || _ = true => apply Bool.orb_true_iff; left; apply H
+             | H : ?x = true |- _ || ?x = true => apply Bool.orb_true_iff; right; apply H
+             | |- context [_ && false] => rewrite Bool.andb_false_r
+             | |- context [false || _] => rewrite Bool.orb_false_l
              end;
-      auto using Bool.andb_true_iff; [ ].
+      auto using valid_special_add_get_carry, valid_special_add_with_get_carry; [ ].
     { apply valid_cmd_bool_valid_expr.
       assumption. }
   Qed.

From 4952bcfb908fd824686b89202fbd87803c74a999 Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Fri, 11 Aug 2023 17:01:45 +0200
Subject: [PATCH 13/34] wip on signature, why is it broken?

---
 src/Bedrock/Field/Synthesis/New/Signature.v | 18 ++++++++++++++----
 1 file changed, 14 insertions(+), 4 deletions(-)

diff --git a/src/Bedrock/Field/Synthesis/New/Signature.v b/src/Bedrock/Field/Synthesis/New/Signature.v
index dd5e21392c..49311f7e5f 100644
--- a/src/Bedrock/Field/Synthesis/New/Signature.v
+++ b/src/Bedrock/Field/Synthesis/New/Signature.v
@@ -154,7 +154,13 @@ Section WithParameters.
     | |- map word.unsigned _ = map word.unsigned _ => reflexivity
     | |- word.unsigned _ = word.unsigned _ => reflexivity
     | |- WeakestPrecondition.get _ _ _ =>
-      repeat (apply Util.get_put_diff; [ congruence | ]);
+      repeat (apply Util.get_put_diff; [
+                cbv [default_inname_gen default_outname_gen]; try congruence;
+                lazymatch goal with
+                | |- prefix_name_gen _ _ <> prefix_name_gen _ _ =>
+                  let H := fresh in
+                  intro H; eapply prefix_name_gen_unique in H; congruence
+                end | ]);
       apply Util.get_put_same; reflexivity
     | |- Forall (fun z => 0 <= z < 2 ^ (?e * 8))
                 (map word.unsigned _) =>
@@ -222,6 +228,7 @@ Section WithParameters.
     | |- API.Wf _ => assumption
     | |- @eq (list word.rep) _ _ => reflexivity
     | |- length [?p] = _ => reflexivity
+    | |- Cmd.spec_of_add_carryx _ => assumption
     | |- forall _, ~ VarnameSet.varname_set_args _ _ =>
       solve [auto using make_innames_varname_gen_disjoint]
     | |- forall _, ~ VarnameSet.varname_set_base (make_outnames _)
@@ -379,7 +386,9 @@ Section WithParameters.
 
     Lemma list_binop_correct f :
       f = make_bedrock_func insizes outsizes inlengths res ->
-      forall functions, (binop_spec _ ((name, f) :: functions)).
+      forall functions,
+        Cmd.spec_of_add_carryx (add_carryx:=add_carryx) functions ->
+        (binop_spec _ ((name, f) :: functions)).
     Proof.
       subst inlengths insizes outsizes.
       cbv [binop_spec list_binop_insizes list_binop_outsizes list_binop_inlengths].
@@ -388,9 +397,10 @@ Section WithParameters.
       2: {
         use_translate_func_correct
           constr:((map word.unsigned x, (map word.unsigned y, tt))) Rr;
-        translate_func_precondition_hammer.
+          translate_func_precondition_hammer; [ ].
         { (* lists_reserved_with_initial_context *)
-          lists_reserved_simplify pout; try solve_equivalence_side_conditions; solve_length out outbounds_length.
+          lists_reserved_simplify pout; try solve_equivalence_side_conditions.
+          solve_length out outbounds_length.
           } }
       { postcondition_simplify; [ | | ]; cycle -1.
         { refine (proj1 (Proper_sep_iff1 _ _ _ _ _ _ _) _);

From 5bd78bf6bb1aa9ba2690afaf2dbe5b6610fd5d95 Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Fri, 11 Aug 2023 17:23:57 +0200
Subject: [PATCH 14/34] signature passing

---
 src/Bedrock/Field/Synthesis/New/Signature.v | 53 +++++++++++++--------
 1 file changed, 32 insertions(+), 21 deletions(-)

diff --git a/src/Bedrock/Field/Synthesis/New/Signature.v b/src/Bedrock/Field/Synthesis/New/Signature.v
index 49311f7e5f..68efc40e4b 100644
--- a/src/Bedrock/Field/Synthesis/New/Signature.v
+++ b/src/Bedrock/Field/Synthesis/New/Signature.v
@@ -154,13 +154,7 @@ Section WithParameters.
     | |- map word.unsigned _ = map word.unsigned _ => reflexivity
     | |- word.unsigned _ = word.unsigned _ => reflexivity
     | |- WeakestPrecondition.get _ _ _ =>
-      repeat (apply Util.get_put_diff; [
-                cbv [default_inname_gen default_outname_gen]; try congruence;
-                lazymatch goal with
-                | |- prefix_name_gen _ _ <> prefix_name_gen _ _ =>
-                  let H := fresh in
-                  intro H; eapply prefix_name_gen_unique in H; congruence
-                end | ]);
+      repeat (apply Util.get_put_diff; [ cbn; congruence | ]);
       apply Util.get_put_same; reflexivity
     | |- Forall (fun z => 0 <= z < 2 ^ (?e * 8))
                 (map word.unsigned _) =>
@@ -399,9 +393,8 @@ Section WithParameters.
           constr:((map word.unsigned x, (map word.unsigned y, tt))) Rr;
           translate_func_precondition_hammer; [ ].
         { (* lists_reserved_with_initial_context *)
-          lists_reserved_simplify pout; try solve_equivalence_side_conditions.
-          solve_length out outbounds_length.
-          } }
+          lists_reserved_simplify pout; try solve_equivalence_side_conditions;
+            solve_length out outbounds_length. } }
       { postcondition_simplify; [ | | ]; cycle -1.
         { refine (proj1 (Proper_sep_iff1 _ _ _ _ _ _ _) _);
             [symmetry; eapply FElem_array_truncated_scalar_iff1 | reflexivity | sepsimpl ].
@@ -473,7 +466,9 @@ Section WithParameters.
 
     Lemma list_unop_correct f :
       f = make_bedrock_func insizes outsizes inlengths res ->
-      forall functions, unop_spec _ ((name, f) :: functions).
+      forall functions,
+        Cmd.spec_of_add_carryx (add_carryx:=add_carryx) functions ->
+        unop_spec _ ((name, f) :: functions).
     Proof using inname_gen_varname_gen_disjoint outbounds_length
           outbounds_tighter_than_max outname_gen_varname_gen_disjoint
           ok relax_bounds res_Wf res_bounds res_eq res_valid.
@@ -548,6 +543,7 @@ Section WithParameters.
     Lemma from_word_correct f :
       f = make_bedrock_func insizes outsizes inlengths res ->
       forall functions,
+        Cmd.spec_of_add_carryx (add_carryx:=add_carryx) functions ->
         spec_of_from_word ((from_word, f) :: functions).
     Proof using inname_gen_varname_gen_disjoint
           outname_gen_varname_gen_disjoint ok relax_bounds res_Wf
@@ -570,7 +566,7 @@ Section WithParameters.
           eapply (translate_func_correct (parameters_sentinel:=parameters_sentinel))
           with (out_ptrs:=[out_ptr]) (flat_args:=in_ptrs)
           (args:=b2_args).
-        16:instantiate (1:=R).
+        17:instantiate (1:=R).
         all:try translate_func_precondition_hammer.
         1:reflexivity.
         { cbv [Equivalence.equivalent_flat_args]; eexists 1%nat; split; [eexists|reflexivity].
@@ -655,11 +651,16 @@ Section WithParameters.
 
     Lemma felem_copy_correct f :
       f = make_bedrock_func insizes outsizes inlengths res ->
-      forall functions, spec_of_felem_copy ((felem_copy, f) :: functions).
+      forall functions,
+        Cmd.spec_of_add_carryx (add_carryx:=add_carryx) functions ->
+        spec_of_felem_copy ((felem_copy, f) :: functions).
     Proof.
       subst inlengths insizes outsizes.
       cbv [spec_of_felem_copy felem_copy_insizes felem_copy_outsizes felem_copy_inlengths].
       cbv beta; intros; subst f. cbv [make_bedrock_func].
+      lazymatch goal with
+      | H : (_ * _ * R)%sep _ |- _ => rename H into Hsep
+      end.
       cleanup. eapply Proper_call.
       2: {
         rename R into Rr.
@@ -671,7 +672,7 @@ Section WithParameters.
           cbn [type.app_curried fst snd].
           apply res_bounds.
           rewrite max_bounds_range_iff.
-          seprewrite_in @FElem_array_truncated_scalar_iff1 H0; extract_ex1_and_emp_in H0.
+          seprewrite_in @FElem_array_truncated_scalar_iff1 Hsep; extract_ex1_and_emp_in Hsep.
           ssplit; rewrite ?map_length; trivial.
           eapply List.Forall_map, Forall_forall; intros.
           rewrite MakeAccessSizes.bits_per_word_eq_width.
@@ -679,8 +680,8 @@ Section WithParameters.
         { (* lists_reserved_with_initial_context *)
           lists_reserved_simplify pout.
           all:try solve_equivalence_side_conditions;
-          seprewrite_in (FElem_array_truncated_scalar_iff1 pout) H0; extract_ex1_and_emp_in H0; try eassumption.
-          seprewrite_in (FElem_array_truncated_scalar_iff1 px) H0; extract_ex1_and_emp_in H0.
+          seprewrite_in (FElem_array_truncated_scalar_iff1 pout) Hsep; extract_ex1_and_emp_in Hsep; try eassumption.
+          seprewrite_in (FElem_array_truncated_scalar_iff1 px) Hsep; extract_ex1_and_emp_in Hsep.
           setoid_rewrite max_bounds_range_iff in res_bounds.
           rewrite (fun x pf => proj1 (res_bounds x pf)), ?map_length; trivial.
           ssplit; rewrite ?map_length; trivial.
@@ -694,7 +695,7 @@ Section WithParameters.
       cbn [List.hd] in *. rewrite MakeAccessSizes.bytes_per_word_eq.
       extract_ex1_and_emp_in_goal; ssplit;
         try (use_sep_assumption; cancel; cbv [seps]);
-        seprewrite_in (FElem_array_truncated_scalar_iff1 px) H0; extract_ex1_and_emp_in H0; trivial.
+        seprewrite_in (FElem_array_truncated_scalar_iff1 px) Hsep; extract_ex1_and_emp_in Hsep; trivial.
       Morphisms.f_equiv.
       rewrite H4.
       rewrite <-(res_eq x) at 2 by trivial.
@@ -766,6 +767,7 @@ Section WithParameters.
     Lemma from_bytes_correct f :
       f = make_bedrock_func insizes outsizes inlengths res ->
       forall functions,
+        Cmd.spec_of_add_carryx (add_carryx:=add_carryx) functions ->
         spec_of_from_bytes ((from_bytes, f) :: functions).
     Proof using inname_gen_varname_gen_disjoint
           outname_gen_varname_gen_disjoint ok relax_bounds res_Wf
@@ -906,6 +908,7 @@ Section WithParameters.
     Lemma to_bytes_correct f :
       f = make_bedrock_func insizes outsizes inlengths res ->
       forall functions,
+        Cmd.spec_of_add_carryx (add_carryx:=add_carryx) functions ->
         spec_of_to_bytes ((to_bytes, f) :: functions).
     Proof using byte_bounds_length byte_bounds_tighter_than_max
           inname_gen_varname_gen_disjoint
@@ -954,8 +957,12 @@ Section WithParameters.
           | |- _ /\ _ => eexists
           end;
         change Field.tight_bounds with tight_bounds in *.
-        { seprewrite_in (@Util.array_truncated_scalar_ptsto_iff1) H10; cbn in H10.
-          rewrite H7, res_eq, partition_le_split in *; trivial. }
+        { 
+          lazymatch goal with
+          | H1 : ?x = expr.interp _ _ _, H2 : (Array.array _ _ _ ?x * Rr)%sep _ |- _ =>
+            seprewrite_in (@Util.array_truncated_scalar_ptsto_iff1) H2; cbn in H2;
+            rewrite H1, res_eq, partition_le_split in *
+          end; trivial. }
         rewrite <-partition_le_split, <-res_eq; eauto. }
     Qed.
   End ToBytes.
@@ -1034,6 +1041,7 @@ Context
     Lemma select_znz_correct f :
       f = make_bedrock_func insizes outsizes inlengths res ->
       forall functions,
+        Cmd.spec_of_add_carryx (add_carryx:=add_carryx) functions ->
         spec_of_selectznz ((select_znz, f) :: functions).
     Proof using inname_gen_varname_gen_disjoint
           outname_gen_varname_gen_disjoint ok res_Wf
@@ -1042,8 +1050,11 @@ Context
       cbv [list_selectznz_insizes list_selectznz_outsizes list_selectznz_inlengths].
       cbv beta; intros; subst f. cbv [make_bedrock_func].
       cleanup.
-      pose proof (FElem_max_bounds _ _ _ _ H0) as Hxbounds.
-      pose proof (FElem_max_bounds _ _ _ _ H1) as Hybounds.
+      lazymatch goal with
+      | H0: (FElem px x * Rx)%sep _, H1: (FElem py y * Ry)%sep _ |- _ =>
+        pose proof (FElem_max_bounds _ _ _ _ H0) as Hxbounds;
+        pose proof (FElem_max_bounds _ _ _ _ H1) as Hybounds
+      end.
       match goal with
       | H : ZRange.is_bounded_by_bool _ _ = _ |- _ => rename H into Hbound
       | _ => idtac

From af6a79b5aa2895f29c619a5795f160c694963d4c Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Fri, 11 Aug 2023 17:36:07 +0200
Subject: [PATCH 15/34] wip

---
 src/Bedrock/Field/Synthesis/New/ComputedOp.v | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Bedrock/Field/Synthesis/New/ComputedOp.v b/src/Bedrock/Field/Synthesis/New/ComputedOp.v
index 30b3ae27a2..8a17c3d8f8 100644
--- a/src/Bedrock/Field/Synthesis/New/ComputedOp.v
+++ b/src/Bedrock/Field/Synthesis/New/ComputedOp.v
@@ -17,7 +17,7 @@ Record computed_op
     res_eq : op = ErrorT.Success res;
     func_eq : b2_func = make_bedrock_func insizes outsizes inlengths res;
   }.
-Global Arguments computed_op {_ _ _ _ _ _ _ _ _ _ t}.
+Global Arguments computed_op {_ _ _ _ _ _ _ _ _ _ _ _ t}.
 
 Ltac make_computed_op :=
   eapply Build_computed_op;

From 08e852dea5cf8856ddc4436133ef2dbedb97f9ea Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Wed, 16 Aug 2023 11:26:23 +0200
Subject: [PATCH 16/34] wip, changing expr cast rules for tuples

---
 .../Field/Synthesis/Examples/p224_64_new.v    |  99 +++++++-
 .../Synthesis/New/WordByWordMontgomery.v      | 229 ++++++++++--------
 src/Bedrock/Field/Translation/Expr.v          |   3 +
 src/Bedrock/Field/Translation/Proofs/Expr.v   |  16 +-
 .../Translation/Proofs/ValidComputable/Expr.v |  21 +-
 5 files changed, 251 insertions(+), 117 deletions(-)

diff --git a/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v b/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
index 07ccdf320f..1be6a5d8d6 100644
--- a/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
+++ b/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
@@ -46,7 +46,7 @@ Section Field.
   Definition from_mont_string := prefix ++ "from_mont".
 
   (* Call fiat-crypto pipeline on all field operations *)
-  Instance p224_ops : @word_by_word_Montgomery_ops from_mont_string to_mont_string _ _ _ _ _ _ _ _ _ _ _ (WordByWordMontgomery.n m machine_wordsize) m.
+  Instance p224_ops : @word_by_word_Montgomery_ops from_mont_string to_mont_string _ _ _ _ _ _ _ _ _ _ _ _ _ (WordByWordMontgomery.n m machine_wordsize) m.
   Proof using Type. Time constructor; make_computed_op. Defined.
 
 
@@ -65,7 +65,7 @@ Section Field.
     pose add_op.
     cbn [add_op p224_ops] in c.
 
-  Qed.
+  Abort.
 
   (**** Translate each field operation into bedrock2 and apply bedrock2 backend
         field pipeline proofs to prove the bedrock2 functions are correct. ****)
@@ -98,6 +98,101 @@ Section Field.
         | |- (_ = _)%Z => vm_compute; reflexivity
         end.
 
+
+      Require Import Crypto.Language.API.
+      Import API.Compilers.
+      Print Func.valid_func_bool.
+      Locate API.expr.
+      Definition cmd_bool
+                 {t} (e : @API.expr (fun _ => unit) t) : bool :=
+        match e return bool with
+        | expr.LetIn
+            (type.base (base.type.prod
+                          (base.type.type_base a)
+                          (base.type.type_base b)))
+            (type.base c) x f =>
+          true
+        | expr.LetIn
+            (type.base (base.type.type_base a))
+            (type.base b) x f =>
+          true
+        | expr.App (type.base s) _ f x =>
+          true
+        | expr.Ident _ i => true
+        | _ => false
+        end.
+      Fixpoint func_bool {t} (e : @API.expr (fun _ => unit) t) : bool :=
+        match e with
+        | expr.Abs _ _ f =>func_bool (f tt)
+        | _ => cmd_bool e
+        end.
+      Lemma valid_expr_bool_if_base_LetIn {A B} (x : API.expr A) (f : unit -> API.expr B) :
+        Cmd.valid_expr_bool_if_base (expr.LetIn x f) = false.
+      Proof.
+        cbv [Cmd.valid_expr_bool_if_base].
+        destruct B; reflexivity.
+      Qed.
+      
+  Derive p224_add
+         SuchThat (forall functions,
+                      Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
+                      spec_of_BinOp bin_add
+                        (field_representation:=field_representation m)
+                        (p224_add :: functions))
+         As p224_add_correct.
+  Proof.
+    begin_derive_bedrock2_func.
+    4:{
+      eapply Func.valid_func_bool_iff.
+      cbn [add_op p224_ops res].
+      cbv [Func.valid_func_bool].
+      repeat  lazymatch goal with
+              | |- context [Func.valid_cmd_bool_if_base (eAbs ?x)] =>
+                change (Func.valid_cmd_bool_if_base (eAbs x)) with false
+              end.
+      cbv [Func.valid_cmd_bool_if_base].
+      cbv [Cmd.valid_cmd_bool].
+      rewrite valid_expr_bool_if_base_LetIn.
+      rewrite valid_expr_bool_if_base_LetIn.
+      rewrite valid_expr_bool_if_base_LetIn.
+      rewrite valid_expr_bool_if_base_LetIn.
+      rewrite valid_expr_bool_if_base_LetIn.
+      rewrite valid_expr_bool_if_base_LetIn.
+      rewrite !valid_expr_bool_if_base_LetIn.
+      Set Printing Depth 100000.
+      repeat match goal with
+             | |- context [Cmd.valid_expr_bool_if_base ?x] =>
+               change (Cmd.valid_expr_bool_if_base x) with false
+             end.
+      cbn iota.
+      lazymatch goal with
+      | |- context [Expr.valid_expr_bool true ?x] =>
+        pose (e:=Expr.valid_expr_bool true x)
+      end.
+      (*
+ Expr.valid_expr_bool true
+         (#Compilers.ident_Z_cast @ ###{| ZRange.lower := 0; ZRange.upper := 4294967295 |} @
+          (#Compilers.ident_Z_cast @ ###{| ZRange.lower := 0; ZRange.upper := 4294967295 |} @
+           (#Compilers.ident_Z_cast @ ###{| ZRange.lower := 0; ZRange.upper := 4294967295 |} @
+            (#Compilers.ident_fst @
+             (#Compilers.ident_Z_cast2 @
+              (###{| ZRange.lower := 0; ZRange.upper := 4294967295 |},
+              ###{| ZRange.lower := 0; ZRange.upper := 1 |}) @ $$tt)) &'
+            #Compilers.ident_Z_cast @ ###{| ZRange.lower := 0; ZRange.upper := 4294967295 |} @ $$tt)
+           || #Compilers.ident_Z_cast @ ###{| ZRange.lower := 0; ZRange.upper := 4294967295 |} @
+              (#Compilers.ident_Z_cast @ ###{| ZRange.lower := 0; ZRange.upper := 4294967295 |} @
+               (#Compilers.ident_fst @
+                (#Compilers.ident_Z_cast2 @
+                 (###{| ZRange.lower := 0; ZRange.upper := 4294967295 |},
+                 ###{| ZRange.lower := 0; ZRange.upper := 1 |}) @ $$tt)) &'
+               #Compilers.ident_Z_cast @ ###{| ZRange.lower := 0; ZRange.upper := 4294967295 |} @ $$tt)))
+*)
+      cbv in e.
+    Locate begin_derive_bedrock2_func.
+    Time derive_bedrock2_func add_op.
+  Qed.
+  Print p224_add.
+
   Derive p224_from_bytes
          SuchThat (forall functions,
                       spec_of_from_bytes
diff --git a/src/Bedrock/Field/Synthesis/New/WordByWordMontgomery.v b/src/Bedrock/Field/Synthesis/New/WordByWordMontgomery.v
index f5868747a4..6d32a17f8c 100644
--- a/src/Bedrock/Field/Synthesis/New/WordByWordMontgomery.v
+++ b/src/Bedrock/Field/Synthesis/New/WordByWordMontgomery.v
@@ -83,7 +83,7 @@ Class word_by_word_Montgomery_ops
         list_selectznz_insizes list_selectznz_outsizes (list_selectznz_inlengths n)
   }.
 
-Arguments word_by_word_Montgomery_ops {_ _ _ _ _ _ _ _ _ _ _ _ _} n.
+Arguments word_by_word_Montgomery_ops {_ _ _ _ _ _ _ _ _ _ _ _ _ _ _} n.
 
 (** We need to tell [check_args] that we are requesting these functions in order to get the relevant properties out *)
 Notation necessary_requests := ["to_bytes"; "from_bytes"]%string (only parsing).
@@ -91,7 +91,7 @@ Notation necessary_requests := ["to_bytes"; "from_bytes"]%string (only parsing).
 Section WordByWordMontgomery.
   Context
   {width BW word mem locals env ext_spec error}
-  {parameters_sentinel : @parameters width BW word mem locals env ext_spec default_varname_gen error}
+  {parameters_sentinel : @parameters width BW word mem locals env ext_spec default_varname_gen Defaults.add_carryx Defaults.sub_borrowx error}
   {field_parameters : FieldParameters}
   {field_parameters_ok : FieldParameters_ok}
   {ok : Types.ok}.
@@ -176,7 +176,7 @@ Section WordByWordMontgomery.
           (to_bytes_func_eq : to_bytes_func = b2_func to_bytes_op)
           (from_mont_func_eq : from_mont_func = b2_func from_mont_op)
           (to_mont_func_eq : to_mont_func = b2_func to_mont_op)
-          (select_znz_func_eq : select_znz_func = b2_func (@select_znz_op from_mont to_mont _ _ _ _ _ _ _ _ _ _ _ _ _ _)).
+          (select_znz_func_eq : select_znz_func = b2_func (@select_znz_op from_mont to_mont _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _)).
 
   Local Notation weight := (uweight width) (only parsing).
   Definition eval_trans := (WordByWordMontgomery.from_montgomerymod width n m (WordByWordMontgomery.m' m width)).
@@ -333,7 +333,8 @@ Qed.
   Lemma mul_func_correct :
     valid_func (res mul_op _) ->
     forall functions,
-      spec_of_BinOp bin_mul ((Field.mul, mul_func) :: functions). Set Printing All.
+      Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx)functions ->
+      spec_of_BinOp bin_mul ((Field.mul, mul_func) :: functions).
   Proof using M_eq check_args_ok mul_func_eq ok.
         (* tight_bounds_tighter_than. *)
     intros. cbv [spec_of_BinOp bin_mul]. rewrite mul_func_eq.
@@ -351,8 +352,9 @@ Qed.
                Representation.eval_words
                bin_model bin_xbounds bin_ybounds
                un_model un_xbounds eval_trans
-      ] in *.
-      specialize (Hcorrect (map Interface.word.unsigned x) (map Interface.word.unsigned y) H0 H1).
+          ] in *.
+      specialize (Hcorrect (map Interface.word.unsigned x) (map Interface.word.unsigned y)
+                           ltac:(assumption) ltac:(assumption)).
       FtoZ. rewrite map_unsigned_of_Z. erewrite (MaxBounds.map_word_wrap_bounded).
       2: {
         eapply valid_max_bounds; eauto. destruct Hcorrect; eauto.
@@ -366,6 +368,7 @@ Qed.
   Lemma square_func_correct :
     valid_func (res square_op _) ->
     forall functions,
+      Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
       spec_of_UnOp un_square ((Field.square, square_func) :: functions).
   Proof using M_eq check_args_ok ok square_func_eq.
     intros. cbv [spec_of_UnOp un_square]. rewrite square_func_eq.
@@ -383,7 +386,7 @@ Qed.
              bin_model bin_xbounds bin_ybounds
              un_model un_xbounds eval_trans
     ] in *.
-    specialize (Hcorrect (map Interface.word.unsigned x) H0).
+    specialize (Hcorrect (map Interface.word.unsigned x) ltac:(assumption)).
     rewrite map_unsigned_of_Z. erewrite (MaxBounds.map_word_wrap_bounded).
     2: {
       eapply valid_max_bounds; eauto. destruct Hcorrect; eauto.
@@ -399,6 +402,7 @@ Qed.
   Lemma add_func_correct :
     valid_func (res add_op _) ->
     forall functions,
+      Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
       spec_of_BinOp bin_add ((Field.add, add_func) :: functions).
   Proof using M_eq check_args_ok add_func_eq ok.
     intros. cbv [spec_of_BinOp bin_add]. rewrite add_func_eq.
@@ -416,7 +420,8 @@ Qed.
              bin_model bin_xbounds bin_ybounds
              un_model un_xbounds eval_trans
     ] in *.
-    specialize (Hcorrect (map Interface.word.unsigned x) (map Interface.word.unsigned y) H0 H1).
+    specialize (Hcorrect (map Interface.word.unsigned x) (map Interface.word.unsigned y)
+                         ltac:(assumption) ltac:(assumption)).
     rewrite map_unsigned_of_Z. erewrite (MaxBounds.map_word_wrap_bounded).
     2: {
       eapply valid_max_bounds; eauto. destruct Hcorrect; eauto.
@@ -431,6 +436,7 @@ Qed.
   Lemma sub_func_correct :
     valid_func (res sub_op _) ->
     forall functions,
+      Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
       spec_of_BinOp bin_sub ((Field.sub, sub_func) :: functions).
   Proof using M_eq check_args_ok sub_func_eq ok.
     intros. cbv [spec_of_BinOp bin_sub]. rewrite sub_func_eq.
@@ -448,7 +454,8 @@ Qed.
              bin_model bin_xbounds bin_ybounds
              un_model un_xbounds eval_trans
     ] in *.
-    specialize (Hcorrect (map Interface.word.unsigned x) (map Interface.word.unsigned y) H0 H1).
+    specialize (Hcorrect (map Interface.word.unsigned x) (map Interface.word.unsigned y)
+               ltac:(assumption) ltac:(assumption)).
     rewrite map_unsigned_of_Z. erewrite (MaxBounds.map_word_wrap_bounded).
     2: {
       eapply valid_max_bounds; eauto. destruct Hcorrect; eauto.
@@ -462,6 +469,7 @@ Qed.
   Lemma opp_func_correct :
     valid_func (res opp_op _) ->
     forall functions,
+      Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
       spec_of_UnOp un_opp ((Field.opp, opp_func) :: functions).
   Proof using M_eq check_args_ok opp_func_eq ok.
     intros. cbv [spec_of_UnOp un_opp]. rewrite opp_func_eq.
@@ -480,7 +488,7 @@ Qed.
              bin_model bin_xbounds bin_ybounds
              un_model un_xbounds eval_trans
     ] in *.
-    specialize (Hcorrect (map Interface.word.unsigned x) H0).
+    specialize (Hcorrect (map Interface.word.unsigned x) ltac:(assumption)).
     rewrite map_unsigned_of_Z. erewrite (MaxBounds.map_word_wrap_bounded).
     2: {
       eapply valid_max_bounds; eauto. destruct Hcorrect; eauto.
@@ -495,6 +503,7 @@ Qed.
   Lemma from_bytes_func_correct :
     valid_func (res from_bytes_op _) ->
     forall functions,
+      Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
       (@spec_of_from_bytes _ _ _ _ _ _ _ field_representation_raw) ((Field.from_bytes, from_bytes_func) :: functions).
   Proof using M_eq check_args_ok from_bytes_func_eq ok.
     intros. cbv [spec_of_from_bytes]. rewrite from_bytes_func_eq.
@@ -506,7 +515,12 @@ Qed.
       handle_side_conditions; [ apply valid_max_bounds | apply valid_length | | | ].
     { (* output length *)
       cbv [list_in_bounds WordByWordMontgomery.valid WordByWordMontgomery.small ] in *.
-      intuition idtac. rewrite H1. rewrite Partition.length_partition; trivial. }
+      intuition idtac.
+      lazymatch goal with
+      | H : ?x = Partition.Partition.partition _ _ _ |- context [Datatypes.length ?x] =>
+        rewrite H
+      end.
+      rewrite Partition.length_partition; trivial. }
 
     { (* output *value* is correct *)
     intros. cbv [feval]. simpl. cbv [Representation.eval_words]. simpl.
@@ -517,7 +531,7 @@ Qed.
              bin_model bin_xbounds bin_ybounds
              un_model un_xbounds eval_trans
     ] in *.
-    specialize (Hcorrect (map Byte.byte.unsigned bs) H0).
+    specialize (Hcorrect (map Byte.byte.unsigned bs) ltac:(assumption)).
     rewrite map_unsigned_of_Z. erewrite (MaxBounds.map_word_wrap_bounded).
     2: {
       eapply valid_max_bounds; eauto. destruct Hcorrect; eauto.
@@ -532,6 +546,7 @@ Qed.
   Lemma to_bytes_func_correct :
     valid_func (res to_bytes_op _) ->
     forall functions,
+      Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
       (@spec_of_to_bytes _ _ _ _ _ _ _ field_representation_raw) ((Field.to_bytes, to_bytes_func) :: functions).
   Proof using M_eq check_args_ok ok to_bytes_func_eq.
     intros. cbv [spec_of_to_bytes]. rewrite to_bytes_func_eq.
@@ -540,15 +555,23 @@ Qed.
       as Hcorrect.
 
     eapply Signature.to_bytes_correct with (res:=res to_bytes_op);
-      handle_side_conditions; cbv [list_in_bounds]; [ | | | ].
+      handle_side_conditions; cbv [list_in_bounds]; [ | | | ];
+        intros; lazymatch goal with
+                | H : WordByWordMontgomery.valid _ _ _ _ |- _ => destruct H
+                | _ => idtac
+                end.
     {
-      intros. apply byte_bounds_range_iff; split; eauto.
-        - destruct H0. eapply WordByWordMontgomery.length_small; eauto.
-        - destruct H0. cbv [WordByWordMontgomery.small] in *.
-          rewrite H0. apply partition_bytes_range.
+      apply byte_bounds_range_iff; split;
+        [ solve [eauto using WordByWordMontgomery.length_small] | ].
+      cbv [WordByWordMontgomery.small] in *.
+      lazymatch goal with
+      | H : ?x = Partition.Partition.partition _ _ _ |- _ =>rewrite H
+      end.
+      apply partition_bytes_range.
     }
     {
-      intros. destruct H0. apply WordByWordMontgomery.length_small in H0. rewrite H0. eauto.
+      intros. erewrite WordByWordMontgomery.length_small by eauto.
+      auto.
     }
     { (* output *value* is correct *)
     intros. cbv [feval]. simpl.
@@ -560,7 +583,7 @@ Qed.
              un_model un_xbounds eval_trans
     ] in *.
 
-    specialize (Hcorrect (map Interface.word.unsigned x) H0).
+    specialize (Hcorrect (map Interface.word.unsigned x) ltac:(assumption)).
     rewrite Hcorrect. cbv [M] in M_eq. rewrite M_eq. auto.
      }
     { (* output *bounds* are correct *)
@@ -570,47 +593,28 @@ Qed.
       erewrite ByteBounds.byte_map_unsigned_of_Z,
       ByteBounds.map_byte_wrap_bounded
         by apply ByteBounds.partition_bounded_by.
-      cbv [bounded_by] in *; simpl in H0.
+      repeat lazymatch goal with
+             | H : bounded_by wordlist _ |- _ =>
+               progress cbn [bounded_by Signature.field_representation Representation.frep] in H
+             | H : WordByWordMontgomery.valid _ _ _ _ |- _ => destruct H
+             end.
       (*TODO: use valid_partition_small*)
-      {
-        split.
-        - unfold WordByWordMontgomery.small. unfold WordByWordMontgomery.eval. rewrite Partition.eval_partition.
-          2: {
-            apply uwprops. lia.
-          }
-        rewrite Zmod_small.
-        2: { destruct H0. unfold WordByWordMontgomery.eval in H1. auto. }
-          cbv [uweight].
-          rewrite Zmod_small; auto. split.
-            + destruct H0. cbv [WordByWordMontgomery.eval] in H1. cbv [uweight] in H1. lia.
-            + destruct H0. cbv [WordByWordMontgomery.eval] in H1. cbv [uweight] in H1. destruct H1.
-              assert ( m < ModOps.weight 8 1 (n_bytes m))%Z.
-              {
-                pose proof (use_curve_good _ _ _ check_args_ok).
-                assert (m < s m)%Z by lia.
-                cbv [uweight] in H3. lia.
-              }
-            lia.
-          - cbv [WordByWordMontgomery.eval]. rewrite Partition.eval_partition.
-            2: {
-              apply uwprops; lia.
-              }
-              split.
-                + apply Z_mod_lt. destruct (uwprops 8); try lia.
-                  cbv [uweight] in *. specialize (weight_positive (n_bytes m)). lia.
-                + rewrite Zmod_small; [| split].
-                  * apply Z_mod_lt. pose proof (use_curve_good _ _ _ check_args_ok); lia.
-                  * apply Z_mod_lt. pose proof (use_curve_good _ _ _ check_args_ok); lia.
-                  * pose proof (use_curve_good _ _ _ check_args_ok).
-                    assert (m < s m)%Z by lia.
-                    cbv [uweight] in *.
-                    eapply Z.lt_trans.
-                    {
-                      apply Z_mod_lt. pose proof (use_curve_good _ _ _ check_args_ok). lia.
-                    }
-                     lia.
-      }
-    }
+      assert ( m < ModOps.weight 8 1 (n_bytes m))%Z.
+      { pose proof (use_curve_good _ _ _ check_args_ok).
+        cbv [uweight] in *. lia. }
+      split.
+      { cbv [WordByWordMontgomery.small WordByWordMontgomery.eval] in *.
+        rewrite Partition.eval_partition by (apply uwprops; lia).
+        rewrite Zmod_small by lia. cbv [uweight] in *.
+        rewrite Zmod_small by lia.
+        auto. }
+      { cbv [WordByWordMontgomery.eval]. rewrite Partition.eval_partition by (apply uwprops; lia).
+        split; [ lia | ].
+        pose proof  (use_curve_good _ _ _ check_args_ok).
+        rewrite Zmod_small; [ lia | ].
+        split; [ lia | ].
+        eapply Z.lt_trans; [ apply Z_mod_lt; lia | ].
+        lia. } }
   Qed.
 
   Lemma m_nz : m <> 0%Z.
@@ -622,6 +626,7 @@ Qed.
   Lemma from_mont_func_correct :
   valid_func (res from_mont_op _) ->
   forall functions,
+      Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
     (@spec_of_UnOp _ _ _ _ _ _ _ _ from_mont) un_from_mont ((from_mont, from_mont_func) :: functions).
     Proof using M_eq check_args_ok ok from_mont_func_eq.
     clear field_parameters_ok.
@@ -641,21 +646,37 @@ Qed.
             bin_model bin_xbounds bin_ybounds
             un_model un_xbounds eval_trans
     ] in *.
-    specialize (Hcorrect (map Interface.word.unsigned x) H0).
+    specialize (Hcorrect (map Interface.word.unsigned x) ltac:(assumption)).
     rewrite map_unsigned_of_Z. erewrite (MaxBounds.map_word_wrap_bounded).
     2: {
       eapply valid_max_bounds; eauto. destruct Hcorrect; eauto.
     }
-    destruct Hcorrect. FtoZ. pose proof (WordByWordMontgomery.from_montgomerymod_correct width n m (@Field.r' width field_parameters) (m' m width)) as Hcorrect.
-    cbv [WordByWordMontgomery.eval] in *.
-    edestruct Hcorrect as [Hvalue Hvalid]; [| | | | | | eapply H2| ]; try eapply use_curve_good; try eassumption; [pose proof r'_correct as Htemp; cbv [r' M] in Htemp; rewrite M_eq in Htemp; eauto |].
-    rewrite Hvalue. rewrite Z.mul_mod; try apply m_nz. rewrite H1. rewrite <- Z.mul_mod; try apply m_nz.
-    symmetry. rewrite Z.mul_mod; try apply m_nz. cbv [list_in_bounds] in *. clear H2.
-    edestruct Hcorrect as [Hvalue' _]; [| | | | | | eapply H0 |]; try eapply use_curve_good; try eassumption; [pose proof r'_correct as Htemp; cbv [r' M] in Htemp; rewrite M_eq in Htemp; eauto |].
-    rewrite Hvalue'. rewrite <- Z.mul_mod; try apply m_nz.
-    cbv [Field.r' PushButtonSynthesis.WordByWordMontgomery.r' Field.r r M felem_size_in_words]. rewrite M_eq.
-    auto.
-    }
+    pose proof r'_correct as Hr'. rewrite M_eq in Hr'.
+    destruct Hcorrect. FtoZ.
+    pose proof (WordByWordMontgomery.from_montgomerymod_correct
+                  width n m (@Field.r' width field_parameters) (m' m width) Hr'
+                    ltac:(eapply use_curve_good; eassumption)
+                    ltac:(eapply use_curve_good; eassumption)
+                    ltac:(eapply use_curve_good; eassumption)
+                    ltac:(eapply use_curve_good; eassumption)
+                    ltac:(eapply use_curve_good; eassumption)
+                 ) as Hcorrect.
+    lazymatch goal with
+    | H : WordByWordMontgomery.valid _ _ _ ?x |- _ => destruct (Hcorrect x H) as [Hvalue Hvalid]
+    end.
+    cbv [WordByWordMontgomery.eval] in *. rewrite Hvalue.
+    lazymatch goal with
+    | H : list_in_bounds _ ?x |- _ => destruct (Hcorrect x H) as [Hvalue' Hvalid']
+    end.
+    PushPullMod.Z.push_mod.
+    rewrite Hvalue'.
+    lazymatch goal with
+    | H : ((Positional.eval _ _ (expr.interp _ _ _)) mod _)%Z = _ |- _ =>
+      rewrite H
+    end.
+    PushPullMod.Z.pull_mod.
+    cbv [Field.r' PushButtonSynthesis.WordByWordMontgomery.r' Field.r r M felem_size_in_words].
+    rewrite M_eq. reflexivity. }
     { (* output *bounds* are correct *)
       intros. apply Hcorrect; auto. }
   Qed.
@@ -663,6 +684,7 @@ Qed.
   Lemma to_mont_func_correct :
   valid_func (res to_mont_op _) ->
   forall functions,
+    Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
     (@spec_of_UnOp _ _ _ _ _ _ _ _ to_mont) un_to_mont ((to_mont, to_mont_func) :: functions).
     Proof using M_eq check_args_ok ok to_mont_func_eq.
     intros. cbv [spec_of_UnOp un_to_mont]. rewrite to_mont_func_eq.
@@ -681,36 +703,46 @@ Qed.
             bin_model bin_xbounds bin_ybounds
             un_model un_xbounds eval_trans
     ] in *.
-    specialize (Hcorrect (map Interface.word.unsigned x) H0).
+    specialize (Hcorrect (map Interface.word.unsigned x) ltac:(assumption)).
     rewrite map_unsigned_of_Z. erewrite (MaxBounds.map_word_wrap_bounded).
     2: {
       eapply valid_max_bounds; eauto. destruct Hcorrect; eauto.
     }
+    pose proof r'_correct as Hr'. rewrite M_eq in Hr'.
     destruct Hcorrect. FtoZ.
     cbv [WordByWordMontgomery.eval] in *.
-    rewrite H1.
-    pose proof (WordByWordMontgomery.from_montgomerymod_correct width n m (@Field.r' width field_parameters) (m' m width)) as Hcorrect.
-    cbv [WordByWordMontgomery.eval] in *.
-    edestruct Hcorrect as [Hvalue _]; [ | | | | | | apply H0 |]; try eapply use_curve_good; try eassumption;
-    [pose proof r'_correct as Htemp; cbv [r' M] in Htemp; rewrite M_eq in Htemp; auto| ].
-    rewrite Z.mul_mod; try apply m_nz. rewrite Hvalue. rewrite <- Z.mul_mod; try apply m_nz.
-    rewrite <- Z.mul_assoc. rewrite Z.mul_mod; try apply m_nz.
     lazymatch goal with
-    | |- _ = (_ * (?prd)%Z mod _)%Z => eassert (Hr' : prd = _)
-    | _ => idtac
+    | H : ((Positional.eval _ _ (WordByWordMontgomery.from_montgomerymod _ _ _ _ _)) mod _)%Z = _ |- _ =>
+      rewrite H
     end.
-      {
-        pose proof (r'_correct) as Htemp. rewrite <- Z.pow_mul_l. rewrite PullPush.Z.mod_pow_full.
-        rewrite Z.mul_comm.
-        cbv [Field.r]. cbv [r' M] in Htemp. rewrite M_eq in Htemp.
-        rewrite Htemp. rewrite Z.pow_1_l; auto with zarith.
-      }
-      rewrite Hr'. assert (H1' : (1 mod m = 1)%Z).
-      {
-        apply Zmod_small; split; [lia| ]. pose proof m_big. lia.
-      }
-      rewrite H1'. rewrite Z.mul_1_r. rewrite Zmod_mod. auto.
-    }
+    pose proof (WordByWordMontgomery.from_montgomerymod_correct
+                  width n m (@Field.r' width field_parameters) (m' m width) Hr'
+                    ltac:(eapply use_curve_good; eassumption)
+                    ltac:(eapply use_curve_good; eassumption)
+                    ltac:(eapply use_curve_good; eassumption)
+                    ltac:(eapply use_curve_good; eassumption)
+                    ltac:(eapply use_curve_good; eassumption)
+               ) as Hcorrect.
+    PushPullMod.Z.push_mod.
+    lazymatch goal with
+    | H : list_in_bounds _ ?x |- _ => destruct (Hcorrect x H) as [Hvalue Hvalid]
+    end.
+    cbv [WordByWordMontgomery.eval felem_size_in_words] in *. rewrite Hvalue.
+    PushPullMod.Z.pull_mod.
+    pose proof m_big.
+    lazymatch goal with
+    | |- (?x mod ?m = (?x * (@Field.r' ?w ?p ^ ?n) * (@Field.r ?w ^ ?n)) mod ?m)%Z =>
+      transitivity ((x * (((@Field.r' w p * @Field.r w) ^ n) mod m)) mod m)%Z;
+        [ | rewrite Z.pow_mul_l; PushPullMod.Z.push_pull_mod; f_equal; lia ];
+        replace (((@Field.r' w p * @Field.r w) ^ n) mod m)%Z with 1%Z;
+        [ rewrite Z.mul_1_r; reflexivity | ];
+        rewrite PullPush.Z.mod_pow_full;
+        replace ((@Field.r' w p * @Field.r w) mod m)%Z with 1%Z;
+        [ rewrite Z.pow_1_l, Z.mod_1_l by lia; reflexivity | ]
+    end.
+    symmetry. rewrite Z.mul_comm.
+    cbv [Field.r' Field.r M]. rewrite M_eq.
+    eapply use_curve_good; eauto. }
     { (* output *bounds* are correct *)
       intros. apply Hcorrect; auto. }
   Qed.
@@ -718,6 +750,7 @@ Qed.
   Lemma select_znz_func_correct :
   valid_func (res select_znz_op _) ->
   forall functions,
+    Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
     spec_of_selectznz ((select_znz, select_znz_func) :: functions).
 Proof using M_eq check_args_ok select_znz_func_eq ok.
   intros. cbv [spec_of_selectznz]. rewrite select_znz_func_eq.
@@ -725,13 +758,13 @@ Proof using M_eq check_args_ok select_znz_func_eq ok.
        _ _ _ ltac:(eassumption) _ (res_eq select_znz_op)
     as Hcorrect.
   eapply Signature.select_znz_correct with (res:=res select_znz_op);
-    handle_side_conditions. intros x y c H0 H1 H2.
+    handle_side_conditions. intros x y c Hxbounds Hybounds Hcbounds.
     unfold COperationSpecifications.WordByWordMontgomery.selectznz_correct in Hcorrect.
-    edestruct (bit_range_eq 1 (fun n => 1%Z) _ H2) as [Hbit | Hbit].
-    - specialize (Hcorrect (Interface.word.unsigned c) (map Interface.word.unsigned x) (map Interface.word.unsigned y) H2 ltac:(eauto) ltac:(eauto)).
-      destruct Hcorrect as [H4 H5]. rewrite Hbit in H4. simpl in H4. rewrite Hbit. simpl. auto.
-    - specialize (Hcorrect (Interface.word.unsigned c) (map Interface.word.unsigned x) (map Interface.word.unsigned y) H2 ltac:(eauto) ltac:(eauto)).
-      destruct Hcorrect as [H4 H5]. rewrite Hbit in H4. simpl in H4. rewrite Hbit. simpl. auto.
+    edestruct (bit_range_eq 1 (fun n => 1%Z) _ Hcbounds) as [Hbit | Hbit].
+    - specialize (Hcorrect (Interface.word.unsigned c) (map Interface.word.unsigned x) (map Interface.word.unsigned y) Hcbounds ltac:(eauto) ltac:(eauto)).
+      destruct Hcorrect as [Hvalue ?]. rewrite Hbit in Hvalue. simpl in Hvalue. rewrite Hbit. simpl. auto.
+    - specialize (Hcorrect (Interface.word.unsigned c) (map Interface.word.unsigned x) (map Interface.word.unsigned y) Hcbounds ltac:(eauto) ltac:(eauto)).
+      destruct Hcorrect as [Hvalue ?]. rewrite Hbit in Hvalue. simpl in Hvalue. rewrite Hbit. simpl. auto.
 Qed.
 
 End WordByWordMontgomery.
diff --git a/src/Bedrock/Field/Translation/Expr.v b/src/Bedrock/Field/Translation/Expr.v
index b644762003..f386ead9a9 100644
--- a/src/Bedrock/Field/Translation/Expr.v
+++ b/src/Bedrock/Field/Translation/Expr.v
@@ -202,6 +202,7 @@ Section Expr.
 
   (* only require cast for the argument of (App f x) if:
      - f is not a cast
+     - f is not fst or snd
      - f is not mul_high (then, x = 2^width)
      - f is not (lnot_modulo _) (then x is allowed to be 2^width)
      - f is not (nth_default ?d ?l) (i doesn't need to fit in a word) *)
@@ -212,6 +213,8 @@ Section Expr.
     | Zcast2 r1 r2 =>
       negb (range_good r1 && range_good r2)
     | expr.Ident _ ident.Z_mul_high => false
+    | expr.Ident _ (ident.fst _ _) => false
+    | expr.Ident _ (ident.snd _ _) => false
     | expr.App
         _ _ (expr.Ident _ ident.Z_lnot_modulo)
         _ => false
diff --git a/src/Bedrock/Field/Translation/Proofs/Expr.v b/src/Bedrock/Field/Translation/Proofs/Expr.v
index fe85243b8d..b437039444 100644
--- a/src/Bedrock/Field/Translation/Proofs/Expr.v
+++ b/src/Bedrock/Field/Translation/Proofs/Expr.v
@@ -65,11 +65,11 @@ Section Expr.
                                    (expr.Ident (ident.Literal (t:=base.type.zrange) r2)))) x)
   | valid_fst :
       forall (x : API.expr type_ZZ),
-        valid_expr true x ->
+        valid_expr false x ->
         valid_expr false (expr.App (expr.Ident ident.fst) x)
   | valid_snd :
       forall (x : API.expr type_ZZ),
-        valid_expr true x ->
+        valid_expr false x ->
         valid_expr false (expr.App (expr.Ident ident.snd) x)
   | valid_literalz :
       forall rc z,
@@ -496,11 +496,7 @@ Section Expr.
       cbn [locally_equivalent_nobounds_base
              locally_equivalent_nobounds
              equivalent_base rep.equiv rep.Z] in *.
-      sepsimpl; eauto.
-      match goal with
-      | H : word.unsigned _ = _ |- _ => rewrite <-H
-      end.
-      rewrite word.of_Z_unsigned. auto. }
+      sepsimpl; eauto. }
     { (* snd *)
       specialize (IHvalid_expr _ _ _ _
                                ltac:(eassumption) ltac:(eassumption)).
@@ -508,11 +504,7 @@ Section Expr.
       cbn [locally_equivalent_nobounds_base
              locally_equivalent_nobounds
              equivalent_base rep.equiv rep.Z] in *.
-      sepsimpl; eauto.
-      match goal with
-      | H : word.unsigned _ = _ |- _ => rewrite <-H
-      end.
-      rewrite word.of_Z_unsigned. auto. }
+      sepsimpl; eauto. }
     { (* literal Z *)
       cbn [locally_equivalent_nobounds_base
              locally_equivalent equivalent_base rep.equiv rep.Z].
diff --git a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
index 63ec1234b0..63d096433e 100644
--- a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
+++ b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
@@ -278,7 +278,7 @@ Section Expr.
         | expr.App type_ZZ type_Z f x =>
           (* fst or snd *)
           (valid_expr_App1_bool require_casts f)
-            && valid_expr_bool' NotPartial true x
+            && valid_expr_bool' NotPartial false x
         | expr.App type_ZZ type_ZZ f x =>
           (valid_expr_App1_bool require_casts f)
             && valid_expr_bool' NotPartial false x
@@ -476,7 +476,7 @@ Section Expr.
      | type.arrow type_ZZ type_Z =>
        fun i =>
          forall x : API.expr type_ZZ,
-           valid_expr true x ->
+           valid_expr false x ->
            valid_expr false (expr.App (expr.Ident i) x)
      | _ => fun _ => False
      end) i.
@@ -654,7 +654,7 @@ Section Expr.
      | type.arrow type_ZZ type_Z =>
        fun f =>
          forall x : API.expr type_ZZ,
-           valid_expr true x ->
+           valid_expr false x ->
            valid_expr rc (expr.App f x)
      | type.arrow type_ZZ type_ZZ =>
        fun f =>
@@ -958,6 +958,14 @@ Section Expr.
     constructor; eauto.
   Qed.
 
+  Lemma valid_expr_require_casts_weaken {t} (e : API.expr t) rc :
+    valid_expr true e ->
+    valid_expr rc e.
+  Proof.
+    destruct rc; [ tauto | ].
+    induction 1; try solve [constructor; eauto using Bool.orb_true_r].
+  Qed.
+
   Lemma valid_expr_bool'_impl1 {t} (e : API.expr t) :
     forall mode rc,
       valid_expr_bool' mode rc e = true ->
@@ -1082,7 +1090,7 @@ Section Expr.
       { (* fst/snd *)
         intros.
         apply (valid_expr_App1_bool_impl1
-                 (t := type_ZZ -> type_Z)); eauto. }
+                 (t := type_ZZ -> type_Z)); eauto using valid_expr_require_casts_weaken. }
       { (* cast ZZ *)
         intros.
         apply (valid_expr_App1_bool_impl1
@@ -1135,7 +1143,10 @@ Section Expr.
       auto using
            Bool.andb_true_iff, Bool.orb_true_iff,
       is_bounded_by_bool_max_range,
-      is_bounded_by_bool_width_range; [ | | ].
+      is_bounded_by_bool_width_range; [ | | | | ].
+    { (* fst *)
+      
+    }
     { (* lnot_modulo *)
       apply Bool.andb_true_iff; split;
         Z.ltb_to_lt; auto. }

From 8628f7534b7c98c0ef1d94cebaa0b5d4d19fd0aa Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Wed, 16 Aug 2023 16:07:15 +0200
Subject: [PATCH 17/34] starting with turning fst/snd case to only apply to
 vars

---
 src/Bedrock/Field/Translation/Proofs/Expr.v   | 53 +++++++++++++------
 .../Translation/Proofs/ValidComputable/Expr.v |  5 +-
 2 files changed, 37 insertions(+), 21 deletions(-)

diff --git a/src/Bedrock/Field/Translation/Proofs/Expr.v b/src/Bedrock/Field/Translation/Proofs/Expr.v
index b437039444..ea749fa948 100644
--- a/src/Bedrock/Field/Translation/Proofs/Expr.v
+++ b/src/Bedrock/Field/Translation/Proofs/Expr.v
@@ -43,9 +43,9 @@ Section Expr.
       bool (* require_casts *) ->
       @API.expr (fun _ => unit) t -> Prop :=
   | valid_cast1 :
-      forall rc r x,
+      forall (rc : bool) r x,
         valid_expr false x ->
-        range_good (width:=width) r = true ->
+        (if rc then range_good (width:=width) r = true else True) ->
         valid_expr rc
                    (expr.App
                       (expr.App (expr.Ident ident.Z_cast)
@@ -53,8 +53,8 @@ Section Expr.
   | valid_cast2 :
       forall (rc : bool) r1 r2 x,
         valid_expr false x ->
-        range_good (width:=width) r1 = true ->
-        range_good (width:=width) r2 = true ->
+        (if rc then range_good (width:=width) r1 = true else True) ->
+        (if rc then range_good (width:=width) r2 = true else True) ->
         valid_expr rc
                    (expr.App
                       (expr.App (expr.Ident ident.Z_cast2)
@@ -63,14 +63,12 @@ Section Expr.
                                       (expr.Ident ident.pair)
                                       (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
                                    (expr.Ident (ident.Literal (t:=base.type.zrange) r2)))) x)
-  | valid_fst :
-      forall (x : API.expr type_ZZ),
-        valid_expr false x ->
-        valid_expr false (expr.App (expr.Ident ident.fst) x)
-  | valid_snd :
-      forall (x : API.expr type_ZZ),
-        valid_expr false x ->
-        valid_expr false (expr.App (expr.Ident ident.snd) x)
+  | valid_fst_var :
+      forall v,
+        valid_expr (t:=type_Z) false (expr.App (expr.Ident (@ident.fst base_Z base_Z)) (expr.Var v))
+  | valid_snd_var :
+      forall v,
+        valid_expr (t:=type_Z) false (expr.App (expr.Ident (@ident.snd base_Z base_Z)) (expr.Var v))
   | valid_literalz :
       forall rc z,
         (is_bounded_by_bool z (max_range(width:=width)) || negb rc)%bool = true ->
@@ -459,12 +457,33 @@ Section Expr.
       cbn [locally_equivalent equivalent_base rep.equiv rep.Z
                               locally_equivalent_nobounds_base] in *.
       cbv [range_good max_range ident.literal] in *.
-      intros; progress reflect_beq_to_eq zrange_beq; subst.
-      rewrite ident.cast_out_of_bounds_simple_0_mod by lia.
       cleanup.
-      rewrite Z.sub_simpl_r.
-      erewrite word.of_Z_inj_mod
-        by (rewrite Z.mod_mod by lia; reflexivity).
+      destruct rc; try eexists; sepsimpl; [ | | ].
+      3:{
+        (* The problem is that the cast can't be safely ignored here.
+
+           - One option is to translate with the cast included if the range isn't good.
+           - Another option is to somehow thread through the fst/snd to prove that this is actually dead code.
+
+         *)
+      lazymatch goal with
+      | |- context [(?r1 =? ?r2)%zrange] =>
+        let H := fresh in
+        destruct (r1 =? r2)%zrange eqn:H;
+          [ apply zrange_bl in H; subst | ]
+      end.
+        Search ident.cast.
+
+        Check ident.cast
+      Print reflect_beq_to_eq.
+      destruct rc; try eexists; sepsimpl; [ | | ].
+      3:{
+        rewrite ident.cast_out_of_bounds_simple_0_mod by lia.
+        cleanup.
+        rewrite Z.sub_simpl_r.
+        erewrite word.of_Z_inj_mod
+          by (rewrite Z.mod_mod by lia; reflexivity).
+        intros; progress reflect_beq_to_eq zrange_beq; subst.
       destruct rc; try eexists; sepsimpl;
         try apply Z.mod_pos_bound; try lia;
           eauto; [ ].
diff --git a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
index 63d096433e..066d5e765d 100644
--- a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
+++ b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
@@ -1143,10 +1143,7 @@ Section Expr.
       auto using
            Bool.andb_true_iff, Bool.orb_true_iff,
       is_bounded_by_bool_max_range,
-      is_bounded_by_bool_width_range; [ | | | | ].
-    { (* fst *)
-      
-    }
+      is_bounded_by_bool_width_range; [ | | ].
     { (* lnot_modulo *)
       apply Bool.andb_true_iff; split;
         Z.ltb_to_lt; auto. }

From 408e44e31c6d3d2a489e8846ba868f3708598d05 Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Wed, 16 Aug 2023 16:37:05 +0200
Subject: [PATCH 18/34] reverting previous and loosening require_cast_for_arg
 instead

---
 src/Bedrock/Field/Translation/Expr.v        |  5 ++-
 src/Bedrock/Field/Translation/Proofs/Expr.v | 39 ++++++++++++++++++---
 2 files changed, 36 insertions(+), 8 deletions(-)

diff --git a/src/Bedrock/Field/Translation/Expr.v b/src/Bedrock/Field/Translation/Expr.v
index f386ead9a9..0385834296 100644
--- a/src/Bedrock/Field/Translation/Expr.v
+++ b/src/Bedrock/Field/Translation/Expr.v
@@ -209,9 +209,8 @@ Section Expr.
   Definition require_cast_for_arg
              {var t} (e : @API.expr var t) : bool :=
     match e with
-    | Zcast r => negb (range_good r)
-    | Zcast2 r1 r2 =>
-      negb (range_good r1 && range_good r2)
+    | Zcast r => false
+    | Zcast2 r1 r2 => false
     | expr.Ident _ ident.Z_mul_high => false
     | expr.Ident _ (ident.fst _ _) => false
     | expr.Ident _ (ident.snd _ _) => false
diff --git a/src/Bedrock/Field/Translation/Proofs/Expr.v b/src/Bedrock/Field/Translation/Proofs/Expr.v
index ea749fa948..a518637889 100644
--- a/src/Bedrock/Field/Translation/Proofs/Expr.v
+++ b/src/Bedrock/Field/Translation/Proofs/Expr.v
@@ -63,12 +63,39 @@ Section Expr.
                                       (expr.Ident ident.pair)
                                       (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
                                    (expr.Ident (ident.Literal (t:=base.type.zrange) r2)))) x)
+  | valid_fst :
+      forall (x : API.expr type_ZZ),
+        (* need to ignore other tuple arg completely...
+           actually it's even OK if it's an error
+           but as is will fail on the cast2
+           - could add a different fst case that handles a cast2 and a var
+           - but translate_expr will still make an error if either range is bad
+           - need to change the actual behavior
+           - actually no, it won't make an error, it will just strip the cast
+           - but it will require a cast for the inner var because the outer was bad
+         *)
+        valid_expr false x ->
+        valid_expr false (expr.App (expr.Ident ident.fst) x)
+  | valid_snd :
+      forall (x : API.expr type_ZZ),
+        valid_expr false x ->
+        valid_expr false (expr.App (expr.Ident ident.snd) x)
   | valid_fst_var :
-      forall v,
-        valid_expr (t:=type_Z) false (expr.App (expr.Ident (@ident.fst base_Z base_Z)) (expr.Var v))
-  | valid_snd_var :
-      forall v,
-        valid_expr (t:=type_Z) false (expr.App (expr.Ident (@ident.snd base_Z base_Z)) (expr.Var v))
+      forall (x : API.expr type_ZZ),
+        valid_expr false x ->
+        valid_expr false
+                   (expr.App (expr.Ident ident.fst)
+                             (expr.App
+                                (expr.App (expr.Ident ident.Z_cast2)
+                                          (expr.App
+                                             (expr.App
+                                                (expr.Ident ident.pair)
+                                                (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
+                                             (expr.Ident (ident.Literal (t:=base.type.zrange) r2)))) x)
+  | valid_snd :
+      forall (x : API.expr type_ZZ),
+        valid_expr false x ->
+        valid_expr false (expr.App (expr.Ident ident.snd) x)
   | valid_literalz :
       forall rc z,
         (is_bounded_by_bool z (max_range(width:=width)) || negb rc)%bool = true ->
@@ -465,6 +492,8 @@ Section Expr.
            - One option is to translate with the cast included if the range isn't good.
            - Another option is to somehow thread through the fst/snd to prove that this is actually dead code.
 
+           translate_expr will require casts if the first cast isn't good.
+           let'd do option 1
          *)
       lazymatch goal with
       | |- context [(?r1 =? ?r2)%zrange] =>

From d2da65f185f1156d95d3d59f4cf401f9e4b18732 Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Thu, 17 Aug 2023 16:36:13 +0200
Subject: [PATCH 19/34] computable valid expr impl1 works

---
 src/Bedrock/Field/Translation/Proofs/Expr.v   | 146 ++++----
 .../Translation/Proofs/ValidComputable/Expr.v | 325 ++++++++++++++----
 2 files changed, 320 insertions(+), 151 deletions(-)

diff --git a/src/Bedrock/Field/Translation/Proofs/Expr.v b/src/Bedrock/Field/Translation/Proofs/Expr.v
index a518637889..d60e0e5893 100644
--- a/src/Bedrock/Field/Translation/Proofs/Expr.v
+++ b/src/Bedrock/Field/Translation/Proofs/Expr.v
@@ -45,7 +45,7 @@ Section Expr.
   | valid_cast1 :
       forall (rc : bool) r x,
         valid_expr false x ->
-        (if rc then range_good (width:=width) r = true else True) ->
+        range_good (width:=width) r = true ->
         valid_expr rc
                    (expr.App
                       (expr.App (expr.Ident ident.Z_cast)
@@ -53,8 +53,8 @@ Section Expr.
   | valid_cast2 :
       forall (rc : bool) r1 r2 x,
         valid_expr false x ->
-        (if rc then range_good (width:=width) r1 = true else True) ->
-        (if rc then range_good (width:=width) r2 = true else True) ->
+        range_good (width:=width) r1 = true ->
+        range_good (width:=width) r2 = true ->
         valid_expr rc
                    (expr.App
                       (expr.App (expr.Ident ident.Z_cast2)
@@ -63,39 +63,36 @@ Section Expr.
                                       (expr.Ident ident.pair)
                                       (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
                                    (expr.Ident (ident.Literal (t:=base.type.zrange) r2)))) x)
-  | valid_fst :
-      forall (x : API.expr type_ZZ),
-        (* need to ignore other tuple arg completely...
-           actually it's even OK if it's an error
-           but as is will fail on the cast2
-           - could add a different fst case that handles a cast2 and a var
-           - but translate_expr will still make an error if either range is bad
-           - need to change the actual behavior
-           - actually no, it won't make an error, it will just strip the cast
-           - but it will require a cast for the inner var because the outer was bad
-         *)
-        valid_expr false x ->
-        valid_expr false (expr.App (expr.Ident ident.fst) x)
-  | valid_snd :
-      forall (x : API.expr type_ZZ),
-        valid_expr false x ->
-        valid_expr false (expr.App (expr.Ident ident.snd) x)
-  | valid_fst_var :
-      forall (x : API.expr type_ZZ),
+  | valid_fst_cast :
+      forall (x : API.expr type_ZZ) rc r1 r2,
         valid_expr false x ->
+        range_good (width:=width) r1 = true ->
+        (* it's okay to have a cast with a bad range on the non-selected tuple element *)
         valid_expr false
-                   (expr.App (expr.Ident ident.fst)
-                             (expr.App
-                                (expr.App (expr.Ident ident.Z_cast2)
-                                          (expr.App
-                                             (expr.App
-                                                (expr.Ident ident.pair)
-                                                (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
-                                             (expr.Ident (ident.Literal (t:=base.type.zrange) r2)))) x)
-  | valid_snd :
-      forall (x : API.expr type_ZZ),
+                   (expr.App
+                      (expr.Ident ident.fst)
+                      (expr.App
+                         (expr.App (expr.Ident ident.Z_cast2)
+                                   (expr.App
+                                      (expr.App
+                                         (expr.Ident ident.pair)
+                                         (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
+                                      (expr.Ident (ident.Literal (t:=base.type.zrange) r2)))) x))
+  | valid_snd_cast :
+      forall (x : API.expr type_ZZ) rc r1 r2,
         valid_expr false x ->
-        valid_expr false (expr.App (expr.Ident ident.snd) x)
+        range_good (width:=width) r2 = true ->
+        (* it's okay to have a cast with a bad range on the non-selected tuple element *)
+        valid_expr false
+                   (expr.App
+                      (expr.Ident ident.snd)
+                      (expr.App
+                         (expr.App (expr.Ident ident.Z_cast2)
+                                   (expr.App
+                                      (expr.App
+                                         (expr.Ident ident.pair)
+                                         (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
+                                      (expr.Ident (ident.Literal (t:=base.type.zrange) r2)))) x))
   | valid_literalz :
       forall rc z,
         (is_bounded_by_bool z (max_range(width:=width)) || negb rc)%bool = true ->
@@ -332,7 +329,7 @@ Section Expr.
   Lemma require_cast_for_arg_binop {var t} :
     forall i : ident.ident t,
       translate_binop i <> None ->
-      require_cast_for_arg (width:=width) (var:=var) (expr.Ident i) = true.
+      require_cast_for_arg (var:=var) (expr.Ident i) = true.
   Proof.
     destruct i;
       cbn [translate_binop require_cast_for_arg];
@@ -342,7 +339,7 @@ Section Expr.
   Lemma require_cast_for_arg_binop2 {var s d} :
     forall (i : ident.ident (s -> d)) x,
       translate_binop i <> None ->
-      require_cast_for_arg (width:=width) (var:=var) (expr.App (expr.Ident i) x) = true.
+      require_cast_for_arg (var:=var) (expr.App (expr.Ident i) x) = true.
   Proof.
     (* destruct is too weak *)
     intro i.
@@ -484,35 +481,12 @@ Section Expr.
       cbn [locally_equivalent equivalent_base rep.equiv rep.Z
                               locally_equivalent_nobounds_base] in *.
       cbv [range_good max_range ident.literal] in *.
+      intros; progress reflect_beq_to_eq zrange_beq; subst.
+      rewrite ident.cast_out_of_bounds_simple_0_mod by lia.
       cleanup.
-      destruct rc; try eexists; sepsimpl; [ | | ].
-      3:{
-        (* The problem is that the cast can't be safely ignored here.
-
-           - One option is to translate with the cast included if the range isn't good.
-           - Another option is to somehow thread through the fst/snd to prove that this is actually dead code.
-
-           translate_expr will require casts if the first cast isn't good.
-           let'd do option 1
-         *)
-      lazymatch goal with
-      | |- context [(?r1 =? ?r2)%zrange] =>
-        let H := fresh in
-        destruct (r1 =? r2)%zrange eqn:H;
-          [ apply zrange_bl in H; subst | ]
-      end.
-        Search ident.cast.
-
-        Check ident.cast
-      Print reflect_beq_to_eq.
-      destruct rc; try eexists; sepsimpl; [ | | ].
-      3:{
-        rewrite ident.cast_out_of_bounds_simple_0_mod by lia.
-        cleanup.
-        rewrite Z.sub_simpl_r.
-        erewrite word.of_Z_inj_mod
-          by (rewrite Z.mod_mod by lia; reflexivity).
-        intros; progress reflect_beq_to_eq zrange_beq; subst.
+      rewrite Z.sub_simpl_r.
+      erewrite word.of_Z_inj_mod
+        by (rewrite Z.mod_mod by lia; reflexivity).
       destruct rc; try eexists; sepsimpl;
         try apply Z.mod_pos_bound; try lia;
           eauto; [ ].
@@ -537,22 +511,44 @@ Section Expr.
                               by (rewrite Z.mod_mod by lia; reflexivity);
                               solve [eauto]
                           end. }
-    { (* fst *)
+    { (* fst then cast *)
       specialize (IHvalid_expr _ _ _ _
                                ltac:(eassumption) ltac:(eassumption)).
-      cbn [locally_equivalent equivalent] in *.
-      cbn [locally_equivalent_nobounds_base
-             locally_equivalent_nobounds
-             equivalent_base rep.equiv rep.Z] in *.
-      sepsimpl; eauto. }
-    { (* snd *)
+      cbv [range_good max_range ident.literal ident.cast2] in *.
+      cbn [locally_equivalent equivalent_base rep.equiv rep.Z fst snd
+                              locally_equivalent_nobounds_base] in *.
+      intros; progress reflect_beq_to_eq zrange_beq; subst.
+      rewrite !ident.cast_out_of_bounds_simple_0_mod by lia.
+      rewrite Z.sub_simpl_r.
+      repeat match goal with
+             | _ => progress sepsimpl
+             | _ => rewrite word.unsigned_of_Z
+             | _ => eassumption
+             | _ => eexists
+             | _ =>
+               erewrite word.of_Z_inj_mod
+                 by (rewrite Z.mod_mod by lia; reflexivity);
+                 solve [eauto]
+             end. }
+    { (* snd then cast *)
       specialize (IHvalid_expr _ _ _ _
                                ltac:(eassumption) ltac:(eassumption)).
-      cbn [locally_equivalent equivalent] in *.
-      cbn [locally_equivalent_nobounds_base
-             locally_equivalent_nobounds
-             equivalent_base rep.equiv rep.Z] in *.
-      sepsimpl; eauto. }
+      cbv [range_good max_range ident.literal ident.cast2] in *.
+      cbn [locally_equivalent equivalent_base rep.equiv rep.Z fst snd
+                              locally_equivalent_nobounds_base] in *.
+      intros; progress reflect_beq_to_eq zrange_beq; subst.
+      rewrite !ident.cast_out_of_bounds_simple_0_mod by lia.
+      rewrite Z.sub_simpl_r.
+      repeat match goal with
+             | _ => progress sepsimpl
+             | _ => rewrite word.unsigned_of_Z
+             | _ => eassumption
+             | _ => eexists
+             | _ =>
+               erewrite word.of_Z_inj_mod
+                 by (rewrite Z.mod_mod by lia; reflexivity);
+                 solve [eauto]
+             end. }
     { (* literal Z *)
       cbn [locally_equivalent_nobounds_base
              locally_equivalent equivalent_base rep.equiv rep.Z].
diff --git a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
index 066d5e765d..a835544c88 100644
--- a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
+++ b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
@@ -30,22 +30,35 @@ Section Expr.
   Local Existing Instance Types.rep.Z.
   Local Existing Instance Types.rep.listZ_local.
 
-  Definition is_fst_snd_ident {t} (i : ident.ident t) : bool :=
+  Definition is_fst_ident {t} (i : ident.ident t) : bool :=
     match i with
     | ident.fst base_Z base_Z => true
+    | _ => false
+    end.
+
+  Definition is_fst_ident_expr {t} (e : @API.expr (fun _ => unit) t) : bool :=
+    match e with
+    | expr.Ident _ i => is_fst_ident i
+    | _ => false
+    end.
+
+  Definition is_snd_ident {t} (i : ident.ident t) : bool :=
+    match i with
     | ident.snd base_Z base_Z => true
     | _ => false
     end.
+  Definition is_snd_ident_expr {t} (e : @API.expr (fun _ => unit) t) : bool :=
+    match e with
+    | expr.Ident type_Z i => is_snd_ident i
+    | _ => false
+    end.
 
-  Definition valid_expr_App1_bool {t} (require_casts : bool)
-           (e : @API.expr (fun _ => unit) t) : bool :=
+  Definition valid_cast_bool {t} (e : @API.expr (fun _ => unit) t) : bool :=
     match e with
     | expr.App type_range (type.arrow type_Z type_Z) f r =>
       is_cast_ident_expr f && is_cast_literal(width:=width) r
     | expr.App type_range2 (type.arrow type_ZZ type_ZZ) f r =>
       is_cast_ident_expr f && is_cast2_literal(width:=width) r
-    | expr.Ident (type.arrow type_ZZ type_Z) i =>
-      negb require_casts && is_fst_snd_ident i
     | _ => false
     end.
 
@@ -195,6 +208,22 @@ Section Expr.
     | _ => false
     end.
 
+  (* Accepts a cast expression with range reqs only on the first element. *)
+  Definition valid_fst_cast_bool {t}
+             (e : @API.expr (fun _ => unit) t) : bool :=
+    match invert_expr.invert_Z_cast2 e with
+    | Some (r1, r2) => range_good (width:=width) r1
+    | None => false
+    end.
+
+  (* Accepts a cast expression with range reqs only on the second element. *)
+  Definition valid_snd_cast_bool {t}
+             (e : @API.expr (fun _ => unit) t) : bool :=
+    match invert_expr.invert_Z_cast2 e with
+    | Some (r1, r2) => range_good (width:=width) r2
+    | None => false
+    end.
+
   (* Because some operations are only valid if the arguments obey certain
      constraints, and to make the inductive logic work out, it helps to be able
      to call valid_expr_bool' recursively but have it return false for anything
@@ -202,7 +231,7 @@ Section Expr.
      very last application in a multi-argument function, take a sneak peek ahead
      to see if the rest of the applications match a certain kind of operation,
      and then enforce any constraints on the last argument. *)
-  Inductive PartialMode := NotPartial | Binop | Shift | Select | Lnot.
+  Inductive PartialMode := NotPartial | Binop | Shift | Select | Lnot | Fst | Snd.
 
   Fixpoint valid_expr_bool' {t}
            (mode : PartialMode) (require_casts : bool)
@@ -241,6 +270,18 @@ Section Expr.
           && valid_expr_bool' NotPartial true x
       | _ => false
       end
+    | Fst =>
+      match e with
+      | expr.App type_ZZ type_ZZ f x =>
+        valid_fst_cast_bool f && valid_expr_bool' NotPartial false x
+      | _ => false
+      end
+    | Snd =>
+      match e with
+      | expr.App type_ZZ type_ZZ f x =>
+        valid_snd_cast_bool f && valid_expr_bool' NotPartial false x
+      | _ => false
+      end
     | NotPartial =>
         match e with
         | expr.App type_nat _ f x =>
@@ -273,15 +314,18 @@ Section Expr.
                           (negb require_casts)
                             && valid_expr_bool' NotPartial true x
                         else (* must be a cast *)
-                          (valid_expr_App1_bool require_casts f)
+                          (valid_cast_bool f)
                             && valid_expr_bool' NotPartial false x
         | expr.App type_ZZ type_Z f x =>
           (* fst or snd *)
-          (valid_expr_App1_bool require_casts f)
-            && valid_expr_bool' NotPartial false x
+          if is_fst_ident_expr f
+          then (negb require_casts) && valid_expr_bool' Fst false x
+          else if is_snd_ident_expr f
+               then (negb require_casts) && valid_expr_bool' Snd false x
+               else false
         | expr.App type_ZZ type_ZZ f x =>
-          (valid_expr_App1_bool require_casts f)
-            && valid_expr_bool' NotPartial false x
+          valid_cast_bool f
+          && valid_expr_bool' NotPartial false x
         | expr.Ident _ (ident.Literal base.type.Z z) =>
           is_bounded_by_bool z (@max_range width)|| negb require_casts
         | expr.Ident _ (ident.Literal base.type.nat n) =>
@@ -294,31 +338,14 @@ Section Expr.
 
   Definition valid_expr_bool {t} := @valid_expr_bool' t NotPartial.
 
-  Lemma valid_expr_App1_bool_type {t} rc (e : API.expr t) :
-    valid_expr_App1_bool rc e = true ->
-    (exists d,
-        t = type.arrow type_Z d
-        \/ t = type.arrow type_ZZ d).
+  Lemma valid_expr_App1_bool_type {t} (e : API.expr t) :
+    valid_cast_bool e = true ->
+    (t = type.arrow type_Z type_Z
+     \/ t = type.arrow type_ZZ type_ZZ).
   Proof.
-    cbv [valid_expr_App1_bool].
-    destruct e;
-      match goal with
-      | idc : ident.ident _ |- _ =>
-        destruct idc; try congruence;
-          break_match; try congruence; intros;
-            eexists; right; reflexivity
-      | v: unit, t : API.type |- _ =>
-        destruct t; congruence
-      | f : API.expr (?s -> ?d) |- _ =>
-        destruct d;
-          break_match; try congruence;
-        try (eexists; right; reflexivity);
-        eexists; left; reflexivity
-      | |- forall (_: false = true), _ => congruence
-      | |- context [@expr.LetIn _ _ _ _ ?B] =>
-        destruct B; congruence
-      | _ => idtac
-      end.
+    cbv [valid_cast_bool].
+    break_match; try congruence.
+    all:intros; tauto.
   Qed.
 
   Lemma is_mul_high_ident_expr_type {t} (f : API.expr t) :
@@ -470,19 +497,55 @@ Section Expr.
     eassumption.
   Qed.
 
-  Lemma is_fst_snd_ident_impl1 {t} (i : ident.ident t) :
-    is_fst_snd_ident i = true ->
+  Lemma is_fst_ident_impl1 {t} (i : ident.ident t) :
+    is_fst_ident i = true ->
     (match t as t0 return ident.ident t0 -> Prop with
      | type.arrow type_ZZ type_Z =>
        fun i =>
-         forall x : API.expr type_ZZ,
+         forall (x : API.expr type_ZZ) r1 r2,
            valid_expr false x ->
-           valid_expr false (expr.App (expr.Ident i) x)
+           range_good (width:=width) r1 = true ->
+           valid_expr false (expr.App (expr.Ident i)
+                                      (expr.App (expr.App
+                                                   (expr.Ident ident.Z_cast2)
+                                                   (expr.App
+                                                      (expr.App
+                                                         (expr.Ident ident.pair)
+                                                         (expr.Ident
+                                                            (ident.Literal (t:=Compilers.zrange) r1)))
+                                                      (expr.Ident
+                                                         (ident.Literal (t:=Compilers.zrange) r2)))) x))
      | _ => fun _ => False
      end) i.
   Proof.
-    cbv [is_fst_snd_ident].
-    break_match; try congruence; [ | ];
+    cbv [is_fst_ident].
+    break_match; try congruence; [ ];
+      intros; constructor; eauto.
+  Qed.
+
+  Lemma is_snd_ident_expr_impl1 {t} (i : ident.ident t) :
+    is_snd_ident i = true ->
+    (match t as t0 return ident.ident t0 -> Prop with
+     | type.arrow type_ZZ type_Z =>
+       fun i =>
+         forall (x : API.expr type_ZZ) r1 r2,
+           valid_expr false x ->
+           range_good (width:=width) r2 = true ->
+           valid_expr false (expr.App (expr.Ident i)
+                                      (expr.App (expr.App
+                                                   (expr.Ident ident.Z_cast2)
+                                                   (expr.App
+                                                      (expr.App
+                                                         (expr.Ident ident.pair)
+                                                         (expr.Ident
+                                                            (ident.Literal (t:=Compilers.zrange) r1)))
+                                                      (expr.Ident
+                                                         (ident.Literal (t:=Compilers.zrange) r2)))) x))
+     | _ => fun _ => False
+     end) i.
+  Proof.
+    cbv [is_snd_ident].
+    break_match; try congruence; [ ];
       intros; constructor; eauto.
   Qed.
 
@@ -642,20 +705,14 @@ Section Expr.
         cbv [range_good]; auto using zrange_lb. }
   Qed.
 
-  Lemma valid_expr_App1_bool_impl1 {t}
-        rc (f : API.expr t) :
-    valid_expr_App1_bool rc f = true ->
+  Lemma valid_cast_bool_impl1 {t} rc (f : API.expr t) :
+    valid_cast_bool f = true ->
     (match t as t0 return expr.expr t0 -> Prop with
      | type.arrow type_Z _ =>
        fun f =>
          forall x : API.expr type_Z,
            valid_expr false x ->
            valid_expr rc (expr.App f x)
-     | type.arrow type_ZZ type_Z =>
-       fun f =>
-         forall x : API.expr type_ZZ,
-           valid_expr false x ->
-           valid_expr rc (expr.App f x)
      | type.arrow type_ZZ type_ZZ =>
        fun f =>
          forall x : API.expr type_ZZ,
@@ -664,19 +721,17 @@ Section Expr.
      | _ => fun _ => False
      end) f.
   Proof.
-    cbv [valid_expr_App1_bool].
+    cbv [valid_cast_bool].
     remember t.
     destruct t; try congruence.
     { intros; exfalso.
       break_match_hyps; congruence. }
-    { break_match; try congruence; [ | | ]; intros;
+    { break_match; try congruence; [ | ]; intros;
         repeat match goal with
                | H : _ && _ = true |- _ =>
                  apply andb_true_iff in H; destruct H
                | H : negb ?rc = true |- _ =>
                  destruct rc; cbn [negb] in *; try congruence; [ ]
-               | H : is_fst_snd_ident _ = true |- _ =>
-                 apply is_fst_snd_ident_impl1 in H; solve [eauto]
                | H : is_cast_ident_expr _ = true |- _ =>
                  eapply is_cast_ident_expr_impl1 in H;
                    apply H; solve [eauto]
@@ -885,6 +940,35 @@ Section Expr.
     congruence.
   Qed.
 
+  Lemma is_fst_ident_expr_eq {t} (f : API.expr t) :
+    is_fst_ident_expr f = true ->
+    (match t as t0 return API.expr t0 -> Prop with
+     | type.arrow type_ZZ type_Z =>
+       fun f => f = expr.Ident (@ident.fst base_Z base_Z)
+     | _ => fun _ => False
+     end) f.
+  Proof.
+    cbv [is_fst_ident_expr is_fst_ident].
+    break_match; congruence.
+  Qed.
+
+  Lemma is_snd_ident_expr_eq {t} (f : API.expr t) :
+    is_snd_ident_expr f = true ->
+    (match t as t0 return API.expr t0 -> Prop with
+     | type.arrow type_ZZ type_Z =>
+       fun f => f = expr.Ident (@ident.snd base_Z base_Z)
+     | _ => fun _ => False
+     end) f.
+  Proof.
+    cbv [is_snd_ident_expr is_snd_ident].
+    destruct f; try congruence; [ ].
+    lazymatch goal with
+    | idc : IdentifiersBasicGENERATED.Compilers.ident _ |- _ =>
+      destruct idc; try congruence; [ ]
+    end.
+    break_match; try congruence.
+  Qed.
+
   Lemma valid_expr_select_bool_impl1 {t}
         rc (f : API.expr t) :
     valid_expr_select_bool rc f = true ->
@@ -966,6 +1050,34 @@ Section Expr.
     induction 1; try solve [constructor; eauto using Bool.orb_true_r].
   Qed.
 
+  Definition is_valid_fst_casted {t} (e : API.expr t) : bool :=
+    match e with
+    | expr.App type_ZZ type_ZZ f x =>
+      valid_fst_cast_bool f && valid_expr_bool' NotPartial false x
+    | _ => false
+    end.
+
+  Definition valid_expr_Fst_valid_fst_casted {t} (e : API.expr t) :
+    valid_expr_bool' Fst false e = true ->
+    is_valid_fst_casted e = true.
+  Proof.
+    destruct e; cbn [valid_expr_bool' is_valid_fst_casted]; congruence.
+  Qed.
+
+  Definition is_valid_snd_casted {t} (e : API.expr t) : bool :=
+    match e with
+    | expr.App type_ZZ type_ZZ f x =>
+      valid_snd_cast_bool f && valid_expr_bool' NotPartial false x
+    | _ => false
+    end.
+
+  Definition valid_expr_Snd_valid_snd_casted {t} (e : API.expr t) :
+    valid_expr_bool' Snd false e = true ->
+    is_valid_snd_casted e = true.
+  Proof.
+    destruct e; cbn [valid_expr_bool' is_valid_snd_casted]; congruence.
+  Qed.
+
   Lemma valid_expr_bool'_impl1 {t} (e : API.expr t) :
     forall mode rc,
       valid_expr_bool' mode rc e = true ->
@@ -1022,6 +1134,24 @@ Section Expr.
                valid_expr rc (expr.App f x)
          | _ => fun _ => False
          end) e
+      | Fst =>
+        (match t as t0 return expr.expr t0 -> Prop with
+         | type_ZZ =>
+           fun e =>
+             is_valid_fst_casted e = true ->
+             rc = false ->
+             valid_expr rc (expr.App (expr.Ident ident.fst) e)
+         | _ => fun _ => False
+         end) e
+      | Snd =>
+        (match t as t0 return expr.expr t0 -> Prop with
+         | type_ZZ =>
+           fun e =>
+             is_valid_snd_casted e = true ->
+             rc = false ->
+             valid_expr rc (expr.App (expr.Ident ident.snd) e)
+         | _ => fun _ => False
+         end) e
       | NotPartial => (exists b, t = type.base b) -> valid_expr rc e
       end.
   Proof.
@@ -1047,22 +1177,24 @@ Section Expr.
     { remember s.
       remember d.
       break_match_hyps; try congruence;
-          repeat match goal with
-                 | H : _ && _ = true |- _ =>
-                   apply andb_true_iff in H; destruct H
-                 | H: valid_expr_App1_bool _ _ = true |- _ =>
-                   apply valid_expr_App1_bool_type in H;
-                     destruct H; destruct H; congruence
-                 | IH : forall mode _ _,
-                     match mode with
-                     | NotPartial => _
-                     | Binop => False
-                     | Shift => False
-                     | Select => False
-                     | Lnot => False
-                     end |- _ =>
-                   specialize (IH NotPartial); (cbn match in IH)
-                 end.
+        repeat match goal with
+               | H : _ && _ = true |- _ =>
+                 apply andb_true_iff in H; destruct H
+               | H: valid_cast_bool _ = true |- _ =>
+                 apply valid_cast_bool_type in H;
+                   destruct H; destruct H; congruence
+               | IH : forall mode _ _,
+                   match mode with
+                   | NotPartial => _
+                   | Binop => False
+                   | Shift => False
+                   | Select => False
+                   | Lnot => False
+                   | Fst => False
+                   | Snd => False
+                   end |- _ =>
+                 specialize (IH NotPartial); (cbn match in IH)
+               end.
       { (* fully-applied binop case *)
         intros. apply (IHe1 Binop); eauto. }
       { (* fully-applied shift case *)
@@ -1083,18 +1215,33 @@ Section Expr.
         eauto. }
       { (* cast Z case *)
         intros.
-        apply (valid_expr_App1_bool_impl1
+        apply (valid_cast_bool_impl1
                  (t := type_Z -> type_Z)); eauto. }
       { (* nth_default case *)
         eauto using valid_expr_nth_default_bool_impl1. }
-      { (* fst/snd *)
+      { (* fully-applied fst case *)
         intros.
-        apply (valid_expr_App1_bool_impl1
-                 (t := type_ZZ -> type_Z)); eauto using valid_expr_require_casts_weaken. }
+        repeat lazymatch goal with
+               | H : is_fst_ident_expr _ = true |- _ =>
+                 apply is_fst_ident_expr_eq in H; subst
+               | H : negb ?b = true |- _ =>
+                 destruct b; cbn [negb] in *; [ congruence | ]
+               end.
+        apply (IHe2 Fst); auto using valid_expr_Fst_valid_fst_casted. }
+      { (* fully-applied snd case *)
+        intros.
+        repeat lazymatch goal with
+               | H : is_snd_ident_expr _ = true |- _ =>
+                 apply is_snd_ident_expr_eq in H; subst
+               | H : negb ?b = true |- _ =>
+                 destruct b; cbn [negb] in *; [ congruence | ]
+               end.
+        apply (IHe2 Snd); auto using valid_expr_Snd_valid_snd_casted. }
       { (* cast ZZ *)
         intros.
-        apply (valid_expr_App1_bool_impl1
-                 (t := type_ZZ -> type_ZZ)); eauto. }
+        apply (valid_cast_bool_impl1
+                 (t := type_ZZ -> type_ZZ)); eauto; [ ].
+        eapply (IHe2 NotPartial); auto. }
       { (* partially-applied binop case *)
         intros.
         apply (valid_expr_binop_bool_impl1
@@ -1112,7 +1259,33 @@ Section Expr.
       { (* partially-applied lnot_modulo case *)
         intros.
         apply (valid_expr_lnot_modulo_bool_impl1
-                 (t:=type_Z -> type_Z -> type_Z)); eauto. } }
+                 (t:=type_Z -> type_Z -> type_Z)); eauto. }
+      { (* partially-applied fst case *)
+        intros.
+        cbv [valid_fst_cast_bool] in *.
+        break_match_hyps; try congruence ; [ ].
+        lazymatch goal with
+        | H : invert_expr.invert_Z_cast2 _ = Some _ |- _ =>
+          apply InversionExtra.Compilers.expr.invert_Z_cast2_Some_ZZ in H;
+            cbn in H; subst
+        end.
+        cbv [ident.literal].
+        constructor; auto; [ ].
+        apply (IHe2 NotPartial); auto.
+        eexists; reflexivity. }
+      { (* partially-applied snd case *)
+        intros.
+        cbv [valid_snd_cast_bool] in *.
+        break_match_hyps; try congruence ; [ ].
+        lazymatch goal with
+        | H : invert_expr.invert_Z_cast2 _ = Some _ |- _ =>
+          apply InversionExtra.Compilers.expr.invert_Z_cast2_Some_ZZ in H;
+            cbn in H; subst
+        end.
+        cbv [ident.literal].
+        constructor; auto; [ ].
+        apply (IHe2 NotPartial); auto.
+        eexists; reflexivity. } }
     { break_match; try congruence. }
   Qed.
 

From db521d80cc1c22939c787f95f0279eaa7a381a74 Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Thu, 17 Aug 2023 16:43:03 +0200
Subject: [PATCH 20/34] computable valid expr works completely

---
 src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
index a835544c88..c399e20880 100644
--- a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
+++ b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
@@ -49,7 +49,7 @@ Section Expr.
     end.
   Definition is_snd_ident_expr {t} (e : @API.expr (fun _ => unit) t) : bool :=
     match e with
-    | expr.Ident type_Z i => is_snd_ident i
+    | expr.Ident _ i => is_snd_ident i
     | _ => false
     end.
 

From 2cc14acd92f6c31477a685c52436ec6598d26464 Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Thu, 17 Aug 2023 17:05:45 +0200
Subject: [PATCH 21/34] starting to allow zz vars

---
 .../Field/Synthesis/Examples/p224_64_new.v    | 26 ++++++++++++++++++-
 src/Bedrock/Field/Translation/Proofs/Expr.v   |  6 +++--
 2 files changed, 29 insertions(+), 3 deletions(-)

diff --git a/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v b/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
index 1be6a5d8d6..1bf13a59ee 100644
--- a/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
+++ b/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
@@ -167,8 +167,32 @@ Section Field.
       cbn iota.
       lazymatch goal with
       | |- context [Expr.valid_expr_bool true ?x] =>
-        pose (e:=Expr.valid_expr_bool true x)
+        pose (e:=Expr.valid_expr_bool true x);
+          assert (Expr.valid_expr true x)
       end.
+      {
+        clear e.
+        Unset Printing Notations.
+        repeat lazymatch goal with
+               | |- Expr.valid_expr
+                     _ (expr.App (expr.App (expr.Ident Compilers.ident_Z_cast) _)  _) =>
+                 apply Expr.valid_cast1; [ | reflexivity .. ]
+               | |- Expr.valid_expr _ (expr.Var _) =>
+                 apply Expr.valid_var_z
+               | _ => apply Expr.valid_binop; [ cbn; congruence | | ]
+               end.
+        Print Expr.valid_expr.
+        { apply Expr.valid_fst.
+          apply Expr.valid_cast2.
+        apply Expr.valid_binop; [ cbn; congruence | | ].
+        {
+          apply Expr.valid_cast1; [ | reflexivity .. ].
+        apply Expr.valid_binop; [ cbn; congruence | | ].
+        constructor.
+        apply Expr.valid_cast1; [ | reflexivity .. ].
+        apply Expr.valid_cast1; [ | reflexivity .. ].
+      cbv [Expr.valid_expr_bool] in e.
+      cbn in e.
       (*
  Expr.valid_expr_bool true
          (#Compilers.ident_Z_cast @ ###{| ZRange.lower := 0; ZRange.upper := 4294967295 |} @
diff --git a/src/Bedrock/Field/Translation/Proofs/Expr.v b/src/Bedrock/Field/Translation/Proofs/Expr.v
index d60e0e5893..d4800683a3 100644
--- a/src/Bedrock/Field/Translation/Proofs/Expr.v
+++ b/src/Bedrock/Field/Translation/Proofs/Expr.v
@@ -64,7 +64,7 @@ Section Expr.
                                       (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
                                    (expr.Ident (ident.Literal (t:=base.type.zrange) r2)))) x)
   | valid_fst_cast :
-      forall (x : API.expr type_ZZ) rc r1 r2,
+      forall (x : API.expr type_ZZ) r1 r2,
         valid_expr false x ->
         range_good (width:=width) r1 = true ->
         (* it's okay to have a cast with a bad range on the non-selected tuple element *)
@@ -79,7 +79,7 @@ Section Expr.
                                          (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
                                       (expr.Ident (ident.Literal (t:=base.type.zrange) r2)))) x))
   | valid_snd_cast :
-      forall (x : API.expr type_ZZ) rc r1 r2,
+      forall (x : API.expr type_ZZ) r1 r2,
         valid_expr false x ->
         range_good (width:=width) r2 = true ->
         (* it's okay to have a cast with a bad range on the non-selected tuple element *)
@@ -102,6 +102,8 @@ Section Expr.
         valid_expr false (expr.Ident (ident.Literal (t:=base.type.nat) n))
   | valid_var_z :
       forall rc v, valid_expr (t:=type_Z) rc (expr.Var v)
+  | valid_var_zz :
+      forall rc v, valid_expr (t:=type_ZZ) rc (expr.Var v)
   | valid_var_listz :
       forall rc v, valid_expr (t:=type_listZ) rc (expr.Var v)
   | valid_nth_default :

From ad7b9fb9d253538cf68ed521b5a181c53a48e937 Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Thu, 17 Aug 2023 17:14:06 +0200
Subject: [PATCH 22/34] zz vars working?

---
 src/Bedrock/Field/Translation/Expr.v                 |  1 +
 src/Bedrock/Field/Translation/Proofs/Expr.v          | 12 ++++++++++++
 .../Field/Translation/Proofs/ValidComputable/Expr.v  |  2 ++
 3 files changed, 15 insertions(+)

diff --git a/src/Bedrock/Field/Translation/Expr.v b/src/Bedrock/Field/Translation/Expr.v
index 0385834296..82f0dd00dd 100644
--- a/src/Bedrock/Field/Translation/Expr.v
+++ b/src/Bedrock/Field/Translation/Expr.v
@@ -272,6 +272,7 @@ Section Expr.
       expr.literal (Z.of_nat n)
     | expr.Var type_listZ x => map expr.var x
     | expr.Var type_Z x => expr.var x
+    | expr.Var type_ZZ x => (expr.var (fst x), expr.var (snd x))
     | _ => make_error _
     end.
 
diff --git a/src/Bedrock/Field/Translation/Proofs/Expr.v b/src/Bedrock/Field/Translation/Proofs/Expr.v
index d4800683a3..8a0f50e471 100644
--- a/src/Bedrock/Field/Translation/Proofs/Expr.v
+++ b/src/Bedrock/Field/Translation/Proofs/Expr.v
@@ -581,6 +581,18 @@ Section Expr.
       destruct rc;
       try apply locally_equivalent_nobounds_impl;
       eauto. }
+    { (* var (Z * Z) *)
+      match goal with
+      | H : context_equiv _ _ |- _ =>
+        cbv [context_equiv] in H;
+          rewrite Forall_forall in H;
+          specialize (H _ ltac:(eassumption))
+      end.
+      cbv [equiv3 locally_equivalent] in *.
+      cbn [equivalent_base equivalent] in *.
+      destruct rc;
+      try apply locally_equivalent_nobounds_impl;
+      eauto. }
     { (* var (list Z) *)
       match goal with
       | H : context_equiv _ _ |- _ =>
diff --git a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
index c399e20880..899fe9ddb0 100644
--- a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
+++ b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
@@ -331,6 +331,7 @@ Section Expr.
         | expr.Ident _ (ident.Literal base.type.nat n) =>
           negb require_casts
         | expr.Var type_Z v => true
+        | expr.Var type_ZZ v => true
         | expr.Var type_listZ v => true
         | _ => false
         end
@@ -1171,6 +1172,7 @@ Section Expr.
       { destruct rc; cbn [negb] in *; try congruence.
         constructor. } }
     { break_match_hyps; try congruence.
+      { constructor. }
       { constructor. }
       { constructor. } }
     { break_match_hyps; congruence. }

From aa087e35f4480c6bfd19d14921b3ef12773c12a9 Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Thu, 17 Aug 2023 17:45:03 +0200
Subject: [PATCH 23/34] starting to adapt zselect, which is failing because of
 the new [0,1] range

---
 .../Field/Synthesis/Examples/p224_64_new.v    | 41 +++++--------------
 src/Bedrock/Field/Translation/Expr.v          |  4 +-
 2 files changed, 14 insertions(+), 31 deletions(-)

diff --git a/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v b/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
index 1bf13a59ee..802d3193cf 100644
--- a/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
+++ b/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
@@ -165,13 +165,22 @@ Section Field.
                change (Cmd.valid_expr_bool_if_base x) with false
              end.
       cbn iota.
+      cbv [Cmd.valid_cons_App1_bool
+             Cmd.valid_cons_App2_bool
+             Cmd.is_cons_ident
+             Cmd.is_nil_ident].
+      repeat lazymatch goal with
+             | |- context [Expr.valid_expr_bool true ?x] =>
+               change (Expr.valid_expr_bool true x) with true
+             end.
+      cbn [orb andb].
       lazymatch goal with
       | |- context [Expr.valid_expr_bool true ?x] =>
         pose (e:=Expr.valid_expr_bool true x);
           assert (Expr.valid_expr true x)
       end.
       {
-        clear e.
+        lazy in e.
         Unset Printing Notations.
         repeat lazymatch goal with
                | |- Expr.valid_expr
@@ -182,35 +191,7 @@ Section Field.
                | _ => apply Expr.valid_binop; [ cbn; congruence | | ]
                end.
         Print Expr.valid_expr.
-        { apply Expr.valid_fst.
-          apply Expr.valid_cast2.
-        apply Expr.valid_binop; [ cbn; congruence | | ].
-        {
-          apply Expr.valid_cast1; [ | reflexivity .. ].
-        apply Expr.valid_binop; [ cbn; congruence | | ].
-        constructor.
-        apply Expr.valid_cast1; [ | reflexivity .. ].
-        apply Expr.valid_cast1; [ | reflexivity .. ].
-      cbv [Expr.valid_expr_bool] in e.
-      cbn in e.
-      (*
- Expr.valid_expr_bool true
-         (#Compilers.ident_Z_cast @ ###{| ZRange.lower := 0; ZRange.upper := 4294967295 |} @
-          (#Compilers.ident_Z_cast @ ###{| ZRange.lower := 0; ZRange.upper := 4294967295 |} @
-           (#Compilers.ident_Z_cast @ ###{| ZRange.lower := 0; ZRange.upper := 4294967295 |} @
-            (#Compilers.ident_fst @
-             (#Compilers.ident_Z_cast2 @
-              (###{| ZRange.lower := 0; ZRange.upper := 4294967295 |},
-              ###{| ZRange.lower := 0; ZRange.upper := 1 |}) @ $$tt)) &'
-            #Compilers.ident_Z_cast @ ###{| ZRange.lower := 0; ZRange.upper := 4294967295 |} @ $$tt)
-           || #Compilers.ident_Z_cast @ ###{| ZRange.lower := 0; ZRange.upper := 4294967295 |} @
-              (#Compilers.ident_Z_cast @ ###{| ZRange.lower := 0; ZRange.upper := 4294967295 |} @
-               (#Compilers.ident_fst @
-                (#Compilers.ident_Z_cast2 @
-                 (###{| ZRange.lower := 0; ZRange.upper := 4294967295 |},
-                 ###{| ZRange.lower := 0; ZRange.upper := 1 |}) @ $$tt)) &'
-               #Compilers.ident_Z_cast @ ###{| ZRange.lower := 0; ZRange.upper := 4294967295 |} @ $$tt)))
-*)
+        (* zselect recursively calls valid_expr, which now fails because of the [0,1] bound *)
       cbv in e.
     Locate begin_derive_bedrock2_func.
     Time derive_bedrock2_func add_op.
diff --git a/src/Bedrock/Field/Translation/Expr.v b/src/Bedrock/Field/Translation/Expr.v
index 82f0dd00dd..1beb8773d8 100644
--- a/src/Bedrock/Field/Translation/Expr.v
+++ b/src/Bedrock/Field/Translation/Expr.v
@@ -111,7 +111,7 @@ Section Expr.
       if literal_eqb x 0
       then if literal_eqb y (2^width - 1)
            then expr.op bopname.add (expr.literal (-1))
-                        (expr.op bopname.eq c (expr.literal 0))
+                        (expr.op bopname.and c (expr.literal 1))
            else base_make_error _
       else base_make_error _.
 
@@ -203,6 +203,7 @@ Section Expr.
   (* only require cast for the argument of (App f x) if:
      - f is not a cast
      - f is not fst or snd
+     - f is not zselect (x may be cast to the range [0,1])
      - f is not mul_high (then, x = 2^width)
      - f is not (lnot_modulo _) (then x is allowed to be 2^width)
      - f is not (nth_default ?d ?l) (i doesn't need to fit in a word) *)
@@ -214,6 +215,7 @@ Section Expr.
     | expr.Ident _ ident.Z_mul_high => false
     | expr.Ident _ (ident.fst _ _) => false
     | expr.Ident _ (ident.snd _ _) => false
+    | expr.Ident _ ident.Z_zselect => false
     | expr.App
         _ _ (expr.Ident _ ident.Z_lnot_modulo)
         _ => false

From fe747d2a07b6f365e82a3df8509fee0dadacd68b Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Thu, 17 Aug 2023 18:01:29 +0200
Subject: [PATCH 24/34] won't work, wrote a new idea

---
 src/Bedrock/Field/Translation/Expr.v        |  2 +-
 src/Bedrock/Field/Translation/Proofs/Expr.v | 37 ++++++++++++++++-----
 2 files changed, 29 insertions(+), 10 deletions(-)

diff --git a/src/Bedrock/Field/Translation/Expr.v b/src/Bedrock/Field/Translation/Expr.v
index 1beb8773d8..c0c74e6657 100644
--- a/src/Bedrock/Field/Translation/Expr.v
+++ b/src/Bedrock/Field/Translation/Expr.v
@@ -111,7 +111,7 @@ Section Expr.
       if literal_eqb x 0
       then if literal_eqb y (2^width - 1)
            then expr.op bopname.add (expr.literal (-1))
-                        (expr.op bopname.and c (expr.literal 1))
+                        (expr.op bopname.eq c (expr.literal 0))
            else base_make_error _
       else base_make_error _.
 
diff --git a/src/Bedrock/Field/Translation/Proofs/Expr.v b/src/Bedrock/Field/Translation/Proofs/Expr.v
index 8a0f50e471..a6fb4c1d5a 100644
--- a/src/Bedrock/Field/Translation/Proofs/Expr.v
+++ b/src/Bedrock/Field/Translation/Proofs/Expr.v
@@ -168,7 +168,7 @@ Section Expr.
       forall (c : API.expr type_Z) (x y : Z),
         x = 0 ->
         y = 2^width-1 ->
-        valid_expr true c ->
+        valid_expr false c ->
         valid_expr (t:=type_Z) false
                    (expr.App (expr.App
                                 (expr.App (expr.Ident ident.Z_zselect) c)
@@ -773,14 +773,33 @@ Section Expr.
       cbv [word.wrap]. Z.rewrite_mod_small.
       pose proof word.width_pos.
       break_match; subst; Z.rewrite_mod_small;
-        Z.ltb_to_lt; try lia.
-      all:pull_Zmod.
-      all:autorewrite with zsimplify_fast.
-      all:try reflexivity.
-      rewrite Z.mod_opp_l_nz
-        by (rewrite ?Z.mod_1_l; auto with zarith).
-      Z.rewrite_mod_small.
-      reflexivity. }
+        Z.ltb_to_lt; try lia; pull_Zmod;
+          autorewrite with zsimplify_fast;
+          try reflexivity;
+          lazymatch goal with
+          | H : 0 mod _ <> 0 |- _ =>
+            rewrite Z.mod_0_l in H; lia
+          | _ => idtac
+          end; [ | ].
+      {
+        Search WeakestPrecondition.expr.
+        apply dexpr_expr in IHvalid_expr.
+        sepsimpl.
+        Search context_equiv.
+        (* this won't work. translate_expr will still see the cast and require a cast on its argument because the range is bad.
+
+         we cooooould always add a special case for [0~>1] casts that just ands with 1. Then could pass carries for add_get_carry through expr, and this would also save all the trouble with tuples. *)
+        Print context_equiv.
+        Print equiv3.
+        Print equivalent_base.
+        destruct IHvalid_expr.
+
+      }
+      {
+        rewrite Z.mod_opp_l_nz
+          by (rewrite ?Z.mod_1_l; auto with zarith).
+        Z.rewrite_mod_small.
+        reflexivity. } }
     { (* opp *)
       specialize (IHvalid_expr _ _ _ _
                                ltac:(eassumption) ltac:(eassumption)).

From deca8c7c156c29d8561eeea7bb0901a40aadee37 Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Thu, 24 Aug 2023 09:05:28 +0200
Subject: [PATCH 25/34] proof working, starting on valid computable

---
 src/Bedrock/Field/Translation/Expr.v          |  56 ++++--
 src/Bedrock/Field/Translation/Proofs/Expr.v   | 170 ++++++++++++------
 .../Translation/Proofs/ValidComputable/Expr.v | 148 +++++++++------
 3 files changed, 250 insertions(+), 124 deletions(-)

diff --git a/src/Bedrock/Field/Translation/Expr.v b/src/Bedrock/Field/Translation/Expr.v
index c0c74e6657..6638f63040 100644
--- a/src/Bedrock/Field/Translation/Expr.v
+++ b/src/Bedrock/Field/Translation/Expr.v
@@ -21,6 +21,7 @@ Section Expr.
 
   (* for the second argument of shifts *)
   Definition width_range :=  r[0~>width-1]%zrange.
+  Definition bit_range := r[0~>1]%zrange.
 
   Local Notation Zcast r :=
     (@expr.App
@@ -39,16 +40,14 @@ Section Expr.
              (expr.Ident (@ident.Literal base.type.zrange r1)))
           (expr.Ident (@ident.Literal base.type.zrange r2)))).
 
-  (* Literal Zs or nats, and lists, do not need casts *)
+  (* Literal Zs, ranges, or nats, and lists, do not need casts *)
   Definition cast_exempt {var t} (e : @API.expr var t)
     : bool :=
     match e with
-    | (expr.Ident _ (ident.Literal base.type.Z z)) =>
-      true
-    | (expr.Ident _ (ident.Literal base.type.nat n)) =>
-      true
-    | expr.Var _ _ =>
-      true
+    | (expr.Ident _ (ident.Literal base.type.Z z)) => true
+    | (expr.Ident _ (ident.Literal base.type.nat n)) => true
+    | (expr.Ident _ (ident.Literal base.type.zrange r)) => true
+    | expr.Var _ _ => true
     | _ => false
     end.
 
@@ -133,15 +132,13 @@ Section Expr.
 
   Definition is_cast_literal_ident {t} (i : ident.ident t) : bool :=
     match i with
-    | ident.Literal base.type.zrange r =>
-      range_good r
+    | ident.Literal base.type.zrange r => true
     | _ => false
     end.
   Definition is_cast_literal
              {var t} (e : @API.expr var t) : bool :=
     match e with
-    | expr.Ident type_range i =>
-      is_cast_literal_ident i
+    | expr.Ident type_range i => is_cast_literal_ident i
     | _ => false
     end.
 
@@ -202,7 +199,7 @@ Section Expr.
 
   (* only require cast for the argument of (App f x) if:
      - f is not a cast
-     - f is not fst or snd
+     - f is not a tuple operation
      - f is not zselect (x may be cast to the range [0,1])
      - f is not mul_high (then, x = 2^width)
      - f is not (lnot_modulo _) (then x is allowed to be 2^width)
@@ -210,11 +207,15 @@ Section Expr.
   Definition require_cast_for_arg
              {var t} (e : @API.expr var t) : bool :=
     match e with
+    | expr.Ident _ (ident.fst _ _) => false
+    | expr.Ident _ (ident.snd _ _) => false
+    | expr.Ident _ (ident.pair _ _) => false
+    | expr.App _ _ (expr.Ident _ (ident.pair _ _)) _ => false
+    | expr.Ident _ ident.Z_cast => false
+    | expr.Ident _ ident.Z_cast2 => false
     | Zcast r => false
     | Zcast2 r1 r2 => false
     | expr.Ident _ ident.Z_mul_high => false
-    | expr.Ident _ (ident.fst _ _) => false
-    | expr.Ident _ (ident.snd _ _) => false
     | expr.Ident _ ident.Z_zselect => false
     | expr.App
         _ _ (expr.Ident _ ident.Z_lnot_modulo)
@@ -239,11 +240,28 @@ Section Expr.
     | _ => None
     end.
 
+  Definition rcast : rtype (type_range -> type_Z -> type_Z) :=
+    fun (r : Syntax.expr) (x : Syntax.expr) =>
+      (* We expect a mask to represent the range. If the mask is the same as the
+         word size, we can ignore it. *)
+      if literal_eqb r (2 ^ width - 1)
+      then x
+      else expr.op bopname.and x r.
+
+  Definition rcast2 : rtype (type_range2 -> type_ZZ -> type_ZZ) :=
+    fun (rr : Syntax.expr * Syntax.expr) (xy : Syntax.expr * Syntax.expr) =>
+      (* We expect a mask to represent the range. If the mask is the same as the
+         word size, we can ignore it. *)
+      let x := rcast (fst rr) (fst xy) in
+      let y := rcast (snd rr) (snd xy) in
+      (x, y).
+
   Definition translate_ident
            {t} (i : ident.ident t) : rtype t :=
     match i in ident.ident t0 return rtype t0 with
     | ident.fst _ _ => fst
     | ident.snd _ _ => snd
+    | ident.pair _ _ => fun x y => (x, y)
     | ident.Z_opp => fun x => expr.op bopname.sub (expr.literal 0) x
     | ident.List_nth_default base_Z => rnth_default
     | ident.Z_shiftr => rshiftr
@@ -252,8 +270,8 @@ Section Expr.
     | ident.Z_lnot_modulo => rlnot_modulo
     | ident.Z_zselect => rselect
     | ident.Z_mul_high => rmul_high
-    | ident.Z_cast => fun _ x => x
-    | ident.Z_cast2 => fun _ x => x
+    | ident.Z_cast => rcast
+    | ident.Z_cast2 => rcast2
     | i => match translate_binop i with
            | Some x => x
            | None => make_error _
@@ -272,6 +290,12 @@ Section Expr.
       else expr.literal z
     | (expr.Ident type_nat (ident.Literal base.type.nat n)) =>
       expr.literal (Z.of_nat n)
+    | (expr.Ident type_range (ident.Literal base.type.zrange r)) =>
+      (* Translate ranges into masks. Only ranges of the form [0~>2^n-1] should
+         get translated. *)
+      if ((lower r =? 0) && (upper r =? Z.ones (Z.log2 (upper r + 1))))%bool
+      then expr.literal (upper r)
+      else make_error _
     | expr.Var type_listZ x => map expr.var x
     | expr.Var type_Z x => expr.var x
     | expr.Var type_ZZ x => (expr.var (fst x), expr.var (snd x))
diff --git a/src/Bedrock/Field/Translation/Proofs/Expr.v b/src/Bedrock/Field/Translation/Proofs/Expr.v
index a6fb4c1d5a..5959221425 100644
--- a/src/Bedrock/Field/Translation/Proofs/Expr.v
+++ b/src/Bedrock/Field/Translation/Proofs/Expr.v
@@ -165,13 +165,19 @@ Section Expr.
                                        x)
                              (expr.Ident (ident.Literal (t:=base.type.Z) m)))
   | valid_zselect :
-      forall (c : API.expr type_Z) (x y : Z),
+      forall rc (c : API.expr type_Z) (x y : Z),
         x = 0 ->
         y = 2^width-1 ->
+        zrange_beq rc bit_range = true ->
         valid_expr false c ->
         valid_expr (t:=type_Z) false
                    (expr.App (expr.App
-                                (expr.App (expr.Ident ident.Z_zselect) c)
+                                (expr.App (expr.Ident ident.Z_zselect)
+                                          (expr.App
+                                             (expr.App
+                                                (expr.Ident ident.Z_cast)
+                                                (expr.Ident (ident.Literal (t:=base.type.zrange) rc)))
+                                             c))
                                 (expr.Ident (ident.Literal (t:=base.type.Z) x)))
                                 (expr.Ident (ident.Literal (t:=base.type.Z) y)))
   | valid_opp :
@@ -405,6 +411,33 @@ Section Expr.
     destruct (ZRange.reflect_zrange_eq r (max_range (width:=width))); congruence.
   Qed.
 
+  Lemma ones_of_pow2_minus1 n : 0 <= n -> Z.ones (Z.log2 (2 ^ n - 1 + 1)) = 2 ^ n - 1.
+  Proof.
+    intros. rewrite Z.sub_add, Z.log2_pow2, Z.ones_equiv by lia. lia.
+  Qed.
+
+  Lemma Z_land_1_r x : Z.land x 1 = x mod 2.
+  Proof.
+    change 1 with (2^1 - 1).
+    rewrite Land.Z.land_pow2 by lia.
+    reflexivity.
+  Qed.
+
+  Lemma mod_pow2_mod_2 x n : 0 < n -> (x mod 2 ^ n) mod 2 = x mod 2.
+  Proof.
+    intros. rewrite Modulo.Z.mod_pow_same_base_smaller with (m:=1) by lia.
+    reflexivity.
+  Qed.
+
+  Lemma mod_2_mod_pow2 x n : 0 < n -> (x mod 2) mod 2^n = x mod 2.
+  Proof.
+    intros.
+    destruct (Z.ltb_spec 1 n).
+    { rewrite Modulo.Z.mod_pow_same_base_larger with (b:=2) (n:=1) by lia.
+      reflexivity. }
+    { assert (n = 1) by lia; subst; rewrite Z.mod_mod by lia; reflexivity. }
+  Qed.
+
   (** TODO: Find a better place for this *)
   Hint Rewrite word.testbit_wrap : Ztestbit_full.
   Lemma translate_expr_correct' {t}
@@ -482,9 +515,15 @@ Section Expr.
                                ltac:(eassumption) ltac:(eassumption)).
       cbn [locally_equivalent equivalent_base rep.equiv rep.Z
                               locally_equivalent_nobounds_base] in *.
-      cbv [range_good max_range ident.literal] in *.
+      cbv [range_good rcast max_range ident.literal] in *.
       intros; progress reflect_beq_to_eq zrange_beq; subst.
-      rewrite ident.cast_out_of_bounds_simple_0_mod by lia.
+      pose proof word.width_pos.
+      repeat match goal with
+             | _ => progress cbn [upper lower andb literal_eqb invert_literal]
+             | _ => rewrite Z.eqb_refl by lia
+             | _ => rewrite ones_of_pow2_minus1 by lia
+             | _ => rewrite ident.cast_out_of_bounds_simple_0_mod by lia
+             end.
       cleanup.
       rewrite Z.sub_simpl_r.
       erewrite word.of_Z_inj_mod
@@ -496,34 +535,44 @@ Section Expr.
     { (* cast2 *)
       specialize (IHvalid_expr _ _ _ _
                                ltac:(eassumption) ltac:(eassumption)).
-      cbv [range_good max_range ident.literal ident.cast2] in *.
+      cbv [range_good rcast rcast2 max_range ident.literal ident.cast2] in *.
       cbn [locally_equivalent equivalent_base rep.equiv rep.Z fst snd
                               locally_equivalent_nobounds_base] in *.
       cbn [Compilers.base_interp] in *.
       intros; progress reflect_beq_to_eq zrange_beq; subst.
       rewrite !ident.cast_out_of_bounds_simple_0_mod by lia.
       rewrite Z.sub_simpl_r.
-      destruct rc; repeat match goal with
-                          | _ => progress sepsimpl
-                          | _ => rewrite word.unsigned_of_Z
-                          | _ => eassumption
-                          | _ => eexists
-                          | _ =>
-                            erewrite word.of_Z_inj_mod
-                              by (rewrite Z.mod_mod by lia; reflexivity);
-                              solve [eauto]
-                          end. }
+      pose proof word.width_pos.
+      destruct rc;
+        repeat match goal with
+               | _ => progress sepsimpl
+               | _ => progress cbn [upper lower andb literal_eqb invert_literal]
+               | _ => rewrite Z.eqb_refl by lia
+               | _ => rewrite ones_of_pow2_minus1 by lia
+               | _ => rewrite ident.cast_out_of_bounds_simple_0_mod by lia
+               | _ => rewrite word.unsigned_of_Z
+               | _ => eassumption
+               | _ => eexists
+               | _ =>
+                 erewrite word.of_Z_inj_mod
+                   by (rewrite Z.mod_mod by lia; reflexivity);
+                   solve [eauto]
+               end. }
     { (* fst then cast *)
       specialize (IHvalid_expr _ _ _ _
                                ltac:(eassumption) ltac:(eassumption)).
-      cbv [range_good max_range ident.literal ident.cast2] in *.
+      cbv [range_good max_range ident.literal ident.cast2 rcast rcast2] in *.
       cbn [locally_equivalent equivalent_base rep.equiv rep.Z fst snd
                               locally_equivalent_nobounds_base] in *.
       intros; progress reflect_beq_to_eq zrange_beq; subst.
-      rewrite !ident.cast_out_of_bounds_simple_0_mod by lia.
-      rewrite Z.sub_simpl_r.
+      pose proof word.width_pos.
       repeat match goal with
+             | _ => progress cbn [upper lower andb literal_eqb invert_literal]
              | _ => progress sepsimpl
+             | _ => rewrite Z.eqb_refl by lia
+             | _ => rewrite ones_of_pow2_minus1 by lia
+             | _ => rewrite ident.cast_out_of_bounds_simple_0_mod by lia
+             | _ => rewrite Z.sub_simpl_r
              | _ => rewrite word.unsigned_of_Z
              | _ => eassumption
              | _ => eexists
@@ -535,14 +584,18 @@ Section Expr.
     { (* snd then cast *)
       specialize (IHvalid_expr _ _ _ _
                                ltac:(eassumption) ltac:(eassumption)).
-      cbv [range_good max_range ident.literal ident.cast2] in *.
+      cbv [range_good max_range ident.literal ident.cast2 rcast rcast2] in *.
       cbn [locally_equivalent equivalent_base rep.equiv rep.Z fst snd
                               locally_equivalent_nobounds_base] in *.
       intros; progress reflect_beq_to_eq zrange_beq; subst.
-      rewrite !ident.cast_out_of_bounds_simple_0_mod by lia.
-      rewrite Z.sub_simpl_r.
+      pose proof word.width_pos.
       repeat match goal with
+             | _ => progress cbn [upper lower andb literal_eqb invert_literal]
              | _ => progress sepsimpl
+             | _ => rewrite Z.eqb_refl by lia
+             | _ => rewrite ones_of_pow2_minus1 by lia
+             | _ => rewrite ident.cast_out_of_bounds_simple_0_mod by lia
+             | _ => rewrite Z.sub_simpl_r
              | _ => rewrite word.unsigned_of_Z
              | _ => eassumption
              | _ => eexists
@@ -760,46 +813,49 @@ Section Expr.
              locally_equivalent_nobounds_base
              locally_equivalent equivalent
              equivalent_base rep.equiv rep.Z ident.literal] in *.
-      cbv [WeakestPrecondition.dexpr ident.literal] in *.
+      intros; progress reflect_beq_to_eq zrange_beq; subst.
+      cbv [WeakestPrecondition.dexpr ident.literal bit_range rcast] in *.
       cbn [WeakestPrecondition.expr WeakestPrecondition.expr_body
                                     Semantics.interp_binop].
       sepsimpl_hyps.
-      eapply Proper_expr; [ | eassumption ].
-      repeat intro; subst.
-      rewrite Zselect.Z.zselect_correct.
-      apply word.unsigned_inj.
-      rewrite word.unsigned_add, word.unsigned_eqb.
-      rewrite <-Bool.pull_bool_if, !word.unsigned_of_Z.
-      cbv [word.wrap]. Z.rewrite_mod_small.
       pose proof word.width_pos.
-      break_match; subst; Z.rewrite_mod_small;
-        Z.ltb_to_lt; try lia; pull_Zmod;
-          autorewrite with zsimplify_fast;
-          try reflexivity;
-          lazymatch goal with
-          | H : 0 mod _ <> 0 |- _ =>
-            rewrite Z.mod_0_l in H; lia
-          | _ => idtac
-          end; [ | ].
-      {
-        Search WeakestPrecondition.expr.
-        apply dexpr_expr in IHvalid_expr.
-        sepsimpl.
-        Search context_equiv.
-        (* this won't work. translate_expr will still see the cast and require a cast on its argument because the range is bad.
-
-         we cooooould always add a special case for [0~>1] casts that just ands with 1. Then could pass carries for add_get_carry through expr, and this would also save all the trouble with tuples. *)
-        Print context_equiv.
-        Print equiv3.
-        Print equivalent_base.
-        destruct IHvalid_expr.
-
-      }
-      {
-        rewrite Z.mod_opp_l_nz
-          by (rewrite ?Z.mod_1_l; auto with zarith).
-        Z.rewrite_mod_small.
-        reflexivity. } }
+      repeat match goal with
+             | _ => progress cbn [upper lower andb literal_eqb invert_literal]
+             | _ => rewrite Z.eqb_refl by lia
+             | _ => rewrite ones_of_pow2_minus1 by lia
+             | _ => rewrite ident.cast_out_of_bounds_simple_0_mod by lia
+             end.
+      cbn [WeakestPrecondition.expr WeakestPrecondition.expr_body
+                                    Semantics.interp_binop].
+      rewrite Zselect.Z.zselect_correct.
+      replace (1 + 1) with 2 by lia.
+      break_match; Z.ltb_to_lt;
+        cbn [WeakestPrecondition.expr WeakestPrecondition.expr_body
+                                      Semantics.interp_binop].
+      all:eapply Proper_expr; [ | eassumption ].
+      all:repeat intro; subst.
+      all:apply word.unsigned_inj.
+      all:repeat lazymatch goal with
+                 | |- context [word.wrap _] => progress cbv [word.wrap]
+                 | |- context [word.unsigned (word.add _ _)] => rewrite word.unsigned_add by lia
+                 | |- context [word.unsigned (word.and _ _)] => rewrite word.unsigned_and by lia
+                 | |- context [word.eqb _ _] => rewrite word.unsigned_eqb by lia
+                 | |- context [word.unsigned (word.of_Z 0)] => rewrite word.unsigned_of_Z_0 by lia
+                 | |- context [word.unsigned (word.of_Z 1)] => rewrite word.unsigned_of_Z_1 by lia
+                 | |- context [word.unsigned (word.of_Z (-1))] => rewrite word.unsigned_of_Z_minus1 by lia
+                 | |- context [word.unsigned (word.of_Z _)] => rewrite word.unsigned_of_Z by lia
+                 | |- context [word.unsigned (if _ then _ else _)] => rewrite <-Bool.pull_bool_if by lia
+                 | |- context [(_ mod 2) mod (2 ^ _)] => rewrite mod_2_mod_pow2 by lia
+                 | |- context [(_ mod (2 ^ _)) mod 2] => rewrite mod_pow2_mod_2 by lia
+                 | |- context [_ ^ 1] => rewrite Z.pow_1_r by lia
+                 | |- context [Z.land _ 1] => rewrite Z_land_1_r by lia
+                 | |- context [Z.ones] => rewrite Z.ones_equiv
+                 | |- context [?n mod ?n] => rewrite Z.mod_same by lia
+                 | |- context [Z.pred ?n + 1] => replace (Z.pred n + 1) with n by lia
+                 | H : 1 = 2 ^ width - 1 |- _ => replace width with 1 in * by lia; clear H
+                 | _ => progress break_match; Z.ltb_to_lt; try lia; autorewrite with zsimplify_fast
+                 end.
+      all:reflexivity. }
     { (* opp *)
       specialize (IHvalid_expr _ _ _ _
                                ltac:(eassumption) ltac:(eassumption)).
diff --git a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
index 899fe9ddb0..e65fe5754d 100644
--- a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
+++ b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
@@ -53,12 +53,41 @@ Section Expr.
     | _ => false
     end.
 
-  Definition valid_cast_bool {t} (e : @API.expr (fun _ => unit) t) : bool :=
+  Definition valid_cast_literal_ident {t} (r : zrange) (i : ident.ident t) : bool :=
+    match i with
+    | ident.Literal base.type.zrange r' => zrange_beq r r'
+    | _ => false
+    end.
+
+  Definition valid_cast_literal {var t} (r : zrange) (e : @API.expr var t) : bool :=
+    match e with
+    | expr.Ident type_range i => valid_cast_literal_ident r i
+    | _ => false
+    end.
+
+  Definition valid_cast2_literal_App1
+             {var t} (r : zrange) (e : @API.expr var t) : bool :=
+    match e with
+    | expr.App
+        type_range (type.arrow type_range type_range2)
+        f r1 =>
+      is_cast2_literal_App2 f && valid_cast_literal r r1
+    | _ => false
+    end.
+  Definition valid_cast2_literal
+             {var t} (r : zrange) (e : @API.expr var t) : bool :=
     match e with
-    | expr.App type_range (type.arrow type_Z type_Z) f r =>
-      is_cast_ident_expr f && is_cast_literal(width:=width) r
-    | expr.App type_range2 (type.arrow type_ZZ type_ZZ) f r =>
-      is_cast_ident_expr f && is_cast2_literal(width:=width) r
+    | expr.App type_range type_range2 f r2 =>
+      valid_cast2_literal_App1 r f && valid_cast_literal r r2
+    | _ => false
+    end.
+
+  Definition valid_cast_bool {t} (r : zrange) (e : @API.expr (fun _ => unit) t) : bool :=
+    match e with
+    | expr.App type_range (type.arrow type_Z type_Z) f x =>
+      is_cast_ident_expr f && valid_cast_literal r x
+    | expr.App type_range2 (type.arrow type_ZZ type_ZZ) f x =>
+      is_cast_ident_expr f && valid_cast2_literal r x
     | _ => false
     end.
 
@@ -224,6 +253,12 @@ Section Expr.
     | None => false
     end.
 
+  Definition valid_bit_range {t} (e : @API.expr (fun _ => unit) t) : bool :=
+    match invert_expr.invert_Z_cast e with
+    | Some r => zrange_beq r bit_range
+    | None => false
+    end.
+
   (* Because some operations are only valid if the arguments obey certain
      constraints, and to make the inductive logic work out, it helps to be able
      to call valid_expr_bool' recursively but have it return false for anything
@@ -231,7 +266,7 @@ Section Expr.
      very last application in a multi-argument function, take a sneak peek ahead
      to see if the rest of the applications match a certain kind of operation,
      and then enforce any constraints on the last argument. *)
-  Inductive PartialMode := NotPartial | Binop | Shift | Select | Lnot | Fst | Snd.
+  Inductive PartialMode := NotPartial | Binop | Shift | Select | Bit | Lnot | Fst | Snd.
 
   Fixpoint valid_expr_bool' {t}
            (mode : PartialMode) (require_casts : bool)
@@ -260,7 +295,13 @@ Section Expr.
                  (type.arrow type_Z
                              (type.arrow type_Z type_Z)) f x =>
         (valid_expr_select_bool require_casts f)
-          && valid_expr_bool' NotPartial true x
+          && valid_expr_bool' Bit true x
+      | _ => false
+      end
+    | Bit =>
+      match e with
+      | expr.App type_Z type_Z f x =>
+        valid_cast_bool bit_range f && valid_bit_range x
       | _ => false
       end
     | Lnot =>
@@ -314,7 +355,7 @@ Section Expr.
                           (negb require_casts)
                             && valid_expr_bool' NotPartial true x
                         else (* must be a cast *)
-                          (valid_cast_bool f)
+                          (valid_cast_bool (max_range (width:=width)) f)
                             && valid_expr_bool' NotPartial false x
         | expr.App type_ZZ type_Z f x =>
           (* fst or snd *)
@@ -324,7 +365,7 @@ Section Expr.
                then (negb require_casts) && valid_expr_bool' Snd false x
                else false
         | expr.App type_ZZ type_ZZ f x =>
-          valid_cast_bool f
+          valid_cast_bool (max_range (width:=width)) f
           && valid_expr_bool' NotPartial false x
         | expr.Ident _ (ident.Literal base.type.Z z) =>
           is_bounded_by_bool z (@max_range width)|| negb require_casts
@@ -339,8 +380,8 @@ Section Expr.
 
   Definition valid_expr_bool {t} := @valid_expr_bool' t NotPartial.
 
-  Lemma valid_expr_App1_bool_type {t} (e : API.expr t) :
-    valid_cast_bool e = true ->
+  Lemma valid_expr_App1_bool_type {t} r (e : API.expr t) :
+    valid_cast_bool r e = true ->
     (t = type.arrow type_Z type_Z
      \/ t = type.arrow type_ZZ type_ZZ).
   Proof.
@@ -550,27 +591,27 @@ Section Expr.
       intros; constructor; eauto.
   Qed.
 
-  Lemma is_cast_literal_ident_eq {t} (i : ident.ident t) :
-    is_cast_literal_ident (width:=width) i = true ->
+  Lemma is_cast_literal_ident_eq {t} r (i : ident.ident t) :
+    valid_cast_literal_ident r i = true ->
     (match t as t0 return ident.ident t0 -> Prop with
      | type_range =>
-       fun i => i = ident.Literal (t:=base.type.zrange) (@max_range width)
+       fun i =>
+         i = ident.Literal (t:=base.type.zrange) r
      | _ => fun _ => False
      end) i.
   Proof.
     cbv [is_cast_literal_ident].
     break_match; try congruence; [ ].
-    cbv [range_good].
-    intros; progress reflect_beq_to_eq zrange_beq; subst.
-    reflexivity.
+    cbv [range_good]. intros; congruence.
   Qed.
 
   Lemma is_cast_literal_eq {t} (r : API.expr t) :
-    is_cast_literal (width:=width) r = true ->
+    is_cast_literal r = true ->
     (match t as t0 return @API.expr (fun _ => unit) t0 -> Prop with
      | type_range =>
-       fun r =>
-         r = expr.Ident (ident.Literal (t:=base.type.zrange) (@max_range width))
+       fun e =>
+         exists r,
+           e = expr.Ident (ident.Literal (t:=base.type.zrange) r)
      | _ => fun _ => False
      end) r.
   Proof.
@@ -579,9 +620,9 @@ Section Expr.
     intros;
       match goal with
       | H : is_cast_literal_ident _ = true |- _ =>
-        apply is_cast_literal_ident_eq in H
+        apply is_cast_literal_ident_eq in H; destruct H
       end.
-    congruence.
+    subst; eexists; reflexivity.
   Qed.
 
   Lemma is_pair_range_eq {t} (i : ident.ident t) :
@@ -614,17 +655,18 @@ Section Expr.
     congruence.
   Qed.
 
-  Lemma is_cast2_literal_App1_eq {t} (r : API.expr t) :
-    is_cast2_literal_App1 (width:=width) r = true ->
+  Lemma is_cast2_literal_App1_eq {t} (e : API.expr t) :
+    is_cast2_literal_App1 e = true ->
     (match t as t0 return @API.expr (fun _ => unit) t0 -> Prop with
      | type.arrow type_range type_range2 =>
-       fun r =>
-         r = expr.App
-               (expr.Ident ident.pair)
-               (expr.Ident
-                  (ident.Literal (t:=base.type.zrange) (@max_range width)))
+       fun e =>
+         exists r,
+           e = expr.App
+                 (expr.Ident ident.pair)
+                 (expr.Ident
+                    (ident.Literal (t:=base.type.zrange) r))
      | _ => fun _ => False
-     end) r.
+     end) e.
   Proof.
     cbv [is_cast2_literal_App1].
     break_match; try congruence; [ ].
@@ -632,28 +674,30 @@ Section Expr.
       repeat match goal with
              | H : _ && _ = true |- _ =>
                apply andb_true_iff in H; destruct H
+             | H : exists _, _ |- _ => destruct H
              | H : is_cast_literal _ = true |- _ =>
                apply is_cast_literal_eq in H; subst
              | H : is_cast2_literal_App2 _ = true |- _ =>
                apply is_cast2_literal_App2_eq in H; subst
              end.
-    congruence.
+    eexists; reflexivity.
   Qed.
 
-  Lemma is_cast2_literal_eq {t} (r : API.expr t) :
-    is_cast2_literal (width:=width) r = true ->
+  Lemma is_cast2_literal_eq {t} (e : API.expr t) :
+    is_cast2_literal e = true ->
     (match t as t0 return @API.expr (fun _ => unit) t0 -> Prop with
      | type_range2 =>
-       fun r =>
-         r = expr.App
-               (expr.App
-                  (expr.Ident ident.pair)
-                  (expr.Ident
-                     (ident.Literal (t:=base.type.zrange) (@max_range width))))
-               (expr.Ident
-                  (ident.Literal (t:=base.type.zrange) (@max_range width)))
+       fun e =>
+         exists r1 r2,
+           e = expr.App
+                 (expr.App
+                    (expr.Ident ident.pair)
+                    (expr.Ident
+                       (ident.Literal (t:=base.type.zrange) r1)))
+                 (expr.Ident
+                    (ident.Literal (t:=base.type.zrange) r2))
      | _ => fun _ => False
-     end) r.
+     end) e.
   Proof.
     cbv [is_cast2_literal].
     break_match; try congruence; [ ].
@@ -661,12 +705,13 @@ Section Expr.
       repeat match goal with
              | H : _ && _ = true |- _ =>
                apply andb_true_iff in H; destruct H
+             | H : exists _, _ |- _ => destruct H; subst
              | H : is_cast_literal _ = true |- _ =>
                apply is_cast_literal_eq in H; subst
              | H : is_cast2_literal_App1 _ = true |- _ =>
                apply is_cast2_literal_App1_eq in H; subst
              end.
-    congruence.
+    do 2 eexists; reflexivity.
   Qed.
 
   Lemma is_cast_ident_expr_impl1 {t} rc (f : API.expr t) :
@@ -677,7 +722,7 @@ Section Expr.
          forall
            (r : API.expr type_range)
            (x : API.expr type_Z),
-           is_cast_literal (width:=width) r = true ->
+           is_cast_literal r = true ->
            valid_expr false x ->
            valid_expr rc (expr.App (expr.App f r) x)
      | type.arrow type_range2 (type.arrow type_ZZ type_ZZ) =>
@@ -685,7 +730,7 @@ Section Expr.
          forall
            (r : API.expr type_range2)
            (x : API.expr type_ZZ),
-           is_cast2_literal (width:=width) r = true ->
+           is_cast2_literal r = true ->
            valid_expr false x ->
            valid_expr rc (expr.App (expr.App f r) x)
      | _ => fun _ => False
@@ -694,12 +739,13 @@ Section Expr.
     cbv [is_cast_ident_expr is_cast_ident].
     break_match; try congruence; [ | ];
       intros;
-      match goal with
-      | H : is_cast_literal _ = true |- _ =>
-        apply is_cast_literal_eq in H; subst
-      | H : is_cast2_literal _ = true |- _ =>
-        apply is_cast2_literal_eq in H; subst
-      end.
+      repeat lazymatch goal with
+             | H : exists _, _ |- _ => destruct H ;subst
+             | H : is_cast_literal _ = true |- _ =>
+               apply is_cast_literal_eq in H; subst
+             | H : is_cast2_literal _ = true |- _ =>
+               apply is_cast2_literal_eq in H; subst
+             end.
     { constructor;
         cbv [range_good]; auto using zrange_lb. }
     { constructor;

From f4fcd252cd194f7ad571575e2cf776cbfc6b0c2d Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Thu, 24 Aug 2023 11:48:22 +0200
Subject: [PATCH 26/34] starting to adjust to allow any maskable range in cast,
 because pairs with internal casts were failing

---
 src/Bedrock/Field/Common/Util.v               |  72 +++++++
 .../Field/Synthesis/Examples/p224_64_new.v    |  54 ++++-
 src/Bedrock/Field/Translation/Expr.v          |   4 +-
 src/Bedrock/Field/Translation/Proofs/Cmd.v    |  70 ------
 src/Bedrock/Field/Translation/Proofs/Expr.v   |  11 +-
 .../Translation/Proofs/ValidComputable/Cmd.v  |   1 +
 .../Translation/Proofs/ValidComputable/Expr.v | 203 ++++++++++++------
 7 files changed, 262 insertions(+), 153 deletions(-)

diff --git a/src/Bedrock/Field/Common/Util.v b/src/Bedrock/Field/Common/Util.v
index 0f9fcd8b0a..42bd9be9a9 100644
--- a/src/Bedrock/Field/Common/Util.v
+++ b/src/Bedrock/Field/Common/Util.v
@@ -27,6 +27,78 @@ Import ListNotations.
 
 Import AbstractInterpretation.Compilers.
 
+Section invert_expr.
+  (* TODO: move somewhere appropriate in the rewriter *)
+  Lemma invert_App_Z_cast_Some {var} e r x :
+    invert_expr.invert_App_Z_cast (var:=var) e = Some (r, x) ->
+    e = (expr.App (expr.App (expr.Ident ident.Z_cast)
+                            (expr.Ident (ident.Literal (t:=base.type.zrange) r))) x).
+  Proof.
+    cbv [invert_expr.invert_App_Z_cast Crypto.Util.Option.bind].
+    lazymatch goal with
+    | |- context [invert_expr.invert_App ?x] =>
+      let H := fresh in
+      destruct (invert_expr.invert_App x) as [ [? [? ?] ] | ] eqn:H;
+        [ | congruence ];
+        apply Inversion.Compilers.expr.invert_App_Some in H
+    end.
+    cbn [fst snd projT2] in *; subst.
+    break_match; try congruence; [ ]. intros.
+    repeat lazymatch goal with
+           | H : Some _ = Some _ |- _ => inversion H; subst; clear H
+           | H : invert_expr.invert_Z_cast _ = Some _ |- _ =>
+             apply InversionExtra.Compilers.expr.invert_Z_cast_Some_Z in H;
+               subst
+           end.
+    reflexivity.
+  Qed.
+
+  (* TODO: move somewhere appropriate in the rewriter *)
+  Lemma invert_App_Z_cast2_Some {var} e r1 r2 x :
+    invert_expr.invert_App_Z_cast2 (var:=var) e = Some (r1, r2, x) ->
+    e = (expr.App (expr.App (expr.Ident ident.Z_cast2)
+                            (expr.App (expr.App (expr.Ident ident.pair)
+                                                (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
+                                      (expr.Ident (ident.Literal (t:=base.type.zrange) r2)))) x).
+  Proof.
+    cbv [invert_expr.invert_App_Z_cast2 Crypto.Util.Option.bind].
+    lazymatch goal with
+    | |- context [invert_expr.invert_App ?x] =>
+      let H := fresh in
+      destruct (invert_expr.invert_App x) as [ [? [? ?] ] | ] eqn:H;
+        [ | congruence ];
+        apply Inversion.Compilers.expr.invert_App_Some in H
+    end.
+    cbn [fst snd projT2] in *; subst.
+    break_match; try congruence; [ ]. intros.
+    repeat lazymatch goal with
+           | H : Some _ = Some _ |- _ => inversion H; subst; clear H
+           | H : invert_expr.invert_Z_cast2 _ = Some _ |- _ =>
+             apply InversionExtra.Compilers.expr.invert_Z_cast2_Some_ZZ in H;
+               subst
+           end.
+    reflexivity.
+  Qed.
+
+  (* TODO: move somewhere appropriate in the rewriter *)
+  Lemma invert_App_Z_cast_eq_Some {var} x r :
+    invert_expr.invert_App_Z_cast (var:=var)
+      (expr.App (expr.App (expr.Ident ident.Z_cast)
+                          (expr.Ident (ident.Literal r)))
+                x) = Some (r, x).
+  Proof. reflexivity. Qed.
+
+  (* TODO: move somewhere appropriate in the rewriter *)
+  Lemma invert_App_Z_cast2_eq_Some {var} x r1 r2 :
+    invert_expr.invert_App_Z_cast2 (var:=var)
+      (expr.App (expr.App (expr.Ident ident.Z_cast2)
+                          (expr.App (expr.App (expr.Ident ident.pair)
+                                              (expr.Ident (ident.Literal r1)))
+                                              (expr.Ident (ident.Literal r2))))
+                x) = Some (r1, r2, x).
+  Proof. reflexivity. Qed.
+End invert_expr.
+
 Section Maps.
   Local Hint Mode map.map - - : typeclass_instances.
   Context {key value} {key_eqb}
diff --git a/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v b/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
index 802d3193cf..70eb0435e0 100644
--- a/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
+++ b/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
@@ -62,6 +62,7 @@ Section Field.
     Local Notation eVar := Language.Compilers.expr.Var.
     Local Notation eLetIn := Language.Compilers.expr.LetIn.
     Local Notation eIdent := Language.Compilers.expr.Ident.
+    Set Printing Depth 100000.
     pose add_op.
     cbn [add_op p224_ops] in c.
 
@@ -170,10 +171,53 @@ Section Field.
              Cmd.is_cons_ident
              Cmd.is_nil_ident].
       repeat lazymatch goal with
+             | |- context [(Expr.valid_expr_bool true ?x || Cmd.valid_special_bool ?x)%bool] =>
+                          first [ change (Expr.valid_expr_bool true x) with true; cbn [orb]
+                                | change (Cmd.valid_special_bool x) with true; rewrite Bool.orb_true_r ]
              | |- context [Expr.valid_expr_bool true ?x] =>
                change (Expr.valid_expr_bool true x) with true
              end.
       cbn [orb andb].
+      match goal with
+      | |- context [Cmd.valid_special_bool ?x] =>
+        match x with
+        | context [ident.Z_add_with_get_carry] =>
+          assert (Cmd.valid_special_bool x = true)
+        end
+      end.
+      { cbv [Cmd.valid_special_bool].
+        cbv [invert_expr.invert_App_cast].
+        rewrite Util.invert_App_Z_cast2_eq_Some.
+        cbn [fst snd].
+        lazymatch goal with
+        | |- context [Cmd.valid_special3_bool ?x ?r] =>
+          change (Cmd.valid_special3_bool x r) with false
+        end.
+        cbn [orb].
+        cbv [Cmd.valid_special4_bool].
+        rewrite Cmd.invert_AppIdent4_eq_Some.
+        cbv [Cmd.valid_ident_special4].
+        cbn [fst snd].
+        cbv [Cmd.is_add_with_get_carry_ident].
+        cbv [Expr.is_literalz].
+        rewrite Z.eqb_refl.
+        repeat lazymatch goal with
+               | |- context [Expr.valid_expr_bool true ?x] =>
+                 change (Expr.valid_expr_bool true x) with true
+               end.
+        cbn [andb].
+        cbv [Cmd.is_word_and_carry_range Expr.range_good Cmd.is_carry_range].
+        cbn [fst snd]. rewrite !ZRange.zrange_lb by reflexivity.
+        cbn [andb].
+        cbv [Cmd.valid_carry_bool].
+        rewrite Util.invert_App_Z_cast_eq_Some.
+        cbn [fst snd].
+        cbv [Cmd.is_carry_range].
+        rewrite !ZRange.zrange_lb by reflexivity.
+        (* same issue; snd has bad range *)
+      }
+        
+      rewrite !Bool.orb_false_r.
       lazymatch goal with
       | |- context [Expr.valid_expr_bool true ?x] =>
         pose (e:=Expr.valid_expr_bool true x);
@@ -190,11 +234,11 @@ Section Field.
                  apply Expr.valid_var_z
                | _ => apply Expr.valid_binop; [ cbn; congruence | | ]
                end.
-        Print Expr.valid_expr.
-        (* zselect recursively calls valid_expr, which now fails because of the [0,1] bound *)
-      cbv in e.
-    Locate begin_derive_bedrock2_func.
-    Time derive_bedrock2_func add_op.
+        apply Expr.valid_zselect; try reflexivity; [ ].
+        apply Expr.valid_snd_cast.
+        (* valid_snd_cast requires that the range is good, but it's [0,1] *)
+
+   Time derive_bedrock2_func add_op.
   Qed.
   Print p224_add.
 
diff --git a/src/Bedrock/Field/Translation/Expr.v b/src/Bedrock/Field/Translation/Expr.v
index 6638f63040..ee855c4fb6 100644
--- a/src/Bedrock/Field/Translation/Expr.v
+++ b/src/Bedrock/Field/Translation/Expr.v
@@ -18,6 +18,8 @@ Section Expr.
   Existing Instance Types.rep.listZ_local. (* local list representation *)
   Definition max_range : zrange := {| lower := 0; upper := 2 ^ width - 1 |}.
   Definition range_good (r : zrange) : bool := zrange_beq r max_range.
+  Definition range_maskable (r : zrange) : bool :=
+    (lower r =? 0) && (upper r =? Z.ones (Z.log2 (upper r) + 1)).
 
   (* for the second argument of shifts *)
   Definition width_range :=  r[0~>width-1]%zrange.
@@ -293,7 +295,7 @@ Section Expr.
     | (expr.Ident type_range (ident.Literal base.type.zrange r)) =>
       (* Translate ranges into masks. Only ranges of the form [0~>2^n-1] should
          get translated. *)
-      if ((lower r =? 0) && (upper r =? Z.ones (Z.log2 (upper r + 1))))%bool
+      if range_maskable r
       then expr.literal (upper r)
       else make_error _
     | expr.Var type_listZ x => map expr.var x
diff --git a/src/Bedrock/Field/Translation/Proofs/Cmd.v b/src/Bedrock/Field/Translation/Proofs/Cmd.v
index 197f49d7dc..429dab4de9 100644
--- a/src/Bedrock/Field/Translation/Proofs/Cmd.v
+++ b/src/Bedrock/Field/Translation/Proofs/Cmd.v
@@ -424,76 +424,6 @@ Section Cmd.
     induction 1; intros; invert_wf3_until_exposed; reflexivity.
   Qed.
 
-  (* TODO: move somewhere appropriate in the rewriter *)
-  Lemma invert_App_Z_cast_Some {var} (e : @API.expr var type_Z) r x :
-    invert_expr.invert_App_Z_cast e = Some (r, x) ->
-    e = (expr.App (expr.App (expr.Ident ident.Z_cast)
-                            (expr.Ident (ident.Literal (t:=Compilers.zrange) r))) x).
-  Proof.
-    cbv [invert_expr.invert_App_Z_cast Crypto.Util.Option.bind].
-    lazymatch goal with
-    | |- context [invert_expr.invert_App ?x] =>
-      let H := fresh in
-      destruct (invert_expr.invert_App x) as [ [? [? ?] ] | ] eqn:H;
-        [ | congruence ];
-        apply Inversion.Compilers.expr.invert_App_Some in H
-    end.
-    cbn [fst snd projT2] in *; subst.
-    break_match; try congruence; [ ]. intros.
-    repeat lazymatch goal with
-           | H : Some _ = Some _ |- _ => inversion H; subst; clear H
-           | H : invert_expr.invert_Z_cast _ = Some _ |- _ =>
-             apply InversionExtra.Compilers.expr.invert_Z_cast_Some_Z in H;
-               subst
-           end.
-    reflexivity.
-  Qed.
-
-  (* TODO: move somewhere appropriate in the rewriter *)
-  Lemma invert_App_Z_cast2_Some {var} (e : @API.expr var type_ZZ) r1 r2 x :
-    invert_expr.invert_App_Z_cast2 e = Some (r1, r2, x) ->
-    e = (expr.App (expr.App (expr.Ident ident.Z_cast2)
-                            (expr.App (expr.App (expr.Ident ident.pair)
-                                                (expr.Ident (ident.Literal (t:=Compilers.zrange) r1)))
-                                      (expr.Ident (ident.Literal (t:=Compilers.zrange) r2)))) x).
-  Proof.
-    cbv [invert_expr.invert_App_Z_cast2 Crypto.Util.Option.bind].
-    lazymatch goal with
-    | |- context [invert_expr.invert_App ?x] =>
-      let H := fresh in
-      destruct (invert_expr.invert_App x) as [ [? [? ?] ] | ] eqn:H;
-        [ | congruence ];
-        apply Inversion.Compilers.expr.invert_App_Some in H
-    end.
-    cbn [fst snd projT2] in *; subst.
-    break_match; try congruence; [ ]. intros.
-    repeat lazymatch goal with
-           | H : Some _ = Some _ |- _ => inversion H; subst; clear H
-           | H : invert_expr.invert_Z_cast2 _ = Some _ |- _ =>
-             apply InversionExtra.Compilers.expr.invert_Z_cast2_Some_ZZ in H;
-               subst
-           end.
-    reflexivity.
-  Qed.
-
-  (* TODO: move somewhere appropriate in the rewriter *)
-  Lemma invert_App_Z_cast_eq_Some {var} (x : @API.expr var type_Z) r :
-    invert_expr.invert_App_Z_cast
-      (expr.App (expr.App (expr.Ident ident.Z_cast)
-                          (expr.Ident (ident.Literal r)))
-                x) = Some (r, x).
-  Proof. reflexivity. Qed.
-
-  (* TODO: move somewhere appropriate in the rewriter *)
-  Lemma invert_App_Z_cast2_eq_Some {var} (x : @API.expr var type_ZZ) r1 r2 :
-    invert_expr.invert_App_Z_cast2
-      (expr.App (expr.App (expr.Ident ident.Z_cast2)
-                          (expr.App (expr.App (expr.Ident ident.pair)
-                                              (expr.Ident (ident.Literal r1)))
-                                              (expr.Ident (ident.Literal r2))))
-                x) = Some (r1, r2, x).
-  Proof. reflexivity. Qed.
-
   Lemma valid_expr_not_special_function {t}
         (e1 : @API.expr (fun _ => unit) t)
         (e2 : @API.expr API.interp_type t)
diff --git a/src/Bedrock/Field/Translation/Proofs/Expr.v b/src/Bedrock/Field/Translation/Proofs/Expr.v
index 5959221425..b81ac2f3bb 100644
--- a/src/Bedrock/Field/Translation/Proofs/Expr.v
+++ b/src/Bedrock/Field/Translation/Proofs/Expr.v
@@ -45,7 +45,7 @@ Section Expr.
   | valid_cast1 :
       forall (rc : bool) r x,
         valid_expr false x ->
-        range_good (width:=width) r = true ->
+        range_maskable r = true ->
         valid_expr rc
                    (expr.App
                       (expr.App (expr.Ident ident.Z_cast)
@@ -53,8 +53,8 @@ Section Expr.
   | valid_cast2 :
       forall (rc : bool) r1 r2 x,
         valid_expr false x ->
-        range_good (width:=width) r1 = true ->
-        range_good (width:=width) r2 = true ->
+        range_maskable r1 = true ->
+        range_maskable r2 = true ->
         valid_expr rc
                    (expr.App
                       (expr.App (expr.Ident ident.Z_cast2)
@@ -66,7 +66,8 @@ Section Expr.
   | valid_fst_cast :
       forall (x : API.expr type_ZZ) r1 r2,
         valid_expr false x ->
-        range_good (width:=width) r1 = true ->
+        (* TODO: either need to add condition that r1 can be made into a mask,
+           or change cast case to specify masks instead of "good" *)
         (* it's okay to have a cast with a bad range on the non-selected tuple element *)
         valid_expr false
                    (expr.App
@@ -81,7 +82,6 @@ Section Expr.
   | valid_snd_cast :
       forall (x : API.expr type_ZZ) r1 r2,
         valid_expr false x ->
-        range_good (width:=width) r2 = true ->
         (* it's okay to have a cast with a bad range on the non-selected tuple element *)
         valid_expr false
                    (expr.App
@@ -564,7 +564,6 @@ Section Expr.
       cbv [range_good max_range ident.literal ident.cast2 rcast rcast2] in *.
       cbn [locally_equivalent equivalent_base rep.equiv rep.Z fst snd
                               locally_equivalent_nobounds_base] in *.
-      intros; progress reflect_beq_to_eq zrange_beq; subst.
       pose proof word.width_pos.
       repeat match goal with
              | _ => progress cbn [upper lower andb literal_eqb invert_literal]
diff --git a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v
index 5842fb0c7c..3548409b18 100644
--- a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v
+++ b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v
@@ -8,6 +8,7 @@ Require Import coqutil.Word.Interface coqutil.Word.Properties.
 Require Import coqutil.Map.Interface.
 Require Import Crypto.Bedrock.Field.Common.Types.
 Require Import Crypto.Bedrock.Field.Common.Tactics.
+Require Import Crypto.Bedrock.Field.Common.Util.
 Require Import Crypto.Bedrock.Field.Translation.Cmd.
 Require Import Crypto.Bedrock.Field.Translation.Proofs.Expr.
 Require Import Crypto.Bedrock.Field.Translation.Proofs.Cmd.
diff --git a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
index e65fe5754d..31cfd730c6 100644
--- a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
+++ b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
@@ -253,7 +253,7 @@ Section Expr.
     | None => false
     end.
 
-  Definition valid_bit_range {t} (e : @API.expr (fun _ => unit) t) : bool :=
+  Definition valid_bit_range_cast {t} (e : @API.expr (fun _ => unit) t) : bool :=
     match invert_expr.invert_Z_cast e with
     | Some r => zrange_beq r bit_range
     | None => false
@@ -268,9 +268,9 @@ Section Expr.
      and then enforce any constraints on the last argument. *)
   Inductive PartialMode := NotPartial | Binop | Shift | Select | Bit | Lnot | Fst | Snd.
 
-  Fixpoint valid_expr_bool' {t}
+  Fixpoint valid_expr_bool'
            (mode : PartialMode) (require_casts : bool)
-           (e : @API.expr (fun _ => unit) t) {struct e} : bool :=
+           {t} (e : @API.expr (fun _ => unit) t) {struct e} : bool :=
     match mode with
     | Binop =>
       match e with
@@ -301,7 +301,7 @@ Section Expr.
     | Bit =>
       match e with
       | expr.App type_Z type_Z f x =>
-        valid_cast_bool bit_range f && valid_bit_range x
+        valid_bit_range_cast f && valid_expr_bool' NotPartial false x
       | _ => false
       end
     | Lnot =>
@@ -378,7 +378,7 @@ Section Expr.
         end
     end.
 
-  Definition valid_expr_bool {t} := @valid_expr_bool' t NotPartial.
+  Definition valid_expr_bool {t} rc := @valid_expr_bool' NotPartial rc t.
 
   Lemma valid_expr_App1_bool_type {t} r (e : API.expr t) :
     valid_cast_bool r e = true ->
@@ -591,7 +591,7 @@ Section Expr.
       intros; constructor; eauto.
   Qed.
 
-  Lemma is_cast_literal_ident_eq {t} r (i : ident.ident t) :
+  Lemma valid_cast_literal_ident_eq {t} r (i : ident.ident t) :
     valid_cast_literal_ident r i = true ->
     (match t as t0 return ident.ident t0 -> Prop with
      | type_range =>
@@ -600,29 +600,29 @@ Section Expr.
      | _ => fun _ => False
      end) i.
   Proof.
-    cbv [is_cast_literal_ident].
+    cbv [valid_cast_literal_ident].
     break_match; try congruence; [ ].
-    cbv [range_good]. intros; congruence.
+    cbv [range_good]. intros; progress reflect_beq_to_eq zrange_beq; subst.
+    reflexivity.
   Qed.
 
-  Lemma is_cast_literal_eq {t} (r : API.expr t) :
-    is_cast_literal r = true ->
+  Lemma valid_cast_literal_eq {t} r (e : API.expr t) :
+    valid_cast_literal r e = true ->
     (match t as t0 return @API.expr (fun _ => unit) t0 -> Prop with
      | type_range =>
        fun e =>
-         exists r,
-           e = expr.Ident (ident.Literal (t:=base.type.zrange) r)
+         e = expr.Ident (ident.Literal (t:=base.type.zrange) r)
      | _ => fun _ => False
-     end) r.
+     end) e.
   Proof.
-    cbv [is_cast_literal].
+    cbv [valid_cast_literal].
     break_match; try congruence; [ ].
     intros;
       match goal with
-      | H : is_cast_literal_ident _ = true |- _ =>
-        apply is_cast_literal_ident_eq in H; destruct H
+      | H : valid_cast_literal_ident _ _ = true |- _ =>
+        apply valid_cast_literal_ident_eq in H
       end.
-    subst; eexists; reflexivity.
+    subst; reflexivity.
   Qed.
 
   Lemma is_pair_range_eq {t} (i : ident.ident t) :
@@ -655,63 +655,59 @@ Section Expr.
     congruence.
   Qed.
 
-  Lemma is_cast2_literal_App1_eq {t} (e : API.expr t) :
-    is_cast2_literal_App1 e = true ->
+  Lemma valid_cast2_literal_App1_eq {t} r (e : API.expr t) :
+    valid_cast2_literal_App1 r e = true ->
     (match t as t0 return @API.expr (fun _ => unit) t0 -> Prop with
      | type.arrow type_range type_range2 =>
        fun e =>
-         exists r,
-           e = expr.App
-                 (expr.Ident ident.pair)
-                 (expr.Ident
-                    (ident.Literal (t:=base.type.zrange) r))
+         e = expr.App
+               (expr.Ident ident.pair)
+               (expr.Ident
+                  (ident.Literal (t:=base.type.zrange) r))
      | _ => fun _ => False
      end) e.
   Proof.
-    cbv [is_cast2_literal_App1].
+    cbv [valid_cast2_literal_App1].
     break_match; try congruence; [ ].
     intros;
       repeat match goal with
              | H : _ && _ = true |- _ =>
                apply andb_true_iff in H; destruct H
-             | H : exists _, _ |- _ => destruct H
-             | H : is_cast_literal _ = true |- _ =>
-               apply is_cast_literal_eq in H; subst
+             | H : valid_cast_literal _ _ = true |- _ =>
+               apply valid_cast_literal_eq in H; subst
              | H : is_cast2_literal_App2 _ = true |- _ =>
                apply is_cast2_literal_App2_eq in H; subst
              end.
-    eexists; reflexivity.
+    reflexivity.
   Qed.
 
-  Lemma is_cast2_literal_eq {t} (e : API.expr t) :
-    is_cast2_literal e = true ->
+  Lemma valid_cast2_literal_eq {t} r (e : API.expr t) :
+    valid_cast2_literal r e = true ->
     (match t as t0 return @API.expr (fun _ => unit) t0 -> Prop with
      | type_range2 =>
        fun e =>
-         exists r1 r2,
-           e = expr.App
-                 (expr.App
-                    (expr.Ident ident.pair)
-                    (expr.Ident
-                       (ident.Literal (t:=base.type.zrange) r1)))
-                 (expr.Ident
-                    (ident.Literal (t:=base.type.zrange) r2))
+         e = expr.App
+               (expr.App
+                  (expr.Ident ident.pair)
+                  (expr.Ident
+                     (ident.Literal (t:=base.type.zrange) r)))
+               (expr.Ident
+                  (ident.Literal (t:=base.type.zrange) r))
      | _ => fun _ => False
      end) e.
   Proof.
-    cbv [is_cast2_literal].
+    cbv [valid_cast2_literal].
     break_match; try congruence; [ ].
     intros;
       repeat match goal with
              | H : _ && _ = true |- _ =>
                apply andb_true_iff in H; destruct H
-             | H : exists _, _ |- _ => destruct H; subst
-             | H : is_cast_literal _ = true |- _ =>
-               apply is_cast_literal_eq in H; subst
-             | H : is_cast2_literal_App1 _ = true |- _ =>
-               apply is_cast2_literal_App1_eq in H; subst
+             | H : valid_cast_literal _ _ = true |- _ =>
+               apply valid_cast_literal_eq in H; subst
+             | H : valid_cast2_literal_App1 _ _ = true |- _ =>
+               apply valid_cast2_literal_App1_eq in H; subst
              end.
-    do 2 eexists; reflexivity.
+    reflexivity.
   Qed.
 
   Lemma is_cast_ident_expr_impl1 {t} rc (f : API.expr t) :
@@ -722,7 +718,7 @@ Section Expr.
          forall
            (r : API.expr type_range)
            (x : API.expr type_Z),
-           is_cast_literal r = true ->
+           valid_cast_literal (max_range (width:=width)) r = true ->
            valid_expr false x ->
            valid_expr rc (expr.App (expr.App f r) x)
      | type.arrow type_range2 (type.arrow type_ZZ type_ZZ) =>
@@ -730,7 +726,7 @@ Section Expr.
          forall
            (r : API.expr type_range2)
            (x : API.expr type_ZZ),
-           is_cast2_literal r = true ->
+           valid_cast2_literal (max_range (width:=width)) r = true ->
            valid_expr false x ->
            valid_expr rc (expr.App (expr.App f r) x)
      | _ => fun _ => False
@@ -741,10 +737,10 @@ Section Expr.
       intros;
       repeat lazymatch goal with
              | H : exists _, _ |- _ => destruct H ;subst
-             | H : is_cast_literal _ = true |- _ =>
-               apply is_cast_literal_eq in H; subst
-             | H : is_cast2_literal _ = true |- _ =>
-               apply is_cast2_literal_eq in H; subst
+             | H : valid_cast_literal _ _ = true |- _ =>
+               apply valid_cast_literal_eq in H; subst
+             | H : valid_cast2_literal _ _ = true |- _ =>
+               apply valid_cast2_literal_eq in H; subst
              end.
     { constructor;
         cbv [range_good]; auto using zrange_lb. }
@@ -753,7 +749,7 @@ Section Expr.
   Qed.
 
   Lemma valid_cast_bool_impl1 {t} rc (f : API.expr t) :
-    valid_cast_bool f = true ->
+    valid_cast_bool (max_range (width:=width)) f = true ->
     (match t as t0 return expr.expr t0 -> Prop with
      | type.arrow type_Z _ =>
        fun f =>
@@ -1023,7 +1019,9 @@ Section Expr.
      | type.arrow type_Z (type.arrow type_Z (type.arrow type_Z type_Z)) =>
        fun f =>
          forall c x y : API.expr type_Z,
-           valid_expr true c ->
+           (exists (r : zrange) (c' : @API.expr (fun _ => unit) type_Z),
+               invert_expr.invert_App_Z_cast c = Some (r, c')
+               /\ zrange_beq r bit_range = true /\ valid_expr false c') ->
            is_literalz x 0 = true ->
            is_literalz y (2^width-1) = true ->
            valid_expr rc
@@ -1036,12 +1034,17 @@ Section Expr.
     cbv [valid_expr_select_bool].
     break_match; try congruence; [ ]; intros.
     repeat match goal with
+           | H : exists _, _ |- _ => destruct H
+           | H : _ /\ _ |- _ => destruct H
            | H : negb ?rc = true |- _ =>
              destruct rc; cbn [negb] in *; try congruence; [ ]
+           | H : invert_expr.invert_App_Z_cast _ = Some _ |- _ =>
+             apply Util.invert_App_Z_cast_Some in H; rewrite H
            | H : is_literalz _ _ = true |- _ =>
              apply is_literalz_impl1 in H
            end.
-    subst; constructor; eauto.
+    intros; progress reflect_beq_to_eq zrange_beq; subst.
+    constructor; eauto.
   Qed.
 
   Lemma valid_lnot_modulus_eq {t} (x : API.expr t) :
@@ -1165,13 +1168,24 @@ Section Expr.
              (type.arrow type_Z (type.arrow type_Z type_Z)) =>
            fun f =>
              forall c x y,
-               valid_expr true c ->
+               (exists (r : zrange) (c' : @API.expr (fun _ => unit) type_Z),
+                   invert_expr.invert_App_Z_cast c = Some (r, c')
+                   /\ zrange_beq r bit_range = true /\ valid_expr false c') ->
                valid_expr_select_bool rc f = true ->
                is_literalz x 0 = true ->
                is_literalz y (2^width-1) = true ->
                valid_expr rc (expr.App (expr.App (expr.App f c) x) y)
          | _ => fun _ => False
          end) e
+      | Bit =>
+        (match t as t0 return expr.expr t0 -> Prop with
+         | type_Z =>
+           fun c =>
+             exists (r : zrange) (c' : @API.expr (fun _ => unit) type_Z),
+               invert_expr.invert_App_Z_cast c = Some (r, c')
+               /\ zrange_beq r bit_range = true /\ valid_expr false c'
+         | _ => fun _ => False
+         end) e
       | Lnot =>
         (match t as t0 return expr.expr t0 -> Prop with
          | type.arrow type_Z type_Z =>
@@ -1237,6 +1251,7 @@ Section Expr.
                    | Binop => False
                    | Shift => False
                    | Select => False
+                   | Bit => False
                    | Lnot => False
                    | Fst => False
                    | Snd => False
@@ -1244,7 +1259,8 @@ Section Expr.
                  specialize (IH NotPartial); (cbn match in IH)
                end.
       { (* fully-applied binop case *)
-        intros. apply (IHe1 Binop); eauto. }
+        intros. apply (IHe1 Binop); eauto.
+        apply (IHe2 NotPartial); eauto. }
       { (* fully-applied shift case *)
         intros. apply (IHe1 Shift); eauto. }
       { (* fully-applied select case *)
@@ -1259,12 +1275,13 @@ Section Expr.
                | H : negb ?rc = true |- _ =>
                  destruct rc; cbn [negb] in *; try congruence; [ ]
                end.
-        econstructor.
-        eauto. }
+        econstructor; eauto; [ ].
+        apply (IHe2 NotPartial); eauto. }
       { (* cast Z case *)
         intros.
         apply (valid_cast_bool_impl1
-                 (t := type_Z -> type_Z)); eauto. }
+                 (t := type_Z -> type_Z)); eauto; [ ].
+        apply (IHe2 NotPartial); eauto. }
       { (* nth_default case *)
         eauto using valid_expr_nth_default_bool_impl1. }
       { (* fully-applied fst case *)
@@ -1289,25 +1306,44 @@ Section Expr.
         intros.
         apply (valid_cast_bool_impl1
                  (t := type_ZZ -> type_ZZ)); eauto; [ ].
-        eapply (IHe2 NotPartial); auto. }
+        eapply (IHe2 NotPartial); eauto. }
       { (* partially-applied binop case *)
         intros.
         apply (valid_expr_binop_bool_impl1
-                 (t:=type_Z -> type_Z -> type_Z)); eauto. }
+                 (t:=type_Z -> type_Z -> type_Z)); eauto; [ ].
+        eapply (IHe2 NotPartial); eauto. }
       { (* partially-applied shift case *)
         intros.
         apply (valid_expr_shift_bool_impl1
-                 (t:=type_Z -> type_Z -> type_Z)); eauto. }
+                 (t:=type_Z -> type_Z -> type_Z)); eauto; [ ].
+        eapply (IHe2 NotPartial); eauto. }
       { (* partially-applied select case (last 2 arguments) *)
         intros. apply (IHe1 Select); eauto. }
       { (* partially-applied select case (all 3 arguments) *)
         intros.
+        lazymatch goal with
+        | H : valid_expr_bool' Bit _ _ = true |- _ =>
+          apply IHe2 in H
+        end.
         apply (valid_expr_select_bool_impl1
                  (t:=type_Z -> type_Z -> type_Z -> type_Z)); eauto. }
+      { (* Bit case *)
+        cbv [valid_bit_range_cast] in *.
+        break_match_hyps; try congruence;
+          repeat lazymatch goal with
+                 | H : invert_expr.invert_Z_cast _ = Some _ |- _ =>
+                   apply InversionExtra.Compilers.expr.invert_Z_cast_Some_Z in H; subst
+                 | H : zrange_beq _ _ = true |- _ => progress reflect_beq_to_eq zrange_beq; subst
+                 | |- exists _, _ => eexists
+                 | |- _ /\ _ => split
+                 | _ => reflexivity
+                 end; [ ].
+        apply (IHe2 NotPartial); eauto. }
       { (* partially-applied lnot_modulo case *)
         intros.
         apply (valid_expr_lnot_modulo_bool_impl1
-                 (t:=type_Z -> type_Z -> type_Z)); eauto. }
+                 (t:=type_Z -> type_Z -> type_Z)); eauto; [ ].
+        apply (IHe2 NotPartial); eauto. }
       { (* partially-applied fst case *)
         intros.
         cbv [valid_fst_cast_bool] in *.
@@ -1359,21 +1395,46 @@ Section Expr.
              | _ => progress cbn [andb]
              | H : valid_expr_bool' _ _ _ = true |- _ =>
                rewrite H
+             | H : range_good _ = true |- _ => cbv [range_good] in H
+             | H : zrange_beq _ _ = true |- _ => progress reflect_beq_to_eq zrange_beq; subst
+             | |- context [zrange_beq ?r ?r] => rewrite zrange_lb by reflexivity
              | _ => rewrite Z.eqb_refl
              end;
       auto using
            Bool.andb_true_iff, Bool.orb_true_iff,
       is_bounded_by_bool_max_range,
-      is_bounded_by_bool_width_range; [ | | ].
+      is_bounded_by_bool_width_range; [ | | | ].
+    { (* fst *)
+      cbv [valid_fst_cast_bool].
+      lazymatch goal with
+      | |- context [invert_expr.invert_Z_cast2
+                     (expr.App _ (expr.App (expr.App (expr.Ident ident.pair)
+                                                     (expr.Ident (ident.Literal ?r1)))
+                                           (expr.Ident (ident.Literal ?r2))))] =>
+        let H := fresh in
+        pose proof (InversionExtra.Compilers.expr.invert_Z_cast2_Z_cast2
+                    (var:=fun _ => unit) (r1, r2)) as H;
+          cbn - [invert_expr.invert_Z_cast2] in H;
+          cbv [ident.literal] in H; rewrite H
+      end.
+      cbv [range_good]; rewrite zrange_lb by reflexivity; reflexivity. }
+    { (* snd *)
+      cbv [valid_snd_cast_bool].
+      lazymatch goal with
+      | |- context [invert_expr.invert_Z_cast2
+                     (expr.App _ (expr.App (expr.App (expr.Ident ident.pair)
+                                                     (expr.Ident (ident.Literal ?r1)))
+                                           (expr.Ident (ident.Literal ?r2))))] =>
+        let H := fresh in
+        pose proof (InversionExtra.Compilers.expr.invert_Z_cast2_Z_cast2
+                    (var:=fun _ => unit) (r1, r2)) as H;
+          cbn - [invert_expr.invert_Z_cast2] in H;
+          cbv [ident.literal] in H; rewrite H
+      end.
+      cbv [range_good]; rewrite zrange_lb by reflexivity; reflexivity. }
     { (* lnot_modulo *)
       apply Bool.andb_true_iff; split;
         Z.ltb_to_lt; auto. }
-    { (* select *)
-      break_match;
-        repeat match goal with
-               | H : (_ && _)%bool = true  |- _ =>
-                 apply Bool.andb_true_iff in H; destruct H
-               end; congruence. }
     { (* binop *)
       match goal with
       | H : translate_binop ?i <> None

From b0f1ab7612e63ba814a1789a9304942f936922fb Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Thu, 24 Aug 2023 14:29:42 +0200
Subject: [PATCH 27/34] mask proof case working

---
 src/Bedrock/Field/Translation/Expr.v        |  16 ++-
 src/Bedrock/Field/Translation/Proofs/Expr.v | 127 ++++++++++++++------
 2 files changed, 98 insertions(+), 45 deletions(-)

diff --git a/src/Bedrock/Field/Translation/Expr.v b/src/Bedrock/Field/Translation/Expr.v
index ee855c4fb6..e7aeb9a167 100644
--- a/src/Bedrock/Field/Translation/Expr.v
+++ b/src/Bedrock/Field/Translation/Expr.v
@@ -19,7 +19,10 @@ Section Expr.
   Definition max_range : zrange := {| lower := 0; upper := 2 ^ width - 1 |}.
   Definition range_good (r : zrange) : bool := zrange_beq r max_range.
   Definition range_maskable (r : zrange) : bool :=
-    (lower r =? 0) && (upper r =? Z.ones (Z.log2 (upper r) + 1)).
+    (lower r =? 0)
+    && (0 <? upper r)
+    && (upper r =? Z.ones (Z.log2 (upper r) + 1))
+    && (Z.log2 (upper r) <? width).
 
   (* for the second argument of shifts *)
   Definition width_range :=  r[0~>width-1]%zrange.
@@ -280,6 +283,11 @@ Section Expr.
            end
     end.
 
+  Definition range_to_mask (r : zrange) : rtype type_range :=
+    if range_maskable r
+    then expr.literal (upper r)
+    else make_error _.
+
   Definition translate_cast_exempt {t}
              (require_in_bounds : bool)
              (e : @API.expr ltype t) : rtype t :=
@@ -293,11 +301,7 @@ Section Expr.
     | (expr.Ident type_nat (ident.Literal base.type.nat n)) =>
       expr.literal (Z.of_nat n)
     | (expr.Ident type_range (ident.Literal base.type.zrange r)) =>
-      (* Translate ranges into masks. Only ranges of the form [0~>2^n-1] should
-         get translated. *)
-      if range_maskable r
-      then expr.literal (upper r)
-      else make_error _
+      range_to_mask r
     | expr.Var type_listZ x => map expr.var x
     | expr.Var type_Z x => expr.var x
     | expr.Var type_ZZ x => (expr.var (fst x), expr.var (snd x))
diff --git a/src/Bedrock/Field/Translation/Proofs/Expr.v b/src/Bedrock/Field/Translation/Proofs/Expr.v
index b81ac2f3bb..7f48c1fff4 100644
--- a/src/Bedrock/Field/Translation/Proofs/Expr.v
+++ b/src/Bedrock/Field/Translation/Proofs/Expr.v
@@ -45,7 +45,8 @@ Section Expr.
   | valid_cast1 :
       forall (rc : bool) r x,
         valid_expr false x ->
-        range_maskable r = true ->
+        range_maskable (width:=width) r = true ->
+        (if rc then range_good (width:=width) r = true else True) ->
         valid_expr rc
                    (expr.App
                       (expr.App (expr.Ident ident.Z_cast)
@@ -53,8 +54,10 @@ Section Expr.
   | valid_cast2 :
       forall (rc : bool) r1 r2 x,
         valid_expr false x ->
-        range_maskable r1 = true ->
-        range_maskable r2 = true ->
+        range_maskable (width:=width) r1 = true ->
+        range_maskable (width:=width) r2 = true ->
+        (if rc then range_good (width:=width) r1 = true else True) ->
+        (if rc then range_good (width:=width) r2 = true else True) ->
         valid_expr rc
                    (expr.App
                       (expr.App (expr.Ident ident.Z_cast2)
@@ -438,6 +441,63 @@ Section Expr.
     { assert (n = 1) by lia; subst; rewrite Z.mod_mod by lia; reflexivity. }
   Qed.
 
+  Lemma wrap_rcast r x :
+    range_maskable (width:=width) r = true ->
+    word.unsigned (word.of_Z (word:=word) (ident.cast r x)) = ident.cast r x.
+  Admitted.
+
+  Lemma expr_rcast_range_to_mask (m : mem) (l : locals) r x y :
+    range_maskable (width:=width) r = true ->
+    WeakestPrecondition.dexpr m l x (word.of_Z y) ->
+    WeakestPrecondition.dexpr m l (rcast (range_to_mask r) x)
+                              (word.of_Z (word:=word) (ident.cast r y)).
+  Proof.
+    intros; cbv [rcast range_to_mask].
+    lazymatch goal with | H : range_maskable ?r = true |- _ => rewrite H end.
+    cbn [literal_eqb invert_literal].
+    cbv [range_maskable] in *; intros.
+    repeat lazymatch goal with
+           | H : (_ && _)%bool = true |- _ => apply Bool.andb_true_iff in H; destruct H
+           | H : zrange_beq ?r1 ?r2 |- _ => progress reflect_beq_to_eq zrange_beq; subst
+           | _ => progress Z.ltb_to_lt
+           end.
+    destruct r as [rl ru]; cbn [lower upper] in *; subst.
+    rewrite ident.cast_out_of_bounds_simple_0_mod by lia.
+    assert (ru < 2 ^ width).
+    { lazymatch goal with H : ru = Z.ones _ |- _ => rewrite H end.
+      rewrite Z.ones_equiv. apply Z.lt_pred_le.
+      apply Z.pow_le_mono_r; lia. }
+    pose proof (Z.log2_nonneg ru).
+    break_match; Z.ltb_to_lt; subst;
+      cbv [WeakestPrecondition.dexpr ident.literal] in *;
+      cbn [WeakestPrecondition.expr WeakestPrecondition.expr_body
+                                    Semantics.interp_binop].
+    { rewrite Z.sub_simpl_r.
+      eapply Proper_expr; [ | eassumption ].
+      repeat intro; subst.
+      apply word.of_Z_inj_mod; Z.rewrite_mod_small.
+      reflexivity. }
+    {
+      cbv [WeakestPrecondition.literal dlet.dlet].
+      eapply Proper_expr; [ | eassumption ].
+      repeat intro; subst.
+      apply word.unsigned_inj.
+      rewrite word.unsigned_and, !word.unsigned_of_Z.
+      cbv [word.wrap].
+      Z.rewrite_mod_small.
+      lazymatch goal with H : ru = Z.ones _ |- _ => rewrite H end.
+      rewrite Z.land_ones by lia.
+      rewrite Z.ones_equiv.
+      lazymatch goal with
+      | |- context [Z.pred ?x + 1] => replace (Z.pred x + 1) with x by lia
+      end.
+      destruct (Z.eq_dec (Z.log2 ru + 1) width).
+      { subst. rewrite !Z.mod_mod; lia. }
+      { rewrite !Modulo.Z.mod_pow_same_base_larger by lia.
+        rewrite !Modulo.Z.mod_pow_same_base_smaller by lia.
+        reflexivity. } }
+  Qed.
+
   (** TODO: Find a better place for this *)
   Hint Rewrite word.testbit_wrap : Ztestbit_full.
   Lemma translate_expr_correct' {t}
@@ -515,49 +575,38 @@ Section Expr.
                                ltac:(eassumption) ltac:(eassumption)).
       cbn [locally_equivalent equivalent_base rep.equiv rep.Z
                               locally_equivalent_nobounds_base] in *.
-      cbv [range_good rcast max_range ident.literal] in *.
-      intros; progress reflect_beq_to_eq zrange_beq; subst.
-      pose proof word.width_pos.
-      repeat match goal with
-             | _ => progress cbn [upper lower andb literal_eqb invert_literal]
-             | _ => rewrite Z.eqb_refl by lia
-             | _ => rewrite ones_of_pow2_minus1 by lia
-             | _ => rewrite ident.cast_out_of_bounds_simple_0_mod by lia
-             end.
-      cleanup.
-      rewrite Z.sub_simpl_r.
-      erewrite word.of_Z_inj_mod
-        by (rewrite Z.mod_mod by lia; reflexivity).
-      destruct rc; try eexists; sepsimpl;
-        try apply Z.mod_pos_bound; try lia;
-          eauto; [ ].
-      rewrite word.unsigned_of_Z. reflexivity. }
+      cbv [range_good max_range ident.literal] in *.
+      break_match; break_match_hyps;
+        repeat lazymatch goal with
+               | H : (_ && _)%bool = true |- _ => apply Bool.andb_true_iff in H; destruct H
+               | H : zrange_beq ?r1 ?r2 = true |- _ => progress reflect_beq_to_eq zrange_beq; subst
+               | _ => progress Z.ltb_to_lt
+               end; [ | ].
+      { eexists; sepsimpl; eauto using wrap_rcast, expr_rcast_range_to_mask. }
+      { apply expr_rcast_range_to_mask; auto. } }
     { (* cast2 *)
       specialize (IHvalid_expr _ _ _ _
                                ltac:(eassumption) ltac:(eassumption)).
-      cbv [range_good rcast rcast2 max_range ident.literal ident.cast2] in *.
+      cbv [range_good rcast2 max_range ident.literal ident.cast2] in *.
       cbn [locally_equivalent equivalent_base rep.equiv rep.Z fst snd
                               locally_equivalent_nobounds_base] in *.
       cbn [Compilers.base_interp] in *.
-      intros; progress reflect_beq_to_eq zrange_beq; subst.
-      rewrite !ident.cast_out_of_bounds_simple_0_mod by lia.
-      rewrite Z.sub_simpl_r.
-      pose proof word.width_pos.
-      destruct rc;
-        repeat match goal with
+      break_match; break_match_hyps;
+        repeat lazymatch goal with
+               | H : (_ && _)%bool = true |- _ => apply Bool.andb_true_iff in H; destruct H; Z.ltb_to_lt
+               | H : _ /\ _ |- _ => destruct H
+               | H : zrange_beq ?r1 ?r2 = true |- _ => progress reflect_beq_to_eq zrange_beq; subst
+               | |- WeakestPrecondition.dexpr _ _ (rcast (range_to_mask _) _) _ =>
+                 apply expr_rcast_range_to_mask; auto; eassumption
+               | |- Separation.sep _ _ map.empty => apply sep_empty_iff
+               | |- _ /\ _ => split
+               | |- Lift1Prop.ex1 _ _ => eexists
                | _ => progress sepsimpl
-               | _ => progress cbn [upper lower andb literal_eqb invert_literal]
-               | _ => rewrite Z.eqb_refl by lia
-               | _ => rewrite ones_of_pow2_minus1 by lia
-               | _ => rewrite ident.cast_out_of_bounds_simple_0_mod by lia
-               | _ => rewrite word.unsigned_of_Z
-               | _ => eassumption
-               | _ => eexists
-               | _ =>
-                 erewrite word.of_Z_inj_mod
-                   by (rewrite Z.mod_mod by lia; reflexivity);
-                   solve [eauto]
-               end. }
+               end; [ | ].
+      all:rewrite ident.cast_out_of_bounds_simple_0_mod by lia.
+      all:rewrite Z.sub_simpl_r by lia.
+      all:rewrite word.unsigned_of_Z; cbv [word.wrap].
+      all:Z.rewrite_mod_small; reflexivity. }
     { (* fst then cast *)
       specialize (IHvalid_expr _ _ _ _
                                ltac:(eassumption) ltac:(eassumption)).

From 3f927039d2fae309abd2144d9b54eccdcca8f680 Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Thu, 24 Aug 2023 17:48:41 +0200
Subject: [PATCH 28/34] works except for sub

---
 .../Field/Synthesis/Examples/p224_64_new.v    |   2 +-
 src/Bedrock/Field/Translation/Expr.v          |   2 +-
 src/Bedrock/Field/Translation/Proofs/Expr.v   | 140 +++++------
 .../Translation/Proofs/ValidComputable/Expr.v | 217 +++++++-----------
 4 files changed, 138 insertions(+), 223 deletions(-)

diff --git a/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v b/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
index 70eb0435e0..7ceda82299 100644
--- a/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
+++ b/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
@@ -170,7 +170,7 @@ Section Field.
              Cmd.valid_cons_App2_bool
              Cmd.is_cons_ident
              Cmd.is_nil_ident].
-      repeat lazymatch goal with
+      repeat match goal with
              | |- context [(Expr.valid_expr_bool true ?x || Cmd.valid_special_bool ?x)%bool] =>
                           first [ change (Expr.valid_expr_bool true x) with true; cbn [orb]
                                 | change (Cmd.valid_special_bool x) with true; rewrite Bool.orb_true_r ]
diff --git a/src/Bedrock/Field/Translation/Expr.v b/src/Bedrock/Field/Translation/Expr.v
index e7aeb9a167..abed487256 100644
--- a/src/Bedrock/Field/Translation/Expr.v
+++ b/src/Bedrock/Field/Translation/Expr.v
@@ -137,7 +137,7 @@ Section Expr.
 
   Definition is_cast_literal_ident {t} (i : ident.ident t) : bool :=
     match i with
-    | ident.Literal base.type.zrange r => true
+    | ident.Literal base.type.zrange r => range_maskable r
     | _ => false
     end.
   Definition is_cast_literal
diff --git a/src/Bedrock/Field/Translation/Proofs/Expr.v b/src/Bedrock/Field/Translation/Proofs/Expr.v
index 7f48c1fff4..680df4d071 100644
--- a/src/Bedrock/Field/Translation/Proofs/Expr.v
+++ b/src/Bedrock/Field/Translation/Proofs/Expr.v
@@ -46,7 +46,6 @@ Section Expr.
       forall (rc : bool) r x,
         valid_expr false x ->
         range_maskable (width:=width) r = true ->
-        (if rc then range_good (width:=width) r = true else True) ->
         valid_expr rc
                    (expr.App
                       (expr.App (expr.Ident ident.Z_cast)
@@ -56,8 +55,6 @@ Section Expr.
         valid_expr false x ->
         range_maskable (width:=width) r1 = true ->
         range_maskable (width:=width) r2 = true ->
-        (if rc then range_good (width:=width) r1 = true else True) ->
-        (if rc then range_good (width:=width) r2 = true else True) ->
         valid_expr rc
                    (expr.App
                       (expr.App (expr.Ident ident.Z_cast2)
@@ -69,8 +66,7 @@ Section Expr.
   | valid_fst_cast :
       forall (x : API.expr type_ZZ) r1 r2,
         valid_expr false x ->
-        (* TODO: either need to add condition that r1 can be made into a mask,
-           or change cast case to specify masks instead of "good" *)
+        range_maskable (width:=width) r1 = true ->
         (* it's okay to have a cast with a bad range on the non-selected tuple element *)
         valid_expr false
                    (expr.App
@@ -85,6 +81,7 @@ Section Expr.
   | valid_snd_cast :
       forall (x : API.expr type_ZZ) r1 r2,
         valid_expr false x ->
+        range_maskable (width:=width) r2 = true ->
         (* it's okay to have a cast with a bad range on the non-selected tuple element *)
         valid_expr false
                    (expr.App
@@ -444,7 +441,26 @@ Section Expr.
   Lemma wrap_rcast r x :
     range_maskable (width:=width) r = true ->
     word.unsigned (word.of_Z (word:=word) (ident.cast r x)) = ident.cast r x.
-  Admitted.
+  Proof.
+    cbv [range_maskable]. intros.
+    rewrite word.unsigned_of_Z. cbv [word.wrap].
+    repeat lazymatch goal with
+           | H : (_ && _)%bool = true |- _ => apply Bool.andb_true_iff in H
+           | H : _ /\ _ |- _ => destruct H
+           end.
+    Z.ltb_to_lt. destruct r as [rl ru]; cbn [upper lower] in *.
+    subst. rewrite ident.cast_out_of_bounds_simple_0_mod by lia.
+    lazymatch goal with H : ru = Z.ones _ |- _ => rewrite H end.
+    rewrite Z.ones_equiv.
+    lazymatch goal with
+    | |- context [Z.pred ?x + 1] => replace (Z.pred x + 1) with x by lia
+    end.
+    pose proof (Z.log2_nonneg ru).
+    destruct (Z.eq_dec (Z.log2 ru + 1) width).
+    { subst. rewrite !Z.mod_mod by (apply Z.pow_nonzero; lia). lia. }
+    { rewrite !Modulo.Z.mod_pow_same_base_larger by lia.
+      reflexivity. }
+  Qed.
 
   Lemma expr_rcast_range_to_mask (m : mem) (l : locals) r x y :
     range_maskable (width:=width) r = true ->
@@ -576,7 +592,7 @@ Section Expr.
       cbn [locally_equivalent equivalent_base rep.equiv rep.Z
                               locally_equivalent_nobounds_base] in *.
       cbv [range_good max_range ident.literal] in *.
-      break_match; break_match_hyps;
+      break_match; break_match_hyps; try congruence;
         repeat lazymatch goal with
                | H : (_ && _)%bool = true |- _ => apply Bool.andb_true_iff in H; destruct H
                | H : zrange_beq ?r1 ?r2 = true |- _ => progress reflect_beq_to_eq zrange_beq; subst
@@ -594,64 +610,33 @@ Section Expr.
       break_match; break_match_hyps;
         repeat lazymatch goal with
                | H : (_ && _)%bool = true |- _ => apply Bool.andb_true_iff in H; destruct H; Z.ltb_to_lt
+               | H : (_ && _)%bool = false |- _ => apply Bool.andb_false_iff in H; destruct H; Z.ltb_to_lt
                | H : _ /\ _ |- _ => destruct H
                | H : zrange_beq ?r1 ?r2 = true |- _ => progress reflect_beq_to_eq zrange_beq; subst
                | |- WeakestPrecondition.dexpr _ _ (rcast (range_to_mask _) _) _ =>
                  apply expr_rcast_range_to_mask; auto; eassumption
                | |- Separation.sep _ _ map.empty => apply sep_empty_iff
                | |- _ /\ _ => split
+               | H1 : ?x = true, H2 : ?x = false |- _ => congruence
                | |- Lift1Prop.ex1 _ _ => eexists
                | _ => progress sepsimpl
                end; [ | ].
-      all:rewrite ident.cast_out_of_bounds_simple_0_mod by lia.
-      all:rewrite Z.sub_simpl_r by lia.
-      all:rewrite word.unsigned_of_Z; cbv [word.wrap].
-      all:Z.rewrite_mod_small; reflexivity. }
+      all:rewrite wrap_rcast by auto.
+      all:reflexivity. }
     { (* fst then cast *)
       specialize (IHvalid_expr _ _ _ _
                                ltac:(eassumption) ltac:(eassumption)).
-      cbv [range_good max_range ident.literal ident.cast2 rcast rcast2] in *.
+      cbv [range_good max_range ident.literal ident.cast2 rcast2] in *.
       cbn [locally_equivalent equivalent_base rep.equiv rep.Z fst snd
                               locally_equivalent_nobounds_base] in *.
-      pose proof word.width_pos.
-      repeat match goal with
-             | _ => progress cbn [upper lower andb literal_eqb invert_literal]
-             | _ => progress sepsimpl
-             | _ => rewrite Z.eqb_refl by lia
-             | _ => rewrite ones_of_pow2_minus1 by lia
-             | _ => rewrite ident.cast_out_of_bounds_simple_0_mod by lia
-             | _ => rewrite Z.sub_simpl_r
-             | _ => rewrite word.unsigned_of_Z
-             | _ => eassumption
-             | _ => eexists
-             | _ =>
-               erewrite word.of_Z_inj_mod
-                 by (rewrite Z.mod_mod by lia; reflexivity);
-                 solve [eauto]
-             end. }
+      sepsimpl; auto using expr_rcast_range_to_mask. }
     { (* snd then cast *)
       specialize (IHvalid_expr _ _ _ _
                                ltac:(eassumption) ltac:(eassumption)).
-      cbv [range_good max_range ident.literal ident.cast2 rcast rcast2] in *.
+      cbv [range_good max_range ident.literal ident.cast2 rcast2] in *.
       cbn [locally_equivalent equivalent_base rep.equiv rep.Z fst snd
                               locally_equivalent_nobounds_base] in *.
-      intros; progress reflect_beq_to_eq zrange_beq; subst.
-      pose proof word.width_pos.
-      repeat match goal with
-             | _ => progress cbn [upper lower andb literal_eqb invert_literal]
-             | _ => progress sepsimpl
-             | _ => rewrite Z.eqb_refl by lia
-             | _ => rewrite ones_of_pow2_minus1 by lia
-             | _ => rewrite ident.cast_out_of_bounds_simple_0_mod by lia
-             | _ => rewrite Z.sub_simpl_r
-             | _ => rewrite word.unsigned_of_Z
-             | _ => eassumption
-             | _ => eexists
-             | _ =>
-               erewrite word.of_Z_inj_mod
-                 by (rewrite Z.mod_mod by lia; reflexivity);
-                 solve [eauto]
-             end. }
+      sepsimpl; auto using expr_rcast_range_to_mask. }
     { (* literal Z *)
       cbn [locally_equivalent_nobounds_base
              locally_equivalent equivalent_base rep.equiv rep.Z].
@@ -862,48 +847,35 @@ Section Expr.
              locally_equivalent equivalent
              equivalent_base rep.equiv rep.Z ident.literal] in *.
       intros; progress reflect_beq_to_eq zrange_beq; subst.
-      cbv [WeakestPrecondition.dexpr ident.literal bit_range rcast] in *.
+      cbv [WeakestPrecondition.dexpr ident.literal bit_range] in *.
       cbn [WeakestPrecondition.expr WeakestPrecondition.expr_body
                                     Semantics.interp_binop].
-      sepsimpl_hyps.
+      cbv [WeakestPrecondition.literal dlet.dlet].
       pose proof word.width_pos.
-      repeat match goal with
-             | _ => progress cbn [upper lower andb literal_eqb invert_literal]
-             | _ => rewrite Z.eqb_refl by lia
-             | _ => rewrite ones_of_pow2_minus1 by lia
-             | _ => rewrite ident.cast_out_of_bounds_simple_0_mod by lia
+      assert (range_maskable (width:=width) r[0~>1] = true) by (cbn; Z.ltb_to_lt; lia).
+      eapply Proper_expr; [ | apply expr_rcast_range_to_mask; solve [eauto] ].
+      repeat intro; subst.
+      cbv [Definitions.Z.zselect].
+      apply word.unsigned_inj.
+      rewrite !ident.cast_out_of_bounds_simple_0_mod by lia.
+      progress change (1 + 1) with 2.
+      repeat lazymatch goal with
+             | |- context [word.wrap _] => progress cbv [word.wrap]
+             | |- context [word.unsigned (word.of_Z 0)] => rewrite word.unsigned_of_Z_0 by lia
+             | |- context [word.unsigned (word.of_Z 1)] => rewrite word.unsigned_of_Z_1 by lia
+             | |- context [word.unsigned (word.of_Z (-1))] => rewrite word.unsigned_of_Z_minus1 by lia
+             | |- context [word.unsigned (word.of_Z _)] => rewrite word.unsigned_of_Z by lia
+             | |- context [word.unsigned (word.add _ _)] => rewrite word.unsigned_add by lia
+             | |- context [word.eqb _ _] => rewrite word.unsigned_eqb by lia
+             | |- context [word.unsigned (if _ then _ else _)] => rewrite <-Bool.pull_bool_if by lia
+             | |- context [Z.ones] => rewrite Z.ones_equiv
+             | |- context [Z.pred ?n + 1] => replace (Z.pred n + 1) with n by lia
+             | |- context [(_ mod 2) mod (2 ^ _)] => rewrite mod_2_mod_pow2 by lia
+             | |- context [?n mod ?n] => rewrite Z.mod_same by lia
+             | _ => progress break_match; Z.ltb_to_lt; try lia
              end.
-      cbn [WeakestPrecondition.expr WeakestPrecondition.expr_body
-                                    Semantics.interp_binop].
-      rewrite Zselect.Z.zselect_correct.
-      replace (1 + 1) with 2 by lia.
-      break_match; Z.ltb_to_lt;
-        cbn [WeakestPrecondition.expr WeakestPrecondition.expr_body
-                                      Semantics.interp_binop].
-      all:eapply Proper_expr; [ | eassumption ].
-      all:repeat intro; subst.
-      all:apply word.unsigned_inj.
-      all:repeat lazymatch goal with
-                 | |- context [word.wrap _] => progress cbv [word.wrap]
-                 | |- context [word.unsigned (word.add _ _)] => rewrite word.unsigned_add by lia
-                 | |- context [word.unsigned (word.and _ _)] => rewrite word.unsigned_and by lia
-                 | |- context [word.eqb _ _] => rewrite word.unsigned_eqb by lia
-                 | |- context [word.unsigned (word.of_Z 0)] => rewrite word.unsigned_of_Z_0 by lia
-                 | |- context [word.unsigned (word.of_Z 1)] => rewrite word.unsigned_of_Z_1 by lia
-                 | |- context [word.unsigned (word.of_Z (-1))] => rewrite word.unsigned_of_Z_minus1 by lia
-                 | |- context [word.unsigned (word.of_Z _)] => rewrite word.unsigned_of_Z by lia
-                 | |- context [word.unsigned (if _ then _ else _)] => rewrite <-Bool.pull_bool_if by lia
-                 | |- context [(_ mod 2) mod (2 ^ _)] => rewrite mod_2_mod_pow2 by lia
-                 | |- context [(_ mod (2 ^ _)) mod 2] => rewrite mod_pow2_mod_2 by lia
-                 | |- context [_ ^ 1] => rewrite Z.pow_1_r by lia
-                 | |- context [Z.land _ 1] => rewrite Z_land_1_r by lia
-                 | |- context [Z.ones] => rewrite Z.ones_equiv
-                 | |- context [?n mod ?n] => rewrite Z.mod_same by lia
-                 | |- context [Z.pred ?n + 1] => replace (Z.pred n + 1) with n by lia
-                 | H : 1 = 2 ^ width - 1 |- _ => replace width with 1 in * by lia; clear H
-                 | _ => progress break_match; Z.ltb_to_lt; try lia; autorewrite with zsimplify_fast
-                 end.
-      all:reflexivity. }
+      all:Z.rewrite_mod_small.
+      all:lia. }
     { (* opp *)
       specialize (IHvalid_expr _ _ _ _
                                ltac:(eassumption) ltac:(eassumption)).
diff --git a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
index 31cfd730c6..fbc8c6079d 100644
--- a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
+++ b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
@@ -53,44 +53,6 @@ Section Expr.
     | _ => false
     end.
 
-  Definition valid_cast_literal_ident {t} (r : zrange) (i : ident.ident t) : bool :=
-    match i with
-    | ident.Literal base.type.zrange r' => zrange_beq r r'
-    | _ => false
-    end.
-
-  Definition valid_cast_literal {var t} (r : zrange) (e : @API.expr var t) : bool :=
-    match e with
-    | expr.Ident type_range i => valid_cast_literal_ident r i
-    | _ => false
-    end.
-
-  Definition valid_cast2_literal_App1
-             {var t} (r : zrange) (e : @API.expr var t) : bool :=
-    match e with
-    | expr.App
-        type_range (type.arrow type_range type_range2)
-        f r1 =>
-      is_cast2_literal_App2 f && valid_cast_literal r r1
-    | _ => false
-    end.
-  Definition valid_cast2_literal
-             {var t} (r : zrange) (e : @API.expr var t) : bool :=
-    match e with
-    | expr.App type_range type_range2 f r2 =>
-      valid_cast2_literal_App1 r f && valid_cast_literal r r2
-    | _ => false
-    end.
-
-  Definition valid_cast_bool {t} (r : zrange) (e : @API.expr (fun _ => unit) t) : bool :=
-    match e with
-    | expr.App type_range (type.arrow type_Z type_Z) f x =>
-      is_cast_ident_expr f && valid_cast_literal r x
-    | expr.App type_range2 (type.arrow type_ZZ type_ZZ) f x =>
-      is_cast_ident_expr f && valid_cast2_literal r x
-    | _ => false
-    end.
-
   Definition is_mul_high_ident {t} (i : ident.ident t) : bool :=
     match i with
     | ident.Z_mul_high => true
@@ -241,7 +203,7 @@ Section Expr.
   Definition valid_fst_cast_bool {t}
              (e : @API.expr (fun _ => unit) t) : bool :=
     match invert_expr.invert_Z_cast2 e with
-    | Some (r1, r2) => range_good (width:=width) r1
+    | Some (r1, r2) => range_maskable (width:=width) r1
     | None => false
     end.
 
@@ -249,7 +211,7 @@ Section Expr.
   Definition valid_snd_cast_bool {t}
              (e : @API.expr (fun _ => unit) t) : bool :=
     match invert_expr.invert_Z_cast2 e with
-    | Some (r1, r2) => range_good (width:=width) r2
+    | Some (r1, r2) => range_maskable (width:=width) r2
     | None => false
     end.
 
@@ -355,7 +317,7 @@ Section Expr.
                           (negb require_casts)
                             && valid_expr_bool' NotPartial true x
                         else (* must be a cast *)
-                          (valid_cast_bool (max_range (width:=width)) f)
+                          (is_cast (width:=width) f)
                             && valid_expr_bool' NotPartial false x
         | expr.App type_ZZ type_Z f x =>
           (* fst or snd *)
@@ -365,7 +327,7 @@ Section Expr.
                then (negb require_casts) && valid_expr_bool' Snd false x
                else false
         | expr.App type_ZZ type_ZZ f x =>
-          valid_cast_bool (max_range (width:=width)) f
+          is_cast (width:=width) f
           && valid_expr_bool' NotPartial false x
         | expr.Ident _ (ident.Literal base.type.Z z) =>
           is_bounded_by_bool z (@max_range width)|| negb require_casts
@@ -380,12 +342,12 @@ Section Expr.
 
   Definition valid_expr_bool {t} rc := @valid_expr_bool' NotPartial rc t.
 
-  Lemma valid_expr_App1_bool_type {t} r (e : API.expr t) :
-    valid_cast_bool r e = true ->
+  Lemma is_cast_type {var t} (e : API.expr t) :
+    is_cast (var:=var) (width:=width) e = true ->
     (t = type.arrow type_Z type_Z
      \/ t = type.arrow type_ZZ type_ZZ).
   Proof.
-    cbv [valid_cast_bool].
+    cbv [is_cast].
     break_match; try congruence.
     all:intros; tauto.
   Qed.
@@ -546,7 +508,7 @@ Section Expr.
        fun i =>
          forall (x : API.expr type_ZZ) r1 r2,
            valid_expr false x ->
-           range_good (width:=width) r1 = true ->
+           range_maskable (width:=width) r1 = true ->
            valid_expr false (expr.App (expr.Ident i)
                                       (expr.App (expr.App
                                                    (expr.Ident ident.Z_cast2)
@@ -572,7 +534,7 @@ Section Expr.
        fun i =>
          forall (x : API.expr type_ZZ) r1 r2,
            valid_expr false x ->
-           range_good (width:=width) r2 = true ->
+           range_maskable (width:=width) r2 = true ->
            valid_expr false (expr.App (expr.Ident i)
                                       (expr.App (expr.App
                                                    (expr.Ident ident.Z_cast2)
@@ -591,38 +553,42 @@ Section Expr.
       intros; constructor; eauto.
   Qed.
 
-  Lemma valid_cast_literal_ident_eq {t} r (i : ident.ident t) :
-    valid_cast_literal_ident r i = true ->
+  Lemma is_cast_literal_ident_eq {t} (i : ident.ident t) :
+    is_cast_literal_ident (width:=width) i = true ->
     (match t as t0 return ident.ident t0 -> Prop with
      | type_range =>
        fun i =>
-         i = ident.Literal (t:=base.type.zrange) r
+         exists r,
+           i = ident.Literal (t:=base.type.zrange) r
+           /\ range_maskable (width:=width) r = true
      | _ => fun _ => False
      end) i.
   Proof.
-    cbv [valid_cast_literal_ident].
+    cbv [is_cast_literal_ident].
     break_match; try congruence; [ ].
-    cbv [range_good]. intros; progress reflect_beq_to_eq zrange_beq; subst.
-    reflexivity.
+    intros; eexists; eauto.
   Qed.
 
-  Lemma valid_cast_literal_eq {t} r (e : API.expr t) :
-    valid_cast_literal r e = true ->
+  Lemma is_cast_literal_eq {t} (e : API.expr t) :
+    is_cast_literal (width:=width) e = true ->
     (match t as t0 return @API.expr (fun _ => unit) t0 -> Prop with
      | type_range =>
        fun e =>
-         e = expr.Ident (ident.Literal (t:=base.type.zrange) r)
+         exists r,
+           e = expr.Ident (ident.Literal (t:=base.type.zrange) r)
+           /\ range_maskable (width:=width) r = true
      | _ => fun _ => False
      end) e.
   Proof.
-    cbv [valid_cast_literal].
+    cbv [is_cast_literal].
     break_match; try congruence; [ ].
     intros;
-      match goal with
-      | H : valid_cast_literal_ident _ _ = true |- _ =>
-        apply valid_cast_literal_ident_eq in H
-      end.
-    subst; reflexivity.
+      repeat lazymatch goal with
+             | H : is_cast_literal_ident _ = true |- _ =>
+               apply is_cast_literal_ident_eq in H; destruct H
+             | H : _ /\ _ |- _ => destruct H
+             end.
+    eexists; split; subst; eauto.
   Qed.
 
   Lemma is_pair_range_eq {t} (i : ident.ident t) :
@@ -655,59 +621,67 @@ Section Expr.
     congruence.
   Qed.
 
-  Lemma valid_cast2_literal_App1_eq {t} r (e : API.expr t) :
-    valid_cast2_literal_App1 r e = true ->
+  Lemma is_cast2_literal_App1_eq {t} (e : API.expr t) :
+    is_cast2_literal_App1 (width:=width) e = true ->
     (match t as t0 return @API.expr (fun _ => unit) t0 -> Prop with
      | type.arrow type_range type_range2 =>
        fun e =>
-         e = expr.App
-               (expr.Ident ident.pair)
-               (expr.Ident
-                  (ident.Literal (t:=base.type.zrange) r))
+         exists r,
+           e = expr.App
+                 (expr.Ident ident.pair)
+                 (expr.Ident
+                    (ident.Literal (t:=base.type.zrange) r))
+           /\ range_maskable (width:=width) r = true
      | _ => fun _ => False
      end) e.
   Proof.
-    cbv [valid_cast2_literal_App1].
+    cbv [is_cast2_literal_App1].
     break_match; try congruence; [ ].
     intros;
       repeat match goal with
              | H : _ && _ = true |- _ =>
                apply andb_true_iff in H; destruct H
-             | H : valid_cast_literal _ _ = true |- _ =>
-               apply valid_cast_literal_eq in H; subst
+             | H : is_cast_literal _ = true |- _ =>
+               apply is_cast_literal_eq in H; destruct H; subst
              | H : is_cast2_literal_App2 _ = true |- _ =>
                apply is_cast2_literal_App2_eq in H; subst
+             | H : _ /\ _ |- _ => destruct H
              end.
-    reflexivity.
+    subst; eexists; eauto.
   Qed.
 
-  Lemma valid_cast2_literal_eq {t} r (e : API.expr t) :
-    valid_cast2_literal r e = true ->
+  Lemma is_cast2_literal_eq {t} (e : API.expr t) :
+    is_cast2_literal (width:=width) e = true ->
     (match t as t0 return @API.expr (fun _ => unit) t0 -> Prop with
      | type_range2 =>
        fun e =>
-         e = expr.App
-               (expr.App
-                  (expr.Ident ident.pair)
-                  (expr.Ident
-                     (ident.Literal (t:=base.type.zrange) r)))
-               (expr.Ident
-                  (ident.Literal (t:=base.type.zrange) r))
+         exists r1 r2,
+           e = expr.App
+                 (expr.App
+                    (expr.Ident ident.pair)
+                    (expr.Ident
+                       (ident.Literal (t:=base.type.zrange) r1)))
+                 (expr.Ident
+                    (ident.Literal (t:=base.type.zrange) r2))
+           /\ range_maskable (width:=width) r1 = true
+           /\ range_maskable (width:=width) r2 = true
      | _ => fun _ => False
      end) e.
   Proof.
-    cbv [valid_cast2_literal].
+    cbv [is_cast2_literal].
     break_match; try congruence; [ ].
     intros;
       repeat match goal with
              | H : _ && _ = true |- _ =>
                apply andb_true_iff in H; destruct H
-             | H : valid_cast_literal _ _ = true |- _ =>
-               apply valid_cast_literal_eq in H; subst
-             | H : valid_cast2_literal_App1 _ _ = true |- _ =>
-               apply valid_cast2_literal_App1_eq in H; subst
+             | H : is_cast_literal _ = true |- _ =>
+               apply is_cast_literal_eq in H; subst
+             | H : is_cast2_literal_App1 _ = true |- _ =>
+               apply is_cast2_literal_App1_eq in H; subst
+             | H : _ /\ _ |- _ => destruct H
+             | H : exists _, _ |- _ => destruct H
              end.
-    reflexivity.
+    subst; repeat eexists; eauto.
   Qed.
 
   Lemma is_cast_ident_expr_impl1 {t} rc (f : API.expr t) :
@@ -718,7 +692,7 @@ Section Expr.
          forall
            (r : API.expr type_range)
            (x : API.expr type_Z),
-           valid_cast_literal (max_range (width:=width)) r = true ->
+           is_cast_literal (width:=width) r = true ->
            valid_expr false x ->
            valid_expr rc (expr.App (expr.App f r) x)
      | type.arrow type_range2 (type.arrow type_ZZ type_ZZ) =>
@@ -726,7 +700,7 @@ Section Expr.
          forall
            (r : API.expr type_range2)
            (x : API.expr type_ZZ),
-           valid_cast2_literal (max_range (width:=width)) r = true ->
+           is_cast2_literal (width:=width) r = true ->
            valid_expr false x ->
            valid_expr rc (expr.App (expr.App f r) x)
      | _ => fun _ => False
@@ -736,20 +710,19 @@ Section Expr.
     break_match; try congruence; [ | ];
       intros;
       repeat lazymatch goal with
-             | H : exists _, _ |- _ => destruct H ;subst
-             | H : valid_cast_literal _ _ = true |- _ =>
-               apply valid_cast_literal_eq in H; subst
-             | H : valid_cast2_literal _ _ = true |- _ =>
-               apply valid_cast2_literal_eq in H; subst
+             | H : is_cast_literal _ = true |- _ =>
+               apply is_cast_literal_eq in H
+             | H : is_cast2_literal _ = true |- _ =>
+               apply is_cast2_literal_eq in H
+             | H : _ /\ _ |- _ => destruct H
+             | H : exists _, _ |- _ => destruct H
+             | _ => progress subst
              end.
-    { constructor;
-        cbv [range_good]; auto using zrange_lb. }
-    { constructor;
-        cbv [range_good]; auto using zrange_lb. }
+    all:constructor; eauto.
   Qed.
 
-  Lemma valid_cast_bool_impl1 {t} rc (f : API.expr t) :
-    valid_cast_bool (max_range (width:=width)) f = true ->
+  Lemma is_cast_impl1 {t} rc (f : API.expr t) :
+    is_cast (width:=width) f = true ->
     (match t as t0 return expr.expr t0 -> Prop with
      | type.arrow type_Z _ =>
        fun f =>
@@ -764,7 +737,7 @@ Section Expr.
      | _ => fun _ => False
      end) f.
   Proof.
-    cbv [valid_cast_bool].
+    cbv [is_cast].
     remember t.
     destruct t; try congruence.
     { intros; exfalso.
@@ -1242,8 +1215,8 @@ Section Expr.
         repeat match goal with
                | H : _ && _ = true |- _ =>
                  apply andb_true_iff in H; destruct H
-               | H: valid_cast_bool _ = true |- _ =>
-                 apply valid_cast_bool_type in H;
+               | H: is_cast _ = true |- _ =>
+                 apply is_cast_type in H;
                    destruct H; destruct H; congruence
                | IH : forall mode _ _,
                    match mode with
@@ -1279,7 +1252,7 @@ Section Expr.
         apply (IHe2 NotPartial); eauto. }
       { (* cast Z case *)
         intros.
-        apply (valid_cast_bool_impl1
+        apply (is_cast_impl1
                  (t := type_Z -> type_Z)); eauto; [ ].
         apply (IHe2 NotPartial); eauto. }
       { (* nth_default case *)
@@ -1304,7 +1277,7 @@ Section Expr.
         apply (IHe2 Snd); auto using valid_expr_Snd_valid_snd_casted. }
       { (* cast ZZ *)
         intros.
-        apply (valid_cast_bool_impl1
+        apply (is_cast_impl1
                  (t := type_ZZ -> type_ZZ)); eauto; [ ].
         eapply (IHe2 NotPartial); eauto. }
       { (* partially-applied binop case *)
@@ -1399,42 +1372,12 @@ Section Expr.
              | H : zrange_beq _ _ = true |- _ => progress reflect_beq_to_eq zrange_beq; subst
              | |- context [zrange_beq ?r ?r] => rewrite zrange_lb by reflexivity
              | _ => rewrite Z.eqb_refl
+             | |- (_ && _)%bool = true => apply Bool.andb_true_iff; split; Z.ltb_to_lt
              end;
       auto using
            Bool.andb_true_iff, Bool.orb_true_iff,
       is_bounded_by_bool_max_range,
-      is_bounded_by_bool_width_range; [ | | | ].
-    { (* fst *)
-      cbv [valid_fst_cast_bool].
-      lazymatch goal with
-      | |- context [invert_expr.invert_Z_cast2
-                     (expr.App _ (expr.App (expr.App (expr.Ident ident.pair)
-                                                     (expr.Ident (ident.Literal ?r1)))
-                                           (expr.Ident (ident.Literal ?r2))))] =>
-        let H := fresh in
-        pose proof (InversionExtra.Compilers.expr.invert_Z_cast2_Z_cast2
-                    (var:=fun _ => unit) (r1, r2)) as H;
-          cbn - [invert_expr.invert_Z_cast2] in H;
-          cbv [ident.literal] in H; rewrite H
-      end.
-      cbv [range_good]; rewrite zrange_lb by reflexivity; reflexivity. }
-    { (* snd *)
-      cbv [valid_snd_cast_bool].
-      lazymatch goal with
-      | |- context [invert_expr.invert_Z_cast2
-                     (expr.App _ (expr.App (expr.App (expr.Ident ident.pair)
-                                                     (expr.Ident (ident.Literal ?r1)))
-                                           (expr.Ident (ident.Literal ?r2))))] =>
-        let H := fresh in
-        pose proof (InversionExtra.Compilers.expr.invert_Z_cast2_Z_cast2
-                    (var:=fun _ => unit) (r1, r2)) as H;
-          cbn - [invert_expr.invert_Z_cast2] in H;
-          cbv [ident.literal] in H; rewrite H
-      end.
-      cbv [range_good]; rewrite zrange_lb by reflexivity; reflexivity. }
-    { (* lnot_modulo *)
-      apply Bool.andb_true_iff; split;
-        Z.ltb_to_lt; auto. }
+      is_bounded_by_bool_width_range; [ ].
     { (* binop *)
       match goal with
       | H : translate_binop ?i <> None

From 908f6e5ae6a2ffdcd0bae932235e1f56c55b0ae8 Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Fri, 25 Aug 2023 11:50:40 +0200
Subject: [PATCH 29/34] works with sub, but fails to handle carries which are
 literals

---
 .../Field/Synthesis/Examples/p224_64_new.v    |  13 +-
 src/Bedrock/Field/Synthesis/New/Signature.v   |  17 +-
 .../Synthesis/New/WordByWordMontgomery.v      |  10 +
 src/Bedrock/Field/Translation/Proofs/Cmd.v    | 481 +++++++++++++++++-
 src/Bedrock/Field/Translation/Proofs/Func.v   |   2 +
 .../Translation/Proofs/ValidComputable/Cmd.v  | 198 +++++--
 6 files changed, 648 insertions(+), 73 deletions(-)

diff --git a/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v b/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
index 7ceda82299..00d2556e18 100644
--- a/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
+++ b/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
@@ -137,6 +137,7 @@ Section Field.
   Derive p224_add
          SuchThat (forall functions,
                       Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
+                      Cmd.spec_of_sub_borrowx (sub_borrowx:=Defaults.sub_borrowx) functions ->
                       spec_of_BinOp bin_add
                         (field_representation:=field_representation m)
                         (p224_add :: functions))
@@ -180,10 +181,7 @@ Section Field.
       cbn [orb andb].
       match goal with
       | |- context [Cmd.valid_special_bool ?x] =>
-        match x with
-        | context [ident.Z_add_with_get_carry] =>
-          assert (Cmd.valid_special_bool x = true)
-        end
+        assert (Cmd.valid_special_bool x = true)
       end.
       { cbv [Cmd.valid_special_bool].
         cbv [invert_expr.invert_App_cast].
@@ -199,6 +197,7 @@ Section Field.
         cbv [Cmd.valid_ident_special4].
         cbn [fst snd].
         cbv [Cmd.is_add_with_get_carry_ident].
+        cbv [Cmd.is_sub_with_get_borrow_ident].
         cbv [Expr.is_literalz].
         rewrite Z.eqb_refl.
         repeat lazymatch goal with
@@ -210,11 +209,7 @@ Section Field.
         cbn [fst snd]. rewrite !ZRange.zrange_lb by reflexivity.
         cbn [andb].
         cbv [Cmd.valid_carry_bool].
-        rewrite Util.invert_App_Z_cast_eq_Some.
-        cbn [fst snd].
-        cbv [Cmd.is_carry_range].
-        rewrite !ZRange.zrange_lb by reflexivity.
-        (* same issue; snd has bad range *)
+        (* problem is that valid_carry_bool only matches cast, while it should also accept a 0/1 literal *)
       }
         
       rewrite !Bool.orb_false_r.
diff --git a/src/Bedrock/Field/Synthesis/New/Signature.v b/src/Bedrock/Field/Synthesis/New/Signature.v
index 68efc40e4b..8f05bd7a52 100644
--- a/src/Bedrock/Field/Synthesis/New/Signature.v
+++ b/src/Bedrock/Field/Synthesis/New/Signature.v
@@ -223,6 +223,7 @@ Section WithParameters.
     | |- @eq (list word.rep) _ _ => reflexivity
     | |- length [?p] = _ => reflexivity
     | |- Cmd.spec_of_add_carryx _ => assumption
+    | |- Cmd.spec_of_sub_borrowx _ => assumption
     | |- forall _, ~ VarnameSet.varname_set_args _ _ =>
       solve [auto using make_innames_varname_gen_disjoint]
     | |- forall _, ~ VarnameSet.varname_set_base (make_outnames _)
@@ -382,6 +383,7 @@ Section WithParameters.
       f = make_bedrock_func insizes outsizes inlengths res ->
       forall functions,
         Cmd.spec_of_add_carryx (add_carryx:=add_carryx) functions ->
+        Cmd.spec_of_sub_borrowx (sub_borrowx:=sub_borrowx) functions ->
         (binop_spec _ ((name, f) :: functions)).
     Proof.
       subst inlengths insizes outsizes.
@@ -468,6 +470,7 @@ Section WithParameters.
       f = make_bedrock_func insizes outsizes inlengths res ->
       forall functions,
         Cmd.spec_of_add_carryx (add_carryx:=add_carryx) functions ->
+        Cmd.spec_of_sub_borrowx (sub_borrowx:=sub_borrowx) functions ->
         unop_spec _ ((name, f) :: functions).
     Proof using inname_gen_varname_gen_disjoint outbounds_length
           outbounds_tighter_than_max outname_gen_varname_gen_disjoint
@@ -544,6 +547,7 @@ Section WithParameters.
       f = make_bedrock_func insizes outsizes inlengths res ->
       forall functions,
         Cmd.spec_of_add_carryx (add_carryx:=add_carryx) functions ->
+        Cmd.spec_of_sub_borrowx (sub_borrowx:=sub_borrowx) functions ->
         spec_of_from_word ((from_word, f) :: functions).
     Proof using inname_gen_varname_gen_disjoint
           outname_gen_varname_gen_disjoint ok relax_bounds res_Wf
@@ -565,8 +569,7 @@ Section WithParameters.
           let in_ptrs := (eval compute in (tl arg_ptrs)) in
           eapply (translate_func_correct (parameters_sentinel:=parameters_sentinel))
           with (out_ptrs:=[out_ptr]) (flat_args:=in_ptrs)
-          (args:=b2_args).
-        17:instantiate (1:=R).
+               (args:=b2_args) (R:=R).
         all:try translate_func_precondition_hammer.
         1:reflexivity.
         { cbv [Equivalence.equivalent_flat_args]; eexists 1%nat; split; [eexists|reflexivity].
@@ -653,6 +656,7 @@ Section WithParameters.
       f = make_bedrock_func insizes outsizes inlengths res ->
       forall functions,
         Cmd.spec_of_add_carryx (add_carryx:=add_carryx) functions ->
+        Cmd.spec_of_sub_borrowx (sub_borrowx:=sub_borrowx) functions ->
         spec_of_felem_copy ((felem_copy, f) :: functions).
     Proof.
       subst inlengths insizes outsizes.
@@ -697,8 +701,10 @@ Section WithParameters.
         try (use_sep_assumption; cancel; cbv [seps]);
         seprewrite_in (FElem_array_truncated_scalar_iff1 px) Hsep; extract_ex1_and_emp_in Hsep; trivial.
       Morphisms.f_equiv.
-      rewrite H4.
-      rewrite <-(res_eq x) at 2 by trivial.
+      rewrite <-(res_eq x) by trivial.
+      lazymatch goal with
+      | H : map word.unsigned _ = expr.interp _ _ _ |- _ => rewrite H
+      end.
       rewrite Util.map_unsigned_of_Z.
       erewrite map_word_wrap_bounded; trivial.
       eapply max_bounds_range_iff; ssplit; eauto.
@@ -768,6 +774,7 @@ Section WithParameters.
       f = make_bedrock_func insizes outsizes inlengths res ->
       forall functions,
         Cmd.spec_of_add_carryx (add_carryx:=add_carryx) functions ->
+        Cmd.spec_of_sub_borrowx (sub_borrowx:=sub_borrowx) functions ->
         spec_of_from_bytes ((from_bytes, f) :: functions).
     Proof using inname_gen_varname_gen_disjoint
           outname_gen_varname_gen_disjoint ok relax_bounds res_Wf
@@ -909,6 +916,7 @@ Section WithParameters.
       f = make_bedrock_func insizes outsizes inlengths res ->
       forall functions,
         Cmd.spec_of_add_carryx (add_carryx:=add_carryx) functions ->
+        Cmd.spec_of_sub_borrowx (sub_borrowx:=sub_borrowx) functions ->
         spec_of_to_bytes ((to_bytes, f) :: functions).
     Proof using byte_bounds_length byte_bounds_tighter_than_max
           inname_gen_varname_gen_disjoint
@@ -1042,6 +1050,7 @@ Context
       f = make_bedrock_func insizes outsizes inlengths res ->
       forall functions,
         Cmd.spec_of_add_carryx (add_carryx:=add_carryx) functions ->
+        Cmd.spec_of_sub_borrowx (sub_borrowx:=sub_borrowx) functions ->
         spec_of_selectznz ((select_znz, f) :: functions).
     Proof using inname_gen_varname_gen_disjoint
           outname_gen_varname_gen_disjoint ok res_Wf
diff --git a/src/Bedrock/Field/Synthesis/New/WordByWordMontgomery.v b/src/Bedrock/Field/Synthesis/New/WordByWordMontgomery.v
index 6d32a17f8c..bd8ba157e2 100644
--- a/src/Bedrock/Field/Synthesis/New/WordByWordMontgomery.v
+++ b/src/Bedrock/Field/Synthesis/New/WordByWordMontgomery.v
@@ -334,6 +334,7 @@ Qed.
     valid_func (res mul_op _) ->
     forall functions,
       Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx)functions ->
+      Cmd.spec_of_sub_borrowx (sub_borrowx:=Defaults.sub_borrowx) functions ->
       spec_of_BinOp bin_mul ((Field.mul, mul_func) :: functions).
   Proof using M_eq check_args_ok mul_func_eq ok.
         (* tight_bounds_tighter_than. *)
@@ -369,6 +370,7 @@ Qed.
     valid_func (res square_op _) ->
     forall functions,
       Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
+      Cmd.spec_of_sub_borrowx (sub_borrowx:=Defaults.sub_borrowx) functions ->
       spec_of_UnOp un_square ((Field.square, square_func) :: functions).
   Proof using M_eq check_args_ok ok square_func_eq.
     intros. cbv [spec_of_UnOp un_square]. rewrite square_func_eq.
@@ -403,6 +405,7 @@ Qed.
     valid_func (res add_op _) ->
     forall functions,
       Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
+      Cmd.spec_of_sub_borrowx (sub_borrowx:=Defaults.sub_borrowx) functions ->
       spec_of_BinOp bin_add ((Field.add, add_func) :: functions).
   Proof using M_eq check_args_ok add_func_eq ok.
     intros. cbv [spec_of_BinOp bin_add]. rewrite add_func_eq.
@@ -437,6 +440,7 @@ Qed.
     valid_func (res sub_op _) ->
     forall functions,
       Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
+      Cmd.spec_of_sub_borrowx (sub_borrowx:=Defaults.sub_borrowx) functions ->
       spec_of_BinOp bin_sub ((Field.sub, sub_func) :: functions).
   Proof using M_eq check_args_ok sub_func_eq ok.
     intros. cbv [spec_of_BinOp bin_sub]. rewrite sub_func_eq.
@@ -470,6 +474,7 @@ Qed.
     valid_func (res opp_op _) ->
     forall functions,
       Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
+      Cmd.spec_of_sub_borrowx (sub_borrowx:=Defaults.sub_borrowx) functions ->
       spec_of_UnOp un_opp ((Field.opp, opp_func) :: functions).
   Proof using M_eq check_args_ok opp_func_eq ok.
     intros. cbv [spec_of_UnOp un_opp]. rewrite opp_func_eq.
@@ -504,6 +509,7 @@ Qed.
     valid_func (res from_bytes_op _) ->
     forall functions,
       Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
+      Cmd.spec_of_sub_borrowx (sub_borrowx:=Defaults.sub_borrowx) functions ->
       (@spec_of_from_bytes _ _ _ _ _ _ _ field_representation_raw) ((Field.from_bytes, from_bytes_func) :: functions).
   Proof using M_eq check_args_ok from_bytes_func_eq ok.
     intros. cbv [spec_of_from_bytes]. rewrite from_bytes_func_eq.
@@ -547,6 +553,7 @@ Qed.
     valid_func (res to_bytes_op _) ->
     forall functions,
       Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
+      Cmd.spec_of_sub_borrowx (sub_borrowx:=Defaults.sub_borrowx) functions ->
       (@spec_of_to_bytes _ _ _ _ _ _ _ field_representation_raw) ((Field.to_bytes, to_bytes_func) :: functions).
   Proof using M_eq check_args_ok ok to_bytes_func_eq.
     intros. cbv [spec_of_to_bytes]. rewrite to_bytes_func_eq.
@@ -627,6 +634,7 @@ Qed.
   valid_func (res from_mont_op _) ->
   forall functions,
       Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
+      Cmd.spec_of_sub_borrowx (sub_borrowx:=Defaults.sub_borrowx) functions ->
     (@spec_of_UnOp _ _ _ _ _ _ _ _ from_mont) un_from_mont ((from_mont, from_mont_func) :: functions).
     Proof using M_eq check_args_ok ok from_mont_func_eq.
     clear field_parameters_ok.
@@ -685,6 +693,7 @@ Qed.
   valid_func (res to_mont_op _) ->
   forall functions,
     Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
+    Cmd.spec_of_sub_borrowx (sub_borrowx:=Defaults.sub_borrowx) functions ->
     (@spec_of_UnOp _ _ _ _ _ _ _ _ to_mont) un_to_mont ((to_mont, to_mont_func) :: functions).
     Proof using M_eq check_args_ok ok to_mont_func_eq.
     intros. cbv [spec_of_UnOp un_to_mont]. rewrite to_mont_func_eq.
@@ -751,6 +760,7 @@ Qed.
   valid_func (res select_znz_op _) ->
   forall functions,
     Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
+    Cmd.spec_of_sub_borrowx (sub_borrowx:=Defaults.sub_borrowx) functions ->
     spec_of_selectznz ((select_znz, select_znz_func) :: functions).
 Proof using M_eq check_args_ok select_znz_func_eq ok.
   intros. cbv [spec_of_selectznz]. rewrite select_znz_func_eq.
diff --git a/src/Bedrock/Field/Translation/Proofs/Cmd.v b/src/Bedrock/Field/Translation/Proofs/Cmd.v
index 429dab4de9..04fccfe2d5 100644
--- a/src/Bedrock/Field/Translation/Proofs/Cmd.v
+++ b/src/Bedrock/Field/Translation/Proofs/Cmd.v
@@ -126,21 +126,78 @@ Section Cmd.
                                              (expr.Ident (ident.Literal (t:=base.type.zrange) rc)))
                                    c))
                       x) y)) f)
+  | valid_sub_get_borrow :
+      forall t r1 r2 (s : Z) x y f,
+        range_good (width:=width) r1 = true ->
+        is_carry_range r2 = true ->
+        s = 2 ^ width ->
+        valid_expr true x ->
+        valid_expr true y ->
+        valid_cmd (f tt) ->
+        valid_cmd
+          (expr.LetIn
+             (B:=type.base t)
+             (expr.App
+                (expr.App (expr.Ident ident.Z_cast2)
+                          (expr.App
+                             (expr.App
+                                (expr.Ident ident.pair)
+                                (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
+                             (expr.Ident (ident.Literal (t:=base.type.zrange) r2))))
+                (expr.App
+                   (expr.App
+                      (expr.App (expr.Ident ident.Z_sub_get_borrow)
+                                (expr.Ident (ident.Literal (t:=base.type.Z) s)))
+                      x) y)) f)
+  | valid_sub_with_get_borrow :
+      forall t rc r1 r2 (s : Z) c x y f,
+        range_good (width:=width) r1 = true ->
+        is_carry_range r2 = true ->
+        is_carry_range rc = true ->
+        s = 2 ^ width ->
+        valid_expr false c ->
+        valid_expr true x ->
+        valid_expr true y ->
+        valid_cmd (f tt) ->
+        valid_cmd
+          (expr.LetIn
+             (B:=type.base t)
+             (expr.App
+                (expr.App (expr.Ident ident.Z_cast2)
+                          (expr.App
+                             (expr.App
+                                (expr.Ident ident.pair)
+                                (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
+                             (expr.Ident (ident.Literal (t:=base.type.zrange) r2))))
+                (expr.App
+                   (expr.App
+                      (expr.App
+                         (expr.App (expr.Ident ident.Z_sub_with_get_borrow)
+                                   (expr.Ident (ident.Literal (t:=base.type.Z) s)))
+                         (expr.App (expr.App (expr.Ident ident.Z_cast)
+                                             (expr.Ident (ident.Literal (t:=base.type.zrange) rc)))
+                                   c))
+                      x) y)) f)
   .
 
   Local Instance spec_of_add_carryx : spec_of add_carryx :=
     fnspec! add_carryx x y carry ~> sum carry_out,
-    { (* The required upper bound on `carry` isn't necessary for the
-         current `add_with_carry` to support the `ensures` clause, but
-         it does formalize an expected condition that future
-         implementations should be free to leverage. *)
-      requires t m := word.unsigned carry < 2;
+    { requires t m := word.unsigned carry < 2;
       ensures T M :=
         M = m /\ T = t /\
         word.unsigned sum + 2^width * word.unsigned carry_out =
         word.unsigned x + word.unsigned carry + word.unsigned y
     }.
 
+  Local Instance spec_of_sub_borrowx : spec_of sub_borrowx :=
+    fnspec! sub_borrowx x y borrow ~> diff borrow_out,
+    { requires t m := word.unsigned borrow < 2;
+      ensures T M :=
+        M = m /\ T = t /\
+        word.unsigned diff - 2^width * word.unsigned borrow_out =
+        word.unsigned x - word.unsigned borrow - word.unsigned y
+    }.
+
   Lemma assign_list_correct :
     forall (rhs : base_rtype base_listZ)
            (xs : base.interp base_listZ)
@@ -448,35 +505,36 @@ Section Cmd.
   Qed.
 
   (* Convenience lemma for add_with_get_carry case. *)
-  Lemma add_get_carry_full_equiv (x y sum carry_out : @word.rep width word) r1 r2:
+  Lemma add_with_get_carry_full_equiv (x y sum carry_in carry_out : @word.rep width word) r1 r2:
     word.unsigned sum + 2^width * word.unsigned carry_out
-    = word.unsigned x + word.unsigned y ->
+    = word.unsigned carry_in + word.unsigned x + word.unsigned y ->
+    0 <= word.unsigned carry_in < 2 ->
     range_good (width:=width) r1 = true -> is_carry_range r2 = true ->
     PreExtra.ident.cast2
       (r1, r2)
-      (Definitions.Z.add_get_carry_full
-         (2 ^ width) (word.unsigned x) (word.unsigned y))
+      (Definitions.Z.add_with_get_carry_full
+         (2 ^ width) (word.unsigned carry_in) (word.unsigned x) (word.unsigned y))
     = (word.unsigned sum, word.unsigned carry_out).
   Proof.
     pose proof word.width_pos. intro Heq. intros.
     pose proof (Properties.word.unsigned_range x).
     pose proof (Properties.word.unsigned_range y).
+    pose proof (Properties.word.unsigned_range carry_in).
     pose proof (Properties.word.unsigned_range sum).
     pose proof (Properties.word.unsigned_range carry_out).
     repeat lazymatch goal with
            | H : range_good _ = true |- _ => apply range_good_eq in H; subst
            | H : is_carry_range _ = true |- _ => apply is_carry_range_eq in H; subst
            end.
-    cbv [Definitions.Z.add_get_carry_full
+    cbv [Definitions.Z.add_with_get_carry_full
            Definitions.Z.add_with_get_carry
            Definitions.Z.add_with_carry
-           Definitions.Z.add_get_carry
            Definitions.Z.get_carry
            PreExtra.ident.cast2
            Rewriter.Util.LetIn.Let_In
         ].
     cbn [fst snd]. rewrite Z.log2_pow2, Z.eqb_refl by lia.
-    cbn [fst snd]. rewrite Z.add_0_l.
+    cbn [fst snd].
     rewrite !CastLemmas.ident.cast_in_bounds by (apply is_bounded_by_bool_max_range; Z.div_mod_to_equations; nia).
     rewrite CastLemmas.ident.cast_in_bounds.
     2:{
@@ -491,37 +549,36 @@ Section Cmd.
     { Z.div_mod_to_equations; nia. }
   Qed.
 
-  (* Convenience lemma for add_with_get_carry case. *)
-  Lemma add_with_get_carry_full_equiv (x y sum carry_in carry_out : @word.rep width word) r1 r2:
+  (* Convenience lemma for add_get_carry case. *)
+  Lemma add_get_carry_full_equiv (x y sum carry_out : @word.rep width word) r1 r2:
     word.unsigned sum + 2^width * word.unsigned carry_out
-    = word.unsigned carry_in + word.unsigned x + word.unsigned y ->
-    0 <= word.unsigned carry_in < 2 ->
+    = word.unsigned x + word.unsigned y ->
     range_good (width:=width) r1 = true -> is_carry_range r2 = true ->
     PreExtra.ident.cast2
       (r1, r2)
-      (Definitions.Z.add_with_get_carry_full
-         (2 ^ width) (word.unsigned carry_in) (word.unsigned x) (word.unsigned y))
+      (Definitions.Z.add_get_carry_full
+         (2 ^ width) (word.unsigned x) (word.unsigned y))
     = (word.unsigned sum, word.unsigned carry_out).
   Proof.
     pose proof word.width_pos. intro Heq. intros.
     pose proof (Properties.word.unsigned_range x).
     pose proof (Properties.word.unsigned_range y).
-    pose proof (Properties.word.unsigned_range carry_in).
     pose proof (Properties.word.unsigned_range sum).
     pose proof (Properties.word.unsigned_range carry_out).
     repeat lazymatch goal with
            | H : range_good _ = true |- _ => apply range_good_eq in H; subst
            | H : is_carry_range _ = true |- _ => apply is_carry_range_eq in H; subst
            end.
-    cbv [Definitions.Z.add_with_get_carry_full
+    cbv [Definitions.Z.add_get_carry_full
            Definitions.Z.add_with_get_carry
            Definitions.Z.add_with_carry
+           Definitions.Z.add_get_carry
            Definitions.Z.get_carry
            PreExtra.ident.cast2
            Rewriter.Util.LetIn.Let_In
         ].
     cbn [fst snd]. rewrite Z.log2_pow2, Z.eqb_refl by lia.
-    cbn [fst snd].
+    cbn [fst snd]. rewrite Z.add_0_l.
     rewrite !CastLemmas.ident.cast_in_bounds by (apply is_bounded_by_bool_max_range; Z.div_mod_to_equations; nia).
     rewrite CastLemmas.ident.cast_in_bounds.
     2:{
@@ -536,6 +593,101 @@ Section Cmd.
     { Z.div_mod_to_equations; nia. }
   Qed.
 
+  (* Convenience lemma for sub_with_get_borrow case. *)
+  Lemma sub_with_get_borrow_full_equiv (x y diff borrow_in borrow_out : @word.rep width word) r1 r2:
+    word.unsigned diff - 2^width * word.unsigned borrow_out
+    = word.unsigned x - word.unsigned borrow_in - word.unsigned y ->
+    0 <= word.unsigned borrow_in < 2 ->
+    range_good (width:=width) r1 = true -> is_carry_range r2 = true ->
+    PreExtra.ident.cast2
+      (r1, r2)
+      (Definitions.Z.sub_with_get_borrow_full
+         (2 ^ width) (word.unsigned borrow_in) (word.unsigned x) (word.unsigned y))
+    = (word.unsigned diff, word.unsigned borrow_out).
+  Proof.
+    pose proof word.width_pos. intro Heq. intros.
+    pose proof (Properties.word.unsigned_range x).
+    pose proof (Properties.word.unsigned_range y).
+    pose proof (Properties.word.unsigned_range borrow_in).
+    pose proof (Properties.word.unsigned_range diff).
+    pose proof (Properties.word.unsigned_range borrow_out).
+    repeat lazymatch goal with
+           | H : range_good _ = true |- _ => apply range_good_eq in H; subst
+           | H : is_carry_range _ = true |- _ => apply is_carry_range_eq in H; subst
+           end.
+    cbv [Definitions.Z.sub_with_get_borrow_full
+           Definitions.Z.sub_with_get_borrow
+           Definitions.Z.sub_with_borrow
+           Definitions.Z.get_carry
+           Definitions.Z.get_borrow
+           Definitions.Z.add_with_carry
+           PreExtra.ident.cast2
+           Rewriter.Util.LetIn.Let_In
+        ].
+    cbn [fst snd]. rewrite Z.log2_pow2, Z.eqb_refl by lia.
+    cbn [fst snd].
+    rewrite !CastLemmas.ident.cast_in_bounds by (apply is_bounded_by_bool_max_range; Z.div_mod_to_equations; nia).
+    rewrite CastLemmas.ident.cast_in_bounds.
+    2:{
+      cbv [ZRange.is_bounded_by_bool].
+      rewrite !Zle_imp_le_bool
+              by (cbn [ZRange.upper ZRange.lower];
+                  Z.div_mod_to_equations; nia).
+      reflexivity. }
+    lazymatch goal with
+    | |- (?d1, ?b1) = (?d2, ?b2) =>
+      assert (b1 = b2) by (Z.div_mod_to_equations; nia);
+        apply f_equal2; [ Z.div_mod_to_equations; nia | lia ]
+    end.
+  Qed.
+
+  (* Convenience lemma for add_with_get_carry case. *)
+  Lemma sub_get_borrow_full_equiv (x y diff borrow_out : @word.rep width word) r1 r2:
+    word.unsigned diff - 2^width * word.unsigned borrow_out
+    = word.unsigned x - word.unsigned y ->
+    range_good (width:=width) r1 = true -> is_carry_range r2 = true ->
+    PreExtra.ident.cast2
+      (r1, r2)
+      (Definitions.Z.sub_get_borrow_full
+         (2 ^ width) (word.unsigned x) (word.unsigned y))
+    = (word.unsigned diff, word.unsigned borrow_out).
+  Proof.
+    pose proof word.width_pos. intro Heq. intros.
+    pose proof (Properties.word.unsigned_range x).
+    pose proof (Properties.word.unsigned_range y).
+    pose proof (Properties.word.unsigned_range diff).
+    pose proof (Properties.word.unsigned_range borrow_out).
+    repeat lazymatch goal with
+           | H : range_good _ = true |- _ => apply range_good_eq in H; subst
+           | H : is_carry_range _ = true |- _ => apply is_carry_range_eq in H; subst
+           end.
+    cbv [Definitions.Z.sub_get_borrow_full
+           Definitions.Z.sub_with_get_borrow
+           Definitions.Z.sub_with_borrow
+           Definitions.Z.add_with_carry
+           Definitions.Z.sub_get_borrow
+           Definitions.Z.get_carry
+           Definitions.Z.get_borrow
+           PreExtra.ident.cast2
+           Rewriter.Util.LetIn.Let_In
+        ].
+    cbn [fst snd]. rewrite Z.log2_pow2, Z.eqb_refl by lia.
+    cbn [fst snd]. rewrite Z.add_0_l.
+    rewrite !CastLemmas.ident.cast_in_bounds by (apply is_bounded_by_bool_max_range; Z.div_mod_to_equations; nia).
+    rewrite CastLemmas.ident.cast_in_bounds.
+    2:{
+      cbv [ZRange.is_bounded_by_bool].
+      rewrite !Zle_imp_le_bool
+              by (cbn [ZRange.upper ZRange.lower];
+                  Z.div_mod_to_equations; nia).
+      reflexivity. }
+    lazymatch goal with
+    | |- (?d1, ?b1) = (?d2, ?b2) =>
+      assert (b1 = b2) by (Z.div_mod_to_equations; nia);
+        apply f_equal2; [ Z.div_mod_to_equations; nia | lia ]
+    end.
+  Qed.
+
   (* TODO: move to equivalence *)
   Lemma locally_equiv_pair l w1 w2 n1 n2 z1 z2 :
     n1 <> n2 ->
@@ -823,6 +975,100 @@ Section Cmd.
     rewrite !Z.eqb_refl. reflexivity.
   Qed.
 
+  Lemma translate_sub_get_borrow (x y : API.expr type_Z) r1 r2 :
+    range_good (width:=width) r1 = true ->
+    is_carry_range r2 = true ->
+    translate_if_special_function
+      (expr.App
+         (expr.App (expr.Ident ident.Z_cast2)
+                   (expr.App
+                      (expr.App
+                         (expr.Ident ident.pair)
+                         (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
+                      (expr.Ident (ident.Literal (t:=base.type.zrange) r2))))
+         (expr.App
+            (expr.App
+               (expr.App (expr.Ident ident.Z_sub_get_borrow)
+                         (expr.Ident (ident.Literal (t:=base.type.Z) (2 ^ width))))
+               x) y))
+    = Some (fun nextn =>
+              let diff := varname_gen nextn in
+              let borrow := varname_gen (S nextn) in
+              (2%nat, (diff,borrow), Syntax.cmd.call [diff;borrow] sub_borrowx [(translate_expr true x); (translate_expr true y); Syntax.expr.literal 0])).
+  Proof.
+    cbv [translate_if_special_function]; intros.
+    cbn [invert_expr.invert_App_cast].
+    rewrite invert_App_Z_cast2_eq_Some.
+    cbn [Crypto.Util.Option.bind fst snd].
+    cbv [translate_if_special3]. rewrite invert_AppIdent3_eq_Some.
+    cbn [Crypto.Util.Option.bind fst snd].
+    cbv [translate_ident_special3].
+    cbn [type.domain]. rewrite invert_Literal_eq_Some.
+    cbn [Crypto.Util.Option.bind fst snd].
+    repeat lazymatch goal with
+           | H : ?x = true |- context [?x] => rewrite H
+           end.
+    cbn [andb].
+    rewrite Z.eqb_refl. reflexivity.
+  Qed.
+
+  Lemma translate_sub_with_get_borrow (b x y : API.expr type_Z) rb r1 r2 :
+    range_good (width:=width) r1 = true ->
+    is_carry_range r2 = true ->
+    is_carry_range rb = true ->
+    translate_if_special_function
+      (expr.App
+         (expr.App (expr.Ident ident.Z_cast2)
+                   (expr.App
+                      (expr.App
+                         (expr.Ident ident.pair)
+                         (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
+                      (expr.Ident (ident.Literal (t:=base.type.zrange) r2))))
+         (expr.App
+            (expr.App
+               (expr.App
+                  (expr.App (expr.Ident ident.Z_sub_with_get_borrow)
+                            (expr.Ident (ident.Literal (t:=base.type.Z) (2 ^ width))))
+                  (expr.App (expr.App (expr.Ident ident.Z_cast)
+                                      (expr.Ident (ident.Literal (t:=base.type.zrange) rb)))
+                            b))
+                  x) y))
+    = Some (fun nextn =>
+              let diff := varname_gen nextn in
+              let borrow := varname_gen (S nextn) in
+              (2%nat, (diff,borrow), Syntax.cmd.call [diff;borrow] sub_borrowx
+                                                   [translate_expr true x
+                                                    ; translate_expr true y
+                                                    ; Syntax.expr.op
+                                                        Syntax.bopname.and
+                                                        (translate_expr false b)
+                                                        (Syntax.expr.literal 1)])).
+  Proof.
+    cbv [translate_if_special_function]; intros.
+    cbn [invert_expr.invert_App_cast].
+    rewrite invert_App_Z_cast2_eq_Some.
+    cbn [Crypto.Util.Option.bind fst snd].
+    lazymatch goal with
+    | |- context [translate_if_special3 ?x ?r] =>
+      lazymatch type of x with
+      | API.expr ?t =>
+        change (translate_if_special3 x r) with (@None (nat -> nat * ltype t * Syntax.cmd.cmd))
+      end
+    end.
+    cbn iota. cbv [translate_if_special4].
+    rewrite invert_AppIdent4_eq_Some.
+    cbn [Crypto.Util.Option.bind fst snd].
+    cbv [translate_ident_special4].
+    rewrite invert_App_Z_cast_eq_Some.
+    cbn [Crypto.Util.Option.bind fst snd].
+    cbn [type.domain]. rewrite invert_Literal_eq_Some.
+    cbn [Crypto.Util.Option.bind fst snd].
+    repeat lazymatch goal with
+           | H : ?x = true |- context [?x] => rewrite H; cbn [andb]
+           end.
+    rewrite !Z.eqb_refl. reflexivity.
+  Qed.
+
   Local Ltac simplify :=
     repeat
       first [ progress (intros; cleanup)
@@ -904,6 +1150,7 @@ Section Cmd.
            (nextn : nat),
       (* specifications of bedrock2 functions we might call *)
       spec_of_add_carryx functions ->
+      spec_of_sub_borrowx functions ->
       (* ret := fiat-crypto interpretation of e2 *)
       let ret1 : API.interp_type t := API.interp e2 in
       (* out := translation output for e3 *)
@@ -1241,5 +1488,197 @@ Section Cmd.
                rewrite interp_and_carry; apply Z.mod_pos_bound; lia | ].
         rewrite interp_and_carry, interp_cast_carry by auto.
         rewrite word.unsigned_of_Z. reflexivity. } }
+    { (* sub_get_borrow *)
+      (* TODO: the proof here is nearly identical to add_get_carry; some could
+         be factored out into tactics. *)
+      rewrite translate_sub_get_borrow by auto. cbn [fst snd].
+      cbn [WeakestPrecondition.cmd WeakestPrecondition.cmd_body].
+      repeat lazymatch goal with
+             | H : valid_expr _ ?e |- _ =>
+               lazymatch goal with
+               | Hwf : wf3 ?G e ?e2 ?e3 |- _ =>
+                 let Htr := fresh in
+                 pose proof translate_expr_correct e e2 e3 ltac:(eassumption) G _ Hwf ltac:(eassumption) as Htr;
+                   destruct Htr; sepsimpl
+               end;
+                 clear H
+             end.
+      eexists; split; [ | ].
+      { (* Argument expressions. *)
+        repeat lazymatch goal with
+               | |- dexprs _ _ (_ :: _) _ => apply dexprs_cons_iff; split
+               | H : dexpr map.empty ?l ?x _ |- WeakestPrecondition.expr ?m ?l ?x _ =>
+                 apply expr_empty; apply H
+               | _ => reflexivity
+               end. }
+      straightline_call; [ rewrite Properties.word.unsigned_of_Z_0; lia | ].
+      sepsimpl; subst; cleanup.
+      eexists; split; [ reflexivity | ].
+      eapply Proper_cmd; [ eapply Proper_call | repeat intro | ].
+      2:{
+        eapply IHe1_valid; clear IHe1_valid;
+        repeat match goal with
+               | _ => progress (intros; cleanup)
+               | H : forall v1 v2 v3, wf3 _ (?f v1) _ _ |- wf3 _ (?f tt) _ _ => solve [apply (H tt)]
+               | H : ?P |- ?P => exact H
+               end; [ | | ].
+        { (* context varname_set *)
+          new_context_ok.
+          lazymatch goal with
+          | H : rep.varname_set _ _ \/ rep.varname_set _ _ |- _ =>
+            cbn  in H; destruct H as [H | H]; apply varname_gen_unique in H; lia
+          end. }
+        { (* undef on *)
+          repeat lazymatch goal with
+                 | |- map.undef_on (map.put _ _ _) _ => apply put_undef_on
+                 | H : forall n nvars, _ -> map.undef_on ?l (used_varnames n nvars)
+                                  |- map.undef_on ?l (used_varnames _ _) =>
+                   apply H; lia
+                 | |- ~ used_varnames _ _ _ => rewrite used_varnames_iff; intro; simplify
+                 | H : varname_gen _ = varname_gen _ |- _ => apply varname_gen_unique in H; lia
+                 end. }
+        { (* context equivalent *)
+          apply Forall_cons;
+            [ apply locally_equiv_pair; eauto; rewrite varname_gen_unique; lia | ].
+          eapply equivalent_not_in_context_forall; eauto;
+            repeat lazymatch goal with
+                   | |- map.only_differ (map.put _ _ _) _ _ =>
+                     eapply only_differ_trans; [ | solve [apply only_differ_put] ]
+                   | |- map.only_differ ?m _ ?m => solve [apply only_differ_empty]
+                   | |- map.only_differ _ _ (map.put _ _ _) =>
+                     apply only_differ_sym
+                   | |- disjoint (union _ _) _ =>
+                     apply disjoint_union_l_iff; split
+                   | |- disjoint empty_set _ =>
+                     solve [apply disjoint_empty_l]
+                   | |- disjoint (singleton_set _) _ =>
+                     symmetry; apply disjoint_singleton_r_iff
+                   | _ => solve [eauto with lia]
+                   end. } }
+      clear IHe1_valid.
+      simplify; subst; eauto; [ | | ].
+      { (* varnames subset *)
+        rewrite <-used_varnames_shift; eauto. }
+      { (* only_differ *)
+        only_differ_ok.
+        eauto using only_differ_succ, only_differ_zero. }
+      { (* equivalence of output holds *)
+        lazymatch goal with
+        | H : equivalent_base ?x1 ?y ?a ?l ?m |- equivalent_base ?x2 ?y ?a ?l ?m =>
+          replace x2 with x1; [ exact H | ]
+        end.
+        lazymatch goal with
+          | H : context [word.unsigned (word.of_Z 0)] |- _ =>
+            rewrite Properties.word.unsigned_of_Z_0 in H
+        end.
+        repeat lazymatch goal with
+               | H : word.unsigned _ = expr.interp ?iinterp ?x |- context [expr.interp ?iinterp ?x] =>
+                 rewrite <-H
+               end.
+        erewrite sub_get_borrow_full_equiv; eauto with lia. } }
+    { (* sub_with_get_borrow *)
+      (* TODO: the proof here is nearly identical to add_with_get_carry; some could
+         be factored out into tactics. *)
+      rewrite translate_sub_with_get_borrow by auto. cbn [fst snd].
+      cbn [WeakestPrecondition.cmd WeakestPrecondition.cmd_body].
+      repeat lazymatch goal with
+             | H : valid_expr ?require_cast ?e |- _ =>
+               lazymatch goal with
+               | Hwf : wf3 ?G e ?e2 ?e3 |- _ =>
+                 let Htr := fresh in
+                 pose proof translate_expr_correct' e e2 e3 require_cast ltac:(eassumption) G _ Hwf ltac:(eassumption) as Htr; cbn iota in Htr; simplify
+               end;
+                 clear H
+             | H : Lift1Prop.ex1 _ _ |- _ => destruct H
+             | H : emp _ _ |- _ => destruct H; cleanup
+             end.
+      cbn [locally_equivalent_nobounds locally_equivalent_nobounds_base] in *.
+      eexists; split; [ | ].
+      { (* Argument expressions. *)
+        repeat lazymatch goal with
+               | |- dexprs _ _ (_ :: _) _ => apply dexprs_cons_iff; split
+               | H : dexpr map.empty ?l ?x _ |- WeakestPrecondition.expr ?m ?l ?x _ =>
+                 apply expr_empty; apply H
+               | _ => reflexivity
+               end; [ ].
+        (* Carry argument is left over. *)
+        cbn [WeakestPrecondition.expr WeakestPrecondition.expr_body].
+        eapply Proper_expr; [ | solve [apply expr_empty; eauto] ].
+        repeat intro; subst. reflexivity. }
+      straightline_call;
+        [ (* carry is < 2 *)
+          rewrite interp_and_carry; apply Z.mod_pos_bound; lia | ].
+      sepsimpl; subst; cleanup.
+      eexists; split; [ reflexivity | ].
+      eapply Proper_cmd; [ eapply Proper_call | repeat intro | ].
+      2:{
+        eapply IHe1_valid; clear IHe1_valid;
+        repeat match goal with
+               | _ => progress (intros; cleanup)
+               | H : forall v1 v2 v3, wf3 _ (?f v1) _ _ |- wf3 _ (?f ?v1) _ (_ ?v3) =>
+                 solve [eapply (H v1 _ v3)]
+               | H : ?P |- ?P => exact H
+               end; [ | | ].
+        { (* context varname_set *)
+          new_context_ok.
+          lazymatch goal with
+          | H : rep.varname_set _ _ \/ rep.varname_set _ _ |- _ =>
+            cbn  in H; destruct H as [H | H]; apply varname_gen_unique in H; lia
+          end. }
+        { (* undef on *)
+          repeat lazymatch goal with
+                 | |- map.undef_on (map.put _ _ _) _ => apply put_undef_on
+                 | H : forall n nvars, _ -> map.undef_on ?l (used_varnames n nvars)
+                                  |- map.undef_on ?l (used_varnames _ _) =>
+                   apply H; lia
+                 | |- ~ used_varnames _ _ _ => rewrite used_varnames_iff; intro; simplify
+                 | H : varname_gen _ = varname_gen _ |- _ => apply varname_gen_unique in H; lia
+                 end. }
+        { (* context equivalent *)
+          apply Forall_cons;
+            [ apply locally_equiv_pair; eauto; rewrite varname_gen_unique; lia | ].
+          eapply equivalent_not_in_context_forall; eauto;
+            repeat lazymatch goal with
+                   | |- map.only_differ (map.put _ _ _) _ _ =>
+                     eapply only_differ_trans; [ | solve [apply only_differ_put] ]
+                   | |- map.only_differ ?m _ ?m => solve [apply only_differ_empty]
+                   | |- map.only_differ _ _ (map.put _ _ _) =>
+                     apply only_differ_sym
+                   | |- disjoint (union _ _) _ =>
+                     apply disjoint_union_l_iff; split
+                   | |- disjoint empty_set _ =>
+                     solve [apply disjoint_empty_l]
+                   | |- disjoint (singleton_set _) _ =>
+                     symmetry; apply disjoint_singleton_r_iff
+                   | _ => solve [eauto with lia]
+                   end. } }
+      clear IHe1_valid.
+      simplify; subst; eauto; [ | | ].
+      { (* varnames subset *)
+        rewrite <-used_varnames_shift; eauto. }
+      { (* only_differ *)
+        only_differ_ok.
+        eauto using only_differ_succ, only_differ_zero. }
+      { (* equivalence of output holds *)
+        lazymatch goal with
+        | H : equivalent_base ?x1 ?y ?a ?l ?m |- equivalent_base ?x2 ?y ?a ?l ?m =>
+          replace x2 with x1; [ exact H | ]
+        end.
+        repeat lazymatch goal with
+               | H : word.unsigned _ = expr.interp ?iinterp ?x |- context [expr.interp ?iinterp ?x] =>
+                 rewrite <-H
+               end.
+        lazymatch goal with
+        | H : context [word.unsigned
+                         (Semantics.interp_binop Syntax.bopname.and (word.of_Z ?x) (word.of_Z 1))]
+          |- context [Definitions.Z.sub_with_get_borrow_full _ (PreExtra.ident.cast ?r ?c) _ _] =>
+          (* more complex rewrite for the carry *)
+          replace (PreExtra.ident.cast r c)
+            with (word.unsigned (word:=word)
+                                (Semantics.interp_binop Syntax.bopname.and (word.of_Z x) (word.of_Z 1)))
+        end; [ erewrite sub_with_get_borrow_full_equiv; try solve [eauto with lia];
+               rewrite interp_and_carry; apply Z.mod_pos_bound; lia | ].
+        rewrite interp_and_carry, interp_cast_carry by auto.
+        rewrite word.unsigned_of_Z. reflexivity. } }
   Qed.
 End Cmd.
diff --git a/src/Bedrock/Field/Translation/Proofs/Func.v b/src/Bedrock/Field/Translation/Proofs/Func.v
index 45dd52c5e9..93c0884456 100644
--- a/src/Bedrock/Field/Translation/Proofs/Func.v
+++ b/src/Bedrock/Field/Translation/Proofs/Func.v
@@ -91,6 +91,7 @@ Section Func.
              (functions : list (string*func)),
         (* specifications of bedrock2 functions we might call *)
         spec_of_add_carryx (add_carryx:=add_carryx) functions ->
+        spec_of_sub_borrowx (sub_borrowx:=sub_borrowx) functions ->
         (* locals doesn't contain variables we could overwrite *)
         (forall n nvars,
             (nextn <= n)%nat ->
@@ -518,6 +519,7 @@ Section Func.
              (R : _ -> Prop),
         (* specifications of bedrock2 functions we might call *)
         spec_of_add_carryx (add_carryx:=add_carryx) functions ->
+        spec_of_sub_borrowx (sub_borrowx:=sub_borrowx) functions ->
         (* argument values are the concatenation of true argument values
            and output pointer values *)
         argvalues = out_ptrs ++ flat_args ->
diff --git a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v
index 3548409b18..029d04148f 100644
--- a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v
+++ b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v
@@ -75,6 +75,12 @@ Section Cmd.
     | _ => false
     end.
 
+  Definition is_sub_get_borrow_ident {t} (i : ident.ident t) : bool :=
+    match i with
+    | ident.Z_sub_get_borrow => true
+    | _ => false
+    end.
+
   Definition is_word_and_carry_range {t} : range_for_type t -> bool :=
     match t as t0 return range_for_type t0 -> bool with
     | type_ZZ => fun r : range_for_type type_ZZ =>
@@ -88,6 +94,12 @@ Section Cmd.
     | _ => false
     end.
 
+  Definition is_sub_with_get_borrow_ident {t} (i : ident.ident t) : bool :=
+    match i with
+    | ident.Z_sub_with_get_borrow => true
+    | _ => false
+    end.
+
   Definition valid_ident_special3 {a b c d} (i : ident (a -> b -> c -> d))
     : @API.expr (fun _ => unit) a
       -> @API.expr (fun _ => unit) b
@@ -100,7 +112,13 @@ Section Cmd.
             && valid_expr_bool true x
             && valid_expr_bool true y
             && is_word_and_carry_range r)
-    else (fun _ _ _ _ => false).
+    else if is_sub_get_borrow_ident i
+         then (fun s x y r =>
+                 is_literalz s (2 ^ width)
+                 && valid_expr_bool true x
+                 && valid_expr_bool true y
+                 && is_word_and_carry_range r)
+         else (fun _ _ _ _ => false).
 
   Definition valid_carry_bool {t} : @API.expr (fun _ => unit) t -> bool :=
     match t with
@@ -130,7 +148,14 @@ Section Cmd.
             && valid_expr_bool true y
             && valid_carry_bool c
             && is_word_and_carry_range r)
-    else (fun _ _ _ _ _ => false).
+    else if is_sub_with_get_borrow_ident i
+         then (fun s c x y r =>
+                 is_literalz s (2 ^ width)
+                 && valid_expr_bool true x
+                 && valid_expr_bool true y
+                 && valid_carry_bool c
+                 && is_word_and_carry_range r)
+         else (fun _ _ _ _ _ => false).
 
   Definition valid_special3_bool {t} (e : @API.expr (fun _ => unit) t) (r : range_for_type t) : bool :=
     match invert_AppIdent3 e with
@@ -209,6 +234,28 @@ Section Cmd.
     cbv [is_add_with_get_carry_ident]; break_match; congruence.
   Qed.
 
+  Lemma is_sub_get_borrow_ident_eq {t} i :
+    @is_sub_get_borrow_ident t i = true ->
+    (match t as t0 return ident.ident t0 -> Prop with
+     | type.arrow type_Z (type.arrow type_Z (type.arrow type_Z type_ZZ)) =>
+       fun i => i = ident.Z_sub_get_borrow
+     | _ => fun _ => False
+     end) i.
+  Proof.
+    cbv [is_sub_get_borrow_ident]; break_match; congruence.
+  Qed.
+
+  Lemma is_sub_with_get_borrow_ident_eq {t} i :
+    @is_sub_with_get_borrow_ident t i = true ->
+    (match t as t0 return ident.ident t0 -> Prop with
+     | type.arrow type_Z (type.arrow type_Z (type.arrow type_Z (type.arrow type_Z type_ZZ))) =>
+       fun i => i = ident.Z_sub_with_get_borrow
+     | _ => fun _ => False
+     end) i.
+  Proof.
+    cbv [is_sub_with_get_borrow_ident]; break_match; congruence.
+  Qed.
+
   Lemma valid_carry_bool_eq {t} e :
     valid_carry_bool e = true ->
     (match t as t0 return API.expr t0 -> Prop with
@@ -272,25 +319,32 @@ Section Cmd.
       end.
       subst; cbn [fst snd projT2] in *.
       cbv [valid_ident_special3] in *.
-      break_match_hyps; intros; [ | congruence ].
-      repeat lazymatch goal with
-             | p : _ * _ |- _ => destruct p; cbn [fst snd] in *
-             | H : (_ && _) = true |- _ => apply Bool.andb_true_iff in H; destruct H
-             | H : @is_word_and_carry_range type_ZZ _ = true |- _ =>
-               apply is_word_and_carry_range_eq in H; destruct H
-             | H : is_add_get_carry_ident _ = true |- _ =>
-               apply is_add_get_carry_ident_eq in H;
-                 break_match_hyps; try contradiction; [ ];
-                   subst
-             | H : is_literalz _ _ = true |- _ =>
-               apply is_literalz_eq in H; subst
-             | H : invert_expr.invert_App_Z_cast2 _ = Some _ |- _ =>
-               apply invert_App_Z_cast2_Some in H; subst
-             | _ => progress cbn [type.interp Language.Compilers.base.interp
-                                             invert_expr.invert_App_cast] in *
-             end; [ ].
+      break_match_hyps; intros; try congruence;
+        repeat lazymatch goal with
+               | p : _ * _ |- _ => destruct p; cbn [fst snd] in *
+               | H : (_ && _) = true |- _ => apply Bool.andb_true_iff in H; destruct H
+               | H : @is_word_and_carry_range type_ZZ _ = true |- _ =>
+                 apply is_word_and_carry_range_eq in H; destruct H
+               | H : is_add_get_carry_ident _ = true |- _ =>
+                 apply is_add_get_carry_ident_eq in H;
+                   break_match_hyps; try contradiction; [ ];
+                     subst
+               | H : is_sub_get_borrow_ident _ = true |- _ =>
+                 apply is_sub_get_borrow_ident_eq in H;
+                   break_match_hyps; try contradiction; [ ];
+                     subst
+               | H : is_literalz _ _ = true |- _ =>
+                 apply is_literalz_eq in H; subst
+               | H : invert_expr.invert_App_Z_cast2 _ = Some _ |- _ =>
+                 apply invert_App_Z_cast2_Some in H; subst
+               | _ => progress cbn [type.interp Language.Compilers.base.interp
+                                               invert_expr.invert_App_cast] in *
+               end; [ | ].
       { (* add_get_carry *)
         eapply valid_add_get_carry; eauto;
+          apply valid_expr_bool_iff; auto. }
+      { (* sub_get_borrow *)
+        eapply valid_sub_get_borrow; eauto;
           apply valid_expr_bool_iff; auto. } }
     { (* valid 4-argument function *)
       cbv [valid_special4_bool] in *.
@@ -301,27 +355,34 @@ Section Cmd.
       end.
       subst; cbn [fst snd projT2] in *.
       cbv [valid_ident_special4] in *.
-      break_match_hyps; intros; [ | congruence ].
-      repeat lazymatch goal with
-             | p : _ * _ |- _ => destruct p; cbn [fst snd] in *
-             | H : (_ && _) = true |- _ => apply Bool.andb_true_iff in H; destruct H
-             | H : @is_word_and_carry_range type_ZZ _ = true |- _ =>
-               apply is_word_and_carry_range_eq in H; destruct H
-             | H : is_add_with_get_carry_ident _ = true |- _ =>
-               apply is_add_with_get_carry_ident_eq in H;
-                 break_match_hyps; try contradiction; [ ];
-                   subst
-             | H : is_literalz _ _ = true |- _ =>
-               apply is_literalz_eq in H; subst
-             | H : invert_expr.invert_App_Z_cast2 _ = Some _ |- _ =>
-               apply invert_App_Z_cast2_Some in H; subst
-             | H : valid_carry_bool _ = true |- _ =>
-               apply valid_carry_bool_eq in H; destruct H as [? [? [? [? ?] ] ] ]
-             | _ => progress cbn [type.interp Language.Compilers.base.interp
-                                             invert_expr.invert_App_cast] in *
-             end; [ ].
+      break_match_hyps; intros; try congruence;
+        repeat lazymatch goal with
+               | p : _ * _ |- _ => destruct p; cbn [fst snd] in *
+               | H : (_ && _) = true |- _ => apply Bool.andb_true_iff in H; destruct H
+               | H : @is_word_and_carry_range type_ZZ _ = true |- _ =>
+                 apply is_word_and_carry_range_eq in H; destruct H
+               | H : is_add_with_get_carry_ident _ = true |- _ =>
+                 apply is_add_with_get_carry_ident_eq in H;
+                   break_match_hyps; try contradiction; [ ];
+                     subst
+               | H : is_sub_with_get_borrow_ident _ = true |- _ =>
+                 apply is_sub_with_get_borrow_ident_eq in H;
+                   break_match_hyps; try contradiction; [ ];
+                     subst
+               | H : is_literalz _ _ = true |- _ =>
+                 apply is_literalz_eq in H; subst
+               | H : invert_expr.invert_App_Z_cast2 _ = Some _ |- _ =>
+                 apply invert_App_Z_cast2_Some in H; subst
+               | H : valid_carry_bool _ = true |- _ =>
+                 apply valid_carry_bool_eq in H; destruct H as [? [? [? [? ?] ] ] ]
+               | _ => progress cbn [type.interp Language.Compilers.base.interp
+                                               invert_expr.invert_App_cast] in *
+               end; [ | ].
       { (* add_with_get_carry *)
         eapply valid_add_with_get_carry; eauto;
+          apply valid_expr_bool_iff; auto. }
+      { (* sub_with_get_borrow *)
+        eapply valid_sub_with_get_borrow; eauto;
           apply valid_expr_bool_iff; auto. } }
   Qed.
 
@@ -487,6 +548,65 @@ Section Cmd.
     reflexivity.
   Qed.
 
+  Lemma valid_special_sub_get_borrow r1 r2 x y:
+    Expr.range_good (width:=width) r1 = true ->
+    is_carry_range r2 = true ->
+    valid_expr_bool (t:=type_Z) true x = true ->
+    valid_expr_bool (t:=type_Z) true y = true ->
+    valid_special_bool
+      (expr.App
+         (expr.App (expr.Ident ident.Z_cast2)
+                   (expr.App
+                      (expr.App
+                         (expr.Ident ident.pair)
+                         (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
+                      (expr.Ident (ident.Literal (t:=base.type.zrange) r2))))
+         (expr.App
+            (expr.App
+               (expr.App (expr.Ident ident.Z_sub_get_borrow)
+                         (expr.Ident (ident.Literal (t:=base.type.Z) (2 ^ width))))
+               x) y)) = true.
+  Proof.
+    intros. cbv [valid_special_bool]. cbn [invert_expr.invert_App_cast].
+    rewrite invert_App_Z_cast2_eq_Some. cbn [fst snd].
+    cbn. rewrite Z.eqb_refl.
+    repeat lazymatch goal with
+           | H : _?x = true |- context [?x] => rewrite H end.
+    reflexivity.
+  Qed.
+
+  Lemma valid_special_sub_with_get_borrow r1 r2 rc c x y:
+    Expr.range_good (width:=width) r1 = true ->
+    is_carry_range r2 = true ->
+    is_carry_range rc = true ->
+    valid_expr_bool (t:=type_Z) false c = true ->
+    valid_expr_bool (t:=type_Z) true x = true ->
+    valid_expr_bool (t:=type_Z) true y = true ->
+    valid_special_bool
+      (expr.App
+         (expr.App (expr.Ident ident.Z_cast2)
+                   (expr.App
+                      (expr.App
+                         (expr.Ident ident.pair)
+                         (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
+                      (expr.Ident (ident.Literal (t:=base.type.zrange) r2))))
+         (expr.App
+            (expr.App
+               (expr.App
+                  (expr.App (expr.Ident ident.Z_sub_with_get_borrow)
+                            (expr.Ident (ident.Literal (t:=base.type.Z) (2 ^ width))))
+                  (expr.App (expr.App (expr.Ident ident.Z_cast)
+                                      (expr.Ident (ident.Literal (t:=base.type.zrange) rc))) c))
+               x) y)) = true.
+  Proof.
+    intros. cbv [valid_special_bool]. cbn [invert_expr.invert_App_cast].
+    rewrite invert_App_Z_cast2_eq_Some. cbn [fst snd].
+    cbn. rewrite Z.eqb_refl.
+    repeat lazymatch goal with
+           | H : _?x = true |- context [?x] => rewrite H end.
+    reflexivity.
+  Qed.
+
   Lemma valid_cmd_bool_impl2 {t} e :
     valid_cmd e -> @valid_cmd_bool t e = true.
   Proof.
@@ -500,7 +620,7 @@ Section Cmd.
              | |- context [_ && false] => rewrite Bool.andb_false_r
              | |- context [false || _] => rewrite Bool.orb_false_l
              end;
-      auto using valid_special_add_get_carry, valid_special_add_with_get_carry; [ ].
+      auto using valid_special_add_get_carry, valid_special_add_with_get_carry, valid_special_sub_get_borrow, valid_special_sub_with_get_borrow; [ ].
     { apply valid_cmd_bool_valid_expr.
       assumption. }
   Qed.

From b24b7304449259ff4e14894ae504dffab46d7c42 Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Fri, 25 Aug 2023 15:55:54 +0200
Subject: [PATCH 30/34] p224 add compiles

---
 .../Field/Synthesis/Examples/p224_64_new.v    |   2 +
 src/Bedrock/Field/Translation/Cmd.v           |  77 ++++---
 src/Bedrock/Field/Translation/Proofs/Cmd.v    | 202 +++++++++++-------
 .../Translation/Proofs/ValidComputable/Cmd.v  | 105 ++++++---
 4 files changed, 251 insertions(+), 135 deletions(-)

diff --git a/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v b/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
index 00d2556e18..21ec371570 100644
--- a/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
+++ b/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
@@ -143,6 +143,7 @@ Section Field.
                         (p224_add :: functions))
          As p224_add_correct.
   Proof.
+   Time derive_bedrock2_func add_op.
     begin_derive_bedrock2_func.
     4:{
       eapply Func.valid_func_bool_iff.
@@ -209,6 +210,7 @@ Section Field.
         cbn [fst snd]. rewrite !ZRange.zrange_lb by reflexivity.
         cbn [andb].
         cbv [Cmd.valid_carry_bool].
+        Locate valid_carry_bool.
         (* problem is that valid_carry_bool only matches cast, while it should also accept a 0/1 literal *)
       }
         
diff --git a/src/Bedrock/Field/Translation/Cmd.v b/src/Bedrock/Field/Translation/Cmd.v
index 3b380b24fe..daa7ee92b3 100644
--- a/src/Bedrock/Field/Translation/Cmd.v
+++ b/src/Bedrock/Field/Translation/Cmd.v
@@ -133,8 +133,8 @@ Section Cmd.
     (type.interp (Language.Compilers.base.interp (fun _ => ZRange.zrange)) t).
 
   (* Translate 3-argument special functions. *)
-  Definition translate_ident_special3 {var a b c d} (i : ident (a -> b -> c -> d))
-    : API.expr (var:=var) a -> API.expr b -> API.expr c
+  Definition translate_ident_special3 {a b c d} (i : ident (a -> b -> c -> d))
+    : API.expr (var:=ltype) a -> API.expr b -> API.expr c
       -> range_for_type d -> option (nat -> nat * ltype d * Syntax.cmd.cmd)
     := match i in ident t return
              API.expr (type.domain t) ->
@@ -180,9 +180,30 @@ Section Cmd.
        | _ => fun _ _ _ _ => None
        end.
 
+  (* Get the value of a carry argument, which may be either an expression casted
+     to the range [0,1] or a literal 0 or 1. *)
+  Definition translate_carry (c : @API.expr ltype type_Z) : rtype type_Z :=
+      match invert_expr.invert_App_Z_cast c with
+      | Some (r, c) =>
+        if is_carry_range r
+        then
+          let c := translate_expr (t:=type_Z) false c in
+          (* need to add an and with 1 to preserve the cast *)
+          Syntax.expr.op Syntax.bopname.and c (Syntax.expr.literal 1)
+        else make_error _
+      | None =>
+        match invert_expr.invert_Literal (invertIdent:=Compilers.invertIdent) c with
+        | Some v =>
+          if ((0 <=? v) && (v <? 2))%bool
+          then Syntax.expr.literal v
+          else make_error _
+        | None => make_error _
+        end
+      end.
+
   (* Translate 4-argument special functions. *)
-  Definition translate_ident_special4 {var a b c d e} (i : ident (a -> b -> c -> d -> e))
-    : API.expr (var:=var) a -> API.expr b -> API.expr c -> API.expr d
+  Definition translate_ident_special4 {a b c d e} (i : ident (a -> b -> c -> d -> e))
+    : API.expr (var:=ltype) a -> API.expr b -> API.expr c -> API.expr d
       -> range_for_type e
       -> option (nat -> nat * ltype e * Syntax.cmd.cmd)
     := match i in ident t return
@@ -198,45 +219,33 @@ Section Cmd.
        | ident.Z_add_with_get_carry =>
          fun s c x y out_range =>
            (s <- invert_expr.invert_Literal s;
-           rc <- invert_expr.invert_App_Z_cast c;
-           if is_carry_range (fst rc)
+           if (range_good (width:=width) (fst out_range) && is_carry_range (snd out_range))%bool
            then
-             if (range_good (width:=width) (fst out_range) && is_carry_range (snd out_range))%bool
+             if s =? 2 ^ width
              then
-               if s =? 2 ^ width
-               then
-                 let c := translate_expr false (snd rc) in
-                 (* For carries we need to preserve the cast, because the proofs don't track bounds. *)
-                 let c := Syntax.expr.op Syntax.bopname.and c (Syntax.expr.literal 1) in
-                 let x := translate_expr true x in
-                 let y := translate_expr true y in
-                 Some (fun nextn =>
-                         let sum := varname_gen nextn in
-                         let carry := varname_gen (S nextn) in
-                         (2%nat, (sum,carry), Syntax.cmd.call [sum;carry] add_carryx [x; y; c]))
-               else None
+               let c := translate_carry c in
+               let x := translate_expr true x in
+               let y := translate_expr true y in
+               Some (fun nextn =>
+                       let sum := varname_gen nextn in
+                       let carry := varname_gen (S nextn) in
+                       (2%nat, (sum,carry), Syntax.cmd.call [sum;carry] add_carryx [x; y; c]))
              else None
            else None)%option
        | ident.Z_sub_with_get_borrow =>
          fun s b x y out_range =>
            (s <- invert_expr.invert_Literal s;
-           rb <- invert_expr.invert_App_Z_cast b;
-           if is_carry_range (fst rb)
+           if (range_good (width:=width) (fst out_range) && is_carry_range (snd out_range))%bool
            then
-             if (range_good (width:=width) (fst out_range) && is_carry_range (snd out_range))%bool
+             if s =? 2 ^ width
              then
-               if s =? 2 ^ width
-               then
-                 let b := translate_expr false (snd rb) in
-                 (* For carries we need to preserve the cast, because the proofs don't track bounds. *)
-                 let b := Syntax.expr.op Syntax.bopname.and b (Syntax.expr.literal 1) in
-                 let x := translate_expr true x in
-                 let y := translate_expr true y in
-                 Some (fun nextn =>
-                         let diff := varname_gen nextn in
-                         let borrow := varname_gen (S nextn) in
-                         (2%nat, (diff, borrow), Syntax.cmd.call [diff;borrow] sub_borrowx [x; y; b]))
-               else None
+               let b := translate_carry b in
+               let x := translate_expr true x in
+               let y := translate_expr true y in
+               Some (fun nextn =>
+                       let diff := varname_gen nextn in
+                       let borrow := varname_gen (S nextn) in
+                       (2%nat, (diff, borrow), Syntax.cmd.call [diff;borrow] sub_borrowx [x; y; b]))
              else None
            else None)%option
        | _ => fun _ _ _ _ _ => None
diff --git a/src/Bedrock/Field/Translation/Proofs/Cmd.v b/src/Bedrock/Field/Translation/Proofs/Cmd.v
index 04fccfe2d5..45f3261c39 100644
--- a/src/Bedrock/Field/Translation/Proofs/Cmd.v
+++ b/src/Bedrock/Field/Translation/Proofs/Cmd.v
@@ -43,6 +43,21 @@ Section Cmd.
   Local Existing Instance Types.rep.Z.
   Local Existing Instance Types.rep.listZ_local.
 
+  (* Carries may be literals or any valid expression cast to the range (0,1). *)
+  Inductive valid_carry : @API.expr (fun _ => unit) type_Z -> Prop :=
+  | valid_carry_Literal :
+      forall v : Z,
+        0 <= v < 2 ->
+        valid_carry (expr.Ident (ident.Literal (t:=base.type.Z) v))
+  | valid_carry_cast :
+      forall rc (c : API.expr type_Z),
+        is_carry_range rc = true ->
+        valid_expr false c ->
+        valid_carry (expr.App (expr.App (expr.Ident ident.Z_cast)
+                                        (expr.Ident (ident.Literal (t:=base.type.zrange) rc)))
+                              c)
+  .
+
   Inductive valid_cmd :
     forall {t}, @API.expr (fun _ => unit) t -> Prop :=
   (* N.B. LetIn is split into cases so that only pairs of type_base and type_base are
@@ -98,12 +113,11 @@ Section Cmd.
                                 (expr.Ident (ident.Literal (t:=base.type.Z) s)))
                       x) y)) f)
   | valid_add_with_get_carry :
-      forall t rc r1 r2 (s : Z) c x y f,
+      forall t r1 r2 (s : Z) c x y f,
         range_good (width:=width) r1 = true ->
         is_carry_range r2 = true ->
-        is_carry_range rc = true ->
         s = 2 ^ width ->
-        valid_expr false c ->
+        valid_carry c ->
         valid_expr true x ->
         valid_expr true y ->
         valid_cmd (f tt) ->
@@ -122,9 +136,7 @@ Section Cmd.
                       (expr.App
                          (expr.App (expr.Ident ident.Z_add_with_get_carry)
                                    (expr.Ident (ident.Literal (t:=base.type.Z) s)))
-                         (expr.App (expr.App (expr.Ident ident.Z_cast)
-                                             (expr.Ident (ident.Literal (t:=base.type.zrange) rc)))
-                                   c))
+                         c)
                       x) y)) f)
   | valid_sub_get_borrow :
       forall t r1 r2 (s : Z) x y f,
@@ -150,12 +162,11 @@ Section Cmd.
                                 (expr.Ident (ident.Literal (t:=base.type.Z) s)))
                       x) y)) f)
   | valid_sub_with_get_borrow :
-      forall t rc r1 r2 (s : Z) c x y f,
+      forall t r1 r2 (s : Z) c x y f,
         range_good (width:=width) r1 = true ->
         is_carry_range r2 = true ->
-        is_carry_range rc = true ->
         s = 2 ^ width ->
-        valid_expr false c ->
+        valid_carry c ->
         valid_expr true x ->
         valid_expr true y ->
         valid_cmd (f tt) ->
@@ -174,9 +185,7 @@ Section Cmd.
                       (expr.App
                          (expr.App (expr.Ident ident.Z_sub_with_get_borrow)
                                    (expr.Ident (ident.Literal (t:=base.type.Z) s)))
-                         (expr.App (expr.App (expr.Ident ident.Z_cast)
-                                             (expr.Ident (ident.Literal (t:=base.type.zrange) rc)))
-                                   c))
+                         c)
                       x) y)) f)
   .
 
@@ -918,10 +927,9 @@ Section Cmd.
     rewrite Z.eqb_refl. reflexivity.
   Qed.
 
-  Lemma translate_add_with_get_carry (c x y : API.expr type_Z) rc r1 r2 :
+  Lemma translate_add_with_get_carry (c x y : API.expr type_Z) r1 r2 :
     range_good (width:=width) r1 = true ->
     is_carry_range r2 = true ->
-    is_carry_range rc = true ->
     translate_if_special_function
       (expr.App
          (expr.App (expr.Ident ident.Z_cast2)
@@ -935,20 +943,15 @@ Section Cmd.
                (expr.App
                   (expr.App (expr.Ident ident.Z_add_with_get_carry)
                             (expr.Ident (ident.Literal (t:=base.type.Z) (2 ^ width))))
-                  (expr.App (expr.App (expr.Ident ident.Z_cast)
-                                      (expr.Ident (ident.Literal (t:=base.type.zrange) rc)))
-                            c))
-                  x) y))
+                  c)
+               x) y))
     = Some (fun nextn =>
               let sum := varname_gen nextn in
               let carry := varname_gen (S nextn) in
               (2%nat, (sum,carry), Syntax.cmd.call [sum;carry] add_carryx
                                               [translate_expr true x
                                                ; translate_expr true y
-                                               ; Syntax.expr.op
-                                                   Syntax.bopname.and
-                                                   (translate_expr false c)
-                                                   (Syntax.expr.literal 1)])).
+                                               ; translate_carry c])).
   Proof.
     cbv [translate_if_special_function]; intros.
     cbn [invert_expr.invert_App_cast].
@@ -965,7 +968,6 @@ Section Cmd.
     rewrite invert_AppIdent4_eq_Some.
     cbn [Crypto.Util.Option.bind fst snd].
     cbv [translate_ident_special4].
-    rewrite invert_App_Z_cast_eq_Some.
     cbn [Crypto.Util.Option.bind fst snd].
     cbn [type.domain]. rewrite invert_Literal_eq_Some.
     cbn [Crypto.Util.Option.bind fst snd].
@@ -1012,10 +1014,9 @@ Section Cmd.
     rewrite Z.eqb_refl. reflexivity.
   Qed.
 
-  Lemma translate_sub_with_get_borrow (b x y : API.expr type_Z) rb r1 r2 :
+  Lemma translate_sub_with_get_borrow (b x y : API.expr type_Z) r1 r2 :
     range_good (width:=width) r1 = true ->
     is_carry_range r2 = true ->
-    is_carry_range rb = true ->
     translate_if_special_function
       (expr.App
          (expr.App (expr.Ident ident.Z_cast2)
@@ -1029,20 +1030,15 @@ Section Cmd.
                (expr.App
                   (expr.App (expr.Ident ident.Z_sub_with_get_borrow)
                             (expr.Ident (ident.Literal (t:=base.type.Z) (2 ^ width))))
-                  (expr.App (expr.App (expr.Ident ident.Z_cast)
-                                      (expr.Ident (ident.Literal (t:=base.type.zrange) rb)))
-                            b))
-                  x) y))
+                  b)
+               x) y))
     = Some (fun nextn =>
               let diff := varname_gen nextn in
               let borrow := varname_gen (S nextn) in
               (2%nat, (diff,borrow), Syntax.cmd.call [diff;borrow] sub_borrowx
                                                    [translate_expr true x
                                                     ; translate_expr true y
-                                                    ; Syntax.expr.op
-                                                        Syntax.bopname.and
-                                                        (translate_expr false b)
-                                                        (Syntax.expr.literal 1)])).
+                                                    ; translate_carry b])).
   Proof.
     cbv [translate_if_special_function]; intros.
     cbn [invert_expr.invert_App_cast].
@@ -1059,7 +1055,6 @@ Section Cmd.
     rewrite invert_AppIdent4_eq_Some.
     cbn [Crypto.Util.Option.bind fst snd].
     cbv [translate_ident_special4].
-    rewrite invert_App_Z_cast_eq_Some.
     cbn [Crypto.Util.Option.bind fst snd].
     cbn [type.domain]. rewrite invert_Literal_eq_Some.
     cbn [Crypto.Util.Option.bind fst snd].
@@ -1069,6 +1064,87 @@ Section Cmd.
     rewrite !Z.eqb_refl. reflexivity.
   Qed.
 
+  Ltac wf3_invert_hyp H :=
+    lazymatch type of H with
+    | wf3 _ (?f _) ?y ?z =>
+      (* first check if there is information to be gained by inverting this
+         hypothesis *)
+      (lazymatch y with
+       | f _ => lazymatch z with
+               | f _ => fail "already inverted"
+               | _ => idtac
+               end
+       | _ => idtac
+       end);
+      inversion H; clear H; cleanup_wf
+    end.
+
+  Ltac wf3_invert_until_exposed :=
+    repeat match goal with
+           | H : wf3 _ (?f _) ?y ?z |- _ => wf3_invert_hyp H
+           end.
+
+  Lemma translate_carry_correct
+        (e1 : @API.expr (fun _ => unit) type_Z)
+        (e2 : @API.expr API.interp_type type_Z)
+        (e3 : @API.expr ltype type_Z) :
+    valid_carry e1 ->
+    forall G locals,
+      wf3 G e1 e2 e3 ->
+      context_equiv G locals ->
+      (exists w,
+          word.unsigned w = API.interp e2
+          /\ dexpr map.empty locals (translate_carry e3) w)
+      /\ 0 <= API.interp e2 < 2.
+  Proof.
+    cbv zeta.
+    revert e2 e3; induction 1; intros.
+    { (* literal case *)
+      wf3_invert_until_exposed.
+      cbv [translate_carry].
+      lazymatch goal with
+      | |- context [invert_expr.invert_App_Z_cast ?x] =>
+        change (invert_expr.invert_App_Z_cast x) with (@None (ZRange.zrange * @API.expr ltype type_Z))
+      end.
+      rewrite invert_Literal_eq_Some.
+      pose proof word.width_pos.
+      assert (2 <= 2 ^ width) by (apply Pow.Z.pow_pos_le; lia).
+      break_match;
+        repeat lazymatch goal with
+               | H : (_ && _)%bool = true |- _ =>
+                 apply Bool.andb_true_iff in H; destruct H; LtbToLt.Z.ltb_to_lt
+               | H : (_ && _)%bool = false |- _ =>
+                 apply Bool.andb_false_iff in H; destruct H; LtbToLt.Z.ltb_to_lt
+               | _ => lia
+               end; [ ].
+      split.
+      { eexists; split; [ | reflexivity ].
+        rewrite word.unsigned_of_Z. cbv [word.wrap].
+        rewrite Z.mod_small by lia. reflexivity. }
+      { cbv [expr.interp Compilers.ident_interp ident.literal]; lia. } }
+    { (* cast case *)
+      wf3_invert_until_exposed.
+      cbv [translate_carry].
+      rewrite invert_App_Z_cast_eq_Some.
+      lazymatch goal with H : is_carry_range _ = true |- _ =>  rewrite H end.
+      cbn [expr.interp Compilers.ident_interp ident.literal].
+      rewrite interp_cast_carry by auto.
+      cbn [dexpr WeakestPrecondition.expr WeakestPrecondition.expr_body].
+      pose proof word.width_pos. cbv [word.wrap].
+      rewrite mod_pow2_mod_2 by lia.
+      split; [ | eapply Z.mod_pos_bound; lia ].
+      eexists; split.
+      2:{
+        eapply Proper_expr; [ repeat intro |
+                              eapply (translate_expr_correct' (t:=base_Z)) with (require_cast:=false);
+                              solve [eauto] ].
+        subst. reflexivity. }
+      { rewrite interp_and_carry.
+        rewrite !word.unsigned_of_Z. cbv [word.wrap].
+        rewrite mod_pow2_mod_2 by lia.
+        reflexivity. } }
+  Qed.
+
   Local Ltac simplify :=
     repeat
       first [ progress (intros; cleanup)
@@ -1185,9 +1261,14 @@ Section Cmd.
              locally_equivalent ret1 ret2 locals').
   Proof.
     revert e2 e3 G. cbv zeta.
+
+    (* useful property for carries *)
+    pose proof word.width_pos.
+    assert (2 <= 2 ^ width) by (apply Pow.Z.pow_pos_le; lia).
+
+    (* induction on expression *)
     induction e1_valid; try (inversion 1; [ ]).
 
-    (* inversion on wf3 leaves a mess; clean up hypotheses *)
     Ltac invert_until_exposed H y :=
       progress match y with
                | expr.App _ _ => idtac (* don't invert original, already-inverted one *)
@@ -1397,9 +1478,12 @@ Section Cmd.
                  pose proof translate_expr_correct' e e2 e3 require_cast ltac:(eassumption) G _ Hwf ltac:(eassumption) as Htr; cbn iota in Htr; simplify
                end;
                  clear H
+             | H : valid_carry ?c |- _ =>
+               eapply translate_carry_correct in H; [ | eassumption .. ]; simplify
              | H : Lift1Prop.ex1 _ _ |- _ => destruct H
              | H : emp _ _ |- _ => destruct H; cleanup
              end.
+      sepsimpl_hyps.
       cbn [locally_equivalent_nobounds locally_equivalent_nobounds_base] in *.
       eexists; split; [ | ].
       { (* Argument expressions. *)
@@ -1408,14 +1492,8 @@ Section Cmd.
                | H : dexpr map.empty ?l ?x _ |- WeakestPrecondition.expr ?m ?l ?x _ =>
                  apply expr_empty; apply H
                | _ => reflexivity
-               end; [ ].
-        (* Carry argument is left over. *)
-        cbn [WeakestPrecondition.expr WeakestPrecondition.expr_body].
-        eapply Proper_expr; [ | solve [apply expr_empty; eauto] ].
-        repeat intro; subst. reflexivity. }
-      straightline_call;
-        [ (* carry is < 2 *)
-          rewrite interp_and_carry; apply Z.mod_pos_bound; lia | ].
+               end. }
+      straightline_call; [ lia | ].
       sepsimpl; subst; cleanup.
       eexists; split; [ reflexivity | ].
       eapply Proper_cmd; [ eapply Proper_call | repeat intro | ].
@@ -1476,18 +1554,7 @@ Section Cmd.
                | H : word.unsigned _ = expr.interp ?iinterp ?x |- context [expr.interp ?iinterp ?x] =>
                  rewrite <-H
                end.
-        lazymatch goal with
-        | H : context [word.unsigned
-                         (Semantics.interp_binop Syntax.bopname.and (word.of_Z ?x) (word.of_Z 1))]
-          |- context [Definitions.Z.add_with_get_carry_full _ (PreExtra.ident.cast ?r ?c) _ _] =>
-          (* more complex rewrite for the carry *)
-          replace (PreExtra.ident.cast r c)
-            with (word.unsigned (word:=word)
-                                (Semantics.interp_binop Syntax.bopname.and (word.of_Z x) (word.of_Z 1)))
-        end; [ erewrite add_with_get_carry_full_equiv; try solve [eauto with lia];
-               rewrite interp_and_carry; apply Z.mod_pos_bound; lia | ].
-        rewrite interp_and_carry, interp_cast_carry by auto.
-        rewrite word.unsigned_of_Z. reflexivity. } }
+        erewrite add_with_get_carry_full_equiv; eauto with lia. } }
     { (* sub_get_borrow *)
       (* TODO: the proof here is nearly identical to add_get_carry; some could
          be factored out into tactics. *)
@@ -1589,6 +1656,8 @@ Section Cmd.
                  pose proof translate_expr_correct' e e2 e3 require_cast ltac:(eassumption) G _ Hwf ltac:(eassumption) as Htr; cbn iota in Htr; simplify
                end;
                  clear H
+             | H : valid_carry ?c |- _ =>
+               eapply translate_carry_correct in H; [ | eassumption .. ]; simplify
              | H : Lift1Prop.ex1 _ _ |- _ => destruct H
              | H : emp _ _ |- _ => destruct H; cleanup
              end.
@@ -1600,14 +1669,8 @@ Section Cmd.
                | H : dexpr map.empty ?l ?x _ |- WeakestPrecondition.expr ?m ?l ?x _ =>
                  apply expr_empty; apply H
                | _ => reflexivity
-               end; [ ].
-        (* Carry argument is left over. *)
-        cbn [WeakestPrecondition.expr WeakestPrecondition.expr_body].
-        eapply Proper_expr; [ | solve [apply expr_empty; eauto] ].
-        repeat intro; subst. reflexivity. }
-      straightline_call;
-        [ (* carry is < 2 *)
-          rewrite interp_and_carry; apply Z.mod_pos_bound; lia | ].
+               end. }
+      straightline_call; [ lia | ].
       sepsimpl; subst; cleanup.
       eexists; split; [ reflexivity | ].
       eapply Proper_cmd; [ eapply Proper_call | repeat intro | ].
@@ -1668,17 +1731,6 @@ Section Cmd.
                | H : word.unsigned _ = expr.interp ?iinterp ?x |- context [expr.interp ?iinterp ?x] =>
                  rewrite <-H
                end.
-        lazymatch goal with
-        | H : context [word.unsigned
-                         (Semantics.interp_binop Syntax.bopname.and (word.of_Z ?x) (word.of_Z 1))]
-          |- context [Definitions.Z.sub_with_get_borrow_full _ (PreExtra.ident.cast ?r ?c) _ _] =>
-          (* more complex rewrite for the carry *)
-          replace (PreExtra.ident.cast r c)
-            with (word.unsigned (word:=word)
-                                (Semantics.interp_binop Syntax.bopname.and (word.of_Z x) (word.of_Z 1)))
-        end; [ erewrite sub_with_get_borrow_full_equiv; try solve [eauto with lia];
-               rewrite interp_and_carry; apply Z.mod_pos_bound; lia | ].
-        rewrite interp_and_carry, interp_cast_carry by auto.
-        rewrite word.unsigned_of_Z. reflexivity. } }
+        erewrite sub_with_get_borrow_full_equiv; eauto with lia. } }
   Qed.
 End Cmd.
diff --git a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v
index 029d04148f..b1639dd149 100644
--- a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v
+++ b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v
@@ -129,7 +129,10 @@ Section Cmd.
             if is_carry_range (fst rc)
             then valid_expr_bool false (snd rc)
             else false
-          | None => false
+          | None => match invert_expr.invert_Literal c with
+                   | Some c => (0 <=? c) && (c <? 2)
+                   | None => false
+                   end
         end
     | _ => fun _ => false
     end.
@@ -256,28 +259,81 @@ Section Cmd.
     cbv [is_sub_with_get_borrow_ident]; break_match; congruence.
   Qed.
 
+  Lemma valid_carry_bool_impl1 e :
+    valid_carry_bool e = true ->
+    valid_carry e.
+  Proof.
+    cbv [valid_carry_bool].
+    break_match; try congruence; intros;
+      repeat lazymatch goal with
+             | p : _ * _ |- _ => destruct p; cbn [fst snd] in *
+             | H : (_ && _)%bool = true |- _ => apply Bool.andb_true_iff in H; destruct H; Z.ltb_to_lt
+             | H : invert_expr.invert_App_Z_cast _ = Some (_,_) |- _ =>
+               apply invert_App_Z_cast_Some in H; subst
+             | H : invert_expr.invert_Literal _ = Some _ |- _ =>
+               apply Inversion.Compilers.expr.invert_Literal_Some_base in H; subst
+             | H : valid_expr_bool _ _ = true |- _ => rewrite valid_expr_bool_iff in H
+             end; [ | ].
+    all:constructor; eauto.
+  Qed.
+
+  Lemma valid_carry_bool_impl2 e :
+    valid_carry e ->
+    valid_carry_bool e = true.
+  Proof.
+    induction 1; cbn [valid_carry_bool].
+    { (* literal case *)
+      lazymatch goal with
+        |- context [invert_expr.invert_App_Z_cast ?x] =>
+        change (invert_expr.invert_App_Z_cast x) with
+          (@None (ZRange.zrange * @API.expr (fun _ => unit) type_Z))
+      end.
+      rewrite invert_Literal_eq_Some.
+      apply Bool.andb_true_iff; split; Z.ltb_to_lt; lia. }
+    { (* cast case *)
+      rewrite invert_App_Z_cast_eq_Some.
+      cbn [fst snd].
+      break_match; try congruence; [ ].
+      apply valid_expr_bool_iff; auto. }
+  Qed.
+
+  Lemma valid_carry_bool_iff e : valid_carry_bool e = true <-> valid_carry e.
+  Proof.
+    split; [ apply valid_carry_bool_impl1 | apply valid_carry_bool_impl2 ].
+  Qed.
+
+  (* TODO: remove? *)
   Lemma valid_carry_bool_eq {t} e :
     valid_carry_bool e = true ->
     (match t as t0 return API.expr t0 -> Prop with
      | type_Z => fun e =>
-                  exists (r : ZRange.zrange) (x : API.expr type_Z),
+                  (exists (r : ZRange.zrange) (x : API.expr type_Z),
                     e = expr.App (expr.App (expr.Ident ident.Z_cast)
                                            (expr.Ident (ident.Literal
                                                           (t:=Compilers.zrange)
                                                           r)))
                                  x
                     /\ valid_expr_bool false x = true
-                    /\ is_carry_range r = true
+                    /\ is_carry_range r = true)
+                  \/ (exists (v : Z),
+                        e = (expr.Ident (ident.Literal (t:=base.type.Z) v))
+                        /\ 0 <= v < 2)
      | _ => fun _ => False
      end) e.
   Proof.
-    cbv [valid_carry_bool]. break_match; try congruence; [ ].
-    repeat lazymatch goal with
-           | p : _ * _ |- _ => destruct p; cbn [fst snd] in *
-           | H : invert_expr.invert_App_Z_cast _ = Some (_,_) |- _ =>
-             apply invert_App_Z_cast_Some in H; subst
-           end.
-    intros; do 2 eexists; repeat split; try reflexivity; auto.
+    cbv [valid_carry_bool].
+    break_match; try congruence; intros;
+      repeat lazymatch goal with
+             | p : _ * _ |- _ => destruct p; cbn [fst snd] in *
+             | H : (_ && _)%bool = true |- _ => apply Bool.andb_true_iff in H; destruct H; Z.ltb_to_lt
+             | H : invert_expr.invert_App_Z_cast _ = Some (_,_) |- _ =>
+               apply invert_App_Z_cast_Some in H; subst
+             | H : invert_expr.invert_Literal _ = Some _ |- _ =>
+               apply Inversion.Compilers.expr.invert_Literal_Some_base in H; subst
+
+             end; [ | ].
+    { left. do 2 eexists; repeat split; try reflexivity; auto. }
+    { right. eexists; repeat split; try reflexivity; auto. }
   Qed.
 
   Lemma is_literalz_eq t (e : API.expr t) (x : Z) :
@@ -373,8 +429,7 @@ Section Cmd.
                  apply is_literalz_eq in H; subst
                | H : invert_expr.invert_App_Z_cast2 _ = Some _ |- _ =>
                  apply invert_App_Z_cast2_Some in H; subst
-               | H : valid_carry_bool _ = true |- _ =>
-                 apply valid_carry_bool_eq in H; destruct H as [? [? [? [? ?] ] ] ]
+               | H : valid_carry_bool _ = true |- _ => rewrite valid_carry_bool_iff in H
                | _ => progress cbn [type.interp Language.Compilers.base.interp
                                                invert_expr.invert_App_cast] in *
                end; [ | ].
@@ -516,11 +571,10 @@ Section Cmd.
     reflexivity.
   Qed.
 
-  Lemma valid_special_add_with_get_carry r1 r2 rc c x y:
+  Lemma valid_special_add_with_get_carry r1 r2 c x y:
     Expr.range_good (width:=width) r1 = true ->
     is_carry_range r2 = true ->
-    is_carry_range rc = true ->
-    valid_expr_bool (t:=type_Z) false c = true ->
+    valid_carry_bool c = true ->
     valid_expr_bool (t:=type_Z) true x = true ->
     valid_expr_bool (t:=type_Z) true y = true ->
     valid_special_bool
@@ -536,15 +590,14 @@ Section Cmd.
                (expr.App
                   (expr.App (expr.Ident ident.Z_add_with_get_carry)
                             (expr.Ident (ident.Literal (t:=base.type.Z) (2 ^ width))))
-                  (expr.App (expr.App (expr.Ident ident.Z_cast)
-                                      (expr.Ident (ident.Literal (t:=base.type.zrange) rc))) c))
+                  c)
                x) y)) = true.
   Proof.
     intros. cbv [valid_special_bool]. cbn [invert_expr.invert_App_cast].
     rewrite invert_App_Z_cast2_eq_Some. cbn [fst snd].
-    cbn. rewrite Z.eqb_refl.
+    cbn - [valid_carry_bool]. rewrite Z.eqb_refl.
     repeat lazymatch goal with
-           | H : _?x = true |- context [?x] => rewrite H end.
+           | H : _ ?x = true |- context [?x] => rewrite H end.
     reflexivity.
   Qed.
 
@@ -575,11 +628,10 @@ Section Cmd.
     reflexivity.
   Qed.
 
-  Lemma valid_special_sub_with_get_borrow r1 r2 rc c x y:
+  Lemma valid_special_sub_with_get_borrow r1 r2 c x y:
     Expr.range_good (width:=width) r1 = true ->
     is_carry_range r2 = true ->
-    is_carry_range rc = true ->
-    valid_expr_bool (t:=type_Z) false c = true ->
+    valid_carry_bool c = true ->
     valid_expr_bool (t:=type_Z) true x = true ->
     valid_expr_bool (t:=type_Z) true y = true ->
     valid_special_bool
@@ -595,15 +647,14 @@ Section Cmd.
                (expr.App
                   (expr.App (expr.Ident ident.Z_sub_with_get_borrow)
                             (expr.Ident (ident.Literal (t:=base.type.Z) (2 ^ width))))
-                  (expr.App (expr.App (expr.Ident ident.Z_cast)
-                                      (expr.Ident (ident.Literal (t:=base.type.zrange) rc))) c))
+                  c)
                x) y)) = true.
   Proof.
     intros. cbv [valid_special_bool]. cbn [invert_expr.invert_App_cast].
     rewrite invert_App_Z_cast2_eq_Some. cbn [fst snd].
-    cbn. rewrite Z.eqb_refl.
+    cbn - [valid_carry_bool]. rewrite Z.eqb_refl.
     repeat lazymatch goal with
-           | H : _?x = true |- context [?x] => rewrite H end.
+           | H : _ ?x = true |- context [?x] => rewrite H end.
     reflexivity.
   Qed.
 
@@ -614,6 +665,8 @@ Section Cmd.
       repeat match goal with
              | H : valid_expr _ _ |- _ =>
                apply valid_expr_bool_iff in H
+             | H : valid_carry _ |- _ =>
+               apply valid_carry_bool_iff in H
              | |- _ && _ = true => apply Bool.andb_true_iff; split
              | H : ?x = true |- ?x || _ = true => apply Bool.orb_true_iff; left; apply H
              | H : ?x = true |- _ || ?x = true => apply Bool.orb_true_iff; right; apply H

From c3aad15b5ebc6febbeb0053536d23d8165167e12 Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Fri, 25 Aug 2023 16:34:01 +0200
Subject: [PATCH 31/34] clean up debugging printouts and reset them to focus on
 mul, comment out things that rely on mul_split

---
 .../Field/Synthesis/Examples/p224_64_new.v    | 198 ++++--------------
 1 file changed, 46 insertions(+), 152 deletions(-)

diff --git a/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v b/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
index 21ec371570..0aac842653 100644
--- a/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
+++ b/src/Bedrock/Field/Synthesis/Examples/p224_64_new.v
@@ -49,22 +49,26 @@ Section Field.
   Instance p224_ops : @word_by_word_Montgomery_ops from_mont_string to_mont_string _ _ _ _ _ _ _ _ _ _ _ _ _ (WordByWordMontgomery.n m machine_wordsize) m.
   Proof using Type. Time constructor; make_computed_op. Defined.
 
-
+  (* TODO: remove these debugging printouts! *)
   Goal False.
-    Local Notation ttype := Language.Compilers.type.type.
-    Local Notation tbase := Language.Compilers.type.base.
-    Local Notation ttype_base := Language.Compilers.base.type.type_base.
-    Local Notation btype := Language.Compilers.base.type.type.
-    Local Notation blist := Language.Compilers.base.type.list.
+    (* Import things to make names shorter *)
     Require Import IdentifiersBasicGENERATED.
-    Local Notation eAbs := Language.Compilers.expr.Abs.
-    Local Notation eApp := Language.Compilers.expr.App.
-    Local Notation eVar := Language.Compilers.expr.Var.
-    Local Notation eLetIn := Language.Compilers.expr.LetIn.
-    Local Notation eIdent := Language.Compilers.expr.Ident.
+    Require Import Rewriter.Language.Language.
+
     Set Printing Depth 100000.
-    pose add_op.
-    cbn [add_op p224_ops] in c.
+
+    (* The below lines will show the bedrock2 translation of modular
+       multiplication. Look for "ERROR" to see where in the translation ran into
+       an expression it couldn't handle. *)
+    pose (F:=b2_func mul_op).
+    lazy [b2_func mul_op p224_ops] in F.
+    clear F.
+
+    (* The below lines will show the fiat-crypto pipeline output expression for
+       modular multiplication. It's a big expression, so printing it takes a few
+       minutes. *)
+    pose (X:=res mul_op).
+    Time lazy [res mul_op p224_ops] in X.
 
   Abort.
 
@@ -99,148 +103,10 @@ Section Field.
         | |- (_ = _)%Z => vm_compute; reflexivity
         end.
 
-
-      Require Import Crypto.Language.API.
-      Import API.Compilers.
-      Print Func.valid_func_bool.
-      Locate API.expr.
-      Definition cmd_bool
-                 {t} (e : @API.expr (fun _ => unit) t) : bool :=
-        match e return bool with
-        | expr.LetIn
-            (type.base (base.type.prod
-                          (base.type.type_base a)
-                          (base.type.type_base b)))
-            (type.base c) x f =>
-          true
-        | expr.LetIn
-            (type.base (base.type.type_base a))
-            (type.base b) x f =>
-          true
-        | expr.App (type.base s) _ f x =>
-          true
-        | expr.Ident _ i => true
-        | _ => false
-        end.
-      Fixpoint func_bool {t} (e : @API.expr (fun _ => unit) t) : bool :=
-        match e with
-        | expr.Abs _ _ f =>func_bool (f tt)
-        | _ => cmd_bool e
-        end.
-      Lemma valid_expr_bool_if_base_LetIn {A B} (x : API.expr A) (f : unit -> API.expr B) :
-        Cmd.valid_expr_bool_if_base (expr.LetIn x f) = false.
-      Proof.
-        cbv [Cmd.valid_expr_bool_if_base].
-        destruct B; reflexivity.
-      Qed.
-      
-  Derive p224_add
+  Derive p224_from_bytes
          SuchThat (forall functions,
                       Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
                       Cmd.spec_of_sub_borrowx (sub_borrowx:=Defaults.sub_borrowx) functions ->
-                      spec_of_BinOp bin_add
-                        (field_representation:=field_representation m)
-                        (p224_add :: functions))
-         As p224_add_correct.
-  Proof.
-   Time derive_bedrock2_func add_op.
-    begin_derive_bedrock2_func.
-    4:{
-      eapply Func.valid_func_bool_iff.
-      cbn [add_op p224_ops res].
-      cbv [Func.valid_func_bool].
-      repeat  lazymatch goal with
-              | |- context [Func.valid_cmd_bool_if_base (eAbs ?x)] =>
-                change (Func.valid_cmd_bool_if_base (eAbs x)) with false
-              end.
-      cbv [Func.valid_cmd_bool_if_base].
-      cbv [Cmd.valid_cmd_bool].
-      rewrite valid_expr_bool_if_base_LetIn.
-      rewrite valid_expr_bool_if_base_LetIn.
-      rewrite valid_expr_bool_if_base_LetIn.
-      rewrite valid_expr_bool_if_base_LetIn.
-      rewrite valid_expr_bool_if_base_LetIn.
-      rewrite valid_expr_bool_if_base_LetIn.
-      rewrite !valid_expr_bool_if_base_LetIn.
-      Set Printing Depth 100000.
-      repeat match goal with
-             | |- context [Cmd.valid_expr_bool_if_base ?x] =>
-               change (Cmd.valid_expr_bool_if_base x) with false
-             end.
-      cbn iota.
-      cbv [Cmd.valid_cons_App1_bool
-             Cmd.valid_cons_App2_bool
-             Cmd.is_cons_ident
-             Cmd.is_nil_ident].
-      repeat match goal with
-             | |- context [(Expr.valid_expr_bool true ?x || Cmd.valid_special_bool ?x)%bool] =>
-                          first [ change (Expr.valid_expr_bool true x) with true; cbn [orb]
-                                | change (Cmd.valid_special_bool x) with true; rewrite Bool.orb_true_r ]
-             | |- context [Expr.valid_expr_bool true ?x] =>
-               change (Expr.valid_expr_bool true x) with true
-             end.
-      cbn [orb andb].
-      match goal with
-      | |- context [Cmd.valid_special_bool ?x] =>
-        assert (Cmd.valid_special_bool x = true)
-      end.
-      { cbv [Cmd.valid_special_bool].
-        cbv [invert_expr.invert_App_cast].
-        rewrite Util.invert_App_Z_cast2_eq_Some.
-        cbn [fst snd].
-        lazymatch goal with
-        | |- context [Cmd.valid_special3_bool ?x ?r] =>
-          change (Cmd.valid_special3_bool x r) with false
-        end.
-        cbn [orb].
-        cbv [Cmd.valid_special4_bool].
-        rewrite Cmd.invert_AppIdent4_eq_Some.
-        cbv [Cmd.valid_ident_special4].
-        cbn [fst snd].
-        cbv [Cmd.is_add_with_get_carry_ident].
-        cbv [Cmd.is_sub_with_get_borrow_ident].
-        cbv [Expr.is_literalz].
-        rewrite Z.eqb_refl.
-        repeat lazymatch goal with
-               | |- context [Expr.valid_expr_bool true ?x] =>
-                 change (Expr.valid_expr_bool true x) with true
-               end.
-        cbn [andb].
-        cbv [Cmd.is_word_and_carry_range Expr.range_good Cmd.is_carry_range].
-        cbn [fst snd]. rewrite !ZRange.zrange_lb by reflexivity.
-        cbn [andb].
-        cbv [Cmd.valid_carry_bool].
-        Locate valid_carry_bool.
-        (* problem is that valid_carry_bool only matches cast, while it should also accept a 0/1 literal *)
-      }
-        
-      rewrite !Bool.orb_false_r.
-      lazymatch goal with
-      | |- context [Expr.valid_expr_bool true ?x] =>
-        pose (e:=Expr.valid_expr_bool true x);
-          assert (Expr.valid_expr true x)
-      end.
-      {
-        lazy in e.
-        Unset Printing Notations.
-        repeat lazymatch goal with
-               | |- Expr.valid_expr
-                     _ (expr.App (expr.App (expr.Ident Compilers.ident_Z_cast) _)  _) =>
-                 apply Expr.valid_cast1; [ | reflexivity .. ]
-               | |- Expr.valid_expr _ (expr.Var _) =>
-                 apply Expr.valid_var_z
-               | _ => apply Expr.valid_binop; [ cbn; congruence | | ]
-               end.
-        apply Expr.valid_zselect; try reflexivity; [ ].
-        apply Expr.valid_snd_cast.
-        (* valid_snd_cast requires that the range is good, but it's [0,1] *)
-
-   Time derive_bedrock2_func add_op.
-  Qed.
-  Print p224_add.
-
-  Derive p224_from_bytes
-         SuchThat (forall functions,
                       spec_of_from_bytes
                         (field_representation:=field_representation_raw m)
                         (p224_from_bytes :: functions))
@@ -249,30 +115,44 @@ Section Field.
 
   Derive p224_to_bytes
          SuchThat (forall functions,
+                      Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
+                      Cmd.spec_of_sub_borrowx (sub_borrowx:=Defaults.sub_borrowx) functions ->
                       spec_of_to_bytes
                         (field_representation:=field_representation_raw m)
                         (p224_to_bytes :: functions))
          As p224_to_bytes_correct.
   Proof. Time derive_bedrock2_func to_bytes_op. Qed.
 
+  (* TODO: this proof doesn't work because `mul_split` is not yet supported. *)
+  (*
   Derive p224_mul
          SuchThat (forall functions,
+                      Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
+                      Cmd.spec_of_sub_borrowx (sub_borrowx:=Defaults.sub_borrowx) functions ->
                       spec_of_BinOp bin_mul
                         (field_representation:=field_representation m)
                         (p224_mul :: functions))
          As p224_mul_correct.
   Proof. Time derive_bedrock2_func mul_op. Qed.
+   *)
 
+  (* TODO: this proof doesn't work because `mul_split` is not yet supported. *)
+  (*
   Derive p224_square
          SuchThat (forall functions,
+                      Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
+                      Cmd.spec_of_sub_borrowx (sub_borrowx:=Defaults.sub_borrowx) functions ->
                       spec_of_UnOp un_square
                         (field_representation:=field_representation m)
                         (p224_square :: functions))
          As p224_square_correct.
   Proof. Time derive_bedrock2_func square_op. Qed.
+   *)
 
   Derive p224_add
          SuchThat (forall functions,
+                      Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
+                      Cmd.spec_of_sub_borrowx (sub_borrowx:=Defaults.sub_borrowx) functions ->
                       spec_of_BinOp bin_add
                         (field_representation:=field_representation m)
                         (p224_add :: functions))
@@ -281,15 +161,21 @@ Section Field.
 
   Derive p224_sub
          SuchThat (forall functions,
+                      Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
+                      Cmd.spec_of_sub_borrowx (sub_borrowx:=Defaults.sub_borrowx) functions ->
                       spec_of_BinOp bin_sub
                         (field_representation:=field_representation m)
                         (p224_sub :: functions))
          As p224_sub_correct.
   Proof. Time derive_bedrock2_func sub_op. Qed.
 
+  (* TODO: this proof doesn't work because `mul_split` is not yet supported. *)
+  (*
   (*TODO: adapt derive_bedrock2_func to also derive the remaining functions.*)
   Derive p224_from_mont
          SuchThat (forall functions,
+                      Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
+                      Cmd.spec_of_sub_borrowx (sub_borrowx:=Defaults.sub_borrowx) functions ->
                       spec_of_UnOp un_from_mont
                         (field_representation:=field_representation m)
                         (p224_from_mont :: functions))
@@ -302,9 +188,14 @@ Section Field.
             + auto.
             + auto.
   Qed.
+  *)
 
+  (* TODO: this proof doesn't work because `mul_split` is not yet supported. *)
+  (*
   Derive p224_to_mont
          SuchThat (forall functions,
+                      Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
+                      Cmd.spec_of_sub_borrowx (sub_borrowx:=Defaults.sub_borrowx) functions ->
                       spec_of_UnOp un_to_mont
                         (field_representation:=field_representation m)
                         (p224_to_mont :: functions))
@@ -315,9 +206,12 @@ Section Field.
         - eapply Func.valid_func_bool_iff. abstract vm_cast_no_check (eq_refl true).
           Unshelve. all: auto.
      Qed.
+   *)
 
   Derive p224_select_znz
            SuchThat (forall functions,
+                      Cmd.spec_of_add_carryx (add_carryx:=Defaults.add_carryx) functions ->
+                      Cmd.spec_of_sub_borrowx (sub_borrowx:=Defaults.sub_borrowx) functions ->
                       spec_of_selectznz
                         (field_representation:=field_representation m)
                         (p224_select_znz :: functions))

From 5340e29198b64c6a26177f1db88e79b05730841b Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Fri, 25 Aug 2023 16:59:57 +0200
Subject: [PATCH 32/34] remove debugging file

---
 p224.txt | 231 -------------------------------------------------------
 1 file changed, 231 deletions(-)
 delete mode 100644 p224.txt

diff --git a/p224.txt b/p224.txt
deleted file mode 100644
index 8d30a8d340..0000000000
--- a/p224.txt
+++ /dev/null
@@ -1,231 +0,0 @@
-make --no-print-directory -C rewriter
-make --no-print-directory -C rupicola/bedrock2/deps/coqutil
-make --no-print-directory -C coqprime src/Coqprime/PrimalityTest/Zp.vo src/Coqprime/PrimalityTest/PocklingtonCertificat.vo
-Generating Makefile.coq.test
-make -f Makefile.coq.test
-make[1]: 'src/Coqprime/PrimalityTest/Zp.vo' is up to date.
-make[1]: 'src/Coqprime/PrimalityTest/PocklingtonCertificat.vo' is up to date.
-make[3]: Nothing to be done for 'real-all'.
-make --no-print-directory -C rupicola/bedrock2 bedrock2_ex
-make -C /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coqutil
-Generating Makefile.coq.test
-make -f Makefile.coq.test
-echo $COQ_VERSION_INFO (8.15.2) > .coq-version-short
-echo $COQ_VERSION_INFO (8.15.2, compiled with) > .coq-version-short-date
-echo $COQ_VERSION_INFO (8.15.2, OCaml 4.08.1) > .coq-version-compilation-date
-echo $COQ_VERSION_INFO (8.15.2, 4.08.1) > .coq-version-ocaml-version
-echo $COQ_VERSION_INFO (8.15.2, <config>) > .coq-version-config
-echo $COQ_VERSION_INFO (8.15.2, <ocaml config>) > .coq-version-ocaml-config
-etc/machine.sh > .machine
-etc/machine-extended.sh > .machine-extended
-make[4]: Nothing to be done for 'real-all'.
-make -C /home/jadep/fiat-crypto/rupicola/bedrock2/bedrock2 noex
-Generating Makefile.coq.noex
-rm -f .coqdeps.d
-make -f Makefile.coq.noex
-make[4]: Nothing to be done for 'real-all'.
-make -C /home/jadep/fiat-crypto/rupicola/bedrock2/bedrock2
-Generating Makefile.coq.noex
-Generating Makefile.coq.ex
-rm -f .coqdeps.d
-make -f Makefile.coq.noex
-make[4]: Nothing to be done for 'real-all'.
-rm -f .coqdeps.d
-COQFLAGS="-Q src/bedrock2 bedrock2 -Q src/bedrock2Examples bedrock2Examples -Q /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coqutil/src/coqutil coqutil " ../etc/bytedump.py bedrock2.PrintListByte.allBytes > special/BytedumpTest.out.tmp
-COQFLAGS="-Q src/bedrock2 bedrock2 -Q src/bedrock2Examples bedrock2Examples -Q /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coqutil/src/coqutil coqutil " ../etc/bytedump.py bedrock2.ToCStringExprTypecheckingTest.test > special/TypecheckExprToCString.c
-make -f Makefile.coq.ex
-make[4]: Nothing to be done for 'real-all'.
-COQFLAGS="-Q src/bedrock2 bedrock2 -Q src/bedrock2Examples bedrock2Examples -Q /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coqutil/src/coqutil coqutil " ../etc/bytedump.py bedrock2.ToCStringStackallocLoopTest.main_cbytes > special/stackloop.c
-make[2]: Nothing to be done for 'real-all'.
-hexdump < /dev/null && \
-	hexdump -C special/BytedumpTest.golden.bin > special/BytedumpTest.golden.hex && \
-	hexdump -C special/BytedumpTest.out.tmp > special/BytedumpTest.out.hex && \
-	diff -u special/BytedumpTest.golden.hex special/BytedumpTest.out.hex && \
-	rm special/BytedumpTest.golden.hex special/BytedumpTest.out.hex || true
-diff -u special/BytedumpTest.golden.bin special/BytedumpTest.out.tmp
-mv special/BytedumpTest.out.tmp special/BytedumpTest.out
-COQFLAGS="-Q src/bedrock2 bedrock2 -Q src/bedrock2Examples bedrock2Examples -Q /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coqutil/src/coqutil coqutil " ../etc/bytedump.py bedrock2Examples.stackalloc.stacknondet_c > special/stacknondet.c
-cc -fsyntax-only special/TypecheckExprToCString.c
-cc -O0 special/stackloop.c -o special/stackloop
-special/stackloop
-cc special/stacknondet.c -o special/stacknondet
-special/stacknondet
-make --no-print-directory -C rupicola/bedrock2 compiler_noex
-make -C /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coqutil
-make NO_TEST=1 -C /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coq-record-update
-Generating Makefile.coq.test
-make -f Makefile.coq.test
-make[4]: Nothing to be done for 'real-all'.
-make[4]: Nothing to be done for 'real-all'.
-make -C /home/jadep/fiat-crypto/rupicola/bedrock2/deps/riscv-coq all
-make -C /home/jadep/fiat-crypto/rupicola/bedrock2/bedrock2 noex
-Generating Makefile.coq.noex
-Generating Makefile.coq.all
-rm -f .coqdeps.d
-make -f Makefile.coq.noex
-rm -f .coqdeps.d
-make -f Makefile.coq.all
-make[4]: Nothing to be done for 'real-all'.
-make[4]: Nothing to be done for 'real-all'.
-make -C /home/jadep/fiat-crypto/rupicola/bedrock2/compiler noex
-Generating Makefile.coq.noex
-rm -f .coqdeps.d
-make -f Makefile.coq.noex
-make[4]: Nothing to be done for 'real-all'.
-make --no-print-directory -C rupicola all
-make --no-print-directory -C bedrock2/deps/coqutil
-Generating Makefile.coq.test
-make -f Makefile.coq.test
-make[4]: Nothing to be done for 'real-all'.
-make --no-print-directory -C bedrock2/bedrock2 noex
-Generating Makefile.coq
-Generating Makefile.coq.noex
-rm -f .coqdeps.d
-make -f Makefile.coq.noex
-make[4]: Nothing to be done for 'real-all'.
-rm -f .coqdeps.d
-make -f Makefile.coq
-COQDEP VFILES
-make[3]: Nothing to be done for 'real-all'.
-COQDEP VFILES
-make --no-print-directory -C rewriter
-make --no-print-directory -C rupicola/bedrock2/deps/coqutil
-make --no-print-directory -C coqprime src/Coqprime/PrimalityTest/Zp.vo src/Coqprime/PrimalityTest/PocklingtonCertificat.vo
-Generating Makefile.coq.test
-make -f Makefile.coq.test
-make[1]: 'src/Coqprime/PrimalityTest/Zp.vo' is up to date.
-make[1]: 'src/Coqprime/PrimalityTest/PocklingtonCertificat.vo' is up to date.
-make[3]: Nothing to be done for 'real-all'.
-make --no-print-directory -C rupicola/bedrock2 bedrock2_ex
-make -C /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coqutil
-Generating Makefile.coq.test
-make -f Makefile.coq.test
-echo $COQ_VERSION_INFO (8.15.2) > .coq-version-short
-echo $COQ_VERSION_INFO (8.15.2, compiled with) > .coq-version-short-date
-echo $COQ_VERSION_INFO (8.15.2, OCaml 4.08.1) > .coq-version-compilation-date
-echo $COQ_VERSION_INFO (8.15.2, 4.08.1) > .coq-version-ocaml-version
-echo $COQ_VERSION_INFO (8.15.2, <config>) > .coq-version-config
-echo $COQ_VERSION_INFO (8.15.2, <ocaml config>) > .coq-version-ocaml-config
-etc/machine.sh > .machine
-etc/machine-extended.sh > .machine-extended
-make[4]: Nothing to be done for 'real-all'.
-make -C /home/jadep/fiat-crypto/rupicola/bedrock2/bedrock2 noex
-Generating Makefile.coq.noex
-rm -f .coqdeps.d
-make -f Makefile.coq.noex
-make[4]: Nothing to be done for 'real-all'.
-make -C /home/jadep/fiat-crypto/rupicola/bedrock2/bedrock2
-Generating Makefile.coq.noex
-Generating Makefile.coq.ex
-rm -f .coqdeps.d
-make -f Makefile.coq.noex
-make[4]: Nothing to be done for 'real-all'.
-rm -f .coqdeps.d
-COQFLAGS="-Q src/bedrock2 bedrock2 -Q src/bedrock2Examples bedrock2Examples -Q /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coqutil/src/coqutil coqutil " ../etc/bytedump.py bedrock2.PrintListByte.allBytes > special/BytedumpTest.out.tmp
-make -f Makefile.coq.ex
-COQFLAGS="-Q src/bedrock2 bedrock2 -Q src/bedrock2Examples bedrock2Examples -Q /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coqutil/src/coqutil coqutil " ../etc/bytedump.py bedrock2.ToCStringExprTypecheckingTest.test > special/TypecheckExprToCString.c
-make[4]: Nothing to be done for 'real-all'.
-COQFLAGS="-Q src/bedrock2 bedrock2 -Q src/bedrock2Examples bedrock2Examples -Q /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coqutil/src/coqutil coqutil " ../etc/bytedump.py bedrock2.ToCStringStackallocLoopTest.main_cbytes > special/stackloop.c
-make[2]: Nothing to be done for 'real-all'.
-hexdump < /dev/null && \
-	hexdump -C special/BytedumpTest.golden.bin > special/BytedumpTest.golden.hex && \
-	hexdump -C special/BytedumpTest.out.tmp > special/BytedumpTest.out.hex && \
-	diff -u special/BytedumpTest.golden.hex special/BytedumpTest.out.hex && \
-	rm special/BytedumpTest.golden.hex special/BytedumpTest.out.hex || true
-diff -u special/BytedumpTest.golden.bin special/BytedumpTest.out.tmp
-mv special/BytedumpTest.out.tmp special/BytedumpTest.out
-COQFLAGS="-Q src/bedrock2 bedrock2 -Q src/bedrock2Examples bedrock2Examples -Q /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coqutil/src/coqutil coqutil " ../etc/bytedump.py bedrock2Examples.stackalloc.stacknondet_c > special/stacknondet.c
-cc -fsyntax-only special/TypecheckExprToCString.c
-cc -O0 special/stackloop.c -o special/stackloop
-special/stackloop
-cc special/stacknondet.c -o special/stacknondet
-special/stacknondet
-make --no-print-directory -C rupicola/bedrock2 compiler_noex
-make -C /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coqutil
-make NO_TEST=1 -C /home/jadep/fiat-crypto/rupicola/bedrock2/deps/coq-record-update
-Generating Makefile.coq.test
-make -f Makefile.coq.test
-make[4]: Nothing to be done for 'real-all'.
-make[4]: Nothing to be done for 'real-all'.
-make -C /home/jadep/fiat-crypto/rupicola/bedrock2/deps/riscv-coq all
-make -C /home/jadep/fiat-crypto/rupicola/bedrock2/bedrock2 noex
-Generating Makefile.coq.all
-Generating Makefile.coq.noex
-rm -f .coqdeps.d
-make -f Makefile.coq.noex
-rm -f .coqdeps.d
-make -f Makefile.coq.all
-make[4]: Nothing to be done for 'real-all'.
-make[4]: Nothing to be done for 'real-all'.
-make -C /home/jadep/fiat-crypto/rupicola/bedrock2/compiler noex
-Generating Makefile.coq.noex
-rm -f .coqdeps.d
-make -f Makefile.coq.noex
-make[4]: Nothing to be done for 'real-all'.
-make --no-print-directory -C rupicola all
-make --no-print-directory -C bedrock2/deps/coqutil
-Generating Makefile.coq.test
-make -f Makefile.coq.test
-make[4]: Nothing to be done for 'real-all'.
-make --no-print-directory -C bedrock2/bedrock2 noex
-Generating Makefile.coq
-Generating Makefile.coq.noex
-rm -f .coqdeps.d
-make -f Makefile.coq.noex
-make[4]: Nothing to be done for 'real-all'.
-rm -f .coqdeps.d
-make -f Makefile.coq
-COQDEP VFILES
-make[3]: Nothing to be done for 'real-all'.
-COQC src/Bedrock/Field/Translation/Flatten.v
-COQC src/Bedrock/Field/Translation/LoadStoreList.v
-COQC src/Bedrock/Field/Common/Arrays/ByteBounds.v
-COQC src/Bedrock/Field/Translation/Proofs/Cmd.v
-COQC src/Bedrock/Field/Translation/Parameters/Defaults.v
-COQC src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
-COQC src/Bedrock/Field/Translation/Proofs/Flatten.v
-Record PipelineOptions : Set := Build_PipelineOptions
-  { absint_opts : AbstractInterpretation.Options;
-    widen_carry : widen_carry_opt;
-    widen_bytes : widen_bytes_opt;
-    unfold_value_barrier : unfold_value_barrier_opt;
-    should_split_multiret : should_split_multiret_opt;
-    should_split_mul : should_split_mul_opt;
-    output_options : output_options_opt;
-    only_signed : only_signed_opt;
-    no_select : no_select_opt;
-    low_level_rewriter_method : low_level_rewriter_method_opt;
-    debug_rewriting : debug_rewriting_opt }.
-
-Arguments Build_PipelineOptions absint_opts widen_carry 
-  widen_bytes unfold_value_barrier should_split_multiret 
-  should_split_mul output_options only_signed no_select
-  low_level_rewriter_method debug_rewriting
-Pipeline.split_multiret_to:
-  Pipeline.BoundsPipelineOptions -> split_multiret_to_opt
-split_multiret_to:
-  PipelineOptions -> machine_wordsize_opt -> split_multiret_to_opt
-BoundsPipeline.split_multiret_to: split_multiret_to_opt -> option (Z * Z)
-Pipeline.Build_BoundsPipelineOptions:
-  AbstractInterpretation.Options ->
-  low_level_rewriter_method_opt ->
-  only_signed_opt ->
-  no_select_size_opt ->
-  split_mul_to_opt ->
-  split_multiret_to_opt ->
-  unfold_value_barrier_opt ->
-  relax_adc_sbb_return_carry_to_bitwidth_opt ->
-  forall translate_to_fancy : translate_to_fancy_opt,
-  debug_rewriting_opt ->
-  let with_dead_code_elimination := true in
-  let with_let_bind_return := true in
-  let adc_no_carry_to_add :=
-    match translate_to_fancy with
-    | Some _ => false
-    | None => true
-    end in
-  Pipeline.BoundsPipelineOptions
-COQC src/Bedrock/Field/Translation/Func.v
-COQC src/Bedrock/Field/Translation/Parameters/Defaults64.v
-COQC src/Bedrock/Field/Translation/Parameters/Defaults32.v
-COQC src/Bedrock/Field/Translation/Proofs/LoadStoreList.v

From 09c490db8bb240174ae3022446ddf9c5ae4353d1 Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Fri, 25 Aug 2023 17:23:27 +0200
Subject: [PATCH 33/34] revert fst/snd cast changes

---
 src/Bedrock/Field/Translation/Proofs/Expr.v   |  44 ++---
 .../Translation/Proofs/ValidComputable/Expr.v | 151 ++----------------
 2 files changed, 24 insertions(+), 171 deletions(-)

diff --git a/src/Bedrock/Field/Translation/Proofs/Expr.v b/src/Bedrock/Field/Translation/Proofs/Expr.v
index 680df4d071..180037ae7c 100644
--- a/src/Bedrock/Field/Translation/Proofs/Expr.v
+++ b/src/Bedrock/Field/Translation/Proofs/Expr.v
@@ -63,36 +63,14 @@ Section Expr.
                                       (expr.Ident ident.pair)
                                       (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
                                    (expr.Ident (ident.Literal (t:=base.type.zrange) r2)))) x)
-  | valid_fst_cast :
-      forall (x : API.expr type_ZZ) r1 r2,
+  | valid_fst :
+      forall (x : API.expr type_ZZ),
         valid_expr false x ->
-        range_maskable (width:=width) r1 = true ->
-        (* it's okay to have a cast with a bad range on the non-selected tuple element *)
-        valid_expr false
-                   (expr.App
-                      (expr.Ident ident.fst)
-                      (expr.App
-                         (expr.App (expr.Ident ident.Z_cast2)
-                                   (expr.App
-                                      (expr.App
-                                         (expr.Ident ident.pair)
-                                         (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
-                                      (expr.Ident (ident.Literal (t:=base.type.zrange) r2)))) x))
-  | valid_snd_cast :
-      forall (x : API.expr type_ZZ) r1 r2,
+        valid_expr false (expr.App (expr.Ident ident.fst) x)
+  | valid_snd :
+      forall (x : API.expr type_ZZ),
         valid_expr false x ->
-        range_maskable (width:=width) r2 = true ->
-        (* it's okay to have a cast with a bad range on the non-selected tuple element *)
-        valid_expr false
-                   (expr.App
-                      (expr.Ident ident.snd)
-                      (expr.App
-                         (expr.App (expr.Ident ident.Z_cast2)
-                                   (expr.App
-                                      (expr.App
-                                         (expr.Ident ident.pair)
-                                         (expr.Ident (ident.Literal (t:=base.type.zrange) r1)))
-                                      (expr.Ident (ident.Literal (t:=base.type.zrange) r2)))) x))
+        valid_expr false (expr.App (expr.Ident ident.snd) x)
   | valid_literalz :
       forall rc z,
         (is_bounded_by_bool z (max_range(width:=width)) || negb rc)%bool = true ->
@@ -623,20 +601,18 @@ Section Expr.
                end; [ | ].
       all:rewrite wrap_rcast by auto.
       all:reflexivity. }
-    { (* fst then cast *)
+    { (* fst *)
       specialize (IHvalid_expr _ _ _ _
                                ltac:(eassumption) ltac:(eassumption)).
-      cbv [range_good max_range ident.literal ident.cast2 rcast2] in *.
       cbn [locally_equivalent equivalent_base rep.equiv rep.Z fst snd
                               locally_equivalent_nobounds_base] in *.
-      sepsimpl; auto using expr_rcast_range_to_mask. }
-    { (* snd then cast *)
+      apply IHvalid_expr. }
+    { (* snd *)
       specialize (IHvalid_expr _ _ _ _
                                ltac:(eassumption) ltac:(eassumption)).
-      cbv [range_good max_range ident.literal ident.cast2 rcast2] in *.
       cbn [locally_equivalent equivalent_base rep.equiv rep.Z fst snd
                               locally_equivalent_nobounds_base] in *.
-      sepsimpl; auto using expr_rcast_range_to_mask. }
+      apply IHvalid_expr. }
     { (* literal Z *)
       cbn [locally_equivalent_nobounds_base
              locally_equivalent equivalent_base rep.equiv rep.Z].
diff --git a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
index fbc8c6079d..033ed048aa 100644
--- a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
+++ b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Expr.v
@@ -199,22 +199,6 @@ Section Expr.
     | _ => false
     end.
 
-  (* Accepts a cast expression with range reqs only on the first element. *)
-  Definition valid_fst_cast_bool {t}
-             (e : @API.expr (fun _ => unit) t) : bool :=
-    match invert_expr.invert_Z_cast2 e with
-    | Some (r1, r2) => range_maskable (width:=width) r1
-    | None => false
-    end.
-
-  (* Accepts a cast expression with range reqs only on the second element. *)
-  Definition valid_snd_cast_bool {t}
-             (e : @API.expr (fun _ => unit) t) : bool :=
-    match invert_expr.invert_Z_cast2 e with
-    | Some (r1, r2) => range_maskable (width:=width) r2
-    | None => false
-    end.
-
   Definition valid_bit_range_cast {t} (e : @API.expr (fun _ => unit) t) : bool :=
     match invert_expr.invert_Z_cast e with
     | Some r => zrange_beq r bit_range
@@ -228,7 +212,7 @@ Section Expr.
      very last application in a multi-argument function, take a sneak peek ahead
      to see if the rest of the applications match a certain kind of operation,
      and then enforce any constraints on the last argument. *)
-  Inductive PartialMode := NotPartial | Binop | Shift | Select | Bit | Lnot | Fst | Snd.
+  Inductive PartialMode := NotPartial | Binop | Shift | Select | Bit | Lnot.
 
   Fixpoint valid_expr_bool'
            (mode : PartialMode) (require_casts : bool)
@@ -273,18 +257,6 @@ Section Expr.
           && valid_expr_bool' NotPartial true x
       | _ => false
       end
-    | Fst =>
-      match e with
-      | expr.App type_ZZ type_ZZ f x =>
-        valid_fst_cast_bool f && valid_expr_bool' NotPartial false x
-      | _ => false
-      end
-    | Snd =>
-      match e with
-      | expr.App type_ZZ type_ZZ f x =>
-        valid_snd_cast_bool f && valid_expr_bool' NotPartial false x
-      | _ => false
-      end
     | NotPartial =>
         match e with
         | expr.App type_nat _ f x =>
@@ -322,9 +294,9 @@ Section Expr.
         | expr.App type_ZZ type_Z f x =>
           (* fst or snd *)
           if is_fst_ident_expr f
-          then (negb require_casts) && valid_expr_bool' Fst false x
+          then (negb require_casts) && valid_expr_bool' NotPartial false x
           else if is_snd_ident_expr f
-               then (negb require_casts) && valid_expr_bool' Snd false x
+               then (negb require_casts) && valid_expr_bool' NotPartial false x
                else false
         | expr.App type_ZZ type_ZZ f x =>
           is_cast (width:=width) f
@@ -506,19 +478,9 @@ Section Expr.
     (match t as t0 return ident.ident t0 -> Prop with
      | type.arrow type_ZZ type_Z =>
        fun i =>
-         forall (x : API.expr type_ZZ) r1 r2,
+         forall (x : API.expr type_ZZ),
            valid_expr false x ->
-           range_maskable (width:=width) r1 = true ->
-           valid_expr false (expr.App (expr.Ident i)
-                                      (expr.App (expr.App
-                                                   (expr.Ident ident.Z_cast2)
-                                                   (expr.App
-                                                      (expr.App
-                                                         (expr.Ident ident.pair)
-                                                         (expr.Ident
-                                                            (ident.Literal (t:=Compilers.zrange) r1)))
-                                                      (expr.Ident
-                                                         (ident.Literal (t:=Compilers.zrange) r2)))) x))
+           valid_expr false (expr.App (expr.Ident i) x)
      | _ => fun _ => False
      end) i.
   Proof.
@@ -527,24 +489,14 @@ Section Expr.
       intros; constructor; eauto.
   Qed.
 
-  Lemma is_snd_ident_expr_impl1 {t} (i : ident.ident t) :
+  Lemma is_snd_ident_impl1 {t} (i : ident.ident t) :
     is_snd_ident i = true ->
     (match t as t0 return ident.ident t0 -> Prop with
      | type.arrow type_ZZ type_Z =>
        fun i =>
-         forall (x : API.expr type_ZZ) r1 r2,
+         forall (x : API.expr type_ZZ),
            valid_expr false x ->
-           range_maskable (width:=width) r2 = true ->
-           valid_expr false (expr.App (expr.Ident i)
-                                      (expr.App (expr.App
-                                                   (expr.Ident ident.Z_cast2)
-                                                   (expr.App
-                                                      (expr.App
-                                                         (expr.Ident ident.pair)
-                                                         (expr.Ident
-                                                            (ident.Literal (t:=Compilers.zrange) r1)))
-                                                      (expr.Ident
-                                                         (ident.Literal (t:=Compilers.zrange) r2)))) x))
+           valid_expr false (expr.App (expr.Ident i) x)
      | _ => fun _ => False
      end) i.
   Proof.
@@ -1073,34 +1025,6 @@ Section Expr.
     induction 1; try solve [constructor; eauto using Bool.orb_true_r].
   Qed.
 
-  Definition is_valid_fst_casted {t} (e : API.expr t) : bool :=
-    match e with
-    | expr.App type_ZZ type_ZZ f x =>
-      valid_fst_cast_bool f && valid_expr_bool' NotPartial false x
-    | _ => false
-    end.
-
-  Definition valid_expr_Fst_valid_fst_casted {t} (e : API.expr t) :
-    valid_expr_bool' Fst false e = true ->
-    is_valid_fst_casted e = true.
-  Proof.
-    destruct e; cbn [valid_expr_bool' is_valid_fst_casted]; congruence.
-  Qed.
-
-  Definition is_valid_snd_casted {t} (e : API.expr t) : bool :=
-    match e with
-    | expr.App type_ZZ type_ZZ f x =>
-      valid_snd_cast_bool f && valid_expr_bool' NotPartial false x
-    | _ => false
-    end.
-
-  Definition valid_expr_Snd_valid_snd_casted {t} (e : API.expr t) :
-    valid_expr_bool' Snd false e = true ->
-    is_valid_snd_casted e = true.
-  Proof.
-    destruct e; cbn [valid_expr_bool' is_valid_snd_casted]; congruence.
-  Qed.
-
   Lemma valid_expr_bool'_impl1 {t} (e : API.expr t) :
     forall mode rc,
       valid_expr_bool' mode rc e = true ->
@@ -1168,24 +1092,6 @@ Section Expr.
                valid_expr rc (expr.App f x)
          | _ => fun _ => False
          end) e
-      | Fst =>
-        (match t as t0 return expr.expr t0 -> Prop with
-         | type_ZZ =>
-           fun e =>
-             is_valid_fst_casted e = true ->
-             rc = false ->
-             valid_expr rc (expr.App (expr.Ident ident.fst) e)
-         | _ => fun _ => False
-         end) e
-      | Snd =>
-        (match t as t0 return expr.expr t0 -> Prop with
-         | type_ZZ =>
-           fun e =>
-             is_valid_snd_casted e = true ->
-             rc = false ->
-             valid_expr rc (expr.App (expr.Ident ident.snd) e)
-         | _ => fun _ => False
-         end) e
       | NotPartial => (exists b, t = type.base b) -> valid_expr rc e
       end.
   Proof.
@@ -1226,8 +1132,6 @@ Section Expr.
                    | Select => False
                    | Bit => False
                    | Lnot => False
-                   | Fst => False
-                   | Snd => False
                    end |- _ =>
                  specialize (IH NotPartial); (cbn match in IH)
                end.
@@ -1257,7 +1161,7 @@ Section Expr.
         apply (IHe2 NotPartial); eauto. }
       { (* nth_default case *)
         eauto using valid_expr_nth_default_bool_impl1. }
-      { (* fully-applied fst case *)
+      { (* fst case *)
         intros.
         repeat lazymatch goal with
                | H : is_fst_ident_expr _ = true |- _ =>
@@ -1265,7 +1169,7 @@ Section Expr.
                | H : negb ?b = true |- _ =>
                  destruct b; cbn [negb] in *; [ congruence | ]
                end.
-        apply (IHe2 Fst); auto using valid_expr_Fst_valid_fst_casted. }
+        apply valid_fst; eauto. }
       { (* fully-applied snd case *)
         intros.
         repeat lazymatch goal with
@@ -1274,16 +1178,15 @@ Section Expr.
                | H : negb ?b = true |- _ =>
                  destruct b; cbn [negb] in *; [ congruence | ]
                end.
-        apply (IHe2 Snd); auto using valid_expr_Snd_valid_snd_casted. }
+        apply valid_snd; eauto. }
       { (* cast ZZ *)
         intros.
         apply (is_cast_impl1
-                 (t := type_ZZ -> type_ZZ)); eauto; [ ].
-        eapply (IHe2 NotPartial); eauto. }
+                 (t := type_ZZ -> type_ZZ)); eauto. }
       { (* partially-applied binop case *)
         intros.
         apply (valid_expr_binop_bool_impl1
-                 (t:=type_Z -> type_Z -> type_Z)); eauto; [ ].
+                 (t:=type_Z -> type_Z -> type_Z)); eauto.
         eapply (IHe2 NotPartial); eauto. }
       { (* partially-applied shift case *)
         intros.
@@ -1316,33 +1219,7 @@ Section Expr.
         intros.
         apply (valid_expr_lnot_modulo_bool_impl1
                  (t:=type_Z -> type_Z -> type_Z)); eauto; [ ].
-        apply (IHe2 NotPartial); eauto. }
-      { (* partially-applied fst case *)
-        intros.
-        cbv [valid_fst_cast_bool] in *.
-        break_match_hyps; try congruence ; [ ].
-        lazymatch goal with
-        | H : invert_expr.invert_Z_cast2 _ = Some _ |- _ =>
-          apply InversionExtra.Compilers.expr.invert_Z_cast2_Some_ZZ in H;
-            cbn in H; subst
-        end.
-        cbv [ident.literal].
-        constructor; auto; [ ].
-        apply (IHe2 NotPartial); auto.
-        eexists; reflexivity. }
-      { (* partially-applied snd case *)
-        intros.
-        cbv [valid_snd_cast_bool] in *.
-        break_match_hyps; try congruence ; [ ].
-        lazymatch goal with
-        | H : invert_expr.invert_Z_cast2 _ = Some _ |- _ =>
-          apply InversionExtra.Compilers.expr.invert_Z_cast2_Some_ZZ in H;
-            cbn in H; subst
-        end.
-        cbv [ident.literal].
-        constructor; auto; [ ].
-        apply (IHe2 NotPartial); auto.
-        eexists; reflexivity. } }
+        apply (IHe2 NotPartial); eauto. } }
     { break_match; try congruence. }
   Qed.
 

From 13b7e0a9448a0009e40d93d5e99dadfd9c495de8 Mon Sep 17 00:00:00 2001
From: Jade Philipoom <jadep@google.com>
Date: Fri, 25 Aug 2023 17:40:40 +0200
Subject: [PATCH 34/34] remove printing statements and dead lemma

---
 .../Field/Translation/Parameters/Defaults.v   |  2 --
 .../Translation/Proofs/ValidComputable/Cmd.v  | 34 -------------------
 2 files changed, 36 deletions(-)

diff --git a/src/Bedrock/Field/Translation/Parameters/Defaults.v b/src/Bedrock/Field/Translation/Parameters/Defaults.v
index 22c1a722d3..7348ff0bd4 100644
--- a/src/Bedrock/Field/Translation/Parameters/Defaults.v
+++ b/src/Bedrock/Field/Translation/Parameters/Defaults.v
@@ -18,8 +18,6 @@ Import ListNotations.
 (* use in-memory lists; local ones are only used internally *)
 Global Existing Instances Types.rep.Z Types.rep.listZ_mem.
 
-Print PipelineOptions.
-Search split_multiret_to_opt.
 Global Instance pipeline_opts : PipelineOptions :=
   let _ := default_PipelineOptions in
   {| (* Abstract interpretation options; currently only involving (>>) uint1 bounds, which is not relevant to bedrock2 *)
diff --git a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v
index b1639dd149..dc44cad4f1 100644
--- a/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v
+++ b/src/Bedrock/Field/Translation/Proofs/ValidComputable/Cmd.v
@@ -302,40 +302,6 @@ Section Cmd.
     split; [ apply valid_carry_bool_impl1 | apply valid_carry_bool_impl2 ].
   Qed.
 
-  (* TODO: remove? *)
-  Lemma valid_carry_bool_eq {t} e :
-    valid_carry_bool e = true ->
-    (match t as t0 return API.expr t0 -> Prop with
-     | type_Z => fun e =>
-                  (exists (r : ZRange.zrange) (x : API.expr type_Z),
-                    e = expr.App (expr.App (expr.Ident ident.Z_cast)
-                                           (expr.Ident (ident.Literal
-                                                          (t:=Compilers.zrange)
-                                                          r)))
-                                 x
-                    /\ valid_expr_bool false x = true
-                    /\ is_carry_range r = true)
-                  \/ (exists (v : Z),
-                        e = (expr.Ident (ident.Literal (t:=base.type.Z) v))
-                        /\ 0 <= v < 2)
-     | _ => fun _ => False
-     end) e.
-  Proof.
-    cbv [valid_carry_bool].
-    break_match; try congruence; intros;
-      repeat lazymatch goal with
-             | p : _ * _ |- _ => destruct p; cbn [fst snd] in *
-             | H : (_ && _)%bool = true |- _ => apply Bool.andb_true_iff in H; destruct H; Z.ltb_to_lt
-             | H : invert_expr.invert_App_Z_cast _ = Some (_,_) |- _ =>
-               apply invert_App_Z_cast_Some in H; subst
-             | H : invert_expr.invert_Literal _ = Some _ |- _ =>
-               apply Inversion.Compilers.expr.invert_Literal_Some_base in H; subst
-
-             end; [ | ].
-    { left. do 2 eexists; repeat split; try reflexivity; auto. }
-    { right. eexists; repeat split; try reflexivity; auto. }
-  Qed.
-
   Lemma is_literalz_eq t (e : API.expr t) (x : Z) :
     is_literalz e x = true ->
     (match t as t0 return API.expr t0 -> Prop with