Add SpecificGen/GF*

For bounds analysis

127 files changed, 12754 insertions, 0 deletions

diff --git a/src/SpecificGen/GF2213_32Bounded.v b/src/SpecificGen/GF2213_32Bounded.v
new file mode 100644
index 000000000..9a35ce124
--- /dev/null
+++ b/src/SpecificGen/GF2213_32Bounded.v
@@ -0,0 +1,462 @@
+Require Import Crypto.BaseSystem.
+Require Import Crypto.ModularArithmetic.PrimeFieldTheorems.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParams.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParamProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystem.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemOpt.
+Require Import Crypto.SpecificGen.GF2213_32.
+Require Import Crypto.SpecificGen.GF2213_32BoundedCommon.
+Require Import Crypto.SpecificGen.GF2213_32Reflective.
+Require Import Bedrock.Word Crypto.Util.WordUtil.
+Require Import Coq.Lists.List Crypto.Util.ListUtil.
+Require Import Crypto.Tactics.VerdiTactics.
+Require Import Crypto.Util.ZUtil.
+Require Import Crypto.Util.Tuple.
+Require Import Crypto.Util.Tactics.
+Require Import Crypto.Util.LetIn.
+Require Import Crypto.Util.Notations.
+Require Import Crypto.Util.Bool.
+Require Import Crypto.Util.Decidable.
+Require Import Crypto.Algebra.
+Import ListNotations.
+Require Import Coq.ZArith.ZArith Coq.ZArith.Zpower Coq.ZArith.ZArith Coq.ZArith.Znumtheory.
+Local Open Scope Z.
+
+
+Local Ltac bounded_t opW blem :=
+  apply blem; apply is_bounded_proj1_fe2213_32.
+Local Ltac bounded_wire_digits_t opW blem :=
+  apply blem; apply is_bounded_proj1_wire_digits.
+
+Local Ltac define_binop f g opW blem :=
+  refine (exist_fe2213_32W (opW (proj1_fe2213_32W f) (proj1_fe2213_32W g)) _);
+  abstract bounded_t opW blem.
+Local Ltac define_unop f opW blem :=
+  refine (exist_fe2213_32W (opW (proj1_fe2213_32W f)) _);
+  abstract bounded_t opW blem.
+Local Ltac define_unop_FEToZ f opW :=
+  refine (opW (proj1_fe2213_32W f)).
+Local Ltac define_unop_FEToWire f opW blem :=
+  refine (exist_wire_digitsW (opW (proj1_fe2213_32W f)) _);
+  abstract bounded_t opW blem.
+Local Ltac define_unop_WireToFE f opW blem :=
+  refine (exist_fe2213_32W (opW (proj1_wire_digitsW f)) _);
+  abstract bounded_wire_digits_t opW blem.
+
+Local Opaque Let_In.
+Local Opaque Z.add Z.sub Z.mul Z.shiftl Z.shiftr Z.land Z.lor Z.eqb NToWord64.
+Local Arguments interp_radd / _ _.
+Local Arguments interp_rsub / _ _.
+Local Arguments interp_rmul / _ _.
+Local Arguments interp_ropp / _.
+Local Arguments interp_rprefreeze / _.
+Local Arguments interp_rge_modulus / _.
+Local Arguments interp_rpack / _.
+Local Arguments interp_runpack / _.
+Definition addW (f g : fe2213_32W) : fe2213_32W := Eval simpl in interp_radd f g.
+Definition subW (f g : fe2213_32W) : fe2213_32W := Eval simpl in interp_rsub f g.
+Definition mulW (f g : fe2213_32W) : fe2213_32W := Eval simpl in interp_rmul f g.
+Definition oppW (f : fe2213_32W) : fe2213_32W := Eval simpl in interp_ropp f.
+Definition prefreezeW (f : fe2213_32W) : fe2213_32W := Eval simpl in interp_rprefreeze f.
+Definition ge_modulusW (f : fe2213_32W) : word64 := Eval simpl in interp_rge_modulus f.
+Definition packW (f : fe2213_32W) : wire_digitsW := Eval simpl in interp_rpack f.
+Definition unpackW (f : wire_digitsW) : fe2213_32W := Eval simpl in interp_runpack f.
+
+Require Import ModularBaseSystemWord.
+Definition modulusW :=
+  Eval cbv - [ZToWord64] in (Tuple.map ZToWord64 (Tuple.from_list_default 0%Z 10 GF2213_32.modulus_digits_)).
+
+Definition postfreeze : GF2213_32.fe2213_32 -> GF2213_32.fe2213_32 :=
+  GF2213_32.postfreeze.
+
+Lemma freeze_prepost_freeze : forall x, postfreeze (prefreeze x) = GF2213_32.freeze x. Proof. reflexivity. Qed.
+
+Definition postfreezeW : fe2213_32W -> fe2213_32W :=
+      (conditional_subtract_modulusW
+         (num_limbs := 10)
+         modulusW
+         ge_modulusW
+         (Interpretations.Word64.neg GF2213_32.int_width)
+      ).
+
+Definition freezeW (f : fe2213_32W) : fe2213_32W := Eval cbv beta delta [prefreezeW postfreezeW] in postfreezeW (prefreezeW f).
+
+Local Transparent Let_In.
+Definition powW (f : fe2213_32W) chain := fold_chain_opt (proj1_fe2213_32W one) mulW chain [f].
+Definition invW (f : fe2213_32W) : fe2213_32W
+  := Eval cbv -[Let_In fe2213_32W mulW] in powW f (chain inv_ec).
+
+Local Ltac port_correct_and_bounded pre_rewrite opW interp_rop rop_cb :=
+  change opW with (interp_rop);
+  rewrite pre_rewrite;
+  intros; apply rop_cb; assumption.
+
+Lemma addW_correct_and_bounded : ibinop_correct_and_bounded addW carry_add.
+Proof. port_correct_and_bounded interp_radd_correct addW interp_radd radd_correct_and_bounded. Qed.
+Lemma subW_correct_and_bounded : ibinop_correct_and_bounded subW carry_sub.
+Proof. port_correct_and_bounded interp_rsub_correct subW interp_rsub rsub_correct_and_bounded. Qed.
+Lemma mulW_correct_and_bounded : ibinop_correct_and_bounded mulW mul.
+Proof. port_correct_and_bounded interp_rmul_correct mulW interp_rmul rmul_correct_and_bounded. Qed.
+Lemma oppW_correct_and_bounded : iunop_correct_and_bounded oppW carry_opp.
+Proof. port_correct_and_bounded interp_ropp_correct oppW interp_ropp ropp_correct_and_bounded. Qed.
+Lemma prefreezeW_correct_and_bounded : iunop_correct_and_bounded prefreezeW prefreeze.
+Proof. port_correct_and_bounded interp_rprefreeze_correct prefreezeW interp_rprefreeze rprefreeze_correct_and_bounded. Qed.
+Lemma ge_modulusW_correct : iunop_FEToZ_correct ge_modulusW ge_modulus.
+Proof. port_correct_and_bounded interp_rge_modulus_correct ge_modulusW interp_rge_modulus rge_modulus_correct_and_bounded. Qed.
+Lemma packW_correct_and_bounded : iunop_FEToWire_correct_and_bounded packW pack.
+Proof. port_correct_and_bounded interp_rpack_correct packW interp_rpack rpack_correct_and_bounded. Qed.
+Lemma unpackW_correct_and_bounded : iunop_WireToFE_correct_and_bounded unpackW unpack.
+Proof. port_correct_and_bounded interp_runpack_correct unpackW interp_runpack runpack_correct_and_bounded. Qed.
+
+(* TODO : move *)
+Lemma neg_range : forall x y, 0 <= x ->
+  0 <= ModularBaseSystemListZOperations.neg x y < 2 ^ x.
+Proof.
+  intros.
+  split; auto using ModularBaseSystemListZOperationsProofs.neg_nonneg.
+  eapply Z.le_lt_trans; eauto using ModularBaseSystemListZOperationsProofs.neg_upperbound.
+  rewrite Z.ones_equiv.
+  omega.
+Qed.
+
+Ltac lower_bound_minus_ge_modulus :=
+  apply Z.le_0_sub;
+  cbv [ge_modulus Let_In ModularBaseSystemListZOperations.cmovl ModularBaseSystemListZOperations.cmovne ModularBaseSystemListZOperations.neg];
+  repeat break_if; Z.ltb_to_lt; subst; try omega;
+    rewrite ?Z.land_0_l; auto;
+    change Interpretations.Word64.word64ToZ with word64ToZ;
+    etransitivity; try apply Z.land_upper_bound_r; instantiate; try omega;
+    apply Z.ones_nonneg; instantiate; vm_compute; discriminate.
+
+Ltac upper_bound_minus_ge_modulus :=
+   (apply Z.log2_lt_pow2_alt; [ vm_compute; reflexivity | ]);
+   eapply Z.le_lt_trans; [ apply Z.le_sub_nonneg; apply Z.land_nonneg; right; omega | ];
+   eapply Z.le_lt_trans; [ eassumption | ];
+   instantiate; vm_compute; reflexivity.
+
+Lemma postfreezeW_correct_and_bounded : iunop_correct_and_bounded postfreezeW postfreeze.
+Proof.
+  intros x H.
+  pose proof (ge_modulusW_correct x H) as Hgm.
+  destruct_head_hnf' prod.
+  unfold_is_bounded_in H.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  cbv [postfreezeW].
+  cbv [conditional_subtract_modulusW Interpretations.Word64.neg].
+  change word64ToZ with Interpretations.Word64.word64ToZ in *.
+  rewrite Hgm.
+
+  cbv [modulusW Tuple.map].
+  cbv [on_tuple List.map to_list to_list' from_list from_list'
+                Tuple.map2 on_tuple2 ListUtil.map2 fe2213_32WToZ].
+  cbv [postfreeze GF2213_32.postfreeze].
+  cbv [Let_In].
+
+  split.
+  { match goal with
+    |- (_,word64ToZ (_ ^- (Interpretations.Word64.ZToWord64 ?x) ^& _)) = (_,_ - (?y &' _)) => assert (x = y) as Hxy by reflexivity; repeat rewrite <-Hxy; clear Hxy end.
+
+  change ZToWord64 with Interpretations.Word64.ZToWord64 in *.
+  rewrite !Interpretations.Word64.word64ToZ_sub;
+  rewrite !Interpretations.Word64.word64ToZ_land;
+  rewrite !Interpretations.Word64.word64ToZ_ZToWord64;
+  try match goal with
+         | |- 0 <=  ModularBaseSystemListZOperations.neg _ _ < 2 ^ _ => apply neg_range; omega
+         | |- 0 <= _ < 2 ^ Z.of_nat _ => vm_compute; split; [refine (fun x => match x with eq_refl => I end) | reflexivity]
+         | |- 0 <= _ &' _ => apply Z.land_nonneg; right; omega
+         | |- (_,_) = (_,_) => reflexivity
+      end;
+  try solve [
+  (apply Z.log2_lt_pow2_alt; [ vm_compute; reflexivity | ]);
+  eapply Z.le_lt_trans; try apply Z.land_upper_bound_r; try apply neg_range; instantiate; try match goal with |- ?G => not has_evar G; vm_compute; discriminate end; reflexivity];
+  match goal with
+  | |- 0 <= _ - _ => lower_bound_minus_ge_modulus
+  | |- Z.log2 (_ - _) < _ => upper_bound_minus_ge_modulus
+  end. }
+
+
+  unfold_is_bounded.
+  change ZToWord64 with Interpretations.Word64.ZToWord64 in *.
+  rewrite !Interpretations.Word64.word64ToZ_sub;
+  rewrite !Interpretations.Word64.word64ToZ_land;
+  rewrite !Interpretations.Word64.word64ToZ_ZToWord64;
+  repeat match goal with |- _ /\ _ => split; Z.ltb_to_lt end;
+  try match goal with
+         | |- 0 <=  ModularBaseSystemListZOperations.neg _ _ < 2 ^ _ => apply neg_range; omega
+         | |- 0 <= _ < 2 ^ Z.of_nat _ => vm_compute; split; [refine (fun x => match x with eq_refl => I end) | reflexivity]
+         | |- 0 <= _ &' _ => apply Z.land_nonneg; right; omega
+      end;
+  try solve [
+  (apply Z.log2_lt_pow2_alt; [ vm_compute; reflexivity | ]);
+  eapply Z.le_lt_trans; try apply Z.land_upper_bound_r; try apply neg_range; instantiate; try match goal with |- ?G => not has_evar G; vm_compute; discriminate end; reflexivity];
+  try match goal with
+  | |- 0 <= _ - _ => lower_bound_minus_ge_modulus
+  | |- Z.log2 (_ - _) < _ => upper_bound_minus_ge_modulus
+  | |- _ - _ <= _ => etransitivity; [ apply Z.le_sub_nonneg; apply Z.land_nonneg; right; omega | instantiate; assumption ]
+  | |- 0 <= ModularBaseSystemListZOperations.neg _ _ =>
+    apply neg_range; vm_compute; discriminate
+  | |- ModularBaseSystemListZOperations.neg _ _ < _ =>
+    apply neg_range; vm_compute; discriminate
+  | |- _ => vm_compute; (discriminate || reflexivity)
+      end.
+Qed.
+
+Lemma freezeW_correct_and_bounded : iunop_correct_and_bounded freezeW freeze.
+Proof.
+  intros f H; rewrite <- freeze_prepost_freeze.
+  change (freezeW f) with (postfreezeW (prefreezeW f)).
+  destruct (prefreezeW_correct_and_bounded f H) as [H0 H1].
+  destruct (postfreezeW_correct_and_bounded _ H1) as [H0' H1'].
+  rewrite H1', H0', H0; split; reflexivity.
+Qed.
+
+Lemma powW_correct_and_bounded chain : iunop_correct_and_bounded (fun x => powW x chain) (fun x => pow x chain).
+Proof.
+  cbv [powW pow].
+  intro x; intros; apply (fold_chain_opt_gen fe2213_32WToZ is_bounded [x]).
+  { reflexivity. }
+  { reflexivity. }
+  { intros; progress rewrite <- (fun X Y => proj1 (mulW_correct_and_bounded _ _ X Y)) by assumption.
+    apply mulW_correct_and_bounded; assumption. }
+  { intros; rewrite (fun X Y => proj1 (mulW_correct_and_bounded _ _ X Y)) by assumption; reflexivity. }
+  { intros [|?]; autorewrite with simpl_nth_default;
+      (assumption || reflexivity). }
+Qed.
+
+Lemma invW_correct_and_bounded : iunop_correct_and_bounded invW inv.
+Proof.
+  intro f.
+  assert (H : forall f, invW f = powW f (chain inv_ec))
+    by abstract (cbv -[Let_In fe2213_32W mulW]; reflexivity).
+  rewrite H.
+  rewrite inv_correct.
+  cbv [inv_opt].
+  rewrite <- pow_correct.
+  apply powW_correct_and_bounded.
+Qed.
+
+Definition fieldwisebW_sig (f g : fe2213_32W)
+  : { b | b = GF2213_32.fieldwiseb (fe2213_32WToZ f) (fe2213_32WToZ g) }.
+Proof.
+  hnf in f, g; destruct_head' prod.
+  eexists.
+  cbv [GF2213_32.fieldwiseb fe2213_32WToZ].
+  rewrite ?word64eqb_Zeqb.
+  reflexivity.
+Defined.
+
+Definition fieldwisebW (f g : fe2213_32W) : bool :=
+  Eval cbv [proj1_sig fieldwisebW_sig appify2 app_fe2213_32W] in
+    appify2 (fun f g => proj1_sig (fieldwisebW_sig f g)) f g.
+
+Lemma fieldwisebW_correct f g
+  : fieldwisebW f g = GF2213_32.fieldwiseb (fe2213_32WToZ f) (fe2213_32WToZ g).
+Proof.
+  set (f' := f); set (g' := g).
+  hnf in f, g; destruct_head' prod.
+  exact (proj2_sig (fieldwisebW_sig f' g')).
+Qed.
+
+Local Arguments freezeW : simpl never.
+Local Arguments fe2213_32WToZ !_ / .
+Local Opaque freezeW.
+
+Definition eqbW_sig (f g : fe2213_32W)
+  : { b | is_bounded (fe2213_32WToZ f) = true
+          -> is_bounded (fe2213_32WToZ g) = true
+          -> b = GF2213_32.eqb (fe2213_32WToZ f) (fe2213_32WToZ g) }.
+Proof.
+  pose proof (fun pf => proj1 (freezeW_correct_and_bounded f pf)) as frf.
+  pose proof (fun pf => proj1 (freezeW_correct_and_bounded g pf)) as frg.
+  hnf in f, g; destruct_head' prod.
+  eexists.
+  unfold GF2213_32.eqb.
+  simpl @fe2213_32WToZ in *; cbv beta iota.
+  intros.
+  rewrite <- frf, <- frg by assumption.
+  rewrite <- fieldwisebW_correct.
+  reflexivity.
+Defined.
+
+Definition eqbW (f g : fe2213_32W) : bool :=
+  Eval cbv [proj1_sig eqbW_sig appify2 app_fe2213_32W] in
+    appify2 (fun f g => proj1_sig (eqbW_sig f g)) f g.
+
+Lemma eqbW_correct f g
+  : is_bounded (fe2213_32WToZ f) = true
+    -> is_bounded (fe2213_32WToZ g) = true
+    -> eqbW f g = GF2213_32.eqb (fe2213_32WToZ f) (fe2213_32WToZ g).
+Proof.
+  set (f' := f); set (g' := g).
+  hnf in f, g; destruct_head' prod.
+  exact (proj2_sig (eqbW_sig f' g')).
+Qed.
+
+(* TODO(jgross): use NToWord or such for this constant too *)
+Definition sqrt_m1W : fe2213_32W :=
+  Eval vm_compute in fe2213_32ZToW sqrt_m1.
+
+Definition GF2213_32sqrt x : GF2213_32.fe2213_32 :=
+  dlet powx := powW (fe2213_32ZToW x) (chain GF2213_32.sqrt_ec) in
+  GF2213_32.sqrt (fe2213_32WToZ powx) (fe2213_32WToZ (mulW powx powx)) x.
+
+Definition sqrtW_sig
+  : { sqrtW | iunop_correct_and_bounded sqrtW GF2213_32sqrt }.
+Proof.
+  eexists.
+  unfold GF2213_32sqrt, GF2213_32.sqrt.
+  intros.
+  rewrite !fe2213_32ZToW_WToZ.
+  split.
+  { etransitivity.
+    Focus 2. {
+      apply Proper_Let_In_nd_changebody_eq; intros.
+      set_evars.
+      match goal with (* unfold the first dlet ... in, but only if it's binding a var *)
+      | [ |- ?x = dlet y := fe2213_32WToZ ?z in ?f ]
+        => is_var z; change (x = match fe2213_32WToZ z with y => f end)
+      end.
+      change sqrt_m1 with (fe2213_32WToZ sqrt_m1W).
+      rewrite <- (fun X Y => proj1 (mulW_correct_and_bounded sqrt_m1W a X Y)), <- eqbW_correct, (pull_bool_if fe2213_32WToZ)
+        by repeat match goal with
+                  | _ => progress subst
+                  | [ |- is_bounded (fe2213_32WToZ ?op) = true ]
+                    => lazymatch op with
+                       | mulW _ _ => apply mulW_correct_and_bounded
+                       | powW _ _ => apply powW_correct_and_bounded
+                       | sqrt_m1W => vm_compute; reflexivity
+                       | _ => assumption
+                       end
+                  end.
+      subst_evars; reflexivity.
+    } Unfocus.
+    lazymatch goal with
+    | [ |- context G[dlet x := ?v in fe2213_32WToZ (@?f x)] ]
+      => let G' := context G[fe2213_32WToZ (dlet x := v in f x)] in
+         cut G'; cbv beta;
+           [ cbv [Let_In]; exact (fun x => x) | apply f_equal ]
+    end.
+    reflexivity. }
+  { cbv [Let_In].
+    break_if.
+    { apply powW_correct_and_bounded; assumption. }
+    { apply mulW_correct_and_bounded; [ vm_compute; reflexivity | ].
+      apply powW_correct_and_bounded; assumption. } }
+Defined.
+
+Definition sqrtW (f : fe2213_32W) : fe2213_32W :=
+  Eval cbv [proj1_sig sqrtW_sig app_fe2213_32W] in
+    app_fe2213_32W f (proj1_sig sqrtW_sig).
+
+Lemma sqrtW_correct_and_bounded : iunop_correct_and_bounded sqrtW GF2213_32sqrt.
+Proof.
+  intro f.
+  set (f' := f).
+  hnf in f; destruct_head' prod.
+  assert (H : sqrtW f' = proj1_sig sqrtW_sig f')
+    by (subst f'; cbv beta iota delta [proj1_sig sqrtW_sig sqrtW]; reflexivity).
+  rewrite H.
+  exact (proj2_sig sqrtW_sig f').
+Qed.
+
+
+
+Definition add (f g : fe2213_32) : fe2213_32.
+Proof. define_binop f g addW addW_correct_and_bounded. Defined.
+Definition sub (f g : fe2213_32) : fe2213_32.
+Proof. define_binop f g subW subW_correct_and_bounded. Defined.
+Definition mul (f g : fe2213_32) : fe2213_32.
+Proof. define_binop f g mulW mulW_correct_and_bounded. Defined.
+Definition opp (f : fe2213_32) : fe2213_32.
+Proof. define_unop f oppW oppW_correct_and_bounded. Defined.
+Definition freeze (f : fe2213_32) : fe2213_32.
+Proof. define_unop f freezeW freezeW_correct_and_bounded. Defined.
+Definition ge_modulus (f : fe2213_32) : word64.
+Proof. define_unop_FEToZ f ge_modulusW. Defined.
+Definition pack (f : fe2213_32) : wire_digits.
+Proof. define_unop_FEToWire f packW packW_correct_and_bounded. Defined.
+Definition unpack (f : wire_digits) : fe2213_32.
+Proof. define_unop_WireToFE f unpackW unpackW_correct_and_bounded. Defined.
+
+Definition pow (f : fe2213_32) (chain : list (nat * nat)) : fe2213_32.
+Proof. define_unop f (fun x => powW x chain) powW_correct_and_bounded. Defined.
+Definition inv (f : fe2213_32) : fe2213_32.
+Proof. define_unop f invW invW_correct_and_bounded. Defined.
+Definition sqrt (f : fe2213_32) : fe2213_32.
+Proof. define_unop f sqrtW sqrtW_correct_and_bounded. Defined.
+
+Local Ltac op_correct_t op opW_correct_and_bounded :=
+  cbv [op];
+  lazymatch goal with
+  | [ |- context[proj1_fe2213_32 (exist_fe2213_32W _ _)] ]
+    => rewrite proj1_fe2213_32_exist_fe2213_32W
+  | [ |- context[proj1_wire_digits (exist_wire_digitsW _ _)] ]
+    => rewrite proj1_wire_digits_exist_wire_digitsW
+  | _ => idtac
+  end;
+  apply opW_correct_and_bounded;
+  lazymatch goal with
+  | [ |- is_bounded _ = true ]
+    => apply is_bounded_proj1_fe2213_32
+  | [ |- wire_digits_is_bounded _ = true ]
+    => apply is_bounded_proj1_wire_digits
+  end.
+
+Lemma add_correct (f g : fe2213_32) : proj1_fe2213_32 (add f g) = carry_add (proj1_fe2213_32 f) (proj1_fe2213_32 g).
+Proof. op_correct_t add addW_correct_and_bounded. Qed.
+Lemma sub_correct (f g : fe2213_32) : proj1_fe2213_32 (sub f g) = carry_sub (proj1_fe2213_32 f) (proj1_fe2213_32 g).
+Proof. op_correct_t sub subW_correct_and_bounded. Qed.
+Lemma mul_correct (f g : fe2213_32) : proj1_fe2213_32 (mul f g) = GF2213_32.mul (proj1_fe2213_32 f) (proj1_fe2213_32 g).
+Proof. op_correct_t mul mulW_correct_and_bounded. Qed.
+Lemma opp_correct (f : fe2213_32) : proj1_fe2213_32 (opp f) = carry_opp (proj1_fe2213_32 f).
+Proof. op_correct_t opp oppW_correct_and_bounded. Qed.
+Lemma freeze_correct (f : fe2213_32) : proj1_fe2213_32 (freeze f) = GF2213_32.freeze (proj1_fe2213_32 f).
+Proof. op_correct_t freeze freezeW_correct_and_bounded. Qed.
+Lemma ge_modulus_correct (f : fe2213_32) : word64ToZ (ge_modulus f) = GF2213_32.ge_modulus (proj1_fe2213_32 f).
+Proof. op_correct_t ge_modulus ge_modulusW_correct. Qed.
+Lemma pack_correct (f : fe2213_32) : proj1_wire_digits (pack f) = GF2213_32.pack (proj1_fe2213_32 f).
+Proof. op_correct_t pack packW_correct_and_bounded. Qed.
+Lemma unpack_correct (f : wire_digits) : proj1_fe2213_32 (unpack f) = GF2213_32.unpack (proj1_wire_digits f).
+Proof. op_correct_t unpack unpackW_correct_and_bounded. Qed.
+Lemma pow_correct (f : fe2213_32) chain : proj1_fe2213_32 (pow f chain) = GF2213_32.pow (proj1_fe2213_32 f) chain.
+Proof. op_correct_t pow (powW_correct_and_bounded chain). Qed.
+Lemma inv_correct (f : fe2213_32) : proj1_fe2213_32 (inv f) = GF2213_32.inv (proj1_fe2213_32 f).
+Proof. op_correct_t inv invW_correct_and_bounded. Qed.
+Lemma sqrt_correct (f : fe2213_32) : proj1_fe2213_32 (sqrt f) = GF2213_32sqrt (proj1_fe2213_32 f).
+Proof. op_correct_t sqrt sqrtW_correct_and_bounded. Qed.
+
+Import Morphisms.
+
+Local Existing Instance prime_modulus.
+
+Lemma field2213_32_and_homomorphisms
+  : @field fe2213_32 eq zero one opp add sub mul inv div
+    /\ @Ring.is_homomorphism (F _) (@Logic.eq _) 1%F F.add F.mul fe2213_32 eq one add mul encode
+    /\ @Ring.is_homomorphism fe2213_32 eq one add mul (F _) (@Logic.eq _) 1%F F.add F.mul decode.
+Proof.
+  eapply @Field.field_and_homomorphism_from_redundant_representation.
+  { exact (F.field_modulo _). }
+  { cbv [decode encode]; intros; rewrite !proj1_fe2213_32_exist_fe2213_32; apply encode_rep. }
+  { reflexivity. }
+  { reflexivity. }
+  { reflexivity. }
+  { cbv [decode encode]; intros; rewrite opp_correct, carry_opp_correct, carry_opp_opt_correct, carry_opp_rep; apply opp_rep; reflexivity. }
+  { cbv [decode encode]; intros; rewrite add_correct, carry_add_correct, carry_add_opt_correct, carry_add_rep; apply add_rep; reflexivity. }
+  { cbv [decode encode]; intros; rewrite sub_correct, carry_sub_correct, carry_sub_opt_correct, carry_sub_rep; apply sub_rep; reflexivity. }
+  { cbv [decode encode]; intros; rewrite mul_correct, GF2213_32.mul_correct, carry_mul_opt_correct by reflexivity; apply carry_mul_rep; reflexivity. }
+  { cbv [decode encode]; intros; rewrite inv_correct, GF2213_32.inv_correct, inv_opt_correct by reflexivity; apply inv_rep; reflexivity. }
+  { cbv [decode encode div]; intros; rewrite !proj1_fe2213_32_exist_fe2213_32; apply encode_rep. }
+Qed.
+
+Global Instance field2213_32 : @field fe2213_32 eq zero one opp add sub mul inv div := proj1 field2213_32_and_homomorphisms.
+
+Local Opaque proj1_fe2213_32 exist_fe2213_32 proj1_fe2213_32W exist_fe2213_32W.
+Global Instance homomorphism_F2213_32_encode
+  : @Ring.is_homomorphism (F modulus) Logic.eq F.one F.add F.mul fe2213_32 eq one add mul encode.
+Proof. apply field2213_32_and_homomorphisms. Qed.
+
+Global Instance homomorphism_F2213_32_decode
+  : @Ring.is_homomorphism fe2213_32 eq one add mul (F modulus) Logic.eq F.one F.add F.mul decode.
+Proof. apply field2213_32_and_homomorphisms. Qed.
diff --git a/src/SpecificGen/GF2213_32BoundedCommon.v b/src/SpecificGen/GF2213_32BoundedCommon.v
new file mode 100644
index 000000000..df3f4739e
--- /dev/null
+++ b/src/SpecificGen/GF2213_32BoundedCommon.v
@@ -0,0 +1,693 @@
+Require Import Crypto.BaseSystem.
+Require Import Crypto.ModularArithmetic.PrimeFieldTheorems.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParams.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParamProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystem.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemOpt.
+Require Import Crypto.SpecificGen.GF2213_32.
+Require Import Bedrock.Word Crypto.Util.WordUtil.
+Require Import Coq.Lists.List Crypto.Util.ListUtil.
+Require Import Crypto.Tactics.VerdiTactics.
+Require Import Crypto.Util.ZUtil.
+Require Import Crypto.Util.Tuple.
+Require Import Crypto.Util.Tactics.
+Require Import Crypto.Util.LetIn.
+Require Import Crypto.Util.Notations.
+Require Import Crypto.Util.Decidable.
+Require Import Crypto.Util.HList.
+Require Import Crypto.Util.Tuple.
+Require Import Crypto.Algebra.
+Import ListNotations.
+Require Import Coq.ZArith.ZArith Coq.ZArith.Zpower Coq.ZArith.ZArith Coq.ZArith.Znumtheory.
+Local Open Scope Z.
+
+(* BEGIN common curve-specific definitions *)
+Definition bit_width : nat := Eval compute in Z.to_nat (GF2213_32.int_width).
+Local Notation b_of exp := (0, 2^exp + 2^(exp-3))%Z (only parsing). (* max is [(0, 2^(exp+2) + 2^exp + 2^(exp-1) + 2^(exp-3) + 2^(exp-4) + 2^(exp-5) + 2^(exp-6) + 2^(exp-10) + 2^(exp-12) + 2^(exp-13) + 2^(exp-14) + 2^(exp-15) + 2^(exp-17) + 2^(exp-23) + 2^(exp-24))%Z] *)
+Definition bounds_exp : tuple Z length_fe2213_32
+  := Eval compute in
+      Tuple.from_list length_fe2213_32 limb_widths eq_refl.
+Definition bounds : tuple (Z * Z) length_fe2213_32
+  := Eval compute in
+      Tuple.map (fun e => b_of e) bounds_exp.
+Definition wire_digit_bounds_exp : tuple Z (length wire_widths)
+  := Eval compute in Tuple.from_list _ wire_widths eq_refl.
+Definition wire_digit_bounds : tuple (Z * Z) (length wire_widths)
+  := Eval compute in Tuple.map (fun e => (0,2^e-1)%Z) wire_digit_bounds_exp.
+(* END common curve-specific definitions *)
+
+(* BEGIN aliases for word extraction *)
+Definition word64 := Word.word bit_width.
+Coercion word64ToZ (x : word64) : Z := Z.of_N (wordToN x).
+Coercion ZToWord64 (x : Z) : word64 := NToWord _ (Z.to_N x).
+Definition NToWord64 : N -> word64 := NToWord _.
+Definition word64ize (x : word64) : word64
+  := Eval cbv [wordToN N.succ_double N.double] in NToWord64 (wordToN x).
+Definition w64eqb (x y : word64) := weqb x y.
+
+Global Arguments NToWord64 : simpl never.
+Arguments word64 : simpl never.
+Arguments bit_width : simpl never.
+Global Opaque word64.
+Global Opaque bit_width.
+
+(* END aliases for word extraction *)
+
+(* BEGIN basic types *)
+Module Type WordIsBounded.
+  Parameter is_boundedT : forall (lower upper : Z), word64 -> bool.
+  Parameter Build_is_boundedT : forall {lower upper} {proj_word : word64},
+      andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true -> is_boundedT lower upper proj_word = true.
+  Parameter project_is_boundedT : forall {lower upper} {proj_word : word64},
+      is_boundedT lower upper proj_word = true -> andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true.
+End WordIsBounded.
+
+Module Import WordIsBoundedDefault : WordIsBounded.
+  Definition is_boundedT : forall (lower upper : Z), word64 -> bool
+    := fun lower upper proj_word => andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z.
+  Definition Build_is_boundedT {lower upper} {proj_word : word64}
+    : andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true -> is_boundedT lower upper proj_word = true
+    := fun x => x.
+  Definition project_is_boundedT {lower upper} {proj_word : word64}
+    : is_boundedT lower upper proj_word = true -> andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true
+    := fun x => x.
+End WordIsBoundedDefault.
+
+Definition bounded_word (lower upper : Z)
+  := { proj_word : word64 | is_boundedT lower upper proj_word = true }.
+Local Notation word_of exp := (bounded_word (fst (b_of exp)) (snd (b_of exp))).
+Local Notation unbounded_word sz := (bounded_word 0 (2^sz-1)%Z).
+
+Local Opaque word64.
+Definition fe2213_32W := Eval cbv (*-[word64]*) in (tuple word64 length_fe2213_32).
+Definition wire_digitsW := Eval cbv (*-[word64]*) in (tuple word64 (length wire_widths)).
+Definition fe2213_32 :=
+  Eval cbv -[bounded_word Z.pow Z.sub Z.add] in
+    hlist (fun e => word_of e) bounds_exp.
+Definition wire_digits :=
+  Eval cbv -[bounded_word Z.pow Z.sub Z.add] in
+    hlist (fun e => unbounded_word e) wire_digit_bounds_exp.
+
+Definition is_bounded_gen {n} (x : tuple Z n) (bounds : tuple (Z * Z) n) : bool
+  := let res := Tuple.map2
+                  (fun bounds v =>
+                     let '(lower, upper) := bounds in
+                     (lower <=? v) && (v <=? upper))%bool%Z
+                  bounds x in
+     List.fold_right andb true (Tuple.to_list _ res).
+
+Definition is_bounded (x : SpecificGen.GF2213_32.fe2213_32) : bool
+  := is_bounded_gen (n:=length_fe2213_32) x bounds.
+
+Definition wire_digits_is_bounded (x : SpecificGen.GF2213_32.wire_digits) : bool
+  := is_bounded_gen (n:=length wire_widths) x wire_digit_bounds.
+
+(* END basic types *)
+
+Section generic_destructuring.
+  Fixpoint app_on' A n : forall T (f : tuple' A n) (P : forall x : tuple' A n, T x), T f
+    := match n return forall T (f : tuple' A n) (P : forall x : tuple' A n, T x), T f with
+       | O => fun T v P => P v
+       | S n' => fun T v P => let '(v, x) := v in app_on' A n' _ v (fun v => P (v, x))
+       end.
+  Definition app_on {A n} : forall {T} (f : tuple A n) (P : forall x : tuple A n, T x), T f
+    := match n return forall T (f : tuple A n) (P : forall x : tuple A n, T x), T f with
+       | O => fun T v P => P v
+       | S n' => @app_on' A n'
+       end.
+  Lemma app_on'_correct {A n T} f (P : forall x : tuple' A n, T x) : app_on' A n T f P = P f.
+  Proof.
+    induction n; simpl in *; destruct_head' prod; [ reflexivity | exact (IHn _ _ (fun t => P (t, _))) ].
+  Qed.
+  Lemma app_on_correct {A n T} f (P : forall x : tuple A n, T x) : app_on f P = P f.
+  Proof. destruct n; [ reflexivity | apply app_on'_correct ]. Qed.
+
+  Fixpoint app_on_h' A F n : forall ts T (f : @hlist' A n F ts) (P : forall x : @hlist' A n F ts, T x), T f
+    := match n return forall ts T (f : @hlist' A n F ts) (P : forall x : @hlist' A n F ts, T x), T f with
+       | O => fun ts T v P => P v
+       | S n' => fun ts T v P => let '(v, x) := v in app_on_h' A F n' _ _ v (fun v => P (v, x))
+       end.
+  Definition app_on_h {A F n} : forall ts T (f : @hlist A n F ts) (P : forall x : @hlist A n F ts, T x), T f
+    := match n return forall ts T (f : @hlist A n F ts) (P : forall x : @hlist A n F ts, T x), T f with
+       | O => fun ts T v P => P v
+       | S n' => @app_on_h' A F n'
+       end.
+  Lemma app_on_h'_correct {A F n ts T} f P : @app_on_h' A F n ts T f P = P f.
+  Proof.
+    induction n; simpl in *; destruct_head' prod; [ reflexivity | exact (IHn _ _ _ (fun h => P (h, f))) ].
+  Qed.
+  Lemma app_on_h_correct {A} F {n} ts {T} f P : @app_on_h A F n ts T f P = P f.
+  Proof. destruct n; [ reflexivity | apply app_on_h'_correct ]. Qed.
+
+  Definition app_wire_digitsW_dep {A T} (P : forall x : tuple A (length wire_widths), T x)
+    : forall (f : tuple A (length wire_widths)), T f
+    := Eval compute in fun f => @app_on A (length wire_widths) T f P.
+  Definition app_wire_digitsW {A T} (f : tuple A (length wire_widths)) (P : tuple A (length wire_widths) -> T)
+    := Eval compute in @app_wire_digitsW_dep A (fun _ => T) P f.
+  Definition app_fe2213_32W_dep {A T} (P : forall x : tuple A length_fe2213_32, T x)
+    : forall (f : tuple A length_fe2213_32), T f
+    := Eval compute in fun f => @app_on A length_fe2213_32 T f P.
+  Definition app_fe2213_32W {A T} (f : tuple A length_fe2213_32) (P : tuple A length_fe2213_32 -> T)
+    := Eval compute in @app_fe2213_32W_dep A (fun _ => T) P f.
+  Definition app_fe2213_32_dep {T} (P : forall x : fe2213_32, T x)
+    : forall f : fe2213_32, T f
+    := Eval compute in fun f => @app_on_h _ (fun e => word_of e) length_fe2213_32 bounds_exp T f P.
+  Definition app_fe2213_32 {T} (f : fe2213_32) (P : hlist (fun e => word_of e) bounds_exp -> T)
+    := Eval compute in @app_fe2213_32_dep (fun _ => T) P f.
+  Definition app_wire_digits_dep {T} (P : forall x : wire_digits, T x)
+    : forall f : wire_digits, T f
+    := Eval compute in fun f => @app_on_h _ (fun e => unbounded_word e) (length wire_widths) wire_digit_bounds_exp T f P.
+  Definition app_wire_digits {T} (f : wire_digits) (P : hlist (fun e => unbounded_word e) wire_digit_bounds_exp -> T)
+    := Eval compute in @app_wire_digits_dep (fun _ => T) P f.
+
+  Definition app_wire_digitsW_dep_correct {A T} f P : @app_wire_digitsW_dep A T P f = P f
+    := app_on_correct f P.
+  Definition app_wire_digitsW_correct {A T} f P : @app_wire_digitsW A T f P = P f
+    := @app_wire_digitsW_dep_correct A (fun _ => T) f P.
+  Definition app_fe2213_32W_dep_correct {A T} f P : @app_fe2213_32W_dep A T P f = P f
+    := app_on_correct f P.
+  Definition app_fe2213_32W_correct {A T} f P : @app_fe2213_32W A T f P = P f
+    := @app_fe2213_32W_dep_correct A (fun _ => T) f P.
+  Definition app_fe2213_32_dep_correct {T} f P : @app_fe2213_32_dep T P f = P f
+    := app_on_h_correct (fun e => word_of e) bounds_exp f P.
+  Definition app_fe2213_32_correct {T} f P : @app_fe2213_32 T f P = P f
+    := @app_fe2213_32_dep_correct (fun _ => T) f P.
+  Definition app_wire_digits_dep_correct {T} f P : @app_wire_digits_dep T P f = P f
+    := app_on_h_correct (fun e => unbounded_word e) wire_digit_bounds_exp f P.
+  Definition app_wire_digits_correct {T} f P : @app_wire_digits T f P = P f
+    := @app_wire_digits_dep_correct (fun _ => T) f P.
+
+  Definition appify2 {T} (op : fe2213_32W -> fe2213_32W -> T) (f g : fe2213_32W) :=
+    app_fe2213_32W f (fun f0 => (app_fe2213_32W g (fun g0 => op f0 g0))).
+
+  Lemma appify2_correct : forall {T} op f g, @appify2 T op f g = op f g.
+  Proof.
+    intros. cbv [appify2].
+    etransitivity; apply app_fe2213_32W_correct.
+  Qed.
+End generic_destructuring.
+
+Definition eta_fe2213_32W_sig (x : fe2213_32W) : { v : fe2213_32W | v = x }.
+Proof.
+  eexists; symmetry.
+  repeat (etransitivity; [ apply surjective_pairing | apply f_equal2 ]); reflexivity.
+Defined.
+Definition eta_fe2213_32W (x : fe2213_32W) : fe2213_32W
+  := Eval cbv [proj1_sig eta_fe2213_32W_sig] in proj1_sig (eta_fe2213_32W_sig x).
+Definition eta_wire_digitsW_sig (x : wire_digitsW) : { v : wire_digitsW | v = x }.
+Proof.
+  eexists; symmetry.
+  repeat (etransitivity; [ apply surjective_pairing | apply f_equal2 ]); reflexivity.
+Defined.
+Definition eta_wire_digitsW (x : wire_digitsW) : wire_digitsW
+  := Eval cbv [proj1_sig eta_wire_digitsW_sig] in proj1_sig (eta_wire_digitsW_sig x).
+
+Local Transparent word64.
+Lemma word64ize_id x : word64ize x = x.
+Proof. apply NToWord_wordToN. Qed.
+Local Opaque word64.
+
+Lemma word64eqb_Zeqb x y : (word64ToZ x =? word64ToZ y)%Z = w64eqb x y.
+Proof. apply wordeqb_Zeqb. Qed.
+
+Local Arguments Z.pow_pos !_ !_ / .
+Lemma word64ToZ_ZToWord64 x : 0 <= x < 2^Z.of_nat bit_width -> word64ToZ (ZToWord64 x) = x.
+Proof.
+  intros; unfold word64ToZ, ZToWord64.
+  rewrite wordToN_NToWord_idempotent, Z2N.id
+    by (omega || apply N2Z.inj_lt; rewrite <- ?(N_nat_Z (Npow2 _)), ?Npow2_nat, ?Zpow_pow2, ?N2Z.id, ?Z2N.id, ?Z2Nat.id by omega; omega).
+  reflexivity.
+Qed.
+Lemma ZToWord64_word64ToZ x : ZToWord64 (word64ToZ x) = x.
+Proof.
+  intros; unfold word64ToZ, ZToWord64.
+  rewrite N2Z.id, NToWord_wordToN; reflexivity.
+Qed.
+
+(* BEGIN precomputation. *)
+
+Definition proj_word {lower upper} (v : bounded_word lower upper) := Eval cbv [proj1_sig] in proj1_sig v.
+Definition word_bounded {lower upper} (v : bounded_word lower upper)
+  : andb (lower <=? proj_word v)%Z (proj_word v <=? upper)%Z = true
+  := project_is_boundedT (proj2_sig v).
+Definition Build_bounded_word' {lower upper} proj_word word_bounded : bounded_word lower upper
+  := exist _ proj_word (Build_is_boundedT word_bounded).
+Arguments proj_word {_ _} _.
+Arguments word_bounded {_ _} _.
+Arguments Build_bounded_word' {_ _} _ _.
+Definition Build_bounded_word {lower upper} (proj_word : word64) (word_bounded : andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true)
+  : bounded_word lower upper
+  := Build_bounded_word'
+       proj_word
+       (match andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z as b return b = true -> b = true with
+        | true => fun _ => eq_refl
+        | false => fun x => x
+        end word_bounded).
+Lemma word_to_unbounded_helper {x e : nat} : (x < pow2 e)%nat -> (Z.of_nat e <= Z.of_nat bit_width)%Z -> ((0 <=? word64ToZ (ZToWord64 (Z.of_nat x))) && (word64ToZ (ZToWord64 (Z.of_nat x)) <=? 2 ^ (Z.of_nat e) - 1))%bool = true.
+Proof.
+  rewrite pow2_id; intro H; apply Nat2Z.inj_lt in H; revert H.
+  rewrite Z.pow_Zpow; simpl Z.of_nat.
+  intros H H'.
+  assert (2^Z.of_nat e <= 2^Z.of_nat bit_width) by auto with zarith.
+  rewrite ?word64ToZ_ZToWord64 by omega.
+  match goal with
+  | [ |- context[andb ?x ?y] ]
+    => destruct x eqn:?, y eqn:?; try reflexivity; Z.ltb_to_lt
+  end;
+    intros; omega.
+Qed.
+Definition word_to_unbounded_word {sz} (x : word sz) : (Z.of_nat sz <=? Z.of_nat bit_width)%Z = true -> unbounded_word (Z.of_nat sz).
+Proof.
+  refine (fun pf => Build_bounded_word (Z.of_N (wordToN x)) _).
+  abstract (rewrite wordToN_nat, nat_N_Z; Z.ltb_to_lt; apply (word_to_unbounded_helper (wordToNat_bound x)); simpl; omega).
+Defined.
+Definition word32_to_unbounded_word (x : word 32) : unbounded_word 32.
+Proof. apply (word_to_unbounded_word x); reflexivity. Defined.
+Definition word31_to_unbounded_word (x : word 31) : unbounded_word 31.
+Proof. apply (word_to_unbounded_word x); reflexivity. Defined.
+
+Local Opaque word64.
+Declare Reduction app_tuple_map := cbv [app_wire_digitsW app_fe2213_32W app_fe2213_32 HList.mapt HList.mapt' Tuple.map on_tuple List.map List.app length_fe2213_32 List.length wire_widths Tuple.from_list Tuple.from_list' Tuple.to_list Tuple.to_list' fst snd].
+Definition fe2213_32WToZ (x : fe2213_32W) : SpecificGen.GF2213_32.fe2213_32
+  := Eval app_tuple_map in
+      app_fe2213_32W x (Tuple.map (fun v : word64 => v : Z)).
+Definition fe2213_32ZToW (x : SpecificGen.GF2213_32.fe2213_32) : fe2213_32W
+  := Eval app_tuple_map in
+      app_fe2213_32W x (Tuple.map (fun v : Z => v : word64)).
+Definition wire_digitsWToZ (x : wire_digitsW) : SpecificGen.GF2213_32.wire_digits
+  := Eval app_tuple_map in
+      app_wire_digitsW x (Tuple.map (fun v : word64 => v : Z)).
+Definition wire_digitsZToW (x : SpecificGen.GF2213_32.wire_digits) : wire_digitsW
+  := Eval app_tuple_map in
+      app_wire_digitsW x (Tuple.map (fun v : Z => v : word64)).
+Definition fe2213_32W_word64ize (x : fe2213_32W) : fe2213_32W
+  := Eval app_tuple_map in
+      app_fe2213_32W x (Tuple.map word64ize).
+Definition wire_digitsW_word64ize (x : wire_digitsW) : wire_digitsW
+  := Eval app_tuple_map in
+      app_wire_digitsW x (Tuple.map word64ize).
+
+(** TODO: Turn this into a lemma to speed up proofs *)
+Ltac unfold_is_bounded_in H :=
+  unfold is_bounded, wire_digits_is_bounded, is_bounded_gen, fe2213_32WToZ, wire_digitsWToZ in H;
+  cbv [to_list length bounds wire_digit_bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map fold_right List.rev List.app length_fe2213_32 List.length wire_widths] in H;
+  rewrite ?Bool.andb_true_iff in H.
+
+Ltac unfold_is_bounded :=
+  unfold is_bounded, wire_digits_is_bounded, is_bounded_gen, fe2213_32WToZ, wire_digitsWToZ;
+  cbv [to_list length bounds wire_digit_bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map fold_right List.rev List.app length_fe2213_32 List.length wire_widths];
+  rewrite ?Bool.andb_true_iff.
+
+Local Transparent bit_width.
+Definition Pow2_64 := Eval compute in 2^Z.of_nat bit_width.
+Definition unfold_Pow2_64 : 2^Z.of_nat bit_width = Pow2_64 := eq_refl.
+Local Opaque bit_width.
+
+Local Ltac prove_lt_bit_width :=
+  rewrite unfold_Pow2_64; cbv [Pow2_64]; omega.
+
+Lemma fe2213_32ZToW_WToZ (x : fe2213_32W) : fe2213_32ZToW (fe2213_32WToZ x) = x.
+Proof.
+  hnf in x; destruct_head' prod; cbv [fe2213_32WToZ fe2213_32ZToW].
+  rewrite !ZToWord64_word64ToZ; reflexivity.
+Qed.
+
+Lemma fe2213_32WToZ_ZToW x : is_bounded x = true -> fe2213_32WToZ (fe2213_32ZToW x) = x.
+Proof.
+  hnf in x; destruct_head' prod; cbv [fe2213_32WToZ fe2213_32ZToW].
+  intro H.
+  unfold_is_bounded_in H; destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite !word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Lemma fe2213_32W_word64ize_id x : fe2213_32W_word64ize x = x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [fe2213_32W_word64ize];
+    repeat apply f_equal2; apply word64ize_id.
+Qed.
+Lemma wire_digitsW_word64ize_id x : wire_digitsW_word64ize x = x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [wire_digitsW_word64ize];
+    repeat apply f_equal2; apply word64ize_id.
+Qed.
+
+Definition uncurry_unop_fe2213_32W {T} (op : fe2213_32W -> T)
+  := Eval cbv (*-[word64]*) in Tuple.uncurry (n:=length_fe2213_32) op.
+Definition curry_unop_fe2213_32W {T} op : fe2213_32W -> T
+  := Eval cbv (*-[word64]*) in fun f => app_fe2213_32W f (Tuple.curry (n:=length_fe2213_32) op).
+Definition uncurry_binop_fe2213_32W {T} (op : fe2213_32W -> fe2213_32W -> T)
+  := Eval cbv (*-[word64]*) in uncurry_unop_fe2213_32W (fun f => uncurry_unop_fe2213_32W (op f)).
+Definition curry_binop_fe2213_32W {T} op : fe2213_32W -> fe2213_32W -> T
+  := Eval cbv (*-[word64]*) in appify2 (fun f => curry_unop_fe2213_32W (curry_unop_fe2213_32W op f)).
+
+Definition uncurry_unop_wire_digitsW {T} (op : wire_digitsW -> T)
+  := Eval cbv (*-[word64]*) in Tuple.uncurry (n:=length wire_widths) op.
+Definition curry_unop_wire_digitsW {T} op : wire_digitsW -> T
+  := Eval cbv (*-[word64]*) in fun f => app_wire_digitsW f (Tuple.curry (n:=length wire_widths) op).
+
+
+Definition proj1_fe2213_32W (x : fe2213_32) : fe2213_32W
+  := Eval app_tuple_map in
+      app_fe2213_32 x (HList.mapt (fun _ => (@proj_word _ _))).
+Coercion proj1_fe2213_32 (x : fe2213_32) : SpecificGen.GF2213_32.fe2213_32
+  := fe2213_32WToZ (proj1_fe2213_32W x).
+
+Lemma is_bounded_proj1_fe2213_32 (x : fe2213_32) : is_bounded (proj1_fe2213_32 x) = true.
+Proof.
+  revert x; refine (app_fe2213_32_dep _); intro x.
+  hnf in x; destruct_head' prod; destruct_head' bounded_word.
+  cbv [is_bounded proj1_fe2213_32 proj1_fe2213_32W fe2213_32WToZ to_list length bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map List.rev List.app proj_word length_fe2213_32 is_bounded_gen].
+  apply fold_right_andb_true_iff_fold_right_and_True.
+  cbv [fold_right List.map].
+  cbv beta in *.
+  repeat split; auto using project_is_boundedT.
+Qed.
+
+Definition proj1_wire_digitsW (x : wire_digits) : wire_digitsW
+  := app_wire_digits x (HList.mapt (fun _ => proj_word)).
+Coercion proj1_wire_digits (x : wire_digits) : SpecificGen.GF2213_32.wire_digits
+  := wire_digitsWToZ (proj1_wire_digitsW x).
+
+Lemma is_bounded_proj1_wire_digits (x : wire_digits) : wire_digits_is_bounded (proj1_wire_digits x) = true.
+Proof.
+  revert x; refine (app_wire_digits_dep _); intro x.
+  hnf in x; destruct_head' prod; destruct_head' bounded_word.
+  cbv [wire_digits_is_bounded proj1_wire_digits proj1_wire_digitsW wire_digitsWToZ to_list length wire_digit_bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map List.rev List.app proj_word is_bounded_gen wire_widths HList.mapt HList.mapt' app_wire_digits fst snd].
+  apply fold_right_andb_true_iff_fold_right_and_True.
+  cbv [fold_right List.map].
+  cbv beta in *.
+  repeat split; auto using project_is_boundedT.
+Qed.
+
+Local Ltac make_exist_W' x app_W_dep :=
+  let H := fresh in
+  revert x; refine (@app_W_dep _ _ _); intros x H;
+  let x' := fresh in
+  set (x' := x);
+  cbv [tuple tuple' length_fe2213_32 List.length wire_widths] in x;
+  destruct_head' prod;
+  let rec do_refine v H :=
+      first [ let v' := (eval cbv [snd fst] in (snd v)) in
+              refine (_, Build_bounded_word v' _);
+              [ do_refine (fst v) (proj2 H) | subst x'; abstract exact (proj1 H) ]
+            | let v' := (eval cbv [snd fst] in v) in
+              refine (Build_bounded_word v' _); subst x'; abstract exact (proj1 H) ] in
+  let H' := constr:(proj1 (@fold_right_andb_true_iff_fold_right_and_True _) H) in
+  let T := type of H' in
+  let T := (eval cbv [id
+                        List.fold_right List.map List.length List.app ListUtil.map2 List.rev
+                        Tuple.to_list Tuple.to_list' Tuple.from_list Tuple.from_list' Tuple.map2 Tuple.on_tuple2
+                        fe2213_32 bounds fe2213_32WToZ length_fe2213_32
+                        wire_digits wire_digit_bounds wire_digitsWToZ wire_widths] in T) in
+  let H' := constr:(H' : T) in
+  let v := (eval unfold x' in x') in
+  do_refine v H'.
+Local Ltac make_exist'' x exist_W ZToW :=
+  let H := fresh in
+  intro H; apply (exist_W (ZToW x));
+  abstract (
+      hnf in x; destruct_head' prod;
+      let H' := fresh in
+      pose proof H as H';
+      unfold_is_bounded_in H;
+      destruct_head' and; simpl in *;
+      Z.ltb_to_lt;
+      rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width;
+      assumption
+    ).
+Local Ltac make_exist' x app_W_dep exist'' exist_W ZToW :=
+  let H := fresh in
+  revert x; refine (@app_W_dep _ _ _); intros x H;
+  let x' := fresh in
+  set (x' := x) in *;
+  cbv [tuple tuple' length_fe2213_32 List.length wire_widths] in x;
+  destruct_head' prod;
+  let rec do_refine v :=
+      first [ let v' := (eval cbv [exist_W ZToW exist'' proj_word Build_bounded_word Build_bounded_word' snd fst] in (proj_word v)) in
+              refine (Build_bounded_word v' _); subst x'; abstract exact (word_bounded v)
+            | let v' := (eval cbv [exist_W ZToW exist'' proj_word Build_bounded_word Build_bounded_word' snd fst] in (proj_word (snd v))) in
+              refine (_, Build_bounded_word v' _);
+              [ do_refine (fst v) | subst x'; abstract exact (word_bounded (snd v)) ] ] in
+  let v := (eval unfold x' in (exist'' x' H)) in
+  do_refine v.
+
+Definition exist_fe2213_32W' (x : fe2213_32W) : is_bounded (fe2213_32WToZ x) = true -> fe2213_32.
+Proof. make_exist_W' x (@app_fe2213_32W_dep). Defined.
+Definition exist_fe2213_32W (x : fe2213_32W) : is_bounded (fe2213_32WToZ x) = true -> fe2213_32
+  := Eval cbv [app_fe2213_32W_dep exist_fe2213_32W' fe2213_32ZToW] in exist_fe2213_32W' x.
+Definition exist_fe2213_32'' (x : SpecificGen.GF2213_32.fe2213_32) : is_bounded x = true -> fe2213_32.
+Proof. make_exist'' x exist_fe2213_32W fe2213_32ZToW. Defined.
+Definition exist_fe2213_32' (x : SpecificGen.GF2213_32.fe2213_32) : is_bounded x = true -> fe2213_32.
+Proof. make_exist' x (@app_fe2213_32W_dep) exist_fe2213_32'' exist_fe2213_32W fe2213_32ZToW. Defined.
+Definition exist_fe2213_32 (x : SpecificGen.GF2213_32.fe2213_32) : is_bounded x = true -> fe2213_32
+  := Eval cbv [exist_fe2213_32' exist_fe2213_32W exist_fe2213_32' app_fe2213_32 app_fe2213_32W_dep] in
+      exist_fe2213_32' x.
+
+Lemma proj1_fe2213_32_exist_fe2213_32W x pf : proj1_fe2213_32 (exist_fe2213_32W x pf) = fe2213_32WToZ x.
+Proof. now hnf in x; destruct_head' prod. Qed.
+Lemma proj1_fe2213_32W_exist_fe2213_32 x pf : proj1_fe2213_32W (exist_fe2213_32 x pf) = fe2213_32ZToW x.
+Proof. now hnf in x; destruct_head' prod. Qed.
+Lemma proj1_fe2213_32_exist_fe2213_32 x pf : proj1_fe2213_32 (exist_fe2213_32 x pf) = x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [proj1_fe2213_32 exist_fe2213_32 proj1_fe2213_32W fe2213_32WToZ proj_word Build_bounded_word Build_bounded_word'].
+  unfold_is_bounded_in pf.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Definition exist_wire_digitsW' (x : wire_digitsW)
+  : wire_digits_is_bounded (wire_digitsWToZ x) = true -> wire_digits.
+Proof. make_exist_W' x (@app_wire_digitsW_dep). Defined.
+Definition exist_wire_digitsW (x : wire_digitsW)
+  : wire_digits_is_bounded (wire_digitsWToZ x) = true -> wire_digits
+  := Eval cbv [app_wire_digitsW_dep exist_wire_digitsW' wire_digitsZToW] in exist_wire_digitsW' x.
+Definition exist_wire_digits'' (x : SpecificGen.GF2213_32.wire_digits)
+  : wire_digits_is_bounded x = true -> wire_digits.
+Proof. make_exist'' x exist_wire_digitsW wire_digitsZToW. Defined.
+Definition exist_wire_digits' (x : SpecificGen.GF2213_32.wire_digits)
+  : wire_digits_is_bounded x = true -> wire_digits.
+Proof. make_exist' x (@app_wire_digitsW_dep) exist_wire_digits'' exist_wire_digitsW wire_digitsZToW. Defined.
+Definition exist_wire_digits (x : SpecificGen.GF2213_32.wire_digits)
+  : wire_digits_is_bounded x = true -> wire_digits
+  := Eval cbv [exist_wire_digits' exist_wire_digitsW exist_wire_digits' app_wire_digits app_wire_digitsW_dep] in
+      exist_wire_digits' x.
+
+Lemma proj1_wire_digits_exist_wire_digitsW x pf : proj1_wire_digits (exist_wire_digitsW x pf) = wire_digitsWToZ x.
+Proof. now hnf in x; destruct_head' prod. Qed.
+Lemma proj1_wire_digitsW_exist_wire_digits x pf : proj1_wire_digitsW (exist_wire_digits x pf) = wire_digitsZToW x.
+Proof. now hnf in x; destruct_head' prod. Qed.
+Lemma proj1_wire_digits_exist_wire_digits x pf : proj1_wire_digits (exist_wire_digits x pf) = x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [proj1_wire_digits exist_wire_digits proj1_wire_digitsW wire_digitsWToZ proj_word Build_bounded_word Build_bounded_word' app_wire_digits HList.mapt HList.mapt' length wire_widths fst snd].
+  unfold_is_bounded_in pf.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Module opt.
+  Definition word64ToZ := Eval vm_compute in word64ToZ.
+  Definition word64ToN := Eval vm_compute in @wordToN bit_width.
+  Definition NToWord64 := Eval vm_compute in NToWord64.
+  Definition bit_width := Eval vm_compute in bit_width.
+  Definition Zleb := Eval cbv [Z.leb] in Z.leb.
+  Definition andb := Eval vm_compute in andb.
+  Definition word64ize := Eval vm_compute in word64ize.
+End opt.
+
+Local Transparent bit_width.
+Local Ltac do_change lem :=
+  match lem with
+  | context L[andb (?x <=? ?y)%Z (?y <=? ?z)]
+    => let x' := (eval vm_compute in x) in
+       let z' := (eval vm_compute in z) in
+       lazymatch y with
+       | word64ToZ (word64ize ?v)
+         => let y' := constr:(opt.word64ToZ (opt.word64ize v)) in
+            let L' := context L[andb (opt.Zleb x' y') (opt.Zleb y' z')] in
+            do_change L'
+       end
+  | _ => lem
+  end.
+Definition fe2213_32_word64ize (x : fe2213_32) : fe2213_32.
+Proof.
+  set (x' := x).
+  hnf in x; destruct_head' prod.
+  let lem := constr:(exist_fe2213_32W (fe2213_32W_word64ize (proj1_fe2213_32W x'))) in
+  let lem := (eval cbv [proj1_fe2213_32W x' fe2213_32W_word64ize proj_word exist_fe2213_32W Build_bounded_word' Build_bounded_word] in lem) in
+  let lem := do_change lem in
+  refine (lem _);
+    change (is_bounded (fe2213_32WToZ (fe2213_32W_word64ize (proj1_fe2213_32W x'))) = true);
+    abstract (rewrite fe2213_32W_word64ize_id; apply is_bounded_proj1_fe2213_32).
+Defined.
+Definition wire_digits_word64ize (x : wire_digits) : wire_digits.
+Proof.
+  set (x' := x).
+  hnf in x; destruct_head' prod.
+  let lem := constr:(exist_wire_digitsW (wire_digitsW_word64ize (proj1_wire_digitsW x'))) in
+  let lem := (eval cbv [proj1_wire_digitsW x' wire_digitsW_word64ize proj_word exist_wire_digitsW Build_bounded_word Build_bounded_word'] in lem) in
+  let lem := do_change lem in
+  let lem := (eval cbv [word64ize opt.word64ize andb Z.leb Z.compare CompOpp Pos.compare] in lem) in
+  refine (lem _);
+    change (wire_digits_is_bounded (wire_digitsWToZ (wire_digitsW_word64ize (proj1_wire_digitsW x'))) = true);
+    abstract (rewrite wire_digitsW_word64ize_id; apply is_bounded_proj1_wire_digits).
+Defined.
+
+Lemma is_bounded_to_nth_default x (H : is_bounded x = true)
+  : forall n : nat,
+    (n < length limb_widths)%nat
+    -> (0 <= nth_default 0 (Tuple.to_list length_fe2213_32 x) n <=
+        snd (b_of (nth_default (-1) limb_widths n)))%Z.
+Proof.
+  hnf in x; destruct_head' prod.
+  unfold_is_bounded_in H; destruct_head' and.
+  Z.ltb_to_lt.
+  unfold nth_default; simpl.
+  intros.
+  repeat match goal with
+         | [ |- context[nth_error _ ?x] ]
+           => is_var x; destruct x; simpl
+         end;
+    omega.
+Qed.
+
+(* END precomputation *)
+
+(* Precompute constants *)
+
+Definition one' := Eval vm_compute in exist_fe2213_32 SpecificGen.GF2213_32.one_ eq_refl.
+Definition one := Eval cbv [one' fe2213_32_word64ize word64ize andb opt.word64ToZ opt.word64ize opt.Zleb Z.compare CompOpp Pos.compare Pos.compare_cont] in fe2213_32_word64ize one'.
+
+Definition zero' := Eval vm_compute in exist_fe2213_32 SpecificGen.GF2213_32.zero_ eq_refl.
+Definition zero := Eval cbv [zero' fe2213_32_word64ize word64ize andb opt.word64ToZ opt.word64ize opt.Zleb Z.compare CompOpp Pos.compare Pos.compare_cont] in fe2213_32_word64ize zero'.
+
+Lemma fold_chain_opt_gen {A B} (F : A -> B) is_bounded ls id' op' id op chain
+      (Hid_bounded : is_bounded (F id') = true)
+      (Hid : id = F id')
+      (Hop_bounded : forall x y, is_bounded (F x) = true
+                                 -> is_bounded (F y) = true
+                                 -> is_bounded (op (F x) (F y)) = true)
+      (Hop : forall x y, is_bounded (F x) = true
+                         -> is_bounded (F y) = true
+                         -> op (F x) (F y) = F (op' x y))
+      (Hls_bounded : forall n, is_bounded (F (nth_default id' ls n)) = true)
+  : F (fold_chain_opt id' op' chain ls)
+    = fold_chain_opt id op chain (List.map F ls)
+    /\ is_bounded (F (fold_chain_opt id' op' chain ls)) = true.
+Proof.
+  rewrite !fold_chain_opt_correct.
+  revert dependent ls; induction chain as [|x xs IHxs]; intros.
+  { pose proof (Hls_bounded 0%nat).
+    destruct ls; simpl; split; trivial; congruence. }
+  { destruct x; simpl; unfold Let_In; simpl.
+    rewrite (fun ls pf => proj1 (IHxs ls pf)) at 1; simpl.
+    { do 2 f_equal.
+      rewrite <- Hop, Hid by auto.
+      rewrite !map_nth_default_always.
+      split; try reflexivity.
+      apply (IHxs (_::_)).
+      intros [|?]; autorewrite with simpl_nth_default; auto.
+      rewrite <- Hop; auto. }
+    { intros [|?]; simpl;
+        autorewrite with simpl_nth_default; auto.
+      rewrite <- Hop; auto. } }
+Qed.
+
+Lemma encode_bounded x : is_bounded (encode x) = true.
+Proof.
+  pose proof (bounded_encode x).
+  generalize dependent (encode x).
+  intro t; compute in t; intros.
+  destruct_head' prod.
+  unfold Pow2Base.bounded in H.
+  cbv [nth_default Tuple.to_list Tuple.to_list' List.length limb_widths params2213_32] in H.
+  repeat match type of H with
+         | context[nth_error (cons _ _) _]
+           => let H' := fresh in
+              pose proof (H O) as H'; specialize (fun i => H (S i)); simpl @nth_error in H, H';
+                cbv beta iota in H'
+         end.
+  clear H.
+  simpl in *.
+  cbv [Z.pow_pos Z.mul Pos.mul Pos.iter nth_default nth_error value] in *.
+  unfold is_bounded.
+  apply fold_right_andb_true_iff_fold_right_and_True.
+  cbv [is_bounded proj1_fe2213_32 to_list length bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map List.rev List.app proj_word fold_right length_fe2213_32].
+  repeat split; rewrite !Bool.andb_true_iff, !Z.leb_le; omega.
+Qed.
+
+Definition encode (x : F modulus) : fe2213_32
+  := exist_fe2213_32 (encode x) (encode_bounded x).
+
+Definition decode (x : fe2213_32) : F modulus
+  := ModularBaseSystem.decode (proj1_fe2213_32 x).
+
+Lemma proj1_fe2213_32_encode x
+  : proj1_fe2213_32 (encode x) = ModularBaseSystem.encode x.
+Proof.
+  cbv [encode].
+  generalize (encode_bounded x); generalize (ModularBaseSystem.encode x).
+  intros y pf; intros; hnf in y; destruct_head_hnf' prod.
+  cbv [proj1_fe2213_32 exist_fe2213_32 proj1_fe2213_32W Build_bounded_word Build_bounded_word' fe2213_32WToZ proj_word].
+  unfold_is_bounded_in pf.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Lemma decode_exist_fe2213_32 x pf
+  : decode (exist_fe2213_32 x pf) = ModularBaseSystem.decode x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [decode proj1_fe2213_32 exist_fe2213_32 proj1_fe2213_32W Build_bounded_word Build_bounded_word' fe2213_32WToZ proj_word].
+  unfold_is_bounded_in pf.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Definition div (f g : fe2213_32) : fe2213_32
+  := exist_fe2213_32 (div (proj1_fe2213_32 f) (proj1_fe2213_32 g)) (encode_bounded _).
+
+Definition eq (f g : fe2213_32) : Prop := eq (proj1_fe2213_32 f) (proj1_fe2213_32 g).
+
+
+Notation ibinop_correct_and_bounded irop op
+  := (forall x y,
+         is_bounded (fe2213_32WToZ x) = true
+         -> is_bounded (fe2213_32WToZ y) = true
+         -> fe2213_32WToZ (irop x y) = op (fe2213_32WToZ x) (fe2213_32WToZ y)
+            /\ is_bounded (fe2213_32WToZ (irop x y)) = true) (only parsing).
+Notation iunop_correct_and_bounded irop op
+  := (forall x,
+         is_bounded (fe2213_32WToZ x) = true
+         -> fe2213_32WToZ (irop x) = op (fe2213_32WToZ x)
+            /\ is_bounded (fe2213_32WToZ (irop x)) = true) (only parsing).
+Notation iunop_FEToZ_correct irop op
+  := (forall x,
+         is_bounded (fe2213_32WToZ x) = true
+         -> word64ToZ (irop x) = op (fe2213_32WToZ x)) (only parsing).
+Notation iunop_FEToWire_correct_and_bounded irop op
+  := (forall x,
+         is_bounded (fe2213_32WToZ x) = true
+         -> wire_digitsWToZ (irop x) = op (fe2213_32WToZ x)
+            /\ wire_digits_is_bounded (wire_digitsWToZ (irop x)) = true) (only parsing).
+Notation iunop_WireToFE_correct_and_bounded irop op
+  := (forall x,
+         wire_digits_is_bounded (wire_digitsWToZ x) = true
+         -> fe2213_32WToZ (irop x) = op (wire_digitsWToZ x)
+            /\ is_bounded (fe2213_32WToZ (irop x)) = true) (only parsing).
+
+Definition prefreeze := GF2213_32.prefreeze.
diff --git a/src/SpecificGen/GF2213_32Reflective.v b/src/SpecificGen/GF2213_32Reflective.v
new file mode 100644
index 000000000..840cfe090
--- /dev/null
+++ b/src/SpecificGen/GF2213_32Reflective.v
@@ -0,0 +1,119 @@
+Require Import Crypto.BaseSystem.
+Require Import Crypto.ModularArithmetic.PrimeFieldTheorems.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParams.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParamProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystem.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemOpt.
+Require Export Crypto.SpecificGen.GF2213_32.
+Require Import Crypto.SpecificGen.GF2213_32BoundedCommon.
+Require Import Crypto.Reflection.Reify.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Crypto.Reflection.Z.Interpretations.Relations.
+Require Import Crypto.Reflection.Z.Interpretations.RelationsCombinations.
+Require Import Crypto.Reflection.Z.Reify.
+Require Import Crypto.Reflection.Z.Syntax.
+Require Import Crypto.SpecificGen.GF2213_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF2213_32Reflective.Reified.
+Require Import Bedrock.Word Crypto.Util.WordUtil.
+Require Import Coq.Lists.List Crypto.Util.ListUtil.
+Require Import Crypto.Tactics.VerdiTactics.
+Require Import Crypto.Util.ZUtil.
+Require Import Crypto.Util.Tuple.
+Require Import Crypto.Util.Tactics.
+Require Import Crypto.Util.LetIn.
+Require Import Crypto.Util.Notations.
+Require Import Crypto.Util.Bool.
+Require Import Crypto.Util.Decidable.
+Require Import Crypto.Algebra.
+Import ListNotations.
+Require Import Coq.ZArith.ZArith Coq.ZArith.Zpower Coq.ZArith.ZArith Coq.ZArith.Znumtheory.
+Local Open Scope Z.
+
+Definition radd : ExprBinOp := Eval vm_compute in rcarry_addW.
+Definition rsub : ExprBinOp := Eval vm_compute in rcarry_subW.
+Definition rmul : ExprBinOp := Eval vm_compute in rmulW.
+Definition ropp : ExprUnOp := Eval vm_compute in rcarry_oppW.
+Definition rprefreeze : ExprUnOp := Eval vm_compute in rprefreezeW.
+Definition rge_modulus : ExprUnOpFEToZ := Eval vm_compute in rge_modulusW.
+Definition rpack : ExprUnOpFEToWire := Eval vm_compute in rpackW.
+Definition runpack : ExprUnOpWireToFE := Eval vm_compute in runpackW.
+
+Definition rword64ize {t} (x : Expr t) : Expr t
+  := MapInterp (fun t => match t with TZ => word64ize end) x.
+
+Declare Reduction asm_interp
+  := cbv beta iota delta
+         [id
+            interp_bexpr interp_uexpr interp_uexpr_FEToWire interp_uexpr_FEToZ interp_uexpr_WireToFE
+            radd rsub rmul ropp rprefreeze rge_modulus rpack runpack
+            curry_binop_fe2213_32W curry_unop_fe2213_32W curry_unop_wire_digitsW
+            Word64.interp_op Word64.interp_base_type
+            Z.interp_op Z.interp_base_type
+            Z.Syntax.interp_op Z.Syntax.interp_base_type
+            mapf_interp_flat_type map_interp Word64.interp_base_type MapInterp mapf_interp word64ize rword64ize
+            Interp interp interp_flat_type interpf interp_flat_type fst snd].
+Ltac asm_interp
+  := cbv beta iota delta
+         [id
+            interp_bexpr interp_uexpr interp_uexpr_FEToWire interp_uexpr_FEToZ interp_uexpr_WireToFE
+            radd rsub rmul ropp rprefreeze rge_modulus rpack runpack
+            curry_binop_fe2213_32W curry_unop_fe2213_32W curry_unop_wire_digitsW
+            Word64.interp_op Word64.interp_base_type
+            Z.interp_op Z.interp_base_type
+            Z.Syntax.interp_op Z.Syntax.interp_base_type
+            mapf_interp_flat_type map_interp Word64.interp_base_type MapInterp mapf_interp word64ize rword64ize
+            Interp interp interp_flat_type interpf interp_flat_type fst snd].
+
+
+Definition interp_radd : SpecificGen.GF2213_32BoundedCommon.fe2213_32W -> SpecificGen.GF2213_32BoundedCommon.fe2213_32W -> SpecificGen.GF2213_32BoundedCommon.fe2213_32W
+  := Eval asm_interp in interp_bexpr (rword64ize radd).
+(*Print interp_radd.*)
+Definition interp_radd_correct : interp_radd = interp_bexpr radd := eq_refl.
+Definition interp_rsub : SpecificGen.GF2213_32BoundedCommon.fe2213_32W -> SpecificGen.GF2213_32BoundedCommon.fe2213_32W -> SpecificGen.GF2213_32BoundedCommon.fe2213_32W
+  := Eval asm_interp in interp_bexpr (rword64ize rsub).
+(*Print interp_rsub.*)
+Definition interp_rsub_correct : interp_rsub = interp_bexpr rsub := eq_refl.
+Definition interp_rmul : SpecificGen.GF2213_32BoundedCommon.fe2213_32W -> SpecificGen.GF2213_32BoundedCommon.fe2213_32W -> SpecificGen.GF2213_32BoundedCommon.fe2213_32W
+  := Eval asm_interp in interp_bexpr (rword64ize rmul).
+(*Print interp_rmul.*)
+Definition interp_rmul_correct : interp_rmul = interp_bexpr rmul := eq_refl.
+Definition interp_ropp : SpecificGen.GF2213_32BoundedCommon.fe2213_32W -> SpecificGen.GF2213_32BoundedCommon.fe2213_32W
+  := Eval asm_interp in interp_uexpr (rword64ize ropp).
+(*Print interp_ropp.*)
+Definition interp_ropp_correct : interp_ropp = interp_uexpr ropp := eq_refl.
+Definition interp_rprefreeze : SpecificGen.GF2213_32BoundedCommon.fe2213_32W -> SpecificGen.GF2213_32BoundedCommon.fe2213_32W
+  := Eval asm_interp in interp_uexpr (rword64ize rprefreeze).
+(*Print interp_rprefreeze.*)
+Definition interp_rprefreeze_correct : interp_rprefreeze = interp_uexpr rprefreeze := eq_refl.
+
+Definition interp_rge_modulus : SpecificGen.GF2213_32BoundedCommon.fe2213_32W -> SpecificGen.GF2213_32BoundedCommon.word64
+  := Eval asm_interp in interp_uexpr_FEToZ (rword64ize rge_modulus).
+Definition interp_rge_modulus_correct : interp_rge_modulus = interp_uexpr_FEToZ rge_modulus := eq_refl.
+
+Definition interp_rpack : SpecificGen.GF2213_32BoundedCommon.fe2213_32W -> SpecificGen.GF2213_32BoundedCommon.wire_digitsW
+  := Eval asm_interp in interp_uexpr_FEToWire (rword64ize rpack).
+Definition interp_rpack_correct : interp_rpack = interp_uexpr_FEToWire rpack := eq_refl.
+
+Definition interp_runpack : SpecificGen.GF2213_32BoundedCommon.wire_digitsW -> SpecificGen.GF2213_32BoundedCommon.fe2213_32W
+  := Eval asm_interp in interp_uexpr_WireToFE (rword64ize runpack).
+Definition interp_runpack_correct : interp_runpack = interp_uexpr_WireToFE runpack := eq_refl.
+
+Lemma radd_correct_and_bounded : binop_correct_and_bounded radd carry_add.
+Proof. exact rcarry_addW_correct_and_bounded. Qed.
+Lemma rsub_correct_and_bounded : binop_correct_and_bounded rsub carry_sub.
+Proof. exact rcarry_subW_correct_and_bounded. Qed.
+Lemma rmul_correct_and_bounded : binop_correct_and_bounded rmul mul.
+Proof. exact rmulW_correct_and_bounded. Qed.
+Lemma ropp_correct_and_bounded : unop_correct_and_bounded ropp carry_opp.
+Proof. exact rcarry_oppW_correct_and_bounded. Qed.
+Lemma rprefreeze_correct_and_bounded : unop_correct_and_bounded rprefreeze prefreeze.
+Proof. exact rprefreezeW_correct_and_bounded. Qed.
+Lemma rge_modulus_correct_and_bounded : unop_FEToZ_correct rge_modulus ge_modulus.
+Proof. exact rge_modulusW_correct_and_bounded. Qed.
+Lemma rpack_correct_and_bounded : unop_FEToWire_correct_and_bounded rpack pack.
+Proof. exact rpackW_correct_and_bounded. Qed.
+Lemma runpack_correct_and_bounded : unop_WireToFE_correct_and_bounded runpack unpack.
+Proof. exact runpackW_correct_and_bounded. Qed.
diff --git a/src/SpecificGen/GF2213_32Reflective/Common.v b/src/SpecificGen/GF2213_32Reflective/Common.v
new file mode 100644
index 000000000..c01957df8
--- /dev/null
+++ b/src/SpecificGen/GF2213_32Reflective/Common.v
@@ -0,0 +1,438 @@
+Require Export Coq.ZArith.ZArith.
+Require Export Coq.Strings.String.
+Require Export Crypto.SpecificGen.GF2213_32.
+Require Export Crypto.SpecificGen.GF2213_32BoundedCommon.
+Require Import Crypto.Reflection.Reify.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Crypto.Reflection.Z.Interpretations.Relations.
+Require Import Crypto.Reflection.Z.Interpretations.RelationsCombinations.
+Require Import Crypto.Reflection.Z.Reify.
+Require Export Crypto.Reflection.Z.Syntax.
+Require Import Crypto.Reflection.InterpWfRel.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Reflection.MapInterpWf.
+Require Import Crypto.Reflection.WfReflective.
+Require Import Crypto.Util.LetIn.
+Require Import Crypto.Util.ZUtil.
+Require Import Crypto.Util.Tactics.
+Require Import Crypto.Util.Notations.
+
+Notation Expr := (Expr base_type Word64.interp_base_type op).
+
+Local Ltac make_type_from uncurried_op :=
+  let T := (type of uncurried_op) in
+  let T := (eval compute in T) in
+  let rT := reify_type T in
+  exact rT.
+
+Definition ExprBinOpT : type base_type.
+Proof. make_type_from (uncurry_binop_fe2213_32 carry_add). Defined.
+Definition ExprUnOpT : type base_type.
+Proof. make_type_from (uncurry_unop_fe2213_32 carry_opp). Defined.
+Definition ExprUnOpFEToZT : type base_type.
+Proof. make_type_from (uncurry_unop_fe2213_32 ge_modulus). Defined.
+Definition ExprUnOpWireToFET : type base_type.
+Proof. make_type_from (uncurry_unop_wire_digits unpack). Defined.
+Definition ExprUnOpFEToWireT : type base_type.
+Proof. make_type_from (uncurry_unop_fe2213_32 pack). Defined.
+Definition ExprBinOp : Type := Expr ExprBinOpT.
+Definition ExprUnOp : Type := Expr ExprUnOpT.
+Definition ExprUnOpFEToZ : Type := Expr ExprUnOpFEToZT.
+Definition ExprUnOpWireToFE : Type := Expr ExprUnOpWireToFET.
+Definition ExprUnOpFEToWire : Type := Expr ExprUnOpFEToWireT.
+
+Local Ltac bounds_from_list ls :=
+  lazymatch (eval hnf in ls) with
+  | (?x :: nil)%list => constr:(Some {| ZBounds.lower := fst x ; ZBounds.upper := snd x |})
+  | (?x :: ?xs)%list => let bs := bounds_from_list xs in
+                        constr:((Some {| ZBounds.lower := fst x ; ZBounds.upper := snd x |}, bs))
+  end.
+
+Local Ltac make_bounds ls :=
+  compute;
+  let v := bounds_from_list (List.rev ls) in
+  let v := (eval compute in v) in
+  exact v.
+
+Definition ExprBinOp_bounds : interp_all_binders_for ExprBinOpT ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ bounds ++ Tuple.to_list _ bounds)%list. Defined.
+Definition ExprUnOp_bounds : interp_all_binders_for ExprUnOpT ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ bounds). Defined.
+Definition ExprUnOpFEToZ_bounds : interp_all_binders_for ExprUnOpFEToZT ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ bounds). Defined.
+Definition ExprUnOpFEToWire_bounds : interp_all_binders_for ExprUnOpFEToWireT ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ bounds). Defined.
+Definition ExprUnOpWireToFE_bounds : interp_all_binders_for ExprUnOpWireToFET ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ wire_digit_bounds). Defined.
+
+Definition interp_bexpr : ExprBinOp -> SpecificGen.GF2213_32BoundedCommon.fe2213_32W -> SpecificGen.GF2213_32BoundedCommon.fe2213_32W -> SpecificGen.GF2213_32BoundedCommon.fe2213_32W
+  := fun e => curry_binop_fe2213_32W (Interp (@Word64.interp_op) e).
+Definition interp_uexpr : ExprUnOp -> SpecificGen.GF2213_32BoundedCommon.fe2213_32W -> SpecificGen.GF2213_32BoundedCommon.fe2213_32W
+  := fun e => curry_unop_fe2213_32W (Interp (@Word64.interp_op) e).
+Definition interp_uexpr_FEToZ : ExprUnOpFEToZ -> SpecificGen.GF2213_32BoundedCommon.fe2213_32W -> SpecificGen.GF2213_32BoundedCommon.word64
+  := fun e => curry_unop_fe2213_32W (Interp (@Word64.interp_op) e).
+Definition interp_uexpr_FEToWire : ExprUnOpFEToWire -> SpecificGen.GF2213_32BoundedCommon.fe2213_32W -> SpecificGen.GF2213_32BoundedCommon.wire_digitsW
+  := fun e => curry_unop_fe2213_32W (Interp (@Word64.interp_op) e).
+Definition interp_uexpr_WireToFE : ExprUnOpWireToFE -> SpecificGen.GF2213_32BoundedCommon.wire_digitsW -> SpecificGen.GF2213_32BoundedCommon.fe2213_32W
+  := fun e => curry_unop_wire_digitsW (Interp (@Word64.interp_op) e).
+
+Notation binop_correct_and_bounded rop op
+  := (ibinop_correct_and_bounded (interp_bexpr rop) op) (only parsing).
+Notation unop_correct_and_bounded rop op
+  := (iunop_correct_and_bounded (interp_uexpr rop) op) (only parsing).
+Notation unop_FEToZ_correct rop op
+  := (iunop_FEToZ_correct (interp_uexpr_FEToZ rop) op) (only parsing).
+Notation unop_FEToWire_correct_and_bounded rop op
+  := (iunop_FEToWire_correct_and_bounded (interp_uexpr_FEToWire rop) op) (only parsing).
+Notation unop_WireToFE_correct_and_bounded rop op
+  := (iunop_WireToFE_correct_and_bounded (interp_uexpr_WireToFE rop) op) (only parsing).
+
+Ltac rexpr_cbv :=
+  lazymatch goal with
+  | [ |- { rexpr | interp_type_gen_rel_pointwise _ (Interp _ (t:=?T) rexpr) (?uncurry ?oper) } ]
+    => let operf := head oper in
+       let uncurryf := head uncurry in
+       try cbv delta [T]; try cbv delta [oper];
+       try cbv beta iota delta [uncurryf]
+  end;
+  cbv beta iota delta [interp_flat_type Z.interp_base_type interp_base_type zero_].
+
+Ltac reify_sig :=
+  rexpr_cbv; eexists; Reify_rhs; reflexivity.
+
+Local Notation rexpr_sig T uncurried_op :=
+  { rexprZ
+  | interp_type_gen_rel_pointwise (fun _ => Logic.eq) (Interp interp_op (t:=T) rexprZ) uncurried_op }
+    (only parsing).
+
+Notation rexpr_binop_sig op := (rexpr_sig ExprBinOpT (uncurry_binop_fe2213_32 op)) (only parsing).
+Notation rexpr_unop_sig op := (rexpr_sig ExprUnOpT (uncurry_unop_fe2213_32 op)) (only parsing).
+Notation rexpr_unop_FEToZ_sig op := (rexpr_sig ExprUnOpFEToZT (uncurry_unop_fe2213_32 op)) (only parsing).
+Notation rexpr_unop_FEToWire_sig op := (rexpr_sig ExprUnOpFEToWireT (uncurry_unop_fe2213_32 op)) (only parsing).
+Notation rexpr_unop_WireToFE_sig op := (rexpr_sig ExprUnOpWireToFET (uncurry_unop_wire_digits op)) (only parsing).
+
+Notation correct_and_bounded_genT ropW'v ropZ_sigv
+  := (let ropW' := ropW'v in
+      let ropZ_sig := ropZ_sigv in
+      let ropW := MapInterp (fun _ x => x) ropW' in
+      let ropZ := MapInterp Word64.to_Z ropW' in
+      let ropBounds := MapInterp ZBounds.of_word64 ropW' in
+      let ropBoundedWord64 := MapInterp BoundedWord64.of_word64 ropW' in
+      ropZ = proj1_sig ropZ_sig
+      /\ interp_type_rel_pointwise2 Relations.related_Z (Interp (@BoundedWord64.interp_op) ropBoundedWord64) (Interp (@Z.interp_op) ropZ)
+      /\ interp_type_rel_pointwise2 Relations.related_bounds (Interp (@BoundedWord64.interp_op) ropBoundedWord64) (Interp (@ZBounds.interp_op) ropBounds)
+      /\ interp_type_rel_pointwise2 Relations.related_word64 (Interp (@BoundedWord64.interp_op) ropBoundedWord64) (Interp (@Word64.interp_op) ropW))
+       (only parsing).
+
+Ltac app_tuples x y :=
+  let tx := type of x in
+  lazymatch (eval hnf in tx) with
+  | prod _ _ => let xs := app_tuples (snd x) y in
+                constr:((fst x, xs))
+  | _ => constr:((x, y))
+  end.
+
+Local Arguments Tuple.map2 : simpl never.
+Local Arguments Tuple.map : simpl never.
+
+Fixpoint args_to_bounded_helperT {n}
+         (v : Tuple.tuple' Word64.word64 n)
+         (bounds : Tuple.tuple' (Z * Z) n)
+         (pf : List.fold_right
+                 andb true
+                 (Tuple.to_list
+                    _
+                    (Tuple.map2
+                       (n:=S n)
+                       (fun bounds v =>
+                          let '(lower, upper) := bounds in ((lower <=? v)%Z && (v <=? upper)%Z)%bool)
+                       bounds
+                       (Tuple.map (n:=S n) Word64.word64ToZ v))) = true)
+         (res : Type)
+         {struct n}
+  : Type.
+Proof.
+  refine (match n return (forall (v : Tuple.tuple' _ n) (bounds : Tuple.tuple' _ n),
+                             List.fold_right
+                               _ _ (Tuple.to_list
+                                      _
+                                      (Tuple.map2 (n:=S n) _ bounds (Tuple.map (n:=S n) _ v))) = true
+                             -> Type)
+          with
+          | 0 => fun v' bounds' pf0 => forall pf1 : (0 <= fst bounds' /\ Z.log2 (snd bounds') < Z.of_nat Word64.bit_width)%Z, res
+          | S n' => fun v' bounds' pf0 => let t := _ in
+                                        forall pf1 : (0 <= fst (snd bounds') /\ Z.log2 (snd (snd bounds')) < Z.of_nat Word64.bit_width)%Z, @args_to_bounded_helperT n' (fst v') (fst bounds') t res
+          end v bounds pf).
+  { clear -pf0.
+    abstract (
+        destruct v', bounds'; simpl @fst;
+        rewrite Tuple.map_S in pf0;
+        simpl in pf0;
+        rewrite Tuple.map2_S in pf0;
+        simpl @List.fold_right in *;
+        rewrite Bool.andb_true_iff in pf0; tauto
+      ). }
+Defined.
+
+Fixpoint args_to_bounded_helper {n} res
+         {struct n}
+  : forall v bounds pf, (Tuple.tuple' BoundedWord64.BoundedWord n -> res) -> @args_to_bounded_helperT n v bounds pf res.
+Proof.
+  refine match n return (forall v bounds pf, (Tuple.tuple' BoundedWord64.BoundedWord n -> res) -> @args_to_bounded_helperT n v bounds pf res) with
+         | 0 => fun v bounds pf f pf' => f {| BoundedWord64.lower := fst bounds ; BoundedWord64.value := v ; BoundedWord64.upper := snd bounds |}
+         | S n'
+           => fun v bounds pf f pf'
+              => @args_to_bounded_helper
+                   n' res (fst v) (fst bounds) _
+                   (fun ts => f (ts, {| BoundedWord64.lower := fst (snd bounds) ; BoundedWord64.value := snd v ; BoundedWord64.upper := snd (snd bounds) |}))
+         end.
+  { clear -pf pf'.
+    unfold Tuple.map2, Tuple.map in pf; simpl in *.
+    abstract (
+        destruct bounds;
+        simpl in *;
+        rewrite !Bool.andb_true_iff in pf;
+        destruct_head' and;
+        Z.ltb_to_lt; auto
+      ). }
+  { simpl in *.
+    clear -pf pf'.
+    abstract (
+        destruct bounds as [? [? ?] ], v; simpl in *;
+        rewrite Tuple.map_S in pf; simpl in pf; rewrite Tuple.map2_S in pf;
+        simpl in pf;
+        rewrite !Bool.andb_true_iff in pf;
+        destruct_head' and;
+        Z.ltb_to_lt; auto
+      ). }
+Defined.
+
+Definition assoc_right''
+  := Eval cbv [Tuple.assoc_right' Tuple.rsnoc' fst snd] in @Tuple.assoc_right'.
+
+Definition args_to_bounded {n} v bounds pf
+  := Eval cbv [args_to_bounded_helper assoc_right''] in
+      @args_to_bounded_helper n _ v bounds pf (@assoc_right'' _ _).
+
+Local Ltac get_len T :=
+  match (eval hnf in T) with
+  | prod ?A ?B
+    => let a := get_len A in
+       let b := get_len B in
+       (eval compute in (a + b)%nat)
+  | _ => constr:(1%nat)
+  end.
+
+Local Ltac args_to_bounded x H :=
+  let x' := fresh in
+  set (x' := x);
+  compute in x;
+  let len := (let T := type of x in get_len T) in
+  destruct_head' prod;
+  let c := constr:(args_to_bounded (n:=pred len) x' _ H) in
+  let bounds := lazymatch c with args_to_bounded _ ?bounds _ => bounds end in
+  let c := (eval cbv [all_binders_for ExprUnOpT interp_flat_type args_to_bounded bounds pred fst snd] in c) in
+  apply c; compute; clear;
+  try abstract (
+        repeat split;
+        solve [ reflexivity
+              | refine (fun v => match v with eq_refl => I end) ]
+      ).
+
+Definition unop_args_to_bounded (x : fe2213_32W) (H : is_bounded (fe2213_32WToZ x) = true)
+  : interp_flat_type (fun _ => BoundedWord64.BoundedWord) (all_binders_for ExprUnOpT).
+Proof. args_to_bounded x H. Defined.
+
+Definition unopWireToFE_args_to_bounded (x : wire_digitsW) (H : wire_digits_is_bounded (wire_digitsWToZ x) = true)
+  : interp_flat_type (fun _ => BoundedWord64.BoundedWord) (all_binders_for ExprUnOpWireToFET).
+Proof. args_to_bounded x H. Defined.
+Definition binop_args_to_bounded (x : fe2213_32W * fe2213_32W)
+           (H : is_bounded (fe2213_32WToZ (fst x)) = true)
+           (H' : is_bounded (fe2213_32WToZ (snd x)) = true)
+  : interp_flat_type (fun _ => BoundedWord64.BoundedWord) (all_binders_for ExprBinOpT).
+Proof.
+  let v := app_tuples (unop_args_to_bounded (fst x) H) (unop_args_to_bounded (snd x) H') in
+  exact v.
+Defined.
+
+Ltac assoc_right_tuple x so_far :=
+  let t := type of x in
+  lazymatch (eval hnf in t) with
+  | prod _ _ => let so_far := assoc_right_tuple (snd x) so_far in
+                assoc_right_tuple (fst x) so_far
+  | _ => lazymatch so_far with
+         | @None => x
+         | _ => constr:((x, so_far))
+         end
+  end.
+
+Local Ltac make_bounds_prop bounds orig_bounds :=
+  let bounds' := fresh "bounds'" in
+  let bounds_bad := fresh "bounds_bad" in
+  rename bounds into bounds_bad;
+  let boundsv := assoc_right_tuple bounds_bad (@None) in
+  pose boundsv as bounds;
+  pose orig_bounds as bounds';
+  repeat (refine (match fst bounds' with
+                  | Some bounds' => let (l, u) := fst bounds in
+                                    let (l', u') := bounds' in
+                                    ((l' <=? l) && (u <=? u'))%Z%bool
+                  | None => false
+                  end && _)%bool;
+          destruct bounds' as [_ bounds'], bounds as [_ bounds]);
+  try exact (match bounds' with
+             | Some bounds' => let (l, u) := bounds in
+                               let (l', u') := bounds' in
+                               ((l' <=? l) && (u <=? u'))%Z%bool
+             | None => false
+             end).
+
+Definition unop_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprUnOpT)) : bool.
+Proof. make_bounds_prop bounds ExprUnOp_bounds. Defined.
+Definition binop_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprBinOpT)) : bool.
+Proof. make_bounds_prop bounds ExprUnOp_bounds. Defined.
+Definition unopFEToWire_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprUnOpFEToWireT)) : bool.
+Proof. make_bounds_prop bounds ExprUnOpWireToFE_bounds. Defined.
+Definition unopWireToFE_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprUnOpWireToFET)) : bool.
+Proof. make_bounds_prop bounds ExprUnOp_bounds. Defined.
+(* TODO FIXME(jgross?, andreser?): Is every function returning a single Z a boolean function? *)
+Definition unopFEToZ_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprUnOpFEToZT)) : bool.
+Proof.
+  refine (let (l, u) := bounds in ((0 <=? l) && (u <=? 1))%Z%bool).
+Defined.
+
+(* FIXME TODO(jgross): This is a horrible tactic.  We should unify the
+    various kinds of correct and boundedness, and abstract in Gallina
+    rather than Ltac *)
+
+Ltac t_correct_and_bounded ropZ_sig Hbounds H0 H1 args :=
+  let Heq := fresh "Heq" in
+  let Hbounds0 := fresh "Hbounds0" in
+  let Hbounds1 := fresh "Hbounds1" in
+  let Hbounds2 := fresh "Hbounds2" in
+  pose proof (proj2_sig ropZ_sig) as Heq;
+  cbv [interp_bexpr interp_uexpr interp_uexpr_FEToWire interp_uexpr_FEToZ interp_uexpr_WireToFE
+                    curry_binop_fe2213_32W curry_unop_fe2213_32W curry_unop_wire_digitsW
+                    curry_binop_fe2213_32 curry_unop_fe2213_32 curry_unop_wire_digits
+                    uncurry_binop_fe2213_32W uncurry_unop_fe2213_32W uncurry_unop_wire_digitsW
+                    uncurry_binop_fe2213_32 uncurry_unop_fe2213_32 uncurry_unop_wire_digits
+                    ExprBinOpT ExprUnOpFEToWireT ExprUnOpT ExprUnOpFEToZT ExprUnOpWireToFET
+                    interp_type_gen_rel_pointwise interp_type_gen_rel_pointwise] in *;
+  cbv zeta in *;
+  simpl @fe2213_32WToZ; simpl @wire_digitsWToZ;
+  rewrite <- Heq; clear Heq;
+  destruct Hbounds as [Heq Hbounds];
+  change interp_op with (@Z.interp_op) in *;
+  change interp_base_type with (@Z.interp_base_type) in *;
+  rewrite <- Heq; clear Heq;
+  destruct Hbounds as [ Hbounds0 [Hbounds1 Hbounds2] ];
+  pose proof (fun pf => Relations.uncurry_interp_type_rel_pointwise2_proj_from_option2 Word64.to_Z pf Hbounds2 Hbounds0) as Hbounds_left;
+  pose proof (fun pf => Relations.uncurry_interp_type_rel_pointwise2_proj1_from_option2 Relations.related_word64_boundsi' pf Hbounds1 Hbounds2) as Hbounds_right;
+  specialize_by repeat first [ progress intros
+                             | reflexivity
+                             | assumption
+                             | progress destruct_head' base_type
+                             | progress destruct_head' BoundedWord64.BoundedWord
+                             | progress destruct_head' and
+                             | progress repeat apply conj ];
+  specialize (Hbounds_left args H0);
+  specialize (Hbounds_right args H0);
+  cbv beta in *;
+  lazymatch type of Hbounds_right with
+  | match ?e with _ => _ end
+    => lazymatch type of H1 with
+       | match ?e' with _ => _ end
+         => change e' with e in H1; destruct e eqn:?; [ | exfalso; assumption ]
+       end
+  end;
+  repeat match goal with x := _ |- _ => subst x end;
+  cbv [id
+         binop_args_to_bounded unop_args_to_bounded unopWireToFE_args_to_bounded
+         Relations.proj_eq_rel interp_flat_type_rel_pointwise2 SmartVarfMap interp_flat_type smart_interp_flat_map Application.all_binders_for fst snd BoundedWord64.to_word64' BoundedWord64.boundedWordToWord64 BoundedWord64.value Application.ApplyInterpedAll Application.fst_binder Application.snd_binder interp_flat_type_rel_pointwise2_gen_Prop Relations.related_word64_boundsi' Relations.related'_word64_bounds ZBounds.upper ZBounds.lower Application.remove_all_binders Word64.to_Z] in Hbounds_left, Hbounds_right;
+  match goal with
+  | [ |- fe2213_32WToZ ?x = _ /\ _ ]
+    => destruct x; destruct_head_hnf' prod
+  | [ |- wire_digitsWToZ ?x = _ /\ _ ]
+    => destruct x; destruct_head_hnf' prod
+  | [ |- _ = _ ]
+    => exact Hbounds_left
+  end;
+  change word64ToZ with Word64.word64ToZ in *;
+  (split; [ exact Hbounds_left | ]);
+  cbv [interp_flat_type] in *;
+  cbv [fst snd
+           binop_bounds_good unop_bounds_good unopFEToWire_bounds_good unopWireToFE_bounds_good unopFEToZ_bounds_good
+           ExprUnOp_bounds ExprBinOp_bounds ExprUnOpFEToWire_bounds ExprUnOpFEToZ_bounds ExprUnOpWireToFE_bounds] in H1;
+  destruct_head' ZBounds.bounds;
+  unfold_is_bounded_in H1;
+  simpl @fe2213_32WToZ; simpl @wire_digitsWToZ;
+  unfold_is_bounded;
+  destruct_head' and;
+  Z.ltb_to_lt;
+  change Word64.word64ToZ with word64ToZ in *;
+  repeat apply conj; Z.ltb_to_lt; try omega; try reflexivity.
+
+
+Ltac rexpr_correct :=
+  let ropW' := fresh in
+  let ropZ_sig := fresh in
+  intros ropW' ropZ_sig;
+  let wf_ropW := fresh "wf_ropW" in
+  assert (wf_ropW : Wf ropW') by (subst ropW' ropZ_sig; reflect_Wf base_type_eq_semidec_is_dec op_beq_bl);
+  cbv zeta; repeat apply conj;
+  [ vm_compute; reflexivity
+  | apply @InterpRelWf;
+    [ | apply @RelWfMapInterp, wf_ropW ].. ];
+  auto with interp_related.
+
+Notation rword_of_Z rexprZ_sig := (MapInterp Word64.of_Z (proj1_sig rexprZ_sig)) (only parsing).
+
+Notation compute_bounds opW bounds
+  := (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp (@ZBounds.of_word64) opW)) bounds)
+       (only parsing).
+
+
+Module Export PrettyPrinting.
+  (* We add [enlargen] to force [bounds_on] to be in [Type] in 8.4 and
+     8.5/8.6.  Because [Set] is special and things break if
+     [bounds_on] ends up in [Set] for reasons jgross hasn't bothered
+     to debug. *)
+  Inductive bounds_on := overflow | in_range (lower upper : Z) | enlargen (_ : Set).
+
+  Inductive result := yes | no | borked.
+
+  Definition ZBounds_to_bounds_on
+    := fun t : base_type
+       => match t return ZBounds.interp_base_type t -> match t with TZ => bounds_on end with
+          | TZ => fun x => match x with
+                           | Some {| ZBounds.lower := l ; ZBounds.upper := u |}
+                             => in_range l u
+                           | None
+                             => overflow
+                           end
+          end.
+
+  Fixpoint does_it_overflow {t} : interp_flat_type (fun t => match t with TZ => bounds_on end) t -> result
+    := match t return interp_flat_type (fun t => match t with TZ => bounds_on end) t -> result with
+       | Tbase TZ => fun v => match v with
+                              | overflow => yes
+                              | in_range _ _ => no
+                              | enlargen _ => borked
+                              end
+       | Prod x y => fun v => match @does_it_overflow _ (fst v), @does_it_overflow _ (snd v) with
+                              | no, no => no
+                              | yes, no | no, yes | yes, yes => yes
+                              | borked, _ | _, borked => borked
+                              end
+       end.
+
+  (** This gives a slightly easier to read version of the bounds *)
+  Notation compute_bounds_for_display opW bounds
+    := (SmartVarfMap ZBounds_to_bounds_on (compute_bounds opW bounds)) (only parsing).
+  Notation sanity_compute opW bounds
+    := (does_it_overflow (SmartVarfMap ZBounds_to_bounds_on (compute_bounds opW bounds))) (only parsing).
+  Notation sanity_check opW bounds
+    := (eq_refl (sanity_compute opW bounds) <: no = no) (only parsing).
+End PrettyPrinting.
diff --git a/src/SpecificGen/GF2213_32Reflective/CommonBinOp.v b/src/SpecificGen/GF2213_32Reflective/CommonBinOp.v
new file mode 100644
index 000000000..be248d708
--- /dev/null
+++ b/src/SpecificGen/GF2213_32Reflective/CommonBinOp.v
@@ -0,0 +1,50 @@
+Require Export Crypto.SpecificGen.GF2213_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF2213_32BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprBinOp_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_binop_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall xy
+                   (xy := (eta_fe2213_32W (fst xy), eta_fe2213_32W (snd xy)))
+                   (Hxy : is_bounded (fe2213_32WToZ (fst xy)) = true
+                          /\ is_bounded (fe2213_32WToZ (snd xy)) = true),
+          let Hx := let (Hx, Hy) := Hxy in Hx in
+          let Hy := let (Hx, Hy) := Hxy in Hy in
+          let args := binop_args_to_bounded xy Hx Hy in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall xy
+                   (xy := (eta_fe2213_32W (fst xy), eta_fe2213_32W (snd xy)))
+                   (Hxy : is_bounded (fe2213_32WToZ (fst xy)) = true
+                          /\ is_bounded (fe2213_32WToZ (snd xy)) = true),
+          let Hx := let (Hx, Hy) := Hxy in Hx in
+          let Hy := let (Hx, Hy) := Hxy in Hy in
+          let args := binop_args_to_bounded (fst xy, snd xy) Hx Hy in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => binop_bounds_good bounds = true
+          | None => False
+          end)
+  : binop_correct_and_bounded (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x y Hx Hy.
+  pose x as x'; pose y as y'.
+  hnf in x, y; destruct_head' prod.
+  specialize (H0 (x', y') (conj Hx Hy)).
+  specialize (H1 (x', y') (conj Hx Hy)).
+  let args := constr:(binop_args_to_bounded (x', y') Hx Hy) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF2213_32Reflective/CommonUnOp.v b/src/SpecificGen/GF2213_32Reflective/CommonUnOp.v
new file mode 100644
index 000000000..3d52bcf78
--- /dev/null
+++ b/src/SpecificGen/GF2213_32Reflective/CommonUnOp.v
@@ -0,0 +1,44 @@
+Require Export Crypto.SpecificGen.GF2213_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF2213_32BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprUnOp_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_unop_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall x
+                   (x := eta_fe2213_32W x)
+                   (Hx : is_bounded (fe2213_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall x
+                   (x := eta_fe2213_32W x)
+                   (Hx : is_bounded (fe2213_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => unop_bounds_good bounds = true
+          | None => False
+          end)
+  : unop_correct_and_bounded (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x Hx.
+  pose x as x'.
+  hnf in x; destruct_head' prod.
+  specialize (H0 x' Hx).
+  specialize (H1 x' Hx).
+  let args := constr:(unop_args_to_bounded x' Hx) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF2213_32Reflective/CommonUnOpFEToWire.v b/src/SpecificGen/GF2213_32Reflective/CommonUnOpFEToWire.v
new file mode 100644
index 000000000..a08efcfd8
--- /dev/null
+++ b/src/SpecificGen/GF2213_32Reflective/CommonUnOpFEToWire.v
@@ -0,0 +1,44 @@
+Require Export Crypto.SpecificGen.GF2213_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF2213_32BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprUnOpFEToWire_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_unop_FEToWire_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall x
+                   (x := eta_fe2213_32W x)
+                   (Hx : is_bounded (fe2213_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall x
+                   (x := eta_fe2213_32W x)
+                   (Hx : is_bounded (fe2213_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => unopFEToWire_bounds_good bounds = true
+          | None => False
+          end)
+  : unop_FEToWire_correct_and_bounded (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x Hx.
+  pose x as x'.
+  hnf in x; destruct_head' prod.
+  specialize (H0 x' Hx).
+  specialize (H1 x' Hx).
+  let args := constr:(unop_args_to_bounded x' Hx) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF2213_32Reflective/CommonUnOpFEToZ.v b/src/SpecificGen/GF2213_32Reflective/CommonUnOpFEToZ.v
new file mode 100644
index 000000000..1f3a5f8a0
--- /dev/null
+++ b/src/SpecificGen/GF2213_32Reflective/CommonUnOpFEToZ.v
@@ -0,0 +1,44 @@
+Require Export Crypto.SpecificGen.GF2213_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF2213_32BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprUnOpFEToZ_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_unop_FEToZ_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall x
+                   (x := eta_fe2213_32W x)
+                   (Hx : is_bounded (fe2213_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall x
+                   (x := eta_fe2213_32W x)
+                   (Hx : is_bounded (fe2213_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => unopFEToZ_bounds_good bounds = true
+          | None => False
+          end)
+  : unop_FEToZ_correct (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x Hx.
+  pose x as x'.
+  hnf in x; destruct_head' prod.
+  specialize (H0 x' Hx).
+  specialize (H1 x' Hx).
+  let args := constr:(unop_args_to_bounded x' Hx) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF2213_32Reflective/CommonUnOpWireToFE.v b/src/SpecificGen/GF2213_32Reflective/CommonUnOpWireToFE.v
new file mode 100644
index 000000000..727936a13
--- /dev/null
+++ b/src/SpecificGen/GF2213_32Reflective/CommonUnOpWireToFE.v
@@ -0,0 +1,44 @@
+Require Export Crypto.SpecificGen.GF2213_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF2213_32BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprUnOpWireToFE_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_unop_WireToFE_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall x
+                   (x := eta_wire_digitsW x)
+                   (Hx : wire_digits_is_bounded (wire_digitsWToZ x) = true),
+          let args := unopWireToFE_args_to_bounded x Hx in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall x
+                   (x := eta_wire_digitsW x)
+                   (Hx : wire_digits_is_bounded (wire_digitsWToZ x) = true),
+          let args := unopWireToFE_args_to_bounded x Hx in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => unopWireToFE_bounds_good bounds = true
+          | None => False
+          end)
+  : unop_WireToFE_correct_and_bounded (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x Hx.
+  pose x as x'.
+  hnf in x; destruct_head' prod.
+  specialize (H0 x' Hx).
+  specialize (H1 x' Hx).
+  let args := constr:(unopWireToFE_args_to_bounded x' Hx) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF2213_32Reflective/Reified.v b/src/SpecificGen/GF2213_32Reflective/Reified.v
new file mode 100644
index 000000000..445c5d28d
--- /dev/null
+++ b/src/SpecificGen/GF2213_32Reflective/Reified.v
@@ -0,0 +1,13 @@
+(** We split the reification up into separate files, one operation per
+    file, so that it can run in parallel. *)
+Require Export Crypto.SpecificGen.GF2213_32Reflective.Reified.Add.
+Require Export Crypto.SpecificGen.GF2213_32Reflective.Reified.CarryAdd.
+Require Export Crypto.SpecificGen.GF2213_32Reflective.Reified.Sub.
+Require Export Crypto.SpecificGen.GF2213_32Reflective.Reified.CarrySub.
+Require Export Crypto.SpecificGen.GF2213_32Reflective.Reified.Mul.
+Require Export Crypto.SpecificGen.GF2213_32Reflective.Reified.Opp.
+Require Export Crypto.SpecificGen.GF2213_32Reflective.Reified.CarryOpp.
+Require Export Crypto.SpecificGen.GF2213_32Reflective.Reified.PreFreeze.
+Require Export Crypto.SpecificGen.GF2213_32Reflective.Reified.GeModulus.
+Require Export Crypto.SpecificGen.GF2213_32Reflective.Reified.Pack.
+Require Export Crypto.SpecificGen.GF2213_32Reflective.Reified.Unpack.
diff --git a/src/SpecificGen/GF2213_32Reflective/Reified/Add.v b/src/SpecificGen/GF2213_32Reflective/Reified/Add.v
new file mode 100644
index 000000000..d278a8f26
--- /dev/null
+++ b/src/SpecificGen/GF2213_32Reflective/Reified/Add.v
@@ -0,0 +1,12 @@
+Require Import Crypto.SpecificGen.GF2213_32Reflective.CommonBinOp.
+
+Definition raddZ_sig : rexpr_binop_sig add. Proof. reify_sig. Defined.
+Definition raddW := Eval vm_compute in rword_of_Z raddZ_sig.
+Lemma raddW_correct_and_bounded_gen : correct_and_bounded_genT raddW raddZ_sig.
+Proof. rexpr_correct. Qed.
+Definition radd_output_bounds := Eval vm_compute in compute_bounds raddW ExprBinOp_bounds.
+
+Local Open Scope string_scope.
+Compute ("Add", compute_bounds_for_display raddW ExprBinOp_bounds).
+Compute ("Add overflows? ", sanity_compute raddW ExprBinOp_bounds).
+Compute ("Add overflows (error if it does)? ", sanity_check raddW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF2213_32Reflective/Reified/CarryAdd.v b/src/SpecificGen/GF2213_32Reflective/Reified/CarryAdd.v
new file mode 100644
index 000000000..516a36bf5
--- /dev/null
+++ b/src/SpecificGen/GF2213_32Reflective/Reified/CarryAdd.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF2213_32Reflective.CommonBinOp.
+
+Definition rcarry_addZ_sig : rexpr_binop_sig carry_add. Proof. reify_sig. Defined.
+Definition rcarry_addW := Eval vm_compute in rword_of_Z rcarry_addZ_sig.
+Lemma rcarry_addW_correct_and_bounded_gen : correct_and_bounded_genT rcarry_addW rcarry_addZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rcarry_add_output_bounds := Eval vm_compute in compute_bounds rcarry_addW ExprBinOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rcarry_addW_correct_and_bounded
+  := ExprBinOp_correct_and_bounded
+       rcarry_addW carry_add rcarry_addZ_sig rcarry_addW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Carry_Add", compute_bounds_for_display rcarry_addW ExprBinOp_bounds).
+Compute ("Carry_Add overflows? ", sanity_compute rcarry_addW ExprBinOp_bounds).
+Compute ("Carry_Add overflows (error if it does)? ", sanity_check rcarry_addW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF2213_32Reflective/Reified/CarryOpp.v b/src/SpecificGen/GF2213_32Reflective/Reified/CarryOpp.v
new file mode 100644
index 000000000..a2ab83ce2
--- /dev/null
+++ b/src/SpecificGen/GF2213_32Reflective/Reified/CarryOpp.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF2213_32Reflective.CommonUnOp.
+
+Definition rcarry_oppZ_sig : rexpr_unop_sig carry_opp. Proof. reify_sig. Defined.
+Definition rcarry_oppW := Eval vm_compute in rword_of_Z rcarry_oppZ_sig.
+Lemma rcarry_oppW_correct_and_bounded_gen : correct_and_bounded_genT rcarry_oppW rcarry_oppZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rcarry_opp_output_bounds := Eval vm_compute in compute_bounds rcarry_oppW ExprUnOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rcarry_oppW_correct_and_bounded
+  := ExprUnOp_correct_and_bounded
+       rcarry_oppW carry_opp rcarry_oppZ_sig rcarry_oppW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Carry_Opp", compute_bounds_for_display rcarry_oppW ExprUnOp_bounds).
+Compute ("Carry_Opp overflows? ", sanity_compute rcarry_oppW ExprUnOp_bounds).
+Compute ("Carry_Opp overflows (error if it does)? ", sanity_check rcarry_oppW ExprUnOp_bounds).
diff --git a/src/SpecificGen/GF2213_32Reflective/Reified/CarrySub.v b/src/SpecificGen/GF2213_32Reflective/Reified/CarrySub.v
new file mode 100644
index 000000000..04a097dd7
--- /dev/null
+++ b/src/SpecificGen/GF2213_32Reflective/Reified/CarrySub.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF2213_32Reflective.CommonBinOp.
+
+Definition rcarry_subZ_sig : rexpr_binop_sig carry_sub. Proof. reify_sig. Defined.
+Definition rcarry_subW := Eval vm_compute in rword_of_Z rcarry_subZ_sig.
+Lemma rcarry_subW_correct_and_bounded_gen : correct_and_bounded_genT rcarry_subW rcarry_subZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rcarry_sub_output_bounds := Eval vm_compute in compute_bounds rcarry_subW ExprBinOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rcarry_subW_correct_and_bounded
+  := ExprBinOp_correct_and_bounded
+       rcarry_subW carry_sub rcarry_subZ_sig rcarry_subW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Carry_Sub", compute_bounds_for_display rcarry_subW ExprBinOp_bounds).
+Compute ("Carry_Sub overflows? ", sanity_compute rcarry_subW ExprBinOp_bounds).
+Compute ("Carry_Sub overflows (error if it does)? ", sanity_check rcarry_subW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF2213_32Reflective/Reified/GeModulus.v b/src/SpecificGen/GF2213_32Reflective/Reified/GeModulus.v
new file mode 100644
index 000000000..659e712d9
--- /dev/null
+++ b/src/SpecificGen/GF2213_32Reflective/Reified/GeModulus.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF2213_32Reflective.CommonUnOpFEToZ.
+
+Definition rge_modulusZ_sig : rexpr_unop_FEToZ_sig ge_modulus. Proof. reify_sig. Defined.
+Definition rge_modulusW := Eval vm_compute in rword_of_Z rge_modulusZ_sig.
+Lemma rge_modulusW_correct_and_bounded_gen : correct_and_bounded_genT rge_modulusW rge_modulusZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rge_modulus_output_bounds := Eval vm_compute in compute_bounds rge_modulusW ExprUnOpFEToZ_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rge_modulusW_correct_and_bounded
+  := ExprUnOpFEToZ_correct_and_bounded
+       rge_modulusW ge_modulus rge_modulusZ_sig rge_modulusW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Ge_Modulus", compute_bounds_for_display rge_modulusW ExprUnOpFEToZ_bounds).
+Compute ("Ge_Modulus overflows? ", sanity_compute rge_modulusW ExprUnOpFEToZ_bounds).
+Compute ("Ge_Modulus overflows (error if it does)? ", sanity_check rge_modulusW ExprUnOpFEToZ_bounds).
diff --git a/src/SpecificGen/GF2213_32Reflective/Reified/Mul.v b/src/SpecificGen/GF2213_32Reflective/Reified/Mul.v
new file mode 100644
index 000000000..08c235a9c
--- /dev/null
+++ b/src/SpecificGen/GF2213_32Reflective/Reified/Mul.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF2213_32Reflective.CommonBinOp.
+
+Definition rmulZ_sig : rexpr_binop_sig mul. Proof. reify_sig. Defined.
+Definition rmulW := Eval vm_compute in rword_of_Z rmulZ_sig.
+Lemma rmulW_correct_and_bounded_gen : correct_and_bounded_genT rmulW rmulZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rmul_output_bounds := Eval vm_compute in compute_bounds rmulW ExprBinOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rmulW_correct_and_bounded
+  := ExprBinOp_correct_and_bounded
+       rmulW mul rmulZ_sig rmulW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Mul", compute_bounds_for_display rmulW ExprBinOp_bounds).
+Compute ("Mul overflows? ", sanity_compute rmulW ExprBinOp_bounds).
+Compute ("Mul overflows (error if it does)? ", sanity_check rmulW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF2213_32Reflective/Reified/Opp.v b/src/SpecificGen/GF2213_32Reflective/Reified/Opp.v
new file mode 100644
index 000000000..091cb96de
--- /dev/null
+++ b/src/SpecificGen/GF2213_32Reflective/Reified/Opp.v
@@ -0,0 +1,12 @@
+Require Import Crypto.SpecificGen.GF2213_32Reflective.CommonUnOp.
+
+Definition roppZ_sig : rexpr_unop_sig opp. Proof. reify_sig. Defined.
+Definition roppW := Eval vm_compute in rword_of_Z roppZ_sig.
+Lemma roppW_correct_and_bounded_gen : correct_and_bounded_genT roppW roppZ_sig.
+Proof. rexpr_correct. Qed.
+Definition ropp_output_bounds := Eval vm_compute in compute_bounds roppW ExprUnOp_bounds.
+
+Local Open Scope string_scope.
+Compute ("Opp", compute_bounds_for_display roppW ExprUnOp_bounds).
+Compute ("Opp overflows? ", sanity_compute roppW ExprUnOp_bounds).
+Compute ("Opp overflows (error if it does)? ", sanity_check roppW ExprUnOp_bounds).
diff --git a/src/SpecificGen/GF2213_32Reflective/Reified/Pack.v b/src/SpecificGen/GF2213_32Reflective/Reified/Pack.v
new file mode 100644
index 000000000..f96f81a53
--- /dev/null
+++ b/src/SpecificGen/GF2213_32Reflective/Reified/Pack.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF2213_32Reflective.CommonUnOpFEToWire.
+
+Definition rpackZ_sig : rexpr_unop_FEToWire_sig pack. Proof. reify_sig. Defined.
+Definition rpackW := Eval vm_compute in rword_of_Z rpackZ_sig.
+Lemma rpackW_correct_and_bounded_gen : correct_and_bounded_genT rpackW rpackZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rpack_output_bounds := Eval vm_compute in compute_bounds rpackW ExprUnOpFEToWire_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rpackW_correct_and_bounded
+  := ExprUnOpFEToWire_correct_and_bounded
+       rpackW pack rpackZ_sig rpackW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Pack", compute_bounds_for_display rpackW ExprUnOpFEToWire_bounds).
+Compute ("Pack overflows? ", sanity_compute rpackW ExprUnOpFEToWire_bounds).
+Compute ("Pack overflows (error if it does)? ", sanity_check rpackW ExprUnOpFEToWire_bounds).
diff --git a/src/SpecificGen/GF2213_32Reflective/Reified/PreFreeze.v b/src/SpecificGen/GF2213_32Reflective/Reified/PreFreeze.v
new file mode 100644
index 000000000..60ab908b0
--- /dev/null
+++ b/src/SpecificGen/GF2213_32Reflective/Reified/PreFreeze.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF2213_32Reflective.CommonUnOp.
+
+Definition rprefreezeZ_sig : rexpr_unop_sig prefreeze. Proof. cbv [prefreeze GF2213_32.prefreeze]. reify_sig. Defined.
+Definition rprefreezeW := Eval vm_compute in rword_of_Z rprefreezeZ_sig.
+Lemma rprefreezeW_correct_and_bounded_gen : correct_and_bounded_genT rprefreezeW rprefreezeZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rprefreeze_output_bounds := Eval vm_compute in compute_bounds rprefreezeW ExprUnOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rprefreezeW_correct_and_bounded
+  := ExprUnOp_correct_and_bounded
+       rprefreezeW prefreeze rprefreezeZ_sig rprefreezeW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("PreFreeze", compute_bounds_for_display rprefreezeW ExprUnOp_bounds).
+Compute ("PreFreeze overflows? ", sanity_compute rprefreezeW ExprUnOp_bounds).
+Compute ("PreFreeze overflows (error if it does)? ", sanity_check rprefreezeW ExprUnOp_bounds).
diff --git a/src/SpecificGen/GF2213_32Reflective/Reified/Sub.v b/src/SpecificGen/GF2213_32Reflective/Reified/Sub.v
new file mode 100644
index 000000000..cc7ba69dd
--- /dev/null
+++ b/src/SpecificGen/GF2213_32Reflective/Reified/Sub.v
@@ -0,0 +1,12 @@
+Require Import Crypto.SpecificGen.GF2213_32Reflective.CommonBinOp.
+
+Definition rsubZ_sig : rexpr_binop_sig sub. Proof. reify_sig. Defined.
+Definition rsubW := Eval vm_compute in rword_of_Z rsubZ_sig.
+Lemma rsubW_correct_and_bounded_gen : correct_and_bounded_genT rsubW rsubZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rsub_output_bounds := Eval vm_compute in compute_bounds rsubW ExprBinOp_bounds.
+
+Local Open Scope string_scope.
+Compute ("Sub", compute_bounds_for_display rsubW ExprBinOp_bounds).
+Compute ("Sub overflows? ", sanity_compute rsubW ExprBinOp_bounds).
+Compute ("Sub overflows (error if it does)? ", sanity_check rsubW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF2213_32Reflective/Reified/Unpack.v b/src/SpecificGen/GF2213_32Reflective/Reified/Unpack.v
new file mode 100644
index 000000000..5ef4ff3d8
--- /dev/null
+++ b/src/SpecificGen/GF2213_32Reflective/Reified/Unpack.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF2213_32Reflective.CommonUnOpWireToFE.
+
+Definition runpackZ_sig : rexpr_unop_WireToFE_sig unpack. Proof. reify_sig. Defined.
+Definition runpackW := Eval vm_compute in rword_of_Z runpackZ_sig.
+Lemma runpackW_correct_and_bounded_gen : correct_and_bounded_genT runpackW runpackZ_sig.
+Proof. rexpr_correct. Qed.
+Definition runpack_output_bounds := Eval vm_compute in compute_bounds runpackW ExprUnOpWireToFE_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition runpackW_correct_and_bounded
+  := ExprUnOpWireToFE_correct_and_bounded
+       runpackW unpack runpackZ_sig runpackW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Unpack", compute_bounds_for_display runpackW ExprUnOpWireToFE_bounds).
+Compute ("Unpack overflows? ", sanity_compute runpackW ExprUnOpWireToFE_bounds).
+Compute ("Unpack overflows (error if it does)? ", sanity_check runpackW ExprUnOpWireToFE_bounds).
diff --git a/src/SpecificGen/GF2519_32Bounded.v b/src/SpecificGen/GF2519_32Bounded.v
new file mode 100644
index 000000000..292ee9adb
--- /dev/null
+++ b/src/SpecificGen/GF2519_32Bounded.v
@@ -0,0 +1,462 @@
+Require Import Crypto.BaseSystem.
+Require Import Crypto.ModularArithmetic.PrimeFieldTheorems.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParams.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParamProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystem.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemOpt.
+Require Import Crypto.SpecificGen.GF2519_32.
+Require Import Crypto.SpecificGen.GF2519_32BoundedCommon.
+Require Import Crypto.SpecificGen.GF2519_32Reflective.
+Require Import Bedrock.Word Crypto.Util.WordUtil.
+Require Import Coq.Lists.List Crypto.Util.ListUtil.
+Require Import Crypto.Tactics.VerdiTactics.
+Require Import Crypto.Util.ZUtil.
+Require Import Crypto.Util.Tuple.
+Require Import Crypto.Util.Tactics.
+Require Import Crypto.Util.LetIn.
+Require Import Crypto.Util.Notations.
+Require Import Crypto.Util.Bool.
+Require Import Crypto.Util.Decidable.
+Require Import Crypto.Algebra.
+Import ListNotations.
+Require Import Coq.ZArith.ZArith Coq.ZArith.Zpower Coq.ZArith.ZArith Coq.ZArith.Znumtheory.
+Local Open Scope Z.
+
+
+Local Ltac bounded_t opW blem :=
+  apply blem; apply is_bounded_proj1_fe2519_32.
+Local Ltac bounded_wire_digits_t opW blem :=
+  apply blem; apply is_bounded_proj1_wire_digits.
+
+Local Ltac define_binop f g opW blem :=
+  refine (exist_fe2519_32W (opW (proj1_fe2519_32W f) (proj1_fe2519_32W g)) _);
+  abstract bounded_t opW blem.
+Local Ltac define_unop f opW blem :=
+  refine (exist_fe2519_32W (opW (proj1_fe2519_32W f)) _);
+  abstract bounded_t opW blem.
+Local Ltac define_unop_FEToZ f opW :=
+  refine (opW (proj1_fe2519_32W f)).
+Local Ltac define_unop_FEToWire f opW blem :=
+  refine (exist_wire_digitsW (opW (proj1_fe2519_32W f)) _);
+  abstract bounded_t opW blem.
+Local Ltac define_unop_WireToFE f opW blem :=
+  refine (exist_fe2519_32W (opW (proj1_wire_digitsW f)) _);
+  abstract bounded_wire_digits_t opW blem.
+
+Local Opaque Let_In.
+Local Opaque Z.add Z.sub Z.mul Z.shiftl Z.shiftr Z.land Z.lor Z.eqb NToWord64.
+Local Arguments interp_radd / _ _.
+Local Arguments interp_rsub / _ _.
+Local Arguments interp_rmul / _ _.
+Local Arguments interp_ropp / _.
+Local Arguments interp_rprefreeze / _.
+Local Arguments interp_rge_modulus / _.
+Local Arguments interp_rpack / _.
+Local Arguments interp_runpack / _.
+Definition addW (f g : fe2519_32W) : fe2519_32W := Eval simpl in interp_radd f g.
+Definition subW (f g : fe2519_32W) : fe2519_32W := Eval simpl in interp_rsub f g.
+Definition mulW (f g : fe2519_32W) : fe2519_32W := Eval simpl in interp_rmul f g.
+Definition oppW (f : fe2519_32W) : fe2519_32W := Eval simpl in interp_ropp f.
+Definition prefreezeW (f : fe2519_32W) : fe2519_32W := Eval simpl in interp_rprefreeze f.
+Definition ge_modulusW (f : fe2519_32W) : word64 := Eval simpl in interp_rge_modulus f.
+Definition packW (f : fe2519_32W) : wire_digitsW := Eval simpl in interp_rpack f.
+Definition unpackW (f : wire_digitsW) : fe2519_32W := Eval simpl in interp_runpack f.
+
+Require Import ModularBaseSystemWord.
+Definition modulusW :=
+  Eval cbv - [ZToWord64] in (Tuple.map ZToWord64 (Tuple.from_list_default 0%Z 10 GF2519_32.modulus_digits_)).
+
+Definition postfreeze : GF2519_32.fe2519_32 -> GF2519_32.fe2519_32 :=
+  GF2519_32.postfreeze.
+
+Lemma freeze_prepost_freeze : forall x, postfreeze (prefreeze x) = GF2519_32.freeze x. Proof. reflexivity. Qed.
+
+Definition postfreezeW : fe2519_32W -> fe2519_32W :=
+      (conditional_subtract_modulusW
+         (num_limbs := 10)
+         modulusW
+         ge_modulusW
+         (Interpretations.Word64.neg GF2519_32.int_width)
+      ).
+
+Definition freezeW (f : fe2519_32W) : fe2519_32W := Eval cbv beta delta [prefreezeW postfreezeW] in postfreezeW (prefreezeW f).
+
+Local Transparent Let_In.
+Definition powW (f : fe2519_32W) chain := fold_chain_opt (proj1_fe2519_32W one) mulW chain [f].
+Definition invW (f : fe2519_32W) : fe2519_32W
+  := Eval cbv -[Let_In fe2519_32W mulW] in powW f (chain inv_ec).
+
+Local Ltac port_correct_and_bounded pre_rewrite opW interp_rop rop_cb :=
+  change opW with (interp_rop);
+  rewrite pre_rewrite;
+  intros; apply rop_cb; assumption.
+
+Lemma addW_correct_and_bounded : ibinop_correct_and_bounded addW carry_add.
+Proof. port_correct_and_bounded interp_radd_correct addW interp_radd radd_correct_and_bounded. Qed.
+Lemma subW_correct_and_bounded : ibinop_correct_and_bounded subW carry_sub.
+Proof. port_correct_and_bounded interp_rsub_correct subW interp_rsub rsub_correct_and_bounded. Qed.
+Lemma mulW_correct_and_bounded : ibinop_correct_and_bounded mulW mul.
+Proof. port_correct_and_bounded interp_rmul_correct mulW interp_rmul rmul_correct_and_bounded. Qed.
+Lemma oppW_correct_and_bounded : iunop_correct_and_bounded oppW carry_opp.
+Proof. port_correct_and_bounded interp_ropp_correct oppW interp_ropp ropp_correct_and_bounded. Qed.
+Lemma prefreezeW_correct_and_bounded : iunop_correct_and_bounded prefreezeW prefreeze.
+Proof. port_correct_and_bounded interp_rprefreeze_correct prefreezeW interp_rprefreeze rprefreeze_correct_and_bounded. Qed.
+Lemma ge_modulusW_correct : iunop_FEToZ_correct ge_modulusW ge_modulus.
+Proof. port_correct_and_bounded interp_rge_modulus_correct ge_modulusW interp_rge_modulus rge_modulus_correct_and_bounded. Qed.
+Lemma packW_correct_and_bounded : iunop_FEToWire_correct_and_bounded packW pack.
+Proof. port_correct_and_bounded interp_rpack_correct packW interp_rpack rpack_correct_and_bounded. Qed.
+Lemma unpackW_correct_and_bounded : iunop_WireToFE_correct_and_bounded unpackW unpack.
+Proof. port_correct_and_bounded interp_runpack_correct unpackW interp_runpack runpack_correct_and_bounded. Qed.
+
+(* TODO : move *)
+Lemma neg_range : forall x y, 0 <= x ->
+  0 <= ModularBaseSystemListZOperations.neg x y < 2 ^ x.
+Proof.
+  intros.
+  split; auto using ModularBaseSystemListZOperationsProofs.neg_nonneg.
+  eapply Z.le_lt_trans; eauto using ModularBaseSystemListZOperationsProofs.neg_upperbound.
+  rewrite Z.ones_equiv.
+  omega.
+Qed.
+
+Ltac lower_bound_minus_ge_modulus :=
+  apply Z.le_0_sub;
+  cbv [ge_modulus Let_In ModularBaseSystemListZOperations.cmovl ModularBaseSystemListZOperations.cmovne ModularBaseSystemListZOperations.neg];
+  repeat break_if; Z.ltb_to_lt; subst; try omega;
+    rewrite ?Z.land_0_l; auto;
+    change Interpretations.Word64.word64ToZ with word64ToZ;
+    etransitivity; try apply Z.land_upper_bound_r; instantiate; try omega;
+    apply Z.ones_nonneg; instantiate; vm_compute; discriminate.
+
+Ltac upper_bound_minus_ge_modulus :=
+   (apply Z.log2_lt_pow2_alt; [ vm_compute; reflexivity | ]);
+   eapply Z.le_lt_trans; [ apply Z.le_sub_nonneg; apply Z.land_nonneg; right; omega | ];
+   eapply Z.le_lt_trans; [ eassumption | ];
+   instantiate; vm_compute; reflexivity.
+
+Lemma postfreezeW_correct_and_bounded : iunop_correct_and_bounded postfreezeW postfreeze.
+Proof.
+  intros x H.
+  pose proof (ge_modulusW_correct x H) as Hgm.
+  destruct_head_hnf' prod.
+  unfold_is_bounded_in H.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  cbv [postfreezeW].
+  cbv [conditional_subtract_modulusW Interpretations.Word64.neg].
+  change word64ToZ with Interpretations.Word64.word64ToZ in *.
+  rewrite Hgm.
+
+  cbv [modulusW Tuple.map].
+  cbv [on_tuple List.map to_list to_list' from_list from_list'
+                Tuple.map2 on_tuple2 ListUtil.map2 fe2519_32WToZ].
+  cbv [postfreeze GF2519_32.postfreeze].
+  cbv [Let_In].
+
+  split.
+  { match goal with
+    |- (_,word64ToZ (_ ^- (Interpretations.Word64.ZToWord64 ?x) ^& _)) = (_,_ - (?y &' _)) => assert (x = y) as Hxy by reflexivity; repeat rewrite <-Hxy; clear Hxy end.
+
+  change ZToWord64 with Interpretations.Word64.ZToWord64 in *.
+  rewrite !Interpretations.Word64.word64ToZ_sub;
+  rewrite !Interpretations.Word64.word64ToZ_land;
+  rewrite !Interpretations.Word64.word64ToZ_ZToWord64;
+  try match goal with
+         | |- 0 <=  ModularBaseSystemListZOperations.neg _ _ < 2 ^ _ => apply neg_range; omega
+         | |- 0 <= _ < 2 ^ Z.of_nat _ => vm_compute; split; [refine (fun x => match x with eq_refl => I end) | reflexivity]
+         | |- 0 <= _ &' _ => apply Z.land_nonneg; right; omega
+         | |- (_,_) = (_,_) => reflexivity
+      end;
+  try solve [
+  (apply Z.log2_lt_pow2_alt; [ vm_compute; reflexivity | ]);
+  eapply Z.le_lt_trans; try apply Z.land_upper_bound_r; try apply neg_range; instantiate; try match goal with |- ?G => not has_evar G; vm_compute; discriminate end; reflexivity];
+  match goal with
+  | |- 0 <= _ - _ => lower_bound_minus_ge_modulus
+  | |- Z.log2 (_ - _) < _ => upper_bound_minus_ge_modulus
+  end. }
+
+
+  unfold_is_bounded.
+  change ZToWord64 with Interpretations.Word64.ZToWord64 in *.
+  rewrite !Interpretations.Word64.word64ToZ_sub;
+  rewrite !Interpretations.Word64.word64ToZ_land;
+  rewrite !Interpretations.Word64.word64ToZ_ZToWord64;
+  repeat match goal with |- _ /\ _ => split; Z.ltb_to_lt end;
+  try match goal with
+         | |- 0 <=  ModularBaseSystemListZOperations.neg _ _ < 2 ^ _ => apply neg_range; omega
+         | |- 0 <= _ < 2 ^ Z.of_nat _ => vm_compute; split; [refine (fun x => match x with eq_refl => I end) | reflexivity]
+         | |- 0 <= _ &' _ => apply Z.land_nonneg; right; omega
+      end;
+  try solve [
+  (apply Z.log2_lt_pow2_alt; [ vm_compute; reflexivity | ]);
+  eapply Z.le_lt_trans; try apply Z.land_upper_bound_r; try apply neg_range; instantiate; try match goal with |- ?G => not has_evar G; vm_compute; discriminate end; reflexivity];
+  try match goal with
+  | |- 0 <= _ - _ => lower_bound_minus_ge_modulus
+  | |- Z.log2 (_ - _) < _ => upper_bound_minus_ge_modulus
+  | |- _ - _ <= _ => etransitivity; [ apply Z.le_sub_nonneg; apply Z.land_nonneg; right; omega | instantiate; assumption ]
+  | |- 0 <= ModularBaseSystemListZOperations.neg _ _ =>
+    apply neg_range; vm_compute; discriminate
+  | |- ModularBaseSystemListZOperations.neg _ _ < _ =>
+    apply neg_range; vm_compute; discriminate
+  | |- _ => vm_compute; (discriminate || reflexivity)
+      end.
+Qed.
+
+Lemma freezeW_correct_and_bounded : iunop_correct_and_bounded freezeW freeze.
+Proof.
+  intros f H; rewrite <- freeze_prepost_freeze.
+  change (freezeW f) with (postfreezeW (prefreezeW f)).
+  destruct (prefreezeW_correct_and_bounded f H) as [H0 H1].
+  destruct (postfreezeW_correct_and_bounded _ H1) as [H0' H1'].
+  rewrite H1', H0', H0; split; reflexivity.
+Qed.
+
+Lemma powW_correct_and_bounded chain : iunop_correct_and_bounded (fun x => powW x chain) (fun x => pow x chain).
+Proof.
+  cbv [powW pow].
+  intro x; intros; apply (fold_chain_opt_gen fe2519_32WToZ is_bounded [x]).
+  { reflexivity. }
+  { reflexivity. }
+  { intros; progress rewrite <- (fun X Y => proj1 (mulW_correct_and_bounded _ _ X Y)) by assumption.
+    apply mulW_correct_and_bounded; assumption. }
+  { intros; rewrite (fun X Y => proj1 (mulW_correct_and_bounded _ _ X Y)) by assumption; reflexivity. }
+  { intros [|?]; autorewrite with simpl_nth_default;
+      (assumption || reflexivity). }
+Qed.
+
+Lemma invW_correct_and_bounded : iunop_correct_and_bounded invW inv.
+Proof.
+  intro f.
+  assert (H : forall f, invW f = powW f (chain inv_ec))
+    by abstract (cbv -[Let_In fe2519_32W mulW]; reflexivity).
+  rewrite H.
+  rewrite inv_correct.
+  cbv [inv_opt].
+  rewrite <- pow_correct.
+  apply powW_correct_and_bounded.
+Qed.
+
+Definition fieldwisebW_sig (f g : fe2519_32W)
+  : { b | b = GF2519_32.fieldwiseb (fe2519_32WToZ f) (fe2519_32WToZ g) }.
+Proof.
+  hnf in f, g; destruct_head' prod.
+  eexists.
+  cbv [GF2519_32.fieldwiseb fe2519_32WToZ].
+  rewrite ?word64eqb_Zeqb.
+  reflexivity.
+Defined.
+
+Definition fieldwisebW (f g : fe2519_32W) : bool :=
+  Eval cbv [proj1_sig fieldwisebW_sig appify2 app_fe2519_32W] in
+    appify2 (fun f g => proj1_sig (fieldwisebW_sig f g)) f g.
+
+Lemma fieldwisebW_correct f g
+  : fieldwisebW f g = GF2519_32.fieldwiseb (fe2519_32WToZ f) (fe2519_32WToZ g).
+Proof.
+  set (f' := f); set (g' := g).
+  hnf in f, g; destruct_head' prod.
+  exact (proj2_sig (fieldwisebW_sig f' g')).
+Qed.
+
+Local Arguments freezeW : simpl never.
+Local Arguments fe2519_32WToZ !_ / .
+Local Opaque freezeW.
+
+Definition eqbW_sig (f g : fe2519_32W)
+  : { b | is_bounded (fe2519_32WToZ f) = true
+          -> is_bounded (fe2519_32WToZ g) = true
+          -> b = GF2519_32.eqb (fe2519_32WToZ f) (fe2519_32WToZ g) }.
+Proof.
+  pose proof (fun pf => proj1 (freezeW_correct_and_bounded f pf)) as frf.
+  pose proof (fun pf => proj1 (freezeW_correct_and_bounded g pf)) as frg.
+  hnf in f, g; destruct_head' prod.
+  eexists.
+  unfold GF2519_32.eqb.
+  simpl @fe2519_32WToZ in *; cbv beta iota.
+  intros.
+  rewrite <- frf, <- frg by assumption.
+  rewrite <- fieldwisebW_correct.
+  reflexivity.
+Defined.
+
+Definition eqbW (f g : fe2519_32W) : bool :=
+  Eval cbv [proj1_sig eqbW_sig appify2 app_fe2519_32W] in
+    appify2 (fun f g => proj1_sig (eqbW_sig f g)) f g.
+
+Lemma eqbW_correct f g
+  : is_bounded (fe2519_32WToZ f) = true
+    -> is_bounded (fe2519_32WToZ g) = true
+    -> eqbW f g = GF2519_32.eqb (fe2519_32WToZ f) (fe2519_32WToZ g).
+Proof.
+  set (f' := f); set (g' := g).
+  hnf in f, g; destruct_head' prod.
+  exact (proj2_sig (eqbW_sig f' g')).
+Qed.
+
+(* TODO(jgross): use NToWord or such for this constant too *)
+Definition sqrt_m1W : fe2519_32W :=
+  Eval vm_compute in fe2519_32ZToW sqrt_m1.
+
+Definition GF2519_32sqrt x : GF2519_32.fe2519_32 :=
+  dlet powx := powW (fe2519_32ZToW x) (chain GF2519_32.sqrt_ec) in
+  GF2519_32.sqrt (fe2519_32WToZ powx) (fe2519_32WToZ (mulW powx powx)) x.
+
+Definition sqrtW_sig
+  : { sqrtW | iunop_correct_and_bounded sqrtW GF2519_32sqrt }.
+Proof.
+  eexists.
+  unfold GF2519_32sqrt, GF2519_32.sqrt.
+  intros.
+  rewrite !fe2519_32ZToW_WToZ.
+  split.
+  { etransitivity.
+    Focus 2. {
+      apply Proper_Let_In_nd_changebody_eq; intros.
+      set_evars.
+      match goal with (* unfold the first dlet ... in, but only if it's binding a var *)
+      | [ |- ?x = dlet y := fe2519_32WToZ ?z in ?f ]
+        => is_var z; change (x = match fe2519_32WToZ z with y => f end)
+      end.
+      change sqrt_m1 with (fe2519_32WToZ sqrt_m1W).
+      rewrite <- (fun X Y => proj1 (mulW_correct_and_bounded sqrt_m1W a X Y)), <- eqbW_correct, (pull_bool_if fe2519_32WToZ)
+        by repeat match goal with
+                  | _ => progress subst
+                  | [ |- is_bounded (fe2519_32WToZ ?op) = true ]
+                    => lazymatch op with
+                       | mulW _ _ => apply mulW_correct_and_bounded
+                       | powW _ _ => apply powW_correct_and_bounded
+                       | sqrt_m1W => vm_compute; reflexivity
+                       | _ => assumption
+                       end
+                  end.
+      subst_evars; reflexivity.
+    } Unfocus.
+    lazymatch goal with
+    | [ |- context G[dlet x := ?v in fe2519_32WToZ (@?f x)] ]
+      => let G' := context G[fe2519_32WToZ (dlet x := v in f x)] in
+         cut G'; cbv beta;
+           [ cbv [Let_In]; exact (fun x => x) | apply f_equal ]
+    end.
+    reflexivity. }
+  { cbv [Let_In].
+    break_if.
+    { apply powW_correct_and_bounded; assumption. }
+    { apply mulW_correct_and_bounded; [ vm_compute; reflexivity | ].
+      apply powW_correct_and_bounded; assumption. } }
+Defined.
+
+Definition sqrtW (f : fe2519_32W) : fe2519_32W :=
+  Eval cbv [proj1_sig sqrtW_sig app_fe2519_32W] in
+    app_fe2519_32W f (proj1_sig sqrtW_sig).
+
+Lemma sqrtW_correct_and_bounded : iunop_correct_and_bounded sqrtW GF2519_32sqrt.
+Proof.
+  intro f.
+  set (f' := f).
+  hnf in f; destruct_head' prod.
+  assert (H : sqrtW f' = proj1_sig sqrtW_sig f')
+    by (subst f'; cbv beta iota delta [proj1_sig sqrtW_sig sqrtW]; reflexivity).
+  rewrite H.
+  exact (proj2_sig sqrtW_sig f').
+Qed.
+
+
+
+Definition add (f g : fe2519_32) : fe2519_32.
+Proof. define_binop f g addW addW_correct_and_bounded. Defined.
+Definition sub (f g : fe2519_32) : fe2519_32.
+Proof. define_binop f g subW subW_correct_and_bounded. Defined.
+Definition mul (f g : fe2519_32) : fe2519_32.
+Proof. define_binop f g mulW mulW_correct_and_bounded. Defined.
+Definition opp (f : fe2519_32) : fe2519_32.
+Proof. define_unop f oppW oppW_correct_and_bounded. Defined.
+Definition freeze (f : fe2519_32) : fe2519_32.
+Proof. define_unop f freezeW freezeW_correct_and_bounded. Defined.
+Definition ge_modulus (f : fe2519_32) : word64.
+Proof. define_unop_FEToZ f ge_modulusW. Defined.
+Definition pack (f : fe2519_32) : wire_digits.
+Proof. define_unop_FEToWire f packW packW_correct_and_bounded. Defined.
+Definition unpack (f : wire_digits) : fe2519_32.
+Proof. define_unop_WireToFE f unpackW unpackW_correct_and_bounded. Defined.
+
+Definition pow (f : fe2519_32) (chain : list (nat * nat)) : fe2519_32.
+Proof. define_unop f (fun x => powW x chain) powW_correct_and_bounded. Defined.
+Definition inv (f : fe2519_32) : fe2519_32.
+Proof. define_unop f invW invW_correct_and_bounded. Defined.
+Definition sqrt (f : fe2519_32) : fe2519_32.
+Proof. define_unop f sqrtW sqrtW_correct_and_bounded. Defined.
+
+Local Ltac op_correct_t op opW_correct_and_bounded :=
+  cbv [op];
+  lazymatch goal with
+  | [ |- context[proj1_fe2519_32 (exist_fe2519_32W _ _)] ]
+    => rewrite proj1_fe2519_32_exist_fe2519_32W
+  | [ |- context[proj1_wire_digits (exist_wire_digitsW _ _)] ]
+    => rewrite proj1_wire_digits_exist_wire_digitsW
+  | _ => idtac
+  end;
+  apply opW_correct_and_bounded;
+  lazymatch goal with
+  | [ |- is_bounded _ = true ]
+    => apply is_bounded_proj1_fe2519_32
+  | [ |- wire_digits_is_bounded _ = true ]
+    => apply is_bounded_proj1_wire_digits
+  end.
+
+Lemma add_correct (f g : fe2519_32) : proj1_fe2519_32 (add f g) = carry_add (proj1_fe2519_32 f) (proj1_fe2519_32 g).
+Proof. op_correct_t add addW_correct_and_bounded. Qed.
+Lemma sub_correct (f g : fe2519_32) : proj1_fe2519_32 (sub f g) = carry_sub (proj1_fe2519_32 f) (proj1_fe2519_32 g).
+Proof. op_correct_t sub subW_correct_and_bounded. Qed.
+Lemma mul_correct (f g : fe2519_32) : proj1_fe2519_32 (mul f g) = GF2519_32.mul (proj1_fe2519_32 f) (proj1_fe2519_32 g).
+Proof. op_correct_t mul mulW_correct_and_bounded. Qed.
+Lemma opp_correct (f : fe2519_32) : proj1_fe2519_32 (opp f) = carry_opp (proj1_fe2519_32 f).
+Proof. op_correct_t opp oppW_correct_and_bounded. Qed.
+Lemma freeze_correct (f : fe2519_32) : proj1_fe2519_32 (freeze f) = GF2519_32.freeze (proj1_fe2519_32 f).
+Proof. op_correct_t freeze freezeW_correct_and_bounded. Qed.
+Lemma ge_modulus_correct (f : fe2519_32) : word64ToZ (ge_modulus f) = GF2519_32.ge_modulus (proj1_fe2519_32 f).
+Proof. op_correct_t ge_modulus ge_modulusW_correct. Qed.
+Lemma pack_correct (f : fe2519_32) : proj1_wire_digits (pack f) = GF2519_32.pack (proj1_fe2519_32 f).
+Proof. op_correct_t pack packW_correct_and_bounded. Qed.
+Lemma unpack_correct (f : wire_digits) : proj1_fe2519_32 (unpack f) = GF2519_32.unpack (proj1_wire_digits f).
+Proof. op_correct_t unpack unpackW_correct_and_bounded. Qed.
+Lemma pow_correct (f : fe2519_32) chain : proj1_fe2519_32 (pow f chain) = GF2519_32.pow (proj1_fe2519_32 f) chain.
+Proof. op_correct_t pow (powW_correct_and_bounded chain). Qed.
+Lemma inv_correct (f : fe2519_32) : proj1_fe2519_32 (inv f) = GF2519_32.inv (proj1_fe2519_32 f).
+Proof. op_correct_t inv invW_correct_and_bounded. Qed.
+Lemma sqrt_correct (f : fe2519_32) : proj1_fe2519_32 (sqrt f) = GF2519_32sqrt (proj1_fe2519_32 f).
+Proof. op_correct_t sqrt sqrtW_correct_and_bounded. Qed.
+
+Import Morphisms.
+
+Local Existing Instance prime_modulus.
+
+Lemma field2519_32_and_homomorphisms
+  : @field fe2519_32 eq zero one opp add sub mul inv div
+    /\ @Ring.is_homomorphism (F _) (@Logic.eq _) 1%F F.add F.mul fe2519_32 eq one add mul encode
+    /\ @Ring.is_homomorphism fe2519_32 eq one add mul (F _) (@Logic.eq _) 1%F F.add F.mul decode.
+Proof.
+  eapply @Field.field_and_homomorphism_from_redundant_representation.
+  { exact (F.field_modulo _). }
+  { cbv [decode encode]; intros; rewrite !proj1_fe2519_32_exist_fe2519_32; apply encode_rep. }
+  { reflexivity. }
+  { reflexivity. }
+  { reflexivity. }
+  { cbv [decode encode]; intros; rewrite opp_correct, carry_opp_correct, carry_opp_opt_correct, carry_opp_rep; apply opp_rep; reflexivity. }
+  { cbv [decode encode]; intros; rewrite add_correct, carry_add_correct, carry_add_opt_correct, carry_add_rep; apply add_rep; reflexivity. }
+  { cbv [decode encode]; intros; rewrite sub_correct, carry_sub_correct, carry_sub_opt_correct, carry_sub_rep; apply sub_rep; reflexivity. }
+  { cbv [decode encode]; intros; rewrite mul_correct, GF2519_32.mul_correct, carry_mul_opt_correct by reflexivity; apply carry_mul_rep; reflexivity. }
+  { cbv [decode encode]; intros; rewrite inv_correct, GF2519_32.inv_correct, inv_opt_correct by reflexivity; apply inv_rep; reflexivity. }
+  { cbv [decode encode div]; intros; rewrite !proj1_fe2519_32_exist_fe2519_32; apply encode_rep. }
+Qed.
+
+Global Instance field2519_32 : @field fe2519_32 eq zero one opp add sub mul inv div := proj1 field2519_32_and_homomorphisms.
+
+Local Opaque proj1_fe2519_32 exist_fe2519_32 proj1_fe2519_32W exist_fe2519_32W.
+Global Instance homomorphism_F2519_32_encode
+  : @Ring.is_homomorphism (F modulus) Logic.eq F.one F.add F.mul fe2519_32 eq one add mul encode.
+Proof. apply field2519_32_and_homomorphisms. Qed.
+
+Global Instance homomorphism_F2519_32_decode
+  : @Ring.is_homomorphism fe2519_32 eq one add mul (F modulus) Logic.eq F.one F.add F.mul decode.
+Proof. apply field2519_32_and_homomorphisms. Qed.
diff --git a/src/SpecificGen/GF2519_32BoundedCommon.v b/src/SpecificGen/GF2519_32BoundedCommon.v
new file mode 100644
index 000000000..cea3e4f10
--- /dev/null
+++ b/src/SpecificGen/GF2519_32BoundedCommon.v
@@ -0,0 +1,693 @@
+Require Import Crypto.BaseSystem.
+Require Import Crypto.ModularArithmetic.PrimeFieldTheorems.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParams.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParamProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystem.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemOpt.
+Require Import Crypto.SpecificGen.GF2519_32.
+Require Import Bedrock.Word Crypto.Util.WordUtil.
+Require Import Coq.Lists.List Crypto.Util.ListUtil.
+Require Import Crypto.Tactics.VerdiTactics.
+Require Import Crypto.Util.ZUtil.
+Require Import Crypto.Util.Tuple.
+Require Import Crypto.Util.Tactics.
+Require Import Crypto.Util.LetIn.
+Require Import Crypto.Util.Notations.
+Require Import Crypto.Util.Decidable.
+Require Import Crypto.Util.HList.
+Require Import Crypto.Util.Tuple.
+Require Import Crypto.Algebra.
+Import ListNotations.
+Require Import Coq.ZArith.ZArith Coq.ZArith.Zpower Coq.ZArith.ZArith Coq.ZArith.Znumtheory.
+Local Open Scope Z.
+
+(* BEGIN common curve-specific definitions *)
+Definition bit_width : nat := Eval compute in Z.to_nat (GF2519_32.int_width).
+Local Notation b_of exp := (0, 2^exp + 2^(exp-3))%Z (only parsing). (* max is [(0, 2^(exp+2) + 2^exp + 2^(exp-1) + 2^(exp-3) + 2^(exp-4) + 2^(exp-5) + 2^(exp-6) + 2^(exp-10) + 2^(exp-12) + 2^(exp-13) + 2^(exp-14) + 2^(exp-15) + 2^(exp-17) + 2^(exp-23) + 2^(exp-24))%Z] *)
+Definition bounds_exp : tuple Z length_fe2519_32
+  := Eval compute in
+      Tuple.from_list length_fe2519_32 limb_widths eq_refl.
+Definition bounds : tuple (Z * Z) length_fe2519_32
+  := Eval compute in
+      Tuple.map (fun e => b_of e) bounds_exp.
+Definition wire_digit_bounds_exp : tuple Z (length wire_widths)
+  := Eval compute in Tuple.from_list _ wire_widths eq_refl.
+Definition wire_digit_bounds : tuple (Z * Z) (length wire_widths)
+  := Eval compute in Tuple.map (fun e => (0,2^e-1)%Z) wire_digit_bounds_exp.
+(* END common curve-specific definitions *)
+
+(* BEGIN aliases for word extraction *)
+Definition word64 := Word.word bit_width.
+Coercion word64ToZ (x : word64) : Z := Z.of_N (wordToN x).
+Coercion ZToWord64 (x : Z) : word64 := NToWord _ (Z.to_N x).
+Definition NToWord64 : N -> word64 := NToWord _.
+Definition word64ize (x : word64) : word64
+  := Eval cbv [wordToN N.succ_double N.double] in NToWord64 (wordToN x).
+Definition w64eqb (x y : word64) := weqb x y.
+
+Global Arguments NToWord64 : simpl never.
+Arguments word64 : simpl never.
+Arguments bit_width : simpl never.
+Global Opaque word64.
+Global Opaque bit_width.
+
+(* END aliases for word extraction *)
+
+(* BEGIN basic types *)
+Module Type WordIsBounded.
+  Parameter is_boundedT : forall (lower upper : Z), word64 -> bool.
+  Parameter Build_is_boundedT : forall {lower upper} {proj_word : word64},
+      andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true -> is_boundedT lower upper proj_word = true.
+  Parameter project_is_boundedT : forall {lower upper} {proj_word : word64},
+      is_boundedT lower upper proj_word = true -> andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true.
+End WordIsBounded.
+
+Module Import WordIsBoundedDefault : WordIsBounded.
+  Definition is_boundedT : forall (lower upper : Z), word64 -> bool
+    := fun lower upper proj_word => andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z.
+  Definition Build_is_boundedT {lower upper} {proj_word : word64}
+    : andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true -> is_boundedT lower upper proj_word = true
+    := fun x => x.
+  Definition project_is_boundedT {lower upper} {proj_word : word64}
+    : is_boundedT lower upper proj_word = true -> andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true
+    := fun x => x.
+End WordIsBoundedDefault.
+
+Definition bounded_word (lower upper : Z)
+  := { proj_word : word64 | is_boundedT lower upper proj_word = true }.
+Local Notation word_of exp := (bounded_word (fst (b_of exp)) (snd (b_of exp))).
+Local Notation unbounded_word sz := (bounded_word 0 (2^sz-1)%Z).
+
+Local Opaque word64.
+Definition fe2519_32W := Eval cbv (*-[word64]*) in (tuple word64 length_fe2519_32).
+Definition wire_digitsW := Eval cbv (*-[word64]*) in (tuple word64 (length wire_widths)).
+Definition fe2519_32 :=
+  Eval cbv -[bounded_word Z.pow Z.sub Z.add] in
+    hlist (fun e => word_of e) bounds_exp.
+Definition wire_digits :=
+  Eval cbv -[bounded_word Z.pow Z.sub Z.add] in
+    hlist (fun e => unbounded_word e) wire_digit_bounds_exp.
+
+Definition is_bounded_gen {n} (x : tuple Z n) (bounds : tuple (Z * Z) n) : bool
+  := let res := Tuple.map2
+                  (fun bounds v =>
+                     let '(lower, upper) := bounds in
+                     (lower <=? v) && (v <=? upper))%bool%Z
+                  bounds x in
+     List.fold_right andb true (Tuple.to_list _ res).
+
+Definition is_bounded (x : SpecificGen.GF2519_32.fe2519_32) : bool
+  := is_bounded_gen (n:=length_fe2519_32) x bounds.
+
+Definition wire_digits_is_bounded (x : SpecificGen.GF2519_32.wire_digits) : bool
+  := is_bounded_gen (n:=length wire_widths) x wire_digit_bounds.
+
+(* END basic types *)
+
+Section generic_destructuring.
+  Fixpoint app_on' A n : forall T (f : tuple' A n) (P : forall x : tuple' A n, T x), T f
+    := match n return forall T (f : tuple' A n) (P : forall x : tuple' A n, T x), T f with
+       | O => fun T v P => P v
+       | S n' => fun T v P => let '(v, x) := v in app_on' A n' _ v (fun v => P (v, x))
+       end.
+  Definition app_on {A n} : forall {T} (f : tuple A n) (P : forall x : tuple A n, T x), T f
+    := match n return forall T (f : tuple A n) (P : forall x : tuple A n, T x), T f with
+       | O => fun T v P => P v
+       | S n' => @app_on' A n'
+       end.
+  Lemma app_on'_correct {A n T} f (P : forall x : tuple' A n, T x) : app_on' A n T f P = P f.
+  Proof.
+    induction n; simpl in *; destruct_head' prod; [ reflexivity | exact (IHn _ _ (fun t => P (t, _))) ].
+  Qed.
+  Lemma app_on_correct {A n T} f (P : forall x : tuple A n, T x) : app_on f P = P f.
+  Proof. destruct n; [ reflexivity | apply app_on'_correct ]. Qed.
+
+  Fixpoint app_on_h' A F n : forall ts T (f : @hlist' A n F ts) (P : forall x : @hlist' A n F ts, T x), T f
+    := match n return forall ts T (f : @hlist' A n F ts) (P : forall x : @hlist' A n F ts, T x), T f with
+       | O => fun ts T v P => P v
+       | S n' => fun ts T v P => let '(v, x) := v in app_on_h' A F n' _ _ v (fun v => P (v, x))
+       end.
+  Definition app_on_h {A F n} : forall ts T (f : @hlist A n F ts) (P : forall x : @hlist A n F ts, T x), T f
+    := match n return forall ts T (f : @hlist A n F ts) (P : forall x : @hlist A n F ts, T x), T f with
+       | O => fun ts T v P => P v
+       | S n' => @app_on_h' A F n'
+       end.
+  Lemma app_on_h'_correct {A F n ts T} f P : @app_on_h' A F n ts T f P = P f.
+  Proof.
+    induction n; simpl in *; destruct_head' prod; [ reflexivity | exact (IHn _ _ _ (fun h => P (h, f))) ].
+  Qed.
+  Lemma app_on_h_correct {A} F {n} ts {T} f P : @app_on_h A F n ts T f P = P f.
+  Proof. destruct n; [ reflexivity | apply app_on_h'_correct ]. Qed.
+
+  Definition app_wire_digitsW_dep {A T} (P : forall x : tuple A (length wire_widths), T x)
+    : forall (f : tuple A (length wire_widths)), T f
+    := Eval compute in fun f => @app_on A (length wire_widths) T f P.
+  Definition app_wire_digitsW {A T} (f : tuple A (length wire_widths)) (P : tuple A (length wire_widths) -> T)
+    := Eval compute in @app_wire_digitsW_dep A (fun _ => T) P f.
+  Definition app_fe2519_32W_dep {A T} (P : forall x : tuple A length_fe2519_32, T x)
+    : forall (f : tuple A length_fe2519_32), T f
+    := Eval compute in fun f => @app_on A length_fe2519_32 T f P.
+  Definition app_fe2519_32W {A T} (f : tuple A length_fe2519_32) (P : tuple A length_fe2519_32 -> T)
+    := Eval compute in @app_fe2519_32W_dep A (fun _ => T) P f.
+  Definition app_fe2519_32_dep {T} (P : forall x : fe2519_32, T x)
+    : forall f : fe2519_32, T f
+    := Eval compute in fun f => @app_on_h _ (fun e => word_of e) length_fe2519_32 bounds_exp T f P.
+  Definition app_fe2519_32 {T} (f : fe2519_32) (P : hlist (fun e => word_of e) bounds_exp -> T)
+    := Eval compute in @app_fe2519_32_dep (fun _ => T) P f.
+  Definition app_wire_digits_dep {T} (P : forall x : wire_digits, T x)
+    : forall f : wire_digits, T f
+    := Eval compute in fun f => @app_on_h _ (fun e => unbounded_word e) (length wire_widths) wire_digit_bounds_exp T f P.
+  Definition app_wire_digits {T} (f : wire_digits) (P : hlist (fun e => unbounded_word e) wire_digit_bounds_exp -> T)
+    := Eval compute in @app_wire_digits_dep (fun _ => T) P f.
+
+  Definition app_wire_digitsW_dep_correct {A T} f P : @app_wire_digitsW_dep A T P f = P f
+    := app_on_correct f P.
+  Definition app_wire_digitsW_correct {A T} f P : @app_wire_digitsW A T f P = P f
+    := @app_wire_digitsW_dep_correct A (fun _ => T) f P.
+  Definition app_fe2519_32W_dep_correct {A T} f P : @app_fe2519_32W_dep A T P f = P f
+    := app_on_correct f P.
+  Definition app_fe2519_32W_correct {A T} f P : @app_fe2519_32W A T f P = P f
+    := @app_fe2519_32W_dep_correct A (fun _ => T) f P.
+  Definition app_fe2519_32_dep_correct {T} f P : @app_fe2519_32_dep T P f = P f
+    := app_on_h_correct (fun e => word_of e) bounds_exp f P.
+  Definition app_fe2519_32_correct {T} f P : @app_fe2519_32 T f P = P f
+    := @app_fe2519_32_dep_correct (fun _ => T) f P.
+  Definition app_wire_digits_dep_correct {T} f P : @app_wire_digits_dep T P f = P f
+    := app_on_h_correct (fun e => unbounded_word e) wire_digit_bounds_exp f P.
+  Definition app_wire_digits_correct {T} f P : @app_wire_digits T f P = P f
+    := @app_wire_digits_dep_correct (fun _ => T) f P.
+
+  Definition appify2 {T} (op : fe2519_32W -> fe2519_32W -> T) (f g : fe2519_32W) :=
+    app_fe2519_32W f (fun f0 => (app_fe2519_32W g (fun g0 => op f0 g0))).
+
+  Lemma appify2_correct : forall {T} op f g, @appify2 T op f g = op f g.
+  Proof.
+    intros. cbv [appify2].
+    etransitivity; apply app_fe2519_32W_correct.
+  Qed.
+End generic_destructuring.
+
+Definition eta_fe2519_32W_sig (x : fe2519_32W) : { v : fe2519_32W | v = x }.
+Proof.
+  eexists; symmetry.
+  repeat (etransitivity; [ apply surjective_pairing | apply f_equal2 ]); reflexivity.
+Defined.
+Definition eta_fe2519_32W (x : fe2519_32W) : fe2519_32W
+  := Eval cbv [proj1_sig eta_fe2519_32W_sig] in proj1_sig (eta_fe2519_32W_sig x).
+Definition eta_wire_digitsW_sig (x : wire_digitsW) : { v : wire_digitsW | v = x }.
+Proof.
+  eexists; symmetry.
+  repeat (etransitivity; [ apply surjective_pairing | apply f_equal2 ]); reflexivity.
+Defined.
+Definition eta_wire_digitsW (x : wire_digitsW) : wire_digitsW
+  := Eval cbv [proj1_sig eta_wire_digitsW_sig] in proj1_sig (eta_wire_digitsW_sig x).
+
+Local Transparent word64.
+Lemma word64ize_id x : word64ize x = x.
+Proof. apply NToWord_wordToN. Qed.
+Local Opaque word64.
+
+Lemma word64eqb_Zeqb x y : (word64ToZ x =? word64ToZ y)%Z = w64eqb x y.
+Proof. apply wordeqb_Zeqb. Qed.
+
+Local Arguments Z.pow_pos !_ !_ / .
+Lemma word64ToZ_ZToWord64 x : 0 <= x < 2^Z.of_nat bit_width -> word64ToZ (ZToWord64 x) = x.
+Proof.
+  intros; unfold word64ToZ, ZToWord64.
+  rewrite wordToN_NToWord_idempotent, Z2N.id
+    by (omega || apply N2Z.inj_lt; rewrite <- ?(N_nat_Z (Npow2 _)), ?Npow2_nat, ?Zpow_pow2, ?N2Z.id, ?Z2N.id, ?Z2Nat.id by omega; omega).
+  reflexivity.
+Qed.
+Lemma ZToWord64_word64ToZ x : ZToWord64 (word64ToZ x) = x.
+Proof.
+  intros; unfold word64ToZ, ZToWord64.
+  rewrite N2Z.id, NToWord_wordToN; reflexivity.
+Qed.
+
+(* BEGIN precomputation. *)
+
+Definition proj_word {lower upper} (v : bounded_word lower upper) := Eval cbv [proj1_sig] in proj1_sig v.
+Definition word_bounded {lower upper} (v : bounded_word lower upper)
+  : andb (lower <=? proj_word v)%Z (proj_word v <=? upper)%Z = true
+  := project_is_boundedT (proj2_sig v).
+Definition Build_bounded_word' {lower upper} proj_word word_bounded : bounded_word lower upper
+  := exist _ proj_word (Build_is_boundedT word_bounded).
+Arguments proj_word {_ _} _.
+Arguments word_bounded {_ _} _.
+Arguments Build_bounded_word' {_ _} _ _.
+Definition Build_bounded_word {lower upper} (proj_word : word64) (word_bounded : andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true)
+  : bounded_word lower upper
+  := Build_bounded_word'
+       proj_word
+       (match andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z as b return b = true -> b = true with
+        | true => fun _ => eq_refl
+        | false => fun x => x
+        end word_bounded).
+Lemma word_to_unbounded_helper {x e : nat} : (x < pow2 e)%nat -> (Z.of_nat e <= Z.of_nat bit_width)%Z -> ((0 <=? word64ToZ (ZToWord64 (Z.of_nat x))) && (word64ToZ (ZToWord64 (Z.of_nat x)) <=? 2 ^ (Z.of_nat e) - 1))%bool = true.
+Proof.
+  rewrite pow2_id; intro H; apply Nat2Z.inj_lt in H; revert H.
+  rewrite Z.pow_Zpow; simpl Z.of_nat.
+  intros H H'.
+  assert (2^Z.of_nat e <= 2^Z.of_nat bit_width) by auto with zarith.
+  rewrite ?word64ToZ_ZToWord64 by omega.
+  match goal with
+  | [ |- context[andb ?x ?y] ]
+    => destruct x eqn:?, y eqn:?; try reflexivity; Z.ltb_to_lt
+  end;
+    intros; omega.
+Qed.
+Definition word_to_unbounded_word {sz} (x : word sz) : (Z.of_nat sz <=? Z.of_nat bit_width)%Z = true -> unbounded_word (Z.of_nat sz).
+Proof.
+  refine (fun pf => Build_bounded_word (Z.of_N (wordToN x)) _).
+  abstract (rewrite wordToN_nat, nat_N_Z; Z.ltb_to_lt; apply (word_to_unbounded_helper (wordToNat_bound x)); simpl; omega).
+Defined.
+Definition word32_to_unbounded_word (x : word 32) : unbounded_word 32.
+Proof. apply (word_to_unbounded_word x); reflexivity. Defined.
+Definition word31_to_unbounded_word (x : word 31) : unbounded_word 31.
+Proof. apply (word_to_unbounded_word x); reflexivity. Defined.
+
+Local Opaque word64.
+Declare Reduction app_tuple_map := cbv [app_wire_digitsW app_fe2519_32W app_fe2519_32 HList.mapt HList.mapt' Tuple.map on_tuple List.map List.app length_fe2519_32 List.length wire_widths Tuple.from_list Tuple.from_list' Tuple.to_list Tuple.to_list' fst snd].
+Definition fe2519_32WToZ (x : fe2519_32W) : SpecificGen.GF2519_32.fe2519_32
+  := Eval app_tuple_map in
+      app_fe2519_32W x (Tuple.map (fun v : word64 => v : Z)).
+Definition fe2519_32ZToW (x : SpecificGen.GF2519_32.fe2519_32) : fe2519_32W
+  := Eval app_tuple_map in
+      app_fe2519_32W x (Tuple.map (fun v : Z => v : word64)).
+Definition wire_digitsWToZ (x : wire_digitsW) : SpecificGen.GF2519_32.wire_digits
+  := Eval app_tuple_map in
+      app_wire_digitsW x (Tuple.map (fun v : word64 => v : Z)).
+Definition wire_digitsZToW (x : SpecificGen.GF2519_32.wire_digits) : wire_digitsW
+  := Eval app_tuple_map in
+      app_wire_digitsW x (Tuple.map (fun v : Z => v : word64)).
+Definition fe2519_32W_word64ize (x : fe2519_32W) : fe2519_32W
+  := Eval app_tuple_map in
+      app_fe2519_32W x (Tuple.map word64ize).
+Definition wire_digitsW_word64ize (x : wire_digitsW) : wire_digitsW
+  := Eval app_tuple_map in
+      app_wire_digitsW x (Tuple.map word64ize).
+
+(** TODO: Turn this into a lemma to speed up proofs *)
+Ltac unfold_is_bounded_in H :=
+  unfold is_bounded, wire_digits_is_bounded, is_bounded_gen, fe2519_32WToZ, wire_digitsWToZ in H;
+  cbv [to_list length bounds wire_digit_bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map fold_right List.rev List.app length_fe2519_32 List.length wire_widths] in H;
+  rewrite ?Bool.andb_true_iff in H.
+
+Ltac unfold_is_bounded :=
+  unfold is_bounded, wire_digits_is_bounded, is_bounded_gen, fe2519_32WToZ, wire_digitsWToZ;
+  cbv [to_list length bounds wire_digit_bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map fold_right List.rev List.app length_fe2519_32 List.length wire_widths];
+  rewrite ?Bool.andb_true_iff.
+
+Local Transparent bit_width.
+Definition Pow2_64 := Eval compute in 2^Z.of_nat bit_width.
+Definition unfold_Pow2_64 : 2^Z.of_nat bit_width = Pow2_64 := eq_refl.
+Local Opaque bit_width.
+
+Local Ltac prove_lt_bit_width :=
+  rewrite unfold_Pow2_64; cbv [Pow2_64]; omega.
+
+Lemma fe2519_32ZToW_WToZ (x : fe2519_32W) : fe2519_32ZToW (fe2519_32WToZ x) = x.
+Proof.
+  hnf in x; destruct_head' prod; cbv [fe2519_32WToZ fe2519_32ZToW].
+  rewrite !ZToWord64_word64ToZ; reflexivity.
+Qed.
+
+Lemma fe2519_32WToZ_ZToW x : is_bounded x = true -> fe2519_32WToZ (fe2519_32ZToW x) = x.
+Proof.
+  hnf in x; destruct_head' prod; cbv [fe2519_32WToZ fe2519_32ZToW].
+  intro H.
+  unfold_is_bounded_in H; destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite !word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Lemma fe2519_32W_word64ize_id x : fe2519_32W_word64ize x = x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [fe2519_32W_word64ize];
+    repeat apply f_equal2; apply word64ize_id.
+Qed.
+Lemma wire_digitsW_word64ize_id x : wire_digitsW_word64ize x = x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [wire_digitsW_word64ize];
+    repeat apply f_equal2; apply word64ize_id.
+Qed.
+
+Definition uncurry_unop_fe2519_32W {T} (op : fe2519_32W -> T)
+  := Eval cbv (*-[word64]*) in Tuple.uncurry (n:=length_fe2519_32) op.
+Definition curry_unop_fe2519_32W {T} op : fe2519_32W -> T
+  := Eval cbv (*-[word64]*) in fun f => app_fe2519_32W f (Tuple.curry (n:=length_fe2519_32) op).
+Definition uncurry_binop_fe2519_32W {T} (op : fe2519_32W -> fe2519_32W -> T)
+  := Eval cbv (*-[word64]*) in uncurry_unop_fe2519_32W (fun f => uncurry_unop_fe2519_32W (op f)).
+Definition curry_binop_fe2519_32W {T} op : fe2519_32W -> fe2519_32W -> T
+  := Eval cbv (*-[word64]*) in appify2 (fun f => curry_unop_fe2519_32W (curry_unop_fe2519_32W op f)).
+
+Definition uncurry_unop_wire_digitsW {T} (op : wire_digitsW -> T)
+  := Eval cbv (*-[word64]*) in Tuple.uncurry (n:=length wire_widths) op.
+Definition curry_unop_wire_digitsW {T} op : wire_digitsW -> T
+  := Eval cbv (*-[word64]*) in fun f => app_wire_digitsW f (Tuple.curry (n:=length wire_widths) op).
+
+
+Definition proj1_fe2519_32W (x : fe2519_32) : fe2519_32W
+  := Eval app_tuple_map in
+      app_fe2519_32 x (HList.mapt (fun _ => (@proj_word _ _))).
+Coercion proj1_fe2519_32 (x : fe2519_32) : SpecificGen.GF2519_32.fe2519_32
+  := fe2519_32WToZ (proj1_fe2519_32W x).
+
+Lemma is_bounded_proj1_fe2519_32 (x : fe2519_32) : is_bounded (proj1_fe2519_32 x) = true.
+Proof.
+  revert x; refine (app_fe2519_32_dep _); intro x.
+  hnf in x; destruct_head' prod; destruct_head' bounded_word.
+  cbv [is_bounded proj1_fe2519_32 proj1_fe2519_32W fe2519_32WToZ to_list length bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map List.rev List.app proj_word length_fe2519_32 is_bounded_gen].
+  apply fold_right_andb_true_iff_fold_right_and_True.
+  cbv [fold_right List.map].
+  cbv beta in *.
+  repeat split; auto using project_is_boundedT.
+Qed.
+
+Definition proj1_wire_digitsW (x : wire_digits) : wire_digitsW
+  := app_wire_digits x (HList.mapt (fun _ => proj_word)).
+Coercion proj1_wire_digits (x : wire_digits) : SpecificGen.GF2519_32.wire_digits
+  := wire_digitsWToZ (proj1_wire_digitsW x).
+
+Lemma is_bounded_proj1_wire_digits (x : wire_digits) : wire_digits_is_bounded (proj1_wire_digits x) = true.
+Proof.
+  revert x; refine (app_wire_digits_dep _); intro x.
+  hnf in x; destruct_head' prod; destruct_head' bounded_word.
+  cbv [wire_digits_is_bounded proj1_wire_digits proj1_wire_digitsW wire_digitsWToZ to_list length wire_digit_bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map List.rev List.app proj_word is_bounded_gen wire_widths HList.mapt HList.mapt' app_wire_digits fst snd].
+  apply fold_right_andb_true_iff_fold_right_and_True.
+  cbv [fold_right List.map].
+  cbv beta in *.
+  repeat split; auto using project_is_boundedT.
+Qed.
+
+Local Ltac make_exist_W' x app_W_dep :=
+  let H := fresh in
+  revert x; refine (@app_W_dep _ _ _); intros x H;
+  let x' := fresh in
+  set (x' := x);
+  cbv [tuple tuple' length_fe2519_32 List.length wire_widths] in x;
+  destruct_head' prod;
+  let rec do_refine v H :=
+      first [ let v' := (eval cbv [snd fst] in (snd v)) in
+              refine (_, Build_bounded_word v' _);
+              [ do_refine (fst v) (proj2 H) | subst x'; abstract exact (proj1 H) ]
+            | let v' := (eval cbv [snd fst] in v) in
+              refine (Build_bounded_word v' _); subst x'; abstract exact (proj1 H) ] in
+  let H' := constr:(proj1 (@fold_right_andb_true_iff_fold_right_and_True _) H) in
+  let T := type of H' in
+  let T := (eval cbv [id
+                        List.fold_right List.map List.length List.app ListUtil.map2 List.rev
+                        Tuple.to_list Tuple.to_list' Tuple.from_list Tuple.from_list' Tuple.map2 Tuple.on_tuple2
+                        fe2519_32 bounds fe2519_32WToZ length_fe2519_32
+                        wire_digits wire_digit_bounds wire_digitsWToZ wire_widths] in T) in
+  let H' := constr:(H' : T) in
+  let v := (eval unfold x' in x') in
+  do_refine v H'.
+Local Ltac make_exist'' x exist_W ZToW :=
+  let H := fresh in
+  intro H; apply (exist_W (ZToW x));
+  abstract (
+      hnf in x; destruct_head' prod;
+      let H' := fresh in
+      pose proof H as H';
+      unfold_is_bounded_in H;
+      destruct_head' and; simpl in *;
+      Z.ltb_to_lt;
+      rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width;
+      assumption
+    ).
+Local Ltac make_exist' x app_W_dep exist'' exist_W ZToW :=
+  let H := fresh in
+  revert x; refine (@app_W_dep _ _ _); intros x H;
+  let x' := fresh in
+  set (x' := x) in *;
+  cbv [tuple tuple' length_fe2519_32 List.length wire_widths] in x;
+  destruct_head' prod;
+  let rec do_refine v :=
+      first [ let v' := (eval cbv [exist_W ZToW exist'' proj_word Build_bounded_word Build_bounded_word' snd fst] in (proj_word v)) in
+              refine (Build_bounded_word v' _); subst x'; abstract exact (word_bounded v)
+            | let v' := (eval cbv [exist_W ZToW exist'' proj_word Build_bounded_word Build_bounded_word' snd fst] in (proj_word (snd v))) in
+              refine (_, Build_bounded_word v' _);
+              [ do_refine (fst v) | subst x'; abstract exact (word_bounded (snd v)) ] ] in
+  let v := (eval unfold x' in (exist'' x' H)) in
+  do_refine v.
+
+Definition exist_fe2519_32W' (x : fe2519_32W) : is_bounded (fe2519_32WToZ x) = true -> fe2519_32.
+Proof. make_exist_W' x (@app_fe2519_32W_dep). Defined.
+Definition exist_fe2519_32W (x : fe2519_32W) : is_bounded (fe2519_32WToZ x) = true -> fe2519_32
+  := Eval cbv [app_fe2519_32W_dep exist_fe2519_32W' fe2519_32ZToW] in exist_fe2519_32W' x.
+Definition exist_fe2519_32'' (x : SpecificGen.GF2519_32.fe2519_32) : is_bounded x = true -> fe2519_32.
+Proof. make_exist'' x exist_fe2519_32W fe2519_32ZToW. Defined.
+Definition exist_fe2519_32' (x : SpecificGen.GF2519_32.fe2519_32) : is_bounded x = true -> fe2519_32.
+Proof. make_exist' x (@app_fe2519_32W_dep) exist_fe2519_32'' exist_fe2519_32W fe2519_32ZToW. Defined.
+Definition exist_fe2519_32 (x : SpecificGen.GF2519_32.fe2519_32) : is_bounded x = true -> fe2519_32
+  := Eval cbv [exist_fe2519_32' exist_fe2519_32W exist_fe2519_32' app_fe2519_32 app_fe2519_32W_dep] in
+      exist_fe2519_32' x.
+
+Lemma proj1_fe2519_32_exist_fe2519_32W x pf : proj1_fe2519_32 (exist_fe2519_32W x pf) = fe2519_32WToZ x.
+Proof. now hnf in x; destruct_head' prod. Qed.
+Lemma proj1_fe2519_32W_exist_fe2519_32 x pf : proj1_fe2519_32W (exist_fe2519_32 x pf) = fe2519_32ZToW x.
+Proof. now hnf in x; destruct_head' prod. Qed.
+Lemma proj1_fe2519_32_exist_fe2519_32 x pf : proj1_fe2519_32 (exist_fe2519_32 x pf) = x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [proj1_fe2519_32 exist_fe2519_32 proj1_fe2519_32W fe2519_32WToZ proj_word Build_bounded_word Build_bounded_word'].
+  unfold_is_bounded_in pf.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Definition exist_wire_digitsW' (x : wire_digitsW)
+  : wire_digits_is_bounded (wire_digitsWToZ x) = true -> wire_digits.
+Proof. make_exist_W' x (@app_wire_digitsW_dep). Defined.
+Definition exist_wire_digitsW (x : wire_digitsW)
+  : wire_digits_is_bounded (wire_digitsWToZ x) = true -> wire_digits
+  := Eval cbv [app_wire_digitsW_dep exist_wire_digitsW' wire_digitsZToW] in exist_wire_digitsW' x.
+Definition exist_wire_digits'' (x : SpecificGen.GF2519_32.wire_digits)
+  : wire_digits_is_bounded x = true -> wire_digits.
+Proof. make_exist'' x exist_wire_digitsW wire_digitsZToW. Defined.
+Definition exist_wire_digits' (x : SpecificGen.GF2519_32.wire_digits)
+  : wire_digits_is_bounded x = true -> wire_digits.
+Proof. make_exist' x (@app_wire_digitsW_dep) exist_wire_digits'' exist_wire_digitsW wire_digitsZToW. Defined.
+Definition exist_wire_digits (x : SpecificGen.GF2519_32.wire_digits)
+  : wire_digits_is_bounded x = true -> wire_digits
+  := Eval cbv [exist_wire_digits' exist_wire_digitsW exist_wire_digits' app_wire_digits app_wire_digitsW_dep] in
+      exist_wire_digits' x.
+
+Lemma proj1_wire_digits_exist_wire_digitsW x pf : proj1_wire_digits (exist_wire_digitsW x pf) = wire_digitsWToZ x.
+Proof. now hnf in x; destruct_head' prod. Qed.
+Lemma proj1_wire_digitsW_exist_wire_digits x pf : proj1_wire_digitsW (exist_wire_digits x pf) = wire_digitsZToW x.
+Proof. now hnf in x; destruct_head' prod. Qed.
+Lemma proj1_wire_digits_exist_wire_digits x pf : proj1_wire_digits (exist_wire_digits x pf) = x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [proj1_wire_digits exist_wire_digits proj1_wire_digitsW wire_digitsWToZ proj_word Build_bounded_word Build_bounded_word' app_wire_digits HList.mapt HList.mapt' length wire_widths fst snd].
+  unfold_is_bounded_in pf.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Module opt.
+  Definition word64ToZ := Eval vm_compute in word64ToZ.
+  Definition word64ToN := Eval vm_compute in @wordToN bit_width.
+  Definition NToWord64 := Eval vm_compute in NToWord64.
+  Definition bit_width := Eval vm_compute in bit_width.
+  Definition Zleb := Eval cbv [Z.leb] in Z.leb.
+  Definition andb := Eval vm_compute in andb.
+  Definition word64ize := Eval vm_compute in word64ize.
+End opt.
+
+Local Transparent bit_width.
+Local Ltac do_change lem :=
+  match lem with
+  | context L[andb (?x <=? ?y)%Z (?y <=? ?z)]
+    => let x' := (eval vm_compute in x) in
+       let z' := (eval vm_compute in z) in
+       lazymatch y with
+       | word64ToZ (word64ize ?v)
+         => let y' := constr:(opt.word64ToZ (opt.word64ize v)) in
+            let L' := context L[andb (opt.Zleb x' y') (opt.Zleb y' z')] in
+            do_change L'
+       end
+  | _ => lem
+  end.
+Definition fe2519_32_word64ize (x : fe2519_32) : fe2519_32.
+Proof.
+  set (x' := x).
+  hnf in x; destruct_head' prod.
+  let lem := constr:(exist_fe2519_32W (fe2519_32W_word64ize (proj1_fe2519_32W x'))) in
+  let lem := (eval cbv [proj1_fe2519_32W x' fe2519_32W_word64ize proj_word exist_fe2519_32W Build_bounded_word' Build_bounded_word] in lem) in
+  let lem := do_change lem in
+  refine (lem _);
+    change (is_bounded (fe2519_32WToZ (fe2519_32W_word64ize (proj1_fe2519_32W x'))) = true);
+    abstract (rewrite fe2519_32W_word64ize_id; apply is_bounded_proj1_fe2519_32).
+Defined.
+Definition wire_digits_word64ize (x : wire_digits) : wire_digits.
+Proof.
+  set (x' := x).
+  hnf in x; destruct_head' prod.
+  let lem := constr:(exist_wire_digitsW (wire_digitsW_word64ize (proj1_wire_digitsW x'))) in
+  let lem := (eval cbv [proj1_wire_digitsW x' wire_digitsW_word64ize proj_word exist_wire_digitsW Build_bounded_word Build_bounded_word'] in lem) in
+  let lem := do_change lem in
+  let lem := (eval cbv [word64ize opt.word64ize andb Z.leb Z.compare CompOpp Pos.compare] in lem) in
+  refine (lem _);
+    change (wire_digits_is_bounded (wire_digitsWToZ (wire_digitsW_word64ize (proj1_wire_digitsW x'))) = true);
+    abstract (rewrite wire_digitsW_word64ize_id; apply is_bounded_proj1_wire_digits).
+Defined.
+
+Lemma is_bounded_to_nth_default x (H : is_bounded x = true)
+  : forall n : nat,
+    (n < length limb_widths)%nat
+    -> (0 <= nth_default 0 (Tuple.to_list length_fe2519_32 x) n <=
+        snd (b_of (nth_default (-1) limb_widths n)))%Z.
+Proof.
+  hnf in x; destruct_head' prod.
+  unfold_is_bounded_in H; destruct_head' and.
+  Z.ltb_to_lt.
+  unfold nth_default; simpl.
+  intros.
+  repeat match goal with
+         | [ |- context[nth_error _ ?x] ]
+           => is_var x; destruct x; simpl
+         end;
+    omega.
+Qed.
+
+(* END precomputation *)
+
+(* Precompute constants *)
+
+Definition one' := Eval vm_compute in exist_fe2519_32 SpecificGen.GF2519_32.one_ eq_refl.
+Definition one := Eval cbv [one' fe2519_32_word64ize word64ize andb opt.word64ToZ opt.word64ize opt.Zleb Z.compare CompOpp Pos.compare Pos.compare_cont] in fe2519_32_word64ize one'.
+
+Definition zero' := Eval vm_compute in exist_fe2519_32 SpecificGen.GF2519_32.zero_ eq_refl.
+Definition zero := Eval cbv [zero' fe2519_32_word64ize word64ize andb opt.word64ToZ opt.word64ize opt.Zleb Z.compare CompOpp Pos.compare Pos.compare_cont] in fe2519_32_word64ize zero'.
+
+Lemma fold_chain_opt_gen {A B} (F : A -> B) is_bounded ls id' op' id op chain
+      (Hid_bounded : is_bounded (F id') = true)
+      (Hid : id = F id')
+      (Hop_bounded : forall x y, is_bounded (F x) = true
+                                 -> is_bounded (F y) = true
+                                 -> is_bounded (op (F x) (F y)) = true)
+      (Hop : forall x y, is_bounded (F x) = true
+                         -> is_bounded (F y) = true
+                         -> op (F x) (F y) = F (op' x y))
+      (Hls_bounded : forall n, is_bounded (F (nth_default id' ls n)) = true)
+  : F (fold_chain_opt id' op' chain ls)
+    = fold_chain_opt id op chain (List.map F ls)
+    /\ is_bounded (F (fold_chain_opt id' op' chain ls)) = true.
+Proof.
+  rewrite !fold_chain_opt_correct.
+  revert dependent ls; induction chain as [|x xs IHxs]; intros.
+  { pose proof (Hls_bounded 0%nat).
+    destruct ls; simpl; split; trivial; congruence. }
+  { destruct x; simpl; unfold Let_In; simpl.
+    rewrite (fun ls pf => proj1 (IHxs ls pf)) at 1; simpl.
+    { do 2 f_equal.
+      rewrite <- Hop, Hid by auto.
+      rewrite !map_nth_default_always.
+      split; try reflexivity.
+      apply (IHxs (_::_)).
+      intros [|?]; autorewrite with simpl_nth_default; auto.
+      rewrite <- Hop; auto. }
+    { intros [|?]; simpl;
+        autorewrite with simpl_nth_default; auto.
+      rewrite <- Hop; auto. } }
+Qed.
+
+Lemma encode_bounded x : is_bounded (encode x) = true.
+Proof.
+  pose proof (bounded_encode x).
+  generalize dependent (encode x).
+  intro t; compute in t; intros.
+  destruct_head' prod.
+  unfold Pow2Base.bounded in H.
+  cbv [nth_default Tuple.to_list Tuple.to_list' List.length limb_widths params2519_32] in H.
+  repeat match type of H with
+         | context[nth_error (cons _ _) _]
+           => let H' := fresh in
+              pose proof (H O) as H'; specialize (fun i => H (S i)); simpl @nth_error in H, H';
+                cbv beta iota in H'
+         end.
+  clear H.
+  simpl in *.
+  cbv [Z.pow_pos Z.mul Pos.mul Pos.iter nth_default nth_error value] in *.
+  unfold is_bounded.
+  apply fold_right_andb_true_iff_fold_right_and_True.
+  cbv [is_bounded proj1_fe2519_32 to_list length bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map List.rev List.app proj_word fold_right length_fe2519_32].
+  repeat split; rewrite !Bool.andb_true_iff, !Z.leb_le; omega.
+Qed.
+
+Definition encode (x : F modulus) : fe2519_32
+  := exist_fe2519_32 (encode x) (encode_bounded x).
+
+Definition decode (x : fe2519_32) : F modulus
+  := ModularBaseSystem.decode (proj1_fe2519_32 x).
+
+Lemma proj1_fe2519_32_encode x
+  : proj1_fe2519_32 (encode x) = ModularBaseSystem.encode x.
+Proof.
+  cbv [encode].
+  generalize (encode_bounded x); generalize (ModularBaseSystem.encode x).
+  intros y pf; intros; hnf in y; destruct_head_hnf' prod.
+  cbv [proj1_fe2519_32 exist_fe2519_32 proj1_fe2519_32W Build_bounded_word Build_bounded_word' fe2519_32WToZ proj_word].
+  unfold_is_bounded_in pf.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Lemma decode_exist_fe2519_32 x pf
+  : decode (exist_fe2519_32 x pf) = ModularBaseSystem.decode x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [decode proj1_fe2519_32 exist_fe2519_32 proj1_fe2519_32W Build_bounded_word Build_bounded_word' fe2519_32WToZ proj_word].
+  unfold_is_bounded_in pf.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Definition div (f g : fe2519_32) : fe2519_32
+  := exist_fe2519_32 (div (proj1_fe2519_32 f) (proj1_fe2519_32 g)) (encode_bounded _).
+
+Definition eq (f g : fe2519_32) : Prop := eq (proj1_fe2519_32 f) (proj1_fe2519_32 g).
+
+
+Notation ibinop_correct_and_bounded irop op
+  := (forall x y,
+         is_bounded (fe2519_32WToZ x) = true
+         -> is_bounded (fe2519_32WToZ y) = true
+         -> fe2519_32WToZ (irop x y) = op (fe2519_32WToZ x) (fe2519_32WToZ y)
+            /\ is_bounded (fe2519_32WToZ (irop x y)) = true) (only parsing).
+Notation iunop_correct_and_bounded irop op
+  := (forall x,
+         is_bounded (fe2519_32WToZ x) = true
+         -> fe2519_32WToZ (irop x) = op (fe2519_32WToZ x)
+            /\ is_bounded (fe2519_32WToZ (irop x)) = true) (only parsing).
+Notation iunop_FEToZ_correct irop op
+  := (forall x,
+         is_bounded (fe2519_32WToZ x) = true
+         -> word64ToZ (irop x) = op (fe2519_32WToZ x)) (only parsing).
+Notation iunop_FEToWire_correct_and_bounded irop op
+  := (forall x,
+         is_bounded (fe2519_32WToZ x) = true
+         -> wire_digitsWToZ (irop x) = op (fe2519_32WToZ x)
+            /\ wire_digits_is_bounded (wire_digitsWToZ (irop x)) = true) (only parsing).
+Notation iunop_WireToFE_correct_and_bounded irop op
+  := (forall x,
+         wire_digits_is_bounded (wire_digitsWToZ x) = true
+         -> fe2519_32WToZ (irop x) = op (wire_digitsWToZ x)
+            /\ is_bounded (fe2519_32WToZ (irop x)) = true) (only parsing).
+
+Definition prefreeze := GF2519_32.prefreeze.
diff --git a/src/SpecificGen/GF2519_32Reflective.v b/src/SpecificGen/GF2519_32Reflective.v
new file mode 100644
index 000000000..964d0f608
--- /dev/null
+++ b/src/SpecificGen/GF2519_32Reflective.v
@@ -0,0 +1,119 @@
+Require Import Crypto.BaseSystem.
+Require Import Crypto.ModularArithmetic.PrimeFieldTheorems.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParams.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParamProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystem.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemOpt.
+Require Export Crypto.SpecificGen.GF2519_32.
+Require Import Crypto.SpecificGen.GF2519_32BoundedCommon.
+Require Import Crypto.Reflection.Reify.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Crypto.Reflection.Z.Interpretations.Relations.
+Require Import Crypto.Reflection.Z.Interpretations.RelationsCombinations.
+Require Import Crypto.Reflection.Z.Reify.
+Require Import Crypto.Reflection.Z.Syntax.
+Require Import Crypto.SpecificGen.GF2519_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF2519_32Reflective.Reified.
+Require Import Bedrock.Word Crypto.Util.WordUtil.
+Require Import Coq.Lists.List Crypto.Util.ListUtil.
+Require Import Crypto.Tactics.VerdiTactics.
+Require Import Crypto.Util.ZUtil.
+Require Import Crypto.Util.Tuple.
+Require Import Crypto.Util.Tactics.
+Require Import Crypto.Util.LetIn.
+Require Import Crypto.Util.Notations.
+Require Import Crypto.Util.Bool.
+Require Import Crypto.Util.Decidable.
+Require Import Crypto.Algebra.
+Import ListNotations.
+Require Import Coq.ZArith.ZArith Coq.ZArith.Zpower Coq.ZArith.ZArith Coq.ZArith.Znumtheory.
+Local Open Scope Z.
+
+Definition radd : ExprBinOp := Eval vm_compute in rcarry_addW.
+Definition rsub : ExprBinOp := Eval vm_compute in rcarry_subW.
+Definition rmul : ExprBinOp := Eval vm_compute in rmulW.
+Definition ropp : ExprUnOp := Eval vm_compute in rcarry_oppW.
+Definition rprefreeze : ExprUnOp := Eval vm_compute in rprefreezeW.
+Definition rge_modulus : ExprUnOpFEToZ := Eval vm_compute in rge_modulusW.
+Definition rpack : ExprUnOpFEToWire := Eval vm_compute in rpackW.
+Definition runpack : ExprUnOpWireToFE := Eval vm_compute in runpackW.
+
+Definition rword64ize {t} (x : Expr t) : Expr t
+  := MapInterp (fun t => match t with TZ => word64ize end) x.
+
+Declare Reduction asm_interp
+  := cbv beta iota delta
+         [id
+            interp_bexpr interp_uexpr interp_uexpr_FEToWire interp_uexpr_FEToZ interp_uexpr_WireToFE
+            radd rsub rmul ropp rprefreeze rge_modulus rpack runpack
+            curry_binop_fe2519_32W curry_unop_fe2519_32W curry_unop_wire_digitsW
+            Word64.interp_op Word64.interp_base_type
+            Z.interp_op Z.interp_base_type
+            Z.Syntax.interp_op Z.Syntax.interp_base_type
+            mapf_interp_flat_type map_interp Word64.interp_base_type MapInterp mapf_interp word64ize rword64ize
+            Interp interp interp_flat_type interpf interp_flat_type fst snd].
+Ltac asm_interp
+  := cbv beta iota delta
+         [id
+            interp_bexpr interp_uexpr interp_uexpr_FEToWire interp_uexpr_FEToZ interp_uexpr_WireToFE
+            radd rsub rmul ropp rprefreeze rge_modulus rpack runpack
+            curry_binop_fe2519_32W curry_unop_fe2519_32W curry_unop_wire_digitsW
+            Word64.interp_op Word64.interp_base_type
+            Z.interp_op Z.interp_base_type
+            Z.Syntax.interp_op Z.Syntax.interp_base_type
+            mapf_interp_flat_type map_interp Word64.interp_base_type MapInterp mapf_interp word64ize rword64ize
+            Interp interp interp_flat_type interpf interp_flat_type fst snd].
+
+
+Definition interp_radd : SpecificGen.GF2519_32BoundedCommon.fe2519_32W -> SpecificGen.GF2519_32BoundedCommon.fe2519_32W -> SpecificGen.GF2519_32BoundedCommon.fe2519_32W
+  := Eval asm_interp in interp_bexpr (rword64ize radd).
+(*Print interp_radd.*)
+Definition interp_radd_correct : interp_radd = interp_bexpr radd := eq_refl.
+Definition interp_rsub : SpecificGen.GF2519_32BoundedCommon.fe2519_32W -> SpecificGen.GF2519_32BoundedCommon.fe2519_32W -> SpecificGen.GF2519_32BoundedCommon.fe2519_32W
+  := Eval asm_interp in interp_bexpr (rword64ize rsub).
+(*Print interp_rsub.*)
+Definition interp_rsub_correct : interp_rsub = interp_bexpr rsub := eq_refl.
+Definition interp_rmul : SpecificGen.GF2519_32BoundedCommon.fe2519_32W -> SpecificGen.GF2519_32BoundedCommon.fe2519_32W -> SpecificGen.GF2519_32BoundedCommon.fe2519_32W
+  := Eval asm_interp in interp_bexpr (rword64ize rmul).
+(*Print interp_rmul.*)
+Definition interp_rmul_correct : interp_rmul = interp_bexpr rmul := eq_refl.
+Definition interp_ropp : SpecificGen.GF2519_32BoundedCommon.fe2519_32W -> SpecificGen.GF2519_32BoundedCommon.fe2519_32W
+  := Eval asm_interp in interp_uexpr (rword64ize ropp).
+(*Print interp_ropp.*)
+Definition interp_ropp_correct : interp_ropp = interp_uexpr ropp := eq_refl.
+Definition interp_rprefreeze : SpecificGen.GF2519_32BoundedCommon.fe2519_32W -> SpecificGen.GF2519_32BoundedCommon.fe2519_32W
+  := Eval asm_interp in interp_uexpr (rword64ize rprefreeze).
+(*Print interp_rprefreeze.*)
+Definition interp_rprefreeze_correct : interp_rprefreeze = interp_uexpr rprefreeze := eq_refl.
+
+Definition interp_rge_modulus : SpecificGen.GF2519_32BoundedCommon.fe2519_32W -> SpecificGen.GF2519_32BoundedCommon.word64
+  := Eval asm_interp in interp_uexpr_FEToZ (rword64ize rge_modulus).
+Definition interp_rge_modulus_correct : interp_rge_modulus = interp_uexpr_FEToZ rge_modulus := eq_refl.
+
+Definition interp_rpack : SpecificGen.GF2519_32BoundedCommon.fe2519_32W -> SpecificGen.GF2519_32BoundedCommon.wire_digitsW
+  := Eval asm_interp in interp_uexpr_FEToWire (rword64ize rpack).
+Definition interp_rpack_correct : interp_rpack = interp_uexpr_FEToWire rpack := eq_refl.
+
+Definition interp_runpack : SpecificGen.GF2519_32BoundedCommon.wire_digitsW -> SpecificGen.GF2519_32BoundedCommon.fe2519_32W
+  := Eval asm_interp in interp_uexpr_WireToFE (rword64ize runpack).
+Definition interp_runpack_correct : interp_runpack = interp_uexpr_WireToFE runpack := eq_refl.
+
+Lemma radd_correct_and_bounded : binop_correct_and_bounded radd carry_add.
+Proof. exact rcarry_addW_correct_and_bounded. Qed.
+Lemma rsub_correct_and_bounded : binop_correct_and_bounded rsub carry_sub.
+Proof. exact rcarry_subW_correct_and_bounded. Qed.
+Lemma rmul_correct_and_bounded : binop_correct_and_bounded rmul mul.
+Proof. exact rmulW_correct_and_bounded. Qed.
+Lemma ropp_correct_and_bounded : unop_correct_and_bounded ropp carry_opp.
+Proof. exact rcarry_oppW_correct_and_bounded. Qed.
+Lemma rprefreeze_correct_and_bounded : unop_correct_and_bounded rprefreeze prefreeze.
+Proof. exact rprefreezeW_correct_and_bounded. Qed.
+Lemma rge_modulus_correct_and_bounded : unop_FEToZ_correct rge_modulus ge_modulus.
+Proof. exact rge_modulusW_correct_and_bounded. Qed.
+Lemma rpack_correct_and_bounded : unop_FEToWire_correct_and_bounded rpack pack.
+Proof. exact rpackW_correct_and_bounded. Qed.
+Lemma runpack_correct_and_bounded : unop_WireToFE_correct_and_bounded runpack unpack.
+Proof. exact runpackW_correct_and_bounded. Qed.
diff --git a/src/SpecificGen/GF2519_32Reflective/Common.v b/src/SpecificGen/GF2519_32Reflective/Common.v
new file mode 100644
index 000000000..16a7dd72c
--- /dev/null
+++ b/src/SpecificGen/GF2519_32Reflective/Common.v
@@ -0,0 +1,438 @@
+Require Export Coq.ZArith.ZArith.
+Require Export Coq.Strings.String.
+Require Export Crypto.SpecificGen.GF2519_32.
+Require Export Crypto.SpecificGen.GF2519_32BoundedCommon.
+Require Import Crypto.Reflection.Reify.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Crypto.Reflection.Z.Interpretations.Relations.
+Require Import Crypto.Reflection.Z.Interpretations.RelationsCombinations.
+Require Import Crypto.Reflection.Z.Reify.
+Require Export Crypto.Reflection.Z.Syntax.
+Require Import Crypto.Reflection.InterpWfRel.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Reflection.MapInterpWf.
+Require Import Crypto.Reflection.WfReflective.
+Require Import Crypto.Util.LetIn.
+Require Import Crypto.Util.ZUtil.
+Require Import Crypto.Util.Tactics.
+Require Import Crypto.Util.Notations.
+
+Notation Expr := (Expr base_type Word64.interp_base_type op).
+
+Local Ltac make_type_from uncurried_op :=
+  let T := (type of uncurried_op) in
+  let T := (eval compute in T) in
+  let rT := reify_type T in
+  exact rT.
+
+Definition ExprBinOpT : type base_type.
+Proof. make_type_from (uncurry_binop_fe2519_32 carry_add). Defined.
+Definition ExprUnOpT : type base_type.
+Proof. make_type_from (uncurry_unop_fe2519_32 carry_opp). Defined.
+Definition ExprUnOpFEToZT : type base_type.
+Proof. make_type_from (uncurry_unop_fe2519_32 ge_modulus). Defined.
+Definition ExprUnOpWireToFET : type base_type.
+Proof. make_type_from (uncurry_unop_wire_digits unpack). Defined.
+Definition ExprUnOpFEToWireT : type base_type.
+Proof. make_type_from (uncurry_unop_fe2519_32 pack). Defined.
+Definition ExprBinOp : Type := Expr ExprBinOpT.
+Definition ExprUnOp : Type := Expr ExprUnOpT.
+Definition ExprUnOpFEToZ : Type := Expr ExprUnOpFEToZT.
+Definition ExprUnOpWireToFE : Type := Expr ExprUnOpWireToFET.
+Definition ExprUnOpFEToWire : Type := Expr ExprUnOpFEToWireT.
+
+Local Ltac bounds_from_list ls :=
+  lazymatch (eval hnf in ls) with
+  | (?x :: nil)%list => constr:(Some {| ZBounds.lower := fst x ; ZBounds.upper := snd x |})
+  | (?x :: ?xs)%list => let bs := bounds_from_list xs in
+                        constr:((Some {| ZBounds.lower := fst x ; ZBounds.upper := snd x |}, bs))
+  end.
+
+Local Ltac make_bounds ls :=
+  compute;
+  let v := bounds_from_list (List.rev ls) in
+  let v := (eval compute in v) in
+  exact v.
+
+Definition ExprBinOp_bounds : interp_all_binders_for ExprBinOpT ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ bounds ++ Tuple.to_list _ bounds)%list. Defined.
+Definition ExprUnOp_bounds : interp_all_binders_for ExprUnOpT ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ bounds). Defined.
+Definition ExprUnOpFEToZ_bounds : interp_all_binders_for ExprUnOpFEToZT ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ bounds). Defined.
+Definition ExprUnOpFEToWire_bounds : interp_all_binders_for ExprUnOpFEToWireT ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ bounds). Defined.
+Definition ExprUnOpWireToFE_bounds : interp_all_binders_for ExprUnOpWireToFET ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ wire_digit_bounds). Defined.
+
+Definition interp_bexpr : ExprBinOp -> SpecificGen.GF2519_32BoundedCommon.fe2519_32W -> SpecificGen.GF2519_32BoundedCommon.fe2519_32W -> SpecificGen.GF2519_32BoundedCommon.fe2519_32W
+  := fun e => curry_binop_fe2519_32W (Interp (@Word64.interp_op) e).
+Definition interp_uexpr : ExprUnOp -> SpecificGen.GF2519_32BoundedCommon.fe2519_32W -> SpecificGen.GF2519_32BoundedCommon.fe2519_32W
+  := fun e => curry_unop_fe2519_32W (Interp (@Word64.interp_op) e).
+Definition interp_uexpr_FEToZ : ExprUnOpFEToZ -> SpecificGen.GF2519_32BoundedCommon.fe2519_32W -> SpecificGen.GF2519_32BoundedCommon.word64
+  := fun e => curry_unop_fe2519_32W (Interp (@Word64.interp_op) e).
+Definition interp_uexpr_FEToWire : ExprUnOpFEToWire -> SpecificGen.GF2519_32BoundedCommon.fe2519_32W -> SpecificGen.GF2519_32BoundedCommon.wire_digitsW
+  := fun e => curry_unop_fe2519_32W (Interp (@Word64.interp_op) e).
+Definition interp_uexpr_WireToFE : ExprUnOpWireToFE -> SpecificGen.GF2519_32BoundedCommon.wire_digitsW -> SpecificGen.GF2519_32BoundedCommon.fe2519_32W
+  := fun e => curry_unop_wire_digitsW (Interp (@Word64.interp_op) e).
+
+Notation binop_correct_and_bounded rop op
+  := (ibinop_correct_and_bounded (interp_bexpr rop) op) (only parsing).
+Notation unop_correct_and_bounded rop op
+  := (iunop_correct_and_bounded (interp_uexpr rop) op) (only parsing).
+Notation unop_FEToZ_correct rop op
+  := (iunop_FEToZ_correct (interp_uexpr_FEToZ rop) op) (only parsing).
+Notation unop_FEToWire_correct_and_bounded rop op
+  := (iunop_FEToWire_correct_and_bounded (interp_uexpr_FEToWire rop) op) (only parsing).
+Notation unop_WireToFE_correct_and_bounded rop op
+  := (iunop_WireToFE_correct_and_bounded (interp_uexpr_WireToFE rop) op) (only parsing).
+
+Ltac rexpr_cbv :=
+  lazymatch goal with
+  | [ |- { rexpr | interp_type_gen_rel_pointwise _ (Interp _ (t:=?T) rexpr) (?uncurry ?oper) } ]
+    => let operf := head oper in
+       let uncurryf := head uncurry in
+       try cbv delta [T]; try cbv delta [oper];
+       try cbv beta iota delta [uncurryf]
+  end;
+  cbv beta iota delta [interp_flat_type Z.interp_base_type interp_base_type zero_].
+
+Ltac reify_sig :=
+  rexpr_cbv; eexists; Reify_rhs; reflexivity.
+
+Local Notation rexpr_sig T uncurried_op :=
+  { rexprZ
+  | interp_type_gen_rel_pointwise (fun _ => Logic.eq) (Interp interp_op (t:=T) rexprZ) uncurried_op }
+    (only parsing).
+
+Notation rexpr_binop_sig op := (rexpr_sig ExprBinOpT (uncurry_binop_fe2519_32 op)) (only parsing).
+Notation rexpr_unop_sig op := (rexpr_sig ExprUnOpT (uncurry_unop_fe2519_32 op)) (only parsing).
+Notation rexpr_unop_FEToZ_sig op := (rexpr_sig ExprUnOpFEToZT (uncurry_unop_fe2519_32 op)) (only parsing).
+Notation rexpr_unop_FEToWire_sig op := (rexpr_sig ExprUnOpFEToWireT (uncurry_unop_fe2519_32 op)) (only parsing).
+Notation rexpr_unop_WireToFE_sig op := (rexpr_sig ExprUnOpWireToFET (uncurry_unop_wire_digits op)) (only parsing).
+
+Notation correct_and_bounded_genT ropW'v ropZ_sigv
+  := (let ropW' := ropW'v in
+      let ropZ_sig := ropZ_sigv in
+      let ropW := MapInterp (fun _ x => x) ropW' in
+      let ropZ := MapInterp Word64.to_Z ropW' in
+      let ropBounds := MapInterp ZBounds.of_word64 ropW' in
+      let ropBoundedWord64 := MapInterp BoundedWord64.of_word64 ropW' in
+      ropZ = proj1_sig ropZ_sig
+      /\ interp_type_rel_pointwise2 Relations.related_Z (Interp (@BoundedWord64.interp_op) ropBoundedWord64) (Interp (@Z.interp_op) ropZ)
+      /\ interp_type_rel_pointwise2 Relations.related_bounds (Interp (@BoundedWord64.interp_op) ropBoundedWord64) (Interp (@ZBounds.interp_op) ropBounds)
+      /\ interp_type_rel_pointwise2 Relations.related_word64 (Interp (@BoundedWord64.interp_op) ropBoundedWord64) (Interp (@Word64.interp_op) ropW))
+       (only parsing).
+
+Ltac app_tuples x y :=
+  let tx := type of x in
+  lazymatch (eval hnf in tx) with
+  | prod _ _ => let xs := app_tuples (snd x) y in
+                constr:((fst x, xs))
+  | _ => constr:((x, y))
+  end.
+
+Local Arguments Tuple.map2 : simpl never.
+Local Arguments Tuple.map : simpl never.
+
+Fixpoint args_to_bounded_helperT {n}
+         (v : Tuple.tuple' Word64.word64 n)
+         (bounds : Tuple.tuple' (Z * Z) n)
+         (pf : List.fold_right
+                 andb true
+                 (Tuple.to_list
+                    _
+                    (Tuple.map2
+                       (n:=S n)
+                       (fun bounds v =>
+                          let '(lower, upper) := bounds in ((lower <=? v)%Z && (v <=? upper)%Z)%bool)
+                       bounds
+                       (Tuple.map (n:=S n) Word64.word64ToZ v))) = true)
+         (res : Type)
+         {struct n}
+  : Type.
+Proof.
+  refine (match n return (forall (v : Tuple.tuple' _ n) (bounds : Tuple.tuple' _ n),
+                             List.fold_right
+                               _ _ (Tuple.to_list
+                                      _
+                                      (Tuple.map2 (n:=S n) _ bounds (Tuple.map (n:=S n) _ v))) = true
+                             -> Type)
+          with
+          | 0 => fun v' bounds' pf0 => forall pf1 : (0 <= fst bounds' /\ Z.log2 (snd bounds') < Z.of_nat Word64.bit_width)%Z, res
+          | S n' => fun v' bounds' pf0 => let t := _ in
+                                        forall pf1 : (0 <= fst (snd bounds') /\ Z.log2 (snd (snd bounds')) < Z.of_nat Word64.bit_width)%Z, @args_to_bounded_helperT n' (fst v') (fst bounds') t res
+          end v bounds pf).
+  { clear -pf0.
+    abstract (
+        destruct v', bounds'; simpl @fst;
+        rewrite Tuple.map_S in pf0;
+        simpl in pf0;
+        rewrite Tuple.map2_S in pf0;
+        simpl @List.fold_right in *;
+        rewrite Bool.andb_true_iff in pf0; tauto
+      ). }
+Defined.
+
+Fixpoint args_to_bounded_helper {n} res
+         {struct n}
+  : forall v bounds pf, (Tuple.tuple' BoundedWord64.BoundedWord n -> res) -> @args_to_bounded_helperT n v bounds pf res.
+Proof.
+  refine match n return (forall v bounds pf, (Tuple.tuple' BoundedWord64.BoundedWord n -> res) -> @args_to_bounded_helperT n v bounds pf res) with
+         | 0 => fun v bounds pf f pf' => f {| BoundedWord64.lower := fst bounds ; BoundedWord64.value := v ; BoundedWord64.upper := snd bounds |}
+         | S n'
+           => fun v bounds pf f pf'
+              => @args_to_bounded_helper
+                   n' res (fst v) (fst bounds) _
+                   (fun ts => f (ts, {| BoundedWord64.lower := fst (snd bounds) ; BoundedWord64.value := snd v ; BoundedWord64.upper := snd (snd bounds) |}))
+         end.
+  { clear -pf pf'.
+    unfold Tuple.map2, Tuple.map in pf; simpl in *.
+    abstract (
+        destruct bounds;
+        simpl in *;
+        rewrite !Bool.andb_true_iff in pf;
+        destruct_head' and;
+        Z.ltb_to_lt; auto
+      ). }
+  { simpl in *.
+    clear -pf pf'.
+    abstract (
+        destruct bounds as [? [? ?] ], v; simpl in *;
+        rewrite Tuple.map_S in pf; simpl in pf; rewrite Tuple.map2_S in pf;
+        simpl in pf;
+        rewrite !Bool.andb_true_iff in pf;
+        destruct_head' and;
+        Z.ltb_to_lt; auto
+      ). }
+Defined.
+
+Definition assoc_right''
+  := Eval cbv [Tuple.assoc_right' Tuple.rsnoc' fst snd] in @Tuple.assoc_right'.
+
+Definition args_to_bounded {n} v bounds pf
+  := Eval cbv [args_to_bounded_helper assoc_right''] in
+      @args_to_bounded_helper n _ v bounds pf (@assoc_right'' _ _).
+
+Local Ltac get_len T :=
+  match (eval hnf in T) with
+  | prod ?A ?B
+    => let a := get_len A in
+       let b := get_len B in
+       (eval compute in (a + b)%nat)
+  | _ => constr:(1%nat)
+  end.
+
+Local Ltac args_to_bounded x H :=
+  let x' := fresh in
+  set (x' := x);
+  compute in x;
+  let len := (let T := type of x in get_len T) in
+  destruct_head' prod;
+  let c := constr:(args_to_bounded (n:=pred len) x' _ H) in
+  let bounds := lazymatch c with args_to_bounded _ ?bounds _ => bounds end in
+  let c := (eval cbv [all_binders_for ExprUnOpT interp_flat_type args_to_bounded bounds pred fst snd] in c) in
+  apply c; compute; clear;
+  try abstract (
+        repeat split;
+        solve [ reflexivity
+              | refine (fun v => match v with eq_refl => I end) ]
+      ).
+
+Definition unop_args_to_bounded (x : fe2519_32W) (H : is_bounded (fe2519_32WToZ x) = true)
+  : interp_flat_type (fun _ => BoundedWord64.BoundedWord) (all_binders_for ExprUnOpT).
+Proof. args_to_bounded x H. Defined.
+
+Definition unopWireToFE_args_to_bounded (x : wire_digitsW) (H : wire_digits_is_bounded (wire_digitsWToZ x) = true)
+  : interp_flat_type (fun _ => BoundedWord64.BoundedWord) (all_binders_for ExprUnOpWireToFET).
+Proof. args_to_bounded x H. Defined.
+Definition binop_args_to_bounded (x : fe2519_32W * fe2519_32W)
+           (H : is_bounded (fe2519_32WToZ (fst x)) = true)
+           (H' : is_bounded (fe2519_32WToZ (snd x)) = true)
+  : interp_flat_type (fun _ => BoundedWord64.BoundedWord) (all_binders_for ExprBinOpT).
+Proof.
+  let v := app_tuples (unop_args_to_bounded (fst x) H) (unop_args_to_bounded (snd x) H') in
+  exact v.
+Defined.
+
+Ltac assoc_right_tuple x so_far :=
+  let t := type of x in
+  lazymatch (eval hnf in t) with
+  | prod _ _ => let so_far := assoc_right_tuple (snd x) so_far in
+                assoc_right_tuple (fst x) so_far
+  | _ => lazymatch so_far with
+         | @None => x
+         | _ => constr:((x, so_far))
+         end
+  end.
+
+Local Ltac make_bounds_prop bounds orig_bounds :=
+  let bounds' := fresh "bounds'" in
+  let bounds_bad := fresh "bounds_bad" in
+  rename bounds into bounds_bad;
+  let boundsv := assoc_right_tuple bounds_bad (@None) in
+  pose boundsv as bounds;
+  pose orig_bounds as bounds';
+  repeat (refine (match fst bounds' with
+                  | Some bounds' => let (l, u) := fst bounds in
+                                    let (l', u') := bounds' in
+                                    ((l' <=? l) && (u <=? u'))%Z%bool
+                  | None => false
+                  end && _)%bool;
+          destruct bounds' as [_ bounds'], bounds as [_ bounds]);
+  try exact (match bounds' with
+             | Some bounds' => let (l, u) := bounds in
+                               let (l', u') := bounds' in
+                               ((l' <=? l) && (u <=? u'))%Z%bool
+             | None => false
+             end).
+
+Definition unop_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprUnOpT)) : bool.
+Proof. make_bounds_prop bounds ExprUnOp_bounds. Defined.
+Definition binop_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprBinOpT)) : bool.
+Proof. make_bounds_prop bounds ExprUnOp_bounds. Defined.
+Definition unopFEToWire_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprUnOpFEToWireT)) : bool.
+Proof. make_bounds_prop bounds ExprUnOpWireToFE_bounds. Defined.
+Definition unopWireToFE_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprUnOpWireToFET)) : bool.
+Proof. make_bounds_prop bounds ExprUnOp_bounds. Defined.
+(* TODO FIXME(jgross?, andreser?): Is every function returning a single Z a boolean function? *)
+Definition unopFEToZ_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprUnOpFEToZT)) : bool.
+Proof.
+  refine (let (l, u) := bounds in ((0 <=? l) && (u <=? 1))%Z%bool).
+Defined.
+
+(* FIXME TODO(jgross): This is a horrible tactic.  We should unify the
+    various kinds of correct and boundedness, and abstract in Gallina
+    rather than Ltac *)
+
+Ltac t_correct_and_bounded ropZ_sig Hbounds H0 H1 args :=
+  let Heq := fresh "Heq" in
+  let Hbounds0 := fresh "Hbounds0" in
+  let Hbounds1 := fresh "Hbounds1" in
+  let Hbounds2 := fresh "Hbounds2" in
+  pose proof (proj2_sig ropZ_sig) as Heq;
+  cbv [interp_bexpr interp_uexpr interp_uexpr_FEToWire interp_uexpr_FEToZ interp_uexpr_WireToFE
+                    curry_binop_fe2519_32W curry_unop_fe2519_32W curry_unop_wire_digitsW
+                    curry_binop_fe2519_32 curry_unop_fe2519_32 curry_unop_wire_digits
+                    uncurry_binop_fe2519_32W uncurry_unop_fe2519_32W uncurry_unop_wire_digitsW
+                    uncurry_binop_fe2519_32 uncurry_unop_fe2519_32 uncurry_unop_wire_digits
+                    ExprBinOpT ExprUnOpFEToWireT ExprUnOpT ExprUnOpFEToZT ExprUnOpWireToFET
+                    interp_type_gen_rel_pointwise interp_type_gen_rel_pointwise] in *;
+  cbv zeta in *;
+  simpl @fe2519_32WToZ; simpl @wire_digitsWToZ;
+  rewrite <- Heq; clear Heq;
+  destruct Hbounds as [Heq Hbounds];
+  change interp_op with (@Z.interp_op) in *;
+  change interp_base_type with (@Z.interp_base_type) in *;
+  rewrite <- Heq; clear Heq;
+  destruct Hbounds as [ Hbounds0 [Hbounds1 Hbounds2] ];
+  pose proof (fun pf => Relations.uncurry_interp_type_rel_pointwise2_proj_from_option2 Word64.to_Z pf Hbounds2 Hbounds0) as Hbounds_left;
+  pose proof (fun pf => Relations.uncurry_interp_type_rel_pointwise2_proj1_from_option2 Relations.related_word64_boundsi' pf Hbounds1 Hbounds2) as Hbounds_right;
+  specialize_by repeat first [ progress intros
+                             | reflexivity
+                             | assumption
+                             | progress destruct_head' base_type
+                             | progress destruct_head' BoundedWord64.BoundedWord
+                             | progress destruct_head' and
+                             | progress repeat apply conj ];
+  specialize (Hbounds_left args H0);
+  specialize (Hbounds_right args H0);
+  cbv beta in *;
+  lazymatch type of Hbounds_right with
+  | match ?e with _ => _ end
+    => lazymatch type of H1 with
+       | match ?e' with _ => _ end
+         => change e' with e in H1; destruct e eqn:?; [ | exfalso; assumption ]
+       end
+  end;
+  repeat match goal with x := _ |- _ => subst x end;
+  cbv [id
+         binop_args_to_bounded unop_args_to_bounded unopWireToFE_args_to_bounded
+         Relations.proj_eq_rel interp_flat_type_rel_pointwise2 SmartVarfMap interp_flat_type smart_interp_flat_map Application.all_binders_for fst snd BoundedWord64.to_word64' BoundedWord64.boundedWordToWord64 BoundedWord64.value Application.ApplyInterpedAll Application.fst_binder Application.snd_binder interp_flat_type_rel_pointwise2_gen_Prop Relations.related_word64_boundsi' Relations.related'_word64_bounds ZBounds.upper ZBounds.lower Application.remove_all_binders Word64.to_Z] in Hbounds_left, Hbounds_right;
+  match goal with
+  | [ |- fe2519_32WToZ ?x = _ /\ _ ]
+    => destruct x; destruct_head_hnf' prod
+  | [ |- wire_digitsWToZ ?x = _ /\ _ ]
+    => destruct x; destruct_head_hnf' prod
+  | [ |- _ = _ ]
+    => exact Hbounds_left
+  end;
+  change word64ToZ with Word64.word64ToZ in *;
+  (split; [ exact Hbounds_left | ]);
+  cbv [interp_flat_type] in *;
+  cbv [fst snd
+           binop_bounds_good unop_bounds_good unopFEToWire_bounds_good unopWireToFE_bounds_good unopFEToZ_bounds_good
+           ExprUnOp_bounds ExprBinOp_bounds ExprUnOpFEToWire_bounds ExprUnOpFEToZ_bounds ExprUnOpWireToFE_bounds] in H1;
+  destruct_head' ZBounds.bounds;
+  unfold_is_bounded_in H1;
+  simpl @fe2519_32WToZ; simpl @wire_digitsWToZ;
+  unfold_is_bounded;
+  destruct_head' and;
+  Z.ltb_to_lt;
+  change Word64.word64ToZ with word64ToZ in *;
+  repeat apply conj; Z.ltb_to_lt; try omega; try reflexivity.
+
+
+Ltac rexpr_correct :=
+  let ropW' := fresh in
+  let ropZ_sig := fresh in
+  intros ropW' ropZ_sig;
+  let wf_ropW := fresh "wf_ropW" in
+  assert (wf_ropW : Wf ropW') by (subst ropW' ropZ_sig; reflect_Wf base_type_eq_semidec_is_dec op_beq_bl);
+  cbv zeta; repeat apply conj;
+  [ vm_compute; reflexivity
+  | apply @InterpRelWf;
+    [ | apply @RelWfMapInterp, wf_ropW ].. ];
+  auto with interp_related.
+
+Notation rword_of_Z rexprZ_sig := (MapInterp Word64.of_Z (proj1_sig rexprZ_sig)) (only parsing).
+
+Notation compute_bounds opW bounds
+  := (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp (@ZBounds.of_word64) opW)) bounds)
+       (only parsing).
+
+
+Module Export PrettyPrinting.
+  (* We add [enlargen] to force [bounds_on] to be in [Type] in 8.4 and
+     8.5/8.6.  Because [Set] is special and things break if
+     [bounds_on] ends up in [Set] for reasons jgross hasn't bothered
+     to debug. *)
+  Inductive bounds_on := overflow | in_range (lower upper : Z) | enlargen (_ : Set).
+
+  Inductive result := yes | no | borked.
+
+  Definition ZBounds_to_bounds_on
+    := fun t : base_type
+       => match t return ZBounds.interp_base_type t -> match t with TZ => bounds_on end with
+          | TZ => fun x => match x with
+                           | Some {| ZBounds.lower := l ; ZBounds.upper := u |}
+                             => in_range l u
+                           | None
+                             => overflow
+                           end
+          end.
+
+  Fixpoint does_it_overflow {t} : interp_flat_type (fun t => match t with TZ => bounds_on end) t -> result
+    := match t return interp_flat_type (fun t => match t with TZ => bounds_on end) t -> result with
+       | Tbase TZ => fun v => match v with
+                              | overflow => yes
+                              | in_range _ _ => no
+                              | enlargen _ => borked
+                              end
+       | Prod x y => fun v => match @does_it_overflow _ (fst v), @does_it_overflow _ (snd v) with
+                              | no, no => no
+                              | yes, no | no, yes | yes, yes => yes
+                              | borked, _ | _, borked => borked
+                              end
+       end.
+
+  (** This gives a slightly easier to read version of the bounds *)
+  Notation compute_bounds_for_display opW bounds
+    := (SmartVarfMap ZBounds_to_bounds_on (compute_bounds opW bounds)) (only parsing).
+  Notation sanity_compute opW bounds
+    := (does_it_overflow (SmartVarfMap ZBounds_to_bounds_on (compute_bounds opW bounds))) (only parsing).
+  Notation sanity_check opW bounds
+    := (eq_refl (sanity_compute opW bounds) <: no = no) (only parsing).
+End PrettyPrinting.
diff --git a/src/SpecificGen/GF2519_32Reflective/CommonBinOp.v b/src/SpecificGen/GF2519_32Reflective/CommonBinOp.v
new file mode 100644
index 000000000..d2bce7c3f
--- /dev/null
+++ b/src/SpecificGen/GF2519_32Reflective/CommonBinOp.v
@@ -0,0 +1,50 @@
+Require Export Crypto.SpecificGen.GF2519_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF2519_32BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprBinOp_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_binop_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall xy
+                   (xy := (eta_fe2519_32W (fst xy), eta_fe2519_32W (snd xy)))
+                   (Hxy : is_bounded (fe2519_32WToZ (fst xy)) = true
+                          /\ is_bounded (fe2519_32WToZ (snd xy)) = true),
+          let Hx := let (Hx, Hy) := Hxy in Hx in
+          let Hy := let (Hx, Hy) := Hxy in Hy in
+          let args := binop_args_to_bounded xy Hx Hy in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall xy
+                   (xy := (eta_fe2519_32W (fst xy), eta_fe2519_32W (snd xy)))
+                   (Hxy : is_bounded (fe2519_32WToZ (fst xy)) = true
+                          /\ is_bounded (fe2519_32WToZ (snd xy)) = true),
+          let Hx := let (Hx, Hy) := Hxy in Hx in
+          let Hy := let (Hx, Hy) := Hxy in Hy in
+          let args := binop_args_to_bounded (fst xy, snd xy) Hx Hy in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => binop_bounds_good bounds = true
+          | None => False
+          end)
+  : binop_correct_and_bounded (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x y Hx Hy.
+  pose x as x'; pose y as y'.
+  hnf in x, y; destruct_head' prod.
+  specialize (H0 (x', y') (conj Hx Hy)).
+  specialize (H1 (x', y') (conj Hx Hy)).
+  let args := constr:(binop_args_to_bounded (x', y') Hx Hy) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF2519_32Reflective/CommonUnOp.v b/src/SpecificGen/GF2519_32Reflective/CommonUnOp.v
new file mode 100644
index 000000000..d651e6118
--- /dev/null
+++ b/src/SpecificGen/GF2519_32Reflective/CommonUnOp.v
@@ -0,0 +1,44 @@
+Require Export Crypto.SpecificGen.GF2519_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF2519_32BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprUnOp_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_unop_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall x
+                   (x := eta_fe2519_32W x)
+                   (Hx : is_bounded (fe2519_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall x
+                   (x := eta_fe2519_32W x)
+                   (Hx : is_bounded (fe2519_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => unop_bounds_good bounds = true
+          | None => False
+          end)
+  : unop_correct_and_bounded (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x Hx.
+  pose x as x'.
+  hnf in x; destruct_head' prod.
+  specialize (H0 x' Hx).
+  specialize (H1 x' Hx).
+  let args := constr:(unop_args_to_bounded x' Hx) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF2519_32Reflective/CommonUnOpFEToWire.v b/src/SpecificGen/GF2519_32Reflective/CommonUnOpFEToWire.v
new file mode 100644
index 000000000..10dc0866e
--- /dev/null
+++ b/src/SpecificGen/GF2519_32Reflective/CommonUnOpFEToWire.v
@@ -0,0 +1,44 @@
+Require Export Crypto.SpecificGen.GF2519_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF2519_32BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprUnOpFEToWire_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_unop_FEToWire_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall x
+                   (x := eta_fe2519_32W x)
+                   (Hx : is_bounded (fe2519_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall x
+                   (x := eta_fe2519_32W x)
+                   (Hx : is_bounded (fe2519_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => unopFEToWire_bounds_good bounds = true
+          | None => False
+          end)
+  : unop_FEToWire_correct_and_bounded (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x Hx.
+  pose x as x'.
+  hnf in x; destruct_head' prod.
+  specialize (H0 x' Hx).
+  specialize (H1 x' Hx).
+  let args := constr:(unop_args_to_bounded x' Hx) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF2519_32Reflective/CommonUnOpFEToZ.v b/src/SpecificGen/GF2519_32Reflective/CommonUnOpFEToZ.v
new file mode 100644
index 000000000..ec00c6233
--- /dev/null
+++ b/src/SpecificGen/GF2519_32Reflective/CommonUnOpFEToZ.v
@@ -0,0 +1,44 @@
+Require Export Crypto.SpecificGen.GF2519_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF2519_32BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprUnOpFEToZ_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_unop_FEToZ_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall x
+                   (x := eta_fe2519_32W x)
+                   (Hx : is_bounded (fe2519_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall x
+                   (x := eta_fe2519_32W x)
+                   (Hx : is_bounded (fe2519_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => unopFEToZ_bounds_good bounds = true
+          | None => False
+          end)
+  : unop_FEToZ_correct (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x Hx.
+  pose x as x'.
+  hnf in x; destruct_head' prod.
+  specialize (H0 x' Hx).
+  specialize (H1 x' Hx).
+  let args := constr:(unop_args_to_bounded x' Hx) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF2519_32Reflective/CommonUnOpWireToFE.v b/src/SpecificGen/GF2519_32Reflective/CommonUnOpWireToFE.v
new file mode 100644
index 000000000..6ca61afe9
--- /dev/null
+++ b/src/SpecificGen/GF2519_32Reflective/CommonUnOpWireToFE.v
@@ -0,0 +1,44 @@
+Require Export Crypto.SpecificGen.GF2519_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF2519_32BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprUnOpWireToFE_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_unop_WireToFE_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall x
+                   (x := eta_wire_digitsW x)
+                   (Hx : wire_digits_is_bounded (wire_digitsWToZ x) = true),
+          let args := unopWireToFE_args_to_bounded x Hx in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall x
+                   (x := eta_wire_digitsW x)
+                   (Hx : wire_digits_is_bounded (wire_digitsWToZ x) = true),
+          let args := unopWireToFE_args_to_bounded x Hx in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => unopWireToFE_bounds_good bounds = true
+          | None => False
+          end)
+  : unop_WireToFE_correct_and_bounded (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x Hx.
+  pose x as x'.
+  hnf in x; destruct_head' prod.
+  specialize (H0 x' Hx).
+  specialize (H1 x' Hx).
+  let args := constr:(unopWireToFE_args_to_bounded x' Hx) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF2519_32Reflective/Reified.v b/src/SpecificGen/GF2519_32Reflective/Reified.v
new file mode 100644
index 000000000..4630e532f
--- /dev/null
+++ b/src/SpecificGen/GF2519_32Reflective/Reified.v
@@ -0,0 +1,13 @@
+(** We split the reification up into separate files, one operation per
+    file, so that it can run in parallel. *)
+Require Export Crypto.SpecificGen.GF2519_32Reflective.Reified.Add.
+Require Export Crypto.SpecificGen.GF2519_32Reflective.Reified.CarryAdd.
+Require Export Crypto.SpecificGen.GF2519_32Reflective.Reified.Sub.
+Require Export Crypto.SpecificGen.GF2519_32Reflective.Reified.CarrySub.
+Require Export Crypto.SpecificGen.GF2519_32Reflective.Reified.Mul.
+Require Export Crypto.SpecificGen.GF2519_32Reflective.Reified.Opp.
+Require Export Crypto.SpecificGen.GF2519_32Reflective.Reified.CarryOpp.
+Require Export Crypto.SpecificGen.GF2519_32Reflective.Reified.PreFreeze.
+Require Export Crypto.SpecificGen.GF2519_32Reflective.Reified.GeModulus.
+Require Export Crypto.SpecificGen.GF2519_32Reflective.Reified.Pack.
+Require Export Crypto.SpecificGen.GF2519_32Reflective.Reified.Unpack.
diff --git a/src/SpecificGen/GF2519_32Reflective/Reified/Add.v b/src/SpecificGen/GF2519_32Reflective/Reified/Add.v
new file mode 100644
index 000000000..c379c398a
--- /dev/null
+++ b/src/SpecificGen/GF2519_32Reflective/Reified/Add.v
@@ -0,0 +1,12 @@
+Require Import Crypto.SpecificGen.GF2519_32Reflective.CommonBinOp.
+
+Definition raddZ_sig : rexpr_binop_sig add. Proof. reify_sig. Defined.
+Definition raddW := Eval vm_compute in rword_of_Z raddZ_sig.
+Lemma raddW_correct_and_bounded_gen : correct_and_bounded_genT raddW raddZ_sig.
+Proof. rexpr_correct. Qed.
+Definition radd_output_bounds := Eval vm_compute in compute_bounds raddW ExprBinOp_bounds.
+
+Local Open Scope string_scope.
+Compute ("Add", compute_bounds_for_display raddW ExprBinOp_bounds).
+Compute ("Add overflows? ", sanity_compute raddW ExprBinOp_bounds).
+Compute ("Add overflows (error if it does)? ", sanity_check raddW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF2519_32Reflective/Reified/CarryAdd.v b/src/SpecificGen/GF2519_32Reflective/Reified/CarryAdd.v
new file mode 100644
index 000000000..91571ac77
--- /dev/null
+++ b/src/SpecificGen/GF2519_32Reflective/Reified/CarryAdd.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF2519_32Reflective.CommonBinOp.
+
+Definition rcarry_addZ_sig : rexpr_binop_sig carry_add. Proof. reify_sig. Defined.
+Definition rcarry_addW := Eval vm_compute in rword_of_Z rcarry_addZ_sig.
+Lemma rcarry_addW_correct_and_bounded_gen : correct_and_bounded_genT rcarry_addW rcarry_addZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rcarry_add_output_bounds := Eval vm_compute in compute_bounds rcarry_addW ExprBinOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rcarry_addW_correct_and_bounded
+  := ExprBinOp_correct_and_bounded
+       rcarry_addW carry_add rcarry_addZ_sig rcarry_addW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Carry_Add", compute_bounds_for_display rcarry_addW ExprBinOp_bounds).
+Compute ("Carry_Add overflows? ", sanity_compute rcarry_addW ExprBinOp_bounds).
+Compute ("Carry_Add overflows (error if it does)? ", sanity_check rcarry_addW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF2519_32Reflective/Reified/CarryOpp.v b/src/SpecificGen/GF2519_32Reflective/Reified/CarryOpp.v
new file mode 100644
index 000000000..708dd54bf
--- /dev/null
+++ b/src/SpecificGen/GF2519_32Reflective/Reified/CarryOpp.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF2519_32Reflective.CommonUnOp.
+
+Definition rcarry_oppZ_sig : rexpr_unop_sig carry_opp. Proof. reify_sig. Defined.
+Definition rcarry_oppW := Eval vm_compute in rword_of_Z rcarry_oppZ_sig.
+Lemma rcarry_oppW_correct_and_bounded_gen : correct_and_bounded_genT rcarry_oppW rcarry_oppZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rcarry_opp_output_bounds := Eval vm_compute in compute_bounds rcarry_oppW ExprUnOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rcarry_oppW_correct_and_bounded
+  := ExprUnOp_correct_and_bounded
+       rcarry_oppW carry_opp rcarry_oppZ_sig rcarry_oppW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Carry_Opp", compute_bounds_for_display rcarry_oppW ExprUnOp_bounds).
+Compute ("Carry_Opp overflows? ", sanity_compute rcarry_oppW ExprUnOp_bounds).
+Compute ("Carry_Opp overflows (error if it does)? ", sanity_check rcarry_oppW ExprUnOp_bounds).
diff --git a/src/SpecificGen/GF2519_32Reflective/Reified/CarrySub.v b/src/SpecificGen/GF2519_32Reflective/Reified/CarrySub.v
new file mode 100644
index 000000000..f69b61455
--- /dev/null
+++ b/src/SpecificGen/GF2519_32Reflective/Reified/CarrySub.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF2519_32Reflective.CommonBinOp.
+
+Definition rcarry_subZ_sig : rexpr_binop_sig carry_sub. Proof. reify_sig. Defined.
+Definition rcarry_subW := Eval vm_compute in rword_of_Z rcarry_subZ_sig.
+Lemma rcarry_subW_correct_and_bounded_gen : correct_and_bounded_genT rcarry_subW rcarry_subZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rcarry_sub_output_bounds := Eval vm_compute in compute_bounds rcarry_subW ExprBinOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rcarry_subW_correct_and_bounded
+  := ExprBinOp_correct_and_bounded
+       rcarry_subW carry_sub rcarry_subZ_sig rcarry_subW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Carry_Sub", compute_bounds_for_display rcarry_subW ExprBinOp_bounds).
+Compute ("Carry_Sub overflows? ", sanity_compute rcarry_subW ExprBinOp_bounds).
+Compute ("Carry_Sub overflows (error if it does)? ", sanity_check rcarry_subW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF2519_32Reflective/Reified/GeModulus.v b/src/SpecificGen/GF2519_32Reflective/Reified/GeModulus.v
new file mode 100644
index 000000000..e5dfa9e43
--- /dev/null
+++ b/src/SpecificGen/GF2519_32Reflective/Reified/GeModulus.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF2519_32Reflective.CommonUnOpFEToZ.
+
+Definition rge_modulusZ_sig : rexpr_unop_FEToZ_sig ge_modulus. Proof. reify_sig. Defined.
+Definition rge_modulusW := Eval vm_compute in rword_of_Z rge_modulusZ_sig.
+Lemma rge_modulusW_correct_and_bounded_gen : correct_and_bounded_genT rge_modulusW rge_modulusZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rge_modulus_output_bounds := Eval vm_compute in compute_bounds rge_modulusW ExprUnOpFEToZ_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rge_modulusW_correct_and_bounded
+  := ExprUnOpFEToZ_correct_and_bounded
+       rge_modulusW ge_modulus rge_modulusZ_sig rge_modulusW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Ge_Modulus", compute_bounds_for_display rge_modulusW ExprUnOpFEToZ_bounds).
+Compute ("Ge_Modulus overflows? ", sanity_compute rge_modulusW ExprUnOpFEToZ_bounds).
+Compute ("Ge_Modulus overflows (error if it does)? ", sanity_check rge_modulusW ExprUnOpFEToZ_bounds).
diff --git a/src/SpecificGen/GF2519_32Reflective/Reified/Mul.v b/src/SpecificGen/GF2519_32Reflective/Reified/Mul.v
new file mode 100644
index 000000000..dc1e0bf49
--- /dev/null
+++ b/src/SpecificGen/GF2519_32Reflective/Reified/Mul.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF2519_32Reflective.CommonBinOp.
+
+Definition rmulZ_sig : rexpr_binop_sig mul. Proof. reify_sig. Defined.
+Definition rmulW := Eval vm_compute in rword_of_Z rmulZ_sig.
+Lemma rmulW_correct_and_bounded_gen : correct_and_bounded_genT rmulW rmulZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rmul_output_bounds := Eval vm_compute in compute_bounds rmulW ExprBinOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rmulW_correct_and_bounded
+  := ExprBinOp_correct_and_bounded
+       rmulW mul rmulZ_sig rmulW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Mul", compute_bounds_for_display rmulW ExprBinOp_bounds).
+Compute ("Mul overflows? ", sanity_compute rmulW ExprBinOp_bounds).
+Compute ("Mul overflows (error if it does)? ", sanity_check rmulW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF2519_32Reflective/Reified/Opp.v b/src/SpecificGen/GF2519_32Reflective/Reified/Opp.v
new file mode 100644
index 000000000..4d38eb057
--- /dev/null
+++ b/src/SpecificGen/GF2519_32Reflective/Reified/Opp.v
@@ -0,0 +1,12 @@
+Require Import Crypto.SpecificGen.GF2519_32Reflective.CommonUnOp.
+
+Definition roppZ_sig : rexpr_unop_sig opp. Proof. reify_sig. Defined.
+Definition roppW := Eval vm_compute in rword_of_Z roppZ_sig.
+Lemma roppW_correct_and_bounded_gen : correct_and_bounded_genT roppW roppZ_sig.
+Proof. rexpr_correct. Qed.
+Definition ropp_output_bounds := Eval vm_compute in compute_bounds roppW ExprUnOp_bounds.
+
+Local Open Scope string_scope.
+Compute ("Opp", compute_bounds_for_display roppW ExprUnOp_bounds).
+Compute ("Opp overflows? ", sanity_compute roppW ExprUnOp_bounds).
+Compute ("Opp overflows (error if it does)? ", sanity_check roppW ExprUnOp_bounds).
diff --git a/src/SpecificGen/GF2519_32Reflective/Reified/Pack.v b/src/SpecificGen/GF2519_32Reflective/Reified/Pack.v
new file mode 100644
index 000000000..f82b07842
--- /dev/null
+++ b/src/SpecificGen/GF2519_32Reflective/Reified/Pack.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF2519_32Reflective.CommonUnOpFEToWire.
+
+Definition rpackZ_sig : rexpr_unop_FEToWire_sig pack. Proof. reify_sig. Defined.
+Definition rpackW := Eval vm_compute in rword_of_Z rpackZ_sig.
+Lemma rpackW_correct_and_bounded_gen : correct_and_bounded_genT rpackW rpackZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rpack_output_bounds := Eval vm_compute in compute_bounds rpackW ExprUnOpFEToWire_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rpackW_correct_and_bounded
+  := ExprUnOpFEToWire_correct_and_bounded
+       rpackW pack rpackZ_sig rpackW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Pack", compute_bounds_for_display rpackW ExprUnOpFEToWire_bounds).
+Compute ("Pack overflows? ", sanity_compute rpackW ExprUnOpFEToWire_bounds).
+Compute ("Pack overflows (error if it does)? ", sanity_check rpackW ExprUnOpFEToWire_bounds).
diff --git a/src/SpecificGen/GF2519_32Reflective/Reified/PreFreeze.v b/src/SpecificGen/GF2519_32Reflective/Reified/PreFreeze.v
new file mode 100644
index 000000000..dc9e2dcef
--- /dev/null
+++ b/src/SpecificGen/GF2519_32Reflective/Reified/PreFreeze.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF2519_32Reflective.CommonUnOp.
+
+Definition rprefreezeZ_sig : rexpr_unop_sig prefreeze. Proof. cbv [prefreeze GF2519_32.prefreeze]. reify_sig. Defined.
+Definition rprefreezeW := Eval vm_compute in rword_of_Z rprefreezeZ_sig.
+Lemma rprefreezeW_correct_and_bounded_gen : correct_and_bounded_genT rprefreezeW rprefreezeZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rprefreeze_output_bounds := Eval vm_compute in compute_bounds rprefreezeW ExprUnOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rprefreezeW_correct_and_bounded
+  := ExprUnOp_correct_and_bounded
+       rprefreezeW prefreeze rprefreezeZ_sig rprefreezeW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("PreFreeze", compute_bounds_for_display rprefreezeW ExprUnOp_bounds).
+Compute ("PreFreeze overflows? ", sanity_compute rprefreezeW ExprUnOp_bounds).
+Compute ("PreFreeze overflows (error if it does)? ", sanity_check rprefreezeW ExprUnOp_bounds).
diff --git a/src/SpecificGen/GF2519_32Reflective/Reified/Sub.v b/src/SpecificGen/GF2519_32Reflective/Reified/Sub.v
new file mode 100644
index 000000000..1875487fb
--- /dev/null
+++ b/src/SpecificGen/GF2519_32Reflective/Reified/Sub.v
@@ -0,0 +1,12 @@
+Require Import Crypto.SpecificGen.GF2519_32Reflective.CommonBinOp.
+
+Definition rsubZ_sig : rexpr_binop_sig sub. Proof. reify_sig. Defined.
+Definition rsubW := Eval vm_compute in rword_of_Z rsubZ_sig.
+Lemma rsubW_correct_and_bounded_gen : correct_and_bounded_genT rsubW rsubZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rsub_output_bounds := Eval vm_compute in compute_bounds rsubW ExprBinOp_bounds.
+
+Local Open Scope string_scope.
+Compute ("Sub", compute_bounds_for_display rsubW ExprBinOp_bounds).
+Compute ("Sub overflows? ", sanity_compute rsubW ExprBinOp_bounds).
+Compute ("Sub overflows (error if it does)? ", sanity_check rsubW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF2519_32Reflective/Reified/Unpack.v b/src/SpecificGen/GF2519_32Reflective/Reified/Unpack.v
new file mode 100644
index 000000000..f839f4f0c
--- /dev/null
+++ b/src/SpecificGen/GF2519_32Reflective/Reified/Unpack.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF2519_32Reflective.CommonUnOpWireToFE.
+
+Definition runpackZ_sig : rexpr_unop_WireToFE_sig unpack. Proof. reify_sig. Defined.
+Definition runpackW := Eval vm_compute in rword_of_Z runpackZ_sig.
+Lemma runpackW_correct_and_bounded_gen : correct_and_bounded_genT runpackW runpackZ_sig.
+Proof. rexpr_correct. Qed.
+Definition runpack_output_bounds := Eval vm_compute in compute_bounds runpackW ExprUnOpWireToFE_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition runpackW_correct_and_bounded
+  := ExprUnOpWireToFE_correct_and_bounded
+       runpackW unpack runpackZ_sig runpackW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Unpack", compute_bounds_for_display runpackW ExprUnOpWireToFE_bounds).
+Compute ("Unpack overflows? ", sanity_compute runpackW ExprUnOpWireToFE_bounds).
+Compute ("Unpack overflows (error if it does)? ", sanity_check runpackW ExprUnOpWireToFE_bounds).
diff --git a/src/SpecificGen/GF25519_32Bounded.v b/src/SpecificGen/GF25519_32Bounded.v
new file mode 100644
index 000000000..311001606
--- /dev/null
+++ b/src/SpecificGen/GF25519_32Bounded.v
@@ -0,0 +1,462 @@
+Require Import Crypto.BaseSystem.
+Require Import Crypto.ModularArithmetic.PrimeFieldTheorems.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParams.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParamProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystem.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemOpt.
+Require Import Crypto.SpecificGen.GF25519_32.
+Require Import Crypto.SpecificGen.GF25519_32BoundedCommon.
+Require Import Crypto.SpecificGen.GF25519_32Reflective.
+Require Import Bedrock.Word Crypto.Util.WordUtil.
+Require Import Coq.Lists.List Crypto.Util.ListUtil.
+Require Import Crypto.Tactics.VerdiTactics.
+Require Import Crypto.Util.ZUtil.
+Require Import Crypto.Util.Tuple.
+Require Import Crypto.Util.Tactics.
+Require Import Crypto.Util.LetIn.
+Require Import Crypto.Util.Notations.
+Require Import Crypto.Util.Bool.
+Require Import Crypto.Util.Decidable.
+Require Import Crypto.Algebra.
+Import ListNotations.
+Require Import Coq.ZArith.ZArith Coq.ZArith.Zpower Coq.ZArith.ZArith Coq.ZArith.Znumtheory.
+Local Open Scope Z.
+
+
+Local Ltac bounded_t opW blem :=
+  apply blem; apply is_bounded_proj1_fe25519_32.
+Local Ltac bounded_wire_digits_t opW blem :=
+  apply blem; apply is_bounded_proj1_wire_digits.
+
+Local Ltac define_binop f g opW blem :=
+  refine (exist_fe25519_32W (opW (proj1_fe25519_32W f) (proj1_fe25519_32W g)) _);
+  abstract bounded_t opW blem.
+Local Ltac define_unop f opW blem :=
+  refine (exist_fe25519_32W (opW (proj1_fe25519_32W f)) _);
+  abstract bounded_t opW blem.
+Local Ltac define_unop_FEToZ f opW :=
+  refine (opW (proj1_fe25519_32W f)).
+Local Ltac define_unop_FEToWire f opW blem :=
+  refine (exist_wire_digitsW (opW (proj1_fe25519_32W f)) _);
+  abstract bounded_t opW blem.
+Local Ltac define_unop_WireToFE f opW blem :=
+  refine (exist_fe25519_32W (opW (proj1_wire_digitsW f)) _);
+  abstract bounded_wire_digits_t opW blem.
+
+Local Opaque Let_In.
+Local Opaque Z.add Z.sub Z.mul Z.shiftl Z.shiftr Z.land Z.lor Z.eqb NToWord64.
+Local Arguments interp_radd / _ _.
+Local Arguments interp_rsub / _ _.
+Local Arguments interp_rmul / _ _.
+Local Arguments interp_ropp / _.
+Local Arguments interp_rprefreeze / _.
+Local Arguments interp_rge_modulus / _.
+Local Arguments interp_rpack / _.
+Local Arguments interp_runpack / _.
+Definition addW (f g : fe25519_32W) : fe25519_32W := Eval simpl in interp_radd f g.
+Definition subW (f g : fe25519_32W) : fe25519_32W := Eval simpl in interp_rsub f g.
+Definition mulW (f g : fe25519_32W) : fe25519_32W := Eval simpl in interp_rmul f g.
+Definition oppW (f : fe25519_32W) : fe25519_32W := Eval simpl in interp_ropp f.
+Definition prefreezeW (f : fe25519_32W) : fe25519_32W := Eval simpl in interp_rprefreeze f.
+Definition ge_modulusW (f : fe25519_32W) : word64 := Eval simpl in interp_rge_modulus f.
+Definition packW (f : fe25519_32W) : wire_digitsW := Eval simpl in interp_rpack f.
+Definition unpackW (f : wire_digitsW) : fe25519_32W := Eval simpl in interp_runpack f.
+
+Require Import ModularBaseSystemWord.
+Definition modulusW :=
+  Eval cbv - [ZToWord64] in (Tuple.map ZToWord64 (Tuple.from_list_default 0%Z 10 GF25519_32.modulus_digits_)).
+
+Definition postfreeze : GF25519_32.fe25519_32 -> GF25519_32.fe25519_32 :=
+  GF25519_32.postfreeze.
+
+Lemma freeze_prepost_freeze : forall x, postfreeze (prefreeze x) = GF25519_32.freeze x. Proof. reflexivity. Qed.
+
+Definition postfreezeW : fe25519_32W -> fe25519_32W :=
+      (conditional_subtract_modulusW
+         (num_limbs := 10)
+         modulusW
+         ge_modulusW
+         (Interpretations.Word64.neg GF25519_32.int_width)
+      ).
+
+Definition freezeW (f : fe25519_32W) : fe25519_32W := Eval cbv beta delta [prefreezeW postfreezeW] in postfreezeW (prefreezeW f).
+
+Local Transparent Let_In.
+Definition powW (f : fe25519_32W) chain := fold_chain_opt (proj1_fe25519_32W one) mulW chain [f].
+Definition invW (f : fe25519_32W) : fe25519_32W
+  := Eval cbv -[Let_In fe25519_32W mulW] in powW f (chain inv_ec).
+
+Local Ltac port_correct_and_bounded pre_rewrite opW interp_rop rop_cb :=
+  change opW with (interp_rop);
+  rewrite pre_rewrite;
+  intros; apply rop_cb; assumption.
+
+Lemma addW_correct_and_bounded : ibinop_correct_and_bounded addW carry_add.
+Proof. port_correct_and_bounded interp_radd_correct addW interp_radd radd_correct_and_bounded. Qed.
+Lemma subW_correct_and_bounded : ibinop_correct_and_bounded subW carry_sub.
+Proof. port_correct_and_bounded interp_rsub_correct subW interp_rsub rsub_correct_and_bounded. Qed.
+Lemma mulW_correct_and_bounded : ibinop_correct_and_bounded mulW mul.
+Proof. port_correct_and_bounded interp_rmul_correct mulW interp_rmul rmul_correct_and_bounded. Qed.
+Lemma oppW_correct_and_bounded : iunop_correct_and_bounded oppW carry_opp.
+Proof. port_correct_and_bounded interp_ropp_correct oppW interp_ropp ropp_correct_and_bounded. Qed.
+Lemma prefreezeW_correct_and_bounded : iunop_correct_and_bounded prefreezeW prefreeze.
+Proof. port_correct_and_bounded interp_rprefreeze_correct prefreezeW interp_rprefreeze rprefreeze_correct_and_bounded. Qed.
+Lemma ge_modulusW_correct : iunop_FEToZ_correct ge_modulusW ge_modulus.
+Proof. port_correct_and_bounded interp_rge_modulus_correct ge_modulusW interp_rge_modulus rge_modulus_correct_and_bounded. Qed.
+Lemma packW_correct_and_bounded : iunop_FEToWire_correct_and_bounded packW pack.
+Proof. port_correct_and_bounded interp_rpack_correct packW interp_rpack rpack_correct_and_bounded. Qed.
+Lemma unpackW_correct_and_bounded : iunop_WireToFE_correct_and_bounded unpackW unpack.
+Proof. port_correct_and_bounded interp_runpack_correct unpackW interp_runpack runpack_correct_and_bounded. Qed.
+
+(* TODO : move *)
+Lemma neg_range : forall x y, 0 <= x ->
+  0 <= ModularBaseSystemListZOperations.neg x y < 2 ^ x.
+Proof.
+  intros.
+  split; auto using ModularBaseSystemListZOperationsProofs.neg_nonneg.
+  eapply Z.le_lt_trans; eauto using ModularBaseSystemListZOperationsProofs.neg_upperbound.
+  rewrite Z.ones_equiv.
+  omega.
+Qed.
+
+Ltac lower_bound_minus_ge_modulus :=
+  apply Z.le_0_sub;
+  cbv [ge_modulus Let_In ModularBaseSystemListZOperations.cmovl ModularBaseSystemListZOperations.cmovne ModularBaseSystemListZOperations.neg];
+  repeat break_if; Z.ltb_to_lt; subst; try omega;
+    rewrite ?Z.land_0_l; auto;
+    change Interpretations.Word64.word64ToZ with word64ToZ;
+    etransitivity; try apply Z.land_upper_bound_r; instantiate; try omega;
+    apply Z.ones_nonneg; instantiate; vm_compute; discriminate.
+
+Ltac upper_bound_minus_ge_modulus :=
+   (apply Z.log2_lt_pow2_alt; [ vm_compute; reflexivity | ]);
+   eapply Z.le_lt_trans; [ apply Z.le_sub_nonneg; apply Z.land_nonneg; right; omega | ];
+   eapply Z.le_lt_trans; [ eassumption | ];
+   instantiate; vm_compute; reflexivity.
+
+Lemma postfreezeW_correct_and_bounded : iunop_correct_and_bounded postfreezeW postfreeze.
+Proof.
+  intros x H.
+  pose proof (ge_modulusW_correct x H) as Hgm.
+  destruct_head_hnf' prod.
+  unfold_is_bounded_in H.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  cbv [postfreezeW].
+  cbv [conditional_subtract_modulusW Interpretations.Word64.neg].
+  change word64ToZ with Interpretations.Word64.word64ToZ in *.
+  rewrite Hgm.
+
+  cbv [modulusW Tuple.map].
+  cbv [on_tuple List.map to_list to_list' from_list from_list'
+                Tuple.map2 on_tuple2 ListUtil.map2 fe25519_32WToZ].
+  cbv [postfreeze GF25519_32.postfreeze].
+  cbv [Let_In].
+
+  split.
+  { match goal with
+    |- (_,word64ToZ (_ ^- (Interpretations.Word64.ZToWord64 ?x) ^& _)) = (_,_ - (?y &' _)) => assert (x = y) as Hxy by reflexivity; repeat rewrite <-Hxy; clear Hxy end.
+
+  change ZToWord64 with Interpretations.Word64.ZToWord64 in *.
+  rewrite !Interpretations.Word64.word64ToZ_sub;
+  rewrite !Interpretations.Word64.word64ToZ_land;
+  rewrite !Interpretations.Word64.word64ToZ_ZToWord64;
+  try match goal with
+         | |- 0 <=  ModularBaseSystemListZOperations.neg _ _ < 2 ^ _ => apply neg_range; omega
+         | |- 0 <= _ < 2 ^ Z.of_nat _ => vm_compute; split; [refine (fun x => match x with eq_refl => I end) | reflexivity]
+         | |- 0 <= _ &' _ => apply Z.land_nonneg; right; omega
+         | |- (_,_) = (_,_) => reflexivity
+      end;
+  try solve [
+  (apply Z.log2_lt_pow2_alt; [ vm_compute; reflexivity | ]);
+  eapply Z.le_lt_trans; try apply Z.land_upper_bound_r; try apply neg_range; instantiate; try match goal with |- ?G => not has_evar G; vm_compute; discriminate end; reflexivity];
+  match goal with
+  | |- 0 <= _ - _ => lower_bound_minus_ge_modulus
+  | |- Z.log2 (_ - _) < _ => upper_bound_minus_ge_modulus
+  end. }
+
+
+  unfold_is_bounded.
+  change ZToWord64 with Interpretations.Word64.ZToWord64 in *.
+  rewrite !Interpretations.Word64.word64ToZ_sub;
+  rewrite !Interpretations.Word64.word64ToZ_land;
+  rewrite !Interpretations.Word64.word64ToZ_ZToWord64;
+  repeat match goal with |- _ /\ _ => split; Z.ltb_to_lt end;
+  try match goal with
+         | |- 0 <=  ModularBaseSystemListZOperations.neg _ _ < 2 ^ _ => apply neg_range; omega
+         | |- 0 <= _ < 2 ^ Z.of_nat _ => vm_compute; split; [refine (fun x => match x with eq_refl => I end) | reflexivity]
+         | |- 0 <= _ &' _ => apply Z.land_nonneg; right; omega
+      end;
+  try solve [
+  (apply Z.log2_lt_pow2_alt; [ vm_compute; reflexivity | ]);
+  eapply Z.le_lt_trans; try apply Z.land_upper_bound_r; try apply neg_range; instantiate; try match goal with |- ?G => not has_evar G; vm_compute; discriminate end; reflexivity];
+  try match goal with
+  | |- 0 <= _ - _ => lower_bound_minus_ge_modulus
+  | |- Z.log2 (_ - _) < _ => upper_bound_minus_ge_modulus
+  | |- _ - _ <= _ => etransitivity; [ apply Z.le_sub_nonneg; apply Z.land_nonneg; right; omega | instantiate; assumption ]
+  | |- 0 <= ModularBaseSystemListZOperations.neg _ _ =>
+    apply neg_range; vm_compute; discriminate
+  | |- ModularBaseSystemListZOperations.neg _ _ < _ =>
+    apply neg_range; vm_compute; discriminate
+  | |- _ => vm_compute; (discriminate || reflexivity)
+      end.
+Qed.
+
+Lemma freezeW_correct_and_bounded : iunop_correct_and_bounded freezeW freeze.
+Proof.
+  intros f H; rewrite <- freeze_prepost_freeze.
+  change (freezeW f) with (postfreezeW (prefreezeW f)).
+  destruct (prefreezeW_correct_and_bounded f H) as [H0 H1].
+  destruct (postfreezeW_correct_and_bounded _ H1) as [H0' H1'].
+  rewrite H1', H0', H0; split; reflexivity.
+Qed.
+
+Lemma powW_correct_and_bounded chain : iunop_correct_and_bounded (fun x => powW x chain) (fun x => pow x chain).
+Proof.
+  cbv [powW pow].
+  intro x; intros; apply (fold_chain_opt_gen fe25519_32WToZ is_bounded [x]).
+  { reflexivity. }
+  { reflexivity. }
+  { intros; progress rewrite <- (fun X Y => proj1 (mulW_correct_and_bounded _ _ X Y)) by assumption.
+    apply mulW_correct_and_bounded; assumption. }
+  { intros; rewrite (fun X Y => proj1 (mulW_correct_and_bounded _ _ X Y)) by assumption; reflexivity. }
+  { intros [|?]; autorewrite with simpl_nth_default;
+      (assumption || reflexivity). }
+Qed.
+
+Lemma invW_correct_and_bounded : iunop_correct_and_bounded invW inv.
+Proof.
+  intro f.
+  assert (H : forall f, invW f = powW f (chain inv_ec))
+    by abstract (cbv -[Let_In fe25519_32W mulW]; reflexivity).
+  rewrite H.
+  rewrite inv_correct.
+  cbv [inv_opt].
+  rewrite <- pow_correct.
+  apply powW_correct_and_bounded.
+Qed.
+
+Definition fieldwisebW_sig (f g : fe25519_32W)
+  : { b | b = GF25519_32.fieldwiseb (fe25519_32WToZ f) (fe25519_32WToZ g) }.
+Proof.
+  hnf in f, g; destruct_head' prod.
+  eexists.
+  cbv [GF25519_32.fieldwiseb fe25519_32WToZ].
+  rewrite ?word64eqb_Zeqb.
+  reflexivity.
+Defined.
+
+Definition fieldwisebW (f g : fe25519_32W) : bool :=
+  Eval cbv [proj1_sig fieldwisebW_sig appify2 app_fe25519_32W] in
+    appify2 (fun f g => proj1_sig (fieldwisebW_sig f g)) f g.
+
+Lemma fieldwisebW_correct f g
+  : fieldwisebW f g = GF25519_32.fieldwiseb (fe25519_32WToZ f) (fe25519_32WToZ g).
+Proof.
+  set (f' := f); set (g' := g).
+  hnf in f, g; destruct_head' prod.
+  exact (proj2_sig (fieldwisebW_sig f' g')).
+Qed.
+
+Local Arguments freezeW : simpl never.
+Local Arguments fe25519_32WToZ !_ / .
+Local Opaque freezeW.
+
+Definition eqbW_sig (f g : fe25519_32W)
+  : { b | is_bounded (fe25519_32WToZ f) = true
+          -> is_bounded (fe25519_32WToZ g) = true
+          -> b = GF25519_32.eqb (fe25519_32WToZ f) (fe25519_32WToZ g) }.
+Proof.
+  pose proof (fun pf => proj1 (freezeW_correct_and_bounded f pf)) as frf.
+  pose proof (fun pf => proj1 (freezeW_correct_and_bounded g pf)) as frg.
+  hnf in f, g; destruct_head' prod.
+  eexists.
+  unfold GF25519_32.eqb.
+  simpl @fe25519_32WToZ in *; cbv beta iota.
+  intros.
+  rewrite <- frf, <- frg by assumption.
+  rewrite <- fieldwisebW_correct.
+  reflexivity.
+Defined.
+
+Definition eqbW (f g : fe25519_32W) : bool :=
+  Eval cbv [proj1_sig eqbW_sig appify2 app_fe25519_32W] in
+    appify2 (fun f g => proj1_sig (eqbW_sig f g)) f g.
+
+Lemma eqbW_correct f g
+  : is_bounded (fe25519_32WToZ f) = true
+    -> is_bounded (fe25519_32WToZ g) = true
+    -> eqbW f g = GF25519_32.eqb (fe25519_32WToZ f) (fe25519_32WToZ g).
+Proof.
+  set (f' := f); set (g' := g).
+  hnf in f, g; destruct_head' prod.
+  exact (proj2_sig (eqbW_sig f' g')).
+Qed.
+
+(* TODO(jgross): use NToWord or such for this constant too *)
+Definition sqrt_m1W : fe25519_32W :=
+  Eval vm_compute in fe25519_32ZToW sqrt_m1.
+
+Definition GF25519_32sqrt x : GF25519_32.fe25519_32 :=
+  dlet powx := powW (fe25519_32ZToW x) (chain GF25519_32.sqrt_ec) in
+  GF25519_32.sqrt (fe25519_32WToZ powx) (fe25519_32WToZ (mulW powx powx)) x.
+
+Definition sqrtW_sig
+  : { sqrtW | iunop_correct_and_bounded sqrtW GF25519_32sqrt }.
+Proof.
+  eexists.
+  unfold GF25519_32sqrt, GF25519_32.sqrt.
+  intros.
+  rewrite !fe25519_32ZToW_WToZ.
+  split.
+  { etransitivity.
+    Focus 2. {
+      apply Proper_Let_In_nd_changebody_eq; intros.
+      set_evars.
+      match goal with (* unfold the first dlet ... in, but only if it's binding a var *)
+      | [ |- ?x = dlet y := fe25519_32WToZ ?z in ?f ]
+        => is_var z; change (x = match fe25519_32WToZ z with y => f end)
+      end.
+      change sqrt_m1 with (fe25519_32WToZ sqrt_m1W).
+      rewrite <- (fun X Y => proj1 (mulW_correct_and_bounded sqrt_m1W a X Y)), <- eqbW_correct, (pull_bool_if fe25519_32WToZ)
+        by repeat match goal with
+                  | _ => progress subst
+                  | [ |- is_bounded (fe25519_32WToZ ?op) = true ]
+                    => lazymatch op with
+                       | mulW _ _ => apply mulW_correct_and_bounded
+                       | powW _ _ => apply powW_correct_and_bounded
+                       | sqrt_m1W => vm_compute; reflexivity
+                       | _ => assumption
+                       end
+                  end.
+      subst_evars; reflexivity.
+    } Unfocus.
+    lazymatch goal with
+    | [ |- context G[dlet x := ?v in fe25519_32WToZ (@?f x)] ]
+      => let G' := context G[fe25519_32WToZ (dlet x := v in f x)] in
+         cut G'; cbv beta;
+           [ cbv [Let_In]; exact (fun x => x) | apply f_equal ]
+    end.
+    reflexivity. }
+  { cbv [Let_In].
+    break_if.
+    { apply powW_correct_and_bounded; assumption. }
+    { apply mulW_correct_and_bounded; [ vm_compute; reflexivity | ].
+      apply powW_correct_and_bounded; assumption. } }
+Defined.
+
+Definition sqrtW (f : fe25519_32W) : fe25519_32W :=
+  Eval cbv [proj1_sig sqrtW_sig app_fe25519_32W] in
+    app_fe25519_32W f (proj1_sig sqrtW_sig).
+
+Lemma sqrtW_correct_and_bounded : iunop_correct_and_bounded sqrtW GF25519_32sqrt.
+Proof.
+  intro f.
+  set (f' := f).
+  hnf in f; destruct_head' prod.
+  assert (H : sqrtW f' = proj1_sig sqrtW_sig f')
+    by (subst f'; cbv beta iota delta [proj1_sig sqrtW_sig sqrtW]; reflexivity).
+  rewrite H.
+  exact (proj2_sig sqrtW_sig f').
+Qed.
+
+
+
+Definition add (f g : fe25519_32) : fe25519_32.
+Proof. define_binop f g addW addW_correct_and_bounded. Defined.
+Definition sub (f g : fe25519_32) : fe25519_32.
+Proof. define_binop f g subW subW_correct_and_bounded. Defined.
+Definition mul (f g : fe25519_32) : fe25519_32.
+Proof. define_binop f g mulW mulW_correct_and_bounded. Defined.
+Definition opp (f : fe25519_32) : fe25519_32.
+Proof. define_unop f oppW oppW_correct_and_bounded. Defined.
+Definition freeze (f : fe25519_32) : fe25519_32.
+Proof. define_unop f freezeW freezeW_correct_and_bounded. Defined.
+Definition ge_modulus (f : fe25519_32) : word64.
+Proof. define_unop_FEToZ f ge_modulusW. Defined.
+Definition pack (f : fe25519_32) : wire_digits.
+Proof. define_unop_FEToWire f packW packW_correct_and_bounded. Defined.
+Definition unpack (f : wire_digits) : fe25519_32.
+Proof. define_unop_WireToFE f unpackW unpackW_correct_and_bounded. Defined.
+
+Definition pow (f : fe25519_32) (chain : list (nat * nat)) : fe25519_32.
+Proof. define_unop f (fun x => powW x chain) powW_correct_and_bounded. Defined.
+Definition inv (f : fe25519_32) : fe25519_32.
+Proof. define_unop f invW invW_correct_and_bounded. Defined.
+Definition sqrt (f : fe25519_32) : fe25519_32.
+Proof. define_unop f sqrtW sqrtW_correct_and_bounded. Defined.
+
+Local Ltac op_correct_t op opW_correct_and_bounded :=
+  cbv [op];
+  lazymatch goal with
+  | [ |- context[proj1_fe25519_32 (exist_fe25519_32W _ _)] ]
+    => rewrite proj1_fe25519_32_exist_fe25519_32W
+  | [ |- context[proj1_wire_digits (exist_wire_digitsW _ _)] ]
+    => rewrite proj1_wire_digits_exist_wire_digitsW
+  | _ => idtac
+  end;
+  apply opW_correct_and_bounded;
+  lazymatch goal with
+  | [ |- is_bounded _ = true ]
+    => apply is_bounded_proj1_fe25519_32
+  | [ |- wire_digits_is_bounded _ = true ]
+    => apply is_bounded_proj1_wire_digits
+  end.
+
+Lemma add_correct (f g : fe25519_32) : proj1_fe25519_32 (add f g) = carry_add (proj1_fe25519_32 f) (proj1_fe25519_32 g).
+Proof. op_correct_t add addW_correct_and_bounded. Qed.
+Lemma sub_correct (f g : fe25519_32) : proj1_fe25519_32 (sub f g) = carry_sub (proj1_fe25519_32 f) (proj1_fe25519_32 g).
+Proof. op_correct_t sub subW_correct_and_bounded. Qed.
+Lemma mul_correct (f g : fe25519_32) : proj1_fe25519_32 (mul f g) = GF25519_32.mul (proj1_fe25519_32 f) (proj1_fe25519_32 g).
+Proof. op_correct_t mul mulW_correct_and_bounded. Qed.
+Lemma opp_correct (f : fe25519_32) : proj1_fe25519_32 (opp f) = carry_opp (proj1_fe25519_32 f).
+Proof. op_correct_t opp oppW_correct_and_bounded. Qed.
+Lemma freeze_correct (f : fe25519_32) : proj1_fe25519_32 (freeze f) = GF25519_32.freeze (proj1_fe25519_32 f).
+Proof. op_correct_t freeze freezeW_correct_and_bounded. Qed.
+Lemma ge_modulus_correct (f : fe25519_32) : word64ToZ (ge_modulus f) = GF25519_32.ge_modulus (proj1_fe25519_32 f).
+Proof. op_correct_t ge_modulus ge_modulusW_correct. Qed.
+Lemma pack_correct (f : fe25519_32) : proj1_wire_digits (pack f) = GF25519_32.pack (proj1_fe25519_32 f).
+Proof. op_correct_t pack packW_correct_and_bounded. Qed.
+Lemma unpack_correct (f : wire_digits) : proj1_fe25519_32 (unpack f) = GF25519_32.unpack (proj1_wire_digits f).
+Proof. op_correct_t unpack unpackW_correct_and_bounded. Qed.
+Lemma pow_correct (f : fe25519_32) chain : proj1_fe25519_32 (pow f chain) = GF25519_32.pow (proj1_fe25519_32 f) chain.
+Proof. op_correct_t pow (powW_correct_and_bounded chain). Qed.
+Lemma inv_correct (f : fe25519_32) : proj1_fe25519_32 (inv f) = GF25519_32.inv (proj1_fe25519_32 f).
+Proof. op_correct_t inv invW_correct_and_bounded. Qed.
+Lemma sqrt_correct (f : fe25519_32) : proj1_fe25519_32 (sqrt f) = GF25519_32sqrt (proj1_fe25519_32 f).
+Proof. op_correct_t sqrt sqrtW_correct_and_bounded. Qed.
+
+Import Morphisms.
+
+Local Existing Instance prime_modulus.
+
+Lemma field25519_32_and_homomorphisms
+  : @field fe25519_32 eq zero one opp add sub mul inv div
+    /\ @Ring.is_homomorphism (F _) (@Logic.eq _) 1%F F.add F.mul fe25519_32 eq one add mul encode
+    /\ @Ring.is_homomorphism fe25519_32 eq one add mul (F _) (@Logic.eq _) 1%F F.add F.mul decode.
+Proof.
+  eapply @Field.field_and_homomorphism_from_redundant_representation.
+  { exact (F.field_modulo _). }
+  { cbv [decode encode]; intros; rewrite !proj1_fe25519_32_exist_fe25519_32; apply encode_rep. }
+  { reflexivity. }
+  { reflexivity. }
+  { reflexivity. }
+  { cbv [decode encode]; intros; rewrite opp_correct, carry_opp_correct, carry_opp_opt_correct, carry_opp_rep; apply opp_rep; reflexivity. }
+  { cbv [decode encode]; intros; rewrite add_correct, carry_add_correct, carry_add_opt_correct, carry_add_rep; apply add_rep; reflexivity. }
+  { cbv [decode encode]; intros; rewrite sub_correct, carry_sub_correct, carry_sub_opt_correct, carry_sub_rep; apply sub_rep; reflexivity. }
+  { cbv [decode encode]; intros; rewrite mul_correct, GF25519_32.mul_correct, carry_mul_opt_correct by reflexivity; apply carry_mul_rep; reflexivity. }
+  { cbv [decode encode]; intros; rewrite inv_correct, GF25519_32.inv_correct, inv_opt_correct by reflexivity; apply inv_rep; reflexivity. }
+  { cbv [decode encode div]; intros; rewrite !proj1_fe25519_32_exist_fe25519_32; apply encode_rep. }
+Qed.
+
+Global Instance field25519_32 : @field fe25519_32 eq zero one opp add sub mul inv div := proj1 field25519_32_and_homomorphisms.
+
+Local Opaque proj1_fe25519_32 exist_fe25519_32 proj1_fe25519_32W exist_fe25519_32W.
+Global Instance homomorphism_F25519_32_encode
+  : @Ring.is_homomorphism (F modulus) Logic.eq F.one F.add F.mul fe25519_32 eq one add mul encode.
+Proof. apply field25519_32_and_homomorphisms. Qed.
+
+Global Instance homomorphism_F25519_32_decode
+  : @Ring.is_homomorphism fe25519_32 eq one add mul (F modulus) Logic.eq F.one F.add F.mul decode.
+Proof. apply field25519_32_and_homomorphisms. Qed.
diff --git a/src/SpecificGen/GF25519_32BoundedCommon.v b/src/SpecificGen/GF25519_32BoundedCommon.v
new file mode 100644
index 000000000..f88b8a152
--- /dev/null
+++ b/src/SpecificGen/GF25519_32BoundedCommon.v
@@ -0,0 +1,693 @@
+Require Import Crypto.BaseSystem.
+Require Import Crypto.ModularArithmetic.PrimeFieldTheorems.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParams.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParamProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystem.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemOpt.
+Require Import Crypto.SpecificGen.GF25519_32.
+Require Import Bedrock.Word Crypto.Util.WordUtil.
+Require Import Coq.Lists.List Crypto.Util.ListUtil.
+Require Import Crypto.Tactics.VerdiTactics.
+Require Import Crypto.Util.ZUtil.
+Require Import Crypto.Util.Tuple.
+Require Import Crypto.Util.Tactics.
+Require Import Crypto.Util.LetIn.
+Require Import Crypto.Util.Notations.
+Require Import Crypto.Util.Decidable.
+Require Import Crypto.Util.HList.
+Require Import Crypto.Util.Tuple.
+Require Import Crypto.Algebra.
+Import ListNotations.
+Require Import Coq.ZArith.ZArith Coq.ZArith.Zpower Coq.ZArith.ZArith Coq.ZArith.Znumtheory.
+Local Open Scope Z.
+
+(* BEGIN common curve-specific definitions *)
+Definition bit_width : nat := Eval compute in Z.to_nat (GF25519_32.int_width).
+Local Notation b_of exp := (0, 2^exp + 2^(exp-3))%Z (only parsing). (* max is [(0, 2^(exp+2) + 2^exp + 2^(exp-1) + 2^(exp-3) + 2^(exp-4) + 2^(exp-5) + 2^(exp-6) + 2^(exp-10) + 2^(exp-12) + 2^(exp-13) + 2^(exp-14) + 2^(exp-15) + 2^(exp-17) + 2^(exp-23) + 2^(exp-24))%Z] *)
+Definition bounds_exp : tuple Z length_fe25519_32
+  := Eval compute in
+      Tuple.from_list length_fe25519_32 limb_widths eq_refl.
+Definition bounds : tuple (Z * Z) length_fe25519_32
+  := Eval compute in
+      Tuple.map (fun e => b_of e) bounds_exp.
+Definition wire_digit_bounds_exp : tuple Z (length wire_widths)
+  := Eval compute in Tuple.from_list _ wire_widths eq_refl.
+Definition wire_digit_bounds : tuple (Z * Z) (length wire_widths)
+  := Eval compute in Tuple.map (fun e => (0,2^e-1)%Z) wire_digit_bounds_exp.
+(* END common curve-specific definitions *)
+
+(* BEGIN aliases for word extraction *)
+Definition word64 := Word.word bit_width.
+Coercion word64ToZ (x : word64) : Z := Z.of_N (wordToN x).
+Coercion ZToWord64 (x : Z) : word64 := NToWord _ (Z.to_N x).
+Definition NToWord64 : N -> word64 := NToWord _.
+Definition word64ize (x : word64) : word64
+  := Eval cbv [wordToN N.succ_double N.double] in NToWord64 (wordToN x).
+Definition w64eqb (x y : word64) := weqb x y.
+
+Global Arguments NToWord64 : simpl never.
+Arguments word64 : simpl never.
+Arguments bit_width : simpl never.
+Global Opaque word64.
+Global Opaque bit_width.
+
+(* END aliases for word extraction *)
+
+(* BEGIN basic types *)
+Module Type WordIsBounded.
+  Parameter is_boundedT : forall (lower upper : Z), word64 -> bool.
+  Parameter Build_is_boundedT : forall {lower upper} {proj_word : word64},
+      andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true -> is_boundedT lower upper proj_word = true.
+  Parameter project_is_boundedT : forall {lower upper} {proj_word : word64},
+      is_boundedT lower upper proj_word = true -> andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true.
+End WordIsBounded.
+
+Module Import WordIsBoundedDefault : WordIsBounded.
+  Definition is_boundedT : forall (lower upper : Z), word64 -> bool
+    := fun lower upper proj_word => andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z.
+  Definition Build_is_boundedT {lower upper} {proj_word : word64}
+    : andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true -> is_boundedT lower upper proj_word = true
+    := fun x => x.
+  Definition project_is_boundedT {lower upper} {proj_word : word64}
+    : is_boundedT lower upper proj_word = true -> andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true
+    := fun x => x.
+End WordIsBoundedDefault.
+
+Definition bounded_word (lower upper : Z)
+  := { proj_word : word64 | is_boundedT lower upper proj_word = true }.
+Local Notation word_of exp := (bounded_word (fst (b_of exp)) (snd (b_of exp))).
+Local Notation unbounded_word sz := (bounded_word 0 (2^sz-1)%Z).
+
+Local Opaque word64.
+Definition fe25519_32W := Eval cbv (*-[word64]*) in (tuple word64 length_fe25519_32).
+Definition wire_digitsW := Eval cbv (*-[word64]*) in (tuple word64 (length wire_widths)).
+Definition fe25519_32 :=
+  Eval cbv -[bounded_word Z.pow Z.sub Z.add] in
+    hlist (fun e => word_of e) bounds_exp.
+Definition wire_digits :=
+  Eval cbv -[bounded_word Z.pow Z.sub Z.add] in
+    hlist (fun e => unbounded_word e) wire_digit_bounds_exp.
+
+Definition is_bounded_gen {n} (x : tuple Z n) (bounds : tuple (Z * Z) n) : bool
+  := let res := Tuple.map2
+                  (fun bounds v =>
+                     let '(lower, upper) := bounds in
+                     (lower <=? v) && (v <=? upper))%bool%Z
+                  bounds x in
+     List.fold_right andb true (Tuple.to_list _ res).
+
+Definition is_bounded (x : SpecificGen.GF25519_32.fe25519_32) : bool
+  := is_bounded_gen (n:=length_fe25519_32) x bounds.
+
+Definition wire_digits_is_bounded (x : SpecificGen.GF25519_32.wire_digits) : bool
+  := is_bounded_gen (n:=length wire_widths) x wire_digit_bounds.
+
+(* END basic types *)
+
+Section generic_destructuring.
+  Fixpoint app_on' A n : forall T (f : tuple' A n) (P : forall x : tuple' A n, T x), T f
+    := match n return forall T (f : tuple' A n) (P : forall x : tuple' A n, T x), T f with
+       | O => fun T v P => P v
+       | S n' => fun T v P => let '(v, x) := v in app_on' A n' _ v (fun v => P (v, x))
+       end.
+  Definition app_on {A n} : forall {T} (f : tuple A n) (P : forall x : tuple A n, T x), T f
+    := match n return forall T (f : tuple A n) (P : forall x : tuple A n, T x), T f with
+       | O => fun T v P => P v
+       | S n' => @app_on' A n'
+       end.
+  Lemma app_on'_correct {A n T} f (P : forall x : tuple' A n, T x) : app_on' A n T f P = P f.
+  Proof.
+    induction n; simpl in *; destruct_head' prod; [ reflexivity | exact (IHn _ _ (fun t => P (t, _))) ].
+  Qed.
+  Lemma app_on_correct {A n T} f (P : forall x : tuple A n, T x) : app_on f P = P f.
+  Proof. destruct n; [ reflexivity | apply app_on'_correct ]. Qed.
+
+  Fixpoint app_on_h' A F n : forall ts T (f : @hlist' A n F ts) (P : forall x : @hlist' A n F ts, T x), T f
+    := match n return forall ts T (f : @hlist' A n F ts) (P : forall x : @hlist' A n F ts, T x), T f with
+       | O => fun ts T v P => P v
+       | S n' => fun ts T v P => let '(v, x) := v in app_on_h' A F n' _ _ v (fun v => P (v, x))
+       end.
+  Definition app_on_h {A F n} : forall ts T (f : @hlist A n F ts) (P : forall x : @hlist A n F ts, T x), T f
+    := match n return forall ts T (f : @hlist A n F ts) (P : forall x : @hlist A n F ts, T x), T f with
+       | O => fun ts T v P => P v
+       | S n' => @app_on_h' A F n'
+       end.
+  Lemma app_on_h'_correct {A F n ts T} f P : @app_on_h' A F n ts T f P = P f.
+  Proof.
+    induction n; simpl in *; destruct_head' prod; [ reflexivity | exact (IHn _ _ _ (fun h => P (h, f))) ].
+  Qed.
+  Lemma app_on_h_correct {A} F {n} ts {T} f P : @app_on_h A F n ts T f P = P f.
+  Proof. destruct n; [ reflexivity | apply app_on_h'_correct ]. Qed.
+
+  Definition app_wire_digitsW_dep {A T} (P : forall x : tuple A (length wire_widths), T x)
+    : forall (f : tuple A (length wire_widths)), T f
+    := Eval compute in fun f => @app_on A (length wire_widths) T f P.
+  Definition app_wire_digitsW {A T} (f : tuple A (length wire_widths)) (P : tuple A (length wire_widths) -> T)
+    := Eval compute in @app_wire_digitsW_dep A (fun _ => T) P f.
+  Definition app_fe25519_32W_dep {A T} (P : forall x : tuple A length_fe25519_32, T x)
+    : forall (f : tuple A length_fe25519_32), T f
+    := Eval compute in fun f => @app_on A length_fe25519_32 T f P.
+  Definition app_fe25519_32W {A T} (f : tuple A length_fe25519_32) (P : tuple A length_fe25519_32 -> T)
+    := Eval compute in @app_fe25519_32W_dep A (fun _ => T) P f.
+  Definition app_fe25519_32_dep {T} (P : forall x : fe25519_32, T x)
+    : forall f : fe25519_32, T f
+    := Eval compute in fun f => @app_on_h _ (fun e => word_of e) length_fe25519_32 bounds_exp T f P.
+  Definition app_fe25519_32 {T} (f : fe25519_32) (P : hlist (fun e => word_of e) bounds_exp -> T)
+    := Eval compute in @app_fe25519_32_dep (fun _ => T) P f.
+  Definition app_wire_digits_dep {T} (P : forall x : wire_digits, T x)
+    : forall f : wire_digits, T f
+    := Eval compute in fun f => @app_on_h _ (fun e => unbounded_word e) (length wire_widths) wire_digit_bounds_exp T f P.
+  Definition app_wire_digits {T} (f : wire_digits) (P : hlist (fun e => unbounded_word e) wire_digit_bounds_exp -> T)
+    := Eval compute in @app_wire_digits_dep (fun _ => T) P f.
+
+  Definition app_wire_digitsW_dep_correct {A T} f P : @app_wire_digitsW_dep A T P f = P f
+    := app_on_correct f P.
+  Definition app_wire_digitsW_correct {A T} f P : @app_wire_digitsW A T f P = P f
+    := @app_wire_digitsW_dep_correct A (fun _ => T) f P.
+  Definition app_fe25519_32W_dep_correct {A T} f P : @app_fe25519_32W_dep A T P f = P f
+    := app_on_correct f P.
+  Definition app_fe25519_32W_correct {A T} f P : @app_fe25519_32W A T f P = P f
+    := @app_fe25519_32W_dep_correct A (fun _ => T) f P.
+  Definition app_fe25519_32_dep_correct {T} f P : @app_fe25519_32_dep T P f = P f
+    := app_on_h_correct (fun e => word_of e) bounds_exp f P.
+  Definition app_fe25519_32_correct {T} f P : @app_fe25519_32 T f P = P f
+    := @app_fe25519_32_dep_correct (fun _ => T) f P.
+  Definition app_wire_digits_dep_correct {T} f P : @app_wire_digits_dep T P f = P f
+    := app_on_h_correct (fun e => unbounded_word e) wire_digit_bounds_exp f P.
+  Definition app_wire_digits_correct {T} f P : @app_wire_digits T f P = P f
+    := @app_wire_digits_dep_correct (fun _ => T) f P.
+
+  Definition appify2 {T} (op : fe25519_32W -> fe25519_32W -> T) (f g : fe25519_32W) :=
+    app_fe25519_32W f (fun f0 => (app_fe25519_32W g (fun g0 => op f0 g0))).
+
+  Lemma appify2_correct : forall {T} op f g, @appify2 T op f g = op f g.
+  Proof.
+    intros. cbv [appify2].
+    etransitivity; apply app_fe25519_32W_correct.
+  Qed.
+End generic_destructuring.
+
+Definition eta_fe25519_32W_sig (x : fe25519_32W) : { v : fe25519_32W | v = x }.
+Proof.
+  eexists; symmetry.
+  repeat (etransitivity; [ apply surjective_pairing | apply f_equal2 ]); reflexivity.
+Defined.
+Definition eta_fe25519_32W (x : fe25519_32W) : fe25519_32W
+  := Eval cbv [proj1_sig eta_fe25519_32W_sig] in proj1_sig (eta_fe25519_32W_sig x).
+Definition eta_wire_digitsW_sig (x : wire_digitsW) : { v : wire_digitsW | v = x }.
+Proof.
+  eexists; symmetry.
+  repeat (etransitivity; [ apply surjective_pairing | apply f_equal2 ]); reflexivity.
+Defined.
+Definition eta_wire_digitsW (x : wire_digitsW) : wire_digitsW
+  := Eval cbv [proj1_sig eta_wire_digitsW_sig] in proj1_sig (eta_wire_digitsW_sig x).
+
+Local Transparent word64.
+Lemma word64ize_id x : word64ize x = x.
+Proof. apply NToWord_wordToN. Qed.
+Local Opaque word64.
+
+Lemma word64eqb_Zeqb x y : (word64ToZ x =? word64ToZ y)%Z = w64eqb x y.
+Proof. apply wordeqb_Zeqb. Qed.
+
+Local Arguments Z.pow_pos !_ !_ / .
+Lemma word64ToZ_ZToWord64 x : 0 <= x < 2^Z.of_nat bit_width -> word64ToZ (ZToWord64 x) = x.
+Proof.
+  intros; unfold word64ToZ, ZToWord64.
+  rewrite wordToN_NToWord_idempotent, Z2N.id
+    by (omega || apply N2Z.inj_lt; rewrite <- ?(N_nat_Z (Npow2 _)), ?Npow2_nat, ?Zpow_pow2, ?N2Z.id, ?Z2N.id, ?Z2Nat.id by omega; omega).
+  reflexivity.
+Qed.
+Lemma ZToWord64_word64ToZ x : ZToWord64 (word64ToZ x) = x.
+Proof.
+  intros; unfold word64ToZ, ZToWord64.
+  rewrite N2Z.id, NToWord_wordToN; reflexivity.
+Qed.
+
+(* BEGIN precomputation. *)
+
+Definition proj_word {lower upper} (v : bounded_word lower upper) := Eval cbv [proj1_sig] in proj1_sig v.
+Definition word_bounded {lower upper} (v : bounded_word lower upper)
+  : andb (lower <=? proj_word v)%Z (proj_word v <=? upper)%Z = true
+  := project_is_boundedT (proj2_sig v).
+Definition Build_bounded_word' {lower upper} proj_word word_bounded : bounded_word lower upper
+  := exist _ proj_word (Build_is_boundedT word_bounded).
+Arguments proj_word {_ _} _.
+Arguments word_bounded {_ _} _.
+Arguments Build_bounded_word' {_ _} _ _.
+Definition Build_bounded_word {lower upper} (proj_word : word64) (word_bounded : andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true)
+  : bounded_word lower upper
+  := Build_bounded_word'
+       proj_word
+       (match andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z as b return b = true -> b = true with
+        | true => fun _ => eq_refl
+        | false => fun x => x
+        end word_bounded).
+Lemma word_to_unbounded_helper {x e : nat} : (x < pow2 e)%nat -> (Z.of_nat e <= Z.of_nat bit_width)%Z -> ((0 <=? word64ToZ (ZToWord64 (Z.of_nat x))) && (word64ToZ (ZToWord64 (Z.of_nat x)) <=? 2 ^ (Z.of_nat e) - 1))%bool = true.
+Proof.
+  rewrite pow2_id; intro H; apply Nat2Z.inj_lt in H; revert H.
+  rewrite Z.pow_Zpow; simpl Z.of_nat.
+  intros H H'.
+  assert (2^Z.of_nat e <= 2^Z.of_nat bit_width) by auto with zarith.
+  rewrite ?word64ToZ_ZToWord64 by omega.
+  match goal with
+  | [ |- context[andb ?x ?y] ]
+    => destruct x eqn:?, y eqn:?; try reflexivity; Z.ltb_to_lt
+  end;
+    intros; omega.
+Qed.
+Definition word_to_unbounded_word {sz} (x : word sz) : (Z.of_nat sz <=? Z.of_nat bit_width)%Z = true -> unbounded_word (Z.of_nat sz).
+Proof.
+  refine (fun pf => Build_bounded_word (Z.of_N (wordToN x)) _).
+  abstract (rewrite wordToN_nat, nat_N_Z; Z.ltb_to_lt; apply (word_to_unbounded_helper (wordToNat_bound x)); simpl; omega).
+Defined.
+Definition word32_to_unbounded_word (x : word 32) : unbounded_word 32.
+Proof. apply (word_to_unbounded_word x); reflexivity. Defined.
+Definition word31_to_unbounded_word (x : word 31) : unbounded_word 31.
+Proof. apply (word_to_unbounded_word x); reflexivity. Defined.
+
+Local Opaque word64.
+Declare Reduction app_tuple_map := cbv [app_wire_digitsW app_fe25519_32W app_fe25519_32 HList.mapt HList.mapt' Tuple.map on_tuple List.map List.app length_fe25519_32 List.length wire_widths Tuple.from_list Tuple.from_list' Tuple.to_list Tuple.to_list' fst snd].
+Definition fe25519_32WToZ (x : fe25519_32W) : SpecificGen.GF25519_32.fe25519_32
+  := Eval app_tuple_map in
+      app_fe25519_32W x (Tuple.map (fun v : word64 => v : Z)).
+Definition fe25519_32ZToW (x : SpecificGen.GF25519_32.fe25519_32) : fe25519_32W
+  := Eval app_tuple_map in
+      app_fe25519_32W x (Tuple.map (fun v : Z => v : word64)).
+Definition wire_digitsWToZ (x : wire_digitsW) : SpecificGen.GF25519_32.wire_digits
+  := Eval app_tuple_map in
+      app_wire_digitsW x (Tuple.map (fun v : word64 => v : Z)).
+Definition wire_digitsZToW (x : SpecificGen.GF25519_32.wire_digits) : wire_digitsW
+  := Eval app_tuple_map in
+      app_wire_digitsW x (Tuple.map (fun v : Z => v : word64)).
+Definition fe25519_32W_word64ize (x : fe25519_32W) : fe25519_32W
+  := Eval app_tuple_map in
+      app_fe25519_32W x (Tuple.map word64ize).
+Definition wire_digitsW_word64ize (x : wire_digitsW) : wire_digitsW
+  := Eval app_tuple_map in
+      app_wire_digitsW x (Tuple.map word64ize).
+
+(** TODO: Turn this into a lemma to speed up proofs *)
+Ltac unfold_is_bounded_in H :=
+  unfold is_bounded, wire_digits_is_bounded, is_bounded_gen, fe25519_32WToZ, wire_digitsWToZ in H;
+  cbv [to_list length bounds wire_digit_bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map fold_right List.rev List.app length_fe25519_32 List.length wire_widths] in H;
+  rewrite ?Bool.andb_true_iff in H.
+
+Ltac unfold_is_bounded :=
+  unfold is_bounded, wire_digits_is_bounded, is_bounded_gen, fe25519_32WToZ, wire_digitsWToZ;
+  cbv [to_list length bounds wire_digit_bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map fold_right List.rev List.app length_fe25519_32 List.length wire_widths];
+  rewrite ?Bool.andb_true_iff.
+
+Local Transparent bit_width.
+Definition Pow2_64 := Eval compute in 2^Z.of_nat bit_width.
+Definition unfold_Pow2_64 : 2^Z.of_nat bit_width = Pow2_64 := eq_refl.
+Local Opaque bit_width.
+
+Local Ltac prove_lt_bit_width :=
+  rewrite unfold_Pow2_64; cbv [Pow2_64]; omega.
+
+Lemma fe25519_32ZToW_WToZ (x : fe25519_32W) : fe25519_32ZToW (fe25519_32WToZ x) = x.
+Proof.
+  hnf in x; destruct_head' prod; cbv [fe25519_32WToZ fe25519_32ZToW].
+  rewrite !ZToWord64_word64ToZ; reflexivity.
+Qed.
+
+Lemma fe25519_32WToZ_ZToW x : is_bounded x = true -> fe25519_32WToZ (fe25519_32ZToW x) = x.
+Proof.
+  hnf in x; destruct_head' prod; cbv [fe25519_32WToZ fe25519_32ZToW].
+  intro H.
+  unfold_is_bounded_in H; destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite !word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Lemma fe25519_32W_word64ize_id x : fe25519_32W_word64ize x = x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [fe25519_32W_word64ize];
+    repeat apply f_equal2; apply word64ize_id.
+Qed.
+Lemma wire_digitsW_word64ize_id x : wire_digitsW_word64ize x = x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [wire_digitsW_word64ize];
+    repeat apply f_equal2; apply word64ize_id.
+Qed.
+
+Definition uncurry_unop_fe25519_32W {T} (op : fe25519_32W -> T)
+  := Eval cbv (*-[word64]*) in Tuple.uncurry (n:=length_fe25519_32) op.
+Definition curry_unop_fe25519_32W {T} op : fe25519_32W -> T
+  := Eval cbv (*-[word64]*) in fun f => app_fe25519_32W f (Tuple.curry (n:=length_fe25519_32) op).
+Definition uncurry_binop_fe25519_32W {T} (op : fe25519_32W -> fe25519_32W -> T)
+  := Eval cbv (*-[word64]*) in uncurry_unop_fe25519_32W (fun f => uncurry_unop_fe25519_32W (op f)).
+Definition curry_binop_fe25519_32W {T} op : fe25519_32W -> fe25519_32W -> T
+  := Eval cbv (*-[word64]*) in appify2 (fun f => curry_unop_fe25519_32W (curry_unop_fe25519_32W op f)).
+
+Definition uncurry_unop_wire_digitsW {T} (op : wire_digitsW -> T)
+  := Eval cbv (*-[word64]*) in Tuple.uncurry (n:=length wire_widths) op.
+Definition curry_unop_wire_digitsW {T} op : wire_digitsW -> T
+  := Eval cbv (*-[word64]*) in fun f => app_wire_digitsW f (Tuple.curry (n:=length wire_widths) op).
+
+
+Definition proj1_fe25519_32W (x : fe25519_32) : fe25519_32W
+  := Eval app_tuple_map in
+      app_fe25519_32 x (HList.mapt (fun _ => (@proj_word _ _))).
+Coercion proj1_fe25519_32 (x : fe25519_32) : SpecificGen.GF25519_32.fe25519_32
+  := fe25519_32WToZ (proj1_fe25519_32W x).
+
+Lemma is_bounded_proj1_fe25519_32 (x : fe25519_32) : is_bounded (proj1_fe25519_32 x) = true.
+Proof.
+  revert x; refine (app_fe25519_32_dep _); intro x.
+  hnf in x; destruct_head' prod; destruct_head' bounded_word.
+  cbv [is_bounded proj1_fe25519_32 proj1_fe25519_32W fe25519_32WToZ to_list length bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map List.rev List.app proj_word length_fe25519_32 is_bounded_gen].
+  apply fold_right_andb_true_iff_fold_right_and_True.
+  cbv [fold_right List.map].
+  cbv beta in *.
+  repeat split; auto using project_is_boundedT.
+Qed.
+
+Definition proj1_wire_digitsW (x : wire_digits) : wire_digitsW
+  := app_wire_digits x (HList.mapt (fun _ => proj_word)).
+Coercion proj1_wire_digits (x : wire_digits) : SpecificGen.GF25519_32.wire_digits
+  := wire_digitsWToZ (proj1_wire_digitsW x).
+
+Lemma is_bounded_proj1_wire_digits (x : wire_digits) : wire_digits_is_bounded (proj1_wire_digits x) = true.
+Proof.
+  revert x; refine (app_wire_digits_dep _); intro x.
+  hnf in x; destruct_head' prod; destruct_head' bounded_word.
+  cbv [wire_digits_is_bounded proj1_wire_digits proj1_wire_digitsW wire_digitsWToZ to_list length wire_digit_bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map List.rev List.app proj_word is_bounded_gen wire_widths HList.mapt HList.mapt' app_wire_digits fst snd].
+  apply fold_right_andb_true_iff_fold_right_and_True.
+  cbv [fold_right List.map].
+  cbv beta in *.
+  repeat split; auto using project_is_boundedT.
+Qed.
+
+Local Ltac make_exist_W' x app_W_dep :=
+  let H := fresh in
+  revert x; refine (@app_W_dep _ _ _); intros x H;
+  let x' := fresh in
+  set (x' := x);
+  cbv [tuple tuple' length_fe25519_32 List.length wire_widths] in x;
+  destruct_head' prod;
+  let rec do_refine v H :=
+      first [ let v' := (eval cbv [snd fst] in (snd v)) in
+              refine (_, Build_bounded_word v' _);
+              [ do_refine (fst v) (proj2 H) | subst x'; abstract exact (proj1 H) ]
+            | let v' := (eval cbv [snd fst] in v) in
+              refine (Build_bounded_word v' _); subst x'; abstract exact (proj1 H) ] in
+  let H' := constr:(proj1 (@fold_right_andb_true_iff_fold_right_and_True _) H) in
+  let T := type of H' in
+  let T := (eval cbv [id
+                        List.fold_right List.map List.length List.app ListUtil.map2 List.rev
+                        Tuple.to_list Tuple.to_list' Tuple.from_list Tuple.from_list' Tuple.map2 Tuple.on_tuple2
+                        fe25519_32 bounds fe25519_32WToZ length_fe25519_32
+                        wire_digits wire_digit_bounds wire_digitsWToZ wire_widths] in T) in
+  let H' := constr:(H' : T) in
+  let v := (eval unfold x' in x') in
+  do_refine v H'.
+Local Ltac make_exist'' x exist_W ZToW :=
+  let H := fresh in
+  intro H; apply (exist_W (ZToW x));
+  abstract (
+      hnf in x; destruct_head' prod;
+      let H' := fresh in
+      pose proof H as H';
+      unfold_is_bounded_in H;
+      destruct_head' and; simpl in *;
+      Z.ltb_to_lt;
+      rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width;
+      assumption
+    ).
+Local Ltac make_exist' x app_W_dep exist'' exist_W ZToW :=
+  let H := fresh in
+  revert x; refine (@app_W_dep _ _ _); intros x H;
+  let x' := fresh in
+  set (x' := x) in *;
+  cbv [tuple tuple' length_fe25519_32 List.length wire_widths] in x;
+  destruct_head' prod;
+  let rec do_refine v :=
+      first [ let v' := (eval cbv [exist_W ZToW exist'' proj_word Build_bounded_word Build_bounded_word' snd fst] in (proj_word v)) in
+              refine (Build_bounded_word v' _); subst x'; abstract exact (word_bounded v)
+            | let v' := (eval cbv [exist_W ZToW exist'' proj_word Build_bounded_word Build_bounded_word' snd fst] in (proj_word (snd v))) in
+              refine (_, Build_bounded_word v' _);
+              [ do_refine (fst v) | subst x'; abstract exact (word_bounded (snd v)) ] ] in
+  let v := (eval unfold x' in (exist'' x' H)) in
+  do_refine v.
+
+Definition exist_fe25519_32W' (x : fe25519_32W) : is_bounded (fe25519_32WToZ x) = true -> fe25519_32.
+Proof. make_exist_W' x (@app_fe25519_32W_dep). Defined.
+Definition exist_fe25519_32W (x : fe25519_32W) : is_bounded (fe25519_32WToZ x) = true -> fe25519_32
+  := Eval cbv [app_fe25519_32W_dep exist_fe25519_32W' fe25519_32ZToW] in exist_fe25519_32W' x.
+Definition exist_fe25519_32'' (x : SpecificGen.GF25519_32.fe25519_32) : is_bounded x = true -> fe25519_32.
+Proof. make_exist'' x exist_fe25519_32W fe25519_32ZToW. Defined.
+Definition exist_fe25519_32' (x : SpecificGen.GF25519_32.fe25519_32) : is_bounded x = true -> fe25519_32.
+Proof. make_exist' x (@app_fe25519_32W_dep) exist_fe25519_32'' exist_fe25519_32W fe25519_32ZToW. Defined.
+Definition exist_fe25519_32 (x : SpecificGen.GF25519_32.fe25519_32) : is_bounded x = true -> fe25519_32
+  := Eval cbv [exist_fe25519_32' exist_fe25519_32W exist_fe25519_32' app_fe25519_32 app_fe25519_32W_dep] in
+      exist_fe25519_32' x.
+
+Lemma proj1_fe25519_32_exist_fe25519_32W x pf : proj1_fe25519_32 (exist_fe25519_32W x pf) = fe25519_32WToZ x.
+Proof. now hnf in x; destruct_head' prod. Qed.
+Lemma proj1_fe25519_32W_exist_fe25519_32 x pf : proj1_fe25519_32W (exist_fe25519_32 x pf) = fe25519_32ZToW x.
+Proof. now hnf in x; destruct_head' prod. Qed.
+Lemma proj1_fe25519_32_exist_fe25519_32 x pf : proj1_fe25519_32 (exist_fe25519_32 x pf) = x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [proj1_fe25519_32 exist_fe25519_32 proj1_fe25519_32W fe25519_32WToZ proj_word Build_bounded_word Build_bounded_word'].
+  unfold_is_bounded_in pf.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Definition exist_wire_digitsW' (x : wire_digitsW)
+  : wire_digits_is_bounded (wire_digitsWToZ x) = true -> wire_digits.
+Proof. make_exist_W' x (@app_wire_digitsW_dep). Defined.
+Definition exist_wire_digitsW (x : wire_digitsW)
+  : wire_digits_is_bounded (wire_digitsWToZ x) = true -> wire_digits
+  := Eval cbv [app_wire_digitsW_dep exist_wire_digitsW' wire_digitsZToW] in exist_wire_digitsW' x.
+Definition exist_wire_digits'' (x : SpecificGen.GF25519_32.wire_digits)
+  : wire_digits_is_bounded x = true -> wire_digits.
+Proof. make_exist'' x exist_wire_digitsW wire_digitsZToW. Defined.
+Definition exist_wire_digits' (x : SpecificGen.GF25519_32.wire_digits)
+  : wire_digits_is_bounded x = true -> wire_digits.
+Proof. make_exist' x (@app_wire_digitsW_dep) exist_wire_digits'' exist_wire_digitsW wire_digitsZToW. Defined.
+Definition exist_wire_digits (x : SpecificGen.GF25519_32.wire_digits)
+  : wire_digits_is_bounded x = true -> wire_digits
+  := Eval cbv [exist_wire_digits' exist_wire_digitsW exist_wire_digits' app_wire_digits app_wire_digitsW_dep] in
+      exist_wire_digits' x.
+
+Lemma proj1_wire_digits_exist_wire_digitsW x pf : proj1_wire_digits (exist_wire_digitsW x pf) = wire_digitsWToZ x.
+Proof. now hnf in x; destruct_head' prod. Qed.
+Lemma proj1_wire_digitsW_exist_wire_digits x pf : proj1_wire_digitsW (exist_wire_digits x pf) = wire_digitsZToW x.
+Proof. now hnf in x; destruct_head' prod. Qed.
+Lemma proj1_wire_digits_exist_wire_digits x pf : proj1_wire_digits (exist_wire_digits x pf) = x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [proj1_wire_digits exist_wire_digits proj1_wire_digitsW wire_digitsWToZ proj_word Build_bounded_word Build_bounded_word' app_wire_digits HList.mapt HList.mapt' length wire_widths fst snd].
+  unfold_is_bounded_in pf.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Module opt.
+  Definition word64ToZ := Eval vm_compute in word64ToZ.
+  Definition word64ToN := Eval vm_compute in @wordToN bit_width.
+  Definition NToWord64 := Eval vm_compute in NToWord64.
+  Definition bit_width := Eval vm_compute in bit_width.
+  Definition Zleb := Eval cbv [Z.leb] in Z.leb.
+  Definition andb := Eval vm_compute in andb.
+  Definition word64ize := Eval vm_compute in word64ize.
+End opt.
+
+Local Transparent bit_width.
+Local Ltac do_change lem :=
+  match lem with
+  | context L[andb (?x <=? ?y)%Z (?y <=? ?z)]
+    => let x' := (eval vm_compute in x) in
+       let z' := (eval vm_compute in z) in
+       lazymatch y with
+       | word64ToZ (word64ize ?v)
+         => let y' := constr:(opt.word64ToZ (opt.word64ize v)) in
+            let L' := context L[andb (opt.Zleb x' y') (opt.Zleb y' z')] in
+            do_change L'
+       end
+  | _ => lem
+  end.
+Definition fe25519_32_word64ize (x : fe25519_32) : fe25519_32.
+Proof.
+  set (x' := x).
+  hnf in x; destruct_head' prod.
+  let lem := constr:(exist_fe25519_32W (fe25519_32W_word64ize (proj1_fe25519_32W x'))) in
+  let lem := (eval cbv [proj1_fe25519_32W x' fe25519_32W_word64ize proj_word exist_fe25519_32W Build_bounded_word' Build_bounded_word] in lem) in
+  let lem := do_change lem in
+  refine (lem _);
+    change (is_bounded (fe25519_32WToZ (fe25519_32W_word64ize (proj1_fe25519_32W x'))) = true);
+    abstract (rewrite fe25519_32W_word64ize_id; apply is_bounded_proj1_fe25519_32).
+Defined.
+Definition wire_digits_word64ize (x : wire_digits) : wire_digits.
+Proof.
+  set (x' := x).
+  hnf in x; destruct_head' prod.
+  let lem := constr:(exist_wire_digitsW (wire_digitsW_word64ize (proj1_wire_digitsW x'))) in
+  let lem := (eval cbv [proj1_wire_digitsW x' wire_digitsW_word64ize proj_word exist_wire_digitsW Build_bounded_word Build_bounded_word'] in lem) in
+  let lem := do_change lem in
+  let lem := (eval cbv [word64ize opt.word64ize andb Z.leb Z.compare CompOpp Pos.compare] in lem) in
+  refine (lem _);
+    change (wire_digits_is_bounded (wire_digitsWToZ (wire_digitsW_word64ize (proj1_wire_digitsW x'))) = true);
+    abstract (rewrite wire_digitsW_word64ize_id; apply is_bounded_proj1_wire_digits).
+Defined.
+
+Lemma is_bounded_to_nth_default x (H : is_bounded x = true)
+  : forall n : nat,
+    (n < length limb_widths)%nat
+    -> (0 <= nth_default 0 (Tuple.to_list length_fe25519_32 x) n <=
+        snd (b_of (nth_default (-1) limb_widths n)))%Z.
+Proof.
+  hnf in x; destruct_head' prod.
+  unfold_is_bounded_in H; destruct_head' and.
+  Z.ltb_to_lt.
+  unfold nth_default; simpl.
+  intros.
+  repeat match goal with
+         | [ |- context[nth_error _ ?x] ]
+           => is_var x; destruct x; simpl
+         end;
+    omega.
+Qed.
+
+(* END precomputation *)
+
+(* Precompute constants *)
+
+Definition one' := Eval vm_compute in exist_fe25519_32 SpecificGen.GF25519_32.one_ eq_refl.
+Definition one := Eval cbv [one' fe25519_32_word64ize word64ize andb opt.word64ToZ opt.word64ize opt.Zleb Z.compare CompOpp Pos.compare Pos.compare_cont] in fe25519_32_word64ize one'.
+
+Definition zero' := Eval vm_compute in exist_fe25519_32 SpecificGen.GF25519_32.zero_ eq_refl.
+Definition zero := Eval cbv [zero' fe25519_32_word64ize word64ize andb opt.word64ToZ opt.word64ize opt.Zleb Z.compare CompOpp Pos.compare Pos.compare_cont] in fe25519_32_word64ize zero'.
+
+Lemma fold_chain_opt_gen {A B} (F : A -> B) is_bounded ls id' op' id op chain
+      (Hid_bounded : is_bounded (F id') = true)
+      (Hid : id = F id')
+      (Hop_bounded : forall x y, is_bounded (F x) = true
+                                 -> is_bounded (F y) = true
+                                 -> is_bounded (op (F x) (F y)) = true)
+      (Hop : forall x y, is_bounded (F x) = true
+                         -> is_bounded (F y) = true
+                         -> op (F x) (F y) = F (op' x y))
+      (Hls_bounded : forall n, is_bounded (F (nth_default id' ls n)) = true)
+  : F (fold_chain_opt id' op' chain ls)
+    = fold_chain_opt id op chain (List.map F ls)
+    /\ is_bounded (F (fold_chain_opt id' op' chain ls)) = true.
+Proof.
+  rewrite !fold_chain_opt_correct.
+  revert dependent ls; induction chain as [|x xs IHxs]; intros.
+  { pose proof (Hls_bounded 0%nat).
+    destruct ls; simpl; split; trivial; congruence. }
+  { destruct x; simpl; unfold Let_In; simpl.
+    rewrite (fun ls pf => proj1 (IHxs ls pf)) at 1; simpl.
+    { do 2 f_equal.
+      rewrite <- Hop, Hid by auto.
+      rewrite !map_nth_default_always.
+      split; try reflexivity.
+      apply (IHxs (_::_)).
+      intros [|?]; autorewrite with simpl_nth_default; auto.
+      rewrite <- Hop; auto. }
+    { intros [|?]; simpl;
+        autorewrite with simpl_nth_default; auto.
+      rewrite <- Hop; auto. } }
+Qed.
+
+Lemma encode_bounded x : is_bounded (encode x) = true.
+Proof.
+  pose proof (bounded_encode x).
+  generalize dependent (encode x).
+  intro t; compute in t; intros.
+  destruct_head' prod.
+  unfold Pow2Base.bounded in H.
+  cbv [nth_default Tuple.to_list Tuple.to_list' List.length limb_widths params25519_32] in H.
+  repeat match type of H with
+         | context[nth_error (cons _ _) _]
+           => let H' := fresh in
+              pose proof (H O) as H'; specialize (fun i => H (S i)); simpl @nth_error in H, H';
+                cbv beta iota in H'
+         end.
+  clear H.
+  simpl in *.
+  cbv [Z.pow_pos Z.mul Pos.mul Pos.iter nth_default nth_error value] in *.
+  unfold is_bounded.
+  apply fold_right_andb_true_iff_fold_right_and_True.
+  cbv [is_bounded proj1_fe25519_32 to_list length bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map List.rev List.app proj_word fold_right length_fe25519_32].
+  repeat split; rewrite !Bool.andb_true_iff, !Z.leb_le; omega.
+Qed.
+
+Definition encode (x : F modulus) : fe25519_32
+  := exist_fe25519_32 (encode x) (encode_bounded x).
+
+Definition decode (x : fe25519_32) : F modulus
+  := ModularBaseSystem.decode (proj1_fe25519_32 x).
+
+Lemma proj1_fe25519_32_encode x
+  : proj1_fe25519_32 (encode x) = ModularBaseSystem.encode x.
+Proof.
+  cbv [encode].
+  generalize (encode_bounded x); generalize (ModularBaseSystem.encode x).
+  intros y pf; intros; hnf in y; destruct_head_hnf' prod.
+  cbv [proj1_fe25519_32 exist_fe25519_32 proj1_fe25519_32W Build_bounded_word Build_bounded_word' fe25519_32WToZ proj_word].
+  unfold_is_bounded_in pf.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Lemma decode_exist_fe25519_32 x pf
+  : decode (exist_fe25519_32 x pf) = ModularBaseSystem.decode x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [decode proj1_fe25519_32 exist_fe25519_32 proj1_fe25519_32W Build_bounded_word Build_bounded_word' fe25519_32WToZ proj_word].
+  unfold_is_bounded_in pf.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Definition div (f g : fe25519_32) : fe25519_32
+  := exist_fe25519_32 (div (proj1_fe25519_32 f) (proj1_fe25519_32 g)) (encode_bounded _).
+
+Definition eq (f g : fe25519_32) : Prop := eq (proj1_fe25519_32 f) (proj1_fe25519_32 g).
+
+
+Notation ibinop_correct_and_bounded irop op
+  := (forall x y,
+         is_bounded (fe25519_32WToZ x) = true
+         -> is_bounded (fe25519_32WToZ y) = true
+         -> fe25519_32WToZ (irop x y) = op (fe25519_32WToZ x) (fe25519_32WToZ y)
+            /\ is_bounded (fe25519_32WToZ (irop x y)) = true) (only parsing).
+Notation iunop_correct_and_bounded irop op
+  := (forall x,
+         is_bounded (fe25519_32WToZ x) = true
+         -> fe25519_32WToZ (irop x) = op (fe25519_32WToZ x)
+            /\ is_bounded (fe25519_32WToZ (irop x)) = true) (only parsing).
+Notation iunop_FEToZ_correct irop op
+  := (forall x,
+         is_bounded (fe25519_32WToZ x) = true
+         -> word64ToZ (irop x) = op (fe25519_32WToZ x)) (only parsing).
+Notation iunop_FEToWire_correct_and_bounded irop op
+  := (forall x,
+         is_bounded (fe25519_32WToZ x) = true
+         -> wire_digitsWToZ (irop x) = op (fe25519_32WToZ x)
+            /\ wire_digits_is_bounded (wire_digitsWToZ (irop x)) = true) (only parsing).
+Notation iunop_WireToFE_correct_and_bounded irop op
+  := (forall x,
+         wire_digits_is_bounded (wire_digitsWToZ x) = true
+         -> fe25519_32WToZ (irop x) = op (wire_digitsWToZ x)
+            /\ is_bounded (fe25519_32WToZ (irop x)) = true) (only parsing).
+
+Definition prefreeze := GF25519_32.prefreeze.
diff --git a/src/SpecificGen/GF25519_32Reflective.v b/src/SpecificGen/GF25519_32Reflective.v
new file mode 100644
index 000000000..0459f10ab
--- /dev/null
+++ b/src/SpecificGen/GF25519_32Reflective.v
@@ -0,0 +1,119 @@
+Require Import Crypto.BaseSystem.
+Require Import Crypto.ModularArithmetic.PrimeFieldTheorems.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParams.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParamProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystem.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemOpt.
+Require Export Crypto.SpecificGen.GF25519_32.
+Require Import Crypto.SpecificGen.GF25519_32BoundedCommon.
+Require Import Crypto.Reflection.Reify.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Crypto.Reflection.Z.Interpretations.Relations.
+Require Import Crypto.Reflection.Z.Interpretations.RelationsCombinations.
+Require Import Crypto.Reflection.Z.Reify.
+Require Import Crypto.Reflection.Z.Syntax.
+Require Import Crypto.SpecificGen.GF25519_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF25519_32Reflective.Reified.
+Require Import Bedrock.Word Crypto.Util.WordUtil.
+Require Import Coq.Lists.List Crypto.Util.ListUtil.
+Require Import Crypto.Tactics.VerdiTactics.
+Require Import Crypto.Util.ZUtil.
+Require Import Crypto.Util.Tuple.
+Require Import Crypto.Util.Tactics.
+Require Import Crypto.Util.LetIn.
+Require Import Crypto.Util.Notations.
+Require Import Crypto.Util.Bool.
+Require Import Crypto.Util.Decidable.
+Require Import Crypto.Algebra.
+Import ListNotations.
+Require Import Coq.ZArith.ZArith Coq.ZArith.Zpower Coq.ZArith.ZArith Coq.ZArith.Znumtheory.
+Local Open Scope Z.
+
+Definition radd : ExprBinOp := Eval vm_compute in rcarry_addW.
+Definition rsub : ExprBinOp := Eval vm_compute in rcarry_subW.
+Definition rmul : ExprBinOp := Eval vm_compute in rmulW.
+Definition ropp : ExprUnOp := Eval vm_compute in rcarry_oppW.
+Definition rprefreeze : ExprUnOp := Eval vm_compute in rprefreezeW.
+Definition rge_modulus : ExprUnOpFEToZ := Eval vm_compute in rge_modulusW.
+Definition rpack : ExprUnOpFEToWire := Eval vm_compute in rpackW.
+Definition runpack : ExprUnOpWireToFE := Eval vm_compute in runpackW.
+
+Definition rword64ize {t} (x : Expr t) : Expr t
+  := MapInterp (fun t => match t with TZ => word64ize end) x.
+
+Declare Reduction asm_interp
+  := cbv beta iota delta
+         [id
+            interp_bexpr interp_uexpr interp_uexpr_FEToWire interp_uexpr_FEToZ interp_uexpr_WireToFE
+            radd rsub rmul ropp rprefreeze rge_modulus rpack runpack
+            curry_binop_fe25519_32W curry_unop_fe25519_32W curry_unop_wire_digitsW
+            Word64.interp_op Word64.interp_base_type
+            Z.interp_op Z.interp_base_type
+            Z.Syntax.interp_op Z.Syntax.interp_base_type
+            mapf_interp_flat_type map_interp Word64.interp_base_type MapInterp mapf_interp word64ize rword64ize
+            Interp interp interp_flat_type interpf interp_flat_type fst snd].
+Ltac asm_interp
+  := cbv beta iota delta
+         [id
+            interp_bexpr interp_uexpr interp_uexpr_FEToWire interp_uexpr_FEToZ interp_uexpr_WireToFE
+            radd rsub rmul ropp rprefreeze rge_modulus rpack runpack
+            curry_binop_fe25519_32W curry_unop_fe25519_32W curry_unop_wire_digitsW
+            Word64.interp_op Word64.interp_base_type
+            Z.interp_op Z.interp_base_type
+            Z.Syntax.interp_op Z.Syntax.interp_base_type
+            mapf_interp_flat_type map_interp Word64.interp_base_type MapInterp mapf_interp word64ize rword64ize
+            Interp interp interp_flat_type interpf interp_flat_type fst snd].
+
+
+Definition interp_radd : SpecificGen.GF25519_32BoundedCommon.fe25519_32W -> SpecificGen.GF25519_32BoundedCommon.fe25519_32W -> SpecificGen.GF25519_32BoundedCommon.fe25519_32W
+  := Eval asm_interp in interp_bexpr (rword64ize radd).
+(*Print interp_radd.*)
+Definition interp_radd_correct : interp_radd = interp_bexpr radd := eq_refl.
+Definition interp_rsub : SpecificGen.GF25519_32BoundedCommon.fe25519_32W -> SpecificGen.GF25519_32BoundedCommon.fe25519_32W -> SpecificGen.GF25519_32BoundedCommon.fe25519_32W
+  := Eval asm_interp in interp_bexpr (rword64ize rsub).
+(*Print interp_rsub.*)
+Definition interp_rsub_correct : interp_rsub = interp_bexpr rsub := eq_refl.
+Definition interp_rmul : SpecificGen.GF25519_32BoundedCommon.fe25519_32W -> SpecificGen.GF25519_32BoundedCommon.fe25519_32W -> SpecificGen.GF25519_32BoundedCommon.fe25519_32W
+  := Eval asm_interp in interp_bexpr (rword64ize rmul).
+(*Print interp_rmul.*)
+Definition interp_rmul_correct : interp_rmul = interp_bexpr rmul := eq_refl.
+Definition interp_ropp : SpecificGen.GF25519_32BoundedCommon.fe25519_32W -> SpecificGen.GF25519_32BoundedCommon.fe25519_32W
+  := Eval asm_interp in interp_uexpr (rword64ize ropp).
+(*Print interp_ropp.*)
+Definition interp_ropp_correct : interp_ropp = interp_uexpr ropp := eq_refl.
+Definition interp_rprefreeze : SpecificGen.GF25519_32BoundedCommon.fe25519_32W -> SpecificGen.GF25519_32BoundedCommon.fe25519_32W
+  := Eval asm_interp in interp_uexpr (rword64ize rprefreeze).
+(*Print interp_rprefreeze.*)
+Definition interp_rprefreeze_correct : interp_rprefreeze = interp_uexpr rprefreeze := eq_refl.
+
+Definition interp_rge_modulus : SpecificGen.GF25519_32BoundedCommon.fe25519_32W -> SpecificGen.GF25519_32BoundedCommon.word64
+  := Eval asm_interp in interp_uexpr_FEToZ (rword64ize rge_modulus).
+Definition interp_rge_modulus_correct : interp_rge_modulus = interp_uexpr_FEToZ rge_modulus := eq_refl.
+
+Definition interp_rpack : SpecificGen.GF25519_32BoundedCommon.fe25519_32W -> SpecificGen.GF25519_32BoundedCommon.wire_digitsW
+  := Eval asm_interp in interp_uexpr_FEToWire (rword64ize rpack).
+Definition interp_rpack_correct : interp_rpack = interp_uexpr_FEToWire rpack := eq_refl.
+
+Definition interp_runpack : SpecificGen.GF25519_32BoundedCommon.wire_digitsW -> SpecificGen.GF25519_32BoundedCommon.fe25519_32W
+  := Eval asm_interp in interp_uexpr_WireToFE (rword64ize runpack).
+Definition interp_runpack_correct : interp_runpack = interp_uexpr_WireToFE runpack := eq_refl.
+
+Lemma radd_correct_and_bounded : binop_correct_and_bounded radd carry_add.
+Proof. exact rcarry_addW_correct_and_bounded. Qed.
+Lemma rsub_correct_and_bounded : binop_correct_and_bounded rsub carry_sub.
+Proof. exact rcarry_subW_correct_and_bounded. Qed.
+Lemma rmul_correct_and_bounded : binop_correct_and_bounded rmul mul.
+Proof. exact rmulW_correct_and_bounded. Qed.
+Lemma ropp_correct_and_bounded : unop_correct_and_bounded ropp carry_opp.
+Proof. exact rcarry_oppW_correct_and_bounded. Qed.
+Lemma rprefreeze_correct_and_bounded : unop_correct_and_bounded rprefreeze prefreeze.
+Proof. exact rprefreezeW_correct_and_bounded. Qed.
+Lemma rge_modulus_correct_and_bounded : unop_FEToZ_correct rge_modulus ge_modulus.
+Proof. exact rge_modulusW_correct_and_bounded. Qed.
+Lemma rpack_correct_and_bounded : unop_FEToWire_correct_and_bounded rpack pack.
+Proof. exact rpackW_correct_and_bounded. Qed.
+Lemma runpack_correct_and_bounded : unop_WireToFE_correct_and_bounded runpack unpack.
+Proof. exact runpackW_correct_and_bounded. Qed.
diff --git a/src/SpecificGen/GF25519_32Reflective/Common.v b/src/SpecificGen/GF25519_32Reflective/Common.v
new file mode 100644
index 000000000..4105b4173
--- /dev/null
+++ b/src/SpecificGen/GF25519_32Reflective/Common.v
@@ -0,0 +1,438 @@
+Require Export Coq.ZArith.ZArith.
+Require Export Coq.Strings.String.
+Require Export Crypto.SpecificGen.GF25519_32.
+Require Export Crypto.SpecificGen.GF25519_32BoundedCommon.
+Require Import Crypto.Reflection.Reify.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Crypto.Reflection.Z.Interpretations.Relations.
+Require Import Crypto.Reflection.Z.Interpretations.RelationsCombinations.
+Require Import Crypto.Reflection.Z.Reify.
+Require Export Crypto.Reflection.Z.Syntax.
+Require Import Crypto.Reflection.InterpWfRel.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Reflection.MapInterpWf.
+Require Import Crypto.Reflection.WfReflective.
+Require Import Crypto.Util.LetIn.
+Require Import Crypto.Util.ZUtil.
+Require Import Crypto.Util.Tactics.
+Require Import Crypto.Util.Notations.
+
+Notation Expr := (Expr base_type Word64.interp_base_type op).
+
+Local Ltac make_type_from uncurried_op :=
+  let T := (type of uncurried_op) in
+  let T := (eval compute in T) in
+  let rT := reify_type T in
+  exact rT.
+
+Definition ExprBinOpT : type base_type.
+Proof. make_type_from (uncurry_binop_fe25519_32 carry_add). Defined.
+Definition ExprUnOpT : type base_type.
+Proof. make_type_from (uncurry_unop_fe25519_32 carry_opp). Defined.
+Definition ExprUnOpFEToZT : type base_type.
+Proof. make_type_from (uncurry_unop_fe25519_32 ge_modulus). Defined.
+Definition ExprUnOpWireToFET : type base_type.
+Proof. make_type_from (uncurry_unop_wire_digits unpack). Defined.
+Definition ExprUnOpFEToWireT : type base_type.
+Proof. make_type_from (uncurry_unop_fe25519_32 pack). Defined.
+Definition ExprBinOp : Type := Expr ExprBinOpT.
+Definition ExprUnOp : Type := Expr ExprUnOpT.
+Definition ExprUnOpFEToZ : Type := Expr ExprUnOpFEToZT.
+Definition ExprUnOpWireToFE : Type := Expr ExprUnOpWireToFET.
+Definition ExprUnOpFEToWire : Type := Expr ExprUnOpFEToWireT.
+
+Local Ltac bounds_from_list ls :=
+  lazymatch (eval hnf in ls) with
+  | (?x :: nil)%list => constr:(Some {| ZBounds.lower := fst x ; ZBounds.upper := snd x |})
+  | (?x :: ?xs)%list => let bs := bounds_from_list xs in
+                        constr:((Some {| ZBounds.lower := fst x ; ZBounds.upper := snd x |}, bs))
+  end.
+
+Local Ltac make_bounds ls :=
+  compute;
+  let v := bounds_from_list (List.rev ls) in
+  let v := (eval compute in v) in
+  exact v.
+
+Definition ExprBinOp_bounds : interp_all_binders_for ExprBinOpT ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ bounds ++ Tuple.to_list _ bounds)%list. Defined.
+Definition ExprUnOp_bounds : interp_all_binders_for ExprUnOpT ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ bounds). Defined.
+Definition ExprUnOpFEToZ_bounds : interp_all_binders_for ExprUnOpFEToZT ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ bounds). Defined.
+Definition ExprUnOpFEToWire_bounds : interp_all_binders_for ExprUnOpFEToWireT ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ bounds). Defined.
+Definition ExprUnOpWireToFE_bounds : interp_all_binders_for ExprUnOpWireToFET ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ wire_digit_bounds). Defined.
+
+Definition interp_bexpr : ExprBinOp -> SpecificGen.GF25519_32BoundedCommon.fe25519_32W -> SpecificGen.GF25519_32BoundedCommon.fe25519_32W -> SpecificGen.GF25519_32BoundedCommon.fe25519_32W
+  := fun e => curry_binop_fe25519_32W (Interp (@Word64.interp_op) e).
+Definition interp_uexpr : ExprUnOp -> SpecificGen.GF25519_32BoundedCommon.fe25519_32W -> SpecificGen.GF25519_32BoundedCommon.fe25519_32W
+  := fun e => curry_unop_fe25519_32W (Interp (@Word64.interp_op) e).
+Definition interp_uexpr_FEToZ : ExprUnOpFEToZ -> SpecificGen.GF25519_32BoundedCommon.fe25519_32W -> SpecificGen.GF25519_32BoundedCommon.word64
+  := fun e => curry_unop_fe25519_32W (Interp (@Word64.interp_op) e).
+Definition interp_uexpr_FEToWire : ExprUnOpFEToWire -> SpecificGen.GF25519_32BoundedCommon.fe25519_32W -> SpecificGen.GF25519_32BoundedCommon.wire_digitsW
+  := fun e => curry_unop_fe25519_32W (Interp (@Word64.interp_op) e).
+Definition interp_uexpr_WireToFE : ExprUnOpWireToFE -> SpecificGen.GF25519_32BoundedCommon.wire_digitsW -> SpecificGen.GF25519_32BoundedCommon.fe25519_32W
+  := fun e => curry_unop_wire_digitsW (Interp (@Word64.interp_op) e).
+
+Notation binop_correct_and_bounded rop op
+  := (ibinop_correct_and_bounded (interp_bexpr rop) op) (only parsing).
+Notation unop_correct_and_bounded rop op
+  := (iunop_correct_and_bounded (interp_uexpr rop) op) (only parsing).
+Notation unop_FEToZ_correct rop op
+  := (iunop_FEToZ_correct (interp_uexpr_FEToZ rop) op) (only parsing).
+Notation unop_FEToWire_correct_and_bounded rop op
+  := (iunop_FEToWire_correct_and_bounded (interp_uexpr_FEToWire rop) op) (only parsing).
+Notation unop_WireToFE_correct_and_bounded rop op
+  := (iunop_WireToFE_correct_and_bounded (interp_uexpr_WireToFE rop) op) (only parsing).
+
+Ltac rexpr_cbv :=
+  lazymatch goal with
+  | [ |- { rexpr | interp_type_gen_rel_pointwise _ (Interp _ (t:=?T) rexpr) (?uncurry ?oper) } ]
+    => let operf := head oper in
+       let uncurryf := head uncurry in
+       try cbv delta [T]; try cbv delta [oper];
+       try cbv beta iota delta [uncurryf]
+  end;
+  cbv beta iota delta [interp_flat_type Z.interp_base_type interp_base_type zero_].
+
+Ltac reify_sig :=
+  rexpr_cbv; eexists; Reify_rhs; reflexivity.
+
+Local Notation rexpr_sig T uncurried_op :=
+  { rexprZ
+  | interp_type_gen_rel_pointwise (fun _ => Logic.eq) (Interp interp_op (t:=T) rexprZ) uncurried_op }
+    (only parsing).
+
+Notation rexpr_binop_sig op := (rexpr_sig ExprBinOpT (uncurry_binop_fe25519_32 op)) (only parsing).
+Notation rexpr_unop_sig op := (rexpr_sig ExprUnOpT (uncurry_unop_fe25519_32 op)) (only parsing).
+Notation rexpr_unop_FEToZ_sig op := (rexpr_sig ExprUnOpFEToZT (uncurry_unop_fe25519_32 op)) (only parsing).
+Notation rexpr_unop_FEToWire_sig op := (rexpr_sig ExprUnOpFEToWireT (uncurry_unop_fe25519_32 op)) (only parsing).
+Notation rexpr_unop_WireToFE_sig op := (rexpr_sig ExprUnOpWireToFET (uncurry_unop_wire_digits op)) (only parsing).
+
+Notation correct_and_bounded_genT ropW'v ropZ_sigv
+  := (let ropW' := ropW'v in
+      let ropZ_sig := ropZ_sigv in
+      let ropW := MapInterp (fun _ x => x) ropW' in
+      let ropZ := MapInterp Word64.to_Z ropW' in
+      let ropBounds := MapInterp ZBounds.of_word64 ropW' in
+      let ropBoundedWord64 := MapInterp BoundedWord64.of_word64 ropW' in
+      ropZ = proj1_sig ropZ_sig
+      /\ interp_type_rel_pointwise2 Relations.related_Z (Interp (@BoundedWord64.interp_op) ropBoundedWord64) (Interp (@Z.interp_op) ropZ)
+      /\ interp_type_rel_pointwise2 Relations.related_bounds (Interp (@BoundedWord64.interp_op) ropBoundedWord64) (Interp (@ZBounds.interp_op) ropBounds)
+      /\ interp_type_rel_pointwise2 Relations.related_word64 (Interp (@BoundedWord64.interp_op) ropBoundedWord64) (Interp (@Word64.interp_op) ropW))
+       (only parsing).
+
+Ltac app_tuples x y :=
+  let tx := type of x in
+  lazymatch (eval hnf in tx) with
+  | prod _ _ => let xs := app_tuples (snd x) y in
+                constr:((fst x, xs))
+  | _ => constr:((x, y))
+  end.
+
+Local Arguments Tuple.map2 : simpl never.
+Local Arguments Tuple.map : simpl never.
+
+Fixpoint args_to_bounded_helperT {n}
+         (v : Tuple.tuple' Word64.word64 n)
+         (bounds : Tuple.tuple' (Z * Z) n)
+         (pf : List.fold_right
+                 andb true
+                 (Tuple.to_list
+                    _
+                    (Tuple.map2
+                       (n:=S n)
+                       (fun bounds v =>
+                          let '(lower, upper) := bounds in ((lower <=? v)%Z && (v <=? upper)%Z)%bool)
+                       bounds
+                       (Tuple.map (n:=S n) Word64.word64ToZ v))) = true)
+         (res : Type)
+         {struct n}
+  : Type.
+Proof.
+  refine (match n return (forall (v : Tuple.tuple' _ n) (bounds : Tuple.tuple' _ n),
+                             List.fold_right
+                               _ _ (Tuple.to_list
+                                      _
+                                      (Tuple.map2 (n:=S n) _ bounds (Tuple.map (n:=S n) _ v))) = true
+                             -> Type)
+          with
+          | 0 => fun v' bounds' pf0 => forall pf1 : (0 <= fst bounds' /\ Z.log2 (snd bounds') < Z.of_nat Word64.bit_width)%Z, res
+          | S n' => fun v' bounds' pf0 => let t := _ in
+                                        forall pf1 : (0 <= fst (snd bounds') /\ Z.log2 (snd (snd bounds')) < Z.of_nat Word64.bit_width)%Z, @args_to_bounded_helperT n' (fst v') (fst bounds') t res
+          end v bounds pf).
+  { clear -pf0.
+    abstract (
+        destruct v', bounds'; simpl @fst;
+        rewrite Tuple.map_S in pf0;
+        simpl in pf0;
+        rewrite Tuple.map2_S in pf0;
+        simpl @List.fold_right in *;
+        rewrite Bool.andb_true_iff in pf0; tauto
+      ). }
+Defined.
+
+Fixpoint args_to_bounded_helper {n} res
+         {struct n}
+  : forall v bounds pf, (Tuple.tuple' BoundedWord64.BoundedWord n -> res) -> @args_to_bounded_helperT n v bounds pf res.
+Proof.
+  refine match n return (forall v bounds pf, (Tuple.tuple' BoundedWord64.BoundedWord n -> res) -> @args_to_bounded_helperT n v bounds pf res) with
+         | 0 => fun v bounds pf f pf' => f {| BoundedWord64.lower := fst bounds ; BoundedWord64.value := v ; BoundedWord64.upper := snd bounds |}
+         | S n'
+           => fun v bounds pf f pf'
+              => @args_to_bounded_helper
+                   n' res (fst v) (fst bounds) _
+                   (fun ts => f (ts, {| BoundedWord64.lower := fst (snd bounds) ; BoundedWord64.value := snd v ; BoundedWord64.upper := snd (snd bounds) |}))
+         end.
+  { clear -pf pf'.
+    unfold Tuple.map2, Tuple.map in pf; simpl in *.
+    abstract (
+        destruct bounds;
+        simpl in *;
+        rewrite !Bool.andb_true_iff in pf;
+        destruct_head' and;
+        Z.ltb_to_lt; auto
+      ). }
+  { simpl in *.
+    clear -pf pf'.
+    abstract (
+        destruct bounds as [? [? ?] ], v; simpl in *;
+        rewrite Tuple.map_S in pf; simpl in pf; rewrite Tuple.map2_S in pf;
+        simpl in pf;
+        rewrite !Bool.andb_true_iff in pf;
+        destruct_head' and;
+        Z.ltb_to_lt; auto
+      ). }
+Defined.
+
+Definition assoc_right''
+  := Eval cbv [Tuple.assoc_right' Tuple.rsnoc' fst snd] in @Tuple.assoc_right'.
+
+Definition args_to_bounded {n} v bounds pf
+  := Eval cbv [args_to_bounded_helper assoc_right''] in
+      @args_to_bounded_helper n _ v bounds pf (@assoc_right'' _ _).
+
+Local Ltac get_len T :=
+  match (eval hnf in T) with
+  | prod ?A ?B
+    => let a := get_len A in
+       let b := get_len B in
+       (eval compute in (a + b)%nat)
+  | _ => constr:(1%nat)
+  end.
+
+Local Ltac args_to_bounded x H :=
+  let x' := fresh in
+  set (x' := x);
+  compute in x;
+  let len := (let T := type of x in get_len T) in
+  destruct_head' prod;
+  let c := constr:(args_to_bounded (n:=pred len) x' _ H) in
+  let bounds := lazymatch c with args_to_bounded _ ?bounds _ => bounds end in
+  let c := (eval cbv [all_binders_for ExprUnOpT interp_flat_type args_to_bounded bounds pred fst snd] in c) in
+  apply c; compute; clear;
+  try abstract (
+        repeat split;
+        solve [ reflexivity
+              | refine (fun v => match v with eq_refl => I end) ]
+      ).
+
+Definition unop_args_to_bounded (x : fe25519_32W) (H : is_bounded (fe25519_32WToZ x) = true)
+  : interp_flat_type (fun _ => BoundedWord64.BoundedWord) (all_binders_for ExprUnOpT).
+Proof. args_to_bounded x H. Defined.
+
+Definition unopWireToFE_args_to_bounded (x : wire_digitsW) (H : wire_digits_is_bounded (wire_digitsWToZ x) = true)
+  : interp_flat_type (fun _ => BoundedWord64.BoundedWord) (all_binders_for ExprUnOpWireToFET).
+Proof. args_to_bounded x H. Defined.
+Definition binop_args_to_bounded (x : fe25519_32W * fe25519_32W)
+           (H : is_bounded (fe25519_32WToZ (fst x)) = true)
+           (H' : is_bounded (fe25519_32WToZ (snd x)) = true)
+  : interp_flat_type (fun _ => BoundedWord64.BoundedWord) (all_binders_for ExprBinOpT).
+Proof.
+  let v := app_tuples (unop_args_to_bounded (fst x) H) (unop_args_to_bounded (snd x) H') in
+  exact v.
+Defined.
+
+Ltac assoc_right_tuple x so_far :=
+  let t := type of x in
+  lazymatch (eval hnf in t) with
+  | prod _ _ => let so_far := assoc_right_tuple (snd x) so_far in
+                assoc_right_tuple (fst x) so_far
+  | _ => lazymatch so_far with
+         | @None => x
+         | _ => constr:((x, so_far))
+         end
+  end.
+
+Local Ltac make_bounds_prop bounds orig_bounds :=
+  let bounds' := fresh "bounds'" in
+  let bounds_bad := fresh "bounds_bad" in
+  rename bounds into bounds_bad;
+  let boundsv := assoc_right_tuple bounds_bad (@None) in
+  pose boundsv as bounds;
+  pose orig_bounds as bounds';
+  repeat (refine (match fst bounds' with
+                  | Some bounds' => let (l, u) := fst bounds in
+                                    let (l', u') := bounds' in
+                                    ((l' <=? l) && (u <=? u'))%Z%bool
+                  | None => false
+                  end && _)%bool;
+          destruct bounds' as [_ bounds'], bounds as [_ bounds]);
+  try exact (match bounds' with
+             | Some bounds' => let (l, u) := bounds in
+                               let (l', u') := bounds' in
+                               ((l' <=? l) && (u <=? u'))%Z%bool
+             | None => false
+             end).
+
+Definition unop_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprUnOpT)) : bool.
+Proof. make_bounds_prop bounds ExprUnOp_bounds. Defined.
+Definition binop_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprBinOpT)) : bool.
+Proof. make_bounds_prop bounds ExprUnOp_bounds. Defined.
+Definition unopFEToWire_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprUnOpFEToWireT)) : bool.
+Proof. make_bounds_prop bounds ExprUnOpWireToFE_bounds. Defined.
+Definition unopWireToFE_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprUnOpWireToFET)) : bool.
+Proof. make_bounds_prop bounds ExprUnOp_bounds. Defined.
+(* TODO FIXME(jgross?, andreser?): Is every function returning a single Z a boolean function? *)
+Definition unopFEToZ_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprUnOpFEToZT)) : bool.
+Proof.
+  refine (let (l, u) := bounds in ((0 <=? l) && (u <=? 1))%Z%bool).
+Defined.
+
+(* FIXME TODO(jgross): This is a horrible tactic.  We should unify the
+    various kinds of correct and boundedness, and abstract in Gallina
+    rather than Ltac *)
+
+Ltac t_correct_and_bounded ropZ_sig Hbounds H0 H1 args :=
+  let Heq := fresh "Heq" in
+  let Hbounds0 := fresh "Hbounds0" in
+  let Hbounds1 := fresh "Hbounds1" in
+  let Hbounds2 := fresh "Hbounds2" in
+  pose proof (proj2_sig ropZ_sig) as Heq;
+  cbv [interp_bexpr interp_uexpr interp_uexpr_FEToWire interp_uexpr_FEToZ interp_uexpr_WireToFE
+                    curry_binop_fe25519_32W curry_unop_fe25519_32W curry_unop_wire_digitsW
+                    curry_binop_fe25519_32 curry_unop_fe25519_32 curry_unop_wire_digits
+                    uncurry_binop_fe25519_32W uncurry_unop_fe25519_32W uncurry_unop_wire_digitsW
+                    uncurry_binop_fe25519_32 uncurry_unop_fe25519_32 uncurry_unop_wire_digits
+                    ExprBinOpT ExprUnOpFEToWireT ExprUnOpT ExprUnOpFEToZT ExprUnOpWireToFET
+                    interp_type_gen_rel_pointwise interp_type_gen_rel_pointwise] in *;
+  cbv zeta in *;
+  simpl @fe25519_32WToZ; simpl @wire_digitsWToZ;
+  rewrite <- Heq; clear Heq;
+  destruct Hbounds as [Heq Hbounds];
+  change interp_op with (@Z.interp_op) in *;
+  change interp_base_type with (@Z.interp_base_type) in *;
+  rewrite <- Heq; clear Heq;
+  destruct Hbounds as [ Hbounds0 [Hbounds1 Hbounds2] ];
+  pose proof (fun pf => Relations.uncurry_interp_type_rel_pointwise2_proj_from_option2 Word64.to_Z pf Hbounds2 Hbounds0) as Hbounds_left;
+  pose proof (fun pf => Relations.uncurry_interp_type_rel_pointwise2_proj1_from_option2 Relations.related_word64_boundsi' pf Hbounds1 Hbounds2) as Hbounds_right;
+  specialize_by repeat first [ progress intros
+                             | reflexivity
+                             | assumption
+                             | progress destruct_head' base_type
+                             | progress destruct_head' BoundedWord64.BoundedWord
+                             | progress destruct_head' and
+                             | progress repeat apply conj ];
+  specialize (Hbounds_left args H0);
+  specialize (Hbounds_right args H0);
+  cbv beta in *;
+  lazymatch type of Hbounds_right with
+  | match ?e with _ => _ end
+    => lazymatch type of H1 with
+       | match ?e' with _ => _ end
+         => change e' with e in H1; destruct e eqn:?; [ | exfalso; assumption ]
+       end
+  end;
+  repeat match goal with x := _ |- _ => subst x end;
+  cbv [id
+         binop_args_to_bounded unop_args_to_bounded unopWireToFE_args_to_bounded
+         Relations.proj_eq_rel interp_flat_type_rel_pointwise2 SmartVarfMap interp_flat_type smart_interp_flat_map Application.all_binders_for fst snd BoundedWord64.to_word64' BoundedWord64.boundedWordToWord64 BoundedWord64.value Application.ApplyInterpedAll Application.fst_binder Application.snd_binder interp_flat_type_rel_pointwise2_gen_Prop Relations.related_word64_boundsi' Relations.related'_word64_bounds ZBounds.upper ZBounds.lower Application.remove_all_binders Word64.to_Z] in Hbounds_left, Hbounds_right;
+  match goal with
+  | [ |- fe25519_32WToZ ?x = _ /\ _ ]
+    => destruct x; destruct_head_hnf' prod
+  | [ |- wire_digitsWToZ ?x = _ /\ _ ]
+    => destruct x; destruct_head_hnf' prod
+  | [ |- _ = _ ]
+    => exact Hbounds_left
+  end;
+  change word64ToZ with Word64.word64ToZ in *;
+  (split; [ exact Hbounds_left | ]);
+  cbv [interp_flat_type] in *;
+  cbv [fst snd
+           binop_bounds_good unop_bounds_good unopFEToWire_bounds_good unopWireToFE_bounds_good unopFEToZ_bounds_good
+           ExprUnOp_bounds ExprBinOp_bounds ExprUnOpFEToWire_bounds ExprUnOpFEToZ_bounds ExprUnOpWireToFE_bounds] in H1;
+  destruct_head' ZBounds.bounds;
+  unfold_is_bounded_in H1;
+  simpl @fe25519_32WToZ; simpl @wire_digitsWToZ;
+  unfold_is_bounded;
+  destruct_head' and;
+  Z.ltb_to_lt;
+  change Word64.word64ToZ with word64ToZ in *;
+  repeat apply conj; Z.ltb_to_lt; try omega; try reflexivity.
+
+
+Ltac rexpr_correct :=
+  let ropW' := fresh in
+  let ropZ_sig := fresh in
+  intros ropW' ropZ_sig;
+  let wf_ropW := fresh "wf_ropW" in
+  assert (wf_ropW : Wf ropW') by (subst ropW' ropZ_sig; reflect_Wf base_type_eq_semidec_is_dec op_beq_bl);
+  cbv zeta; repeat apply conj;
+  [ vm_compute; reflexivity
+  | apply @InterpRelWf;
+    [ | apply @RelWfMapInterp, wf_ropW ].. ];
+  auto with interp_related.
+
+Notation rword_of_Z rexprZ_sig := (MapInterp Word64.of_Z (proj1_sig rexprZ_sig)) (only parsing).
+
+Notation compute_bounds opW bounds
+  := (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp (@ZBounds.of_word64) opW)) bounds)
+       (only parsing).
+
+
+Module Export PrettyPrinting.
+  (* We add [enlargen] to force [bounds_on] to be in [Type] in 8.4 and
+     8.5/8.6.  Because [Set] is special and things break if
+     [bounds_on] ends up in [Set] for reasons jgross hasn't bothered
+     to debug. *)
+  Inductive bounds_on := overflow | in_range (lower upper : Z) | enlargen (_ : Set).
+
+  Inductive result := yes | no | borked.
+
+  Definition ZBounds_to_bounds_on
+    := fun t : base_type
+       => match t return ZBounds.interp_base_type t -> match t with TZ => bounds_on end with
+          | TZ => fun x => match x with
+                           | Some {| ZBounds.lower := l ; ZBounds.upper := u |}
+                             => in_range l u
+                           | None
+                             => overflow
+                           end
+          end.
+
+  Fixpoint does_it_overflow {t} : interp_flat_type (fun t => match t with TZ => bounds_on end) t -> result
+    := match t return interp_flat_type (fun t => match t with TZ => bounds_on end) t -> result with
+       | Tbase TZ => fun v => match v with
+                              | overflow => yes
+                              | in_range _ _ => no
+                              | enlargen _ => borked
+                              end
+       | Prod x y => fun v => match @does_it_overflow _ (fst v), @does_it_overflow _ (snd v) with
+                              | no, no => no
+                              | yes, no | no, yes | yes, yes => yes
+                              | borked, _ | _, borked => borked
+                              end
+       end.
+
+  (** This gives a slightly easier to read version of the bounds *)
+  Notation compute_bounds_for_display opW bounds
+    := (SmartVarfMap ZBounds_to_bounds_on (compute_bounds opW bounds)) (only parsing).
+  Notation sanity_compute opW bounds
+    := (does_it_overflow (SmartVarfMap ZBounds_to_bounds_on (compute_bounds opW bounds))) (only parsing).
+  Notation sanity_check opW bounds
+    := (eq_refl (sanity_compute opW bounds) <: no = no) (only parsing).
+End PrettyPrinting.
diff --git a/src/SpecificGen/GF25519_32Reflective/CommonBinOp.v b/src/SpecificGen/GF25519_32Reflective/CommonBinOp.v
new file mode 100644
index 000000000..837229900
--- /dev/null
+++ b/src/SpecificGen/GF25519_32Reflective/CommonBinOp.v
@@ -0,0 +1,50 @@
+Require Export Crypto.SpecificGen.GF25519_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF25519_32BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprBinOp_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_binop_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall xy
+                   (xy := (eta_fe25519_32W (fst xy), eta_fe25519_32W (snd xy)))
+                   (Hxy : is_bounded (fe25519_32WToZ (fst xy)) = true
+                          /\ is_bounded (fe25519_32WToZ (snd xy)) = true),
+          let Hx := let (Hx, Hy) := Hxy in Hx in
+          let Hy := let (Hx, Hy) := Hxy in Hy in
+          let args := binop_args_to_bounded xy Hx Hy in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall xy
+                   (xy := (eta_fe25519_32W (fst xy), eta_fe25519_32W (snd xy)))
+                   (Hxy : is_bounded (fe25519_32WToZ (fst xy)) = true
+                          /\ is_bounded (fe25519_32WToZ (snd xy)) = true),
+          let Hx := let (Hx, Hy) := Hxy in Hx in
+          let Hy := let (Hx, Hy) := Hxy in Hy in
+          let args := binop_args_to_bounded (fst xy, snd xy) Hx Hy in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => binop_bounds_good bounds = true
+          | None => False
+          end)
+  : binop_correct_and_bounded (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x y Hx Hy.
+  pose x as x'; pose y as y'.
+  hnf in x, y; destruct_head' prod.
+  specialize (H0 (x', y') (conj Hx Hy)).
+  specialize (H1 (x', y') (conj Hx Hy)).
+  let args := constr:(binop_args_to_bounded (x', y') Hx Hy) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF25519_32Reflective/CommonUnOp.v b/src/SpecificGen/GF25519_32Reflective/CommonUnOp.v
new file mode 100644
index 000000000..864efb92b
--- /dev/null
+++ b/src/SpecificGen/GF25519_32Reflective/CommonUnOp.v
@@ -0,0 +1,44 @@
+Require Export Crypto.SpecificGen.GF25519_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF25519_32BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprUnOp_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_unop_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall x
+                   (x := eta_fe25519_32W x)
+                   (Hx : is_bounded (fe25519_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall x
+                   (x := eta_fe25519_32W x)
+                   (Hx : is_bounded (fe25519_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => unop_bounds_good bounds = true
+          | None => False
+          end)
+  : unop_correct_and_bounded (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x Hx.
+  pose x as x'.
+  hnf in x; destruct_head' prod.
+  specialize (H0 x' Hx).
+  specialize (H1 x' Hx).
+  let args := constr:(unop_args_to_bounded x' Hx) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF25519_32Reflective/CommonUnOpFEToWire.v b/src/SpecificGen/GF25519_32Reflective/CommonUnOpFEToWire.v
new file mode 100644
index 000000000..68efe5b86
--- /dev/null
+++ b/src/SpecificGen/GF25519_32Reflective/CommonUnOpFEToWire.v
@@ -0,0 +1,44 @@
+Require Export Crypto.SpecificGen.GF25519_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF25519_32BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprUnOpFEToWire_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_unop_FEToWire_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall x
+                   (x := eta_fe25519_32W x)
+                   (Hx : is_bounded (fe25519_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall x
+                   (x := eta_fe25519_32W x)
+                   (Hx : is_bounded (fe25519_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => unopFEToWire_bounds_good bounds = true
+          | None => False
+          end)
+  : unop_FEToWire_correct_and_bounded (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x Hx.
+  pose x as x'.
+  hnf in x; destruct_head' prod.
+  specialize (H0 x' Hx).
+  specialize (H1 x' Hx).
+  let args := constr:(unop_args_to_bounded x' Hx) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF25519_32Reflective/CommonUnOpFEToZ.v b/src/SpecificGen/GF25519_32Reflective/CommonUnOpFEToZ.v
new file mode 100644
index 000000000..6b9864d6f
--- /dev/null
+++ b/src/SpecificGen/GF25519_32Reflective/CommonUnOpFEToZ.v
@@ -0,0 +1,44 @@
+Require Export Crypto.SpecificGen.GF25519_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF25519_32BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprUnOpFEToZ_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_unop_FEToZ_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall x
+                   (x := eta_fe25519_32W x)
+                   (Hx : is_bounded (fe25519_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall x
+                   (x := eta_fe25519_32W x)
+                   (Hx : is_bounded (fe25519_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => unopFEToZ_bounds_good bounds = true
+          | None => False
+          end)
+  : unop_FEToZ_correct (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x Hx.
+  pose x as x'.
+  hnf in x; destruct_head' prod.
+  specialize (H0 x' Hx).
+  specialize (H1 x' Hx).
+  let args := constr:(unop_args_to_bounded x' Hx) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF25519_32Reflective/CommonUnOpWireToFE.v b/src/SpecificGen/GF25519_32Reflective/CommonUnOpWireToFE.v
new file mode 100644
index 000000000..09ac72cdc
--- /dev/null
+++ b/src/SpecificGen/GF25519_32Reflective/CommonUnOpWireToFE.v
@@ -0,0 +1,44 @@
+Require Export Crypto.SpecificGen.GF25519_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF25519_32BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprUnOpWireToFE_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_unop_WireToFE_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall x
+                   (x := eta_wire_digitsW x)
+                   (Hx : wire_digits_is_bounded (wire_digitsWToZ x) = true),
+          let args := unopWireToFE_args_to_bounded x Hx in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall x
+                   (x := eta_wire_digitsW x)
+                   (Hx : wire_digits_is_bounded (wire_digitsWToZ x) = true),
+          let args := unopWireToFE_args_to_bounded x Hx in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => unopWireToFE_bounds_good bounds = true
+          | None => False
+          end)
+  : unop_WireToFE_correct_and_bounded (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x Hx.
+  pose x as x'.
+  hnf in x; destruct_head' prod.
+  specialize (H0 x' Hx).
+  specialize (H1 x' Hx).
+  let args := constr:(unopWireToFE_args_to_bounded x' Hx) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF25519_32Reflective/Reified.v b/src/SpecificGen/GF25519_32Reflective/Reified.v
new file mode 100644
index 000000000..106a6beb8
--- /dev/null
+++ b/src/SpecificGen/GF25519_32Reflective/Reified.v
@@ -0,0 +1,13 @@
+(** We split the reification up into separate files, one operation per
+    file, so that it can run in parallel. *)
+Require Export Crypto.SpecificGen.GF25519_32Reflective.Reified.Add.
+Require Export Crypto.SpecificGen.GF25519_32Reflective.Reified.CarryAdd.
+Require Export Crypto.SpecificGen.GF25519_32Reflective.Reified.Sub.
+Require Export Crypto.SpecificGen.GF25519_32Reflective.Reified.CarrySub.
+Require Export Crypto.SpecificGen.GF25519_32Reflective.Reified.Mul.
+Require Export Crypto.SpecificGen.GF25519_32Reflective.Reified.Opp.
+Require Export Crypto.SpecificGen.GF25519_32Reflective.Reified.CarryOpp.
+Require Export Crypto.SpecificGen.GF25519_32Reflective.Reified.PreFreeze.
+Require Export Crypto.SpecificGen.GF25519_32Reflective.Reified.GeModulus.
+Require Export Crypto.SpecificGen.GF25519_32Reflective.Reified.Pack.
+Require Export Crypto.SpecificGen.GF25519_32Reflective.Reified.Unpack.
diff --git a/src/SpecificGen/GF25519_32Reflective/Reified/Add.v b/src/SpecificGen/GF25519_32Reflective/Reified/Add.v
new file mode 100644
index 000000000..c35de3c76
--- /dev/null
+++ b/src/SpecificGen/GF25519_32Reflective/Reified/Add.v
@@ -0,0 +1,12 @@
+Require Import Crypto.SpecificGen.GF25519_32Reflective.CommonBinOp.
+
+Definition raddZ_sig : rexpr_binop_sig add. Proof. reify_sig. Defined.
+Definition raddW := Eval vm_compute in rword_of_Z raddZ_sig.
+Lemma raddW_correct_and_bounded_gen : correct_and_bounded_genT raddW raddZ_sig.
+Proof. rexpr_correct. Qed.
+Definition radd_output_bounds := Eval vm_compute in compute_bounds raddW ExprBinOp_bounds.
+
+Local Open Scope string_scope.
+Compute ("Add", compute_bounds_for_display raddW ExprBinOp_bounds).
+Compute ("Add overflows? ", sanity_compute raddW ExprBinOp_bounds).
+Compute ("Add overflows (error if it does)? ", sanity_check raddW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF25519_32Reflective/Reified/CarryAdd.v b/src/SpecificGen/GF25519_32Reflective/Reified/CarryAdd.v
new file mode 100644
index 000000000..d7a9923fb
--- /dev/null
+++ b/src/SpecificGen/GF25519_32Reflective/Reified/CarryAdd.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF25519_32Reflective.CommonBinOp.
+
+Definition rcarry_addZ_sig : rexpr_binop_sig carry_add. Proof. reify_sig. Defined.
+Definition rcarry_addW := Eval vm_compute in rword_of_Z rcarry_addZ_sig.
+Lemma rcarry_addW_correct_and_bounded_gen : correct_and_bounded_genT rcarry_addW rcarry_addZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rcarry_add_output_bounds := Eval vm_compute in compute_bounds rcarry_addW ExprBinOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rcarry_addW_correct_and_bounded
+  := ExprBinOp_correct_and_bounded
+       rcarry_addW carry_add rcarry_addZ_sig rcarry_addW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Carry_Add", compute_bounds_for_display rcarry_addW ExprBinOp_bounds).
+Compute ("Carry_Add overflows? ", sanity_compute rcarry_addW ExprBinOp_bounds).
+Compute ("Carry_Add overflows (error if it does)? ", sanity_check rcarry_addW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF25519_32Reflective/Reified/CarryOpp.v b/src/SpecificGen/GF25519_32Reflective/Reified/CarryOpp.v
new file mode 100644
index 000000000..9a3eb5cb4
--- /dev/null
+++ b/src/SpecificGen/GF25519_32Reflective/Reified/CarryOpp.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF25519_32Reflective.CommonUnOp.
+
+Definition rcarry_oppZ_sig : rexpr_unop_sig carry_opp. Proof. reify_sig. Defined.
+Definition rcarry_oppW := Eval vm_compute in rword_of_Z rcarry_oppZ_sig.
+Lemma rcarry_oppW_correct_and_bounded_gen : correct_and_bounded_genT rcarry_oppW rcarry_oppZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rcarry_opp_output_bounds := Eval vm_compute in compute_bounds rcarry_oppW ExprUnOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rcarry_oppW_correct_and_bounded
+  := ExprUnOp_correct_and_bounded
+       rcarry_oppW carry_opp rcarry_oppZ_sig rcarry_oppW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Carry_Opp", compute_bounds_for_display rcarry_oppW ExprUnOp_bounds).
+Compute ("Carry_Opp overflows? ", sanity_compute rcarry_oppW ExprUnOp_bounds).
+Compute ("Carry_Opp overflows (error if it does)? ", sanity_check rcarry_oppW ExprUnOp_bounds).
diff --git a/src/SpecificGen/GF25519_32Reflective/Reified/CarrySub.v b/src/SpecificGen/GF25519_32Reflective/Reified/CarrySub.v
new file mode 100644
index 000000000..a632e6ae7
--- /dev/null
+++ b/src/SpecificGen/GF25519_32Reflective/Reified/CarrySub.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF25519_32Reflective.CommonBinOp.
+
+Definition rcarry_subZ_sig : rexpr_binop_sig carry_sub. Proof. reify_sig. Defined.
+Definition rcarry_subW := Eval vm_compute in rword_of_Z rcarry_subZ_sig.
+Lemma rcarry_subW_correct_and_bounded_gen : correct_and_bounded_genT rcarry_subW rcarry_subZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rcarry_sub_output_bounds := Eval vm_compute in compute_bounds rcarry_subW ExprBinOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rcarry_subW_correct_and_bounded
+  := ExprBinOp_correct_and_bounded
+       rcarry_subW carry_sub rcarry_subZ_sig rcarry_subW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Carry_Sub", compute_bounds_for_display rcarry_subW ExprBinOp_bounds).
+Compute ("Carry_Sub overflows? ", sanity_compute rcarry_subW ExprBinOp_bounds).
+Compute ("Carry_Sub overflows (error if it does)? ", sanity_check rcarry_subW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF25519_32Reflective/Reified/GeModulus.v b/src/SpecificGen/GF25519_32Reflective/Reified/GeModulus.v
new file mode 100644
index 000000000..961940d22
--- /dev/null
+++ b/src/SpecificGen/GF25519_32Reflective/Reified/GeModulus.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF25519_32Reflective.CommonUnOpFEToZ.
+
+Definition rge_modulusZ_sig : rexpr_unop_FEToZ_sig ge_modulus. Proof. reify_sig. Defined.
+Definition rge_modulusW := Eval vm_compute in rword_of_Z rge_modulusZ_sig.
+Lemma rge_modulusW_correct_and_bounded_gen : correct_and_bounded_genT rge_modulusW rge_modulusZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rge_modulus_output_bounds := Eval vm_compute in compute_bounds rge_modulusW ExprUnOpFEToZ_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rge_modulusW_correct_and_bounded
+  := ExprUnOpFEToZ_correct_and_bounded
+       rge_modulusW ge_modulus rge_modulusZ_sig rge_modulusW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Ge_Modulus", compute_bounds_for_display rge_modulusW ExprUnOpFEToZ_bounds).
+Compute ("Ge_Modulus overflows? ", sanity_compute rge_modulusW ExprUnOpFEToZ_bounds).
+Compute ("Ge_Modulus overflows (error if it does)? ", sanity_check rge_modulusW ExprUnOpFEToZ_bounds).
diff --git a/src/SpecificGen/GF25519_32Reflective/Reified/Mul.v b/src/SpecificGen/GF25519_32Reflective/Reified/Mul.v
new file mode 100644
index 000000000..4cfa15372
--- /dev/null
+++ b/src/SpecificGen/GF25519_32Reflective/Reified/Mul.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF25519_32Reflective.CommonBinOp.
+
+Definition rmulZ_sig : rexpr_binop_sig mul. Proof. reify_sig. Defined.
+Definition rmulW := Eval vm_compute in rword_of_Z rmulZ_sig.
+Lemma rmulW_correct_and_bounded_gen : correct_and_bounded_genT rmulW rmulZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rmul_output_bounds := Eval vm_compute in compute_bounds rmulW ExprBinOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rmulW_correct_and_bounded
+  := ExprBinOp_correct_and_bounded
+       rmulW mul rmulZ_sig rmulW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Mul", compute_bounds_for_display rmulW ExprBinOp_bounds).
+Compute ("Mul overflows? ", sanity_compute rmulW ExprBinOp_bounds).
+Compute ("Mul overflows (error if it does)? ", sanity_check rmulW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF25519_32Reflective/Reified/Opp.v b/src/SpecificGen/GF25519_32Reflective/Reified/Opp.v
new file mode 100644
index 000000000..c105233ba
--- /dev/null
+++ b/src/SpecificGen/GF25519_32Reflective/Reified/Opp.v
@@ -0,0 +1,12 @@
+Require Import Crypto.SpecificGen.GF25519_32Reflective.CommonUnOp.
+
+Definition roppZ_sig : rexpr_unop_sig opp. Proof. reify_sig. Defined.
+Definition roppW := Eval vm_compute in rword_of_Z roppZ_sig.
+Lemma roppW_correct_and_bounded_gen : correct_and_bounded_genT roppW roppZ_sig.
+Proof. rexpr_correct. Qed.
+Definition ropp_output_bounds := Eval vm_compute in compute_bounds roppW ExprUnOp_bounds.
+
+Local Open Scope string_scope.
+Compute ("Opp", compute_bounds_for_display roppW ExprUnOp_bounds).
+Compute ("Opp overflows? ", sanity_compute roppW ExprUnOp_bounds).
+Compute ("Opp overflows (error if it does)? ", sanity_check roppW ExprUnOp_bounds).
diff --git a/src/SpecificGen/GF25519_32Reflective/Reified/Pack.v b/src/SpecificGen/GF25519_32Reflective/Reified/Pack.v
new file mode 100644
index 000000000..9f32e104a
--- /dev/null
+++ b/src/SpecificGen/GF25519_32Reflective/Reified/Pack.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF25519_32Reflective.CommonUnOpFEToWire.
+
+Definition rpackZ_sig : rexpr_unop_FEToWire_sig pack. Proof. reify_sig. Defined.
+Definition rpackW := Eval vm_compute in rword_of_Z rpackZ_sig.
+Lemma rpackW_correct_and_bounded_gen : correct_and_bounded_genT rpackW rpackZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rpack_output_bounds := Eval vm_compute in compute_bounds rpackW ExprUnOpFEToWire_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rpackW_correct_and_bounded
+  := ExprUnOpFEToWire_correct_and_bounded
+       rpackW pack rpackZ_sig rpackW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Pack", compute_bounds_for_display rpackW ExprUnOpFEToWire_bounds).
+Compute ("Pack overflows? ", sanity_compute rpackW ExprUnOpFEToWire_bounds).
+Compute ("Pack overflows (error if it does)? ", sanity_check rpackW ExprUnOpFEToWire_bounds).
diff --git a/src/SpecificGen/GF25519_32Reflective/Reified/PreFreeze.v b/src/SpecificGen/GF25519_32Reflective/Reified/PreFreeze.v
new file mode 100644
index 000000000..1ba921294
--- /dev/null
+++ b/src/SpecificGen/GF25519_32Reflective/Reified/PreFreeze.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF25519_32Reflective.CommonUnOp.
+
+Definition rprefreezeZ_sig : rexpr_unop_sig prefreeze. Proof. cbv [prefreeze GF25519_32.prefreeze]. reify_sig. Defined.
+Definition rprefreezeW := Eval vm_compute in rword_of_Z rprefreezeZ_sig.
+Lemma rprefreezeW_correct_and_bounded_gen : correct_and_bounded_genT rprefreezeW rprefreezeZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rprefreeze_output_bounds := Eval vm_compute in compute_bounds rprefreezeW ExprUnOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rprefreezeW_correct_and_bounded
+  := ExprUnOp_correct_and_bounded
+       rprefreezeW prefreeze rprefreezeZ_sig rprefreezeW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("PreFreeze", compute_bounds_for_display rprefreezeW ExprUnOp_bounds).
+Compute ("PreFreeze overflows? ", sanity_compute rprefreezeW ExprUnOp_bounds).
+Compute ("PreFreeze overflows (error if it does)? ", sanity_check rprefreezeW ExprUnOp_bounds).
diff --git a/src/SpecificGen/GF25519_32Reflective/Reified/Sub.v b/src/SpecificGen/GF25519_32Reflective/Reified/Sub.v
new file mode 100644
index 000000000..12881bf22
--- /dev/null
+++ b/src/SpecificGen/GF25519_32Reflective/Reified/Sub.v
@@ -0,0 +1,12 @@
+Require Import Crypto.SpecificGen.GF25519_32Reflective.CommonBinOp.
+
+Definition rsubZ_sig : rexpr_binop_sig sub. Proof. reify_sig. Defined.
+Definition rsubW := Eval vm_compute in rword_of_Z rsubZ_sig.
+Lemma rsubW_correct_and_bounded_gen : correct_and_bounded_genT rsubW rsubZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rsub_output_bounds := Eval vm_compute in compute_bounds rsubW ExprBinOp_bounds.
+
+Local Open Scope string_scope.
+Compute ("Sub", compute_bounds_for_display rsubW ExprBinOp_bounds).
+Compute ("Sub overflows? ", sanity_compute rsubW ExprBinOp_bounds).
+Compute ("Sub overflows (error if it does)? ", sanity_check rsubW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF25519_32Reflective/Reified/Unpack.v b/src/SpecificGen/GF25519_32Reflective/Reified/Unpack.v
new file mode 100644
index 000000000..04433583d
--- /dev/null
+++ b/src/SpecificGen/GF25519_32Reflective/Reified/Unpack.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF25519_32Reflective.CommonUnOpWireToFE.
+
+Definition runpackZ_sig : rexpr_unop_WireToFE_sig unpack. Proof. reify_sig. Defined.
+Definition runpackW := Eval vm_compute in rword_of_Z runpackZ_sig.
+Lemma runpackW_correct_and_bounded_gen : correct_and_bounded_genT runpackW runpackZ_sig.
+Proof. rexpr_correct. Qed.
+Definition runpack_output_bounds := Eval vm_compute in compute_bounds runpackW ExprUnOpWireToFE_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition runpackW_correct_and_bounded
+  := ExprUnOpWireToFE_correct_and_bounded
+       runpackW unpack runpackZ_sig runpackW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Unpack", compute_bounds_for_display runpackW ExprUnOpWireToFE_bounds).
+Compute ("Unpack overflows? ", sanity_compute runpackW ExprUnOpWireToFE_bounds).
+Compute ("Unpack overflows (error if it does)? ", sanity_check runpackW ExprUnOpWireToFE_bounds).
diff --git a/src/SpecificGen/GF25519_64Bounded.v b/src/SpecificGen/GF25519_64Bounded.v
new file mode 100644
index 000000000..e474eb2bc
--- /dev/null
+++ b/src/SpecificGen/GF25519_64Bounded.v
@@ -0,0 +1,462 @@
+Require Import Crypto.BaseSystem.
+Require Import Crypto.ModularArithmetic.PrimeFieldTheorems.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParams.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParamProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystem.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemOpt.
+Require Import Crypto.SpecificGen.GF25519_64.
+Require Import Crypto.SpecificGen.GF25519_64BoundedCommon.
+Require Import Crypto.SpecificGen.GF25519_64Reflective.
+Require Import Bedrock.Word Crypto.Util.WordUtil.
+Require Import Coq.Lists.List Crypto.Util.ListUtil.
+Require Import Crypto.Tactics.VerdiTactics.
+Require Import Crypto.Util.ZUtil.
+Require Import Crypto.Util.Tuple.
+Require Import Crypto.Util.Tactics.
+Require Import Crypto.Util.LetIn.
+Require Import Crypto.Util.Notations.
+Require Import Crypto.Util.Bool.
+Require Import Crypto.Util.Decidable.
+Require Import Crypto.Algebra.
+Import ListNotations.
+Require Import Coq.ZArith.ZArith Coq.ZArith.Zpower Coq.ZArith.ZArith Coq.ZArith.Znumtheory.
+Local Open Scope Z.
+
+
+Local Ltac bounded_t opW blem :=
+  apply blem; apply is_bounded_proj1_fe25519_64.
+Local Ltac bounded_wire_digits_t opW blem :=
+  apply blem; apply is_bounded_proj1_wire_digits.
+
+Local Ltac define_binop f g opW blem :=
+  refine (exist_fe25519_64W (opW (proj1_fe25519_64W f) (proj1_fe25519_64W g)) _);
+  abstract bounded_t opW blem.
+Local Ltac define_unop f opW blem :=
+  refine (exist_fe25519_64W (opW (proj1_fe25519_64W f)) _);
+  abstract bounded_t opW blem.
+Local Ltac define_unop_FEToZ f opW :=
+  refine (opW (proj1_fe25519_64W f)).
+Local Ltac define_unop_FEToWire f opW blem :=
+  refine (exist_wire_digitsW (opW (proj1_fe25519_64W f)) _);
+  abstract bounded_t opW blem.
+Local Ltac define_unop_WireToFE f opW blem :=
+  refine (exist_fe25519_64W (opW (proj1_wire_digitsW f)) _);
+  abstract bounded_wire_digits_t opW blem.
+
+Local Opaque Let_In.
+Local Opaque Z.add Z.sub Z.mul Z.shiftl Z.shiftr Z.land Z.lor Z.eqb NToWord64.
+Local Arguments interp_radd / _ _.
+Local Arguments interp_rsub / _ _.
+Local Arguments interp_rmul / _ _.
+Local Arguments interp_ropp / _.
+Local Arguments interp_rprefreeze / _.
+Local Arguments interp_rge_modulus / _.
+Local Arguments interp_rpack / _.
+Local Arguments interp_runpack / _.
+Definition addW (f g : fe25519_64W) : fe25519_64W := Eval simpl in interp_radd f g.
+Definition subW (f g : fe25519_64W) : fe25519_64W := Eval simpl in interp_rsub f g.
+Definition mulW (f g : fe25519_64W) : fe25519_64W := Eval simpl in interp_rmul f g.
+Definition oppW (f : fe25519_64W) : fe25519_64W := Eval simpl in interp_ropp f.
+Definition prefreezeW (f : fe25519_64W) : fe25519_64W := Eval simpl in interp_rprefreeze f.
+Definition ge_modulusW (f : fe25519_64W) : word64 := Eval simpl in interp_rge_modulus f.
+Definition packW (f : fe25519_64W) : wire_digitsW := Eval simpl in interp_rpack f.
+Definition unpackW (f : wire_digitsW) : fe25519_64W := Eval simpl in interp_runpack f.
+
+Require Import ModularBaseSystemWord.
+Definition modulusW :=
+  Eval cbv - [ZToWord64] in (Tuple.map ZToWord64 (Tuple.from_list_default 0%Z 10 GF25519_64.modulus_digits_)).
+
+Definition postfreeze : GF25519_64.fe25519_64 -> GF25519_64.fe25519_64 :=
+  GF25519_64.postfreeze.
+
+Lemma freeze_prepost_freeze : forall x, postfreeze (prefreeze x) = GF25519_64.freeze x. Proof. reflexivity. Qed.
+
+Definition postfreezeW : fe25519_64W -> fe25519_64W :=
+      (conditional_subtract_modulusW
+         (num_limbs := 10)
+         modulusW
+         ge_modulusW
+         (Interpretations.Word64.neg GF25519_64.int_width)
+      ).
+
+Definition freezeW (f : fe25519_64W) : fe25519_64W := Eval cbv beta delta [prefreezeW postfreezeW] in postfreezeW (prefreezeW f).
+
+Local Transparent Let_In.
+Definition powW (f : fe25519_64W) chain := fold_chain_opt (proj1_fe25519_64W one) mulW chain [f].
+Definition invW (f : fe25519_64W) : fe25519_64W
+  := Eval cbv -[Let_In fe25519_64W mulW] in powW f (chain inv_ec).
+
+Local Ltac port_correct_and_bounded pre_rewrite opW interp_rop rop_cb :=
+  change opW with (interp_rop);
+  rewrite pre_rewrite;
+  intros; apply rop_cb; assumption.
+
+Lemma addW_correct_and_bounded : ibinop_correct_and_bounded addW carry_add.
+Proof. port_correct_and_bounded interp_radd_correct addW interp_radd radd_correct_and_bounded. Qed.
+Lemma subW_correct_and_bounded : ibinop_correct_and_bounded subW carry_sub.
+Proof. port_correct_and_bounded interp_rsub_correct subW interp_rsub rsub_correct_and_bounded. Qed.
+Lemma mulW_correct_and_bounded : ibinop_correct_and_bounded mulW mul.
+Proof. port_correct_and_bounded interp_rmul_correct mulW interp_rmul rmul_correct_and_bounded. Qed.
+Lemma oppW_correct_and_bounded : iunop_correct_and_bounded oppW carry_opp.
+Proof. port_correct_and_bounded interp_ropp_correct oppW interp_ropp ropp_correct_and_bounded. Qed.
+Lemma prefreezeW_correct_and_bounded : iunop_correct_and_bounded prefreezeW prefreeze.
+Proof. port_correct_and_bounded interp_rprefreeze_correct prefreezeW interp_rprefreeze rprefreeze_correct_and_bounded. Qed.
+Lemma ge_modulusW_correct : iunop_FEToZ_correct ge_modulusW ge_modulus.
+Proof. port_correct_and_bounded interp_rge_modulus_correct ge_modulusW interp_rge_modulus rge_modulus_correct_and_bounded. Qed.
+Lemma packW_correct_and_bounded : iunop_FEToWire_correct_and_bounded packW pack.
+Proof. port_correct_and_bounded interp_rpack_correct packW interp_rpack rpack_correct_and_bounded. Qed.
+Lemma unpackW_correct_and_bounded : iunop_WireToFE_correct_and_bounded unpackW unpack.
+Proof. port_correct_and_bounded interp_runpack_correct unpackW interp_runpack runpack_correct_and_bounded. Qed.
+
+(* TODO : move *)
+Lemma neg_range : forall x y, 0 <= x ->
+  0 <= ModularBaseSystemListZOperations.neg x y < 2 ^ x.
+Proof.
+  intros.
+  split; auto using ModularBaseSystemListZOperationsProofs.neg_nonneg.
+  eapply Z.le_lt_trans; eauto using ModularBaseSystemListZOperationsProofs.neg_upperbound.
+  rewrite Z.ones_equiv.
+  omega.
+Qed.
+
+Ltac lower_bound_minus_ge_modulus :=
+  apply Z.le_0_sub;
+  cbv [ge_modulus Let_In ModularBaseSystemListZOperations.cmovl ModularBaseSystemListZOperations.cmovne ModularBaseSystemListZOperations.neg];
+  repeat break_if; Z.ltb_to_lt; subst; try omega;
+    rewrite ?Z.land_0_l; auto;
+    change Interpretations.Word64.word64ToZ with word64ToZ;
+    etransitivity; try apply Z.land_upper_bound_r; instantiate; try omega;
+    apply Z.ones_nonneg; instantiate; vm_compute; discriminate.
+
+Ltac upper_bound_minus_ge_modulus :=
+   (apply Z.log2_lt_pow2_alt; [ vm_compute; reflexivity | ]);
+   eapply Z.le_lt_trans; [ apply Z.le_sub_nonneg; apply Z.land_nonneg; right; omega | ];
+   eapply Z.le_lt_trans; [ eassumption | ];
+   instantiate; vm_compute; reflexivity.
+
+Lemma postfreezeW_correct_and_bounded : iunop_correct_and_bounded postfreezeW postfreeze.
+Proof.
+  intros x H.
+  pose proof (ge_modulusW_correct x H) as Hgm.
+  destruct_head_hnf' prod.
+  unfold_is_bounded_in H.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  cbv [postfreezeW].
+  cbv [conditional_subtract_modulusW Interpretations.Word64.neg].
+  change word64ToZ with Interpretations.Word64.word64ToZ in *.
+  rewrite Hgm.
+
+  cbv [modulusW Tuple.map].
+  cbv [on_tuple List.map to_list to_list' from_list from_list'
+                Tuple.map2 on_tuple2 ListUtil.map2 fe25519_64WToZ].
+  cbv [postfreeze GF25519_64.postfreeze].
+  cbv [Let_In].
+
+  split.
+  { match goal with
+    |- (_,word64ToZ (_ ^- (Interpretations.Word64.ZToWord64 ?x) ^& _)) = (_,_ - (?y &' _)) => assert (x = y) as Hxy by reflexivity; repeat rewrite <-Hxy; clear Hxy end.
+
+  change ZToWord64 with Interpretations.Word64.ZToWord64 in *.
+  rewrite !Interpretations.Word64.word64ToZ_sub;
+  rewrite !Interpretations.Word64.word64ToZ_land;
+  rewrite !Interpretations.Word64.word64ToZ_ZToWord64;
+  try match goal with
+         | |- 0 <=  ModularBaseSystemListZOperations.neg _ _ < 2 ^ _ => apply neg_range; omega
+         | |- 0 <= _ < 2 ^ Z.of_nat _ => vm_compute; split; [refine (fun x => match x with eq_refl => I end) | reflexivity]
+         | |- 0 <= _ &' _ => apply Z.land_nonneg; right; omega
+         | |- (_,_) = (_,_) => reflexivity
+      end;
+  try solve [
+  (apply Z.log2_lt_pow2_alt; [ vm_compute; reflexivity | ]);
+  eapply Z.le_lt_trans; try apply Z.land_upper_bound_r; try apply neg_range; instantiate; try match goal with |- ?G => not has_evar G; vm_compute; discriminate end; reflexivity];
+  match goal with
+  | |- 0 <= _ - _ => lower_bound_minus_ge_modulus
+  | |- Z.log2 (_ - _) < _ => upper_bound_minus_ge_modulus
+  end. }
+
+
+  unfold_is_bounded.
+  change ZToWord64 with Interpretations.Word64.ZToWord64 in *.
+  rewrite !Interpretations.Word64.word64ToZ_sub;
+  rewrite !Interpretations.Word64.word64ToZ_land;
+  rewrite !Interpretations.Word64.word64ToZ_ZToWord64;
+  repeat match goal with |- _ /\ _ => split; Z.ltb_to_lt end;
+  try match goal with
+         | |- 0 <=  ModularBaseSystemListZOperations.neg _ _ < 2 ^ _ => apply neg_range; omega
+         | |- 0 <= _ < 2 ^ Z.of_nat _ => vm_compute; split; [refine (fun x => match x with eq_refl => I end) | reflexivity]
+         | |- 0 <= _ &' _ => apply Z.land_nonneg; right; omega
+      end;
+  try solve [
+  (apply Z.log2_lt_pow2_alt; [ vm_compute; reflexivity | ]);
+  eapply Z.le_lt_trans; try apply Z.land_upper_bound_r; try apply neg_range; instantiate; try match goal with |- ?G => not has_evar G; vm_compute; discriminate end; reflexivity];
+  try match goal with
+  | |- 0 <= _ - _ => lower_bound_minus_ge_modulus
+  | |- Z.log2 (_ - _) < _ => upper_bound_minus_ge_modulus
+  | |- _ - _ <= _ => etransitivity; [ apply Z.le_sub_nonneg; apply Z.land_nonneg; right; omega | instantiate; assumption ]
+  | |- 0 <= ModularBaseSystemListZOperations.neg _ _ =>
+    apply neg_range; vm_compute; discriminate
+  | |- ModularBaseSystemListZOperations.neg _ _ < _ =>
+    apply neg_range; vm_compute; discriminate
+  | |- _ => vm_compute; (discriminate || reflexivity)
+      end.
+Qed.
+
+Lemma freezeW_correct_and_bounded : iunop_correct_and_bounded freezeW freeze.
+Proof.
+  intros f H; rewrite <- freeze_prepost_freeze.
+  change (freezeW f) with (postfreezeW (prefreezeW f)).
+  destruct (prefreezeW_correct_and_bounded f H) as [H0 H1].
+  destruct (postfreezeW_correct_and_bounded _ H1) as [H0' H1'].
+  rewrite H1', H0', H0; split; reflexivity.
+Qed.
+
+Lemma powW_correct_and_bounded chain : iunop_correct_and_bounded (fun x => powW x chain) (fun x => pow x chain).
+Proof.
+  cbv [powW pow].
+  intro x; intros; apply (fold_chain_opt_gen fe25519_64WToZ is_bounded [x]).
+  { reflexivity. }
+  { reflexivity. }
+  { intros; progress rewrite <- (fun X Y => proj1 (mulW_correct_and_bounded _ _ X Y)) by assumption.
+    apply mulW_correct_and_bounded; assumption. }
+  { intros; rewrite (fun X Y => proj1 (mulW_correct_and_bounded _ _ X Y)) by assumption; reflexivity. }
+  { intros [|?]; autorewrite with simpl_nth_default;
+      (assumption || reflexivity). }
+Qed.
+
+Lemma invW_correct_and_bounded : iunop_correct_and_bounded invW inv.
+Proof.
+  intro f.
+  assert (H : forall f, invW f = powW f (chain inv_ec))
+    by abstract (cbv -[Let_In fe25519_64W mulW]; reflexivity).
+  rewrite H.
+  rewrite inv_correct.
+  cbv [inv_opt].
+  rewrite <- pow_correct.
+  apply powW_correct_and_bounded.
+Qed.
+
+Definition fieldwisebW_sig (f g : fe25519_64W)
+  : { b | b = GF25519_64.fieldwiseb (fe25519_64WToZ f) (fe25519_64WToZ g) }.
+Proof.
+  hnf in f, g; destruct_head' prod.
+  eexists.
+  cbv [GF25519_64.fieldwiseb fe25519_64WToZ].
+  rewrite ?word64eqb_Zeqb.
+  reflexivity.
+Defined.
+
+Definition fieldwisebW (f g : fe25519_64W) : bool :=
+  Eval cbv [proj1_sig fieldwisebW_sig appify2 app_fe25519_64W] in
+    appify2 (fun f g => proj1_sig (fieldwisebW_sig f g)) f g.
+
+Lemma fieldwisebW_correct f g
+  : fieldwisebW f g = GF25519_64.fieldwiseb (fe25519_64WToZ f) (fe25519_64WToZ g).
+Proof.
+  set (f' := f); set (g' := g).
+  hnf in f, g; destruct_head' prod.
+  exact (proj2_sig (fieldwisebW_sig f' g')).
+Qed.
+
+Local Arguments freezeW : simpl never.
+Local Arguments fe25519_64WToZ !_ / .
+Local Opaque freezeW.
+
+Definition eqbW_sig (f g : fe25519_64W)
+  : { b | is_bounded (fe25519_64WToZ f) = true
+          -> is_bounded (fe25519_64WToZ g) = true
+          -> b = GF25519_64.eqb (fe25519_64WToZ f) (fe25519_64WToZ g) }.
+Proof.
+  pose proof (fun pf => proj1 (freezeW_correct_and_bounded f pf)) as frf.
+  pose proof (fun pf => proj1 (freezeW_correct_and_bounded g pf)) as frg.
+  hnf in f, g; destruct_head' prod.
+  eexists.
+  unfold GF25519_64.eqb.
+  simpl @fe25519_64WToZ in *; cbv beta iota.
+  intros.
+  rewrite <- frf, <- frg by assumption.
+  rewrite <- fieldwisebW_correct.
+  reflexivity.
+Defined.
+
+Definition eqbW (f g : fe25519_64W) : bool :=
+  Eval cbv [proj1_sig eqbW_sig appify2 app_fe25519_64W] in
+    appify2 (fun f g => proj1_sig (eqbW_sig f g)) f g.
+
+Lemma eqbW_correct f g
+  : is_bounded (fe25519_64WToZ f) = true
+    -> is_bounded (fe25519_64WToZ g) = true
+    -> eqbW f g = GF25519_64.eqb (fe25519_64WToZ f) (fe25519_64WToZ g).
+Proof.
+  set (f' := f); set (g' := g).
+  hnf in f, g; destruct_head' prod.
+  exact (proj2_sig (eqbW_sig f' g')).
+Qed.
+
+(* TODO(jgross): use NToWord or such for this constant too *)
+Definition sqrt_m1W : fe25519_64W :=
+  Eval vm_compute in fe25519_64ZToW sqrt_m1.
+
+Definition GF25519_64sqrt x : GF25519_64.fe25519_64 :=
+  dlet powx := powW (fe25519_64ZToW x) (chain GF25519_64.sqrt_ec) in
+  GF25519_64.sqrt (fe25519_64WToZ powx) (fe25519_64WToZ (mulW powx powx)) x.
+
+Definition sqrtW_sig
+  : { sqrtW | iunop_correct_and_bounded sqrtW GF25519_64sqrt }.
+Proof.
+  eexists.
+  unfold GF25519_64sqrt, GF25519_64.sqrt.
+  intros.
+  rewrite !fe25519_64ZToW_WToZ.
+  split.
+  { etransitivity.
+    Focus 2. {
+      apply Proper_Let_In_nd_changebody_eq; intros.
+      set_evars.
+      match goal with (* unfold the first dlet ... in, but only if it's binding a var *)
+      | [ |- ?x = dlet y := fe25519_64WToZ ?z in ?f ]
+        => is_var z; change (x = match fe25519_64WToZ z with y => f end)
+      end.
+      change sqrt_m1 with (fe25519_64WToZ sqrt_m1W).
+      rewrite <- (fun X Y => proj1 (mulW_correct_and_bounded sqrt_m1W a X Y)), <- eqbW_correct, (pull_bool_if fe25519_64WToZ)
+        by repeat match goal with
+                  | _ => progress subst
+                  | [ |- is_bounded (fe25519_64WToZ ?op) = true ]
+                    => lazymatch op with
+                       | mulW _ _ => apply mulW_correct_and_bounded
+                       | powW _ _ => apply powW_correct_and_bounded
+                       | sqrt_m1W => vm_compute; reflexivity
+                       | _ => assumption
+                       end
+                  end.
+      subst_evars; reflexivity.
+    } Unfocus.
+    lazymatch goal with
+    | [ |- context G[dlet x := ?v in fe25519_64WToZ (@?f x)] ]
+      => let G' := context G[fe25519_64WToZ (dlet x := v in f x)] in
+         cut G'; cbv beta;
+           [ cbv [Let_In]; exact (fun x => x) | apply f_equal ]
+    end.
+    reflexivity. }
+  { cbv [Let_In].
+    break_if.
+    { apply powW_correct_and_bounded; assumption. }
+    { apply mulW_correct_and_bounded; [ vm_compute; reflexivity | ].
+      apply powW_correct_and_bounded; assumption. } }
+Defined.
+
+Definition sqrtW (f : fe25519_64W) : fe25519_64W :=
+  Eval cbv [proj1_sig sqrtW_sig app_fe25519_64W] in
+    app_fe25519_64W f (proj1_sig sqrtW_sig).
+
+Lemma sqrtW_correct_and_bounded : iunop_correct_and_bounded sqrtW GF25519_64sqrt.
+Proof.
+  intro f.
+  set (f' := f).
+  hnf in f; destruct_head' prod.
+  assert (H : sqrtW f' = proj1_sig sqrtW_sig f')
+    by (subst f'; cbv beta iota delta [proj1_sig sqrtW_sig sqrtW]; reflexivity).
+  rewrite H.
+  exact (proj2_sig sqrtW_sig f').
+Qed.
+
+
+
+Definition add (f g : fe25519_64) : fe25519_64.
+Proof. define_binop f g addW addW_correct_and_bounded. Defined.
+Definition sub (f g : fe25519_64) : fe25519_64.
+Proof. define_binop f g subW subW_correct_and_bounded. Defined.
+Definition mul (f g : fe25519_64) : fe25519_64.
+Proof. define_binop f g mulW mulW_correct_and_bounded. Defined.
+Definition opp (f : fe25519_64) : fe25519_64.
+Proof. define_unop f oppW oppW_correct_and_bounded. Defined.
+Definition freeze (f : fe25519_64) : fe25519_64.
+Proof. define_unop f freezeW freezeW_correct_and_bounded. Defined.
+Definition ge_modulus (f : fe25519_64) : word64.
+Proof. define_unop_FEToZ f ge_modulusW. Defined.
+Definition pack (f : fe25519_64) : wire_digits.
+Proof. define_unop_FEToWire f packW packW_correct_and_bounded. Defined.
+Definition unpack (f : wire_digits) : fe25519_64.
+Proof. define_unop_WireToFE f unpackW unpackW_correct_and_bounded. Defined.
+
+Definition pow (f : fe25519_64) (chain : list (nat * nat)) : fe25519_64.
+Proof. define_unop f (fun x => powW x chain) powW_correct_and_bounded. Defined.
+Definition inv (f : fe25519_64) : fe25519_64.
+Proof. define_unop f invW invW_correct_and_bounded. Defined.
+Definition sqrt (f : fe25519_64) : fe25519_64.
+Proof. define_unop f sqrtW sqrtW_correct_and_bounded. Defined.
+
+Local Ltac op_correct_t op opW_correct_and_bounded :=
+  cbv [op];
+  lazymatch goal with
+  | [ |- context[proj1_fe25519_64 (exist_fe25519_64W _ _)] ]
+    => rewrite proj1_fe25519_64_exist_fe25519_64W
+  | [ |- context[proj1_wire_digits (exist_wire_digitsW _ _)] ]
+    => rewrite proj1_wire_digits_exist_wire_digitsW
+  | _ => idtac
+  end;
+  apply opW_correct_and_bounded;
+  lazymatch goal with
+  | [ |- is_bounded _ = true ]
+    => apply is_bounded_proj1_fe25519_64
+  | [ |- wire_digits_is_bounded _ = true ]
+    => apply is_bounded_proj1_wire_digits
+  end.
+
+Lemma add_correct (f g : fe25519_64) : proj1_fe25519_64 (add f g) = carry_add (proj1_fe25519_64 f) (proj1_fe25519_64 g).
+Proof. op_correct_t add addW_correct_and_bounded. Qed.
+Lemma sub_correct (f g : fe25519_64) : proj1_fe25519_64 (sub f g) = carry_sub (proj1_fe25519_64 f) (proj1_fe25519_64 g).
+Proof. op_correct_t sub subW_correct_and_bounded. Qed.
+Lemma mul_correct (f g : fe25519_64) : proj1_fe25519_64 (mul f g) = GF25519_64.mul (proj1_fe25519_64 f) (proj1_fe25519_64 g).
+Proof. op_correct_t mul mulW_correct_and_bounded. Qed.
+Lemma opp_correct (f : fe25519_64) : proj1_fe25519_64 (opp f) = carry_opp (proj1_fe25519_64 f).
+Proof. op_correct_t opp oppW_correct_and_bounded. Qed.
+Lemma freeze_correct (f : fe25519_64) : proj1_fe25519_64 (freeze f) = GF25519_64.freeze (proj1_fe25519_64 f).
+Proof. op_correct_t freeze freezeW_correct_and_bounded. Qed.
+Lemma ge_modulus_correct (f : fe25519_64) : word64ToZ (ge_modulus f) = GF25519_64.ge_modulus (proj1_fe25519_64 f).
+Proof. op_correct_t ge_modulus ge_modulusW_correct. Qed.
+Lemma pack_correct (f : fe25519_64) : proj1_wire_digits (pack f) = GF25519_64.pack (proj1_fe25519_64 f).
+Proof. op_correct_t pack packW_correct_and_bounded. Qed.
+Lemma unpack_correct (f : wire_digits) : proj1_fe25519_64 (unpack f) = GF25519_64.unpack (proj1_wire_digits f).
+Proof. op_correct_t unpack unpackW_correct_and_bounded. Qed.
+Lemma pow_correct (f : fe25519_64) chain : proj1_fe25519_64 (pow f chain) = GF25519_64.pow (proj1_fe25519_64 f) chain.
+Proof. op_correct_t pow (powW_correct_and_bounded chain). Qed.
+Lemma inv_correct (f : fe25519_64) : proj1_fe25519_64 (inv f) = GF25519_64.inv (proj1_fe25519_64 f).
+Proof. op_correct_t inv invW_correct_and_bounded. Qed.
+Lemma sqrt_correct (f : fe25519_64) : proj1_fe25519_64 (sqrt f) = GF25519_64sqrt (proj1_fe25519_64 f).
+Proof. op_correct_t sqrt sqrtW_correct_and_bounded. Qed.
+
+Import Morphisms.
+
+Local Existing Instance prime_modulus.
+
+Lemma field25519_64_and_homomorphisms
+  : @field fe25519_64 eq zero one opp add sub mul inv div
+    /\ @Ring.is_homomorphism (F _) (@Logic.eq _) 1%F F.add F.mul fe25519_64 eq one add mul encode
+    /\ @Ring.is_homomorphism fe25519_64 eq one add mul (F _) (@Logic.eq _) 1%F F.add F.mul decode.
+Proof.
+  eapply @Field.field_and_homomorphism_from_redundant_representation.
+  { exact (F.field_modulo _). }
+  { cbv [decode encode]; intros; rewrite !proj1_fe25519_64_exist_fe25519_64; apply encode_rep. }
+  { reflexivity. }
+  { reflexivity. }
+  { reflexivity. }
+  { cbv [decode encode]; intros; rewrite opp_correct, carry_opp_correct, carry_opp_opt_correct, carry_opp_rep; apply opp_rep; reflexivity. }
+  { cbv [decode encode]; intros; rewrite add_correct, carry_add_correct, carry_add_opt_correct, carry_add_rep; apply add_rep; reflexivity. }
+  { cbv [decode encode]; intros; rewrite sub_correct, carry_sub_correct, carry_sub_opt_correct, carry_sub_rep; apply sub_rep; reflexivity. }
+  { cbv [decode encode]; intros; rewrite mul_correct, GF25519_64.mul_correct, carry_mul_opt_correct by reflexivity; apply carry_mul_rep; reflexivity. }
+  { cbv [decode encode]; intros; rewrite inv_correct, GF25519_64.inv_correct, inv_opt_correct by reflexivity; apply inv_rep; reflexivity. }
+  { cbv [decode encode div]; intros; rewrite !proj1_fe25519_64_exist_fe25519_64; apply encode_rep. }
+Qed.
+
+Global Instance field25519_64 : @field fe25519_64 eq zero one opp add sub mul inv div := proj1 field25519_64_and_homomorphisms.
+
+Local Opaque proj1_fe25519_64 exist_fe25519_64 proj1_fe25519_64W exist_fe25519_64W.
+Global Instance homomorphism_F25519_64_encode
+  : @Ring.is_homomorphism (F modulus) Logic.eq F.one F.add F.mul fe25519_64 eq one add mul encode.
+Proof. apply field25519_64_and_homomorphisms. Qed.
+
+Global Instance homomorphism_F25519_64_decode
+  : @Ring.is_homomorphism fe25519_64 eq one add mul (F modulus) Logic.eq F.one F.add F.mul decode.
+Proof. apply field25519_64_and_homomorphisms. Qed.
diff --git a/src/SpecificGen/GF25519_64BoundedCommon.v b/src/SpecificGen/GF25519_64BoundedCommon.v
new file mode 100644
index 000000000..e6a3b6c20
--- /dev/null
+++ b/src/SpecificGen/GF25519_64BoundedCommon.v
@@ -0,0 +1,693 @@
+Require Import Crypto.BaseSystem.
+Require Import Crypto.ModularArithmetic.PrimeFieldTheorems.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParams.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParamProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystem.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemOpt.
+Require Import Crypto.SpecificGen.GF25519_64.
+Require Import Bedrock.Word Crypto.Util.WordUtil.
+Require Import Coq.Lists.List Crypto.Util.ListUtil.
+Require Import Crypto.Tactics.VerdiTactics.
+Require Import Crypto.Util.ZUtil.
+Require Import Crypto.Util.Tuple.
+Require Import Crypto.Util.Tactics.
+Require Import Crypto.Util.LetIn.
+Require Import Crypto.Util.Notations.
+Require Import Crypto.Util.Decidable.
+Require Import Crypto.Util.HList.
+Require Import Crypto.Util.Tuple.
+Require Import Crypto.Algebra.
+Import ListNotations.
+Require Import Coq.ZArith.ZArith Coq.ZArith.Zpower Coq.ZArith.ZArith Coq.ZArith.Znumtheory.
+Local Open Scope Z.
+
+(* BEGIN common curve-specific definitions *)
+Definition bit_width : nat := Eval compute in Z.to_nat (GF25519_64.int_width).
+Local Notation b_of exp := (0, 2^exp + 2^(exp-3))%Z (only parsing). (* max is [(0, 2^(exp+2) + 2^exp + 2^(exp-1) + 2^(exp-3) + 2^(exp-4) + 2^(exp-5) + 2^(exp-6) + 2^(exp-10) + 2^(exp-12) + 2^(exp-13) + 2^(exp-14) + 2^(exp-15) + 2^(exp-17) + 2^(exp-23) + 2^(exp-24))%Z] *)
+Definition bounds_exp : tuple Z length_fe25519_64
+  := Eval compute in
+      Tuple.from_list length_fe25519_64 limb_widths eq_refl.
+Definition bounds : tuple (Z * Z) length_fe25519_64
+  := Eval compute in
+      Tuple.map (fun e => b_of e) bounds_exp.
+Definition wire_digit_bounds_exp : tuple Z (length wire_widths)
+  := Eval compute in Tuple.from_list _ wire_widths eq_refl.
+Definition wire_digit_bounds : tuple (Z * Z) (length wire_widths)
+  := Eval compute in Tuple.map (fun e => (0,2^e-1)%Z) wire_digit_bounds_exp.
+(* END common curve-specific definitions *)
+
+(* BEGIN aliases for word extraction *)
+Definition word64 := Word.word bit_width.
+Coercion word64ToZ (x : word64) : Z := Z.of_N (wordToN x).
+Coercion ZToWord64 (x : Z) : word64 := NToWord _ (Z.to_N x).
+Definition NToWord64 : N -> word64 := NToWord _.
+Definition word64ize (x : word64) : word64
+  := Eval cbv [wordToN N.succ_double N.double] in NToWord64 (wordToN x).
+Definition w64eqb (x y : word64) := weqb x y.
+
+Global Arguments NToWord64 : simpl never.
+Arguments word64 : simpl never.
+Arguments bit_width : simpl never.
+Global Opaque word64.
+Global Opaque bit_width.
+
+(* END aliases for word extraction *)
+
+(* BEGIN basic types *)
+Module Type WordIsBounded.
+  Parameter is_boundedT : forall (lower upper : Z), word64 -> bool.
+  Parameter Build_is_boundedT : forall {lower upper} {proj_word : word64},
+      andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true -> is_boundedT lower upper proj_word = true.
+  Parameter project_is_boundedT : forall {lower upper} {proj_word : word64},
+      is_boundedT lower upper proj_word = true -> andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true.
+End WordIsBounded.
+
+Module Import WordIsBoundedDefault : WordIsBounded.
+  Definition is_boundedT : forall (lower upper : Z), word64 -> bool
+    := fun lower upper proj_word => andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z.
+  Definition Build_is_boundedT {lower upper} {proj_word : word64}
+    : andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true -> is_boundedT lower upper proj_word = true
+    := fun x => x.
+  Definition project_is_boundedT {lower upper} {proj_word : word64}
+    : is_boundedT lower upper proj_word = true -> andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true
+    := fun x => x.
+End WordIsBoundedDefault.
+
+Definition bounded_word (lower upper : Z)
+  := { proj_word : word64 | is_boundedT lower upper proj_word = true }.
+Local Notation word_of exp := (bounded_word (fst (b_of exp)) (snd (b_of exp))).
+Local Notation unbounded_word sz := (bounded_word 0 (2^sz-1)%Z).
+
+Local Opaque word64.
+Definition fe25519_64W := Eval cbv (*-[word64]*) in (tuple word64 length_fe25519_64).
+Definition wire_digitsW := Eval cbv (*-[word64]*) in (tuple word64 (length wire_widths)).
+Definition fe25519_64 :=
+  Eval cbv -[bounded_word Z.pow Z.sub Z.add] in
+    hlist (fun e => word_of e) bounds_exp.
+Definition wire_digits :=
+  Eval cbv -[bounded_word Z.pow Z.sub Z.add] in
+    hlist (fun e => unbounded_word e) wire_digit_bounds_exp.
+
+Definition is_bounded_gen {n} (x : tuple Z n) (bounds : tuple (Z * Z) n) : bool
+  := let res := Tuple.map2
+                  (fun bounds v =>
+                     let '(lower, upper) := bounds in
+                     (lower <=? v) && (v <=? upper))%bool%Z
+                  bounds x in
+     List.fold_right andb true (Tuple.to_list _ res).
+
+Definition is_bounded (x : SpecificGen.GF25519_64.fe25519_64) : bool
+  := is_bounded_gen (n:=length_fe25519_64) x bounds.
+
+Definition wire_digits_is_bounded (x : SpecificGen.GF25519_64.wire_digits) : bool
+  := is_bounded_gen (n:=length wire_widths) x wire_digit_bounds.
+
+(* END basic types *)
+
+Section generic_destructuring.
+  Fixpoint app_on' A n : forall T (f : tuple' A n) (P : forall x : tuple' A n, T x), T f
+    := match n return forall T (f : tuple' A n) (P : forall x : tuple' A n, T x), T f with
+       | O => fun T v P => P v
+       | S n' => fun T v P => let '(v, x) := v in app_on' A n' _ v (fun v => P (v, x))
+       end.
+  Definition app_on {A n} : forall {T} (f : tuple A n) (P : forall x : tuple A n, T x), T f
+    := match n return forall T (f : tuple A n) (P : forall x : tuple A n, T x), T f with
+       | O => fun T v P => P v
+       | S n' => @app_on' A n'
+       end.
+  Lemma app_on'_correct {A n T} f (P : forall x : tuple' A n, T x) : app_on' A n T f P = P f.
+  Proof.
+    induction n; simpl in *; destruct_head' prod; [ reflexivity | exact (IHn _ _ (fun t => P (t, _))) ].
+  Qed.
+  Lemma app_on_correct {A n T} f (P : forall x : tuple A n, T x) : app_on f P = P f.
+  Proof. destruct n; [ reflexivity | apply app_on'_correct ]. Qed.
+
+  Fixpoint app_on_h' A F n : forall ts T (f : @hlist' A n F ts) (P : forall x : @hlist' A n F ts, T x), T f
+    := match n return forall ts T (f : @hlist' A n F ts) (P : forall x : @hlist' A n F ts, T x), T f with
+       | O => fun ts T v P => P v
+       | S n' => fun ts T v P => let '(v, x) := v in app_on_h' A F n' _ _ v (fun v => P (v, x))
+       end.
+  Definition app_on_h {A F n} : forall ts T (f : @hlist A n F ts) (P : forall x : @hlist A n F ts, T x), T f
+    := match n return forall ts T (f : @hlist A n F ts) (P : forall x : @hlist A n F ts, T x), T f with
+       | O => fun ts T v P => P v
+       | S n' => @app_on_h' A F n'
+       end.
+  Lemma app_on_h'_correct {A F n ts T} f P : @app_on_h' A F n ts T f P = P f.
+  Proof.
+    induction n; simpl in *; destruct_head' prod; [ reflexivity | exact (IHn _ _ _ (fun h => P (h, f))) ].
+  Qed.
+  Lemma app_on_h_correct {A} F {n} ts {T} f P : @app_on_h A F n ts T f P = P f.
+  Proof. destruct n; [ reflexivity | apply app_on_h'_correct ]. Qed.
+
+  Definition app_wire_digitsW_dep {A T} (P : forall x : tuple A (length wire_widths), T x)
+    : forall (f : tuple A (length wire_widths)), T f
+    := Eval compute in fun f => @app_on A (length wire_widths) T f P.
+  Definition app_wire_digitsW {A T} (f : tuple A (length wire_widths)) (P : tuple A (length wire_widths) -> T)
+    := Eval compute in @app_wire_digitsW_dep A (fun _ => T) P f.
+  Definition app_fe25519_64W_dep {A T} (P : forall x : tuple A length_fe25519_64, T x)
+    : forall (f : tuple A length_fe25519_64), T f
+    := Eval compute in fun f => @app_on A length_fe25519_64 T f P.
+  Definition app_fe25519_64W {A T} (f : tuple A length_fe25519_64) (P : tuple A length_fe25519_64 -> T)
+    := Eval compute in @app_fe25519_64W_dep A (fun _ => T) P f.
+  Definition app_fe25519_64_dep {T} (P : forall x : fe25519_64, T x)
+    : forall f : fe25519_64, T f
+    := Eval compute in fun f => @app_on_h _ (fun e => word_of e) length_fe25519_64 bounds_exp T f P.
+  Definition app_fe25519_64 {T} (f : fe25519_64) (P : hlist (fun e => word_of e) bounds_exp -> T)
+    := Eval compute in @app_fe25519_64_dep (fun _ => T) P f.
+  Definition app_wire_digits_dep {T} (P : forall x : wire_digits, T x)
+    : forall f : wire_digits, T f
+    := Eval compute in fun f => @app_on_h _ (fun e => unbounded_word e) (length wire_widths) wire_digit_bounds_exp T f P.
+  Definition app_wire_digits {T} (f : wire_digits) (P : hlist (fun e => unbounded_word e) wire_digit_bounds_exp -> T)
+    := Eval compute in @app_wire_digits_dep (fun _ => T) P f.
+
+  Definition app_wire_digitsW_dep_correct {A T} f P : @app_wire_digitsW_dep A T P f = P f
+    := app_on_correct f P.
+  Definition app_wire_digitsW_correct {A T} f P : @app_wire_digitsW A T f P = P f
+    := @app_wire_digitsW_dep_correct A (fun _ => T) f P.
+  Definition app_fe25519_64W_dep_correct {A T} f P : @app_fe25519_64W_dep A T P f = P f
+    := app_on_correct f P.
+  Definition app_fe25519_64W_correct {A T} f P : @app_fe25519_64W A T f P = P f
+    := @app_fe25519_64W_dep_correct A (fun _ => T) f P.
+  Definition app_fe25519_64_dep_correct {T} f P : @app_fe25519_64_dep T P f = P f
+    := app_on_h_correct (fun e => word_of e) bounds_exp f P.
+  Definition app_fe25519_64_correct {T} f P : @app_fe25519_64 T f P = P f
+    := @app_fe25519_64_dep_correct (fun _ => T) f P.
+  Definition app_wire_digits_dep_correct {T} f P : @app_wire_digits_dep T P f = P f
+    := app_on_h_correct (fun e => unbounded_word e) wire_digit_bounds_exp f P.
+  Definition app_wire_digits_correct {T} f P : @app_wire_digits T f P = P f
+    := @app_wire_digits_dep_correct (fun _ => T) f P.
+
+  Definition appify2 {T} (op : fe25519_64W -> fe25519_64W -> T) (f g : fe25519_64W) :=
+    app_fe25519_64W f (fun f0 => (app_fe25519_64W g (fun g0 => op f0 g0))).
+
+  Lemma appify2_correct : forall {T} op f g, @appify2 T op f g = op f g.
+  Proof.
+    intros. cbv [appify2].
+    etransitivity; apply app_fe25519_64W_correct.
+  Qed.
+End generic_destructuring.
+
+Definition eta_fe25519_64W_sig (x : fe25519_64W) : { v : fe25519_64W | v = x }.
+Proof.
+  eexists; symmetry.
+  repeat (etransitivity; [ apply surjective_pairing | apply f_equal2 ]); reflexivity.
+Defined.
+Definition eta_fe25519_64W (x : fe25519_64W) : fe25519_64W
+  := Eval cbv [proj1_sig eta_fe25519_64W_sig] in proj1_sig (eta_fe25519_64W_sig x).
+Definition eta_wire_digitsW_sig (x : wire_digitsW) : { v : wire_digitsW | v = x }.
+Proof.
+  eexists; symmetry.
+  repeat (etransitivity; [ apply surjective_pairing | apply f_equal2 ]); reflexivity.
+Defined.
+Definition eta_wire_digitsW (x : wire_digitsW) : wire_digitsW
+  := Eval cbv [proj1_sig eta_wire_digitsW_sig] in proj1_sig (eta_wire_digitsW_sig x).
+
+Local Transparent word64.
+Lemma word64ize_id x : word64ize x = x.
+Proof. apply NToWord_wordToN. Qed.
+Local Opaque word64.
+
+Lemma word64eqb_Zeqb x y : (word64ToZ x =? word64ToZ y)%Z = w64eqb x y.
+Proof. apply wordeqb_Zeqb. Qed.
+
+Local Arguments Z.pow_pos !_ !_ / .
+Lemma word64ToZ_ZToWord64 x : 0 <= x < 2^Z.of_nat bit_width -> word64ToZ (ZToWord64 x) = x.
+Proof.
+  intros; unfold word64ToZ, ZToWord64.
+  rewrite wordToN_NToWord_idempotent, Z2N.id
+    by (omega || apply N2Z.inj_lt; rewrite <- ?(N_nat_Z (Npow2 _)), ?Npow2_nat, ?Zpow_pow2, ?N2Z.id, ?Z2N.id, ?Z2Nat.id by omega; omega).
+  reflexivity.
+Qed.
+Lemma ZToWord64_word64ToZ x : ZToWord64 (word64ToZ x) = x.
+Proof.
+  intros; unfold word64ToZ, ZToWord64.
+  rewrite N2Z.id, NToWord_wordToN; reflexivity.
+Qed.
+
+(* BEGIN precomputation. *)
+
+Definition proj_word {lower upper} (v : bounded_word lower upper) := Eval cbv [proj1_sig] in proj1_sig v.
+Definition word_bounded {lower upper} (v : bounded_word lower upper)
+  : andb (lower <=? proj_word v)%Z (proj_word v <=? upper)%Z = true
+  := project_is_boundedT (proj2_sig v).
+Definition Build_bounded_word' {lower upper} proj_word word_bounded : bounded_word lower upper
+  := exist _ proj_word (Build_is_boundedT word_bounded).
+Arguments proj_word {_ _} _.
+Arguments word_bounded {_ _} _.
+Arguments Build_bounded_word' {_ _} _ _.
+Definition Build_bounded_word {lower upper} (proj_word : word64) (word_bounded : andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true)
+  : bounded_word lower upper
+  := Build_bounded_word'
+       proj_word
+       (match andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z as b return b = true -> b = true with
+        | true => fun _ => eq_refl
+        | false => fun x => x
+        end word_bounded).
+Lemma word_to_unbounded_helper {x e : nat} : (x < pow2 e)%nat -> (Z.of_nat e <= Z.of_nat bit_width)%Z -> ((0 <=? word64ToZ (ZToWord64 (Z.of_nat x))) && (word64ToZ (ZToWord64 (Z.of_nat x)) <=? 2 ^ (Z.of_nat e) - 1))%bool = true.
+Proof.
+  rewrite pow2_id; intro H; apply Nat2Z.inj_lt in H; revert H.
+  rewrite Z.pow_Zpow; simpl Z.of_nat.
+  intros H H'.
+  assert (2^Z.of_nat e <= 2^Z.of_nat bit_width) by auto with zarith.
+  rewrite ?word64ToZ_ZToWord64 by omega.
+  match goal with
+  | [ |- context[andb ?x ?y] ]
+    => destruct x eqn:?, y eqn:?; try reflexivity; Z.ltb_to_lt
+  end;
+    intros; omega.
+Qed.
+Definition word_to_unbounded_word {sz} (x : word sz) : (Z.of_nat sz <=? Z.of_nat bit_width)%Z = true -> unbounded_word (Z.of_nat sz).
+Proof.
+  refine (fun pf => Build_bounded_word (Z.of_N (wordToN x)) _).
+  abstract (rewrite wordToN_nat, nat_N_Z; Z.ltb_to_lt; apply (word_to_unbounded_helper (wordToNat_bound x)); simpl; omega).
+Defined.
+Definition word32_to_unbounded_word (x : word 32) : unbounded_word 32.
+Proof. apply (word_to_unbounded_word x); reflexivity. Defined.
+Definition word31_to_unbounded_word (x : word 31) : unbounded_word 31.
+Proof. apply (word_to_unbounded_word x); reflexivity. Defined.
+
+Local Opaque word64.
+Declare Reduction app_tuple_map := cbv [app_wire_digitsW app_fe25519_64W app_fe25519_64 HList.mapt HList.mapt' Tuple.map on_tuple List.map List.app length_fe25519_64 List.length wire_widths Tuple.from_list Tuple.from_list' Tuple.to_list Tuple.to_list' fst snd].
+Definition fe25519_64WToZ (x : fe25519_64W) : SpecificGen.GF25519_64.fe25519_64
+  := Eval app_tuple_map in
+      app_fe25519_64W x (Tuple.map (fun v : word64 => v : Z)).
+Definition fe25519_64ZToW (x : SpecificGen.GF25519_64.fe25519_64) : fe25519_64W
+  := Eval app_tuple_map in
+      app_fe25519_64W x (Tuple.map (fun v : Z => v : word64)).
+Definition wire_digitsWToZ (x : wire_digitsW) : SpecificGen.GF25519_64.wire_digits
+  := Eval app_tuple_map in
+      app_wire_digitsW x (Tuple.map (fun v : word64 => v : Z)).
+Definition wire_digitsZToW (x : SpecificGen.GF25519_64.wire_digits) : wire_digitsW
+  := Eval app_tuple_map in
+      app_wire_digitsW x (Tuple.map (fun v : Z => v : word64)).
+Definition fe25519_64W_word64ize (x : fe25519_64W) : fe25519_64W
+  := Eval app_tuple_map in
+      app_fe25519_64W x (Tuple.map word64ize).
+Definition wire_digitsW_word64ize (x : wire_digitsW) : wire_digitsW
+  := Eval app_tuple_map in
+      app_wire_digitsW x (Tuple.map word64ize).
+
+(** TODO: Turn this into a lemma to speed up proofs *)
+Ltac unfold_is_bounded_in H :=
+  unfold is_bounded, wire_digits_is_bounded, is_bounded_gen, fe25519_64WToZ, wire_digitsWToZ in H;
+  cbv [to_list length bounds wire_digit_bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map fold_right List.rev List.app length_fe25519_64 List.length wire_widths] in H;
+  rewrite ?Bool.andb_true_iff in H.
+
+Ltac unfold_is_bounded :=
+  unfold is_bounded, wire_digits_is_bounded, is_bounded_gen, fe25519_64WToZ, wire_digitsWToZ;
+  cbv [to_list length bounds wire_digit_bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map fold_right List.rev List.app length_fe25519_64 List.length wire_widths];
+  rewrite ?Bool.andb_true_iff.
+
+Local Transparent bit_width.
+Definition Pow2_64 := Eval compute in 2^Z.of_nat bit_width.
+Definition unfold_Pow2_64 : 2^Z.of_nat bit_width = Pow2_64 := eq_refl.
+Local Opaque bit_width.
+
+Local Ltac prove_lt_bit_width :=
+  rewrite unfold_Pow2_64; cbv [Pow2_64]; omega.
+
+Lemma fe25519_64ZToW_WToZ (x : fe25519_64W) : fe25519_64ZToW (fe25519_64WToZ x) = x.
+Proof.
+  hnf in x; destruct_head' prod; cbv [fe25519_64WToZ fe25519_64ZToW].
+  rewrite !ZToWord64_word64ToZ; reflexivity.
+Qed.
+
+Lemma fe25519_64WToZ_ZToW x : is_bounded x = true -> fe25519_64WToZ (fe25519_64ZToW x) = x.
+Proof.
+  hnf in x; destruct_head' prod; cbv [fe25519_64WToZ fe25519_64ZToW].
+  intro H.
+  unfold_is_bounded_in H; destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite !word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Lemma fe25519_64W_word64ize_id x : fe25519_64W_word64ize x = x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [fe25519_64W_word64ize];
+    repeat apply f_equal2; apply word64ize_id.
+Qed.
+Lemma wire_digitsW_word64ize_id x : wire_digitsW_word64ize x = x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [wire_digitsW_word64ize];
+    repeat apply f_equal2; apply word64ize_id.
+Qed.
+
+Definition uncurry_unop_fe25519_64W {T} (op : fe25519_64W -> T)
+  := Eval cbv (*-[word64]*) in Tuple.uncurry (n:=length_fe25519_64) op.
+Definition curry_unop_fe25519_64W {T} op : fe25519_64W -> T
+  := Eval cbv (*-[word64]*) in fun f => app_fe25519_64W f (Tuple.curry (n:=length_fe25519_64) op).
+Definition uncurry_binop_fe25519_64W {T} (op : fe25519_64W -> fe25519_64W -> T)
+  := Eval cbv (*-[word64]*) in uncurry_unop_fe25519_64W (fun f => uncurry_unop_fe25519_64W (op f)).
+Definition curry_binop_fe25519_64W {T} op : fe25519_64W -> fe25519_64W -> T
+  := Eval cbv (*-[word64]*) in appify2 (fun f => curry_unop_fe25519_64W (curry_unop_fe25519_64W op f)).
+
+Definition uncurry_unop_wire_digitsW {T} (op : wire_digitsW -> T)
+  := Eval cbv (*-[word64]*) in Tuple.uncurry (n:=length wire_widths) op.
+Definition curry_unop_wire_digitsW {T} op : wire_digitsW -> T
+  := Eval cbv (*-[word64]*) in fun f => app_wire_digitsW f (Tuple.curry (n:=length wire_widths) op).
+
+
+Definition proj1_fe25519_64W (x : fe25519_64) : fe25519_64W
+  := Eval app_tuple_map in
+      app_fe25519_64 x (HList.mapt (fun _ => (@proj_word _ _))).
+Coercion proj1_fe25519_64 (x : fe25519_64) : SpecificGen.GF25519_64.fe25519_64
+  := fe25519_64WToZ (proj1_fe25519_64W x).
+
+Lemma is_bounded_proj1_fe25519_64 (x : fe25519_64) : is_bounded (proj1_fe25519_64 x) = true.
+Proof.
+  revert x; refine (app_fe25519_64_dep _); intro x.
+  hnf in x; destruct_head' prod; destruct_head' bounded_word.
+  cbv [is_bounded proj1_fe25519_64 proj1_fe25519_64W fe25519_64WToZ to_list length bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map List.rev List.app proj_word length_fe25519_64 is_bounded_gen].
+  apply fold_right_andb_true_iff_fold_right_and_True.
+  cbv [fold_right List.map].
+  cbv beta in *.
+  repeat split; auto using project_is_boundedT.
+Qed.
+
+Definition proj1_wire_digitsW (x : wire_digits) : wire_digitsW
+  := app_wire_digits x (HList.mapt (fun _ => proj_word)).
+Coercion proj1_wire_digits (x : wire_digits) : SpecificGen.GF25519_64.wire_digits
+  := wire_digitsWToZ (proj1_wire_digitsW x).
+
+Lemma is_bounded_proj1_wire_digits (x : wire_digits) : wire_digits_is_bounded (proj1_wire_digits x) = true.
+Proof.
+  revert x; refine (app_wire_digits_dep _); intro x.
+  hnf in x; destruct_head' prod; destruct_head' bounded_word.
+  cbv [wire_digits_is_bounded proj1_wire_digits proj1_wire_digitsW wire_digitsWToZ to_list length wire_digit_bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map List.rev List.app proj_word is_bounded_gen wire_widths HList.mapt HList.mapt' app_wire_digits fst snd].
+  apply fold_right_andb_true_iff_fold_right_and_True.
+  cbv [fold_right List.map].
+  cbv beta in *.
+  repeat split; auto using project_is_boundedT.
+Qed.
+
+Local Ltac make_exist_W' x app_W_dep :=
+  let H := fresh in
+  revert x; refine (@app_W_dep _ _ _); intros x H;
+  let x' := fresh in
+  set (x' := x);
+  cbv [tuple tuple' length_fe25519_64 List.length wire_widths] in x;
+  destruct_head' prod;
+  let rec do_refine v H :=
+      first [ let v' := (eval cbv [snd fst] in (snd v)) in
+              refine (_, Build_bounded_word v' _);
+              [ do_refine (fst v) (proj2 H) | subst x'; abstract exact (proj1 H) ]
+            | let v' := (eval cbv [snd fst] in v) in
+              refine (Build_bounded_word v' _); subst x'; abstract exact (proj1 H) ] in
+  let H' := constr:(proj1 (@fold_right_andb_true_iff_fold_right_and_True _) H) in
+  let T := type of H' in
+  let T := (eval cbv [id
+                        List.fold_right List.map List.length List.app ListUtil.map2 List.rev
+                        Tuple.to_list Tuple.to_list' Tuple.from_list Tuple.from_list' Tuple.map2 Tuple.on_tuple2
+                        fe25519_64 bounds fe25519_64WToZ length_fe25519_64
+                        wire_digits wire_digit_bounds wire_digitsWToZ wire_widths] in T) in
+  let H' := constr:(H' : T) in
+  let v := (eval unfold x' in x') in
+  do_refine v H'.
+Local Ltac make_exist'' x exist_W ZToW :=
+  let H := fresh in
+  intro H; apply (exist_W (ZToW x));
+  abstract (
+      hnf in x; destruct_head' prod;
+      let H' := fresh in
+      pose proof H as H';
+      unfold_is_bounded_in H;
+      destruct_head' and; simpl in *;
+      Z.ltb_to_lt;
+      rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width;
+      assumption
+    ).
+Local Ltac make_exist' x app_W_dep exist'' exist_W ZToW :=
+  let H := fresh in
+  revert x; refine (@app_W_dep _ _ _); intros x H;
+  let x' := fresh in
+  set (x' := x) in *;
+  cbv [tuple tuple' length_fe25519_64 List.length wire_widths] in x;
+  destruct_head' prod;
+  let rec do_refine v :=
+      first [ let v' := (eval cbv [exist_W ZToW exist'' proj_word Build_bounded_word Build_bounded_word' snd fst] in (proj_word v)) in
+              refine (Build_bounded_word v' _); subst x'; abstract exact (word_bounded v)
+            | let v' := (eval cbv [exist_W ZToW exist'' proj_word Build_bounded_word Build_bounded_word' snd fst] in (proj_word (snd v))) in
+              refine (_, Build_bounded_word v' _);
+              [ do_refine (fst v) | subst x'; abstract exact (word_bounded (snd v)) ] ] in
+  let v := (eval unfold x' in (exist'' x' H)) in
+  do_refine v.
+
+Definition exist_fe25519_64W' (x : fe25519_64W) : is_bounded (fe25519_64WToZ x) = true -> fe25519_64.
+Proof. make_exist_W' x (@app_fe25519_64W_dep). Defined.
+Definition exist_fe25519_64W (x : fe25519_64W) : is_bounded (fe25519_64WToZ x) = true -> fe25519_64
+  := Eval cbv [app_fe25519_64W_dep exist_fe25519_64W' fe25519_64ZToW] in exist_fe25519_64W' x.
+Definition exist_fe25519_64'' (x : SpecificGen.GF25519_64.fe25519_64) : is_bounded x = true -> fe25519_64.
+Proof. make_exist'' x exist_fe25519_64W fe25519_64ZToW. Defined.
+Definition exist_fe25519_64' (x : SpecificGen.GF25519_64.fe25519_64) : is_bounded x = true -> fe25519_64.
+Proof. make_exist' x (@app_fe25519_64W_dep) exist_fe25519_64'' exist_fe25519_64W fe25519_64ZToW. Defined.
+Definition exist_fe25519_64 (x : SpecificGen.GF25519_64.fe25519_64) : is_bounded x = true -> fe25519_64
+  := Eval cbv [exist_fe25519_64' exist_fe25519_64W exist_fe25519_64' app_fe25519_64 app_fe25519_64W_dep] in
+      exist_fe25519_64' x.
+
+Lemma proj1_fe25519_64_exist_fe25519_64W x pf : proj1_fe25519_64 (exist_fe25519_64W x pf) = fe25519_64WToZ x.
+Proof. now hnf in x; destruct_head' prod. Qed.
+Lemma proj1_fe25519_64W_exist_fe25519_64 x pf : proj1_fe25519_64W (exist_fe25519_64 x pf) = fe25519_64ZToW x.
+Proof. now hnf in x; destruct_head' prod. Qed.
+Lemma proj1_fe25519_64_exist_fe25519_64 x pf : proj1_fe25519_64 (exist_fe25519_64 x pf) = x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [proj1_fe25519_64 exist_fe25519_64 proj1_fe25519_64W fe25519_64WToZ proj_word Build_bounded_word Build_bounded_word'].
+  unfold_is_bounded_in pf.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Definition exist_wire_digitsW' (x : wire_digitsW)
+  : wire_digits_is_bounded (wire_digitsWToZ x) = true -> wire_digits.
+Proof. make_exist_W' x (@app_wire_digitsW_dep). Defined.
+Definition exist_wire_digitsW (x : wire_digitsW)
+  : wire_digits_is_bounded (wire_digitsWToZ x) = true -> wire_digits
+  := Eval cbv [app_wire_digitsW_dep exist_wire_digitsW' wire_digitsZToW] in exist_wire_digitsW' x.
+Definition exist_wire_digits'' (x : SpecificGen.GF25519_64.wire_digits)
+  : wire_digits_is_bounded x = true -> wire_digits.
+Proof. make_exist'' x exist_wire_digitsW wire_digitsZToW. Defined.
+Definition exist_wire_digits' (x : SpecificGen.GF25519_64.wire_digits)
+  : wire_digits_is_bounded x = true -> wire_digits.
+Proof. make_exist' x (@app_wire_digitsW_dep) exist_wire_digits'' exist_wire_digitsW wire_digitsZToW. Defined.
+Definition exist_wire_digits (x : SpecificGen.GF25519_64.wire_digits)
+  : wire_digits_is_bounded x = true -> wire_digits
+  := Eval cbv [exist_wire_digits' exist_wire_digitsW exist_wire_digits' app_wire_digits app_wire_digitsW_dep] in
+      exist_wire_digits' x.
+
+Lemma proj1_wire_digits_exist_wire_digitsW x pf : proj1_wire_digits (exist_wire_digitsW x pf) = wire_digitsWToZ x.
+Proof. now hnf in x; destruct_head' prod. Qed.
+Lemma proj1_wire_digitsW_exist_wire_digits x pf : proj1_wire_digitsW (exist_wire_digits x pf) = wire_digitsZToW x.
+Proof. now hnf in x; destruct_head' prod. Qed.
+Lemma proj1_wire_digits_exist_wire_digits x pf : proj1_wire_digits (exist_wire_digits x pf) = x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [proj1_wire_digits exist_wire_digits proj1_wire_digitsW wire_digitsWToZ proj_word Build_bounded_word Build_bounded_word' app_wire_digits HList.mapt HList.mapt' length wire_widths fst snd].
+  unfold_is_bounded_in pf.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Module opt.
+  Definition word64ToZ := Eval vm_compute in word64ToZ.
+  Definition word64ToN := Eval vm_compute in @wordToN bit_width.
+  Definition NToWord64 := Eval vm_compute in NToWord64.
+  Definition bit_width := Eval vm_compute in bit_width.
+  Definition Zleb := Eval cbv [Z.leb] in Z.leb.
+  Definition andb := Eval vm_compute in andb.
+  Definition word64ize := Eval vm_compute in word64ize.
+End opt.
+
+Local Transparent bit_width.
+Local Ltac do_change lem :=
+  match lem with
+  | context L[andb (?x <=? ?y)%Z (?y <=? ?z)]
+    => let x' := (eval vm_compute in x) in
+       let z' := (eval vm_compute in z) in
+       lazymatch y with
+       | word64ToZ (word64ize ?v)
+         => let y' := constr:(opt.word64ToZ (opt.word64ize v)) in
+            let L' := context L[andb (opt.Zleb x' y') (opt.Zleb y' z')] in
+            do_change L'
+       end
+  | _ => lem
+  end.
+Definition fe25519_64_word64ize (x : fe25519_64) : fe25519_64.
+Proof.
+  set (x' := x).
+  hnf in x; destruct_head' prod.
+  let lem := constr:(exist_fe25519_64W (fe25519_64W_word64ize (proj1_fe25519_64W x'))) in
+  let lem := (eval cbv [proj1_fe25519_64W x' fe25519_64W_word64ize proj_word exist_fe25519_64W Build_bounded_word' Build_bounded_word] in lem) in
+  let lem := do_change lem in
+  refine (lem _);
+    change (is_bounded (fe25519_64WToZ (fe25519_64W_word64ize (proj1_fe25519_64W x'))) = true);
+    abstract (rewrite fe25519_64W_word64ize_id; apply is_bounded_proj1_fe25519_64).
+Defined.
+Definition wire_digits_word64ize (x : wire_digits) : wire_digits.
+Proof.
+  set (x' := x).
+  hnf in x; destruct_head' prod.
+  let lem := constr:(exist_wire_digitsW (wire_digitsW_word64ize (proj1_wire_digitsW x'))) in
+  let lem := (eval cbv [proj1_wire_digitsW x' wire_digitsW_word64ize proj_word exist_wire_digitsW Build_bounded_word Build_bounded_word'] in lem) in
+  let lem := do_change lem in
+  let lem := (eval cbv [word64ize opt.word64ize andb Z.leb Z.compare CompOpp Pos.compare] in lem) in
+  refine (lem _);
+    change (wire_digits_is_bounded (wire_digitsWToZ (wire_digitsW_word64ize (proj1_wire_digitsW x'))) = true);
+    abstract (rewrite wire_digitsW_word64ize_id; apply is_bounded_proj1_wire_digits).
+Defined.
+
+Lemma is_bounded_to_nth_default x (H : is_bounded x = true)
+  : forall n : nat,
+    (n < length limb_widths)%nat
+    -> (0 <= nth_default 0 (Tuple.to_list length_fe25519_64 x) n <=
+        snd (b_of (nth_default (-1) limb_widths n)))%Z.
+Proof.
+  hnf in x; destruct_head' prod.
+  unfold_is_bounded_in H; destruct_head' and.
+  Z.ltb_to_lt.
+  unfold nth_default; simpl.
+  intros.
+  repeat match goal with
+         | [ |- context[nth_error _ ?x] ]
+           => is_var x; destruct x; simpl
+         end;
+    omega.
+Qed.
+
+(* END precomputation *)
+
+(* Precompute constants *)
+
+Definition one' := Eval vm_compute in exist_fe25519_64 SpecificGen.GF25519_64.one_ eq_refl.
+Definition one := Eval cbv [one' fe25519_64_word64ize word64ize andb opt.word64ToZ opt.word64ize opt.Zleb Z.compare CompOpp Pos.compare Pos.compare_cont] in fe25519_64_word64ize one'.
+
+Definition zero' := Eval vm_compute in exist_fe25519_64 SpecificGen.GF25519_64.zero_ eq_refl.
+Definition zero := Eval cbv [zero' fe25519_64_word64ize word64ize andb opt.word64ToZ opt.word64ize opt.Zleb Z.compare CompOpp Pos.compare Pos.compare_cont] in fe25519_64_word64ize zero'.
+
+Lemma fold_chain_opt_gen {A B} (F : A -> B) is_bounded ls id' op' id op chain
+      (Hid_bounded : is_bounded (F id') = true)
+      (Hid : id = F id')
+      (Hop_bounded : forall x y, is_bounded (F x) = true
+                                 -> is_bounded (F y) = true
+                                 -> is_bounded (op (F x) (F y)) = true)
+      (Hop : forall x y, is_bounded (F x) = true
+                         -> is_bounded (F y) = true
+                         -> op (F x) (F y) = F (op' x y))
+      (Hls_bounded : forall n, is_bounded (F (nth_default id' ls n)) = true)
+  : F (fold_chain_opt id' op' chain ls)
+    = fold_chain_opt id op chain (List.map F ls)
+    /\ is_bounded (F (fold_chain_opt id' op' chain ls)) = true.
+Proof.
+  rewrite !fold_chain_opt_correct.
+  revert dependent ls; induction chain as [|x xs IHxs]; intros.
+  { pose proof (Hls_bounded 0%nat).
+    destruct ls; simpl; split; trivial; congruence. }
+  { destruct x; simpl; unfold Let_In; simpl.
+    rewrite (fun ls pf => proj1 (IHxs ls pf)) at 1; simpl.
+    { do 2 f_equal.
+      rewrite <- Hop, Hid by auto.
+      rewrite !map_nth_default_always.
+      split; try reflexivity.
+      apply (IHxs (_::_)).
+      intros [|?]; autorewrite with simpl_nth_default; auto.
+      rewrite <- Hop; auto. }
+    { intros [|?]; simpl;
+        autorewrite with simpl_nth_default; auto.
+      rewrite <- Hop; auto. } }
+Qed.
+
+Lemma encode_bounded x : is_bounded (encode x) = true.
+Proof.
+  pose proof (bounded_encode x).
+  generalize dependent (encode x).
+  intro t; compute in t; intros.
+  destruct_head' prod.
+  unfold Pow2Base.bounded in H.
+  cbv [nth_default Tuple.to_list Tuple.to_list' List.length limb_widths params25519_64] in H.
+  repeat match type of H with
+         | context[nth_error (cons _ _) _]
+           => let H' := fresh in
+              pose proof (H O) as H'; specialize (fun i => H (S i)); simpl @nth_error in H, H';
+                cbv beta iota in H'
+         end.
+  clear H.
+  simpl in *.
+  cbv [Z.pow_pos Z.mul Pos.mul Pos.iter nth_default nth_error value] in *.
+  unfold is_bounded.
+  apply fold_right_andb_true_iff_fold_right_and_True.
+  cbv [is_bounded proj1_fe25519_64 to_list length bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map List.rev List.app proj_word fold_right length_fe25519_64].
+  repeat split; rewrite !Bool.andb_true_iff, !Z.leb_le; omega.
+Qed.
+
+Definition encode (x : F modulus) : fe25519_64
+  := exist_fe25519_64 (encode x) (encode_bounded x).
+
+Definition decode (x : fe25519_64) : F modulus
+  := ModularBaseSystem.decode (proj1_fe25519_64 x).
+
+Lemma proj1_fe25519_64_encode x
+  : proj1_fe25519_64 (encode x) = ModularBaseSystem.encode x.
+Proof.
+  cbv [encode].
+  generalize (encode_bounded x); generalize (ModularBaseSystem.encode x).
+  intros y pf; intros; hnf in y; destruct_head_hnf' prod.
+  cbv [proj1_fe25519_64 exist_fe25519_64 proj1_fe25519_64W Build_bounded_word Build_bounded_word' fe25519_64WToZ proj_word].
+  unfold_is_bounded_in pf.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Lemma decode_exist_fe25519_64 x pf
+  : decode (exist_fe25519_64 x pf) = ModularBaseSystem.decode x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [decode proj1_fe25519_64 exist_fe25519_64 proj1_fe25519_64W Build_bounded_word Build_bounded_word' fe25519_64WToZ proj_word].
+  unfold_is_bounded_in pf.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Definition div (f g : fe25519_64) : fe25519_64
+  := exist_fe25519_64 (div (proj1_fe25519_64 f) (proj1_fe25519_64 g)) (encode_bounded _).
+
+Definition eq (f g : fe25519_64) : Prop := eq (proj1_fe25519_64 f) (proj1_fe25519_64 g).
+
+
+Notation ibinop_correct_and_bounded irop op
+  := (forall x y,
+         is_bounded (fe25519_64WToZ x) = true
+         -> is_bounded (fe25519_64WToZ y) = true
+         -> fe25519_64WToZ (irop x y) = op (fe25519_64WToZ x) (fe25519_64WToZ y)
+            /\ is_bounded (fe25519_64WToZ (irop x y)) = true) (only parsing).
+Notation iunop_correct_and_bounded irop op
+  := (forall x,
+         is_bounded (fe25519_64WToZ x) = true
+         -> fe25519_64WToZ (irop x) = op (fe25519_64WToZ x)
+            /\ is_bounded (fe25519_64WToZ (irop x)) = true) (only parsing).
+Notation iunop_FEToZ_correct irop op
+  := (forall x,
+         is_bounded (fe25519_64WToZ x) = true
+         -> word64ToZ (irop x) = op (fe25519_64WToZ x)) (only parsing).
+Notation iunop_FEToWire_correct_and_bounded irop op
+  := (forall x,
+         is_bounded (fe25519_64WToZ x) = true
+         -> wire_digitsWToZ (irop x) = op (fe25519_64WToZ x)
+            /\ wire_digits_is_bounded (wire_digitsWToZ (irop x)) = true) (only parsing).
+Notation iunop_WireToFE_correct_and_bounded irop op
+  := (forall x,
+         wire_digits_is_bounded (wire_digitsWToZ x) = true
+         -> fe25519_64WToZ (irop x) = op (wire_digitsWToZ x)
+            /\ is_bounded (fe25519_64WToZ (irop x)) = true) (only parsing).
+
+Definition prefreeze := GF25519_64.prefreeze.
diff --git a/src/SpecificGen/GF25519_64Reflective.v b/src/SpecificGen/GF25519_64Reflective.v
new file mode 100644
index 000000000..095def252
--- /dev/null
+++ b/src/SpecificGen/GF25519_64Reflective.v
@@ -0,0 +1,119 @@
+Require Import Crypto.BaseSystem.
+Require Import Crypto.ModularArithmetic.PrimeFieldTheorems.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParams.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParamProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystem.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemOpt.
+Require Export Crypto.SpecificGen.GF25519_64.
+Require Import Crypto.SpecificGen.GF25519_64BoundedCommon.
+Require Import Crypto.Reflection.Reify.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Crypto.Reflection.Z.Interpretations.Relations.
+Require Import Crypto.Reflection.Z.Interpretations.RelationsCombinations.
+Require Import Crypto.Reflection.Z.Reify.
+Require Import Crypto.Reflection.Z.Syntax.
+Require Import Crypto.SpecificGen.GF25519_64Reflective.Common.
+Require Import Crypto.SpecificGen.GF25519_64Reflective.Reified.
+Require Import Bedrock.Word Crypto.Util.WordUtil.
+Require Import Coq.Lists.List Crypto.Util.ListUtil.
+Require Import Crypto.Tactics.VerdiTactics.
+Require Import Crypto.Util.ZUtil.
+Require Import Crypto.Util.Tuple.
+Require Import Crypto.Util.Tactics.
+Require Import Crypto.Util.LetIn.
+Require Import Crypto.Util.Notations.
+Require Import Crypto.Util.Bool.
+Require Import Crypto.Util.Decidable.
+Require Import Crypto.Algebra.
+Import ListNotations.
+Require Import Coq.ZArith.ZArith Coq.ZArith.Zpower Coq.ZArith.ZArith Coq.ZArith.Znumtheory.
+Local Open Scope Z.
+
+Definition radd : ExprBinOp := Eval vm_compute in rcarry_addW.
+Definition rsub : ExprBinOp := Eval vm_compute in rcarry_subW.
+Definition rmul : ExprBinOp := Eval vm_compute in rmulW.
+Definition ropp : ExprUnOp := Eval vm_compute in rcarry_oppW.
+Definition rprefreeze : ExprUnOp := Eval vm_compute in rprefreezeW.
+Definition rge_modulus : ExprUnOpFEToZ := Eval vm_compute in rge_modulusW.
+Definition rpack : ExprUnOpFEToWire := Eval vm_compute in rpackW.
+Definition runpack : ExprUnOpWireToFE := Eval vm_compute in runpackW.
+
+Definition rword64ize {t} (x : Expr t) : Expr t
+  := MapInterp (fun t => match t with TZ => word64ize end) x.
+
+Declare Reduction asm_interp
+  := cbv beta iota delta
+         [id
+            interp_bexpr interp_uexpr interp_uexpr_FEToWire interp_uexpr_FEToZ interp_uexpr_WireToFE
+            radd rsub rmul ropp rprefreeze rge_modulus rpack runpack
+            curry_binop_fe25519_64W curry_unop_fe25519_64W curry_unop_wire_digitsW
+            Word64.interp_op Word64.interp_base_type
+            Z.interp_op Z.interp_base_type
+            Z.Syntax.interp_op Z.Syntax.interp_base_type
+            mapf_interp_flat_type map_interp Word64.interp_base_type MapInterp mapf_interp word64ize rword64ize
+            Interp interp interp_flat_type interpf interp_flat_type fst snd].
+Ltac asm_interp
+  := cbv beta iota delta
+         [id
+            interp_bexpr interp_uexpr interp_uexpr_FEToWire interp_uexpr_FEToZ interp_uexpr_WireToFE
+            radd rsub rmul ropp rprefreeze rge_modulus rpack runpack
+            curry_binop_fe25519_64W curry_unop_fe25519_64W curry_unop_wire_digitsW
+            Word64.interp_op Word64.interp_base_type
+            Z.interp_op Z.interp_base_type
+            Z.Syntax.interp_op Z.Syntax.interp_base_type
+            mapf_interp_flat_type map_interp Word64.interp_base_type MapInterp mapf_interp word64ize rword64ize
+            Interp interp interp_flat_type interpf interp_flat_type fst snd].
+
+
+Definition interp_radd : SpecificGen.GF25519_64BoundedCommon.fe25519_64W -> SpecificGen.GF25519_64BoundedCommon.fe25519_64W -> SpecificGen.GF25519_64BoundedCommon.fe25519_64W
+  := Eval asm_interp in interp_bexpr (rword64ize radd).
+(*Print interp_radd.*)
+Definition interp_radd_correct : interp_radd = interp_bexpr radd := eq_refl.
+Definition interp_rsub : SpecificGen.GF25519_64BoundedCommon.fe25519_64W -> SpecificGen.GF25519_64BoundedCommon.fe25519_64W -> SpecificGen.GF25519_64BoundedCommon.fe25519_64W
+  := Eval asm_interp in interp_bexpr (rword64ize rsub).
+(*Print interp_rsub.*)
+Definition interp_rsub_correct : interp_rsub = interp_bexpr rsub := eq_refl.
+Definition interp_rmul : SpecificGen.GF25519_64BoundedCommon.fe25519_64W -> SpecificGen.GF25519_64BoundedCommon.fe25519_64W -> SpecificGen.GF25519_64BoundedCommon.fe25519_64W
+  := Eval asm_interp in interp_bexpr (rword64ize rmul).
+(*Print interp_rmul.*)
+Definition interp_rmul_correct : interp_rmul = interp_bexpr rmul := eq_refl.
+Definition interp_ropp : SpecificGen.GF25519_64BoundedCommon.fe25519_64W -> SpecificGen.GF25519_64BoundedCommon.fe25519_64W
+  := Eval asm_interp in interp_uexpr (rword64ize ropp).
+(*Print interp_ropp.*)
+Definition interp_ropp_correct : interp_ropp = interp_uexpr ropp := eq_refl.
+Definition interp_rprefreeze : SpecificGen.GF25519_64BoundedCommon.fe25519_64W -> SpecificGen.GF25519_64BoundedCommon.fe25519_64W
+  := Eval asm_interp in interp_uexpr (rword64ize rprefreeze).
+(*Print interp_rprefreeze.*)
+Definition interp_rprefreeze_correct : interp_rprefreeze = interp_uexpr rprefreeze := eq_refl.
+
+Definition interp_rge_modulus : SpecificGen.GF25519_64BoundedCommon.fe25519_64W -> SpecificGen.GF25519_64BoundedCommon.word64
+  := Eval asm_interp in interp_uexpr_FEToZ (rword64ize rge_modulus).
+Definition interp_rge_modulus_correct : interp_rge_modulus = interp_uexpr_FEToZ rge_modulus := eq_refl.
+
+Definition interp_rpack : SpecificGen.GF25519_64BoundedCommon.fe25519_64W -> SpecificGen.GF25519_64BoundedCommon.wire_digitsW
+  := Eval asm_interp in interp_uexpr_FEToWire (rword64ize rpack).
+Definition interp_rpack_correct : interp_rpack = interp_uexpr_FEToWire rpack := eq_refl.
+
+Definition interp_runpack : SpecificGen.GF25519_64BoundedCommon.wire_digitsW -> SpecificGen.GF25519_64BoundedCommon.fe25519_64W
+  := Eval asm_interp in interp_uexpr_WireToFE (rword64ize runpack).
+Definition interp_runpack_correct : interp_runpack = interp_uexpr_WireToFE runpack := eq_refl.
+
+Lemma radd_correct_and_bounded : binop_correct_and_bounded radd carry_add.
+Proof. exact rcarry_addW_correct_and_bounded. Qed.
+Lemma rsub_correct_and_bounded : binop_correct_and_bounded rsub carry_sub.
+Proof. exact rcarry_subW_correct_and_bounded. Qed.
+Lemma rmul_correct_and_bounded : binop_correct_and_bounded rmul mul.
+Proof. exact rmulW_correct_and_bounded. Qed.
+Lemma ropp_correct_and_bounded : unop_correct_and_bounded ropp carry_opp.
+Proof. exact rcarry_oppW_correct_and_bounded. Qed.
+Lemma rprefreeze_correct_and_bounded : unop_correct_and_bounded rprefreeze prefreeze.
+Proof. exact rprefreezeW_correct_and_bounded. Qed.
+Lemma rge_modulus_correct_and_bounded : unop_FEToZ_correct rge_modulus ge_modulus.
+Proof. exact rge_modulusW_correct_and_bounded. Qed.
+Lemma rpack_correct_and_bounded : unop_FEToWire_correct_and_bounded rpack pack.
+Proof. exact rpackW_correct_and_bounded. Qed.
+Lemma runpack_correct_and_bounded : unop_WireToFE_correct_and_bounded runpack unpack.
+Proof. exact runpackW_correct_and_bounded. Qed.
diff --git a/src/SpecificGen/GF25519_64Reflective/Common.v b/src/SpecificGen/GF25519_64Reflective/Common.v
new file mode 100644
index 000000000..444edcde4
--- /dev/null
+++ b/src/SpecificGen/GF25519_64Reflective/Common.v
@@ -0,0 +1,438 @@
+Require Export Coq.ZArith.ZArith.
+Require Export Coq.Strings.String.
+Require Export Crypto.SpecificGen.GF25519_64.
+Require Export Crypto.SpecificGen.GF25519_64BoundedCommon.
+Require Import Crypto.Reflection.Reify.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Crypto.Reflection.Z.Interpretations.Relations.
+Require Import Crypto.Reflection.Z.Interpretations.RelationsCombinations.
+Require Import Crypto.Reflection.Z.Reify.
+Require Export Crypto.Reflection.Z.Syntax.
+Require Import Crypto.Reflection.InterpWfRel.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Reflection.MapInterpWf.
+Require Import Crypto.Reflection.WfReflective.
+Require Import Crypto.Util.LetIn.
+Require Import Crypto.Util.ZUtil.
+Require Import Crypto.Util.Tactics.
+Require Import Crypto.Util.Notations.
+
+Notation Expr := (Expr base_type Word64.interp_base_type op).
+
+Local Ltac make_type_from uncurried_op :=
+  let T := (type of uncurried_op) in
+  let T := (eval compute in T) in
+  let rT := reify_type T in
+  exact rT.
+
+Definition ExprBinOpT : type base_type.
+Proof. make_type_from (uncurry_binop_fe25519_64 carry_add). Defined.
+Definition ExprUnOpT : type base_type.
+Proof. make_type_from (uncurry_unop_fe25519_64 carry_opp). Defined.
+Definition ExprUnOpFEToZT : type base_type.
+Proof. make_type_from (uncurry_unop_fe25519_64 ge_modulus). Defined.
+Definition ExprUnOpWireToFET : type base_type.
+Proof. make_type_from (uncurry_unop_wire_digits unpack). Defined.
+Definition ExprUnOpFEToWireT : type base_type.
+Proof. make_type_from (uncurry_unop_fe25519_64 pack). Defined.
+Definition ExprBinOp : Type := Expr ExprBinOpT.
+Definition ExprUnOp : Type := Expr ExprUnOpT.
+Definition ExprUnOpFEToZ : Type := Expr ExprUnOpFEToZT.
+Definition ExprUnOpWireToFE : Type := Expr ExprUnOpWireToFET.
+Definition ExprUnOpFEToWire : Type := Expr ExprUnOpFEToWireT.
+
+Local Ltac bounds_from_list ls :=
+  lazymatch (eval hnf in ls) with
+  | (?x :: nil)%list => constr:(Some {| ZBounds.lower := fst x ; ZBounds.upper := snd x |})
+  | (?x :: ?xs)%list => let bs := bounds_from_list xs in
+                        constr:((Some {| ZBounds.lower := fst x ; ZBounds.upper := snd x |}, bs))
+  end.
+
+Local Ltac make_bounds ls :=
+  compute;
+  let v := bounds_from_list (List.rev ls) in
+  let v := (eval compute in v) in
+  exact v.
+
+Definition ExprBinOp_bounds : interp_all_binders_for ExprBinOpT ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ bounds ++ Tuple.to_list _ bounds)%list. Defined.
+Definition ExprUnOp_bounds : interp_all_binders_for ExprUnOpT ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ bounds). Defined.
+Definition ExprUnOpFEToZ_bounds : interp_all_binders_for ExprUnOpFEToZT ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ bounds). Defined.
+Definition ExprUnOpFEToWire_bounds : interp_all_binders_for ExprUnOpFEToWireT ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ bounds). Defined.
+Definition ExprUnOpWireToFE_bounds : interp_all_binders_for ExprUnOpWireToFET ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ wire_digit_bounds). Defined.
+
+Definition interp_bexpr : ExprBinOp -> SpecificGen.GF25519_64BoundedCommon.fe25519_64W -> SpecificGen.GF25519_64BoundedCommon.fe25519_64W -> SpecificGen.GF25519_64BoundedCommon.fe25519_64W
+  := fun e => curry_binop_fe25519_64W (Interp (@Word64.interp_op) e).
+Definition interp_uexpr : ExprUnOp -> SpecificGen.GF25519_64BoundedCommon.fe25519_64W -> SpecificGen.GF25519_64BoundedCommon.fe25519_64W
+  := fun e => curry_unop_fe25519_64W (Interp (@Word64.interp_op) e).
+Definition interp_uexpr_FEToZ : ExprUnOpFEToZ -> SpecificGen.GF25519_64BoundedCommon.fe25519_64W -> SpecificGen.GF25519_64BoundedCommon.word64
+  := fun e => curry_unop_fe25519_64W (Interp (@Word64.interp_op) e).
+Definition interp_uexpr_FEToWire : ExprUnOpFEToWire -> SpecificGen.GF25519_64BoundedCommon.fe25519_64W -> SpecificGen.GF25519_64BoundedCommon.wire_digitsW
+  := fun e => curry_unop_fe25519_64W (Interp (@Word64.interp_op) e).
+Definition interp_uexpr_WireToFE : ExprUnOpWireToFE -> SpecificGen.GF25519_64BoundedCommon.wire_digitsW -> SpecificGen.GF25519_64BoundedCommon.fe25519_64W
+  := fun e => curry_unop_wire_digitsW (Interp (@Word64.interp_op) e).
+
+Notation binop_correct_and_bounded rop op
+  := (ibinop_correct_and_bounded (interp_bexpr rop) op) (only parsing).
+Notation unop_correct_and_bounded rop op
+  := (iunop_correct_and_bounded (interp_uexpr rop) op) (only parsing).
+Notation unop_FEToZ_correct rop op
+  := (iunop_FEToZ_correct (interp_uexpr_FEToZ rop) op) (only parsing).
+Notation unop_FEToWire_correct_and_bounded rop op
+  := (iunop_FEToWire_correct_and_bounded (interp_uexpr_FEToWire rop) op) (only parsing).
+Notation unop_WireToFE_correct_and_bounded rop op
+  := (iunop_WireToFE_correct_and_bounded (interp_uexpr_WireToFE rop) op) (only parsing).
+
+Ltac rexpr_cbv :=
+  lazymatch goal with
+  | [ |- { rexpr | interp_type_gen_rel_pointwise _ (Interp _ (t:=?T) rexpr) (?uncurry ?oper) } ]
+    => let operf := head oper in
+       let uncurryf := head uncurry in
+       try cbv delta [T]; try cbv delta [oper];
+       try cbv beta iota delta [uncurryf]
+  end;
+  cbv beta iota delta [interp_flat_type Z.interp_base_type interp_base_type zero_].
+
+Ltac reify_sig :=
+  rexpr_cbv; eexists; Reify_rhs; reflexivity.
+
+Local Notation rexpr_sig T uncurried_op :=
+  { rexprZ
+  | interp_type_gen_rel_pointwise (fun _ => Logic.eq) (Interp interp_op (t:=T) rexprZ) uncurried_op }
+    (only parsing).
+
+Notation rexpr_binop_sig op := (rexpr_sig ExprBinOpT (uncurry_binop_fe25519_64 op)) (only parsing).
+Notation rexpr_unop_sig op := (rexpr_sig ExprUnOpT (uncurry_unop_fe25519_64 op)) (only parsing).
+Notation rexpr_unop_FEToZ_sig op := (rexpr_sig ExprUnOpFEToZT (uncurry_unop_fe25519_64 op)) (only parsing).
+Notation rexpr_unop_FEToWire_sig op := (rexpr_sig ExprUnOpFEToWireT (uncurry_unop_fe25519_64 op)) (only parsing).
+Notation rexpr_unop_WireToFE_sig op := (rexpr_sig ExprUnOpWireToFET (uncurry_unop_wire_digits op)) (only parsing).
+
+Notation correct_and_bounded_genT ropW'v ropZ_sigv
+  := (let ropW' := ropW'v in
+      let ropZ_sig := ropZ_sigv in
+      let ropW := MapInterp (fun _ x => x) ropW' in
+      let ropZ := MapInterp Word64.to_Z ropW' in
+      let ropBounds := MapInterp ZBounds.of_word64 ropW' in
+      let ropBoundedWord64 := MapInterp BoundedWord64.of_word64 ropW' in
+      ropZ = proj1_sig ropZ_sig
+      /\ interp_type_rel_pointwise2 Relations.related_Z (Interp (@BoundedWord64.interp_op) ropBoundedWord64) (Interp (@Z.interp_op) ropZ)
+      /\ interp_type_rel_pointwise2 Relations.related_bounds (Interp (@BoundedWord64.interp_op) ropBoundedWord64) (Interp (@ZBounds.interp_op) ropBounds)
+      /\ interp_type_rel_pointwise2 Relations.related_word64 (Interp (@BoundedWord64.interp_op) ropBoundedWord64) (Interp (@Word64.interp_op) ropW))
+       (only parsing).
+
+Ltac app_tuples x y :=
+  let tx := type of x in
+  lazymatch (eval hnf in tx) with
+  | prod _ _ => let xs := app_tuples (snd x) y in
+                constr:((fst x, xs))
+  | _ => constr:((x, y))
+  end.
+
+Local Arguments Tuple.map2 : simpl never.
+Local Arguments Tuple.map : simpl never.
+
+Fixpoint args_to_bounded_helperT {n}
+         (v : Tuple.tuple' Word64.word64 n)
+         (bounds : Tuple.tuple' (Z * Z) n)
+         (pf : List.fold_right
+                 andb true
+                 (Tuple.to_list
+                    _
+                    (Tuple.map2
+                       (n:=S n)
+                       (fun bounds v =>
+                          let '(lower, upper) := bounds in ((lower <=? v)%Z && (v <=? upper)%Z)%bool)
+                       bounds
+                       (Tuple.map (n:=S n) Word64.word64ToZ v))) = true)
+         (res : Type)
+         {struct n}
+  : Type.
+Proof.
+  refine (match n return (forall (v : Tuple.tuple' _ n) (bounds : Tuple.tuple' _ n),
+                             List.fold_right
+                               _ _ (Tuple.to_list
+                                      _
+                                      (Tuple.map2 (n:=S n) _ bounds (Tuple.map (n:=S n) _ v))) = true
+                             -> Type)
+          with
+          | 0 => fun v' bounds' pf0 => forall pf1 : (0 <= fst bounds' /\ Z.log2 (snd bounds') < Z.of_nat Word64.bit_width)%Z, res
+          | S n' => fun v' bounds' pf0 => let t := _ in
+                                        forall pf1 : (0 <= fst (snd bounds') /\ Z.log2 (snd (snd bounds')) < Z.of_nat Word64.bit_width)%Z, @args_to_bounded_helperT n' (fst v') (fst bounds') t res
+          end v bounds pf).
+  { clear -pf0.
+    abstract (
+        destruct v', bounds'; simpl @fst;
+        rewrite Tuple.map_S in pf0;
+        simpl in pf0;
+        rewrite Tuple.map2_S in pf0;
+        simpl @List.fold_right in *;
+        rewrite Bool.andb_true_iff in pf0; tauto
+      ). }
+Defined.
+
+Fixpoint args_to_bounded_helper {n} res
+         {struct n}
+  : forall v bounds pf, (Tuple.tuple' BoundedWord64.BoundedWord n -> res) -> @args_to_bounded_helperT n v bounds pf res.
+Proof.
+  refine match n return (forall v bounds pf, (Tuple.tuple' BoundedWord64.BoundedWord n -> res) -> @args_to_bounded_helperT n v bounds pf res) with
+         | 0 => fun v bounds pf f pf' => f {| BoundedWord64.lower := fst bounds ; BoundedWord64.value := v ; BoundedWord64.upper := snd bounds |}
+         | S n'
+           => fun v bounds pf f pf'
+              => @args_to_bounded_helper
+                   n' res (fst v) (fst bounds) _
+                   (fun ts => f (ts, {| BoundedWord64.lower := fst (snd bounds) ; BoundedWord64.value := snd v ; BoundedWord64.upper := snd (snd bounds) |}))
+         end.
+  { clear -pf pf'.
+    unfold Tuple.map2, Tuple.map in pf; simpl in *.
+    abstract (
+        destruct bounds;
+        simpl in *;
+        rewrite !Bool.andb_true_iff in pf;
+        destruct_head' and;
+        Z.ltb_to_lt; auto
+      ). }
+  { simpl in *.
+    clear -pf pf'.
+    abstract (
+        destruct bounds as [? [? ?] ], v; simpl in *;
+        rewrite Tuple.map_S in pf; simpl in pf; rewrite Tuple.map2_S in pf;
+        simpl in pf;
+        rewrite !Bool.andb_true_iff in pf;
+        destruct_head' and;
+        Z.ltb_to_lt; auto
+      ). }
+Defined.
+
+Definition assoc_right''
+  := Eval cbv [Tuple.assoc_right' Tuple.rsnoc' fst snd] in @Tuple.assoc_right'.
+
+Definition args_to_bounded {n} v bounds pf
+  := Eval cbv [args_to_bounded_helper assoc_right''] in
+      @args_to_bounded_helper n _ v bounds pf (@assoc_right'' _ _).
+
+Local Ltac get_len T :=
+  match (eval hnf in T) with
+  | prod ?A ?B
+    => let a := get_len A in
+       let b := get_len B in
+       (eval compute in (a + b)%nat)
+  | _ => constr:(1%nat)
+  end.
+
+Local Ltac args_to_bounded x H :=
+  let x' := fresh in
+  set (x' := x);
+  compute in x;
+  let len := (let T := type of x in get_len T) in
+  destruct_head' prod;
+  let c := constr:(args_to_bounded (n:=pred len) x' _ H) in
+  let bounds := lazymatch c with args_to_bounded _ ?bounds _ => bounds end in
+  let c := (eval cbv [all_binders_for ExprUnOpT interp_flat_type args_to_bounded bounds pred fst snd] in c) in
+  apply c; compute; clear;
+  try abstract (
+        repeat split;
+        solve [ reflexivity
+              | refine (fun v => match v with eq_refl => I end) ]
+      ).
+
+Definition unop_args_to_bounded (x : fe25519_64W) (H : is_bounded (fe25519_64WToZ x) = true)
+  : interp_flat_type (fun _ => BoundedWord64.BoundedWord) (all_binders_for ExprUnOpT).
+Proof. args_to_bounded x H. Defined.
+
+Definition unopWireToFE_args_to_bounded (x : wire_digitsW) (H : wire_digits_is_bounded (wire_digitsWToZ x) = true)
+  : interp_flat_type (fun _ => BoundedWord64.BoundedWord) (all_binders_for ExprUnOpWireToFET).
+Proof. args_to_bounded x H. Defined.
+Definition binop_args_to_bounded (x : fe25519_64W * fe25519_64W)
+           (H : is_bounded (fe25519_64WToZ (fst x)) = true)
+           (H' : is_bounded (fe25519_64WToZ (snd x)) = true)
+  : interp_flat_type (fun _ => BoundedWord64.BoundedWord) (all_binders_for ExprBinOpT).
+Proof.
+  let v := app_tuples (unop_args_to_bounded (fst x) H) (unop_args_to_bounded (snd x) H') in
+  exact v.
+Defined.
+
+Ltac assoc_right_tuple x so_far :=
+  let t := type of x in
+  lazymatch (eval hnf in t) with
+  | prod _ _ => let so_far := assoc_right_tuple (snd x) so_far in
+                assoc_right_tuple (fst x) so_far
+  | _ => lazymatch so_far with
+         | @None => x
+         | _ => constr:((x, so_far))
+         end
+  end.
+
+Local Ltac make_bounds_prop bounds orig_bounds :=
+  let bounds' := fresh "bounds'" in
+  let bounds_bad := fresh "bounds_bad" in
+  rename bounds into bounds_bad;
+  let boundsv := assoc_right_tuple bounds_bad (@None) in
+  pose boundsv as bounds;
+  pose orig_bounds as bounds';
+  repeat (refine (match fst bounds' with
+                  | Some bounds' => let (l, u) := fst bounds in
+                                    let (l', u') := bounds' in
+                                    ((l' <=? l) && (u <=? u'))%Z%bool
+                  | None => false
+                  end && _)%bool;
+          destruct bounds' as [_ bounds'], bounds as [_ bounds]);
+  try exact (match bounds' with
+             | Some bounds' => let (l, u) := bounds in
+                               let (l', u') := bounds' in
+                               ((l' <=? l) && (u <=? u'))%Z%bool
+             | None => false
+             end).
+
+Definition unop_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprUnOpT)) : bool.
+Proof. make_bounds_prop bounds ExprUnOp_bounds. Defined.
+Definition binop_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprBinOpT)) : bool.
+Proof. make_bounds_prop bounds ExprUnOp_bounds. Defined.
+Definition unopFEToWire_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprUnOpFEToWireT)) : bool.
+Proof. make_bounds_prop bounds ExprUnOpWireToFE_bounds. Defined.
+Definition unopWireToFE_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprUnOpWireToFET)) : bool.
+Proof. make_bounds_prop bounds ExprUnOp_bounds. Defined.
+(* TODO FIXME(jgross?, andreser?): Is every function returning a single Z a boolean function? *)
+Definition unopFEToZ_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprUnOpFEToZT)) : bool.
+Proof.
+  refine (let (l, u) := bounds in ((0 <=? l) && (u <=? 1))%Z%bool).
+Defined.
+
+(* FIXME TODO(jgross): This is a horrible tactic.  We should unify the
+    various kinds of correct and boundedness, and abstract in Gallina
+    rather than Ltac *)
+
+Ltac t_correct_and_bounded ropZ_sig Hbounds H0 H1 args :=
+  let Heq := fresh "Heq" in
+  let Hbounds0 := fresh "Hbounds0" in
+  let Hbounds1 := fresh "Hbounds1" in
+  let Hbounds2 := fresh "Hbounds2" in
+  pose proof (proj2_sig ropZ_sig) as Heq;
+  cbv [interp_bexpr interp_uexpr interp_uexpr_FEToWire interp_uexpr_FEToZ interp_uexpr_WireToFE
+                    curry_binop_fe25519_64W curry_unop_fe25519_64W curry_unop_wire_digitsW
+                    curry_binop_fe25519_64 curry_unop_fe25519_64 curry_unop_wire_digits
+                    uncurry_binop_fe25519_64W uncurry_unop_fe25519_64W uncurry_unop_wire_digitsW
+                    uncurry_binop_fe25519_64 uncurry_unop_fe25519_64 uncurry_unop_wire_digits
+                    ExprBinOpT ExprUnOpFEToWireT ExprUnOpT ExprUnOpFEToZT ExprUnOpWireToFET
+                    interp_type_gen_rel_pointwise interp_type_gen_rel_pointwise] in *;
+  cbv zeta in *;
+  simpl @fe25519_64WToZ; simpl @wire_digitsWToZ;
+  rewrite <- Heq; clear Heq;
+  destruct Hbounds as [Heq Hbounds];
+  change interp_op with (@Z.interp_op) in *;
+  change interp_base_type with (@Z.interp_base_type) in *;
+  rewrite <- Heq; clear Heq;
+  destruct Hbounds as [ Hbounds0 [Hbounds1 Hbounds2] ];
+  pose proof (fun pf => Relations.uncurry_interp_type_rel_pointwise2_proj_from_option2 Word64.to_Z pf Hbounds2 Hbounds0) as Hbounds_left;
+  pose proof (fun pf => Relations.uncurry_interp_type_rel_pointwise2_proj1_from_option2 Relations.related_word64_boundsi' pf Hbounds1 Hbounds2) as Hbounds_right;
+  specialize_by repeat first [ progress intros
+                             | reflexivity
+                             | assumption
+                             | progress destruct_head' base_type
+                             | progress destruct_head' BoundedWord64.BoundedWord
+                             | progress destruct_head' and
+                             | progress repeat apply conj ];
+  specialize (Hbounds_left args H0);
+  specialize (Hbounds_right args H0);
+  cbv beta in *;
+  lazymatch type of Hbounds_right with
+  | match ?e with _ => _ end
+    => lazymatch type of H1 with
+       | match ?e' with _ => _ end
+         => change e' with e in H1; destruct e eqn:?; [ | exfalso; assumption ]
+       end
+  end;
+  repeat match goal with x := _ |- _ => subst x end;
+  cbv [id
+         binop_args_to_bounded unop_args_to_bounded unopWireToFE_args_to_bounded
+         Relations.proj_eq_rel interp_flat_type_rel_pointwise2 SmartVarfMap interp_flat_type smart_interp_flat_map Application.all_binders_for fst snd BoundedWord64.to_word64' BoundedWord64.boundedWordToWord64 BoundedWord64.value Application.ApplyInterpedAll Application.fst_binder Application.snd_binder interp_flat_type_rel_pointwise2_gen_Prop Relations.related_word64_boundsi' Relations.related'_word64_bounds ZBounds.upper ZBounds.lower Application.remove_all_binders Word64.to_Z] in Hbounds_left, Hbounds_right;
+  match goal with
+  | [ |- fe25519_64WToZ ?x = _ /\ _ ]
+    => destruct x; destruct_head_hnf' prod
+  | [ |- wire_digitsWToZ ?x = _ /\ _ ]
+    => destruct x; destruct_head_hnf' prod
+  | [ |- _ = _ ]
+    => exact Hbounds_left
+  end;
+  change word64ToZ with Word64.word64ToZ in *;
+  (split; [ exact Hbounds_left | ]);
+  cbv [interp_flat_type] in *;
+  cbv [fst snd
+           binop_bounds_good unop_bounds_good unopFEToWire_bounds_good unopWireToFE_bounds_good unopFEToZ_bounds_good
+           ExprUnOp_bounds ExprBinOp_bounds ExprUnOpFEToWire_bounds ExprUnOpFEToZ_bounds ExprUnOpWireToFE_bounds] in H1;
+  destruct_head' ZBounds.bounds;
+  unfold_is_bounded_in H1;
+  simpl @fe25519_64WToZ; simpl @wire_digitsWToZ;
+  unfold_is_bounded;
+  destruct_head' and;
+  Z.ltb_to_lt;
+  change Word64.word64ToZ with word64ToZ in *;
+  repeat apply conj; Z.ltb_to_lt; try omega; try reflexivity.
+
+
+Ltac rexpr_correct :=
+  let ropW' := fresh in
+  let ropZ_sig := fresh in
+  intros ropW' ropZ_sig;
+  let wf_ropW := fresh "wf_ropW" in
+  assert (wf_ropW : Wf ropW') by (subst ropW' ropZ_sig; reflect_Wf base_type_eq_semidec_is_dec op_beq_bl);
+  cbv zeta; repeat apply conj;
+  [ vm_compute; reflexivity
+  | apply @InterpRelWf;
+    [ | apply @RelWfMapInterp, wf_ropW ].. ];
+  auto with interp_related.
+
+Notation rword_of_Z rexprZ_sig := (MapInterp Word64.of_Z (proj1_sig rexprZ_sig)) (only parsing).
+
+Notation compute_bounds opW bounds
+  := (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp (@ZBounds.of_word64) opW)) bounds)
+       (only parsing).
+
+
+Module Export PrettyPrinting.
+  (* We add [enlargen] to force [bounds_on] to be in [Type] in 8.4 and
+     8.5/8.6.  Because [Set] is special and things break if
+     [bounds_on] ends up in [Set] for reasons jgross hasn't bothered
+     to debug. *)
+  Inductive bounds_on := overflow | in_range (lower upper : Z) | enlargen (_ : Set).
+
+  Inductive result := yes | no | borked.
+
+  Definition ZBounds_to_bounds_on
+    := fun t : base_type
+       => match t return ZBounds.interp_base_type t -> match t with TZ => bounds_on end with
+          | TZ => fun x => match x with
+                           | Some {| ZBounds.lower := l ; ZBounds.upper := u |}
+                             => in_range l u
+                           | None
+                             => overflow
+                           end
+          end.
+
+  Fixpoint does_it_overflow {t} : interp_flat_type (fun t => match t with TZ => bounds_on end) t -> result
+    := match t return interp_flat_type (fun t => match t with TZ => bounds_on end) t -> result with
+       | Tbase TZ => fun v => match v with
+                              | overflow => yes
+                              | in_range _ _ => no
+                              | enlargen _ => borked
+                              end
+       | Prod x y => fun v => match @does_it_overflow _ (fst v), @does_it_overflow _ (snd v) with
+                              | no, no => no
+                              | yes, no | no, yes | yes, yes => yes
+                              | borked, _ | _, borked => borked
+                              end
+       end.
+
+  (** This gives a slightly easier to read version of the bounds *)
+  Notation compute_bounds_for_display opW bounds
+    := (SmartVarfMap ZBounds_to_bounds_on (compute_bounds opW bounds)) (only parsing).
+  Notation sanity_compute opW bounds
+    := (does_it_overflow (SmartVarfMap ZBounds_to_bounds_on (compute_bounds opW bounds))) (only parsing).
+  Notation sanity_check opW bounds
+    := (eq_refl (sanity_compute opW bounds) <: no = no) (only parsing).
+End PrettyPrinting.
diff --git a/src/SpecificGen/GF25519_64Reflective/CommonBinOp.v b/src/SpecificGen/GF25519_64Reflective/CommonBinOp.v
new file mode 100644
index 000000000..cd4a5031b
--- /dev/null
+++ b/src/SpecificGen/GF25519_64Reflective/CommonBinOp.v
@@ -0,0 +1,50 @@
+Require Export Crypto.SpecificGen.GF25519_64Reflective.Common.
+Require Import Crypto.SpecificGen.GF25519_64BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprBinOp_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_binop_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall xy
+                   (xy := (eta_fe25519_64W (fst xy), eta_fe25519_64W (snd xy)))
+                   (Hxy : is_bounded (fe25519_64WToZ (fst xy)) = true
+                          /\ is_bounded (fe25519_64WToZ (snd xy)) = true),
+          let Hx := let (Hx, Hy) := Hxy in Hx in
+          let Hy := let (Hx, Hy) := Hxy in Hy in
+          let args := binop_args_to_bounded xy Hx Hy in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall xy
+                   (xy := (eta_fe25519_64W (fst xy), eta_fe25519_64W (snd xy)))
+                   (Hxy : is_bounded (fe25519_64WToZ (fst xy)) = true
+                          /\ is_bounded (fe25519_64WToZ (snd xy)) = true),
+          let Hx := let (Hx, Hy) := Hxy in Hx in
+          let Hy := let (Hx, Hy) := Hxy in Hy in
+          let args := binop_args_to_bounded (fst xy, snd xy) Hx Hy in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => binop_bounds_good bounds = true
+          | None => False
+          end)
+  : binop_correct_and_bounded (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x y Hx Hy.
+  pose x as x'; pose y as y'.
+  hnf in x, y; destruct_head' prod.
+  specialize (H0 (x', y') (conj Hx Hy)).
+  specialize (H1 (x', y') (conj Hx Hy)).
+  let args := constr:(binop_args_to_bounded (x', y') Hx Hy) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF25519_64Reflective/CommonUnOp.v b/src/SpecificGen/GF25519_64Reflective/CommonUnOp.v
new file mode 100644
index 000000000..bfc3c3cc1
--- /dev/null
+++ b/src/SpecificGen/GF25519_64Reflective/CommonUnOp.v
@@ -0,0 +1,44 @@
+Require Export Crypto.SpecificGen.GF25519_64Reflective.Common.
+Require Import Crypto.SpecificGen.GF25519_64BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprUnOp_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_unop_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall x
+                   (x := eta_fe25519_64W x)
+                   (Hx : is_bounded (fe25519_64WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall x
+                   (x := eta_fe25519_64W x)
+                   (Hx : is_bounded (fe25519_64WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => unop_bounds_good bounds = true
+          | None => False
+          end)
+  : unop_correct_and_bounded (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x Hx.
+  pose x as x'.
+  hnf in x; destruct_head' prod.
+  specialize (H0 x' Hx).
+  specialize (H1 x' Hx).
+  let args := constr:(unop_args_to_bounded x' Hx) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF25519_64Reflective/CommonUnOpFEToWire.v b/src/SpecificGen/GF25519_64Reflective/CommonUnOpFEToWire.v
new file mode 100644
index 000000000..f615067c6
--- /dev/null
+++ b/src/SpecificGen/GF25519_64Reflective/CommonUnOpFEToWire.v
@@ -0,0 +1,44 @@
+Require Export Crypto.SpecificGen.GF25519_64Reflective.Common.
+Require Import Crypto.SpecificGen.GF25519_64BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprUnOpFEToWire_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_unop_FEToWire_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall x
+                   (x := eta_fe25519_64W x)
+                   (Hx : is_bounded (fe25519_64WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall x
+                   (x := eta_fe25519_64W x)
+                   (Hx : is_bounded (fe25519_64WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => unopFEToWire_bounds_good bounds = true
+          | None => False
+          end)
+  : unop_FEToWire_correct_and_bounded (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x Hx.
+  pose x as x'.
+  hnf in x; destruct_head' prod.
+  specialize (H0 x' Hx).
+  specialize (H1 x' Hx).
+  let args := constr:(unop_args_to_bounded x' Hx) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF25519_64Reflective/CommonUnOpFEToZ.v b/src/SpecificGen/GF25519_64Reflective/CommonUnOpFEToZ.v
new file mode 100644
index 000000000..079a0729c
--- /dev/null
+++ b/src/SpecificGen/GF25519_64Reflective/CommonUnOpFEToZ.v
@@ -0,0 +1,44 @@
+Require Export Crypto.SpecificGen.GF25519_64Reflective.Common.
+Require Import Crypto.SpecificGen.GF25519_64BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprUnOpFEToZ_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_unop_FEToZ_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall x
+                   (x := eta_fe25519_64W x)
+                   (Hx : is_bounded (fe25519_64WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall x
+                   (x := eta_fe25519_64W x)
+                   (Hx : is_bounded (fe25519_64WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => unopFEToZ_bounds_good bounds = true
+          | None => False
+          end)
+  : unop_FEToZ_correct (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x Hx.
+  pose x as x'.
+  hnf in x; destruct_head' prod.
+  specialize (H0 x' Hx).
+  specialize (H1 x' Hx).
+  let args := constr:(unop_args_to_bounded x' Hx) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF25519_64Reflective/CommonUnOpWireToFE.v b/src/SpecificGen/GF25519_64Reflective/CommonUnOpWireToFE.v
new file mode 100644
index 000000000..c58f70e91
--- /dev/null
+++ b/src/SpecificGen/GF25519_64Reflective/CommonUnOpWireToFE.v
@@ -0,0 +1,44 @@
+Require Export Crypto.SpecificGen.GF25519_64Reflective.Common.
+Require Import Crypto.SpecificGen.GF25519_64BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprUnOpWireToFE_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_unop_WireToFE_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall x
+                   (x := eta_wire_digitsW x)
+                   (Hx : wire_digits_is_bounded (wire_digitsWToZ x) = true),
+          let args := unopWireToFE_args_to_bounded x Hx in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall x
+                   (x := eta_wire_digitsW x)
+                   (Hx : wire_digits_is_bounded (wire_digitsWToZ x) = true),
+          let args := unopWireToFE_args_to_bounded x Hx in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => unopWireToFE_bounds_good bounds = true
+          | None => False
+          end)
+  : unop_WireToFE_correct_and_bounded (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x Hx.
+  pose x as x'.
+  hnf in x; destruct_head' prod.
+  specialize (H0 x' Hx).
+  specialize (H1 x' Hx).
+  let args := constr:(unopWireToFE_args_to_bounded x' Hx) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF25519_64Reflective/Reified.v b/src/SpecificGen/GF25519_64Reflective/Reified.v
new file mode 100644
index 000000000..a5236884e
--- /dev/null
+++ b/src/SpecificGen/GF25519_64Reflective/Reified.v
@@ -0,0 +1,13 @@
+(** We split the reification up into separate files, one operation per
+    file, so that it can run in parallel. *)
+Require Export Crypto.SpecificGen.GF25519_64Reflective.Reified.Add.
+Require Export Crypto.SpecificGen.GF25519_64Reflective.Reified.CarryAdd.
+Require Export Crypto.SpecificGen.GF25519_64Reflective.Reified.Sub.
+Require Export Crypto.SpecificGen.GF25519_64Reflective.Reified.CarrySub.
+Require Export Crypto.SpecificGen.GF25519_64Reflective.Reified.Mul.
+Require Export Crypto.SpecificGen.GF25519_64Reflective.Reified.Opp.
+Require Export Crypto.SpecificGen.GF25519_64Reflective.Reified.CarryOpp.
+Require Export Crypto.SpecificGen.GF25519_64Reflective.Reified.PreFreeze.
+Require Export Crypto.SpecificGen.GF25519_64Reflective.Reified.GeModulus.
+Require Export Crypto.SpecificGen.GF25519_64Reflective.Reified.Pack.
+Require Export Crypto.SpecificGen.GF25519_64Reflective.Reified.Unpack.
diff --git a/src/SpecificGen/GF25519_64Reflective/Reified/Add.v b/src/SpecificGen/GF25519_64Reflective/Reified/Add.v
new file mode 100644
index 000000000..1adf81d96
--- /dev/null
+++ b/src/SpecificGen/GF25519_64Reflective/Reified/Add.v
@@ -0,0 +1,12 @@
+Require Import Crypto.SpecificGen.GF25519_64Reflective.CommonBinOp.
+
+Definition raddZ_sig : rexpr_binop_sig add. Proof. reify_sig. Defined.
+Definition raddW := Eval vm_compute in rword_of_Z raddZ_sig.
+Lemma raddW_correct_and_bounded_gen : correct_and_bounded_genT raddW raddZ_sig.
+Proof. rexpr_correct. Qed.
+Definition radd_output_bounds := Eval vm_compute in compute_bounds raddW ExprBinOp_bounds.
+
+Local Open Scope string_scope.
+Compute ("Add", compute_bounds_for_display raddW ExprBinOp_bounds).
+Compute ("Add overflows? ", sanity_compute raddW ExprBinOp_bounds).
+Compute ("Add overflows (error if it does)? ", sanity_check raddW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF25519_64Reflective/Reified/CarryAdd.v b/src/SpecificGen/GF25519_64Reflective/Reified/CarryAdd.v
new file mode 100644
index 000000000..3a6871acc
--- /dev/null
+++ b/src/SpecificGen/GF25519_64Reflective/Reified/CarryAdd.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF25519_64Reflective.CommonBinOp.
+
+Definition rcarry_addZ_sig : rexpr_binop_sig carry_add. Proof. reify_sig. Defined.
+Definition rcarry_addW := Eval vm_compute in rword_of_Z rcarry_addZ_sig.
+Lemma rcarry_addW_correct_and_bounded_gen : correct_and_bounded_genT rcarry_addW rcarry_addZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rcarry_add_output_bounds := Eval vm_compute in compute_bounds rcarry_addW ExprBinOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rcarry_addW_correct_and_bounded
+  := ExprBinOp_correct_and_bounded
+       rcarry_addW carry_add rcarry_addZ_sig rcarry_addW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Carry_Add", compute_bounds_for_display rcarry_addW ExprBinOp_bounds).
+Compute ("Carry_Add overflows? ", sanity_compute rcarry_addW ExprBinOp_bounds).
+Compute ("Carry_Add overflows (error if it does)? ", sanity_check rcarry_addW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF25519_64Reflective/Reified/CarryOpp.v b/src/SpecificGen/GF25519_64Reflective/Reified/CarryOpp.v
new file mode 100644
index 000000000..bd584ff2e
--- /dev/null
+++ b/src/SpecificGen/GF25519_64Reflective/Reified/CarryOpp.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF25519_64Reflective.CommonUnOp.
+
+Definition rcarry_oppZ_sig : rexpr_unop_sig carry_opp. Proof. reify_sig. Defined.
+Definition rcarry_oppW := Eval vm_compute in rword_of_Z rcarry_oppZ_sig.
+Lemma rcarry_oppW_correct_and_bounded_gen : correct_and_bounded_genT rcarry_oppW rcarry_oppZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rcarry_opp_output_bounds := Eval vm_compute in compute_bounds rcarry_oppW ExprUnOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rcarry_oppW_correct_and_bounded
+  := ExprUnOp_correct_and_bounded
+       rcarry_oppW carry_opp rcarry_oppZ_sig rcarry_oppW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Carry_Opp", compute_bounds_for_display rcarry_oppW ExprUnOp_bounds).
+Compute ("Carry_Opp overflows? ", sanity_compute rcarry_oppW ExprUnOp_bounds).
+Compute ("Carry_Opp overflows (error if it does)? ", sanity_check rcarry_oppW ExprUnOp_bounds).
diff --git a/src/SpecificGen/GF25519_64Reflective/Reified/CarrySub.v b/src/SpecificGen/GF25519_64Reflective/Reified/CarrySub.v
new file mode 100644
index 000000000..5b7bda4e9
--- /dev/null
+++ b/src/SpecificGen/GF25519_64Reflective/Reified/CarrySub.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF25519_64Reflective.CommonBinOp.
+
+Definition rcarry_subZ_sig : rexpr_binop_sig carry_sub. Proof. reify_sig. Defined.
+Definition rcarry_subW := Eval vm_compute in rword_of_Z rcarry_subZ_sig.
+Lemma rcarry_subW_correct_and_bounded_gen : correct_and_bounded_genT rcarry_subW rcarry_subZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rcarry_sub_output_bounds := Eval vm_compute in compute_bounds rcarry_subW ExprBinOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rcarry_subW_correct_and_bounded
+  := ExprBinOp_correct_and_bounded
+       rcarry_subW carry_sub rcarry_subZ_sig rcarry_subW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Carry_Sub", compute_bounds_for_display rcarry_subW ExprBinOp_bounds).
+Compute ("Carry_Sub overflows? ", sanity_compute rcarry_subW ExprBinOp_bounds).
+Compute ("Carry_Sub overflows (error if it does)? ", sanity_check rcarry_subW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF25519_64Reflective/Reified/GeModulus.v b/src/SpecificGen/GF25519_64Reflective/Reified/GeModulus.v
new file mode 100644
index 000000000..e755a2238
--- /dev/null
+++ b/src/SpecificGen/GF25519_64Reflective/Reified/GeModulus.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF25519_64Reflective.CommonUnOpFEToZ.
+
+Definition rge_modulusZ_sig : rexpr_unop_FEToZ_sig ge_modulus. Proof. reify_sig. Defined.
+Definition rge_modulusW := Eval vm_compute in rword_of_Z rge_modulusZ_sig.
+Lemma rge_modulusW_correct_and_bounded_gen : correct_and_bounded_genT rge_modulusW rge_modulusZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rge_modulus_output_bounds := Eval vm_compute in compute_bounds rge_modulusW ExprUnOpFEToZ_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rge_modulusW_correct_and_bounded
+  := ExprUnOpFEToZ_correct_and_bounded
+       rge_modulusW ge_modulus rge_modulusZ_sig rge_modulusW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Ge_Modulus", compute_bounds_for_display rge_modulusW ExprUnOpFEToZ_bounds).
+Compute ("Ge_Modulus overflows? ", sanity_compute rge_modulusW ExprUnOpFEToZ_bounds).
+Compute ("Ge_Modulus overflows (error if it does)? ", sanity_check rge_modulusW ExprUnOpFEToZ_bounds).
diff --git a/src/SpecificGen/GF25519_64Reflective/Reified/Mul.v b/src/SpecificGen/GF25519_64Reflective/Reified/Mul.v
new file mode 100644
index 000000000..ba589a18d
--- /dev/null
+++ b/src/SpecificGen/GF25519_64Reflective/Reified/Mul.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF25519_64Reflective.CommonBinOp.
+
+Definition rmulZ_sig : rexpr_binop_sig mul. Proof. reify_sig. Defined.
+Definition rmulW := Eval vm_compute in rword_of_Z rmulZ_sig.
+Lemma rmulW_correct_and_bounded_gen : correct_and_bounded_genT rmulW rmulZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rmul_output_bounds := Eval vm_compute in compute_bounds rmulW ExprBinOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rmulW_correct_and_bounded
+  := ExprBinOp_correct_and_bounded
+       rmulW mul rmulZ_sig rmulW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Mul", compute_bounds_for_display rmulW ExprBinOp_bounds).
+Compute ("Mul overflows? ", sanity_compute rmulW ExprBinOp_bounds).
+Compute ("Mul overflows (error if it does)? ", sanity_check rmulW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF25519_64Reflective/Reified/Opp.v b/src/SpecificGen/GF25519_64Reflective/Reified/Opp.v
new file mode 100644
index 000000000..6170329d5
--- /dev/null
+++ b/src/SpecificGen/GF25519_64Reflective/Reified/Opp.v
@@ -0,0 +1,12 @@
+Require Import Crypto.SpecificGen.GF25519_64Reflective.CommonUnOp.
+
+Definition roppZ_sig : rexpr_unop_sig opp. Proof. reify_sig. Defined.
+Definition roppW := Eval vm_compute in rword_of_Z roppZ_sig.
+Lemma roppW_correct_and_bounded_gen : correct_and_bounded_genT roppW roppZ_sig.
+Proof. rexpr_correct. Qed.
+Definition ropp_output_bounds := Eval vm_compute in compute_bounds roppW ExprUnOp_bounds.
+
+Local Open Scope string_scope.
+Compute ("Opp", compute_bounds_for_display roppW ExprUnOp_bounds).
+Compute ("Opp overflows? ", sanity_compute roppW ExprUnOp_bounds).
+Compute ("Opp overflows (error if it does)? ", sanity_check roppW ExprUnOp_bounds).
diff --git a/src/SpecificGen/GF25519_64Reflective/Reified/Pack.v b/src/SpecificGen/GF25519_64Reflective/Reified/Pack.v
new file mode 100644
index 000000000..c73b348ab
--- /dev/null
+++ b/src/SpecificGen/GF25519_64Reflective/Reified/Pack.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF25519_64Reflective.CommonUnOpFEToWire.
+
+Definition rpackZ_sig : rexpr_unop_FEToWire_sig pack. Proof. reify_sig. Defined.
+Definition rpackW := Eval vm_compute in rword_of_Z rpackZ_sig.
+Lemma rpackW_correct_and_bounded_gen : correct_and_bounded_genT rpackW rpackZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rpack_output_bounds := Eval vm_compute in compute_bounds rpackW ExprUnOpFEToWire_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rpackW_correct_and_bounded
+  := ExprUnOpFEToWire_correct_and_bounded
+       rpackW pack rpackZ_sig rpackW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Pack", compute_bounds_for_display rpackW ExprUnOpFEToWire_bounds).
+Compute ("Pack overflows? ", sanity_compute rpackW ExprUnOpFEToWire_bounds).
+Compute ("Pack overflows (error if it does)? ", sanity_check rpackW ExprUnOpFEToWire_bounds).
diff --git a/src/SpecificGen/GF25519_64Reflective/Reified/PreFreeze.v b/src/SpecificGen/GF25519_64Reflective/Reified/PreFreeze.v
new file mode 100644
index 000000000..457ffa715
--- /dev/null
+++ b/src/SpecificGen/GF25519_64Reflective/Reified/PreFreeze.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF25519_64Reflective.CommonUnOp.
+
+Definition rprefreezeZ_sig : rexpr_unop_sig prefreeze. Proof. cbv [prefreeze GF25519_64.prefreeze]. reify_sig. Defined.
+Definition rprefreezeW := Eval vm_compute in rword_of_Z rprefreezeZ_sig.
+Lemma rprefreezeW_correct_and_bounded_gen : correct_and_bounded_genT rprefreezeW rprefreezeZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rprefreeze_output_bounds := Eval vm_compute in compute_bounds rprefreezeW ExprUnOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rprefreezeW_correct_and_bounded
+  := ExprUnOp_correct_and_bounded
+       rprefreezeW prefreeze rprefreezeZ_sig rprefreezeW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("PreFreeze", compute_bounds_for_display rprefreezeW ExprUnOp_bounds).
+Compute ("PreFreeze overflows? ", sanity_compute rprefreezeW ExprUnOp_bounds).
+Compute ("PreFreeze overflows (error if it does)? ", sanity_check rprefreezeW ExprUnOp_bounds).
diff --git a/src/SpecificGen/GF25519_64Reflective/Reified/Sub.v b/src/SpecificGen/GF25519_64Reflective/Reified/Sub.v
new file mode 100644
index 000000000..a0deda793
--- /dev/null
+++ b/src/SpecificGen/GF25519_64Reflective/Reified/Sub.v
@@ -0,0 +1,12 @@
+Require Import Crypto.SpecificGen.GF25519_64Reflective.CommonBinOp.
+
+Definition rsubZ_sig : rexpr_binop_sig sub. Proof. reify_sig. Defined.
+Definition rsubW := Eval vm_compute in rword_of_Z rsubZ_sig.
+Lemma rsubW_correct_and_bounded_gen : correct_and_bounded_genT rsubW rsubZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rsub_output_bounds := Eval vm_compute in compute_bounds rsubW ExprBinOp_bounds.
+
+Local Open Scope string_scope.
+Compute ("Sub", compute_bounds_for_display rsubW ExprBinOp_bounds).
+Compute ("Sub overflows? ", sanity_compute rsubW ExprBinOp_bounds).
+Compute ("Sub overflows (error if it does)? ", sanity_check rsubW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF25519_64Reflective/Reified/Unpack.v b/src/SpecificGen/GF25519_64Reflective/Reified/Unpack.v
new file mode 100644
index 000000000..2e1a40f31
--- /dev/null
+++ b/src/SpecificGen/GF25519_64Reflective/Reified/Unpack.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF25519_64Reflective.CommonUnOpWireToFE.
+
+Definition runpackZ_sig : rexpr_unop_WireToFE_sig unpack. Proof. reify_sig. Defined.
+Definition runpackW := Eval vm_compute in rword_of_Z runpackZ_sig.
+Lemma runpackW_correct_and_bounded_gen : correct_and_bounded_genT runpackW runpackZ_sig.
+Proof. rexpr_correct. Qed.
+Definition runpack_output_bounds := Eval vm_compute in compute_bounds runpackW ExprUnOpWireToFE_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition runpackW_correct_and_bounded
+  := ExprUnOpWireToFE_correct_and_bounded
+       runpackW unpack runpackZ_sig runpackW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Unpack", compute_bounds_for_display runpackW ExprUnOpWireToFE_bounds).
+Compute ("Unpack overflows? ", sanity_compute runpackW ExprUnOpWireToFE_bounds).
+Compute ("Unpack overflows (error if it does)? ", sanity_check runpackW ExprUnOpWireToFE_bounds).
diff --git a/src/SpecificGen/GF41417_32Bounded.v b/src/SpecificGen/GF41417_32Bounded.v
new file mode 100644
index 000000000..af6a28421
--- /dev/null
+++ b/src/SpecificGen/GF41417_32Bounded.v
@@ -0,0 +1,462 @@
+Require Import Crypto.BaseSystem.
+Require Import Crypto.ModularArithmetic.PrimeFieldTheorems.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParams.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParamProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystem.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemOpt.
+Require Import Crypto.SpecificGen.GF41417_32.
+Require Import Crypto.SpecificGen.GF41417_32BoundedCommon.
+Require Import Crypto.SpecificGen.GF41417_32Reflective.
+Require Import Bedrock.Word Crypto.Util.WordUtil.
+Require Import Coq.Lists.List Crypto.Util.ListUtil.
+Require Import Crypto.Tactics.VerdiTactics.
+Require Import Crypto.Util.ZUtil.
+Require Import Crypto.Util.Tuple.
+Require Import Crypto.Util.Tactics.
+Require Import Crypto.Util.LetIn.
+Require Import Crypto.Util.Notations.
+Require Import Crypto.Util.Bool.
+Require Import Crypto.Util.Decidable.
+Require Import Crypto.Algebra.
+Import ListNotations.
+Require Import Coq.ZArith.ZArith Coq.ZArith.Zpower Coq.ZArith.ZArith Coq.ZArith.Znumtheory.
+Local Open Scope Z.
+
+
+Local Ltac bounded_t opW blem :=
+  apply blem; apply is_bounded_proj1_fe41417_32.
+Local Ltac bounded_wire_digits_t opW blem :=
+  apply blem; apply is_bounded_proj1_wire_digits.
+
+Local Ltac define_binop f g opW blem :=
+  refine (exist_fe41417_32W (opW (proj1_fe41417_32W f) (proj1_fe41417_32W g)) _);
+  abstract bounded_t opW blem.
+Local Ltac define_unop f opW blem :=
+  refine (exist_fe41417_32W (opW (proj1_fe41417_32W f)) _);
+  abstract bounded_t opW blem.
+Local Ltac define_unop_FEToZ f opW :=
+  refine (opW (proj1_fe41417_32W f)).
+Local Ltac define_unop_FEToWire f opW blem :=
+  refine (exist_wire_digitsW (opW (proj1_fe41417_32W f)) _);
+  abstract bounded_t opW blem.
+Local Ltac define_unop_WireToFE f opW blem :=
+  refine (exist_fe41417_32W (opW (proj1_wire_digitsW f)) _);
+  abstract bounded_wire_digits_t opW blem.
+
+Local Opaque Let_In.
+Local Opaque Z.add Z.sub Z.mul Z.shiftl Z.shiftr Z.land Z.lor Z.eqb NToWord64.
+Local Arguments interp_radd / _ _.
+Local Arguments interp_rsub / _ _.
+Local Arguments interp_rmul / _ _.
+Local Arguments interp_ropp / _.
+Local Arguments interp_rprefreeze / _.
+Local Arguments interp_rge_modulus / _.
+Local Arguments interp_rpack / _.
+Local Arguments interp_runpack / _.
+Definition addW (f g : fe41417_32W) : fe41417_32W := Eval simpl in interp_radd f g.
+Definition subW (f g : fe41417_32W) : fe41417_32W := Eval simpl in interp_rsub f g.
+Definition mulW (f g : fe41417_32W) : fe41417_32W := Eval simpl in interp_rmul f g.
+Definition oppW (f : fe41417_32W) : fe41417_32W := Eval simpl in interp_ropp f.
+Definition prefreezeW (f : fe41417_32W) : fe41417_32W := Eval simpl in interp_rprefreeze f.
+Definition ge_modulusW (f : fe41417_32W) : word64 := Eval simpl in interp_rge_modulus f.
+Definition packW (f : fe41417_32W) : wire_digitsW := Eval simpl in interp_rpack f.
+Definition unpackW (f : wire_digitsW) : fe41417_32W := Eval simpl in interp_runpack f.
+
+Require Import ModularBaseSystemWord.
+Definition modulusW :=
+  Eval cbv - [ZToWord64] in (Tuple.map ZToWord64 (Tuple.from_list_default 0%Z 10 GF41417_32.modulus_digits_)).
+
+Definition postfreeze : GF41417_32.fe41417_32 -> GF41417_32.fe41417_32 :=
+  GF41417_32.postfreeze.
+
+Lemma freeze_prepost_freeze : forall x, postfreeze (prefreeze x) = GF41417_32.freeze x. Proof. reflexivity. Qed.
+
+Definition postfreezeW : fe41417_32W -> fe41417_32W :=
+      (conditional_subtract_modulusW
+         (num_limbs := 10)
+         modulusW
+         ge_modulusW
+         (Interpretations.Word64.neg GF41417_32.int_width)
+      ).
+
+Definition freezeW (f : fe41417_32W) : fe41417_32W := Eval cbv beta delta [prefreezeW postfreezeW] in postfreezeW (prefreezeW f).
+
+Local Transparent Let_In.
+Definition powW (f : fe41417_32W) chain := fold_chain_opt (proj1_fe41417_32W one) mulW chain [f].
+Definition invW (f : fe41417_32W) : fe41417_32W
+  := Eval cbv -[Let_In fe41417_32W mulW] in powW f (chain inv_ec).
+
+Local Ltac port_correct_and_bounded pre_rewrite opW interp_rop rop_cb :=
+  change opW with (interp_rop);
+  rewrite pre_rewrite;
+  intros; apply rop_cb; assumption.
+
+Lemma addW_correct_and_bounded : ibinop_correct_and_bounded addW carry_add.
+Proof. port_correct_and_bounded interp_radd_correct addW interp_radd radd_correct_and_bounded. Qed.
+Lemma subW_correct_and_bounded : ibinop_correct_and_bounded subW carry_sub.
+Proof. port_correct_and_bounded interp_rsub_correct subW interp_rsub rsub_correct_and_bounded. Qed.
+Lemma mulW_correct_and_bounded : ibinop_correct_and_bounded mulW mul.
+Proof. port_correct_and_bounded interp_rmul_correct mulW interp_rmul rmul_correct_and_bounded. Qed.
+Lemma oppW_correct_and_bounded : iunop_correct_and_bounded oppW carry_opp.
+Proof. port_correct_and_bounded interp_ropp_correct oppW interp_ropp ropp_correct_and_bounded. Qed.
+Lemma prefreezeW_correct_and_bounded : iunop_correct_and_bounded prefreezeW prefreeze.
+Proof. port_correct_and_bounded interp_rprefreeze_correct prefreezeW interp_rprefreeze rprefreeze_correct_and_bounded. Qed.
+Lemma ge_modulusW_correct : iunop_FEToZ_correct ge_modulusW ge_modulus.
+Proof. port_correct_and_bounded interp_rge_modulus_correct ge_modulusW interp_rge_modulus rge_modulus_correct_and_bounded. Qed.
+Lemma packW_correct_and_bounded : iunop_FEToWire_correct_and_bounded packW pack.
+Proof. port_correct_and_bounded interp_rpack_correct packW interp_rpack rpack_correct_and_bounded. Qed.
+Lemma unpackW_correct_and_bounded : iunop_WireToFE_correct_and_bounded unpackW unpack.
+Proof. port_correct_and_bounded interp_runpack_correct unpackW interp_runpack runpack_correct_and_bounded. Qed.
+
+(* TODO : move *)
+Lemma neg_range : forall x y, 0 <= x ->
+  0 <= ModularBaseSystemListZOperations.neg x y < 2 ^ x.
+Proof.
+  intros.
+  split; auto using ModularBaseSystemListZOperationsProofs.neg_nonneg.
+  eapply Z.le_lt_trans; eauto using ModularBaseSystemListZOperationsProofs.neg_upperbound.
+  rewrite Z.ones_equiv.
+  omega.
+Qed.
+
+Ltac lower_bound_minus_ge_modulus :=
+  apply Z.le_0_sub;
+  cbv [ge_modulus Let_In ModularBaseSystemListZOperations.cmovl ModularBaseSystemListZOperations.cmovne ModularBaseSystemListZOperations.neg];
+  repeat break_if; Z.ltb_to_lt; subst; try omega;
+    rewrite ?Z.land_0_l; auto;
+    change Interpretations.Word64.word64ToZ with word64ToZ;
+    etransitivity; try apply Z.land_upper_bound_r; instantiate; try omega;
+    apply Z.ones_nonneg; instantiate; vm_compute; discriminate.
+
+Ltac upper_bound_minus_ge_modulus :=
+   (apply Z.log2_lt_pow2_alt; [ vm_compute; reflexivity | ]);
+   eapply Z.le_lt_trans; [ apply Z.le_sub_nonneg; apply Z.land_nonneg; right; omega | ];
+   eapply Z.le_lt_trans; [ eassumption | ];
+   instantiate; vm_compute; reflexivity.
+
+Lemma postfreezeW_correct_and_bounded : iunop_correct_and_bounded postfreezeW postfreeze.
+Proof.
+  intros x H.
+  pose proof (ge_modulusW_correct x H) as Hgm.
+  destruct_head_hnf' prod.
+  unfold_is_bounded_in H.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  cbv [postfreezeW].
+  cbv [conditional_subtract_modulusW Interpretations.Word64.neg].
+  change word64ToZ with Interpretations.Word64.word64ToZ in *.
+  rewrite Hgm.
+
+  cbv [modulusW Tuple.map].
+  cbv [on_tuple List.map to_list to_list' from_list from_list'
+                Tuple.map2 on_tuple2 ListUtil.map2 fe41417_32WToZ].
+  cbv [postfreeze GF41417_32.postfreeze].
+  cbv [Let_In].
+
+  split.
+  { match goal with
+    |- (_,word64ToZ (_ ^- (Interpretations.Word64.ZToWord64 ?x) ^& _)) = (_,_ - (?y &' _)) => assert (x = y) as Hxy by reflexivity; repeat rewrite <-Hxy; clear Hxy end.
+
+  change ZToWord64 with Interpretations.Word64.ZToWord64 in *.
+  rewrite !Interpretations.Word64.word64ToZ_sub;
+  rewrite !Interpretations.Word64.word64ToZ_land;
+  rewrite !Interpretations.Word64.word64ToZ_ZToWord64;
+  try match goal with
+         | |- 0 <=  ModularBaseSystemListZOperations.neg _ _ < 2 ^ _ => apply neg_range; omega
+         | |- 0 <= _ < 2 ^ Z.of_nat _ => vm_compute; split; [refine (fun x => match x with eq_refl => I end) | reflexivity]
+         | |- 0 <= _ &' _ => apply Z.land_nonneg; right; omega
+         | |- (_,_) = (_,_) => reflexivity
+      end;
+  try solve [
+  (apply Z.log2_lt_pow2_alt; [ vm_compute; reflexivity | ]);
+  eapply Z.le_lt_trans; try apply Z.land_upper_bound_r; try apply neg_range; instantiate; try match goal with |- ?G => not has_evar G; vm_compute; discriminate end; reflexivity];
+  match goal with
+  | |- 0 <= _ - _ => lower_bound_minus_ge_modulus
+  | |- Z.log2 (_ - _) < _ => upper_bound_minus_ge_modulus
+  end. }
+
+
+  unfold_is_bounded.
+  change ZToWord64 with Interpretations.Word64.ZToWord64 in *.
+  rewrite !Interpretations.Word64.word64ToZ_sub;
+  rewrite !Interpretations.Word64.word64ToZ_land;
+  rewrite !Interpretations.Word64.word64ToZ_ZToWord64;
+  repeat match goal with |- _ /\ _ => split; Z.ltb_to_lt end;
+  try match goal with
+         | |- 0 <=  ModularBaseSystemListZOperations.neg _ _ < 2 ^ _ => apply neg_range; omega
+         | |- 0 <= _ < 2 ^ Z.of_nat _ => vm_compute; split; [refine (fun x => match x with eq_refl => I end) | reflexivity]
+         | |- 0 <= _ &' _ => apply Z.land_nonneg; right; omega
+      end;
+  try solve [
+  (apply Z.log2_lt_pow2_alt; [ vm_compute; reflexivity | ]);
+  eapply Z.le_lt_trans; try apply Z.land_upper_bound_r; try apply neg_range; instantiate; try match goal with |- ?G => not has_evar G; vm_compute; discriminate end; reflexivity];
+  try match goal with
+  | |- 0 <= _ - _ => lower_bound_minus_ge_modulus
+  | |- Z.log2 (_ - _) < _ => upper_bound_minus_ge_modulus
+  | |- _ - _ <= _ => etransitivity; [ apply Z.le_sub_nonneg; apply Z.land_nonneg; right; omega | instantiate; assumption ]
+  | |- 0 <= ModularBaseSystemListZOperations.neg _ _ =>
+    apply neg_range; vm_compute; discriminate
+  | |- ModularBaseSystemListZOperations.neg _ _ < _ =>
+    apply neg_range; vm_compute; discriminate
+  | |- _ => vm_compute; (discriminate || reflexivity)
+      end.
+Qed.
+
+Lemma freezeW_correct_and_bounded : iunop_correct_and_bounded freezeW freeze.
+Proof.
+  intros f H; rewrite <- freeze_prepost_freeze.
+  change (freezeW f) with (postfreezeW (prefreezeW f)).
+  destruct (prefreezeW_correct_and_bounded f H) as [H0 H1].
+  destruct (postfreezeW_correct_and_bounded _ H1) as [H0' H1'].
+  rewrite H1', H0', H0; split; reflexivity.
+Qed.
+
+Lemma powW_correct_and_bounded chain : iunop_correct_and_bounded (fun x => powW x chain) (fun x => pow x chain).
+Proof.
+  cbv [powW pow].
+  intro x; intros; apply (fold_chain_opt_gen fe41417_32WToZ is_bounded [x]).
+  { reflexivity. }
+  { reflexivity. }
+  { intros; progress rewrite <- (fun X Y => proj1 (mulW_correct_and_bounded _ _ X Y)) by assumption.
+    apply mulW_correct_and_bounded; assumption. }
+  { intros; rewrite (fun X Y => proj1 (mulW_correct_and_bounded _ _ X Y)) by assumption; reflexivity. }
+  { intros [|?]; autorewrite with simpl_nth_default;
+      (assumption || reflexivity). }
+Qed.
+
+Lemma invW_correct_and_bounded : iunop_correct_and_bounded invW inv.
+Proof.
+  intro f.
+  assert (H : forall f, invW f = powW f (chain inv_ec))
+    by abstract (cbv -[Let_In fe41417_32W mulW]; reflexivity).
+  rewrite H.
+  rewrite inv_correct.
+  cbv [inv_opt].
+  rewrite <- pow_correct.
+  apply powW_correct_and_bounded.
+Qed.
+
+Definition fieldwisebW_sig (f g : fe41417_32W)
+  : { b | b = GF41417_32.fieldwiseb (fe41417_32WToZ f) (fe41417_32WToZ g) }.
+Proof.
+  hnf in f, g; destruct_head' prod.
+  eexists.
+  cbv [GF41417_32.fieldwiseb fe41417_32WToZ].
+  rewrite ?word64eqb_Zeqb.
+  reflexivity.
+Defined.
+
+Definition fieldwisebW (f g : fe41417_32W) : bool :=
+  Eval cbv [proj1_sig fieldwisebW_sig appify2 app_fe41417_32W] in
+    appify2 (fun f g => proj1_sig (fieldwisebW_sig f g)) f g.
+
+Lemma fieldwisebW_correct f g
+  : fieldwisebW f g = GF41417_32.fieldwiseb (fe41417_32WToZ f) (fe41417_32WToZ g).
+Proof.
+  set (f' := f); set (g' := g).
+  hnf in f, g; destruct_head' prod.
+  exact (proj2_sig (fieldwisebW_sig f' g')).
+Qed.
+
+Local Arguments freezeW : simpl never.
+Local Arguments fe41417_32WToZ !_ / .
+Local Opaque freezeW.
+
+Definition eqbW_sig (f g : fe41417_32W)
+  : { b | is_bounded (fe41417_32WToZ f) = true
+          -> is_bounded (fe41417_32WToZ g) = true
+          -> b = GF41417_32.eqb (fe41417_32WToZ f) (fe41417_32WToZ g) }.
+Proof.
+  pose proof (fun pf => proj1 (freezeW_correct_and_bounded f pf)) as frf.
+  pose proof (fun pf => proj1 (freezeW_correct_and_bounded g pf)) as frg.
+  hnf in f, g; destruct_head' prod.
+  eexists.
+  unfold GF41417_32.eqb.
+  simpl @fe41417_32WToZ in *; cbv beta iota.
+  intros.
+  rewrite <- frf, <- frg by assumption.
+  rewrite <- fieldwisebW_correct.
+  reflexivity.
+Defined.
+
+Definition eqbW (f g : fe41417_32W) : bool :=
+  Eval cbv [proj1_sig eqbW_sig appify2 app_fe41417_32W] in
+    appify2 (fun f g => proj1_sig (eqbW_sig f g)) f g.
+
+Lemma eqbW_correct f g
+  : is_bounded (fe41417_32WToZ f) = true
+    -> is_bounded (fe41417_32WToZ g) = true
+    -> eqbW f g = GF41417_32.eqb (fe41417_32WToZ f) (fe41417_32WToZ g).
+Proof.
+  set (f' := f); set (g' := g).
+  hnf in f, g; destruct_head' prod.
+  exact (proj2_sig (eqbW_sig f' g')).
+Qed.
+
+(* TODO(jgross): use NToWord or such for this constant too *)
+Definition sqrt_m1W : fe41417_32W :=
+  Eval vm_compute in fe41417_32ZToW sqrt_m1.
+
+Definition GF41417_32sqrt x : GF41417_32.fe41417_32 :=
+  dlet powx := powW (fe41417_32ZToW x) (chain GF41417_32.sqrt_ec) in
+  GF41417_32.sqrt (fe41417_32WToZ powx) (fe41417_32WToZ (mulW powx powx)) x.
+
+Definition sqrtW_sig
+  : { sqrtW | iunop_correct_and_bounded sqrtW GF41417_32sqrt }.
+Proof.
+  eexists.
+  unfold GF41417_32sqrt, GF41417_32.sqrt.
+  intros.
+  rewrite !fe41417_32ZToW_WToZ.
+  split.
+  { etransitivity.
+    Focus 2. {
+      apply Proper_Let_In_nd_changebody_eq; intros.
+      set_evars.
+      match goal with (* unfold the first dlet ... in, but only if it's binding a var *)
+      | [ |- ?x = dlet y := fe41417_32WToZ ?z in ?f ]
+        => is_var z; change (x = match fe41417_32WToZ z with y => f end)
+      end.
+      change sqrt_m1 with (fe41417_32WToZ sqrt_m1W).
+      rewrite <- (fun X Y => proj1 (mulW_correct_and_bounded sqrt_m1W a X Y)), <- eqbW_correct, (pull_bool_if fe41417_32WToZ)
+        by repeat match goal with
+                  | _ => progress subst
+                  | [ |- is_bounded (fe41417_32WToZ ?op) = true ]
+                    => lazymatch op with
+                       | mulW _ _ => apply mulW_correct_and_bounded
+                       | powW _ _ => apply powW_correct_and_bounded
+                       | sqrt_m1W => vm_compute; reflexivity
+                       | _ => assumption
+                       end
+                  end.
+      subst_evars; reflexivity.
+    } Unfocus.
+    lazymatch goal with
+    | [ |- context G[dlet x := ?v in fe41417_32WToZ (@?f x)] ]
+      => let G' := context G[fe41417_32WToZ (dlet x := v in f x)] in
+         cut G'; cbv beta;
+           [ cbv [Let_In]; exact (fun x => x) | apply f_equal ]
+    end.
+    reflexivity. }
+  { cbv [Let_In].
+    break_if.
+    { apply powW_correct_and_bounded; assumption. }
+    { apply mulW_correct_and_bounded; [ vm_compute; reflexivity | ].
+      apply powW_correct_and_bounded; assumption. } }
+Defined.
+
+Definition sqrtW (f : fe41417_32W) : fe41417_32W :=
+  Eval cbv [proj1_sig sqrtW_sig app_fe41417_32W] in
+    app_fe41417_32W f (proj1_sig sqrtW_sig).
+
+Lemma sqrtW_correct_and_bounded : iunop_correct_and_bounded sqrtW GF41417_32sqrt.
+Proof.
+  intro f.
+  set (f' := f).
+  hnf in f; destruct_head' prod.
+  assert (H : sqrtW f' = proj1_sig sqrtW_sig f')
+    by (subst f'; cbv beta iota delta [proj1_sig sqrtW_sig sqrtW]; reflexivity).
+  rewrite H.
+  exact (proj2_sig sqrtW_sig f').
+Qed.
+
+
+
+Definition add (f g : fe41417_32) : fe41417_32.
+Proof. define_binop f g addW addW_correct_and_bounded. Defined.
+Definition sub (f g : fe41417_32) : fe41417_32.
+Proof. define_binop f g subW subW_correct_and_bounded. Defined.
+Definition mul (f g : fe41417_32) : fe41417_32.
+Proof. define_binop f g mulW mulW_correct_and_bounded. Defined.
+Definition opp (f : fe41417_32) : fe41417_32.
+Proof. define_unop f oppW oppW_correct_and_bounded. Defined.
+Definition freeze (f : fe41417_32) : fe41417_32.
+Proof. define_unop f freezeW freezeW_correct_and_bounded. Defined.
+Definition ge_modulus (f : fe41417_32) : word64.
+Proof. define_unop_FEToZ f ge_modulusW. Defined.
+Definition pack (f : fe41417_32) : wire_digits.
+Proof. define_unop_FEToWire f packW packW_correct_and_bounded. Defined.
+Definition unpack (f : wire_digits) : fe41417_32.
+Proof. define_unop_WireToFE f unpackW unpackW_correct_and_bounded. Defined.
+
+Definition pow (f : fe41417_32) (chain : list (nat * nat)) : fe41417_32.
+Proof. define_unop f (fun x => powW x chain) powW_correct_and_bounded. Defined.
+Definition inv (f : fe41417_32) : fe41417_32.
+Proof. define_unop f invW invW_correct_and_bounded. Defined.
+Definition sqrt (f : fe41417_32) : fe41417_32.
+Proof. define_unop f sqrtW sqrtW_correct_and_bounded. Defined.
+
+Local Ltac op_correct_t op opW_correct_and_bounded :=
+  cbv [op];
+  lazymatch goal with
+  | [ |- context[proj1_fe41417_32 (exist_fe41417_32W _ _)] ]
+    => rewrite proj1_fe41417_32_exist_fe41417_32W
+  | [ |- context[proj1_wire_digits (exist_wire_digitsW _ _)] ]
+    => rewrite proj1_wire_digits_exist_wire_digitsW
+  | _ => idtac
+  end;
+  apply opW_correct_and_bounded;
+  lazymatch goal with
+  | [ |- is_bounded _ = true ]
+    => apply is_bounded_proj1_fe41417_32
+  | [ |- wire_digits_is_bounded _ = true ]
+    => apply is_bounded_proj1_wire_digits
+  end.
+
+Lemma add_correct (f g : fe41417_32) : proj1_fe41417_32 (add f g) = carry_add (proj1_fe41417_32 f) (proj1_fe41417_32 g).
+Proof. op_correct_t add addW_correct_and_bounded. Qed.
+Lemma sub_correct (f g : fe41417_32) : proj1_fe41417_32 (sub f g) = carry_sub (proj1_fe41417_32 f) (proj1_fe41417_32 g).
+Proof. op_correct_t sub subW_correct_and_bounded. Qed.
+Lemma mul_correct (f g : fe41417_32) : proj1_fe41417_32 (mul f g) = GF41417_32.mul (proj1_fe41417_32 f) (proj1_fe41417_32 g).
+Proof. op_correct_t mul mulW_correct_and_bounded. Qed.
+Lemma opp_correct (f : fe41417_32) : proj1_fe41417_32 (opp f) = carry_opp (proj1_fe41417_32 f).
+Proof. op_correct_t opp oppW_correct_and_bounded. Qed.
+Lemma freeze_correct (f : fe41417_32) : proj1_fe41417_32 (freeze f) = GF41417_32.freeze (proj1_fe41417_32 f).
+Proof. op_correct_t freeze freezeW_correct_and_bounded. Qed.
+Lemma ge_modulus_correct (f : fe41417_32) : word64ToZ (ge_modulus f) = GF41417_32.ge_modulus (proj1_fe41417_32 f).
+Proof. op_correct_t ge_modulus ge_modulusW_correct. Qed.
+Lemma pack_correct (f : fe41417_32) : proj1_wire_digits (pack f) = GF41417_32.pack (proj1_fe41417_32 f).
+Proof. op_correct_t pack packW_correct_and_bounded. Qed.
+Lemma unpack_correct (f : wire_digits) : proj1_fe41417_32 (unpack f) = GF41417_32.unpack (proj1_wire_digits f).
+Proof. op_correct_t unpack unpackW_correct_and_bounded. Qed.
+Lemma pow_correct (f : fe41417_32) chain : proj1_fe41417_32 (pow f chain) = GF41417_32.pow (proj1_fe41417_32 f) chain.
+Proof. op_correct_t pow (powW_correct_and_bounded chain). Qed.
+Lemma inv_correct (f : fe41417_32) : proj1_fe41417_32 (inv f) = GF41417_32.inv (proj1_fe41417_32 f).
+Proof. op_correct_t inv invW_correct_and_bounded. Qed.
+Lemma sqrt_correct (f : fe41417_32) : proj1_fe41417_32 (sqrt f) = GF41417_32sqrt (proj1_fe41417_32 f).
+Proof. op_correct_t sqrt sqrtW_correct_and_bounded. Qed.
+
+Import Morphisms.
+
+Local Existing Instance prime_modulus.
+
+Lemma field41417_32_and_homomorphisms
+  : @field fe41417_32 eq zero one opp add sub mul inv div
+    /\ @Ring.is_homomorphism (F _) (@Logic.eq _) 1%F F.add F.mul fe41417_32 eq one add mul encode
+    /\ @Ring.is_homomorphism fe41417_32 eq one add mul (F _) (@Logic.eq _) 1%F F.add F.mul decode.
+Proof.
+  eapply @Field.field_and_homomorphism_from_redundant_representation.
+  { exact (F.field_modulo _). }
+  { cbv [decode encode]; intros; rewrite !proj1_fe41417_32_exist_fe41417_32; apply encode_rep. }
+  { reflexivity. }
+  { reflexivity. }
+  { reflexivity. }
+  { cbv [decode encode]; intros; rewrite opp_correct, carry_opp_correct, carry_opp_opt_correct, carry_opp_rep; apply opp_rep; reflexivity. }
+  { cbv [decode encode]; intros; rewrite add_correct, carry_add_correct, carry_add_opt_correct, carry_add_rep; apply add_rep; reflexivity. }
+  { cbv [decode encode]; intros; rewrite sub_correct, carry_sub_correct, carry_sub_opt_correct, carry_sub_rep; apply sub_rep; reflexivity. }
+  { cbv [decode encode]; intros; rewrite mul_correct, GF41417_32.mul_correct, carry_mul_opt_correct by reflexivity; apply carry_mul_rep; reflexivity. }
+  { cbv [decode encode]; intros; rewrite inv_correct, GF41417_32.inv_correct, inv_opt_correct by reflexivity; apply inv_rep; reflexivity. }
+  { cbv [decode encode div]; intros; rewrite !proj1_fe41417_32_exist_fe41417_32; apply encode_rep. }
+Qed.
+
+Global Instance field41417_32 : @field fe41417_32 eq zero one opp add sub mul inv div := proj1 field41417_32_and_homomorphisms.
+
+Local Opaque proj1_fe41417_32 exist_fe41417_32 proj1_fe41417_32W exist_fe41417_32W.
+Global Instance homomorphism_F41417_32_encode
+  : @Ring.is_homomorphism (F modulus) Logic.eq F.one F.add F.mul fe41417_32 eq one add mul encode.
+Proof. apply field41417_32_and_homomorphisms. Qed.
+
+Global Instance homomorphism_F41417_32_decode
+  : @Ring.is_homomorphism fe41417_32 eq one add mul (F modulus) Logic.eq F.one F.add F.mul decode.
+Proof. apply field41417_32_and_homomorphisms. Qed.
diff --git a/src/SpecificGen/GF41417_32BoundedCommon.v b/src/SpecificGen/GF41417_32BoundedCommon.v
new file mode 100644
index 000000000..2f87412c9
--- /dev/null
+++ b/src/SpecificGen/GF41417_32BoundedCommon.v
@@ -0,0 +1,693 @@
+Require Import Crypto.BaseSystem.
+Require Import Crypto.ModularArithmetic.PrimeFieldTheorems.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParams.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParamProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystem.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemOpt.
+Require Import Crypto.SpecificGen.GF41417_32.
+Require Import Bedrock.Word Crypto.Util.WordUtil.
+Require Import Coq.Lists.List Crypto.Util.ListUtil.
+Require Import Crypto.Tactics.VerdiTactics.
+Require Import Crypto.Util.ZUtil.
+Require Import Crypto.Util.Tuple.
+Require Import Crypto.Util.Tactics.
+Require Import Crypto.Util.LetIn.
+Require Import Crypto.Util.Notations.
+Require Import Crypto.Util.Decidable.
+Require Import Crypto.Util.HList.
+Require Import Crypto.Util.Tuple.
+Require Import Crypto.Algebra.
+Import ListNotations.
+Require Import Coq.ZArith.ZArith Coq.ZArith.Zpower Coq.ZArith.ZArith Coq.ZArith.Znumtheory.
+Local Open Scope Z.
+
+(* BEGIN common curve-specific definitions *)
+Definition bit_width : nat := Eval compute in Z.to_nat (GF41417_32.int_width).
+Local Notation b_of exp := (0, 2^exp + 2^(exp-3))%Z (only parsing). (* max is [(0, 2^(exp+2) + 2^exp + 2^(exp-1) + 2^(exp-3) + 2^(exp-4) + 2^(exp-5) + 2^(exp-6) + 2^(exp-10) + 2^(exp-12) + 2^(exp-13) + 2^(exp-14) + 2^(exp-15) + 2^(exp-17) + 2^(exp-23) + 2^(exp-24))%Z] *)
+Definition bounds_exp : tuple Z length_fe41417_32
+  := Eval compute in
+      Tuple.from_list length_fe41417_32 limb_widths eq_refl.
+Definition bounds : tuple (Z * Z) length_fe41417_32
+  := Eval compute in
+      Tuple.map (fun e => b_of e) bounds_exp.
+Definition wire_digit_bounds_exp : tuple Z (length wire_widths)
+  := Eval compute in Tuple.from_list _ wire_widths eq_refl.
+Definition wire_digit_bounds : tuple (Z * Z) (length wire_widths)
+  := Eval compute in Tuple.map (fun e => (0,2^e-1)%Z) wire_digit_bounds_exp.
+(* END common curve-specific definitions *)
+
+(* BEGIN aliases for word extraction *)
+Definition word64 := Word.word bit_width.
+Coercion word64ToZ (x : word64) : Z := Z.of_N (wordToN x).
+Coercion ZToWord64 (x : Z) : word64 := NToWord _ (Z.to_N x).
+Definition NToWord64 : N -> word64 := NToWord _.
+Definition word64ize (x : word64) : word64
+  := Eval cbv [wordToN N.succ_double N.double] in NToWord64 (wordToN x).
+Definition w64eqb (x y : word64) := weqb x y.
+
+Global Arguments NToWord64 : simpl never.
+Arguments word64 : simpl never.
+Arguments bit_width : simpl never.
+Global Opaque word64.
+Global Opaque bit_width.
+
+(* END aliases for word extraction *)
+
+(* BEGIN basic types *)
+Module Type WordIsBounded.
+  Parameter is_boundedT : forall (lower upper : Z), word64 -> bool.
+  Parameter Build_is_boundedT : forall {lower upper} {proj_word : word64},
+      andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true -> is_boundedT lower upper proj_word = true.
+  Parameter project_is_boundedT : forall {lower upper} {proj_word : word64},
+      is_boundedT lower upper proj_word = true -> andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true.
+End WordIsBounded.
+
+Module Import WordIsBoundedDefault : WordIsBounded.
+  Definition is_boundedT : forall (lower upper : Z), word64 -> bool
+    := fun lower upper proj_word => andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z.
+  Definition Build_is_boundedT {lower upper} {proj_word : word64}
+    : andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true -> is_boundedT lower upper proj_word = true
+    := fun x => x.
+  Definition project_is_boundedT {lower upper} {proj_word : word64}
+    : is_boundedT lower upper proj_word = true -> andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true
+    := fun x => x.
+End WordIsBoundedDefault.
+
+Definition bounded_word (lower upper : Z)
+  := { proj_word : word64 | is_boundedT lower upper proj_word = true }.
+Local Notation word_of exp := (bounded_word (fst (b_of exp)) (snd (b_of exp))).
+Local Notation unbounded_word sz := (bounded_word 0 (2^sz-1)%Z).
+
+Local Opaque word64.
+Definition fe41417_32W := Eval cbv (*-[word64]*) in (tuple word64 length_fe41417_32).
+Definition wire_digitsW := Eval cbv (*-[word64]*) in (tuple word64 (length wire_widths)).
+Definition fe41417_32 :=
+  Eval cbv -[bounded_word Z.pow Z.sub Z.add] in
+    hlist (fun e => word_of e) bounds_exp.
+Definition wire_digits :=
+  Eval cbv -[bounded_word Z.pow Z.sub Z.add] in
+    hlist (fun e => unbounded_word e) wire_digit_bounds_exp.
+
+Definition is_bounded_gen {n} (x : tuple Z n) (bounds : tuple (Z * Z) n) : bool
+  := let res := Tuple.map2
+                  (fun bounds v =>
+                     let '(lower, upper) := bounds in
+                     (lower <=? v) && (v <=? upper))%bool%Z
+                  bounds x in
+     List.fold_right andb true (Tuple.to_list _ res).
+
+Definition is_bounded (x : SpecificGen.GF41417_32.fe41417_32) : bool
+  := is_bounded_gen (n:=length_fe41417_32) x bounds.
+
+Definition wire_digits_is_bounded (x : SpecificGen.GF41417_32.wire_digits) : bool
+  := is_bounded_gen (n:=length wire_widths) x wire_digit_bounds.
+
+(* END basic types *)
+
+Section generic_destructuring.
+  Fixpoint app_on' A n : forall T (f : tuple' A n) (P : forall x : tuple' A n, T x), T f
+    := match n return forall T (f : tuple' A n) (P : forall x : tuple' A n, T x), T f with
+       | O => fun T v P => P v
+       | S n' => fun T v P => let '(v, x) := v in app_on' A n' _ v (fun v => P (v, x))
+       end.
+  Definition app_on {A n} : forall {T} (f : tuple A n) (P : forall x : tuple A n, T x), T f
+    := match n return forall T (f : tuple A n) (P : forall x : tuple A n, T x), T f with
+       | O => fun T v P => P v
+       | S n' => @app_on' A n'
+       end.
+  Lemma app_on'_correct {A n T} f (P : forall x : tuple' A n, T x) : app_on' A n T f P = P f.
+  Proof.
+    induction n; simpl in *; destruct_head' prod; [ reflexivity | exact (IHn _ _ (fun t => P (t, _))) ].
+  Qed.
+  Lemma app_on_correct {A n T} f (P : forall x : tuple A n, T x) : app_on f P = P f.
+  Proof. destruct n; [ reflexivity | apply app_on'_correct ]. Qed.
+
+  Fixpoint app_on_h' A F n : forall ts T (f : @hlist' A n F ts) (P : forall x : @hlist' A n F ts, T x), T f
+    := match n return forall ts T (f : @hlist' A n F ts) (P : forall x : @hlist' A n F ts, T x), T f with
+       | O => fun ts T v P => P v
+       | S n' => fun ts T v P => let '(v, x) := v in app_on_h' A F n' _ _ v (fun v => P (v, x))
+       end.
+  Definition app_on_h {A F n} : forall ts T (f : @hlist A n F ts) (P : forall x : @hlist A n F ts, T x), T f
+    := match n return forall ts T (f : @hlist A n F ts) (P : forall x : @hlist A n F ts, T x), T f with
+       | O => fun ts T v P => P v
+       | S n' => @app_on_h' A F n'
+       end.
+  Lemma app_on_h'_correct {A F n ts T} f P : @app_on_h' A F n ts T f P = P f.
+  Proof.
+    induction n; simpl in *; destruct_head' prod; [ reflexivity | exact (IHn _ _ _ (fun h => P (h, f))) ].
+  Qed.
+  Lemma app_on_h_correct {A} F {n} ts {T} f P : @app_on_h A F n ts T f P = P f.
+  Proof. destruct n; [ reflexivity | apply app_on_h'_correct ]. Qed.
+
+  Definition app_wire_digitsW_dep {A T} (P : forall x : tuple A (length wire_widths), T x)
+    : forall (f : tuple A (length wire_widths)), T f
+    := Eval compute in fun f => @app_on A (length wire_widths) T f P.
+  Definition app_wire_digitsW {A T} (f : tuple A (length wire_widths)) (P : tuple A (length wire_widths) -> T)
+    := Eval compute in @app_wire_digitsW_dep A (fun _ => T) P f.
+  Definition app_fe41417_32W_dep {A T} (P : forall x : tuple A length_fe41417_32, T x)
+    : forall (f : tuple A length_fe41417_32), T f
+    := Eval compute in fun f => @app_on A length_fe41417_32 T f P.
+  Definition app_fe41417_32W {A T} (f : tuple A length_fe41417_32) (P : tuple A length_fe41417_32 -> T)
+    := Eval compute in @app_fe41417_32W_dep A (fun _ => T) P f.
+  Definition app_fe41417_32_dep {T} (P : forall x : fe41417_32, T x)
+    : forall f : fe41417_32, T f
+    := Eval compute in fun f => @app_on_h _ (fun e => word_of e) length_fe41417_32 bounds_exp T f P.
+  Definition app_fe41417_32 {T} (f : fe41417_32) (P : hlist (fun e => word_of e) bounds_exp -> T)
+    := Eval compute in @app_fe41417_32_dep (fun _ => T) P f.
+  Definition app_wire_digits_dep {T} (P : forall x : wire_digits, T x)
+    : forall f : wire_digits, T f
+    := Eval compute in fun f => @app_on_h _ (fun e => unbounded_word e) (length wire_widths) wire_digit_bounds_exp T f P.
+  Definition app_wire_digits {T} (f : wire_digits) (P : hlist (fun e => unbounded_word e) wire_digit_bounds_exp -> T)
+    := Eval compute in @app_wire_digits_dep (fun _ => T) P f.
+
+  Definition app_wire_digitsW_dep_correct {A T} f P : @app_wire_digitsW_dep A T P f = P f
+    := app_on_correct f P.
+  Definition app_wire_digitsW_correct {A T} f P : @app_wire_digitsW A T f P = P f
+    := @app_wire_digitsW_dep_correct A (fun _ => T) f P.
+  Definition app_fe41417_32W_dep_correct {A T} f P : @app_fe41417_32W_dep A T P f = P f
+    := app_on_correct f P.
+  Definition app_fe41417_32W_correct {A T} f P : @app_fe41417_32W A T f P = P f
+    := @app_fe41417_32W_dep_correct A (fun _ => T) f P.
+  Definition app_fe41417_32_dep_correct {T} f P : @app_fe41417_32_dep T P f = P f
+    := app_on_h_correct (fun e => word_of e) bounds_exp f P.
+  Definition app_fe41417_32_correct {T} f P : @app_fe41417_32 T f P = P f
+    := @app_fe41417_32_dep_correct (fun _ => T) f P.
+  Definition app_wire_digits_dep_correct {T} f P : @app_wire_digits_dep T P f = P f
+    := app_on_h_correct (fun e => unbounded_word e) wire_digit_bounds_exp f P.
+  Definition app_wire_digits_correct {T} f P : @app_wire_digits T f P = P f
+    := @app_wire_digits_dep_correct (fun _ => T) f P.
+
+  Definition appify2 {T} (op : fe41417_32W -> fe41417_32W -> T) (f g : fe41417_32W) :=
+    app_fe41417_32W f (fun f0 => (app_fe41417_32W g (fun g0 => op f0 g0))).
+
+  Lemma appify2_correct : forall {T} op f g, @appify2 T op f g = op f g.
+  Proof.
+    intros. cbv [appify2].
+    etransitivity; apply app_fe41417_32W_correct.
+  Qed.
+End generic_destructuring.
+
+Definition eta_fe41417_32W_sig (x : fe41417_32W) : { v : fe41417_32W | v = x }.
+Proof.
+  eexists; symmetry.
+  repeat (etransitivity; [ apply surjective_pairing | apply f_equal2 ]); reflexivity.
+Defined.
+Definition eta_fe41417_32W (x : fe41417_32W) : fe41417_32W
+  := Eval cbv [proj1_sig eta_fe41417_32W_sig] in proj1_sig (eta_fe41417_32W_sig x).
+Definition eta_wire_digitsW_sig (x : wire_digitsW) : { v : wire_digitsW | v = x }.
+Proof.
+  eexists; symmetry.
+  repeat (etransitivity; [ apply surjective_pairing | apply f_equal2 ]); reflexivity.
+Defined.
+Definition eta_wire_digitsW (x : wire_digitsW) : wire_digitsW
+  := Eval cbv [proj1_sig eta_wire_digitsW_sig] in proj1_sig (eta_wire_digitsW_sig x).
+
+Local Transparent word64.
+Lemma word64ize_id x : word64ize x = x.
+Proof. apply NToWord_wordToN. Qed.
+Local Opaque word64.
+
+Lemma word64eqb_Zeqb x y : (word64ToZ x =? word64ToZ y)%Z = w64eqb x y.
+Proof. apply wordeqb_Zeqb. Qed.
+
+Local Arguments Z.pow_pos !_ !_ / .
+Lemma word64ToZ_ZToWord64 x : 0 <= x < 2^Z.of_nat bit_width -> word64ToZ (ZToWord64 x) = x.
+Proof.
+  intros; unfold word64ToZ, ZToWord64.
+  rewrite wordToN_NToWord_idempotent, Z2N.id
+    by (omega || apply N2Z.inj_lt; rewrite <- ?(N_nat_Z (Npow2 _)), ?Npow2_nat, ?Zpow_pow2, ?N2Z.id, ?Z2N.id, ?Z2Nat.id by omega; omega).
+  reflexivity.
+Qed.
+Lemma ZToWord64_word64ToZ x : ZToWord64 (word64ToZ x) = x.
+Proof.
+  intros; unfold word64ToZ, ZToWord64.
+  rewrite N2Z.id, NToWord_wordToN; reflexivity.
+Qed.
+
+(* BEGIN precomputation. *)
+
+Definition proj_word {lower upper} (v : bounded_word lower upper) := Eval cbv [proj1_sig] in proj1_sig v.
+Definition word_bounded {lower upper} (v : bounded_word lower upper)
+  : andb (lower <=? proj_word v)%Z (proj_word v <=? upper)%Z = true
+  := project_is_boundedT (proj2_sig v).
+Definition Build_bounded_word' {lower upper} proj_word word_bounded : bounded_word lower upper
+  := exist _ proj_word (Build_is_boundedT word_bounded).
+Arguments proj_word {_ _} _.
+Arguments word_bounded {_ _} _.
+Arguments Build_bounded_word' {_ _} _ _.
+Definition Build_bounded_word {lower upper} (proj_word : word64) (word_bounded : andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true)
+  : bounded_word lower upper
+  := Build_bounded_word'
+       proj_word
+       (match andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z as b return b = true -> b = true with
+        | true => fun _ => eq_refl
+        | false => fun x => x
+        end word_bounded).
+Lemma word_to_unbounded_helper {x e : nat} : (x < pow2 e)%nat -> (Z.of_nat e <= Z.of_nat bit_width)%Z -> ((0 <=? word64ToZ (ZToWord64 (Z.of_nat x))) && (word64ToZ (ZToWord64 (Z.of_nat x)) <=? 2 ^ (Z.of_nat e) - 1))%bool = true.
+Proof.
+  rewrite pow2_id; intro H; apply Nat2Z.inj_lt in H; revert H.
+  rewrite Z.pow_Zpow; simpl Z.of_nat.
+  intros H H'.
+  assert (2^Z.of_nat e <= 2^Z.of_nat bit_width) by auto with zarith.
+  rewrite ?word64ToZ_ZToWord64 by omega.
+  match goal with
+  | [ |- context[andb ?x ?y] ]
+    => destruct x eqn:?, y eqn:?; try reflexivity; Z.ltb_to_lt
+  end;
+    intros; omega.
+Qed.
+Definition word_to_unbounded_word {sz} (x : word sz) : (Z.of_nat sz <=? Z.of_nat bit_width)%Z = true -> unbounded_word (Z.of_nat sz).
+Proof.
+  refine (fun pf => Build_bounded_word (Z.of_N (wordToN x)) _).
+  abstract (rewrite wordToN_nat, nat_N_Z; Z.ltb_to_lt; apply (word_to_unbounded_helper (wordToNat_bound x)); simpl; omega).
+Defined.
+Definition word32_to_unbounded_word (x : word 32) : unbounded_word 32.
+Proof. apply (word_to_unbounded_word x); reflexivity. Defined.
+Definition word31_to_unbounded_word (x : word 31) : unbounded_word 31.
+Proof. apply (word_to_unbounded_word x); reflexivity. Defined.
+
+Local Opaque word64.
+Declare Reduction app_tuple_map := cbv [app_wire_digitsW app_fe41417_32W app_fe41417_32 HList.mapt HList.mapt' Tuple.map on_tuple List.map List.app length_fe41417_32 List.length wire_widths Tuple.from_list Tuple.from_list' Tuple.to_list Tuple.to_list' fst snd].
+Definition fe41417_32WToZ (x : fe41417_32W) : SpecificGen.GF41417_32.fe41417_32
+  := Eval app_tuple_map in
+      app_fe41417_32W x (Tuple.map (fun v : word64 => v : Z)).
+Definition fe41417_32ZToW (x : SpecificGen.GF41417_32.fe41417_32) : fe41417_32W
+  := Eval app_tuple_map in
+      app_fe41417_32W x (Tuple.map (fun v : Z => v : word64)).
+Definition wire_digitsWToZ (x : wire_digitsW) : SpecificGen.GF41417_32.wire_digits
+  := Eval app_tuple_map in
+      app_wire_digitsW x (Tuple.map (fun v : word64 => v : Z)).
+Definition wire_digitsZToW (x : SpecificGen.GF41417_32.wire_digits) : wire_digitsW
+  := Eval app_tuple_map in
+      app_wire_digitsW x (Tuple.map (fun v : Z => v : word64)).
+Definition fe41417_32W_word64ize (x : fe41417_32W) : fe41417_32W
+  := Eval app_tuple_map in
+      app_fe41417_32W x (Tuple.map word64ize).
+Definition wire_digitsW_word64ize (x : wire_digitsW) : wire_digitsW
+  := Eval app_tuple_map in
+      app_wire_digitsW x (Tuple.map word64ize).
+
+(** TODO: Turn this into a lemma to speed up proofs *)
+Ltac unfold_is_bounded_in H :=
+  unfold is_bounded, wire_digits_is_bounded, is_bounded_gen, fe41417_32WToZ, wire_digitsWToZ in H;
+  cbv [to_list length bounds wire_digit_bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map fold_right List.rev List.app length_fe41417_32 List.length wire_widths] in H;
+  rewrite ?Bool.andb_true_iff in H.
+
+Ltac unfold_is_bounded :=
+  unfold is_bounded, wire_digits_is_bounded, is_bounded_gen, fe41417_32WToZ, wire_digitsWToZ;
+  cbv [to_list length bounds wire_digit_bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map fold_right List.rev List.app length_fe41417_32 List.length wire_widths];
+  rewrite ?Bool.andb_true_iff.
+
+Local Transparent bit_width.
+Definition Pow2_64 := Eval compute in 2^Z.of_nat bit_width.
+Definition unfold_Pow2_64 : 2^Z.of_nat bit_width = Pow2_64 := eq_refl.
+Local Opaque bit_width.
+
+Local Ltac prove_lt_bit_width :=
+  rewrite unfold_Pow2_64; cbv [Pow2_64]; omega.
+
+Lemma fe41417_32ZToW_WToZ (x : fe41417_32W) : fe41417_32ZToW (fe41417_32WToZ x) = x.
+Proof.
+  hnf in x; destruct_head' prod; cbv [fe41417_32WToZ fe41417_32ZToW].
+  rewrite !ZToWord64_word64ToZ; reflexivity.
+Qed.
+
+Lemma fe41417_32WToZ_ZToW x : is_bounded x = true -> fe41417_32WToZ (fe41417_32ZToW x) = x.
+Proof.
+  hnf in x; destruct_head' prod; cbv [fe41417_32WToZ fe41417_32ZToW].
+  intro H.
+  unfold_is_bounded_in H; destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite !word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Lemma fe41417_32W_word64ize_id x : fe41417_32W_word64ize x = x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [fe41417_32W_word64ize];
+    repeat apply f_equal2; apply word64ize_id.
+Qed.
+Lemma wire_digitsW_word64ize_id x : wire_digitsW_word64ize x = x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [wire_digitsW_word64ize];
+    repeat apply f_equal2; apply word64ize_id.
+Qed.
+
+Definition uncurry_unop_fe41417_32W {T} (op : fe41417_32W -> T)
+  := Eval cbv (*-[word64]*) in Tuple.uncurry (n:=length_fe41417_32) op.
+Definition curry_unop_fe41417_32W {T} op : fe41417_32W -> T
+  := Eval cbv (*-[word64]*) in fun f => app_fe41417_32W f (Tuple.curry (n:=length_fe41417_32) op).
+Definition uncurry_binop_fe41417_32W {T} (op : fe41417_32W -> fe41417_32W -> T)
+  := Eval cbv (*-[word64]*) in uncurry_unop_fe41417_32W (fun f => uncurry_unop_fe41417_32W (op f)).
+Definition curry_binop_fe41417_32W {T} op : fe41417_32W -> fe41417_32W -> T
+  := Eval cbv (*-[word64]*) in appify2 (fun f => curry_unop_fe41417_32W (curry_unop_fe41417_32W op f)).
+
+Definition uncurry_unop_wire_digitsW {T} (op : wire_digitsW -> T)
+  := Eval cbv (*-[word64]*) in Tuple.uncurry (n:=length wire_widths) op.
+Definition curry_unop_wire_digitsW {T} op : wire_digitsW -> T
+  := Eval cbv (*-[word64]*) in fun f => app_wire_digitsW f (Tuple.curry (n:=length wire_widths) op).
+
+
+Definition proj1_fe41417_32W (x : fe41417_32) : fe41417_32W
+  := Eval app_tuple_map in
+      app_fe41417_32 x (HList.mapt (fun _ => (@proj_word _ _))).
+Coercion proj1_fe41417_32 (x : fe41417_32) : SpecificGen.GF41417_32.fe41417_32
+  := fe41417_32WToZ (proj1_fe41417_32W x).
+
+Lemma is_bounded_proj1_fe41417_32 (x : fe41417_32) : is_bounded (proj1_fe41417_32 x) = true.
+Proof.
+  revert x; refine (app_fe41417_32_dep _); intro x.
+  hnf in x; destruct_head' prod; destruct_head' bounded_word.
+  cbv [is_bounded proj1_fe41417_32 proj1_fe41417_32W fe41417_32WToZ to_list length bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map List.rev List.app proj_word length_fe41417_32 is_bounded_gen].
+  apply fold_right_andb_true_iff_fold_right_and_True.
+  cbv [fold_right List.map].
+  cbv beta in *.
+  repeat split; auto using project_is_boundedT.
+Qed.
+
+Definition proj1_wire_digitsW (x : wire_digits) : wire_digitsW
+  := app_wire_digits x (HList.mapt (fun _ => proj_word)).
+Coercion proj1_wire_digits (x : wire_digits) : SpecificGen.GF41417_32.wire_digits
+  := wire_digitsWToZ (proj1_wire_digitsW x).
+
+Lemma is_bounded_proj1_wire_digits (x : wire_digits) : wire_digits_is_bounded (proj1_wire_digits x) = true.
+Proof.
+  revert x; refine (app_wire_digits_dep _); intro x.
+  hnf in x; destruct_head' prod; destruct_head' bounded_word.
+  cbv [wire_digits_is_bounded proj1_wire_digits proj1_wire_digitsW wire_digitsWToZ to_list length wire_digit_bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map List.rev List.app proj_word is_bounded_gen wire_widths HList.mapt HList.mapt' app_wire_digits fst snd].
+  apply fold_right_andb_true_iff_fold_right_and_True.
+  cbv [fold_right List.map].
+  cbv beta in *.
+  repeat split; auto using project_is_boundedT.
+Qed.
+
+Local Ltac make_exist_W' x app_W_dep :=
+  let H := fresh in
+  revert x; refine (@app_W_dep _ _ _); intros x H;
+  let x' := fresh in
+  set (x' := x);
+  cbv [tuple tuple' length_fe41417_32 List.length wire_widths] in x;
+  destruct_head' prod;
+  let rec do_refine v H :=
+      first [ let v' := (eval cbv [snd fst] in (snd v)) in
+              refine (_, Build_bounded_word v' _);
+              [ do_refine (fst v) (proj2 H) | subst x'; abstract exact (proj1 H) ]
+            | let v' := (eval cbv [snd fst] in v) in
+              refine (Build_bounded_word v' _); subst x'; abstract exact (proj1 H) ] in
+  let H' := constr:(proj1 (@fold_right_andb_true_iff_fold_right_and_True _) H) in
+  let T := type of H' in
+  let T := (eval cbv [id
+                        List.fold_right List.map List.length List.app ListUtil.map2 List.rev
+                        Tuple.to_list Tuple.to_list' Tuple.from_list Tuple.from_list' Tuple.map2 Tuple.on_tuple2
+                        fe41417_32 bounds fe41417_32WToZ length_fe41417_32
+                        wire_digits wire_digit_bounds wire_digitsWToZ wire_widths] in T) in
+  let H' := constr:(H' : T) in
+  let v := (eval unfold x' in x') in
+  do_refine v H'.
+Local Ltac make_exist'' x exist_W ZToW :=
+  let H := fresh in
+  intro H; apply (exist_W (ZToW x));
+  abstract (
+      hnf in x; destruct_head' prod;
+      let H' := fresh in
+      pose proof H as H';
+      unfold_is_bounded_in H;
+      destruct_head' and; simpl in *;
+      Z.ltb_to_lt;
+      rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width;
+      assumption
+    ).
+Local Ltac make_exist' x app_W_dep exist'' exist_W ZToW :=
+  let H := fresh in
+  revert x; refine (@app_W_dep _ _ _); intros x H;
+  let x' := fresh in
+  set (x' := x) in *;
+  cbv [tuple tuple' length_fe41417_32 List.length wire_widths] in x;
+  destruct_head' prod;
+  let rec do_refine v :=
+      first [ let v' := (eval cbv [exist_W ZToW exist'' proj_word Build_bounded_word Build_bounded_word' snd fst] in (proj_word v)) in
+              refine (Build_bounded_word v' _); subst x'; abstract exact (word_bounded v)
+            | let v' := (eval cbv [exist_W ZToW exist'' proj_word Build_bounded_word Build_bounded_word' snd fst] in (proj_word (snd v))) in
+              refine (_, Build_bounded_word v' _);
+              [ do_refine (fst v) | subst x'; abstract exact (word_bounded (snd v)) ] ] in
+  let v := (eval unfold x' in (exist'' x' H)) in
+  do_refine v.
+
+Definition exist_fe41417_32W' (x : fe41417_32W) : is_bounded (fe41417_32WToZ x) = true -> fe41417_32.
+Proof. make_exist_W' x (@app_fe41417_32W_dep). Defined.
+Definition exist_fe41417_32W (x : fe41417_32W) : is_bounded (fe41417_32WToZ x) = true -> fe41417_32
+  := Eval cbv [app_fe41417_32W_dep exist_fe41417_32W' fe41417_32ZToW] in exist_fe41417_32W' x.
+Definition exist_fe41417_32'' (x : SpecificGen.GF41417_32.fe41417_32) : is_bounded x = true -> fe41417_32.
+Proof. make_exist'' x exist_fe41417_32W fe41417_32ZToW. Defined.
+Definition exist_fe41417_32' (x : SpecificGen.GF41417_32.fe41417_32) : is_bounded x = true -> fe41417_32.
+Proof. make_exist' x (@app_fe41417_32W_dep) exist_fe41417_32'' exist_fe41417_32W fe41417_32ZToW. Defined.
+Definition exist_fe41417_32 (x : SpecificGen.GF41417_32.fe41417_32) : is_bounded x = true -> fe41417_32
+  := Eval cbv [exist_fe41417_32' exist_fe41417_32W exist_fe41417_32' app_fe41417_32 app_fe41417_32W_dep] in
+      exist_fe41417_32' x.
+
+Lemma proj1_fe41417_32_exist_fe41417_32W x pf : proj1_fe41417_32 (exist_fe41417_32W x pf) = fe41417_32WToZ x.
+Proof. now hnf in x; destruct_head' prod. Qed.
+Lemma proj1_fe41417_32W_exist_fe41417_32 x pf : proj1_fe41417_32W (exist_fe41417_32 x pf) = fe41417_32ZToW x.
+Proof. now hnf in x; destruct_head' prod. Qed.
+Lemma proj1_fe41417_32_exist_fe41417_32 x pf : proj1_fe41417_32 (exist_fe41417_32 x pf) = x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [proj1_fe41417_32 exist_fe41417_32 proj1_fe41417_32W fe41417_32WToZ proj_word Build_bounded_word Build_bounded_word'].
+  unfold_is_bounded_in pf.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Definition exist_wire_digitsW' (x : wire_digitsW)
+  : wire_digits_is_bounded (wire_digitsWToZ x) = true -> wire_digits.
+Proof. make_exist_W' x (@app_wire_digitsW_dep). Defined.
+Definition exist_wire_digitsW (x : wire_digitsW)
+  : wire_digits_is_bounded (wire_digitsWToZ x) = true -> wire_digits
+  := Eval cbv [app_wire_digitsW_dep exist_wire_digitsW' wire_digitsZToW] in exist_wire_digitsW' x.
+Definition exist_wire_digits'' (x : SpecificGen.GF41417_32.wire_digits)
+  : wire_digits_is_bounded x = true -> wire_digits.
+Proof. make_exist'' x exist_wire_digitsW wire_digitsZToW. Defined.
+Definition exist_wire_digits' (x : SpecificGen.GF41417_32.wire_digits)
+  : wire_digits_is_bounded x = true -> wire_digits.
+Proof. make_exist' x (@app_wire_digitsW_dep) exist_wire_digits'' exist_wire_digitsW wire_digitsZToW. Defined.
+Definition exist_wire_digits (x : SpecificGen.GF41417_32.wire_digits)
+  : wire_digits_is_bounded x = true -> wire_digits
+  := Eval cbv [exist_wire_digits' exist_wire_digitsW exist_wire_digits' app_wire_digits app_wire_digitsW_dep] in
+      exist_wire_digits' x.
+
+Lemma proj1_wire_digits_exist_wire_digitsW x pf : proj1_wire_digits (exist_wire_digitsW x pf) = wire_digitsWToZ x.
+Proof. now hnf in x; destruct_head' prod. Qed.
+Lemma proj1_wire_digitsW_exist_wire_digits x pf : proj1_wire_digitsW (exist_wire_digits x pf) = wire_digitsZToW x.
+Proof. now hnf in x; destruct_head' prod. Qed.
+Lemma proj1_wire_digits_exist_wire_digits x pf : proj1_wire_digits (exist_wire_digits x pf) = x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [proj1_wire_digits exist_wire_digits proj1_wire_digitsW wire_digitsWToZ proj_word Build_bounded_word Build_bounded_word' app_wire_digits HList.mapt HList.mapt' length wire_widths fst snd].
+  unfold_is_bounded_in pf.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Module opt.
+  Definition word64ToZ := Eval vm_compute in word64ToZ.
+  Definition word64ToN := Eval vm_compute in @wordToN bit_width.
+  Definition NToWord64 := Eval vm_compute in NToWord64.
+  Definition bit_width := Eval vm_compute in bit_width.
+  Definition Zleb := Eval cbv [Z.leb] in Z.leb.
+  Definition andb := Eval vm_compute in andb.
+  Definition word64ize := Eval vm_compute in word64ize.
+End opt.
+
+Local Transparent bit_width.
+Local Ltac do_change lem :=
+  match lem with
+  | context L[andb (?x <=? ?y)%Z (?y <=? ?z)]
+    => let x' := (eval vm_compute in x) in
+       let z' := (eval vm_compute in z) in
+       lazymatch y with
+       | word64ToZ (word64ize ?v)
+         => let y' := constr:(opt.word64ToZ (opt.word64ize v)) in
+            let L' := context L[andb (opt.Zleb x' y') (opt.Zleb y' z')] in
+            do_change L'
+       end
+  | _ => lem
+  end.
+Definition fe41417_32_word64ize (x : fe41417_32) : fe41417_32.
+Proof.
+  set (x' := x).
+  hnf in x; destruct_head' prod.
+  let lem := constr:(exist_fe41417_32W (fe41417_32W_word64ize (proj1_fe41417_32W x'))) in
+  let lem := (eval cbv [proj1_fe41417_32W x' fe41417_32W_word64ize proj_word exist_fe41417_32W Build_bounded_word' Build_bounded_word] in lem) in
+  let lem := do_change lem in
+  refine (lem _);
+    change (is_bounded (fe41417_32WToZ (fe41417_32W_word64ize (proj1_fe41417_32W x'))) = true);
+    abstract (rewrite fe41417_32W_word64ize_id; apply is_bounded_proj1_fe41417_32).
+Defined.
+Definition wire_digits_word64ize (x : wire_digits) : wire_digits.
+Proof.
+  set (x' := x).
+  hnf in x; destruct_head' prod.
+  let lem := constr:(exist_wire_digitsW (wire_digitsW_word64ize (proj1_wire_digitsW x'))) in
+  let lem := (eval cbv [proj1_wire_digitsW x' wire_digitsW_word64ize proj_word exist_wire_digitsW Build_bounded_word Build_bounded_word'] in lem) in
+  let lem := do_change lem in
+  let lem := (eval cbv [word64ize opt.word64ize andb Z.leb Z.compare CompOpp Pos.compare] in lem) in
+  refine (lem _);
+    change (wire_digits_is_bounded (wire_digitsWToZ (wire_digitsW_word64ize (proj1_wire_digitsW x'))) = true);
+    abstract (rewrite wire_digitsW_word64ize_id; apply is_bounded_proj1_wire_digits).
+Defined.
+
+Lemma is_bounded_to_nth_default x (H : is_bounded x = true)
+  : forall n : nat,
+    (n < length limb_widths)%nat
+    -> (0 <= nth_default 0 (Tuple.to_list length_fe41417_32 x) n <=
+        snd (b_of (nth_default (-1) limb_widths n)))%Z.
+Proof.
+  hnf in x; destruct_head' prod.
+  unfold_is_bounded_in H; destruct_head' and.
+  Z.ltb_to_lt.
+  unfold nth_default; simpl.
+  intros.
+  repeat match goal with
+         | [ |- context[nth_error _ ?x] ]
+           => is_var x; destruct x; simpl
+         end;
+    omega.
+Qed.
+
+(* END precomputation *)
+
+(* Precompute constants *)
+
+Definition one' := Eval vm_compute in exist_fe41417_32 SpecificGen.GF41417_32.one_ eq_refl.
+Definition one := Eval cbv [one' fe41417_32_word64ize word64ize andb opt.word64ToZ opt.word64ize opt.Zleb Z.compare CompOpp Pos.compare Pos.compare_cont] in fe41417_32_word64ize one'.
+
+Definition zero' := Eval vm_compute in exist_fe41417_32 SpecificGen.GF41417_32.zero_ eq_refl.
+Definition zero := Eval cbv [zero' fe41417_32_word64ize word64ize andb opt.word64ToZ opt.word64ize opt.Zleb Z.compare CompOpp Pos.compare Pos.compare_cont] in fe41417_32_word64ize zero'.
+
+Lemma fold_chain_opt_gen {A B} (F : A -> B) is_bounded ls id' op' id op chain
+      (Hid_bounded : is_bounded (F id') = true)
+      (Hid : id = F id')
+      (Hop_bounded : forall x y, is_bounded (F x) = true
+                                 -> is_bounded (F y) = true
+                                 -> is_bounded (op (F x) (F y)) = true)
+      (Hop : forall x y, is_bounded (F x) = true
+                         -> is_bounded (F y) = true
+                         -> op (F x) (F y) = F (op' x y))
+      (Hls_bounded : forall n, is_bounded (F (nth_default id' ls n)) = true)
+  : F (fold_chain_opt id' op' chain ls)
+    = fold_chain_opt id op chain (List.map F ls)
+    /\ is_bounded (F (fold_chain_opt id' op' chain ls)) = true.
+Proof.
+  rewrite !fold_chain_opt_correct.
+  revert dependent ls; induction chain as [|x xs IHxs]; intros.
+  { pose proof (Hls_bounded 0%nat).
+    destruct ls; simpl; split; trivial; congruence. }
+  { destruct x; simpl; unfold Let_In; simpl.
+    rewrite (fun ls pf => proj1 (IHxs ls pf)) at 1; simpl.
+    { do 2 f_equal.
+      rewrite <- Hop, Hid by auto.
+      rewrite !map_nth_default_always.
+      split; try reflexivity.
+      apply (IHxs (_::_)).
+      intros [|?]; autorewrite with simpl_nth_default; auto.
+      rewrite <- Hop; auto. }
+    { intros [|?]; simpl;
+        autorewrite with simpl_nth_default; auto.
+      rewrite <- Hop; auto. } }
+Qed.
+
+Lemma encode_bounded x : is_bounded (encode x) = true.
+Proof.
+  pose proof (bounded_encode x).
+  generalize dependent (encode x).
+  intro t; compute in t; intros.
+  destruct_head' prod.
+  unfold Pow2Base.bounded in H.
+  cbv [nth_default Tuple.to_list Tuple.to_list' List.length limb_widths params41417_32] in H.
+  repeat match type of H with
+         | context[nth_error (cons _ _) _]
+           => let H' := fresh in
+              pose proof (H O) as H'; specialize (fun i => H (S i)); simpl @nth_error in H, H';
+                cbv beta iota in H'
+         end.
+  clear H.
+  simpl in *.
+  cbv [Z.pow_pos Z.mul Pos.mul Pos.iter nth_default nth_error value] in *.
+  unfold is_bounded.
+  apply fold_right_andb_true_iff_fold_right_and_True.
+  cbv [is_bounded proj1_fe41417_32 to_list length bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map List.rev List.app proj_word fold_right length_fe41417_32].
+  repeat split; rewrite !Bool.andb_true_iff, !Z.leb_le; omega.
+Qed.
+
+Definition encode (x : F modulus) : fe41417_32
+  := exist_fe41417_32 (encode x) (encode_bounded x).
+
+Definition decode (x : fe41417_32) : F modulus
+  := ModularBaseSystem.decode (proj1_fe41417_32 x).
+
+Lemma proj1_fe41417_32_encode x
+  : proj1_fe41417_32 (encode x) = ModularBaseSystem.encode x.
+Proof.
+  cbv [encode].
+  generalize (encode_bounded x); generalize (ModularBaseSystem.encode x).
+  intros y pf; intros; hnf in y; destruct_head_hnf' prod.
+  cbv [proj1_fe41417_32 exist_fe41417_32 proj1_fe41417_32W Build_bounded_word Build_bounded_word' fe41417_32WToZ proj_word].
+  unfold_is_bounded_in pf.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Lemma decode_exist_fe41417_32 x pf
+  : decode (exist_fe41417_32 x pf) = ModularBaseSystem.decode x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [decode proj1_fe41417_32 exist_fe41417_32 proj1_fe41417_32W Build_bounded_word Build_bounded_word' fe41417_32WToZ proj_word].
+  unfold_is_bounded_in pf.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Definition div (f g : fe41417_32) : fe41417_32
+  := exist_fe41417_32 (div (proj1_fe41417_32 f) (proj1_fe41417_32 g)) (encode_bounded _).
+
+Definition eq (f g : fe41417_32) : Prop := eq (proj1_fe41417_32 f) (proj1_fe41417_32 g).
+
+
+Notation ibinop_correct_and_bounded irop op
+  := (forall x y,
+         is_bounded (fe41417_32WToZ x) = true
+         -> is_bounded (fe41417_32WToZ y) = true
+         -> fe41417_32WToZ (irop x y) = op (fe41417_32WToZ x) (fe41417_32WToZ y)
+            /\ is_bounded (fe41417_32WToZ (irop x y)) = true) (only parsing).
+Notation iunop_correct_and_bounded irop op
+  := (forall x,
+         is_bounded (fe41417_32WToZ x) = true
+         -> fe41417_32WToZ (irop x) = op (fe41417_32WToZ x)
+            /\ is_bounded (fe41417_32WToZ (irop x)) = true) (only parsing).
+Notation iunop_FEToZ_correct irop op
+  := (forall x,
+         is_bounded (fe41417_32WToZ x) = true
+         -> word64ToZ (irop x) = op (fe41417_32WToZ x)) (only parsing).
+Notation iunop_FEToWire_correct_and_bounded irop op
+  := (forall x,
+         is_bounded (fe41417_32WToZ x) = true
+         -> wire_digitsWToZ (irop x) = op (fe41417_32WToZ x)
+            /\ wire_digits_is_bounded (wire_digitsWToZ (irop x)) = true) (only parsing).
+Notation iunop_WireToFE_correct_and_bounded irop op
+  := (forall x,
+         wire_digits_is_bounded (wire_digitsWToZ x) = true
+         -> fe41417_32WToZ (irop x) = op (wire_digitsWToZ x)
+            /\ is_bounded (fe41417_32WToZ (irop x)) = true) (only parsing).
+
+Definition prefreeze := GF41417_32.prefreeze.
diff --git a/src/SpecificGen/GF41417_32Reflective.v b/src/SpecificGen/GF41417_32Reflective.v
new file mode 100644
index 000000000..d85e22870
--- /dev/null
+++ b/src/SpecificGen/GF41417_32Reflective.v
@@ -0,0 +1,119 @@
+Require Import Crypto.BaseSystem.
+Require Import Crypto.ModularArithmetic.PrimeFieldTheorems.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParams.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParamProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystem.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemOpt.
+Require Export Crypto.SpecificGen.GF41417_32.
+Require Import Crypto.SpecificGen.GF41417_32BoundedCommon.
+Require Import Crypto.Reflection.Reify.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Crypto.Reflection.Z.Interpretations.Relations.
+Require Import Crypto.Reflection.Z.Interpretations.RelationsCombinations.
+Require Import Crypto.Reflection.Z.Reify.
+Require Import Crypto.Reflection.Z.Syntax.
+Require Import Crypto.SpecificGen.GF41417_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF41417_32Reflective.Reified.
+Require Import Bedrock.Word Crypto.Util.WordUtil.
+Require Import Coq.Lists.List Crypto.Util.ListUtil.
+Require Import Crypto.Tactics.VerdiTactics.
+Require Import Crypto.Util.ZUtil.
+Require Import Crypto.Util.Tuple.
+Require Import Crypto.Util.Tactics.
+Require Import Crypto.Util.LetIn.
+Require Import Crypto.Util.Notations.
+Require Import Crypto.Util.Bool.
+Require Import Crypto.Util.Decidable.
+Require Import Crypto.Algebra.
+Import ListNotations.
+Require Import Coq.ZArith.ZArith Coq.ZArith.Zpower Coq.ZArith.ZArith Coq.ZArith.Znumtheory.
+Local Open Scope Z.
+
+Definition radd : ExprBinOp := Eval vm_compute in rcarry_addW.
+Definition rsub : ExprBinOp := Eval vm_compute in rcarry_subW.
+Definition rmul : ExprBinOp := Eval vm_compute in rmulW.
+Definition ropp : ExprUnOp := Eval vm_compute in rcarry_oppW.
+Definition rprefreeze : ExprUnOp := Eval vm_compute in rprefreezeW.
+Definition rge_modulus : ExprUnOpFEToZ := Eval vm_compute in rge_modulusW.
+Definition rpack : ExprUnOpFEToWire := Eval vm_compute in rpackW.
+Definition runpack : ExprUnOpWireToFE := Eval vm_compute in runpackW.
+
+Definition rword64ize {t} (x : Expr t) : Expr t
+  := MapInterp (fun t => match t with TZ => word64ize end) x.
+
+Declare Reduction asm_interp
+  := cbv beta iota delta
+         [id
+            interp_bexpr interp_uexpr interp_uexpr_FEToWire interp_uexpr_FEToZ interp_uexpr_WireToFE
+            radd rsub rmul ropp rprefreeze rge_modulus rpack runpack
+            curry_binop_fe41417_32W curry_unop_fe41417_32W curry_unop_wire_digitsW
+            Word64.interp_op Word64.interp_base_type
+            Z.interp_op Z.interp_base_type
+            Z.Syntax.interp_op Z.Syntax.interp_base_type
+            mapf_interp_flat_type map_interp Word64.interp_base_type MapInterp mapf_interp word64ize rword64ize
+            Interp interp interp_flat_type interpf interp_flat_type fst snd].
+Ltac asm_interp
+  := cbv beta iota delta
+         [id
+            interp_bexpr interp_uexpr interp_uexpr_FEToWire interp_uexpr_FEToZ interp_uexpr_WireToFE
+            radd rsub rmul ropp rprefreeze rge_modulus rpack runpack
+            curry_binop_fe41417_32W curry_unop_fe41417_32W curry_unop_wire_digitsW
+            Word64.interp_op Word64.interp_base_type
+            Z.interp_op Z.interp_base_type
+            Z.Syntax.interp_op Z.Syntax.interp_base_type
+            mapf_interp_flat_type map_interp Word64.interp_base_type MapInterp mapf_interp word64ize rword64ize
+            Interp interp interp_flat_type interpf interp_flat_type fst snd].
+
+
+Definition interp_radd : SpecificGen.GF41417_32BoundedCommon.fe41417_32W -> SpecificGen.GF41417_32BoundedCommon.fe41417_32W -> SpecificGen.GF41417_32BoundedCommon.fe41417_32W
+  := Eval asm_interp in interp_bexpr (rword64ize radd).
+(*Print interp_radd.*)
+Definition interp_radd_correct : interp_radd = interp_bexpr radd := eq_refl.
+Definition interp_rsub : SpecificGen.GF41417_32BoundedCommon.fe41417_32W -> SpecificGen.GF41417_32BoundedCommon.fe41417_32W -> SpecificGen.GF41417_32BoundedCommon.fe41417_32W
+  := Eval asm_interp in interp_bexpr (rword64ize rsub).
+(*Print interp_rsub.*)
+Definition interp_rsub_correct : interp_rsub = interp_bexpr rsub := eq_refl.
+Definition interp_rmul : SpecificGen.GF41417_32BoundedCommon.fe41417_32W -> SpecificGen.GF41417_32BoundedCommon.fe41417_32W -> SpecificGen.GF41417_32BoundedCommon.fe41417_32W
+  := Eval asm_interp in interp_bexpr (rword64ize rmul).
+(*Print interp_rmul.*)
+Definition interp_rmul_correct : interp_rmul = interp_bexpr rmul := eq_refl.
+Definition interp_ropp : SpecificGen.GF41417_32BoundedCommon.fe41417_32W -> SpecificGen.GF41417_32BoundedCommon.fe41417_32W
+  := Eval asm_interp in interp_uexpr (rword64ize ropp).
+(*Print interp_ropp.*)
+Definition interp_ropp_correct : interp_ropp = interp_uexpr ropp := eq_refl.
+Definition interp_rprefreeze : SpecificGen.GF41417_32BoundedCommon.fe41417_32W -> SpecificGen.GF41417_32BoundedCommon.fe41417_32W
+  := Eval asm_interp in interp_uexpr (rword64ize rprefreeze).
+(*Print interp_rprefreeze.*)
+Definition interp_rprefreeze_correct : interp_rprefreeze = interp_uexpr rprefreeze := eq_refl.
+
+Definition interp_rge_modulus : SpecificGen.GF41417_32BoundedCommon.fe41417_32W -> SpecificGen.GF41417_32BoundedCommon.word64
+  := Eval asm_interp in interp_uexpr_FEToZ (rword64ize rge_modulus).
+Definition interp_rge_modulus_correct : interp_rge_modulus = interp_uexpr_FEToZ rge_modulus := eq_refl.
+
+Definition interp_rpack : SpecificGen.GF41417_32BoundedCommon.fe41417_32W -> SpecificGen.GF41417_32BoundedCommon.wire_digitsW
+  := Eval asm_interp in interp_uexpr_FEToWire (rword64ize rpack).
+Definition interp_rpack_correct : interp_rpack = interp_uexpr_FEToWire rpack := eq_refl.
+
+Definition interp_runpack : SpecificGen.GF41417_32BoundedCommon.wire_digitsW -> SpecificGen.GF41417_32BoundedCommon.fe41417_32W
+  := Eval asm_interp in interp_uexpr_WireToFE (rword64ize runpack).
+Definition interp_runpack_correct : interp_runpack = interp_uexpr_WireToFE runpack := eq_refl.
+
+Lemma radd_correct_and_bounded : binop_correct_and_bounded radd carry_add.
+Proof. exact rcarry_addW_correct_and_bounded. Qed.
+Lemma rsub_correct_and_bounded : binop_correct_and_bounded rsub carry_sub.
+Proof. exact rcarry_subW_correct_and_bounded. Qed.
+Lemma rmul_correct_and_bounded : binop_correct_and_bounded rmul mul.
+Proof. exact rmulW_correct_and_bounded. Qed.
+Lemma ropp_correct_and_bounded : unop_correct_and_bounded ropp carry_opp.
+Proof. exact rcarry_oppW_correct_and_bounded. Qed.
+Lemma rprefreeze_correct_and_bounded : unop_correct_and_bounded rprefreeze prefreeze.
+Proof. exact rprefreezeW_correct_and_bounded. Qed.
+Lemma rge_modulus_correct_and_bounded : unop_FEToZ_correct rge_modulus ge_modulus.
+Proof. exact rge_modulusW_correct_and_bounded. Qed.
+Lemma rpack_correct_and_bounded : unop_FEToWire_correct_and_bounded rpack pack.
+Proof. exact rpackW_correct_and_bounded. Qed.
+Lemma runpack_correct_and_bounded : unop_WireToFE_correct_and_bounded runpack unpack.
+Proof. exact runpackW_correct_and_bounded. Qed.
diff --git a/src/SpecificGen/GF41417_32Reflective/Common.v b/src/SpecificGen/GF41417_32Reflective/Common.v
new file mode 100644
index 000000000..517c66d8a
--- /dev/null
+++ b/src/SpecificGen/GF41417_32Reflective/Common.v
@@ -0,0 +1,438 @@
+Require Export Coq.ZArith.ZArith.
+Require Export Coq.Strings.String.
+Require Export Crypto.SpecificGen.GF41417_32.
+Require Export Crypto.SpecificGen.GF41417_32BoundedCommon.
+Require Import Crypto.Reflection.Reify.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Crypto.Reflection.Z.Interpretations.Relations.
+Require Import Crypto.Reflection.Z.Interpretations.RelationsCombinations.
+Require Import Crypto.Reflection.Z.Reify.
+Require Export Crypto.Reflection.Z.Syntax.
+Require Import Crypto.Reflection.InterpWfRel.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Reflection.MapInterpWf.
+Require Import Crypto.Reflection.WfReflective.
+Require Import Crypto.Util.LetIn.
+Require Import Crypto.Util.ZUtil.
+Require Import Crypto.Util.Tactics.
+Require Import Crypto.Util.Notations.
+
+Notation Expr := (Expr base_type Word64.interp_base_type op).
+
+Local Ltac make_type_from uncurried_op :=
+  let T := (type of uncurried_op) in
+  let T := (eval compute in T) in
+  let rT := reify_type T in
+  exact rT.
+
+Definition ExprBinOpT : type base_type.
+Proof. make_type_from (uncurry_binop_fe41417_32 carry_add). Defined.
+Definition ExprUnOpT : type base_type.
+Proof. make_type_from (uncurry_unop_fe41417_32 carry_opp). Defined.
+Definition ExprUnOpFEToZT : type base_type.
+Proof. make_type_from (uncurry_unop_fe41417_32 ge_modulus). Defined.
+Definition ExprUnOpWireToFET : type base_type.
+Proof. make_type_from (uncurry_unop_wire_digits unpack). Defined.
+Definition ExprUnOpFEToWireT : type base_type.
+Proof. make_type_from (uncurry_unop_fe41417_32 pack). Defined.
+Definition ExprBinOp : Type := Expr ExprBinOpT.
+Definition ExprUnOp : Type := Expr ExprUnOpT.
+Definition ExprUnOpFEToZ : Type := Expr ExprUnOpFEToZT.
+Definition ExprUnOpWireToFE : Type := Expr ExprUnOpWireToFET.
+Definition ExprUnOpFEToWire : Type := Expr ExprUnOpFEToWireT.
+
+Local Ltac bounds_from_list ls :=
+  lazymatch (eval hnf in ls) with
+  | (?x :: nil)%list => constr:(Some {| ZBounds.lower := fst x ; ZBounds.upper := snd x |})
+  | (?x :: ?xs)%list => let bs := bounds_from_list xs in
+                        constr:((Some {| ZBounds.lower := fst x ; ZBounds.upper := snd x |}, bs))
+  end.
+
+Local Ltac make_bounds ls :=
+  compute;
+  let v := bounds_from_list (List.rev ls) in
+  let v := (eval compute in v) in
+  exact v.
+
+Definition ExprBinOp_bounds : interp_all_binders_for ExprBinOpT ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ bounds ++ Tuple.to_list _ bounds)%list. Defined.
+Definition ExprUnOp_bounds : interp_all_binders_for ExprUnOpT ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ bounds). Defined.
+Definition ExprUnOpFEToZ_bounds : interp_all_binders_for ExprUnOpFEToZT ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ bounds). Defined.
+Definition ExprUnOpFEToWire_bounds : interp_all_binders_for ExprUnOpFEToWireT ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ bounds). Defined.
+Definition ExprUnOpWireToFE_bounds : interp_all_binders_for ExprUnOpWireToFET ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ wire_digit_bounds). Defined.
+
+Definition interp_bexpr : ExprBinOp -> SpecificGen.GF41417_32BoundedCommon.fe41417_32W -> SpecificGen.GF41417_32BoundedCommon.fe41417_32W -> SpecificGen.GF41417_32BoundedCommon.fe41417_32W
+  := fun e => curry_binop_fe41417_32W (Interp (@Word64.interp_op) e).
+Definition interp_uexpr : ExprUnOp -> SpecificGen.GF41417_32BoundedCommon.fe41417_32W -> SpecificGen.GF41417_32BoundedCommon.fe41417_32W
+  := fun e => curry_unop_fe41417_32W (Interp (@Word64.interp_op) e).
+Definition interp_uexpr_FEToZ : ExprUnOpFEToZ -> SpecificGen.GF41417_32BoundedCommon.fe41417_32W -> SpecificGen.GF41417_32BoundedCommon.word64
+  := fun e => curry_unop_fe41417_32W (Interp (@Word64.interp_op) e).
+Definition interp_uexpr_FEToWire : ExprUnOpFEToWire -> SpecificGen.GF41417_32BoundedCommon.fe41417_32W -> SpecificGen.GF41417_32BoundedCommon.wire_digitsW
+  := fun e => curry_unop_fe41417_32W (Interp (@Word64.interp_op) e).
+Definition interp_uexpr_WireToFE : ExprUnOpWireToFE -> SpecificGen.GF41417_32BoundedCommon.wire_digitsW -> SpecificGen.GF41417_32BoundedCommon.fe41417_32W
+  := fun e => curry_unop_wire_digitsW (Interp (@Word64.interp_op) e).
+
+Notation binop_correct_and_bounded rop op
+  := (ibinop_correct_and_bounded (interp_bexpr rop) op) (only parsing).
+Notation unop_correct_and_bounded rop op
+  := (iunop_correct_and_bounded (interp_uexpr rop) op) (only parsing).
+Notation unop_FEToZ_correct rop op
+  := (iunop_FEToZ_correct (interp_uexpr_FEToZ rop) op) (only parsing).
+Notation unop_FEToWire_correct_and_bounded rop op
+  := (iunop_FEToWire_correct_and_bounded (interp_uexpr_FEToWire rop) op) (only parsing).
+Notation unop_WireToFE_correct_and_bounded rop op
+  := (iunop_WireToFE_correct_and_bounded (interp_uexpr_WireToFE rop) op) (only parsing).
+
+Ltac rexpr_cbv :=
+  lazymatch goal with
+  | [ |- { rexpr | interp_type_gen_rel_pointwise _ (Interp _ (t:=?T) rexpr) (?uncurry ?oper) } ]
+    => let operf := head oper in
+       let uncurryf := head uncurry in
+       try cbv delta [T]; try cbv delta [oper];
+       try cbv beta iota delta [uncurryf]
+  end;
+  cbv beta iota delta [interp_flat_type Z.interp_base_type interp_base_type zero_].
+
+Ltac reify_sig :=
+  rexpr_cbv; eexists; Reify_rhs; reflexivity.
+
+Local Notation rexpr_sig T uncurried_op :=
+  { rexprZ
+  | interp_type_gen_rel_pointwise (fun _ => Logic.eq) (Interp interp_op (t:=T) rexprZ) uncurried_op }
+    (only parsing).
+
+Notation rexpr_binop_sig op := (rexpr_sig ExprBinOpT (uncurry_binop_fe41417_32 op)) (only parsing).
+Notation rexpr_unop_sig op := (rexpr_sig ExprUnOpT (uncurry_unop_fe41417_32 op)) (only parsing).
+Notation rexpr_unop_FEToZ_sig op := (rexpr_sig ExprUnOpFEToZT (uncurry_unop_fe41417_32 op)) (only parsing).
+Notation rexpr_unop_FEToWire_sig op := (rexpr_sig ExprUnOpFEToWireT (uncurry_unop_fe41417_32 op)) (only parsing).
+Notation rexpr_unop_WireToFE_sig op := (rexpr_sig ExprUnOpWireToFET (uncurry_unop_wire_digits op)) (only parsing).
+
+Notation correct_and_bounded_genT ropW'v ropZ_sigv
+  := (let ropW' := ropW'v in
+      let ropZ_sig := ropZ_sigv in
+      let ropW := MapInterp (fun _ x => x) ropW' in
+      let ropZ := MapInterp Word64.to_Z ropW' in
+      let ropBounds := MapInterp ZBounds.of_word64 ropW' in
+      let ropBoundedWord64 := MapInterp BoundedWord64.of_word64 ropW' in
+      ropZ = proj1_sig ropZ_sig
+      /\ interp_type_rel_pointwise2 Relations.related_Z (Interp (@BoundedWord64.interp_op) ropBoundedWord64) (Interp (@Z.interp_op) ropZ)
+      /\ interp_type_rel_pointwise2 Relations.related_bounds (Interp (@BoundedWord64.interp_op) ropBoundedWord64) (Interp (@ZBounds.interp_op) ropBounds)
+      /\ interp_type_rel_pointwise2 Relations.related_word64 (Interp (@BoundedWord64.interp_op) ropBoundedWord64) (Interp (@Word64.interp_op) ropW))
+       (only parsing).
+
+Ltac app_tuples x y :=
+  let tx := type of x in
+  lazymatch (eval hnf in tx) with
+  | prod _ _ => let xs := app_tuples (snd x) y in
+                constr:((fst x, xs))
+  | _ => constr:((x, y))
+  end.
+
+Local Arguments Tuple.map2 : simpl never.
+Local Arguments Tuple.map : simpl never.
+
+Fixpoint args_to_bounded_helperT {n}
+         (v : Tuple.tuple' Word64.word64 n)
+         (bounds : Tuple.tuple' (Z * Z) n)
+         (pf : List.fold_right
+                 andb true
+                 (Tuple.to_list
+                    _
+                    (Tuple.map2
+                       (n:=S n)
+                       (fun bounds v =>
+                          let '(lower, upper) := bounds in ((lower <=? v)%Z && (v <=? upper)%Z)%bool)
+                       bounds
+                       (Tuple.map (n:=S n) Word64.word64ToZ v))) = true)
+         (res : Type)
+         {struct n}
+  : Type.
+Proof.
+  refine (match n return (forall (v : Tuple.tuple' _ n) (bounds : Tuple.tuple' _ n),
+                             List.fold_right
+                               _ _ (Tuple.to_list
+                                      _
+                                      (Tuple.map2 (n:=S n) _ bounds (Tuple.map (n:=S n) _ v))) = true
+                             -> Type)
+          with
+          | 0 => fun v' bounds' pf0 => forall pf1 : (0 <= fst bounds' /\ Z.log2 (snd bounds') < Z.of_nat Word64.bit_width)%Z, res
+          | S n' => fun v' bounds' pf0 => let t := _ in
+                                        forall pf1 : (0 <= fst (snd bounds') /\ Z.log2 (snd (snd bounds')) < Z.of_nat Word64.bit_width)%Z, @args_to_bounded_helperT n' (fst v') (fst bounds') t res
+          end v bounds pf).
+  { clear -pf0.
+    abstract (
+        destruct v', bounds'; simpl @fst;
+        rewrite Tuple.map_S in pf0;
+        simpl in pf0;
+        rewrite Tuple.map2_S in pf0;
+        simpl @List.fold_right in *;
+        rewrite Bool.andb_true_iff in pf0; tauto
+      ). }
+Defined.
+
+Fixpoint args_to_bounded_helper {n} res
+         {struct n}
+  : forall v bounds pf, (Tuple.tuple' BoundedWord64.BoundedWord n -> res) -> @args_to_bounded_helperT n v bounds pf res.
+Proof.
+  refine match n return (forall v bounds pf, (Tuple.tuple' BoundedWord64.BoundedWord n -> res) -> @args_to_bounded_helperT n v bounds pf res) with
+         | 0 => fun v bounds pf f pf' => f {| BoundedWord64.lower := fst bounds ; BoundedWord64.value := v ; BoundedWord64.upper := snd bounds |}
+         | S n'
+           => fun v bounds pf f pf'
+              => @args_to_bounded_helper
+                   n' res (fst v) (fst bounds) _
+                   (fun ts => f (ts, {| BoundedWord64.lower := fst (snd bounds) ; BoundedWord64.value := snd v ; BoundedWord64.upper := snd (snd bounds) |}))
+         end.
+  { clear -pf pf'.
+    unfold Tuple.map2, Tuple.map in pf; simpl in *.
+    abstract (
+        destruct bounds;
+        simpl in *;
+        rewrite !Bool.andb_true_iff in pf;
+        destruct_head' and;
+        Z.ltb_to_lt; auto
+      ). }
+  { simpl in *.
+    clear -pf pf'.
+    abstract (
+        destruct bounds as [? [? ?] ], v; simpl in *;
+        rewrite Tuple.map_S in pf; simpl in pf; rewrite Tuple.map2_S in pf;
+        simpl in pf;
+        rewrite !Bool.andb_true_iff in pf;
+        destruct_head' and;
+        Z.ltb_to_lt; auto
+      ). }
+Defined.
+
+Definition assoc_right''
+  := Eval cbv [Tuple.assoc_right' Tuple.rsnoc' fst snd] in @Tuple.assoc_right'.
+
+Definition args_to_bounded {n} v bounds pf
+  := Eval cbv [args_to_bounded_helper assoc_right''] in
+      @args_to_bounded_helper n _ v bounds pf (@assoc_right'' _ _).
+
+Local Ltac get_len T :=
+  match (eval hnf in T) with
+  | prod ?A ?B
+    => let a := get_len A in
+       let b := get_len B in
+       (eval compute in (a + b)%nat)
+  | _ => constr:(1%nat)
+  end.
+
+Local Ltac args_to_bounded x H :=
+  let x' := fresh in
+  set (x' := x);
+  compute in x;
+  let len := (let T := type of x in get_len T) in
+  destruct_head' prod;
+  let c := constr:(args_to_bounded (n:=pred len) x' _ H) in
+  let bounds := lazymatch c with args_to_bounded _ ?bounds _ => bounds end in
+  let c := (eval cbv [all_binders_for ExprUnOpT interp_flat_type args_to_bounded bounds pred fst snd] in c) in
+  apply c; compute; clear;
+  try abstract (
+        repeat split;
+        solve [ reflexivity
+              | refine (fun v => match v with eq_refl => I end) ]
+      ).
+
+Definition unop_args_to_bounded (x : fe41417_32W) (H : is_bounded (fe41417_32WToZ x) = true)
+  : interp_flat_type (fun _ => BoundedWord64.BoundedWord) (all_binders_for ExprUnOpT).
+Proof. args_to_bounded x H. Defined.
+
+Definition unopWireToFE_args_to_bounded (x : wire_digitsW) (H : wire_digits_is_bounded (wire_digitsWToZ x) = true)
+  : interp_flat_type (fun _ => BoundedWord64.BoundedWord) (all_binders_for ExprUnOpWireToFET).
+Proof. args_to_bounded x H. Defined.
+Definition binop_args_to_bounded (x : fe41417_32W * fe41417_32W)
+           (H : is_bounded (fe41417_32WToZ (fst x)) = true)
+           (H' : is_bounded (fe41417_32WToZ (snd x)) = true)
+  : interp_flat_type (fun _ => BoundedWord64.BoundedWord) (all_binders_for ExprBinOpT).
+Proof.
+  let v := app_tuples (unop_args_to_bounded (fst x) H) (unop_args_to_bounded (snd x) H') in
+  exact v.
+Defined.
+
+Ltac assoc_right_tuple x so_far :=
+  let t := type of x in
+  lazymatch (eval hnf in t) with
+  | prod _ _ => let so_far := assoc_right_tuple (snd x) so_far in
+                assoc_right_tuple (fst x) so_far
+  | _ => lazymatch so_far with
+         | @None => x
+         | _ => constr:((x, so_far))
+         end
+  end.
+
+Local Ltac make_bounds_prop bounds orig_bounds :=
+  let bounds' := fresh "bounds'" in
+  let bounds_bad := fresh "bounds_bad" in
+  rename bounds into bounds_bad;
+  let boundsv := assoc_right_tuple bounds_bad (@None) in
+  pose boundsv as bounds;
+  pose orig_bounds as bounds';
+  repeat (refine (match fst bounds' with
+                  | Some bounds' => let (l, u) := fst bounds in
+                                    let (l', u') := bounds' in
+                                    ((l' <=? l) && (u <=? u'))%Z%bool
+                  | None => false
+                  end && _)%bool;
+          destruct bounds' as [_ bounds'], bounds as [_ bounds]);
+  try exact (match bounds' with
+             | Some bounds' => let (l, u) := bounds in
+                               let (l', u') := bounds' in
+                               ((l' <=? l) && (u <=? u'))%Z%bool
+             | None => false
+             end).
+
+Definition unop_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprUnOpT)) : bool.
+Proof. make_bounds_prop bounds ExprUnOp_bounds. Defined.
+Definition binop_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprBinOpT)) : bool.
+Proof. make_bounds_prop bounds ExprUnOp_bounds. Defined.
+Definition unopFEToWire_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprUnOpFEToWireT)) : bool.
+Proof. make_bounds_prop bounds ExprUnOpWireToFE_bounds. Defined.
+Definition unopWireToFE_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprUnOpWireToFET)) : bool.
+Proof. make_bounds_prop bounds ExprUnOp_bounds. Defined.
+(* TODO FIXME(jgross?, andreser?): Is every function returning a single Z a boolean function? *)
+Definition unopFEToZ_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprUnOpFEToZT)) : bool.
+Proof.
+  refine (let (l, u) := bounds in ((0 <=? l) && (u <=? 1))%Z%bool).
+Defined.
+
+(* FIXME TODO(jgross): This is a horrible tactic.  We should unify the
+    various kinds of correct and boundedness, and abstract in Gallina
+    rather than Ltac *)
+
+Ltac t_correct_and_bounded ropZ_sig Hbounds H0 H1 args :=
+  let Heq := fresh "Heq" in
+  let Hbounds0 := fresh "Hbounds0" in
+  let Hbounds1 := fresh "Hbounds1" in
+  let Hbounds2 := fresh "Hbounds2" in
+  pose proof (proj2_sig ropZ_sig) as Heq;
+  cbv [interp_bexpr interp_uexpr interp_uexpr_FEToWire interp_uexpr_FEToZ interp_uexpr_WireToFE
+                    curry_binop_fe41417_32W curry_unop_fe41417_32W curry_unop_wire_digitsW
+                    curry_binop_fe41417_32 curry_unop_fe41417_32 curry_unop_wire_digits
+                    uncurry_binop_fe41417_32W uncurry_unop_fe41417_32W uncurry_unop_wire_digitsW
+                    uncurry_binop_fe41417_32 uncurry_unop_fe41417_32 uncurry_unop_wire_digits
+                    ExprBinOpT ExprUnOpFEToWireT ExprUnOpT ExprUnOpFEToZT ExprUnOpWireToFET
+                    interp_type_gen_rel_pointwise interp_type_gen_rel_pointwise] in *;
+  cbv zeta in *;
+  simpl @fe41417_32WToZ; simpl @wire_digitsWToZ;
+  rewrite <- Heq; clear Heq;
+  destruct Hbounds as [Heq Hbounds];
+  change interp_op with (@Z.interp_op) in *;
+  change interp_base_type with (@Z.interp_base_type) in *;
+  rewrite <- Heq; clear Heq;
+  destruct Hbounds as [ Hbounds0 [Hbounds1 Hbounds2] ];
+  pose proof (fun pf => Relations.uncurry_interp_type_rel_pointwise2_proj_from_option2 Word64.to_Z pf Hbounds2 Hbounds0) as Hbounds_left;
+  pose proof (fun pf => Relations.uncurry_interp_type_rel_pointwise2_proj1_from_option2 Relations.related_word64_boundsi' pf Hbounds1 Hbounds2) as Hbounds_right;
+  specialize_by repeat first [ progress intros
+                             | reflexivity
+                             | assumption
+                             | progress destruct_head' base_type
+                             | progress destruct_head' BoundedWord64.BoundedWord
+                             | progress destruct_head' and
+                             | progress repeat apply conj ];
+  specialize (Hbounds_left args H0);
+  specialize (Hbounds_right args H0);
+  cbv beta in *;
+  lazymatch type of Hbounds_right with
+  | match ?e with _ => _ end
+    => lazymatch type of H1 with
+       | match ?e' with _ => _ end
+         => change e' with e in H1; destruct e eqn:?; [ | exfalso; assumption ]
+       end
+  end;
+  repeat match goal with x := _ |- _ => subst x end;
+  cbv [id
+         binop_args_to_bounded unop_args_to_bounded unopWireToFE_args_to_bounded
+         Relations.proj_eq_rel interp_flat_type_rel_pointwise2 SmartVarfMap interp_flat_type smart_interp_flat_map Application.all_binders_for fst snd BoundedWord64.to_word64' BoundedWord64.boundedWordToWord64 BoundedWord64.value Application.ApplyInterpedAll Application.fst_binder Application.snd_binder interp_flat_type_rel_pointwise2_gen_Prop Relations.related_word64_boundsi' Relations.related'_word64_bounds ZBounds.upper ZBounds.lower Application.remove_all_binders Word64.to_Z] in Hbounds_left, Hbounds_right;
+  match goal with
+  | [ |- fe41417_32WToZ ?x = _ /\ _ ]
+    => destruct x; destruct_head_hnf' prod
+  | [ |- wire_digitsWToZ ?x = _ /\ _ ]
+    => destruct x; destruct_head_hnf' prod
+  | [ |- _ = _ ]
+    => exact Hbounds_left
+  end;
+  change word64ToZ with Word64.word64ToZ in *;
+  (split; [ exact Hbounds_left | ]);
+  cbv [interp_flat_type] in *;
+  cbv [fst snd
+           binop_bounds_good unop_bounds_good unopFEToWire_bounds_good unopWireToFE_bounds_good unopFEToZ_bounds_good
+           ExprUnOp_bounds ExprBinOp_bounds ExprUnOpFEToWire_bounds ExprUnOpFEToZ_bounds ExprUnOpWireToFE_bounds] in H1;
+  destruct_head' ZBounds.bounds;
+  unfold_is_bounded_in H1;
+  simpl @fe41417_32WToZ; simpl @wire_digitsWToZ;
+  unfold_is_bounded;
+  destruct_head' and;
+  Z.ltb_to_lt;
+  change Word64.word64ToZ with word64ToZ in *;
+  repeat apply conj; Z.ltb_to_lt; try omega; try reflexivity.
+
+
+Ltac rexpr_correct :=
+  let ropW' := fresh in
+  let ropZ_sig := fresh in
+  intros ropW' ropZ_sig;
+  let wf_ropW := fresh "wf_ropW" in
+  assert (wf_ropW : Wf ropW') by (subst ropW' ropZ_sig; reflect_Wf base_type_eq_semidec_is_dec op_beq_bl);
+  cbv zeta; repeat apply conj;
+  [ vm_compute; reflexivity
+  | apply @InterpRelWf;
+    [ | apply @RelWfMapInterp, wf_ropW ].. ];
+  auto with interp_related.
+
+Notation rword_of_Z rexprZ_sig := (MapInterp Word64.of_Z (proj1_sig rexprZ_sig)) (only parsing).
+
+Notation compute_bounds opW bounds
+  := (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp (@ZBounds.of_word64) opW)) bounds)
+       (only parsing).
+
+
+Module Export PrettyPrinting.
+  (* We add [enlargen] to force [bounds_on] to be in [Type] in 8.4 and
+     8.5/8.6.  Because [Set] is special and things break if
+     [bounds_on] ends up in [Set] for reasons jgross hasn't bothered
+     to debug. *)
+  Inductive bounds_on := overflow | in_range (lower upper : Z) | enlargen (_ : Set).
+
+  Inductive result := yes | no | borked.
+
+  Definition ZBounds_to_bounds_on
+    := fun t : base_type
+       => match t return ZBounds.interp_base_type t -> match t with TZ => bounds_on end with
+          | TZ => fun x => match x with
+                           | Some {| ZBounds.lower := l ; ZBounds.upper := u |}
+                             => in_range l u
+                           | None
+                             => overflow
+                           end
+          end.
+
+  Fixpoint does_it_overflow {t} : interp_flat_type (fun t => match t with TZ => bounds_on end) t -> result
+    := match t return interp_flat_type (fun t => match t with TZ => bounds_on end) t -> result with
+       | Tbase TZ => fun v => match v with
+                              | overflow => yes
+                              | in_range _ _ => no
+                              | enlargen _ => borked
+                              end
+       | Prod x y => fun v => match @does_it_overflow _ (fst v), @does_it_overflow _ (snd v) with
+                              | no, no => no
+                              | yes, no | no, yes | yes, yes => yes
+                              | borked, _ | _, borked => borked
+                              end
+       end.
+
+  (** This gives a slightly easier to read version of the bounds *)
+  Notation compute_bounds_for_display opW bounds
+    := (SmartVarfMap ZBounds_to_bounds_on (compute_bounds opW bounds)) (only parsing).
+  Notation sanity_compute opW bounds
+    := (does_it_overflow (SmartVarfMap ZBounds_to_bounds_on (compute_bounds opW bounds))) (only parsing).
+  Notation sanity_check opW bounds
+    := (eq_refl (sanity_compute opW bounds) <: no = no) (only parsing).
+End PrettyPrinting.
diff --git a/src/SpecificGen/GF41417_32Reflective/CommonBinOp.v b/src/SpecificGen/GF41417_32Reflective/CommonBinOp.v
new file mode 100644
index 000000000..93a83cf51
--- /dev/null
+++ b/src/SpecificGen/GF41417_32Reflective/CommonBinOp.v
@@ -0,0 +1,50 @@
+Require Export Crypto.SpecificGen.GF41417_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF41417_32BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprBinOp_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_binop_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall xy
+                   (xy := (eta_fe41417_32W (fst xy), eta_fe41417_32W (snd xy)))
+                   (Hxy : is_bounded (fe41417_32WToZ (fst xy)) = true
+                          /\ is_bounded (fe41417_32WToZ (snd xy)) = true),
+          let Hx := let (Hx, Hy) := Hxy in Hx in
+          let Hy := let (Hx, Hy) := Hxy in Hy in
+          let args := binop_args_to_bounded xy Hx Hy in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall xy
+                   (xy := (eta_fe41417_32W (fst xy), eta_fe41417_32W (snd xy)))
+                   (Hxy : is_bounded (fe41417_32WToZ (fst xy)) = true
+                          /\ is_bounded (fe41417_32WToZ (snd xy)) = true),
+          let Hx := let (Hx, Hy) := Hxy in Hx in
+          let Hy := let (Hx, Hy) := Hxy in Hy in
+          let args := binop_args_to_bounded (fst xy, snd xy) Hx Hy in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => binop_bounds_good bounds = true
+          | None => False
+          end)
+  : binop_correct_and_bounded (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x y Hx Hy.
+  pose x as x'; pose y as y'.
+  hnf in x, y; destruct_head' prod.
+  specialize (H0 (x', y') (conj Hx Hy)).
+  specialize (H1 (x', y') (conj Hx Hy)).
+  let args := constr:(binop_args_to_bounded (x', y') Hx Hy) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF41417_32Reflective/CommonUnOp.v b/src/SpecificGen/GF41417_32Reflective/CommonUnOp.v
new file mode 100644
index 000000000..c616b1a77
--- /dev/null
+++ b/src/SpecificGen/GF41417_32Reflective/CommonUnOp.v
@@ -0,0 +1,44 @@
+Require Export Crypto.SpecificGen.GF41417_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF41417_32BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprUnOp_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_unop_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall x
+                   (x := eta_fe41417_32W x)
+                   (Hx : is_bounded (fe41417_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall x
+                   (x := eta_fe41417_32W x)
+                   (Hx : is_bounded (fe41417_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => unop_bounds_good bounds = true
+          | None => False
+          end)
+  : unop_correct_and_bounded (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x Hx.
+  pose x as x'.
+  hnf in x; destruct_head' prod.
+  specialize (H0 x' Hx).
+  specialize (H1 x' Hx).
+  let args := constr:(unop_args_to_bounded x' Hx) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF41417_32Reflective/CommonUnOpFEToWire.v b/src/SpecificGen/GF41417_32Reflective/CommonUnOpFEToWire.v
new file mode 100644
index 000000000..7391e98bf
--- /dev/null
+++ b/src/SpecificGen/GF41417_32Reflective/CommonUnOpFEToWire.v
@@ -0,0 +1,44 @@
+Require Export Crypto.SpecificGen.GF41417_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF41417_32BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprUnOpFEToWire_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_unop_FEToWire_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall x
+                   (x := eta_fe41417_32W x)
+                   (Hx : is_bounded (fe41417_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall x
+                   (x := eta_fe41417_32W x)
+                   (Hx : is_bounded (fe41417_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => unopFEToWire_bounds_good bounds = true
+          | None => False
+          end)
+  : unop_FEToWire_correct_and_bounded (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x Hx.
+  pose x as x'.
+  hnf in x; destruct_head' prod.
+  specialize (H0 x' Hx).
+  specialize (H1 x' Hx).
+  let args := constr:(unop_args_to_bounded x' Hx) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF41417_32Reflective/CommonUnOpFEToZ.v b/src/SpecificGen/GF41417_32Reflective/CommonUnOpFEToZ.v
new file mode 100644
index 000000000..6d991dbb4
--- /dev/null
+++ b/src/SpecificGen/GF41417_32Reflective/CommonUnOpFEToZ.v
@@ -0,0 +1,44 @@
+Require Export Crypto.SpecificGen.GF41417_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF41417_32BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprUnOpFEToZ_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_unop_FEToZ_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall x
+                   (x := eta_fe41417_32W x)
+                   (Hx : is_bounded (fe41417_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall x
+                   (x := eta_fe41417_32W x)
+                   (Hx : is_bounded (fe41417_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => unopFEToZ_bounds_good bounds = true
+          | None => False
+          end)
+  : unop_FEToZ_correct (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x Hx.
+  pose x as x'.
+  hnf in x; destruct_head' prod.
+  specialize (H0 x' Hx).
+  specialize (H1 x' Hx).
+  let args := constr:(unop_args_to_bounded x' Hx) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF41417_32Reflective/CommonUnOpWireToFE.v b/src/SpecificGen/GF41417_32Reflective/CommonUnOpWireToFE.v
new file mode 100644
index 000000000..bb91ea89f
--- /dev/null
+++ b/src/SpecificGen/GF41417_32Reflective/CommonUnOpWireToFE.v
@@ -0,0 +1,44 @@
+Require Export Crypto.SpecificGen.GF41417_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF41417_32BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprUnOpWireToFE_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_unop_WireToFE_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall x
+                   (x := eta_wire_digitsW x)
+                   (Hx : wire_digits_is_bounded (wire_digitsWToZ x) = true),
+          let args := unopWireToFE_args_to_bounded x Hx in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall x
+                   (x := eta_wire_digitsW x)
+                   (Hx : wire_digits_is_bounded (wire_digitsWToZ x) = true),
+          let args := unopWireToFE_args_to_bounded x Hx in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => unopWireToFE_bounds_good bounds = true
+          | None => False
+          end)
+  : unop_WireToFE_correct_and_bounded (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x Hx.
+  pose x as x'.
+  hnf in x; destruct_head' prod.
+  specialize (H0 x' Hx).
+  specialize (H1 x' Hx).
+  let args := constr:(unopWireToFE_args_to_bounded x' Hx) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF41417_32Reflective/Reified.v b/src/SpecificGen/GF41417_32Reflective/Reified.v
new file mode 100644
index 000000000..ad8291b55
--- /dev/null
+++ b/src/SpecificGen/GF41417_32Reflective/Reified.v
@@ -0,0 +1,13 @@
+(** We split the reification up into separate files, one operation per
+    file, so that it can run in parallel. *)
+Require Export Crypto.SpecificGen.GF41417_32Reflective.Reified.Add.
+Require Export Crypto.SpecificGen.GF41417_32Reflective.Reified.CarryAdd.
+Require Export Crypto.SpecificGen.GF41417_32Reflective.Reified.Sub.
+Require Export Crypto.SpecificGen.GF41417_32Reflective.Reified.CarrySub.
+Require Export Crypto.SpecificGen.GF41417_32Reflective.Reified.Mul.
+Require Export Crypto.SpecificGen.GF41417_32Reflective.Reified.Opp.
+Require Export Crypto.SpecificGen.GF41417_32Reflective.Reified.CarryOpp.
+Require Export Crypto.SpecificGen.GF41417_32Reflective.Reified.PreFreeze.
+Require Export Crypto.SpecificGen.GF41417_32Reflective.Reified.GeModulus.
+Require Export Crypto.SpecificGen.GF41417_32Reflective.Reified.Pack.
+Require Export Crypto.SpecificGen.GF41417_32Reflective.Reified.Unpack.
diff --git a/src/SpecificGen/GF41417_32Reflective/Reified/Add.v b/src/SpecificGen/GF41417_32Reflective/Reified/Add.v
new file mode 100644
index 000000000..ee249b9b1
--- /dev/null
+++ b/src/SpecificGen/GF41417_32Reflective/Reified/Add.v
@@ -0,0 +1,12 @@
+Require Import Crypto.SpecificGen.GF41417_32Reflective.CommonBinOp.
+
+Definition raddZ_sig : rexpr_binop_sig add. Proof. reify_sig. Defined.
+Definition raddW := Eval vm_compute in rword_of_Z raddZ_sig.
+Lemma raddW_correct_and_bounded_gen : correct_and_bounded_genT raddW raddZ_sig.
+Proof. rexpr_correct. Qed.
+Definition radd_output_bounds := Eval vm_compute in compute_bounds raddW ExprBinOp_bounds.
+
+Local Open Scope string_scope.
+Compute ("Add", compute_bounds_for_display raddW ExprBinOp_bounds).
+Compute ("Add overflows? ", sanity_compute raddW ExprBinOp_bounds).
+Compute ("Add overflows (error if it does)? ", sanity_check raddW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF41417_32Reflective/Reified/CarryAdd.v b/src/SpecificGen/GF41417_32Reflective/Reified/CarryAdd.v
new file mode 100644
index 000000000..db3d447ea
--- /dev/null
+++ b/src/SpecificGen/GF41417_32Reflective/Reified/CarryAdd.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF41417_32Reflective.CommonBinOp.
+
+Definition rcarry_addZ_sig : rexpr_binop_sig carry_add. Proof. reify_sig. Defined.
+Definition rcarry_addW := Eval vm_compute in rword_of_Z rcarry_addZ_sig.
+Lemma rcarry_addW_correct_and_bounded_gen : correct_and_bounded_genT rcarry_addW rcarry_addZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rcarry_add_output_bounds := Eval vm_compute in compute_bounds rcarry_addW ExprBinOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rcarry_addW_correct_and_bounded
+  := ExprBinOp_correct_and_bounded
+       rcarry_addW carry_add rcarry_addZ_sig rcarry_addW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Carry_Add", compute_bounds_for_display rcarry_addW ExprBinOp_bounds).
+Compute ("Carry_Add overflows? ", sanity_compute rcarry_addW ExprBinOp_bounds).
+Compute ("Carry_Add overflows (error if it does)? ", sanity_check rcarry_addW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF41417_32Reflective/Reified/CarryOpp.v b/src/SpecificGen/GF41417_32Reflective/Reified/CarryOpp.v
new file mode 100644
index 000000000..9ba6183b9
--- /dev/null
+++ b/src/SpecificGen/GF41417_32Reflective/Reified/CarryOpp.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF41417_32Reflective.CommonUnOp.
+
+Definition rcarry_oppZ_sig : rexpr_unop_sig carry_opp. Proof. reify_sig. Defined.
+Definition rcarry_oppW := Eval vm_compute in rword_of_Z rcarry_oppZ_sig.
+Lemma rcarry_oppW_correct_and_bounded_gen : correct_and_bounded_genT rcarry_oppW rcarry_oppZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rcarry_opp_output_bounds := Eval vm_compute in compute_bounds rcarry_oppW ExprUnOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rcarry_oppW_correct_and_bounded
+  := ExprUnOp_correct_and_bounded
+       rcarry_oppW carry_opp rcarry_oppZ_sig rcarry_oppW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Carry_Opp", compute_bounds_for_display rcarry_oppW ExprUnOp_bounds).
+Compute ("Carry_Opp overflows? ", sanity_compute rcarry_oppW ExprUnOp_bounds).
+Compute ("Carry_Opp overflows (error if it does)? ", sanity_check rcarry_oppW ExprUnOp_bounds).
diff --git a/src/SpecificGen/GF41417_32Reflective/Reified/CarrySub.v b/src/SpecificGen/GF41417_32Reflective/Reified/CarrySub.v
new file mode 100644
index 000000000..ccd18a264
--- /dev/null
+++ b/src/SpecificGen/GF41417_32Reflective/Reified/CarrySub.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF41417_32Reflective.CommonBinOp.
+
+Definition rcarry_subZ_sig : rexpr_binop_sig carry_sub. Proof. reify_sig. Defined.
+Definition rcarry_subW := Eval vm_compute in rword_of_Z rcarry_subZ_sig.
+Lemma rcarry_subW_correct_and_bounded_gen : correct_and_bounded_genT rcarry_subW rcarry_subZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rcarry_sub_output_bounds := Eval vm_compute in compute_bounds rcarry_subW ExprBinOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rcarry_subW_correct_and_bounded
+  := ExprBinOp_correct_and_bounded
+       rcarry_subW carry_sub rcarry_subZ_sig rcarry_subW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Carry_Sub", compute_bounds_for_display rcarry_subW ExprBinOp_bounds).
+Compute ("Carry_Sub overflows? ", sanity_compute rcarry_subW ExprBinOp_bounds).
+Compute ("Carry_Sub overflows (error if it does)? ", sanity_check rcarry_subW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF41417_32Reflective/Reified/GeModulus.v b/src/SpecificGen/GF41417_32Reflective/Reified/GeModulus.v
new file mode 100644
index 000000000..e1985d4c1
--- /dev/null
+++ b/src/SpecificGen/GF41417_32Reflective/Reified/GeModulus.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF41417_32Reflective.CommonUnOpFEToZ.
+
+Definition rge_modulusZ_sig : rexpr_unop_FEToZ_sig ge_modulus. Proof. reify_sig. Defined.
+Definition rge_modulusW := Eval vm_compute in rword_of_Z rge_modulusZ_sig.
+Lemma rge_modulusW_correct_and_bounded_gen : correct_and_bounded_genT rge_modulusW rge_modulusZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rge_modulus_output_bounds := Eval vm_compute in compute_bounds rge_modulusW ExprUnOpFEToZ_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rge_modulusW_correct_and_bounded
+  := ExprUnOpFEToZ_correct_and_bounded
+       rge_modulusW ge_modulus rge_modulusZ_sig rge_modulusW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Ge_Modulus", compute_bounds_for_display rge_modulusW ExprUnOpFEToZ_bounds).
+Compute ("Ge_Modulus overflows? ", sanity_compute rge_modulusW ExprUnOpFEToZ_bounds).
+Compute ("Ge_Modulus overflows (error if it does)? ", sanity_check rge_modulusW ExprUnOpFEToZ_bounds).
diff --git a/src/SpecificGen/GF41417_32Reflective/Reified/Mul.v b/src/SpecificGen/GF41417_32Reflective/Reified/Mul.v
new file mode 100644
index 000000000..3c3b38b85
--- /dev/null
+++ b/src/SpecificGen/GF41417_32Reflective/Reified/Mul.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF41417_32Reflective.CommonBinOp.
+
+Definition rmulZ_sig : rexpr_binop_sig mul. Proof. reify_sig. Defined.
+Definition rmulW := Eval vm_compute in rword_of_Z rmulZ_sig.
+Lemma rmulW_correct_and_bounded_gen : correct_and_bounded_genT rmulW rmulZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rmul_output_bounds := Eval vm_compute in compute_bounds rmulW ExprBinOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rmulW_correct_and_bounded
+  := ExprBinOp_correct_and_bounded
+       rmulW mul rmulZ_sig rmulW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Mul", compute_bounds_for_display rmulW ExprBinOp_bounds).
+Compute ("Mul overflows? ", sanity_compute rmulW ExprBinOp_bounds).
+Compute ("Mul overflows (error if it does)? ", sanity_check rmulW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF41417_32Reflective/Reified/Opp.v b/src/SpecificGen/GF41417_32Reflective/Reified/Opp.v
new file mode 100644
index 000000000..4672002ac
--- /dev/null
+++ b/src/SpecificGen/GF41417_32Reflective/Reified/Opp.v
@@ -0,0 +1,12 @@
+Require Import Crypto.SpecificGen.GF41417_32Reflective.CommonUnOp.
+
+Definition roppZ_sig : rexpr_unop_sig opp. Proof. reify_sig. Defined.
+Definition roppW := Eval vm_compute in rword_of_Z roppZ_sig.
+Lemma roppW_correct_and_bounded_gen : correct_and_bounded_genT roppW roppZ_sig.
+Proof. rexpr_correct. Qed.
+Definition ropp_output_bounds := Eval vm_compute in compute_bounds roppW ExprUnOp_bounds.
+
+Local Open Scope string_scope.
+Compute ("Opp", compute_bounds_for_display roppW ExprUnOp_bounds).
+Compute ("Opp overflows? ", sanity_compute roppW ExprUnOp_bounds).
+Compute ("Opp overflows (error if it does)? ", sanity_check roppW ExprUnOp_bounds).
diff --git a/src/SpecificGen/GF41417_32Reflective/Reified/Pack.v b/src/SpecificGen/GF41417_32Reflective/Reified/Pack.v
new file mode 100644
index 000000000..d4fac5c2a
--- /dev/null
+++ b/src/SpecificGen/GF41417_32Reflective/Reified/Pack.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF41417_32Reflective.CommonUnOpFEToWire.
+
+Definition rpackZ_sig : rexpr_unop_FEToWire_sig pack. Proof. reify_sig. Defined.
+Definition rpackW := Eval vm_compute in rword_of_Z rpackZ_sig.
+Lemma rpackW_correct_and_bounded_gen : correct_and_bounded_genT rpackW rpackZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rpack_output_bounds := Eval vm_compute in compute_bounds rpackW ExprUnOpFEToWire_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rpackW_correct_and_bounded
+  := ExprUnOpFEToWire_correct_and_bounded
+       rpackW pack rpackZ_sig rpackW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Pack", compute_bounds_for_display rpackW ExprUnOpFEToWire_bounds).
+Compute ("Pack overflows? ", sanity_compute rpackW ExprUnOpFEToWire_bounds).
+Compute ("Pack overflows (error if it does)? ", sanity_check rpackW ExprUnOpFEToWire_bounds).
diff --git a/src/SpecificGen/GF41417_32Reflective/Reified/PreFreeze.v b/src/SpecificGen/GF41417_32Reflective/Reified/PreFreeze.v
new file mode 100644
index 000000000..889c6ca49
--- /dev/null
+++ b/src/SpecificGen/GF41417_32Reflective/Reified/PreFreeze.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF41417_32Reflective.CommonUnOp.
+
+Definition rprefreezeZ_sig : rexpr_unop_sig prefreeze. Proof. cbv [prefreeze GF41417_32.prefreeze]. reify_sig. Defined.
+Definition rprefreezeW := Eval vm_compute in rword_of_Z rprefreezeZ_sig.
+Lemma rprefreezeW_correct_and_bounded_gen : correct_and_bounded_genT rprefreezeW rprefreezeZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rprefreeze_output_bounds := Eval vm_compute in compute_bounds rprefreezeW ExprUnOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rprefreezeW_correct_and_bounded
+  := ExprUnOp_correct_and_bounded
+       rprefreezeW prefreeze rprefreezeZ_sig rprefreezeW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("PreFreeze", compute_bounds_for_display rprefreezeW ExprUnOp_bounds).
+Compute ("PreFreeze overflows? ", sanity_compute rprefreezeW ExprUnOp_bounds).
+Compute ("PreFreeze overflows (error if it does)? ", sanity_check rprefreezeW ExprUnOp_bounds).
diff --git a/src/SpecificGen/GF41417_32Reflective/Reified/Sub.v b/src/SpecificGen/GF41417_32Reflective/Reified/Sub.v
new file mode 100644
index 000000000..fd25f599d
--- /dev/null
+++ b/src/SpecificGen/GF41417_32Reflective/Reified/Sub.v
@@ -0,0 +1,12 @@
+Require Import Crypto.SpecificGen.GF41417_32Reflective.CommonBinOp.
+
+Definition rsubZ_sig : rexpr_binop_sig sub. Proof. reify_sig. Defined.
+Definition rsubW := Eval vm_compute in rword_of_Z rsubZ_sig.
+Lemma rsubW_correct_and_bounded_gen : correct_and_bounded_genT rsubW rsubZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rsub_output_bounds := Eval vm_compute in compute_bounds rsubW ExprBinOp_bounds.
+
+Local Open Scope string_scope.
+Compute ("Sub", compute_bounds_for_display rsubW ExprBinOp_bounds).
+Compute ("Sub overflows? ", sanity_compute rsubW ExprBinOp_bounds).
+Compute ("Sub overflows (error if it does)? ", sanity_check rsubW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF41417_32Reflective/Reified/Unpack.v b/src/SpecificGen/GF41417_32Reflective/Reified/Unpack.v
new file mode 100644
index 000000000..f2f8881b7
--- /dev/null
+++ b/src/SpecificGen/GF41417_32Reflective/Reified/Unpack.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF41417_32Reflective.CommonUnOpWireToFE.
+
+Definition runpackZ_sig : rexpr_unop_WireToFE_sig unpack. Proof. reify_sig. Defined.
+Definition runpackW := Eval vm_compute in rword_of_Z runpackZ_sig.
+Lemma runpackW_correct_and_bounded_gen : correct_and_bounded_genT runpackW runpackZ_sig.
+Proof. rexpr_correct. Qed.
+Definition runpack_output_bounds := Eval vm_compute in compute_bounds runpackW ExprUnOpWireToFE_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition runpackW_correct_and_bounded
+  := ExprUnOpWireToFE_correct_and_bounded
+       runpackW unpack runpackZ_sig runpackW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Unpack", compute_bounds_for_display runpackW ExprUnOpWireToFE_bounds).
+Compute ("Unpack overflows? ", sanity_compute runpackW ExprUnOpWireToFE_bounds).
+Compute ("Unpack overflows (error if it does)? ", sanity_check runpackW ExprUnOpWireToFE_bounds).
diff --git a/src/SpecificGen/GF5211_32Bounded.v b/src/SpecificGen/GF5211_32Bounded.v
new file mode 100644
index 000000000..3574afadc
--- /dev/null
+++ b/src/SpecificGen/GF5211_32Bounded.v
@@ -0,0 +1,462 @@
+Require Import Crypto.BaseSystem.
+Require Import Crypto.ModularArithmetic.PrimeFieldTheorems.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParams.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParamProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystem.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemOpt.
+Require Import Crypto.SpecificGen.GF5211_32.
+Require Import Crypto.SpecificGen.GF5211_32BoundedCommon.
+Require Import Crypto.SpecificGen.GF5211_32Reflective.
+Require Import Bedrock.Word Crypto.Util.WordUtil.
+Require Import Coq.Lists.List Crypto.Util.ListUtil.
+Require Import Crypto.Tactics.VerdiTactics.
+Require Import Crypto.Util.ZUtil.
+Require Import Crypto.Util.Tuple.
+Require Import Crypto.Util.Tactics.
+Require Import Crypto.Util.LetIn.
+Require Import Crypto.Util.Notations.
+Require Import Crypto.Util.Bool.
+Require Import Crypto.Util.Decidable.
+Require Import Crypto.Algebra.
+Import ListNotations.
+Require Import Coq.ZArith.ZArith Coq.ZArith.Zpower Coq.ZArith.ZArith Coq.ZArith.Znumtheory.
+Local Open Scope Z.
+
+
+Local Ltac bounded_t opW blem :=
+  apply blem; apply is_bounded_proj1_fe5211_32.
+Local Ltac bounded_wire_digits_t opW blem :=
+  apply blem; apply is_bounded_proj1_wire_digits.
+
+Local Ltac define_binop f g opW blem :=
+  refine (exist_fe5211_32W (opW (proj1_fe5211_32W f) (proj1_fe5211_32W g)) _);
+  abstract bounded_t opW blem.
+Local Ltac define_unop f opW blem :=
+  refine (exist_fe5211_32W (opW (proj1_fe5211_32W f)) _);
+  abstract bounded_t opW blem.
+Local Ltac define_unop_FEToZ f opW :=
+  refine (opW (proj1_fe5211_32W f)).
+Local Ltac define_unop_FEToWire f opW blem :=
+  refine (exist_wire_digitsW (opW (proj1_fe5211_32W f)) _);
+  abstract bounded_t opW blem.
+Local Ltac define_unop_WireToFE f opW blem :=
+  refine (exist_fe5211_32W (opW (proj1_wire_digitsW f)) _);
+  abstract bounded_wire_digits_t opW blem.
+
+Local Opaque Let_In.
+Local Opaque Z.add Z.sub Z.mul Z.shiftl Z.shiftr Z.land Z.lor Z.eqb NToWord64.
+Local Arguments interp_radd / _ _.
+Local Arguments interp_rsub / _ _.
+Local Arguments interp_rmul / _ _.
+Local Arguments interp_ropp / _.
+Local Arguments interp_rprefreeze / _.
+Local Arguments interp_rge_modulus / _.
+Local Arguments interp_rpack / _.
+Local Arguments interp_runpack / _.
+Definition addW (f g : fe5211_32W) : fe5211_32W := Eval simpl in interp_radd f g.
+Definition subW (f g : fe5211_32W) : fe5211_32W := Eval simpl in interp_rsub f g.
+Definition mulW (f g : fe5211_32W) : fe5211_32W := Eval simpl in interp_rmul f g.
+Definition oppW (f : fe5211_32W) : fe5211_32W := Eval simpl in interp_ropp f.
+Definition prefreezeW (f : fe5211_32W) : fe5211_32W := Eval simpl in interp_rprefreeze f.
+Definition ge_modulusW (f : fe5211_32W) : word64 := Eval simpl in interp_rge_modulus f.
+Definition packW (f : fe5211_32W) : wire_digitsW := Eval simpl in interp_rpack f.
+Definition unpackW (f : wire_digitsW) : fe5211_32W := Eval simpl in interp_runpack f.
+
+Require Import ModularBaseSystemWord.
+Definition modulusW :=
+  Eval cbv - [ZToWord64] in (Tuple.map ZToWord64 (Tuple.from_list_default 0%Z 10 GF5211_32.modulus_digits_)).
+
+Definition postfreeze : GF5211_32.fe5211_32 -> GF5211_32.fe5211_32 :=
+  GF5211_32.postfreeze.
+
+Lemma freeze_prepost_freeze : forall x, postfreeze (prefreeze x) = GF5211_32.freeze x. Proof. reflexivity. Qed.
+
+Definition postfreezeW : fe5211_32W -> fe5211_32W :=
+      (conditional_subtract_modulusW
+         (num_limbs := 10)
+         modulusW
+         ge_modulusW
+         (Interpretations.Word64.neg GF5211_32.int_width)
+      ).
+
+Definition freezeW (f : fe5211_32W) : fe5211_32W := Eval cbv beta delta [prefreezeW postfreezeW] in postfreezeW (prefreezeW f).
+
+Local Transparent Let_In.
+Definition powW (f : fe5211_32W) chain := fold_chain_opt (proj1_fe5211_32W one) mulW chain [f].
+Definition invW (f : fe5211_32W) : fe5211_32W
+  := Eval cbv -[Let_In fe5211_32W mulW] in powW f (chain inv_ec).
+
+Local Ltac port_correct_and_bounded pre_rewrite opW interp_rop rop_cb :=
+  change opW with (interp_rop);
+  rewrite pre_rewrite;
+  intros; apply rop_cb; assumption.
+
+Lemma addW_correct_and_bounded : ibinop_correct_and_bounded addW carry_add.
+Proof. port_correct_and_bounded interp_radd_correct addW interp_radd radd_correct_and_bounded. Qed.
+Lemma subW_correct_and_bounded : ibinop_correct_and_bounded subW carry_sub.
+Proof. port_correct_and_bounded interp_rsub_correct subW interp_rsub rsub_correct_and_bounded. Qed.
+Lemma mulW_correct_and_bounded : ibinop_correct_and_bounded mulW mul.
+Proof. port_correct_and_bounded interp_rmul_correct mulW interp_rmul rmul_correct_and_bounded. Qed.
+Lemma oppW_correct_and_bounded : iunop_correct_and_bounded oppW carry_opp.
+Proof. port_correct_and_bounded interp_ropp_correct oppW interp_ropp ropp_correct_and_bounded. Qed.
+Lemma prefreezeW_correct_and_bounded : iunop_correct_and_bounded prefreezeW prefreeze.
+Proof. port_correct_and_bounded interp_rprefreeze_correct prefreezeW interp_rprefreeze rprefreeze_correct_and_bounded. Qed.
+Lemma ge_modulusW_correct : iunop_FEToZ_correct ge_modulusW ge_modulus.
+Proof. port_correct_and_bounded interp_rge_modulus_correct ge_modulusW interp_rge_modulus rge_modulus_correct_and_bounded. Qed.
+Lemma packW_correct_and_bounded : iunop_FEToWire_correct_and_bounded packW pack.
+Proof. port_correct_and_bounded interp_rpack_correct packW interp_rpack rpack_correct_and_bounded. Qed.
+Lemma unpackW_correct_and_bounded : iunop_WireToFE_correct_and_bounded unpackW unpack.
+Proof. port_correct_and_bounded interp_runpack_correct unpackW interp_runpack runpack_correct_and_bounded. Qed.
+
+(* TODO : move *)
+Lemma neg_range : forall x y, 0 <= x ->
+  0 <= ModularBaseSystemListZOperations.neg x y < 2 ^ x.
+Proof.
+  intros.
+  split; auto using ModularBaseSystemListZOperationsProofs.neg_nonneg.
+  eapply Z.le_lt_trans; eauto using ModularBaseSystemListZOperationsProofs.neg_upperbound.
+  rewrite Z.ones_equiv.
+  omega.
+Qed.
+
+Ltac lower_bound_minus_ge_modulus :=
+  apply Z.le_0_sub;
+  cbv [ge_modulus Let_In ModularBaseSystemListZOperations.cmovl ModularBaseSystemListZOperations.cmovne ModularBaseSystemListZOperations.neg];
+  repeat break_if; Z.ltb_to_lt; subst; try omega;
+    rewrite ?Z.land_0_l; auto;
+    change Interpretations.Word64.word64ToZ with word64ToZ;
+    etransitivity; try apply Z.land_upper_bound_r; instantiate; try omega;
+    apply Z.ones_nonneg; instantiate; vm_compute; discriminate.
+
+Ltac upper_bound_minus_ge_modulus :=
+   (apply Z.log2_lt_pow2_alt; [ vm_compute; reflexivity | ]);
+   eapply Z.le_lt_trans; [ apply Z.le_sub_nonneg; apply Z.land_nonneg; right; omega | ];
+   eapply Z.le_lt_trans; [ eassumption | ];
+   instantiate; vm_compute; reflexivity.
+
+Lemma postfreezeW_correct_and_bounded : iunop_correct_and_bounded postfreezeW postfreeze.
+Proof.
+  intros x H.
+  pose proof (ge_modulusW_correct x H) as Hgm.
+  destruct_head_hnf' prod.
+  unfold_is_bounded_in H.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  cbv [postfreezeW].
+  cbv [conditional_subtract_modulusW Interpretations.Word64.neg].
+  change word64ToZ with Interpretations.Word64.word64ToZ in *.
+  rewrite Hgm.
+
+  cbv [modulusW Tuple.map].
+  cbv [on_tuple List.map to_list to_list' from_list from_list'
+                Tuple.map2 on_tuple2 ListUtil.map2 fe5211_32WToZ].
+  cbv [postfreeze GF5211_32.postfreeze].
+  cbv [Let_In].
+
+  split.
+  { match goal with
+    |- (_,word64ToZ (_ ^- (Interpretations.Word64.ZToWord64 ?x) ^& _)) = (_,_ - (?y &' _)) => assert (x = y) as Hxy by reflexivity; repeat rewrite <-Hxy; clear Hxy end.
+
+  change ZToWord64 with Interpretations.Word64.ZToWord64 in *.
+  rewrite !Interpretations.Word64.word64ToZ_sub;
+  rewrite !Interpretations.Word64.word64ToZ_land;
+  rewrite !Interpretations.Word64.word64ToZ_ZToWord64;
+  try match goal with
+         | |- 0 <=  ModularBaseSystemListZOperations.neg _ _ < 2 ^ _ => apply neg_range; omega
+         | |- 0 <= _ < 2 ^ Z.of_nat _ => vm_compute; split; [refine (fun x => match x with eq_refl => I end) | reflexivity]
+         | |- 0 <= _ &' _ => apply Z.land_nonneg; right; omega
+         | |- (_,_) = (_,_) => reflexivity
+      end;
+  try solve [
+  (apply Z.log2_lt_pow2_alt; [ vm_compute; reflexivity | ]);
+  eapply Z.le_lt_trans; try apply Z.land_upper_bound_r; try apply neg_range; instantiate; try match goal with |- ?G => not has_evar G; vm_compute; discriminate end; reflexivity];
+  match goal with
+  | |- 0 <= _ - _ => lower_bound_minus_ge_modulus
+  | |- Z.log2 (_ - _) < _ => upper_bound_minus_ge_modulus
+  end. }
+
+
+  unfold_is_bounded.
+  change ZToWord64 with Interpretations.Word64.ZToWord64 in *.
+  rewrite !Interpretations.Word64.word64ToZ_sub;
+  rewrite !Interpretations.Word64.word64ToZ_land;
+  rewrite !Interpretations.Word64.word64ToZ_ZToWord64;
+  repeat match goal with |- _ /\ _ => split; Z.ltb_to_lt end;
+  try match goal with
+         | |- 0 <=  ModularBaseSystemListZOperations.neg _ _ < 2 ^ _ => apply neg_range; omega
+         | |- 0 <= _ < 2 ^ Z.of_nat _ => vm_compute; split; [refine (fun x => match x with eq_refl => I end) | reflexivity]
+         | |- 0 <= _ &' _ => apply Z.land_nonneg; right; omega
+      end;
+  try solve [
+  (apply Z.log2_lt_pow2_alt; [ vm_compute; reflexivity | ]);
+  eapply Z.le_lt_trans; try apply Z.land_upper_bound_r; try apply neg_range; instantiate; try match goal with |- ?G => not has_evar G; vm_compute; discriminate end; reflexivity];
+  try match goal with
+  | |- 0 <= _ - _ => lower_bound_minus_ge_modulus
+  | |- Z.log2 (_ - _) < _ => upper_bound_minus_ge_modulus
+  | |- _ - _ <= _ => etransitivity; [ apply Z.le_sub_nonneg; apply Z.land_nonneg; right; omega | instantiate; assumption ]
+  | |- 0 <= ModularBaseSystemListZOperations.neg _ _ =>
+    apply neg_range; vm_compute; discriminate
+  | |- ModularBaseSystemListZOperations.neg _ _ < _ =>
+    apply neg_range; vm_compute; discriminate
+  | |- _ => vm_compute; (discriminate || reflexivity)
+      end.
+Qed.
+
+Lemma freezeW_correct_and_bounded : iunop_correct_and_bounded freezeW freeze.
+Proof.
+  intros f H; rewrite <- freeze_prepost_freeze.
+  change (freezeW f) with (postfreezeW (prefreezeW f)).
+  destruct (prefreezeW_correct_and_bounded f H) as [H0 H1].
+  destruct (postfreezeW_correct_and_bounded _ H1) as [H0' H1'].
+  rewrite H1', H0', H0; split; reflexivity.
+Qed.
+
+Lemma powW_correct_and_bounded chain : iunop_correct_and_bounded (fun x => powW x chain) (fun x => pow x chain).
+Proof.
+  cbv [powW pow].
+  intro x; intros; apply (fold_chain_opt_gen fe5211_32WToZ is_bounded [x]).
+  { reflexivity. }
+  { reflexivity. }
+  { intros; progress rewrite <- (fun X Y => proj1 (mulW_correct_and_bounded _ _ X Y)) by assumption.
+    apply mulW_correct_and_bounded; assumption. }
+  { intros; rewrite (fun X Y => proj1 (mulW_correct_and_bounded _ _ X Y)) by assumption; reflexivity. }
+  { intros [|?]; autorewrite with simpl_nth_default;
+      (assumption || reflexivity). }
+Qed.
+
+Lemma invW_correct_and_bounded : iunop_correct_and_bounded invW inv.
+Proof.
+  intro f.
+  assert (H : forall f, invW f = powW f (chain inv_ec))
+    by abstract (cbv -[Let_In fe5211_32W mulW]; reflexivity).
+  rewrite H.
+  rewrite inv_correct.
+  cbv [inv_opt].
+  rewrite <- pow_correct.
+  apply powW_correct_and_bounded.
+Qed.
+
+Definition fieldwisebW_sig (f g : fe5211_32W)
+  : { b | b = GF5211_32.fieldwiseb (fe5211_32WToZ f) (fe5211_32WToZ g) }.
+Proof.
+  hnf in f, g; destruct_head' prod.
+  eexists.
+  cbv [GF5211_32.fieldwiseb fe5211_32WToZ].
+  rewrite ?word64eqb_Zeqb.
+  reflexivity.
+Defined.
+
+Definition fieldwisebW (f g : fe5211_32W) : bool :=
+  Eval cbv [proj1_sig fieldwisebW_sig appify2 app_fe5211_32W] in
+    appify2 (fun f g => proj1_sig (fieldwisebW_sig f g)) f g.
+
+Lemma fieldwisebW_correct f g
+  : fieldwisebW f g = GF5211_32.fieldwiseb (fe5211_32WToZ f) (fe5211_32WToZ g).
+Proof.
+  set (f' := f); set (g' := g).
+  hnf in f, g; destruct_head' prod.
+  exact (proj2_sig (fieldwisebW_sig f' g')).
+Qed.
+
+Local Arguments freezeW : simpl never.
+Local Arguments fe5211_32WToZ !_ / .
+Local Opaque freezeW.
+
+Definition eqbW_sig (f g : fe5211_32W)
+  : { b | is_bounded (fe5211_32WToZ f) = true
+          -> is_bounded (fe5211_32WToZ g) = true
+          -> b = GF5211_32.eqb (fe5211_32WToZ f) (fe5211_32WToZ g) }.
+Proof.
+  pose proof (fun pf => proj1 (freezeW_correct_and_bounded f pf)) as frf.
+  pose proof (fun pf => proj1 (freezeW_correct_and_bounded g pf)) as frg.
+  hnf in f, g; destruct_head' prod.
+  eexists.
+  unfold GF5211_32.eqb.
+  simpl @fe5211_32WToZ in *; cbv beta iota.
+  intros.
+  rewrite <- frf, <- frg by assumption.
+  rewrite <- fieldwisebW_correct.
+  reflexivity.
+Defined.
+
+Definition eqbW (f g : fe5211_32W) : bool :=
+  Eval cbv [proj1_sig eqbW_sig appify2 app_fe5211_32W] in
+    appify2 (fun f g => proj1_sig (eqbW_sig f g)) f g.
+
+Lemma eqbW_correct f g
+  : is_bounded (fe5211_32WToZ f) = true
+    -> is_bounded (fe5211_32WToZ g) = true
+    -> eqbW f g = GF5211_32.eqb (fe5211_32WToZ f) (fe5211_32WToZ g).
+Proof.
+  set (f' := f); set (g' := g).
+  hnf in f, g; destruct_head' prod.
+  exact (proj2_sig (eqbW_sig f' g')).
+Qed.
+
+(* TODO(jgross): use NToWord or such for this constant too *)
+Definition sqrt_m1W : fe5211_32W :=
+  Eval vm_compute in fe5211_32ZToW sqrt_m1.
+
+Definition GF5211_32sqrt x : GF5211_32.fe5211_32 :=
+  dlet powx := powW (fe5211_32ZToW x) (chain GF5211_32.sqrt_ec) in
+  GF5211_32.sqrt (fe5211_32WToZ powx) (fe5211_32WToZ (mulW powx powx)) x.
+
+Definition sqrtW_sig
+  : { sqrtW | iunop_correct_and_bounded sqrtW GF5211_32sqrt }.
+Proof.
+  eexists.
+  unfold GF5211_32sqrt, GF5211_32.sqrt.
+  intros.
+  rewrite !fe5211_32ZToW_WToZ.
+  split.
+  { etransitivity.
+    Focus 2. {
+      apply Proper_Let_In_nd_changebody_eq; intros.
+      set_evars.
+      match goal with (* unfold the first dlet ... in, but only if it's binding a var *)
+      | [ |- ?x = dlet y := fe5211_32WToZ ?z in ?f ]
+        => is_var z; change (x = match fe5211_32WToZ z with y => f end)
+      end.
+      change sqrt_m1 with (fe5211_32WToZ sqrt_m1W).
+      rewrite <- (fun X Y => proj1 (mulW_correct_and_bounded sqrt_m1W a X Y)), <- eqbW_correct, (pull_bool_if fe5211_32WToZ)
+        by repeat match goal with
+                  | _ => progress subst
+                  | [ |- is_bounded (fe5211_32WToZ ?op) = true ]
+                    => lazymatch op with
+                       | mulW _ _ => apply mulW_correct_and_bounded
+                       | powW _ _ => apply powW_correct_and_bounded
+                       | sqrt_m1W => vm_compute; reflexivity
+                       | _ => assumption
+                       end
+                  end.
+      subst_evars; reflexivity.
+    } Unfocus.
+    lazymatch goal with
+    | [ |- context G[dlet x := ?v in fe5211_32WToZ (@?f x)] ]
+      => let G' := context G[fe5211_32WToZ (dlet x := v in f x)] in
+         cut G'; cbv beta;
+           [ cbv [Let_In]; exact (fun x => x) | apply f_equal ]
+    end.
+    reflexivity. }
+  { cbv [Let_In].
+    break_if.
+    { apply powW_correct_and_bounded; assumption. }
+    { apply mulW_correct_and_bounded; [ vm_compute; reflexivity | ].
+      apply powW_correct_and_bounded; assumption. } }
+Defined.
+
+Definition sqrtW (f : fe5211_32W) : fe5211_32W :=
+  Eval cbv [proj1_sig sqrtW_sig app_fe5211_32W] in
+    app_fe5211_32W f (proj1_sig sqrtW_sig).
+
+Lemma sqrtW_correct_and_bounded : iunop_correct_and_bounded sqrtW GF5211_32sqrt.
+Proof.
+  intro f.
+  set (f' := f).
+  hnf in f; destruct_head' prod.
+  assert (H : sqrtW f' = proj1_sig sqrtW_sig f')
+    by (subst f'; cbv beta iota delta [proj1_sig sqrtW_sig sqrtW]; reflexivity).
+  rewrite H.
+  exact (proj2_sig sqrtW_sig f').
+Qed.
+
+
+
+Definition add (f g : fe5211_32) : fe5211_32.
+Proof. define_binop f g addW addW_correct_and_bounded. Defined.
+Definition sub (f g : fe5211_32) : fe5211_32.
+Proof. define_binop f g subW subW_correct_and_bounded. Defined.
+Definition mul (f g : fe5211_32) : fe5211_32.
+Proof. define_binop f g mulW mulW_correct_and_bounded. Defined.
+Definition opp (f : fe5211_32) : fe5211_32.
+Proof. define_unop f oppW oppW_correct_and_bounded. Defined.
+Definition freeze (f : fe5211_32) : fe5211_32.
+Proof. define_unop f freezeW freezeW_correct_and_bounded. Defined.
+Definition ge_modulus (f : fe5211_32) : word64.
+Proof. define_unop_FEToZ f ge_modulusW. Defined.
+Definition pack (f : fe5211_32) : wire_digits.
+Proof. define_unop_FEToWire f packW packW_correct_and_bounded. Defined.
+Definition unpack (f : wire_digits) : fe5211_32.
+Proof. define_unop_WireToFE f unpackW unpackW_correct_and_bounded. Defined.
+
+Definition pow (f : fe5211_32) (chain : list (nat * nat)) : fe5211_32.
+Proof. define_unop f (fun x => powW x chain) powW_correct_and_bounded. Defined.
+Definition inv (f : fe5211_32) : fe5211_32.
+Proof. define_unop f invW invW_correct_and_bounded. Defined.
+Definition sqrt (f : fe5211_32) : fe5211_32.
+Proof. define_unop f sqrtW sqrtW_correct_and_bounded. Defined.
+
+Local Ltac op_correct_t op opW_correct_and_bounded :=
+  cbv [op];
+  lazymatch goal with
+  | [ |- context[proj1_fe5211_32 (exist_fe5211_32W _ _)] ]
+    => rewrite proj1_fe5211_32_exist_fe5211_32W
+  | [ |- context[proj1_wire_digits (exist_wire_digitsW _ _)] ]
+    => rewrite proj1_wire_digits_exist_wire_digitsW
+  | _ => idtac
+  end;
+  apply opW_correct_and_bounded;
+  lazymatch goal with
+  | [ |- is_bounded _ = true ]
+    => apply is_bounded_proj1_fe5211_32
+  | [ |- wire_digits_is_bounded _ = true ]
+    => apply is_bounded_proj1_wire_digits
+  end.
+
+Lemma add_correct (f g : fe5211_32) : proj1_fe5211_32 (add f g) = carry_add (proj1_fe5211_32 f) (proj1_fe5211_32 g).
+Proof. op_correct_t add addW_correct_and_bounded. Qed.
+Lemma sub_correct (f g : fe5211_32) : proj1_fe5211_32 (sub f g) = carry_sub (proj1_fe5211_32 f) (proj1_fe5211_32 g).
+Proof. op_correct_t sub subW_correct_and_bounded. Qed.
+Lemma mul_correct (f g : fe5211_32) : proj1_fe5211_32 (mul f g) = GF5211_32.mul (proj1_fe5211_32 f) (proj1_fe5211_32 g).
+Proof. op_correct_t mul mulW_correct_and_bounded. Qed.
+Lemma opp_correct (f : fe5211_32) : proj1_fe5211_32 (opp f) = carry_opp (proj1_fe5211_32 f).
+Proof. op_correct_t opp oppW_correct_and_bounded. Qed.
+Lemma freeze_correct (f : fe5211_32) : proj1_fe5211_32 (freeze f) = GF5211_32.freeze (proj1_fe5211_32 f).
+Proof. op_correct_t freeze freezeW_correct_and_bounded. Qed.
+Lemma ge_modulus_correct (f : fe5211_32) : word64ToZ (ge_modulus f) = GF5211_32.ge_modulus (proj1_fe5211_32 f).
+Proof. op_correct_t ge_modulus ge_modulusW_correct. Qed.
+Lemma pack_correct (f : fe5211_32) : proj1_wire_digits (pack f) = GF5211_32.pack (proj1_fe5211_32 f).
+Proof. op_correct_t pack packW_correct_and_bounded. Qed.
+Lemma unpack_correct (f : wire_digits) : proj1_fe5211_32 (unpack f) = GF5211_32.unpack (proj1_wire_digits f).
+Proof. op_correct_t unpack unpackW_correct_and_bounded. Qed.
+Lemma pow_correct (f : fe5211_32) chain : proj1_fe5211_32 (pow f chain) = GF5211_32.pow (proj1_fe5211_32 f) chain.
+Proof. op_correct_t pow (powW_correct_and_bounded chain). Qed.
+Lemma inv_correct (f : fe5211_32) : proj1_fe5211_32 (inv f) = GF5211_32.inv (proj1_fe5211_32 f).
+Proof. op_correct_t inv invW_correct_and_bounded. Qed.
+Lemma sqrt_correct (f : fe5211_32) : proj1_fe5211_32 (sqrt f) = GF5211_32sqrt (proj1_fe5211_32 f).
+Proof. op_correct_t sqrt sqrtW_correct_and_bounded. Qed.
+
+Import Morphisms.
+
+Local Existing Instance prime_modulus.
+
+Lemma field5211_32_and_homomorphisms
+  : @field fe5211_32 eq zero one opp add sub mul inv div
+    /\ @Ring.is_homomorphism (F _) (@Logic.eq _) 1%F F.add F.mul fe5211_32 eq one add mul encode
+    /\ @Ring.is_homomorphism fe5211_32 eq one add mul (F _) (@Logic.eq _) 1%F F.add F.mul decode.
+Proof.
+  eapply @Field.field_and_homomorphism_from_redundant_representation.
+  { exact (F.field_modulo _). }
+  { cbv [decode encode]; intros; rewrite !proj1_fe5211_32_exist_fe5211_32; apply encode_rep. }
+  { reflexivity. }
+  { reflexivity. }
+  { reflexivity. }
+  { cbv [decode encode]; intros; rewrite opp_correct, carry_opp_correct, carry_opp_opt_correct, carry_opp_rep; apply opp_rep; reflexivity. }
+  { cbv [decode encode]; intros; rewrite add_correct, carry_add_correct, carry_add_opt_correct, carry_add_rep; apply add_rep; reflexivity. }
+  { cbv [decode encode]; intros; rewrite sub_correct, carry_sub_correct, carry_sub_opt_correct, carry_sub_rep; apply sub_rep; reflexivity. }
+  { cbv [decode encode]; intros; rewrite mul_correct, GF5211_32.mul_correct, carry_mul_opt_correct by reflexivity; apply carry_mul_rep; reflexivity. }
+  { cbv [decode encode]; intros; rewrite inv_correct, GF5211_32.inv_correct, inv_opt_correct by reflexivity; apply inv_rep; reflexivity. }
+  { cbv [decode encode div]; intros; rewrite !proj1_fe5211_32_exist_fe5211_32; apply encode_rep. }
+Qed.
+
+Global Instance field5211_32 : @field fe5211_32 eq zero one opp add sub mul inv div := proj1 field5211_32_and_homomorphisms.
+
+Local Opaque proj1_fe5211_32 exist_fe5211_32 proj1_fe5211_32W exist_fe5211_32W.
+Global Instance homomorphism_F5211_32_encode
+  : @Ring.is_homomorphism (F modulus) Logic.eq F.one F.add F.mul fe5211_32 eq one add mul encode.
+Proof. apply field5211_32_and_homomorphisms. Qed.
+
+Global Instance homomorphism_F5211_32_decode
+  : @Ring.is_homomorphism fe5211_32 eq one add mul (F modulus) Logic.eq F.one F.add F.mul decode.
+Proof. apply field5211_32_and_homomorphisms. Qed.
diff --git a/src/SpecificGen/GF5211_32BoundedCommon.v b/src/SpecificGen/GF5211_32BoundedCommon.v
new file mode 100644
index 000000000..bd2394540
--- /dev/null
+++ b/src/SpecificGen/GF5211_32BoundedCommon.v
@@ -0,0 +1,693 @@
+Require Import Crypto.BaseSystem.
+Require Import Crypto.ModularArithmetic.PrimeFieldTheorems.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParams.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParamProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystem.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemOpt.
+Require Import Crypto.SpecificGen.GF5211_32.
+Require Import Bedrock.Word Crypto.Util.WordUtil.
+Require Import Coq.Lists.List Crypto.Util.ListUtil.
+Require Import Crypto.Tactics.VerdiTactics.
+Require Import Crypto.Util.ZUtil.
+Require Import Crypto.Util.Tuple.
+Require Import Crypto.Util.Tactics.
+Require Import Crypto.Util.LetIn.
+Require Import Crypto.Util.Notations.
+Require Import Crypto.Util.Decidable.
+Require Import Crypto.Util.HList.
+Require Import Crypto.Util.Tuple.
+Require Import Crypto.Algebra.
+Import ListNotations.
+Require Import Coq.ZArith.ZArith Coq.ZArith.Zpower Coq.ZArith.ZArith Coq.ZArith.Znumtheory.
+Local Open Scope Z.
+
+(* BEGIN common curve-specific definitions *)
+Definition bit_width : nat := Eval compute in Z.to_nat (GF5211_32.int_width).
+Local Notation b_of exp := (0, 2^exp + 2^(exp-3))%Z (only parsing). (* max is [(0, 2^(exp+2) + 2^exp + 2^(exp-1) + 2^(exp-3) + 2^(exp-4) + 2^(exp-5) + 2^(exp-6) + 2^(exp-10) + 2^(exp-12) + 2^(exp-13) + 2^(exp-14) + 2^(exp-15) + 2^(exp-17) + 2^(exp-23) + 2^(exp-24))%Z] *)
+Definition bounds_exp : tuple Z length_fe5211_32
+  := Eval compute in
+      Tuple.from_list length_fe5211_32 limb_widths eq_refl.
+Definition bounds : tuple (Z * Z) length_fe5211_32
+  := Eval compute in
+      Tuple.map (fun e => b_of e) bounds_exp.
+Definition wire_digit_bounds_exp : tuple Z (length wire_widths)
+  := Eval compute in Tuple.from_list _ wire_widths eq_refl.
+Definition wire_digit_bounds : tuple (Z * Z) (length wire_widths)
+  := Eval compute in Tuple.map (fun e => (0,2^e-1)%Z) wire_digit_bounds_exp.
+(* END common curve-specific definitions *)
+
+(* BEGIN aliases for word extraction *)
+Definition word64 := Word.word bit_width.
+Coercion word64ToZ (x : word64) : Z := Z.of_N (wordToN x).
+Coercion ZToWord64 (x : Z) : word64 := NToWord _ (Z.to_N x).
+Definition NToWord64 : N -> word64 := NToWord _.
+Definition word64ize (x : word64) : word64
+  := Eval cbv [wordToN N.succ_double N.double] in NToWord64 (wordToN x).
+Definition w64eqb (x y : word64) := weqb x y.
+
+Global Arguments NToWord64 : simpl never.
+Arguments word64 : simpl never.
+Arguments bit_width : simpl never.
+Global Opaque word64.
+Global Opaque bit_width.
+
+(* END aliases for word extraction *)
+
+(* BEGIN basic types *)
+Module Type WordIsBounded.
+  Parameter is_boundedT : forall (lower upper : Z), word64 -> bool.
+  Parameter Build_is_boundedT : forall {lower upper} {proj_word : word64},
+      andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true -> is_boundedT lower upper proj_word = true.
+  Parameter project_is_boundedT : forall {lower upper} {proj_word : word64},
+      is_boundedT lower upper proj_word = true -> andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true.
+End WordIsBounded.
+
+Module Import WordIsBoundedDefault : WordIsBounded.
+  Definition is_boundedT : forall (lower upper : Z), word64 -> bool
+    := fun lower upper proj_word => andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z.
+  Definition Build_is_boundedT {lower upper} {proj_word : word64}
+    : andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true -> is_boundedT lower upper proj_word = true
+    := fun x => x.
+  Definition project_is_boundedT {lower upper} {proj_word : word64}
+    : is_boundedT lower upper proj_word = true -> andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true
+    := fun x => x.
+End WordIsBoundedDefault.
+
+Definition bounded_word (lower upper : Z)
+  := { proj_word : word64 | is_boundedT lower upper proj_word = true }.
+Local Notation word_of exp := (bounded_word (fst (b_of exp)) (snd (b_of exp))).
+Local Notation unbounded_word sz := (bounded_word 0 (2^sz-1)%Z).
+
+Local Opaque word64.
+Definition fe5211_32W := Eval cbv (*-[word64]*) in (tuple word64 length_fe5211_32).
+Definition wire_digitsW := Eval cbv (*-[word64]*) in (tuple word64 (length wire_widths)).
+Definition fe5211_32 :=
+  Eval cbv -[bounded_word Z.pow Z.sub Z.add] in
+    hlist (fun e => word_of e) bounds_exp.
+Definition wire_digits :=
+  Eval cbv -[bounded_word Z.pow Z.sub Z.add] in
+    hlist (fun e => unbounded_word e) wire_digit_bounds_exp.
+
+Definition is_bounded_gen {n} (x : tuple Z n) (bounds : tuple (Z * Z) n) : bool
+  := let res := Tuple.map2
+                  (fun bounds v =>
+                     let '(lower, upper) := bounds in
+                     (lower <=? v) && (v <=? upper))%bool%Z
+                  bounds x in
+     List.fold_right andb true (Tuple.to_list _ res).
+
+Definition is_bounded (x : SpecificGen.GF5211_32.fe5211_32) : bool
+  := is_bounded_gen (n:=length_fe5211_32) x bounds.
+
+Definition wire_digits_is_bounded (x : SpecificGen.GF5211_32.wire_digits) : bool
+  := is_bounded_gen (n:=length wire_widths) x wire_digit_bounds.
+
+(* END basic types *)
+
+Section generic_destructuring.
+  Fixpoint app_on' A n : forall T (f : tuple' A n) (P : forall x : tuple' A n, T x), T f
+    := match n return forall T (f : tuple' A n) (P : forall x : tuple' A n, T x), T f with
+       | O => fun T v P => P v
+       | S n' => fun T v P => let '(v, x) := v in app_on' A n' _ v (fun v => P (v, x))
+       end.
+  Definition app_on {A n} : forall {T} (f : tuple A n) (P : forall x : tuple A n, T x), T f
+    := match n return forall T (f : tuple A n) (P : forall x : tuple A n, T x), T f with
+       | O => fun T v P => P v
+       | S n' => @app_on' A n'
+       end.
+  Lemma app_on'_correct {A n T} f (P : forall x : tuple' A n, T x) : app_on' A n T f P = P f.
+  Proof.
+    induction n; simpl in *; destruct_head' prod; [ reflexivity | exact (IHn _ _ (fun t => P (t, _))) ].
+  Qed.
+  Lemma app_on_correct {A n T} f (P : forall x : tuple A n, T x) : app_on f P = P f.
+  Proof. destruct n; [ reflexivity | apply app_on'_correct ]. Qed.
+
+  Fixpoint app_on_h' A F n : forall ts T (f : @hlist' A n F ts) (P : forall x : @hlist' A n F ts, T x), T f
+    := match n return forall ts T (f : @hlist' A n F ts) (P : forall x : @hlist' A n F ts, T x), T f with
+       | O => fun ts T v P => P v
+       | S n' => fun ts T v P => let '(v, x) := v in app_on_h' A F n' _ _ v (fun v => P (v, x))
+       end.
+  Definition app_on_h {A F n} : forall ts T (f : @hlist A n F ts) (P : forall x : @hlist A n F ts, T x), T f
+    := match n return forall ts T (f : @hlist A n F ts) (P : forall x : @hlist A n F ts, T x), T f with
+       | O => fun ts T v P => P v
+       | S n' => @app_on_h' A F n'
+       end.
+  Lemma app_on_h'_correct {A F n ts T} f P : @app_on_h' A F n ts T f P = P f.
+  Proof.
+    induction n; simpl in *; destruct_head' prod; [ reflexivity | exact (IHn _ _ _ (fun h => P (h, f))) ].
+  Qed.
+  Lemma app_on_h_correct {A} F {n} ts {T} f P : @app_on_h A F n ts T f P = P f.
+  Proof. destruct n; [ reflexivity | apply app_on_h'_correct ]. Qed.
+
+  Definition app_wire_digitsW_dep {A T} (P : forall x : tuple A (length wire_widths), T x)
+    : forall (f : tuple A (length wire_widths)), T f
+    := Eval compute in fun f => @app_on A (length wire_widths) T f P.
+  Definition app_wire_digitsW {A T} (f : tuple A (length wire_widths)) (P : tuple A (length wire_widths) -> T)
+    := Eval compute in @app_wire_digitsW_dep A (fun _ => T) P f.
+  Definition app_fe5211_32W_dep {A T} (P : forall x : tuple A length_fe5211_32, T x)
+    : forall (f : tuple A length_fe5211_32), T f
+    := Eval compute in fun f => @app_on A length_fe5211_32 T f P.
+  Definition app_fe5211_32W {A T} (f : tuple A length_fe5211_32) (P : tuple A length_fe5211_32 -> T)
+    := Eval compute in @app_fe5211_32W_dep A (fun _ => T) P f.
+  Definition app_fe5211_32_dep {T} (P : forall x : fe5211_32, T x)
+    : forall f : fe5211_32, T f
+    := Eval compute in fun f => @app_on_h _ (fun e => word_of e) length_fe5211_32 bounds_exp T f P.
+  Definition app_fe5211_32 {T} (f : fe5211_32) (P : hlist (fun e => word_of e) bounds_exp -> T)
+    := Eval compute in @app_fe5211_32_dep (fun _ => T) P f.
+  Definition app_wire_digits_dep {T} (P : forall x : wire_digits, T x)
+    : forall f : wire_digits, T f
+    := Eval compute in fun f => @app_on_h _ (fun e => unbounded_word e) (length wire_widths) wire_digit_bounds_exp T f P.
+  Definition app_wire_digits {T} (f : wire_digits) (P : hlist (fun e => unbounded_word e) wire_digit_bounds_exp -> T)
+    := Eval compute in @app_wire_digits_dep (fun _ => T) P f.
+
+  Definition app_wire_digitsW_dep_correct {A T} f P : @app_wire_digitsW_dep A T P f = P f
+    := app_on_correct f P.
+  Definition app_wire_digitsW_correct {A T} f P : @app_wire_digitsW A T f P = P f
+    := @app_wire_digitsW_dep_correct A (fun _ => T) f P.
+  Definition app_fe5211_32W_dep_correct {A T} f P : @app_fe5211_32W_dep A T P f = P f
+    := app_on_correct f P.
+  Definition app_fe5211_32W_correct {A T} f P : @app_fe5211_32W A T f P = P f
+    := @app_fe5211_32W_dep_correct A (fun _ => T) f P.
+  Definition app_fe5211_32_dep_correct {T} f P : @app_fe5211_32_dep T P f = P f
+    := app_on_h_correct (fun e => word_of e) bounds_exp f P.
+  Definition app_fe5211_32_correct {T} f P : @app_fe5211_32 T f P = P f
+    := @app_fe5211_32_dep_correct (fun _ => T) f P.
+  Definition app_wire_digits_dep_correct {T} f P : @app_wire_digits_dep T P f = P f
+    := app_on_h_correct (fun e => unbounded_word e) wire_digit_bounds_exp f P.
+  Definition app_wire_digits_correct {T} f P : @app_wire_digits T f P = P f
+    := @app_wire_digits_dep_correct (fun _ => T) f P.
+
+  Definition appify2 {T} (op : fe5211_32W -> fe5211_32W -> T) (f g : fe5211_32W) :=
+    app_fe5211_32W f (fun f0 => (app_fe5211_32W g (fun g0 => op f0 g0))).
+
+  Lemma appify2_correct : forall {T} op f g, @appify2 T op f g = op f g.
+  Proof.
+    intros. cbv [appify2].
+    etransitivity; apply app_fe5211_32W_correct.
+  Qed.
+End generic_destructuring.
+
+Definition eta_fe5211_32W_sig (x : fe5211_32W) : { v : fe5211_32W | v = x }.
+Proof.
+  eexists; symmetry.
+  repeat (etransitivity; [ apply surjective_pairing | apply f_equal2 ]); reflexivity.
+Defined.
+Definition eta_fe5211_32W (x : fe5211_32W) : fe5211_32W
+  := Eval cbv [proj1_sig eta_fe5211_32W_sig] in proj1_sig (eta_fe5211_32W_sig x).
+Definition eta_wire_digitsW_sig (x : wire_digitsW) : { v : wire_digitsW | v = x }.
+Proof.
+  eexists; symmetry.
+  repeat (etransitivity; [ apply surjective_pairing | apply f_equal2 ]); reflexivity.
+Defined.
+Definition eta_wire_digitsW (x : wire_digitsW) : wire_digitsW
+  := Eval cbv [proj1_sig eta_wire_digitsW_sig] in proj1_sig (eta_wire_digitsW_sig x).
+
+Local Transparent word64.
+Lemma word64ize_id x : word64ize x = x.
+Proof. apply NToWord_wordToN. Qed.
+Local Opaque word64.
+
+Lemma word64eqb_Zeqb x y : (word64ToZ x =? word64ToZ y)%Z = w64eqb x y.
+Proof. apply wordeqb_Zeqb. Qed.
+
+Local Arguments Z.pow_pos !_ !_ / .
+Lemma word64ToZ_ZToWord64 x : 0 <= x < 2^Z.of_nat bit_width -> word64ToZ (ZToWord64 x) = x.
+Proof.
+  intros; unfold word64ToZ, ZToWord64.
+  rewrite wordToN_NToWord_idempotent, Z2N.id
+    by (omega || apply N2Z.inj_lt; rewrite <- ?(N_nat_Z (Npow2 _)), ?Npow2_nat, ?Zpow_pow2, ?N2Z.id, ?Z2N.id, ?Z2Nat.id by omega; omega).
+  reflexivity.
+Qed.
+Lemma ZToWord64_word64ToZ x : ZToWord64 (word64ToZ x) = x.
+Proof.
+  intros; unfold word64ToZ, ZToWord64.
+  rewrite N2Z.id, NToWord_wordToN; reflexivity.
+Qed.
+
+(* BEGIN precomputation. *)
+
+Definition proj_word {lower upper} (v : bounded_word lower upper) := Eval cbv [proj1_sig] in proj1_sig v.
+Definition word_bounded {lower upper} (v : bounded_word lower upper)
+  : andb (lower <=? proj_word v)%Z (proj_word v <=? upper)%Z = true
+  := project_is_boundedT (proj2_sig v).
+Definition Build_bounded_word' {lower upper} proj_word word_bounded : bounded_word lower upper
+  := exist _ proj_word (Build_is_boundedT word_bounded).
+Arguments proj_word {_ _} _.
+Arguments word_bounded {_ _} _.
+Arguments Build_bounded_word' {_ _} _ _.
+Definition Build_bounded_word {lower upper} (proj_word : word64) (word_bounded : andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z = true)
+  : bounded_word lower upper
+  := Build_bounded_word'
+       proj_word
+       (match andb (lower <=? proj_word)%Z (proj_word <=? upper)%Z as b return b = true -> b = true with
+        | true => fun _ => eq_refl
+        | false => fun x => x
+        end word_bounded).
+Lemma word_to_unbounded_helper {x e : nat} : (x < pow2 e)%nat -> (Z.of_nat e <= Z.of_nat bit_width)%Z -> ((0 <=? word64ToZ (ZToWord64 (Z.of_nat x))) && (word64ToZ (ZToWord64 (Z.of_nat x)) <=? 2 ^ (Z.of_nat e) - 1))%bool = true.
+Proof.
+  rewrite pow2_id; intro H; apply Nat2Z.inj_lt in H; revert H.
+  rewrite Z.pow_Zpow; simpl Z.of_nat.
+  intros H H'.
+  assert (2^Z.of_nat e <= 2^Z.of_nat bit_width) by auto with zarith.
+  rewrite ?word64ToZ_ZToWord64 by omega.
+  match goal with
+  | [ |- context[andb ?x ?y] ]
+    => destruct x eqn:?, y eqn:?; try reflexivity; Z.ltb_to_lt
+  end;
+    intros; omega.
+Qed.
+Definition word_to_unbounded_word {sz} (x : word sz) : (Z.of_nat sz <=? Z.of_nat bit_width)%Z = true -> unbounded_word (Z.of_nat sz).
+Proof.
+  refine (fun pf => Build_bounded_word (Z.of_N (wordToN x)) _).
+  abstract (rewrite wordToN_nat, nat_N_Z; Z.ltb_to_lt; apply (word_to_unbounded_helper (wordToNat_bound x)); simpl; omega).
+Defined.
+Definition word32_to_unbounded_word (x : word 32) : unbounded_word 32.
+Proof. apply (word_to_unbounded_word x); reflexivity. Defined.
+Definition word31_to_unbounded_word (x : word 31) : unbounded_word 31.
+Proof. apply (word_to_unbounded_word x); reflexivity. Defined.
+
+Local Opaque word64.
+Declare Reduction app_tuple_map := cbv [app_wire_digitsW app_fe5211_32W app_fe5211_32 HList.mapt HList.mapt' Tuple.map on_tuple List.map List.app length_fe5211_32 List.length wire_widths Tuple.from_list Tuple.from_list' Tuple.to_list Tuple.to_list' fst snd].
+Definition fe5211_32WToZ (x : fe5211_32W) : SpecificGen.GF5211_32.fe5211_32
+  := Eval app_tuple_map in
+      app_fe5211_32W x (Tuple.map (fun v : word64 => v : Z)).
+Definition fe5211_32ZToW (x : SpecificGen.GF5211_32.fe5211_32) : fe5211_32W
+  := Eval app_tuple_map in
+      app_fe5211_32W x (Tuple.map (fun v : Z => v : word64)).
+Definition wire_digitsWToZ (x : wire_digitsW) : SpecificGen.GF5211_32.wire_digits
+  := Eval app_tuple_map in
+      app_wire_digitsW x (Tuple.map (fun v : word64 => v : Z)).
+Definition wire_digitsZToW (x : SpecificGen.GF5211_32.wire_digits) : wire_digitsW
+  := Eval app_tuple_map in
+      app_wire_digitsW x (Tuple.map (fun v : Z => v : word64)).
+Definition fe5211_32W_word64ize (x : fe5211_32W) : fe5211_32W
+  := Eval app_tuple_map in
+      app_fe5211_32W x (Tuple.map word64ize).
+Definition wire_digitsW_word64ize (x : wire_digitsW) : wire_digitsW
+  := Eval app_tuple_map in
+      app_wire_digitsW x (Tuple.map word64ize).
+
+(** TODO: Turn this into a lemma to speed up proofs *)
+Ltac unfold_is_bounded_in H :=
+  unfold is_bounded, wire_digits_is_bounded, is_bounded_gen, fe5211_32WToZ, wire_digitsWToZ in H;
+  cbv [to_list length bounds wire_digit_bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map fold_right List.rev List.app length_fe5211_32 List.length wire_widths] in H;
+  rewrite ?Bool.andb_true_iff in H.
+
+Ltac unfold_is_bounded :=
+  unfold is_bounded, wire_digits_is_bounded, is_bounded_gen, fe5211_32WToZ, wire_digitsWToZ;
+  cbv [to_list length bounds wire_digit_bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map fold_right List.rev List.app length_fe5211_32 List.length wire_widths];
+  rewrite ?Bool.andb_true_iff.
+
+Local Transparent bit_width.
+Definition Pow2_64 := Eval compute in 2^Z.of_nat bit_width.
+Definition unfold_Pow2_64 : 2^Z.of_nat bit_width = Pow2_64 := eq_refl.
+Local Opaque bit_width.
+
+Local Ltac prove_lt_bit_width :=
+  rewrite unfold_Pow2_64; cbv [Pow2_64]; omega.
+
+Lemma fe5211_32ZToW_WToZ (x : fe5211_32W) : fe5211_32ZToW (fe5211_32WToZ x) = x.
+Proof.
+  hnf in x; destruct_head' prod; cbv [fe5211_32WToZ fe5211_32ZToW].
+  rewrite !ZToWord64_word64ToZ; reflexivity.
+Qed.
+
+Lemma fe5211_32WToZ_ZToW x : is_bounded x = true -> fe5211_32WToZ (fe5211_32ZToW x) = x.
+Proof.
+  hnf in x; destruct_head' prod; cbv [fe5211_32WToZ fe5211_32ZToW].
+  intro H.
+  unfold_is_bounded_in H; destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite !word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Lemma fe5211_32W_word64ize_id x : fe5211_32W_word64ize x = x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [fe5211_32W_word64ize];
+    repeat apply f_equal2; apply word64ize_id.
+Qed.
+Lemma wire_digitsW_word64ize_id x : wire_digitsW_word64ize x = x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [wire_digitsW_word64ize];
+    repeat apply f_equal2; apply word64ize_id.
+Qed.
+
+Definition uncurry_unop_fe5211_32W {T} (op : fe5211_32W -> T)
+  := Eval cbv (*-[word64]*) in Tuple.uncurry (n:=length_fe5211_32) op.
+Definition curry_unop_fe5211_32W {T} op : fe5211_32W -> T
+  := Eval cbv (*-[word64]*) in fun f => app_fe5211_32W f (Tuple.curry (n:=length_fe5211_32) op).
+Definition uncurry_binop_fe5211_32W {T} (op : fe5211_32W -> fe5211_32W -> T)
+  := Eval cbv (*-[word64]*) in uncurry_unop_fe5211_32W (fun f => uncurry_unop_fe5211_32W (op f)).
+Definition curry_binop_fe5211_32W {T} op : fe5211_32W -> fe5211_32W -> T
+  := Eval cbv (*-[word64]*) in appify2 (fun f => curry_unop_fe5211_32W (curry_unop_fe5211_32W op f)).
+
+Definition uncurry_unop_wire_digitsW {T} (op : wire_digitsW -> T)
+  := Eval cbv (*-[word64]*) in Tuple.uncurry (n:=length wire_widths) op.
+Definition curry_unop_wire_digitsW {T} op : wire_digitsW -> T
+  := Eval cbv (*-[word64]*) in fun f => app_wire_digitsW f (Tuple.curry (n:=length wire_widths) op).
+
+
+Definition proj1_fe5211_32W (x : fe5211_32) : fe5211_32W
+  := Eval app_tuple_map in
+      app_fe5211_32 x (HList.mapt (fun _ => (@proj_word _ _))).
+Coercion proj1_fe5211_32 (x : fe5211_32) : SpecificGen.GF5211_32.fe5211_32
+  := fe5211_32WToZ (proj1_fe5211_32W x).
+
+Lemma is_bounded_proj1_fe5211_32 (x : fe5211_32) : is_bounded (proj1_fe5211_32 x) = true.
+Proof.
+  revert x; refine (app_fe5211_32_dep _); intro x.
+  hnf in x; destruct_head' prod; destruct_head' bounded_word.
+  cbv [is_bounded proj1_fe5211_32 proj1_fe5211_32W fe5211_32WToZ to_list length bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map List.rev List.app proj_word length_fe5211_32 is_bounded_gen].
+  apply fold_right_andb_true_iff_fold_right_and_True.
+  cbv [fold_right List.map].
+  cbv beta in *.
+  repeat split; auto using project_is_boundedT.
+Qed.
+
+Definition proj1_wire_digitsW (x : wire_digits) : wire_digitsW
+  := app_wire_digits x (HList.mapt (fun _ => proj_word)).
+Coercion proj1_wire_digits (x : wire_digits) : SpecificGen.GF5211_32.wire_digits
+  := wire_digitsWToZ (proj1_wire_digitsW x).
+
+Lemma is_bounded_proj1_wire_digits (x : wire_digits) : wire_digits_is_bounded (proj1_wire_digits x) = true.
+Proof.
+  revert x; refine (app_wire_digits_dep _); intro x.
+  hnf in x; destruct_head' prod; destruct_head' bounded_word.
+  cbv [wire_digits_is_bounded proj1_wire_digits proj1_wire_digitsW wire_digitsWToZ to_list length wire_digit_bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map List.rev List.app proj_word is_bounded_gen wire_widths HList.mapt HList.mapt' app_wire_digits fst snd].
+  apply fold_right_andb_true_iff_fold_right_and_True.
+  cbv [fold_right List.map].
+  cbv beta in *.
+  repeat split; auto using project_is_boundedT.
+Qed.
+
+Local Ltac make_exist_W' x app_W_dep :=
+  let H := fresh in
+  revert x; refine (@app_W_dep _ _ _); intros x H;
+  let x' := fresh in
+  set (x' := x);
+  cbv [tuple tuple' length_fe5211_32 List.length wire_widths] in x;
+  destruct_head' prod;
+  let rec do_refine v H :=
+      first [ let v' := (eval cbv [snd fst] in (snd v)) in
+              refine (_, Build_bounded_word v' _);
+              [ do_refine (fst v) (proj2 H) | subst x'; abstract exact (proj1 H) ]
+            | let v' := (eval cbv [snd fst] in v) in
+              refine (Build_bounded_word v' _); subst x'; abstract exact (proj1 H) ] in
+  let H' := constr:(proj1 (@fold_right_andb_true_iff_fold_right_and_True _) H) in
+  let T := type of H' in
+  let T := (eval cbv [id
+                        List.fold_right List.map List.length List.app ListUtil.map2 List.rev
+                        Tuple.to_list Tuple.to_list' Tuple.from_list Tuple.from_list' Tuple.map2 Tuple.on_tuple2
+                        fe5211_32 bounds fe5211_32WToZ length_fe5211_32
+                        wire_digits wire_digit_bounds wire_digitsWToZ wire_widths] in T) in
+  let H' := constr:(H' : T) in
+  let v := (eval unfold x' in x') in
+  do_refine v H'.
+Local Ltac make_exist'' x exist_W ZToW :=
+  let H := fresh in
+  intro H; apply (exist_W (ZToW x));
+  abstract (
+      hnf in x; destruct_head' prod;
+      let H' := fresh in
+      pose proof H as H';
+      unfold_is_bounded_in H;
+      destruct_head' and; simpl in *;
+      Z.ltb_to_lt;
+      rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width;
+      assumption
+    ).
+Local Ltac make_exist' x app_W_dep exist'' exist_W ZToW :=
+  let H := fresh in
+  revert x; refine (@app_W_dep _ _ _); intros x H;
+  let x' := fresh in
+  set (x' := x) in *;
+  cbv [tuple tuple' length_fe5211_32 List.length wire_widths] in x;
+  destruct_head' prod;
+  let rec do_refine v :=
+      first [ let v' := (eval cbv [exist_W ZToW exist'' proj_word Build_bounded_word Build_bounded_word' snd fst] in (proj_word v)) in
+              refine (Build_bounded_word v' _); subst x'; abstract exact (word_bounded v)
+            | let v' := (eval cbv [exist_W ZToW exist'' proj_word Build_bounded_word Build_bounded_word' snd fst] in (proj_word (snd v))) in
+              refine (_, Build_bounded_word v' _);
+              [ do_refine (fst v) | subst x'; abstract exact (word_bounded (snd v)) ] ] in
+  let v := (eval unfold x' in (exist'' x' H)) in
+  do_refine v.
+
+Definition exist_fe5211_32W' (x : fe5211_32W) : is_bounded (fe5211_32WToZ x) = true -> fe5211_32.
+Proof. make_exist_W' x (@app_fe5211_32W_dep). Defined.
+Definition exist_fe5211_32W (x : fe5211_32W) : is_bounded (fe5211_32WToZ x) = true -> fe5211_32
+  := Eval cbv [app_fe5211_32W_dep exist_fe5211_32W' fe5211_32ZToW] in exist_fe5211_32W' x.
+Definition exist_fe5211_32'' (x : SpecificGen.GF5211_32.fe5211_32) : is_bounded x = true -> fe5211_32.
+Proof. make_exist'' x exist_fe5211_32W fe5211_32ZToW. Defined.
+Definition exist_fe5211_32' (x : SpecificGen.GF5211_32.fe5211_32) : is_bounded x = true -> fe5211_32.
+Proof. make_exist' x (@app_fe5211_32W_dep) exist_fe5211_32'' exist_fe5211_32W fe5211_32ZToW. Defined.
+Definition exist_fe5211_32 (x : SpecificGen.GF5211_32.fe5211_32) : is_bounded x = true -> fe5211_32
+  := Eval cbv [exist_fe5211_32' exist_fe5211_32W exist_fe5211_32' app_fe5211_32 app_fe5211_32W_dep] in
+      exist_fe5211_32' x.
+
+Lemma proj1_fe5211_32_exist_fe5211_32W x pf : proj1_fe5211_32 (exist_fe5211_32W x pf) = fe5211_32WToZ x.
+Proof. now hnf in x; destruct_head' prod. Qed.
+Lemma proj1_fe5211_32W_exist_fe5211_32 x pf : proj1_fe5211_32W (exist_fe5211_32 x pf) = fe5211_32ZToW x.
+Proof. now hnf in x; destruct_head' prod. Qed.
+Lemma proj1_fe5211_32_exist_fe5211_32 x pf : proj1_fe5211_32 (exist_fe5211_32 x pf) = x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [proj1_fe5211_32 exist_fe5211_32 proj1_fe5211_32W fe5211_32WToZ proj_word Build_bounded_word Build_bounded_word'].
+  unfold_is_bounded_in pf.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Definition exist_wire_digitsW' (x : wire_digitsW)
+  : wire_digits_is_bounded (wire_digitsWToZ x) = true -> wire_digits.
+Proof. make_exist_W' x (@app_wire_digitsW_dep). Defined.
+Definition exist_wire_digitsW (x : wire_digitsW)
+  : wire_digits_is_bounded (wire_digitsWToZ x) = true -> wire_digits
+  := Eval cbv [app_wire_digitsW_dep exist_wire_digitsW' wire_digitsZToW] in exist_wire_digitsW' x.
+Definition exist_wire_digits'' (x : SpecificGen.GF5211_32.wire_digits)
+  : wire_digits_is_bounded x = true -> wire_digits.
+Proof. make_exist'' x exist_wire_digitsW wire_digitsZToW. Defined.
+Definition exist_wire_digits' (x : SpecificGen.GF5211_32.wire_digits)
+  : wire_digits_is_bounded x = true -> wire_digits.
+Proof. make_exist' x (@app_wire_digitsW_dep) exist_wire_digits'' exist_wire_digitsW wire_digitsZToW. Defined.
+Definition exist_wire_digits (x : SpecificGen.GF5211_32.wire_digits)
+  : wire_digits_is_bounded x = true -> wire_digits
+  := Eval cbv [exist_wire_digits' exist_wire_digitsW exist_wire_digits' app_wire_digits app_wire_digitsW_dep] in
+      exist_wire_digits' x.
+
+Lemma proj1_wire_digits_exist_wire_digitsW x pf : proj1_wire_digits (exist_wire_digitsW x pf) = wire_digitsWToZ x.
+Proof. now hnf in x; destruct_head' prod. Qed.
+Lemma proj1_wire_digitsW_exist_wire_digits x pf : proj1_wire_digitsW (exist_wire_digits x pf) = wire_digitsZToW x.
+Proof. now hnf in x; destruct_head' prod. Qed.
+Lemma proj1_wire_digits_exist_wire_digits x pf : proj1_wire_digits (exist_wire_digits x pf) = x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [proj1_wire_digits exist_wire_digits proj1_wire_digitsW wire_digitsWToZ proj_word Build_bounded_word Build_bounded_word' app_wire_digits HList.mapt HList.mapt' length wire_widths fst snd].
+  unfold_is_bounded_in pf.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Module opt.
+  Definition word64ToZ := Eval vm_compute in word64ToZ.
+  Definition word64ToN := Eval vm_compute in @wordToN bit_width.
+  Definition NToWord64 := Eval vm_compute in NToWord64.
+  Definition bit_width := Eval vm_compute in bit_width.
+  Definition Zleb := Eval cbv [Z.leb] in Z.leb.
+  Definition andb := Eval vm_compute in andb.
+  Definition word64ize := Eval vm_compute in word64ize.
+End opt.
+
+Local Transparent bit_width.
+Local Ltac do_change lem :=
+  match lem with
+  | context L[andb (?x <=? ?y)%Z (?y <=? ?z)]
+    => let x' := (eval vm_compute in x) in
+       let z' := (eval vm_compute in z) in
+       lazymatch y with
+       | word64ToZ (word64ize ?v)
+         => let y' := constr:(opt.word64ToZ (opt.word64ize v)) in
+            let L' := context L[andb (opt.Zleb x' y') (opt.Zleb y' z')] in
+            do_change L'
+       end
+  | _ => lem
+  end.
+Definition fe5211_32_word64ize (x : fe5211_32) : fe5211_32.
+Proof.
+  set (x' := x).
+  hnf in x; destruct_head' prod.
+  let lem := constr:(exist_fe5211_32W (fe5211_32W_word64ize (proj1_fe5211_32W x'))) in
+  let lem := (eval cbv [proj1_fe5211_32W x' fe5211_32W_word64ize proj_word exist_fe5211_32W Build_bounded_word' Build_bounded_word] in lem) in
+  let lem := do_change lem in
+  refine (lem _);
+    change (is_bounded (fe5211_32WToZ (fe5211_32W_word64ize (proj1_fe5211_32W x'))) = true);
+    abstract (rewrite fe5211_32W_word64ize_id; apply is_bounded_proj1_fe5211_32).
+Defined.
+Definition wire_digits_word64ize (x : wire_digits) : wire_digits.
+Proof.
+  set (x' := x).
+  hnf in x; destruct_head' prod.
+  let lem := constr:(exist_wire_digitsW (wire_digitsW_word64ize (proj1_wire_digitsW x'))) in
+  let lem := (eval cbv [proj1_wire_digitsW x' wire_digitsW_word64ize proj_word exist_wire_digitsW Build_bounded_word Build_bounded_word'] in lem) in
+  let lem := do_change lem in
+  let lem := (eval cbv [word64ize opt.word64ize andb Z.leb Z.compare CompOpp Pos.compare] in lem) in
+  refine (lem _);
+    change (wire_digits_is_bounded (wire_digitsWToZ (wire_digitsW_word64ize (proj1_wire_digitsW x'))) = true);
+    abstract (rewrite wire_digitsW_word64ize_id; apply is_bounded_proj1_wire_digits).
+Defined.
+
+Lemma is_bounded_to_nth_default x (H : is_bounded x = true)
+  : forall n : nat,
+    (n < length limb_widths)%nat
+    -> (0 <= nth_default 0 (Tuple.to_list length_fe5211_32 x) n <=
+        snd (b_of (nth_default (-1) limb_widths n)))%Z.
+Proof.
+  hnf in x; destruct_head' prod.
+  unfold_is_bounded_in H; destruct_head' and.
+  Z.ltb_to_lt.
+  unfold nth_default; simpl.
+  intros.
+  repeat match goal with
+         | [ |- context[nth_error _ ?x] ]
+           => is_var x; destruct x; simpl
+         end;
+    omega.
+Qed.
+
+(* END precomputation *)
+
+(* Precompute constants *)
+
+Definition one' := Eval vm_compute in exist_fe5211_32 SpecificGen.GF5211_32.one_ eq_refl.
+Definition one := Eval cbv [one' fe5211_32_word64ize word64ize andb opt.word64ToZ opt.word64ize opt.Zleb Z.compare CompOpp Pos.compare Pos.compare_cont] in fe5211_32_word64ize one'.
+
+Definition zero' := Eval vm_compute in exist_fe5211_32 SpecificGen.GF5211_32.zero_ eq_refl.
+Definition zero := Eval cbv [zero' fe5211_32_word64ize word64ize andb opt.word64ToZ opt.word64ize opt.Zleb Z.compare CompOpp Pos.compare Pos.compare_cont] in fe5211_32_word64ize zero'.
+
+Lemma fold_chain_opt_gen {A B} (F : A -> B) is_bounded ls id' op' id op chain
+      (Hid_bounded : is_bounded (F id') = true)
+      (Hid : id = F id')
+      (Hop_bounded : forall x y, is_bounded (F x) = true
+                                 -> is_bounded (F y) = true
+                                 -> is_bounded (op (F x) (F y)) = true)
+      (Hop : forall x y, is_bounded (F x) = true
+                         -> is_bounded (F y) = true
+                         -> op (F x) (F y) = F (op' x y))
+      (Hls_bounded : forall n, is_bounded (F (nth_default id' ls n)) = true)
+  : F (fold_chain_opt id' op' chain ls)
+    = fold_chain_opt id op chain (List.map F ls)
+    /\ is_bounded (F (fold_chain_opt id' op' chain ls)) = true.
+Proof.
+  rewrite !fold_chain_opt_correct.
+  revert dependent ls; induction chain as [|x xs IHxs]; intros.
+  { pose proof (Hls_bounded 0%nat).
+    destruct ls; simpl; split; trivial; congruence. }
+  { destruct x; simpl; unfold Let_In; simpl.
+    rewrite (fun ls pf => proj1 (IHxs ls pf)) at 1; simpl.
+    { do 2 f_equal.
+      rewrite <- Hop, Hid by auto.
+      rewrite !map_nth_default_always.
+      split; try reflexivity.
+      apply (IHxs (_::_)).
+      intros [|?]; autorewrite with simpl_nth_default; auto.
+      rewrite <- Hop; auto. }
+    { intros [|?]; simpl;
+        autorewrite with simpl_nth_default; auto.
+      rewrite <- Hop; auto. } }
+Qed.
+
+Lemma encode_bounded x : is_bounded (encode x) = true.
+Proof.
+  pose proof (bounded_encode x).
+  generalize dependent (encode x).
+  intro t; compute in t; intros.
+  destruct_head' prod.
+  unfold Pow2Base.bounded in H.
+  cbv [nth_default Tuple.to_list Tuple.to_list' List.length limb_widths params5211_32] in H.
+  repeat match type of H with
+         | context[nth_error (cons _ _) _]
+           => let H' := fresh in
+              pose proof (H O) as H'; specialize (fun i => H (S i)); simpl @nth_error in H, H';
+                cbv beta iota in H'
+         end.
+  clear H.
+  simpl in *.
+  cbv [Z.pow_pos Z.mul Pos.mul Pos.iter nth_default nth_error value] in *.
+  unfold is_bounded.
+  apply fold_right_andb_true_iff_fold_right_and_True.
+  cbv [is_bounded proj1_fe5211_32 to_list length bounds from_list from_list' map2 on_tuple2 to_list' ListUtil.map2 List.map List.rev List.app proj_word fold_right length_fe5211_32].
+  repeat split; rewrite !Bool.andb_true_iff, !Z.leb_le; omega.
+Qed.
+
+Definition encode (x : F modulus) : fe5211_32
+  := exist_fe5211_32 (encode x) (encode_bounded x).
+
+Definition decode (x : fe5211_32) : F modulus
+  := ModularBaseSystem.decode (proj1_fe5211_32 x).
+
+Lemma proj1_fe5211_32_encode x
+  : proj1_fe5211_32 (encode x) = ModularBaseSystem.encode x.
+Proof.
+  cbv [encode].
+  generalize (encode_bounded x); generalize (ModularBaseSystem.encode x).
+  intros y pf; intros; hnf in y; destruct_head_hnf' prod.
+  cbv [proj1_fe5211_32 exist_fe5211_32 proj1_fe5211_32W Build_bounded_word Build_bounded_word' fe5211_32WToZ proj_word].
+  unfold_is_bounded_in pf.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Lemma decode_exist_fe5211_32 x pf
+  : decode (exist_fe5211_32 x pf) = ModularBaseSystem.decode x.
+Proof.
+  hnf in x; destruct_head' prod.
+  cbv [decode proj1_fe5211_32 exist_fe5211_32 proj1_fe5211_32W Build_bounded_word Build_bounded_word' fe5211_32WToZ proj_word].
+  unfold_is_bounded_in pf.
+  destruct_head' and.
+  Z.ltb_to_lt.
+  rewrite ?word64ToZ_ZToWord64 by prove_lt_bit_width.
+  reflexivity.
+Qed.
+
+Definition div (f g : fe5211_32) : fe5211_32
+  := exist_fe5211_32 (div (proj1_fe5211_32 f) (proj1_fe5211_32 g)) (encode_bounded _).
+
+Definition eq (f g : fe5211_32) : Prop := eq (proj1_fe5211_32 f) (proj1_fe5211_32 g).
+
+
+Notation ibinop_correct_and_bounded irop op
+  := (forall x y,
+         is_bounded (fe5211_32WToZ x) = true
+         -> is_bounded (fe5211_32WToZ y) = true
+         -> fe5211_32WToZ (irop x y) = op (fe5211_32WToZ x) (fe5211_32WToZ y)
+            /\ is_bounded (fe5211_32WToZ (irop x y)) = true) (only parsing).
+Notation iunop_correct_and_bounded irop op
+  := (forall x,
+         is_bounded (fe5211_32WToZ x) = true
+         -> fe5211_32WToZ (irop x) = op (fe5211_32WToZ x)
+            /\ is_bounded (fe5211_32WToZ (irop x)) = true) (only parsing).
+Notation iunop_FEToZ_correct irop op
+  := (forall x,
+         is_bounded (fe5211_32WToZ x) = true
+         -> word64ToZ (irop x) = op (fe5211_32WToZ x)) (only parsing).
+Notation iunop_FEToWire_correct_and_bounded irop op
+  := (forall x,
+         is_bounded (fe5211_32WToZ x) = true
+         -> wire_digitsWToZ (irop x) = op (fe5211_32WToZ x)
+            /\ wire_digits_is_bounded (wire_digitsWToZ (irop x)) = true) (only parsing).
+Notation iunop_WireToFE_correct_and_bounded irop op
+  := (forall x,
+         wire_digits_is_bounded (wire_digitsWToZ x) = true
+         -> fe5211_32WToZ (irop x) = op (wire_digitsWToZ x)
+            /\ is_bounded (fe5211_32WToZ (irop x)) = true) (only parsing).
+
+Definition prefreeze := GF5211_32.prefreeze.
diff --git a/src/SpecificGen/GF5211_32Reflective.v b/src/SpecificGen/GF5211_32Reflective.v
new file mode 100644
index 000000000..332d5c7e9
--- /dev/null
+++ b/src/SpecificGen/GF5211_32Reflective.v
@@ -0,0 +1,119 @@
+Require Import Crypto.BaseSystem.
+Require Import Crypto.ModularArithmetic.PrimeFieldTheorems.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParams.
+Require Import Crypto.ModularArithmetic.PseudoMersenneBaseParamProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystem.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemProofs.
+Require Import Crypto.ModularArithmetic.ModularBaseSystemOpt.
+Require Export Crypto.SpecificGen.GF5211_32.
+Require Import Crypto.SpecificGen.GF5211_32BoundedCommon.
+Require Import Crypto.Reflection.Reify.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Crypto.Reflection.Z.Interpretations.Relations.
+Require Import Crypto.Reflection.Z.Interpretations.RelationsCombinations.
+Require Import Crypto.Reflection.Z.Reify.
+Require Import Crypto.Reflection.Z.Syntax.
+Require Import Crypto.SpecificGen.GF5211_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF5211_32Reflective.Reified.
+Require Import Bedrock.Word Crypto.Util.WordUtil.
+Require Import Coq.Lists.List Crypto.Util.ListUtil.
+Require Import Crypto.Tactics.VerdiTactics.
+Require Import Crypto.Util.ZUtil.
+Require Import Crypto.Util.Tuple.
+Require Import Crypto.Util.Tactics.
+Require Import Crypto.Util.LetIn.
+Require Import Crypto.Util.Notations.
+Require Import Crypto.Util.Bool.
+Require Import Crypto.Util.Decidable.
+Require Import Crypto.Algebra.
+Import ListNotations.
+Require Import Coq.ZArith.ZArith Coq.ZArith.Zpower Coq.ZArith.ZArith Coq.ZArith.Znumtheory.
+Local Open Scope Z.
+
+Definition radd : ExprBinOp := Eval vm_compute in rcarry_addW.
+Definition rsub : ExprBinOp := Eval vm_compute in rcarry_subW.
+Definition rmul : ExprBinOp := Eval vm_compute in rmulW.
+Definition ropp : ExprUnOp := Eval vm_compute in rcarry_oppW.
+Definition rprefreeze : ExprUnOp := Eval vm_compute in rprefreezeW.
+Definition rge_modulus : ExprUnOpFEToZ := Eval vm_compute in rge_modulusW.
+Definition rpack : ExprUnOpFEToWire := Eval vm_compute in rpackW.
+Definition runpack : ExprUnOpWireToFE := Eval vm_compute in runpackW.
+
+Definition rword64ize {t} (x : Expr t) : Expr t
+  := MapInterp (fun t => match t with TZ => word64ize end) x.
+
+Declare Reduction asm_interp
+  := cbv beta iota delta
+         [id
+            interp_bexpr interp_uexpr interp_uexpr_FEToWire interp_uexpr_FEToZ interp_uexpr_WireToFE
+            radd rsub rmul ropp rprefreeze rge_modulus rpack runpack
+            curry_binop_fe5211_32W curry_unop_fe5211_32W curry_unop_wire_digitsW
+            Word64.interp_op Word64.interp_base_type
+            Z.interp_op Z.interp_base_type
+            Z.Syntax.interp_op Z.Syntax.interp_base_type
+            mapf_interp_flat_type map_interp Word64.interp_base_type MapInterp mapf_interp word64ize rword64ize
+            Interp interp interp_flat_type interpf interp_flat_type fst snd].
+Ltac asm_interp
+  := cbv beta iota delta
+         [id
+            interp_bexpr interp_uexpr interp_uexpr_FEToWire interp_uexpr_FEToZ interp_uexpr_WireToFE
+            radd rsub rmul ropp rprefreeze rge_modulus rpack runpack
+            curry_binop_fe5211_32W curry_unop_fe5211_32W curry_unop_wire_digitsW
+            Word64.interp_op Word64.interp_base_type
+            Z.interp_op Z.interp_base_type
+            Z.Syntax.interp_op Z.Syntax.interp_base_type
+            mapf_interp_flat_type map_interp Word64.interp_base_type MapInterp mapf_interp word64ize rword64ize
+            Interp interp interp_flat_type interpf interp_flat_type fst snd].
+
+
+Definition interp_radd : SpecificGen.GF5211_32BoundedCommon.fe5211_32W -> SpecificGen.GF5211_32BoundedCommon.fe5211_32W -> SpecificGen.GF5211_32BoundedCommon.fe5211_32W
+  := Eval asm_interp in interp_bexpr (rword64ize radd).
+(*Print interp_radd.*)
+Definition interp_radd_correct : interp_radd = interp_bexpr radd := eq_refl.
+Definition interp_rsub : SpecificGen.GF5211_32BoundedCommon.fe5211_32W -> SpecificGen.GF5211_32BoundedCommon.fe5211_32W -> SpecificGen.GF5211_32BoundedCommon.fe5211_32W
+  := Eval asm_interp in interp_bexpr (rword64ize rsub).
+(*Print interp_rsub.*)
+Definition interp_rsub_correct : interp_rsub = interp_bexpr rsub := eq_refl.
+Definition interp_rmul : SpecificGen.GF5211_32BoundedCommon.fe5211_32W -> SpecificGen.GF5211_32BoundedCommon.fe5211_32W -> SpecificGen.GF5211_32BoundedCommon.fe5211_32W
+  := Eval asm_interp in interp_bexpr (rword64ize rmul).
+(*Print interp_rmul.*)
+Definition interp_rmul_correct : interp_rmul = interp_bexpr rmul := eq_refl.
+Definition interp_ropp : SpecificGen.GF5211_32BoundedCommon.fe5211_32W -> SpecificGen.GF5211_32BoundedCommon.fe5211_32W
+  := Eval asm_interp in interp_uexpr (rword64ize ropp).
+(*Print interp_ropp.*)
+Definition interp_ropp_correct : interp_ropp = interp_uexpr ropp := eq_refl.
+Definition interp_rprefreeze : SpecificGen.GF5211_32BoundedCommon.fe5211_32W -> SpecificGen.GF5211_32BoundedCommon.fe5211_32W
+  := Eval asm_interp in interp_uexpr (rword64ize rprefreeze).
+(*Print interp_rprefreeze.*)
+Definition interp_rprefreeze_correct : interp_rprefreeze = interp_uexpr rprefreeze := eq_refl.
+
+Definition interp_rge_modulus : SpecificGen.GF5211_32BoundedCommon.fe5211_32W -> SpecificGen.GF5211_32BoundedCommon.word64
+  := Eval asm_interp in interp_uexpr_FEToZ (rword64ize rge_modulus).
+Definition interp_rge_modulus_correct : interp_rge_modulus = interp_uexpr_FEToZ rge_modulus := eq_refl.
+
+Definition interp_rpack : SpecificGen.GF5211_32BoundedCommon.fe5211_32W -> SpecificGen.GF5211_32BoundedCommon.wire_digitsW
+  := Eval asm_interp in interp_uexpr_FEToWire (rword64ize rpack).
+Definition interp_rpack_correct : interp_rpack = interp_uexpr_FEToWire rpack := eq_refl.
+
+Definition interp_runpack : SpecificGen.GF5211_32BoundedCommon.wire_digitsW -> SpecificGen.GF5211_32BoundedCommon.fe5211_32W
+  := Eval asm_interp in interp_uexpr_WireToFE (rword64ize runpack).
+Definition interp_runpack_correct : interp_runpack = interp_uexpr_WireToFE runpack := eq_refl.
+
+Lemma radd_correct_and_bounded : binop_correct_and_bounded radd carry_add.
+Proof. exact rcarry_addW_correct_and_bounded. Qed.
+Lemma rsub_correct_and_bounded : binop_correct_and_bounded rsub carry_sub.
+Proof. exact rcarry_subW_correct_and_bounded. Qed.
+Lemma rmul_correct_and_bounded : binop_correct_and_bounded rmul mul.
+Proof. exact rmulW_correct_and_bounded. Qed.
+Lemma ropp_correct_and_bounded : unop_correct_and_bounded ropp carry_opp.
+Proof. exact rcarry_oppW_correct_and_bounded. Qed.
+Lemma rprefreeze_correct_and_bounded : unop_correct_and_bounded rprefreeze prefreeze.
+Proof. exact rprefreezeW_correct_and_bounded. Qed.
+Lemma rge_modulus_correct_and_bounded : unop_FEToZ_correct rge_modulus ge_modulus.
+Proof. exact rge_modulusW_correct_and_bounded. Qed.
+Lemma rpack_correct_and_bounded : unop_FEToWire_correct_and_bounded rpack pack.
+Proof. exact rpackW_correct_and_bounded. Qed.
+Lemma runpack_correct_and_bounded : unop_WireToFE_correct_and_bounded runpack unpack.
+Proof. exact runpackW_correct_and_bounded. Qed.
diff --git a/src/SpecificGen/GF5211_32Reflective/Common.v b/src/SpecificGen/GF5211_32Reflective/Common.v
new file mode 100644
index 000000000..a2b9a7c63
--- /dev/null
+++ b/src/SpecificGen/GF5211_32Reflective/Common.v
@@ -0,0 +1,438 @@
+Require Export Coq.ZArith.ZArith.
+Require Export Coq.Strings.String.
+Require Export Crypto.SpecificGen.GF5211_32.
+Require Export Crypto.SpecificGen.GF5211_32BoundedCommon.
+Require Import Crypto.Reflection.Reify.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Crypto.Reflection.Z.Interpretations.Relations.
+Require Import Crypto.Reflection.Z.Interpretations.RelationsCombinations.
+Require Import Crypto.Reflection.Z.Reify.
+Require Export Crypto.Reflection.Z.Syntax.
+Require Import Crypto.Reflection.InterpWfRel.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Reflection.MapInterpWf.
+Require Import Crypto.Reflection.WfReflective.
+Require Import Crypto.Util.LetIn.
+Require Import Crypto.Util.ZUtil.
+Require Import Crypto.Util.Tactics.
+Require Import Crypto.Util.Notations.
+
+Notation Expr := (Expr base_type Word64.interp_base_type op).
+
+Local Ltac make_type_from uncurried_op :=
+  let T := (type of uncurried_op) in
+  let T := (eval compute in T) in
+  let rT := reify_type T in
+  exact rT.
+
+Definition ExprBinOpT : type base_type.
+Proof. make_type_from (uncurry_binop_fe5211_32 carry_add). Defined.
+Definition ExprUnOpT : type base_type.
+Proof. make_type_from (uncurry_unop_fe5211_32 carry_opp). Defined.
+Definition ExprUnOpFEToZT : type base_type.
+Proof. make_type_from (uncurry_unop_fe5211_32 ge_modulus). Defined.
+Definition ExprUnOpWireToFET : type base_type.
+Proof. make_type_from (uncurry_unop_wire_digits unpack). Defined.
+Definition ExprUnOpFEToWireT : type base_type.
+Proof. make_type_from (uncurry_unop_fe5211_32 pack). Defined.
+Definition ExprBinOp : Type := Expr ExprBinOpT.
+Definition ExprUnOp : Type := Expr ExprUnOpT.
+Definition ExprUnOpFEToZ : Type := Expr ExprUnOpFEToZT.
+Definition ExprUnOpWireToFE : Type := Expr ExprUnOpWireToFET.
+Definition ExprUnOpFEToWire : Type := Expr ExprUnOpFEToWireT.
+
+Local Ltac bounds_from_list ls :=
+  lazymatch (eval hnf in ls) with
+  | (?x :: nil)%list => constr:(Some {| ZBounds.lower := fst x ; ZBounds.upper := snd x |})
+  | (?x :: ?xs)%list => let bs := bounds_from_list xs in
+                        constr:((Some {| ZBounds.lower := fst x ; ZBounds.upper := snd x |}, bs))
+  end.
+
+Local Ltac make_bounds ls :=
+  compute;
+  let v := bounds_from_list (List.rev ls) in
+  let v := (eval compute in v) in
+  exact v.
+
+Definition ExprBinOp_bounds : interp_all_binders_for ExprBinOpT ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ bounds ++ Tuple.to_list _ bounds)%list. Defined.
+Definition ExprUnOp_bounds : interp_all_binders_for ExprUnOpT ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ bounds). Defined.
+Definition ExprUnOpFEToZ_bounds : interp_all_binders_for ExprUnOpFEToZT ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ bounds). Defined.
+Definition ExprUnOpFEToWire_bounds : interp_all_binders_for ExprUnOpFEToWireT ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ bounds). Defined.
+Definition ExprUnOpWireToFE_bounds : interp_all_binders_for ExprUnOpWireToFET ZBounds.interp_base_type.
+Proof. make_bounds (Tuple.to_list _ wire_digit_bounds). Defined.
+
+Definition interp_bexpr : ExprBinOp -> SpecificGen.GF5211_32BoundedCommon.fe5211_32W -> SpecificGen.GF5211_32BoundedCommon.fe5211_32W -> SpecificGen.GF5211_32BoundedCommon.fe5211_32W
+  := fun e => curry_binop_fe5211_32W (Interp (@Word64.interp_op) e).
+Definition interp_uexpr : ExprUnOp -> SpecificGen.GF5211_32BoundedCommon.fe5211_32W -> SpecificGen.GF5211_32BoundedCommon.fe5211_32W
+  := fun e => curry_unop_fe5211_32W (Interp (@Word64.interp_op) e).
+Definition interp_uexpr_FEToZ : ExprUnOpFEToZ -> SpecificGen.GF5211_32BoundedCommon.fe5211_32W -> SpecificGen.GF5211_32BoundedCommon.word64
+  := fun e => curry_unop_fe5211_32W (Interp (@Word64.interp_op) e).
+Definition interp_uexpr_FEToWire : ExprUnOpFEToWire -> SpecificGen.GF5211_32BoundedCommon.fe5211_32W -> SpecificGen.GF5211_32BoundedCommon.wire_digitsW
+  := fun e => curry_unop_fe5211_32W (Interp (@Word64.interp_op) e).
+Definition interp_uexpr_WireToFE : ExprUnOpWireToFE -> SpecificGen.GF5211_32BoundedCommon.wire_digitsW -> SpecificGen.GF5211_32BoundedCommon.fe5211_32W
+  := fun e => curry_unop_wire_digitsW (Interp (@Word64.interp_op) e).
+
+Notation binop_correct_and_bounded rop op
+  := (ibinop_correct_and_bounded (interp_bexpr rop) op) (only parsing).
+Notation unop_correct_and_bounded rop op
+  := (iunop_correct_and_bounded (interp_uexpr rop) op) (only parsing).
+Notation unop_FEToZ_correct rop op
+  := (iunop_FEToZ_correct (interp_uexpr_FEToZ rop) op) (only parsing).
+Notation unop_FEToWire_correct_and_bounded rop op
+  := (iunop_FEToWire_correct_and_bounded (interp_uexpr_FEToWire rop) op) (only parsing).
+Notation unop_WireToFE_correct_and_bounded rop op
+  := (iunop_WireToFE_correct_and_bounded (interp_uexpr_WireToFE rop) op) (only parsing).
+
+Ltac rexpr_cbv :=
+  lazymatch goal with
+  | [ |- { rexpr | interp_type_gen_rel_pointwise _ (Interp _ (t:=?T) rexpr) (?uncurry ?oper) } ]
+    => let operf := head oper in
+       let uncurryf := head uncurry in
+       try cbv delta [T]; try cbv delta [oper];
+       try cbv beta iota delta [uncurryf]
+  end;
+  cbv beta iota delta [interp_flat_type Z.interp_base_type interp_base_type zero_].
+
+Ltac reify_sig :=
+  rexpr_cbv; eexists; Reify_rhs; reflexivity.
+
+Local Notation rexpr_sig T uncurried_op :=
+  { rexprZ
+  | interp_type_gen_rel_pointwise (fun _ => Logic.eq) (Interp interp_op (t:=T) rexprZ) uncurried_op }
+    (only parsing).
+
+Notation rexpr_binop_sig op := (rexpr_sig ExprBinOpT (uncurry_binop_fe5211_32 op)) (only parsing).
+Notation rexpr_unop_sig op := (rexpr_sig ExprUnOpT (uncurry_unop_fe5211_32 op)) (only parsing).
+Notation rexpr_unop_FEToZ_sig op := (rexpr_sig ExprUnOpFEToZT (uncurry_unop_fe5211_32 op)) (only parsing).
+Notation rexpr_unop_FEToWire_sig op := (rexpr_sig ExprUnOpFEToWireT (uncurry_unop_fe5211_32 op)) (only parsing).
+Notation rexpr_unop_WireToFE_sig op := (rexpr_sig ExprUnOpWireToFET (uncurry_unop_wire_digits op)) (only parsing).
+
+Notation correct_and_bounded_genT ropW'v ropZ_sigv
+  := (let ropW' := ropW'v in
+      let ropZ_sig := ropZ_sigv in
+      let ropW := MapInterp (fun _ x => x) ropW' in
+      let ropZ := MapInterp Word64.to_Z ropW' in
+      let ropBounds := MapInterp ZBounds.of_word64 ropW' in
+      let ropBoundedWord64 := MapInterp BoundedWord64.of_word64 ropW' in
+      ropZ = proj1_sig ropZ_sig
+      /\ interp_type_rel_pointwise2 Relations.related_Z (Interp (@BoundedWord64.interp_op) ropBoundedWord64) (Interp (@Z.interp_op) ropZ)
+      /\ interp_type_rel_pointwise2 Relations.related_bounds (Interp (@BoundedWord64.interp_op) ropBoundedWord64) (Interp (@ZBounds.interp_op) ropBounds)
+      /\ interp_type_rel_pointwise2 Relations.related_word64 (Interp (@BoundedWord64.interp_op) ropBoundedWord64) (Interp (@Word64.interp_op) ropW))
+       (only parsing).
+
+Ltac app_tuples x y :=
+  let tx := type of x in
+  lazymatch (eval hnf in tx) with
+  | prod _ _ => let xs := app_tuples (snd x) y in
+                constr:((fst x, xs))
+  | _ => constr:((x, y))
+  end.
+
+Local Arguments Tuple.map2 : simpl never.
+Local Arguments Tuple.map : simpl never.
+
+Fixpoint args_to_bounded_helperT {n}
+         (v : Tuple.tuple' Word64.word64 n)
+         (bounds : Tuple.tuple' (Z * Z) n)
+         (pf : List.fold_right
+                 andb true
+                 (Tuple.to_list
+                    _
+                    (Tuple.map2
+                       (n:=S n)
+                       (fun bounds v =>
+                          let '(lower, upper) := bounds in ((lower <=? v)%Z && (v <=? upper)%Z)%bool)
+                       bounds
+                       (Tuple.map (n:=S n) Word64.word64ToZ v))) = true)
+         (res : Type)
+         {struct n}
+  : Type.
+Proof.
+  refine (match n return (forall (v : Tuple.tuple' _ n) (bounds : Tuple.tuple' _ n),
+                             List.fold_right
+                               _ _ (Tuple.to_list
+                                      _
+                                      (Tuple.map2 (n:=S n) _ bounds (Tuple.map (n:=S n) _ v))) = true
+                             -> Type)
+          with
+          | 0 => fun v' bounds' pf0 => forall pf1 : (0 <= fst bounds' /\ Z.log2 (snd bounds') < Z.of_nat Word64.bit_width)%Z, res
+          | S n' => fun v' bounds' pf0 => let t := _ in
+                                        forall pf1 : (0 <= fst (snd bounds') /\ Z.log2 (snd (snd bounds')) < Z.of_nat Word64.bit_width)%Z, @args_to_bounded_helperT n' (fst v') (fst bounds') t res
+          end v bounds pf).
+  { clear -pf0.
+    abstract (
+        destruct v', bounds'; simpl @fst;
+        rewrite Tuple.map_S in pf0;
+        simpl in pf0;
+        rewrite Tuple.map2_S in pf0;
+        simpl @List.fold_right in *;
+        rewrite Bool.andb_true_iff in pf0; tauto
+      ). }
+Defined.
+
+Fixpoint args_to_bounded_helper {n} res
+         {struct n}
+  : forall v bounds pf, (Tuple.tuple' BoundedWord64.BoundedWord n -> res) -> @args_to_bounded_helperT n v bounds pf res.
+Proof.
+  refine match n return (forall v bounds pf, (Tuple.tuple' BoundedWord64.BoundedWord n -> res) -> @args_to_bounded_helperT n v bounds pf res) with
+         | 0 => fun v bounds pf f pf' => f {| BoundedWord64.lower := fst bounds ; BoundedWord64.value := v ; BoundedWord64.upper := snd bounds |}
+         | S n'
+           => fun v bounds pf f pf'
+              => @args_to_bounded_helper
+                   n' res (fst v) (fst bounds) _
+                   (fun ts => f (ts, {| BoundedWord64.lower := fst (snd bounds) ; BoundedWord64.value := snd v ; BoundedWord64.upper := snd (snd bounds) |}))
+         end.
+  { clear -pf pf'.
+    unfold Tuple.map2, Tuple.map in pf; simpl in *.
+    abstract (
+        destruct bounds;
+        simpl in *;
+        rewrite !Bool.andb_true_iff in pf;
+        destruct_head' and;
+        Z.ltb_to_lt; auto
+      ). }
+  { simpl in *.
+    clear -pf pf'.
+    abstract (
+        destruct bounds as [? [? ?] ], v; simpl in *;
+        rewrite Tuple.map_S in pf; simpl in pf; rewrite Tuple.map2_S in pf;
+        simpl in pf;
+        rewrite !Bool.andb_true_iff in pf;
+        destruct_head' and;
+        Z.ltb_to_lt; auto
+      ). }
+Defined.
+
+Definition assoc_right''
+  := Eval cbv [Tuple.assoc_right' Tuple.rsnoc' fst snd] in @Tuple.assoc_right'.
+
+Definition args_to_bounded {n} v bounds pf
+  := Eval cbv [args_to_bounded_helper assoc_right''] in
+      @args_to_bounded_helper n _ v bounds pf (@assoc_right'' _ _).
+
+Local Ltac get_len T :=
+  match (eval hnf in T) with
+  | prod ?A ?B
+    => let a := get_len A in
+       let b := get_len B in
+       (eval compute in (a + b)%nat)
+  | _ => constr:(1%nat)
+  end.
+
+Local Ltac args_to_bounded x H :=
+  let x' := fresh in
+  set (x' := x);
+  compute in x;
+  let len := (let T := type of x in get_len T) in
+  destruct_head' prod;
+  let c := constr:(args_to_bounded (n:=pred len) x' _ H) in
+  let bounds := lazymatch c with args_to_bounded _ ?bounds _ => bounds end in
+  let c := (eval cbv [all_binders_for ExprUnOpT interp_flat_type args_to_bounded bounds pred fst snd] in c) in
+  apply c; compute; clear;
+  try abstract (
+        repeat split;
+        solve [ reflexivity
+              | refine (fun v => match v with eq_refl => I end) ]
+      ).
+
+Definition unop_args_to_bounded (x : fe5211_32W) (H : is_bounded (fe5211_32WToZ x) = true)
+  : interp_flat_type (fun _ => BoundedWord64.BoundedWord) (all_binders_for ExprUnOpT).
+Proof. args_to_bounded x H. Defined.
+
+Definition unopWireToFE_args_to_bounded (x : wire_digitsW) (H : wire_digits_is_bounded (wire_digitsWToZ x) = true)
+  : interp_flat_type (fun _ => BoundedWord64.BoundedWord) (all_binders_for ExprUnOpWireToFET).
+Proof. args_to_bounded x H. Defined.
+Definition binop_args_to_bounded (x : fe5211_32W * fe5211_32W)
+           (H : is_bounded (fe5211_32WToZ (fst x)) = true)
+           (H' : is_bounded (fe5211_32WToZ (snd x)) = true)
+  : interp_flat_type (fun _ => BoundedWord64.BoundedWord) (all_binders_for ExprBinOpT).
+Proof.
+  let v := app_tuples (unop_args_to_bounded (fst x) H) (unop_args_to_bounded (snd x) H') in
+  exact v.
+Defined.
+
+Ltac assoc_right_tuple x so_far :=
+  let t := type of x in
+  lazymatch (eval hnf in t) with
+  | prod _ _ => let so_far := assoc_right_tuple (snd x) so_far in
+                assoc_right_tuple (fst x) so_far
+  | _ => lazymatch so_far with
+         | @None => x
+         | _ => constr:((x, so_far))
+         end
+  end.
+
+Local Ltac make_bounds_prop bounds orig_bounds :=
+  let bounds' := fresh "bounds'" in
+  let bounds_bad := fresh "bounds_bad" in
+  rename bounds into bounds_bad;
+  let boundsv := assoc_right_tuple bounds_bad (@None) in
+  pose boundsv as bounds;
+  pose orig_bounds as bounds';
+  repeat (refine (match fst bounds' with
+                  | Some bounds' => let (l, u) := fst bounds in
+                                    let (l', u') := bounds' in
+                                    ((l' <=? l) && (u <=? u'))%Z%bool
+                  | None => false
+                  end && _)%bool;
+          destruct bounds' as [_ bounds'], bounds as [_ bounds]);
+  try exact (match bounds' with
+             | Some bounds' => let (l, u) := bounds in
+                               let (l', u') := bounds' in
+                               ((l' <=? l) && (u <=? u'))%Z%bool
+             | None => false
+             end).
+
+Definition unop_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprUnOpT)) : bool.
+Proof. make_bounds_prop bounds ExprUnOp_bounds. Defined.
+Definition binop_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprBinOpT)) : bool.
+Proof. make_bounds_prop bounds ExprUnOp_bounds. Defined.
+Definition unopFEToWire_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprUnOpFEToWireT)) : bool.
+Proof. make_bounds_prop bounds ExprUnOpWireToFE_bounds. Defined.
+Definition unopWireToFE_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprUnOpWireToFET)) : bool.
+Proof. make_bounds_prop bounds ExprUnOp_bounds. Defined.
+(* TODO FIXME(jgross?, andreser?): Is every function returning a single Z a boolean function? *)
+Definition unopFEToZ_bounds_good (bounds : interp_flat_type (fun _ => ZBounds.bounds) (remove_all_binders ExprUnOpFEToZT)) : bool.
+Proof.
+  refine (let (l, u) := bounds in ((0 <=? l) && (u <=? 1))%Z%bool).
+Defined.
+
+(* FIXME TODO(jgross): This is a horrible tactic.  We should unify the
+    various kinds of correct and boundedness, and abstract in Gallina
+    rather than Ltac *)
+
+Ltac t_correct_and_bounded ropZ_sig Hbounds H0 H1 args :=
+  let Heq := fresh "Heq" in
+  let Hbounds0 := fresh "Hbounds0" in
+  let Hbounds1 := fresh "Hbounds1" in
+  let Hbounds2 := fresh "Hbounds2" in
+  pose proof (proj2_sig ropZ_sig) as Heq;
+  cbv [interp_bexpr interp_uexpr interp_uexpr_FEToWire interp_uexpr_FEToZ interp_uexpr_WireToFE
+                    curry_binop_fe5211_32W curry_unop_fe5211_32W curry_unop_wire_digitsW
+                    curry_binop_fe5211_32 curry_unop_fe5211_32 curry_unop_wire_digits
+                    uncurry_binop_fe5211_32W uncurry_unop_fe5211_32W uncurry_unop_wire_digitsW
+                    uncurry_binop_fe5211_32 uncurry_unop_fe5211_32 uncurry_unop_wire_digits
+                    ExprBinOpT ExprUnOpFEToWireT ExprUnOpT ExprUnOpFEToZT ExprUnOpWireToFET
+                    interp_type_gen_rel_pointwise interp_type_gen_rel_pointwise] in *;
+  cbv zeta in *;
+  simpl @fe5211_32WToZ; simpl @wire_digitsWToZ;
+  rewrite <- Heq; clear Heq;
+  destruct Hbounds as [Heq Hbounds];
+  change interp_op with (@Z.interp_op) in *;
+  change interp_base_type with (@Z.interp_base_type) in *;
+  rewrite <- Heq; clear Heq;
+  destruct Hbounds as [ Hbounds0 [Hbounds1 Hbounds2] ];
+  pose proof (fun pf => Relations.uncurry_interp_type_rel_pointwise2_proj_from_option2 Word64.to_Z pf Hbounds2 Hbounds0) as Hbounds_left;
+  pose proof (fun pf => Relations.uncurry_interp_type_rel_pointwise2_proj1_from_option2 Relations.related_word64_boundsi' pf Hbounds1 Hbounds2) as Hbounds_right;
+  specialize_by repeat first [ progress intros
+                             | reflexivity
+                             | assumption
+                             | progress destruct_head' base_type
+                             | progress destruct_head' BoundedWord64.BoundedWord
+                             | progress destruct_head' and
+                             | progress repeat apply conj ];
+  specialize (Hbounds_left args H0);
+  specialize (Hbounds_right args H0);
+  cbv beta in *;
+  lazymatch type of Hbounds_right with
+  | match ?e with _ => _ end
+    => lazymatch type of H1 with
+       | match ?e' with _ => _ end
+         => change e' with e in H1; destruct e eqn:?; [ | exfalso; assumption ]
+       end
+  end;
+  repeat match goal with x := _ |- _ => subst x end;
+  cbv [id
+         binop_args_to_bounded unop_args_to_bounded unopWireToFE_args_to_bounded
+         Relations.proj_eq_rel interp_flat_type_rel_pointwise2 SmartVarfMap interp_flat_type smart_interp_flat_map Application.all_binders_for fst snd BoundedWord64.to_word64' BoundedWord64.boundedWordToWord64 BoundedWord64.value Application.ApplyInterpedAll Application.fst_binder Application.snd_binder interp_flat_type_rel_pointwise2_gen_Prop Relations.related_word64_boundsi' Relations.related'_word64_bounds ZBounds.upper ZBounds.lower Application.remove_all_binders Word64.to_Z] in Hbounds_left, Hbounds_right;
+  match goal with
+  | [ |- fe5211_32WToZ ?x = _ /\ _ ]
+    => destruct x; destruct_head_hnf' prod
+  | [ |- wire_digitsWToZ ?x = _ /\ _ ]
+    => destruct x; destruct_head_hnf' prod
+  | [ |- _ = _ ]
+    => exact Hbounds_left
+  end;
+  change word64ToZ with Word64.word64ToZ in *;
+  (split; [ exact Hbounds_left | ]);
+  cbv [interp_flat_type] in *;
+  cbv [fst snd
+           binop_bounds_good unop_bounds_good unopFEToWire_bounds_good unopWireToFE_bounds_good unopFEToZ_bounds_good
+           ExprUnOp_bounds ExprBinOp_bounds ExprUnOpFEToWire_bounds ExprUnOpFEToZ_bounds ExprUnOpWireToFE_bounds] in H1;
+  destruct_head' ZBounds.bounds;
+  unfold_is_bounded_in H1;
+  simpl @fe5211_32WToZ; simpl @wire_digitsWToZ;
+  unfold_is_bounded;
+  destruct_head' and;
+  Z.ltb_to_lt;
+  change Word64.word64ToZ with word64ToZ in *;
+  repeat apply conj; Z.ltb_to_lt; try omega; try reflexivity.
+
+
+Ltac rexpr_correct :=
+  let ropW' := fresh in
+  let ropZ_sig := fresh in
+  intros ropW' ropZ_sig;
+  let wf_ropW := fresh "wf_ropW" in
+  assert (wf_ropW : Wf ropW') by (subst ropW' ropZ_sig; reflect_Wf base_type_eq_semidec_is_dec op_beq_bl);
+  cbv zeta; repeat apply conj;
+  [ vm_compute; reflexivity
+  | apply @InterpRelWf;
+    [ | apply @RelWfMapInterp, wf_ropW ].. ];
+  auto with interp_related.
+
+Notation rword_of_Z rexprZ_sig := (MapInterp Word64.of_Z (proj1_sig rexprZ_sig)) (only parsing).
+
+Notation compute_bounds opW bounds
+  := (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp (@ZBounds.of_word64) opW)) bounds)
+       (only parsing).
+
+
+Module Export PrettyPrinting.
+  (* We add [enlargen] to force [bounds_on] to be in [Type] in 8.4 and
+     8.5/8.6.  Because [Set] is special and things break if
+     [bounds_on] ends up in [Set] for reasons jgross hasn't bothered
+     to debug. *)
+  Inductive bounds_on := overflow | in_range (lower upper : Z) | enlargen (_ : Set).
+
+  Inductive result := yes | no | borked.
+
+  Definition ZBounds_to_bounds_on
+    := fun t : base_type
+       => match t return ZBounds.interp_base_type t -> match t with TZ => bounds_on end with
+          | TZ => fun x => match x with
+                           | Some {| ZBounds.lower := l ; ZBounds.upper := u |}
+                             => in_range l u
+                           | None
+                             => overflow
+                           end
+          end.
+
+  Fixpoint does_it_overflow {t} : interp_flat_type (fun t => match t with TZ => bounds_on end) t -> result
+    := match t return interp_flat_type (fun t => match t with TZ => bounds_on end) t -> result with
+       | Tbase TZ => fun v => match v with
+                              | overflow => yes
+                              | in_range _ _ => no
+                              | enlargen _ => borked
+                              end
+       | Prod x y => fun v => match @does_it_overflow _ (fst v), @does_it_overflow _ (snd v) with
+                              | no, no => no
+                              | yes, no | no, yes | yes, yes => yes
+                              | borked, _ | _, borked => borked
+                              end
+       end.
+
+  (** This gives a slightly easier to read version of the bounds *)
+  Notation compute_bounds_for_display opW bounds
+    := (SmartVarfMap ZBounds_to_bounds_on (compute_bounds opW bounds)) (only parsing).
+  Notation sanity_compute opW bounds
+    := (does_it_overflow (SmartVarfMap ZBounds_to_bounds_on (compute_bounds opW bounds))) (only parsing).
+  Notation sanity_check opW bounds
+    := (eq_refl (sanity_compute opW bounds) <: no = no) (only parsing).
+End PrettyPrinting.
diff --git a/src/SpecificGen/GF5211_32Reflective/CommonBinOp.v b/src/SpecificGen/GF5211_32Reflective/CommonBinOp.v
new file mode 100644
index 000000000..a6a6e0f28
--- /dev/null
+++ b/src/SpecificGen/GF5211_32Reflective/CommonBinOp.v
@@ -0,0 +1,50 @@
+Require Export Crypto.SpecificGen.GF5211_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF5211_32BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprBinOp_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_binop_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall xy
+                   (xy := (eta_fe5211_32W (fst xy), eta_fe5211_32W (snd xy)))
+                   (Hxy : is_bounded (fe5211_32WToZ (fst xy)) = true
+                          /\ is_bounded (fe5211_32WToZ (snd xy)) = true),
+          let Hx := let (Hx, Hy) := Hxy in Hx in
+          let Hy := let (Hx, Hy) := Hxy in Hy in
+          let args := binop_args_to_bounded xy Hx Hy in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall xy
+                   (xy := (eta_fe5211_32W (fst xy), eta_fe5211_32W (snd xy)))
+                   (Hxy : is_bounded (fe5211_32WToZ (fst xy)) = true
+                          /\ is_bounded (fe5211_32WToZ (snd xy)) = true),
+          let Hx := let (Hx, Hy) := Hxy in Hx in
+          let Hy := let (Hx, Hy) := Hxy in Hy in
+          let args := binop_args_to_bounded (fst xy, snd xy) Hx Hy in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => binop_bounds_good bounds = true
+          | None => False
+          end)
+  : binop_correct_and_bounded (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x y Hx Hy.
+  pose x as x'; pose y as y'.
+  hnf in x, y; destruct_head' prod.
+  specialize (H0 (x', y') (conj Hx Hy)).
+  specialize (H1 (x', y') (conj Hx Hy)).
+  let args := constr:(binop_args_to_bounded (x', y') Hx Hy) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF5211_32Reflective/CommonUnOp.v b/src/SpecificGen/GF5211_32Reflective/CommonUnOp.v
new file mode 100644
index 000000000..9a1d5bdef
--- /dev/null
+++ b/src/SpecificGen/GF5211_32Reflective/CommonUnOp.v
@@ -0,0 +1,44 @@
+Require Export Crypto.SpecificGen.GF5211_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF5211_32BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprUnOp_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_unop_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall x
+                   (x := eta_fe5211_32W x)
+                   (Hx : is_bounded (fe5211_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall x
+                   (x := eta_fe5211_32W x)
+                   (Hx : is_bounded (fe5211_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => unop_bounds_good bounds = true
+          | None => False
+          end)
+  : unop_correct_and_bounded (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x Hx.
+  pose x as x'.
+  hnf in x; destruct_head' prod.
+  specialize (H0 x' Hx).
+  specialize (H1 x' Hx).
+  let args := constr:(unop_args_to_bounded x' Hx) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF5211_32Reflective/CommonUnOpFEToWire.v b/src/SpecificGen/GF5211_32Reflective/CommonUnOpFEToWire.v
new file mode 100644
index 000000000..14f3d3dd7
--- /dev/null
+++ b/src/SpecificGen/GF5211_32Reflective/CommonUnOpFEToWire.v
@@ -0,0 +1,44 @@
+Require Export Crypto.SpecificGen.GF5211_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF5211_32BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprUnOpFEToWire_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_unop_FEToWire_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall x
+                   (x := eta_fe5211_32W x)
+                   (Hx : is_bounded (fe5211_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall x
+                   (x := eta_fe5211_32W x)
+                   (Hx : is_bounded (fe5211_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => unopFEToWire_bounds_good bounds = true
+          | None => False
+          end)
+  : unop_FEToWire_correct_and_bounded (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x Hx.
+  pose x as x'.
+  hnf in x; destruct_head' prod.
+  specialize (H0 x' Hx).
+  specialize (H1 x' Hx).
+  let args := constr:(unop_args_to_bounded x' Hx) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF5211_32Reflective/CommonUnOpFEToZ.v b/src/SpecificGen/GF5211_32Reflective/CommonUnOpFEToZ.v
new file mode 100644
index 000000000..ab44167a6
--- /dev/null
+++ b/src/SpecificGen/GF5211_32Reflective/CommonUnOpFEToZ.v
@@ -0,0 +1,44 @@
+Require Export Crypto.SpecificGen.GF5211_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF5211_32BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprUnOpFEToZ_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_unop_FEToZ_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall x
+                   (x := eta_fe5211_32W x)
+                   (Hx : is_bounded (fe5211_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall x
+                   (x := eta_fe5211_32W x)
+                   (Hx : is_bounded (fe5211_32WToZ x) = true),
+          let args := unop_args_to_bounded x Hx in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => unopFEToZ_bounds_good bounds = true
+          | None => False
+          end)
+  : unop_FEToZ_correct (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x Hx.
+  pose x as x'.
+  hnf in x; destruct_head' prod.
+  specialize (H0 x' Hx).
+  specialize (H1 x' Hx).
+  let args := constr:(unop_args_to_bounded x' Hx) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF5211_32Reflective/CommonUnOpWireToFE.v b/src/SpecificGen/GF5211_32Reflective/CommonUnOpWireToFE.v
new file mode 100644
index 000000000..9948ea3a0
--- /dev/null
+++ b/src/SpecificGen/GF5211_32Reflective/CommonUnOpWireToFE.v
@@ -0,0 +1,44 @@
+Require Export Crypto.SpecificGen.GF5211_32Reflective.Common.
+Require Import Crypto.SpecificGen.GF5211_32BoundedCommon.
+Require Import Crypto.Reflection.Z.Interpretations.
+Require Import Crypto.Reflection.Syntax.
+Require Import Crypto.Reflection.Application.
+Require Import Crypto.Reflection.MapInterp.
+Require Import Crypto.Util.Tactics.
+
+Local Opaque Interp.
+Lemma ExprUnOpWireToFE_correct_and_bounded
+      ropW op (ropZ_sig : rexpr_unop_WireToFE_sig op)
+      (Hbounds : correct_and_bounded_genT ropW ropZ_sig)
+      (H0 : forall x
+                   (x := eta_wire_digitsW x)
+                   (Hx : wire_digits_is_bounded (wire_digitsWToZ x) = true),
+          let args := unopWireToFE_args_to_bounded x Hx in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@BoundedWord64.interp_op) (MapInterp BoundedWord64.of_word64 ropW))
+                                    (LiftOption.to' (Some args)))
+          with
+          | Some _ => True
+          | None => False
+          end)
+      (H1 : forall x
+                   (x := eta_wire_digitsW x)
+                   (Hx : wire_digits_is_bounded (wire_digitsWToZ x) = true),
+          let args := unopWireToFE_args_to_bounded x Hx in
+          let x' := SmartVarfMap (fun _ : base_type => BoundedWord64.BoundedWordToBounds) args in
+          match LiftOption.of'
+                  (ApplyInterpedAll (Interp (@ZBounds.interp_op) (MapInterp ZBounds.of_word64 ropW)) (LiftOption.to' (Some x')))
+          with
+          | Some bounds => unopWireToFE_bounds_good bounds = true
+          | None => False
+          end)
+  : unop_WireToFE_correct_and_bounded (MapInterp (fun _ x => x) ropW) op.
+Proof.
+  intros x Hx.
+  pose x as x'.
+  hnf in x; destruct_head' prod.
+  specialize (H0 x' Hx).
+  specialize (H1 x' Hx).
+  let args := constr:(unopWireToFE_args_to_bounded x' Hx) in
+  t_correct_and_bounded ropZ_sig Hbounds H0 H1 args.
+Qed.
diff --git a/src/SpecificGen/GF5211_32Reflective/Reified.v b/src/SpecificGen/GF5211_32Reflective/Reified.v
new file mode 100644
index 000000000..a783188c9
--- /dev/null
+++ b/src/SpecificGen/GF5211_32Reflective/Reified.v
@@ -0,0 +1,13 @@
+(** We split the reification up into separate files, one operation per
+    file, so that it can run in parallel. *)
+Require Export Crypto.SpecificGen.GF5211_32Reflective.Reified.Add.
+Require Export Crypto.SpecificGen.GF5211_32Reflective.Reified.CarryAdd.
+Require Export Crypto.SpecificGen.GF5211_32Reflective.Reified.Sub.
+Require Export Crypto.SpecificGen.GF5211_32Reflective.Reified.CarrySub.
+Require Export Crypto.SpecificGen.GF5211_32Reflective.Reified.Mul.
+Require Export Crypto.SpecificGen.GF5211_32Reflective.Reified.Opp.
+Require Export Crypto.SpecificGen.GF5211_32Reflective.Reified.CarryOpp.
+Require Export Crypto.SpecificGen.GF5211_32Reflective.Reified.PreFreeze.
+Require Export Crypto.SpecificGen.GF5211_32Reflective.Reified.GeModulus.
+Require Export Crypto.SpecificGen.GF5211_32Reflective.Reified.Pack.
+Require Export Crypto.SpecificGen.GF5211_32Reflective.Reified.Unpack.
diff --git a/src/SpecificGen/GF5211_32Reflective/Reified/Add.v b/src/SpecificGen/GF5211_32Reflective/Reified/Add.v
new file mode 100644
index 000000000..5ddd88689
--- /dev/null
+++ b/src/SpecificGen/GF5211_32Reflective/Reified/Add.v
@@ -0,0 +1,12 @@
+Require Import Crypto.SpecificGen.GF5211_32Reflective.CommonBinOp.
+
+Definition raddZ_sig : rexpr_binop_sig add. Proof. reify_sig. Defined.
+Definition raddW := Eval vm_compute in rword_of_Z raddZ_sig.
+Lemma raddW_correct_and_bounded_gen : correct_and_bounded_genT raddW raddZ_sig.
+Proof. rexpr_correct. Qed.
+Definition radd_output_bounds := Eval vm_compute in compute_bounds raddW ExprBinOp_bounds.
+
+Local Open Scope string_scope.
+Compute ("Add", compute_bounds_for_display raddW ExprBinOp_bounds).
+Compute ("Add overflows? ", sanity_compute raddW ExprBinOp_bounds).
+Compute ("Add overflows (error if it does)? ", sanity_check raddW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF5211_32Reflective/Reified/CarryAdd.v b/src/SpecificGen/GF5211_32Reflective/Reified/CarryAdd.v
new file mode 100644
index 000000000..3b17ad60c
--- /dev/null
+++ b/src/SpecificGen/GF5211_32Reflective/Reified/CarryAdd.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF5211_32Reflective.CommonBinOp.
+
+Definition rcarry_addZ_sig : rexpr_binop_sig carry_add. Proof. reify_sig. Defined.
+Definition rcarry_addW := Eval vm_compute in rword_of_Z rcarry_addZ_sig.
+Lemma rcarry_addW_correct_and_bounded_gen : correct_and_bounded_genT rcarry_addW rcarry_addZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rcarry_add_output_bounds := Eval vm_compute in compute_bounds rcarry_addW ExprBinOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rcarry_addW_correct_and_bounded
+  := ExprBinOp_correct_and_bounded
+       rcarry_addW carry_add rcarry_addZ_sig rcarry_addW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Carry_Add", compute_bounds_for_display rcarry_addW ExprBinOp_bounds).
+Compute ("Carry_Add overflows? ", sanity_compute rcarry_addW ExprBinOp_bounds).
+Compute ("Carry_Add overflows (error if it does)? ", sanity_check rcarry_addW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF5211_32Reflective/Reified/CarryOpp.v b/src/SpecificGen/GF5211_32Reflective/Reified/CarryOpp.v
new file mode 100644
index 000000000..faf4f7533
--- /dev/null
+++ b/src/SpecificGen/GF5211_32Reflective/Reified/CarryOpp.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF5211_32Reflective.CommonUnOp.
+
+Definition rcarry_oppZ_sig : rexpr_unop_sig carry_opp. Proof. reify_sig. Defined.
+Definition rcarry_oppW := Eval vm_compute in rword_of_Z rcarry_oppZ_sig.
+Lemma rcarry_oppW_correct_and_bounded_gen : correct_and_bounded_genT rcarry_oppW rcarry_oppZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rcarry_opp_output_bounds := Eval vm_compute in compute_bounds rcarry_oppW ExprUnOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rcarry_oppW_correct_and_bounded
+  := ExprUnOp_correct_and_bounded
+       rcarry_oppW carry_opp rcarry_oppZ_sig rcarry_oppW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Carry_Opp", compute_bounds_for_display rcarry_oppW ExprUnOp_bounds).
+Compute ("Carry_Opp overflows? ", sanity_compute rcarry_oppW ExprUnOp_bounds).
+Compute ("Carry_Opp overflows (error if it does)? ", sanity_check rcarry_oppW ExprUnOp_bounds).
diff --git a/src/SpecificGen/GF5211_32Reflective/Reified/CarrySub.v b/src/SpecificGen/GF5211_32Reflective/Reified/CarrySub.v
new file mode 100644
index 000000000..ad75f4530
--- /dev/null
+++ b/src/SpecificGen/GF5211_32Reflective/Reified/CarrySub.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF5211_32Reflective.CommonBinOp.
+
+Definition rcarry_subZ_sig : rexpr_binop_sig carry_sub. Proof. reify_sig. Defined.
+Definition rcarry_subW := Eval vm_compute in rword_of_Z rcarry_subZ_sig.
+Lemma rcarry_subW_correct_and_bounded_gen : correct_and_bounded_genT rcarry_subW rcarry_subZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rcarry_sub_output_bounds := Eval vm_compute in compute_bounds rcarry_subW ExprBinOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rcarry_subW_correct_and_bounded
+  := ExprBinOp_correct_and_bounded
+       rcarry_subW carry_sub rcarry_subZ_sig rcarry_subW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Carry_Sub", compute_bounds_for_display rcarry_subW ExprBinOp_bounds).
+Compute ("Carry_Sub overflows? ", sanity_compute rcarry_subW ExprBinOp_bounds).
+Compute ("Carry_Sub overflows (error if it does)? ", sanity_check rcarry_subW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF5211_32Reflective/Reified/GeModulus.v b/src/SpecificGen/GF5211_32Reflective/Reified/GeModulus.v
new file mode 100644
index 000000000..68b630622
--- /dev/null
+++ b/src/SpecificGen/GF5211_32Reflective/Reified/GeModulus.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF5211_32Reflective.CommonUnOpFEToZ.
+
+Definition rge_modulusZ_sig : rexpr_unop_FEToZ_sig ge_modulus. Proof. reify_sig. Defined.
+Definition rge_modulusW := Eval vm_compute in rword_of_Z rge_modulusZ_sig.
+Lemma rge_modulusW_correct_and_bounded_gen : correct_and_bounded_genT rge_modulusW rge_modulusZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rge_modulus_output_bounds := Eval vm_compute in compute_bounds rge_modulusW ExprUnOpFEToZ_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rge_modulusW_correct_and_bounded
+  := ExprUnOpFEToZ_correct_and_bounded
+       rge_modulusW ge_modulus rge_modulusZ_sig rge_modulusW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Ge_Modulus", compute_bounds_for_display rge_modulusW ExprUnOpFEToZ_bounds).
+Compute ("Ge_Modulus overflows? ", sanity_compute rge_modulusW ExprUnOpFEToZ_bounds).
+Compute ("Ge_Modulus overflows (error if it does)? ", sanity_check rge_modulusW ExprUnOpFEToZ_bounds).
diff --git a/src/SpecificGen/GF5211_32Reflective/Reified/Mul.v b/src/SpecificGen/GF5211_32Reflective/Reified/Mul.v
new file mode 100644
index 000000000..b6d2170de
--- /dev/null
+++ b/src/SpecificGen/GF5211_32Reflective/Reified/Mul.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF5211_32Reflective.CommonBinOp.
+
+Definition rmulZ_sig : rexpr_binop_sig mul. Proof. reify_sig. Defined.
+Definition rmulW := Eval vm_compute in rword_of_Z rmulZ_sig.
+Lemma rmulW_correct_and_bounded_gen : correct_and_bounded_genT rmulW rmulZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rmul_output_bounds := Eval vm_compute in compute_bounds rmulW ExprBinOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rmulW_correct_and_bounded
+  := ExprBinOp_correct_and_bounded
+       rmulW mul rmulZ_sig rmulW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Mul", compute_bounds_for_display rmulW ExprBinOp_bounds).
+Compute ("Mul overflows? ", sanity_compute rmulW ExprBinOp_bounds).
+Compute ("Mul overflows (error if it does)? ", sanity_check rmulW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF5211_32Reflective/Reified/Opp.v b/src/SpecificGen/GF5211_32Reflective/Reified/Opp.v
new file mode 100644
index 000000000..ae3389010
--- /dev/null
+++ b/src/SpecificGen/GF5211_32Reflective/Reified/Opp.v
@@ -0,0 +1,12 @@
+Require Import Crypto.SpecificGen.GF5211_32Reflective.CommonUnOp.
+
+Definition roppZ_sig : rexpr_unop_sig opp. Proof. reify_sig. Defined.
+Definition roppW := Eval vm_compute in rword_of_Z roppZ_sig.
+Lemma roppW_correct_and_bounded_gen : correct_and_bounded_genT roppW roppZ_sig.
+Proof. rexpr_correct. Qed.
+Definition ropp_output_bounds := Eval vm_compute in compute_bounds roppW ExprUnOp_bounds.
+
+Local Open Scope string_scope.
+Compute ("Opp", compute_bounds_for_display roppW ExprUnOp_bounds).
+Compute ("Opp overflows? ", sanity_compute roppW ExprUnOp_bounds).
+Compute ("Opp overflows (error if it does)? ", sanity_check roppW ExprUnOp_bounds).
diff --git a/src/SpecificGen/GF5211_32Reflective/Reified/Pack.v b/src/SpecificGen/GF5211_32Reflective/Reified/Pack.v
new file mode 100644
index 000000000..108ce3578
--- /dev/null
+++ b/src/SpecificGen/GF5211_32Reflective/Reified/Pack.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF5211_32Reflective.CommonUnOpFEToWire.
+
+Definition rpackZ_sig : rexpr_unop_FEToWire_sig pack. Proof. reify_sig. Defined.
+Definition rpackW := Eval vm_compute in rword_of_Z rpackZ_sig.
+Lemma rpackW_correct_and_bounded_gen : correct_and_bounded_genT rpackW rpackZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rpack_output_bounds := Eval vm_compute in compute_bounds rpackW ExprUnOpFEToWire_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rpackW_correct_and_bounded
+  := ExprUnOpFEToWire_correct_and_bounded
+       rpackW pack rpackZ_sig rpackW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Pack", compute_bounds_for_display rpackW ExprUnOpFEToWire_bounds).
+Compute ("Pack overflows? ", sanity_compute rpackW ExprUnOpFEToWire_bounds).
+Compute ("Pack overflows (error if it does)? ", sanity_check rpackW ExprUnOpFEToWire_bounds).
diff --git a/src/SpecificGen/GF5211_32Reflective/Reified/PreFreeze.v b/src/SpecificGen/GF5211_32Reflective/Reified/PreFreeze.v
new file mode 100644
index 000000000..4788f9f1a
--- /dev/null
+++ b/src/SpecificGen/GF5211_32Reflective/Reified/PreFreeze.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF5211_32Reflective.CommonUnOp.
+
+Definition rprefreezeZ_sig : rexpr_unop_sig prefreeze. Proof. cbv [prefreeze GF5211_32.prefreeze]. reify_sig. Defined.
+Definition rprefreezeW := Eval vm_compute in rword_of_Z rprefreezeZ_sig.
+Lemma rprefreezeW_correct_and_bounded_gen : correct_and_bounded_genT rprefreezeW rprefreezeZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rprefreeze_output_bounds := Eval vm_compute in compute_bounds rprefreezeW ExprUnOp_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition rprefreezeW_correct_and_bounded
+  := ExprUnOp_correct_and_bounded
+       rprefreezeW prefreeze rprefreezeZ_sig rprefreezeW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("PreFreeze", compute_bounds_for_display rprefreezeW ExprUnOp_bounds).
+Compute ("PreFreeze overflows? ", sanity_compute rprefreezeW ExprUnOp_bounds).
+Compute ("PreFreeze overflows (error if it does)? ", sanity_check rprefreezeW ExprUnOp_bounds).
diff --git a/src/SpecificGen/GF5211_32Reflective/Reified/Sub.v b/src/SpecificGen/GF5211_32Reflective/Reified/Sub.v
new file mode 100644
index 000000000..f0c1f5d27
--- /dev/null
+++ b/src/SpecificGen/GF5211_32Reflective/Reified/Sub.v
@@ -0,0 +1,12 @@
+Require Import Crypto.SpecificGen.GF5211_32Reflective.CommonBinOp.
+
+Definition rsubZ_sig : rexpr_binop_sig sub. Proof. reify_sig. Defined.
+Definition rsubW := Eval vm_compute in rword_of_Z rsubZ_sig.
+Lemma rsubW_correct_and_bounded_gen : correct_and_bounded_genT rsubW rsubZ_sig.
+Proof. rexpr_correct. Qed.
+Definition rsub_output_bounds := Eval vm_compute in compute_bounds rsubW ExprBinOp_bounds.
+
+Local Open Scope string_scope.
+Compute ("Sub", compute_bounds_for_display rsubW ExprBinOp_bounds).
+Compute ("Sub overflows? ", sanity_compute rsubW ExprBinOp_bounds).
+Compute ("Sub overflows (error if it does)? ", sanity_check rsubW ExprBinOp_bounds).
diff --git a/src/SpecificGen/GF5211_32Reflective/Reified/Unpack.v b/src/SpecificGen/GF5211_32Reflective/Reified/Unpack.v
new file mode 100644
index 000000000..1040ec6d2
--- /dev/null
+++ b/src/SpecificGen/GF5211_32Reflective/Reified/Unpack.v
@@ -0,0 +1,17 @@
+Require Import Crypto.SpecificGen.GF5211_32Reflective.CommonUnOpWireToFE.
+
+Definition runpackZ_sig : rexpr_unop_WireToFE_sig unpack. Proof. reify_sig. Defined.
+Definition runpackW := Eval vm_compute in rword_of_Z runpackZ_sig.
+Lemma runpackW_correct_and_bounded_gen : correct_and_bounded_genT runpackW runpackZ_sig.
+Proof. rexpr_correct. Qed.
+Definition runpack_output_bounds := Eval vm_compute in compute_bounds runpackW ExprUnOpWireToFE_bounds.
+Local Obligation Tactic := intros; vm_compute; constructor.
+Program Definition runpackW_correct_and_bounded
+  := ExprUnOpWireToFE_correct_and_bounded
+       runpackW unpack runpackZ_sig runpackW_correct_and_bounded_gen
+       _ _.
+
+Local Open Scope string_scope.
+Compute ("Unpack", compute_bounds_for_display runpackW ExprUnOpWireToFE_bounds).
+Compute ("Unpack overflows? ", sanity_compute runpackW ExprUnOpWireToFE_bounds).
+Compute ("Unpack overflows (error if it does)? ", sanity_check runpackW ExprUnOpWireToFE_bounds).
diff --git a/src/SpecificGen/copy_bounds.sh b/src/SpecificGen/copy_bounds.sh
new file mode 100755
index 000000000..5c883ad18
--- /dev/null
+++ b/src/SpecificGen/copy_bounds.sh
@@ -0,0 +1,16 @@
+#!/bin/bash
+
+DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )"
+
+cd "$DIR"
+
+FILENAME="$1"
+V_FILE_STEM="${FILENAME%.*}"
+
+for ORIG in $(git ls-files "../Specific/**GF25519*.v" | grep -v "../Specific/GF25519.v"); do
+    NEW="$(echo "$ORIG" | sed s'|^../Specific|.|g' | sed s"|25519|${V_FILE_STEM}|g")"
+    echo "$NEW"
+    NEW_DIR="$(dirname "$NEW")"
+    mkdir -p "$NEW_DIR" || exit $?
+    cat "$ORIG" | sed s'/Specific/SpecificGen/g' | sed s"/25519/${V_FILE_STEM}/g" > "$NEW" || exit $?
+done