diff options
Diffstat (limited to 'src/Experiments')
-rw-r--r-- | src/Experiments/NewPipeline/Arithmetic.v | 1327 | ||||
-rw-r--r-- | src/Experiments/NewPipeline/CLI.v | 101 | ||||
-rw-r--r-- | src/Experiments/NewPipeline/CStringification.v | 56 | ||||
-rw-r--r-- | src/Experiments/NewPipeline/CompilersTestCases.v | 8 | ||||
-rw-r--r-- | src/Experiments/NewPipeline/ExtractionHaskell/word_by_word_montgomery.v | 4 | ||||
-rw-r--r-- | src/Experiments/NewPipeline/ExtractionOCaml/word_by_word_montgomery.v | 3 | ||||
-rw-r--r-- | src/Experiments/NewPipeline/Language.v | 75 | ||||
-rw-r--r-- | src/Experiments/NewPipeline/Rewriter.v | 463 | ||||
-rw-r--r-- | src/Experiments/NewPipeline/StandaloneHaskellMain.v | 12 | ||||
-rw-r--r-- | src/Experiments/NewPipeline/StandaloneOCamlMain.v | 9 | ||||
-rw-r--r-- | src/Experiments/NewPipeline/Toplevel1.v | 985 | ||||
-rw-r--r-- | src/Experiments/NewPipeline/arith_rewrite_head.out | 16842 | ||||
-rw-r--r-- | src/Experiments/NewPipeline/fancy_rewrite_head.out | 38485 | ||||
-rw-r--r-- | src/Experiments/NewPipeline/nbe_rewrite_head.out | 5123 | ||||
-rw-r--r-- | src/Experiments/NewPipeline/rewrite_head.out | 17274 |
15 files changed, 58505 insertions, 22262 deletions
diff --git a/src/Experiments/NewPipeline/Arithmetic.v b/src/Experiments/NewPipeline/Arithmetic.v index 398fd17bc..4bf3c55e6 100644 --- a/src/Experiments/NewPipeline/Arithmetic.v +++ b/src/Experiments/NewPipeline/Arithmetic.v @@ -10,8 +10,8 @@ Require Import Crypto.Util.ListUtil Coq.Lists.List Crypto.Util.NatUtil. Require Import QArith.QArith_base QArith.Qround Crypto.Util.QUtil. Require Import Crypto.Algebra.Ring Crypto.Util.Decidable.Bool2Prop. Require Import Crypto.Arithmetic.BarrettReduction.Generalized. -Require Import Crypto.Arithmetic.MontgomeryReduction.Definition. -Require Import Crypto.Arithmetic.MontgomeryReduction.Proofs. +Require Import Crypto.Arithmetic.ModularArithmeticTheorems. +Require Import Crypto.Arithmetic.PrimeFieldTheorems. Require Import Crypto.Util.ZUtil.Tactics.PullPush.Modulo. Require Import Crypto.Util.Tactics.RunTacticAsConstr. Require Import Crypto.Util.Tactics.Head. @@ -20,6 +20,7 @@ Require Import Crypto.Util.OptionList. Require Import Crypto.Util.Prod. Require Import Crypto.Util.Sum. Require Import Crypto.Util.Bool. +Require Import Crypto.Util.Sigma. Require Import Crypto.Util.ZUtil. Require Import Crypto.Util.ZUtil.Modulo Crypto.Util.ZUtil.Div Crypto.Util.ZUtil.Hints.Core. Require Import Crypto.Util.ZUtil.Hints.PullPush. @@ -43,6 +44,7 @@ Require Import Crypto.Util.ZUtil.EquivModulo. Require Import Crypto.Util.Prod. Require Import Crypto.Util.CPSNotations. Require Import Crypto.Util.Equality. +Require Import Crypto.Util.Tactics.SetEvars. Import ListNotations. Local Open Scope Z_scope. Module Associational. @@ -499,6 +501,10 @@ Module Positional. Section Positional. autorewrite with push_eval cancel_pair; ring. Qed. + Lemma eval_snoc_S n x y : n = length x -> eval (S n) (x ++ [y]) = eval n x + weight n * y. + Proof. intros; erewrite eval_snoc; eauto. Qed. + Hint Rewrite eval_snoc_S : push_eval. + (* SKIP over this: zeros, add_to_nth *) Local Ltac push := autorewrite with push_eval push_map distr_length push_flat_map push_fold_right push_nth_default cancel_pair natsimplify. @@ -534,6 +540,9 @@ Module Positional. Section Positional. end; lia. Qed. Hint Rewrite @eval_add_to_nth eval_zeros eval_combine_zeros : push_eval. + Lemma zeros_ext_map {A} n (p : list A) : length p = n -> zeros n = map (fun _ => 0) p. + Proof. cbv [zeros]; intro; subst; induction p; cbn; congruence. Qed. + Definition place (t:Z*Z) (i:nat) : nat * Z := nat_rect (fun _ => unit -> (nat * Z)%type) @@ -584,11 +593,52 @@ Module Positional. Section Positional. push; omega. Qed. Hint Rewrite eval_extend_to_length : push_eval. - Lemma length_eval_extend_to_length n_in n_out p : + Lemma length_extend_to_length n_in n_out p : length p = n_in -> (n_in <= n_out)%nat -> length (extend_to_length n_in n_out p) = n_out. Proof. cbv [extend_to_length]; intros; distr_length. Qed. - Hint Rewrite length_eval_extend_to_length : distr_length. + Hint Rewrite length_extend_to_length : distr_length. + + Definition drop_high_to_length (n : nat) (p:list Z) : list Z := + firstn n p. + (* + Lemma eval_drop_high_to_length n m p : + (forall i, weight (S i) mod weight i = 0) -> length p = m -> (n <= m)%nat -> + eval n (drop_high_to_length n p) mod weight n + = eval m p mod weight n. + Proof. + cbv [eval drop_high_to_length to_associational]; intros. + replace m with (n + (m - n))%nat in * by (f_equal; omega). + generalize dependent (m - n)%nat; clear m; intro m; intros H' H''. + rewrite seq_add, map_app, <- (firstn_skipn n p), combine_app_samelength, firstn_skipn, Associational.eval_app; + push; try omega **. + rewrite <- (Z.add_0_r (Associational.eval _)) at 1. + apply Z.add_mod_Proper; [ reflexivity | cbv [Z.equiv_modulo] ]. + generalize (skipn_length n p); rewrite H', minus_plus. + generalize (skipn n p); clear dependent p; clear H''; intros p Hp. + rewrite Zmod_0_l. + subst. + cbv [Associational.eval]. + revert n; induction p as [|p ps IHps]; intro; [ reflexivity | ]. + cbn in *. + push_Zmod; pull_Zmod; autorewrite with zsimplify_const. + rewrite <- IHps. + { cbn; reflexivity + Search (0 mod _). + rewrite Z.mod_0_l + Search (?x + ?y - ?x)%nat. + Search Z.equiv_modulo Proper. + pose proof H as H''. + rewrite <- (firstn_skipn n p) in H''. + distr_length. + + rewrite Nat.min_l in H'' by omega. + Qed. + Hint Rewrite eval_drop_high_to_length : push_eval.*) + Lemma length_drop_high_to_length n p : + length (drop_high_to_length n p) = Nat.min n (length p). + Proof. cbv [drop_high_to_length]; intros; distr_length. Qed. + Hint Rewrite length_drop_high_to_length : distr_length. Section mulmod. Context (s:Z) (s_nz:s <> 0) @@ -646,6 +696,7 @@ Module Positional. Section Positional. Lemma length_carry n m index p : length (carry n m index p) = m. Proof. cbv [carry]; distr_length. Qed. + Hint Rewrite length_carry : distr_length. Lemma eval_carry n m i p: (n <> 0%nat) -> (m <> 0%nat) -> weight (S i) / weight i <> 0 -> eval m (carry n m i p) = eval n p. @@ -712,6 +763,12 @@ Module Positional. Section Positional. apply fold_right_invariant; [|intro; rewrite <-in_rev]; intros; push; auto. Qed. Hint Rewrite @eval_chained_carries_no_reduce : push_eval. + Lemma length_chained_carries_no_reduce n p idxs + : length p = n -> length (@chained_carries_no_reduce n p idxs) = n. + Proof. + intros; cbv [chained_carries_no_reduce]; induction (rev idxs) as [|x xs IHxs]; + cbn [fold_right]; distr_length. + Qed. Hint Rewrite @length_chained_carries_no_reduce : distr_length. (* Reverse of [eval]; translate from Z to basesystem by putting everything in first digit and then carrying. *) @@ -727,9 +784,22 @@ Module Positional. Section Positional. : length (encode n s c x) = n. Proof. cbv [encode]; repeat distr_length. Qed. + (* Reverse of [eval]; translate from Z to basesystem by putting + everything in first digit and then carrying, but without reduction. *) + Definition encode_no_reduce n (x : Z) : list Z := + chained_carries_no_reduce n (from_associational n [(1,x)]) (seq 0 n). + Lemma eval_encode_no_reduce n x : + (n <> 0%nat) -> + (forall i, In i (seq 0 n) -> weight (S i) / weight i <> 0) -> + eval n (encode_no_reduce n x) = x. + Proof using Type*. cbv [encode_no_reduce]; intros; push; auto; f_equal; omega. Qed. + Lemma length_encode_no_reduce n x + : length (encode_no_reduce n x) = n. + Proof. cbv [encode_no_reduce]; repeat distr_length. Qed. + End Carries. - Hint Rewrite @eval_encode : push_eval. - Hint Rewrite @length_encode : distr_length. + Hint Rewrite @eval_encode @eval_encode_no_reduce @eval_carry @eval_carry_reduce @eval_chained_carries @eval_chained_carries_no_reduce : push_eval. + Hint Rewrite @length_encode @length_encode_no_reduce @length_carry @length_carry_reduce @length_chained_carries @length_chained_carries_no_reduce : distr_length. Section sub. Context (n:nat) @@ -840,8 +910,8 @@ Module Positional. Section Positional. End select. End Positional. (* Hint Rewrite disappears after the end of a section *) -Hint Rewrite length_zeros length_add_to_nth length_from_associational @length_add @length_carry_reduce @length_chained_carries @length_encode @length_sub @length_opp @length_select @length_zselect @length_select_min : distr_length. -Hint Rewrite @eval_select @eval_zselect : push_eval. +Hint Rewrite length_zeros length_add_to_nth length_from_associational @length_add @length_carry_reduce @length_chained_carries @length_encode @length_sub @length_opp @length_select @length_zselect @length_select_min @length_extend_to_length @length_drop_high_to_length : distr_length. +Hint Rewrite @eval_zeros @eval_nil @eval_snoc_S @eval_select @eval_zselect @eval_extend_to_length (*@eval_drop_high_to_length*) : push_eval. Section Positional_nonuniform. Context (weight weight' : nat -> Z). @@ -2099,7 +2169,15 @@ Module Rows. (* Subtract q if and only if p >= q. *) Definition conditional_sub n (p q:list Z) := let '(v, c) := sub n p q in - Positional.select c v p. + Positional.select (-c) v p. + + (* the carry will be 0 unless we underflow--we do the addition only + in the underflow case *) + Definition sub_then_maybe_add n mask (p q r:list Z) := + let '(p_minus_q, c) := sub n p q in + let rr := Positional.zselect mask (-c) r in + let '(res, c') := add n p_minus_q rr in + (res, c' - c). Hint Rewrite eval_cons eval_nil using solve [auto] : push_eval. @@ -2189,6 +2267,11 @@ Module Rows. fst (mul base n m p q) = partition m (Positional.eval weight n p * Positional.eval weight n q). Proof using wprops. solver. Qed. + Lemma mul_div base n m p q : + base <> 0 -> n <> 0%nat -> m <> 0%nat -> length p = n -> length q = n -> + snd (mul base n m p q) = (Positional.eval weight n p * Positional.eval weight n q) / weight m. + Proof using wprops. solver. Qed. + Lemma length_mul base n m p q : length p = n -> length q = n -> length (fst (mul base n m p q)) = m. @@ -2227,11 +2310,53 @@ Module Rows. rewrite <-Z.div_mod'' by auto. autorewrite with push_eval; reflexivity. Qed. + + (* returns all-but-lowest-limb and lowest limb *) + Definition divmod (p : list Z) : list Z * Z + := (tl p, hd 0 p). + (* + Lemma eval_divmod n (p : list Z) : + length p = S n -> + (forall i, weight i = weight 1 ^ Z.of_nat i) -> + (forall i, (i <= n)%nat -> + nth_default 0 p i = (Positional.eval weight (S n) p mod weight (S i)) / (weight i)) -> + let pv := Positional.eval weight (S n) p in + Positional.eval (fun i => weight (S i) / weight 1) n (fst (divmod p)) = pv / weight 1 + /\ snd (divmod p) = pv mod weight 1. + Proof. + cbv [is_div_mod divmod]; destruct p; cbn [fst snd hd tl length]; [ omega | ]. + intros Hlen Hsmall. + split. + { rewrite Positional.eval_cons, weight_0 by (assumption || omega). + autorewrite with zsimplify_const. + symmetry; erewrite Positional.eval_weight_mul. + Print Positional. + 2: { + (etransitivity; [ exact (Hsmall 0%nat ltac:(omega)) | ]). + rewrite weight_0 by assumption; autorewrite with zsimplify_const; reflexivity. + } + + + revert H0. + push_Zmod. +hd 0 p). + Lemma eval_divmod n (p : list Z) : + length p = S n -> p = partition (S n) (Positional.eval weight (S n) p) -> + is_div_mod (Positional.eval (fun i => weight (S i) / weight 1) n) + (divmod p) + (Positional.eval weight (S n) p) + (weight 1). + Proof. + cbv [is_div_mod divmod]; destruct p; cbn [fst snd hd tl length]; [ omega | ]. + intros. + rewrite eval_ + *) End Ops. End Rows. Hint Rewrite length_from_columns using eassumption : distr_length. Hint Rewrite length_sum_rows using solve [ reflexivity | eassumption | distr_length; eauto ] : distr_length. Hint Rewrite length_fst_extract_row length_snd_extract_row length_flatten length_flatten' length_partition length_fst_from_columns' length_snd_from_columns' : distr_length. + Hint Rewrite @eval_partition : push_eval. End Rows. Module BaseConversion. @@ -2609,7 +2734,7 @@ Section freeze_mod_ops. (m_enc_correct : Positional.eval weight n m_enc = m) (Hm_enc_len : length m_enc = n). - Definition wprops_bytes := (@wprops 8 1 ltac:(lia)). + Definition wprops_bytes := (@wprops 8 1 ltac:(clear; lia)). Local Notation wprops := (@wprops limbwidth_num limbwidth_den limbwidth_good). Local Hint Immediate (wprops). @@ -2624,7 +2749,9 @@ Section freeze_mod_ops. Local Hint Immediate (weight_divides wprops_bytes). Local Hint Resolve Z.positive_is_nonzero Z.lt_gt. - Definition bytes_n := (1 + (Z.to_nat (Z.log2_up (weight n) / 8)))%nat. + Definition bytes_n + := Eval cbv [Qceiling Qdiv inject_Z Qfloor Qmult Qopp Qnum Qden Qinv Pos.mul] + in Z.to_nat (Qceiling (Z.log2_up (weight n) / 8)). Definition to_bytes' (v : list Z) := BaseConversion.convert_bases weight bytes_weight n bytes_n v. @@ -2638,54 +2765,118 @@ Section freeze_mod_ops. that the result partitions. See https://github.com/JasonGross/fiat-crypto/tree/zzz-wip-better-arith-proofs for some partial work in this direction. *) - Definition to_bytesmod (f : list Z) : list Z - := let v := to_bytes' (freeze weight n (Z.ones bitwidth) m_enc f) in + Definition to_bytes (f : list Z) : list Z + := let v := to_bytes' f in fst (Rows.flatten bytes_weight bytes_n (Rows.from_associational bytes_weight bytes_n (Positional.to_associational bytes_weight bytes_n v))). + Definition freeze_to_bytesmod (f : list Z) : list Z + := to_bytes (freeze weight n (Z.ones bitwidth) m_enc f). + + Definition to_bytesmod (f : list Z) : list Z + := to_bytes f. + Definition from_bytesmod (f : list Z) : list Z := from_bytes f. + Lemma bytes_nz : bytes_n <> 0%nat. + Proof using limbwidth_good Hn_nz. + clear -limbwidth_good Hn_nz. + cbv [bytes_n]. + cbv [Qceiling Qdiv inject_Z Qfloor Qmult Qopp Qnum Qden Qinv]. + autorewrite with zsimplify_const. + change (Z.pos (1*8)) with 8. + cbv [weight]. + rewrite Z.log2_up_pow2 by (Z.div_mod_to_quot_rem; nia). + autorewrite with zsimplify_fast. + rewrite <- Z2Nat.inj_0, Z2Nat.inj_iff by (Z.div_mod_to_quot_rem; nia). + Z.div_mod_to_quot_rem; nia. + Qed. + + Lemma bytes_n_big : weight n <= bytes_weight bytes_n. + Proof using limbwidth_good Hn_nz. + clear -limbwidth_good Hn_nz. + cbv [bytes_n bytes_weight]. + Z.peel_le. + rewrite Z.log2_up_pow2 by (Z.div_mod_to_quot_rem; nia). + autorewrite with zsimplify_fast. + rewrite Z2Nat.id by (Z.div_mod_to_quot_rem; nia). + Z.div_mod_to_quot_rem; nia. + Qed. + + Lemma eval_to_bytes_mod + : forall (f : list Z) + (Hf : length f = n), + eval bytes_weight bytes_n (to_bytes f) = eval weight n f mod (bytes_weight bytes_n). + Proof using limbwidth_good Hn_nz. + generalize wprops wprops_bytes; clear -Hn_nz limbwidth_good. + intros. + cbv [to_bytes]. + rewrite Rows.flatten_mod by eauto using Rows.length_from_associational. + rewrite Rows.eval_from_associational by eauto using bytes_nz with omega. + rewrite eval_to_associational. + cbv [to_bytes']. + rewrite BaseConversion.eval_convert_bases + by (auto using bytes_nz; distr_length; auto using wprops). + reflexivity. + Qed. + + Lemma eval_to_bytes + : forall (f : list Z) + (Hf : length f = n) + (Hf_small : 0 <= eval weight n f < weight n), + eval bytes_weight bytes_n (to_bytes f) = eval weight n f. + Proof using Hn_nz limbwidth_good. + generalize bytes_n_big. clear -Hn_nz limbwidth_good. + intros; rewrite eval_to_bytes_mod by assumption. + rewrite Z.mod_small by omega; reflexivity. + Qed. + + Lemma to_bytes_partitions + : forall (f : list Z) + (Hf : length f = n), + to_bytes f = Rows.partition bytes_weight bytes_n (Positional.eval weight n f). + Proof using Hn_nz limbwidth_good. + clear -Hn_nz limbwidth_good. + intros; cbv [to_bytes]. + rewrite Rows.flatten_partitions' by eauto using wprops, Rows.length_from_associational. + rewrite Rows.eval_from_associational by eauto using bytes_nz with omega. + rewrite eval_to_associational. + cbv [to_bytes']. + rewrite BaseConversion.eval_convert_bases + by (auto using wprops_bytes, bytes_nz; distr_length; auto using wprops). + reflexivity. + Qed. + Lemma eval_to_bytesmod : forall (f : list Z) + (Hf : length f = n) + (Hf_small : 0 <= eval weight n f < weight n), + eval bytes_weight bytes_n (to_bytesmod f) = eval weight n f + /\ to_bytesmod f = Rows.partition bytes_weight bytes_n (Positional.eval weight n f). + Proof using Hn_nz limbwidth_good. + split; apply eval_to_bytes || apply to_bytes_partitions; assumption. + Qed. + + Lemma eval_freeze_to_bytesmod + : forall (f : list Z) (Hf : length f = n) (Hf_bounded : 0 <= eval weight n f < 2 * m), - (eval bytes_weight bytes_n (to_bytesmod f)) = (eval weight n f) mod m - /\ to_bytesmod f = Rows.partition bytes_weight bytes_n (Positional.eval weight n f mod m). + (eval bytes_weight bytes_n (freeze_to_bytesmod f)) = (eval weight n f) mod m + /\ freeze_to_bytesmod f = Rows.partition bytes_weight bytes_n (Positional.eval weight n f mod m). Proof. - intros; subst m s; split. - { cbv [to_bytesmod]. - rewrite Rows.flatten_mod by eauto using Rows.length_from_associational. - rewrite Rows.eval_from_associational by (cbv [bytes_n]; eauto with omega). - rewrite eval_to_associational. - cbv [to_bytes']. - rewrite BaseConversion.eval_convert_bases - by (cbv [bytes_n]; auto using wprops_bytes; distr_length; auto using wprops). - erewrite eval_freeze by eauto using wprops. - rewrite (Z.mod_small (_ mod _)); [ reflexivity | ]. - split; [ | eapply Z.lt_le_trans ]; [ apply Z.mod_pos_bound; omega.. | ]. - transitivity (weight n); [ omega | ]. - cbv [weight bytes_n]. - Z.peel_le. - rewrite Z.log2_up_pow2 by (Z.div_mod_to_quot_rem_in_goal; nia). - autorewrite with push_Zof_nat. - rewrite Z2Nat.id by (Z.div_mod_to_quot_rem_in_goal; nia). - Z.div_mod_to_quot_rem_in_goal; nia. } - { cbv [to_bytesmod]. - rewrite Rows.flatten_partitions' by eauto using wprops, Rows.length_from_associational. - rewrite Rows.eval_from_associational by (cbv [bytes_n]; eauto with omega). - rewrite eval_to_associational. - cbv [to_bytes']. - rewrite BaseConversion.eval_convert_bases - by (cbv [bytes_n]; auto using wprops_bytes; distr_length; auto using wprops). - erewrite eval_freeze by eauto using wprops. - reflexivity. } + intros; subst m s. + cbv [freeze_to_bytesmod]. + rewrite eval_to_bytes, to_bytes_partitions; + erewrite ?eval_freeze by eauto using wprops; + autorewrite with distr_length; eauto. + Z.div_mod_to_quot_rem; nia. Qed. Lemma eval_from_bytesmod : forall (f : list Z) (Hf : length f = bytes_n), eval weight n (from_bytesmod f) = eval bytes_weight bytes_n f. - Proof. + Proof using Hn_nz limbwidth_good. cbv [from_bytesmod from_bytes]; intros. rewrite BaseConversion.eval_convert_bases by eauto using wprops. reflexivity. @@ -2729,3 +2920,1053 @@ Section primitives. | progress Z.rewrite_mod_small ]. Qed. End primitives. + +Module UniformWeight. + Definition uweight (lgr : Z) : nat -> Z + := weight lgr 1. + Definition uwprops lgr (Hr : 0 < lgr) : @weight_properties (uweight lgr). + Proof. apply wprops; omega. Qed. + Lemma uweight_eq_alt' lgr n : uweight lgr n = 2^(lgr*Z.of_nat n). + Proof. now cbv [uweight weight]; autorewrite with zsimplify_fast. Qed. + Lemma uweight_eq_alt lgr (Hr : 0 <= lgr) n : uweight lgr n = (2^lgr)^Z.of_nat n. + Proof. now rewrite uweight_eq_alt', Z.pow_mul_r by lia. Qed. +End UniformWeight. + +Module WordByWordMontgomery. + Section with_args. + Context (lgr : Z) + (m : Z). + Local Notation weight := (UniformWeight.uweight lgr). + Let T (n : nat) := list Z. + Let r := (2^lgr). + Definition eval {n} : T n -> Z := Positional.eval weight n. + Let zero {n} : T n := Positional.zeros n. + Let divmod {n} : T (S n) -> T n * Z := Rows.divmod. + Let scmul {n} (c : Z) (p : T n) : T (S n) (* uses double-output multiply *) + := let '(v, c) := Rows.mul weight r n (S n) (Positional.extend_to_length 1 n [c]) p in + v. + Let addT {n} (p q : T n) : T (S n) (* joins carry *) + := let '(v, c) := Rows.add weight n p q in + v ++ [c]. + Let drop_high_addT' {n} (p : T (S n)) (q : T n) : T (S n) (* drops carry *) + := fst (Rows.add weight (S n) p (Positional.extend_to_length n (S n) q)). + Let conditional_sub {n} (arg : T (S n)) (N : T n) : T n (* computes [arg - N] if [N <= arg], and drops high bit *) + := Positional.drop_high_to_length n (Rows.conditional_sub weight (S n) arg (Positional.extend_to_length n (S n) N)). + Context (R_numlimbs : nat) + (N : T R_numlimbs). (* encoding of m *) + Let sub_then_maybe_add (a b : T R_numlimbs) : T R_numlimbs (* computes [a - b + if (a - b) <? 0 then N else 0] *) + := fst (Rows.sub_then_maybe_add weight R_numlimbs (r-1) a b N). + Local Opaque T. + Section Iteration. + Context (pred_A_numlimbs : nat) + (B : T R_numlimbs) (k : Z) + (A : T (S pred_A_numlimbs)) + (S : T (S R_numlimbs)). + (* Given A, B < R, we want to compute A * B / R mod N. R = bound 0 * ... * bound (n-1) *) + Local Definition A_a := dlet p := @divmod _ A in p. Local Definition A' := fst A_a. Local Definition a := snd A_a. + Local Definition S1 := @addT _ S (@scmul _ a B). + Local Definition s := snd (@divmod _ S1). + Local Definition q := fst (Z.mul_split r s k). + Local Definition S2 := @drop_high_addT' _ S1 (@scmul _ q N). + Local Definition S3' := fst (@divmod _ S2). + + Local Definition A'_S3 + := dlet A_a := @divmod _ A in + dlet A' := fst A_a in + dlet a := snd A_a in + dlet S1 := @addT _ S (@scmul _ a B) in + dlet s := snd (@divmod _ S1) in + dlet q := fst (Z.mul_split r s k) in + dlet S2 := @drop_high_addT' _ S1 (@scmul _ q N) in + dlet S3 := fst (@divmod _ S2) in + (A', S3). + + Lemma A'_S3_alt : A'_S3 = (A', S3'). + Proof. cbv [A'_S3 A' S3' Let_In S2 q s S1 A' a A_a]; reflexivity. Qed. + End Iteration. + + Section loop. + Context (A_numlimbs : nat) + (A : T A_numlimbs) + (B : T R_numlimbs) + (k : Z) + (S' : T (S R_numlimbs)). + + Definition redc_body {pred_A_numlimbs} : T (S pred_A_numlimbs) * T (S R_numlimbs) + -> T pred_A_numlimbs * T (S R_numlimbs) + := fun '(A, S') => A'_S3 _ B k A S'. + + Definition redc_loop (count : nat) : T count * T (S R_numlimbs) -> T O * T (S R_numlimbs) + := nat_rect + (fun count => T count * _ -> _) + (fun A_S => A_S) + (fun count' redc_loop_count' A_S + => redc_loop_count' (redc_body A_S)) + count. + + Definition pre_redc : T (S R_numlimbs) + := snd (redc_loop A_numlimbs (A, @zero (1 + R_numlimbs)%nat)). + + Definition redc : T R_numlimbs + := conditional_sub pre_redc N. + End loop. + + Create HintDb word_by_word_montgomery. + Hint Unfold A'_S3 S3' S2 q s S1 a A' A_a Let_In : word_by_word_montgomery. + + Definition add (A B : T R_numlimbs) : T R_numlimbs + := conditional_sub (@addT _ A B) N. + Definition sub (A B : T R_numlimbs) : T R_numlimbs + := sub_then_maybe_add A B. + Definition opp (A : T R_numlimbs) : T R_numlimbs + := sub (@zero _) A. + Definition nonzero (A : list Z) : Z + := fold_right Z.lor 0 A. + + Context (lgr_big : 0 < lgr) + (R_numlimbs_nz : R_numlimbs <> 0%nat). + Let R := (r^Z.of_nat R_numlimbs). + Transparent T. + Definition small {n} (v : T n) : Prop + := v = Rows.partition weight n (eval v). + Context (small_N : small N) + (N_lt_R : eval N < R) + (N_nz : 0 < eval N) + (B : T R_numlimbs) + (B_bounds : 0 <= eval B < R) + (small_B : small B) + ri (ri_correct : r*ri mod (eval N) = 1 mod (eval N)) + (k : Z) (k_correct : k * eval N mod r = (-1) mod r). + + Local Lemma r_big : r > 1. + Proof using lgr_big. clear -lgr_big; subst r. auto with zarith. Qed. + Local Notation wprops := (@UniformWeight.uwprops lgr lgr_big). + + Local Hint Immediate (wprops). + Local Hint Immediate (weight_0 wprops). + Local Hint Immediate (weight_positive wprops). + Local Hint Immediate (weight_multiples wprops). + Local Hint Immediate (weight_divides wprops). + Local Hint Immediate r_big. + + Lemma length_small {n v} : @small n v -> length v = n. + Proof using Type. clear; cbv [small]; intro H; rewrite H; autorewrite with distr_length; reflexivity. Qed. + + Let partition_Proper := (@Rows.partition_Proper _ wprops). + Local Existing Instance partition_Proper. + Lemma eval_nonzero n A : @small n A -> nonzero A = 0 <-> @eval n A = 0. + Proof. + cbv [nonzero eval small]; intro Heq. + do 2 rewrite Heq. + rewrite !Rows.eval_partition, Z.mod_mod by auto. + generalize (Positional.eval weight n A); clear Heq A. + induction n as [|n IHn]. + { cbn; rewrite weight_0 by auto; intros; autorewrite with zsimplify_const; omega. } + { intro; rewrite Rows.partition_step. + rewrite fold_right_snoc, Z.lor_comm, <- fold_right_push, Z.lor_eq_0_iff by auto using Z.lor_assoc. + assert (Heq : Z.equiv_modulo (weight n) (z mod weight (S n)) (z mod (weight n))). + { cbv [Z.equiv_modulo]. + generalize (weight_multiples ltac:(auto) n). + generalize (weight_positive ltac:(auto) n). + generalize (weight_positive ltac:(auto) (S n)). + generalize (weight (S n)) (weight n); clear; intros wsn wn. + clear; intros. + Z.div_mod_to_quot_rem; subst. + autorewrite with zsimplify_const in *. + Z.linear_substitute_all. + apply Zminus_eq; ring_simplify. + rewrite <- !Z.add_opp_r, !Z.mul_opp_comm, <- !Z.mul_opp_r, <- !Z.mul_assoc. + rewrite <- !Z.mul_add_distr_l, Z.mul_eq_0. + nia. } + rewrite Heq at 1; rewrite IHn. + rewrite Z.mod_mod by auto. + generalize (weight_multiples ltac:(auto) n). + generalize (weight_positive ltac:(auto) n). + generalize (weight_positive ltac:(auto) (S n)). + generalize (weight (S n)) (weight n); clear; intros wsn wn; intros. + Z.div_mod_to_quot_rem. + repeat (intro || apply conj); destruct_head'_or; try omega; destruct_head'_and; subst; autorewrite with zsimplify_const in *; try nia; + Z.linear_substitute_all. + all: apply Zminus_eq; ring_simplify. + all: rewrite <- ?Z.add_opp_r, ?Z.mul_opp_comm, <- ?Z.mul_opp_r, <- ?Z.mul_assoc. + all: rewrite <- !Z.mul_add_distr_l, Z.mul_eq_0. + all: nia. } + Qed. + + Local Ltac push_step := + first [ progress eta_expand + | rewrite Rows.mul_partitions + | rewrite Rows.mul_div + | rewrite Rows.add_partitions + | rewrite Rows.add_div + | progress autorewrite with push_eval distr_length + | match goal with + | [ H : ?v = _ |- context[length ?v] ] => erewrite length_small by eassumption + | [ H : small ?v |- context[length ?v] ] => erewrite length_small by eassumption + end + | rewrite Positional.eval_cons + | rewrite (weight_0 wprops) + | rewrite <- Z.div_mod'' by auto with omega + | solve [ trivial ] ]. + Local Ltac push := repeat push_step. + + Local Ltac t_step := + match goal with + | [ H := _ |- _ ] => progress cbv [H] in * + | _ => progress push_step + | _ => progress autorewrite with zsimplify_const + | _ => solve [ auto with omega ] + end. + + Local Hint Unfold eval zero small divmod scmul drop_high_addT' addT R : loc. + Local Lemma eval_zero : forall n, eval (@zero n) = 0. + Proof using Type. + clear; autounfold with loc; intros; autorewrite with push_eval; auto. + cbv -[Z.pow Z.mul Z.opp Z.div]; autorewrite with zsimplify_const; reflexivity. + Qed. + Local Lemma small_zero : forall n, small (@zero n). + Proof using Type. + etransitivity; [ eapply Positional.zeros_ext_map | rewrite eval_zero ]; cbv [Rows.partition]; cbn; try reflexivity; autorewrite with distr_length; reflexivity. + Qed. + Local Hint Immediate small_zero. + Local Axiom eval_div : forall n v, small v -> eval (fst (@divmod n v)) = eval v / r. + Local Axiom eval_mod : forall n v, small v -> snd (@divmod n v) = eval v mod r. + Local Axiom small_div : forall n v, small v -> small (fst (@divmod n v)). + Local Lemma eval_scmul: forall n a v, small v -> 0 <= a < r -> 0 <= eval v < r^Z.of_nat n -> eval (@scmul n a v) = a * eval v. + Proof using lgr_big. + generalize (@length_small); clear -lgr_big; intro. + autounfold with loc; intro n; destruct (zerop n). + { cbn; intros; subst; cbn; rewrite Z.add_with_get_carry_full_mod; cbn; omega. } + intros; repeat t_step. + repeat first [ reflexivity + | rewrite UniformWeight.uweight_eq_alt by omega + | progress autorewrite with push_Zof_nat + | rewrite Z.pow_succ_r by lia + | progress Z.rewrite_mod_small ]. + Qed. + Local Lemma small_scmul : forall n a v, small v -> 0 <= a < r -> 0 <= eval v < r^Z.of_nat n -> small (@scmul n a v). + Proof using lgr_big. + intros n a v Hpart. + generalize (length_small Hpart). + generalize eval_scmul. + clear -Hpart lgr_big. + destruct (zerop n). + { destruct v; subst; cbn; try congruence; cbv [small]; cbn. + rewrite Z.add_with_get_carry_full_mod; cbn; autorewrite with zsimplify_const; reflexivity. } + { cbv [small]; intros eval_scmul; intros. + rewrite eval_scmul by auto. + cbv [scmul]; eta_expand. + rewrite Rows.mul_partitions by (auto with omega; autorewrite with distr_length; auto with omega). + autorewrite with push_eval; auto with omega. + rewrite Positional.eval_cons, Positional.eval_nil by reflexivity. + rewrite weight_0 by auto; autorewrite with zsimplify_const; reflexivity. } + Qed. + Local Lemma eval_addT : forall n a b, small a -> small b -> eval (@addT n a b) = eval a + eval b. + Proof using lgr_big. + intros n a b Ha Hb; generalize (length_small Ha); generalize (length_small Hb). + clear -lgr_big Ha Hb. + autounfold with loc; destruct (zerop n); subst. + { destruct a, b; cbn; try omega. } + { eta_expand; intros; repeat t_step. } + Qed. + Local Axiom small_addT : forall n a b, small a -> small b -> small (@addT n a b). + Local Lemma eval_drop_high_addT' : forall n a b, small a -> small b -> eval (@drop_high_addT' n a b) = (eval a + eval b) mod (r^Z.of_nat (S n)). + Proof using lgr_big. + intros n a b Ha Hb; generalize (length_small Ha); generalize (length_small Hb). + clear -lgr_big Ha Hb. + autounfold with loc in *; destruct (zerop n); subst. + { destruct a as [| ? [|] ], b; cbn; try omega. + cbv [Rows.partition seq eval map] in Ha. + cbn in Ha. + rewrite (weight_0 wprops) in *. + rewrite Z.add_with_get_carry_full_mod. + subst r. + rewrite UniformWeight.uweight_eq_alt in * by omega. + autorewrite with zsimplify_const in *. + inversion Ha as [Ha']; clear Ha. + rewrite <- !Ha'. + reflexivity. } + { eta_expand; intros; repeat t_step. + rewrite UniformWeight.uweight_eq_alt by omega. + reflexivity. } + Qed. + Local Lemma small_drop_high_addT' : forall n a b, small a -> small b -> small (@drop_high_addT' n a b). + Proof using lgr_big. + intros n a b Ha Hb; generalize (length_small Ha); generalize (length_small Hb); generalize (@eval_drop_high_addT' n a b Ha). + clear -lgr_big Ha Hb. + cbv [small]. + intro Heq; rewrite Heq; autounfold with loc in *. + rewrite Ha, Hb. + repeat t_step. + rewrite !UniformWeight.uweight_eq_alt by omega. + autorewrite with push_Zof_nat zsimplify_fast. + rewrite Z.pow_succ_r by omega. + Admitted. + Local Axiom eval_conditional_sub : forall v, small v -> 0 <= eval v < eval N + R -> eval (conditional_sub v N) = eval v + if eval N <=? eval v then -eval N else 0. + Local Axiom small_conditional_sub : forall v, small v -> 0 <= eval v < eval N + R -> small (conditional_sub v N). + Local Axiom eval_sub_then_maybe_add : forall a b, small a -> small b -> 0 <= eval a < eval N -> 0 <= eval b < eval N -> eval (sub_then_maybe_add a b) = eval a - eval b + if eval a - eval b <? 0 then eval N else 0. + Local Axiom small_sub_then_maybe_add : forall a b, small (sub_then_maybe_add a b). + + Local Opaque T addT drop_high_addT' divmod zero scmul conditional_sub sub_then_maybe_add. + Create HintDb push_mont_eval discriminated. + Create HintDb word_by_word_montgomery. + Hint Unfold A'_S3 S3' S2 q s S1 a A' A_a Let_In : word_by_word_montgomery. + Let r_big' := r_big. (* to put it in the context *) + Local Ltac t_small := + repeat first [ assumption + | apply small_addT + | apply small_drop_high_addT' + | apply small_div + | apply small_zero + | apply small_scmul + | apply small_conditional_sub + | apply small_sub_then_maybe_add + | apply Z_mod_lt + | rewrite Z.mul_split_mod + | solve [ auto with zarith ] + | lia + | progress autorewrite with push_mont_eval + | progress autounfold with word_by_word_montgomery + | match goal with + | [ H : and _ _ |- _ ] => destruct H + end ]. + Hint Rewrite + eval_zero + eval_div + eval_mod + eval_addT + eval_drop_high_addT' + eval_scmul + eval_conditional_sub + eval_sub_then_maybe_add + using (repeat autounfold with word_by_word_montgomery; t_small) + : push_mont_eval. + + Local Arguments eval {_} _. + Local Arguments small {_} _. + Local Arguments divmod {_} _. + + (* Recurse for a as many iterations as A has limbs, varying A := A, S := 0, r, bounds *) + Section Iteration_proofs. + Context (pred_A_numlimbs : nat) + (A : T (S pred_A_numlimbs)) + (S : T (S R_numlimbs)) + (small_A : small A) + (small_S : small S) + (S_nonneg : 0 <= eval S). + (* Given A, B < R, we want to compute A * B / R mod N. R = bound 0 * ... * bound (n-1) *) + + Local Coercion eval : T >-> Z. + + Local Notation a := (@a pred_A_numlimbs A). + Local Notation A' := (@A' pred_A_numlimbs A). + Local Notation S1 := (@S1 pred_A_numlimbs B A S). + Local Notation s := (@s pred_A_numlimbs B A S). + Local Notation q := (@q pred_A_numlimbs B k A S). + Local Notation S2 := (@S2 pred_A_numlimbs B k A S). + Local Notation S3 := (@S3' pred_A_numlimbs B k A S). + + Local Notation eval_pre_S3 := ((S + a * B + q * N) / r). + + Lemma eval_S3_eq : eval S3 = eval_pre_S3 mod (r * r ^ Z.of_nat R_numlimbs). + Proof. + unfold S3, S2, S1. + autorewrite with push_mont_eval push_Zof_nat; []. + rewrite !Z.pow_succ_r, <- ?Z.mul_assoc by omega. + rewrite Z.mod_pull_div by Z.zero_bounds. + do 2 f_equal; nia. + Qed. + + Lemma pre_S3_bound + : eval S < eval N + eval B + -> eval_pre_S3 < eval N + eval B. + Proof. + assert (Hmod : forall a b, 0 < b -> a mod b <= b - 1) + by (intros x y; pose proof (Z_mod_lt x y); omega). + intro HS. + eapply Z.le_lt_trans. + { transitivity ((N+B-1 + (r-1)*B + (r-1)*N) / r); + [ | set_evars; ring_simplify_subterms; subst_evars; reflexivity ]. + Z.peel_le; repeat apply Z.add_le_mono; repeat apply Z.mul_le_mono_nonneg; try lia; + repeat autounfold with word_by_word_montgomery; rewrite ?Z.mul_split_mod; + autorewrite with push_mont_eval; + try Z.zero_bounds; + auto with lia. } + rewrite (Z.mul_comm _ r), <- Z.add_sub_assoc, <- Z.add_opp_r, !Z.div_add_l' by lia. + autorewrite with zsimplify. + simpl; omega. + Qed. + + Lemma pre_S3_nonneg : 0 <= eval_pre_S3. + Proof. + repeat autounfold with word_by_word_montgomery; rewrite ?Z.mul_split_mod; + autorewrite with push_mont_eval; []. + rewrite ?Npos_correct; Z.zero_bounds; lia. + Qed. + + Lemma small_A' + : small A'. + Proof. repeat autounfold with word_by_word_montgomery; t_small. Qed. + + Lemma small_S3 + : small S3. + Proof. repeat autounfold with word_by_word_montgomery; t_small. Qed. + + Lemma S3_nonneg : 0 <= eval S3. + Proof. rewrite eval_S3_eq; Z.zero_bounds. Qed. + + Lemma S3_bound + : eval S < eval N + eval B + -> eval S3 < eval N + eval B. + Proof. + rewrite eval_S3_eq. + intro H; pose proof (pre_S3_bound H); pose proof pre_S3_nonneg. + subst R. + rewrite Z.mod_small by nia. + assumption. + Qed. + + Lemma S1_eq : eval S1 = S + a*B. + Proof. + cbv [S1 a A']. + repeat autorewrite with push_mont_eval. + reflexivity. + Qed. + + Lemma S2_mod_r_helper : (S + a*B + q * N) mod r = 0. + Proof. + cbv [S2 q s]; autorewrite with push_mont_eval; rewrite S1_eq. + assert (r > 0) by lia. + assert (Hr : (-(1 mod r)) mod r = r - 1 /\ (-(1)) mod r = r - 1). + { destruct (Z.eq_dec r 1) as [H'|H']. + { rewrite H'; split; reflexivity. } + { rewrite !Z_mod_nz_opp_full; rewrite ?Z.mod_mod; Z.rewrite_mod_small; [ split; reflexivity | omega.. ]. } } + autorewrite with pull_Zmod. + replace 0 with (0 mod r) by apply Zmod_0_l. + pose (Z.to_pos r) as r'. + replace r with (Z.pos r') by (subst r'; rewrite Z2Pos.id; lia). + eapply F.eq_of_Z_iff. + rewrite Z.mul_split_mod. + repeat rewrite ?F.of_Z_add, ?F.of_Z_mul, <-?F.of_Z_mod. + rewrite <-!Algebra.Hierarchy.associative. + replace ((F.of_Z r' k * F.of_Z r' (eval N))%F) with (F.opp (m:=r') F.one). + { cbv [F.of_Z F.add]; simpl. + apply path_sig_hprop; [ intro; exact HProp.allpath_hprop | ]. + simpl. + subst r'; rewrite Z2Pos.id by lia. + rewrite (proj1 Hr), Z.mul_sub_distr_l. + push_Zmod; pull_Zmod. + apply (f_equal2 Z.modulo); omega. } + { rewrite <- F.of_Z_mul. + rewrite F.of_Z_mod. + subst r'; rewrite Z2Pos.id by lia. + rewrite k_correct. + cbv [F.of_Z F.add F.opp F.one]; simpl. + change (-(1)) with (-1) in *. + apply path_sig_hprop; [ intro; exact HProp.allpath_hprop | ]; simpl. + rewrite Z2Pos.id by lia. + rewrite (proj1 Hr), (proj2 Hr); Z.rewrite_mod_small; reflexivity. } + Qed. + + Lemma pre_S3_mod_N + : eval_pre_S3 mod N = (S + a*B)*ri mod N. + Proof. + pose proof fun a => Z.div_to_inv_modulo N a r ri ltac:(lia) ri_correct as HH; + cbv [Z.equiv_modulo] in HH; rewrite HH; clear HH. + etransitivity; [rewrite (fun a => Z.mul_mod_l a ri N)| + rewrite (fun a => Z.mul_mod_l a ri N); reflexivity]. + rewrite S2_mod_r_helper. + push_Zmod; pull_Zmod; autorewrite with zsimplify_const. + reflexivity. + Qed. + + Lemma S3_mod_N + (Hbound : eval S < eval N + eval B) + : S3 mod N = (S + a*B)*ri mod N. + Proof. + rewrite eval_S3_eq. + pose proof (pre_S3_bound Hbound); pose proof pre_S3_nonneg. + rewrite (Z.mod_small _ (r * _)) by (subst R; nia). + apply pre_S3_mod_N. + Qed. + End Iteration_proofs. + + Section redc_proofs. + Local Notation redc_body := (@redc_body B k). + Local Notation redc_loop := (@redc_loop B k). + Local Notation pre_redc A := (@pre_redc _ A B k). + Local Notation redc A := (@redc _ A B k). + + Section body. + Context (pred_A_numlimbs : nat) + (A_S : T (S pred_A_numlimbs) * T (S R_numlimbs)). + Let A:=fst A_S. + Let S:=snd A_S. + Let A_a:=divmod A. + Let a:=snd A_a. + Context (small_A : small A) + (small_S : small S) + (S_bound : 0 <= eval S < eval N + eval B). + + Lemma small_fst_redc_body : small (fst (redc_body A_S)). + Proof. destruct A_S; apply small_A'; assumption. Qed. + Lemma small_snd_redc_body : small (snd (redc_body A_S)). + Proof. destruct A_S; unfold redc_body; apply small_S3; assumption. Qed. + Lemma snd_redc_body_nonneg : 0 <= eval (snd (redc_body A_S)). + Proof. destruct A_S; apply S3_nonneg; assumption. Qed. + + Lemma snd_redc_body_mod_N + : (eval (snd (redc_body A_S))) mod (eval N) = (eval S + a*eval B)*ri mod (eval N). + Proof. destruct A_S; apply S3_mod_N; auto; omega. Qed. + + Lemma fst_redc_body + : (eval (fst (redc_body A_S))) = eval (fst A_S) / r. + Proof. + destruct A_S; simpl; repeat autounfold with word_by_word_montgomery; simpl. + autorewrite with push_mont_eval. + reflexivity. + Qed. + + Lemma fst_redc_body_mod_N + : (eval (fst (redc_body A_S))) mod (eval N) = ((eval (fst A_S) - a)*ri) mod (eval N). + Proof. + rewrite fst_redc_body. + etransitivity; [ eapply Z.div_to_inv_modulo; try eassumption; lia | ]. + unfold a, A_a, A. + autorewrite with push_mont_eval. + reflexivity. + Qed. + + Lemma redc_body_bound + : eval S < eval N + eval B + -> eval (snd (redc_body A_S)) < eval N + eval B. + Proof. + destruct A_S; apply S3_bound; unfold S in *; cbn [snd] in *; try assumption; try omega. + Qed. + End body. + + Local Arguments Z.pow !_ !_. + Local Arguments Z.of_nat !_. + Local Ltac induction_loop count IHcount + := induction count as [|count IHcount]; intros; cbn [redc_loop nat_rect] in *; [ | (*rewrite redc_loop_comm_body in * *) ]. + Lemma redc_loop_good count A_S + (Hsmall : small (fst A_S) /\ small (snd A_S)) + (Hbound : 0 <= eval (snd A_S) < eval N + eval B) + : (small (fst (redc_loop count A_S)) /\ small (snd (redc_loop count A_S))) + /\ 0 <= eval (snd (redc_loop count A_S)) < eval N + eval B. + Proof. + induction_loop count IHcount; auto; []. + change (id (0 <= eval B < R)) in B_bounds (* don't let [destruct_head'_and] loop *). + destruct_head'_and. + repeat first [ apply conj + | apply small_fst_redc_body + | apply small_snd_redc_body + | apply redc_body_bound + | apply snd_redc_body_nonneg + | apply IHcount + | solve [ auto ] ]. + Qed. + + Lemma small_redc_loop count A_S + (Hsmall : small (fst A_S) /\ small (snd A_S)) + (Hbound : 0 <= eval (snd A_S) < eval N + eval B) + : small (fst (redc_loop count A_S)) /\ small (snd (redc_loop count A_S)). + Proof. apply redc_loop_good; assumption. Qed. + + Lemma redc_loop_bound count A_S + (Hsmall : small (fst A_S) /\ small (snd A_S)) + (Hbound : 0 <= eval (snd A_S) < eval N + eval B) + : 0 <= eval (snd (redc_loop count A_S)) < eval N + eval B. + Proof. apply redc_loop_good; assumption. Qed. + + Local Ltac handle_IH_small := + repeat first [ apply redc_loop_good + | apply small_fst_redc_body + | apply small_snd_redc_body + | apply redc_body_bound + | apply snd_redc_body_nonneg + | apply conj + | progress cbn [fst snd] + | progress destruct_head' and + | solve [ auto ] ]. + + Lemma fst_redc_loop count A_S + (Hsmall : small (fst A_S) /\ small (snd A_S)) + (Hbound : 0 <= eval (snd A_S) < eval N + eval B) + : eval (fst (redc_loop count A_S)) = eval (fst A_S) / r^(Z.of_nat count). + Proof. + cbv [redc_loop]; induction_loop count IHcount. + { simpl; autorewrite with zsimplify; reflexivity. } + { rewrite IHcount, fst_redc_body by handle_IH_small. + change (1 + R_numlimbs)%nat with (S R_numlimbs) in *. + rewrite Zdiv_Zdiv by Z.zero_bounds. + rewrite <- (Z.pow_1_r r) at 1. + rewrite <- Z.pow_add_r by lia. + replace (1 + Z.of_nat count) with (Z.of_nat (S count)) by lia. + reflexivity. } + Qed. + + Lemma fst_redc_loop_mod_N count A_S + (Hsmall : small (fst A_S) /\ small (snd A_S)) + (Hbound : 0 <= eval (snd A_S) < eval N + eval B) + : eval (fst (redc_loop count A_S)) mod (eval N) + = (eval (fst A_S) - eval (fst A_S) mod r^Z.of_nat count) + * ri^(Z.of_nat count) mod (eval N). + Proof. + rewrite fst_redc_loop by assumption. + destruct count. + { simpl; autorewrite with zsimplify; reflexivity. } + { etransitivity; + [ eapply Z.div_to_inv_modulo; + try solve [ eassumption + | apply Z.lt_gt, Z.pow_pos_nonneg; lia ] + | ]. + { erewrite <- Z.pow_mul_l, <- Z.pow_1_l. + { apply Z.pow_mod_Proper; [ eassumption | reflexivity ]. } + { lia. } } + reflexivity. } + Qed. + + Local Arguments Z.pow : simpl never. + Lemma snd_redc_loop_mod_N count A_S + (Hsmall : small (fst A_S) /\ small (snd A_S)) + (Hbound : 0 <= eval (snd A_S) < eval N + eval B) + : (eval (snd (redc_loop count A_S))) mod (eval N) + = ((eval (snd A_S) + (eval (fst A_S) mod r^(Z.of_nat count))*eval B)*ri^(Z.of_nat count)) mod (eval N). + Proof. + cbv [redc_loop]. + induction_loop count IHcount. + { simpl; autorewrite with zsimplify; reflexivity. } + { rewrite IHcount by handle_IH_small. + push_Zmod; rewrite snd_redc_body_mod_N, fst_redc_body by handle_IH_small; pull_Zmod. + autorewrite with push_mont_eval; []. + match goal with + | [ |- ?x mod ?N = ?y mod ?N ] + => change (Z.equiv_modulo N x y) + end. + destruct A_S as [A S]. + cbn [fst snd]. + change (Z.pos (Pos.of_succ_nat ?n)) with (Z.of_nat (Datatypes.S n)). + rewrite !Z.mul_add_distr_r. + rewrite <- !Z.mul_assoc. + replace (ri * ri^(Z.of_nat count)) with (ri^(Z.of_nat (Datatypes.S count))) + by (change (Datatypes.S count) with (1 + count)%nat; + autorewrite with push_Zof_nat; rewrite Z.pow_add_r by lia; simpl Z.succ; rewrite Z.pow_1_r; nia). + rewrite <- !Z.add_assoc. + apply Z.add_mod_Proper; [ reflexivity | ]. + unfold Z.equiv_modulo; push_Zmod; rewrite (Z.mul_mod_l (_ mod r) _ (eval N)). + rewrite Z.mod_pull_div by auto with zarith lia. + push_Zmod. + erewrite Z.div_to_inv_modulo; + [ + | apply Z.lt_gt; lia + | eassumption ]. + pull_Zmod. + match goal with + | [ |- ?x mod ?N = ?y mod ?N ] + => change (Z.equiv_modulo N x y) + end. + repeat first [ rewrite <- !Z.pow_succ_r, <- !Nat2Z.inj_succ by lia + | rewrite (Z.mul_comm _ ri) + | rewrite (Z.mul_assoc _ ri _) + | rewrite (Z.mul_comm _ (ri^_)) + | rewrite (Z.mul_assoc _ (ri^_) _) ]. + repeat first [ rewrite <- Z.mul_assoc + | rewrite <- Z.mul_add_distr_l + | rewrite (Z.mul_comm _ (eval B)) + | rewrite !Nat2Z.inj_succ, !Z.pow_succ_r by lia; + rewrite <- Znumtheory.Zmod_div_mod by (apply Z.divide_factor_r || Z.zero_bounds) + | rewrite Zplus_minus + | rewrite (Z.mul_comm r (r^_)) + | reflexivity ]. } + Qed. + + Lemma pre_redc_bound A_numlimbs (A : T A_numlimbs) + (small_A : small A) + : 0 <= eval (pre_redc A) < eval N + eval B. + Proof. + unfold pre_redc. + apply redc_loop_good; simpl; autorewrite with push_mont_eval; + rewrite ?Npos_correct; auto; lia. + Qed. + + Lemma small_pre_redc A_numlimbs (A : T A_numlimbs) + (small_A : small A) + : small (pre_redc A). + Proof. + unfold pre_redc. + apply redc_loop_good; simpl; autorewrite with push_mont_eval; + rewrite ?Npos_correct; auto; lia. + Qed. + + Lemma pre_redc_mod_N A_numlimbs (A : T A_numlimbs) (small_A : small A) (A_bound : 0 <= eval A < r ^ Z.of_nat A_numlimbs) + : (eval (pre_redc A)) mod (eval N) = (eval A * eval B * ri^(Z.of_nat A_numlimbs)) mod (eval N). + Proof. + unfold pre_redc. + rewrite snd_redc_loop_mod_N; cbn [fst snd]; + autorewrite with push_mont_eval zsimplify; + [ | rewrite ?Npos_correct; auto; lia.. ]. + Z.rewrite_mod_small. + reflexivity. + Qed. + + Lemma redc_mod_N A_numlimbs (A : T A_numlimbs) (small_A : small A) (A_bound : 0 <= eval A < r ^ Z.of_nat A_numlimbs) + : (eval (redc A)) mod (eval N) = (eval A * eval B * ri^(Z.of_nat A_numlimbs)) mod (eval N). + Proof. + pose proof (@small_pre_redc _ A small_A). + pose proof (@pre_redc_bound _ A small_A). + unfold redc. + autorewrite with push_mont_eval; []. + break_innermost_match; + try rewrite Z.add_opp_r, Zminus_mod, Z_mod_same_full; + autorewrite with zsimplify_fast; + apply pre_redc_mod_N; auto. + Qed. + + Lemma redc_bound_tight A_numlimbs (A : T A_numlimbs) + (small_A : small A) + : 0 <= eval (redc A) < eval N + eval B + if eval N <=? eval (pre_redc A) then -eval N else 0. + Proof. + pose proof (@small_pre_redc _ A small_A). + pose proof (@pre_redc_bound _ A small_A). + unfold redc. + rewrite eval_conditional_sub by t_small. + break_innermost_match; Z.ltb_to_lt; omega. + Qed. + + Lemma redc_bound_N A_numlimbs (A : T A_numlimbs) + (small_A : small A) + : eval B < eval N -> 0 <= eval (redc A) < eval N. + Proof. + pose proof (@small_pre_redc _ A small_A). + pose proof (@pre_redc_bound _ A small_A). + unfold redc. + rewrite eval_conditional_sub by t_small. + break_innermost_match; Z.ltb_to_lt; omega. + Qed. + + Lemma redc_bound A_numlimbs (A : T A_numlimbs) + (small_A : small A) + (A_bound : 0 <= eval A < r ^ Z.of_nat A_numlimbs) + : 0 <= eval (redc A) < R. + Proof. + pose proof (@small_pre_redc _ A small_A). + pose proof (@pre_redc_bound _ A small_A). + unfold redc. + rewrite eval_conditional_sub by t_small. + break_innermost_match; Z.ltb_to_lt; try omega. + Qed. + + Lemma small_redc A_numlimbs (A : T A_numlimbs) + (small_A : small A) + (A_bound : 0 <= eval A < r ^ Z.of_nat A_numlimbs) + : small (redc A). + Proof. + pose proof (@small_pre_redc _ A small_A). + pose proof (@pre_redc_bound _ A small_A). + unfold redc. + apply small_conditional_sub; [ apply small_pre_redc | .. ]; auto; omega. + Qed. + End redc_proofs. + + Section add_sub. + Context (Av Bv : T R_numlimbs) + (small_Av : small Av) + (small_Bv : small Bv) + (Av_bound : 0 <= eval Av < eval N) + (Bv_bound : 0 <= eval Bv < eval N). + + Local Ltac do_clear := + clear dependent B; clear dependent k; clear dependent ri. + + Lemma small_add : small (add Av Bv). + Proof. unfold add; t_small. Qed. + Lemma small_sub : small (sub Av Bv). + Proof. unfold sub; t_small. Qed. + Lemma small_opp : small (opp Av). + Proof. unfold opp, sub; t_small. Qed. + + Lemma eval_add : eval (add Av Bv) = eval Av + eval Bv + if (eval N <=? eval Av + eval Bv) then -eval N else 0. + Proof. unfold add; autorewrite with push_mont_eval; reflexivity. Qed. + Lemma eval_sub : eval (sub Av Bv) = eval Av - eval Bv + if (eval Av - eval Bv <? 0) then eval N else 0. + Proof. unfold sub; autorewrite with push_mont_eval; reflexivity. Qed. + Lemma eval_opp : eval (opp Av) = (if (eval Av =? 0) then 0 else eval N) - eval Av. + Proof. + unfold opp, sub; autorewrite with push_mont_eval. + break_innermost_match; Z.ltb_to_lt; lia. + Qed. + + Local Ltac t_mod_N := + repeat first [ progress break_innermost_match + | reflexivity + | let H := fresh in intro H; rewrite H; clear H + | progress autorewrite with zsimplify_const + | rewrite Z.add_opp_r + | progress (push_Zmod; pull_Zmod) ]. + + Lemma eval_add_mod_N : eval (add Av Bv) mod eval N = (eval Av + eval Bv) mod eval N. + Proof. generalize eval_add; clear. t_mod_N. Qed. + Lemma eval_sub_mod_N : eval (sub Av Bv) mod eval N = (eval Av - eval Bv) mod eval N. + Proof. generalize eval_sub; clear. t_mod_N. Qed. + Lemma eval_opp_mod_N : eval (opp Av) mod eval N = (-eval Av) mod eval N. + Proof. generalize eval_opp; clear; t_mod_N. Qed. + + Lemma add_bound : 0 <= eval (add Av Bv) < eval N. + Proof. generalize eval_add; break_innermost_match; Z.ltb_to_lt; lia. Qed. + Lemma sub_bound : 0 <= eval (sub Av Bv) < eval N. + Proof. generalize eval_sub; break_innermost_match; Z.ltb_to_lt; lia. Qed. + Lemma opp_bound : 0 <= eval (opp Av) < eval N. + Proof. generalize eval_opp; break_innermost_match; Z.ltb_to_lt; lia. Qed. + End add_sub. + End with_args. + + Section modops. + Context (bitwidth : Z) + (n : nat) + (m : Z). + Let r := 2^bitwidth. + Local Notation weight := (UniformWeight.uweight bitwidth). + Local Notation eval := (@eval bitwidth n). + Let m_enc := Rows.partition weight n m. + Local Coercion Z.of_nat : nat >-> Z. + Context (r' : Z) + (m' : Z) + (r'_correct : (r * r') mod m = 1) + (m'_correct : (m * m') mod r = (-1) mod r) + (bitwidth_big : 0 < bitwidth) + (m_big : 1 < m) + (n_nz : n <> 0%nat) + (m_small : m < r^n). + + Local Notation wprops := (@UniformWeight.uwprops bitwidth bitwidth_big). + Local Notation small := (@small bitwidth n). + + Local Hint Immediate (wprops). + Local Hint Immediate (weight_0 wprops). + Local Hint Immediate (weight_positive wprops). + Local Hint Immediate (weight_multiples wprops). + Local Hint Immediate (weight_divides wprops). + + Local Lemma m_enc_correct_montgomery : m = eval m_enc. + Proof. + cbv [eval m_enc]; autorewrite with push_eval; auto. + rewrite UniformWeight.uweight_eq_alt by omega. + Z.rewrite_mod_small; reflexivity. + Qed. + Local Lemma r'_pow_correct : (r'^n * r^n) mod (eval m_enc) = 1. + Proof. + rewrite <- Z.pow_mul_l, Z.mod_pow_full, ?(Z.mul_comm r'), <- m_enc_correct_montgomery, r'_correct. + autorewrite with zsimplify_const; auto with omega. + Z.rewrite_mod_small; omega. + Qed. + Local Lemma small_m_enc : small m_enc. + Proof. + cbv [m_enc small eval]; autorewrite with push_eval; auto. + rewrite UniformWeight.uweight_eq_alt by omega. + Z.rewrite_mod_small; reflexivity. + Qed. + + Local Ltac t_fin := + repeat match goal with + | _ => assumption + | [ |- ?x = ?x ] => reflexivity + | [ |- and _ _ ] => split + | _ => rewrite <- !m_enc_correct_montgomery + | _ => rewrite !r'_correct + | _ => rewrite !Z.mod_1_l by assumption; reflexivity + | _ => rewrite !(Z.mul_comm m' m) + | _ => lia + | _ => exact small_m_enc + | [ H : small ?x |- context[eval ?x] ] + => rewrite H; cbv [eval]; rewrite Rows.eval_partition by auto + | [ |- context[weight _] ] => rewrite UniformWeight.uweight_eq_alt by auto with omega + | _=> progress Z.rewrite_mod_small + | _ => progress Z.zero_bounds + | [ |- _ mod ?x < ?x ] => apply Z.mod_pos_bound + end. + + Definition mulmod (a b : list Z) : list Z := @redc bitwidth n m_enc n a b m'. + Definition squaremod (a : list Z) : list Z := mulmod a a. + Definition addmod (a b : list Z) : list Z := @add bitwidth n m_enc a b. + Definition submod (a b : list Z) : list Z := @sub bitwidth n m_enc a b. + Definition oppmod (a : list Z) : list Z := @opp bitwidth n m_enc a. + Definition nonzeromod (a : list Z) : Z := @nonzero a. + Definition to_bytesmod (a : list Z) : list Z := @to_bytesmod bitwidth 1 n a. + + Definition valid (a : list Z) := small a /\ 0 <= eval a < m. + + Lemma mulmod_correct0 + : forall a b : list Z, + small a -> small b + -> small (mulmod a b) + /\ (eval b < m -> 0 <= eval (mulmod a b) < m) + /\ (eval (mulmod a b) mod m = (eval a * eval b * r'^n) mod m). + Proof. + intros a b Ha Hb; repeat apply conj; cbv [small mulmod eval]; + [ eapply small_redc + | rewrite m_enc_correct_montgomery; eapply redc_bound_N + | rewrite !m_enc_correct_montgomery; eapply redc_mod_N ]; + t_fin. + Qed. + + Definition onemod : list Z := Rows.partition weight n 1. + + Definition onemod_correct : eval onemod = 1 /\ valid onemod. + Proof. cbv [valid small onemod eval]; autorewrite with push_eval; t_fin. Qed. + + Definition R2mod : list Z := Rows.partition weight n ((r^n * r^n) mod m). + + Definition R2mod_correct : eval R2mod mod m = (r^n*r^n) mod m /\ valid R2mod. + Proof. + cbv [valid small R2mod eval]; autorewrite with push_eval; t_fin; + rewrite !(Z.mod_small (_ mod m)) by (Z.div_mod_to_quot_rem; subst r; lia); + t_fin. + Qed. + + Definition from_montgomery_mod (v : list Z) : list Z + := mulmod v onemod. + + Lemma from_montgomery_mod_correct (v : list Z) + : valid v -> eval (from_montgomery_mod v) mod m = (eval v * r'^n) mod m + /\ valid (from_montgomery_mod v). + Proof. + intro Hv; cbv [from_montgomery_mod valid] in *; destruct_head'_and. + replace (eval v * r'^n) with (eval v * eval onemod * r'^n) by (rewrite (proj1 onemod_correct); lia). + repeat apply conj; apply mulmod_correct0; auto; try apply onemod_correct; rewrite (proj1 onemod_correct); omega. + Qed. + + Lemma eval_from_montgomery_mod (v : list Z) : valid v -> eval (from_montgomery_mod v) mod m = (eval v * r'^n) mod m. + Proof. intros; apply from_montgomery_mod_correct; assumption. Qed. + Lemma valid_from_montgomery_mod (v : list Z) + : valid v -> valid (from_montgomery_mod v). + Proof. intros; apply from_montgomery_mod_correct; assumption. Qed. + + Lemma mulmod_correct + : (forall a (_ : valid a) b (_ : valid b), eval (from_montgomery_mod (mulmod a b)) mod m + = (eval (from_montgomery_mod a) * eval (from_montgomery_mod b)) mod m) + /\ (forall a (_ : valid a) b (_ : valid b), valid (mulmod a b)). + Proof. + repeat apply conj; intros; + push_Zmod; rewrite ?eval_from_montgomery_mod; pull_Zmod; repeat apply conj; + try apply mulmod_correct0; cbv [valid] in *; destruct_head'_and; auto; []. + rewrite !Z.mul_assoc. + apply Z.mul_mod_Proper; [ | reflexivity ]. + cbv [Z.equiv_modulo]; etransitivity; [ apply mulmod_correct0 | apply f_equal2; lia ]; auto. + Qed. + + Lemma squaremod_correct + : (forall a (_ : valid a), eval (from_montgomery_mod (squaremod a)) mod m + = (eval (from_montgomery_mod a) * eval (from_montgomery_mod a)) mod m) + /\ (forall a (_ : valid a), valid (squaremod a)). + Proof. + split; intros; cbv [squaremod]; apply mulmod_correct; assumption. + Qed. + + Definition encodemod (v : Z) : list Z + := mulmod (Rows.partition weight n v) R2mod. + + Local Ltac t_valid v := + cbv [valid]; repeat apply conj; + auto; cbv [small eval]; autorewrite with push_eval; auto; + rewrite ?UniformWeight.uweight_eq_alt by omega; + Z.rewrite_mod_small; + rewrite ?(Z.mod_small (_ mod m)) by (subst r; Z.div_mod_to_quot_rem; lia); + rewrite ?(Z.mod_small v) by (subst r; Z.div_mod_to_quot_rem; lia); + try apply Z.mod_pos_bound; subst r; try lia; try reflexivity. + Lemma encodemod_correct + : (forall v, 0 <= v < m -> eval (from_montgomery_mod (encodemod v)) mod m = v mod m) + /\ (forall v, 0 <= v < m -> valid (encodemod v)). + Proof. + split; intros v ?; cbv [encodemod R2mod]; [ rewrite (proj1 mulmod_correct) | apply mulmod_correct ]; + [ | now t_valid v.. ]. + push_Zmod; rewrite !eval_from_montgomery_mod; [ | now t_valid v.. ]. + cbv [eval]; autorewrite with push_eval; auto. + rewrite ?UniformWeight.uweight_eq_alt by omega. + rewrite ?(Z.mod_small v) by (subst r; Z.div_mod_to_quot_rem; lia). + rewrite ?(Z.mod_small (_ mod m)) by (subst r; Z.div_mod_to_quot_rem; lia). + pull_Zmod. + rewrite <- !Z.mul_assoc; autorewrite with pull_Zpow. + generalize r'_correct; push_Zmod; intro Heq; rewrite Heq; clear Heq; pull_Zmod; autorewrite with zsimplify_const. + rewrite (Z.mul_comm r' r); generalize r'_correct; push_Zmod; intro Heq; rewrite Heq; clear Heq; pull_Zmod; autorewrite with zsimplify_const. + Z.rewrite_mod_small. + reflexivity. + Qed. + + Lemma addmod_correct + : (forall a (_ : valid a) b (_ : valid b), eval (from_montgomery_mod (addmod a b)) mod m + = (eval (from_montgomery_mod a) + eval (from_montgomery_mod b)) mod m) + /\ (forall a (_ : valid a) b (_ : valid b), valid (addmod a b)). + Proof. + repeat apply conj; intros; + push_Zmod; rewrite ?eval_from_montgomery_mod; pull_Zmod; repeat apply conj; + cbv [valid addmod] in *; destruct_head'_and; auto; + try rewrite m_enc_correct_montgomery; + try (eapply small_add || eapply add_bound); rewrite <- ?m_enc_correct_montgomery; eauto with omega; []. + push_Zmod; erewrite eval_add by (rewrite <- ?m_enc_correct_montgomery; eauto with omega); pull_Zmod; rewrite <- ?m_enc_correct_montgomery. + break_innermost_match; push_Zmod; pull_Zmod; autorewrite with zsimplify_const; apply f_equal2; nia. + Qed. + + Lemma submod_correct + : (forall a (_ : valid a) b (_ : valid b), eval (from_montgomery_mod (submod a b)) mod m + = (eval (from_montgomery_mod a) - eval (from_montgomery_mod b)) mod m) + /\ (forall a (_ : valid a) b (_ : valid b), valid (submod a b)). + Proof. + repeat apply conj; intros; + push_Zmod; rewrite ?eval_from_montgomery_mod; pull_Zmod; repeat apply conj; + cbv [valid submod] in *; destruct_head'_and; auto; + try rewrite m_enc_correct_montgomery; + try (eapply small_sub || eapply sub_bound); rewrite <- ?m_enc_correct_montgomery; eauto with omega; []. + push_Zmod; erewrite eval_sub by (rewrite <- ?m_enc_correct_montgomery; eauto with omega); pull_Zmod; rewrite <- ?m_enc_correct_montgomery. + break_innermost_match; push_Zmod; pull_Zmod; autorewrite with zsimplify_const; apply f_equal2; nia. + Qed. + + Lemma oppmod_correct + : (forall a (_ : valid a), eval (from_montgomery_mod (oppmod a)) mod m + = (-eval (from_montgomery_mod a)) mod m) + /\ (forall a (_ : valid a), valid (oppmod a)). + Proof. + repeat apply conj; intros; + push_Zmod; rewrite ?eval_from_montgomery_mod; pull_Zmod; repeat apply conj; + cbv [valid oppmod] in *; destruct_head'_and; auto; + try rewrite m_enc_correct_montgomery; + try (eapply small_opp || eapply opp_bound); rewrite <- ?m_enc_correct_montgomery; eauto with omega; []. + push_Zmod; erewrite eval_opp by (rewrite <- ?m_enc_correct_montgomery; eauto with omega); pull_Zmod; rewrite <- ?m_enc_correct_montgomery. + break_innermost_match; push_Zmod; pull_Zmod; autorewrite with zsimplify_const; apply f_equal2; nia. + Qed. + + Lemma nonzeromod_correct + : (forall a (_ : valid a), (nonzeromod a = 0) <-> ((eval (from_montgomery_mod a)) mod m = 0)). + Proof. + intros a Ha; rewrite eval_from_montgomery_mod by assumption. + cbv [nonzeromod valid] in *; destruct_head'_and. + rewrite eval_nonzero; try eassumption; [ | subst r; apply conj; try eassumption; omega.. ]. + split; intro H'; [ rewrite H'; autorewrite with zsimplify_const; reflexivity | ]. + assert (H'' : ((eval a * r'^n) * r^n) mod m = 0) + by (revert H'; push_Zmod; intro H'; rewrite H'; autorewrite with zsimplify_const; reflexivity). + rewrite <- Z.mul_assoc in H''. + autorewrite with pull_Zpow push_Zmod in H''. + rewrite (Z.mul_comm r' r), r'_correct in H''. + autorewrite with zsimplify_const pull_Zmod in H''; [ | lia.. ]. + clear H'. + generalize dependent (eval a); clear. + intros z ???. + assert (z / m = 0) by (Z.div_mod_to_quot_rem; nia). + Z.div_mod_to_quot_rem; nia. + Qed. + + Lemma to_bytesmod_correct + : (forall a (_ : valid a), Positional.eval (UniformWeight.uweight 8) (bytes_n bitwidth 1 n) (to_bytesmod a) + = eval a mod m) + /\ (forall a (_ : valid a), to_bytesmod a = Rows.partition (UniformWeight.uweight 8) (bytes_n bitwidth 1 n) (eval a mod m)). + Proof. + generalize (@length_small bitwidth n); + cbv [valid small to_bytesmod eval]; split; intros; (etransitivity; [ apply eval_to_bytesmod | ]); + fold weight in *; fold (UniformWeight.uweight 8) in *; subst r; + try solve [ intuition eauto with omega ]. + all: repeat first [ rewrite UniformWeight.uweight_eq_alt by omega + | omega + | reflexivity + | progress Z.rewrite_mod_small ]. + Qed. + End modops. +End WordByWordMontgomery. diff --git a/src/Experiments/NewPipeline/CLI.v b/src/Experiments/NewPipeline/CLI.v index 79189637b..3d219049f 100644 --- a/src/Experiments/NewPipeline/CLI.v +++ b/src/Experiments/NewPipeline/CLI.v @@ -204,6 +204,107 @@ Module ForExtraction. end. End UnsaturatedSolinas. + Module WordByWordMontgomery. + Definition PipelineLines + (curve_description : string) + (s : string) + (c : string) + (machine_wordsize : string) + (requests : list string) + : list (string * Pipeline.ErrorT (list string)) + list string + := let prefix := ("fiat_" ++ curve_description ++ "_")%string in + let str_machine_wordsize := machine_wordsize in + let str_c := c in + let str_s := s in + let machine_wordsize := parse_machine_wordsize machine_wordsize in + let show_requests := match requests with nil => "(all)" | _ => String.concat ", " requests end in + match parse_s s, parse_c c with + | None, None + => inr ["Could not parse s (" ++ s ++ ") nor c (" ++ c ++ ")"] + | None, _ + => inr ["Could not parse s (" ++ s ++ ")"] + | _, None + => inr ["Could not parse c (" ++ c ++ ")"] + | Some s, Some c + => let '(res, types_used) + := WordByWordMontgomery.Synthesize s c machine_wordsize prefix requests in + let header := + ((["/* Autogenerated */"; + "/* curve description: " ++ curve_description ++ " */"; + "/* requested operations: " ++ show_requests ++ " */"; + "/* s = " ++ Hex.show_Z false s ++ " (from """ ++ str_s ++ """) */"; + "/* c = " ++ show false c ++ " (from """ ++ str_c ++ """) */"; + "/* machine_wordsize = " ++ show false machine_wordsize ++ " (from """ ++ str_machine_wordsize ++ """) */"; + "/* */"; + "/* NOTE: In addition to the bounds specified above each function, all */"; + "/* functions synthesized for this Montgomery arithmetic require the */"; + "/* input to be strictly less than the prime modulus (s-c), and also */"; + "/* require the input to be in the unique saturated representation. */"; + "/* All functions also ensure that these two properties are true of */"; + "/* return values. */"; + ""]%string) + ++ ToString.C.String.typedef_header prefix types_used + ++ [""])%list in + inl + ([("check_args" ++ NewLine ++ String.concat NewLine header, + WordByWordMontgomery.check_args + s c machine_wordsize + (ErrorT.Success header))%string] + ++ res)%list + end. + + Definition ProcessedLines + (curve_description : string) + (s : string) + (c : string) + (machine_wordsize : string) + (requests : list string) + : list string + list string + := match CollectErrors (PipelineLines curve_description s c machine_wordsize requests) with + | inl ls + => inl + (List.map (fun s => String.concat NewLine s ++ NewLine ++ NewLine) + ls) + | inr nil => inr nil + | inr (l :: ls) + => inr (l ++ (List.flat_map + (fun e => NewLine :: e) + ls))%list + end. + + Definition Pipeline + {A} + (curve_description : string) + (s : string) + (c : string) + (machine_wordsize : string) + (requests : list string) + (success : list string -> A) + (error : list string -> A) + : A + := match ProcessedLines curve_description s c machine_wordsize requests with + | inl s => success s + | inr s => error s + end. + + Definition PipelineMain + {A} + (argv : list string) + (success : list string -> A) + (error : list string -> A) + : A + := match argv with + | _::curve_description::s::c::machine_wordsize::requests + => Pipeline + curve_description s c machine_wordsize requests + success + error + | nil => error ["empty argv"] + | prog::args + => error ["Expected arguments curve_description, s, c, machine_wordsize, [function_to_synthesize*] got " ++ show false (List.length args) ++ " arguments in " ++ prog] + end. + End WordByWordMontgomery. + Module SaturatedSolinas. Definition PipelineLines (curve_description : string) diff --git a/src/Experiments/NewPipeline/CStringification.v b/src/Experiments/NewPipeline/CStringification.v index 5f4f78243..f107a3ddd 100644 --- a/src/Experiments/NewPipeline/CStringification.v +++ b/src/Experiments/NewPipeline/CStringification.v @@ -1092,7 +1092,17 @@ Module Compilers. => fun rout '(e, r) '(offset, roffset) => let rin := option_map integer_promote_type r in match invert_literal offset with - | Some offset => ret (cast_down_if_needed rout (Z_shiftr offset @@ e, rin)) + | Some offset + => (** N.B. We must cast the expression up to a + large enough type to fit 2^offset + (importantly, not just 2^offset-1), + because C considers it to be undefined + behavior to shift >= width of the type. + We should probably figure out how to not + generate these things in the first + place... *) + let '(e', rin') := Zcast_up_if_needed (Some (int.of_zrange_relaxed r[0~>2^offset]%zrange)) (e, rin) in + ret (cast_down_if_needed rout (Z_shiftr offset @@ e', rin')) | None => inr ["Invalid right-shift by a non-literal"]%string end | ident.Z_shiftl @@ -1100,8 +1110,21 @@ Module Compilers. => let rin := option_map integer_promote_type r in match invert_literal offset with | Some offset - => let '(e', rin') := cast_up_if_needed rout (e, rin) in - ret (cast_down_if_needed rout (Z_shiftl offset @@ e', rin')) + => (** N.B. We must cast the expression up to a + large enough type to fit 2^offset + (importantly, not just 2^offset-1), + because C considers it to be undefined + behavior to shift >= width of the type. + We should probably figure out how to not + generate these things in the first + place... *) + let rpre_out := int.of_zrange_relaxed r[0~>2^offset]%zrange in + let rpre_out := match rout with + | Some rout => Some (ToString.C.int.union rout rpre_out) + | None => Some rpre_out + end in + let '(e', rin') := Zcast_up_if_needed rpre_out (e, rin) in + ret (cast_down_if_needed rout (Z_shiftl offset @@ e', rin')) | None => inr ["Invalid left-shift by a non-literal"]%string end | ident.Z_bneg @@ -1442,16 +1465,19 @@ Module Compilers. else inr ["Final bounds check failed on " ++ descr ++ " " ++ show false idc ++ "; expected an unsigned " ++ decimal_string_of_Z s ++ "-bit number (" ++ show false (int.of_zrange_relaxed r[0~>2^s-1]) ++ "), but found a " ++ show false ty ++ "."]%string end. + Let round_up_to_split_type (lgs : Z) (t : option int.type) : option int.type + := option_map (int.union (int.of_zrange_relaxed r[0~>2^lgs-1])) t. + Let recognize_3arg_2ref_ident (do_bounds_check : bool) (t:=(base.type.Z -> base.type.Z -> base.type.Z -> base.type.Z * base.type.Z)%etype) (idc : ident.ident t) (rout : option int.type * option int.type) (args : type.for_each_lhs_of_arrow (fun t => @Compilers.expr.expr base.type ident.ident var_data t * (arith_expr type.Z * option int.type))%type t) - : ErrT (arith_expr (type.Zptr * type.Zptr) -> expr) + : ErrT ((option int.type * option int.type) * (arith_expr (type.Zptr * type.Zptr) -> expr)) := let _ := @PHOAS.expr.partially_show_expr in let '((s, _), ((e1v, (e1, r1)), ((e2v, (e2, r2)), tt))) := args in - match (s <- invert_Literal s; maybe_log2 s)%option, idc return ErrT (arith_expr (type.Zptr * type.Zptr) -> expr) + match (s <- invert_Literal s; maybe_log2 s)%option, idc return ErrT ((option int.type * option int.type) * (arith_expr (type.Zptr * type.Zptr) -> expr)) with | Some s, ident.Z_mul_split => (_ ,, _ ,, _ ,, _ @@ -1459,7 +1485,8 @@ Module Compilers. bounds_check do_bounds_check "second argument to" idc s e2v r2, bounds_check do_bounds_check "first return value of" idc s e2v (fst rout), bounds_check do_bounds_check "second return value of" idc s e2v (snd rout); - inl (fun retptr => [Call (Z_mul_split s @@ (retptr, (e1, e2)))%Cexpr])) + inl ((round_up_to_split_type s (fst rout), round_up_to_split_type s (snd rout)), + fun retptr => [Call (Z_mul_split s @@ (retptr, (e1, e2)))%Cexpr])) | Some s, ident.Z_add_get_carry as idc | Some s, ident.Z_sub_get_borrow as idc => let idc' : ident _ _ := invert_Some match idc with @@ -1472,7 +1499,8 @@ Module Compilers. bounds_check do_bounds_check "second argument to" idc s e2v r2, bounds_check do_bounds_check "first return value of" idc s e2v (fst rout), bounds_check do_bounds_check "second return value of" idc 1 (* boolean carry/borrow *) e2v (snd rout); - inl (fun retptr => [Call (idc' @@ (retptr, (literal 0 @@ TT, e1, e2)))%Cexpr])) + inl ((round_up_to_split_type s (fst rout), snd rout), + fun retptr => [Call (idc' @@ (retptr, (literal 0 @@ TT, e1, e2)))%Cexpr])) | Some _, _ => inr ["Unrecognized identifier when attempting to construct an assignment with 2 arguments: " ++ show true idc]%string | None, _ => inr ["Expression is not a literal power of two of type ℤ: " ++ show true s ++ " (when trying to parse the first argument of " ++ show true idc ++ ")"]%string end. @@ -1483,10 +1511,10 @@ Module Compilers. (idc : ident.ident t) (rout : option int.type * option int.type) (args : type.for_each_lhs_of_arrow (fun t => @Compilers.expr.expr base.type ident.ident var_data t * (arith_expr type.Z * option int.type))%type t) - : ErrT (arith_expr (type.Zptr * type.Zptr) -> expr) + : ErrT ((option int.type * option int.type) * (arith_expr (type.Zptr * type.Zptr) -> expr)) := let _ := @PHOAS.expr.partially_show_expr in let '((s, _), ((e1v, (e1, r1)), ((e2v, (e2, r2)), ((e3v, (e3, r3)), tt)))) := args in - match (s <- invert_Literal s; maybe_log2 s)%option, idc return ErrT (arith_expr (type.Zptr * type.Zptr) -> expr) + match (s <- invert_Literal s; maybe_log2 s)%option, idc return ErrT ((option int.type * option int.type) * (arith_expr (type.Zptr * type.Zptr) -> expr)) with | Some s, ident.Z_add_with_get_carry as idc | Some s, ident.Z_sub_with_get_borrow as idc @@ -1501,7 +1529,8 @@ Module Compilers. bounds_check do_bounds_check "third argument to" idc s e2v r2, bounds_check do_bounds_check "first return value of" idc s e2v (fst rout), bounds_check do_bounds_check "second (carry) return value of" idc 1 (* boolean carry/borrow *) e2v (snd rout)); - inl (fun retptr => [Call (idc' @@ (retptr, (e1, e2, e3)))%Cexpr])) + inl ((round_up_to_split_type s (fst rout), snd rout), + fun retptr => [Call (idc' @@ (retptr, (e1, e2, e3)))%Cexpr])) | Some _, _ => inr ["Unrecognized identifier when attempting to construct an assignment with 2 arguments: " ++ show true idc]%string | None, _ => inr ["Expression is not a literal power of two of type ℤ: " ++ show true s ++ " (when trying to parse the first argument of " ++ show true idc ++ ")"]%string end. @@ -1512,7 +1541,7 @@ Module Compilers. (idc : ident.ident t) (rout : option int.type * option int.type) (args : type.for_each_lhs_of_arrow (fun t => @Compilers.expr.expr base.type ident.ident var_data t * (arith_expr type.Z * option int.type))%type t), - ErrT (arith_expr (type.Zptr * type.Zptr) -> expr) + ErrT ((option int.type * option int.type) * (arith_expr (type.Zptr * type.Zptr) -> expr)) := match t with | (type.base base.type.Z -> type.base base.type.Z -> type.base base.type.Z -> type.base (base.type.Z * base.type.Z))%etype => recognize_3arg_2ref_ident @@ -1585,7 +1614,8 @@ Module Compilers. match invert_AppIdent_curried e with | Some (existT t (idc, args)) => args <- arith_expr_of_PHOAS_args args; - idce <- recognize_2ref_ident do_bounds_check idc (rout1, rout2) args; + idce <- recognize_2ref_ident do_bounds_check idc (rout1, rout2) args; + let '((rout1, rout2), idce) := idce in v1,, v2 <- (declare_name (show false idc) count make_name rout1, declare_name (show false idc) (Pos.succ count) make_name rout2); let '(decls1, n1, retv1) := v1 in @@ -1638,7 +1668,7 @@ Module Compilers. (make_name : positive -> option string) (v : var_data d) : ErrT expr - := Eval cbv beta iota delta [bind2_err bind3_err bind4_err bind5_err recognize_1ref_ident recognize_3arg_2ref_ident recognize_4arg_2ref_ident recognize_2ref_ident make_assign_arg_1ref_opt make_assign_arg_2ref make_assign_arg_ref make_uniform_assign_expr_of_PHOAS make_uniform_assign_expr_of_PHOAS] in + := Eval cbv beta iota delta [bind2_err bind3_err bind4_err bind5_err recognize_1ref_ident recognize_3arg_2ref_ident recognize_4arg_2ref_ident recognize_2ref_ident make_assign_arg_1ref_opt make_assign_arg_2ref make_assign_arg_ref make_uniform_assign_expr_of_PHOAS make_uniform_assign_expr_of_PHOAS round_up_to_split_type] in match type.try_transport base.try_make_transport_cps _ _ s' e1 with | Some e1 => make_uniform_assign_expr_of_PHOAS do_bounds_check e1 e2 count make_name v | None => inr [report_type_mismatch s' s] diff --git a/src/Experiments/NewPipeline/CompilersTestCases.v b/src/Experiments/NewPipeline/CompilersTestCases.v index 0fa697fbe..3d8204fbf 100644 --- a/src/Experiments/NewPipeline/CompilersTestCases.v +++ b/src/Experiments/NewPipeline/CompilersTestCases.v @@ -43,21 +43,21 @@ Module testrewrite. Import expr. Import ident. - Eval compute in RewriteRules.Rewrite (fun var => + Eval compute in RewriteRules.RewriteNBE (fun var => (#ident.fst @ (expr_let x := ##10 in ($x, $x)))%expr). Notation "x + y" := (@expr.Ident base.type ident _ _ ident.Z_add @ x @ y)%expr : expr_scope. - Eval compute in RewriteRules.Rewrite (fun var => + Eval compute in RewriteRules.RewriteNBE (fun var => ((\ x , expr_let y := ##5 in #ident.fst @ $x + (#ident.fst @ $x + ($y + $y))) @ (##1, ##1))%expr). - Eval compute in RewriteRules.Rewrite (fun var => + Eval compute in RewriteRules.RewriteNBE (fun var => ((\ x , expr_let y := ##5 in $y + ($y + (#ident.fst @ $x + #ident.snd @ $x))) @ (##1, ##7))%expr). - Eval cbv in partial.eval_with_bound (RewriteRules.Rewrite (fun var => + Eval cbv in partial.eval_with_bound (RewriteRules.RewriteNBE (fun var => (\z , ((\ x , expr_let y := ##5 in $y + ($z + (#ident.fst @ $x + #ident.snd @ $x))) @ (##1, ##7)))%expr) _) (Some r[0~>100]%zrange, tt). diff --git a/src/Experiments/NewPipeline/ExtractionHaskell/word_by_word_montgomery.v b/src/Experiments/NewPipeline/ExtractionHaskell/word_by_word_montgomery.v new file mode 100644 index 000000000..5ac65a524 --- /dev/null +++ b/src/Experiments/NewPipeline/ExtractionHaskell/word_by_word_montgomery.v @@ -0,0 +1,4 @@ +Require Import Crypto.Experiments.NewPipeline.StandaloneHaskellMain. + +(*Redirect "/tmp/word_by_word_montgomery.hs" *)Recursive Extraction WordByWordMontgomery.main. +(* cat /tmp/solinas.hs.out | sed -f haskell.sed > ../../solinas.hs *) diff --git a/src/Experiments/NewPipeline/ExtractionOCaml/word_by_word_montgomery.v b/src/Experiments/NewPipeline/ExtractionOCaml/word_by_word_montgomery.v new file mode 100644 index 000000000..083e53a30 --- /dev/null +++ b/src/Experiments/NewPipeline/ExtractionOCaml/word_by_word_montgomery.v @@ -0,0 +1,3 @@ +Require Import Crypto.Experiments.NewPipeline.StandaloneOCamlMain. + +(*Redirect "/tmp/word_by_word_montgomery.ml"*) Recursive Extraction WordByWordMontgomery.main. diff --git a/src/Experiments/NewPipeline/Language.v b/src/Experiments/NewPipeline/Language.v index 971ae81ef..b3a7ea235 100644 --- a/src/Experiments/NewPipeline/Language.v +++ b/src/Experiments/NewPipeline/Language.v @@ -524,10 +524,17 @@ Module Compilers. | match ?x with nil => ?N | cons a b => @?C a b end => let T := type of term in reify_rec (@list_case _ (fun _ => T) N C x) - | let x := ?a in @?b x + | let x := ?a in ?b => let A := type of a in - let B := lazymatch type of b with forall x, @?B x => B end in - reify_rec (b a) (*(@Let_In A B a b)*) + let T := type of term in + let rec_val := match constr:(Set) with + | _ => let v := constr:((fun x : A => b) a) in + let __ := type of v in (* ensure that the abstraction is well-typed, i.e., that we're not relying on the value of the let to well-type the body *) + v + | _ => constr:(match a return T with x => b end) (* if we do rely on the body of [x] to well-type [b], then just inline it *) + end in + (*let B := lazymatch type of b with forall x, @?B x => B end in*) + reify_rec rec_val (*(@Let_In A B a b)*) | @Let_In ?A ?B ?a ?b => let ra := reify_rec a in let rb := reify_rec b in @@ -1047,36 +1054,60 @@ Module Compilers. => let rA := base.reify A in let rB := base.reify B in then_tac (@ident.pair rA rB) - | @Datatypes.bool_rect (fun _ => ?T) ?Ptrue ?Pfalse - => reify_rec (@Thunked.bool_rect T (fun _ : Datatypes.unit => Ptrue) (fun _ : Datatypes.unit => Pfalse)) + | @Datatypes.bool_rect ?T0 ?Ptrue ?Pfalse + => lazymatch (eval cbv beta in T0) with + | fun _ => ?T => reify_rec (@Thunked.bool_rect T (fun _ : Datatypes.unit => Ptrue) (fun _ : Datatypes.unit => Pfalse)) + | T0 => else_tac () + | ?T' => reify_rec (@Datatypes.bool_rect T' Ptrue Pfalse) + end | @Thunked.bool_rect ?T => let rT := base.reify T in then_tac (@ident.bool_rect rT) - | @Datatypes.prod_rect ?A ?B (fun _ => ?T) - => let rA := base.reify A in - let rB := base.reify B in - let rT := base.reify T in - then_tac (@ident.prod_rect rA rB rT) - | @Datatypes.nat_rect (fun _ => ?T) ?P0 - => lazymatch T with - | _ -> _ => else_tac () - | _ => reify_rec (@Thunked.nat_rect T (fun _ : Datatypes.unit => P0)) + | @Datatypes.prod_rect ?A ?B ?T0 + => lazymatch (eval cbv beta in T0) with + | fun _ => ?T + => let rA := base.reify A in + let rB := base.reify B in + let rT := base.reify T in + then_tac (@ident.prod_rect rA rB rT) + | T0 => else_tac () + | ?T' => reify_rec (@Datatypes.prod_rect A B T') + end + | @Datatypes.nat_rect ?T0 ?P0 + => lazymatch (eval cbv beta in T0) with + | fun _ => _ -> _ => else_tac () + | fun _ => ?T => reify_rec (@Thunked.nat_rect T (fun _ : Datatypes.unit => P0)) + | T0 => else_tac () + | ?T' => reify_rec (@Datatypes.nat_rect T' P0) end - | @Datatypes.nat_rect (fun _ => ?P -> ?Q) - => let rP := base.reify P in - let rQ := base.reify Q in - then_tac (@ident.nat_rect_arrow rP rQ) + | @Datatypes.nat_rect ?T0 + => lazymatch (eval cbv beta in T0) with + | (fun _ => ?P -> ?Q) + => let rP := base.reify P in + let rQ := base.reify Q in + then_tac (@ident.nat_rect_arrow rP rQ) + | T0 => else_tac () + | ?T' => reify_rec (@Datatypes.nat_rect T') + end | @Thunked.nat_rect ?T => let rT := base.reify T in then_tac (@ident.nat_rect rT) - | @Datatypes.list_rect ?A (fun _ => ?T) ?Pnil - => reify_rec (@Thunked.list_rect A T (fun _ : Datatypes.unit => Pnil)) + | @Datatypes.list_rect ?A ?T0 ?Pnil + => lazymatch (eval cbv beta in T0) with + | fun _ => ?T => reify_rec (@Thunked.list_rect A T (fun _ : Datatypes.unit => Pnil)) + | T0 => else_tac () + | ?T' => reify_rec (@Datatypes.list_rect A T' Pnil) + end | @Thunked.list_rect ?A ?T => let rA := base.reify A in let rT := base.reify T in then_tac (@ident.list_rect rA rT) - | @ListUtil.list_case ?A (fun _ => ?T) ?Pnil - => reify_rec (@Thunked.list_case A T (fun _ : Datatypes.unit => Pnil)) + | @ListUtil.list_case ?A ?T0 ?Pnil + => lazymatch (eval cbv beta in T0) with + | fun _ => ?T => reify_rec (@Thunked.list_case A T (fun _ : Datatypes.unit => Pnil)) + | T0 => else_tac () + | ?T' => reify_rec (@ListUtil.list_case A T' Pnil) + end | @Thunked.list_case ?A ?T => let rA := base.reify A in let rT := base.reify T in diff --git a/src/Experiments/NewPipeline/Rewriter.v b/src/Experiments/NewPipeline/Rewriter.v index 599a7d34e..f9f6e22ac 100644 --- a/src/Experiments/NewPipeline/Rewriter.v +++ b/src/Experiments/NewPipeline/Rewriter.v @@ -1153,7 +1153,7 @@ In the RHS, the follow notation applies: If stuck, email Jason. *) - Definition rewrite_rules : rewrite_rulesT + Definition nbe_rewrite_rules : rewrite_rulesT := Eval cbn [Make.interp_rewrite_rules List.app] in Make.interp_rewrite_rules ++ [ @@ -1275,131 +1275,219 @@ In the RHS, the follow notation applies: (fun x => x <-- x; f x) (List.map UnderLets.Base ls)); reify_list retv)) - ; make_rewrite (#?ℤ + ??{ℤ}) (fun z v => v when Z.eqb z 0) - ; make_rewrite (??{ℤ} + #?ℤ ) (fun v z => v when Z.eqb z 0) - ; make_rewrite (#?ℤ + (-??{ℤ})) (fun z v => ##z - v when Z.gtb z 0) - ; make_rewrite ((-??{ℤ}) + #?ℤ ) (fun v z => ##z - v when Z.gtb z 0) - ; make_rewrite (#?ℤ + (-??{ℤ})) (fun z v => -(##((-z)%Z) + v) when Z.ltb z 0) - ; make_rewrite ((-??{ℤ}) + #?ℤ ) (fun v z => -(v + ##((-z)%Z)) when Z.ltb z 0) - ; make_rewrite ((-??{ℤ}) + (-??{ℤ})) (fun x y => -(x + y)) - ; make_rewrite ((-??{ℤ}) + ??{ℤ} ) (fun x y => y - x) - ; make_rewrite ( ??{ℤ} + (-??{ℤ})) (fun x y => x - y) - - ; make_rewrite (#?ℤ - (-??{ℤ})) (fun z v => v when Z.eqb z 0) - ; make_rewrite (#?ℤ - ??{ℤ} ) (fun z v => -v when Z.eqb z 0) - ; make_rewrite (??{ℤ} - #?ℤ ) (fun v z => v when Z.eqb z 0) - ; make_rewrite (#?ℤ - (-??{ℤ})) (fun z v => ##z + v when Z.gtb z 0) - ; make_rewrite (#?ℤ - (-??{ℤ})) (fun z v => v - ##((-z)%Z) when Z.ltb z 0) - ; make_rewrite (#?ℤ - ??{ℤ} ) (fun z v => -(##((-z)%Z) + v) when Z.ltb z 0) - ; make_rewrite ((-??{ℤ}) - #?ℤ ) (fun v z => -(v + ##((-z)%Z)) when Z.gtb z 0) - ; make_rewrite ((-??{ℤ}) - #?ℤ ) (fun v z => ##((-z)%Z) - v when Z.ltb z 0) - ; make_rewrite ( ??{ℤ} - #?ℤ ) (fun v z => v + ##((-z)%Z) when Z.ltb z 0) - ; make_rewrite ((-??{ℤ}) - (-??{ℤ})) (fun x y => y - x) - ; make_rewrite ((-??{ℤ}) - ??{ℤ} ) (fun x y => -(x + y)) - ; make_rewrite ( ??{ℤ} - (-??{ℤ})) (fun x y => x + y) - - ; make_rewrite (#?ℤ * ??{ℤ}) (fun z v => ##0 when Z.eqb z 0) - ; make_rewrite (??{ℤ} * #?ℤ ) (fun v z => ##0 when Z.eqb z 0) - ; make_rewrite (#?ℤ * ??{ℤ}) (fun z v => v when Z.eqb z 1) - ; make_rewrite (??{ℤ} * #?ℤ ) (fun v z => v when Z.eqb z 1) - ; make_rewrite (#?ℤ * (-??{ℤ})) (fun z v => v when Z.eqb z (-1)) - ; make_rewrite ((-??{ℤ}) * #?ℤ ) (fun v z => v when Z.eqb z (-1)) - ; make_rewrite (#?ℤ * ??{ℤ} ) (fun z v => -v when Z.eqb z (-1)) - ; make_rewrite (??{ℤ} * #?ℤ ) (fun v z => -v when Z.eqb z (-1)) - ; make_rewrite (#?ℤ * ??{ℤ} ) (fun z v => -(##((-z)%Z) * v) when Z.ltb z 0) - ; make_rewrite (??{ℤ} * #?ℤ ) (fun v z => -(v * ##((-z)%Z)) when Z.ltb z 0) - ; make_rewrite ((-??{ℤ}) * (-??{ℤ})) (fun x y => x * y) - ; make_rewrite ((-??{ℤ}) * ??{ℤ} ) (fun x y => -(x * y)) - ; make_rewrite ( ??{ℤ} * (-??{ℤ})) (fun x y => -(x * y)) - - ; make_rewrite (??{ℤ} * #?ℤ) (fun x y => x << ##(Z.log2 y) when (y =? (2^Z.log2 y)) && (negb (y =? 2))) - ; make_rewrite (#?ℤ * ??{ℤ}) (fun y x => x << ##(Z.log2 y) when (y =? (2^Z.log2 y)) && (negb (y =? 2))) - ; make_rewrite (??{ℤ} / #?ℤ) (fun x y => x >> ##(Z.log2 y) when Z.eqb y (2^Z.log2 y)) - ; make_rewrite (??{ℤ} mod #?ℤ) (fun x y => x &' ##(y-1)%Z when Z.eqb y (2^Z.log2 y)) - ; make_rewrite (-(-??{ℤ})) (fun v => v) - - ; make_rewrite (#pident.Z_mul_split @ #?ℤ @ #?ℤ @ ??{ℤ}) (fun s xx y => (##0, ##0)%Z when Z.eqb xx 0) - ; make_rewrite (#pident.Z_mul_split @ #?ℤ @ ??{ℤ} @ #?ℤ) (fun s y xx => (##0, ##0)%Z when Z.eqb xx 0) - ; make_rewrite (#pident.Z_mul_split @ #?ℤ @ #?ℤ @ ??{ℤ}) (fun s xx y => (y, ##0)%Z when Z.eqb xx 1) - ; make_rewrite (#pident.Z_mul_split @ #?ℤ @ ??{ℤ} @ #?ℤ) (fun s y xx => (y, ##0)%Z when Z.eqb xx 1) - ; make_rewrite (#pident.Z_mul_split @ #?ℤ @ #?ℤ @ ??{ℤ}) (fun s xx y => (-y, ##0%Z) when Z.eqb xx (-1)) - ; make_rewrite (#pident.Z_mul_split @ #?ℤ @ ??{ℤ} @ #?ℤ) (fun s y xx => (-y, ##0%Z) when Z.eqb xx (-1)) - - ; make_rewrite (#pident.Z_add_get_carry @ ??{ℤ} @ #?ℤ @ ??{ℤ}) (fun s xx y => (y, ##0) when xx =? 0) - ; make_rewrite (#pident.Z_add_get_carry @ ??{ℤ} @ ??{ℤ} @ #?ℤ) (fun s y xx => (y, ##0) when xx =? 0) - - ; make_rewrite (#pident.Z_add_with_carry @ #?ℤ @ ??{ℤ} @ ??{ℤ}) (fun cc x y => x + y when cc =? 0) - - ; make_rewrite - (#pident.Z_add_with_get_carry @ #?ℤ @ #?ℤ @ #?ℤ @ ??{ℤ}) (fun s cc xx y => (y, ##0) when (cc =? 0) && (xx =? 0)) - ; make_rewrite - (#pident.Z_add_with_get_carry @ #?ℤ @ #?ℤ @ ??{ℤ} @ #?ℤ) (fun s cc y xx => (y, ##0) when (cc =? 0) && (xx =? 0)) - ; make_rewrite (* carry = 0: ADC x y -> ADD x y *) - (#pident.Z_add_with_get_carry @ ??{ℤ} @ #?ℤ @ ??{ℤ} @ ??{ℤ}) - (fun s cc x y => #ident.Z_add_get_carry @ s @ x @ y when cc =? 0) - ; make_rewrite (* ADC 0 0 -> (ADX 0 0, 0) *) - (#pident.Z_add_with_get_carry @ ??{ℤ} @ ??{ℤ} @ #?ℤ @ #?ℤ) - (fun s c xx yy => #ident.Z_add_with_carry @ s @ ##xx @ ##yy when (xx =? 0) && (yy =? 0)) - - ; make_rewrite - (#pident.Z_add_get_carry @ ??{ℤ} @ (-??{ℤ}) @ ??{ℤ}) - (fun s y x => ret (UnderLets.UnderLet - (#ident.Z_sub_get_borrow @ s @ x @ y) - (fun vc => UnderLets.Base (#ident.fst @ $vc, -(#ident.snd @ $vc))))) - ; make_rewrite - (#pident.Z_add_get_carry @ ??{ℤ} @ ??{ℤ} @ (-??{ℤ})) - (fun s x y => ret (UnderLets.UnderLet - (#ident.Z_sub_get_borrow @ s @ x @ y) - (fun vc => UnderLets.Base (#ident.fst @ $vc, -(#ident.snd @ $vc))))) - ; make_rewrite - (#pident.Z_add_get_carry @ ??{ℤ} @ #?ℤ @ ??{ℤ}) - (fun s yy x => ret (UnderLets.UnderLet - (#ident.Z_sub_get_borrow @ s @ x @ ##(-yy)%Z) - (fun vc => UnderLets.Base (#ident.fst @ $vc, -(#ident.snd @ $vc)))) - when yy <=? 0) - ; make_rewrite - (#pident.Z_add_get_carry @ ??{ℤ} @ ??{ℤ} @ #?ℤ) - (fun s x yy => ret (UnderLets.UnderLet - (#ident.Z_sub_get_borrow @ s @ x @ ##(-yy)%Z) - (fun vc => UnderLets.Base (#ident.fst @ $vc, -(#ident.snd @ $vc)))) - when yy <=? 0) - - - ; make_rewrite - (#pident.Z_add_with_get_carry @ ??{ℤ} @ (-??{ℤ}) @ (-??{ℤ}) @ ??{ℤ}) - (fun s c y x => ret (UnderLets.UnderLet - (#ident.Z_sub_with_get_borrow @ s @ c @ x @ y) - (fun vc => UnderLets.Base (#ident.fst @ $vc, -(#ident.snd @ $vc))))) - ; make_rewrite - (#pident.Z_add_with_get_carry @ ??{ℤ} @ (-??{ℤ}) @ ??{ℤ} @ (-??{ℤ})) - (fun s c x y => ret (UnderLets.UnderLet - (#ident.Z_sub_with_get_borrow @ s @ c @ x @ y) - (fun vc => UnderLets.Base (#ident.fst @ $vc, -(#ident.snd @ $vc))))) - ; make_rewrite - (#pident.Z_add_with_get_carry @ ??{ℤ} @ (-??{ℤ}) @ #?ℤ @ ??{ℤ}) - (fun s c yy x => ret (UnderLets.UnderLet - (#ident.Z_sub_with_get_borrow @ s @ c @ x @ ##(-yy)%Z) - (fun vc => UnderLets.Base (#ident.fst @ $vc, -(#ident.snd @ $vc)))) - when yy <=? 0) - ; make_rewrite - (#pident.Z_add_with_get_carry @ ??{ℤ} @ (-??{ℤ}) @ ??{ℤ} @ #?ℤ) - (fun s c x yy => ret (UnderLets.UnderLet - (#ident.Z_sub_with_get_borrow @ s @ c @ x @ ##(-yy)%Z) - (fun vc => UnderLets.Base (#ident.fst @ $vc, -(#ident.snd @ $vc)))) - when yy <=? 0) - - - ; make_rewrite_step (* _step, so that if one of the arguments is concrete, we automatically get the rewrite rule for [Z_cast] applying to it *) - (#pident.Z_cast2 @ (??{ℤ}, ??{ℤ})) (fun r x y => (#(ident.Z_cast (fst r)) @ $x, #(ident.Z_cast (snd r)) @ $y)) - - ; make_rewrite (-??{ℤ}) (fun e => ret (UnderLets.UnderLet e (fun v => UnderLets.Base (-$v))) when negb (SubstVarLike.is_var_fst_snd_pair_opp e)) (* inline negation when the rewriter wouldn't already inline it *) ]%list%pattern%cps%option%under_lets%Z%bool. - Definition dtree' - := Eval compute in @compile_rewrites ident var pattern.ident pattern.ident.arg_types pattern.ident.ident_beq 100 rewrite_rules. - Definition dtree : decision_tree - := Eval compute in invert_Some dtree'. - Definition default_fuel := Eval compute in List.length rewrite_rules. + Definition arith_rewrite_rules : rewrite_rulesT + := [make_rewrite (#pident.fst @ (??, ??)) (fun _ x _ y => x) + ; make_rewrite (#pident.snd @ (??, ??)) (fun _ x _ y => y) + ; make_rewrite (#?ℤ + ??{ℤ}) (fun z v => v when Z.eqb z 0) + ; make_rewrite (??{ℤ} + #?ℤ ) (fun v z => v when Z.eqb z 0) + ; make_rewrite (#?ℤ + (-??{ℤ})) (fun z v => ##z - v when Z.gtb z 0) + ; make_rewrite ((-??{ℤ}) + #?ℤ ) (fun v z => ##z - v when Z.gtb z 0) + ; make_rewrite (#?ℤ + (-??{ℤ})) (fun z v => -(##((-z)%Z) + v) when Z.ltb z 0) + ; make_rewrite ((-??{ℤ}) + #?ℤ ) (fun v z => -(v + ##((-z)%Z)) when Z.ltb z 0) + ; make_rewrite ((-??{ℤ}) + (-??{ℤ})) (fun x y => -(x + y)) + ; make_rewrite ((-??{ℤ}) + ??{ℤ} ) (fun x y => y - x) + ; make_rewrite ( ??{ℤ} + (-??{ℤ})) (fun x y => x - y) + + ; make_rewrite (#?ℤ - (-??{ℤ})) (fun z v => v when Z.eqb z 0) + ; make_rewrite (#?ℤ - ??{ℤ} ) (fun z v => -v when Z.eqb z 0) + ; make_rewrite (??{ℤ} - #?ℤ ) (fun v z => v when Z.eqb z 0) + ; make_rewrite (#?ℤ - (-??{ℤ})) (fun z v => ##z + v when Z.gtb z 0) + ; make_rewrite (#?ℤ - (-??{ℤ})) (fun z v => v - ##((-z)%Z) when Z.ltb z 0) + ; make_rewrite (#?ℤ - ??{ℤ} ) (fun z v => -(##((-z)%Z) + v) when Z.ltb z 0) + ; make_rewrite ((-??{ℤ}) - #?ℤ ) (fun v z => -(v + ##((-z)%Z)) when Z.gtb z 0) + ; make_rewrite ((-??{ℤ}) - #?ℤ ) (fun v z => ##((-z)%Z) - v when Z.ltb z 0) + ; make_rewrite ( ??{ℤ} - #?ℤ ) (fun v z => v + ##((-z)%Z) when Z.ltb z 0) + ; make_rewrite ((-??{ℤ}) - (-??{ℤ})) (fun x y => y - x) + ; make_rewrite ((-??{ℤ}) - ??{ℤ} ) (fun x y => -(x + y)) + ; make_rewrite ( ??{ℤ} - (-??{ℤ})) (fun x y => x + y) + + ; make_rewrite (#?ℤ * ??{ℤ}) (fun z v => ##0 when Z.eqb z 0) + ; make_rewrite (??{ℤ} * #?ℤ ) (fun v z => ##0 when Z.eqb z 0) + ; make_rewrite (#?ℤ * ??{ℤ}) (fun z v => v when Z.eqb z 1) + ; make_rewrite (??{ℤ} * #?ℤ ) (fun v z => v when Z.eqb z 1) + ; make_rewrite (#?ℤ * (-??{ℤ})) (fun z v => v when Z.eqb z (-1)) + ; make_rewrite ((-??{ℤ}) * #?ℤ ) (fun v z => v when Z.eqb z (-1)) + ; make_rewrite (#?ℤ * ??{ℤ} ) (fun z v => -v when Z.eqb z (-1)) + ; make_rewrite (??{ℤ} * #?ℤ ) (fun v z => -v when Z.eqb z (-1)) + ; make_rewrite (#?ℤ * ??{ℤ} ) (fun z v => -(##((-z)%Z) * v) when Z.ltb z 0) + ; make_rewrite (??{ℤ} * #?ℤ ) (fun v z => -(v * ##((-z)%Z)) when Z.ltb z 0) + ; make_rewrite ((-??{ℤ}) * (-??{ℤ})) (fun x y => x * y) + ; make_rewrite ((-??{ℤ}) * ??{ℤ} ) (fun x y => -(x * y)) + ; make_rewrite ( ??{ℤ} * (-??{ℤ})) (fun x y => -(x * y)) + + ; make_rewrite (??{ℤ} &' #?ℤ) (fun x mask => ##(0)%Z when mask =? 0) + ; make_rewrite (#?ℤ &' ??{ℤ}) (fun mask x => ##(0)%Z when mask =? 0) + + ; make_rewrite (??{ℤ} * #?ℤ) (fun x y => x << ##(Z.log2 y) when (y =? (2^Z.log2 y)) && (negb (y =? 2))) + ; make_rewrite (#?ℤ * ??{ℤ}) (fun y x => x << ##(Z.log2 y) when (y =? (2^Z.log2 y)) && (negb (y =? 2))) + ; make_rewrite (??{ℤ} / #?ℤ) (fun x y => x when (y =? 1)) + ; make_rewrite (??{ℤ} mod #?ℤ) (fun x y => ##(0)%Z when (y =? 1)) + ; make_rewrite (??{ℤ} / #?ℤ) (fun x y => x >> ##(Z.log2 y) when (y =? (2^Z.log2 y))) + ; make_rewrite (??{ℤ} mod #?ℤ) (fun x y => x &' ##(y-1)%Z when (y =? (2^Z.log2 y))) + ; make_rewrite (-(-??{ℤ})) (fun v => v) + + ; make_rewrite (#pident.Z_mul_split @ #?ℤ @ #?ℤ @ ??{ℤ}) (fun s xx y => (##0, ##0)%Z when Z.eqb xx 0) + ; make_rewrite (#pident.Z_mul_split @ #?ℤ @ ??{ℤ} @ #?ℤ) (fun s y xx => (##0, ##0)%Z when Z.eqb xx 0) + ; make_rewrite (#pident.Z_mul_split @ #?ℤ @ #?ℤ @ ??{ℤ}) (fun s xx y => (y, ##0)%Z when Z.eqb xx 1) + ; make_rewrite (#pident.Z_mul_split @ #?ℤ @ ??{ℤ} @ #?ℤ) (fun s y xx => (y, ##0)%Z when Z.eqb xx 1) + ; make_rewrite (#pident.Z_mul_split @ #?ℤ @ #?ℤ @ ??{ℤ}) (fun s xx y => (-y, ##0%Z) when Z.eqb xx (-1)) + ; make_rewrite (#pident.Z_mul_split @ #?ℤ @ ??{ℤ} @ #?ℤ) (fun s y xx => (-y, ##0%Z) when Z.eqb xx (-1)) + + ; make_rewrite + (#pident.Z_add_get_carry @ ??{ℤ} @ (-??{ℤ}) @ ??{ℤ}) + (fun s y x => ret (UnderLets.UnderLet + (#ident.Z_sub_get_borrow @ s @ x @ y) + (fun vc => UnderLets.Base (#ident.fst @ $vc, -(#ident.snd @ $vc))))) + ; make_rewrite + (#pident.Z_add_get_carry @ ??{ℤ} @ ??{ℤ} @ (-??{ℤ})) + (fun s x y => ret (UnderLets.UnderLet + (#ident.Z_sub_get_borrow @ s @ x @ y) + (fun vc => UnderLets.Base (#ident.fst @ $vc, -(#ident.snd @ $vc))))) + ; make_rewrite + (#pident.Z_add_get_carry @ ??{ℤ} @ #?ℤ @ ??{ℤ}) + (fun s yy x => ret (UnderLets.UnderLet + (#ident.Z_sub_get_borrow @ s @ x @ ##(-yy)%Z) + (fun vc => UnderLets.Base (#ident.fst @ $vc, -(#ident.snd @ $vc)))) + when yy <? 0) + ; make_rewrite + (#pident.Z_add_get_carry @ ??{ℤ} @ ??{ℤ} @ #?ℤ) + (fun s x yy => ret (UnderLets.UnderLet + (#ident.Z_sub_get_borrow @ s @ x @ ##(-yy)%Z) + (fun vc => UnderLets.Base (#ident.fst @ $vc, -(#ident.snd @ $vc)))) + when yy <? 0) + + + ; make_rewrite + (#pident.Z_add_with_get_carry @ ??{ℤ} @ (-??{ℤ}) @ (-??{ℤ}) @ ??{ℤ}) + (fun s c y x => ret (UnderLets.UnderLet + (#ident.Z_sub_with_get_borrow @ s @ c @ x @ y) + (fun vc => UnderLets.Base (#ident.fst @ $vc, -(#ident.snd @ $vc))))) + ; make_rewrite + (#pident.Z_add_with_get_carry @ ??{ℤ} @ (-??{ℤ}) @ ??{ℤ} @ (-??{ℤ})) + (fun s c x y => ret (UnderLets.UnderLet + (#ident.Z_sub_with_get_borrow @ s @ c @ x @ y) + (fun vc => UnderLets.Base (#ident.fst @ $vc, -(#ident.snd @ $vc))))) + ; make_rewrite + (#pident.Z_add_with_get_carry @ ??{ℤ} @ #?ℤ @ (-??{ℤ}) @ ??{ℤ}) + (fun s cc y x => ret (UnderLets.UnderLet + (#ident.Z_sub_get_borrow @ s @ x @ y) + (fun vc => UnderLets.Base (#ident.fst @ $vc, -(#ident.snd @ $vc)))) + when cc =? 0) + ; make_rewrite + (#pident.Z_add_with_get_carry @ ??{ℤ} @ #?ℤ @ (-??{ℤ}) @ ??{ℤ}) + (fun s cc y x => ret (UnderLets.UnderLet + (#ident.Z_sub_with_get_borrow @ s @ ##(-cc)%Z @ x @ y) + (fun vc => UnderLets.Base (#ident.fst @ $vc, -(#ident.snd @ $vc)))) + when cc <? 0) + ; make_rewrite + (#pident.Z_add_with_get_carry @ ??{ℤ} @ #?ℤ @ ??{ℤ} @ (-??{ℤ})) + (fun s cc x y => ret (UnderLets.UnderLet + (#ident.Z_sub_get_borrow @ s @ x @ y) + (fun vc => UnderLets.Base (#ident.fst @ $vc, -(#ident.snd @ $vc)))) + when cc =? 0) + ; make_rewrite + (#pident.Z_add_with_get_carry @ ??{ℤ} @ #?ℤ @ ??{ℤ} @ (-??{ℤ})) + (fun s cc x y => ret (UnderLets.UnderLet + (#ident.Z_sub_with_get_borrow @ s @ ##(-cc)%Z @ x @ y) + (fun vc => UnderLets.Base (#ident.fst @ $vc, -(#ident.snd @ $vc)))) + when cc <? 0) + ; make_rewrite + (#pident.Z_add_with_get_carry @ ??{ℤ} @ (-??{ℤ}) @ #?ℤ @ ??{ℤ}) + (fun s c yy x => ret (UnderLets.UnderLet + (#ident.Z_sub_with_get_borrow @ s @ c @ x @ ##(-yy)%Z) + (fun vc => UnderLets.Base (#ident.fst @ $vc, -(#ident.snd @ $vc)))) + when yy <=? 0) + ; make_rewrite + (#pident.Z_add_with_get_carry @ ??{ℤ} @ (-??{ℤ}) @ ??{ℤ} @ #?ℤ) + (fun s c x yy => ret (UnderLets.UnderLet + (#ident.Z_sub_with_get_borrow @ s @ c @ x @ ##(-yy)%Z) + (fun vc => UnderLets.Base (#ident.fst @ $vc, -(#ident.snd @ $vc)))) + when yy <=? 0) + ; make_rewrite + (#pident.Z_add_with_get_carry @ ??{ℤ} @ #?ℤ @ #?ℤ @ ??{ℤ}) + (fun s cc yy x => ret (UnderLets.UnderLet + (#ident.Z_sub_with_get_borrow @ s @ ##(-cc)%Z @ x @ ##(-yy)%Z) + (fun vc => UnderLets.Base (#ident.fst @ $vc, -(#ident.snd @ $vc)))) + when (yy <=? 0) && (cc <=? 0) && ((yy + cc) <? 0)) (* at least one must be strictly negative *) + ; make_rewrite + (#pident.Z_add_with_get_carry @ ??{ℤ} @ #?ℤ @ ??{ℤ} @ #?ℤ) + (fun s cc x yy => ret (UnderLets.UnderLet + (#ident.Z_sub_with_get_borrow @ s @ ##(-cc)%Z @ x @ ##(-yy)%Z) + (fun vc => UnderLets.Base (#ident.fst @ $vc, -(#ident.snd @ $vc)))) + when (yy <=? 0) && (cc <=? 0) && ((yy + cc) <? 0)) (* at least one must be strictly negative *) + + + ; make_rewrite (#pident.Z_add_get_carry @ ??{ℤ} @ #?ℤ @ ??{ℤ}) (fun s xx y => (y, ##0) when xx =? 0) + ; make_rewrite (#pident.Z_add_get_carry @ ??{ℤ} @ ??{ℤ} @ #?ℤ) (fun s y xx => (y, ##0) when xx =? 0) + + ; make_rewrite (#pident.Z_add_with_carry @ #?ℤ @ ??{ℤ} @ ??{ℤ}) (fun cc x y => x + y when cc =? 0) + (*; make_rewrite_step (#pident.Z_add_with_carry @ ??{ℤ} @ ??{ℤ} @ ??{ℤ}) (fun x y z => $x + $y + $z)*) + + ; make_rewrite + (#pident.Z_add_with_get_carry @ #?ℤ @ #?ℤ @ #?ℤ @ ??{ℤ}) (fun s cc xx y => (y, ##0) when (cc =? 0) && (xx =? 0)) + ; make_rewrite + (#pident.Z_add_with_get_carry @ #?ℤ @ #?ℤ @ ??{ℤ} @ #?ℤ) (fun s cc y xx => (y, ##0) when (cc =? 0) && (xx =? 0)) + (*; make_rewrite + (#pident.Z_add_with_get_carry @ ??{ℤ} @ ??{ℤ} @ #?ℤ @ #?ℤ) (fun s c xx yy => (c, ##0) when (xx =? 0) && (yy =? 0))*) + ; make_rewrite (* carry = 0: ADC x y -> ADD x y *) + (#pident.Z_add_with_get_carry @ ??{ℤ} @ #?ℤ @ ??{ℤ} @ ??{ℤ}) + (fun s cc x y => ret (UnderLets.UnderLet + (#ident.Z_add_get_carry @ s @ x @ y) + (fun vc => UnderLets.Base (#ident.fst @ $vc, #ident.snd @ $vc))) + when cc =? 0) + ; make_rewrite (* ADC 0 0 -> (ADX 0 0, 0) *) (* except we don't do ADX, because C stringification doesn't handle it *) + (#pident.Z_add_with_get_carry @ ??{ℤ} @ ??{ℤ} @ #?ℤ @ #?ℤ) + (fun s c xx yy => ret (UnderLets.UnderLet + (#ident.Z_add_with_get_carry @ s @ c @ ##xx @ ##yy) + (fun vc => UnderLets.Base (#ident.fst @ $vc, ##0))) + when (xx =? 0) && (yy =? 0)) + + + (* let-bind any adc/sbb/mulx *) + ; make_rewrite + (#pident.Z_add_with_get_carry @ ??{ℤ} @ ??{ℤ} @ ??{ℤ} @ ??{ℤ}) + (fun s c x y => ret (UnderLets.UnderLet (#ident.Z_add_with_get_carry @ s @ c @ x @ y) + (fun vc => UnderLets.Base (#ident.fst @ $vc, #ident.snd @ $vc)))) + ; make_rewrite + (#pident.Z_add_with_carry @ ??{ℤ} @ ??{ℤ} @ ??{ℤ}) + (fun c x y => ret (UnderLets.UnderLet (#ident.Z_add_with_carry @ c @ x @ y) + (fun vc => UnderLets.Base ($vc)))) + ; make_rewrite + (#pident.Z_add_get_carry @ ??{ℤ} @ ??{ℤ} @ ??{ℤ}) + (fun s x y => ret (UnderLets.UnderLet (#ident.Z_add_get_carry @ s @ x @ y) + (fun vc => UnderLets.Base (#ident.fst @ $vc, #ident.snd @ $vc)))) + ; make_rewrite + (#pident.Z_sub_with_get_borrow @ ??{ℤ} @ ??{ℤ} @ ??{ℤ} @ ??{ℤ}) + (fun s c x y => ret (UnderLets.UnderLet (#ident.Z_sub_with_get_borrow @ s @ c @ x @ y) + (fun vc => UnderLets.Base (#ident.fst @ $vc, #ident.snd @ $vc)))) + ; make_rewrite + (#pident.Z_sub_get_borrow @ ??{ℤ} @ ??{ℤ} @ ??{ℤ}) + (fun s x y => ret (UnderLets.UnderLet (#ident.Z_sub_get_borrow @ s @ x @ y) + (fun vc => UnderLets.Base (#ident.fst @ $vc, #ident.snd @ $vc)))) + ; make_rewrite + (#pident.Z_mul_split @ ??{ℤ} @ ??{ℤ} @ ??{ℤ}) + (fun s x y => ret (UnderLets.UnderLet (#ident.Z_mul_split @ s @ x @ y) + (fun v => UnderLets.Base (#ident.fst @ $v, #ident.snd @ $v)))) + + + ; make_rewrite_step (* _step, so that if one of the arguments is concrete, we automatically get the rewrite rule for [Z_cast] applying to it *) + (#pident.Z_cast2 @ (??{ℤ}, ??{ℤ})) (fun r x y => (#(ident.Z_cast (fst r)) @ $x, #(ident.Z_cast (snd r)) @ $y)) + + ; make_rewrite (-??{ℤ}) (fun e => ret (UnderLets.UnderLet e (fun v => UnderLets.Base (-$v))) when negb (SubstVarLike.is_var_fst_snd_pair_opp e)) (* inline negation when the rewriter wouldn't already inline it *) + ]%list%pattern%cps%option%under_lets%Z%bool. + + Definition nbe_dtree' + := Eval compute in @compile_rewrites ident var pattern.ident pattern.ident.arg_types pattern.ident.ident_beq 100 nbe_rewrite_rules. + Definition arith_dtree' + := Eval compute in @compile_rewrites ident var pattern.ident pattern.ident.arg_types pattern.ident.ident_beq 100 arith_rewrite_rules. + Definition nbe_dtree : decision_tree + := Eval compute in invert_Some nbe_dtree'. + Definition arith_dtree : decision_tree + := Eval compute in invert_Some arith_dtree'. + Definition nbe_default_fuel := Eval compute in List.length nbe_rewrite_rules. + Definition arith_default_fuel := Eval compute in List.length arith_rewrite_rules. Import PrimitiveHList. (* N.B. The [combine_hlist] call MUST eta-expand @@ -1414,13 +1502,21 @@ In the RHS, the follow notation applies: trying to reduce things.) We accomplish this by making [hlist] based on a primitive [prod] type with judgmental η, so that matching on its structure never blocks reduction. *) - Definition split_rewrite_rules := Eval cbv [split_list projT1 projT2 rewrite_rules] in split_list rewrite_rules. - Definition pr1_rewrite_rules := Eval hnf in projT1 split_rewrite_rules. - Definition pr2_rewrite_rules := Eval hnf in projT2 split_rewrite_rules. - Definition all_rewrite_rules := combine_hlist (P:=rewrite_ruleTP) pr1_rewrite_rules pr2_rewrite_rules. + Definition nbe_split_rewrite_rules := Eval cbv [split_list projT1 projT2 nbe_rewrite_rules] in split_list nbe_rewrite_rules. + Definition nbe_pr1_rewrite_rules := Eval hnf in projT1 nbe_split_rewrite_rules. + Definition nbe_pr2_rewrite_rules := Eval hnf in projT2 nbe_split_rewrite_rules. + Definition nbe_all_rewrite_rules := combine_hlist (P:=rewrite_ruleTP) nbe_pr1_rewrite_rules nbe_pr2_rewrite_rules. + + Definition arith_split_rewrite_rules := Eval cbv [split_list projT1 projT2 arith_rewrite_rules] in split_list arith_rewrite_rules. + Definition arith_pr1_rewrite_rules := Eval hnf in projT1 arith_split_rewrite_rules. + Definition arith_pr2_rewrite_rules := Eval hnf in projT2 arith_split_rewrite_rules. + Definition arith_all_rewrite_rules := combine_hlist (P:=rewrite_ruleTP) arith_pr1_rewrite_rules arith_pr2_rewrite_rules. + + Definition nbe_rewrite_head0 do_again {t} (idc : ident t) : value_with_lets t + := @assemble_identifier_rewriters nbe_dtree nbe_all_rewrite_rules do_again t idc. - Definition rewrite_head0 do_again {t} (idc : ident t) : value_with_lets t - := @assemble_identifier_rewriters dtree all_rewrite_rules do_again t idc. + Definition arith_rewrite_head0 do_again {t} (idc : ident t) : value_with_lets t + := @assemble_identifier_rewriters arith_dtree arith_all_rewrite_rules do_again t idc. Section fancy. Context (invert_low invert_high : Z (*log2wordmax*) -> Z -> option Z). @@ -1694,26 +1790,103 @@ Z.mul @@ (?x >> 128, ?y >> 128) --> mulhh @@ (x, y) Redirect "/tmp/fancy_rewrite_head" Print fancy_rewrite_head. End red_fancy. - Section red. + Section red_nbe. + Context {var : type.type base.type -> Type} + (do_again : forall t : base.type, @expr base.type ident (@Compile.value base.type ident var) (type.base t) + -> UnderLets.UnderLets base.type ident var (@expr base.type ident var (type.base t))) + {t} (idc : ident t). + + Time Let rewrite_head1 + := Eval cbv -[nbe_pr2_rewrite_rules + base.interp base.try_make_transport_cps + type.try_make_transport_cps type.try_transport_cps + UnderLets.splice UnderLets.to_expr + Compile.reflect UnderLets.reify_and_let_binds_base_cps Compile.reify Compile.reify_and_let_binds_cps + Compile.value' + SubstVarLike.is_var_fst_snd_pair_opp + ] in @nbe_rewrite_head0 var do_again t idc. + (* Finished transaction in 16.593 secs (16.567u,0.s) (successful) *) + + Time Local Definition nbe_rewrite_head2 + := Eval cbv [id + rewrite_head1 nbe_pr2_rewrite_rules + projT1 projT2 + cpsbind cpscall cps_option_bind cpsreturn + pattern.ident.arg_types + Compile.app_binding_data + Compile.app_pbase_type_interp_cps + Compile.app_ptype_interp_cps + Compile.bind_base_cps + Compile.bind_data_cps + Compile.binding_dataT + Compile.bind_value_cps + Compile.eval_decision_tree + Compile.eval_rewrite_rules + Compile.expr_of_rawexpr + Compile.lift_pbase_type_interp_cps + Compile.lift_ptype_interp_cps + Compile.lift_with_bindings + Compile.pbase_type_interp_cps + Compile.ptype_interp + Compile.ptype_interp_cps + (*Compile.reflect*) + (*Compile.reify*) + Compile.reveal_rawexpr_cps + Compile.rValueOrExpr + Compile.swap_list + Compile.type_of_rawexpr + Compile.value + (*Compile.value'*) + Compile.value_of_rawexpr + Compile.value_with_lets + Compile.with_bindingsT + ident.smart_Literal + type.try_transport_cps + rlist_rect rlist_rect_cast rwhen + ] in rewrite_head1. + (* Finished transaction in 29.683 secs (29.592u,0.048s) (successful) *) + + Local Arguments base.try_make_base_transport_cps _ !_ !_. + Local Arguments base.try_make_transport_cps _ !_ !_. + Local Arguments type.try_make_transport_cps _ _ _ !_ !_. + Local Arguments nbe_rewrite_head2 / . + + Time Definition nbe_rewrite_head + := Eval cbn [id + nbe_rewrite_head2 + cpsbind cpscall cps_option_bind cpsreturn + Compile.reify Compile.reify_and_let_binds_cps Compile.reflect Compile.value' + UnderLets.reify_and_let_binds_base_cps + UnderLets.splice UnderLets.splice_list UnderLets.to_expr + base.interp base.base_interp + type.try_make_transport_cps base.try_make_transport_cps base.try_make_base_transport_cps + PrimitiveProd.Primitive.fst PrimitiveProd.Primitive.snd Datatypes.fst Datatypes.snd + ] in nbe_rewrite_head2. + (* Finished transaction in 16.561 secs (16.54u,0.s) (successful) *) + + Redirect "/tmp/nbe_rewrite_head" Print nbe_rewrite_head. + End red_nbe. + + Section red_arith. Context {var : type.type base.type -> Type} (do_again : forall t : base.type, @expr base.type ident (@Compile.value base.type ident var) (type.base t) -> UnderLets.UnderLets base.type ident var (@expr base.type ident var (type.base t))) {t} (idc : ident t). Time Let rewrite_head1 - := Eval cbv -[pr2_rewrite_rules + := Eval cbv -[arith_pr2_rewrite_rules base.interp base.try_make_transport_cps type.try_make_transport_cps type.try_transport_cps UnderLets.splice UnderLets.to_expr Compile.reflect UnderLets.reify_and_let_binds_base_cps Compile.reify Compile.reify_and_let_binds_cps Compile.value' SubstVarLike.is_var_fst_snd_pair_opp - ] in @rewrite_head0 var do_again t idc. + ] in @arith_rewrite_head0 var do_again t idc. (* Finished transaction in 16.593 secs (16.567u,0.s) (successful) *) - Time Local Definition rewrite_head2 + Time Local Definition arith_rewrite_head2 := Eval cbv [id - rewrite_head1 pr2_rewrite_rules + rewrite_head1 arith_pr2_rewrite_rules projT1 projT2 cpsbind cpscall cps_option_bind cpsreturn pattern.ident.arg_types @@ -1753,11 +1926,11 @@ Z.mul @@ (?x >> 128, ?y >> 128) --> mulhh @@ (x, y) Local Arguments base.try_make_base_transport_cps _ !_ !_. Local Arguments base.try_make_transport_cps _ !_ !_. Local Arguments type.try_make_transport_cps _ _ _ !_ !_. - Local Arguments rewrite_head2 / . + Local Arguments arith_rewrite_head2 / . - Time Definition rewrite_head + Time Definition arith_rewrite_head := Eval cbn [id - rewrite_head2 + arith_rewrite_head2 cpsbind cpscall cps_option_bind cpsreturn Compile.reify Compile.reify_and_let_binds_cps Compile.reflect Compile.value' UnderLets.reify_and_let_binds_base_cps @@ -1765,14 +1938,16 @@ Z.mul @@ (?x >> 128, ?y >> 128) --> mulhh @@ (x, y) base.interp base.base_interp type.try_make_transport_cps base.try_make_transport_cps base.try_make_base_transport_cps PrimitiveProd.Primitive.fst PrimitiveProd.Primitive.snd Datatypes.fst Datatypes.snd - ] in rewrite_head2. + ] in arith_rewrite_head2. (* Finished transaction in 16.561 secs (16.54u,0.s) (successful) *) - Redirect "/tmp/rewrite_head" Print rewrite_head. - End red. + Redirect "/tmp/arith_rewrite_head" Print arith_rewrite_head. + End red_arith. - Definition Rewrite {t} (e : expr.Expr (ident:=ident) t) : expr.Expr (ident:=ident) t - := @Compile.Rewrite (@rewrite_head) default_fuel t e. + Definition RewriteNBE {t} (e : expr.Expr (ident:=ident) t) : expr.Expr (ident:=ident) t + := @Compile.Rewrite (@nbe_rewrite_head) nbe_default_fuel t e. + Definition RewriteArith {t} (e : expr.Expr (ident:=ident) t) : expr.Expr (ident:=ident) t + := @Compile.Rewrite (@arith_rewrite_head) arith_default_fuel t e. Definition RewriteToFancy (invert_low invert_high : Z (*log2wordmax*) -> Z -> option Z) {t} (e : expr.Expr (ident:=ident) t) : expr.Expr (ident:=ident) t @@ -1781,5 +1956,5 @@ Z.mul @@ (?x >> 128, ?y >> 128) --> mulhh @@ (x, y) Import defaults. - Definition PartialEvaluate {t} (e : Expr t) : Expr t := RewriteRules.Rewrite e. + Definition PartialEvaluate {t} (e : Expr t) : Expr t := RewriteRules.RewriteNBE e. End Compilers. diff --git a/src/Experiments/NewPipeline/StandaloneHaskellMain.v b/src/Experiments/NewPipeline/StandaloneHaskellMain.v index d9ada8451..131907bc1 100644 --- a/src/Experiments/NewPipeline/StandaloneHaskellMain.v +++ b/src/Experiments/NewPipeline/StandaloneHaskellMain.v @@ -49,6 +49,18 @@ Module UnsaturatedSolinas. (fun err => raise_failure _ (String.concat String.NewLine err))). End UnsaturatedSolinas. +Module WordByWordMontgomery. + Definition main : IO_unit + := cast_io + (argv <- getArgs; + prog <- getProgName; + ForExtraction.WordByWordMontgomery.PipelineMain + (prog::argv) + (fun res => printf_string + (String.concat "" res)) + (fun err => raise_failure _ (String.concat String.NewLine err))). +End WordByWordMontgomery. + Module SaturatedSolinas. Definition main : IO_unit := cast_io diff --git a/src/Experiments/NewPipeline/StandaloneOCamlMain.v b/src/Experiments/NewPipeline/StandaloneOCamlMain.v index 0c354b45a..c5b4db570 100644 --- a/src/Experiments/NewPipeline/StandaloneOCamlMain.v +++ b/src/Experiments/NewPipeline/StandaloneOCamlMain.v @@ -102,6 +102,15 @@ Module UnsaturatedSolinas. raise_failure. End UnsaturatedSolinas. +Module WordByWordMontgomery. + Definition main : unit + := let argv := List.map string_to_Coq_string sys_argv in + ForExtraction.WordByWordMontgomery.PipelineMain + argv + printf_list_string + raise_failure. +End WordByWordMontgomery. + Module SaturatedSolinas. Definition main : unit := let argv := List.map string_to_Coq_string sys_argv in diff --git a/src/Experiments/NewPipeline/Toplevel1.v b/src/Experiments/NewPipeline/Toplevel1.v index 1f86f656f..8a79fc852 100644 --- a/src/Experiments/NewPipeline/Toplevel1.v +++ b/src/Experiments/NewPipeline/Toplevel1.v @@ -36,6 +36,7 @@ Require Import Crypto.Util.ZUtil.AddModulo. Require Import Crypto.Util.ZUtil.CC. Require Import Crypto.Arithmetic.MontgomeryReduction.Definition. Require Import Crypto.Arithmetic.MontgomeryReduction.Proofs. +Require Import Crypto.Util.ZUtil.ModInv. Require Import Crypto.Util.ErrorT. Require Import Crypto.Util.Strings.Show. Require Import Crypto.Util.ZRange.Show. @@ -261,6 +262,230 @@ Module Ring. End ring_goal. End Ring. +(** NOTE: Module MontgomeryStyleRing SHOULD NOT depend on any compilers things *) +Module MontgomeryStyleRing. + Local Notation is_bounded_by0 r v + := ((lower r <=? v) && (v <=? upper r)). + Local Notation is_bounded_by0o r + := (match r with Some r' => fun v' => is_bounded_by0 r' v' | None => fun _ => true end). + Local Notation is_bounded_by bounds ls + := (fold_andb_map (fun r v'' => is_bounded_by0o r v'') bounds ls). + Local Notation is_bounded_by1 bounds ls + := (andb (is_bounded_by bounds (@fst _ unit ls)) true). + Local Notation is_bounded_by2 bounds ls + := (andb (is_bounded_by bounds (fst ls)) (is_bounded_by1 bounds (snd ls))). + + Lemma length_is_bounded_by bounds ls + : is_bounded_by bounds ls = true -> length ls = length bounds. + Proof. + intro H. + apply fold_andb_map_length in H; congruence. + Qed. + + Section ring_goal. + Context (limbwidth_num limbwidth_den : Z) + (n : nat) + (s : Z) + (c : list (Z * Z)) + (bounds : list (option zrange)) + (length_bounds : length bounds = n). + Local Notation weight := (weight limbwidth_num limbwidth_den). + Local Notation eval := (Positional.eval weight n). + Let prime_bound : zrange + := r[0~>(s - Associational.eval c - 1)]%zrange. + Let m := Z.to_pos (s - Associational.eval c). + Context (m_eq : Z.pos m = s - Associational.eval c) + (sc_pos : 0 < s - Associational.eval c) + (valid : list Z -> Prop) + (from_montgomery_mod : list Z -> list Z) + (Hfrom_montgomery_mod + : forall v, valid v -> valid (from_montgomery_mod v)) + (Interp_rfrom_montgomeryv : list Z -> list Z) + (HInterp_rfrom_montgomeryv : forall arg, + is_bounded_by1 bounds arg = true + -> is_bounded_by bounds (Interp_rfrom_montgomeryv (fst arg)) = true + /\ Interp_rfrom_montgomeryv (fst arg) = from_montgomery_mod (fst arg)) + (mulmod : list Z -> list Z -> list Z) + (Hmulmod + : (forall a (_ : valid a) b (_ : valid b), eval (from_montgomery_mod (mulmod a b)) mod (s - Associational.eval c) + = (eval (from_montgomery_mod a) * eval (from_montgomery_mod b)) mod (s - Associational.eval c)) + /\ (forall a (_ : valid a) b (_ : valid b), valid (mulmod a b))) + (Interp_rmulv : list Z -> list Z -> list Z) + (HInterp_rmulv : forall arg, + is_bounded_by2 bounds arg = true + -> is_bounded_by bounds (Interp_rmulv (fst arg) (fst (snd arg))) = true + /\ Interp_rmulv (fst arg) (fst (snd arg)) = mulmod (fst arg) (fst (snd arg))) + (addmod : list Z -> list Z -> list Z) + (Haddmod + : (forall a (_ : valid a) b (_ : valid b), eval (from_montgomery_mod (addmod a b)) mod (s - Associational.eval c) + = (eval (from_montgomery_mod a) + eval (from_montgomery_mod b)) mod (s - Associational.eval c)) + /\ (forall a (_ : valid a) b (_ : valid b), valid (addmod a b))) + (Interp_raddv : list Z -> list Z -> list Z) + (HInterp_raddv : forall arg, + is_bounded_by2 bounds arg = true + -> is_bounded_by bounds (Interp_raddv (fst arg) (fst (snd arg))) = true + /\ Interp_raddv (fst arg) (fst (snd arg)) = addmod (fst arg) (fst (snd arg))) + (submod : list Z -> list Z -> list Z) + (Hsubmod + : (forall a (_ : valid a) b (_ : valid b), eval (from_montgomery_mod (submod a b)) mod (s - Associational.eval c) + = (eval (from_montgomery_mod a) - eval (from_montgomery_mod b)) mod (s - Associational.eval c)) + /\ (forall a (_ : valid a) b (_ : valid b), valid (submod a b))) + (Interp_rsubv : list Z -> list Z -> list Z) + (HInterp_rsubv : forall arg, + is_bounded_by2 bounds arg = true + -> is_bounded_by bounds (Interp_rsubv (fst arg) (fst (snd arg))) = true + /\ Interp_rsubv (fst arg) (fst (snd arg)) = submod (fst arg) (fst (snd arg))) + (oppmod : list Z -> list Z) + (Hoppmod + : (forall a (_ : valid a), eval (from_montgomery_mod (oppmod a)) mod (s - Associational.eval c) + = (-eval (from_montgomery_mod a)) mod (s - Associational.eval c)) + /\ (forall a (_ : valid a), valid (oppmod a))) + (Interp_roppv : list Z -> list Z) + (HInterp_roppv : forall arg, + is_bounded_by1 bounds arg = true + -> is_bounded_by bounds (Interp_roppv (fst arg)) = true + /\ Interp_roppv (fst arg) = oppmod (fst arg)) + (zeromod : list Z) + (Hzeromod + : (eval (from_montgomery_mod zeromod)) mod (s - Associational.eval c) + = 0 mod (s - Associational.eval c) + /\ valid zeromod) + (Interp_rzerov : list Z) + (HInterp_rzerov : is_bounded_by bounds Interp_rzerov = true + /\ Interp_rzerov = zeromod) + (onemod : list Z) + (Honemod + : (eval (from_montgomery_mod onemod)) mod (s - Associational.eval c) + = 1 mod (s - Associational.eval c) + /\ valid onemod) + (Interp_ronev : list Z) + (HInterp_ronev : is_bounded_by bounds Interp_ronev = true + /\ Interp_ronev = onemod) + (encodemod : Z -> list Z) + (Hencodemod + : (forall v, 0 <= v < s - Associational.eval c -> eval (from_montgomery_mod (encodemod v)) mod (s - Associational.eval c) = v mod (s - Associational.eval c)) + /\ (forall v, 0 <= v < s - Associational.eval c -> valid (encodemod v))) + (Interp_rencodev : Z -> list Z) + (HInterp_rencodev : forall arg, + is_bounded_by0 prime_bound (@fst _ unit arg) && true = true + -> is_bounded_by bounds (Interp_rencodev (fst arg)) = true + /\ Interp_rencodev (fst arg) = encodemod (fst arg)). + + Local Notation T := (list Z) (only parsing). + Local Notation encoded_ok ls + := (is_bounded_by bounds ls = true /\ valid ls) (only parsing). + Local Notation encoded_okf := (fun ls => encoded_ok ls) (only parsing). + + Definition Fdecode (v : T) : F m + := F.of_Z m (Positional.eval weight n (Interp_rfrom_montgomeryv v)). + Definition T_eq (x y : T) + := Fdecode x = Fdecode y. + + Definition encodedT := sig encoded_okf. + + Definition ring_mul (x y : T) : T + := Interp_rmulv x y. + Definition ring_add (x y : T) : T := Interp_raddv x y. + Definition ring_sub (x y : T) : T := Interp_rsubv x y. + Definition ring_opp (x : T) : T := Interp_roppv x. + Definition ring_encode (x : F m) : T := Interp_rencodev (F.to_Z x). + + Definition GoodT : Prop + := @subsetoid_ring + (list Z) encoded_okf T_eq + Interp_rzerov Interp_ronev ring_opp ring_add ring_sub ring_mul + /\ @is_subsetoid_homomorphism + (F m) (fun _ => True) eq 1%F F.add F.mul + (list Z) encoded_okf T_eq Interp_ronev ring_add ring_mul ring_encode + /\ @is_subsetoid_homomorphism + (list Z) encoded_okf T_eq Interp_ronev ring_add ring_mul + (F m) (fun _ => True) eq 1%F F.add F.mul + Fdecode. + + Hint Rewrite ->@F.to_Z_add : push_FtoZ. + Hint Rewrite ->@F.to_Z_mul : push_FtoZ. + Hint Rewrite ->@F.to_Z_opp : push_FtoZ. + Hint Rewrite ->@F.to_Z_of_Z : push_FtoZ. + + Lemma Fm_bounded_alt (x : F m) + : (0 <=? F.to_Z x) && (F.to_Z x <=? Z.pos m - 1) = true. + Proof using m_eq. + clear -m_eq. + destruct x as [x H]; cbn [F.to_Z proj1_sig]. + pose proof (Z.mod_pos_bound x (Z.pos m)). + rewrite andb_true_iff; split; Z.ltb_to_lt; lia. + Qed. + + Lemma Fm_bounded_alt' (x : F m) + : 0 <= F.to_Z x < Z.pos m. + Proof using m_eq. + clear -m_eq. + destruct x as [x H]; cbn [F.to_Z proj1_sig]. + pose proof (Z.mod_pos_bound x (Z.pos m)). + split; Z.ltb_to_lt; lia. + Qed. + + Lemma Good : GoodT. + Proof. + split_and. + repeat match goal with + | [ H : context[andb _ true] |- _ ] => setoid_rewrite andb_true_r in H + end. + eapply subsetoid_ring_by_ring_isomorphism; + cbv [ring_opp ring_add ring_sub ring_mul ring_encode F.sub] in *; + repeat match goal with + | [ H : forall arg : _ * unit, _ |- _ ] => specialize (fun arg => H (arg, tt)) + | [ H : forall arg : _ * (_ * unit), _ |- _ ] => specialize (fun a b => H (a, (b, tt))) + | _ => progress cbn [fst snd] in * + | _ => solve [ auto using andb_true_intro, conj with nocore ] + | _ => progress intros + | [ H : is_bounded_by _ _ = true /\ _ |- _ ] => destruct H + | [ |- is_bounded_by _ _ = true /\ _ ] => split + | [ H : _ |- is_bounded_by _ _ = true ] => apply H + | [ H : _ |- valid _ ] => rewrite H + | [ H : context[valid _] |- valid _ ] => apply H + | [ |- _ <-> _ ] => reflexivity + | [ |- ?x = ?x ] => reflexivity + | [ |- _ = _ :> Z ] => first [ reflexivity | rewrite <- m_eq; reflexivity ] + | [ H : context[?x] |- Fdecode ?x = _ ] => rewrite H + | [ H : context[?x _] |- Fdecode (?x _) = _ ] => rewrite H + | [ H : context[?x _ _] |- Fdecode (?x _ _) = _ ] => rewrite H + | _ => progress cbv [Fdecode] + | [ |- _ = _ :> F _ ] => apply F.eq_to_Z_iff + | _ => progress autorewrite with push_FtoZ + | _ => rewrite m_eq + | [ H : context[?f (?x _ _)] |- context[eval (?f (?x _ _))] ] => rewrite H + | [ H : context[?f (?x _)] |- context[eval (?f (?x _))] ] => rewrite H + | [ H : context[?f ?x] |- context[eval (?f ?x)] ] => rewrite H + | [ H : context[?x _ _] |- context[eval (?x _ _)] ] => rewrite H + | [ H : context[?x _] |- context[eval (?x _)] ] => rewrite H + | [ H : context[?x] |- context[eval ?x] ] => rewrite H + | [ H : context[?y _ _ = ?x _ _], H' : context[is_bounded_by _ (?y _ _) = true] + |- is_bounded_by _ (?x _ _) = true ] + => rewrite <- H; [ apply H' | .. ] + | [ H : context[?y _ = ?x _], H' : context[is_bounded_by _ (?y _) = true] + |- is_bounded_by _ (?x _) = true ] + => rewrite <- H; [ apply H' | .. ] + | [ H : context[?y = ?x], H' : context[is_bounded_by _ ?y = true] + |- is_bounded_by _ ?x = true ] + => rewrite <- H; [ apply H' | .. ] + | [ |- context[List.length ?x] ] + => erewrite (length_is_bounded_by _ x) + by eauto using andb_true_intro, conj with nocore + | [ |- _ = _ :> Z ] + => push_Zmod; reflexivity + | _ => pull_Zmod; rewrite Z.add_opp_r + | _ => rewrite expanding_id_id + | [ |- context[F.to_Z _ mod (_ - _)] ] + => rewrite <- m_eq, F.mod_to_Z + | _ => rewrite <- m_eq; apply Fm_bounded_alt + | _ => rewrite <- m_eq; apply Fm_bounded_alt' + | [ |- context[andb _ true] ] => rewrite andb_true_r + end. + Qed. + End ring_goal. +End MontgomeryStyleRing. + Import Associational Positional. Import @@ -289,13 +514,14 @@ Notation "x" := (expr.Var x) (only printing, at level 9) : expr_scope. Axiom admit_pf : False. Notation admit := (match admit_pf with end). + Module Pipeline. Import GeneralizeVar. Inductive ErrorMessage := | Computed_bounds_are_not_tight_enough {t} (computed_bounds expected_bounds : ZRange.type.base.option.interp (type.final_codomain t)) (syntax_tree : Expr t) (arg_bounds : type.for_each_lhs_of_arrow ZRange.type.option.interp t) - | Type_too_complicated_for_cps (t : type) + | No_modular_inverse (descr : string) (v : Z) (m : Z) | Value_not_leZ (descr : string) (lhs rhs : Z) | Value_not_leQ (descr : string) (lhs rhs : Q) | Value_not_ltZ (descr : string) (lhs rhs : Z) @@ -395,8 +621,8 @@ Module Pipeline. => (["(Unprintible syntax tree used in bounds analysis)" ++ String.NewLine]%string) ++ ["Stringification failed on the syntax tree:"] ++ show_lines false syntax_tree ++ [errs] end)%list - | Type_too_complicated_for_cps t - => ["Type too complicated for cps: " ++ show false t] + | No_modular_inverse descr v m + => ["Could not compute a modular inverse (" ++ descr ++ ") for " ++ show false v ++ " mod " ++ show false m] | Value_not_leZ descr lhs rhs => ["Value not ≤ (" ++ descr ++ ") : expected " ++ show false lhs ++ " ≤ " ++ show false rhs] | Value_not_leQ descr lhs rhs @@ -437,6 +663,7 @@ Module Pipeline. := (*let E := expr.Uncurry E in*) let E := PartialEvaluateWithListInfoFromBounds E arg_bounds in let E := PartialEvaluate E in + let E := RewriteRules.RewriteArith E in (* Note that DCE evaluates the expr with two different [var] arguments, and so results in a pipeline that is 2x slower unless we pass through a uniformly concrete [var] type @@ -448,7 +675,10 @@ Module Pipeline. let E := FromFlat e in let E := if with_subst01 then Subst01.Subst01 E else E in let E := UnderLets.LetBindReturn E in - let E := PartialEvaluate E in (* after inlining, see if any new rewrite redexes are available *) + let E := RewriteRules.RewriteArith E in (* after inlining, see if any new rewrite redexes are available *) + dlet_nd e := ToFlat E in + let E := FromFlat e in + let E := if with_dead_code_elimination then DeadCodeElimination.EliminateDead E else E in let E := ReassociateSmallConstants.Reassociate (2^8) E in let E := match translate_to_fancy with | Some {| invert_low := invert_low ; invert_high := invert_high |} => RewriteRules.RewriteToFancy invert_low invert_high E @@ -823,12 +1053,12 @@ Derive to_bytes_gen (bitwidth : Z) (m_enc : list Z) (f : list Z), - Interp (t:=reify_type_of to_bytesmod) + Interp (t:=reify_type_of freeze_to_bytesmod) to_bytes_gen limbwidth_num limbwidth_den n bitwidth m_enc f - = to_bytesmod limbwidth_num limbwidth_den n bitwidth m_enc f) + = freeze_to_bytesmod limbwidth_num limbwidth_den n bitwidth m_enc f) As to_bytes_gen_correct. Proof. cache_reify (). Qed. -Hint Extern 1 (_ = to_bytesmod _ _ _ _ _ _) => simple apply to_bytes_gen_correct : reify_gen_cache. +Hint Extern 1 (_ = freeze_to_bytesmod _ _ _ _ _ _) => simple apply to_bytes_gen_correct : reify_gen_cache. Derive from_bytes_gen SuchThat (forall (limbwidth_num limbwidth_den : Z) @@ -1152,7 +1382,7 @@ Module Import UnsaturatedSolinas. := BoundsPipeline_with_bytes_no_subst01_correct (Some tight_bounds, tt) prime_bytes_bounds - (to_bytesmod (Qnum limbwidth) (Z.pos (Qden limbwidth)) n machine_wordsize m_enc). + (freeze_to_bytesmod (Qnum limbwidth) (Z.pos (Qden limbwidth)) n machine_wordsize m_enc). Definition srfrom_bytes prefix := BoundsPipelineToStrings_with_bytes_no_subst01 @@ -1373,8 +1603,8 @@ Module Import UnsaturatedSolinas. (Hf : type.andb_bool_for_each_lhs_of_arrow (t:=to_bytesT) (@ZRange.type.option.is_bounded_by) (Some tight_bounds, tt) f = true), ((ZRange.type.base.option.is_bounded_by prime_bytes_bounds (type.app_curried (Interp rto_bytesv) f) = true /\ (forall cast_outside_of_range, type.app_curried (expr.Interp (@ident.gen_interp cast_outside_of_range) rto_bytesv) f - = type.app_curried (t:=to_bytesT) (to_bytesmod (Qnum limbwidth) (Z.pos (Qden limbwidth)) n machine_wordsize m_enc) f)) - /\ (Positional.eval (weight 8 1) n_bytes (type.app_curried (t:=to_bytesT) (to_bytesmod (Qnum limbwidth) (Z.pos (Qden limbwidth)) n machine_wordsize m_enc) f)) = (Positional.eval (weight (Qnum limbwidth) (Z.pos (Qden limbwidth))) n (fst f) mod m))). + = type.app_curried (t:=to_bytesT) (freeze_to_bytesmod (Qnum limbwidth) (Z.pos (Qden limbwidth)) n machine_wordsize m_enc) f)) + /\ (Positional.eval (weight 8 1) n_bytes (type.app_curried (t:=to_bytesT) (freeze_to_bytesmod (Qnum limbwidth) (Z.pos (Qden limbwidth)) n machine_wordsize m_enc) f)) = (Positional.eval (weight (Qnum limbwidth) (Z.pos (Qden limbwidth))) n (fst f) mod m))). (** XXX TODO MOVE ME *) Lemma fold_andb_map_snoc A B f x xs y ys @@ -1448,7 +1678,7 @@ Module Import UnsaturatedSolinas. { apply Hto_bytesv; assumption. } { cbn [type.for_each_lhs_of_arrow type_base type.andb_bool_for_each_lhs_of_arrow ZRange.type.option.is_bounded_by fst snd] in *. rewrite Bool.andb_true_iff in *; split_and'. - etransitivity; [ apply eval_to_bytesmod | f_equal; (eassumption || (symmetry; eassumption)) ]; + etransitivity; [ apply eval_freeze_to_bytesmod | f_equal; (eassumption || (symmetry; eassumption)) ]; auto; try omega. { erewrite Ring.length_is_bounded_by by eassumption; assumption. } { lazymatch goal with @@ -1834,6 +2064,739 @@ Goal False. Abort. *) +Module WordByWordMontgomery. + Import Arithmetic.WordByWordMontgomery. + Derive mul_gen + SuchThat (forall (bitwidth : Z) + (n : nat) + (m : Z) + (m' : Z) + (f g : list Z), + Interp (t:=reify_type_of mulmod) + mul_gen bitwidth n m m' f g + = mulmod bitwidth n m m' f g) + As mul_gen_correct. + Proof. Time cache_reify (). Time Qed. + Hint Extern 1 (_ = mulmod _ _ _ _ _ _) => simple apply mul_gen_correct : reify_gen_cache. + + Derive square_gen + SuchThat (forall (bitwidth : Z) + (n : nat) + (m : Z) + (m' : Z) + (f : list Z), + Interp (t:=reify_type_of squaremod) + square_gen bitwidth n m m' f + = squaremod bitwidth n m m' f) + As square_gen_correct. + Proof. + Time cache_reify (). + (* we would do something faster, but it breaks extraction COQBUG(https://github.com/coq/coq/issues/7954) *) + (* + intros; etransitivity; [ | cbv [squaremod]; apply mul_gen_correct ]. + subst square_gen. + instantiate (1:=ltac:(let r := Reify (fun F (bitwidth:Z) (n:nat) (m m' : Z) (f : list Z) => (F bitwidth n m m' f f):list Z) in refine (r @ mul_gen)%Expr)). + reflexivity. + *) + Time Qed. + Hint Extern 1 (_ = squaremod _ _ _ _ _) => simple apply square_gen_correct : reify_gen_cache. + + Derive encode_gen + SuchThat (forall (bitwidth : Z) + (n : nat) + (m : Z) + (m' : Z) + (v : Z), + Interp (t:=reify_type_of encodemod) + encode_gen bitwidth n m m' v + = encodemod bitwidth n m m' v) + As encode_gen_correct. + Proof. + Time cache_reify (). + (* we would do something faster, but it breaks extraction COQBUG(https://github.com/coq/coq/issues/7954) *) + (* + intros; etransitivity; [ | cbv [encodemod]; apply mul_gen_correct ]. + subst encode_gen; revert bitwidth n m m' v. + lazymatch goal with + | [ |- forall bw n m m' v, ?interp ?ev bw n m m' v = ?interp' mul_gen bw n m m' (@?A bw n m m' v) (@?B bw n m m' v) ] + => let rv := constr:(fun F bw n m m' v => (F bw n m m' (A bw n m m' v) (B bw n m m' v)):list Z) in + intros; + instantiate (1:=ltac:(let r := Reify rv in + refine (r @ mul_gen)%Expr)) + end. + reflexivity. + *) + Time Qed. + Hint Extern 1 (_ = encodemod _ _ _ _ _) => simple apply encode_gen_correct : reify_gen_cache. + + Derive add_gen + SuchThat (forall (bitwidth : Z) + (n : nat) + (m : Z) + (f g : list Z), + Interp (t:=reify_type_of addmod) + add_gen bitwidth n m f g + = addmod bitwidth n m f g) + As add_gen_correct. + Proof. Time cache_reify (). Time Qed. + Hint Extern 1 (_ = addmod _ _ _ _ _) => simple apply add_gen_correct : reify_gen_cache. + + Derive sub_gen + SuchThat (forall (bitwidth : Z) + (n : nat) + (m : Z) + (f g : list Z), + Interp (t:=reify_type_of submod) + sub_gen bitwidth n m f g + = submod bitwidth n m f g) + As sub_gen_correct. + Proof. Time cache_reify (). Time Qed. + Hint Extern 1 (_ = submod _ _ _ _ _) => simple apply sub_gen_correct : reify_gen_cache. + + Derive opp_gen + SuchThat (forall (bitwidth : Z) + (n : nat) + (m : Z) + (f : list Z), + Interp (t:=reify_type_of oppmod) + opp_gen bitwidth n m f + = oppmod bitwidth n m f) + As opp_gen_correct. + Proof. Time cache_reify (). Time Qed. + Hint Extern 1 (_ = oppmod _ _ _ _) => simple apply opp_gen_correct : reify_gen_cache. + + Derive from_montgomery_gen + SuchThat (forall (bitwidth : Z) + (n : nat) + (m : Z) + (m' : Z) + (f : list Z), + Interp (t:=reify_type_of from_montgomery_mod) + from_montgomery_gen bitwidth n m m' f + = from_montgomery_mod bitwidth n m m' f) + As from_montgomery_gen_correct. + Proof. + Time cache_reify (). + (* we would do something faster, but it breaks extraction COQBUG(https://github.com/coq/coq/issues/7954) *) + (* + intros; etransitivity; [ | cbv [from_montgomery_mod]; apply mul_gen_correct ]. + subst from_montgomery_gen. + instantiate (1:=ltac:(let r := Reify (fun F (bitwidth:Z) (n:nat) (m m' : Z) (f : list Z) => (F bitwidth n m m' f (onemod bitwidth n)):list Z) in refine (r @ mul_gen)%Expr)). + reflexivity. + *) + Qed. + Hint Extern 1 (_ = from_montgomery_mod _ _ _ _ _) => simple apply from_montgomery_gen_correct : reify_gen_cache. + + Definition zeromod bitwidth n m m' := encodemod bitwidth n m m' 0. + Definition onemod bitwidth n m m' := encodemod bitwidth n m m' 1. + Derive zero_gen + SuchThat (forall (bitwidth : Z) + (n : nat) + (m : Z) + (m' : Z), + Interp (t:=reify_type_of zeromod) + zero_gen bitwidth n m m' + = zeromod bitwidth n m m') + As zero_gen_correct. + Proof. + (* Time cache_reify (). *) + (* we do something faster *) + intros; etransitivity; [ | cbv [zeromod]; apply encode_gen_correct ]. + subst zero_gen. + instantiate (1:=ltac:(let r := Reify (fun F (bitwidth:Z) (n:nat) (m m' : Z) => (F bitwidth n m m' 0):list Z) in refine (r @ encode_gen)%Expr)). + reflexivity. + Qed. + Hint Extern 1 (_ = zeromod _ _ _ _) => simple apply zero_gen_correct : reify_gen_cache. + + Derive one_gen + SuchThat (forall (bitwidth : Z) + (n : nat) + (m : Z) + (m' : Z), + Interp (t:=reify_type_of onemod) + one_gen bitwidth n m m' + = onemod bitwidth n m m') + As one_gen_correct. + Proof. + (* Time cache_reify (). *) + (* we do something faster *) + intros; etransitivity; [ | cbv [onemod]; apply encode_gen_correct ]. + subst one_gen. + instantiate (1:=ltac:(let r := Reify (fun F (bitwidth:Z) (n:nat) (m m' : Z) => (F bitwidth n m m' 1):list Z) in refine (r @ encode_gen)%Expr)). + reflexivity. + Qed. + Hint Extern 1 (_ = onemod _ _ _ _) => simple apply one_gen_correct : reify_gen_cache. + + Derive nonzero_gen + SuchThat (forall (f : list Z), + Interp (t:=reify_type_of nonzeromod) + nonzero_gen f + = nonzeromod f) + As nonzero_gen_correct. + Proof. Time cache_reify (). Time Qed. + Hint Extern 1 (_ = nonzeromod _) => simple apply nonzero_gen_correct : reify_gen_cache. + + Derive to_bytes_gen + SuchThat (forall (bitwidth : Z) + (n : nat) + (f : list Z), + Interp (t:=reify_type_of to_bytesmod) + to_bytes_gen bitwidth n f + = to_bytesmod bitwidth n f) + As to_bytes_gen_correct. + Proof. cache_reify (). Qed. + Hint Extern 1 (_ = to_bytesmod _ _ _) => simple apply to_bytes_gen_correct : reify_gen_cache. + + Section rcarry_mul. + Context (s : Z) + (c : list (Z * Z)) + (machine_wordsize : Z). + + Let n : nat := Z.to_nat (Qceiling (Z.log2_up s / machine_wordsize)). + Let m := s - Associational.eval c. + Let r := 2^machine_wordsize. + Let r' := match Z.modinv r m with + | Some r' => r' + | None => 0 + end. + Let m' := match Z.modinv (-m) r with + | Some m' => m' + | None => 0 + end. + Let n_bytes := bytes_n machine_wordsize 1 n. + Let prime_upperbound_list : list Z + := encode (UniformWeight.uweight machine_wordsize) n s c (s-1). + Let prime_bytes_upperbound_list : list Z + := encode (weight 8 1) n_bytes s c (s-1). + Let upperbounds : list Z := prime_upperbound_list. + Definition prime_bound : ZRange.type.option.interp (base.type.Z) + := Some r[0~>(s - Associational.eval c - 1)]%zrange. + Definition prime_bounds : ZRange.type.option.interp (base.type.list (base.type.Z)) + := Some (List.map (fun v => Some r[0 ~> v]%zrange) prime_upperbound_list). + Definition prime_bytes_bounds : ZRange.type.option.interp (base.type.list (base.type.Z)) + := Some (List.map (fun v => Some r[0 ~> v]%zrange) prime_bytes_upperbound_list). + Definition saturated_bounds : ZRange.type.option.interp (base.type.list (base.type.Z)) + := Some (List.repeat (Some r[0 ~> 2^machine_wordsize-1]%zrange) n). + + Definition m_enc : list Z + := encode (UniformWeight.uweight machine_wordsize) n s c (s-Associational.eval c). + + Definition relax_zrange_of_machine_wordsize + := relax_zrange_gen [1; machine_wordsize; 2 * machine_wordsize]%Z. + + Definition relax_zrange_of_machine_wordsize_with_bytes + := relax_zrange_gen [1; 8; machine_wordsize; 2 * machine_wordsize]%Z. + + Let relax_zrange := relax_zrange_of_machine_wordsize. + Let relax_zrange_with_bytes := relax_zrange_of_machine_wordsize_with_bytes. + Definition bounds : list (ZRange.type.option.interp base.type.Z) + := Option.invert_Some saturated_bounds (*List.map (fun u => Some r[0~>u]%zrange) upperbounds*). + + (** Note: If you change the name or type signature of this + function, you will need to update the code in CLI.v *) + Definition check_args {T} (res : Pipeline.ErrorT T) + : Pipeline.ErrorT T + := fold_right + (fun '(b, e) k => if b:bool then Error e else k) + res + [(negb (1 <? machine_wordsize)%Z, Pipeline.Value_not_ltZ "machine_wordsize <= 1" 1 machine_wordsize); + ((negb (0 <? Associational.eval c))%Z, Pipeline.Value_not_ltZ "Associational.eval c ≤ 0" 0 (Associational.eval c)); + ((negb (Associational.eval c <? s))%Z, Pipeline.Value_not_ltZ "s ≤ Associational.eval c" (Associational.eval c) s); + ((s =? 0)%Z, Pipeline.Values_not_provably_distinctZ "s = 0" s 0); + ((n =? 0)%nat, Pipeline.Values_not_provably_distinctZ "n = 0" n 0%nat); + ((r' =? 0)%Z, Pipeline.No_modular_inverse "r⁻¹ mod m" r m); + (negb ((r * r') mod m =? 1)%Z, Pipeline.Values_not_provably_equalZ "(r * r') mod m ≠ 1" ((r * r') mod m) 1); + (negb ((m * m') mod r =? (-1) mod r)%Z, Pipeline.Values_not_provably_equalZ "(m * m') mod r ≠ (-1) mod r" ((m * m') mod r) ((-1) mod r)); + (negb (s <=? r^n), Pipeline.Value_not_leZ "r^n ≤ s" s (r^n)); + (negb (1 <? s - Associational.eval c), Pipeline.Value_not_ltZ "s - Associational.eval c ≤ 1" 1 (s - Associational.eval c))]. + + Notation type_of_strip_3arrow := ((fun (d : Prop) (_ : forall A B C, d) => d) _). + + Notation BoundsPipelineToStrings prefix name comment rop in_bounds out_bounds + := ((prefix ++ name)%string, + Pipeline.BoundsPipelineToStrings + true (* static *) prefix (prefix ++ name)%string comment%string%list + (*false*) true None + relax_zrange + rop%Expr in_bounds out_bounds). + + Notation BoundsPipeline_correct in_bounds out_bounds op + := (fun rv (rop : Expr (reify_type_of op)) Hrop + => @Pipeline.BoundsPipeline_correct_trans + (*false*) true None + relax_zrange + (relax_zrange_gen_good _) + _ + rop + in_bounds + out_bounds + op + Hrop rv) + (only parsing). + + Notation BoundsPipelineToStrings_no_subst01 prefix name comment rop in_bounds out_bounds + := ((prefix ++ name)%string, + Pipeline.BoundsPipelineToStrings + true (* static *) prefix (prefix ++ name)%string comment%string%list + (*false*) false None + relax_zrange + rop%Expr in_bounds out_bounds). + + Notation BoundsPipeline_no_subst01_correct in_bounds out_bounds op + := (fun rv (rop : Expr (reify_type_of op)) Hrop + => @Pipeline.BoundsPipeline_correct_trans + (*false*) false None + relax_zrange + (relax_zrange_gen_good _) + _ + rop + in_bounds + out_bounds + op + Hrop rv) + (only parsing). + + Notation BoundsPipelineToStrings_with_bytes_no_subst01 prefix name comment rop in_bounds out_bounds + := ((prefix ++ name)%string, + Pipeline.BoundsPipelineToStrings + true (* static *) prefix (prefix ++ name)%string comment%string%list + (*false*) false None + relax_zrange_with_bytes + rop%Expr in_bounds out_bounds). + + Notation BoundsPipeline_with_bytes_no_subst01_correct in_bounds out_bounds op + := (fun rv (rop : Expr (reify_type_of op)) Hrop + => @Pipeline.BoundsPipeline_correct_trans + (*false*) false None + relax_zrange_with_bytes + (relax_zrange_gen_good _) + _ + rop + in_bounds + out_bounds + op + Hrop rv) + (only parsing). + + (* N.B. We only need [rmul] if we want to extract the Pipeline; otherwise we can just use [rmul_correct] *) + Definition srmul prefix + := BoundsPipelineToStrings_no_subst01 + prefix "mul" [] + (mul_gen + @ GallinaReify.Reify machine_wordsize @ GallinaReify.Reify n @ GallinaReify.Reify m @ GallinaReify.Reify m') + (Some bounds, (Some bounds, tt)) + (Some bounds). + + Definition rmul_correct + := BoundsPipeline_no_subst01_correct + (Some bounds, (Some bounds, tt)) + (Some bounds) + (mulmod machine_wordsize n m m'). + + Definition srsquare prefix + := BoundsPipelineToStrings_no_subst01 + prefix "square" [] + (square_gen + @ GallinaReify.Reify machine_wordsize @ GallinaReify.Reify n @ GallinaReify.Reify m @ GallinaReify.Reify m') + (Some bounds, tt) + (Some bounds). + + Definition rsquare_correct + := BoundsPipeline_no_subst01_correct + (Some bounds, tt) + (Some bounds) + (squaremod machine_wordsize n m m'). + + Definition sradd prefix + := BoundsPipelineToStrings + prefix "add" [] + (add_gen + @ GallinaReify.Reify machine_wordsize @ GallinaReify.Reify n @ GallinaReify.Reify m) + (Some bounds, (Some bounds, tt)) + (Some bounds). + + Definition radd_correct + := BoundsPipeline_correct + (Some bounds, (Some bounds, tt)) + (Some bounds) + (addmod machine_wordsize n m). + + Definition srsub prefix + := BoundsPipelineToStrings + prefix "sub" [] + (sub_gen + @ GallinaReify.Reify machine_wordsize @ GallinaReify.Reify n @ GallinaReify.Reify m) + (Some bounds, (Some bounds, tt)) + (Some bounds). + + Definition rsub_correct + := BoundsPipeline_correct + (Some bounds, (Some bounds, tt)) + (Some bounds) + (submod machine_wordsize n m). + + Definition sropp prefix + := BoundsPipelineToStrings + prefix "opp" [] + (opp_gen + @ GallinaReify.Reify machine_wordsize @ GallinaReify.Reify n @ GallinaReify.Reify m) + (Some bounds, tt) + (Some bounds). + + Definition ropp_correct + := BoundsPipeline_correct + (Some bounds, tt) + (Some bounds) + (oppmod machine_wordsize n m). + + Definition srfrom_montgomery prefix + := BoundsPipelineToStrings + prefix "from_montgomery" [] + (from_montgomery_gen + @ GallinaReify.Reify machine_wordsize @ GallinaReify.Reify n @ GallinaReify.Reify m @ GallinaReify.Reify m') + (Some bounds, tt) + (Some bounds). + + Definition rfrom_montgomery_correct + := BoundsPipeline_correct + (Some bounds, tt) + (Some bounds) + (from_montgomery_mod machine_wordsize n m m'). + + Definition srnonzero prefix + := BoundsPipelineToStrings + prefix "nonzero" [] + nonzero_gen + (Some bounds, tt) + (Some r[0~>r-1]%zrange). + + Definition rnonzero_correct + := BoundsPipeline_correct + (Some bounds, tt) + (Some r[0~>r-1]%zrange) + nonzeromod. + + Definition srselectznz prefix + := BoundsPipelineToStrings_with_bytes_no_subst01 + prefix "selectznz" [] + selectznz_gen + (Some r[0~>1], (saturated_bounds, (saturated_bounds, tt)))%zrange + saturated_bounds. + + Definition rselectznz_correct + := BoundsPipeline_with_bytes_no_subst01_correct + (Some r[0~>1], (saturated_bounds, (saturated_bounds, tt)))%zrange + saturated_bounds + Positional.select. + + Definition srto_bytes prefix + := BoundsPipelineToStrings_with_bytes_no_subst01 + prefix "to_bytes" [] + (to_bytes_gen + @ GallinaReify.Reify machine_wordsize @ GallinaReify.Reify n) + (prime_bounds, tt) + prime_bytes_bounds. + + Definition rto_bytes_correct + := BoundsPipeline_with_bytes_no_subst01_correct + (prime_bounds, tt) + prime_bytes_bounds + (to_bytesmod machine_wordsize n). + + Definition srfrom_bytes prefix + := BoundsPipelineToStrings_with_bytes_no_subst01 + prefix "from_bytes" [] + (from_bytes_gen + @ GallinaReify.Reify machine_wordsize @ GallinaReify.Reify 1 @ GallinaReify.Reify n) + (prime_bytes_bounds, tt) + prime_bounds. + + Definition rfrom_bytes_correct + := BoundsPipeline_with_bytes_no_subst01_correct + (prime_bytes_bounds, tt) + prime_bounds + (from_bytesmod machine_wordsize 1 n). + + Definition rencode_correct + := BoundsPipeline_correct + (prime_bound, tt) + (Some bounds) + (encodemod machine_wordsize n m m'). + + Definition rzero_correct + := BoundsPipeline_correct + tt + (Some bounds) + (zeromod machine_wordsize n m m'). + + Definition rone_correct + := BoundsPipeline_correct + tt + (Some bounds) + (onemod machine_wordsize n m m'). + + Notation srmulx := (srmulx machine_wordsize). + Notation srmulx_correct := (srmulx_correct machine_wordsize). + Notation sraddcarryx := (sraddcarryx machine_wordsize). + Notation sraddcarryx_correct := (sraddcarryx_correct machine_wordsize). + Notation srsubborrowx := (srsubborrowx machine_wordsize). + Notation srsubborrowx_correct := (srsubborrowx_correct machine_wordsize). + Notation srcmovznz := (srcmovznz machine_wordsize). + Notation srcmovznz_correct := (srcmovznz_correct machine_wordsize). + + (* we need to strip off [Hrv : ... = Pipeline.Success rv] and related arguments *) + Definition rmul_correctT rv : Prop + := type_of_strip_3arrow (@rmul_correct rv). + Definition rsquare_correctT rv : Prop + := type_of_strip_3arrow (@rsquare_correct rv). + Definition radd_correctT rv : Prop + := type_of_strip_3arrow (@radd_correct rv). + Definition rsub_correctT rv : Prop + := type_of_strip_3arrow (@rsub_correct rv). + Definition rfrom_montgomery_correctT rv : Prop + := type_of_strip_3arrow (@rfrom_montgomery_correct rv). + Definition ropp_correctT rv : Prop + := type_of_strip_3arrow (@ropp_correct rv). + Definition rnonzero_correctT rv : Prop + := type_of_strip_3arrow (@rnonzero_correct rv). + Definition rselectznz_correctT rv : Prop + := type_of_strip_3arrow (@rselectznz_correct rv). + Definition rto_bytes_correctT rv : Prop + := type_of_strip_3arrow (@rto_bytes_correct rv). + Definition rfrom_bytes_correctT rv : Prop + := type_of_strip_3arrow (@rfrom_bytes_correct rv). + Definition rencode_correctT rv : Prop + := type_of_strip_3arrow (@rencode_correct rv). + Definition rzero_correctT rv : Prop + := type_of_strip_3arrow (@rzero_correct rv). + Definition rone_correctT rv : Prop + := type_of_strip_3arrow (@rone_correct rv). + + Section make_ring. + Let mv : positive := Z.to_pos (s - Associational.eval c). + Context (curve_good : check_args (Success tt) = Success tt) + {rmulv} (Hrmulv : rmul_correctT rmulv) + {raddv} (Hraddv : radd_correctT raddv) + {rsubv} (Hrsubv : rsub_correctT rsubv) + {rfrom_montgomeryv} (Hrfrom_montgomeryv : rfrom_montgomery_correctT rfrom_montgomeryv) + {roppv} (Hroppv : ropp_correctT roppv) + {rzerov} (Hrzerov : rzero_correctT rzerov) + {ronev} (Hronev : rone_correctT ronev) + {rencodev} (Hrencodev : rencode_correctT rencodev) + {rnonzerov} (Hrnonzerov : rnonzero_correctT rnonzerov) + {rto_bytesv} (Hto_bytesv : rto_bytes_correctT rto_bytesv) + {rfrom_bytesv} (Hfrom_bytesv : rfrom_bytes_correctT rfrom_bytesv). + + Local Ltac use_curve_good_t := + repeat first [ assumption + | progress rewrite ?map_length, ?Z.mul_0_r, ?Pos.mul_1_r, ?Z.mul_1_r in * + | reflexivity + | lia + | rewrite interp_reify_list, ?map_map + | rewrite map_ext with (g:=id), map_id + | progress distr_length + | progress cbv [Qceiling Qfloor Qopp Qdiv Qplus inject_Z Qmult Qinv] in * + | progress cbv [Qle] in * + | progress cbn -[reify_list] in * + | progress intros + | solve [ auto ] ]. + + Lemma use_curve_good + : Z.pos mv = s - Associational.eval c + /\ Z.pos mv <> 0 + /\ s - Associational.eval c <> 0 + /\ s <> 0 + /\ 0 < machine_wordsize + /\ n <> 0%nat + /\ List.length bounds = n + /\ List.length bounds = n + /\ 0 < 1 <= machine_wordsize + /\ 0 < Associational.eval c < s + /\ (r * r') mod m = 1 + /\ (m * m') mod r = (-1) mod r + /\ 0 < machine_wordsize + /\ 1 < m + /\ m < r^n. + Proof. + clear -curve_good. + cbv [check_args fold_right] in curve_good. + cbv [bounds prime_bound m_enc prime_bounds] in *. + break_innermost_match_hyps; try discriminate. + rewrite negb_false_iff in *. + Z.ltb_to_lt. + rewrite NPeano.Nat.eqb_neq in *. + intros. + cbv [Qnum Qden Qceiling Qfloor Qopp Qdiv Qplus inject_Z Qmult Qinv] in *. + rewrite ?map_length, ?Z.mul_0_r, ?Pos.mul_1_r, ?Z.mul_1_r in *. + specialize_by lia. + repeat match goal with H := _ |- _ => subst H end. + repeat match goal with + | [ H : list_beq _ _ _ _ = true |- _ ] => apply internal_list_dec_bl in H; [ | intros; Z.ltb_to_lt; omega.. ] + end. + repeat apply conj. + { destruct (s - Associational.eval c) eqn:?; cbn; lia. } + { use_curve_good_t. } + { use_curve_good_t. } + { use_curve_good_t. } + { use_curve_good_t. } + { use_curve_good_t. } + { use_curve_good_t. } + { use_curve_good_t. } + { use_curve_good_t. } + { use_curve_good_t. } + { use_curve_good_t. } + { use_curve_good_t. } + { use_curve_good_t. } + { use_curve_good_t. } + { use_curve_good_t. } + { use_curve_good_t. } + { use_curve_good_t. } + Qed. + + (** TODO: Find a better place to put the spec for [to_bytes] *) + Definition GoodT : Prop + := @MontgomeryStyleRing.GoodT + machine_wordsize 1 + n s c + bounds + (valid machine_wordsize n m) + (Interp rfrom_montgomeryv) + (Interp rmulv) + (Interp raddv) + (Interp rsubv) + (Interp roppv) + (Interp rzerov) + (Interp ronev) + (Interp rencodev) + /\ (let to_bytesT := (base.type.list base.type.Z -> base.type.list base.type.Z)%etype in + forall f + (Hf : type.andb_bool_for_each_lhs_of_arrow (t:=to_bytesT) (@ZRange.type.option.is_bounded_by) (prime_bounds, tt) f = true), + ((ZRange.type.base.option.is_bounded_by prime_bytes_bounds (type.app_curried (Interp rto_bytesv) f) = true + /\ (forall cast_outside_of_range, type.app_curried (expr.Interp (@ident.gen_interp cast_outside_of_range) rto_bytesv) f + = type.app_curried (t:=to_bytesT) (to_bytesmod machine_wordsize n) f)) + /\ (Positional.eval (weight 8 1) n_bytes (type.app_curried (t:=to_bytesT) (to_bytesmod machine_wordsize n) f)) = (Positional.eval (weight machine_wordsize 1) n (fst f) mod m))) + /\ (forall f + (Hf : type.andb_bool_for_each_lhs_of_arrow (t:=(base.type.list base.type.Z -> base.type.Z)%etype) (@ZRange.type.option.is_bounded_by) (Some bounds, tt) f = true), (Interp rnonzerov (fst f) = 0) <-> ((@eval machine_wordsize n (from_montgomery_mod machine_wordsize n m m' (fst f))) mod m = 0)). + + (** XXX TODO MOVE ME *) + Local Opaque valid addmod submod oppmod encodemod mulmod from_montgomery_mod nonzeromod. + Theorem Good : GoodT. + Proof. + pose proof use_curve_good; destruct_head'_and; destruct_head_hnf' ex. + split; [ | split ]. + { eapply MontgomeryStyleRing.Good; + lazymatch goal with + | [ H : ?P ?rop |- context[expr.Interp _ ?rop] ] + => intros; + let H1 := fresh in + let H2 := fresh in + unshelve edestruct H as [H1 H2]; [ .. | solve [ split; [ eapply H1 | eapply H2 ] ] ]; + solve [ exact tt | eassumption | reflexivity ] + | _ => idtac + end; + repeat first [ eassumption + | eapply mulmod_correct + | eapply addmod_correct + | eapply submod_correct + | eapply oppmod_correct + | eapply encodemod_correct + | eapply from_montgomery_mod_correct + | eapply nonzeromod_correct + | intros; apply conj + | omega ]. } + { cbv zeta; intros f Hf; split. + { apply Hto_bytesv; assumption. } + { cbn [type.for_each_lhs_of_arrow type_base type.andb_bool_for_each_lhs_of_arrow ZRange.type.option.is_bounded_by fst snd] in *. + rewrite Bool.andb_true_iff in *; split_and'. + apply to_bytesmod_correct; eauto; []. + split; cbv [small]. + admit. + admit. } } + { intros. + split; [ intro H'; eapply nonzeromod_correct; + [ .. | rewrite <- H'; symmetry; eapply Hrnonzerov ] + | etransitivity; [ apply Hrnonzerov | eapply nonzeromod_correct; [ .. | eassumption ] ] ]; + try eassumption. + admit. + admit. } + Admitted. + End make_ring. + + Section for_stringification. + Definition aggregate_infos {A B C} (ls : list (A * ErrorT B (C * ToString.C.ident_infos))) : ToString.C.ident_infos + := fold_right + ToString.C.ident_info_union + ToString.C.ident_info_empty + (List.map + (fun '(_, res) => match res with + | Success (_, infos) => infos + | Error _ => ToString.C.ident_info_empty + end) + ls). + + Definition extra_synthesis (function_name_prefix : string) (infos : ToString.C.ident_infos) + : list (string * Pipeline.ErrorT (list string)) * PositiveSet.t + := let ls_addcarryx := List.flat_map + (fun lg_split:positive => [sraddcarryx function_name_prefix lg_split; srsubborrowx function_name_prefix lg_split]) + (PositiveSet.elements (ToString.C.addcarryx_lg_splits infos)) in + let ls_mulx := List.map + (fun lg_split:positive => srmulx function_name_prefix lg_split) + (PositiveSet.elements (ToString.C.mulx_lg_splits infos)) in + let ls_cmov := List.map + (fun bitwidth:positive => srcmovznz function_name_prefix bitwidth) + (PositiveSet.elements (ToString.C.cmovznz_bitwidths infos)) in + let ls := ls_addcarryx ++ ls_mulx ++ ls_cmov in + let infos := aggregate_infos ls in + (List.map (fun '(name, res) => (name, (res <- res; Success (fst res))%error)) ls, + ToString.C.bitwidths_used infos). + + Local Open Scope string_scope. + Local Open Scope list_scope. + + Definition known_functions + := [("mul", srmul); + ("square", srsquare); + ("add", sradd); + ("sub", srsub); + ("opp", sropp); + ("from_montgomery", srfrom_montgomery); + ("nonzero", srnonzero); + ("selectznz", srselectznz); + ("to_bytes", srto_bytes); + ("from_bytes", srfrom_bytes)]. + + Definition synthesize_of_name (function_name_prefix : string) (name : string) + : string * ErrorT Pipeline.ErrorMessage (list string * ToString.C.ident_infos) + := fold_right + (fun v default + => match v with + | Some res => res + | None => default + end) + ((name, + Error + (Pipeline.Invalid_argument + ("Unrecognized request to synthesize """ ++ name ++ """; valid names are " ++ String.concat ", " (List.map (@fst _ _) known_functions))))) + (map + (fun '(expected_name, resf) => if string_beq name expected_name then Some (resf function_name_prefix) else None) + known_functions). + + (** Note: If you change the name or type signature of this + function, you will need to update the code in CLI.v *) + Definition Synthesize (function_name_prefix : string) (requests : list string) + : list (string * Pipeline.ErrorT (list string)) * PositiveSet.t (* types used *) + := let ls := match requests with + | nil => List.map (fun '(_, sr) => sr function_name_prefix) known_functions + | requests => List.map (synthesize_of_name function_name_prefix) requests + end in + let infos := aggregate_infos ls in + let '(extra_ls, extra_bit_widths) := extra_synthesis function_name_prefix infos in + (extra_ls ++ List.map (fun '(name, res) => (name, (res <- res; Success (fst res))%error)) ls, + PositiveSet.union extra_bit_widths (ToString.C.bitwidths_used infos)). + End for_stringification. + End rcarry_mul. +End WordByWordMontgomery. + Module SaturatedSolinas. Section MulMod. Context (s : Z) (c : list (Z * Z)) diff --git a/src/Experiments/NewPipeline/arith_rewrite_head.out b/src/Experiments/NewPipeline/arith_rewrite_head.out new file mode 100644 index 000000000..23b5205d2 --- /dev/null +++ b/src/Experiments/NewPipeline/arith_rewrite_head.out @@ -0,0 +1,16842 @@ +arith_rewrite_head = +match idc in (ident t) return (Compile.value' true t) with +| @ident.Literal t v => + match + t as t0 + return + (base.base_interp t0 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base t0))) + with + | base.type.unit => fun v0 : unit => UnderLets.Base ##(v0)%expr + | base.type.Z => fun v0 : Z => UnderLets.Base ##(v0)%expr + | base.type.bool => fun v0 : bool => UnderLets.Base ##(v0)%expr + | base.type.nat => fun v0 : nat => UnderLets.Base ##(v0)%expr + end v +| ident.Nat_succ => + fun x : defaults.expr (type.base base.type.nat) => + UnderLets.Base (#(ident.Nat_succ)%expr @ x)%expr_pat +| ident.Nat_pred => + fun x : defaults.expr (type.base base.type.nat) => + UnderLets.Base (#(ident.Nat_pred)%expr @ x)%expr_pat +| ident.Nat_max => + fun x x0 : defaults.expr (type.base base.type.nat) => + UnderLets.Base (#(ident.Nat_max)%expr @ x @ x0)%expr_pat +| ident.Nat_mul => + fun x x0 : defaults.expr (type.base base.type.nat) => + UnderLets.Base (#(ident.Nat_mul)%expr @ x @ x0)%expr_pat +| ident.Nat_add => + fun x x0 : defaults.expr (type.base base.type.nat) => + UnderLets.Base (#(ident.Nat_add)%expr @ x @ x0)%expr_pat +| ident.Nat_sub => + fun x x0 : defaults.expr (type.base base.type.nat) => + UnderLets.Base (#(ident.Nat_sub)%expr @ x @ x0)%expr_pat +| @ident.nil t => UnderLets.Base []%expr_pat +| @ident.cons t => + fun (x : defaults.expr (type.base t)) + (x0 : defaults.expr (type.base (base.type.list t))) => + UnderLets.Base (x :: x0)%expr_pat +| @ident.pair A B => + fun (x : defaults.expr (type.base A)) (x0 : defaults.expr (type.base B)) + => UnderLets.Base (x, x0)%expr_pat +| @ident.fst A B => + fun x : defaults.expr (type.base (A * B)%etype) => + match x with + | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ #(idc)%expr_pat x1) x0 => + match + match idc with + | @ident.pair A0 B0 => Some (A0, B0) + | _ => None + end + with + | Some _ => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base A))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base A))) + with + | type.base t3 => + fun _ : defaults.expr (type.base t3) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) t2 + A + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base A))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base A)) => + match a with + | Some x' => UnderLets.Base (x' v) + | None => + UnderLets.Base (#(ident.fst)%expr @ x)%expr_pat + end) + | (s1 -> d1)%ptype => + fun _ : Compile.value' false s1 -> Compile.value' true d1 + => UnderLets.Base (#(ident.fst)%expr @ x)%expr_pat + end (Compile.reflect x0) + | (s1 -> d1)%ptype => + fun _ : Compile.value' false s1 -> Compile.value' true d1 => + UnderLets.Base (#(ident.fst)%expr @ x)%expr_pat + end (Compile.reflect x1) + | None => UnderLets.Base (#(ident.fst)%expr @ x)%expr_pat + end + | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ ($_)%expr _) _ | @expr.App _ + _ _ s _ (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _) _ | @expr.App + _ _ _ s _ (@expr.App _ _ _ s0 _ (_ @ _)%expr_pat _) _ | @expr.App _ _ _ + s _ (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _) _ => + UnderLets.Base (#(ident.fst)%expr @ x)%expr_pat + | @expr.App _ _ _ s _ #(_)%expr_pat _ | @expr.App _ _ _ s _ ($_)%expr _ | + @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.Base (#(ident.fst)%expr @ x)%expr_pat + | _ => UnderLets.Base (#(ident.fst)%expr @ x)%expr_pat + end +| @ident.snd A B => + fun x : defaults.expr (type.base (A * B)%etype) => + match x with + | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ #(idc)%expr_pat x1) x0 => + match + match idc with + | @ident.pair A0 B0 => Some (A0, B0) + | _ => None + end + with + | Some _ => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base B))) + with + | type.base t2 => + fun _ : defaults.expr (type.base t2) => + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base B))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) t3 + B + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base B))) + (fun + a : option + (defaults.expr (type.base t3) -> + defaults.expr (type.base B)) => + match a with + | Some x' => UnderLets.Base (x' v0) + | None => + UnderLets.Base (#(ident.snd)%expr @ x)%expr_pat + end) + | (s1 -> d1)%ptype => + fun _ : Compile.value' false s1 -> Compile.value' true d1 + => UnderLets.Base (#(ident.snd)%expr @ x)%expr_pat + end (Compile.reflect x0) + | (s1 -> d1)%ptype => + fun _ : Compile.value' false s1 -> Compile.value' true d1 => + UnderLets.Base (#(ident.snd)%expr @ x)%expr_pat + end (Compile.reflect x1) + | None => UnderLets.Base (#(ident.snd)%expr @ x)%expr_pat + end + | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ ($_)%expr _) _ | @expr.App _ + _ _ s _ (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _) _ | @expr.App + _ _ _ s _ (@expr.App _ _ _ s0 _ (_ @ _)%expr_pat _) _ | @expr.App _ _ _ + s _ (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _) _ => + UnderLets.Base (#(ident.snd)%expr @ x)%expr_pat + | @expr.App _ _ _ s _ #(_)%expr_pat _ | @expr.App _ _ _ s _ ($_)%expr _ | + @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.Base (#(ident.snd)%expr @ x)%expr_pat + | _ => UnderLets.Base (#(ident.snd)%expr @ x)%expr_pat + end +| @ident.prod_rect A B T => + fun + (x : defaults.expr (type.base A) -> + defaults.expr (type.base B) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base T))) + (x0 : defaults.expr (type.base (A * B)%etype)) => + UnderLets.Base + (#(ident.prod_rect)%expr @ + (λ (x1 : var (type.base A))(x2 : var (type.base B)), + UnderLets.to_expr (x ($x1) ($x2)))%expr @ x0)%expr_pat +| @ident.bool_rect T => + fun + (x + x0 : defaults.expr (type.base base.type.unit) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base T))) + (x1 : defaults.expr (type.base base.type.bool)) => + UnderLets.Base + (#(ident.bool_rect)%expr @ + (λ x2 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x2)))%expr @ + (λ x2 : var (type.base base.type.unit), + UnderLets.to_expr (x0 ($x2)))%expr @ x1)%expr_pat +| @ident.nat_rect P => + fun + (x : defaults.expr (type.base base.type.unit) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (x0 : defaults.expr (type.base base.type.nat) -> + defaults.expr (type.base P) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (x1 : defaults.expr (type.base base.type.nat)) => + UnderLets.Base + (#(ident.nat_rect)%expr @ + (λ x2 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x2)))%expr @ + (λ (x2 : var (type.base base.type.nat))(x3 : var (type.base P)), + UnderLets.to_expr (x0 ($x2) ($x3)))%expr @ x1)%expr_pat +| @ident.nat_rect_arrow P Q => + fun + (x : defaults.expr (type.base P) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base Q))) + (x0 : defaults.expr (type.base base.type.nat) -> + (defaults.expr (type.base P) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base Q))) -> + defaults.expr (type.base P) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base Q))) + (x1 : defaults.expr (type.base base.type.nat)) + (x2 : defaults.expr (type.base P)) => + UnderLets.Base + (#(ident.nat_rect_arrow)%expr @ + (λ x3 : var (type.base P), + UnderLets.to_expr (x ($x3)))%expr @ + (λ (x3 : var (type.base base.type.nat))(x4 : var + (type.base P -> + type.base Q)%ptype) + (x5 : var (type.base P)), + UnderLets.to_expr + (x0 ($x3) + (fun x6 : defaults.expr (type.base P) => + UnderLets.Base ($x4 @ x6)%expr_pat) ($x5)))%expr @ x1 @ x2)%expr_pat +| @ident.list_rect A P => + fun + (x : defaults.expr (type.base base.type.unit) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (x0 : defaults.expr (type.base A) -> + defaults.expr (type.base (base.type.list A)) -> + defaults.expr (type.base P) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (x1 : defaults.expr (type.base (base.type.list A))) => + UnderLets.Base + (#(ident.list_rect)%expr @ + (λ x2 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x2)))%expr @ + (λ (x2 : var (type.base A))(x3 : var (type.base (base.type.list A))) + (x4 : var (type.base P)), + UnderLets.to_expr (x0 ($x2) ($x3) ($x4)))%expr @ x1)%expr_pat +| @ident.list_case A P => + fun + (x : defaults.expr (type.base base.type.unit) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (x0 : defaults.expr (type.base A) -> + defaults.expr (type.base (base.type.list A)) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (x1 : defaults.expr (type.base (base.type.list A))) => + UnderLets.Base + (#(ident.list_case)%expr @ + (λ x2 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x2)))%expr @ + (λ (x2 : var (type.base A))(x3 : var (type.base (base.type.list A))), + UnderLets.to_expr (x0 ($x2) ($x3)))%expr @ x1)%expr_pat +| @ident.List_length T => + fun x : defaults.expr (type.base (base.type.list T)) => + UnderLets.Base (#(ident.List_length)%expr @ x)%expr_pat +| ident.List_seq => + fun x x0 : defaults.expr (type.base base.type.nat) => + UnderLets.Base (#(ident.List_seq)%expr @ x @ x0)%expr_pat +| @ident.List_firstn A => + fun (x : defaults.expr (type.base base.type.nat)) + (x0 : defaults.expr (type.base (base.type.list A))) => + UnderLets.Base (#(ident.List_firstn)%expr @ x @ x0)%expr_pat +| @ident.List_skipn A => + fun (x : defaults.expr (type.base base.type.nat)) + (x0 : defaults.expr (type.base (base.type.list A))) => + UnderLets.Base (#(ident.List_skipn)%expr @ x @ x0)%expr_pat +| @ident.List_repeat A => + fun (x : defaults.expr (type.base A)) + (x0 : defaults.expr (type.base base.type.nat)) => + UnderLets.Base (#(ident.List_repeat)%expr @ x @ x0)%expr_pat +| @ident.List_combine A B => + fun (x : defaults.expr (type.base (base.type.list A))) + (x0 : defaults.expr (type.base (base.type.list B))) => + UnderLets.Base (#(ident.List_combine)%expr @ x @ x0)%expr_pat +| @ident.List_map A B => + fun + (x : defaults.expr (type.base A) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base B))) + (x0 : defaults.expr (type.base (base.type.list A))) => + UnderLets.Base + (#(ident.List_map)%expr @ + (λ x1 : var (type.base A), + UnderLets.to_expr (x ($x1)))%expr @ x0)%expr_pat +| @ident.List_app A => + fun x x0 : defaults.expr (type.base (base.type.list A)) => + UnderLets.Base (x ++ x0)%expr +| @ident.List_rev A => + fun x : defaults.expr (type.base (base.type.list A)) => + UnderLets.Base (#(ident.List_rev)%expr @ x)%expr_pat +| @ident.List_flat_map A B => + fun + (x : defaults.expr (type.base A) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base (base.type.list B)))) + (x0 : defaults.expr (type.base (base.type.list A))) => + UnderLets.Base + (#(ident.List_flat_map)%expr @ + (λ x1 : var (type.base A), + UnderLets.to_expr (x ($x1)))%expr @ x0)%expr_pat +| @ident.List_partition A => + fun + (x : defaults.expr (type.base A) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.bool))) + (x0 : defaults.expr (type.base (base.type.list A))) => + UnderLets.Base + (#(ident.List_partition)%expr @ + (λ x1 : var (type.base A), + UnderLets.to_expr (x ($x1)))%expr @ x0)%expr_pat +| @ident.List_fold_right A B => + fun + (x : defaults.expr (type.base B) -> + defaults.expr (type.base A) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base A))) + (x0 : defaults.expr (type.base A)) + (x1 : defaults.expr (type.base (base.type.list B))) => + UnderLets.Base + (#(ident.List_fold_right)%expr @ + (λ (x2 : var (type.base B))(x3 : var (type.base A)), + UnderLets.to_expr (x ($x2) ($x3)))%expr @ x0 @ x1)%expr_pat +| @ident.List_update_nth T => + fun (x : defaults.expr (type.base base.type.nat)) + (x0 : defaults.expr (type.base T) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base T))) + (x1 : defaults.expr (type.base (base.type.list T))) => + UnderLets.Base + (#(ident.List_update_nth)%expr @ x @ + (λ x2 : var (type.base T), + UnderLets.to_expr (x0 ($x2)))%expr @ x1)%expr_pat +| @ident.List_nth_default T => + fun (x : defaults.expr (type.base T)) + (x0 : defaults.expr (type.base (base.type.list T))) + (x1 : defaults.expr (type.base base.type.nat)) => + UnderLets.Base (#(ident.List_nth_default)%expr @ x @ x0 @ x1)%expr_pat +| ident.Z_add => + fun x x0 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args =? 0 + then UnderLets.Base x0 + else + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + if args0 =? 0 + then UnderLets.Base x + else UnderLets.Base (x + x0)%expr + | None => UnderLets.Base (x + x0)%expr + end + | @expr.App _ _ _ s _ #(idc0)%expr_pat x1 => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + if args >? 0 + then UnderLets.Base (##(args) - x' v)%expr + else + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t3 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a0 with + | Some x'0 => + if args <? 0 + then + UnderLets.Base + (- (##((- args)%Z) + x'0 v0))%expr + else + match + s as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t4 => + fun + v1 : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr + (type.base t1)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : option + (defaults.expr + (type.base t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a1 with + | Some x'1 => + UnderLets.Base + (x - x'1 v1)%expr + | None => + UnderLets.Base + (x + x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false + s0 -> + Compile.value' true d0 + => + UnderLets.Base (x + x0)%expr + end (Compile.reflect x1) + | None => + UnderLets.Base (x + x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base (x + x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x + x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base (x + x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x + x0)%expr + end + | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ + (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ + (_ @ _)%expr_pat _ | @expr.App _ _ _ s _ + (@expr.LetIn _ _ _ _ _ _ _) _ => UnderLets.Base (x + x0)%expr + | _ => UnderLets.Base (x + x0)%expr + end + | None => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args =? 0 + then UnderLets.Base x + else UnderLets.Base (x + x0)%expr + | None => UnderLets.Base (x + x0)%expr + end + | @expr.App _ _ _ s _ #(idc0)%expr_pat x1 => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => defaults.expr (type.base t1)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (x - x' v)%expr + | None => UnderLets.Base (x + x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base (x + x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x + x0)%expr + end + | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ + (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ + (_ @ _)%expr_pat _ | @expr.App _ _ _ s _ + (@expr.LetIn _ _ _ _ _ _ _) _ => UnderLets.Base (x + x0)%expr + | _ => UnderLets.Base (x + x0)%expr + end + end + | ($_)%expr => + match x0 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t1 v0 => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args => + if args =? 0 + then UnderLets.Base x + else UnderLets.Base (x + x0)%expr + | None => UnderLets.Base (x + x0)%expr + end + | @expr.App _ _ _ s _ #(idc)%expr_pat x1 => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v0 : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => defaults.expr (type.base t1)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (x - x' v0)%expr + | None => UnderLets.Base (x + x0)%expr + end) + | (s0 -> d0)%ptype => + fun _ : Compile.value' false s0 -> Compile.value' true d0 + => UnderLets.Base (x + x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x + x0)%expr + end + | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ + (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ (_ @ _)%expr_pat + _ | @expr.App _ _ _ s _ (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.Base (x + x0)%expr + | _ => UnderLets.Base (x + x0)%expr + end + | @expr.Abs _ _ _ _ _ _ => + match x0 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match + t0 as t1 return (base.base_interp t1 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args =? 0 + then UnderLets.Base x + else UnderLets.Base (x + x0)%expr + | None => UnderLets.Base (x + x0)%expr + end + | @expr.App _ _ _ s0 _ #(idc)%expr_pat x1 => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (x - x' v)%expr + | None => UnderLets.Base (x + x0)%expr + end) + | (s1 -> d1)%ptype => + fun _ : Compile.value' false s1 -> Compile.value' true d1 + => UnderLets.Base (x + x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x + x0)%expr + end + | @expr.App _ _ _ s0 _ ($_)%expr _ | @expr.App _ _ _ s0 _ + (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 _ (_ @ _)%expr_pat + _ | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.Base (x + x0)%expr + | _ => UnderLets.Base (x + x0)%expr + end + | @expr.App _ _ _ s _ f x1 => + match x0 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match + t0 as t1 return (base.base_interp t1 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args =? 0 + then UnderLets.Base x + else + match f with + | #(idc0)%expr_pat => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args >? 0 + then + UnderLets.Base (##(args) - x' v)%expr + else + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) => + match a0 with + | Some x'0 => + if args <? 0 + then + UnderLets.Base + (- + (x'0 v0 + ##((- args)%Z)))%expr + else + match + s as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v1 : defaults.expr + (type.base t4) + => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr + (type.base t1)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a1 with + | Some x'1 => + UnderLets.Base + (x0 - x'1 v1)%expr + | None => + UnderLets.Base + (x + x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' + false s0 -> + Compile.value' + true d0 => + UnderLets.Base + (x + x0)%expr + end (Compile.reflect x1) + | None => + UnderLets.Base (x + x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base (x + x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x + x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base (x + x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x + x0)%expr + end + | _ => UnderLets.Base (x + x0)%expr + end + | None => + match f with + | #(idc0)%expr_pat => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => UnderLets.Base (x0 - x' v)%expr + | None => UnderLets.Base (x + x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base (x + x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x + x0)%expr + end + | _ => UnderLets.Base (x + x0)%expr + end + end + | ($_)%expr => + match f with + | #(idc)%expr_pat => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v0 : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => defaults.expr (type.base t1)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (x0 - x' v0)%expr + | None => UnderLets.Base (x + x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base (x + x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x + x0)%expr + end + | _ => UnderLets.Base (x + x0)%expr + end + | @expr.Abs _ _ _ _ _ _ => + match f with + | #(idc)%expr_pat => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (x0 - x' v)%expr + | None => UnderLets.Base (x + x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x + x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x + x0)%expr + end + | _ => UnderLets.Base (x + x0)%expr + end + | @expr.App _ _ _ s0 _ #(idc)%expr_pat x2 => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match f with + | #(idc0)%expr_pat => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t3 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a0 with + | Some x'0 => + UnderLets.Base + (- (x' v + x'0 v0))%expr + | None => + UnderLets.Base (x + x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x + x0)%expr + end (Compile.reflect x2) + | None => UnderLets.Base (x + x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x + x0)%expr + end (Compile.reflect x1) + | None => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => UnderLets.Base (x - x' v)%expr + | None => UnderLets.Base (x + x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x + x0)%expr + end (Compile.reflect x2) + end + | ($_)%expr => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v0 : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => defaults.expr (type.base t1)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (x - x' v0)%expr + | None => UnderLets.Base (x + x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x + x0)%expr + end (Compile.reflect x2) + | @expr.LetIn _ _ _ _ _ _ _ => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (x - x' v)%expr + | None => UnderLets.Base (x + x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x + x0)%expr + end (Compile.reflect x2) + | _ => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (x - x' v)%expr + | None => UnderLets.Base (x + x0)%expr + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base (x + x0)%expr + end (Compile.reflect x2) + end + | None => + match f with + | #(idc0)%expr_pat => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => UnderLets.Base (x0 - x' v)%expr + | None => UnderLets.Base (x + x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x + x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x + x0)%expr + end + | _ => UnderLets.Base (x + x0)%expr + end + end + | @expr.App _ _ _ s0 _ ($_)%expr _ => + match f with + | #(idc)%expr_pat => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v0 : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => defaults.expr (type.base t1)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (x0 - x' v0)%expr + | None => UnderLets.Base (x + x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x + x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x + x0)%expr + end + | _ => UnderLets.Base (x + x0)%expr + end + | @expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 + _ (_ @ _)%expr_pat _ => + match f with + | #(idc)%expr_pat => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (x0 - x' v)%expr + | None => UnderLets.Base (x + x0)%expr + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base (x + x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x + x0)%expr + end + | _ => UnderLets.Base (x + x0)%expr + end + | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => + match f with + | #(idc)%expr_pat => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (x0 - x' v)%expr + | None => UnderLets.Base (x + x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x + x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x + x0)%expr + end + | _ => UnderLets.Base (x + x0)%expr + end + | @expr.LetIn _ _ _ _ _ _ _ => + match f with + | #(idc)%expr_pat => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (x0 - x' v)%expr + | None => UnderLets.Base (x + x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base (x + x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x + x0)%expr + end + | _ => UnderLets.Base (x + x0)%expr + end + end + | @expr.LetIn _ _ _ _ _ _ _ => + match x0 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match + t0 as t1 return (base.base_interp t1 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args =? 0 + then UnderLets.Base x + else UnderLets.Base (x + x0)%expr + | None => UnderLets.Base (x + x0)%expr + end + | @expr.App _ _ _ s _ #(idc)%expr_pat x2 => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (x - x' v)%expr + | None => UnderLets.Base (x + x0)%expr + end) + | (s0 -> d0)%ptype => + fun _ : Compile.value' false s0 -> Compile.value' true d0 + => UnderLets.Base (x + x0)%expr + end (Compile.reflect x2) + | None => UnderLets.Base (x + x0)%expr + end + | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ + (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ (_ @ _)%expr_pat + _ | @expr.App _ _ _ s _ (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.Base (x + x0)%expr + | _ => UnderLets.Base (x + x0)%expr + end + end +| ident.Z_mul => + fun x x0 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args =? 0 + then UnderLets.Base ##(0)%expr + else + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + if args0 =? 0 + then UnderLets.Base ##(0)%expr + else + if args =? 1 + then UnderLets.Base x0 + else + if args0 =? 1 + then UnderLets.Base x + else + if args =? -1 + then UnderLets.Base (- x0)%expr + else + if args0 =? -1 + then UnderLets.Base (- x)%expr + else + if args <? 0 + then UnderLets.Base (- (##((- args)%Z) * x0))%expr + else + if args0 <? 0 + then UnderLets.Base (- (x * ##((- args0)%Z)))%expr + else + if + (args0 =? 2 ^ Z.log2 args0) && negb (args0 =? 2) + then UnderLets.Base (x << ##(Z.log2 args0))%expr + else + if (args =? 2 ^ Z.log2 args) && negb (args =? 2) + then UnderLets.Base (x0 << ##(Z.log2 args))%expr + else UnderLets.Base (x * x0)%expr + | None => + if args =? 1 + then UnderLets.Base x0 + else + if args =? -1 + then UnderLets.Base (- x0)%expr + else + if args <? 0 + then UnderLets.Base (- (##((- args)%Z) * x0))%expr + else + if (args =? 2 ^ Z.log2 args) && negb (args =? 2) + then UnderLets.Base (x0 << ##(Z.log2 args))%expr + else UnderLets.Base (x * x0)%expr + end + | @expr.App _ _ _ s _ f x1 => + if args =? 1 + then UnderLets.Base x0 + else + match f with + | #(idc0)%expr_pat => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? -1 + then UnderLets.Base (x' v) + else + if args =? -1 + then UnderLets.Base (- x0)%expr + else + if args <? 0 + then + UnderLets.Base + (- (##((- args)%Z) * x0))%expr + else + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) + t3 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + UnderLets.Base + (- (x * x'0 v0))%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => + if args =? -1 + then UnderLets.Base (- x0)%expr + else + if args <? 0 + then UnderLets.Base (- (##((- args)%Z) * x0))%expr + else + if (args =? 2 ^ Z.log2 args) && negb (args =? 2) + then UnderLets.Base (x0 << ##(Z.log2 args))%expr + else UnderLets.Base (x * x0)%expr + end + | _ => + if args =? -1 + then UnderLets.Base (- x0)%expr + else + if args <? 0 + then UnderLets.Base (- (##((- args)%Z) * x0))%expr + else + if (args =? 2 ^ Z.log2 args) && negb (args =? 2) + then UnderLets.Base (x0 << ##(Z.log2 args))%expr + else UnderLets.Base (x * x0)%expr + end + | _ => + if args =? 1 + then UnderLets.Base x0 + else + if args =? -1 + then UnderLets.Base (- x0)%expr + else + if args <? 0 + then UnderLets.Base (- (##((- args)%Z) * x0))%expr + else + if (args =? 2 ^ Z.log2 args) && negb (args =? 2) + then UnderLets.Base (x0 << ##(Z.log2 args))%expr + else UnderLets.Base (x * x0)%expr + end + | None => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args =? 0 + then UnderLets.Base ##(0)%expr + else + if args =? 1 + then UnderLets.Base x + else + if args =? -1 + then UnderLets.Base (- x)%expr + else + if args <? 0 + then UnderLets.Base (- (x * ##((- args)%Z)))%expr + else + if (args =? 2 ^ Z.log2 args) && negb (args =? 2) + then UnderLets.Base (x << ##(Z.log2 args))%expr + else UnderLets.Base (x * x0)%expr + | None => UnderLets.Base (x * x0)%expr + end + | @expr.App _ _ _ s _ #(idc0)%expr_pat x1 => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => defaults.expr (type.base t1)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (- (x * x' v))%expr + | None => UnderLets.Base (x * x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr + end + | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ + (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ + (_ @ _)%expr_pat _ | @expr.App _ _ _ s _ + (@expr.LetIn _ _ _ _ _ _ _) _ => UnderLets.Base (x * x0)%expr + | _ => UnderLets.Base (x * x0)%expr + end + end + | ($_)%expr => + match x0 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t1 v0 => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args => + if args =? 0 + then UnderLets.Base ##(0)%expr + else + if args =? 1 + then UnderLets.Base x + else + if args =? -1 + then UnderLets.Base (- x)%expr + else + if args <? 0 + then UnderLets.Base (- (x * ##((- args)%Z)))%expr + else + if (args =? 2 ^ Z.log2 args) && negb (args =? 2) + then UnderLets.Base (x << ##(Z.log2 args))%expr + else UnderLets.Base (x * x0)%expr + | None => UnderLets.Base (x * x0)%expr + end + | @expr.App _ _ _ s _ #(idc)%expr_pat x1 => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v0 : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => defaults.expr (type.base t1)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (- (x * x' v0))%expr + | None => UnderLets.Base (x * x0)%expr + end) + | (s0 -> d0)%ptype => + fun _ : Compile.value' false s0 -> Compile.value' true d0 + => UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr + end + | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ + (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ (_ @ _)%expr_pat + _ | @expr.App _ _ _ s _ (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.Base (x * x0)%expr + | _ => UnderLets.Base (x * x0)%expr + end + | @expr.Abs _ _ _ _ _ _ => + match x0 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match + t0 as t1 return (base.base_interp t1 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args =? 0 + then UnderLets.Base ##(0)%expr + else + if args =? 1 + then UnderLets.Base x + else + if args =? -1 + then UnderLets.Base (- x)%expr + else + if args <? 0 + then UnderLets.Base (- (x * ##((- args)%Z)))%expr + else + if (args =? 2 ^ Z.log2 args) && negb (args =? 2) + then UnderLets.Base (x << ##(Z.log2 args))%expr + else UnderLets.Base (x * x0)%expr + | None => UnderLets.Base (x * x0)%expr + end + | @expr.App _ _ _ s0 _ #(idc)%expr_pat x1 => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (- (x * x' v))%expr + | None => UnderLets.Base (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun _ : Compile.value' false s1 -> Compile.value' true d1 + => UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr + end + | @expr.App _ _ _ s0 _ ($_)%expr _ | @expr.App _ _ _ s0 _ + (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 _ (_ @ _)%expr_pat + _ | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.Base (x * x0)%expr + | _ => UnderLets.Base (x * x0)%expr + end + | @expr.App _ _ _ s _ f x1 => + match x0 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match + t0 as t1 return (base.base_interp t1 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args =? 0 + then UnderLets.Base ##(0)%expr + else + if args =? 1 + then UnderLets.Base x + else + match f with + | #(idc0)%expr_pat => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? -1 + then UnderLets.Base (x' v) + else + if args =? -1 + then UnderLets.Base (- x)%expr + else + if args <? 0 + then + UnderLets.Base + (- (x * ##((- args)%Z)))%expr + else + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) + t3 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + UnderLets.Base + (- (x'0 v0 * x0))%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => + if args =? -1 + then UnderLets.Base (- x)%expr + else + if args <? 0 + then UnderLets.Base (- (x * ##((- args)%Z)))%expr + else + if (args =? 2 ^ Z.log2 args) && negb (args =? 2) + then UnderLets.Base (x << ##(Z.log2 args))%expr + else UnderLets.Base (x * x0)%expr + end + | _ => + if args =? -1 + then UnderLets.Base (- x)%expr + else + if args <? 0 + then UnderLets.Base (- (x * ##((- args)%Z)))%expr + else + if (args =? 2 ^ Z.log2 args) && negb (args =? 2) + then UnderLets.Base (x << ##(Z.log2 args))%expr + else UnderLets.Base (x * x0)%expr + end + | None => + match f with + | #(idc0)%expr_pat => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + UnderLets.Base (- (x' v * x0))%expr + | None => UnderLets.Base (x * x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + end + | ($_)%expr => + match f with + | #(idc)%expr_pat => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v0 : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => defaults.expr (type.base t1)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (- (x' v0 * x0))%expr + | None => UnderLets.Base (x * x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | @expr.Abs _ _ _ _ _ _ => + match f with + | #(idc)%expr_pat => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (- (x' v * x0))%expr + | None => UnderLets.Base (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | @expr.App _ _ _ s0 _ #(idc)%expr_pat x2 => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match f with + | #(idc0)%expr_pat => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t3 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a0 with + | Some x'0 => + UnderLets.Base + (x' v * x'0 v0)%expr + | None => + UnderLets.Base (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => UnderLets.Base (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + UnderLets.Base (- (x * x' v))%expr + | None => UnderLets.Base (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + end + | ($_)%expr => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v0 : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => defaults.expr (type.base t1)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (- (x * x' v0))%expr + | None => UnderLets.Base (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | @expr.LetIn _ _ _ _ _ _ _ => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (- (x * x' v))%expr + | None => UnderLets.Base (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | _ => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (- (x * x' v))%expr + | None => UnderLets.Base (x * x0)%expr + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + end + | None => + match f with + | #(idc0)%expr_pat => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + UnderLets.Base (- (x' v * x0))%expr + | None => UnderLets.Base (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + end + | @expr.App _ _ _ s0 _ ($_)%expr _ => + match f with + | #(idc)%expr_pat => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v0 : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => defaults.expr (type.base t1)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (- (x' v0 * x0))%expr + | None => UnderLets.Base (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | @expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 + _ (_ @ _)%expr_pat _ => + match f with + | #(idc)%expr_pat => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (- (x' v * x0))%expr + | None => UnderLets.Base (x * x0)%expr + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => + match f with + | #(idc)%expr_pat => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (- (x' v * x0))%expr + | None => UnderLets.Base (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | @expr.LetIn _ _ _ _ _ _ _ => + match f with + | #(idc)%expr_pat => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (- (x' v * x0))%expr + | None => UnderLets.Base (x * x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + end + | @expr.LetIn _ _ _ _ _ _ _ => + match x0 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match + t0 as t1 return (base.base_interp t1 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args =? 0 + then UnderLets.Base ##(0)%expr + else + if args =? 1 + then UnderLets.Base x + else + if args =? -1 + then UnderLets.Base (- x)%expr + else + if args <? 0 + then UnderLets.Base (- (x * ##((- args)%Z)))%expr + else + if (args =? 2 ^ Z.log2 args) && negb (args =? 2) + then UnderLets.Base (x << ##(Z.log2 args))%expr + else UnderLets.Base (x * x0)%expr + | None => UnderLets.Base (x * x0)%expr + end + | @expr.App _ _ _ s _ #(idc)%expr_pat x2 => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (- (x * x' v))%expr + | None => UnderLets.Base (x * x0)%expr + end) + | (s0 -> d0)%ptype => + fun _ : Compile.value' false s0 -> Compile.value' true d0 + => UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => UnderLets.Base (x * x0)%expr + end + | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ + (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ (_ @ _)%expr_pat + _ | @expr.App _ _ _ s _ (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.Base (x * x0)%expr + | _ => UnderLets.Base (x * x0)%expr + end + end +| ident.Z_pow => + fun x x0 : defaults.expr (type.base base.type.Z) => + UnderLets.Base (#(ident.Z_pow)%expr @ x @ x0)%expr_pat +| ident.Z_sub => + fun x x0 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + if args =? 0 + then UnderLets.Base (- x0)%expr + else + if args0 =? 0 + then UnderLets.Base x + else + if args <? 0 + then UnderLets.Base (- (##((- args)%Z) + x0))%expr + else + if args0 <? 0 + then UnderLets.Base (x + ##((- args0)%Z))%expr + else UnderLets.Base (x - x0)%expr + | None => + if args =? 0 + then UnderLets.Base (- x0)%expr + else + if args <? 0 + then UnderLets.Base (- (##((- args)%Z) + x0))%expr + else UnderLets.Base (x - x0)%expr + end + | @expr.App _ _ _ s _ #(idc0)%expr_pat x1 => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => defaults.expr (type.base t1)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 0 + then UnderLets.Base (x' v) + else + if args =? 0 + then UnderLets.Base (- x0)%expr + else + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t3 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a0 with + | Some x'0 => + if args >? 0 + then + UnderLets.Base + (##(args) + x'0 v0)%expr + else + match + s as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t4 => + fun + v1 : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr + (type.base t1)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : option + (defaults.expr + (type.base t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a1 with + | Some x'1 => + if args <? 0 + then + UnderLets.Base + (x'1 v1 - + ##((- args)%Z))%expr + else + if args <? 0 + then + UnderLets.Base + (- + (##((- args)%Z) + + x0))%expr + else + match + s as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t5 => + fun + v2 : + defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t1 : base.type + => + defaults.expr + (type.base + t1)) t5 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + UnderLets.Base + (x + + x'2 v2)%expr + | None => + UnderLets.Base + (x - x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' + false s0 -> + Compile.value' + true d0 + => + UnderLets.Base + (x - x0)%expr + end + (Compile.reflect + x1) + | None => + UnderLets.Base + (x - x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false + s0 -> + Compile.value' true d0 + => + UnderLets.Base (x - x0)%expr + end (Compile.reflect x1) + | None => + UnderLets.Base (x - x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base (x - x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x - x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base (x - x0)%expr + end (Compile.reflect x1) + | None => + if args =? 0 + then UnderLets.Base (- x0)%expr + else + if args <? 0 + then UnderLets.Base (- (##((- args)%Z) + x0))%expr + else UnderLets.Base (x - x0)%expr + end + | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ + (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ + (_ @ _)%expr_pat _ | @expr.App _ _ _ s _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + if args =? 0 + then UnderLets.Base (- x0)%expr + else + if args <? 0 + then UnderLets.Base (- (##((- args)%Z) + x0))%expr + else UnderLets.Base (x - x0)%expr + | _ => + if args =? 0 + then UnderLets.Base (- x0)%expr + else + if args <? 0 + then UnderLets.Base (- (##((- args)%Z) + x0))%expr + else UnderLets.Base (x - x0)%expr + end + | None => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args =? 0 + then UnderLets.Base x + else + if args <? 0 + then UnderLets.Base (x + ##((- args)%Z))%expr + else UnderLets.Base (x - x0)%expr + | None => UnderLets.Base (x - x0)%expr + end + | @expr.App _ _ _ s _ #(idc0)%expr_pat x1 => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => defaults.expr (type.base t1)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (x + x' v)%expr + | None => UnderLets.Base (x - x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base (x - x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x - x0)%expr + end + | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ + (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ + (_ @ _)%expr_pat _ | @expr.App _ _ _ s _ + (@expr.LetIn _ _ _ _ _ _ _) _ => UnderLets.Base (x - x0)%expr + | _ => UnderLets.Base (x - x0)%expr + end + end + | ($_)%expr => + match x0 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t1 v0 => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args => + if args =? 0 + then UnderLets.Base x + else + if args <? 0 + then UnderLets.Base (x + ##((- args)%Z))%expr + else UnderLets.Base (x - x0)%expr + | None => UnderLets.Base (x - x0)%expr + end + | @expr.App _ _ _ s _ #(idc)%expr_pat x1 => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v0 : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => defaults.expr (type.base t1)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (x + x' v0)%expr + | None => UnderLets.Base (x - x0)%expr + end) + | (s0 -> d0)%ptype => + fun _ : Compile.value' false s0 -> Compile.value' true d0 + => UnderLets.Base (x - x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x - x0)%expr + end + | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ + (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ (_ @ _)%expr_pat + _ | @expr.App _ _ _ s _ (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.Base (x - x0)%expr + | _ => UnderLets.Base (x - x0)%expr + end + | @expr.Abs _ _ _ _ _ _ => + match x0 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match + t0 as t1 return (base.base_interp t1 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args =? 0 + then UnderLets.Base x + else + if args <? 0 + then UnderLets.Base (x + ##((- args)%Z))%expr + else UnderLets.Base (x - x0)%expr + | None => UnderLets.Base (x - x0)%expr + end + | @expr.App _ _ _ s0 _ #(idc)%expr_pat x1 => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (x + x' v)%expr + | None => UnderLets.Base (x - x0)%expr + end) + | (s1 -> d1)%ptype => + fun _ : Compile.value' false s1 -> Compile.value' true d1 + => UnderLets.Base (x - x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x - x0)%expr + end + | @expr.App _ _ _ s0 _ ($_)%expr _ | @expr.App _ _ _ s0 _ + (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 _ (_ @ _)%expr_pat + _ | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.Base (x - x0)%expr + | _ => UnderLets.Base (x - x0)%expr + end + | @expr.App _ _ _ s _ f x1 => + match x0 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match + t0 as t1 return (base.base_interp t1 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args =? 0 + then UnderLets.Base x + else + match f with + | #(idc0)%expr_pat => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args >? 0 + then + UnderLets.Base + (- (x' v + ##((- args)%Z)))%expr + else + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) => + match a0 with + | Some x'0 => + if args <? 0 + then + UnderLets.Base + (##((- args)%Z) - x'0 v0)%expr + else + if args <? 0 + then + UnderLets.Base + (x + ##((- args)%Z))%expr + else + match + s as t4 + return + (Compile.value' false + t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v1 : defaults.expr + (type.base t4) + => + base.try_make_transport_cps + (fun t1 : base.type + => + defaults.expr + (type.base t1)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a1 with + | Some x'1 => + UnderLets.Base + (- + (x'1 v1 + x0))%expr + | None => + UnderLets.Base + (x - x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' + false s0 -> + Compile.value' + true d0 => + UnderLets.Base + (x - x0)%expr + end (Compile.reflect x1) + | None => + UnderLets.Base (x - x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base (x - x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x - x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base (x - x0)%expr + end (Compile.reflect x1) + | None => + if args <? 0 + then UnderLets.Base (x + ##((- args)%Z))%expr + else UnderLets.Base (x - x0)%expr + end + | _ => + if args <? 0 + then UnderLets.Base (x + ##((- args)%Z))%expr + else UnderLets.Base (x - x0)%expr + end + | None => + match f with + | #(idc0)%expr_pat => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + UnderLets.Base (- (x' v + x0))%expr + | None => UnderLets.Base (x - x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base (x - x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x - x0)%expr + end + | _ => UnderLets.Base (x - x0)%expr + end + end + | ($_)%expr => + match f with + | #(idc)%expr_pat => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v0 : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => defaults.expr (type.base t1)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (- (x' v0 + x0))%expr + | None => UnderLets.Base (x - x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base (x - x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x - x0)%expr + end + | _ => UnderLets.Base (x - x0)%expr + end + | @expr.Abs _ _ _ _ _ _ => + match f with + | #(idc)%expr_pat => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (- (x' v + x0))%expr + | None => UnderLets.Base (x - x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x - x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x - x0)%expr + end + | _ => UnderLets.Base (x - x0)%expr + end + | @expr.App _ _ _ s0 _ #(idc)%expr_pat x2 => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match f with + | #(idc0)%expr_pat => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t3 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a0 with + | Some x'0 => + UnderLets.Base + (x'0 v0 - x' v)%expr + | None => + UnderLets.Base (x - x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x - x0)%expr + end (Compile.reflect x2) + | None => UnderLets.Base (x - x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x - x0)%expr + end (Compile.reflect x1) + | None => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => UnderLets.Base (x + x' v)%expr + | None => UnderLets.Base (x - x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x - x0)%expr + end (Compile.reflect x2) + end + | ($_)%expr => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v0 : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => defaults.expr (type.base t1)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (x + x' v0)%expr + | None => UnderLets.Base (x - x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x - x0)%expr + end (Compile.reflect x2) + | @expr.LetIn _ _ _ _ _ _ _ => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (x + x' v)%expr + | None => UnderLets.Base (x - x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x - x0)%expr + end (Compile.reflect x2) + | _ => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (x + x' v)%expr + | None => UnderLets.Base (x - x0)%expr + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base (x - x0)%expr + end (Compile.reflect x2) + end + | None => + match f with + | #(idc0)%expr_pat => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + UnderLets.Base (- (x' v + x0))%expr + | None => UnderLets.Base (x - x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x - x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x - x0)%expr + end + | _ => UnderLets.Base (x - x0)%expr + end + end + | @expr.App _ _ _ s0 _ ($_)%expr _ => + match f with + | #(idc)%expr_pat => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v0 : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => defaults.expr (type.base t1)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (- (x' v0 + x0))%expr + | None => UnderLets.Base (x - x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x - x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x - x0)%expr + end + | _ => UnderLets.Base (x - x0)%expr + end + | @expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 + _ (_ @ _)%expr_pat _ => + match f with + | #(idc)%expr_pat => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (- (x' v + x0))%expr + | None => UnderLets.Base (x - x0)%expr + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base (x - x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x - x0)%expr + end + | _ => UnderLets.Base (x - x0)%expr + end + | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => + match f with + | #(idc)%expr_pat => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (- (x' v + x0))%expr + | None => UnderLets.Base (x - x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x - x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x - x0)%expr + end + | _ => UnderLets.Base (x - x0)%expr + end + | @expr.LetIn _ _ _ _ _ _ _ => + match f with + | #(idc)%expr_pat => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (- (x' v + x0))%expr + | None => UnderLets.Base (x - x0)%expr + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base (x - x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x - x0)%expr + end + | _ => UnderLets.Base (x - x0)%expr + end + end + | @expr.LetIn _ _ _ _ _ _ _ => + match x0 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match + t0 as t1 return (base.base_interp t1 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args =? 0 + then UnderLets.Base x + else + if args <? 0 + then UnderLets.Base (x + ##((- args)%Z))%expr + else UnderLets.Base (x - x0)%expr + | None => UnderLets.Base (x - x0)%expr + end + | @expr.App _ _ _ s _ #(idc)%expr_pat x2 => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (x + x' v)%expr + | None => UnderLets.Base (x - x0)%expr + end) + | (s0 -> d0)%ptype => + fun _ : Compile.value' false s0 -> Compile.value' true d0 + => UnderLets.Base (x - x0)%expr + end (Compile.reflect x2) + | None => UnderLets.Base (x - x0)%expr + end + | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ + (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ (_ @ _)%expr_pat + _ | @expr.App _ _ _ s _ (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.Base (x - x0)%expr + | _ => UnderLets.Base (x - x0)%expr + end + end +| ident.Z_opp => + fun x : defaults.expr (type.base base.type.Z) => + match x with + | ($_)%expr => + if negb (SubstVarLike.is_var_fst_snd_pair_opp x) + then + UnderLets.UnderLet x + (fun v0 : var (type.base base.type.Z) => + UnderLets.Base (- $v0)%expr) + else UnderLets.Base (- x)%expr + | @expr.App _ _ _ s _ #(idc)%expr_pat x0 => + match match idc with + | ident.Z_opp => Some tt + | _ => None + end with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => UnderLets.Base (x' v) + | None => UnderLets.Base (- x)%expr + end) + | (s0 -> d0)%ptype => + fun _ : Compile.value' false s0 -> Compile.value' true d0 => + UnderLets.Base (- x)%expr + end (Compile.reflect x0) + | None => + if negb (SubstVarLike.is_var_fst_snd_pair_opp x) + then + UnderLets.UnderLet x + (fun v : var (type.base base.type.Z) => + UnderLets.Base (- $v)%expr) + else UnderLets.Base (- x)%expr + end + | @expr.App _ _ _ s _ ($_)%expr _ => + if negb (SubstVarLike.is_var_fst_snd_pair_opp x) + then + UnderLets.UnderLet x + (fun v0 : var (type.base base.type.Z) => + UnderLets.Base (- $v0)%expr) + else UnderLets.Base (- x)%expr + | @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ + (_ @ _)%expr_pat _ | @expr.App _ _ _ s _ (@expr.LetIn _ _ _ _ _ _ _) + _ => + if negb (SubstVarLike.is_var_fst_snd_pair_opp x) + then + UnderLets.UnderLet x + (fun v : var (type.base base.type.Z) => UnderLets.Base (- $v)%expr) + else UnderLets.Base (- x)%expr + | _ => + if negb (SubstVarLike.is_var_fst_snd_pair_opp x) + then + UnderLets.UnderLet x + (fun v : var (type.base base.type.Z) => UnderLets.Base (- $v)%expr) + else UnderLets.Base (- x)%expr + end +| ident.Z_div => + fun x x0 : defaults.expr (type.base base.type.Z) => + match x0 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args =? 1 + then UnderLets.Base x + else + if args =? 2 ^ Z.log2 args + then UnderLets.Base (x >> ##(Z.log2 args))%expr + else UnderLets.Base (x / x0)%expr + | None => UnderLets.Base (x / x0)%expr + end + | _ => UnderLets.Base (x / x0)%expr + end +| ident.Z_modulo => + fun x x0 : defaults.expr (type.base base.type.Z) => + match x0 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args =? 1 + then UnderLets.Base ##(0)%expr + else + if args =? 2 ^ Z.log2 args + then UnderLets.Base (x &' ##((args - 1)%Z))%expr + else UnderLets.Base (x mod x0)%expr + | None => UnderLets.Base (x mod x0)%expr + end + | _ => UnderLets.Base (x mod x0)%expr + end +| ident.Z_log2 => + fun x : defaults.expr (type.base base.type.Z) => + UnderLets.Base (#(ident.Z_log2)%expr @ x)%expr_pat +| ident.Z_log2_up => + fun x : defaults.expr (type.base base.type.Z) => + UnderLets.Base (#(ident.Z_log2_up)%expr @ x)%expr_pat +| ident.Z_eqb => + fun x x0 : defaults.expr (type.base base.type.Z) => + UnderLets.Base (#(ident.Z_eqb)%expr @ x @ x0)%expr_pat +| ident.Z_leb => + fun x x0 : defaults.expr (type.base base.type.Z) => + UnderLets.Base (#(ident.Z_leb)%expr @ x @ x0)%expr_pat +| ident.Z_geb => + fun x x0 : defaults.expr (type.base base.type.Z) => + UnderLets.Base (#(ident.Z_geb)%expr @ x @ x0)%expr_pat +| ident.Z_of_nat => + fun x : defaults.expr (type.base base.type.nat) => + UnderLets.Base (#(ident.Z_of_nat)%expr @ x)%expr_pat +| ident.Z_to_nat => + fun x : defaults.expr (type.base base.type.Z) => + UnderLets.Base (#(ident.Z_to_nat)%expr @ x)%expr_pat +| ident.Z_shiftr => + fun x x0 : defaults.expr (type.base base.type.Z) => + UnderLets.Base (x >> x0)%expr +| ident.Z_shiftl => + fun x x0 : defaults.expr (type.base base.type.Z) => + UnderLets.Base (x << x0)%expr +| ident.Z_land => + fun x x0 : defaults.expr (type.base base.type.Z) => + match x0 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args =? 0 + then UnderLets.Base ##(0)%expr + else + match x with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + if args0 =? 0 + then UnderLets.Base ##(0)%expr + else UnderLets.Base (x &' x0)%expr + | None => UnderLets.Base (x &' x0)%expr + end + | _ => UnderLets.Base (x &' x0)%expr + end + | None => + match x with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args =? 0 + then UnderLets.Base ##(0)%expr + else UnderLets.Base (x &' x0)%expr + | None => UnderLets.Base (x &' x0)%expr + end + | _ => UnderLets.Base (x &' x0)%expr + end + end + | ($_)%expr => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t1 v0 => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args => + if args =? 0 + then UnderLets.Base ##(0)%expr + else UnderLets.Base (x &' x0)%expr + | None => UnderLets.Base (x &' x0)%expr + end + | _ => UnderLets.Base (x &' x0)%expr + end + | _ => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match + t0 as t1 return (base.base_interp t1 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args =? 0 + then UnderLets.Base ##(0)%expr + else UnderLets.Base (x &' x0)%expr + | None => UnderLets.Base (x &' x0)%expr + end + | _ => UnderLets.Base (x &' x0)%expr + end + end +| ident.Z_lor => + fun x x0 : defaults.expr (type.base base.type.Z) => + UnderLets.Base (x || x0)%expr +| ident.Z_bneg => + fun x : defaults.expr (type.base base.type.Z) => + UnderLets.Base (#(ident.Z_bneg)%expr @ x)%expr_pat +| ident.Z_lnot_modulo => + fun x x0 : defaults.expr (type.base base.type.Z) => + UnderLets.Base (#(ident.Z_lnot_modulo)%expr @ x @ x0)%expr_pat +| ident.Z_mul_split => + fun x x0 x1 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some _ => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + if args0 =? 0 + then UnderLets.Base (##(0)%expr, ##(0)%expr)%expr_pat + else + match x1 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + if args1 =? 0 + then + UnderLets.Base + (##(0)%expr, ##(0)%expr)%expr_pat + else + if args0 =? 1 + then UnderLets.Base (x1, ##(0)%expr)%expr_pat + else + if args1 =? 1 + then UnderLets.Base (x0, ##(0)%expr)%expr_pat + else + if args0 =? -1 + then + UnderLets.Base + ((- x1)%expr, ##(0)%expr)%expr_pat + else + if args1 =? -1 + then + UnderLets.Base + ((- x0)%expr, ##(0)%expr)%expr_pat + else + UnderLets.UnderLet + (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + if args0 =? 1 + then UnderLets.Base (x1, ##(0)%expr)%expr_pat + else + if args0 =? -1 + then + UnderLets.Base + ((- x1)%expr, ##(0)%expr)%expr_pat + else + UnderLets.UnderLet + (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + if args0 =? 1 + then UnderLets.Base (x1, ##(0)%expr)%expr_pat + else + if args0 =? -1 + then + UnderLets.Base ((- x1)%expr, ##(0)%expr)%expr_pat + else + UnderLets.UnderLet + (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + if args0 =? 1 + then UnderLets.Base (x1, ##(0)%expr)%expr_pat + else + if args0 =? -1 + then + UnderLets.Base ((- x1)%expr, ##(0)%expr)%expr_pat + else + UnderLets.UnderLet + (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | None => + match x1 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + if args0 =? 0 + then + UnderLets.Base (##(0)%expr, ##(0)%expr)%expr_pat + else + if args0 =? 1 + then UnderLets.Base (x0, ##(0)%expr)%expr_pat + else + if args0 =? -1 + then + UnderLets.Base + ((- x0)%expr, ##(0)%expr)%expr_pat + else + UnderLets.UnderLet + (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + UnderLets.UnderLet + (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + end + | ($_)%expr => + match x1 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t2 v0 => + match + t2 as t3 return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args0 => + if args0 =? 0 + then UnderLets.Base (##(0)%expr, ##(0)%expr)%expr_pat + else + if args0 =? 1 + then UnderLets.Base (x0, ##(0)%expr)%expr_pat + else + if args0 =? -1 + then + UnderLets.Base ((- x0)%expr, ##(0)%expr)%expr_pat + else + UnderLets.UnderLet + (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | None => + UnderLets.UnderLet + (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat + (fun + v1 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | _ => + match x1 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + if args0 =? 0 + then UnderLets.Base (##(0)%expr, ##(0)%expr)%expr_pat + else + if args0 =? 1 + then UnderLets.Base (x0, ##(0)%expr)%expr_pat + else + if args0 =? -1 + then + UnderLets.Base ((- x0)%expr, ##(0)%expr)%expr_pat + else + UnderLets.UnderLet + (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + UnderLets.UnderLet + (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + end + | None => + UnderLets.UnderLet + (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + UnderLets.UnderLet (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end +| ident.Z_add_get_carry => + fun x x0 x1 : defaults.expr (type.base base.type.Z) => + match x0 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x1 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x1 @ + ##((- args)%Z)%expr)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + if args0 <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ + ##((- args0)%Z)%expr)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + if args =? 0 + then UnderLets.Base (x1, ##(0)%expr)%expr_pat + else + if args0 =? 0 + then UnderLets.Base (x0, ##(0)%expr)%expr_pat + else + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x1 @ + ##((- args)%Z)%expr)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + if args =? 0 + then UnderLets.Base (x1, ##(0)%expr)%expr_pat + else + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x1 @ + ##((- args)%Z)%expr)%expr_pat + (fun + v0 : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + if args =? 0 + then UnderLets.Base (x1, ##(0)%expr)%expr_pat + else + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun + v0 : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s _ #(idc0)%expr_pat x2 => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => defaults.expr (type.base t1)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ + x' v)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end (Compile.reflect x2) + | None => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x1 @ + ##((- args)%Z)%expr)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + if args =? 0 + then UnderLets.Base (x1, ##(0)%expr)%expr_pat + else + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s _ ($_)%expr _ => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x1 @ + ##((- args)%Z)%expr)%expr_pat + (fun + v0 : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + if args =? 0 + then UnderLets.Base (x1, ##(0)%expr)%expr_pat + else + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun + v0 : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ + s _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x1 @ + ##((- args)%Z)%expr)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + if args =? 0 + then UnderLets.Base (x1, ##(0)%expr)%expr_pat + else + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun + v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | _ => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x1 @ + ##((- args)%Z)%expr)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + if args =? 0 + then UnderLets.Base (x1, ##(0)%expr)%expr_pat + else + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun + v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | None => + match x1 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ + ##((- args)%Z)%expr)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + if args =? 0 + then UnderLets.Base (x0, ##(0)%expr)%expr_pat + else + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s _ #(idc0)%expr_pat x2 => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => defaults.expr (type.base t1)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ + x' v)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end (Compile.reflect x2) + | None => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s _ ($_)%expr _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ + s _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + end + | ($_)%expr => + match x1 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t1 v0 => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ + ##((- args)%Z)%expr)%expr_pat + (fun + v0 : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + if args =? 0 + then UnderLets.Base (x0, ##(0)%expr)%expr_pat + else + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun + v0 : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | None => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v1 : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + | @expr.App _ _ _ s _ #(idc)%expr_pat x2 => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v0 : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => defaults.expr (type.base t1)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ x' v0)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + (- (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end) + | (s0 -> d0)%ptype => + fun _ : Compile.value' false s0 -> Compile.value' true d0 + => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end (Compile.reflect x2) + | None => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | @expr.App _ _ _ s _ ($_)%expr _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v1 : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + | @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ + (_ @ _)%expr_pat _ | @expr.App _ _ _ s _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | @expr.Abs _ _ _ _ _ _ => + match x1 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match + t0 as t1 return (base.base_interp t1 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ + ##((- args)%Z)%expr)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + if args =? 0 + then UnderLets.Base (x0, ##(0)%expr)%expr_pat + else + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun + v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s0 _ #(idc)%expr_pat x2 => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ x' v)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end) + | (s1 -> d1)%ptype => + fun _ : Compile.value' false s1 -> Compile.value' true d1 + => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end (Compile.reflect x2) + | None => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s0 _ ($_)%expr _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 + _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s0 _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s _ #(idc)%expr_pat x2 => + match match idc with + | ident.Z_opp => Some tt + | _ => None + end with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x1 @ x' v)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end) + | (s0 -> d0)%ptype => + fun _ : Compile.value' false s0 -> Compile.value' true d0 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end (Compile.reflect x2) + | None => + match x1 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ + ##((- args)%Z)%expr)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + if args =? 0 + then UnderLets.Base (x0, ##(0)%expr)%expr_pat + else + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s0 _ #(idc0)%expr_pat x3 => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => defaults.expr (type.base t1)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ + x' v)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s0 _ ($_)%expr _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ + _ s0 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s0 _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + end + | @expr.App _ _ _ s _ ($_)%expr _ => + match x1 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t1 v0 => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ + ##((- args)%Z)%expr)%expr_pat + (fun + v0 : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + if args =? 0 + then UnderLets.Base (x0, ##(0)%expr)%expr_pat + else + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun + v0 : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | None => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v1 : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + | @expr.App _ _ _ s0 _ #(idc)%expr_pat x3 => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v0 : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => defaults.expr (type.base t1)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ x' v0)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + (- (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end) + | (s1 -> d1)%ptype => + fun _ : Compile.value' false s1 -> Compile.value' true d1 + => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | @expr.App _ _ _ s0 _ ($_)%expr _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v1 : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + | @expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 + _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s0 _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ => + match x1 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match + t0 as t1 return (base.base_interp t1 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ + ##((- args)%Z)%expr)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + if args =? 0 + then UnderLets.Base (x0, ##(0)%expr)%expr_pat + else + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun + v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s1 _ #(idc)%expr_pat x3 => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s1 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ x' v)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end) + | (s2 -> d2)%ptype => + fun _ : Compile.value' false s2 -> Compile.value' true d2 + => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s1 _ ($_)%expr _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s1 + _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s1 _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s _ (_ @ _)%expr_pat _ => + match x1 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match + t0 as t1 return (base.base_interp t1 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ + ##((- args)%Z)%expr)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + if args =? 0 + then UnderLets.Base (x0, ##(0)%expr)%expr_pat + else + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun + v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s1 _ #(idc)%expr_pat x4 => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s1 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ x' v)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end) + | (s2 -> d2)%ptype => + fun _ : Compile.value' false s2 -> Compile.value' true d2 + => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end (Compile.reflect x4) + | None => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s1 _ ($_)%expr _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s1 + _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s1 _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s _ (@expr.LetIn _ _ _ _ _ _ _) _ => + match x1 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match + t0 as t1 return (base.base_interp t1 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ + ##((- args)%Z)%expr)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + if args =? 0 + then UnderLets.Base (x0, ##(0)%expr)%expr_pat + else + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun + v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s0 _ #(idc)%expr_pat x4 => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ x' v)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end) + | (s1 -> d1)%ptype => + fun _ : Compile.value' false s1 -> Compile.value' true d1 + => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end (Compile.reflect x4) + | None => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s0 _ ($_)%expr _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 + _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s0 _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.LetIn _ _ _ _ _ _ _ => + match x1 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match + t0 as t1 return (base.base_interp t1 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ + ##((- args)%Z)%expr)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + if args =? 0 + then UnderLets.Base (x0, ##(0)%expr)%expr_pat + else + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun + v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s _ #(idc)%expr_pat x3 => + match + match idc with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ x' v)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end) + | (s0 -> d0)%ptype => + fun _ : Compile.value' false s0 -> Compile.value' true d0 + => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s _ ($_)%expr _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ + (_ @ _)%expr_pat _ | @expr.App _ _ _ s _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + end +| ident.Z_add_with_carry => + fun x x0 x1 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + if args =? 0 + then UnderLets.Base (x0 + x1)%expr + else + UnderLets.UnderLet + (#(ident.Z_add_with_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base base.type.Z) => + UnderLets.Base ($v)%expr) + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base base.type.Z) => + UnderLets.Base ($v)%expr) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_with_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v0 : var (type.base base.type.Z) => UnderLets.Base ($v0)%expr) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_with_carry)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base base.type.Z) => UnderLets.Base ($v)%expr) + end +| ident.Z_add_with_get_carry => + fun x x0 x1 x2 : defaults.expr (type.base base.type.Z) => + match x0 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x1 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + if + (args0 <=? 0) && (args <=? 0) && + (args0 + args <? 0) + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ x @ + ##((- args)%Z)%expr @ x2 @ + ##((- args0)%Z)%expr)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + if + (args1 <=? 0) && (args <=? 0) && + (args1 + args <? 0) + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ x @ + ##((- args)%Z)%expr @ x1 @ + ##((- args1)%Z)%expr)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + match x with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some _ => + if (args =? 0) && (args0 =? 0) + then + UnderLets.Base + (x2, ##(0)%expr)%expr_pat + else + if (args =? 0) && (args1 =? 0) + then + UnderLets.Base + (x1, ##(0)%expr)%expr_pat + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + if (args0 =? 0) && (args1 =? 0) + then + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ ##(args0)%expr @ + ##(args1)%expr)%expr_pat + (fun + v : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + ##(0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * + base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + if (args0 =? 0) && (args1 =? 0) + then + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ ##(args0)%expr @ + ##(args1)%expr)%expr_pat + (fun + v : var + (type.base + (base.type.Z * + base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + ##(0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * + base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + if (args0 =? 0) && (args1 =? 0) + then + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ ##(args0)%expr @ ##(args1)%expr)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + ##(0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + if (args0 =? 0) && (args1 =? 0) + then + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ ##(args0)%expr @ ##(args1)%expr)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + ##(0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | None => + if + (args0 <=? 0) && (args <=? 0) && + (args0 + args <? 0) + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ x @ + ##((- args)%Z)%expr @ x2 @ + ##((- args0)%Z)%expr)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + match x with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some _ => + if (args =? 0) && (args0 =? 0) + then + UnderLets.Base + (x2, ##(0)%expr)%expr_pat + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * + base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * + base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * + base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * + base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + end + | ($_)%expr => + if + (args0 <=? 0) && (args <=? 0) && (args0 + args <? 0) + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ x @ + ##((- args)%Z)%expr @ x2 @ ##((- args0)%Z)%expr)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + match x with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t3 v0 => + match + t3 as t4 + return (base.base_interp t4 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some _ => + if (args =? 0) && (args0 =? 0) + then + UnderLets.Base (x2, ##(0)%expr)%expr_pat + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | @expr.App _ _ _ s _ #(idc1)%expr_pat x3 => + match + match idc1 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ + x1 @ x' v)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- + (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) + t3 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ + ##((- args)%Z)%expr @ + x1 @ x'0 v0)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + (- + (#(ident.snd)%expr @ + $v1)%expr_pat)%expr)%expr_pat) + else + if + (args0 <=? 0) && + (args <=? 0) && + (args0 + args <? 0) + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ + ##((- args)%Z)%expr @ + x2 @ + ##((- args0)%Z)%expr)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + (- + (#(ident.snd)%expr @ + $v1)%expr_pat)%expr)%expr_pat) + else + match x with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal + t5 v1 => + match + t5 as t6 + return + (base.base_interp + t6 -> + option Z) + with + | base.type.unit => + fun + _ : unit + => None + | base.type.Z => + fun v2 : Z + => + Some v2 + | base.type.bool => + fun + _ : bool + => None + | base.type.nat => + fun + _ : nat + => None + end v1 + | _ => None + end + with + | Some _ => + if + (args =? 0) && + (args0 =? 0) + then + UnderLets.Base + (x2, + ##(0)%expr)%expr_pat + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ + x @ x1 @ x2)%expr_pat + (fun + v1 : + var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + ( + # + (ident.fst)%expr @ + ($v1)%expr, + # + (ident.snd)%expr @ + ($v1)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ + x2)%expr_pat + (fun + v1 : + var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + ( + # + (ident.fst)%expr @ + ($v1)%expr, + # + (ident.snd)%expr @ + ($v1)%expr)%expr_pat) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ + x @ x1 @ x2)%expr_pat + (fun + v1 : + var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (# + (ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ + x2)%expr_pat + (fun + v1 : + var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (# + (ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ + x @ x1 @ x2)%expr_pat + (fun + v2 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v2)%expr, + #(ident.snd)%expr @ + ($v2)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v2 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v2)%expr, + #(ident.snd)%expr @ + ($v2)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ + x @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + end + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + if + (args0 <=? 0) && (args <=? 0) && + (args0 + args <? 0) + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ x @ + ##((- args)%Z)%expr @ x2 @ + ##((- args0)%Z)%expr)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + match x with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some _ => + if (args =? 0) && (args0 =? 0) + then + UnderLets.Base + (x2, ##(0)%expr)%expr_pat + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * + base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * + base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * + base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * + base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + end + | @expr.App _ _ _ s _ ($_)%expr _ => + if + (args0 <=? 0) && (args <=? 0) && (args0 + args <? 0) + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ x @ + ##((- args)%Z)%expr @ x2 @ ##((- args0)%Z)%expr)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + match x with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t3 v0 => + match + t3 as t4 + return (base.base_interp t4 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some _ => + if (args =? 0) && (args0 =? 0) + then + UnderLets.Base (x2, ##(0)%expr)%expr_pat + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ | + @expr.App _ _ _ s _ (_ @ _)%expr_pat _ | @expr.App _ _ + _ s _ (@expr.LetIn _ _ _ _ _ _ _) _ => + if + (args0 <=? 0) && (args <=? 0) && (args0 + args <? 0) + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ x @ + ##((- args)%Z)%expr @ x2 @ ##((- args0)%Z)%expr)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + match x with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some _ => + if (args =? 0) && (args0 =? 0) + then + UnderLets.Base (x2, ##(0)%expr)%expr_pat + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | _ => + if + (args0 <=? 0) && (args <=? 0) && (args0 + args <? 0) + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ x @ + ##((- args)%Z)%expr @ x2 @ ##((- args0)%Z)%expr)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + match x with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some _ => + if (args =? 0) && (args0 =? 0) + then + UnderLets.Base (x2, ##(0)%expr)%expr_pat + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + end + | None => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + if + (args0 <=? 0) && (args <=? 0) && + (args0 + args <? 0) + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ x @ + ##((- args)%Z)%expr @ x1 @ + ##((- args0)%Z)%expr)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + match x with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some _ => + if (args =? 0) && (args0 =? 0) + then + UnderLets.Base + (x1, ##(0)%expr)%expr_pat + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * + base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * + base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * + base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * + base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s _ #(idc1)%expr_pat x3 => + match + match idc1 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ + x1 @ x' v)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- + (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) + t3 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ + ##((- args)%Z)%expr @ + x1 @ x'0 v0)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + (- + (#(ident.snd)%expr @ + $v1)%expr_pat)%expr)%expr_pat) + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ + x @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s _ ($_)%expr _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ | + @expr.App _ _ _ s _ (_ @ _)%expr_pat _ | @expr.App _ _ + _ s _ (@expr.LetIn _ _ _ _ _ _ _) _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + end + | ($_)%expr => + match x2 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t2 v0 => + match + t2 as t3 return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args0 => + if + (args0 <=? 0) && (args <=? 0) && (args0 + args <? 0) + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ x @ + ##((- args)%Z)%expr @ x1 @ ##((- args0)%Z)%expr)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + match x with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t3 v0 => + match + t3 as t4 + return (base.base_interp t4 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some _ => + if (args =? 0) && (args0 =? 0) + then + UnderLets.Base (x1, ##(0)%expr)%expr_pat + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + | @expr.App _ _ _ s _ #(idc0)%expr_pat x3 => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v0 : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ + x1 @ x' v0)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + (- + (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) + else + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v1 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a0 with + | Some x'0 => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ ##((- args)%Z)%expr @ + x1 @ x'0 v1)%expr_pat + (fun + v2 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v2)%expr, + (- + (#(ident.snd)%expr @ + $v2)%expr_pat)%expr)%expr_pat) + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ + x @ x1 @ x2)%expr_pat + (fun + v2 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v2)%expr, + #(ident.snd)%expr @ + ($v2)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v2 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v2)%expr, + #(ident.snd)%expr @ + ($v2)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | @expr.App _ _ _ s _ ($_)%expr _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + | @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ + _ _ s _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | @expr.Abs _ _ _ _ _ _ => + match x2 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + if + (args0 <=? 0) && (args <=? 0) && (args0 + args <? 0) + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ x @ + ##((- args)%Z)%expr @ x1 @ ##((- args0)%Z)%expr)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + match x with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some _ => + if (args =? 0) && (args0 =? 0) + then + UnderLets.Base (x1, ##(0)%expr)%expr_pat + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s0 _ #(idc0)%expr_pat x3 => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ + x1 @ x' v)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- + (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a0 with + | Some x'0 => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ ##((- args)%Z)%expr @ + x1 @ x'0 v0)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + (- + (#(ident.snd)%expr @ + $v1)%expr_pat)%expr)%expr_pat) + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ + x @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s0 _ ($_)%expr _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App + _ _ _ s0 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s0 _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s _ #(idc0)%expr_pat x3 => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => defaults.expr (type.base t1)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x2 @ + x' v)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t3 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a0 : option + (defaults.expr (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a0 with + | Some x'0 => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ ##((- args)%Z)%expr @ x2 @ + x'0 v0)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + (- + (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) + else + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t4 v1 => + match + t4 as t5 + return + (base.base_interp + t5 -> option Z) + with + | base.type.unit => + fun _ : unit => + None + | base.type.Z => + fun v2 : Z => + Some v2 + | base.type.bool => + fun _ : bool => + None + | base.type.nat => + fun _ : nat => None + end v1 + | _ => None + end + with + | Some args1 => + if + (args1 <=? 0) && + (args <=? 0) && + (args1 + args <? 0) + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ + ##((- args)%Z)%expr @ + x1 @ + ##((- args1)%Z)%expr)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + (- + (#(ident.snd)%expr @ + $v1)%expr_pat)%expr)%expr_pat) + else + match x with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal + t5 v1 => + match + t5 as t6 + return + (base.base_interp + t6 -> + option Z) + with + | base.type.unit => + fun + _ : unit + => None + | base.type.Z => + fun v2 : Z + => + Some v2 + | base.type.bool => + fun + _ : bool + => None + | base.type.nat => + fun + _ : nat + => None + end v1 + | _ => None + end + with + | Some _ => + if + (args =? 0) && + (args1 =? 0) + then + UnderLets.Base + (x1, + ##(0)%expr)%expr_pat + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ + x @ x1 @ x2)%expr_pat + (fun + v1 : + var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + ( + # + (ident.fst)%expr @ + ($v1)%expr, + # + (ident.snd)%expr @ + ($v1)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ + x2)%expr_pat + (fun + v1 : + var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + ( + # + (ident.fst)%expr @ + ($v1)%expr, + # + (ident.snd)%expr @ + ($v1)%expr)%expr_pat) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ + x @ x1 @ x2)%expr_pat + (fun + v1 : + var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (# + (ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ + x2)%expr_pat + (fun + v1 : + var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (# + (ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ + x @ x1 @ x2)%expr_pat + (fun + v2 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v2)%expr, + #(ident.snd)%expr @ + ($v2)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v2 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v2)%expr, + #(ident.snd)%expr @ + ($v2)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ + x @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + end + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ + x @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ + x @ x1 @ x2)%expr_pat + (fun + v2 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v2)%expr, + #(ident.snd)%expr @ + ($v2)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v2 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v2)%expr, + #(ident.snd)%expr @ + ($v2)%expr)%expr_pat) + | @expr.App _ _ _ s0 _ + #(idc1)%expr_pat x4 => + match + match idc1 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s0 as t4 + return + (Compile.value' false + t4 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t4 => + fun + v1 : defaults.expr + (type.base + t4) => + base.try_make_transport_cps + (fun t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a1 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a1 with + | Some x'1 => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ + x @ x1 @ + x'1 v1)%expr_pat + (fun + v2 : + var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + ( + # + (ident.fst)%expr @ + ($v2)%expr, + (- + (# + (ident.snd)%expr @ + $v2)%expr_pat)%expr)%expr_pat) + else + match + s0 as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base + t5 => + fun + v2 : + defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base + t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a2 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + args <? 0 + then + UnderLets.UnderLet + (# + (ident.Z_sub_with_get_borrow)%expr @ + x @ + ## + ((- args)%Z)%expr @ + x1 @ + x'2 v2)%expr_pat + (fun + v3 : + var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + ( + # + (ident.fst)%expr @ + ($v3)%expr, + (- + (# + (ident.snd)%expr @ + $v3)%expr_pat)%expr)%expr_pat) + else + if + args =? 0 + then + UnderLets.UnderLet + (# + (ident.Z_add_get_carry)%expr @ + x @ x1 @ + x2)%expr_pat + (fun + v3 : + var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + ( + # + (ident.fst)%expr @ + ($v3)%expr, + # + (ident.snd)%expr @ + ($v3)%expr)%expr_pat) + else + UnderLets.UnderLet + (# + (ident.Z_add_with_get_carry)%expr @ + x @ x0 @ + x1 @ x2)%expr_pat + (fun + v3 : + var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + ( + # + (ident.fst)%expr @ + ($v3)%expr, + # + (ident.snd)%expr @ + ($v3)%expr)%expr_pat) + | None => + UnderLets.Base + (# + (ident.Z_add_with_get_carry)%expr @ + x @ x0 @ + x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : + Compile.value' + false s1 -> + Compile.value' + true d1 + => + UnderLets.Base + (# + (ident.Z_add_with_get_carry)%expr @ + x @ x0 @ + x1 @ x2)%expr_pat + end + (Compile.reflect + x4) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ + x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' + false s1 -> + Compile.value' + true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ + x @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + end + | @expr.App _ _ _ s0 _ ($_)%expr + _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ + x @ x1 @ x2)%expr_pat + (fun + v2 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v2)%expr, + #(ident.snd)%expr @ + ($v2)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v2 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v2)%expr, + #(ident.snd)%expr @ + ($v2)%expr)%expr_pat) + | @expr.App _ _ _ s0 _ + (@expr.Abs _ _ _ _ _ _) _ | + @expr.App _ _ _ s0 _ + (_ @ _)%expr_pat _ | @expr.App + _ _ _ s0 _ + (@expr.LetIn _ _ _ _ _ _ _) + _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ + x @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ + x @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + end + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + end (Compile.reflect x3) + | None => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + if + (args0 <=? 0) && (args <=? 0) && + (args0 + args <? 0) + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ x @ + ##((- args)%Z)%expr @ x1 @ + ##((- args0)%Z)%expr)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + match x with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some _ => + if (args =? 0) && (args0 =? 0) + then + UnderLets.Base + (x1, ##(0)%expr)%expr_pat + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * + base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * + base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * + base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * + base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s0 _ #(idc1)%expr_pat x4 => + match + match idc1 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ + x1 @ x' v)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- + (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) + t3 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ + ##((- args)%Z)%expr @ + x1 @ x'0 v0)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + (- + (#(ident.snd)%expr @ + $v1)%expr_pat)%expr)%expr_pat) + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ + x @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s0 _ ($_)%expr _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ | + @expr.App _ _ _ s0 _ (_ @ _)%expr_pat _ | @expr.App _ _ + _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + end + | @expr.App _ _ _ s _ ($_)%expr _ => + match x2 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t2 v0 => + match + t2 as t3 return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args0 => + if + (args0 <=? 0) && (args <=? 0) && (args0 + args <? 0) + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ x @ + ##((- args)%Z)%expr @ x1 @ ##((- args0)%Z)%expr)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + match x with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t3 v0 => + match + t3 as t4 + return (base.base_interp t4 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some _ => + if (args =? 0) && (args0 =? 0) + then + UnderLets.Base (x1, ##(0)%expr)%expr_pat + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + | @expr.App _ _ _ s0 _ #(idc0)%expr_pat x4 => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v0 : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ + x1 @ x' v0)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + (- + (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) + else + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v1 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a0 with + | Some x'0 => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ ##((- args)%Z)%expr @ + x1 @ x'0 v1)%expr_pat + (fun + v2 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v2)%expr, + (- + (#(ident.snd)%expr @ + $v2)%expr_pat)%expr)%expr_pat) + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ + x @ x1 @ x2)%expr_pat + (fun + v2 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v2)%expr, + #(ident.snd)%expr @ + ($v2)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v2 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v2)%expr, + #(ident.snd)%expr @ + ($v2)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | @expr.App _ _ _ s0 _ ($_)%expr _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + | @expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App + _ _ _ s0 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s0 _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ => + match x2 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + if + (args0 <=? 0) && (args <=? 0) && (args0 + args <? 0) + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ x @ + ##((- args)%Z)%expr @ x1 @ ##((- args0)%Z)%expr)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + match x with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some _ => + if (args =? 0) && (args0 =? 0) + then + UnderLets.Base (x1, ##(0)%expr)%expr_pat + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s1 _ #(idc0)%expr_pat x4 => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s1 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ + x1 @ x' v)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- + (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + match + s1 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a0 with + | Some x'0 => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ ##((- args)%Z)%expr @ + x1 @ x'0 v0)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + (- + (#(ident.snd)%expr @ + $v1)%expr_pat)%expr)%expr_pat) + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ + x @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s1 _ ($_)%expr _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App + _ _ _ s1 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s1 _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s _ (_ @ _)%expr_pat _ => + match x2 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + if + (args0 <=? 0) && (args <=? 0) && (args0 + args <? 0) + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ x @ + ##((- args)%Z)%expr @ x1 @ ##((- args0)%Z)%expr)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + match x with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some _ => + if (args =? 0) && (args0 =? 0) + then + UnderLets.Base (x1, ##(0)%expr)%expr_pat + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s1 _ #(idc0)%expr_pat x5 => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s1 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ + x1 @ x' v)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- + (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + match + s1 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a0 with + | Some x'0 => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ ##((- args)%Z)%expr @ + x1 @ x'0 v0)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + (- + (#(ident.snd)%expr @ + $v1)%expr_pat)%expr)%expr_pat) + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ + x @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x5) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x5) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s1 _ ($_)%expr _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App + _ _ _ s1 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s1 _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s _ (@expr.LetIn _ _ _ _ _ _ _) _ => + match x2 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + if + (args0 <=? 0) && (args <=? 0) && (args0 + args <? 0) + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ x @ + ##((- args)%Z)%expr @ x1 @ ##((- args0)%Z)%expr)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + match x with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some _ => + if (args =? 0) && (args0 =? 0) + then + UnderLets.Base (x1, ##(0)%expr)%expr_pat + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s0 _ #(idc0)%expr_pat x5 => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ + x1 @ x' v)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- + (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a0 with + | Some x'0 => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ ##((- args)%Z)%expr @ + x1 @ x'0 v0)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + (- + (#(ident.snd)%expr @ + $v1)%expr_pat)%expr)%expr_pat) + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ + x @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x5) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x5) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s0 _ ($_)%expr _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App + _ _ _ s0 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s0 _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.LetIn _ _ _ _ _ _ _ => + match x2 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + if + (args0 <=? 0) && (args <=? 0) && (args0 + args <? 0) + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ x @ + ##((- args)%Z)%expr @ x1 @ ##((- args0)%Z)%expr)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) + else + match x with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some _ => + if (args =? 0) && (args0 =? 0) + then + UnderLets.Base (x1, ##(0)%expr)%expr_pat + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s _ #(idc0)%expr_pat x4 => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ + x1 @ x' v)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- + (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a0 with + | Some x'0 => + if args <? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ ##((- args)%Z)%expr @ + x1 @ x'0 v0)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + (- + (#(ident.snd)%expr @ + $v1)%expr_pat)%expr)%expr_pat) + else + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ + x @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s _ ($_)%expr _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ + _ _ s _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | _ => + if args =? 0 + then + UnderLets.UnderLet + (#(ident.Z_add_get_carry)%expr @ x @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + end + | None => + match x1 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + if (args =? 0) && (args0 =? 0) + then + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + ##(args)%expr @ ##(args0)%expr)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, ##(0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + end + | ($_)%expr => + match x1 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t1 v0 => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args => + match x2 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t2 v0 => + match + t2 as t3 return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args0 => + if (args =? 0) && (args0 =? 0) + then + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + ##(args)%expr @ ##(args0)%expr)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, ##(0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun v1 : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | @expr.App _ _ _ s _ #(idc)%expr_pat x3 => + match match idc with + | ident.Z_opp => Some tt + | _ => None + end with + | Some _ => + match x1 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args0 <=? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v @ x2 @ + ##((- args0)%Z)%expr)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- + (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) + t3 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if args1 <=? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x'0 v0 @ x1 @ + ##((- args1)%Z)%expr)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + (- + (#(ident.snd)%expr @ + $v1)%expr_pat)%expr)%expr_pat) + else + if + (args0 =? 0) && + (args1 =? 0) + then + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ + ##(args0)%expr @ + ##(args1)%expr)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + ##(0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + #(ident.snd)%expr @ + ($v1)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args0 <=? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v @ x2 @ + ##((- args0)%Z)%expr)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- + (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x3) + end + | ($_)%expr => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v0 : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + if args0 <=? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v0 @ x2 @ ##((- args0)%Z)%expr)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + (- + (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x3) + | @expr.Abs _ _ _ _ _ _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + if args0 <=? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v @ x2 @ ##((- args0)%Z)%expr)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- + (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x3) + | @expr.App _ _ _ s0 _ #(idc1)%expr_pat x4 => + match + match idc1 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) + t3 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) => + match a0 with + | Some x'0 => + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v @ x1 @ + x'0 v0)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + (- + (#(ident.snd)%expr @ + $v1)%expr_pat)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args0 <=? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v @ x2 @ + ##((- args0)%Z)%expr)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- + (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x3) + end + | @expr.App _ _ _ s0 _ ($_)%expr _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v0 : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + if args0 <=? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v0 @ x2 @ ##((- args0)%Z)%expr)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + (- + (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x3) + | @expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ | + @expr.App _ _ _ s0 _ (_ @ _)%expr_pat _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + if args0 <=? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v @ x2 @ ##((- args0)%Z)%expr)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- + (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x3) + | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + if args0 <=? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v @ x2 @ ##((- args0)%Z)%expr)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- + (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x3) + | @expr.LetIn _ _ _ _ _ _ _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + if args0 <=? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v @ x2 @ ##((- args0)%Z)%expr)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- + (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x3) + end + | None => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args0 <=? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v @ x1 @ + ##((- args0)%Z)%expr)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- + (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s0 _ #(idc1)%expr_pat x4 => + match + match idc1 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) + t3 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) => + match a0 with + | Some x'0 => + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v @ x1 @ + x'0 v0)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + (- + (#(ident.snd)%expr @ + $v1)%expr_pat)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s0 _ ($_)%expr _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ | + @expr.App _ _ _ s0 _ (_ @ _)%expr_pat _ | @expr.App _ _ + _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + end + | ($_)%expr => + match x2 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t2 v0 => + match + t2 as t3 return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args0 => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v0 : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + if args0 <=? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v0 @ x1 @ ##((- args0)%Z)%expr)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + (- + (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + | @expr.App _ _ _ s0 _ #(idc0)%expr_pat x4 => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v0 : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v1 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a0 with + | Some x'0 => + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v0 @ x1 @ x'0 v1)%expr_pat + (fun + v2 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v2)%expr, + (- + (#(ident.snd)%expr @ $v2)%expr_pat)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | @expr.App _ _ _ s0 _ ($_)%expr _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + | @expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App + _ _ _ s0 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s0 _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | @expr.Abs _ _ _ _ _ _ => + match x2 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + if args0 <=? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v @ x1 @ ##((- args0)%Z)%expr)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- + (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s1 _ #(idc0)%expr_pat x4 => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + match + s1 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t3 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a0 with + | Some x'0 => + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v @ x1 @ x'0 v0)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + (- + (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s1 _ ($_)%expr _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App + _ _ _ s1 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s1 _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s0 _ #(idc0)%expr_pat x4 => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => defaults.expr (type.base t1)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t3 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a0 : option + (defaults.expr (type.base t3) -> + defaults.expr + (type.base base.type.Z)) => + match a0 with + | Some x'0 => + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v @ x2 @ x'0 v0)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + (- + (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + end (Compile.reflect x3) + | None => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args0 <=? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v @ x1 @ + ##((- args0)%Z)%expr)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- + (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s1 _ #(idc1)%expr_pat x5 => + match + match idc1 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + match + s1 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) + t3 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) => + match a0 with + | Some x'0 => + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v @ x1 @ + x'0 v0)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + (- + (#(ident.snd)%expr @ + $v1)%expr_pat)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x5) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s1 _ ($_)%expr _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _ | + @expr.App _ _ _ s1 _ (_ @ _)%expr_pat _ | @expr.App _ _ + _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + end + | @expr.App _ _ _ s0 _ ($_)%expr _ => + match x2 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t2 v0 => + match + t2 as t3 return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args0 => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v0 : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + if args0 <=? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v0 @ x1 @ ##((- args0)%Z)%expr)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + (- + (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + | @expr.App _ _ _ s1 _ #(idc0)%expr_pat x5 => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v0 : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + match + s1 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v1 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a0 with + | Some x'0 => + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v0 @ x1 @ x'0 v1)%expr_pat + (fun + v2 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v2)%expr, + (- + (#(ident.snd)%expr @ $v2)%expr_pat)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x5) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | @expr.App _ _ _ s1 _ ($_)%expr _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + | @expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App + _ _ _ s1 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s1 _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | @expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ => + match x2 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + if args0 <=? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v @ x1 @ ##((- args0)%Z)%expr)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- + (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s2 _ #(idc0)%expr_pat x5 => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + match + s2 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t3 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a0 with + | Some x'0 => + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v @ x1 @ x'0 v0)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + (- + (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x5) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s2 _ ($_)%expr _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App + _ _ _ s2 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s2 _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s0 _ (_ @ _)%expr_pat _ => + match x2 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + if args0 <=? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v @ x1 @ ##((- args0)%Z)%expr)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- + (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s2 _ #(idc0)%expr_pat x6 => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + match + s2 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t3 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a0 with + | Some x'0 => + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v @ x1 @ x'0 v0)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + (- + (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x6) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s2 _ ($_)%expr _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App + _ _ _ s2 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s2 _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => + match x2 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + if args0 <=? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v @ x1 @ ##((- args0)%Z)%expr)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- + (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s1 _ #(idc0)%expr_pat x6 => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + match + s1 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t3 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a0 with + | Some x'0 => + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v @ x1 @ x'0 v0)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + (- + (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x6) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s1 _ ($_)%expr _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App + _ _ _ s1 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s1 _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.LetIn _ _ _ _ _ _ _ => + match x2 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + if args0 <=? 0 + then + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v @ x1 @ ##((- args0)%Z)%expr)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + (- + (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s0 -> d0)%ptype => + fun + _ : Compile.value' false s0 -> + Compile.value' true d0 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s0 _ #(idc0)%expr_pat x5 => + match + match idc0 with + | ident.Z_opp => Some tt + | _ => None + end + with + | Some _ => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t3 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a0 with + | Some x'0 => + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x' v @ x1 @ x'0 v0)%expr_pat + (fun + v1 : var + (type.base + (base.type.Z * + base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ + ($v1)%expr, + (- + (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x5) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | @expr.App _ _ _ s0 _ ($_)%expr _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | @expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App + _ _ _ s0 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s0 _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + end + | None => + match x1 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + if (args =? 0) && (args0 =? 0) + then + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + ##(args)%expr @ ##(args0)%expr)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, ##(0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + end + | @expr.App _ _ _ s _ ($_)%expr _ => + match x1 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t1 v0 => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args => + match x2 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t2 v0 => + match + t2 as t3 return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args0 => + if (args =? 0) && (args0 =? 0) + then + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + ##(args)%expr @ ##(args0)%expr)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, ##(0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v0 : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v1 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun v1 : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v1)%expr, + #(ident.snd)%expr @ ($v1)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + end + | @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ + (_ @ _)%expr_pat _ | @expr.App _ _ _ s _ (@expr.LetIn _ _ _ _ _ _ _) + _ => + match x1 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match + t0 as t1 return (base.base_interp t1 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x2 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + if (args =? 0) && (args0 =? 0) + then + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + ##(args)%expr @ ##(args0)%expr)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, ##(0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | _ => + match x1 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match + t0 as t1 return (base.base_interp t1 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x2 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + if (args =? 0) && (args0 =? 0) + then + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + ##(args)%expr @ ##(args0)%expr)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, ##(0)%expr)%expr_pat) + else + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + (fun + v : var + (type.base + (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v0 : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun + v : var + (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | None => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) + => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + | ($_)%expr => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v0)%expr, + #(ident.snd)%expr @ ($v0)%expr)%expr_pat) + | _ => + UnderLets.UnderLet + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, + #(ident.snd)%expr @ ($v)%expr)%expr_pat) + end + end +| ident.Z_sub_get_borrow => + fun x x0 x1 : defaults.expr (type.base base.type.Z) => + UnderLets.UnderLet + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ x1)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, #(ident.snd)%expr @ ($v)%expr)%expr_pat) +| ident.Z_sub_with_get_borrow => + fun x x0 x1 x2 : defaults.expr (type.base base.type.Z) => + UnderLets.UnderLet + (#(ident.Z_sub_with_get_borrow)%expr @ x @ x0 @ x1 @ x2)%expr_pat + (fun v : var (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base + (#(ident.fst)%expr @ ($v)%expr, #(ident.snd)%expr @ ($v)%expr)%expr_pat) +| ident.Z_zselect => + fun x x0 x1 : defaults.expr (type.base base.type.Z) => + UnderLets.Base (#(ident.Z_zselect)%expr @ x @ x0 @ x1)%expr_pat +| ident.Z_add_modulo => + fun x x0 x1 : defaults.expr (type.base base.type.Z) => + UnderLets.Base (#(ident.Z_add_modulo)%expr @ x @ x0 @ x1)%expr_pat +| ident.Z_rshi => + fun x x0 x1 x2 : defaults.expr (type.base base.type.Z) => + UnderLets.Base (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat +| ident.Z_cc_m => + fun x x0 : defaults.expr (type.base base.type.Z) => + UnderLets.Base (#(ident.Z_cc_m)%expr @ x @ x0)%expr_pat +| ident.Z_cast range => + fun x : defaults.expr (type.base base.type.Z) => + UnderLets.Base (#(ident.Z_cast range)%expr @ x)%expr_pat +| ident.Z_cast2 range => + fun x : defaults.expr (type.base (base.type.Z * base.type.Z)%etype) => + match x with + | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ #(idc)%expr_pat x1) x0 => + match + match idc with + | @ident.pair A B => Some (A, B) + | _ => None + end + with + | Some _ => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) => + base.try_make_transport_cps + (fun t0 : base.type => + defaults.expr (type.base t0)) t3 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a0 : option + (defaults.expr (type.base t3) -> + defaults.expr (type.base base.type.Z)) + => + match a0 with + | Some x'0 => + (fv <-- do_again + (base.type.Z * base.type.Z) + (#(ident.Z_cast (fst range))%expr @ + ($(x' v))%expr, + #(ident.Z_cast (snd range))%expr @ + ($(x'0 v0))%expr)%expr_pat; + UnderLets.Base (id (id fv)))%under_lets + | None => + UnderLets.Base + (#(ident.Z_cast2 range)%expr @ x)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_cast2 range)%expr @ x)%expr_pat + end (Compile.reflect x0) + | None => + UnderLets.Base + (#(ident.Z_cast2 range)%expr @ x)%expr_pat + end) + | (s1 -> d1)%ptype => + fun _ : Compile.value' false s1 -> Compile.value' true d1 => + UnderLets.Base (#(ident.Z_cast2 range)%expr @ x)%expr_pat + end (Compile.reflect x1) + | None => UnderLets.Base (#(ident.Z_cast2 range)%expr @ x)%expr_pat + end + | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ ($_)%expr _) _ | @expr.App _ + _ _ s _ (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _) _ | @expr.App + _ _ _ s _ (@expr.App _ _ _ s0 _ (_ @ _)%expr_pat _) _ | @expr.App _ _ _ + s _ (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _) _ => + UnderLets.Base (#(ident.Z_cast2 range)%expr @ x)%expr_pat + | @expr.App _ _ _ s _ #(_)%expr_pat _ | @expr.App _ _ _ s _ ($_)%expr _ | + @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.Base (#(ident.Z_cast2 range)%expr @ x)%expr_pat + | _ => UnderLets.Base (#(ident.Z_cast2 range)%expr @ x)%expr_pat + end +| ident.fancy_add log2wordmax imm => + fun x : defaults.expr (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base (#(ident.fancy_add log2wordmax imm)%expr @ x)%expr_pat +| ident.fancy_addc log2wordmax imm => + fun + x : defaults.expr + (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) => + UnderLets.Base (#(ident.fancy_addc log2wordmax imm)%expr @ x)%expr_pat +| ident.fancy_sub log2wordmax imm => + fun x : defaults.expr (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base (#(ident.fancy_sub log2wordmax imm)%expr @ x)%expr_pat +| ident.fancy_subb log2wordmax imm => + fun + x : defaults.expr + (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) => + UnderLets.Base (#(ident.fancy_subb log2wordmax imm)%expr @ x)%expr_pat +| ident.fancy_mulll log2wordmax => + fun x : defaults.expr (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base (#(ident.fancy_mulll log2wordmax)%expr @ x)%expr_pat +| ident.fancy_mullh log2wordmax => + fun x : defaults.expr (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base (#(ident.fancy_mullh log2wordmax)%expr @ x)%expr_pat +| ident.fancy_mulhl log2wordmax => + fun x : defaults.expr (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base (#(ident.fancy_mulhl log2wordmax)%expr @ x)%expr_pat +| ident.fancy_mulhh log2wordmax => + fun x : defaults.expr (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base (#(ident.fancy_mulhh log2wordmax)%expr @ x)%expr_pat +| ident.fancy_rshi log2wordmax x => + fun x0 : defaults.expr (type.base (base.type.Z * base.type.Z)%etype) => + UnderLets.Base (#(ident.fancy_rshi log2wordmax x)%expr @ x0)%expr_pat +| ident.fancy_selc => + fun + x : defaults.expr + (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) => + UnderLets.Base (#(ident.fancy_selc)%expr @ x)%expr_pat +| ident.fancy_selm log2wordmax => + fun + x : defaults.expr + (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) => + UnderLets.Base (#(ident.fancy_selm log2wordmax)%expr @ x)%expr_pat +| ident.fancy_sell => + fun + x : defaults.expr + (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) => + UnderLets.Base (#(ident.fancy_sell)%expr @ x)%expr_pat +| ident.fancy_addm => + fun + x : defaults.expr + (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) => + UnderLets.Base (#(ident.fancy_addm)%expr @ x)%expr_pat +end + : Compile.value' true t diff --git a/src/Experiments/NewPipeline/fancy_rewrite_head.out b/src/Experiments/NewPipeline/fancy_rewrite_head.out index 2201473ab..b93038b7c 100644 --- a/src/Experiments/NewPipeline/fancy_rewrite_head.out +++ b/src/Experiments/NewPipeline/fancy_rewrite_head.out @@ -5,7 +5,8 @@ match idc in (ident t) return (Compile.value' true t) with t as t0 return (base.base_interp t0 -> - UnderLets.UnderLets base.type ident var (expr (type.base t0))) + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base t0))) with | base.type.unit => fun v0 : unit => UnderLets.Base ##(v0)%expr | base.type.Z => fun v0 : Z => UnderLets.Base ##(v0)%expr @@ -13,42 +14,44 @@ match idc in (ident t) return (Compile.value' true t) with | base.type.nat => fun v0 : nat => UnderLets.Base ##(v0)%expr end v | ident.Nat_succ => - fun x : expr (type.base base.type.nat) => + fun x : defaults.expr (type.base base.type.nat) => UnderLets.Base (#(ident.Nat_succ)%expr @ x)%expr_pat | ident.Nat_pred => - fun x : expr (type.base base.type.nat) => + fun x : defaults.expr (type.base base.type.nat) => UnderLets.Base (#(ident.Nat_pred)%expr @ x)%expr_pat | ident.Nat_max => - fun x x0 : expr (type.base base.type.nat) => + fun x x0 : defaults.expr (type.base base.type.nat) => UnderLets.Base (#(ident.Nat_max)%expr @ x @ x0)%expr_pat | ident.Nat_mul => - fun x x0 : expr (type.base base.type.nat) => + fun x x0 : defaults.expr (type.base base.type.nat) => UnderLets.Base (#(ident.Nat_mul)%expr @ x @ x0)%expr_pat | ident.Nat_add => - fun x x0 : expr (type.base base.type.nat) => + fun x x0 : defaults.expr (type.base base.type.nat) => UnderLets.Base (#(ident.Nat_add)%expr @ x @ x0)%expr_pat | ident.Nat_sub => - fun x x0 : expr (type.base base.type.nat) => + fun x x0 : defaults.expr (type.base base.type.nat) => UnderLets.Base (#(ident.Nat_sub)%expr @ x @ x0)%expr_pat | @ident.nil t => UnderLets.Base []%expr_pat | @ident.cons t => - fun (x : expr (type.base t)) (x0 : expr (type.base (base.type.list t))) - => UnderLets.Base (x :: x0)%expr_pat + fun (x : defaults.expr (type.base t)) + (x0 : defaults.expr (type.base (base.type.list t))) => + UnderLets.Base (x :: x0)%expr_pat | @ident.pair A B => - fun (x : expr (type.base A)) (x0 : expr (type.base B)) => - UnderLets.Base (x, x0)%expr_pat + fun (x : defaults.expr (type.base A)) (x0 : defaults.expr (type.base B)) + => UnderLets.Base (x, x0)%expr_pat | @ident.fst A B => - fun x : expr (type.base (A * B)%etype) => + fun x : defaults.expr (type.base (A * B)%etype) => UnderLets.Base (#(ident.fst)%expr @ x)%expr_pat | @ident.snd A B => - fun x : expr (type.base (A * B)%etype) => + fun x : defaults.expr (type.base (A * B)%etype) => UnderLets.Base (#(ident.snd)%expr @ x)%expr_pat | @ident.prod_rect A B T => fun - (x : expr (type.base A) -> - expr (type.base B) -> - UnderLets.UnderLets base.type ident var (expr (type.base T))) - (x0 : expr (type.base (A * B)%etype)) => + (x : defaults.expr (type.base A) -> + defaults.expr (type.base B) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base T))) + (x0 : defaults.expr (type.base (A * B)%etype)) => UnderLets.Base (#(ident.prod_rect)%expr @ (λ (x1 : var (type.base A))(x2 : var (type.base B)), @@ -56,9 +59,10 @@ match idc in (ident t) return (Compile.value' true t) with | @ident.bool_rect T => fun (x - x0 : expr (type.base base.type.unit) -> - UnderLets.UnderLets base.type ident var (expr (type.base T))) - (x1 : expr (type.base base.type.bool)) => + x0 : defaults.expr (type.base base.type.unit) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base T))) + (x1 : defaults.expr (type.base base.type.bool)) => UnderLets.Base (#(ident.bool_rect)%expr @ (λ x2 : var (type.base base.type.unit), @@ -67,27 +71,57 @@ match idc in (ident t) return (Compile.value' true t) with UnderLets.to_expr (x0 ($x2)))%expr @ x1)%expr_pat | @ident.nat_rect P => fun - (x : expr (type.base base.type.unit) -> - UnderLets.UnderLets base.type ident var (expr (type.base P))) - (x0 : expr (type.base base.type.nat) -> - expr (type.base P) -> - UnderLets.UnderLets base.type ident var (expr (type.base P))) - (x1 : expr (type.base base.type.nat)) => + (x : defaults.expr (type.base base.type.unit) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (x0 : defaults.expr (type.base base.type.nat) -> + defaults.expr (type.base P) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (x1 : defaults.expr (type.base base.type.nat)) => UnderLets.Base (#(ident.nat_rect)%expr @ (λ x2 : var (type.base base.type.unit), UnderLets.to_expr (x ($x2)))%expr @ (λ (x2 : var (type.base base.type.nat))(x3 : var (type.base P)), UnderLets.to_expr (x0 ($x2) ($x3)))%expr @ x1)%expr_pat +| @ident.nat_rect_arrow P Q => + fun + (x : defaults.expr (type.base P) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base Q))) + (x0 : defaults.expr (type.base base.type.nat) -> + (defaults.expr (type.base P) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base Q))) -> + defaults.expr (type.base P) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base Q))) + (x1 : defaults.expr (type.base base.type.nat)) + (x2 : defaults.expr (type.base P)) => + UnderLets.Base + (#(ident.nat_rect_arrow)%expr @ + (λ x3 : var (type.base P), + UnderLets.to_expr (x ($x3)))%expr @ + (λ (x3 : var (type.base base.type.nat))(x4 : var + (type.base P -> + type.base Q)%ptype) + (x5 : var (type.base P)), + UnderLets.to_expr + (x0 ($x3) + (fun x6 : defaults.expr (type.base P) => + UnderLets.Base ($x4 @ x6)%expr_pat) ($x5)))%expr @ x1 @ x2)%expr_pat | @ident.list_rect A P => fun - (x : expr (type.base base.type.unit) -> - UnderLets.UnderLets base.type ident var (expr (type.base P))) - (x0 : expr (type.base A) -> - expr (type.base (base.type.list A)) -> - expr (type.base P) -> - UnderLets.UnderLets base.type ident var (expr (type.base P))) - (x1 : expr (type.base (base.type.list A))) => + (x : defaults.expr (type.base base.type.unit) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (x0 : defaults.expr (type.base A) -> + defaults.expr (type.base (base.type.list A)) -> + defaults.expr (type.base P) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (x1 : defaults.expr (type.base (base.type.list A))) => UnderLets.Base (#(ident.list_rect)%expr @ (λ x2 : var (type.base base.type.unit), @@ -97,12 +131,14 @@ match idc in (ident t) return (Compile.value' true t) with UnderLets.to_expr (x0 ($x2) ($x3) ($x4)))%expr @ x1)%expr_pat | @ident.list_case A P => fun - (x : expr (type.base base.type.unit) -> - UnderLets.UnderLets base.type ident var (expr (type.base P))) - (x0 : expr (type.base A) -> - expr (type.base (base.type.list A)) -> - UnderLets.UnderLets base.type ident var (expr (type.base P))) - (x1 : expr (type.base (base.type.list A))) => + (x : defaults.expr (type.base base.type.unit) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (x0 : defaults.expr (type.base A) -> + defaults.expr (type.base (base.type.list A)) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (x1 : defaults.expr (type.base (base.type.list A))) => UnderLets.Base (#(ident.list_case)%expr @ (λ x2 : var (type.base base.type.unit), @@ -110,80 +146,95 @@ match idc in (ident t) return (Compile.value' true t) with (λ (x2 : var (type.base A))(x3 : var (type.base (base.type.list A))), UnderLets.to_expr (x0 ($x2) ($x3)))%expr @ x1)%expr_pat | @ident.List_length T => - fun x : expr (type.base (base.type.list T)) => + fun x : defaults.expr (type.base (base.type.list T)) => UnderLets.Base (#(ident.List_length)%expr @ x)%expr_pat | ident.List_seq => - fun x x0 : expr (type.base base.type.nat) => + fun x x0 : defaults.expr (type.base base.type.nat) => UnderLets.Base (#(ident.List_seq)%expr @ x @ x0)%expr_pat +| @ident.List_firstn A => + fun (x : defaults.expr (type.base base.type.nat)) + (x0 : defaults.expr (type.base (base.type.list A))) => + UnderLets.Base (#(ident.List_firstn)%expr @ x @ x0)%expr_pat +| @ident.List_skipn A => + fun (x : defaults.expr (type.base base.type.nat)) + (x0 : defaults.expr (type.base (base.type.list A))) => + UnderLets.Base (#(ident.List_skipn)%expr @ x @ x0)%expr_pat | @ident.List_repeat A => - fun (x : expr (type.base A)) (x0 : expr (type.base base.type.nat)) => + fun (x : defaults.expr (type.base A)) + (x0 : defaults.expr (type.base base.type.nat)) => UnderLets.Base (#(ident.List_repeat)%expr @ x @ x0)%expr_pat | @ident.List_combine A B => - fun (x : expr (type.base (base.type.list A))) - (x0 : expr (type.base (base.type.list B))) => + fun (x : defaults.expr (type.base (base.type.list A))) + (x0 : defaults.expr (type.base (base.type.list B))) => UnderLets.Base (#(ident.List_combine)%expr @ x @ x0)%expr_pat | @ident.List_map A B => fun - (x : expr (type.base A) -> - UnderLets.UnderLets base.type ident var (expr (type.base B))) - (x0 : expr (type.base (base.type.list A))) => + (x : defaults.expr (type.base A) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base B))) + (x0 : defaults.expr (type.base (base.type.list A))) => UnderLets.Base (#(ident.List_map)%expr @ (λ x1 : var (type.base A), UnderLets.to_expr (x ($x1)))%expr @ x0)%expr_pat | @ident.List_app A => - fun x x0 : expr (type.base (base.type.list A)) => + fun x x0 : defaults.expr (type.base (base.type.list A)) => UnderLets.Base (x ++ x0)%expr | @ident.List_rev A => - fun x : expr (type.base (base.type.list A)) => + fun x : defaults.expr (type.base (base.type.list A)) => UnderLets.Base (#(ident.List_rev)%expr @ x)%expr_pat | @ident.List_flat_map A B => fun - (x : expr (type.base A) -> + (x : defaults.expr (type.base A) -> UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.list B)))) - (x0 : expr (type.base (base.type.list A))) => + (defaults.expr (type.base (base.type.list B)))) + (x0 : defaults.expr (type.base (base.type.list A))) => UnderLets.Base (#(ident.List_flat_map)%expr @ (λ x1 : var (type.base A), UnderLets.to_expr (x ($x1)))%expr @ x0)%expr_pat | @ident.List_partition A => fun - (x : expr (type.base A) -> + (x : defaults.expr (type.base A) -> UnderLets.UnderLets base.type ident var - (expr (type.base base.type.bool))) - (x0 : expr (type.base (base.type.list A))) => + (defaults.expr (type.base base.type.bool))) + (x0 : defaults.expr (type.base (base.type.list A))) => UnderLets.Base (#(ident.List_partition)%expr @ (λ x1 : var (type.base A), UnderLets.to_expr (x ($x1)))%expr @ x0)%expr_pat | @ident.List_fold_right A B => fun - (x : expr (type.base B) -> - expr (type.base A) -> - UnderLets.UnderLets base.type ident var (expr (type.base A))) - (x0 : expr (type.base A)) (x1 : expr (type.base (base.type.list B))) => + (x : defaults.expr (type.base B) -> + defaults.expr (type.base A) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base A))) + (x0 : defaults.expr (type.base A)) + (x1 : defaults.expr (type.base (base.type.list B))) => UnderLets.Base (#(ident.List_fold_right)%expr @ (λ (x2 : var (type.base B))(x3 : var (type.base A)), UnderLets.to_expr (x ($x2) ($x3)))%expr @ x0 @ x1)%expr_pat | @ident.List_update_nth T => - fun (x : expr (type.base base.type.nat)) - (x0 : expr (type.base T) -> - UnderLets.UnderLets base.type ident var (expr (type.base T))) - (x1 : expr (type.base (base.type.list T))) => + fun (x : defaults.expr (type.base base.type.nat)) + (x0 : defaults.expr (type.base T) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base T))) + (x1 : defaults.expr (type.base (base.type.list T))) => UnderLets.Base (#(ident.List_update_nth)%expr @ x @ (λ x2 : var (type.base T), UnderLets.to_expr (x0 ($x2)))%expr @ x1)%expr_pat | @ident.List_nth_default T => - fun (x : expr (type.base T)) (x0 : expr (type.base (base.type.list T))) - (x1 : expr (type.base base.type.nat)) => + fun (x : defaults.expr (type.base T)) + (x0 : defaults.expr (type.base (base.type.list T))) + (x1 : defaults.expr (type.base base.type.nat)) => UnderLets.Base (#(ident.List_nth_default)%expr @ x @ x0 @ x1)%expr_pat | ident.Z_add => - fun x x0 : expr (type.base base.type.Z) => UnderLets.Base (x + x0)%expr + fun x x0 : defaults.expr (type.base base.type.Z) => + UnderLets.Base (x + x0)%expr | ident.Z_mul => - fun x x0 : expr (type.base base.type.Z) => + fun x x0 : defaults.expr (type.base base.type.Z) => match x with | #(idc)%expr_pat => match @@ -200,268 +251,3557 @@ match idc in (ident t) return (Compile.value' true t) with with | Some args => match x0 with - | @expr.App _ _ _ s _ #(idc0)%expr_pat x1 => + | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ #(idc0)%expr_pat x2) + x1 => match match idc0 with - | ident.Z_land mask => Some mask + | ident.Z_land => Some tt | _ => None end with - | Some args0 => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args0 =? 2 ^ (2 * Z.log2_up args0 / 2) - 1 - then + | Some _ => + match x1 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if + args1 =? + 2 ^ (2 * Z.log2_up args1 / 2) - 1 + then + match + invert_low (2 * Z.log2_up args1) + args + with + | Some x3 => + UnderLets.Base + (#(ident.fancy_mulll + (2 * Z.log2_up args1))%expr @ + (##(x3)%expr, x' v))%expr_pat + | None => + match x2 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t4 v0 => + match + t4 as t5 + return + (base.base_interp + t5 -> option Z) + with + | base.type.unit => + fun _ : unit => + None + | base.type.Z => + fun v1 : Z => + Some v1 + | base.type.bool => + fun _ : bool => + None + | base.type.nat => + fun _ : nat => None + end v0 + | _ => None + end + with + | Some args2 => + match + s as t4 + return + (Compile.value' false + t4 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base + t4) => + base.try_make_transport_cps + (fun t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args2 =? + 2 + ^ (2 * + Z.log2_up + args2 / 2) - + 1 + then + match + invert_low + (2 * + Z.log2_up + args2) + args + with + | Some x3 => + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args2))%expr @ + (## + (x3)%expr, + x'0 v0))%expr_pat + | None => + match + s as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t5 => + fun + v1 : + defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base + t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a1 + with + | Some + x'1 => + if + args2 =? + 2 + ^ + (2 * + Z.log2_up + args2 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args2) + args + with + | Some + x3 => + UnderLets.Base + (# + (ident.fancy_mulhl + (2 * + Z.log2_up + args2))%expr @ + (## + (x3)%expr, + x'1 v1))%expr_pat + | None => + match + s0 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v2 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + args1 =? + 2 + ^ + (2 * + Z.log2_up + args1 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args1) + args + with + | Some + x3 => + UnderLets.Base + (# + (ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (## + (x3)%expr, + x'2 v2))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> + d1)%ptype => + fun + _ : + Compile.value' + false s1 -> + Compile.value' + true d1 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + end + else + match + s0 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v2 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + args1 =? + 2 + ^ + (2 * + Z.log2_up + args1 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args1) + args + with + | Some + x3 => + UnderLets.Base + (# + (ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (## + (x3)%expr, + x'2 v2))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> + d1)%ptype => + fun + _ : + Compile.value' + false s1 -> + Compile.value' + true d1 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> + d1)%ptype => + fun + _ : + Compile.value' + false s1 -> + Compile.value' + true d1 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x1) + end + else + match + s as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t5 => + fun + v1 : + defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base + t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a1 + with + | Some + x'1 => + if + args2 =? + 2 + ^ + (2 * + Z.log2_up + args2 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args2) + args + with + | Some + x3 => + UnderLets.Base + (# + (ident.fancy_mulhl + (2 * + Z.log2_up + args2))%expr @ + (## + (x3)%expr, + x'1 v1))%expr_pat + | None => + match + s0 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v2 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + args1 =? + 2 + ^ + (2 * + Z.log2_up + args1 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args1) + args + with + | Some + x3 => + UnderLets.Base + (# + (ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (## + (x3)%expr, + x'2 v2))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> + d1)%ptype => + fun + _ : + Compile.value' + false s1 -> + Compile.value' + true d1 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + end + else + match + s0 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v2 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + args1 =? + 2 + ^ + (2 * + Z.log2_up + args1 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args1) + args + with + | Some + x3 => + UnderLets.Base + (# + (ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (## + (x3)%expr, + x'2 v2))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> + d1)%ptype => + fun + _ : + Compile.value' + false s1 -> + Compile.value' + true d1 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : + Compile.value' + false s1 -> + Compile.value' + true d1 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x1) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' + false s1 -> + Compile.value' + true d1 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x1) + | None => + match + s0 as t4 + return + (Compile.value' false + t4 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base + t4) => + base.try_make_transport_cps + (fun t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args1 =? + 2 + ^ (2 * + Z.log2_up + args1 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args1) + args + with + | Some x3 => + UnderLets.Base + (# + (ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (## + (x3)%expr, + x'0 v0))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' + false s1 -> + Compile.value' + true d1 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) + end + | ($_)%expr => + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v1 : defaults.expr + (type.base t4) + => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args1 =? + 2 + ^ (2 * + Z.log2_up + args1 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args1) + args + with + | Some x3 => + UnderLets.Base + (#(ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (## + (x3)%expr, + x'0 v1))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' + false s1 -> + Compile.value' true + d1 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) + | @expr.Abs _ _ _ _ _ _ => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args1 =? + 2 + ^ (2 * + Z.log2_up + args1 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args1) + args + with + | Some x3 => + UnderLets.Base + (#(ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (## + (x3)%expr, + x'0 v0))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' + false s2 -> + Compile.value' true + d2 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) + | (_ @ _)%expr_pat => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args1 =? + 2 + ^ (2 * + Z.log2_up + args1 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args1) + args + with + | Some x4 => + UnderLets.Base + (#(ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (## + (x4)%expr, + x'0 v0))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' + false s2 -> + Compile.value' true + d2 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) + | @expr.LetIn _ _ _ _ _ _ _ => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args1 =? + 2 + ^ (2 * + Z.log2_up + args1 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args1) + args + with + | Some x4 => + UnderLets.Base + (#(ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (## + (x4)%expr, + x'0 v0))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' + false s1 -> + Compile.value' true + d1 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) + end + end + else + match x2 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t4 v0 => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v0 + | _ => None + end + with + | Some args2 => + match + s as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) + => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args2 =? + 2 + ^ (2 * + Z.log2_up + args2 / 2) - + 1 + then + match + invert_low + (2 * + Z.log2_up + args2) + args + with + | Some x3 => + UnderLets.Base + (#(ident.fancy_mulll + (2 * + Z.log2_up + args2))%expr @ + (## + (x3)%expr, + x'0 v0))%expr_pat + | None => + match + s as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t5 => + fun + v1 : + defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base + t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a1 + with + | Some + x'1 => + if + args2 =? + 2 + ^ + (2 * + Z.log2_up + args2 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args2) + args + with + | Some + x3 => + UnderLets.Base + (# + (ident.fancy_mulhl + (2 * + Z.log2_up + args2))%expr @ + (## + (x3)%expr, + x'1 v1))%expr_pat + | None => + match + s0 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v2 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + args1 =? + 2 + ^ + (2 * + Z.log2_up + args1 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args1) + args + with + | Some + x3 => + UnderLets.Base + (# + (ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (## + (x3)%expr, + x'2 v2))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> + d1)%ptype => + fun + _ : + Compile.value' + false s1 -> + Compile.value' + true d1 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + end + else + match + s0 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v2 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + args1 =? + 2 + ^ + (2 * + Z.log2_up + args1 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args1) + args + with + | Some + x3 => + UnderLets.Base + (# + (ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (## + (x3)%expr, + x'2 v2))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> + d1)%ptype => + fun + _ : + Compile.value' + false s1 -> + Compile.value' + true d1 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : + Compile.value' + false s1 -> + Compile.value' + true d1 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x1) + end + else + match + s as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t5 => + fun + v1 : + defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base + t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a1 + with + | Some + x'1 => + if + args2 =? + 2 + ^ + (2 * + Z.log2_up + args2 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args2) + args + with + | Some + x3 => + UnderLets.Base + (# + (ident.fancy_mulhl + (2 * + Z.log2_up + args2))%expr @ + (## + (x3)%expr, + x'1 v1))%expr_pat + | None => + match + s0 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v2 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + args1 =? + 2 + ^ + (2 * + Z.log2_up + args1 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args1) + args + with + | Some + x3 => + UnderLets.Base + (# + (ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (## + (x3)%expr, + x'2 v2))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> + d1)%ptype => + fun + _ : + Compile.value' + false s1 -> + Compile.value' + true d1 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + end + else + match + s0 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v2 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + args1 =? + 2 + ^ + (2 * + Z.log2_up + args1 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args1) + args + with + | Some + x3 => + UnderLets.Base + (# + (ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (## + (x3)%expr, + x'2 v2))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> + d1)%ptype => + fun + _ : + Compile.value' + false s1 -> + Compile.value' + true d1 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : + Compile.value' + false s1 -> + Compile.value' + true d1 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x1) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' + false s1 -> + Compile.value' true + d1 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x1) + | None => + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) + => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args1 =? + 2 + ^ (2 * + Z.log2_up + args1 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args1) + args + with + | Some x3 => + UnderLets.Base + (#(ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (## + (x3)%expr, + x'0 v0))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' + false s1 -> + Compile.value' true + d1 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) + end + | ($_)%expr => + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t4 => + fun + v1 : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args1 =? + 2 + ^ (2 * + Z.log2_up args1 / + 2) - 1 + then + match + invert_high + (2 * + Z.log2_up args1) + args + with + | Some x3 => + UnderLets.Base + (#(ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (##(x3)%expr, + x'0 v1))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | @expr.Abs _ _ _ _ _ _ => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args1 =? + 2 + ^ (2 * + Z.log2_up args1 / + 2) - 1 + then + match + invert_high + (2 * + Z.log2_up args1) + args + with + | Some x3 => + UnderLets.Base + (#(ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (##(x3)%expr, + x'0 v0))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | (_ @ _)%expr_pat => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args1 =? + 2 + ^ (2 * + Z.log2_up args1 / + 2) - 1 + then + match + invert_high + (2 * + Z.log2_up args1) + args + with + | Some x4 => + UnderLets.Base + (#(ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (##(x4)%expr, + x'0 v0))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | @expr.LetIn _ _ _ _ _ _ _ => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args1 =? + 2 + ^ (2 * + Z.log2_up args1 / + 2) - 1 + then + match + invert_high + (2 * + Z.log2_up args1) + args + with + | Some x4 => + UnderLets.Base + (#(ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (##(x4)%expr, + x'0 v0))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + end + | None => UnderLets.Base (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + match x2 with + | #(idc2)%expr_pat => match - invert_low (2 * Z.log2_up args0) args + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end with - | Some x2 => - UnderLets.Base - (#(ident.fancy_mulll - (2 * Z.log2_up args0))%expr @ - (##(x2)%expr, x' v))%expr_pat - | None => + | Some args1 => match s as t3 return (Compile.value' false t3 -> UnderLets.UnderLets base.type ident - var (expr (type.base base.type.Z))) + var + (defaults.expr + (type.base base.type.Z))) with | type.base t3 => - fun v0 : expr (type.base t3) => + fun v : defaults.expr (type.base t3) + => base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 base.type.Z (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) + (defaults.expr + (type.base base.type.Z))) (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) => - match a0 with - | Some x'0 => + match a with + | Some x' => if - args0 =? - 2 ^ (2 * Z.log2_up args0 / 2) - + args1 =? + 2 ^ (2 * Z.log2_up args1 / 2) - 1 then match - invert_high - (2 * Z.log2_up args0) + invert_low + (2 * Z.log2_up args1) args with - | Some x2 => + | Some x3 => UnderLets.Base - (#(ident.fancy_mulhl + (#(ident.fancy_mulll (2 * - Z.log2_up args0))%expr @ - (##(x2)%expr, x'0 v0))%expr_pat + Z.log2_up args1))%expr @ + (##(x3)%expr, x' v))%expr_pat | None => - UnderLets.Base - (x * x0)%expr + match + s as t4 + return + (Compile.value' false + t4 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base + t4) => + base.try_make_transport_cps + (fun t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args1 =? + 2 + ^ (2 * + Z.log2_up + args1 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args1) + args + with + | Some x3 => + UnderLets.Base + (# + (ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (## + (x3)%expr, + x'0 v0))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' + false s1 -> + Compile.value' + true d1 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x1) end else - UnderLets.Base (x * x0)%expr + match + s as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) + => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args1 =? + 2 + ^ (2 * + Z.log2_up + args1 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args1) + args + with + | Some x3 => + UnderLets.Base + (#(ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (## + (x3)%expr, + x'0 v0))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' + false s1 -> + Compile.value' true + d1 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x1) | None => UnderLets.Base (x * x0)%expr end) - | (s0 -> d0)%ptype => + | (s1 -> d1)%ptype => fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => + _ : Compile.value' false s1 -> + Compile.value' true d1 => UnderLets.Base (x * x0)%expr end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr end - else + | _ => UnderLets.Base (x * x0)%expr + end + end + | ($_)%expr => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t3 v0 => + match + t3 as t4 + return (base.base_interp t4 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args1 => match s as t3 return (Compile.value' false t3 -> UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) + (defaults.expr (type.base base.type.Z))) with | type.base t3 => - fun v0 : expr (type.base t3) => + fun v0 : defaults.expr (type.base t3) => base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 base.type.Z + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z (UnderLets.UnderLets base.type ident - var (expr (type.base base.type.Z))) + var + (defaults.expr + (type.base base.type.Z))) (fun - a0 : option - (expr (type.base t3) -> - expr (type.base base.type.Z)) - => - match a0 with - | Some x'0 => + a : option + (defaults.expr (type.base t3) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => if - args0 =? - 2 ^ (2 * Z.log2_up args0 / 2) - 1 + args1 =? + 2 ^ (2 * Z.log2_up args1 / 2) - 1 then match - invert_high - (2 * Z.log2_up args0) args + invert_low + (2 * Z.log2_up args1) args with - | Some x2 => + | Some x3 => UnderLets.Base - (#(ident.fancy_mulhl - (2 * Z.log2_up args0))%expr @ - (##(x2)%expr, x'0 v0))%expr_pat + (#(ident.fancy_mulll + (2 * Z.log2_up args1))%expr @ + (##(x3)%expr, x' v0))%expr_pat + | None => + match + s as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v1 : defaults.expr + (type.base t4) + => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args1 =? + 2 + ^ (2 * + Z.log2_up + args1 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args1) + args + with + | Some x3 => + UnderLets.Base + (#(ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (## + (x3)%expr, + x'0 v1))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' + false s1 -> + Compile.value' true + d1 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x1) + end + else + match + s as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t4 => + fun + v1 : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args1 =? + 2 + ^ (2 * + Z.log2_up args1 / + 2) - 1 + then + match + invert_high + (2 * + Z.log2_up args1) + args + with + | Some x3 => + UnderLets.Base + (#(ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (##(x3)%expr, + x'0 v1))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | @expr.Abs _ _ _ _ _ _ => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if + args1 =? + 2 ^ (2 * Z.log2_up args1 / 2) - 1 + then + match + invert_low + (2 * Z.log2_up args1) args + with + | Some x3 => + UnderLets.Base + (#(ident.fancy_mulll + (2 * Z.log2_up args1))%expr @ + (##(x3)%expr, x' v))%expr_pat | None => + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args1 =? + 2 + ^ (2 * + Z.log2_up + args1 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args1) + args + with + | Some x3 => + UnderLets.Base + (#(ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (## + (x3)%expr, + x'0 v0))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' + false s2 -> + Compile.value' true + d2 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x1) + end + else + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args1 =? + 2 + ^ (2 * + Z.log2_up args1 / + 2) - 1 + then + match + invert_high + (2 * + Z.log2_up args1) + args + with + | Some x3 => + UnderLets.Base + (#(ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (##(x3)%expr, + x'0 v0))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 + => UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | (_ @ _)%expr_pat => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if + args1 =? + 2 ^ (2 * Z.log2_up args1 / 2) - 1 + then + match + invert_low + (2 * Z.log2_up args1) args + with + | Some x4 => + UnderLets.Base + (#(ident.fancy_mulll + (2 * Z.log2_up args1))%expr @ + (##(x4)%expr, x' v))%expr_pat + | None => + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args1 =? + 2 + ^ (2 * + Z.log2_up + args1 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args1) + args + with + | Some x4 => + UnderLets.Base + (#(ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (## + (x4)%expr, + x'0 v0))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' + false s2 -> + Compile.value' true + d2 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x1) end - else UnderLets.Base (x * x0)%expr + else + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args1 =? + 2 + ^ (2 * + Z.log2_up args1 / + 2) - 1 + then + match + invert_high + (2 * + Z.log2_up args1) + args + with + | Some x4 => + UnderLets.Base + (#(ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (##(x4)%expr, + x'0 v0))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) | None => UnderLets.Base (x * x0)%expr end) - | (s0 -> d0)%ptype => + | (s2 -> d2)%ptype => fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => + _ : Compile.value' false s2 -> + Compile.value' true d2 => UnderLets.Base (x * x0)%expr end (Compile.reflect x1) - | None => UnderLets.Base (x * x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | @expr.LetIn _ _ _ _ _ _ _ => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if + args1 =? + 2 ^ (2 * Z.log2_up args1 / 2) - 1 + then + match + invert_low + (2 * Z.log2_up args1) args + with + | Some x4 => + UnderLets.Base + (#(ident.fancy_mulll + (2 * Z.log2_up args1))%expr @ + (##(x4)%expr, x' v))%expr_pat + | None => + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args1 =? + 2 + ^ (2 * + Z.log2_up + args1 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args1) + args + with + | Some x4 => + UnderLets.Base + (#(ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (## + (x4)%expr, + x'0 v0))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' + false s1 -> + Compile.value' true + d1 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x1) + end + else + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args1 =? + 2 + ^ (2 * + Z.log2_up args1 / + 2) - 1 + then + match + invert_high + (2 * + Z.log2_up args1) + args + with + | Some x4 => + UnderLets.Base + (#(ident.fancy_mulhl + (2 * + Z.log2_up + args1))%expr @ + (##(x4)%expr, + x'0 v0))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + end | None => match match idc0 with - | ident.Z_shiftr offset => Some offset + | ident.Z_shiftr => Some tt | _ => None end with - | Some args0 => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match invert_low (2 * args0) args with - | Some x2 => - UnderLets.Base - (#(ident.fancy_mullh (2 * args0))%expr @ - (##(x2)%expr, x' v))%expr_pat - | None => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type - ident var - (expr (type.base base.type.Z))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 - base.type.Z - (UnderLets.UnderLets base.type - ident var - (expr (type.base base.type.Z))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base - base.type.Z)) => - match a0 with - | Some x'0 => - match - invert_high (2 * args0) - args - with - | Some x2 => - UnderLets.Base - (#(ident.fancy_mulhh - (2 * args0))%expr @ - (##(x2)%expr, - x'0 v0))%expr_pat - | None => - UnderLets.Base - (x * x0)%expr - end - | None => - UnderLets.Base - (x * x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) - end - | None => UnderLets.Base (x * x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) + | Some _ => + match x1 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + match + invert_low (2 * args1) args + with + | Some x3 => + UnderLets.Base + (#(ident.fancy_mullh + (2 * args1))%expr @ + (##(x3)%expr, x' v))%expr_pat + | None => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + match + invert_high + (2 * args1) + args + with + | Some x3 => + UnderLets.Base + (#(ident.fancy_mulhh + (2 * + args1))%expr @ + (##(x3)%expr, + x'0 v0))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false + s1 -> + Compile.value' true + d1 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) + end + | None => UnderLets.Base (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end | None => UnderLets.Base (x * x0)%expr end end - | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ - (_ @ _)%expr_pat _ | @expr.App _ _ _ s _ - (@expr.LetIn _ _ _ _ _ _ _) _ => UnderLets.Base (x * x0)%expr + | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ ($_)%expr _) _ | + @expr.App _ _ _ s _ + (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _) _ | @expr.App + _ _ _ s _ (@expr.App _ _ _ s0 _ (_ @ _)%expr_pat _) _ | + @expr.App _ _ _ s _ + (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _) _ => + UnderLets.Base (x * x0)%expr + | @expr.App _ _ _ s _ #(_)%expr_pat _ | @expr.App _ _ _ s _ + ($_)%expr _ | @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ | + @expr.App _ _ _ s _ (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.Base (x * x0)%expr | _ => UnderLets.Base (x * x0)%expr end | None => UnderLets.Base (x * x0)%expr end - | @expr.App _ _ _ s _ #(idc)%expr_pat x1 => - match - match idc with - | ident.Z_land mask => Some mask - | _ => None - end - with - | Some args => - match x0 with + | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ #(idc)%expr_pat x2) x1 => + match match idc with + | ident.Z_land => Some tt + | _ => None + end with + | Some _ => + match x2 with | #(idc0)%expr_pat => match match idc0 with @@ -478,322 +3818,11179 @@ match idc in (ident t) return (Compile.value' true t) with end with | Some args0 => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args =? 2 ^ (2 * Z.log2_up args / 2) - 1 - then + match x0 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if + args0 =? + 2 ^ (2 * Z.log2_up args0 / 2) - 1 + then + match + invert_low (2 * Z.log2_up args0) + args1 + with + | Some y => + UnderLets.Base + (#(ident.fancy_mulll + (2 * Z.log2_up args0))%expr @ + (x' v, ##(y)%expr))%expr_pat + | None => + match x1 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t4 v0 => + match + t4 as t5 + return + (base.base_interp + t5 -> option Z) + with + | base.type.unit => + fun _ : unit => + None + | base.type.Z => + fun v1 : Z => + Some v1 + | base.type.bool => + fun _ : bool => + None + | base.type.nat => + fun _ : nat => None + end v0 + | _ => None + end + with + | Some args2 => + match + s0 as t4 + return + (Compile.value' false + t4 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base + t4) => + base.try_make_transport_cps + (fun t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args2 =? + 2 + ^ (2 * + Z.log2_up + args2 / 2) - + 1 + then + match + invert_low + (2 * + Z.log2_up + args2) + args1 + with + | Some y => + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args2))%expr @ + ( + x'0 v0, + ## + (y)%expr))%expr_pat + | None => + match + s as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t5 => + fun + v1 : + defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base + t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a1 + with + | Some + x'1 => + if + args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args0) + args1 + with + | Some + y => + UnderLets.Base + (# + (ident.fancy_mullh + (2 * + Z.log2_up + args0))%expr @ + ( + x'1 v1, + ## + (y)%expr))%expr_pat + | None => + match + s0 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v2 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + args2 =? + 2 + ^ + (2 * + Z.log2_up + args2 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args2) + args1 + with + | Some + y => + UnderLets.Base + (# + (ident.fancy_mullh + (2 * + Z.log2_up + args2))%expr @ + ( + x'2 v2, + ## + (y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> + d1)%ptype => + fun + _ : + Compile.value' + false s1 -> + Compile.value' + true d1 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + end + else + match + s0 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v2 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + args2 =? + 2 + ^ + (2 * + Z.log2_up + args2 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args2) + args1 + with + | Some + y => + UnderLets.Base + (# + (ident.fancy_mullh + (2 * + Z.log2_up + args2))%expr @ + ( + x'2 v2, + ## + (y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> + d1)%ptype => + fun + _ : + Compile.value' + false s1 -> + Compile.value' + true d1 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> + d1)%ptype => + fun + _ : + Compile.value' + false s1 -> + Compile.value' + true d1 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x1) + end + else + match + s as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t5 => + fun + v1 : + defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base + t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a1 + with + | Some + x'1 => + if + args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args0) + args1 + with + | Some + y => + UnderLets.Base + (# + (ident.fancy_mullh + (2 * + Z.log2_up + args0))%expr @ + ( + x'1 v1, + ## + (y)%expr))%expr_pat + | None => + match + s0 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v2 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + args2 =? + 2 + ^ + (2 * + Z.log2_up + args2 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args2) + args1 + with + | Some + y => + UnderLets.Base + (# + (ident.fancy_mullh + (2 * + Z.log2_up + args2))%expr @ + ( + x'2 v2, + ## + (y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> + d1)%ptype => + fun + _ : + Compile.value' + false s1 -> + Compile.value' + true d1 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + end + else + match + s0 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v2 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + args2 =? + 2 + ^ + (2 * + Z.log2_up + args2 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args2) + args1 + with + | Some + y => + UnderLets.Base + (# + (ident.fancy_mullh + (2 * + Z.log2_up + args2))%expr @ + ( + x'2 v2, + ## + (y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> + d1)%ptype => + fun + _ : + Compile.value' + false s1 -> + Compile.value' + true d1 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : + Compile.value' + false s1 -> + Compile.value' + true d1 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x1) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' + false s1 -> + Compile.value' + true d1 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) + | None => + match + s as t4 + return + (Compile.value' false + t4 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base + t4) => + base.try_make_transport_cps + (fun t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args0 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args0) + args1 + with + | Some y => + UnderLets.Base + (# + (ident.fancy_mullh + (2 * + Z.log2_up + args0))%expr @ + ( + x'0 v0, + ## + (y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' + false s1 -> + Compile.value' + true d1 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x1) + end + | ($_)%expr => + match + s as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v1 : defaults.expr + (type.base t4) + => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args0 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args0) + args1 + with + | Some y => + UnderLets.Base + (#(ident.fancy_mullh + (2 * + Z.log2_up + args0))%expr @ + (x'0 v1, + ## + (y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' + false s1 -> + Compile.value' true + d1 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x1) + | @expr.LetIn _ _ _ _ _ _ _ => + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args0 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args0) + args1 + with + | Some y => + UnderLets.Base + (#(ident.fancy_mullh + (2 * + Z.log2_up + args0))%expr @ + (x'0 v0, + ## + (y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' + false s1 -> + Compile.value' true + d1 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x1) + | _ => + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args0 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args0) + args1 + with + | Some y => + UnderLets.Base + (#(ident.fancy_mullh + (2 * + Z.log2_up + args0))%expr @ + (x'0 v0, + ## + (y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' + false s2 -> + Compile.value' true + d2 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x1) + end + end + else + match x1 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t4 v0 => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v0 + | _ => None + end + with + | Some args2 => + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) + => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args2 =? + 2 + ^ (2 * + Z.log2_up + args2 / 2) - + 1 + then + match + invert_low + (2 * + Z.log2_up + args2) + args1 + with + | Some y => + UnderLets.Base + (#(ident.fancy_mulll + (2 * + Z.log2_up + args2))%expr @ + (x'0 v0, + ## + (y)%expr))%expr_pat + | None => + match + s as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t5 => + fun + v1 : + defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base + t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a1 + with + | Some + x'1 => + if + args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args0) + args1 + with + | Some + y => + UnderLets.Base + (# + (ident.fancy_mullh + (2 * + Z.log2_up + args0))%expr @ + ( + x'1 v1, + ## + (y)%expr))%expr_pat + | None => + match + s0 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v2 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + args2 =? + 2 + ^ + (2 * + Z.log2_up + args2 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args2) + args1 + with + | Some + y => + UnderLets.Base + (# + (ident.fancy_mullh + (2 * + Z.log2_up + args2))%expr @ + ( + x'2 v2, + ## + (y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> + d1)%ptype => + fun + _ : + Compile.value' + false s1 -> + Compile.value' + true d1 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + end + else + match + s0 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v2 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + args2 =? + 2 + ^ + (2 * + Z.log2_up + args2 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args2) + args1 + with + | Some + y => + UnderLets.Base + (# + (ident.fancy_mullh + (2 * + Z.log2_up + args2))%expr @ + ( + x'2 v2, + ## + (y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> + d1)%ptype => + fun + _ : + Compile.value' + false s1 -> + Compile.value' + true d1 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : + Compile.value' + false s1 -> + Compile.value' + true d1 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x1) + end + else + match + s as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t5 => + fun + v1 : + defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base + t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a1 + with + | Some + x'1 => + if + args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args0) + args1 + with + | Some + y => + UnderLets.Base + (# + (ident.fancy_mullh + (2 * + Z.log2_up + args0))%expr @ + ( + x'1 v1, + ## + (y)%expr))%expr_pat + | None => + match + s0 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v2 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + args2 =? + 2 + ^ + (2 * + Z.log2_up + args2 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args2) + args1 + with + | Some + y => + UnderLets.Base + (# + (ident.fancy_mullh + (2 * + Z.log2_up + args2))%expr @ + ( + x'2 v2, + ## + (y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> + d1)%ptype => + fun + _ : + Compile.value' + false s1 -> + Compile.value' + true d1 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + end + else + match + s0 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v2 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + args2 =? + 2 + ^ + (2 * + Z.log2_up + args2 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args2) + args1 + with + | Some + y => + UnderLets.Base + (# + (ident.fancy_mullh + (2 * + Z.log2_up + args2))%expr @ + ( + x'2 v2, + ## + (y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> + d1)%ptype => + fun + _ : + Compile.value' + false s1 -> + Compile.value' + true d1 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : + Compile.value' + false s1 -> + Compile.value' + true d1 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x1) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' + false s1 -> + Compile.value' true + d1 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) + | None => + match + s as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) + => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args0 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args0) + args1 + with + | Some y => + UnderLets.Base + (#(ident.fancy_mullh + (2 * + Z.log2_up + args0))%expr @ + (x'0 v0, + ## + (y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' + false s1 -> + Compile.value' true + d1 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x1) + end + | ($_)%expr => + match + s as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t4 => + fun + v1 : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args0 =? + 2 + ^ (2 * + Z.log2_up args0 / + 2) - 1 + then + match + invert_high + (2 * + Z.log2_up args0) + args1 + with + | Some y => + UnderLets.Base + (#(ident.fancy_mullh + (2 * + Z.log2_up + args0))%expr @ + (x'0 v1, + ##(y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | @expr.LetIn _ _ _ _ _ _ _ => + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args0 =? + 2 + ^ (2 * + Z.log2_up args0 / + 2) - 1 + then + match + invert_high + (2 * + Z.log2_up args0) + args1 + with + | Some y => + UnderLets.Base + (#(ident.fancy_mullh + (2 * + Z.log2_up + args0))%expr @ + (x'0 v0, + ##(y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | _ => + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args0 =? + 2 + ^ (2 * + Z.log2_up args0 / + 2) - 1 + then + match + invert_high + (2 * + Z.log2_up args0) + args1 + with + | Some y => + UnderLets.Base + (#(ident.fancy_mullh + (2 * + Z.log2_up + args0))%expr @ + (x'0 v0, + ##(y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + end + | None => UnderLets.Base (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr + end + | @expr.App _ _ _ s1 _ + (@expr.App _ _ _ s2 _ #(idc1)%expr_pat x4) x3 => + match + match idc1 with + | ident.Z_land => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc2)%expr_pat => match - invert_low (2 * Z.log2_up args) args0 + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end with - | Some y => - UnderLets.Base - (#(ident.fancy_mulll - (2 * Z.log2_up args))%expr @ - (x' v, ##(y)%expr))%expr_pat - | None => + | Some args2 => match s as t3 return (Compile.value' false t3 -> UnderLets.UnderLets base.type ident - var (expr (type.base base.type.Z))) + var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun v : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + match + s1 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + (args0 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (#(ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + (x' v, x'0 v0))%expr_pat + else + match x1 with + | #(idc3)%expr_pat => + match + match + idc3 + with + | @ident.Literal + t6 v1 => + match + t6 as t7 + return + (base.base_interp + t7 -> + option Z) + with + | base.type.unit => + fun + _ : unit + => None + | base.type.Z => + fun + v2 : Z => + Some v2 + | base.type.bool => + fun + _ : bool + => None + | base.type.nat => + fun + _ : nat + => None + end v1 + | _ => None + end + with + | Some + args3 => + match + s0 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v1 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a1 + with + | Some + x'1 => + match + s1 as t7 + return + (Compile.value' + false t7 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t7 => + fun + v2 : + defaults.expr + (type.base + t7) => + base.try_make_transport_cps + (fun + t8 : base.type + => + defaults.expr + (type.base + t8)) t7 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t7) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + (args3 =? + 2 + ^ + (2 * + Z.log2_up + args3 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args3 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args3))%expr @ + ( + x'1 v1, + x'2 v2))%expr_pat + else + match + x3 + with + | # + (idc4)%expr_pat => + match + match + idc4 + with + | @ident.Literal + t9 v3 => + match + t9 as t10 + return + (base.base_interp + t10 -> + option Z) + with + | base.type.unit => + fun + _ : unit + => None + | base.type.Z => + fun + v4 : Z => + Some v4 + | base.type.bool => + fun + _ : bool + => None + | base.type.nat => + fun + _ : nat + => None + end v3 + | _ => + None + end + with + | Some + args4 => + match + s as t9 + return + (Compile.value' + false t9 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t9 => + fun + v3 : + defaults.expr + (type.base + t9) => + base.try_make_transport_cps + (fun + t10 : base.type + => + defaults.expr + (type.base + t10)) t9 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a3 : + option + (defaults.expr + (type.base + t9) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a3 + with + | Some + x'3 => + match + s2 as t10 + return + (Compile.value' + false t10 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t10 => + fun + v4 : + defaults.expr + (type.base + t10) => + base.try_make_transport_cps + (fun + t11 : base.type + => + defaults.expr + (type.base + t11)) t10 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a4 : + option + (defaults.expr + (type.base + t10) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a4 + with + | Some + x'4 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args4 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x'3 v3, + x'4 v4))%expr_pat + else + match + s0 as t11 + return + (Compile.value' + false t11 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t11 => + fun + v5 : + defaults.expr + (type.base + t11) => + base.try_make_transport_cps + (fun + t12 : base.type + => + defaults.expr + (type.base + t12)) t11 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a5 : + option + (defaults.expr + (type.base + t11) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a5 + with + | Some + x'5 => + match + s2 as t12 + return + (Compile.value' + false t12 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t12 => + fun + v6 : + defaults.expr + (type.base + t12) => + base.try_make_transport_cps + (fun + t13 : base.type + => + defaults.expr + (type.base + t13)) t12 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a6 : + option + (defaults.expr + (type.base + t12) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a6 + with + | Some + x'6 => + if + (args3 =? + 2 + ^ + (2 * + Z.log2_up + args3 / 2) - + 1) && + (args4 =? + 2 + ^ + (2 * + Z.log2_up + args3 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args3))%expr @ + ( + x'5 v5, + x'6 v6))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x1) + | None => + UnderLets.Base + (x * x0)%expr + end + | _ => + UnderLets.Base + (x * x0)%expr + end + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x3) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + | None => + match + x3 + with + | # + (idc4)%expr_pat => + match + match + idc4 + with + | @ident.Literal + t7 v1 => + match + t7 as t8 + return + (base.base_interp + t8 -> + option Z) + with + | base.type.unit => + fun + _ : unit + => None + | base.type.Z => + fun + v2 : Z => + Some v2 + | base.type.bool => + fun + _ : bool + => None + | base.type.nat => + fun + _ : nat + => None + end v1 + | _ => + None + end + with + | Some + args3 => + match + s as t7 + return + (Compile.value' + false t7 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t7 => + fun + v1 : + defaults.expr + (type.base + t7) => + base.try_make_transport_cps + (fun + t8 : base.type + => + defaults.expr + (type.base + t8)) t7 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : + option + (defaults.expr + (type.base + t7) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a1 + with + | Some + x'1 => + match + s2 as t8 + return + (Compile.value' + false t8 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t8 => + fun + v2 : + defaults.expr + (type.base + t8) => + base.try_make_transport_cps + (fun + t9 : base.type + => + defaults.expr + (type.base + t9)) t8 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t8) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args3 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x'1 v1, + x'2 v2))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x1) + | None => + UnderLets.Base + (x * x0)%expr + end + | _ => + UnderLets.Base + (x * x0)%expr + end + end + | ($_)%expr => + match x3 with + | #(idc3)%expr_pat => + match + match + idc3 + with + | @ident.Literal + t7 v2 => + match + t7 as t8 + return + (base.base_interp + t8 -> + option Z) + with + | base.type.unit => + fun + _ : unit + => None + | base.type.Z => + fun + v3 : Z => + Some v3 + | base.type.bool => + fun + _ : bool + => None + | base.type.nat => + fun + _ : nat + => None + end v2 + | _ => + None + end + with + | Some + args3 => + match + s as t7 + return + (Compile.value' + false t7 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t7 => + fun + v2 : + defaults.expr + (type.base + t7) => + base.try_make_transport_cps + (fun + t8 : base.type + => + defaults.expr + (type.base + t8)) t7 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : + option + (defaults.expr + (type.base + t7) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a1 + with + | Some + x'1 => + match + s2 as t8 + return + (Compile.value' + false t8 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t8 => + fun + v3 : + defaults.expr + (type.base + t8) => + base.try_make_transport_cps + (fun + t9 : base.type + => + defaults.expr + (type.base + t9)) t8 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t8) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args3 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x'1 v2, + x'2 v3))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x1) + | None => + UnderLets.Base + (x * x0)%expr + end + | _ => + UnderLets.Base + (x * x0)%expr + end + | @expr.LetIn _ _ + _ _ _ _ _ => + match x3 with + | #(idc3)%expr_pat => + match + match + idc3 + with + | @ident.Literal + t6 v1 => + match + t6 as t7 + return + (base.base_interp + t7 -> + option Z) + with + | base.type.unit => + fun + _ : unit + => None + | base.type.Z => + fun + v2 : Z => + Some v2 + | base.type.bool => + fun + _ : bool + => None + | base.type.nat => + fun + _ : nat + => None + end v1 + | _ => + None + end + with + | Some + args3 => + match + s as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v1 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a1 + with + | Some + x'1 => + match + s2 as t7 + return + (Compile.value' + false t7 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t7 => + fun + v2 : + defaults.expr + (type.base + t7) => + base.try_make_transport_cps + (fun + t8 : base.type + => + defaults.expr + (type.base + t8)) t7 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t7) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args3 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x'1 v1, + x'2 v2))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x1) + | None => + UnderLets.Base + (x * x0)%expr + end + | _ => + UnderLets.Base + (x * x0)%expr + end + | _ => + match x3 with + | #(idc3)%expr_pat => + match + match + idc3 + with + | @ident.Literal + t6 v1 => + match + t6 as t7 + return + (base.base_interp + t7 -> + option Z) + with + | base.type.unit => + fun + _ : unit + => None + | base.type.Z => + fun + v2 : Z => + Some v2 + | base.type.bool => + fun + _ : bool + => None + | base.type.nat => + fun + _ : nat + => None + end v1 + | _ => + None + end + with + | Some + args3 => + match + s as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v1 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a1 + with + | Some + x'1 => + match + s2 as t7 + return + (Compile.value' + false t7 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t7 => + fun + v2 : + defaults.expr + (type.base + t7) => + base.try_make_transport_cps + (fun + t8 : base.type + => + defaults.expr + (type.base + t8)) t7 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t7) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args3 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x'1 v1, + x'2 v2))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> + d4)%ptype => + fun + _ : + Compile.value' + false s4 -> + Compile.value' + true d4 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> + d4)%ptype => + fun + _ : + Compile.value' + false s4 -> + Compile.value' + true d4 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x1) + | None => + UnderLets.Base + (x * x0)%expr + end + | _ => + UnderLets.Base + (x * x0)%expr + end + end + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false + s3 -> + Compile.value' true + d3 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x3) + | None => + UnderLets.Base (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => + match x3 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t4 v => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t4 => + fun + v : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s2 as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t5 => + fun + v0 : defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base t6)) + t5 base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x' v, + x'0 v0))%expr_pat + else + match + x1 + with + | # + (idc4)%expr_pat => + match + match + idc4 + with + | @ident.Literal + t7 v1 => + match + t7 as t8 + return + (base.base_interp + t8 -> + option Z) + with + | base.type.unit => + fun + _ : unit + => None + | base.type.Z => + fun + v2 : Z => + Some v2 + | base.type.bool => + fun + _ : bool + => None + | base.type.nat => + fun + _ : nat + => None + end v1 + | _ => + None + end + with + | Some + args3 => + match + s0 as t7 + return + (Compile.value' + false t7 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t7 => + fun + v1 : + defaults.expr + (type.base + t7) => + base.try_make_transport_cps + (fun + t8 : base.type + => + defaults.expr + (type.base + t8)) t7 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : + option + (defaults.expr + (type.base + t7) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a1 + with + | Some + x'1 => + match + s2 as t8 + return + (Compile.value' + false t8 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t8 => + fun + v2 : + defaults.expr + (type.base + t8) => + base.try_make_transport_cps + (fun + t9 : base.type + => + defaults.expr + (type.base + t9)) t8 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t8) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + (args3 =? + 2 + ^ + (2 * + Z.log2_up + args3 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args3 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args3))%expr @ + ( + x'1 v1, + x'2 v2))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + | None => + UnderLets.Base + (x * x0)%expr + end + | _ => + UnderLets.Base + (x * x0)%expr + end + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' + true d3 => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + end + | ($_)%expr => + match x3 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t4 v0 => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v0 + | _ => None + end + with + | Some args2 => + match + s as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t4) -> + defaults.expr + (type.base + base.type.Z)) => + match a with + | Some x' => + match + s2 as t5 + return + (Compile.value' false + t5 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t5 => + fun + v1 : defaults.expr + (type.base t5) + => + base.try_make_transport_cps + (fun t6 : base.type + => + defaults.expr + (type.base t6)) + t5 base.type.Z + (UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + (args0 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (#(ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + (x' v0, + x'0 v1))%expr_pat + else + match x1 with + | #(idc3)%expr_pat => + match + match + idc3 + with + | @ident.Literal + t7 v2 => + match + t7 as t8 + return + (base.base_interp + t8 -> + option Z) + with + | base.type.unit => + fun + _ : unit + => None + | base.type.Z => + fun + v3 : Z => + Some v3 + | base.type.bool => + fun + _ : bool + => None + | base.type.nat => + fun + _ : nat + => None + end v2 + | _ => + None + end + with + | Some + args3 => + match + s0 as t7 + return + (Compile.value' + false t7 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t7 => + fun + v2 : + defaults.expr + (type.base + t7) => + base.try_make_transport_cps + (fun + t8 : base.type + => + defaults.expr + (type.base + t8)) t7 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : + option + (defaults.expr + (type.base + t7) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a1 + with + | Some + x'1 => + match + s2 as t8 + return + (Compile.value' + false t8 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t8 => + fun + v3 : + defaults.expr + (type.base + t8) => + base.try_make_transport_cps + (fun + t9 : base.type + => + defaults.expr + (type.base + t9)) t8 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t8) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + (args3 =? + 2 + ^ + (2 * + Z.log2_up + args3 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args3 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args3))%expr @ + ( + x'1 v2, + x'2 v3))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + | None => + UnderLets.Base + (x * x0)%expr + end + | _ => + UnderLets.Base + (x * x0)%expr + end + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' + true d3 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | @expr.LetIn _ _ _ _ _ _ _ => + match x3 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) + t3 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) => + match a with + | Some x' => + match + s2 as t4 + return + (Compile.value' false + t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) + => + base.try_make_transport_cps + (fun t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + (args0 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (#(ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + (x' v, + x'0 v0))%expr_pat + else + match x1 with + | #(idc3)%expr_pat => + match + match + idc3 + with + | @ident.Literal + t6 v1 => + match + t6 as t7 + return + (base.base_interp + t7 -> + option Z) + with + | base.type.unit => + fun + _ : unit + => None + | base.type.Z => + fun + v2 : Z => + Some v2 + | base.type.bool => + fun + _ : bool + => None + | base.type.nat => + fun + _ : nat + => None + end v1 + | _ => + None + end + with + | Some + args3 => + match + s0 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v1 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a1 + with + | Some + x'1 => + match + s2 as t7 + return + (Compile.value' + false t7 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t7 => + fun + v2 : + defaults.expr + (type.base + t7) => + base.try_make_transport_cps + (fun + t8 : base.type + => + defaults.expr + (type.base + t8)) t7 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t7) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + (args3 =? + 2 + ^ + (2 * + Z.log2_up + args3 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args3 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args3))%expr @ + ( + x'1 v1, + x'2 v2))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + | None => + UnderLets.Base + (x * x0)%expr + end + | _ => + UnderLets.Base + (x * x0)%expr + end + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' + true d3 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | _ => + match x3 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) + t3 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) => + match a with + | Some x' => + match + s2 as t4 + return + (Compile.value' false + t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) + => + base.try_make_transport_cps + (fun t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + (args0 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (#(ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + (x' v, + x'0 v0))%expr_pat + else + match x1 with + | #(idc3)%expr_pat => + match + match + idc3 + with + | @ident.Literal + t6 v1 => + match + t6 as t7 + return + (base.base_interp + t7 -> + option Z) + with + | base.type.unit => + fun + _ : unit + => None + | base.type.Z => + fun + v2 : Z => + Some v2 + | base.type.bool => + fun + _ : bool + => None + | base.type.nat => + fun + _ : nat + => None + end v1 + | _ => + None + end + with + | Some + args3 => + match + s0 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v1 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a1 + with + | Some + x'1 => + match + s2 as t7 + return + (Compile.value' + false t7 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t7 => + fun + v2 : + defaults.expr + (type.base + t7) => + base.try_make_transport_cps + (fun + t8 : base.type + => + defaults.expr + (type.base + t8)) t7 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t7) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + (args3 =? + 2 + ^ + (2 * + Z.log2_up + args3 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args3 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args3))%expr @ + ( + x'1 v1, + x'2 v2))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> + d4)%ptype => + fun + _ : + Compile.value' + false s4 -> + Compile.value' + true d4 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> + d4)%ptype => + fun + _ : + Compile.value' + false s4 -> + Compile.value' + true d4 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + | None => + UnderLets.Base + (x * x0)%expr + end + | _ => + UnderLets.Base + (x * x0)%expr + end + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' + false s4 -> + Compile.value' + true d4 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + end + | None => + match + match idc1 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x3 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) + t3 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) => + match a with + | Some x' => + match + s2 as t4 + return + (Compile.value' false + t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) + => + base.try_make_transport_cps + (fun t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args0 =? + 2 + ^ (2 * args2 / + 2) - 1 + then + UnderLets.Base + (#(ident.fancy_mullh + (2 * + args2))%expr @ + (x' v, + x'0 v0))%expr_pat + else + match x1 with + | #(idc3)%expr_pat => + match + match + idc3 + with + | @ident.Literal + t6 v1 => + match + t6 as t7 + return + (base.base_interp + t7 -> + option Z) + with + | base.type.unit => + fun + _ : unit + => None + | base.type.Z => + fun + v2 : Z => + Some v2 + | base.type.bool => + fun + _ : bool + => None + | base.type.nat => + fun + _ : nat + => None + end v1 + | _ => + None + end + with + | Some + args3 => + match + s0 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v1 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a1 + with + | Some + x'1 => + match + s2 as t7 + return + (Compile.value' + false t7 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t7 => + fun + v2 : + defaults.expr + (type.base + t7) => + base.try_make_transport_cps + (fun + t8 : base.type + => + defaults.expr + (type.base + t8)) t7 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t7) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + args3 =? + 2 + ^ + (2 * + args2 / 2) - + 1 + then + UnderLets.Base + (# + (ident.fancy_mullh + (2 * + args2))%expr @ + ( + x'1 v1, + x'2 v2))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + | None => + UnderLets.Base + (x * x0)%expr + end + | _ => + UnderLets.Base + (x * x0)%expr + end + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' + true d3 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x1) + | None => UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | None => UnderLets.Base (x * x0)%expr + end + end + | @expr.App _ _ _ s1 _ (@expr.App _ _ _ s2 _ ($_)%expr _) + _ | @expr.App _ _ _ s1 _ + (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _) _ | + @expr.App _ _ _ s1 _ + (@expr.App _ _ _ s2 _ (_ @ _)%expr_pat _) _ | @expr.App + _ _ _ s1 _ + (@expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) _) + _ => UnderLets.Base (x * x0)%expr + | @expr.App _ _ _ s1 _ #(_)%expr_pat _ | @expr.App _ _ _ + s1 _ ($_)%expr _ | @expr.App _ _ _ s1 _ + (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s1 _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.Base (x * x0)%expr + | _ => UnderLets.Base (x * x0)%expr + end + | None => + match x1 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match x0 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base base.type.Z))) with | type.base t3 => - fun v0 : expr (type.base t3) => + fun v : defaults.expr (type.base t3) + => base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 base.type.Z (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) + (defaults.expr + (type.base base.type.Z))) (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) => - match a0 with - | Some x'0 => + match a with + | Some x' => if - args =? - 2 ^ (2 * Z.log2_up args / 2) - + args0 =? + 2 ^ (2 * Z.log2_up args0 / 2) - 1 then match - invert_high - (2 * Z.log2_up args) - args0 + invert_low + (2 * Z.log2_up args0) + args1 with | Some y => UnderLets.Base - (#(ident.fancy_mullh + (#(ident.fancy_mulll (2 * - Z.log2_up args))%expr @ - (x'0 v0, ##(y)%expr))%expr_pat + Z.log2_up args0))%expr @ + (x' v, ##(y)%expr))%expr_pat | None => - UnderLets.Base - (x * x0)%expr + match + s0 as t4 + return + (Compile.value' false + t4 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base + t4) => + base.try_make_transport_cps + (fun t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args0 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args0) + args1 + with + | Some y => + UnderLets.Base + (# + (ident.fancy_mullh + (2 * + Z.log2_up + args0))%expr @ + ( + x'0 v0, + ## + (y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' + false s1 -> + Compile.value' + true d1 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) end else - UnderLets.Base (x * x0)%expr + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) + => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args0 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args0) + args1 + with + | Some y => + UnderLets.Base + (#(ident.fancy_mullh + (2 * + Z.log2_up + args0))%expr @ + (x'0 v0, + ## + (y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' + false s1 -> + Compile.value' true + d1 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) | None => UnderLets.Base (x * x0)%expr end) - | (s0 -> d0)%ptype => + | (s1 -> d1)%ptype => fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => + _ : Compile.value' false s1 -> + Compile.value' true d1 => UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) + end (Compile.reflect x2) + | None => UnderLets.Base (x * x0)%expr end - else + | @expr.App _ _ _ s1 _ + (@expr.App _ _ _ s2 _ #(idc2)%expr_pat x4) + x3 => match - s as t3 + match idc2 with + | ident.Z_land => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t4 v => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t4 => + fun + v : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s1 as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t5 => + fun + v0 : defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base t6)) + t5 base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x' v, + x'0 v0))%expr_pat + else + match + x3 + with + | # + (idc4)%expr_pat => + match + match + idc4 + with + | @ident.Literal + t7 v1 => + match + t7 as t8 + return + (base.base_interp + t8 -> + option Z) + with + | base.type.unit => + fun + _ : unit + => None + | base.type.Z => + fun + v2 : Z => + Some v2 + | base.type.bool => + fun + _ : bool + => None + | base.type.nat => + fun + _ : nat + => None + end v1 + | _ => + None + end + with + | Some + args3 => + match + s0 as t7 + return + (Compile.value' + false t7 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t7 => + fun + v1 : + defaults.expr + (type.base + t7) => + base.try_make_transport_cps + (fun + t8 : base.type + => + defaults.expr + (type.base + t8)) t7 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : + option + (defaults.expr + (type.base + t7) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a1 + with + | Some + x'1 => + match + s2 as t8 + return + (Compile.value' + false t8 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t8 => + fun + v2 : + defaults.expr + (type.base + t8) => + base.try_make_transport_cps + (fun + t9 : base.type + => + defaults.expr + (type.base + t9)) t8 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t8) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args3 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x'1 v1, + x'2 v2))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + | None => + UnderLets.Base + (x * x0)%expr + end + | _ => + UnderLets.Base + (x * x0)%expr + end + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' + true d3 => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect x3) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + match x3 with + | #(idc4)%expr_pat => + match + match idc4 with + | @ident.Literal t5 v => + match + t5 as t6 + return + (base.base_interp + t6 -> option Z) + with + | base.type.unit => + fun _ : unit => + None + | base.type.Z => + fun v0 : Z => + Some v0 + | base.type.bool => + fun _ : bool => + None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t5 + return + (Compile.value' false + t5 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t5 => + fun + v : defaults.expr + (type.base t5) + => + base.try_make_transport_cps + (fun t6 : base.type + => + defaults.expr + (type.base t6)) + t5 base.type.Z + (UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s2 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v0 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a0 + with + | Some + x'0 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x' v, + x'0 v0))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' + true d3 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base + (x * x0)%expr + end + | _ => + UnderLets.Base (x * x0)%expr + end + end + | ($_)%expr => + match x3 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t5 v0 => + match + t5 as t6 + return + (base.base_interp t6 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v0 + | _ => None + end + with + | Some args2 => + match + s0 as t5 + return + (Compile.value' false t5 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t5 => + fun + v0 : defaults.expr + (type.base t5) + => + base.try_make_transport_cps + (fun t6 : base.type => + defaults.expr + (type.base t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s2 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t6 => + fun + v1 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a0 + with + | Some + x'0 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x' v0, + x'0 v1))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' true + d3 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | @expr.LetIn _ _ _ _ _ _ _ => + match x3 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t4 v => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s2 as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t5 => + fun + v0 : + defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base + t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a0 + with + | Some + x'0 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x' v, + x'0 v0))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' true + d3 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | _ => + match x3 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t4 v => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s2 as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t5 => + fun + v0 : + defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base + t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a0 + with + | Some + x'0 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x' v, + x'0 v0))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : + Compile.value' + false s4 -> + Compile.value' + true d4 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' + false s4 -> + Compile.value' true + d4 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + end + | None => + match + match idc2 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x3 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t4 v => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s2 as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t5 => + fun + v0 : + defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base + t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a0 + with + | Some + x'0 => + if + args0 =? + 2 + ^ + (2 * + args2 / 2) - + 1 + then + UnderLets.Base + (# + (ident.fancy_mullh + (2 * + args2))%expr @ + ( + x' v, + x'0 v0))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' true + d3 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | None => UnderLets.Base (x * x0)%expr + end + end + | @expr.App _ _ _ s1 _ + (@expr.App _ _ _ s2 _ ($_)%expr _) _ | + @expr.App _ _ _ s1 _ + (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) + _) _ | @expr.App _ _ _ s1 _ + (@expr.App _ _ _ s2 _ (_ @ _)%expr_pat _) _ | + @expr.App _ _ _ s1 _ + (@expr.App _ _ _ s2 _ + (@expr.LetIn _ _ _ _ _ _ _) _) _ => + UnderLets.Base (x * x0)%expr + | @expr.App _ _ _ s1 _ #(_)%expr_pat _ | + @expr.App _ _ _ s1 _ ($_)%expr _ | @expr.App _ + _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App + _ _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.Base (x * x0)%expr + | _ => UnderLets.Base (x * x0)%expr + end + | None => UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + end + | ($_)%expr => + match x1 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t2 v0 => + match + t2 as t3 return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args0 => + match x0 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t3 v0 => + match + t3 as t4 + return (base.base_interp t4 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args1 => + match + s0 as t3 return (Compile.value' false t3 -> UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) + (defaults.expr (type.base base.type.Z))) with | type.base t3 => - fun v0 : expr (type.base t3) => + fun v0 : defaults.expr (type.base t3) => base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 base.type.Z + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z (UnderLets.UnderLets base.type ident - var (expr (type.base base.type.Z))) + var + (defaults.expr + (type.base base.type.Z))) (fun - a0 : option - (expr (type.base t3) -> - expr (type.base base.type.Z)) - => - match a0 with - | Some x'0 => + a : option + (defaults.expr (type.base t3) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => if - args =? - 2 ^ (2 * Z.log2_up args / 2) - 1 + args0 =? + 2 ^ (2 * Z.log2_up args0 / 2) - 1 then match - invert_high - (2 * Z.log2_up args) args0 + invert_low + (2 * Z.log2_up args0) args1 with | Some y => UnderLets.Base - (#(ident.fancy_mullh - (2 * Z.log2_up args))%expr @ - (x'0 v0, ##(y)%expr))%expr_pat + (#(ident.fancy_mulll + (2 * Z.log2_up args0))%expr @ + (x' v0, ##(y)%expr))%expr_pat | None => - UnderLets.Base (x * x0)%expr + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v1 : defaults.expr + (type.base t4) + => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args0 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args0) + args1 + with + | Some y => + UnderLets.Base + (#(ident.fancy_mullh + (2 * + Z.log2_up + args0))%expr @ + (x'0 v1, + ## + (y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' + false s1 -> + Compile.value' true + d1 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) end - else UnderLets.Base (x * x0)%expr + else + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t4 => + fun + v1 : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args0 =? + 2 + ^ (2 * + Z.log2_up args0 / + 2) - 1 + then + match + invert_high + (2 * + Z.log2_up args0) + args1 + with + | Some y => + UnderLets.Base + (#(ident.fancy_mullh + (2 * + Z.log2_up + args0))%expr @ + (x'0 v1, + ##(y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) | None => UnderLets.Base (x * x0)%expr end) - | (s0 -> d0)%ptype => + | (s1 -> d1)%ptype => fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => + _ : Compile.value' false s1 -> + Compile.value' true d1 => UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x * x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => UnderLets.Base (x * x0)%expr + end + | @expr.App _ _ _ s1 _ + (@expr.App _ _ _ s2 _ #(idc1)%expr_pat x4) x3 => + match + match idc1 with + | ident.Z_land => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t4 v0 => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v0 + | _ => None + end + with + | Some args2 => + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t4) -> + defaults.expr + (type.base + base.type.Z)) => + match a with + | Some x' => + match + s1 as t5 + return + (Compile.value' false + t5 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t5 => + fun + v1 : defaults.expr + (type.base t5) + => + base.try_make_transport_cps + (fun t6 : base.type + => + defaults.expr + (type.base t6)) + t5 base.type.Z + (UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + (args0 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (#(ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + (x' v0, + x'0 v1))%expr_pat + else + match x3 with + | #(idc3)%expr_pat => + match + match + idc3 + with + | @ident.Literal + t7 v2 => + match + t7 as t8 + return + (base.base_interp + t8 -> + option Z) + with + | base.type.unit => + fun + _ : unit + => None + | base.type.Z => + fun + v3 : Z => + Some v3 + | base.type.bool => + fun + _ : bool + => None + | base.type.nat => + fun + _ : nat + => None + end v2 + | _ => + None + end + with + | Some + args3 => + match + s0 as t7 + return + (Compile.value' + false t7 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t7 => + fun + v2 : + defaults.expr + (type.base + t7) => + base.try_make_transport_cps + (fun + t8 : base.type + => + defaults.expr + (type.base + t8)) t7 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : + option + (defaults.expr + (type.base + t7) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a1 + with + | Some + x'1 => + match + s2 as t8 + return + (Compile.value' + false t8 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t8 => + fun + v3 : + defaults.expr + (type.base + t8) => + base.try_make_transport_cps + (fun + t9 : base.type + => + defaults.expr + (type.base + t9)) t8 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t8) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args3 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x'1 v2, + x'2 v3))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + | None => + UnderLets.Base + (x * x0)%expr + end + | _ => + UnderLets.Base + (x * x0)%expr + end + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' + true d3 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x3) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + match x3 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t5 v0 => + match + t5 as t6 + return + (base.base_interp t6 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v0 + | _ => None + end + with + | Some args2 => + match + s0 as t5 + return + (Compile.value' false t5 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t5 => + fun + v0 : defaults.expr + (type.base t5) + => + base.try_make_transport_cps + (fun t6 : base.type => + defaults.expr + (type.base t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s2 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t6 => + fun + v1 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a0 + with + | Some + x'0 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x' v0, + x'0 v1))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' true + d3 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + end + | ($_)%expr => + match x3 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t5 v1 => + match + t5 as t6 + return + (base.base_interp t6 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v2 : Z => Some v2 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v1 + | _ => None + end + with + | Some args2 => + match + s0 as t5 + return + (Compile.value' false t5 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t5 => + fun + v1 : defaults.expr + (type.base t5) => + base.try_make_transport_cps + (fun t6 : base.type => + defaults.expr + (type.base t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s2 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t6 => + fun + v2 : defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base t7)) + t6 base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x' v1, + x'0 v2))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' + true d3 => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | @expr.LetIn _ _ _ _ _ _ _ => + match x3 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t4 v0 => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v0 + | _ => None + end + with + | Some args2 => + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s2 as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t5 => + fun + v1 : defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base t6)) + t5 base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x' v0, + x'0 v1))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' + true d3 => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | _ => + match x3 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t4 v0 => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v0 + | _ => None + end + with + | Some args2 => + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s2 as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t5 => + fun + v1 : defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base t6)) + t5 base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x' v0, + x'0 v1))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' + false s4 -> + Compile.value' + true d4 => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + end + | None => + match + match idc1 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x3 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t4 v0 => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v0 + | _ => None + end + with + | Some args2 => + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s2 as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t5 => + fun + v1 : defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base t6)) + t5 base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args0 =? + 2 + ^ + (2 * args2 / + 2) - 1 + then + UnderLets.Base + (# + (ident.fancy_mullh + (2 * + args2))%expr @ + ( + x' v0, + x'0 v1))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' + true d3 => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | None => UnderLets.Base (x * x0)%expr + end + end + | @expr.App _ _ _ s1 _ + (@expr.App _ _ _ s2 _ ($_)%expr _) _ | @expr.App _ + _ _ s1 _ + (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _) + _ | @expr.App _ _ _ s1 _ + (@expr.App _ _ _ s2 _ (_ @ _)%expr_pat _) _ | + @expr.App _ _ _ s1 _ + (@expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) + _) _ => UnderLets.Base (x * x0)%expr + | @expr.App _ _ _ s1 _ #(_)%expr_pat _ | @expr.App _ + _ _ s1 _ ($_)%expr _ | @expr.App _ _ _ s1 _ + (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s1 _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.Base (x * x0)%expr + | _ => UnderLets.Base (x * x0)%expr + end + | None => UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr end - | @expr.App _ _ _ s0 _ #(idc0)%expr_pat x2 => - match - match idc0 with - | ident.Z_land mask => Some mask - | _ => None - end - with - | Some args0 => + | @expr.Abs _ _ _ _ _ _ => + match x1 with + | #(idc0)%expr_pat => match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s0 as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a0 : option - (expr (type.base t3) -> - expr (type.base base.type.Z)) - => - match a0 with - | Some x'0 => - if - (args =? - 2 ^ (2 * Z.log2_up args / 2) - 1) && - (args0 =? - 2 ^ (2 * Z.log2_up args / 2) - 1) - then - UnderLets.Base - (#(ident.fancy_mulll - (2 * Z.log2_up args))%expr @ - (x' v, x'0 v0))%expr_pat - else UnderLets.Base (x * x0)%expr - | None => UnderLets.Base (x * x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x2) - | None => UnderLets.Base (x * x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) - | None => + | Some args0 => + match x0 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if + args0 =? + 2 ^ (2 * Z.log2_up args0 / 2) - 1 + then + match + invert_low + (2 * Z.log2_up args0) args1 + with + | Some y => + UnderLets.Base + (#(ident.fancy_mulll + (2 * Z.log2_up args0))%expr @ + (x' v, ##(y)%expr))%expr_pat + | None => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args0 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args0) + args1 + with + | Some y => + UnderLets.Base + (#(ident.fancy_mullh + (2 * + Z.log2_up + args0))%expr @ + (x'0 v0, + ## + (y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' + false s2 -> + Compile.value' true + d2 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) + end + else + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args0 =? + 2 + ^ (2 * + Z.log2_up args0 / + 2) - 1 + then + match + invert_high + (2 * + Z.log2_up args0) + args1 + with + | Some y => + UnderLets.Base + (#(ident.fancy_mullh + (2 * + Z.log2_up + args0))%expr @ + (x'0 v0, + ##(y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => UnderLets.Base (x * x0)%expr + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => UnderLets.Base (x * x0)%expr + end + | @expr.App _ _ _ s2 _ + (@expr.App _ _ _ s3 _ #(idc1)%expr_pat x4) x3 => + match + match idc1 with + | ident.Z_land => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) + t3 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) => + match a with + | Some x' => + match + s2 as t4 + return + (Compile.value' false + t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) + => + base.try_make_transport_cps + (fun t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + (args0 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (#(ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + (x' v, + x'0 v0))%expr_pat + else + match x3 with + | #(idc3)%expr_pat => + match + match + idc3 + with + | @ident.Literal + t6 v1 => + match + t6 as t7 + return + (base.base_interp + t7 -> + option Z) + with + | base.type.unit => + fun + _ : unit + => None + | base.type.Z => + fun + v2 : Z => + Some v2 + | base.type.bool => + fun + _ : bool + => None + | base.type.nat => + fun + _ : nat + => None + end v1 + | _ => + None + end + with + | Some + args3 => + match + s0 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v1 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a1 + with + | Some + x'1 => + match + s3 as t7 + return + (Compile.value' + false t7 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t7 => + fun + v2 : + defaults.expr + (type.base + t7) => + base.try_make_transport_cps + (fun + t8 : base.type + => + defaults.expr + (type.base + t8)) t7 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t7) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args3 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x'1 v1, + x'2 v2))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> + d4)%ptype => + fun + _ : + Compile.value' + false s4 -> + Compile.value' + true d4 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> + d4)%ptype => + fun + _ : + Compile.value' + false s4 -> + Compile.value' + true d4 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + | None => + UnderLets.Base + (x * x0)%expr + end + | _ => + UnderLets.Base + (x * x0)%expr + end + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' + false s4 -> + Compile.value' + true d4 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x3) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + match x3 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t4 v => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s3 as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t5 => + fun + v0 : + defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base + t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a0 + with + | Some + x'0 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x' v, + x'0 v0))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : + Compile.value' + false s4 -> + Compile.value' + true d4 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' + false s4 -> + Compile.value' true + d4 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + end + | ($_)%expr => + match x3 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t4 v0 => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v0 + | _ => None + end + with + | Some args2 => + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s3 as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t5 => + fun + v1 : defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base t6)) + t5 base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x' v0, + x'0 v1))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' + false s4 -> + Compile.value' + true d4 => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | @expr.LetIn _ _ _ _ _ _ _ => + match x3 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s3 as t4 + return + (Compile.value' + false t4 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base + t4) => + base.try_make_transport_cps + (fun + t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x' v, + x'0 v0))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' + false s4 -> + Compile.value' + true d4 => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | _ => + match x3 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s3 as t4 + return + (Compile.value' + false t4 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base + t4) => + base.try_make_transport_cps + (fun + t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x' v, + x'0 v0))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s5 -> d5)%ptype => + fun + _ : Compile.value' + false s5 -> + Compile.value' + true d5 => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s5 -> d5)%ptype => + fun + _ : Compile.value' false s5 -> + Compile.value' true d5 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + end + | None => + match + match idc1 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x3 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s3 as t4 + return + (Compile.value' + false t4 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base + t4) => + base.try_make_transport_cps + (fun + t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args0 =? + 2 + ^ + (2 * args2 / + 2) - 1 + then + UnderLets.Base + (# + (ident.fancy_mullh + (2 * + args2))%expr @ + ( + x' v, + x'0 v0))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' + false s4 -> + Compile.value' + true d4 => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | None => UnderLets.Base (x * x0)%expr + end + end + | @expr.App _ _ _ s2 _ + (@expr.App _ _ _ s3 _ ($_)%expr _) _ | @expr.App _ + _ _ s2 _ + (@expr.App _ _ _ s3 _ (@expr.Abs _ _ _ _ _ _) _) + _ | @expr.App _ _ _ s2 _ + (@expr.App _ _ _ s3 _ (_ @ _)%expr_pat _) _ | + @expr.App _ _ _ s2 _ + (@expr.App _ _ _ s3 _ (@expr.LetIn _ _ _ _ _ _ _) + _) _ => UnderLets.Base (x * x0)%expr + | @expr.App _ _ _ s2 _ #(_)%expr_pat _ | @expr.App _ + _ _ s2 _ ($_)%expr _ | @expr.App _ _ _ s2 _ + (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s2 _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.Base (x * x0)%expr + | _ => UnderLets.Base (x * x0)%expr + end + | None => UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | (_ @ _)%expr_pat => + match x1 with + | #(idc0)%expr_pat => match match idc0 with - | ident.Z_shiftr offset => Some offset + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v | _ => None end with | Some args0 => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s0 as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident - var (expr (type.base base.type.Z))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 base.type.Z - (UnderLets.UnderLets base.type ident - var - (expr (type.base base.type.Z))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) - => - match a0 with - | Some x'0 => - if - args =? - 2 ^ (2 * args0 / 2) - 1 - then - UnderLets.Base - (#(ident.fancy_mullh - (2 * args0))%expr @ - (x' v, x'0 v0))%expr_pat - else - UnderLets.Base (x * x0)%expr - | None => - UnderLets.Base (x * x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x2) - | None => UnderLets.Base (x * x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => + match x0 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if + args0 =? + 2 ^ (2 * Z.log2_up args0 / 2) - 1 + then + match + invert_low + (2 * Z.log2_up args0) args1 + with + | Some y => + UnderLets.Base + (#(ident.fancy_mulll + (2 * Z.log2_up args0))%expr @ + (x' v, ##(y)%expr))%expr_pat + | None => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args0 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args0) + args1 + with + | Some y => + UnderLets.Base + (#(ident.fancy_mullh + (2 * + Z.log2_up + args0))%expr @ + (x'0 v0, + ## + (y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' + false s2 -> + Compile.value' true + d2 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) + end + else + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args0 =? + 2 + ^ (2 * + Z.log2_up args0 / + 2) - 1 + then + match + invert_high + (2 * + Z.log2_up args0) + args1 + with + | Some y => + UnderLets.Base + (#(ident.fancy_mullh + (2 * + Z.log2_up + args0))%expr @ + (x'0 v0, + ##(y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => UnderLets.Base (x * x0)%expr + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => UnderLets.Base (x * x0)%expr + end + | @expr.App _ _ _ s2 _ + (@expr.App _ _ _ s3 _ #(idc1)%expr_pat x5) x4 => + match + match idc1 with + | ident.Z_land => Some tt + | _ => None + end + with + | Some _ => + match x5 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) + t3 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) => + match a with + | Some x' => + match + s2 as t4 + return + (Compile.value' false + t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) + => + base.try_make_transport_cps + (fun t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + (args0 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (#(ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + (x' v, + x'0 v0))%expr_pat + else + match x4 with + | #(idc3)%expr_pat => + match + match + idc3 + with + | @ident.Literal + t6 v1 => + match + t6 as t7 + return + (base.base_interp + t7 -> + option Z) + with + | base.type.unit => + fun + _ : unit + => None + | base.type.Z => + fun + v2 : Z => + Some v2 + | base.type.bool => + fun + _ : bool + => None + | base.type.nat => + fun + _ : nat + => None + end v1 + | _ => + None + end + with + | Some + args3 => + match + s0 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v1 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a1 + with + | Some + x'1 => + match + s3 as t7 + return + (Compile.value' + false t7 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t7 => + fun + v2 : + defaults.expr + (type.base + t7) => + base.try_make_transport_cps + (fun + t8 : base.type + => + defaults.expr + (type.base + t8)) t7 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t7) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args3 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x'1 v1, + x'2 v2))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> + d4)%ptype => + fun + _ : + Compile.value' + false s4 -> + Compile.value' + true d4 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x5) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> + d4)%ptype => + fun + _ : + Compile.value' + false s4 -> + Compile.value' + true d4 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + | None => + UnderLets.Base + (x * x0)%expr + end + | _ => + UnderLets.Base + (x * x0)%expr + end + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' + false s4 -> + Compile.value' + true d4 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + match x4 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t4 v => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s3 as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t5 => + fun + v0 : + defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base + t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a0 + with + | Some + x'0 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x' v, + x'0 v0))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : + Compile.value' + false s4 -> + Compile.value' + true d4 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x5) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' + false s4 -> + Compile.value' true + d4 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + end + | ($_)%expr => + match x4 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t4 v0 => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v0 + | _ => None + end + with + | Some args2 => + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s3 as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t5 => + fun + v1 : defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base t6)) + t5 base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x' v0, + x'0 v1))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' + false s4 -> + Compile.value' + true d4 => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect x5) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | @expr.LetIn _ _ _ _ _ _ _ => + match x4 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s3 as t4 + return + (Compile.value' + false t4 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base + t4) => + base.try_make_transport_cps + (fun + t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x' v, + x'0 v0))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' + false s4 -> + Compile.value' + true d4 => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect x5) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | _ => + match x4 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s3 as t4 + return + (Compile.value' + false t4 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base + t4) => + base.try_make_transport_cps + (fun + t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x' v, + x'0 v0))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s5 -> d5)%ptype => + fun + _ : Compile.value' + false s5 -> + Compile.value' + true d5 => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect x5) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s5 -> d5)%ptype => + fun + _ : Compile.value' false s5 -> + Compile.value' true d5 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + end + | None => + match + match idc1 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s3 as t4 + return + (Compile.value' + false t4 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base + t4) => + base.try_make_transport_cps + (fun + t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args0 =? + 2 + ^ + (2 * args2 / + 2) - 1 + then + UnderLets.Base + (# + (ident.fancy_mullh + (2 * + args2))%expr @ + ( + x' v, + x'0 v0))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' + false s4 -> + Compile.value' + true d4 => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect x5) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | None => UnderLets.Base (x * x0)%expr + end + end + | @expr.App _ _ _ s2 _ + (@expr.App _ _ _ s3 _ ($_)%expr _) _ | @expr.App _ + _ _ s2 _ + (@expr.App _ _ _ s3 _ (@expr.Abs _ _ _ _ _ _) _) + _ | @expr.App _ _ _ s2 _ + (@expr.App _ _ _ s3 _ (_ @ _)%expr_pat _) _ | + @expr.App _ _ _ s2 _ + (@expr.App _ _ _ s3 _ (@expr.LetIn _ _ _ _ _ _ _) + _) _ => UnderLets.Base (x * x0)%expr + | @expr.App _ _ _ s2 _ #(_)%expr_pat _ | @expr.App _ + _ _ s2 _ ($_)%expr _ | @expr.App _ _ _ s2 _ + (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s2 _ + (@expr.LetIn _ _ _ _ _ _ _) _ => UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) + | _ => UnderLets.Base (x * x0)%expr + end | None => UnderLets.Base (x * x0)%expr end + | _ => UnderLets.Base (x * x0)%expr end - | @expr.App _ _ _ s0 _ ($_)%expr _ | @expr.App _ _ _ s0 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 _ - (_ @ _)%expr_pat _ | @expr.App _ _ _ s0 _ - (@expr.LetIn _ _ _ _ _ _ _) _ => UnderLets.Base (x * x0)%expr - | _ => UnderLets.Base (x * x0)%expr - end - | None => - match - match idc with - | ident.Z_shiftr offset => Some offset - | _ => None - end - with - | Some args => - match x0 with + | @expr.LetIn _ _ _ _ _ _ _ => + match x1 with | #(idc0)%expr_pat => match match idc0 with @@ -810,5092 +15007,19878 @@ match idc in (ident t) return (Compile.value' true t) with end with | Some args0 => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match invert_low (2 * args) args0 with - | Some y => - UnderLets.Base - (#(ident.fancy_mulhl (2 * args))%expr @ - (x' v, ##(y)%expr))%expr_pat - | None => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type - ident var - (expr (type.base base.type.Z))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 - base.type.Z - (UnderLets.UnderLets base.type - ident var - (expr (type.base base.type.Z))) - (fun - a0 : option - (expr (type.base t3) -> - expr + match x0 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if + args0 =? + 2 ^ (2 * Z.log2_up args0 / 2) - 1 + then + match + invert_low + (2 * Z.log2_up args0) args1 + with + | Some y => + UnderLets.Base + (#(ident.fancy_mulll + (2 * Z.log2_up args0))%expr @ + (x' v, ##(y)%expr))%expr_pat + | None => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args0 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1 + then + match + invert_high + (2 * + Z.log2_up + args0) + args1 + with + | Some y => + UnderLets.Base + (#(ident.fancy_mullh + (2 * + Z.log2_up + args0))%expr @ + (x'0 v0, + ## + (y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' + false s1 -> + Compile.value' true + d1 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) + end + else + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args0 =? + 2 + ^ (2 * + Z.log2_up args0 / + 2) - 1 + then + match + invert_high + (2 * + Z.log2_up args0) + args1 + with + | Some y => + UnderLets.Base + (#(ident.fancy_mullh + (2 * + Z.log2_up + args0))%expr @ + (x'0 v0, + ##(y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => UnderLets.Base (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => UnderLets.Base (x * x0)%expr + end + | @expr.App _ _ _ s1 _ + (@expr.App _ _ _ s2 _ #(idc1)%expr_pat x5) x4 => + match + match idc1 with + | ident.Z_land => Some tt + | _ => None + end + with + | Some _ => + match x5 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) + t3 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr (type.base base.type.Z)) => - match a0 with - | Some x'0 => + match a with + | Some x' => + match + s1 as t4 + return + (Compile.value' false + t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) + => + base.try_make_transport_cps + (fun t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + (args0 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (#(ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + (x' v, + x'0 v0))%expr_pat + else + match x4 with + | #(idc3)%expr_pat => + match + match + idc3 + with + | @ident.Literal + t6 v1 => + match + t6 as t7 + return + (base.base_interp + t7 -> + option Z) + with + | base.type.unit => + fun + _ : unit + => None + | base.type.Z => + fun + v2 : Z => + Some v2 + | base.type.bool => + fun + _ : bool + => None + | base.type.nat => + fun + _ : nat + => None + end v1 + | _ => + None + end + with + | Some + args3 => + match + s0 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v1 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a1 + with + | Some + x'1 => + match + s2 as t7 + return + (Compile.value' + false t7 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t7 => + fun + v2 : + defaults.expr + (type.base + t7) => + base.try_make_transport_cps + (fun + t8 : base.type + => + defaults.expr + (type.base + t8)) t7 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t7) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args3 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x'1 v1, + x'2 v2))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x5) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + | None => + UnderLets.Base + (x * x0)%expr + end + | _ => + UnderLets.Base + (x * x0)%expr + end + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' + true d3 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + match x4 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t4 v => match - invert_high (2 * args) - args0 + t4 as t5 + return + (base.base_interp t5 -> + option Z) with - | Some y => - UnderLets.Base - (#(ident.fancy_mulhh - (2 * args))%expr @ - (x'0 v0, ##(y)%expr))%expr_pat - | None => - UnderLets.Base - (x * x0)%expr - end - | None => - UnderLets.Base - (x * x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) - end - | None => UnderLets.Base (x * x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s2 as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t5 => + fun + v0 : + defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base + t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a0 + with + | Some + x'0 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x' v, + x'0 v0))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x5) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' true + d3 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + end + | ($_)%expr => + match x4 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t4 v0 => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v0 + | _ => None + end + with + | Some args2 => + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s2 as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t5 => + fun + v1 : defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base t6)) + t5 base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x' v0, + x'0 v1))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' + true d3 => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect x5) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | @expr.LetIn _ _ _ _ _ _ _ => + match x4 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s2 as t4 + return + (Compile.value' + false t4 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base + t4) => + base.try_make_transport_cps + (fun + t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x' v, + x'0 v0))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' + true d3 => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect x5) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | _ => + match x4 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s2 as t4 + return + (Compile.value' + false t4 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base + t4) => + base.try_make_transport_cps + (fun + t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + (args0 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) && + (args2 =? + 2 + ^ + (2 * + Z.log2_up + args0 / 2) - + 1) + then + UnderLets.Base + (# + (ident.fancy_mulll + (2 * + Z.log2_up + args0))%expr @ + ( + x' v, + x'0 v0))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' + false s4 -> + Compile.value' + true d4 => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect x5) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + end + | None => + match + match idc1 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s2 as t4 + return + (Compile.value' + false t4 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base + t4) => + base.try_make_transport_cps + (fun + t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args0 =? + 2 + ^ + (2 * args2 / + 2) - 1 + then + UnderLets.Base + (# + (ident.fancy_mullh + (2 * + args2))%expr @ + ( + x' v, + x'0 v0))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' + true d3 => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect x5) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | None => UnderLets.Base (x * x0)%expr + end + end + | @expr.App _ _ _ s1 _ + (@expr.App _ _ _ s2 _ ($_)%expr _) _ | @expr.App _ + _ _ s1 _ + (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _) + _ | @expr.App _ _ _ s1 _ + (@expr.App _ _ _ s2 _ (_ @ _)%expr_pat _) _ | + @expr.App _ _ _ s1 _ + (@expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) + _) _ => UnderLets.Base (x * x0)%expr + | @expr.App _ _ _ s1 _ #(_)%expr_pat _ | @expr.App _ + _ _ s1 _ ($_)%expr _ | @expr.App _ _ _ s1 _ + (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s1 _ + (@expr.LetIn _ _ _ _ _ _ _) _ => UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) + | _ => UnderLets.Base (x * x0)%expr + end | None => UnderLets.Base (x * x0)%expr end - | @expr.App _ _ _ s0 _ #(idc0)%expr_pat x2 => + | _ => UnderLets.Base (x * x0)%expr + end + end + | None => + match + match idc with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x1 with + | #(idc0)%expr_pat => match match idc0 with - | ident.Z_land mask => Some mask + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v | _ => None end with | Some args0 => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s0 as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident - var (expr (type.base base.type.Z))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 base.type.Z - (UnderLets.UnderLets base.type ident - var - (expr (type.base base.type.Z))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) - => - match a0 with - | Some x'0 => - if - args0 =? - 2 ^ (2 * args / 2) - 1 - then + match x0 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + match + invert_low (2 * args0) args1 + with + | Some y => UnderLets.Base (#(ident.fancy_mulhl - (2 * args))%expr @ - (x' v, x'0 v0))%expr_pat - else - UnderLets.Base (x * x0)%expr - | None => - UnderLets.Base (x * x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x2) - | None => UnderLets.Base (x * x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) - | None => - match - match idc0 with - | ident.Z_shiftr offset => Some offset - | _ => None - end - with - | Some args0 => + (2 * args0))%expr @ + (x' v, ##(y)%expr))%expr_pat + | None => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + match + invert_high + (2 * args0) + args1 + with + | Some y => + UnderLets.Base + (#(ident.fancy_mulhh + (2 * + args0))%expr @ + (x'0 v0, + ##(y)%expr))%expr_pat + | None => + UnderLets.Base + (x * x0)%expr + end + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false + s1 -> + Compile.value' true + d1 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) + end + | None => UnderLets.Base (x * x0)%expr + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => UnderLets.Base (x * x0)%expr + end + | @expr.App _ _ _ s1 _ + (@expr.App _ _ _ s2 _ #(idc1)%expr_pat x4) x3 => match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) + match idc1 with + | ident.Z_land => Some tt + | _ => None + end with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) - t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s0 as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type - ident var - (expr (type.base base.type.Z))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 - base.type.Z - (UnderLets.UnderLets base.type - ident var - (expr (type.base base.type.Z))) - (fun - a0 : option - (expr (type.base t3) -> - expr + | Some _ => + match x4 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) + t3 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr (type.base base.type.Z)) => - match a0 with - | Some x'0 => - if args =? args0 - then - UnderLets.Base - (#(ident.fancy_mulhh - (2 * args))%expr @ - (x' v, x'0 v0))%expr_pat - else + match a with + | Some x' => + match + s1 as t4 + return + (Compile.value' false + t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) + => + base.try_make_transport_cps + (fun t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args2 =? + 2 + ^ (2 * args0 / + 2) - 1 + then + UnderLets.Base + (#(ident.fancy_mulhl + (2 * + args0))%expr @ + (x' v, + x'0 v0))%expr_pat + else + match x3 with + | #(idc3)%expr_pat => + match + match + idc3 + with + | @ident.Literal + t6 v1 => + match + t6 as t7 + return + (base.base_interp + t7 -> + option Z) + with + | base.type.unit => + fun + _ : unit + => None + | base.type.Z => + fun + v2 : Z => + Some v2 + | base.type.bool => + fun + _ : bool + => None + | base.type.nat => + fun + _ : nat + => None + end v1 + | _ => + None + end + with + | Some + args3 => + match + s0 as t6 + return + (Compile.value' + false t6 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t6 => + fun + v1 : + defaults.expr + (type.base + t6) => + base.try_make_transport_cps + (fun + t7 : base.type + => + defaults.expr + (type.base + t7)) t6 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a1 : + option + (defaults.expr + (type.base + t6) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a1 + with + | Some + x'1 => + match + s2 as t7 + return + (Compile.value' + false t7 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base + t7 => + fun + v2 : + defaults.expr + (type.base + t7) => + base.try_make_transport_cps + (fun + t8 : base.type + => + defaults.expr + (type.base + t8)) t7 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a2 : + option + (defaults.expr + (type.base + t7) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a2 + with + | Some + x'2 => + if + args3 =? + 2 + ^ + (2 * + args0 / 2) - + 1 + then + UnderLets.Base + (# + (ident.fancy_mulhl + (2 * + args0))%expr @ + ( + x'1 v1, + x'2 v2))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> + d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x2) + | None => + UnderLets.Base + (x * x0)%expr + end + | _ => + UnderLets.Base + (x * x0)%expr + end + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' + true d3 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x3) + | None => UnderLets.Base (x * x0)%expr - | None => - UnderLets.Base - (x * x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x2) - | None => UnderLets.Base (x * x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + match x3 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t4 v => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s2 as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t5 => + fun + v0 : + defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base + t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a0 + with + | Some + x'0 => + if + args2 =? + 2 + ^ + (2 * + args0 / 2) - + 1 + then + UnderLets.Base + (# + (ident.fancy_mulhl + (2 * + args0))%expr @ + ( + x' v, + x'0 v0))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect + x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' true + d3 => + UnderLets.Base + (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + end + | ($_)%expr => + match x3 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t4 v0 => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v0 + | _ => None + end + with + | Some args2 => + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s2 as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t5 => + fun + v1 : defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base t6)) + t5 base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args2 =? + 2 + ^ + (2 * args0 / + 2) - 1 + then + UnderLets.Base + (# + (ident.fancy_mulhl + (2 * + args0))%expr @ + ( + x' v0, + x'0 v1))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' + true d3 => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | @expr.LetIn _ _ _ _ _ _ _ => + match x3 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s2 as t4 + return + (Compile.value' + false t4 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base + t4) => + base.try_make_transport_cps + (fun + t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args2 =? + 2 + ^ + (2 * args0 / + 2) - 1 + then + UnderLets.Base + (# + (ident.fancy_mulhl + (2 * + args0))%expr @ + ( + x' v, + x'0 v0))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' + true d3 => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | _ => + match x3 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s2 as t4 + return + (Compile.value' + false t4 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base + t4) => + base.try_make_transport_cps + (fun + t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args2 =? + 2 + ^ + (2 * args0 / + 2) - 1 + then + UnderLets.Base + (# + (ident.fancy_mulhl + (2 * + args0))%expr @ + ( + x' v, + x'0 v0))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' + false s4 -> + Compile.value' + true d4 => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + end + | None => + match + match idc1 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x3 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + match + s2 as t4 + return + (Compile.value' + false t4 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + base.type.Z))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base + t4) => + base.try_make_transport_cps + (fun + t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : + option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args0 =? + args2 + then + UnderLets.Base + (# + (ident.fancy_mulhh + (2 * + args0))%expr @ + ( + x' v, + x'0 v0))%expr_pat + else + UnderLets.Base + (x * x0)%expr + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' + true d3 => + UnderLets.Base + (x * x0)%expr + end + (Compile.reflect x4) + | None => + UnderLets.Base + (x * x0)%expr + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base (x * x0)%expr + end (Compile.reflect x2) + | None => + UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | None => UnderLets.Base (x * x0)%expr + end + end + | @expr.App _ _ _ s1 _ + (@expr.App _ _ _ s2 _ ($_)%expr _) _ | @expr.App _ + _ _ s1 _ + (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _) + _ | @expr.App _ _ _ s1 _ + (@expr.App _ _ _ s2 _ (_ @ _)%expr_pat _) _ | + @expr.App _ _ _ s1 _ + (@expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) + _) _ => UnderLets.Base (x * x0)%expr + | @expr.App _ _ _ s1 _ #(_)%expr_pat _ | @expr.App _ + _ _ s1 _ ($_)%expr _ | @expr.App _ _ _ s1 _ + (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s1 _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.Base (x * x0)%expr + | _ => UnderLets.Base (x * x0)%expr end + | None => UnderLets.Base (x * x0)%expr end - | @expr.App _ _ _ s0 _ ($_)%expr _ | @expr.App _ _ _ s0 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 _ - (_ @ _)%expr_pat _ | @expr.App _ _ _ s0 _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base (x * x0)%expr | _ => UnderLets.Base (x * x0)%expr end | None => UnderLets.Base (x * x0)%expr end end - | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ (_ @ _)%expr_pat _ | - @expr.App _ _ _ s _ (@expr.LetIn _ _ _ _ _ _ _) _ => + | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ ($_)%expr _) _ | @expr.App _ + _ _ s _ (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _) _ | @expr.App + _ _ _ s _ (@expr.App _ _ _ s0 _ (_ @ _)%expr_pat _) _ | @expr.App _ _ _ + s _ (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _) _ => UnderLets.Base (x * x0)%expr + | @expr.App _ _ _ s _ #(_)%expr_pat _ | @expr.App _ _ _ s _ ($_)%expr _ | + @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ + (@expr.LetIn _ _ _ _ _ _ _) _ => UnderLets.Base (x * x0)%expr | _ => UnderLets.Base (x * x0)%expr end | ident.Z_pow => - fun x x0 : expr (type.base base.type.Z) => + fun x x0 : defaults.expr (type.base base.type.Z) => UnderLets.Base (#(ident.Z_pow)%expr @ x @ x0)%expr_pat | ident.Z_sub => - fun x x0 : expr (type.base base.type.Z) => UnderLets.Base (x - x0)%expr + fun x x0 : defaults.expr (type.base base.type.Z) => + UnderLets.Base (x - x0)%expr | ident.Z_opp => - fun x : expr (type.base base.type.Z) => UnderLets.Base (- x)%expr + fun x : defaults.expr (type.base base.type.Z) => + UnderLets.Base (- x)%expr | ident.Z_div => - fun x x0 : expr (type.base base.type.Z) => UnderLets.Base (x / x0)%expr + fun x x0 : defaults.expr (type.base base.type.Z) => + UnderLets.Base (x / x0)%expr | ident.Z_modulo => - fun x x0 : expr (type.base base.type.Z) => UnderLets.Base (x mod x0)%expr + fun x x0 : defaults.expr (type.base base.type.Z) => + UnderLets.Base (x mod x0)%expr +| ident.Z_log2 => + fun x : defaults.expr (type.base base.type.Z) => + UnderLets.Base (#(ident.Z_log2)%expr @ x)%expr_pat +| ident.Z_log2_up => + fun x : defaults.expr (type.base base.type.Z) => + UnderLets.Base (#(ident.Z_log2_up)%expr @ x)%expr_pat | ident.Z_eqb => - fun x x0 : expr (type.base base.type.Z) => + fun x x0 : defaults.expr (type.base base.type.Z) => UnderLets.Base (#(ident.Z_eqb)%expr @ x @ x0)%expr_pat | ident.Z_leb => - fun x x0 : expr (type.base base.type.Z) => + fun x x0 : defaults.expr (type.base base.type.Z) => UnderLets.Base (#(ident.Z_leb)%expr @ x @ x0)%expr_pat +| ident.Z_geb => + fun x x0 : defaults.expr (type.base base.type.Z) => + UnderLets.Base (#(ident.Z_geb)%expr @ x @ x0)%expr_pat | ident.Z_of_nat => - fun x : expr (type.base base.type.nat) => + fun x : defaults.expr (type.base base.type.nat) => UnderLets.Base (#(ident.Z_of_nat)%expr @ x)%expr_pat -| ident.Z_shiftr offset => - fun x : expr (type.base base.type.Z) => UnderLets.Base (x >> offset)%expr -| ident.Z_shiftl offset => - fun x : expr (type.base base.type.Z) => UnderLets.Base (x << offset)%expr -| ident.Z_land mask => - fun x : expr (type.base base.type.Z) => - UnderLets.Base (#(ident.Z_land mask)%expr @ x)%expr_pat +| ident.Z_to_nat => + fun x : defaults.expr (type.base base.type.Z) => + UnderLets.Base (#(ident.Z_to_nat)%expr @ x)%expr_pat +| ident.Z_shiftr => + fun x x0 : defaults.expr (type.base base.type.Z) => + UnderLets.Base (x >> x0)%expr +| ident.Z_shiftl => + fun x x0 : defaults.expr (type.base base.type.Z) => + UnderLets.Base (x << x0)%expr +| ident.Z_land => + fun x x0 : defaults.expr (type.base base.type.Z) => + UnderLets.Base (x &' x0)%expr +| ident.Z_lor => + fun x x0 : defaults.expr (type.base base.type.Z) => + UnderLets.Base (x || x0)%expr +| ident.Z_bneg => + fun x : defaults.expr (type.base base.type.Z) => + UnderLets.Base (#(ident.Z_bneg)%expr @ x)%expr_pat +| ident.Z_lnot_modulo => + fun x x0 : defaults.expr (type.base base.type.Z) => + UnderLets.Base (#(ident.Z_lnot_modulo)%expr @ x @ x0)%expr_pat | ident.Z_mul_split => - fun x x0 x1 : expr (type.base base.type.Z) => + fun x x0 x1 : defaults.expr (type.base base.type.Z) => UnderLets.Base (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat -| ident.Z_mul_split_concrete s => - fun x x0 : expr (type.base base.type.Z) => - UnderLets.Base (#(ident.Z_mul_split_concrete s)%expr @ x @ x0)%expr_pat | ident.Z_add_get_carry => - fun x x0 x1 : expr (type.base base.type.Z) => - UnderLets.Base (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat -| ident.Z_add_get_carry_concrete s => - fun x x0 : expr (type.base base.type.Z) => - match x0 with - | #(_)%expr_pat => - match x with - | @expr.App _ _ _ s0 _ #(idc0)%expr_pat x1 => - match - match idc0 with - | ident.Z_shiftl offset => Some offset - | _ => None - end - with - | Some args => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) args)%expr @ - (x0, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + fun x x0 x1 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x1 with + | #(_)%expr_pat => + match x0 with + | (@expr.App _ _ _ s0 _ #(idc1) x3 @ x2)%expr_pat => + match + match idc1 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x2 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return (base.base_interp t4 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v : defaults.expr (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t3) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) args1)%expr @ + (x1, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - end) - | (s1 -> d0)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d0 - => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x1) - | None => - match - match idc0 with - | ident.Z_shiftr offset => Some offset - | _ => None - end - with - | Some args => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) (- args))%expr @ - (x0, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | None => + match + match idc1 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x2 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args1))%expr @ + (x1, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end) - | (s1 -> d0)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x1) - | None => - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + end + | (@expr.App _ _ _ s0 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s0 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat end - end - | @expr.App _ _ _ s0 _ ($_)%expr _ | @expr.App _ _ _ s0 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | ($_)%expr => - match x with - | @expr.App _ _ _ s0 _ #(idc)%expr_pat x1 => - match - match idc with - | ident.Z_shiftl offset => Some offset - | _ => None - end - with - | Some args => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) args)%expr @ - (x0, x' v0))%expr_pat - else - if s =? 2 ^ Z.log2 s + | ($_)%expr => + match x0 with + | (@expr.App _ _ _ s0 _ #(idc0) x3 @ x2)%expr_pat => + match + match idc0 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t3 v0 => + match + t3 as t4 + return (base.base_interp t4 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args1 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t3) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) args1)%expr @ + (x1, x' v0))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - end) - | (s1 -> d0)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d0 - => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x1) - | None => - match - match idc with - | ident.Z_shiftr offset => Some offset - | _ => None - end - with - | Some args => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) (- args))%expr @ - (x0, x' v0))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | None => + match + match idc0 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t3 v0 => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args1 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args1))%expr @ + (x1, x' v0))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end) - | (s1 -> d0)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x1) - | None => - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + end + | (@expr.App _ _ _ s0 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s0 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat end - end - | @expr.App _ _ _ s0 _ ($_)%expr _ | @expr.App _ _ _ s0 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.Abs _ _ _ _ _ _ => - match x with - | @expr.App _ _ _ s1 _ #(idc)%expr_pat x1 => - match - match idc with - | ident.Z_shiftl offset => Some offset - | _ => None - end - with - | Some args => - match - s1 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) args)%expr @ - (x0, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + | @expr.Abs _ _ _ _ _ _ => + match x0 with + | (@expr.App _ _ _ s1 _ #(idc0) x3 @ x2)%expr_pat => + match + match idc0 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s1 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) args1)%expr @ + (x1, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - end) - | (s2 -> d1)%ptype => - fun _ : Compile.value' false s2 -> Compile.value' true d1 - => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x1) - | None => - match - match idc with - | ident.Z_shiftr offset => Some offset - | _ => None - end - with - | Some args => - match - s1 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) (- args))%expr @ - (x0, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | None => + match + match idc0 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return + (base.base_interp t3 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s1 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) + => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t2) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args1))%expr @ + (x1, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x1) - | None => - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + end + | (@expr.App _ _ _ s1 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s1 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat end - end - | @expr.App _ _ _ s1 _ ($_)%expr _ | @expr.App _ _ _ s1 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s1 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s0 _ #(idc)%expr_pat x1 => - match - match idc with - | ident.Z_shiftl offset => Some offset - | _ => None - end - with - | Some args => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) args)%expr @ - (x, x' v))%expr_pat - else - match x with - | @expr.App _ _ _ s1 _ #(idc0)%expr_pat x2 => + | (#(_) @ _)%expr_pat => + match x0 with + | (@expr.App _ _ _ s1 _ #(idc1) x4 @ x3)%expr_pat => + match + match idc1 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x3 with + | #(idc2)%expr_pat => match - match idc0 with - | ident.Z_shiftl offset => Some offset + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return (base.base_interp t4 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v | _ => None end with - | Some args0 => + | Some args1 => match s1 as t3 return (Compile.value' false t3 -> UnderLets.UnderLets base.type ident var - (expr + (defaults.expr (type.base (base.type.Z * base.type.Z)%etype))) with | type.base t3 => - fun v0 : expr (type.base t3) => + fun v : defaults.expr (type.base t3) => base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 base.type.Z + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z (UnderLets.UnderLets base.type ident var - (expr + (defaults.expr (type.base (base.type.Z * base.type.Z)%etype))) (fun - a0 : option - (expr (type.base t3) -> - expr (type.base base.type.Z)) - => - match a0 with - | Some x'0 => - if s =? 2 ^ Z.log2 s + a : option + (defaults.expr (type.base t3) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) - args0)%expr @ (x0, x'0 v0))%expr_pat + (#(ident.fancy_add + (Z.log2 args) args1)%expr @ + (x1, x' v))%expr_pat else - if s =? 2 ^ Z.log2 s + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) - 0)%expr @ (x, x0))%expr_pat + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete - s)%expr @ x @ x0)%expr_pat + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat | None => UnderLets.Base - (#(ident.Z_add_get_carry_concrete - s)%expr @ x @ x0)%expr_pat + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat end) - | (s2 -> d1)%ptype => + | (s2 -> d2)%ptype => fun _ : Compile.value' false s2 -> - Compile.value' true d1 => + Compile.value' true d2 => UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end (Compile.reflect x2) + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end (Compile.reflect x4) | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | None => + match + match idc1 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x3 with + | #(idc2)%expr_pat => match - match idc0 with - | ident.Z_shiftr offset => Some offset + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v | _ => None end with - | Some args0 => + | Some args1 => match s1 as t3 return (Compile.value' false t3 -> UnderLets.UnderLets base.type ident var - (expr + (defaults.expr (type.base (base.type.Z * base.type.Z)%etype))) with | type.base t3 => - fun v0 : expr (type.base t3) => + fun v : defaults.expr (type.base t3) + => base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 base.type.Z (UnderLets.UnderLets base.type ident var - (expr + (defaults.expr (type.base (base.type.Z * base.type.Z)%etype))) (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) => - match a0 with - | Some x'0 => - if s =? 2 ^ Z.log2 s + match a with + | Some x' => + if args =? 2 ^ Z.log2 args then UnderLets.Base (#(ident.fancy_add - (Z.log2 s) (- args0))%expr @ - (x0, x'0 v0))%expr_pat + (Z.log2 args) + (- args1))%expr @ + (x1, x' v))%expr_pat else - if s =? 2 ^ Z.log2 s + if args =? 2 ^ Z.log2 args then UnderLets.Base (#(ident.fancy_add - (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete - s)%expr @ x @ x0)%expr_pat + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat | None => UnderLets.Base - (#(ident.Z_add_get_carry_concrete - s)%expr @ x @ x0)%expr_pat + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat end) - | (s2 -> d1)%ptype => + | (s2 -> d2)%ptype => fun _ : Compile.value' false s2 -> - Compile.value' true d1 => + Compile.value' true d2 => UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end (Compile.reflect x2) + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end (Compile.reflect x4) | None => - if s =? 2 ^ Z.log2 s + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat end - | @expr.App _ _ _ s1 _ ($_)%expr _ | @expr.App _ _ _ - s1 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s1 - _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s1 _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - | _ => - if s =? 2 ^ Z.log2 s + | None => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat end - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end) - | (s1 -> d0)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x1) - | None => - match - match idc with - | ident.Z_shiftr offset => Some offset - | _ => None - end - with - | Some args => - match x with - | #(_)%expr_pat => + end + | (@expr.App _ _ _ s1 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s1 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | (($_)%expr @ _)%expr_pat => + match x0 with + | (@expr.App _ _ _ s1 _ #(idc0) x4 @ x3)%expr_pat => match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) + match idc0 with + | ident.Z_shiftl => Some tt + | _ => None + end with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) (- args))%expr @ - (x, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + | Some _ => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t3 v0 => + match + t3 as t4 + return (base.base_interp t4 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args1 => + match + s1 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t3) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) args1)%expr @ + (x1, x' v0))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end) - | (s1 -> d0)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x1) - | ($_)%expr => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) (- args))%expr @ - (x, x' v0))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | None => + match + match idc0 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t3 v0 => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args1 => + match + s1 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args1))%expr @ + (x1, x' v0))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end) - | (s1 -> d0)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x1) - | @expr.Abs _ _ _ _ _ _ => + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + end + | (@expr.App _ _ _ s1 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s1 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | (@expr.Abs _ _ _ _ _ _ @ _)%expr_pat => + match x0 with + | (@expr.App _ _ _ s2 _ #(idc0) x4 @ x3)%expr_pat => match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) + match idc0 with + | ident.Z_shiftl => Some tt + | _ => None + end with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) (- args))%expr @ - (x, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + | Some _ => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s2 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) args1)%expr @ + (x1, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x1) - | @expr.App _ _ _ s1 _ #(idc0)%expr_pat x2 => - match - match idc0 with - | ident.Z_shiftl offset => Some offset - | _ => None - end - with - | Some args0 => + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | None => match - s1 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) + match idc0 with + | ident.Z_shiftr => Some tt + | _ => None + end with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) args0)%expr @ - (x0, x' v))%expr_pat - else + | Some _ => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return + (base.base_interp t3 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => match - s0 as t3 + s2 as t2 return - (Compile.value' false t3 -> + (Compile.value' false t2 -> UnderLets.UnderLets base.type ident var - (expr + (defaults.expr (type.base (base.type.Z * base.type.Z)%etype))) with - | type.base t3 => - fun v0 : expr (type.base t3) => + | type.base t2 => + fun v : defaults.expr (type.base t2) + => base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 base.type.Z (UnderLets.UnderLets base.type ident var - (expr + (defaults.expr (type.base (base.type.Z * base.type.Z)%etype))) (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) + a : option + (defaults.expr + (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => - match a0 with - | Some x'0 => - if s =? 2 ^ Z.log2 s + match a with + | Some x' => + if args =? 2 ^ Z.log2 args then UnderLets.Base (#(ident.fancy_add - (Z.log2 s) (- args))%expr @ - (x, x'0 v0))%expr_pat + (Z.log2 args) + (- args1))%expr @ + (x1, x' v))%expr_pat else - if s =? 2 ^ Z.log2 s + if args =? 2 ^ Z.log2 args then UnderLets.Base (#(ident.fancy_add - (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete - s)%expr @ x @ x0)%expr_pat + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat | None => UnderLets.Base - (#(ident.Z_add_get_carry_concrete - s)%expr @ x @ x0)%expr_pat + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat end) - | (s2 -> d1)%ptype => + | (s3 -> d3)%ptype => fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => + _ : Compile.value' false s3 -> + Compile.value' true d3 => UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end (Compile.reflect x1) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - end (Compile.reflect x2) - | None => + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + end + | (@expr.App _ _ _ s2 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | (@expr.App _ _ _ s0 _ #(idc0) x3 @ x2)%expr_pat => + match + match idc0 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x2 with + | #(idc1)%expr_pat => match - match idc0 with - | ident.Z_shiftr offset => Some offset + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v | _ => None end with - | Some args0 => + | Some args1 => match s0 as t2 return (Compile.value' false t2 -> UnderLets.UnderLets base.type ident var - (expr + (defaults.expr (type.base (base.type.Z * base.type.Z)%etype))) with | type.base t2 => - fun v : expr (type.base t2) => + fun v : defaults.expr (type.base t2) => base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) - t2 base.type.Z + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z (UnderLets.UnderLets base.type ident var - (expr + (defaults.expr (type.base (base.type.Z * base.type.Z)%etype))) (fun a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => match a with | Some x' => - if s =? 2 ^ Z.log2 s + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) - (- args))%expr @ (x, x' v))%expr_pat + (#(ident.fancy_add (Z.log2 args) + args1)%expr @ (x0, x' v))%expr_pat else + match x0 with + | (@expr.App _ _ _ s2 _ #(idc2) x5 @ + x4)%expr_pat => + match + match idc2 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t5 + v0 => + match + t5 as t6 + return + (base.base_interp + t6 -> + option Z) + with + | base.type.unit => + fun _ : unit => + None + | base.type.Z => + fun v1 : Z => + Some v1 + | base.type.bool => + fun _ : bool => + None + | base.type.nat => + fun _ : nat => + None + end v0 + | _ => None + end + with + | Some args3 => + match + s2 as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t5 => + fun + v0 : defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base + t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a0 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args =? + 2 + ^ + Z.log2 + args + then + UnderLets.Base + (# + (ident.fancy_add + (Z.log2 + args) + args3)%expr @ + (x1, + x'0 v0))%expr_pat + else + if + args =? + 2 + ^ + Z.log2 + args + then + UnderLets.Base + (# + (ident.fancy_add + (Z.log2 + args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (# + (ident.Z_add_get_carry)%expr @ + x @ x0 @ + x1)%expr_pat + | None => + UnderLets.Base + (# + (ident.Z_add_get_carry)%expr @ + x @ x0 @ + x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + (Compile.reflect x5) + | None => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | _ => + if + args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | None => + match + match idc2 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t5 + v0 => + match + t5 as t6 + return + (base.base_interp + t6 -> + option Z) + with + | base.type.unit => + fun + _ : unit + => None + | base.type.Z => + fun v1 : Z + => + Some v1 + | base.type.bool => + fun + _ : bool + => None + | base.type.nat => + fun _ : nat + => None + end v0 + | _ => None + end + with + | Some args3 => + match + s2 as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t5 => + fun + v0 : + defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base + t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a0 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a0 + with + | Some + x'0 => + if + args =? + 2 + ^ + Z.log2 + args + then + UnderLets.Base + (# + (ident.fancy_add + (Z.log2 + args) + (- args3))%expr @ + (x1, + x'0 v0))%expr_pat + else + if + args =? + 2 + ^ + Z.log2 + args + then + UnderLets.Base + (# + (ident.fancy_add + (Z.log2 + args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (# + (ident.Z_add_get_carry)%expr @ + x @ x0 @ + x1)%expr_pat + | None => + UnderLets.Base + (# + (ident.Z_add_get_carry)%expr @ + x @ x0 @ + x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ + x1)%expr_pat + end + (Compile.reflect + x5) + | None => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 + args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | _ => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | None => + if + args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + end + | (@expr.App _ _ _ s2 _ ($_)%expr _ @ + _)%expr_pat | + (@expr.App _ _ _ s2 _ + (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ + (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end (Compile.reflect x3) + | None => + match x0 with + | (@expr.App _ _ _ s2 _ #(idc2) x5 @ x4)%expr_pat => + match + match idc2 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc3)%expr_pat => match - s1 as t3 + match idc3 with + | @ident.Literal t4 v => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s2 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t4 => + fun + v : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + args2)%expr @ + (x1, x' v))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end (Compile.reflect x5) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | None => + match + match idc2 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t4 v => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s2 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t4 => + fun + v : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 + args) + (- args2))%expr @ + (x1, x' v))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 + args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' true + d3 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end (Compile.reflect x5) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + end + | (@expr.App _ _ _ s2 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) + _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ + (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + end + | ($_)%expr => + match x0 with + | (@expr.App _ _ _ s2 _ #(idc1) x5 @ x4)%expr_pat => + match + match idc1 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t4 v0 => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v0 + | _ => None + end + with + | Some args2 => + match + s2 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t4) -> + defaults.expr + (type.base + base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + args2)%expr @ + (x1, x' v0))%expr_pat + else + if + args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end (Compile.reflect x5) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | None => + match + match idc1 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t4 v0 => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v0 + | _ => None + end + with + | Some args2 => + match + s2 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args2))%expr @ + (x1, x' v0))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end (Compile.reflect x5) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + end + | (@expr.App _ _ _ s2 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) + _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | @expr.Abs _ _ _ _ _ _ => + match x0 with + | (@expr.App _ _ _ s3 _ #(idc1) x5 @ x4)%expr_pat => + match + match idc1 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s3 as t3 return (Compile.value' false t3 -> UnderLets.UnderLets base.type ident var - (expr + (defaults.expr (type.base (base.type.Z * base.type.Z)%etype))) with | type.base t3 => - fun v0 : expr (type.base t3) => + fun + v : defaults.expr + (type.base t3) => base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 - base.type.Z + (fun t4 : base.type => + defaults.expr (type.base t4)) + t3 base.type.Z (UnderLets.UnderLets base.type ident var - (expr + (defaults.expr (type.base (base.type.Z * base.type.Z)%etype))) (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base - base.type.Z)) - => - match a0 with - | Some x'0 => - if s =? 2 ^ Z.log2 s + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args then UnderLets.Base (#(ident.fancy_add - (Z.log2 s) - (- args0))%expr @ - (x0, x'0 v0))%expr_pat + (Z.log2 args) + args2)%expr @ + (x1, x' v))%expr_pat else - if s =? 2 ^ Z.log2 s + if + args =? 2 ^ Z.log2 args then UnderLets.Base (#(ident.fancy_add - (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete - s)%expr @ x @ x0)%expr_pat + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat | None => UnderLets.Base - (#(ident.Z_add_get_carry_concrete - s)%expr @ x @ x0)%expr_pat + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat end) - | (s2 -> d1)%ptype => + | (s4 -> d4)%ptype => fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => + _ : Compile.value' false s4 -> + Compile.value' true d4 => UnderLets.Base - (#(ident.Z_add_get_carry_concrete - s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end (Compile.reflect x1) - | None => + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end (Compile.reflect x5) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | None => + match + match idc1 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s3 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args2))%expr @ + (x1, x' v))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 + => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end (Compile.reflect x5) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + end + | (@expr.App _ _ _ s3 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s3 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s3 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s3 _ (@expr.LetIn _ _ _ _ _ _ _) + _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | (_ @ _)%expr_pat => + match x0 with + | (@expr.App _ _ _ s3 _ #(idc1) x6 @ x5)%expr_pat => match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) + match idc1 with + | ident.Z_shiftl => Some tt + | _ => None + end with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) - t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) - (- args))%expr @ (x, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + | Some _ => + match x5 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s3 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) + t3 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + args2)%expr @ + (x1, x' v))%expr_pat + else + if + args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end (Compile.reflect x6) + | None => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete - s)%expr @ x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end (Compile.reflect x1) + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | None => + match + match idc1 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x5 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s3 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args2))%expr @ + (x1, x' v))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 + => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end (Compile.reflect x6) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + end + | (@expr.App _ _ _ s3 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s3 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s3 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s3 _ (@expr.LetIn _ _ _ _ _ _ _) + _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | @expr.LetIn _ _ _ _ _ _ _ => + match x0 with + | (@expr.App _ _ _ s2 _ #(idc1) x6 @ x5)%expr_pat => + match + match idc1 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x5 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s2 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) + t3 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + args2)%expr @ + (x1, x' v))%expr_pat + else + if + args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end (Compile.reflect x6) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | None => + match + match idc1 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x5 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s2 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args2))%expr @ + (x1, x' v))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end (Compile.reflect x6) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + end + | (@expr.App _ _ _ s2 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) + _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat end end - | @expr.App _ _ _ s1 _ ($_)%expr _ => + | None => match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) + match idc0 with + | ident.Z_shiftr => Some tt + | _ => None + end with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) (- args))%expr @ - (x, x' v0))%expr_pat - else - if s =? 2 ^ Z.log2 s + | Some _ => + match x0 with + | #(_)%expr_pat => + match x2 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args1))%expr @ + (x0, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x1) - | @expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App - _ _ _ s1 _ (_ @ _)%expr_pat _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) (- args))%expr @ - (x, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | ($_)%expr => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t3 v0 => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args1 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args1))%expr @ + (x0, x' v0))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end) - | (s3 -> d2)%ptype => - fun - _ : Compile.value' false s3 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x1) - | @expr.App _ _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) (- args))%expr @ - (x, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | (#(_) @ _)%expr_pat => + match x2 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args1))%expr @ + (x0, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x1) - | @expr.LetIn _ _ _ _ _ _ _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) (- args))%expr @ - (x, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | (($_)%expr @ _)%expr_pat => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t3 v0 => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args1 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args1))%expr @ + (x0, x' v0))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end) - | (s1 -> d0)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x1) + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | (@expr.Abs _ _ _ _ _ _ @ _)%expr_pat => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return + (base.base_interp t3 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) + => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t2) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args1))%expr @ + (x0, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | (@expr.App _ _ _ s2 _ #(idc1) x5 @ x4)%expr_pat => + match + match idc1 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s2 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) + t3 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + args2)%expr @ + (x1, x' v))%expr_pat + else + match x2 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t5 + v0 => + match + t5 as t6 + return + (base.base_interp + t6 -> + option Z) + with + | base.type.unit => + fun + _ : unit + => None + | base.type.Z => + fun v1 : Z + => + Some v1 + | base.type.bool => + fun + _ : bool + => None + | base.type.nat => + fun _ : nat + => None + end v0 + | _ => None + end + with + | Some args3 => + match + s0 as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t5 => + fun + v0 : + defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base + t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a0 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a0 + with + | Some + x'0 => + if + args =? + 2 + ^ + Z.log2 + args + then + UnderLets.Base + (# + (ident.fancy_add + (Z.log2 + args) + (- args3))%expr @ + (x0, + x'0 v0))%expr_pat + else + if + args =? + 2 + ^ + Z.log2 + args + then + UnderLets.Base + (# + (ident.fancy_add + (Z.log2 + args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (# + (ident.Z_add_get_carry)%expr @ + x @ x0 @ + x1)%expr_pat + | None => + UnderLets.Base + (# + (ident.Z_add_get_carry)%expr @ + x @ x0 @ + x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ + x1)%expr_pat + end + (Compile.reflect + x3) + | None => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 + args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | _ => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end (Compile.reflect x5) + | None => + match x2 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t4 v => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t4 => + fun + v : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 + args) + (- args2))%expr @ + (x0, x' v))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 + args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' true + d3 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + end + | ($_)%expr => + match x2 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t4 v0 => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v0 + | _ => None + end + with + | Some args2 => + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args2))%expr @ + (x0, x' v0))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | @expr.LetIn _ _ _ _ _ _ _ => + match x2 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args2))%expr @ + (x0, x' v))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + match x2 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args2))%expr @ + (x0, x' v))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 + => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + end + | None => + match + match idc1 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x2 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args2))%expr @ + (x0, x' v))%expr_pat + else + match x4 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal + t5 v0 => + match + t5 as t6 + return + (base.base_interp + t6 -> + option Z) + with + | base.type.unit => + fun + _ : unit + => None + | base.type.Z => + fun + v1 : Z => + Some v1 + | base.type.bool => + fun + _ : bool + => None + | base.type.nat => + fun + _ : nat + => None + end v0 + | _ => None + end + with + | Some args3 => + match + s2 as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base + t5 => + fun + v0 : + defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base + t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a0 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a0 + with + | Some + x'0 => + if + args =? + 2 + ^ + Z.log2 + args + then + UnderLets.Base + (# + (ident.fancy_add + (Z.log2 + args) + (- args3))%expr @ + (x1, + x'0 v0))%expr_pat + else + if + args =? + 2 + ^ + Z.log2 + args + then + UnderLets.Base + (# + (ident.fancy_add + (Z.log2 + args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (# + (ident.Z_add_get_carry)%expr @ + x @ x0 @ + x1)%expr_pat + | None => + UnderLets.Base + (# + (ident.Z_add_get_carry)%expr @ + x @ x0 @ + x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (# + (ident.Z_add_get_carry)%expr @ + x @ x0 @ + x1)%expr_pat + end + (Compile.reflect + x5) + | None => + if + args =? + 2 + ^ Z.log2 + args + then + UnderLets.Base + (# + (ident.fancy_add + (Z.log2 + args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (# + (ident.Z_add_get_carry)%expr @ + x @ x0 @ + x1)%expr_pat + end + | _ => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 + args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + match x4 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t4 v => + match + t4 as t5 + return + (base.base_interp + t5 -> option Z) + with + | base.type.unit => + fun _ : unit => + None + | base.type.Z => + fun v0 : Z => + Some v0 + | base.type.bool => + fun _ : bool => + None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s2 as t4 + return + (Compile.value' false + t4 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t4 => + fun + v : defaults.expr + (type.base t4) + => + base.try_make_transport_cps + (fun t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 + ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 + args) + (- args2))%expr @ + (x1, x' v))%expr_pat + else + if + args =? + 2 + ^ Z.log2 + args + then + UnderLets.Base + (# + (ident.fancy_add + (Z.log2 + args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (# + (ident.Z_add_get_carry)%expr @ + x @ x0 @ + x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' + true d3 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end (Compile.reflect x5) + | None => + if + args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + end + | ($_)%expr => + match x4 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t4 v0 => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v0 + | _ => None + end + with + | Some args2 => + match + s2 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) + => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 + args) + (- args2))%expr @ + (x1, x' v0))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 + args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' true + d3 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end (Compile.reflect x5) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | @expr.LetIn _ _ _ _ _ _ _ => + match x4 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s2 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base + t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 + args) + (- args2))%expr @ + (x1, x' v))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 + args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' true + d3 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end (Compile.reflect x5) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | _ => + match x4 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s2 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base + t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 + args) + (- args2))%expr @ + (x1, x' v))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 + args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' + false s4 -> + Compile.value' true + d4 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end (Compile.reflect x5) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + end + | None => + match x2 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args1))%expr @ + (x0, x' v))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + end + end + | (@expr.App _ _ _ s2 _ ($_)%expr _ @ _)%expr_pat => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t3 v0 => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args1 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args1))%expr @ + (x0, x' v0))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (_ @ _) _ @ _)%expr_pat => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return + (base.base_interp t3 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) + => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t2) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args1))%expr @ + (x0, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | (@expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) + _ @ _)%expr_pat => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return + (base.base_interp t3 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) + => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t2) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args1))%expr @ + (x0, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | @expr.LetIn _ _ _ _ _ _ _ => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return + (base.base_interp t3 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) + => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t2) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args1))%expr @ + (x0, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | _ => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return + (base.base_interp t3 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) + => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t2) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args1))%expr @ + (x0, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + end + | None => + match x0 with + | (@expr.App _ _ _ s2 _ #(idc1) x5 @ x4)%expr_pat => + match + match idc1 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s2 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) + t3 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + args1)%expr @ + (x1, x' v))%expr_pat + else + if + args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end (Compile.reflect x5) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | None => + match + match idc1 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s2 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args1))%expr @ + (x1, x' v))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end (Compile.reflect x5) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + end + | (@expr.App _ _ _ s2 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) + _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + end end - | None => - match x with - | @expr.App _ _ _ s1 _ #(idc0)%expr_pat x2 => + | (@expr.App _ _ _ s0 _ ($_)%expr _ @ _)%expr_pat => + match x0 with + | (@expr.App _ _ _ s2 _ #(idc0) x5 @ x4)%expr_pat => match match idc0 with - | ident.Z_shiftl offset => Some offset + | ident.Z_shiftl => Some tt | _ => None end with - | Some args => - match - s1 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then + | Some _ => + match x4 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t3 v0 => + match + t3 as t4 + return (base.base_interp t4 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args1 => + match + s2 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t3) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) args1)%expr @ + (x1, x' v0))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => UnderLets.Base - (#(ident.fancy_add (Z.log2 s) args)%expr @ - (x0, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - end (Compile.reflect x2) + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end (Compile.reflect x5) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end | None => match match idc0 with - | ident.Z_shiftr offset => Some offset + | ident.Z_shiftr => Some tt | _ => None end with - | Some args => - match - s1 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) - t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then + | Some _ => + match x4 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t3 v0 => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args1 => + match + s2 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args1))%expr @ + (x1, x' v0))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => UnderLets.Base - (#(ident.fancy_add (Z.log2 s) - (- args))%expr @ (x0, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete - s)%expr @ x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end (Compile.reflect x2) + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end (Compile.reflect x5) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end | None => - if s =? 2 ^ Z.log2 s + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat end end - | @expr.App _ _ _ s1 _ ($_)%expr _ | @expr.App _ _ _ s1 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s1 _ - (_ @ _)%expr_pat _ | @expr.App _ _ _ s1 _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - if s =? 2 ^ Z.log2 s + | (@expr.App _ _ _ s2 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat | _ => - if s =? 2 ^ Z.log2 s + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat end - end - end - | @expr.App _ _ _ s0 _ ($_)%expr _ => - match x with - | @expr.App _ _ _ s1 _ #(idc)%expr_pat x2 => - match - match idc with - | ident.Z_shiftl offset => Some offset - | _ => None - end - with - | Some args => - match - s1 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) args)%expr @ - (x0, x' v0))%expr_pat - else - if s =? 2 ^ Z.log2 s + | (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat => + match x0 with + | (@expr.App _ _ _ s3 _ #(idc0) x5 @ x4)%expr_pat => + match + match idc0 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s3 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) args1)%expr @ + (x1, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end (Compile.reflect x5) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - end) - | (s2 -> d1)%ptype => - fun _ : Compile.value' false s2 -> Compile.value' true d1 - => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x2) - | None => - match - match idc with - | ident.Z_shiftr offset => Some offset - | _ => None - end - with - | Some args => - match - s1 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) (- args))%expr @ - (x0, x' v0))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | None => + match + match idc0 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return + (base.base_interp t3 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s3 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) + => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t2) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args1))%expr @ + (x1, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end (Compile.reflect x5) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x2) - | None => - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + end + | (@expr.App _ _ _ s3 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s3 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s3 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s3 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat end - end - | @expr.App _ _ _ s1 _ ($_)%expr _ | @expr.App _ _ _ s1 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s1 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ => - match x with - | @expr.App _ _ _ s2 _ #(idc)%expr_pat x2 => - match - match idc with - | ident.Z_shiftl offset => Some offset - | _ => None - end - with - | Some args => - match - s2 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) args)%expr @ - (x0, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + | (@expr.App _ _ _ s0 _ (_ @ _) _ @ _)%expr_pat => + match x0 with + | (@expr.App _ _ _ s3 _ #(idc0) x6 @ x5)%expr_pat => + match + match idc0 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x5 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s3 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) args1)%expr @ + (x1, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end (Compile.reflect x6) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - end) - | (s3 -> d2)%ptype => - fun _ : Compile.value' false s3 -> Compile.value' true d2 - => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x2) - | None => - match - match idc with - | ident.Z_shiftr offset => Some offset - | _ => None - end - with - | Some args => - match - s2 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) (- args))%expr @ - (x0, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | None => + match + match idc0 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x5 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return + (base.base_interp t3 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s3 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) + => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t2) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args1))%expr @ + (x1, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end (Compile.reflect x6) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end) - | (s3 -> d2)%ptype => - fun - _ : Compile.value' false s3 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x2) - | None => - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + end + | (@expr.App _ _ _ s3 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s3 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s3 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s3 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat end - end - | @expr.App _ _ _ s2 _ ($_)%expr _ | @expr.App _ _ _ s2 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s2 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s0 _ (_ @ _)%expr_pat _ => - match x with - | @expr.App _ _ _ s2 _ #(idc)%expr_pat x3 => - match - match idc with - | ident.Z_shiftl offset => Some offset - | _ => None - end - with - | Some args => - match - s2 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) args)%expr @ - (x0, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + | (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + match x0 with + | (@expr.App _ _ _ s2 _ #(idc0) x6 @ x5)%expr_pat => + match + match idc0 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x5 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s2 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) args1)%expr @ + (x1, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end (Compile.reflect x6) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - end) - | (s3 -> d2)%ptype => - fun _ : Compile.value' false s3 -> Compile.value' true d2 - => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x3) - | None => - match - match idc with - | ident.Z_shiftr offset => Some offset - | _ => None - end - with - | Some args => - match - s2 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) (- args))%expr @ - (x0, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | None => + match + match idc0 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x5 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return + (base.base_interp t3 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s2 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) + => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t2) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args1))%expr @ + (x1, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end (Compile.reflect x6) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end) - | (s3 -> d2)%ptype => - fun - _ : Compile.value' false s3 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x3) - | None => - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + end + | (@expr.App _ _ _ s2 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat end - end - | @expr.App _ _ _ s2 _ ($_)%expr _ | @expr.App _ _ _ s2 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s2 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - match x with - | @expr.App _ _ _ s1 _ #(idc)%expr_pat x3 => - match - match idc with - | ident.Z_shiftl offset => Some offset - | _ => None - end - with - | Some args => - match - s1 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) args)%expr @ - (x0, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + | (@expr.LetIn _ _ _ _ _ _ _ @ _)%expr_pat => + match x0 with + | (@expr.App _ _ _ s1 _ #(idc0) x5 @ x4)%expr_pat => + match + match idc0 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s1 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) args1)%expr @ + (x1, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end (Compile.reflect x5) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - end) - | (s2 -> d1)%ptype => - fun _ : Compile.value' false s2 -> Compile.value' true d1 - => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x3) - | None => - match - match idc with - | ident.Z_shiftr offset => Some offset - | _ => None - end - with - | Some args => - match - s1 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) (- args))%expr @ - (x0, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | None => + match + match idc0 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return + (base.base_interp t3 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s1 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) + => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t2) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args1))%expr @ + (x1, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end (Compile.reflect x5) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x3) - | None => - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + end + | (@expr.App _ _ _ s1 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s1 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat end - end - | @expr.App _ _ _ s1 _ ($_)%expr _ | @expr.App _ _ _ s1 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s1 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.LetIn _ _ _ _ _ _ _ => - match x with - | @expr.App _ _ _ s0 _ #(idc)%expr_pat x2 => - match - match idc with - | ident.Z_shiftl offset => Some offset - | _ => None - end - with - | Some args => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) args)%expr @ - (x0, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + | @expr.LetIn _ _ _ _ _ _ _ => + match x0 with + | (@expr.App _ _ _ s0 _ #(idc0) x4 @ x3)%expr_pat => + match + match idc0 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) args1)%expr @ + (x1, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - end) - | (s1 -> d0)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d0 - => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x2) - | None => - match - match idc with - | ident.Z_shiftr offset => Some offset - | _ => None - end - with - | Some args => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) (- args))%expr @ - (x0, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | None => + match + match idc0 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return + (base.base_interp t3 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) + => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t2) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) + (- args1))%expr @ + (x1, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ + x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end) - | (s1 -> d0)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x2) - | None => - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ + x1)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + end + | (@expr.App _ _ _ s0 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s0 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_add (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat + (#(ident.fancy_add (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat end end - | @expr.App _ _ _ s0 _ ($_)%expr _ | @expr.App _ _ _ s0 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_add (Z.log2 s) 0)%expr @ (x, x0))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat end + | _ => + UnderLets.Base (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat end | ident.Z_add_with_carry => - fun x x0 x1 : expr (type.base base.type.Z) => + fun x x0 x1 : defaults.expr (type.base base.type.Z) => UnderLets.Base (#(ident.Z_add_with_carry)%expr @ x @ x0 @ x1)%expr_pat | ident.Z_add_with_get_carry => - fun x x0 x1 x2 : expr (type.base base.type.Z) => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat -| ident.Z_add_with_get_carry_concrete s => - fun x x0 x1 : expr (type.base base.type.Z) => - match x1 with - | #(_)%expr_pat => - match x0 with - | @expr.App _ _ _ s0 _ #(idc0)%expr_pat x2 => - match - match idc0 with - | ident.Z_shiftl offset => Some offset - | _ => None - end - with - | Some args => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) args)%expr @ - (x, x1, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + fun x x0 x1 x2 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x2 with + | #(_)%expr_pat => + match x1 with + | (@expr.App _ _ _ s0 _ #(idc1) x4 @ x3)%expr_pat => + match + match idc1 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x3 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return (base.base_interp t4 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v : defaults.expr (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t3) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) args1)%expr @ + (x0, x2, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s1 -> d0)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d0 - => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - end (Compile.reflect x2) - | None => - match - match idc0 with - | ident.Z_shiftr offset => Some offset - | _ => None - end - with - | Some args => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) (- args))%expr @ - (x, x1, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + | None => + match + match idc1 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x3 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args1))%expr @ + (x0, x2, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s1 -> d0)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + end + | (@expr.App _ _ _ s0 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s0 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat end - end - | @expr.App _ _ _ s0 _ ($_)%expr _ | @expr.App _ _ _ s0 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ x1)%expr_pat - | _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ x1)%expr_pat - end - | ($_)%expr => - match x0 with - | @expr.App _ _ _ s0 _ #(idc)%expr_pat x2 => - match - match idc with - | ident.Z_shiftl offset => Some offset - | _ => None - end - with - | Some args => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) args)%expr @ - (x, x1, x' v0))%expr_pat - else - if s =? 2 ^ Z.log2 s + | ($_)%expr => + match x1 with + | (@expr.App _ _ _ s0 _ #(idc0) x4 @ x3)%expr_pat => + match + match idc0 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t3 v0 => + match + t3 as t4 + return (base.base_interp t4 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args1 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t3) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) args1)%expr @ + (x0, x2, x' v0))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s1 -> d0)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d0 - => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - end (Compile.reflect x2) - | None => - match - match idc with - | ident.Z_shiftr offset => Some offset - | _ => None - end - with - | Some args => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) (- args))%expr @ - (x, x1, x' v0))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + | None => + match + match idc0 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t3 v0 => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args1 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args1))%expr @ + (x0, x2, x' v0))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s1 -> d0)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + end + | (@expr.App _ _ _ s0 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s0 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat end - end - | @expr.App _ _ _ s0 _ ($_)%expr _ | @expr.App _ _ _ s0 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ x1)%expr_pat - | _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ x1)%expr_pat - end - | @expr.Abs _ _ _ _ _ _ => - match x0 with - | @expr.App _ _ _ s1 _ #(idc)%expr_pat x2 => - match - match idc with - | ident.Z_shiftl offset => Some offset - | _ => None - end - with - | Some args => - match - s1 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) args)%expr @ - (x, x1, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + | @expr.Abs _ _ _ _ _ _ => + match x1 with + | (@expr.App _ _ _ s1 _ #(idc0) x4 @ x3)%expr_pat => + match + match idc0 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s1 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) args1)%expr @ + (x0, x2, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun _ : Compile.value' false s2 -> Compile.value' true d1 - => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - end (Compile.reflect x2) - | None => - match - match idc with - | ident.Z_shiftr offset => Some offset - | _ => None - end - with - | Some args => - match - s1 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) (- args))%expr @ - (x, x1, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + | None => + match + match idc0 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return + (base.base_interp t3 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s1 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) + => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t2) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args1))%expr @ + (x0, x2, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + end + | (@expr.App _ _ _ s1 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s1 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat end - end - | @expr.App _ _ _ s1 _ ($_)%expr _ | @expr.App _ _ _ s1 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s1 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ x1)%expr_pat - | _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s0 _ #(idc)%expr_pat x2 => - match - match idc with - | ident.Z_shiftl offset => Some offset - | _ => None - end - with - | Some args => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) args)%expr @ - (x, x0, x' v))%expr_pat - else - match x0 with - | @expr.App _ _ _ s1 _ #(idc0)%expr_pat x3 => + | (#(_) @ _)%expr_pat => + match x1 with + | (@expr.App _ _ _ s1 _ #(idc1) x5 @ x4)%expr_pat => + match + match idc1 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc2)%expr_pat => match - match idc0 with - | ident.Z_shiftl offset => Some offset + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return (base.base_interp t4 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v | _ => None end with - | Some args0 => + | Some args1 => match s1 as t3 return (Compile.value' false t3 -> UnderLets.UnderLets base.type ident var - (expr + (defaults.expr (type.base (base.type.Z * base.type.Z)%etype))) with | type.base t3 => - fun v0 : expr (type.base t3) => + fun v : defaults.expr (type.base t3) => base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 base.type.Z + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z (UnderLets.UnderLets base.type ident var - (expr + (defaults.expr (type.base (base.type.Z * base.type.Z)%etype))) (fun - a0 : option - (expr (type.base t3) -> - expr (type.base base.type.Z)) - => - match a0 with - | Some x'0 => - if s =? 2 ^ Z.log2 s + a : option + (defaults.expr (type.base t3) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) - args0)%expr @ - (x, x1, x'0 v0))%expr_pat + (#(ident.fancy_addc + (Z.log2 args) args1)%expr @ + (x0, x2, x' v))%expr_pat else - if s =? 2 ^ Z.log2 s + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) - 0)%expr @ (x, x0, x1))%expr_pat + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat | None => UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat end) - | (s2 -> d1)%ptype => + | (s2 -> d2)%ptype => fun _ : Compile.value' false s2 -> - Compile.value' true d1 => + Compile.value' true d2 => UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end (Compile.reflect x3) + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x5) | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + | None => + match + match idc1 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc2)%expr_pat => match - match idc0 with - | ident.Z_shiftr offset => Some offset + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v | _ => None end with - | Some args0 => + | Some args1 => match s1 as t3 return (Compile.value' false t3 -> UnderLets.UnderLets base.type ident var - (expr + (defaults.expr (type.base (base.type.Z * base.type.Z)%etype))) with | type.base t3 => - fun v0 : expr (type.base t3) => + fun v : defaults.expr (type.base t3) + => base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 base.type.Z (UnderLets.UnderLets base.type ident var - (expr + (defaults.expr (type.base (base.type.Z * base.type.Z)%etype))) (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) => - match a0 with - | Some x'0 => - if s =? 2 ^ Z.log2 s + match a with + | Some x' => + if args =? 2 ^ Z.log2 args then UnderLets.Base (#(ident.fancy_addc - (Z.log2 s) (- args0))%expr @ - (x, x1, x'0 v0))%expr_pat + (Z.log2 args) + (- args1))%expr @ + (x0, x2, x' v))%expr_pat else - if s =? 2 ^ Z.log2 s + if args =? 2 ^ Z.log2 args then UnderLets.Base (#(ident.fancy_addc - (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat | None => UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat end) - | (s2 -> d1)%ptype => + | (s2 -> d2)%ptype => fun _ : Compile.value' false s2 -> - Compile.value' true d1 => + Compile.value' true d2 => UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end (Compile.reflect x3) + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x5) | None => - if s =? 2 ^ Z.log2 s + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat end - | @expr.App _ _ _ s1 _ ($_)%expr _ | @expr.App _ _ _ - s1 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s1 - _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s1 _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | _ => - if s =? 2 ^ Z.log2 s + | None => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat end - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end) - | (s1 -> d0)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - end (Compile.reflect x2) - | None => - match - match idc with - | ident.Z_shiftr offset => Some offset - | _ => None - end - with - | Some args => - match x0 with - | #(_)%expr_pat => + end + | (@expr.App _ _ _ s1 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s1 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + end + | (($_)%expr @ _)%expr_pat => + match x1 with + | (@expr.App _ _ _ s1 _ #(idc0) x5 @ x4)%expr_pat => match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) + match idc0 with + | ident.Z_shiftl => Some tt + | _ => None + end with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) (- args))%expr @ - (x, x0, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + | Some _ => + match x4 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t3 v0 => + match + t3 as t4 + return (base.base_interp t4 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args1 => + match + s1 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t3) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) args1)%expr @ + (x0, x2, x' v0))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x5) + | None => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s1 -> d0)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end (Compile.reflect x2) - | ($_)%expr => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) (- args))%expr @ - (x, x0, x' v0))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + | None => + match + match idc0 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t3 v0 => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args1 => + match + s1 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args1))%expr @ + (x0, x2, x' v0))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x5) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s1 -> d0)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end (Compile.reflect x2) - | @expr.Abs _ _ _ _ _ _ => + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + end + | (@expr.App _ _ _ s1 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s1 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + end + | (@expr.Abs _ _ _ _ _ _ @ _)%expr_pat => + match x1 with + | (@expr.App _ _ _ s2 _ #(idc0) x5 @ x4)%expr_pat => match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) + match idc0 with + | ident.Z_shiftl => Some tt + | _ => None + end with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) (- args))%expr @ - (x, x0, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + | Some _ => + match x4 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s2 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) args1)%expr @ + (x0, x2, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x5) + | None => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end (Compile.reflect x2) - | @expr.App _ _ _ s1 _ #(idc0)%expr_pat x3 => - match - match idc0 with - | ident.Z_shiftl offset => Some offset - | _ => None - end - with - | Some args0 => + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + | None => match - s1 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) + match idc0 with + | ident.Z_shiftr => Some tt + | _ => None + end with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) args0)%expr @ - (x, x1, x' v))%expr_pat - else + | Some _ => + match x4 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return + (base.base_interp t3 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => match - s0 as t3 + s2 as t2 return - (Compile.value' false t3 -> + (Compile.value' false t2 -> UnderLets.UnderLets base.type ident var - (expr + (defaults.expr (type.base (base.type.Z * base.type.Z)%etype))) with - | type.base t3 => - fun v0 : expr (type.base t3) => + | type.base t2 => + fun v : defaults.expr (type.base t2) + => base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 base.type.Z (UnderLets.UnderLets base.type ident var - (expr + (defaults.expr (type.base (base.type.Z * base.type.Z)%etype))) (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) + a : option + (defaults.expr + (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => - match a0 with - | Some x'0 => - if s =? 2 ^ Z.log2 s + match a with + | Some x' => + if args =? 2 ^ Z.log2 args then UnderLets.Base (#(ident.fancy_addc - (Z.log2 s) (- args))%expr @ - (x, x0, x'0 v0))%expr_pat + (Z.log2 args) + (- args1))%expr @ + (x0, x2, x' v))%expr_pat else - if s =? 2 ^ Z.log2 s + if args =? 2 ^ Z.log2 args then UnderLets.Base (#(ident.fancy_addc - (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat | None => UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat end) - | (s2 -> d1)%ptype => + | (s3 -> d3)%ptype => fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => + _ : Compile.value' false s3 -> + Compile.value' true d3 => UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x3) - | None => + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x5) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + end + | (@expr.App _ _ _ s2 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + end + | (@expr.App _ _ _ s0 _ #(idc0) x4 @ x3)%expr_pat => + match + match idc0 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x3 with + | #(idc1)%expr_pat => match - match idc0 with - | ident.Z_shiftr offset => Some offset + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v | _ => None end with - | Some args0 => + | Some args1 => match s0 as t2 return (Compile.value' false t2 -> UnderLets.UnderLets base.type ident var - (expr + (defaults.expr (type.base (base.type.Z * base.type.Z)%etype))) with | type.base t2 => - fun v : expr (type.base t2) => + fun v : defaults.expr (type.base t2) => base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) - t2 base.type.Z + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z (UnderLets.UnderLets base.type ident var - (expr + (defaults.expr (type.base (base.type.Z * base.type.Z)%etype))) (fun a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => match a with | Some x' => - if s =? 2 ^ Z.log2 s + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) - (- args))%expr @ (x, x0, x' v))%expr_pat + (#(ident.fancy_addc (Z.log2 args) + args1)%expr @ (x0, x1, x' v))%expr_pat else + match x1 with + | (@expr.App _ _ _ s2 _ #(idc2) x6 @ + x5)%expr_pat => + match + match idc2 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x5 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t5 + v0 => + match + t5 as t6 + return + (base.base_interp + t6 -> + option Z) + with + | base.type.unit => + fun _ : unit => + None + | base.type.Z => + fun v1 : Z => + Some v1 + | base.type.bool => + fun _ : bool => + None + | base.type.nat => + fun _ : nat => + None + end v0 + | _ => None + end + with + | Some args3 => + match + s2 as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t5 => + fun + v0 : defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base + t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a0 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if + args =? + 2 + ^ + Z.log2 + args + then + UnderLets.Base + (# + (ident.fancy_addc + (Z.log2 + args) + args3)%expr @ + (x0, x2, + x'0 v0))%expr_pat + else + if + args =? + 2 + ^ + Z.log2 + args + then + UnderLets.Base + (# + (ident.fancy_addc + (Z.log2 + args) 0)%expr @ + (x0, x1, + x2))%expr_pat + else + UnderLets.Base + (# + (ident.Z_add_with_get_carry)%expr @ + x @ x0 @ + x1 @ x2)%expr_pat + | None => + UnderLets.Base + (# + (ident.Z_add_with_get_carry)%expr @ + x @ x0 @ + x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ + x2)%expr_pat + end + (Compile.reflect x6) + | None => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if + args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | None => + match + match idc2 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x5 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t5 + v0 => + match + t5 as t6 + return + (base.base_interp + t6 -> + option Z) + with + | base.type.unit => + fun + _ : unit + => None + | base.type.Z => + fun v1 : Z + => + Some v1 + | base.type.bool => + fun + _ : bool + => None + | base.type.nat => + fun _ : nat + => None + end v0 + | _ => None + end + with + | Some args3 => + match + s2 as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t5 => + fun + v0 : + defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base + t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a0 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a0 + with + | Some + x'0 => + if + args =? + 2 + ^ + Z.log2 + args + then + UnderLets.Base + (# + (ident.fancy_addc + (Z.log2 + args) + (- args3))%expr @ + (x0, x2, + x'0 v0))%expr_pat + else + if + args =? + 2 + ^ + Z.log2 + args + then + UnderLets.Base + (# + (ident.fancy_addc + (Z.log2 + args) 0)%expr @ + (x0, x1, + x2))%expr_pat + else + UnderLets.Base + (# + (ident.Z_add_with_get_carry)%expr @ + x @ x0 @ + x1 @ x2)%expr_pat + | None => + UnderLets.Base + (# + (ident.Z_add_with_get_carry)%expr @ + x @ x0 @ + x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ + x1 @ x2)%expr_pat + end + (Compile.reflect + x6) + | None => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 + args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ + x2)%expr_pat + end + | _ => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | None => + if + args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + end + | (@expr.App _ _ _ s2 _ ($_)%expr _ @ + _)%expr_pat | + (@expr.App _ _ _ s2 _ + (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ + (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + match x1 with + | (@expr.App _ _ _ s2 _ #(idc2) x6 @ x5)%expr_pat => + match + match idc2 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x5 with + | #(idc3)%expr_pat => match - s1 as t3 + match idc3 with + | @ident.Literal t4 v => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s2 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t4 => + fun + v : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + args2)%expr @ + (x0, x2, x' v))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x6) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) + 0)%expr @ (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | None => + match + match idc2 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x5 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t4 v => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s2 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t4 => + fun + v : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 + args) + (- args2))%expr @ + (x0, x2, x' v))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 + args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ + x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ + x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' true + d3 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x6) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) + 0)%expr @ (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + end + | (@expr.App _ _ _ s2 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) + _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ + (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + end + | ($_)%expr => + match x1 with + | (@expr.App _ _ _ s2 _ #(idc1) x6 @ x5)%expr_pat => + match + match idc1 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x5 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t4 v0 => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v0 + | _ => None + end + with + | Some args2 => + match + s2 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t4) -> + defaults.expr + (type.base + base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + args2)%expr @ + (x0, x2, x' v0))%expr_pat + else + if + args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x6) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) + 0)%expr @ (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | None => + match + match idc1 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x5 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t4 v0 => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v0 + | _ => None + end + with + | Some args2 => + match + s2 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args2))%expr @ + (x0, x2, x' v0))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x6) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) + 0)%expr @ (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + end + | (@expr.App _ _ _ s2 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) + _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + | @expr.Abs _ _ _ _ _ _ => + match x1 with + | (@expr.App _ _ _ s3 _ #(idc1) x6 @ x5)%expr_pat => + match + match idc1 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x5 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s3 as t3 return (Compile.value' false t3 -> UnderLets.UnderLets base.type ident var - (expr + (defaults.expr (type.base (base.type.Z * base.type.Z)%etype))) with | type.base t3 => - fun v0 : expr (type.base t3) => + fun + v : defaults.expr + (type.base t3) => base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 - base.type.Z + (fun t4 : base.type => + defaults.expr (type.base t4)) + t3 base.type.Z (UnderLets.UnderLets base.type ident var - (expr + (defaults.expr (type.base (base.type.Z * base.type.Z)%etype))) (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base - base.type.Z)) - => - match a0 with - | Some x'0 => - if s =? 2 ^ Z.log2 s + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args then UnderLets.Base (#(ident.fancy_addc - (Z.log2 s) - (- args0))%expr @ - (x, x1, x'0 v0))%expr_pat + (Z.log2 args) + args2)%expr @ + (x0, x2, x' v))%expr_pat else - if s =? 2 ^ Z.log2 s + if + args =? 2 ^ Z.log2 args then UnderLets.Base (#(ident.fancy_addc - (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ - x1)%expr_pat + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat | None => UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ - x1)%expr_pat + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat end) - | (s2 -> d1)%ptype => + | (s4 -> d4)%ptype => fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => + _ : Compile.value' false s4 -> + Compile.value' true d4 => UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end (Compile.reflect x3) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x6) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) + 0)%expr @ (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | None => + match + match idc1 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x5 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s3 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args2))%expr @ + (x0, x2, x' v))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 + => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x6) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) + 0)%expr @ (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + end + | (@expr.App _ _ _ s3 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s3 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s3 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s3 _ (@expr.LetIn _ _ _ _ _ _ _) + _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + | (_ @ _)%expr_pat => + match x1 with + | (@expr.App _ _ _ s3 _ #(idc1) x7 @ x6)%expr_pat => match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) + match idc1 with + | ident.Z_shiftl => Some tt + | _ => None + end with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) - t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) - (- args))%expr @ (x, x0, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + | Some _ => + match x6 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s3 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) + t3 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + args2)%expr @ + (x0, x2, x' v))%expr_pat + else + if + args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x7) + | None => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) + 0)%expr @ (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | None => + match + match idc1 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x6 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s3 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args2))%expr @ + (x0, x2, x' v))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 + => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x7) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) + 0)%expr @ (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + end + | (@expr.App _ _ _ s3 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s3 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s3 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s3 _ (@expr.LetIn _ _ _ _ _ _ _) + _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + | @expr.LetIn _ _ _ _ _ _ _ => + match x1 with + | (@expr.App _ _ _ s2 _ #(idc1) x7 @ x6)%expr_pat => + match + match idc1 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x6 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s2 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) + t3 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + args2)%expr @ + (x0, x2, x' v))%expr_pat + else + if + args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x7) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) + 0)%expr @ (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | None => + match + match idc1 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x6 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s2 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args2))%expr @ + (x0, x2, x' v))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x7) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) + 0)%expr @ (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + end + | (@expr.App _ _ _ s2 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) + _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat end end - | @expr.App _ _ _ s1 _ ($_)%expr _ => + | None => match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) + match idc0 with + | ident.Z_shiftr => Some tt + | _ => None + end with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) (- args))%expr @ - (x, x0, x' v0))%expr_pat - else - if s =? 2 ^ Z.log2 s + | Some _ => + match x1 with + | #(_)%expr_pat => + match x3 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args1))%expr @ + (x0, x1, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end (Compile.reflect x2) - | @expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App - _ _ _ s1 _ (_ @ _)%expr_pat _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) (- args))%expr @ - (x, x0, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | ($_)%expr => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t3 v0 => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args1 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args1))%expr @ + (x0, x1, x' v0))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s3 -> d2)%ptype => - fun - _ : Compile.value' false s3 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end (Compile.reflect x2) - | @expr.App _ _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) (- args))%expr @ - (x, x0, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | (#(_) @ _)%expr_pat => + match x3 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args1))%expr @ + (x0, x1, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end (Compile.reflect x2) - | @expr.LetIn _ _ _ _ _ _ _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) (- args))%expr @ - (x, x0, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | (($_)%expr @ _)%expr_pat => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t3 v0 => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args1 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args1))%expr @ + (x0, x1, x' v0))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s1 -> d0)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end (Compile.reflect x2) + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | (@expr.Abs _ _ _ _ _ _ @ _)%expr_pat => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return + (base.base_interp t3 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) + => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t2) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args1))%expr @ + (x0, x1, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | (@expr.App _ _ _ s2 _ #(idc1) x6 @ x5)%expr_pat => + match + match idc1 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x5 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s2 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) + t3 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + args2)%expr @ + (x0, x2, x' v))%expr_pat + else + match x3 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t5 + v0 => + match + t5 as t6 + return + (base.base_interp + t6 -> + option Z) + with + | base.type.unit => + fun + _ : unit + => None + | base.type.Z => + fun v1 : Z + => + Some v1 + | base.type.bool => + fun + _ : bool + => None + | base.type.nat => + fun _ : nat + => None + end v0 + | _ => None + end + with + | Some args3 => + match + s0 as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t5 => + fun + v0 : + defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base + t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a0 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a0 + with + | Some + x'0 => + if + args =? + 2 + ^ + Z.log2 + args + then + UnderLets.Base + (# + (ident.fancy_addc + (Z.log2 + args) + (- args3))%expr @ + (x0, x1, + x'0 v0))%expr_pat + else + if + args =? + 2 + ^ + Z.log2 + args + then + UnderLets.Base + (# + (ident.fancy_addc + (Z.log2 + args) 0)%expr @ + (x0, x1, + x2))%expr_pat + else + UnderLets.Base + (# + (ident.Z_add_with_get_carry)%expr @ + x @ x0 @ + x1 @ x2)%expr_pat + | None => + UnderLets.Base + (# + (ident.Z_add_with_get_carry)%expr @ + x @ x0 @ + x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ + x1 @ x2)%expr_pat + end + (Compile.reflect + x4) + | None => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 + args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ + x2)%expr_pat + end + | _ => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x6) + | None => + match x3 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t4 v => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t4 => + fun + v : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 + args) + (- args2))%expr @ + (x0, x1, x' v))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 + args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ + x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ + x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' true + d3 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + end + | ($_)%expr => + match x3 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t4 v0 => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v0 + | _ => None + end + with + | Some args2 => + match + s0 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args2))%expr @ + (x0, x1, x' v0))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) + 0)%expr @ (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | @expr.LetIn _ _ _ _ _ _ _ => + match x3 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args2))%expr @ + (x0, x1, x' v))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) + 0)%expr @ (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + match x3 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args2))%expr @ + (x0, x1, x' v))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 + => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) + 0)%expr @ (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + end + | None => + match + match idc1 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x3 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args2))%expr @ + (x0, x1, x' v))%expr_pat + else + match x5 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal + t5 v0 => + match + t5 as t6 + return + (base.base_interp + t6 -> + option Z) + with + | base.type.unit => + fun + _ : unit + => None + | base.type.Z => + fun + v1 : Z => + Some v1 + | base.type.bool => + fun + _ : bool + => None + | base.type.nat => + fun + _ : nat + => None + end v0 + | _ => None + end + with + | Some args3 => + match + s2 as t5 + return + (Compile.value' + false t5 -> + UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base + t5 => + fun + v0 : + defaults.expr + (type.base + t5) => + base.try_make_transport_cps + (fun + t6 : base.type + => + defaults.expr + (type.base + t6)) t5 + base.type.Z + (UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a0 : + option + (defaults.expr + (type.base + t5) -> + defaults.expr + (type.base + base.type.Z)) + => + match + a0 + with + | Some + x'0 => + if + args =? + 2 + ^ + Z.log2 + args + then + UnderLets.Base + (# + (ident.fancy_addc + (Z.log2 + args) + (- args3))%expr @ + (x0, x2, + x'0 v0))%expr_pat + else + if + args =? + 2 + ^ + Z.log2 + args + then + UnderLets.Base + (# + (ident.fancy_addc + (Z.log2 + args) 0)%expr @ + (x0, x1, + x2))%expr_pat + else + UnderLets.Base + (# + (ident.Z_add_with_get_carry)%expr @ + x @ x0 @ + x1 @ x2)%expr_pat + | None => + UnderLets.Base + (# + (ident.Z_add_with_get_carry)%expr @ + x @ x0 @ + x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : + Compile.value' + false s3 -> + Compile.value' + true d3 + => + UnderLets.Base + (# + (ident.Z_add_with_get_carry)%expr @ + x @ x0 @ + x1 @ x2)%expr_pat + end + (Compile.reflect + x6) + | None => + if + args =? + 2 + ^ Z.log2 + args + then + UnderLets.Base + (# + (ident.fancy_addc + (Z.log2 + args) 0)%expr @ + (x0, x1, + x2))%expr_pat + else + UnderLets.Base + (# + (ident.Z_add_with_get_carry)%expr @ + x @ x0 @ + x1 @ x2)%expr_pat + end + | _ => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 + args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ + x2)%expr_pat + end + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + match x5 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t4 v => + match + t4 as t5 + return + (base.base_interp + t5 -> option Z) + with + | base.type.unit => + fun _ : unit => + None + | base.type.Z => + fun v0 : Z => + Some v0 + | base.type.bool => + fun _ : bool => + None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s2 as t4 + return + (Compile.value' false + t4 -> + UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t4 => + fun + v : defaults.expr + (type.base t4) + => + base.try_make_transport_cps + (fun t5 : base.type + => + defaults.expr + (type.base t5)) + t4 base.type.Z + (UnderLets.UnderLets + base.type ident + var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 + ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 + args) + (- args2))%expr @ + (x0, x2, + x' v))%expr_pat + else + if + args =? + 2 + ^ Z.log2 + args + then + UnderLets.Base + (# + (ident.fancy_addc + (Z.log2 + args) 0)%expr @ + (x0, x1, + x2))%expr_pat + else + UnderLets.Base + (# + (ident.Z_add_with_get_carry)%expr @ + x @ x0 @ + x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ + x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' + true d3 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x6) + | None => + if + args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + end + | ($_)%expr => + match x5 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t4 v0 => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v0 + | _ => None + end + with + | Some args2 => + match + s2 as t4 + return + (Compile.value' false t4 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t4 => + fun + v0 : defaults.expr + (type.base t4) + => + base.try_make_transport_cps + (fun t5 : base.type => + defaults.expr + (type.base t5)) t4 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base + t4) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 + args) + (- args2))%expr @ + (x0, x2, + x' v0))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 + args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ + x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ + x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' true + d3 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x6) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | @expr.LetIn _ _ _ _ _ _ _ => + match x5 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s2 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base + t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 + args) + (- args2))%expr @ + (x0, x2, x' v))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 + args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ + x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ + x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' + false s3 -> + Compile.value' true + d3 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x6) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + match x5 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match + s2 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base + t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 + args) + (- args2))%expr @ + (x0, x2, x' v))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 + args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ + x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ + x2)%expr_pat + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' + false s4 -> + Compile.value' true + d4 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x6) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + end + | None => + match x3 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args1))%expr @ + (x0, x1, x' v))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) + 0)%expr @ (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + end + end + | (@expr.App _ _ _ s2 _ ($_)%expr _ @ _)%expr_pat => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t3 v0 => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args1 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args1))%expr @ + (x0, x1, x' v0))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (_ @ _) _ @ _)%expr_pat => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return + (base.base_interp t3 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) + => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t2) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args1))%expr @ + (x0, x1, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | (@expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) + _ @ _)%expr_pat => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return + (base.base_interp t3 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) + => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t2) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args1))%expr @ + (x0, x1, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | @expr.LetIn _ _ _ _ _ _ _ => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return + (base.base_interp t3 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) + => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t2) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args1))%expr @ + (x0, x1, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | _ => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return + (base.base_interp t3 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) + => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t2) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args1))%expr @ + (x0, x1, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + end + | None => + match x1 with + | (@expr.App _ _ _ s2 _ #(idc1) x6 @ x5)%expr_pat => + match + match idc1 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x5 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s2 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) + t3 base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + args1)%expr @ + (x0, x2, x' v))%expr_pat + else + if + args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x6) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) + 0)%expr @ (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | None => + match + match idc1 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x5 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s2 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + with + | type.base t3 => + fun + v : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + (base.type.Z * + base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a with + | Some x' => + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args1))%expr @ + (x0, x2, x' v))%expr_pat + else + if + args =? + 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 + => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x6) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) + 0)%expr @ (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + end + | (@expr.App _ _ _ s2 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) + _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + end end - | None => - match x0 with - | @expr.App _ _ _ s1 _ #(idc0)%expr_pat x3 => + | (@expr.App _ _ _ s0 _ ($_)%expr _ @ _)%expr_pat => + match x1 with + | (@expr.App _ _ _ s2 _ #(idc0) x6 @ x5)%expr_pat => match match idc0 with - | ident.Z_shiftl offset => Some offset + | ident.Z_shiftl => Some tt | _ => None end with - | Some args => - match - s1 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then + | Some _ => + match x5 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t3 v0 => + match + t3 as t4 + return (base.base_interp t4 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args1 => + match + s2 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t3) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) args1)%expr @ + (x0, x2, x' v0))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) args)%expr @ - (x, x1, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x3) + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x6) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end | None => match match idc0 with - | ident.Z_shiftr offset => Some offset + | ident.Z_shiftr => Some tt | _ => None end with - | Some args => - match - s1 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) - t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then + | Some _ => + match x5 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t3 v0 => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args1 => + match + s2 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) + => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args1))%expr @ + (x0, x2, x' v0))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) - (- args))%expr @ (x, x1, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x3) + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x6) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end | None => - if s =? 2 ^ Z.log2 s + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat end end - | @expr.App _ _ _ s1 _ ($_)%expr _ | @expr.App _ _ _ s1 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s1 _ - (_ @ _)%expr_pat _ | @expr.App _ _ _ s1 _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - if s =? 2 ^ Z.log2 s + | (@expr.App _ _ _ s2 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat | _ => - if s =? 2 ^ Z.log2 s + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat end - end - end - | @expr.App _ _ _ s0 _ ($_)%expr _ => - match x0 with - | @expr.App _ _ _ s1 _ #(idc)%expr_pat x3 => - match - match idc with - | ident.Z_shiftl offset => Some offset - | _ => None - end - with - | Some args => - match - s1 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) args)%expr @ - (x, x1, x' v0))%expr_pat - else - if s =? 2 ^ Z.log2 s + | (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat => + match x1 with + | (@expr.App _ _ _ s3 _ #(idc0) x6 @ x5)%expr_pat => + match + match idc0 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x5 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s3 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) args1)%expr @ + (x0, x2, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x6) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun _ : Compile.value' false s2 -> Compile.value' true d1 - => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - end (Compile.reflect x3) - | None => - match - match idc with - | ident.Z_shiftr offset => Some offset - | _ => None - end - with - | Some args => - match - s1 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) (- args))%expr @ - (x, x1, x' v0))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + | None => + match + match idc0 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x5 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return + (base.base_interp t3 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s3 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) + => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t2) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args1))%expr @ + (x0, x2, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x6) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end (Compile.reflect x3) - | None => - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + end + | (@expr.App _ _ _ s3 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s3 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s3 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s3 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat end - end - | @expr.App _ _ _ s1 _ ($_)%expr _ | @expr.App _ _ _ s1 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s1 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ x1)%expr_pat - | _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ => - match x0 with - | @expr.App _ _ _ s2 _ #(idc)%expr_pat x3 => - match - match idc with - | ident.Z_shiftl offset => Some offset - | _ => None - end - with - | Some args => - match - s2 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) args)%expr @ - (x, x1, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + | (@expr.App _ _ _ s0 _ (_ @ _) _ @ _)%expr_pat => + match x1 with + | (@expr.App _ _ _ s3 _ #(idc0) x7 @ x6)%expr_pat => + match + match idc0 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x6 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s3 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) args1)%expr @ + (x0, x2, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x7) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s3 -> d2)%ptype => - fun _ : Compile.value' false s3 -> Compile.value' true d2 - => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - end (Compile.reflect x3) - | None => - match - match idc with - | ident.Z_shiftr offset => Some offset - | _ => None - end - with - | Some args => - match - s2 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) (- args))%expr @ - (x, x1, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + | None => + match + match idc0 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x6 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return + (base.base_interp t3 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s3 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) + => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t2) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args1))%expr @ + (x0, x2, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s4 -> d4)%ptype => + fun + _ : Compile.value' false s4 -> + Compile.value' true d4 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x7) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s3 -> d2)%ptype => - fun - _ : Compile.value' false s3 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end (Compile.reflect x3) - | None => - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + end + | (@expr.App _ _ _ s3 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s3 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s3 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s3 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat end - end - | @expr.App _ _ _ s2 _ ($_)%expr _ | @expr.App _ _ _ s2 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s2 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ x1)%expr_pat - | _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s0 _ (_ @ _)%expr_pat _ => - match x0 with - | @expr.App _ _ _ s2 _ #(idc)%expr_pat x4 => - match - match idc with - | ident.Z_shiftl offset => Some offset - | _ => None - end - with - | Some args => - match - s2 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) args)%expr @ - (x, x1, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + | (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + match x1 with + | (@expr.App _ _ _ s2 _ #(idc0) x7 @ x6)%expr_pat => + match + match idc0 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x6 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s2 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) args1)%expr @ + (x0, x2, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x7) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s3 -> d2)%ptype => - fun _ : Compile.value' false s3 -> Compile.value' true d2 - => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - end (Compile.reflect x4) - | None => - match - match idc with - | ident.Z_shiftr offset => Some offset - | _ => None - end - with - | Some args => - match - s2 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) (- args))%expr @ - (x, x1, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + | None => + match + match idc0 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x6 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return + (base.base_interp t3 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s2 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) + => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t2) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args1))%expr @ + (x0, x2, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s3 -> d3)%ptype => + fun + _ : Compile.value' false s3 -> + Compile.value' true d3 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x7) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s3 -> d2)%ptype => - fun - _ : Compile.value' false s3 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end (Compile.reflect x4) - | None => - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + end + | (@expr.App _ _ _ s2 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat end - end - | @expr.App _ _ _ s2 _ ($_)%expr _ | @expr.App _ _ _ s2 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s2 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ x1)%expr_pat - | _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - match x0 with - | @expr.App _ _ _ s1 _ #(idc)%expr_pat x4 => - match - match idc with - | ident.Z_shiftl offset => Some offset - | _ => None - end - with - | Some args => - match - s1 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) args)%expr @ - (x, x1, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + | (@expr.LetIn _ _ _ _ _ _ _ @ _)%expr_pat => + match x1 with + | (@expr.App _ _ _ s1 _ #(idc0) x6 @ x5)%expr_pat => + match + match idc0 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x5 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s1 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) args1)%expr @ + (x0, x2, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x6) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun _ : Compile.value' false s2 -> Compile.value' true d1 - => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - end (Compile.reflect x4) - | None => - match - match idc with - | ident.Z_shiftr offset => Some offset - | _ => None - end - with - | Some args => - match - s1 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) (- args))%expr @ - (x, x1, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + | None => + match + match idc0 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x5 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return + (base.base_interp t3 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s1 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) + => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t2) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args1))%expr @ + (x0, x2, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x6) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end (Compile.reflect x4) - | None => - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + end + | (@expr.App _ _ _ s1 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s1 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat end - end - | @expr.App _ _ _ s1 _ ($_)%expr _ | @expr.App _ _ _ s1 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s1 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ x1)%expr_pat - | _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ x1)%expr_pat - end - | @expr.LetIn _ _ _ _ _ _ _ => - match x0 with - | @expr.App _ _ _ s0 _ #(idc)%expr_pat x3 => - match - match idc with - | ident.Z_shiftl offset => Some offset - | _ => None - end - with - | Some args => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) args)%expr @ - (x, x1, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + | @expr.LetIn _ _ _ _ _ _ _ => + match x1 with + | (@expr.App _ _ _ s0 _ #(idc0) x5 @ x4)%expr_pat => + match + match idc0 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) args1)%expr @ + (x0, x2, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x5) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s1 -> d0)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d0 - => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - end (Compile.reflect x3) - | None => - match - match idc with - | ident.Z_shiftr offset => Some offset - | _ => None - end - with - | Some args => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) (- args))%expr @ - (x, x1, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + | None => + match + match idc0 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x4 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return + (base.base_interp t3 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) + => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr + (type.base t2) -> + defaults.expr + (type.base base.type.Z)) + => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) + (- args1))%expr @ + (x0, x2, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x5) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s1 -> d0)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end (Compile.reflect x3) - | None => - if s =? 2 ^ Z.log2 s + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + end + | (@expr.App _ _ _ s0 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s0 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_addc (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat end end - | @expr.App _ _ _ s0 _ ($_)%expr _ | @expr.App _ _ _ s0 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ x1)%expr_pat - | _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_addc (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat end + | _ => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat end | ident.Z_sub_get_borrow => - fun x x0 x1 : expr (type.base base.type.Z) => - UnderLets.Base (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ x1)%expr_pat -| ident.Z_sub_get_borrow_concrete s => - fun x x0 : expr (type.base base.type.Z) => - match x0 with - | @expr.App _ _ _ s0 _ #(idc)%expr_pat x1 => + fun x x0 x1 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => match match idc with - | ident.Z_shiftl offset => Some offset + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v | _ => None end with | Some args => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_sub (Z.log2 s) args)%expr @ - (x, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + match x1 with + | (@expr.App _ _ _ s0 _ #(idc0) x3 @ x2)%expr_pat => + match + match idc0 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_sub (Z.log2 args) + args1)%expr @ (x0, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_sub (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_sub_get_borrow)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_sub_get_borrow)%expr @ x @ + x0 @ x1)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ + x1)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_sub (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_sub (Z.log2 s) 0)%expr @ (x, x0))%expr_pat + (#(ident.fancy_sub (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ - x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ x0)%expr_pat - end) - | (s1 -> d0)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x1) - | None => - match - match idc with - | ident.Z_shiftr offset => Some offset - | _ => None - end - with - | Some args => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_sub (Z.log2 s) (- args))%expr @ - (x, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ x1)%expr_pat + end + | None => + match + match idc0 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_sub + (Z.log2 args) (- args1))%expr @ + (x0, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_sub + (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_sub_get_borrow)%expr @ + x @ x0 @ x1)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_sub_get_borrow)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_sub_get_borrow)%expr @ x @ + x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_sub (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ + x1)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_sub (Z.log2 s) 0)%expr @ - (x, x0))%expr_pat + (#(ident.fancy_sub (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ - x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ - x0)%expr_pat - end) - | (s1 -> d0)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d0 - => - UnderLets.Base - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x1) - | None => - if s =? 2 ^ Z.log2 s + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ x1)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_sub (Z.log2 args) 0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ x1)%expr_pat + end + end + | (@expr.App _ _ _ s0 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s0 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_sub (Z.log2 s) 0)%expr @ (x, x0))%expr_pat + (#(ident.fancy_sub (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat else UnderLets.Base - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ x0)%expr_pat + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ x1)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_sub (Z.log2 args) 0)%expr @ (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ x1)%expr_pat end + | None => + UnderLets.Base + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ x1)%expr_pat end - | @expr.App _ _ _ s0 _ ($_)%expr _ | @expr.App _ _ _ s0 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 _ (_ @ _)%expr_pat _ | - @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_sub (Z.log2 s) 0)%expr @ (x, x0))%expr_pat - else - UnderLets.Base - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ x0)%expr_pat | _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_sub (Z.log2 s) 0)%expr @ (x, x0))%expr_pat - else - UnderLets.Base - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ x0)%expr_pat + UnderLets.Base + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ x1)%expr_pat end | ident.Z_sub_with_get_borrow => - fun x x0 x1 x2 : expr (type.base base.type.Z) => - UnderLets.Base - (#(ident.Z_sub_with_get_borrow)%expr @ x @ x0 @ x1 @ x2)%expr_pat -| ident.Z_sub_with_get_borrow_concrete s => - fun x x0 x1 : expr (type.base base.type.Z) => - match x1 with - | @expr.App _ _ _ s0 _ #(idc)%expr_pat x2 => + fun x x0 x1 x2 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => match match idc with - | ident.Z_shiftl offset => Some offset + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v | _ => None end with | Some args => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_subb (Z.log2 s) args)%expr @ - (x, x0, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + match x2 with + | (@expr.App _ _ _ s0 _ #(idc0) x4 @ x3)%expr_pat => + match + match idc0 with + | ident.Z_shiftl => Some tt + | _ => None + end + with + | Some _ => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_subb (Z.log2 args) + args1)%expr @ (x0, x1, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_subb (Z.log2 args) + 0)%expr @ (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_sub_with_get_borrow)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_subb (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_sub_with_get_borrow)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_subb (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_subb (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_sub_with_get_borrow_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_sub_with_get_borrow_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end) - | (s1 -> d0)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_sub_with_get_borrow_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - end (Compile.reflect x2) - | None => - match - match idc with - | ident.Z_shiftr offset => Some offset - | _ => None - end - with - | Some args => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_subb (Z.log2 s) (- args))%expr @ - (x, x0, x' v))%expr_pat - else - if s =? 2 ^ Z.log2 s + (#(ident.Z_sub_with_get_borrow)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + end + | None => + match + match idc0 with + | ident.Z_shiftr => Some tt + | _ => None + end + with + | Some _ => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base + (base.type.Z * base.type.Z)%etype))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_subb + (Z.log2 args) (- args1))%expr @ + (x0, x1, x' v))%expr_pat + else + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_subb + (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end (Compile.reflect x4) + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_subb (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_sub_with_get_borrow)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_subb (Z.log2 s) 0)%expr @ - (x, x0, x1))%expr_pat + (#(ident.fancy_subb (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_sub_with_get_borrow_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_sub_with_get_borrow_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s1 -> d0)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d0 - => - UnderLets.Base - (#(ident.Z_sub_with_get_borrow_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - if s =? 2 ^ Z.log2 s + (#(ident.Z_sub_with_get_borrow)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + | None => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_subb (Z.log2 args) 0)%expr @ + (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_sub_with_get_borrow)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + end + end + | (@expr.App _ _ _ s0 _ ($_)%expr _ @ _)%expr_pat | + (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s0 _ (_ @ _) _ @ _)%expr_pat | + (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_subb (Z.log2 args) 0)%expr @ (x0, x1, x2))%expr_pat + else + UnderLets.Base + (#(ident.Z_sub_with_get_borrow)%expr @ x @ x0 @ x1 @ x2)%expr_pat + | _ => + if args =? 2 ^ Z.log2 args then UnderLets.Base - (#(ident.fancy_subb (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat + (#(ident.fancy_subb (Z.log2 args) 0)%expr @ (x0, x1, x2))%expr_pat else UnderLets.Base - (#(ident.Z_sub_with_get_borrow_concrete s)%expr @ x @ x0 @ - x1)%expr_pat + (#(ident.Z_sub_with_get_borrow)%expr @ x @ x0 @ x1 @ x2)%expr_pat end + | None => + UnderLets.Base + (#(ident.Z_sub_with_get_borrow)%expr @ x @ x0 @ x1 @ x2)%expr_pat end - | @expr.App _ _ _ s0 _ ($_)%expr _ | @expr.App _ _ _ s0 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 _ (_ @ _)%expr_pat _ | - @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_subb (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat - else - UnderLets.Base - (#(ident.Z_sub_with_get_borrow_concrete s)%expr @ x @ x0 @ x1)%expr_pat | _ => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_subb (Z.log2 s) 0)%expr @ (x, x0, x1))%expr_pat - else - UnderLets.Base - (#(ident.Z_sub_with_get_borrow_concrete s)%expr @ x @ x0 @ x1)%expr_pat + UnderLets.Base + (#(ident.Z_sub_with_get_borrow)%expr @ x @ x0 @ x1 @ x2)%expr_pat end | ident.Z_zselect => - fun x x0 x1 : expr (type.base base.type.Z) => + fun x x0 x1 : defaults.expr (type.base base.type.Z) => match x with - | @expr.App _ _ _ s _ #(idc)%expr_pat x2 => - match - match idc with - | ident.Z_cc_m_concrete s0 => Some s0 - | _ => None - end - with - | Some args => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args =? 2 ^ Z.log2 args - then - UnderLets.Base - (#(ident.fancy_selm (Z.log2 args))%expr @ - (x' v, x0, x1))%expr_pat - else + | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ #(idc)%expr_pat x3) x2 => + match match idc with + | ident.Z_cc_m => Some tt + | _ => None + end with + | Some _ => + match x3 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => defaults.expr (type.base t1)) + t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) => + match a with + | Some x' => + if args0 =? 2 ^ Z.log2 args0 + then + UnderLets.Base + (#(ident.fancy_selm (Z.log2 args0))%expr @ + (x' v, x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.fancy_selc)%expr @ (x, x0, x1))%expr_pat + | None => + UnderLets.Base + (#(ident.Z_zselect)%expr @ x @ x0 @ x1)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => UnderLets.Base - (#(ident.fancy_selc)%expr @ (x, x0, x1))%expr_pat - | None => - UnderLets.Base - (#(ident.Z_zselect)%expr @ x @ x0 @ x1)%expr_pat - end) - | (s0 -> d0)%ptype => - fun _ : Compile.value' false s0 -> Compile.value' true d0 => + (#(ident.Z_zselect)%expr @ x @ x0 @ x1)%expr_pat + end (Compile.reflect x2) + | None => + UnderLets.Base + (#(ident.fancy_selc)%expr @ (x, x0, x1))%expr_pat + end + | _ => UnderLets.Base - (#(ident.Z_zselect)%expr @ x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) + (#(ident.fancy_selc)%expr @ (x, x0, x1))%expr_pat + end | None => match match idc with - | ident.Z_land mask => Some mask + | ident.Z_land => Some tt | _ => None end with - | Some args => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args =? 1 - then + | Some _ => + match x3 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match + s as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base base.type.Z)) + => + match a with + | Some x' => + if args0 =? 1 + then + UnderLets.Base + (#(ident.fancy_sell)%expr @ + (x' v, x0, x1))%expr_pat + else + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t3 v0 => + match + t3 as t4 + return + (base.base_interp t4 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v1 : Z => Some v1 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v0 + | _ => None + end + with + | Some args1 => + match + s0 as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base base.type.Z))) + with + | type.base t3 => + fun + v0 : defaults.expr + (type.base t3) => + base.try_make_transport_cps + (fun t4 : base.type => + defaults.expr + (type.base t4)) t3 + base.type.Z + (UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base + base.type.Z))) + (fun + a0 : option + (defaults.expr + (type.base t3) -> + defaults.expr + (type.base + base.type.Z)) + => + match a0 with + | Some x'0 => + if args1 =? 1 + then + UnderLets.Base + (#(ident.fancy_sell)%expr @ + (x'0 v0, x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.fancy_selc)%expr @ + (x, x0, x1))%expr_pat + | None => + UnderLets.Base + (#(ident.Z_zselect)%expr @ + x @ x0 @ x1)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 + => + UnderLets.Base + (#(ident.Z_zselect)%expr @ + x @ x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.Base + (#(ident.fancy_selc)%expr @ + (x, x0, x1))%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_selc)%expr @ + (x, x0, x1))%expr_pat + end + | None => + UnderLets.Base + (#(ident.Z_zselect)%expr @ x @ x0 @ x1)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_zselect)%expr @ x @ x0 @ x1)%expr_pat + end (Compile.reflect x2) + | None => + match x2 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident + var + (defaults.expr + (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args0 =? 1 + then + UnderLets.Base + (#(ident.fancy_sell)%expr @ + (x' v, x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.fancy_selc)%expr @ + (x, x0, x1))%expr_pat + | None => + UnderLets.Base + (#(ident.Z_zselect)%expr @ x @ + x0 @ x1)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_zselect)%expr @ x @ x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.Base + (#(ident.fancy_selc)%expr @ (x, x0, x1))%expr_pat + end + | _ => UnderLets.Base - (#(ident.fancy_sell)%expr @ (x' v, x0, x1))%expr_pat - else + (#(ident.fancy_selc)%expr @ (x, x0, x1))%expr_pat + end + end + | ($_)%expr => + match x2 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t2 v0 => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v1 : Z => Some v1 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v0 + | _ => None + end + with + | Some args0 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v0 : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t3 : base.type => + defaults.expr (type.base t3)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args0 =? 1 + then + UnderLets.Base + (#(ident.fancy_sell)%expr @ + (x' v0, x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.fancy_selc)%expr @ + (x, x0, x1))%expr_pat + | None => + UnderLets.Base + (#(ident.Z_zselect)%expr @ x @ x0 @ + x1)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_zselect)%expr @ x @ x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => UnderLets.Base (#(ident.fancy_selc)%expr @ (x, x0, x1))%expr_pat - | None => - UnderLets.Base - (#(ident.Z_zselect)%expr @ x @ x0 @ x1)%expr_pat - end) - | (s0 -> d0)%ptype => - fun _ : Compile.value' false s0 -> Compile.value' true d0 - => - UnderLets.Base - (#(ident.Z_zselect)%expr @ x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) + end + | _ => + UnderLets.Base + (#(ident.fancy_selc)%expr @ (x, x0, x1))%expr_pat + end + | @expr.LetIn _ _ _ _ _ _ _ => + match x2 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 + return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args0 =? 1 + then + UnderLets.Base + (#(ident.fancy_sell)%expr @ + (x' v, x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.fancy_selc)%expr @ + (x, x0, x1))%expr_pat + | None => + UnderLets.Base + (#(ident.Z_zselect)%expr @ x @ x0 @ + x1)%expr_pat + end) + | (s1 -> d1)%ptype => + fun + _ : Compile.value' false s1 -> + Compile.value' true d1 => + UnderLets.Base + (#(ident.Z_zselect)%expr @ x @ x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.Base + (#(ident.fancy_selc)%expr @ (x, x0, x1))%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_selc)%expr @ (x, x0, x1))%expr_pat + end + | _ => + match x2 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 + return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + base.try_make_transport_cps + (fun t1 : base.type => + defaults.expr (type.base t1)) t2 + base.type.Z + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.Z))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr + (type.base base.type.Z)) => + match a with + | Some x' => + if args0 =? 1 + then + UnderLets.Base + (#(ident.fancy_sell)%expr @ + (x' v, x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.fancy_selc)%expr @ + (x, x0, x1))%expr_pat + | None => + UnderLets.Base + (#(ident.Z_zselect)%expr @ x @ x0 @ + x1)%expr_pat + end) + | (s2 -> d2)%ptype => + fun + _ : Compile.value' false s2 -> + Compile.value' true d2 => + UnderLets.Base + (#(ident.Z_zselect)%expr @ x @ x0 @ x1)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.Base + (#(ident.fancy_selc)%expr @ (x, x0, x1))%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_selc)%expr @ (x, x0, x1))%expr_pat + end + end | None => UnderLets.Base (#(ident.fancy_selc)%expr @ (x, x0, x1))%expr_pat end end - | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ (_ @ _)%expr_pat _ | - @expr.App _ _ _ s _ (@expr.LetIn _ _ _ _ _ _ _) _ => + | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ ($_)%expr _) _ | @expr.App _ + _ _ s _ (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _) _ | @expr.App + _ _ _ s _ (@expr.App _ _ _ s0 _ (_ @ _)%expr_pat _) _ | @expr.App _ _ _ + s _ (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _) _ => + UnderLets.Base (#(ident.fancy_selc)%expr @ (x, x0, x1))%expr_pat + | @expr.App _ _ _ s _ #(_)%expr_pat _ | @expr.App _ _ _ s _ ($_)%expr _ | + @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ + (@expr.LetIn _ _ _ _ _ _ _) _ => UnderLets.Base (#(ident.fancy_selc)%expr @ (x, x0, x1))%expr_pat | _ => UnderLets.Base (#(ident.fancy_selc)%expr @ (x, x0, x1))%expr_pat end | ident.Z_add_modulo => - fun x x0 x1 : expr (type.base base.type.Z) => + fun x x0 x1 : defaults.expr (type.base base.type.Z) => UnderLets.Base (#(ident.fancy_addm)%expr @ (x, x0, x1))%expr_pat | ident.Z_rshi => - fun x x0 x1 x2 : expr (type.base base.type.Z) => - UnderLets.Base (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat -| ident.Z_rshi_concrete s offset => - fun x x0 : expr (type.base base.type.Z) => - if s =? 2 ^ Z.log2 s - then - UnderLets.Base - (#(ident.fancy_rshi (Z.log2 s) offset)%expr @ (x, x0))%expr_pat - else - UnderLets.Base - (#(ident.Z_rshi_concrete s offset)%expr @ x @ x0)%expr_pat + fun x x0 x1 x2 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x2 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + if args =? 2 ^ Z.log2 args + then + UnderLets.Base + (#(ident.fancy_rshi (Z.log2 args) args0)%expr @ + (x0, x1))%expr_pat + else + UnderLets.Base + (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat + | None => + UnderLets.Base + (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat + end + | None => + UnderLets.Base (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat + end + | _ => UnderLets.Base (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat + end | ident.Z_cc_m => - fun x x0 : expr (type.base base.type.Z) => + fun x x0 : defaults.expr (type.base base.type.Z) => UnderLets.Base (#(ident.Z_cc_m)%expr @ x @ x0)%expr_pat -| ident.Z_cc_m_concrete s => - fun x : expr (type.base base.type.Z) => - UnderLets.Base (#(ident.Z_cc_m_concrete s)%expr @ x)%expr_pat -| ident.Z_neg_snd => - fun x : expr (type.base (base.type.Z * base.type.Z)%etype) => - UnderLets.Base (#(ident.Z_neg_snd)%expr @ x)%expr_pat | ident.Z_cast range => - fun x : expr (type.base base.type.Z) => + fun x : defaults.expr (type.base base.type.Z) => UnderLets.Base (#(ident.Z_cast range)%expr @ x)%expr_pat | ident.Z_cast2 range => - fun x : expr (type.base (base.type.Z * base.type.Z)%etype) => + fun x : defaults.expr (type.base (base.type.Z * base.type.Z)%etype) => UnderLets.Base (#(ident.Z_cast2 range)%expr @ x)%expr_pat | ident.fancy_add log2wordmax imm => - fun x : expr (type.base (base.type.Z * base.type.Z)%etype) => + fun x : defaults.expr (type.base (base.type.Z * base.type.Z)%etype) => UnderLets.Base (#(ident.fancy_add log2wordmax imm)%expr @ x)%expr_pat | ident.fancy_addc log2wordmax imm => - fun x : expr (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) - => UnderLets.Base (#(ident.fancy_addc log2wordmax imm)%expr @ x)%expr_pat + fun + x : defaults.expr + (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) => + UnderLets.Base (#(ident.fancy_addc log2wordmax imm)%expr @ x)%expr_pat | ident.fancy_sub log2wordmax imm => - fun x : expr (type.base (base.type.Z * base.type.Z)%etype) => + fun x : defaults.expr (type.base (base.type.Z * base.type.Z)%etype) => UnderLets.Base (#(ident.fancy_sub log2wordmax imm)%expr @ x)%expr_pat | ident.fancy_subb log2wordmax imm => - fun x : expr (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) - => UnderLets.Base (#(ident.fancy_subb log2wordmax imm)%expr @ x)%expr_pat + fun + x : defaults.expr + (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) => + UnderLets.Base (#(ident.fancy_subb log2wordmax imm)%expr @ x)%expr_pat | ident.fancy_mulll log2wordmax => - fun x : expr (type.base (base.type.Z * base.type.Z)%etype) => + fun x : defaults.expr (type.base (base.type.Z * base.type.Z)%etype) => UnderLets.Base (#(ident.fancy_mulll log2wordmax)%expr @ x)%expr_pat | ident.fancy_mullh log2wordmax => - fun x : expr (type.base (base.type.Z * base.type.Z)%etype) => + fun x : defaults.expr (type.base (base.type.Z * base.type.Z)%etype) => UnderLets.Base (#(ident.fancy_mullh log2wordmax)%expr @ x)%expr_pat | ident.fancy_mulhl log2wordmax => - fun x : expr (type.base (base.type.Z * base.type.Z)%etype) => + fun x : defaults.expr (type.base (base.type.Z * base.type.Z)%etype) => UnderLets.Base (#(ident.fancy_mulhl log2wordmax)%expr @ x)%expr_pat | ident.fancy_mulhh log2wordmax => - fun x : expr (type.base (base.type.Z * base.type.Z)%etype) => + fun x : defaults.expr (type.base (base.type.Z * base.type.Z)%etype) => UnderLets.Base (#(ident.fancy_mulhh log2wordmax)%expr @ x)%expr_pat | ident.fancy_rshi log2wordmax x => - fun x0 : expr (type.base (base.type.Z * base.type.Z)%etype) => + fun x0 : defaults.expr (type.base (base.type.Z * base.type.Z)%etype) => UnderLets.Base (#(ident.fancy_rshi log2wordmax x)%expr @ x0)%expr_pat | ident.fancy_selc => - fun x : expr (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) - => UnderLets.Base (#(ident.fancy_selc)%expr @ x)%expr_pat + fun + x : defaults.expr + (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) => + UnderLets.Base (#(ident.fancy_selc)%expr @ x)%expr_pat | ident.fancy_selm log2wordmax => - fun x : expr (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) - => UnderLets.Base (#(ident.fancy_selm log2wordmax)%expr @ x)%expr_pat + fun + x : defaults.expr + (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) => + UnderLets.Base (#(ident.fancy_selm log2wordmax)%expr @ x)%expr_pat | ident.fancy_sell => - fun x : expr (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) - => UnderLets.Base (#(ident.fancy_sell)%expr @ x)%expr_pat + fun + x : defaults.expr + (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) => + UnderLets.Base (#(ident.fancy_sell)%expr @ x)%expr_pat | ident.fancy_addm => - fun x : expr (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) - => UnderLets.Base (#(ident.fancy_addm)%expr @ x)%expr_pat + fun + x : defaults.expr + (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) => + UnderLets.Base (#(ident.fancy_addm)%expr @ x)%expr_pat end : Compile.value' true t diff --git a/src/Experiments/NewPipeline/nbe_rewrite_head.out b/src/Experiments/NewPipeline/nbe_rewrite_head.out new file mode 100644 index 000000000..82d4983bd --- /dev/null +++ b/src/Experiments/NewPipeline/nbe_rewrite_head.out @@ -0,0 +1,5123 @@ +nbe_rewrite_head = +match idc in (ident t) return (Compile.value' true t) with +| @ident.Literal t v => + match + t as t0 + return + (base.base_interp t0 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base t0))) + with + | base.type.unit => fun v0 : unit => UnderLets.Base ##(v0)%expr + | base.type.Z => fun v0 : Z => UnderLets.Base ##(v0)%expr + | base.type.bool => fun v0 : bool => UnderLets.Base ##(v0)%expr + | base.type.nat => fun v0 : nat => UnderLets.Base ##(v0)%expr + end v +| ident.Nat_succ => + fun x : defaults.expr (type.base base.type.nat) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option nat) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun _ : Z => None + | base.type.bool => fun _ : bool => None + | base.type.nat => fun v0 : nat => Some v0 + end v + | _ => None + end + with + | Some args => UnderLets.Base ##(Nat.succ args)%expr + | None => UnderLets.Base (#(ident.Nat_succ)%expr @ x)%expr_pat + end + | _ => UnderLets.Base (#(ident.Nat_succ)%expr @ x)%expr_pat + end +| ident.Nat_pred => + fun x : defaults.expr (type.base base.type.nat) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option nat) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun _ : Z => None + | base.type.bool => fun _ : bool => None + | base.type.nat => fun v0 : nat => Some v0 + end v + | _ => None + end + with + | Some args => UnderLets.Base ##(Nat.pred args)%expr + | None => UnderLets.Base (#(ident.Nat_pred)%expr @ x)%expr_pat + end + | _ => UnderLets.Base (#(ident.Nat_pred)%expr @ x)%expr_pat + end +| ident.Nat_max => + fun x x0 : defaults.expr (type.base base.type.nat) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option nat) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun _ : Z => None + | base.type.bool => fun _ : bool => None + | base.type.nat => fun v0 : nat => Some v0 + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option nat) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun _ : Z => None + | base.type.bool => fun _ : bool => None + | base.type.nat => fun v0 : nat => Some v0 + end v + | _ => None + end + with + | Some args0 => UnderLets.Base ##(Nat.max args args0)%expr + | None => + UnderLets.Base (#(ident.Nat_max)%expr @ x @ x0)%expr_pat + end + | _ => UnderLets.Base (#(ident.Nat_max)%expr @ x @ x0)%expr_pat + end + | None => UnderLets.Base (#(ident.Nat_max)%expr @ x @ x0)%expr_pat + end + | _ => UnderLets.Base (#(ident.Nat_max)%expr @ x @ x0)%expr_pat + end +| ident.Nat_mul => + fun x x0 : defaults.expr (type.base base.type.nat) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option nat) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun _ : Z => None + | base.type.bool => fun _ : bool => None + | base.type.nat => fun v0 : nat => Some v0 + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option nat) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun _ : Z => None + | base.type.bool => fun _ : bool => None + | base.type.nat => fun v0 : nat => Some v0 + end v + | _ => None + end + with + | Some args0 => UnderLets.Base ##((args * args0)%nat)%expr + | None => + UnderLets.Base (#(ident.Nat_mul)%expr @ x @ x0)%expr_pat + end + | _ => UnderLets.Base (#(ident.Nat_mul)%expr @ x @ x0)%expr_pat + end + | None => UnderLets.Base (#(ident.Nat_mul)%expr @ x @ x0)%expr_pat + end + | _ => UnderLets.Base (#(ident.Nat_mul)%expr @ x @ x0)%expr_pat + end +| ident.Nat_add => + fun x x0 : defaults.expr (type.base base.type.nat) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option nat) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun _ : Z => None + | base.type.bool => fun _ : bool => None + | base.type.nat => fun v0 : nat => Some v0 + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option nat) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun _ : Z => None + | base.type.bool => fun _ : bool => None + | base.type.nat => fun v0 : nat => Some v0 + end v + | _ => None + end + with + | Some args0 => UnderLets.Base ##((args + args0)%nat)%expr + | None => + UnderLets.Base (#(ident.Nat_add)%expr @ x @ x0)%expr_pat + end + | _ => UnderLets.Base (#(ident.Nat_add)%expr @ x @ x0)%expr_pat + end + | None => UnderLets.Base (#(ident.Nat_add)%expr @ x @ x0)%expr_pat + end + | _ => UnderLets.Base (#(ident.Nat_add)%expr @ x @ x0)%expr_pat + end +| ident.Nat_sub => + fun x x0 : defaults.expr (type.base base.type.nat) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option nat) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun _ : Z => None + | base.type.bool => fun _ : bool => None + | base.type.nat => fun v0 : nat => Some v0 + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option nat) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun _ : Z => None + | base.type.bool => fun _ : bool => None + | base.type.nat => fun v0 : nat => Some v0 + end v + | _ => None + end + with + | Some args0 => UnderLets.Base ##((args - args0)%nat)%expr + | None => + UnderLets.Base (#(ident.Nat_sub)%expr @ x @ x0)%expr_pat + end + | _ => UnderLets.Base (#(ident.Nat_sub)%expr @ x @ x0)%expr_pat + end + | None => UnderLets.Base (#(ident.Nat_sub)%expr @ x @ x0)%expr_pat + end + | _ => UnderLets.Base (#(ident.Nat_sub)%expr @ x @ x0)%expr_pat + end +| @ident.nil t => UnderLets.Base []%expr_pat +| @ident.cons t => + fun (x : defaults.expr (type.base t)) + (x0 : defaults.expr (type.base (base.type.list t))) => + UnderLets.Base (x :: x0)%expr_pat +| @ident.pair A B => + fun (x : defaults.expr (type.base A)) (x0 : defaults.expr (type.base B)) + => UnderLets.Base (x, x0)%expr_pat +| @ident.fst A B => + fun x : defaults.expr (type.base (A * B)%etype) => + match x with + | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ #(idc)%expr_pat x1) x0 => + match + match idc with + | @ident.pair A0 B0 => Some (A0, B0) + | _ => None + end + with + | Some _ => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base A))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base A))) + with + | type.base t3 => + fun _ : defaults.expr (type.base t3) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) t2 + A + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base A))) + (fun + a : option + (defaults.expr (type.base t2) -> + defaults.expr (type.base A)) => + match a with + | Some x' => UnderLets.Base (x' v) + | None => + UnderLets.Base (#(ident.fst)%expr @ x)%expr_pat + end) + | (s1 -> d1)%ptype => + fun _ : Compile.value' false s1 -> Compile.value' true d1 + => UnderLets.Base (#(ident.fst)%expr @ x)%expr_pat + end (Compile.reflect x0) + | (s1 -> d1)%ptype => + fun _ : Compile.value' false s1 -> Compile.value' true d1 => + UnderLets.Base (#(ident.fst)%expr @ x)%expr_pat + end (Compile.reflect x1) + | None => UnderLets.Base (#(ident.fst)%expr @ x)%expr_pat + end + | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ ($_)%expr _) _ | @expr.App _ + _ _ s _ (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _) _ | @expr.App + _ _ _ s _ (@expr.App _ _ _ s0 _ (_ @ _)%expr_pat _) _ | @expr.App _ _ _ + s _ (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _) _ => + UnderLets.Base (#(ident.fst)%expr @ x)%expr_pat + | @expr.App _ _ _ s _ #(_)%expr_pat _ | @expr.App _ _ _ s _ ($_)%expr _ | + @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.Base (#(ident.fst)%expr @ x)%expr_pat + | _ => UnderLets.Base (#(ident.fst)%expr @ x)%expr_pat + end +| @ident.snd A B => + fun x : defaults.expr (type.base (A * B)%etype) => + match x with + | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ #(idc)%expr_pat x1) x0 => + match + match idc with + | @ident.pair A0 B0 => Some (A0, B0) + | _ => None + end + with + | Some _ => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base B))) + with + | type.base t2 => + fun _ : defaults.expr (type.base t2) => + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base B))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) => + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) t3 + B + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base B))) + (fun + a : option + (defaults.expr (type.base t3) -> + defaults.expr (type.base B)) => + match a with + | Some x' => UnderLets.Base (x' v0) + | None => + UnderLets.Base (#(ident.snd)%expr @ x)%expr_pat + end) + | (s1 -> d1)%ptype => + fun _ : Compile.value' false s1 -> Compile.value' true d1 + => UnderLets.Base (#(ident.snd)%expr @ x)%expr_pat + end (Compile.reflect x0) + | (s1 -> d1)%ptype => + fun _ : Compile.value' false s1 -> Compile.value' true d1 => + UnderLets.Base (#(ident.snd)%expr @ x)%expr_pat + end (Compile.reflect x1) + | None => UnderLets.Base (#(ident.snd)%expr @ x)%expr_pat + end + | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ ($_)%expr _) _ | @expr.App _ + _ _ s _ (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _) _ | @expr.App + _ _ _ s _ (@expr.App _ _ _ s0 _ (_ @ _)%expr_pat _) _ | @expr.App _ _ _ + s _ (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _) _ => + UnderLets.Base (#(ident.snd)%expr @ x)%expr_pat + | @expr.App _ _ _ s _ #(_)%expr_pat _ | @expr.App _ _ _ s _ ($_)%expr _ | + @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ + (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.Base (#(ident.snd)%expr @ x)%expr_pat + | _ => UnderLets.Base (#(ident.snd)%expr @ x)%expr_pat + end +| @ident.prod_rect A B T => + fun + (x : defaults.expr (type.base A) -> + defaults.expr (type.base B) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base T))) + (x0 : defaults.expr (type.base (A * B)%etype)) => + match x0 with + | @expr.App _ _ _ s _ #(_)%expr_pat _ | @expr.App _ _ _ s _ ($_)%expr _ | + @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ => + UnderLets.Base + (#(ident.prod_rect)%expr @ + (λ (x2 : var (type.base A))(x3 : var (type.base B)), + UnderLets.to_expr (x ($x2) ($x3)))%expr @ x0)%expr_pat + | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ #(idc)%expr_pat x2) x1 => + match + match idc with + | @ident.pair A0 B0 => Some (A0, B0) + | _ => None + end + with + | Some _ => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base T))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base T))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) => + Compile.castbe v + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base T))) + (fun x3 : option (defaults.expr (type.base A)) => + match x3 with + | Some x4 => + Compile.castbe v0 + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base T))) + (fun y : option (defaults.expr (type.base B)) => + match y with + | Some y0 => + (fv <-- (e <-- x x4 y0; + UnderLets.Base + {| + anyexpr_ty := T; + unwrap := e |}); + base.try_make_transport_cps + (fun t0 : base.type => + defaults.expr (type.base t0)) + (let (anyexpr_ty, _) := fv in anyexpr_ty) + T + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base T))) + (fun + a : option + (defaults.expr + (type.base + (let (anyexpr_ty, _) := + fv in + anyexpr_ty)) -> + defaults.expr (type.base T)) + => + match a with + | Some x' => + UnderLets.Base + (x' + (let + (anyexpr_ty, unwrap) as a0 + return + (defaults.expr + (type.base + (let + (anyexpr_ty, + _) := a0 in + anyexpr_ty))) := + fv in + unwrap)) + | None => + UnderLets.Base + (#(ident.prod_rect)%expr @ + (λ (x5 : var (type.base A)) + (x6 : var (type.base B)), + UnderLets.to_expr + (x ($x5) ($x6)))%expr @ x0)%expr_pat + end))%under_lets + | None => + UnderLets.Base + (#(ident.prod_rect)%expr @ + (λ (x5 : var (type.base A))(x6 : + var + (type.base + B)), + UnderLets.to_expr (x ($x5) ($x6)))%expr @ + x0)%expr_pat + end) + | None => + UnderLets.Base + (#(ident.prod_rect)%expr @ + (λ (x4 : var (type.base A))(x5 : var + (type.base B)), + UnderLets.to_expr (x ($x4) ($x5)))%expr @ x0)%expr_pat + end) + | (s1 -> d1)%ptype => + fun _ : Compile.value' false s1 -> Compile.value' true d1 + => + UnderLets.Base + (#(ident.prod_rect)%expr @ + (λ (x3 : var (type.base A))(x4 : var (type.base B)), + UnderLets.to_expr (x ($x3) ($x4)))%expr @ x0)%expr_pat + end (Compile.reflect x1) + | (s1 -> d1)%ptype => + fun _ : Compile.value' false s1 -> Compile.value' true d1 => + UnderLets.Base + (#(ident.prod_rect)%expr @ + (λ (x3 : var (type.base A))(x4 : var (type.base B)), + UnderLets.to_expr (x ($x3) ($x4)))%expr @ x0)%expr_pat + end (Compile.reflect x2) + | None => + UnderLets.Base + (#(ident.prod_rect)%expr @ + (λ (x3 : var (type.base A))(x4 : var (type.base B)), + UnderLets.to_expr (x ($x3) ($x4)))%expr @ x0)%expr_pat + end + | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ ($_)%expr _) _ | @expr.App _ + _ _ s _ (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _) _ => + UnderLets.Base + (#(ident.prod_rect)%expr @ + (λ (x3 : var (type.base A))(x4 : var (type.base B)), + UnderLets.to_expr (x ($x3) ($x4)))%expr @ x0)%expr_pat + | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ (_ @ _)%expr_pat _) _ | + @expr.App _ _ _ s _ + (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _) _ => + UnderLets.Base + (#(ident.prod_rect)%expr @ + (λ (x4 : var (type.base A))(x5 : var (type.base B)), + UnderLets.to_expr (x ($x4) ($x5)))%expr @ x0)%expr_pat + | @expr.App _ _ _ s _ (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.Base + (#(ident.prod_rect)%expr @ + (λ (x3 : var (type.base A))(x4 : var (type.base B)), + UnderLets.to_expr (x ($x3) ($x4)))%expr @ x0)%expr_pat + | @expr.LetIn _ _ _ _ _ _ _ => + UnderLets.Base + (#(ident.prod_rect)%expr @ + (λ (x2 : var (type.base A))(x3 : var (type.base B)), + UnderLets.to_expr (x ($x2) ($x3)))%expr @ x0)%expr_pat + | _ => + UnderLets.Base + (#(ident.prod_rect)%expr @ + (λ (x1 : var (type.base A))(x2 : var (type.base B)), + UnderLets.to_expr (x ($x1) ($x2)))%expr @ x0)%expr_pat + end +| @ident.bool_rect T => + fun + (x + x0 : defaults.expr (type.base base.type.unit) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base T))) + (x1 : defaults.expr (type.base base.type.bool)) => + match x1 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option bool) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun _ : Z => None + | base.type.bool => fun v0 : bool => Some v0 + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + (fv <-- (e <-- (if args as b + return + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (if b then T else T)))) + then x ##(tt)%expr + else x0 ##(tt)%expr); + UnderLets.Base + {| anyexpr_ty := if args then T else T; unwrap := e |}); + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) + (let (anyexpr_ty, _) := fv in anyexpr_ty) T + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base T))) + (fun + a : option + (defaults.expr + (type.base + (let (anyexpr_ty, _) := fv in anyexpr_ty)) -> + defaults.expr (type.base T)) => + match a with + | Some x' => + UnderLets.Base + (x' + (let + (anyexpr_ty, unwrap) as a0 + return + (defaults.expr + (type.base + (let (anyexpr_ty, _) := a0 in anyexpr_ty))) := + fv in + unwrap)) + | None => + UnderLets.Base + (#(ident.bool_rect)%expr @ + (λ x2 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x2)))%expr @ + (λ x2 : var (type.base base.type.unit), + UnderLets.to_expr (x0 ($x2)))%expr @ x1)%expr_pat + end))%under_lets + | None => + UnderLets.Base + (#(ident.bool_rect)%expr @ + (λ x2 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x2)))%expr @ + (λ x2 : var (type.base base.type.unit), + UnderLets.to_expr (x0 ($x2)))%expr @ x1)%expr_pat + end + | ($_)%expr | @expr.Abs _ _ _ _ _ _ => + UnderLets.Base + (#(ident.bool_rect)%expr @ + (λ x2 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x2)))%expr @ + (λ x2 : var (type.base base.type.unit), + UnderLets.to_expr (x0 ($x2)))%expr @ x1)%expr_pat + | _ => + UnderLets.Base + (#(ident.bool_rect)%expr @ + (λ x3 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x3)))%expr @ + (λ x3 : var (type.base base.type.unit), + UnderLets.to_expr (x0 ($x3)))%expr @ x1)%expr_pat + end +| @ident.nat_rect P => + fun + (x : defaults.expr (type.base base.type.unit) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (x0 : defaults.expr (type.base base.type.nat) -> + defaults.expr (type.base P) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (x1 : defaults.expr (type.base base.type.nat)) => + match x1 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option nat) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun _ : Z => None + | base.type.bool => fun _ : bool => None + | base.type.nat => fun v0 : nat => Some v0 + end v + | _ => None + end + with + | Some args => + Compile.castv x0 + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (fun + S_case : option + (defaults.expr (type.base base.type.nat) -> + defaults.expr (type.base P) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) => + match S_case with + | Some S_case0 => + (fv <-- (e <-- nat_rect + (fun _ : nat => + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (x ##(tt)%expr) + (fun (n' : nat) + (rec : UnderLets.UnderLets base.type + ident var + (defaults.expr (type.base P))) + => rec0 <-- rec; + S_case0 ##(n')%expr rec0) args; + UnderLets.Base {| anyexpr_ty := P; unwrap := e |}); + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) + (let (anyexpr_ty, _) := fv in anyexpr_ty) P + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (fun + a : option + (defaults.expr + (type.base + (let (anyexpr_ty, _) := fv in anyexpr_ty)) -> + defaults.expr (type.base P)) => + match a with + | Some x' => + UnderLets.Base + (x' + (let + (anyexpr_ty, unwrap) as a0 + return + (defaults.expr + (type.base + (let (anyexpr_ty, _) := a0 in + anyexpr_ty))) := fv in + unwrap)) + | None => + UnderLets.Base + (#(ident.nat_rect)%expr @ + (λ x2 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x2)))%expr @ + (λ (x2 : var (type.base base.type.nat)) + (x3 : var (type.base P)), + UnderLets.to_expr (x0 ($x2) ($x3)))%expr @ x1)%expr_pat + end))%under_lets + | None => + UnderLets.Base + (#(ident.nat_rect)%expr @ + (λ x2 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x2)))%expr @ + (λ (x2 : var (type.base base.type.nat))(x3 : var + (type.base + P)), + UnderLets.to_expr (x0 ($x2) ($x3)))%expr @ x1)%expr_pat + end) + | None => + UnderLets.Base + (#(ident.nat_rect)%expr @ + (λ x2 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x2)))%expr @ + (λ (x2 : var (type.base base.type.nat))(x3 : var (type.base P)), + UnderLets.to_expr (x0 ($x2) ($x3)))%expr @ x1)%expr_pat + end + | ($_)%expr | @expr.Abs _ _ _ _ _ _ => + UnderLets.Base + (#(ident.nat_rect)%expr @ + (λ x2 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x2)))%expr @ + (λ (x2 : var (type.base base.type.nat))(x3 : var (type.base P)), + UnderLets.to_expr (x0 ($x2) ($x3)))%expr @ x1)%expr_pat + | _ => + UnderLets.Base + (#(ident.nat_rect)%expr @ + (λ x3 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x3)))%expr @ + (λ (x3 : var (type.base base.type.nat))(x4 : var (type.base P)), + UnderLets.to_expr (x0 ($x3) ($x4)))%expr @ x1)%expr_pat + end +| @ident.nat_rect_arrow P Q => + fun + (x : defaults.expr (type.base P) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base Q))) + (x0 : defaults.expr (type.base base.type.nat) -> + (defaults.expr (type.base P) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base Q))) -> + defaults.expr (type.base P) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base Q))) + (x1 : defaults.expr (type.base base.type.nat)) + (x2 : defaults.expr (type.base P)) => + match x1 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option nat) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun _ : Z => None + | base.type.bool => fun _ : bool => None + | base.type.nat => fun v0 : nat => Some v0 + end v + | _ => None + end + with + | Some args => + Compile.castv x0 + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base Q))) + (fun + S_case : option + (defaults.expr (type.base base.type.nat) -> + (defaults.expr (type.base P) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base Q))) -> + defaults.expr (type.base P) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base Q))) => + match S_case with + | Some S_case0 => + Compile.castbe x2 + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base Q))) + (fun v : option (defaults.expr (type.base P)) => + match v with + | Some v0 => + (fv <-- (e <-- nat_rect + (fun _ : nat => + defaults.expr (type.base P) -> + UnderLets.UnderLets base.type + ident var + (defaults.expr (type.base Q))) + x + (fun (n' : nat) + (rec : defaults.expr + (type.base P) -> + UnderLets.UnderLets + base.type ident var + (defaults.expr + (type.base Q))) + (v1 : defaults.expr + (type.base P)) => + S_case0 ##(n')%expr rec v1) args + v0; + UnderLets.Base + {| anyexpr_ty := Q; unwrap := e |}); + base.try_make_transport_cps + (fun t0 : base.type => + defaults.expr (type.base t0)) + (let (anyexpr_ty, _) := fv in anyexpr_ty) Q + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base Q))) + (fun + a : option + (defaults.expr + (type.base + (let (anyexpr_ty, _) := fv in + anyexpr_ty)) -> + defaults.expr (type.base Q)) => + match a with + | Some x' => + UnderLets.Base + (x' + (let + (anyexpr_ty, unwrap) as a0 + return + (defaults.expr + (type.base + (let (anyexpr_ty, _) := + a0 in + anyexpr_ty))) := fv in + unwrap)) + | None => + UnderLets.Base + (#(ident.nat_rect_arrow)%expr @ + (λ x3 : var (type.base P), + UnderLets.to_expr (x ($x3)))%expr @ + (λ (x3 : var (type.base base.type.nat)) + (x4 : var + (type.base P -> type.base Q)%ptype) + (x5 : var (type.base P)), + UnderLets.to_expr + (x0 ($x3) + (fun + x6 : defaults.expr + (type.base P) => + UnderLets.Base + ($x4 @ x6)%expr_pat) ($x5)))%expr @ + x1 @ x2)%expr_pat + end))%under_lets + | None => + UnderLets.Base + (#(ident.nat_rect_arrow)%expr @ + (λ x3 : var (type.base P), + UnderLets.to_expr (x ($x3)))%expr @ + (λ (x3 : var (type.base base.type.nat))(x4 : + var + (type.base + P -> + type.base + Q)%ptype) + (x5 : var (type.base P)), + UnderLets.to_expr + (x0 ($x3) + (fun x6 : defaults.expr (type.base P) => + UnderLets.Base ($x4 @ x6)%expr_pat) + ($x5)))%expr @ x1 @ x2)%expr_pat + end) + | None => + UnderLets.Base + (#(ident.nat_rect_arrow)%expr @ + (λ x3 : var (type.base P), + UnderLets.to_expr (x ($x3)))%expr @ + (λ (x3 : var (type.base base.type.nat))(x4 : var + (type.base + P -> + type.base + Q)%ptype) + (x5 : var (type.base P)), + UnderLets.to_expr + (x0 ($x3) + (fun x6 : defaults.expr (type.base P) => + UnderLets.Base ($x4 @ x6)%expr_pat) ($x5)))%expr @ + x1 @ x2)%expr_pat + end) + | None => + UnderLets.Base + (#(ident.nat_rect_arrow)%expr @ + (λ x3 : var (type.base P), + UnderLets.to_expr (x ($x3)))%expr @ + (λ (x3 : var (type.base base.type.nat))(x4 : var + (type.base P -> + type.base Q)%ptype) + (x5 : var (type.base P)), + UnderLets.to_expr + (x0 ($x3) + (fun x6 : defaults.expr (type.base P) => + UnderLets.Base ($x4 @ x6)%expr_pat) ($x5)))%expr @ x1 @ + x2)%expr_pat + end + | ($_)%expr | @expr.Abs _ _ _ _ _ _ => + UnderLets.Base + (#(ident.nat_rect_arrow)%expr @ + (λ x3 : var (type.base P), + UnderLets.to_expr (x ($x3)))%expr @ + (λ (x3 : var (type.base base.type.nat))(x4 : var + (type.base P -> + type.base Q)%ptype) + (x5 : var (type.base P)), + UnderLets.to_expr + (x0 ($x3) + (fun x6 : defaults.expr (type.base P) => + UnderLets.Base ($x4 @ x6)%expr_pat) ($x5)))%expr @ x1 @ x2)%expr_pat + | _ => + UnderLets.Base + (#(ident.nat_rect_arrow)%expr @ + (λ x4 : var (type.base P), + UnderLets.to_expr (x ($x4)))%expr @ + (λ (x4 : var (type.base base.type.nat))(x5 : var + (type.base P -> + type.base Q)%ptype) + (x6 : var (type.base P)), + UnderLets.to_expr + (x0 ($x4) + (fun x7 : defaults.expr (type.base P) => + UnderLets.Base ($x5 @ x7)%expr_pat) ($x6)))%expr @ x1 @ x2)%expr_pat + end +| @ident.list_rect A P => + fun + (x : defaults.expr (type.base base.type.unit) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (x0 : defaults.expr (type.base A) -> + defaults.expr (type.base (base.type.list A)) -> + defaults.expr (type.base P) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (x1 : defaults.expr (type.base (base.type.list A))) => + Compile.castv x0 + (UnderLets.UnderLets base.type ident var (defaults.expr (type.base P))) + (fun + Pcons : option + (defaults.expr (type.base A) -> + defaults.expr (type.base (base.type.list A)) -> + defaults.expr (type.base P) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) => + match Pcons with + | Some Pcons0 => + reflect_list_cps x1 + (fun ls : option (list (defaults.expr (type.base A))) => + match ls with + | Some ls0 => + (fv <-- (e <-- list_rect + (fun + _ : list (defaults.expr (type.base A)) + => + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (x ##(tt)%expr) + (fun (x2 : defaults.expr (type.base A)) + (xs : list + (defaults.expr (type.base A))) + (rec : UnderLets.UnderLets base.type + ident var + (defaults.expr (type.base P))) + => + rec' <-- rec; + Pcons0 x2 (reify_list xs) rec') ls0; + UnderLets.Base {| anyexpr_ty := P; unwrap := e |}); + base.try_make_transport_cps + (fun t : base.type => defaults.expr (type.base t)) + (let (anyexpr_ty, _) := fv in anyexpr_ty) P + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (fun + a : option + (defaults.expr + (type.base + (let (anyexpr_ty, _) := fv in anyexpr_ty)) -> + defaults.expr (type.base P)) => + match a with + | Some x' => + UnderLets.Base + (x' + (let + (anyexpr_ty, unwrap) as a0 + return + (defaults.expr + (type.base + (let (anyexpr_ty, _) := a0 in + anyexpr_ty))) := fv in + unwrap)) + | None => + UnderLets.Base + (#(ident.list_rect)%expr @ + (λ x2 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x2)))%expr @ + (λ (x2 : var (type.base A))(x3 : var + (type.base + (base.type.list + A))) + (x4 : var (type.base P)), + UnderLets.to_expr (x0 ($x2) ($x3) ($x4)))%expr @ + x1)%expr_pat + end))%under_lets + | None => + UnderLets.Base + (#(ident.list_rect)%expr @ + (λ x2 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x2)))%expr @ + (λ (x2 : var (type.base A))(x3 : var + (type.base + (base.type.list A))) + (x4 : var (type.base P)), + UnderLets.to_expr (x0 ($x2) ($x3) ($x4)))%expr @ x1)%expr_pat + end) + | None => + UnderLets.Base + (#(ident.list_rect)%expr @ + (λ x2 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x2)))%expr @ + (λ (x2 : var (type.base A))(x3 : var + (type.base + (base.type.list A))) + (x4 : var (type.base P)), + UnderLets.to_expr (x0 ($x2) ($x3) ($x4)))%expr @ x1)%expr_pat + end) +| @ident.list_case A P => + fun + (x : defaults.expr (type.base base.type.unit) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (x0 : defaults.expr (type.base A) -> + defaults.expr (type.base (base.type.list A)) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (x1 : defaults.expr (type.base (base.type.list A))) => + match x1 with + | #(idc)%expr_pat => + match match idc with + | @ident.nil t0 => Some t0 + | _ => None + end with + | Some _ => + (fv <-- (e <-- x ##(tt)%expr; + UnderLets.Base {| anyexpr_ty := P; unwrap := e |}); + base.try_make_transport_cps + (fun t0 : base.type => defaults.expr (type.base t0)) + (let (anyexpr_ty, _) := fv in anyexpr_ty) P + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (fun + a : option + (defaults.expr + (type.base + (let (anyexpr_ty, _) := fv in anyexpr_ty)) -> + defaults.expr (type.base P)) => + match a with + | Some x' => + UnderLets.Base + (x' + (let + (anyexpr_ty, unwrap) as a0 + return + (defaults.expr + (type.base + (let (anyexpr_ty, _) := a0 in anyexpr_ty))) := + fv in + unwrap)) + | None => + UnderLets.Base + (#(ident.list_case)%expr @ + (λ x2 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x2)))%expr @ + (λ (x2 : var (type.base A))(x3 : var + (type.base + (base.type.list + A))), + UnderLets.to_expr (x0 ($x2) ($x3)))%expr @ x1)%expr_pat + end))%under_lets + | None => + UnderLets.Base + (#(ident.list_case)%expr @ + (λ x2 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x2)))%expr @ + (λ (x2 : var (type.base A))(x3 : var + (type.base + (base.type.list A))), + UnderLets.to_expr (x0 ($x2) ($x3)))%expr @ x1)%expr_pat + end + | @expr.App _ _ _ s _ #(_)%expr_pat _ | @expr.App _ _ _ s _ ($_)%expr _ | + @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ => + UnderLets.Base + (#(ident.list_case)%expr @ + (λ x3 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x3)))%expr @ + (λ (x3 : var (type.base A))(x4 : var + (type.base (base.type.list A))), + UnderLets.to_expr (x0 ($x3) ($x4)))%expr @ x1)%expr_pat + | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ #(idc)%expr_pat x3) x2 => + match match idc with + | @ident.cons t0 => Some t0 + | _ => None + end with + | Some _ => + match + s0 as t2 + return + (Compile.value' false t2 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + with + | type.base t2 => + fun v : defaults.expr (type.base t2) => + match + s as t3 + return + (Compile.value' false t3 -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + with + | type.base t3 => + fun v0 : defaults.expr (type.base t3) => + Compile.castbe v + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (fun x4 : option (defaults.expr (type.base A)) => + match x4 with + | Some x5 => + Compile.castbe v0 + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (fun + xs : option + (defaults.expr + (type.base (base.type.list A))) => + match xs with + | Some xs0 => + (fv <-- (e <-- x0 x5 xs0; + UnderLets.Base + {| + anyexpr_ty := P; + unwrap := e |}); + base.try_make_transport_cps + (fun t0 : base.type => + defaults.expr (type.base t0)) + (let (anyexpr_ty, _) := fv in anyexpr_ty) + P + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base P))) + (fun + a : option + (defaults.expr + (type.base + (let (anyexpr_ty, _) := + fv in + anyexpr_ty)) -> + defaults.expr (type.base P)) + => + match a with + | Some x' => + UnderLets.Base + (x' + (let + (anyexpr_ty, unwrap) as a0 + return + (defaults.expr + (type.base + (let + (anyexpr_ty, + _) := a0 in + anyexpr_ty))) := + fv in + unwrap)) + | None => + UnderLets.Base + (#(ident.list_case)%expr @ + (λ x6 : var + (type.base + base.type.unit), + UnderLets.to_expr (x ($x6)))%expr @ + (λ (x6 : var (type.base A)) + (x7 : var + (type.base + (base.type.list A))), + UnderLets.to_expr + (x0 ($x6) ($x7)))%expr @ x1)%expr_pat + end))%under_lets + | None => + UnderLets.Base + (#(ident.list_case)%expr @ + (λ x6 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x6)))%expr @ + (λ (x6 : var (type.base A))(x7 : + var + (type.base + (base.type.list + A))), + UnderLets.to_expr (x0 ($x6) ($x7)))%expr @ + x1)%expr_pat + end) + | None => + UnderLets.Base + (#(ident.list_case)%expr @ + (λ x5 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x5)))%expr @ + (λ (x5 : var (type.base A))(x6 : var + (type.base + (base.type.list + A))), + UnderLets.to_expr (x0 ($x5) ($x6)))%expr @ x1)%expr_pat + end) + | (s1 -> d1)%ptype => + fun _ : Compile.value' false s1 -> Compile.value' true d1 + => + UnderLets.Base + (#(ident.list_case)%expr @ + (λ x4 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x4)))%expr @ + (λ (x4 : var (type.base A))(x5 : var + (type.base + (base.type.list + A))), + UnderLets.to_expr (x0 ($x4) ($x5)))%expr @ x1)%expr_pat + end (Compile.reflect x2) + | (s1 -> d1)%ptype => + fun _ : Compile.value' false s1 -> Compile.value' true d1 => + UnderLets.Base + (#(ident.list_case)%expr @ + (λ x4 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x4)))%expr @ + (λ (x4 : var (type.base A))(x5 : var + (type.base + (base.type.list A))), + UnderLets.to_expr (x0 ($x4) ($x5)))%expr @ x1)%expr_pat + end (Compile.reflect x3) + | None => + UnderLets.Base + (#(ident.list_case)%expr @ + (λ x4 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x4)))%expr @ + (λ (x4 : var (type.base A))(x5 : var + (type.base + (base.type.list A))), + UnderLets.to_expr (x0 ($x4) ($x5)))%expr @ x1)%expr_pat + end + | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ ($_)%expr _) _ | @expr.App _ + _ _ s _ (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _) _ => + UnderLets.Base + (#(ident.list_case)%expr @ + (λ x4 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x4)))%expr @ + (λ (x4 : var (type.base A))(x5 : var + (type.base (base.type.list A))), + UnderLets.to_expr (x0 ($x4) ($x5)))%expr @ x1)%expr_pat + | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ (_ @ _)%expr_pat _) _ | + @expr.App _ _ _ s _ + (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _) _ => + UnderLets.Base + (#(ident.list_case)%expr @ + (λ x5 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x5)))%expr @ + (λ (x5 : var (type.base A))(x6 : var + (type.base (base.type.list A))), + UnderLets.to_expr (x0 ($x5) ($x6)))%expr @ x1)%expr_pat + | @expr.App _ _ _ s _ (@expr.LetIn _ _ _ _ _ _ _) _ => + UnderLets.Base + (#(ident.list_case)%expr @ + (λ x4 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x4)))%expr @ + (λ (x4 : var (type.base A))(x5 : var + (type.base (base.type.list A))), + UnderLets.to_expr (x0 ($x4) ($x5)))%expr @ x1)%expr_pat + | @expr.LetIn _ _ _ _ _ _ _ => + UnderLets.Base + (#(ident.list_case)%expr @ + (λ x3 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x3)))%expr @ + (λ (x3 : var (type.base A))(x4 : var + (type.base (base.type.list A))), + UnderLets.to_expr (x0 ($x3) ($x4)))%expr @ x1)%expr_pat + | _ => + UnderLets.Base + (#(ident.list_case)%expr @ + (λ x2 : var (type.base base.type.unit), + UnderLets.to_expr (x ($x2)))%expr @ + (λ (x2 : var (type.base A))(x3 : var + (type.base (base.type.list A))), + UnderLets.to_expr (x0 ($x2) ($x3)))%expr @ x1)%expr_pat + end +| @ident.List_length T => + fun x : defaults.expr (type.base (base.type.list T)) => + reflect_list_cps x + (fun xs : option (list (defaults.expr (type.base T))) => + match xs with + | Some xs0 => UnderLets.Base ##(length xs0)%expr + | None => UnderLets.Base (#(ident.List_length)%expr @ x)%expr_pat + end) +| ident.List_seq => + fun x x0 : defaults.expr (type.base base.type.nat) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option nat) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun _ : Z => None + | base.type.bool => fun _ : bool => None + | base.type.nat => fun v0 : nat => Some v0 + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option nat) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun _ : Z => None + | base.type.bool => fun _ : bool => None + | base.type.nat => fun v0 : nat => Some v0 + end v + | _ => None + end + with + | Some args0 => + UnderLets.Base + (fold_right + (fun (x1 : defaults.expr (type.base base.type.nat)) + (xs : defaults.expr + (type.base (base.type.list base.type.nat))) + => (x1 :: xs)%expr_pat) []%expr_pat + (map (fun v : nat => ##(v)%expr) (seq args args0))) + | None => + UnderLets.Base (#(ident.List_seq)%expr @ x @ x0)%expr_pat + end + | _ => UnderLets.Base (#(ident.List_seq)%expr @ x @ x0)%expr_pat + end + | None => UnderLets.Base (#(ident.List_seq)%expr @ x @ x0)%expr_pat + end + | _ => UnderLets.Base (#(ident.List_seq)%expr @ x @ x0)%expr_pat + end +| @ident.List_firstn A => + fun (x : defaults.expr (type.base base.type.nat)) + (x0 : defaults.expr (type.base (base.type.list A))) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option nat) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun _ : Z => None + | base.type.bool => fun _ : bool => None + | base.type.nat => fun v0 : nat => Some v0 + end v + | _ => None + end + with + | Some args => + reflect_list_cps x0 + (fun xs : option (list (defaults.expr (type.base A))) => + match xs with + | Some xs0 => + base.try_make_transport_cps + (fun A0 : base.type => + defaults.expr (type.base (base.type.list A0))) A A + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base (base.type.list A)))) + (fun + a : option + (defaults.expr (type.base (base.type.list A)) -> + defaults.expr (type.base (base.type.list A))) + => + match a with + | Some x' => + UnderLets.Base (x' (reify_list (firstn args xs0))) + | None => + UnderLets.Base + (#(ident.List_firstn)%expr @ x @ x0)%expr_pat + end) + | None => + UnderLets.Base + (#(ident.List_firstn)%expr @ x @ x0)%expr_pat + end) + | None => + UnderLets.Base (#(ident.List_firstn)%expr @ x @ x0)%expr_pat + end + | _ => UnderLets.Base (#(ident.List_firstn)%expr @ x @ x0)%expr_pat + end +| @ident.List_skipn A => + fun (x : defaults.expr (type.base base.type.nat)) + (x0 : defaults.expr (type.base (base.type.list A))) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option nat) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun _ : Z => None + | base.type.bool => fun _ : bool => None + | base.type.nat => fun v0 : nat => Some v0 + end v + | _ => None + end + with + | Some args => + reflect_list_cps x0 + (fun xs : option (list (defaults.expr (type.base A))) => + match xs with + | Some xs0 => + base.try_make_transport_cps + (fun A0 : base.type => + defaults.expr (type.base (base.type.list A0))) A A + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base (base.type.list A)))) + (fun + a : option + (defaults.expr (type.base (base.type.list A)) -> + defaults.expr (type.base (base.type.list A))) + => + match a with + | Some x' => + UnderLets.Base (x' (reify_list (skipn args xs0))) + | None => + UnderLets.Base + (#(ident.List_skipn)%expr @ x @ x0)%expr_pat + end) + | None => + UnderLets.Base + (#(ident.List_skipn)%expr @ x @ x0)%expr_pat + end) + | None => UnderLets.Base (#(ident.List_skipn)%expr @ x @ x0)%expr_pat + end + | _ => UnderLets.Base (#(ident.List_skipn)%expr @ x @ x0)%expr_pat + end +| @ident.List_repeat A => + fun (x : defaults.expr (type.base A)) + (x0 : defaults.expr (type.base base.type.nat)) => + match x0 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option nat) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun _ : Z => None + | base.type.bool => fun _ : bool => None + | base.type.nat => fun v0 : nat => Some v0 + end v + | _ => None + end + with + | Some args => + base.try_make_transport_cps + (fun A0 : base.type => + defaults.expr (type.base (base.type.list A0))) A A + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base (base.type.list A)))) + (fun + a : option + (defaults.expr (type.base (base.type.list A)) -> + defaults.expr (type.base (base.type.list A))) => + match a with + | Some x' => UnderLets.Base (x' (reify_list (repeat x args))) + | None => + UnderLets.Base + (#(ident.List_repeat)%expr @ x @ x0)%expr_pat + end) + | None => + UnderLets.Base (#(ident.List_repeat)%expr @ x @ x0)%expr_pat + end + | _ => UnderLets.Base (#(ident.List_repeat)%expr @ x @ x0)%expr_pat + end +| @ident.List_combine A B => + fun (x : defaults.expr (type.base (base.type.list A))) + (x0 : defaults.expr (type.base (base.type.list B))) => + reflect_list_cps x + (fun xs : option (list (defaults.expr (type.base A))) => + match xs with + | Some xs0 => + reflect_list_cps x0 + (fun ys : option (list (defaults.expr (type.base B))) => + match ys with + | Some ys0 => + (trA <-- base.try_make_transport_cps + (fun A0 : base.type => + defaults.expr + (type.base (base.type.list (A0 * B)))) A A; + trB <-- base.try_make_transport_cps + (fun B0 : base.type => + defaults.expr + (type.base (base.type.list (A * B0)))) B B; + return Some + (fun + v : defaults.expr + (type.base (base.type.list (A * B))) => + trB (trA v)))%cps + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base (base.type.list (A * B))))) + (fun + a : option + (defaults.expr + (type.base (base.type.list (A * B))) -> + defaults.expr + (type.base (base.type.list (A * B)))) => + match a with + | Some x' => + UnderLets.Base + (x' + (reify_list + (map (fun '(x1, y) => (x1, y)%expr_pat) + (combine xs0 ys0)))) + | None => + UnderLets.Base + (#(ident.List_combine)%expr @ x @ x0)%expr_pat + end) + | None => + UnderLets.Base + (#(ident.List_combine)%expr @ x @ x0)%expr_pat + end) + | None => + UnderLets.Base (#(ident.List_combine)%expr @ x @ x0)%expr_pat + end) +| @ident.List_map A B => + fun + (x : defaults.expr (type.base A) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base B))) + (x0 : defaults.expr (type.base (base.type.list A))) => + Compile.castbe x0 + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base (base.type.list B)))) + (fun e : option (defaults.expr (type.base (base.type.list A))) => + match e with + | Some e0 => + reflect_list_cps e0 + (fun ls : option (list (defaults.expr (type.base A))) => + match ls with + | Some ls0 => + (fv <-- (e1 <-- list_rect + (fun + _ : list (defaults.expr (type.base A)) + => + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.list B)))) + (UnderLets.Base []%expr_pat) + (fun (x1 : defaults.expr (type.base A)) + (_ : list + (defaults.expr (type.base A))) + (rec : UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.list B)))) + => + rec' <-- rec; + fx <-- x x1; + UnderLets.Base (fx :: rec')%expr_pat) + ls0; + UnderLets.Base + {| + anyexpr_ty := base.type.list B; + unwrap := e1 |}); + base.try_make_transport_cps + (fun t : base.type => defaults.expr (type.base t)) + (let (anyexpr_ty, _) := fv in anyexpr_ty) + (base.type.list B) + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base (base.type.list B)))) + (fun + a : option + (defaults.expr + (type.base + (let (anyexpr_ty, _) := fv in anyexpr_ty)) -> + defaults.expr (type.base (base.type.list B))) + => + match a with + | Some x' => + UnderLets.Base + (x' + (let + (anyexpr_ty, unwrap) as a0 + return + (defaults.expr + (type.base + (let (anyexpr_ty, _) := a0 in + anyexpr_ty))) := fv in + unwrap)) + | None => + UnderLets.Base + (#(ident.List_map)%expr @ + (λ x1 : var (type.base A), + UnderLets.to_expr (x ($x1)))%expr @ x0)%expr_pat + end))%under_lets + | None => + UnderLets.Base + (#(ident.List_map)%expr @ + (λ x1 : var (type.base A), + UnderLets.to_expr (x ($x1)))%expr @ x0)%expr_pat + end) + | None => + UnderLets.Base + (#(ident.List_map)%expr @ + (λ x1 : var (type.base A), + UnderLets.to_expr (x ($x1)))%expr @ x0)%expr_pat + end) +| @ident.List_app A => + fun x x0 : defaults.expr (type.base (base.type.list A)) => + Compile.castbe x + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base (base.type.list A)))) + (fun e : option (defaults.expr (type.base (base.type.list A))) => + match e with + | Some e0 => + reflect_list_cps e0 + (fun ls : option (list (defaults.expr (type.base A))) => + match ls with + | Some ls0 => + (fv <-- (e1 <-- list_rect + (fun + _ : list (defaults.expr (type.base A)) + => + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.list A)))) + (UnderLets.Base x0) + (fun (x1 : defaults.expr (type.base A)) + (_ : list + (defaults.expr (type.base A))) + (rec : UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.list A)))) + => + rec' <-- rec; + UnderLets.Base (x1 :: rec')%expr_pat) + ls0; + UnderLets.Base + {| + anyexpr_ty := base.type.list A; + unwrap := e1 |}); + base.try_make_transport_cps + (fun t : base.type => defaults.expr (type.base t)) + (let (anyexpr_ty, _) := fv in anyexpr_ty) + (base.type.list A) + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base (base.type.list A)))) + (fun + a : option + (defaults.expr + (type.base + (let (anyexpr_ty, _) := fv in anyexpr_ty)) -> + defaults.expr (type.base (base.type.list A))) + => + match a with + | Some x' => + UnderLets.Base + (x' + (let + (anyexpr_ty, unwrap) as a0 + return + (defaults.expr + (type.base + (let (anyexpr_ty, _) := a0 in + anyexpr_ty))) := fv in + unwrap)) + | None => UnderLets.Base (x ++ x0)%expr + end))%under_lets + | None => UnderLets.Base (x ++ x0)%expr + end) + | None => UnderLets.Base (x ++ x0)%expr + end) +| @ident.List_rev A => + fun x : defaults.expr (type.base (base.type.list A)) => + reflect_list_cps x + (fun xs : option (list (defaults.expr (type.base A))) => + match xs with + | Some xs0 => + base.try_make_transport_cps + (fun A0 : base.type => + defaults.expr (type.base (base.type.list A0))) A A + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base (base.type.list A)))) + (fun + a : option + (defaults.expr (type.base (base.type.list A)) -> + defaults.expr (type.base (base.type.list A))) => + match a with + | Some x' => UnderLets.Base (x' (reify_list (rev xs0))) + | None => UnderLets.Base (#(ident.List_rev)%expr @ x)%expr_pat + end) + | None => UnderLets.Base (#(ident.List_rev)%expr @ x)%expr_pat + end) +| @ident.List_flat_map A B => + fun + (x : defaults.expr (type.base A) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base (base.type.list B)))) + (x0 : defaults.expr (type.base (base.type.list A))) => + Compile.castbe x0 + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base (base.type.list B)))) + (fun e : option (defaults.expr (type.base (base.type.list A))) => + match e with + | Some e0 => + reflect_list_cps e0 + (fun ls : option (list (defaults.expr (type.base A))) => + match ls with + | Some ls0 => + (fv <-- (e1 <-- list_rect + (fun + _ : list (defaults.expr (type.base A)) + => + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.list B)))) + (UnderLets.Base []%expr_pat) + (fun (x1 : defaults.expr (type.base A)) + (_ : list + (defaults.expr (type.base A))) + (rec : UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.list B)))) + => + rec' <-- rec; + fx <-- x x1; + UnderLets.Base ($fx ++ rec')%expr) ls0; + UnderLets.Base + {| + anyexpr_ty := base.type.list B; + unwrap := e1 |}); + fv0 <-- do_again (let (anyexpr_ty, _) := fv in anyexpr_ty) + (let + (anyexpr_ty, unwrap) as a + return + (defaults.expr + (type.base + (let (anyexpr_ty, _) := a in + anyexpr_ty))) := fv in + unwrap); + base.try_make_transport_cps + (fun t : base.type => defaults.expr (type.base t)) + (let (anyexpr_ty, _) := fv in anyexpr_ty) + (base.type.list B) + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base (base.type.list B)))) + (fun + a : option + (defaults.expr + (type.base + (let (anyexpr_ty, _) := fv in anyexpr_ty)) -> + defaults.expr (type.base (base.type.list B))) + => + match a with + | Some x' => UnderLets.Base (x' fv0) + | None => + UnderLets.Base + (#(ident.List_flat_map)%expr @ + (λ x1 : var (type.base A), + UnderLets.to_expr (x ($x1)))%expr @ x0)%expr_pat + end))%under_lets + | None => + UnderLets.Base + (#(ident.List_flat_map)%expr @ + (λ x1 : var (type.base A), + UnderLets.to_expr (x ($x1)))%expr @ x0)%expr_pat + end) + | None => + UnderLets.Base + (#(ident.List_flat_map)%expr @ + (λ x1 : var (type.base A), + UnderLets.to_expr (x ($x1)))%expr @ x0)%expr_pat + end) +| @ident.List_partition A => + fun + (x : defaults.expr (type.base A) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base base.type.bool))) + (x0 : defaults.expr (type.base (base.type.list A))) => + Compile.castbe x0 + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base (base.type.list A * base.type.list A)%etype))) + (fun e : option (defaults.expr (type.base (base.type.list A))) => + match e with + | Some e0 => + reflect_list_cps e0 + (fun ls : option (list (defaults.expr (type.base A))) => + match ls with + | Some ls0 => + (fv <-- (e1 <-- list_rect + (fun + _ : list (defaults.expr (type.base A)) + => + UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.list A * + base.type.list A)%etype))) + (UnderLets.Base ([], [])%expr_pat) + (fun (x1 : defaults.expr (type.base A)) + (_ : list + (defaults.expr (type.base A))) + (rec : UnderLets.UnderLets base.type + ident var + (defaults.expr + (type.base + (base.type.list A * + base.type.list A)%etype))) + => + rec' <-- rec; + fx <-- id x x1; + UnderLets.Base + (#(ident.prod_rect)%expr @ + (λ g + d : defaults.expr + (type.base + (base.type.list A)), + (#(ident.bool_rect)%expr @ + (λ _ : defaults.expr + (type.base base.type.unit), + ($x1 :: $g, $d)%expr_pat) @ + (λ _ : defaults.expr + (type.base base.type.unit), + ($g, $x1 :: $d)%expr_pat) @ $fx)%expr_pat)%expr @ + rec')%expr_pat) ls0; + UnderLets.Base + {| + anyexpr_ty := (base.type.list A * + base.type.list A)%etype; + unwrap := e1 |}); + fv0 <-- do_again (let (anyexpr_ty, _) := fv in anyexpr_ty) + (let + (anyexpr_ty, unwrap) as a + return + (defaults.expr + (type.base + (let (anyexpr_ty, _) := a in + anyexpr_ty))) := fv in + unwrap); + base.try_make_transport_cps + (fun t : base.type => defaults.expr (type.base t)) + (let (anyexpr_ty, _) := fv in anyexpr_ty) + (base.type.list A * base.type.list A) + (UnderLets.UnderLets base.type ident var + (defaults.expr + (type.base + (base.type.list A * base.type.list A)%etype))) + (fun + a : option + (defaults.expr + (type.base + (let (anyexpr_ty, _) := fv in anyexpr_ty)) -> + defaults.expr + (type.base + (base.type.list A * base.type.list A)%etype)) + => + match a with + | Some x' => UnderLets.Base (x' fv0) + | None => + UnderLets.Base + (#(ident.List_partition)%expr @ + (λ x1 : var (type.base A), + UnderLets.to_expr (x ($x1)))%expr @ x0)%expr_pat + end))%under_lets + | None => + UnderLets.Base + (#(ident.List_partition)%expr @ + (λ x1 : var (type.base A), + UnderLets.to_expr (x ($x1)))%expr @ x0)%expr_pat + end) + | None => + UnderLets.Base + (#(ident.List_partition)%expr @ + (λ x1 : var (type.base A), + UnderLets.to_expr (x ($x1)))%expr @ x0)%expr_pat + end) +| @ident.List_fold_right A B => + fun + (x : defaults.expr (type.base B) -> + defaults.expr (type.base A) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base A))) + (x0 : defaults.expr (type.base A)) + (x1 : defaults.expr (type.base (base.type.list B))) => + Compile.castv x + (UnderLets.UnderLets base.type ident var (defaults.expr (type.base A))) + (fun + f : option + (defaults.expr (type.base B) -> + defaults.expr (type.base A) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base A))) => + match f with + | Some f0 => + reflect_list_cps x1 + (fun ls : option (list (defaults.expr (type.base B))) => + match ls with + | Some ls0 => + (fv <-- (e <-- list_rect + (fun + _ : list (defaults.expr (type.base B)) + => + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base A))) + (UnderLets.Base x0) + (fun (x2 : defaults.expr (type.base B)) + (_ : list (defaults.expr (type.base B))) + (rec : UnderLets.UnderLets base.type + ident var + (defaults.expr (type.base A))) + => rec' <-- rec; + f0 x2 rec') ls0; + UnderLets.Base {| anyexpr_ty := A; unwrap := e |}); + base.try_make_transport_cps + (fun t : base.type => defaults.expr (type.base t)) + (let (anyexpr_ty, _) := fv in anyexpr_ty) A + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base A))) + (fun + a : option + (defaults.expr + (type.base + (let (anyexpr_ty, _) := fv in anyexpr_ty)) -> + defaults.expr (type.base A)) => + match a with + | Some x' => + UnderLets.Base + (x' + (let + (anyexpr_ty, unwrap) as a0 + return + (defaults.expr + (type.base + (let (anyexpr_ty, _) := a0 in + anyexpr_ty))) := fv in + unwrap)) + | None => + UnderLets.Base + (#(ident.List_fold_right)%expr @ + (λ (x2 : var (type.base B))(x3 : var + (type.base A)), + UnderLets.to_expr (x ($x2) ($x3)))%expr @ x0 @ + x1)%expr_pat + end))%under_lets + | None => + UnderLets.Base + (#(ident.List_fold_right)%expr @ + (λ (x2 : var (type.base B))(x3 : var (type.base A)), + UnderLets.to_expr (x ($x2) ($x3)))%expr @ x0 @ x1)%expr_pat + end) + | None => + UnderLets.Base + (#(ident.List_fold_right)%expr @ + (λ (x2 : var (type.base B))(x3 : var (type.base A)), + UnderLets.to_expr (x ($x2) ($x3)))%expr @ x0 @ x1)%expr_pat + end) +| @ident.List_update_nth T => + fun (x : defaults.expr (type.base base.type.nat)) + (x0 : defaults.expr (type.base T) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base T))) + (x1 : defaults.expr (type.base (base.type.list T))) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option nat) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun _ : Z => None + | base.type.bool => fun _ : bool => None + | base.type.nat => fun v0 : nat => Some v0 + end v + | _ => None + end + with + | Some args => + Compile.castv x0 + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base (base.type.list T)))) + (fun + f : option + (defaults.expr (type.base T) -> + UnderLets.UnderLets base.type ident var + (defaults.expr (type.base T))) => + match f with + | Some f0 => + reflect_list_cps x1 + (fun ls : option (list (defaults.expr (type.base T))) => + match ls with + | Some ls0 => + (fv <-- (e <-- (retv <---- update_nth args + (fun + x2 : UnderLets.UnderLets + base.type + ident var + (defaults.expr + (type.base + T)) => + x3 <-- x2; + f0 x3) + (map UnderLets.Base + ls0); + UnderLets.Base (reify_list retv)); + UnderLets.Base + {| + anyexpr_ty := base.type.list T; + unwrap := e |}); + base.try_make_transport_cps + (fun t0 : base.type => + defaults.expr (type.base t0)) + (let (anyexpr_ty, _) := fv in anyexpr_ty) + (base.type.list T) + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base (base.type.list T)))) + (fun + a : option + (defaults.expr + (type.base + (let (anyexpr_ty, _) := fv in + anyexpr_ty)) -> + defaults.expr + (type.base (base.type.list T))) => + match a with + | Some x' => + UnderLets.Base + (x' + (let + (anyexpr_ty, unwrap) as a0 + return + (defaults.expr + (type.base + (let (anyexpr_ty, _) := + a0 in + anyexpr_ty))) := fv in + unwrap)) + | None => + UnderLets.Base + (#(ident.List_update_nth)%expr @ x @ + (λ x2 : var (type.base T), + UnderLets.to_expr (x0 ($x2)))%expr @ x1)%expr_pat + end))%under_lets + | None => + UnderLets.Base + (#(ident.List_update_nth)%expr @ x @ + (λ x2 : var (type.base T), + UnderLets.to_expr (x0 ($x2)))%expr @ x1)%expr_pat + end) + | None => + UnderLets.Base + (#(ident.List_update_nth)%expr @ x @ + (λ x2 : var (type.base T), + UnderLets.to_expr (x0 ($x2)))%expr @ x1)%expr_pat + end) + | None => + UnderLets.Base + (#(ident.List_update_nth)%expr @ x @ + (λ x2 : var (type.base T), + UnderLets.to_expr (x0 ($x2)))%expr @ x1)%expr_pat + end + | ($_)%expr | @expr.Abs _ _ _ _ _ _ => + UnderLets.Base + (#(ident.List_update_nth)%expr @ x @ + (λ x2 : var (type.base T), + UnderLets.to_expr (x0 ($x2)))%expr @ x1)%expr_pat + | _ => + UnderLets.Base + (#(ident.List_update_nth)%expr @ x @ + (λ x3 : var (type.base T), + UnderLets.to_expr (x0 ($x3)))%expr @ x1)%expr_pat + end +| @ident.List_nth_default T => + fun (x : defaults.expr (type.base T)) + (x0 : defaults.expr (type.base (base.type.list T))) + (x1 : defaults.expr (type.base base.type.nat)) => + match x1 with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option nat) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun _ : Z => None + | base.type.bool => fun _ : bool => None + | base.type.nat => fun v0 : nat => Some v0 + end v + | _ => None + end + with + | Some args => + Compile.castbe x + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base T))) + (fun default : option (defaults.expr (type.base T)) => + match default with + | Some default0 => + reflect_list_cps x0 + (fun ls : option (list (defaults.expr (type.base T))) => + match ls with + | Some ls0 => + base.try_make_transport_cps + (fun t0 : base.type => + defaults.expr (type.base t0)) T T + (UnderLets.UnderLets base.type ident var + (defaults.expr (type.base T))) + (fun + a : option + (defaults.expr (type.base T) -> + defaults.expr (type.base T)) => + match a with + | Some x' => + UnderLets.Base + (x' (nth_default default0 ls0 args)) + | None => + UnderLets.Base + (#(ident.List_nth_default)%expr @ x @ x0 @ + x1)%expr_pat + end) + | None => + UnderLets.Base + (#(ident.List_nth_default)%expr @ x @ x0 @ x1)%expr_pat + end) + | None => + UnderLets.Base + (#(ident.List_nth_default)%expr @ x @ x0 @ x1)%expr_pat + end) + | None => + UnderLets.Base + (#(ident.List_nth_default)%expr @ x @ x0 @ x1)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.List_nth_default)%expr @ x @ x0 @ x1)%expr_pat + end +| ident.Z_add => + fun x x0 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => UnderLets.Base ##((args + args0)%Z)%expr + | None => UnderLets.Base (x + x0)%expr + end + | _ => UnderLets.Base (x + x0)%expr + end + | None => UnderLets.Base (x + x0)%expr + end + | _ => UnderLets.Base (x + x0)%expr + end +| ident.Z_mul => + fun x x0 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => UnderLets.Base ##((args * args0)%Z)%expr + | None => UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end + | None => UnderLets.Base (x * x0)%expr + end + | _ => UnderLets.Base (x * x0)%expr + end +| ident.Z_pow => + fun x x0 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => UnderLets.Base ##(args ^ args0)%expr + | None => + UnderLets.Base (#(ident.Z_pow)%expr @ x @ x0)%expr_pat + end + | _ => UnderLets.Base (#(ident.Z_pow)%expr @ x @ x0)%expr_pat + end + | None => UnderLets.Base (#(ident.Z_pow)%expr @ x @ x0)%expr_pat + end + | _ => UnderLets.Base (#(ident.Z_pow)%expr @ x @ x0)%expr_pat + end +| ident.Z_sub => + fun x x0 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => UnderLets.Base ##((args - args0)%Z)%expr + | None => UnderLets.Base (x - x0)%expr + end + | _ => UnderLets.Base (x - x0)%expr + end + | None => UnderLets.Base (x - x0)%expr + end + | _ => UnderLets.Base (x - x0)%expr + end +| ident.Z_opp => + fun x : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => UnderLets.Base ##((- args)%Z)%expr + | None => UnderLets.Base (- x)%expr + end + | _ => UnderLets.Base (- x)%expr + end +| ident.Z_div => + fun x x0 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => UnderLets.Base ##((args / args0)%Z)%expr + | None => UnderLets.Base (x / x0)%expr + end + | _ => UnderLets.Base (x / x0)%expr + end + | None => UnderLets.Base (x / x0)%expr + end + | _ => UnderLets.Base (x / x0)%expr + end +| ident.Z_modulo => + fun x x0 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => UnderLets.Base ##((args mod args0)%Z)%expr + | None => UnderLets.Base (x mod x0)%expr + end + | _ => UnderLets.Base (x mod x0)%expr + end + | None => UnderLets.Base (x mod x0)%expr + end + | _ => UnderLets.Base (x mod x0)%expr + end +| ident.Z_log2 => + fun x : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => UnderLets.Base ##(Z.log2 args)%expr + | None => UnderLets.Base (#(ident.Z_log2)%expr @ x)%expr_pat + end + | _ => UnderLets.Base (#(ident.Z_log2)%expr @ x)%expr_pat + end +| ident.Z_log2_up => + fun x : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => UnderLets.Base ##(Z.log2_up args)%expr + | None => UnderLets.Base (#(ident.Z_log2_up)%expr @ x)%expr_pat + end + | _ => UnderLets.Base (#(ident.Z_log2_up)%expr @ x)%expr_pat + end +| ident.Z_eqb => + fun x x0 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => UnderLets.Base ##(args =? args0)%expr + | None => + UnderLets.Base (#(ident.Z_eqb)%expr @ x @ x0)%expr_pat + end + | _ => UnderLets.Base (#(ident.Z_eqb)%expr @ x @ x0)%expr_pat + end + | None => UnderLets.Base (#(ident.Z_eqb)%expr @ x @ x0)%expr_pat + end + | _ => UnderLets.Base (#(ident.Z_eqb)%expr @ x @ x0)%expr_pat + end +| ident.Z_leb => + fun x x0 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => UnderLets.Base ##(args <=? args0)%expr + | None => + UnderLets.Base (#(ident.Z_leb)%expr @ x @ x0)%expr_pat + end + | _ => UnderLets.Base (#(ident.Z_leb)%expr @ x @ x0)%expr_pat + end + | None => UnderLets.Base (#(ident.Z_leb)%expr @ x @ x0)%expr_pat + end + | _ => UnderLets.Base (#(ident.Z_leb)%expr @ x @ x0)%expr_pat + end +| ident.Z_geb => + fun x x0 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => UnderLets.Base ##(args >=? args0)%expr + | None => + UnderLets.Base (#(ident.Z_geb)%expr @ x @ x0)%expr_pat + end + | _ => UnderLets.Base (#(ident.Z_geb)%expr @ x @ x0)%expr_pat + end + | None => UnderLets.Base (#(ident.Z_geb)%expr @ x @ x0)%expr_pat + end + | _ => UnderLets.Base (#(ident.Z_geb)%expr @ x @ x0)%expr_pat + end +| ident.Z_of_nat => + fun x : defaults.expr (type.base base.type.nat) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option nat) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun _ : Z => None + | base.type.bool => fun _ : bool => None + | base.type.nat => fun v0 : nat => Some v0 + end v + | _ => None + end + with + | Some args => UnderLets.Base ##(Z.of_nat args)%expr + | None => UnderLets.Base (#(ident.Z_of_nat)%expr @ x)%expr_pat + end + | _ => UnderLets.Base (#(ident.Z_of_nat)%expr @ x)%expr_pat + end +| ident.Z_to_nat => + fun x : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => UnderLets.Base ##(Z.to_nat args)%expr + | None => UnderLets.Base (#(ident.Z_to_nat)%expr @ x)%expr_pat + end + | _ => UnderLets.Base (#(ident.Z_to_nat)%expr @ x)%expr_pat + end +| ident.Z_shiftr => + fun x x0 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => UnderLets.Base ##(Z.shiftr args args0)%expr + | None => UnderLets.Base (x >> x0)%expr + end + | _ => UnderLets.Base (x >> x0)%expr + end + | None => UnderLets.Base (x >> x0)%expr + end + | _ => UnderLets.Base (x >> x0)%expr + end +| ident.Z_shiftl => + fun x x0 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => UnderLets.Base ##(Z.shiftl args args0)%expr + | None => UnderLets.Base (x << x0)%expr + end + | _ => UnderLets.Base (x << x0)%expr + end + | None => UnderLets.Base (x << x0)%expr + end + | _ => UnderLets.Base (x << x0)%expr + end +| ident.Z_land => + fun x x0 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => UnderLets.Base ##(Z.land args args0)%expr + | None => UnderLets.Base (x &' x0)%expr + end + | _ => UnderLets.Base (x &' x0)%expr + end + | None => UnderLets.Base (x &' x0)%expr + end + | _ => UnderLets.Base (x &' x0)%expr + end +| ident.Z_lor => + fun x x0 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => UnderLets.Base ##(Z.lor args args0)%expr + | None => UnderLets.Base (x || x0)%expr + end + | _ => UnderLets.Base (x || x0)%expr + end + | None => UnderLets.Base (x || x0)%expr + end + | _ => UnderLets.Base (x || x0)%expr + end +| ident.Z_bneg => + fun x : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => UnderLets.Base ##(Definitions.Z.bneg args)%expr + | None => UnderLets.Base (#(ident.Z_bneg)%expr @ x)%expr_pat + end + | _ => UnderLets.Base (#(ident.Z_bneg)%expr @ x)%expr_pat + end +| ident.Z_lnot_modulo => + fun x x0 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + UnderLets.Base + ##(Definitions.Z.lnot_modulo args args0)%expr + | None => + UnderLets.Base + (#(ident.Z_lnot_modulo)%expr @ x @ x0)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_lnot_modulo)%expr @ x @ x0)%expr_pat + end + | None => + UnderLets.Base (#(ident.Z_lnot_modulo)%expr @ x @ x0)%expr_pat + end + | _ => UnderLets.Base (#(ident.Z_lnot_modulo)%expr @ x @ x0)%expr_pat + end +| ident.Z_mul_split => + fun x x0 x1 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match x1 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + UnderLets.Base + (let + '(a, b) := + Definitions.Z.mul_split args args0 args1 in + (##(a)%expr, ##(b)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat + end + | None => + UnderLets.Base + (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat + end + | None => + UnderLets.Base (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat + end + | _ => UnderLets.Base (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat + end +| ident.Z_add_get_carry => + fun x x0 x1 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match x1 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + UnderLets.Base + (let + '(a, b) := + Definitions.Z.add_get_carry_full args args0 + args1 in (##(a)%expr, ##(b)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | None => + UnderLets.Base + (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | _ => + UnderLets.Base (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat + end +| ident.Z_add_with_carry => + fun x x0 x1 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match x1 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + UnderLets.Base + ##(Definitions.Z.add_with_carry args args0 + args1)%expr + | None => + UnderLets.Base + (#(ident.Z_add_with_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_add_with_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | None => + UnderLets.Base + (#(ident.Z_add_with_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_add_with_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | None => + UnderLets.Base + (#(ident.Z_add_with_carry)%expr @ x @ x0 @ x1)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_add_with_carry)%expr @ x @ x0 @ x1)%expr_pat + end +| ident.Z_add_with_get_carry => + fun x x0 x1 x2 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match x1 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match x2 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + UnderLets.Base + (let + '(a, b) := + Definitions.Z.add_with_get_carry_full + args args0 args1 args2 in + (##(a)%expr, ##(b)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + end + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + end + | None => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat + end +| ident.Z_sub_get_borrow => + fun x x0 x1 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match x1 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + UnderLets.Base + (let + '(a, b) := + Definitions.Z.sub_get_borrow_full args args0 + args1 in (##(a)%expr, ##(b)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ x1)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ x1)%expr_pat + end + | None => + UnderLets.Base + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ x1)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ x1)%expr_pat + end + | None => + UnderLets.Base + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ x1)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ x1)%expr_pat + end +| ident.Z_sub_with_get_borrow => + fun x x0 x1 x2 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match x1 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match x2 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + UnderLets.Base + (let + '(a, b) := + Definitions.Z.sub_with_get_borrow_full + args args0 args1 args2 in + (##(a)%expr, ##(b)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_sub_with_get_borrow)%expr @ + x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_sub_with_get_borrow)%expr @ x @ + x0 @ x1 @ x2)%expr_pat + end + | None => + UnderLets.Base + (#(ident.Z_sub_with_get_borrow)%expr @ x @ x0 @ + x1 @ x2)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_sub_with_get_borrow)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + end + | None => + UnderLets.Base + (#(ident.Z_sub_with_get_borrow)%expr @ x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_sub_with_get_borrow)%expr @ x @ x0 @ x1 @ x2)%expr_pat + end + | None => + UnderLets.Base + (#(ident.Z_sub_with_get_borrow)%expr @ x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_sub_with_get_borrow)%expr @ x @ x0 @ x1 @ x2)%expr_pat + end +| ident.Z_zselect => + fun x x0 x1 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match x1 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + UnderLets.Base + ##(Definitions.Z.zselect args args0 args1)%expr + | None => + UnderLets.Base + (#(ident.Z_zselect)%expr @ x @ x0 @ x1)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_zselect)%expr @ x @ x0 @ x1)%expr_pat + end + | None => + UnderLets.Base + (#(ident.Z_zselect)%expr @ x @ x0 @ x1)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_zselect)%expr @ x @ x0 @ x1)%expr_pat + end + | None => + UnderLets.Base (#(ident.Z_zselect)%expr @ x @ x0 @ x1)%expr_pat + end + | _ => UnderLets.Base (#(ident.Z_zselect)%expr @ x @ x0 @ x1)%expr_pat + end +| ident.Z_add_modulo => + fun x x0 x1 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match x1 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + UnderLets.Base + ##(Definitions.Z.add_modulo args args0 args1)%expr + | None => + UnderLets.Base + (#(ident.Z_add_modulo)%expr @ x @ x0 @ x1)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_add_modulo)%expr @ x @ x0 @ x1)%expr_pat + end + | None => + UnderLets.Base + (#(ident.Z_add_modulo)%expr @ x @ x0 @ x1)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_add_modulo)%expr @ x @ x0 @ x1)%expr_pat + end + | None => + UnderLets.Base + (#(ident.Z_add_modulo)%expr @ x @ x0 @ x1)%expr_pat + end + | _ => UnderLets.Base (#(ident.Z_add_modulo)%expr @ x @ x0 @ x1)%expr_pat + end +| ident.Z_rshi => + fun x x0 x1 x2 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match x1 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match x2 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + UnderLets.Base + ##(Definitions.Z.rshi args args0 args1 + args2)%expr + | None => + UnderLets.Base + (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ + x2)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat + end + | None => + UnderLets.Base + (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat + end + | None => + UnderLets.Base + (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat + end + | None => + UnderLets.Base (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat + end + | _ => UnderLets.Base (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat + end +| ident.Z_cc_m => + fun x x0 : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + match x0 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + UnderLets.Base ##(Definitions.Z.cc_m args args0)%expr + | None => + UnderLets.Base (#(ident.Z_cc_m)%expr @ x @ x0)%expr_pat + end + | _ => UnderLets.Base (#(ident.Z_cc_m)%expr @ x @ x0)%expr_pat + end + | None => UnderLets.Base (#(ident.Z_cc_m)%expr @ x @ x0)%expr_pat + end + | _ => UnderLets.Base (#(ident.Z_cc_m)%expr @ x @ x0)%expr_pat + end +| ident.Z_cast range => + fun x : defaults.expr (type.base base.type.Z) => + match x with + | #(idc)%expr_pat => + match + match idc with + | @ident.Literal t0 v => + match t0 as t1 return (base.base_interp t1 -> option Z) with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args => + UnderLets.Base + ##(ident.cast ident.cast_outside_of_range range args)%expr + | None => UnderLets.Base (#(ident.Z_cast range)%expr @ x)%expr_pat + end + | _ => UnderLets.Base (#(ident.Z_cast range)%expr @ x)%expr_pat + end +| ident.Z_cast2 range => + fun x : defaults.expr (type.base (base.type.Z * base.type.Z)%etype) => + match x with + | (#(idc) @ x1 @ x0)%expr_pat => + match + match idc with + | @ident.pair A B => Some (A, B) + | _ => None + end + with + | Some _ => + match x1 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match x0 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + UnderLets.Base + (let + '(a, b) := + (let (r1, r2) := range in + fun '(x2, x3) => + (ident.cast ident.cast_outside_of_range r1 + x2, + ident.cast ident.cast_outside_of_range r2 x3)) + (args0, args1) in + (##(a)%expr, ##(b)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.Z_cast2 range)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.Z_cast2 range)%expr @ x)%expr_pat + end + | None => + UnderLets.Base (#(ident.Z_cast2 range)%expr @ x)%expr_pat + end + | _ => UnderLets.Base (#(ident.Z_cast2 range)%expr @ x)%expr_pat + end + | None => UnderLets.Base (#(ident.Z_cast2 range)%expr @ x)%expr_pat + end + | _ => UnderLets.Base (#(ident.Z_cast2 range)%expr @ x)%expr_pat + end +| ident.fancy_add log2wordmax imm => + fun x : defaults.expr (type.base (base.type.Z * base.type.Z)%etype) => + match x with + | (#(idc) @ x1 @ x0)%expr_pat => + match + match idc with + | @ident.pair A B => Some (A, B) + | _ => None + end + with + | Some _ => + match x1 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match x0 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + UnderLets.Base + (let + '(a, b) := + ident.fancy.interp + (invert_Some + (ident.to_fancy + (ident.fancy_add log2wordmax imm))) + (args0, args1) in + (##(a)%expr, ##(b)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.fancy_add log2wordmax imm)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_add log2wordmax imm)%expr @ x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_add log2wordmax imm)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_add log2wordmax imm)%expr @ x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_add log2wordmax imm)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base (#(ident.fancy_add log2wordmax imm)%expr @ x)%expr_pat + end +| ident.fancy_addc log2wordmax imm => + fun + x : defaults.expr + (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) => + match x with + | (#(idc) @ x1 @ x0)%expr_pat => + match + match idc with + | @ident.pair A B => Some (A, B) + | _ => None + end + with + | Some _ => + match x1 with + | (#(idc0) @ x3 @ x2)%expr_pat => + match + match idc0 with + | @ident.pair A B => Some (A, B) + | _ => None + end + with + | Some _ => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match x2 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match x0 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t4 v => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args3 => + UnderLets.Base + (let + '(a, b) := + ident.fancy.interp + (invert_Some + (ident.to_fancy + (ident.fancy_addc + log2wordmax imm))) + (args1, args2, args3) in + (##(a)%expr, ##(b)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.fancy_addc log2wordmax + imm)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_addc log2wordmax imm)%expr @ + x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_addc log2wordmax imm)%expr @ + x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_addc log2wordmax imm)%expr @ + x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_addc log2wordmax imm)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_addc log2wordmax imm)%expr @ x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_addc log2wordmax imm)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_addc log2wordmax imm)%expr @ x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_addc log2wordmax imm)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_addc log2wordmax imm)%expr @ x)%expr_pat + end +| ident.fancy_sub log2wordmax imm => + fun x : defaults.expr (type.base (base.type.Z * base.type.Z)%etype) => + match x with + | (#(idc) @ x1 @ x0)%expr_pat => + match + match idc with + | @ident.pair A B => Some (A, B) + | _ => None + end + with + | Some _ => + match x1 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match x0 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + UnderLets.Base + (let + '(a, b) := + ident.fancy.interp + (invert_Some + (ident.to_fancy + (ident.fancy_sub log2wordmax imm))) + (args0, args1) in + (##(a)%expr, ##(b)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.fancy_sub log2wordmax imm)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_sub log2wordmax imm)%expr @ x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_sub log2wordmax imm)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_sub log2wordmax imm)%expr @ x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_sub log2wordmax imm)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base (#(ident.fancy_sub log2wordmax imm)%expr @ x)%expr_pat + end +| ident.fancy_subb log2wordmax imm => + fun + x : defaults.expr + (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) => + match x with + | (#(idc) @ x1 @ x0)%expr_pat => + match + match idc with + | @ident.pair A B => Some (A, B) + | _ => None + end + with + | Some _ => + match x1 with + | (#(idc0) @ x3 @ x2)%expr_pat => + match + match idc0 with + | @ident.pair A B => Some (A, B) + | _ => None + end + with + | Some _ => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match x2 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match x0 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t4 v => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args3 => + UnderLets.Base + (let + '(a, b) := + ident.fancy.interp + (invert_Some + (ident.to_fancy + (ident.fancy_subb + log2wordmax imm))) + (args1, args2, args3) in + (##(a)%expr, ##(b)%expr)%expr_pat) + | None => + UnderLets.Base + (#(ident.fancy_subb log2wordmax + imm)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_subb log2wordmax imm)%expr @ + x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_subb log2wordmax imm)%expr @ + x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_subb log2wordmax imm)%expr @ + x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_subb log2wordmax imm)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_subb log2wordmax imm)%expr @ x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_subb log2wordmax imm)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_subb log2wordmax imm)%expr @ x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_subb log2wordmax imm)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_subb log2wordmax imm)%expr @ x)%expr_pat + end +| ident.fancy_mulll log2wordmax => + fun x : defaults.expr (type.base (base.type.Z * base.type.Z)%etype) => + match x with + | (#(idc) @ x1 @ x0)%expr_pat => + match + match idc with + | @ident.pair A B => Some (A, B) + | _ => None + end + with + | Some _ => + match x1 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match x0 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + UnderLets.Base + ##(ident.fancy.interp + (invert_Some + (ident.to_fancy + (ident.fancy_mulll log2wordmax))) + (args0, args1)%core)%expr + | None => + UnderLets.Base + (#(ident.fancy_mulll log2wordmax)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_mulll log2wordmax)%expr @ x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_mulll log2wordmax)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_mulll log2wordmax)%expr @ x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_mulll log2wordmax)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base (#(ident.fancy_mulll log2wordmax)%expr @ x)%expr_pat + end +| ident.fancy_mullh log2wordmax => + fun x : defaults.expr (type.base (base.type.Z * base.type.Z)%etype) => + match x with + | (#(idc) @ x1 @ x0)%expr_pat => + match + match idc with + | @ident.pair A B => Some (A, B) + | _ => None + end + with + | Some _ => + match x1 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match x0 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + UnderLets.Base + ##(ident.fancy.interp + (invert_Some + (ident.to_fancy + (ident.fancy_mullh log2wordmax))) + (args0, args1)%core)%expr + | None => + UnderLets.Base + (#(ident.fancy_mullh log2wordmax)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_mullh log2wordmax)%expr @ x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_mullh log2wordmax)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_mullh log2wordmax)%expr @ x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_mullh log2wordmax)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base (#(ident.fancy_mullh log2wordmax)%expr @ x)%expr_pat + end +| ident.fancy_mulhl log2wordmax => + fun x : defaults.expr (type.base (base.type.Z * base.type.Z)%etype) => + match x with + | (#(idc) @ x1 @ x0)%expr_pat => + match + match idc with + | @ident.pair A B => Some (A, B) + | _ => None + end + with + | Some _ => + match x1 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match x0 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + UnderLets.Base + ##(ident.fancy.interp + (invert_Some + (ident.to_fancy + (ident.fancy_mulhl log2wordmax))) + (args0, args1)%core)%expr + | None => + UnderLets.Base + (#(ident.fancy_mulhl log2wordmax)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_mulhl log2wordmax)%expr @ x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_mulhl log2wordmax)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_mulhl log2wordmax)%expr @ x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_mulhl log2wordmax)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base (#(ident.fancy_mulhl log2wordmax)%expr @ x)%expr_pat + end +| ident.fancy_mulhh log2wordmax => + fun x : defaults.expr (type.base (base.type.Z * base.type.Z)%etype) => + match x with + | (#(idc) @ x1 @ x0)%expr_pat => + match + match idc with + | @ident.pair A B => Some (A, B) + | _ => None + end + with + | Some _ => + match x1 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match x0 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + UnderLets.Base + ##(ident.fancy.interp + (invert_Some + (ident.to_fancy + (ident.fancy_mulhh log2wordmax))) + (args0, args1)%core)%expr + | None => + UnderLets.Base + (#(ident.fancy_mulhh log2wordmax)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_mulhh log2wordmax)%expr @ x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_mulhh log2wordmax)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_mulhh log2wordmax)%expr @ x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_mulhh log2wordmax)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base (#(ident.fancy_mulhh log2wordmax)%expr @ x)%expr_pat + end +| ident.fancy_rshi log2wordmax x => + fun x0 : defaults.expr (type.base (base.type.Z * base.type.Z)%etype) => + match x0 with + | (#(idc) @ x2 @ x1)%expr_pat => + match + match idc with + | @ident.pair A B => Some (A, B) + | _ => None + end + with + | Some _ => + match x2 with + | #(idc0)%expr_pat => + match + match idc0 with + | @ident.Literal t1 v => + match + t1 as t2 return (base.base_interp t2 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args0 => + match x1 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + UnderLets.Base + ##(ident.fancy.interp + (invert_Some + (ident.to_fancy + (ident.fancy_rshi log2wordmax x))) + (args0, args1)%core)%expr + | None => + UnderLets.Base + (#(ident.fancy_rshi log2wordmax x)%expr @ x0)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_rshi log2wordmax x)%expr @ x0)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_rshi log2wordmax x)%expr @ x0)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_rshi log2wordmax x)%expr @ x0)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_rshi log2wordmax x)%expr @ x0)%expr_pat + end + | _ => + UnderLets.Base (#(ident.fancy_rshi log2wordmax x)%expr @ x0)%expr_pat + end +| ident.fancy_selc => + fun + x : defaults.expr + (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) => + match x with + | (#(idc) @ x1 @ x0)%expr_pat => + match + match idc with + | @ident.pair A B => Some (A, B) + | _ => None + end + with + | Some _ => + match x1 with + | (#(idc0) @ x3 @ x2)%expr_pat => + match + match idc0 with + | @ident.pair A B => Some (A, B) + | _ => None + end + with + | Some _ => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match x2 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match x0 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t4 v => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args3 => + UnderLets.Base + ##(ident.fancy.interp + (invert_Some + (ident.to_fancy + ident.fancy_selc)) + (args1, args2, args3)%core)%expr + | None => + UnderLets.Base + (#(ident.fancy_selc)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_selc)%expr @ x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_selc)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_selc)%expr @ x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_selc)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_selc)%expr @ x)%expr_pat + end + | None => + UnderLets.Base (#(ident.fancy_selc)%expr @ x)%expr_pat + end + | _ => UnderLets.Base (#(ident.fancy_selc)%expr @ x)%expr_pat + end + | None => UnderLets.Base (#(ident.fancy_selc)%expr @ x)%expr_pat + end + | _ => UnderLets.Base (#(ident.fancy_selc)%expr @ x)%expr_pat + end +| ident.fancy_selm log2wordmax => + fun + x : defaults.expr + (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) => + match x with + | (#(idc) @ x1 @ x0)%expr_pat => + match + match idc with + | @ident.pair A B => Some (A, B) + | _ => None + end + with + | Some _ => + match x1 with + | (#(idc0) @ x3 @ x2)%expr_pat => + match + match idc0 with + | @ident.pair A B => Some (A, B) + | _ => None + end + with + | Some _ => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match x2 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match x0 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t4 v => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args3 => + UnderLets.Base + ##(ident.fancy.interp + (invert_Some + (ident.to_fancy + (ident.fancy_selm + log2wordmax))) + (args1, args2, args3)%core)%expr + | None => + UnderLets.Base + (#(ident.fancy_selm log2wordmax)%expr @ + x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_selm log2wordmax)%expr @ + x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_selm log2wordmax)%expr @ + x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_selm log2wordmax)%expr @ x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_selm log2wordmax)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_selm log2wordmax)%expr @ x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_selm log2wordmax)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_selm log2wordmax)%expr @ x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_selm log2wordmax)%expr @ x)%expr_pat + end + | _ => UnderLets.Base (#(ident.fancy_selm log2wordmax)%expr @ x)%expr_pat + end +| ident.fancy_sell => + fun + x : defaults.expr + (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) => + match x with + | (#(idc) @ x1 @ x0)%expr_pat => + match + match idc with + | @ident.pair A B => Some (A, B) + | _ => None + end + with + | Some _ => + match x1 with + | (#(idc0) @ x3 @ x2)%expr_pat => + match + match idc0 with + | @ident.pair A B => Some (A, B) + | _ => None + end + with + | Some _ => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match x2 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match x0 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t4 v => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args3 => + UnderLets.Base + ##(ident.fancy.interp + (invert_Some + (ident.to_fancy + ident.fancy_sell)) + (args1, args2, args3)%core)%expr + | None => + UnderLets.Base + (#(ident.fancy_sell)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_sell)%expr @ x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_sell)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_sell)%expr @ x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_sell)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_sell)%expr @ x)%expr_pat + end + | None => + UnderLets.Base (#(ident.fancy_sell)%expr @ x)%expr_pat + end + | _ => UnderLets.Base (#(ident.fancy_sell)%expr @ x)%expr_pat + end + | None => UnderLets.Base (#(ident.fancy_sell)%expr @ x)%expr_pat + end + | _ => UnderLets.Base (#(ident.fancy_sell)%expr @ x)%expr_pat + end +| ident.fancy_addm => + fun + x : defaults.expr + (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) => + match x with + | (#(idc) @ x1 @ x0)%expr_pat => + match + match idc with + | @ident.pair A B => Some (A, B) + | _ => None + end + with + | Some _ => + match x1 with + | (#(idc0) @ x3 @ x2)%expr_pat => + match + match idc0 with + | @ident.pair A B => Some (A, B) + | _ => None + end + with + | Some _ => + match x3 with + | #(idc1)%expr_pat => + match + match idc1 with + | @ident.Literal t2 v => + match + t2 as t3 + return (base.base_interp t3 -> option Z) + with + | base.type.unit => fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args1 => + match x2 with + | #(idc2)%expr_pat => + match + match idc2 with + | @ident.Literal t3 v => + match + t3 as t4 + return + (base.base_interp t4 -> option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => fun _ : nat => None + end v + | _ => None + end + with + | Some args2 => + match x0 with + | #(idc3)%expr_pat => + match + match idc3 with + | @ident.Literal t4 v => + match + t4 as t5 + return + (base.base_interp t5 -> + option Z) + with + | base.type.unit => + fun _ : unit => None + | base.type.Z => + fun v0 : Z => Some v0 + | base.type.bool => + fun _ : bool => None + | base.type.nat => + fun _ : nat => None + end v + | _ => None + end + with + | Some args3 => + UnderLets.Base + ##(ident.fancy.interp + (invert_Some + (ident.to_fancy + ident.fancy_addm)) + (args1, args2, args3)%core)%expr + | None => + UnderLets.Base + (#(ident.fancy_addm)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_addm)%expr @ x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_addm)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_addm)%expr @ x)%expr_pat + end + | None => + UnderLets.Base + (#(ident.fancy_addm)%expr @ x)%expr_pat + end + | _ => + UnderLets.Base + (#(ident.fancy_addm)%expr @ x)%expr_pat + end + | None => + UnderLets.Base (#(ident.fancy_addm)%expr @ x)%expr_pat + end + | _ => UnderLets.Base (#(ident.fancy_addm)%expr @ x)%expr_pat + end + | None => UnderLets.Base (#(ident.fancy_addm)%expr @ x)%expr_pat + end + | _ => UnderLets.Base (#(ident.fancy_addm)%expr @ x)%expr_pat + end +end + : Compile.value' true t diff --git a/src/Experiments/NewPipeline/rewrite_head.out b/src/Experiments/NewPipeline/rewrite_head.out deleted file mode 100644 index 600c4cb58..000000000 --- a/src/Experiments/NewPipeline/rewrite_head.out +++ /dev/null @@ -1,17274 +0,0 @@ -rewrite_head = -match idc in (ident t) return (Compile.value' true t) with -| @ident.Literal t v => - match - t as t0 - return - (base.base_interp t0 -> - UnderLets.UnderLets base.type ident var (expr (type.base t0))) - with - | base.type.unit => fun v0 : unit => UnderLets.Base ##(v0)%expr - | base.type.Z => fun v0 : Z => UnderLets.Base ##(v0)%expr - | base.type.bool => fun v0 : bool => UnderLets.Base ##(v0)%expr - | base.type.nat => fun v0 : nat => UnderLets.Base ##(v0)%expr - end v -| ident.Nat_succ => - fun x : expr (type.base base.type.nat) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option nat) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun _ : Z => None - | base.type.bool => fun _ : bool => None - | base.type.nat => fun v0 : nat => Some v0 - end v - | _ => None - end - with - | Some args => UnderLets.Base ##(Nat.succ args)%expr - | None => UnderLets.Base (#(ident.Nat_succ)%expr @ x)%expr_pat - end - | _ => UnderLets.Base (#(ident.Nat_succ)%expr @ x)%expr_pat - end -| ident.Nat_pred => - fun x : expr (type.base base.type.nat) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option nat) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun _ : Z => None - | base.type.bool => fun _ : bool => None - | base.type.nat => fun v0 : nat => Some v0 - end v - | _ => None - end - with - | Some args => UnderLets.Base ##(Nat.pred args)%expr - | None => UnderLets.Base (#(ident.Nat_pred)%expr @ x)%expr_pat - end - | _ => UnderLets.Base (#(ident.Nat_pred)%expr @ x)%expr_pat - end -| ident.Nat_max => - fun x x0 : expr (type.base base.type.nat) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option nat) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun _ : Z => None - | base.type.bool => fun _ : bool => None - | base.type.nat => fun v0 : nat => Some v0 - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option nat) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun _ : Z => None - | base.type.bool => fun _ : bool => None - | base.type.nat => fun v0 : nat => Some v0 - end v - | _ => None - end - with - | Some args0 => UnderLets.Base ##(Nat.max args args0)%expr - | None => - UnderLets.Base (#(ident.Nat_max)%expr @ x @ x0)%expr_pat - end - | _ => UnderLets.Base (#(ident.Nat_max)%expr @ x @ x0)%expr_pat - end - | None => UnderLets.Base (#(ident.Nat_max)%expr @ x @ x0)%expr_pat - end - | _ => UnderLets.Base (#(ident.Nat_max)%expr @ x @ x0)%expr_pat - end -| ident.Nat_mul => - fun x x0 : expr (type.base base.type.nat) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option nat) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun _ : Z => None - | base.type.bool => fun _ : bool => None - | base.type.nat => fun v0 : nat => Some v0 - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option nat) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun _ : Z => None - | base.type.bool => fun _ : bool => None - | base.type.nat => fun v0 : nat => Some v0 - end v - | _ => None - end - with - | Some args0 => UnderLets.Base ##((args * args0)%nat)%expr - | None => - UnderLets.Base (#(ident.Nat_mul)%expr @ x @ x0)%expr_pat - end - | _ => UnderLets.Base (#(ident.Nat_mul)%expr @ x @ x0)%expr_pat - end - | None => UnderLets.Base (#(ident.Nat_mul)%expr @ x @ x0)%expr_pat - end - | _ => UnderLets.Base (#(ident.Nat_mul)%expr @ x @ x0)%expr_pat - end -| ident.Nat_add => - fun x x0 : expr (type.base base.type.nat) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option nat) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun _ : Z => None - | base.type.bool => fun _ : bool => None - | base.type.nat => fun v0 : nat => Some v0 - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option nat) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun _ : Z => None - | base.type.bool => fun _ : bool => None - | base.type.nat => fun v0 : nat => Some v0 - end v - | _ => None - end - with - | Some args0 => UnderLets.Base ##((args + args0)%nat)%expr - | None => - UnderLets.Base (#(ident.Nat_add)%expr @ x @ x0)%expr_pat - end - | _ => UnderLets.Base (#(ident.Nat_add)%expr @ x @ x0)%expr_pat - end - | None => UnderLets.Base (#(ident.Nat_add)%expr @ x @ x0)%expr_pat - end - | _ => UnderLets.Base (#(ident.Nat_add)%expr @ x @ x0)%expr_pat - end -| ident.Nat_sub => - fun x x0 : expr (type.base base.type.nat) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option nat) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun _ : Z => None - | base.type.bool => fun _ : bool => None - | base.type.nat => fun v0 : nat => Some v0 - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option nat) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun _ : Z => None - | base.type.bool => fun _ : bool => None - | base.type.nat => fun v0 : nat => Some v0 - end v - | _ => None - end - with - | Some args0 => UnderLets.Base ##((args - args0)%nat)%expr - | None => - UnderLets.Base (#(ident.Nat_sub)%expr @ x @ x0)%expr_pat - end - | _ => UnderLets.Base (#(ident.Nat_sub)%expr @ x @ x0)%expr_pat - end - | None => UnderLets.Base (#(ident.Nat_sub)%expr @ x @ x0)%expr_pat - end - | _ => UnderLets.Base (#(ident.Nat_sub)%expr @ x @ x0)%expr_pat - end -| @ident.nil t => UnderLets.Base []%expr_pat -| @ident.cons t => - fun (x : expr (type.base t)) (x0 : expr (type.base (base.type.list t))) - => UnderLets.Base (x :: x0)%expr_pat -| @ident.pair A B => - fun (x : expr (type.base A)) (x0 : expr (type.base B)) => - UnderLets.Base (x, x0)%expr_pat -| @ident.fst A B => - fun x : expr (type.base (A * B)%etype) => - match x with - | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ #(idc)%expr_pat x1) x0 => - match - match idc with - | @ident.pair A0 B0 => Some (A0, B0) - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var (expr (type.base A))) - with - | type.base t2 => - fun v : expr (type.base t2) => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident var - (expr (type.base A))) - with - | type.base t3 => - fun _ : expr (type.base t3) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 A - (UnderLets.UnderLets base.type ident var - (expr (type.base A))) - (fun - a : option - (expr (type.base t2) -> expr (type.base A)) => - match a with - | Some x' => UnderLets.Base (x' v) - | None => - UnderLets.Base (#(ident.fst)%expr @ x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d1 - => UnderLets.Base (#(ident.fst)%expr @ x)%expr_pat - end (Compile.reflect x0) - | (s1 -> d1)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d1 => - UnderLets.Base (#(ident.fst)%expr @ x)%expr_pat - end (Compile.reflect x1) - | None => UnderLets.Base (#(ident.fst)%expr @ x)%expr_pat - end - | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ ($_)%expr _) _ | @expr.App _ - _ _ s _ (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _) _ | @expr.App - _ _ _ s _ (@expr.App _ _ _ s0 _ (_ @ _)%expr_pat _) _ | @expr.App _ _ _ - s _ (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _) _ => - UnderLets.Base (#(ident.fst)%expr @ x)%expr_pat - | @expr.App _ _ _ s _ #(_)%expr_pat _ | @expr.App _ _ _ s _ ($_)%expr _ | - @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base (#(ident.fst)%expr @ x)%expr_pat - | _ => UnderLets.Base (#(ident.fst)%expr @ x)%expr_pat - end -| @ident.snd A B => - fun x : expr (type.base (A * B)%etype) => - match x with - | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ #(idc)%expr_pat x1) x0 => - match - match idc with - | @ident.pair A0 B0 => Some (A0, B0) - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var (expr (type.base B))) - with - | type.base t2 => - fun _ : expr (type.base t2) => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident var - (expr (type.base B))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t3 B - (UnderLets.UnderLets base.type ident var - (expr (type.base B))) - (fun - a : option - (expr (type.base t3) -> expr (type.base B)) => - match a with - | Some x' => UnderLets.Base (x' v0) - | None => - UnderLets.Base (#(ident.snd)%expr @ x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d1 - => UnderLets.Base (#(ident.snd)%expr @ x)%expr_pat - end (Compile.reflect x0) - | (s1 -> d1)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d1 => - UnderLets.Base (#(ident.snd)%expr @ x)%expr_pat - end (Compile.reflect x1) - | None => UnderLets.Base (#(ident.snd)%expr @ x)%expr_pat - end - | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ ($_)%expr _) _ | @expr.App _ - _ _ s _ (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _) _ | @expr.App - _ _ _ s _ (@expr.App _ _ _ s0 _ (_ @ _)%expr_pat _) _ | @expr.App _ _ _ - s _ (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _) _ => - UnderLets.Base (#(ident.snd)%expr @ x)%expr_pat - | @expr.App _ _ _ s _ #(_)%expr_pat _ | @expr.App _ _ _ s _ ($_)%expr _ | - @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base (#(ident.snd)%expr @ x)%expr_pat - | _ => UnderLets.Base (#(ident.snd)%expr @ x)%expr_pat - end -| @ident.prod_rect A B T => - fun - (x : expr (type.base A) -> - expr (type.base B) -> - UnderLets.UnderLets base.type ident var (expr (type.base T))) - (x0 : expr (type.base (A * B)%etype)) => - match x0 with - | @expr.App _ _ _ s _ #(_)%expr_pat _ | @expr.App _ _ _ s _ ($_)%expr _ | - @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.prod_rect)%expr @ - (λ (x2 : var (type.base A))(x3 : var (type.base B)), - UnderLets.to_expr (x ($x2) ($x3)))%expr @ x0)%expr_pat - | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ #(idc)%expr_pat x2) x1 => - match - match idc with - | @ident.pair A0 B0 => Some (A0, B0) - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var (expr (type.base T))) - with - | type.base t2 => - fun v : expr (type.base t2) => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident var - (expr (type.base T))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - Compile.castbe v - (UnderLets.UnderLets base.type ident var - (expr (type.base T))) - (fun x3 : option (expr (type.base A)) => - match x3 with - | Some x4 => - Compile.castbe v0 - (UnderLets.UnderLets base.type ident var - (expr (type.base T))) - (fun y : option (expr (type.base B)) => - match y with - | Some y0 => - (fv <-- (e <-- x x4 y0; - UnderLets.Base - {| - anyexpr_ty := T; - unwrap := e |}); - base.try_make_transport_cps - (fun t0 : base.type => - expr (type.base t0)) - (let (anyexpr_ty, _) := fv in anyexpr_ty) - T - (UnderLets.UnderLets base.type ident var - (expr (type.base T))) - (fun - a : option - (expr - (type.base - (let (anyexpr_ty, _) := - fv in - anyexpr_ty)) -> - expr (type.base T)) => - match a with - | Some x' => - UnderLets.Base - (x' - (let - (anyexpr_ty, unwrap) as a0 - return - (expr - (type.base - (let - (anyexpr_ty, - _) := a0 in - anyexpr_ty))) := - fv in - unwrap)) - | None => - UnderLets.Base - (#(ident.prod_rect)%expr @ - (λ (x5 : var (type.base A)) - (x6 : var (type.base B)), - UnderLets.to_expr - (x ($x5) ($x6)))%expr @ x0)%expr_pat - end))%under_lets - | None => - UnderLets.Base - (#(ident.prod_rect)%expr @ - (λ (x5 : var (type.base A))(x6 : - var - (type.base - B)), - UnderLets.to_expr (x ($x5) ($x6)))%expr @ - x0)%expr_pat - end) - | None => - UnderLets.Base - (#(ident.prod_rect)%expr @ - (λ (x4 : var (type.base A))(x5 : var - (type.base B)), - UnderLets.to_expr (x ($x4) ($x5)))%expr @ x0)%expr_pat - end) - | (s1 -> d1)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d1 - => - UnderLets.Base - (#(ident.prod_rect)%expr @ - (λ (x3 : var (type.base A))(x4 : var (type.base B)), - UnderLets.to_expr (x ($x3) ($x4)))%expr @ x0)%expr_pat - end (Compile.reflect x1) - | (s1 -> d1)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d1 => - UnderLets.Base - (#(ident.prod_rect)%expr @ - (λ (x3 : var (type.base A))(x4 : var (type.base B)), - UnderLets.to_expr (x ($x3) ($x4)))%expr @ x0)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.prod_rect)%expr @ - (λ (x3 : var (type.base A))(x4 : var (type.base B)), - UnderLets.to_expr (x ($x3) ($x4)))%expr @ x0)%expr_pat - end - | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ ($_)%expr _) _ | @expr.App _ - _ _ s _ (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _) _ => - UnderLets.Base - (#(ident.prod_rect)%expr @ - (λ (x3 : var (type.base A))(x4 : var (type.base B)), - UnderLets.to_expr (x ($x3) ($x4)))%expr @ x0)%expr_pat - | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ (_ @ _)%expr_pat _) _ | - @expr.App _ _ _ s _ - (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _) _ => - UnderLets.Base - (#(ident.prod_rect)%expr @ - (λ (x4 : var (type.base A))(x5 : var (type.base B)), - UnderLets.to_expr (x ($x4) ($x5)))%expr @ x0)%expr_pat - | @expr.App _ _ _ s _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.prod_rect)%expr @ - (λ (x3 : var (type.base A))(x4 : var (type.base B)), - UnderLets.to_expr (x ($x3) ($x4)))%expr @ x0)%expr_pat - | @expr.LetIn _ _ _ _ _ _ _ => - UnderLets.Base - (#(ident.prod_rect)%expr @ - (λ (x2 : var (type.base A))(x3 : var (type.base B)), - UnderLets.to_expr (x ($x2) ($x3)))%expr @ x0)%expr_pat - | _ => - UnderLets.Base - (#(ident.prod_rect)%expr @ - (λ (x1 : var (type.base A))(x2 : var (type.base B)), - UnderLets.to_expr (x ($x1) ($x2)))%expr @ x0)%expr_pat - end -| @ident.bool_rect T => - fun - (x - x0 : expr (type.base base.type.unit) -> - UnderLets.UnderLets base.type ident var (expr (type.base T))) - (x1 : expr (type.base base.type.bool)) => - match x1 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option bool) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun _ : Z => None - | base.type.bool => fun v0 : bool => Some v0 - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - (fv <-- (e <-- (if args as b - return - (UnderLets.UnderLets base.type ident var - (expr (type.base (if b then T else T)))) - then x ##(tt)%expr - else x0 ##(tt)%expr); - UnderLets.Base - {| anyexpr_ty := if args then T else T; unwrap := e |}); - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) - (let (anyexpr_ty, _) := fv in anyexpr_ty) T - (UnderLets.UnderLets base.type ident var (expr (type.base T))) - (fun - a : option - (expr - (type.base - (let (anyexpr_ty, _) := fv in anyexpr_ty)) -> - expr (type.base T)) => - match a with - | Some x' => - UnderLets.Base - (x' - (let - (anyexpr_ty, unwrap) as a0 - return - (expr - (type.base - (let (anyexpr_ty, _) := a0 in anyexpr_ty))) := - fv in - unwrap)) - | None => - UnderLets.Base - (#(ident.bool_rect)%expr @ - (λ x2 : var (type.base base.type.unit), - UnderLets.to_expr (x ($x2)))%expr @ - (λ x2 : var (type.base base.type.unit), - UnderLets.to_expr (x0 ($x2)))%expr @ x1)%expr_pat - end))%under_lets - | None => - UnderLets.Base - (#(ident.bool_rect)%expr @ - (λ x2 : var (type.base base.type.unit), - UnderLets.to_expr (x ($x2)))%expr @ - (λ x2 : var (type.base base.type.unit), - UnderLets.to_expr (x0 ($x2)))%expr @ x1)%expr_pat - end - | ($_)%expr | @expr.Abs _ _ _ _ _ _ => - UnderLets.Base - (#(ident.bool_rect)%expr @ - (λ x2 : var (type.base base.type.unit), - UnderLets.to_expr (x ($x2)))%expr @ - (λ x2 : var (type.base base.type.unit), - UnderLets.to_expr (x0 ($x2)))%expr @ x1)%expr_pat - | _ => - UnderLets.Base - (#(ident.bool_rect)%expr @ - (λ x3 : var (type.base base.type.unit), - UnderLets.to_expr (x ($x3)))%expr @ - (λ x3 : var (type.base base.type.unit), - UnderLets.to_expr (x0 ($x3)))%expr @ x1)%expr_pat - end -| @ident.nat_rect P => - fun - (x : expr (type.base base.type.unit) -> - UnderLets.UnderLets base.type ident var (expr (type.base P))) - (x0 : expr (type.base base.type.nat) -> - expr (type.base P) -> - UnderLets.UnderLets base.type ident var (expr (type.base P))) - (x1 : expr (type.base base.type.nat)) => - match x1 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option nat) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun _ : Z => None - | base.type.bool => fun _ : bool => None - | base.type.nat => fun v0 : nat => Some v0 - end v - | _ => None - end - with - | Some args => - Compile.castv x0 - (UnderLets.UnderLets base.type ident var (expr (type.base P))) - (fun - S_case : option - (expr (type.base base.type.nat) -> - expr (type.base P) -> - UnderLets.UnderLets base.type ident var - (expr (type.base P))) => - match S_case with - | Some S_case0 => - (fv <-- (e <-- nat_rect - (fun _ : nat => - UnderLets.UnderLets base.type ident var - (expr (type.base P))) (x ##(tt)%expr) - (fun (n' : nat) - (rec : UnderLets.UnderLets base.type - ident var - (expr (type.base P))) => - rec0 <-- rec; - S_case0 ##(n')%expr rec0) args; - UnderLets.Base {| anyexpr_ty := P; unwrap := e |}); - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) - (let (anyexpr_ty, _) := fv in anyexpr_ty) P - (UnderLets.UnderLets base.type ident var - (expr (type.base P))) - (fun - a : option - (expr - (type.base - (let (anyexpr_ty, _) := fv in anyexpr_ty)) -> - expr (type.base P)) => - match a with - | Some x' => - UnderLets.Base - (x' - (let - (anyexpr_ty, unwrap) as a0 - return - (expr - (type.base - (let (anyexpr_ty, _) := a0 in - anyexpr_ty))) := fv in - unwrap)) - | None => - UnderLets.Base - (#(ident.nat_rect)%expr @ - (λ x2 : var (type.base base.type.unit), - UnderLets.to_expr (x ($x2)))%expr @ - (λ (x2 : var (type.base base.type.nat)) - (x3 : var (type.base P)), - UnderLets.to_expr (x0 ($x2) ($x3)))%expr @ x1)%expr_pat - end))%under_lets - | None => - UnderLets.Base - (#(ident.nat_rect)%expr @ - (λ x2 : var (type.base base.type.unit), - UnderLets.to_expr (x ($x2)))%expr @ - (λ (x2 : var (type.base base.type.nat))(x3 : var - (type.base - P)), - UnderLets.to_expr (x0 ($x2) ($x3)))%expr @ x1)%expr_pat - end) - | None => - UnderLets.Base - (#(ident.nat_rect)%expr @ - (λ x2 : var (type.base base.type.unit), - UnderLets.to_expr (x ($x2)))%expr @ - (λ (x2 : var (type.base base.type.nat))(x3 : var (type.base P)), - UnderLets.to_expr (x0 ($x2) ($x3)))%expr @ x1)%expr_pat - end - | ($_)%expr | @expr.Abs _ _ _ _ _ _ => - UnderLets.Base - (#(ident.nat_rect)%expr @ - (λ x2 : var (type.base base.type.unit), - UnderLets.to_expr (x ($x2)))%expr @ - (λ (x2 : var (type.base base.type.nat))(x3 : var (type.base P)), - UnderLets.to_expr (x0 ($x2) ($x3)))%expr @ x1)%expr_pat - | _ => - UnderLets.Base - (#(ident.nat_rect)%expr @ - (λ x3 : var (type.base base.type.unit), - UnderLets.to_expr (x ($x3)))%expr @ - (λ (x3 : var (type.base base.type.nat))(x4 : var (type.base P)), - UnderLets.to_expr (x0 ($x3) ($x4)))%expr @ x1)%expr_pat - end -| @ident.list_rect A P => - fun - (x : expr (type.base base.type.unit) -> - UnderLets.UnderLets base.type ident var (expr (type.base P))) - (x0 : expr (type.base A) -> - expr (type.base (base.type.list A)) -> - expr (type.base P) -> - UnderLets.UnderLets base.type ident var (expr (type.base P))) - (x1 : expr (type.base (base.type.list A))) => - Compile.castv x0 - (UnderLets.UnderLets base.type ident var (expr (type.base P))) - (fun - Pcons : option - (expr (type.base A) -> - expr (type.base (base.type.list A)) -> - expr (type.base P) -> - UnderLets.UnderLets base.type ident var - (expr (type.base P))) => - match Pcons with - | Some Pcons0 => - reflect_list_cps x1 - (fun ls : option (list (expr (type.base A))) => - match ls with - | Some ls0 => - (fv <-- (e <-- list_rect - (fun _ : list (expr (type.base A)) => - UnderLets.UnderLets base.type ident var - (expr (type.base P))) (x ##(tt)%expr) - (fun (x2 : expr (type.base A)) - (xs : list (expr (type.base A))) - (rec : UnderLets.UnderLets base.type - ident var (expr (type.base P))) - => - rec' <-- rec; - Pcons0 x2 (reify_list xs) rec') ls0; - UnderLets.Base {| anyexpr_ty := P; unwrap := e |}); - base.try_make_transport_cps - (fun t : base.type => expr (type.base t)) - (let (anyexpr_ty, _) := fv in anyexpr_ty) P - (UnderLets.UnderLets base.type ident var - (expr (type.base P))) - (fun - a : option - (expr - (type.base - (let (anyexpr_ty, _) := fv in anyexpr_ty)) -> - expr (type.base P)) => - match a with - | Some x' => - UnderLets.Base - (x' - (let - (anyexpr_ty, unwrap) as a0 - return - (expr - (type.base - (let (anyexpr_ty, _) := a0 in - anyexpr_ty))) := fv in - unwrap)) - | None => - UnderLets.Base - (#(ident.list_rect)%expr @ - (λ x2 : var (type.base base.type.unit), - UnderLets.to_expr (x ($x2)))%expr @ - (λ (x2 : var (type.base A))(x3 : var - (type.base - (base.type.list - A))) - (x4 : var (type.base P)), - UnderLets.to_expr (x0 ($x2) ($x3) ($x4)))%expr @ - x1)%expr_pat - end))%under_lets - | None => - UnderLets.Base - (#(ident.list_rect)%expr @ - (λ x2 : var (type.base base.type.unit), - UnderLets.to_expr (x ($x2)))%expr @ - (λ (x2 : var (type.base A))(x3 : var - (type.base - (base.type.list A))) - (x4 : var (type.base P)), - UnderLets.to_expr (x0 ($x2) ($x3) ($x4)))%expr @ x1)%expr_pat - end) - | None => - UnderLets.Base - (#(ident.list_rect)%expr @ - (λ x2 : var (type.base base.type.unit), - UnderLets.to_expr (x ($x2)))%expr @ - (λ (x2 : var (type.base A))(x3 : var - (type.base - (base.type.list A))) - (x4 : var (type.base P)), - UnderLets.to_expr (x0 ($x2) ($x3) ($x4)))%expr @ x1)%expr_pat - end) -| @ident.list_case A P => - fun - (x : expr (type.base base.type.unit) -> - UnderLets.UnderLets base.type ident var (expr (type.base P))) - (x0 : expr (type.base A) -> - expr (type.base (base.type.list A)) -> - UnderLets.UnderLets base.type ident var (expr (type.base P))) - (x1 : expr (type.base (base.type.list A))) => - match x1 with - | #(idc)%expr_pat => - match match idc with - | @ident.nil t0 => Some t0 - | _ => None - end with - | Some _ => - (fv <-- (e <-- x ##(tt)%expr; - UnderLets.Base {| anyexpr_ty := P; unwrap := e |}); - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) - (let (anyexpr_ty, _) := fv in anyexpr_ty) P - (UnderLets.UnderLets base.type ident var (expr (type.base P))) - (fun - a : option - (expr - (type.base - (let (anyexpr_ty, _) := fv in anyexpr_ty)) -> - expr (type.base P)) => - match a with - | Some x' => - UnderLets.Base - (x' - (let - (anyexpr_ty, unwrap) as a0 - return - (expr - (type.base - (let (anyexpr_ty, _) := a0 in anyexpr_ty))) := - fv in - unwrap)) - | None => - UnderLets.Base - (#(ident.list_case)%expr @ - (λ x2 : var (type.base base.type.unit), - UnderLets.to_expr (x ($x2)))%expr @ - (λ (x2 : var (type.base A))(x3 : var - (type.base - (base.type.list - A))), - UnderLets.to_expr (x0 ($x2) ($x3)))%expr @ x1)%expr_pat - end))%under_lets - | None => - UnderLets.Base - (#(ident.list_case)%expr @ - (λ x2 : var (type.base base.type.unit), - UnderLets.to_expr (x ($x2)))%expr @ - (λ (x2 : var (type.base A))(x3 : var - (type.base - (base.type.list A))), - UnderLets.to_expr (x0 ($x2) ($x3)))%expr @ x1)%expr_pat - end - | @expr.App _ _ _ s _ #(_)%expr_pat _ | @expr.App _ _ _ s _ ($_)%expr _ | - @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.list_case)%expr @ - (λ x3 : var (type.base base.type.unit), - UnderLets.to_expr (x ($x3)))%expr @ - (λ (x3 : var (type.base A))(x4 : var - (type.base (base.type.list A))), - UnderLets.to_expr (x0 ($x3) ($x4)))%expr @ x1)%expr_pat - | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ #(idc)%expr_pat x3) x2 => - match match idc with - | @ident.cons t0 => Some t0 - | _ => None - end with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var (expr (type.base P))) - with - | type.base t2 => - fun v : expr (type.base t2) => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident var - (expr (type.base P))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - Compile.castbe v - (UnderLets.UnderLets base.type ident var - (expr (type.base P))) - (fun x4 : option (expr (type.base A)) => - match x4 with - | Some x5 => - Compile.castbe v0 - (UnderLets.UnderLets base.type ident var - (expr (type.base P))) - (fun - xs : option - (expr (type.base (base.type.list A))) - => - match xs with - | Some xs0 => - (fv <-- (e <-- x0 x5 xs0; - UnderLets.Base - {| - anyexpr_ty := P; - unwrap := e |}); - base.try_make_transport_cps - (fun t0 : base.type => - expr (type.base t0)) - (let (anyexpr_ty, _) := fv in anyexpr_ty) - P - (UnderLets.UnderLets base.type ident var - (expr (type.base P))) - (fun - a : option - (expr - (type.base - (let (anyexpr_ty, _) := - fv in - anyexpr_ty)) -> - expr (type.base P)) => - match a with - | Some x' => - UnderLets.Base - (x' - (let - (anyexpr_ty, unwrap) as a0 - return - (expr - (type.base - (let - (anyexpr_ty, - _) := a0 in - anyexpr_ty))) := - fv in - unwrap)) - | None => - UnderLets.Base - (#(ident.list_case)%expr @ - (λ x6 : var - (type.base - base.type.unit), - UnderLets.to_expr (x ($x6)))%expr @ - (λ (x6 : var (type.base A)) - (x7 : var - (type.base - (base.type.list A))), - UnderLets.to_expr - (x0 ($x6) ($x7)))%expr @ x1)%expr_pat - end))%under_lets - | None => - UnderLets.Base - (#(ident.list_case)%expr @ - (λ x6 : var (type.base base.type.unit), - UnderLets.to_expr (x ($x6)))%expr @ - (λ (x6 : var (type.base A))(x7 : - var - (type.base - (base.type.list - A))), - UnderLets.to_expr (x0 ($x6) ($x7)))%expr @ - x1)%expr_pat - end) - | None => - UnderLets.Base - (#(ident.list_case)%expr @ - (λ x5 : var (type.base base.type.unit), - UnderLets.to_expr (x ($x5)))%expr @ - (λ (x5 : var (type.base A))(x6 : var - (type.base - (base.type.list - A))), - UnderLets.to_expr (x0 ($x5) ($x6)))%expr @ x1)%expr_pat - end) - | (s1 -> d1)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d1 - => - UnderLets.Base - (#(ident.list_case)%expr @ - (λ x4 : var (type.base base.type.unit), - UnderLets.to_expr (x ($x4)))%expr @ - (λ (x4 : var (type.base A))(x5 : var - (type.base - (base.type.list - A))), - UnderLets.to_expr (x0 ($x4) ($x5)))%expr @ x1)%expr_pat - end (Compile.reflect x2) - | (s1 -> d1)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d1 => - UnderLets.Base - (#(ident.list_case)%expr @ - (λ x4 : var (type.base base.type.unit), - UnderLets.to_expr (x ($x4)))%expr @ - (λ (x4 : var (type.base A))(x5 : var - (type.base - (base.type.list A))), - UnderLets.to_expr (x0 ($x4) ($x5)))%expr @ x1)%expr_pat - end (Compile.reflect x3) - | None => - UnderLets.Base - (#(ident.list_case)%expr @ - (λ x4 : var (type.base base.type.unit), - UnderLets.to_expr (x ($x4)))%expr @ - (λ (x4 : var (type.base A))(x5 : var - (type.base - (base.type.list A))), - UnderLets.to_expr (x0 ($x4) ($x5)))%expr @ x1)%expr_pat - end - | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ ($_)%expr _) _ | @expr.App _ - _ _ s _ (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _) _ => - UnderLets.Base - (#(ident.list_case)%expr @ - (λ x4 : var (type.base base.type.unit), - UnderLets.to_expr (x ($x4)))%expr @ - (λ (x4 : var (type.base A))(x5 : var - (type.base (base.type.list A))), - UnderLets.to_expr (x0 ($x4) ($x5)))%expr @ x1)%expr_pat - | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ (_ @ _)%expr_pat _) _ | - @expr.App _ _ _ s _ - (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _) _ => - UnderLets.Base - (#(ident.list_case)%expr @ - (λ x5 : var (type.base base.type.unit), - UnderLets.to_expr (x ($x5)))%expr @ - (λ (x5 : var (type.base A))(x6 : var - (type.base (base.type.list A))), - UnderLets.to_expr (x0 ($x5) ($x6)))%expr @ x1)%expr_pat - | @expr.App _ _ _ s _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.list_case)%expr @ - (λ x4 : var (type.base base.type.unit), - UnderLets.to_expr (x ($x4)))%expr @ - (λ (x4 : var (type.base A))(x5 : var - (type.base (base.type.list A))), - UnderLets.to_expr (x0 ($x4) ($x5)))%expr @ x1)%expr_pat - | @expr.LetIn _ _ _ _ _ _ _ => - UnderLets.Base - (#(ident.list_case)%expr @ - (λ x3 : var (type.base base.type.unit), - UnderLets.to_expr (x ($x3)))%expr @ - (λ (x3 : var (type.base A))(x4 : var - (type.base (base.type.list A))), - UnderLets.to_expr (x0 ($x3) ($x4)))%expr @ x1)%expr_pat - | _ => - UnderLets.Base - (#(ident.list_case)%expr @ - (λ x2 : var (type.base base.type.unit), - UnderLets.to_expr (x ($x2)))%expr @ - (λ (x2 : var (type.base A))(x3 : var - (type.base (base.type.list A))), - UnderLets.to_expr (x0 ($x2) ($x3)))%expr @ x1)%expr_pat - end -| @ident.List_length T => - fun x : expr (type.base (base.type.list T)) => - reflect_list_cps x - (fun xs : option (list (expr (type.base T))) => - match xs with - | Some xs0 => UnderLets.Base ##(length xs0)%expr - | None => UnderLets.Base (#(ident.List_length)%expr @ x)%expr_pat - end) -| ident.List_seq => - fun x x0 : expr (type.base base.type.nat) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option nat) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun _ : Z => None - | base.type.bool => fun _ : bool => None - | base.type.nat => fun v0 : nat => Some v0 - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option nat) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun _ : Z => None - | base.type.bool => fun _ : bool => None - | base.type.nat => fun v0 : nat => Some v0 - end v - | _ => None - end - with - | Some args0 => - UnderLets.Base - (fold_right - (fun (x1 : expr (type.base base.type.nat)) - (xs : expr - (type.base (base.type.list base.type.nat))) - => (x1 :: xs)%expr_pat) []%expr_pat - (map (fun v : nat => ##(v)%expr) (seq args args0))) - | None => - UnderLets.Base (#(ident.List_seq)%expr @ x @ x0)%expr_pat - end - | _ => UnderLets.Base (#(ident.List_seq)%expr @ x @ x0)%expr_pat - end - | None => UnderLets.Base (#(ident.List_seq)%expr @ x @ x0)%expr_pat - end - | _ => UnderLets.Base (#(ident.List_seq)%expr @ x @ x0)%expr_pat - end -| @ident.List_repeat A => - fun (x : expr (type.base A)) (x0 : expr (type.base base.type.nat)) => - match x0 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option nat) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun _ : Z => None - | base.type.bool => fun _ : bool => None - | base.type.nat => fun v0 : nat => Some v0 - end v - | _ => None - end - with - | Some args => - base.try_make_transport_cps - (fun A0 : base.type => expr (type.base (base.type.list A0))) A - A - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.list A)))) - (fun - a : option - (expr (type.base (base.type.list A)) -> - expr (type.base (base.type.list A))) => - match a with - | Some x' => UnderLets.Base (x' (reify_list (repeat x args))) - | None => - UnderLets.Base - (#(ident.List_repeat)%expr @ x @ x0)%expr_pat - end) - | None => - UnderLets.Base (#(ident.List_repeat)%expr @ x @ x0)%expr_pat - end - | _ => UnderLets.Base (#(ident.List_repeat)%expr @ x @ x0)%expr_pat - end -| @ident.List_combine A B => - fun (x : expr (type.base (base.type.list A))) - (x0 : expr (type.base (base.type.list B))) => - reflect_list_cps x - (fun xs : option (list (expr (type.base A))) => - match xs with - | Some xs0 => - reflect_list_cps x0 - (fun ys : option (list (expr (type.base B))) => - match ys with - | Some ys0 => - (trA <-- base.try_make_transport_cps - (fun A0 : base.type => - expr (type.base (base.type.list (A0 * B)))) A A; - trB <-- base.try_make_transport_cps - (fun B0 : base.type => - expr (type.base (base.type.list (A * B0)))) B B; - return Some - (fun - v : expr (type.base (base.type.list (A * B))) - => trB (trA v)))%cps - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.list (A * B))))) - (fun - a : option - (expr (type.base (base.type.list (A * B))) -> - expr (type.base (base.type.list (A * B)))) => - match a with - | Some x' => - UnderLets.Base - (x' - (reify_list - (map (fun '(x1, y) => (x1, y)%expr_pat) - (combine xs0 ys0)))) - | None => - UnderLets.Base - (#(ident.List_combine)%expr @ x @ x0)%expr_pat - end) - | None => - UnderLets.Base - (#(ident.List_combine)%expr @ x @ x0)%expr_pat - end) - | None => - UnderLets.Base (#(ident.List_combine)%expr @ x @ x0)%expr_pat - end) -| @ident.List_map A B => - fun - (x : expr (type.base A) -> - UnderLets.UnderLets base.type ident var (expr (type.base B))) - (x0 : expr (type.base (base.type.list A))) => - Compile.castbe x0 - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.list B)))) - (fun e : option (expr (type.base (base.type.list A))) => - match e with - | Some e0 => - reflect_list_cps e0 - (fun ls : option (list (expr (type.base A))) => - match ls with - | Some ls0 => - (fv <-- (e1 <-- list_rect - (fun _ : list (expr (type.base A)) => - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.list B)))) - (UnderLets.Base []%expr_pat) - (fun (x1 : expr (type.base A)) - (_ : list (expr (type.base A))) - (rec : UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.list B)))) - => - rec' <-- rec; - fx <-- x x1; - UnderLets.Base (fx :: rec')%expr_pat) - ls0; - UnderLets.Base - {| - anyexpr_ty := base.type.list B; - unwrap := e1 |}); - base.try_make_transport_cps - (fun t : base.type => expr (type.base t)) - (let (anyexpr_ty, _) := fv in anyexpr_ty) - (base.type.list B) - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.list B)))) - (fun - a : option - (expr - (type.base - (let (anyexpr_ty, _) := fv in anyexpr_ty)) -> - expr (type.base (base.type.list B))) => - match a with - | Some x' => - UnderLets.Base - (x' - (let - (anyexpr_ty, unwrap) as a0 - return - (expr - (type.base - (let (anyexpr_ty, _) := a0 in - anyexpr_ty))) := fv in - unwrap)) - | None => - UnderLets.Base - (#(ident.List_map)%expr @ - (λ x1 : var (type.base A), - UnderLets.to_expr (x ($x1)))%expr @ x0)%expr_pat - end))%under_lets - | None => - UnderLets.Base - (#(ident.List_map)%expr @ - (λ x1 : var (type.base A), - UnderLets.to_expr (x ($x1)))%expr @ x0)%expr_pat - end) - | None => - UnderLets.Base - (#(ident.List_map)%expr @ - (λ x1 : var (type.base A), - UnderLets.to_expr (x ($x1)))%expr @ x0)%expr_pat - end) -| @ident.List_app A => - fun x x0 : expr (type.base (base.type.list A)) => - Compile.castbe x - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.list A)))) - (fun e : option (expr (type.base (base.type.list A))) => - match e with - | Some e0 => - reflect_list_cps e0 - (fun ls : option (list (expr (type.base A))) => - match ls with - | Some ls0 => - (fv <-- (e1 <-- list_rect - (fun _ : list (expr (type.base A)) => - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.list A)))) - (UnderLets.Base x0) - (fun (x1 : expr (type.base A)) - (_ : list (expr (type.base A))) - (rec : UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.list A)))) - => - rec' <-- rec; - UnderLets.Base (x1 :: rec')%expr_pat) - ls0; - UnderLets.Base - {| - anyexpr_ty := base.type.list A; - unwrap := e1 |}); - base.try_make_transport_cps - (fun t : base.type => expr (type.base t)) - (let (anyexpr_ty, _) := fv in anyexpr_ty) - (base.type.list A) - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.list A)))) - (fun - a : option - (expr - (type.base - (let (anyexpr_ty, _) := fv in anyexpr_ty)) -> - expr (type.base (base.type.list A))) => - match a with - | Some x' => - UnderLets.Base - (x' - (let - (anyexpr_ty, unwrap) as a0 - return - (expr - (type.base - (let (anyexpr_ty, _) := a0 in - anyexpr_ty))) := fv in - unwrap)) - | None => UnderLets.Base (x ++ x0)%expr - end))%under_lets - | None => UnderLets.Base (x ++ x0)%expr - end) - | None => UnderLets.Base (x ++ x0)%expr - end) -| @ident.List_rev A => - fun x : expr (type.base (base.type.list A)) => - reflect_list_cps x - (fun xs : option (list (expr (type.base A))) => - match xs with - | Some xs0 => - base.try_make_transport_cps - (fun A0 : base.type => expr (type.base (base.type.list A0))) A A - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.list A)))) - (fun - a : option - (expr (type.base (base.type.list A)) -> - expr (type.base (base.type.list A))) => - match a with - | Some x' => UnderLets.Base (x' (reify_list (rev xs0))) - | None => UnderLets.Base (#(ident.List_rev)%expr @ x)%expr_pat - end) - | None => UnderLets.Base (#(ident.List_rev)%expr @ x)%expr_pat - end) -| @ident.List_flat_map A B => - fun - (x : expr (type.base A) -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.list B)))) - (x0 : expr (type.base (base.type.list A))) => - Compile.castbe x0 - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.list B)))) - (fun e : option (expr (type.base (base.type.list A))) => - match e with - | Some e0 => - reflect_list_cps e0 - (fun ls : option (list (expr (type.base A))) => - match ls with - | Some ls0 => - (fv <-- (e1 <-- list_rect - (fun _ : list (expr (type.base A)) => - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.list B)))) - (UnderLets.Base []%expr_pat) - (fun (x1 : expr (type.base A)) - (_ : list (expr (type.base A))) - (rec : UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.list B)))) - => - rec' <-- rec; - fx <-- x x1; - UnderLets.Base ($fx ++ rec')%expr) ls0; - UnderLets.Base - {| - anyexpr_ty := base.type.list B; - unwrap := e1 |}); - fv0 <-- do_again (let (anyexpr_ty, _) := fv in anyexpr_ty) - (let - (anyexpr_ty, unwrap) as a - return - (expr - (type.base - (let (anyexpr_ty, _) := a in - anyexpr_ty))) := fv in - unwrap); - base.try_make_transport_cps - (fun t : base.type => expr (type.base t)) - (let (anyexpr_ty, _) := fv in anyexpr_ty) - (base.type.list B) - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.list B)))) - (fun - a : option - (expr - (type.base - (let (anyexpr_ty, _) := fv in anyexpr_ty)) -> - expr (type.base (base.type.list B))) => - match a with - | Some x' => UnderLets.Base (x' fv0) - | None => - UnderLets.Base - (#(ident.List_flat_map)%expr @ - (λ x1 : var (type.base A), - UnderLets.to_expr (x ($x1)))%expr @ x0)%expr_pat - end))%under_lets - | None => - UnderLets.Base - (#(ident.List_flat_map)%expr @ - (λ x1 : var (type.base A), - UnderLets.to_expr (x ($x1)))%expr @ x0)%expr_pat - end) - | None => - UnderLets.Base - (#(ident.List_flat_map)%expr @ - (λ x1 : var (type.base A), - UnderLets.to_expr (x ($x1)))%expr @ x0)%expr_pat - end) -| @ident.List_partition A => - fun - (x : expr (type.base A) -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.bool))) - (x0 : expr (type.base (base.type.list A))) => - Compile.castbe x0 - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.list A * base.type.list A)%etype))) - (fun e : option (expr (type.base (base.type.list A))) => - match e with - | Some e0 => - reflect_list_cps e0 - (fun ls : option (list (expr (type.base A))) => - match ls with - | Some ls0 => - (fv <-- (e1 <-- list_rect - (fun _ : list (expr (type.base A)) => - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.list A * - base.type.list A)%etype))) - (UnderLets.Base ([], [])%expr_pat) - (fun (x1 : expr (type.base A)) - (_ : list (expr (type.base A))) - (rec : UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.list A * - base.type.list A)%etype))) - => - rec' <-- rec; - fx <-- id x x1; - UnderLets.Base - (#(ident.prod_rect)%expr @ - (λ g - d : expr - (type.base - (base.type.list A)), - (#(ident.bool_rect)%expr @ - (λ _ : expr - (type.base base.type.unit), - ($x1 :: $g, $d)%expr_pat) @ - (λ _ : expr - (type.base base.type.unit), - ($g, $x1 :: $d)%expr_pat) @ $fx)%expr_pat)%expr @ - rec')%expr_pat) ls0; - UnderLets.Base - {| - anyexpr_ty := (base.type.list A * - base.type.list A)%etype; - unwrap := e1 |}); - fv0 <-- do_again (let (anyexpr_ty, _) := fv in anyexpr_ty) - (let - (anyexpr_ty, unwrap) as a - return - (expr - (type.base - (let (anyexpr_ty, _) := a in - anyexpr_ty))) := fv in - unwrap); - base.try_make_transport_cps - (fun t : base.type => expr (type.base t)) - (let (anyexpr_ty, _) := fv in anyexpr_ty) - (base.type.list A * base.type.list A) - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.list A * base.type.list A)%etype))) - (fun - a : option - (expr - (type.base - (let (anyexpr_ty, _) := fv in anyexpr_ty)) -> - expr - (type.base - (base.type.list A * base.type.list A)%etype)) - => - match a with - | Some x' => UnderLets.Base (x' fv0) - | None => - UnderLets.Base - (#(ident.List_partition)%expr @ - (λ x1 : var (type.base A), - UnderLets.to_expr (x ($x1)))%expr @ x0)%expr_pat - end))%under_lets - | None => - UnderLets.Base - (#(ident.List_partition)%expr @ - (λ x1 : var (type.base A), - UnderLets.to_expr (x ($x1)))%expr @ x0)%expr_pat - end) - | None => - UnderLets.Base - (#(ident.List_partition)%expr @ - (λ x1 : var (type.base A), - UnderLets.to_expr (x ($x1)))%expr @ x0)%expr_pat - end) -| @ident.List_fold_right A B => - fun - (x : expr (type.base B) -> - expr (type.base A) -> - UnderLets.UnderLets base.type ident var (expr (type.base A))) - (x0 : expr (type.base A)) (x1 : expr (type.base (base.type.list B))) => - Compile.castv x - (UnderLets.UnderLets base.type ident var (expr (type.base A))) - (fun - f : option - (expr (type.base B) -> - expr (type.base A) -> - UnderLets.UnderLets base.type ident var (expr (type.base A))) - => - match f with - | Some f0 => - reflect_list_cps x1 - (fun ls : option (list (expr (type.base B))) => - match ls with - | Some ls0 => - (fv <-- (e <-- list_rect - (fun _ : list (expr (type.base B)) => - UnderLets.UnderLets base.type ident var - (expr (type.base A))) - (UnderLets.Base x0) - (fun (x2 : expr (type.base B)) - (_ : list (expr (type.base B))) - (rec : UnderLets.UnderLets base.type - ident var (expr (type.base A))) - => rec' <-- rec; - f0 x2 rec') ls0; - UnderLets.Base {| anyexpr_ty := A; unwrap := e |}); - base.try_make_transport_cps - (fun t : base.type => expr (type.base t)) - (let (anyexpr_ty, _) := fv in anyexpr_ty) A - (UnderLets.UnderLets base.type ident var - (expr (type.base A))) - (fun - a : option - (expr - (type.base - (let (anyexpr_ty, _) := fv in anyexpr_ty)) -> - expr (type.base A)) => - match a with - | Some x' => - UnderLets.Base - (x' - (let - (anyexpr_ty, unwrap) as a0 - return - (expr - (type.base - (let (anyexpr_ty, _) := a0 in - anyexpr_ty))) := fv in - unwrap)) - | None => - UnderLets.Base - (#(ident.List_fold_right)%expr @ - (λ (x2 : var (type.base B))(x3 : var - (type.base A)), - UnderLets.to_expr (x ($x2) ($x3)))%expr @ x0 @ - x1)%expr_pat - end))%under_lets - | None => - UnderLets.Base - (#(ident.List_fold_right)%expr @ - (λ (x2 : var (type.base B))(x3 : var (type.base A)), - UnderLets.to_expr (x ($x2) ($x3)))%expr @ x0 @ x1)%expr_pat - end) - | None => - UnderLets.Base - (#(ident.List_fold_right)%expr @ - (λ (x2 : var (type.base B))(x3 : var (type.base A)), - UnderLets.to_expr (x ($x2) ($x3)))%expr @ x0 @ x1)%expr_pat - end) -| @ident.List_update_nth T => - fun (x : expr (type.base base.type.nat)) - (x0 : expr (type.base T) -> - UnderLets.UnderLets base.type ident var (expr (type.base T))) - (x1 : expr (type.base (base.type.list T))) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option nat) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun _ : Z => None - | base.type.bool => fun _ : bool => None - | base.type.nat => fun v0 : nat => Some v0 - end v - | _ => None - end - with - | Some args => - Compile.castv x0 - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.list T)))) - (fun - f : option - (expr (type.base T) -> - UnderLets.UnderLets base.type ident var - (expr (type.base T))) => - match f with - | Some f0 => - reflect_list_cps x1 - (fun ls : option (list (expr (type.base T))) => - match ls with - | Some ls0 => - (fv <-- (e <-- (retv <---- update_nth args - (fun - x2 : UnderLets.UnderLets - base.type - ident var - (expr - (type.base - T)) => - x3 <-- x2; - f0 x3) - (map UnderLets.Base - ls0); - UnderLets.Base (reify_list retv)); - UnderLets.Base - {| - anyexpr_ty := base.type.list T; - unwrap := e |}); - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) - (let (anyexpr_ty, _) := fv in anyexpr_ty) - (base.type.list T) - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.list T)))) - (fun - a : option - (expr - (type.base - (let (anyexpr_ty, _) := fv in - anyexpr_ty)) -> - expr (type.base (base.type.list T))) - => - match a with - | Some x' => - UnderLets.Base - (x' - (let - (anyexpr_ty, unwrap) as a0 - return - (expr - (type.base - (let (anyexpr_ty, _) := - a0 in - anyexpr_ty))) := fv in - unwrap)) - | None => - UnderLets.Base - (#(ident.List_update_nth)%expr @ x @ - (λ x2 : var (type.base T), - UnderLets.to_expr (x0 ($x2)))%expr @ x1)%expr_pat - end))%under_lets - | None => - UnderLets.Base - (#(ident.List_update_nth)%expr @ x @ - (λ x2 : var (type.base T), - UnderLets.to_expr (x0 ($x2)))%expr @ x1)%expr_pat - end) - | None => - UnderLets.Base - (#(ident.List_update_nth)%expr @ x @ - (λ x2 : var (type.base T), - UnderLets.to_expr (x0 ($x2)))%expr @ x1)%expr_pat - end) - | None => - UnderLets.Base - (#(ident.List_update_nth)%expr @ x @ - (λ x2 : var (type.base T), - UnderLets.to_expr (x0 ($x2)))%expr @ x1)%expr_pat - end - | ($_)%expr | @expr.Abs _ _ _ _ _ _ => - UnderLets.Base - (#(ident.List_update_nth)%expr @ x @ - (λ x2 : var (type.base T), - UnderLets.to_expr (x0 ($x2)))%expr @ x1)%expr_pat - | _ => - UnderLets.Base - (#(ident.List_update_nth)%expr @ x @ - (λ x3 : var (type.base T), - UnderLets.to_expr (x0 ($x3)))%expr @ x1)%expr_pat - end -| @ident.List_nth_default T => - fun (x : expr (type.base T)) (x0 : expr (type.base (base.type.list T))) - (x1 : expr (type.base base.type.nat)) => - match x1 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option nat) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun _ : Z => None - | base.type.bool => fun _ : bool => None - | base.type.nat => fun v0 : nat => Some v0 - end v - | _ => None - end - with - | Some args => - Compile.castbe x - (UnderLets.UnderLets base.type ident var (expr (type.base T))) - (fun default : option (expr (type.base T)) => - match default with - | Some default0 => - reflect_list_cps x0 - (fun ls : option (list (expr (type.base T))) => - match ls with - | Some ls0 => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) T T - (UnderLets.UnderLets base.type ident var - (expr (type.base T))) - (fun - a : option - (expr (type.base T) -> - expr (type.base T)) => - match a with - | Some x' => - UnderLets.Base - (x' (nth_default default0 ls0 args)) - | None => - UnderLets.Base - (#(ident.List_nth_default)%expr @ x @ x0 @ - x1)%expr_pat - end) - | None => - UnderLets.Base - (#(ident.List_nth_default)%expr @ x @ x0 @ x1)%expr_pat - end) - | None => - UnderLets.Base - (#(ident.List_nth_default)%expr @ x @ x0 @ x1)%expr_pat - end) - | None => - UnderLets.Base - (#(ident.List_nth_default)%expr @ x @ x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.List_nth_default)%expr @ x @ x0 @ x1)%expr_pat - end -| ident.Z_add => - fun x x0 : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => UnderLets.Base ##((args + args0)%Z)%expr - | None => - if args =? 0 - then UnderLets.Base x0 - else UnderLets.Base (x + x0)%expr - end - | @expr.App _ _ _ s _ f x1 => - if args =? 0 - then UnderLets.Base x0 - else - match f with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args >? 0 - then - UnderLets.Base (##(args) - x' v)%expr - else - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident - var - (expr (type.base base.type.Z))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 - base.type.Z - (UnderLets.UnderLets base.type - ident var - (expr (type.base base.type.Z))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base - base.type.Z)) => - match a0 with - | Some x'0 => - if args <? 0 - then - UnderLets.Base - (- - (##((- args)%Z) + x'0 v0))%expr - else - match - s as t4 - return - (Compile.value' false t4 -> - UnderLets.UnderLets - base.type ident var - (expr - (type.base - base.type.Z))) - with - | type.base t4 => - fun - v1 : expr - (type.base t4) - => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) - t4 base.type.Z - (UnderLets.UnderLets - base.type ident var - (expr - (type.base - base.type.Z))) - (fun - a1 : option - (expr - (type.base - t4) -> - expr - (type.base - base.type.Z)) - => - match a1 with - | Some x'1 => - UnderLets.Base - (x - x'1 v1)%expr - | None => - UnderLets.Base - (x + x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' - false s0 -> - Compile.value' - true d0 => - UnderLets.Base - (x + x0)%expr - end (Compile.reflect x1) - | None => - UnderLets.Base (x + x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x + x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x + x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x + x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x + x0)%expr - end - | _ => UnderLets.Base (x + x0)%expr - end - | _ => - if args =? 0 - then UnderLets.Base x0 - else UnderLets.Base (x + x0)%expr - end - | None => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - if args =? 0 - then UnderLets.Base x - else UnderLets.Base (x + x0)%expr - | None => UnderLets.Base (x + x0)%expr - end - | @expr.App _ _ _ s _ #(idc0)%expr_pat x1 => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (x - x' v)%expr - | None => UnderLets.Base (x + x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x + x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x + x0)%expr - end - | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ - (_ @ _)%expr_pat _ | @expr.App _ _ _ s _ - (@expr.LetIn _ _ _ _ _ _ _) _ => UnderLets.Base (x + x0)%expr - | _ => UnderLets.Base (x + x0)%expr - end - end - | ($_)%expr => - match x0 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t1 v0 => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v1 : Z => Some v1 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v0 - | _ => None - end - with - | Some args => - if args =? 0 - then UnderLets.Base x - else UnderLets.Base (x + x0)%expr - | None => UnderLets.Base (x + x0)%expr - end - | @expr.App _ _ _ s _ #(idc)%expr_pat x1 => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (x - x' v0)%expr - | None => UnderLets.Base (x + x0)%expr - end) - | (s0 -> d0)%ptype => - fun _ : Compile.value' false s0 -> Compile.value' true d0 - => UnderLets.Base (x + x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x + x0)%expr - end - | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base (x + x0)%expr - | _ => UnderLets.Base (x + x0)%expr - end - | @expr.Abs _ _ _ _ _ _ => - match x0 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match - t0 as t1 return (base.base_interp t1 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - if args =? 0 - then UnderLets.Base x - else UnderLets.Base (x + x0)%expr - | None => UnderLets.Base (x + x0)%expr - end - | @expr.App _ _ _ s0 _ #(idc)%expr_pat x1 => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (x - x' v)%expr - | None => UnderLets.Base (x + x0)%expr - end) - | (s1 -> d1)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d1 - => UnderLets.Base (x + x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x + x0)%expr - end - | @expr.App _ _ _ s0 _ ($_)%expr _ | @expr.App _ _ _ s0 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base (x + x0)%expr - | _ => UnderLets.Base (x + x0)%expr - end - | @expr.App _ _ _ s _ f x1 => - match x0 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match - t0 as t1 return (base.base_interp t1 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - if args =? 0 - then UnderLets.Base x - else - match f with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args >? 0 - then - UnderLets.Base (##(args) - x' v)%expr - else - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident - var - (expr (type.base base.type.Z))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 - base.type.Z - (UnderLets.UnderLets base.type - ident var - (expr (type.base base.type.Z))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base - base.type.Z)) => - match a0 with - | Some x'0 => - if args <? 0 - then - UnderLets.Base - (- - (x'0 v0 + ##((- args)%Z)))%expr - else - match - s as t4 - return - (Compile.value' false t4 -> - UnderLets.UnderLets - base.type ident var - (expr - (type.base - base.type.Z))) - with - | type.base t4 => - fun - v1 : expr - (type.base t4) - => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) - t4 base.type.Z - (UnderLets.UnderLets - base.type ident var - (expr - (type.base - base.type.Z))) - (fun - a1 : option - (expr - (type.base - t4) -> - expr - (type.base - base.type.Z)) - => - match a1 with - | Some x'1 => - UnderLets.Base - (x0 - x'1 v1)%expr - | None => - UnderLets.Base - (x + x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' - false s0 -> - Compile.value' - true d0 => - UnderLets.Base - (x + x0)%expr - end (Compile.reflect x1) - | None => - UnderLets.Base (x + x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x + x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x + x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x + x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x + x0)%expr - end - | _ => UnderLets.Base (x + x0)%expr - end - | None => - match f with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (x0 - x' v)%expr - | None => UnderLets.Base (x + x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x + x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x + x0)%expr - end - | _ => UnderLets.Base (x + x0)%expr - end - end - | ($_)%expr => - match f with - | #(idc)%expr_pat => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (x0 - x' v0)%expr - | None => UnderLets.Base (x + x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x + x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x + x0)%expr - end - | _ => UnderLets.Base (x + x0)%expr - end - | @expr.Abs _ _ _ _ _ _ => - match f with - | #(idc)%expr_pat => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (x0 - x' v)%expr - | None => UnderLets.Base (x + x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x + x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x + x0)%expr - end - | _ => UnderLets.Base (x + x0)%expr - end - | @expr.App _ _ _ s0 _ #(idc)%expr_pat x2 => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match f with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s0 as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident - var (expr (type.base base.type.Z))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 base.type.Z - (UnderLets.UnderLets base.type ident - var - (expr (type.base base.type.Z))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.Base - (- (x' v + x'0 v0))%expr - | None => - UnderLets.Base (x + x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x + x0)%expr - end (Compile.reflect x2) - | None => UnderLets.Base (x + x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x + x0)%expr - end (Compile.reflect x1) - | None => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (x - x' v)%expr - | None => UnderLets.Base (x + x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x + x0)%expr - end (Compile.reflect x2) - end - | ($_)%expr => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (x - x' v0)%expr - | None => UnderLets.Base (x + x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x + x0)%expr - end (Compile.reflect x2) - | @expr.LetIn _ _ _ _ _ _ _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (x - x' v)%expr - | None => UnderLets.Base (x + x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x + x0)%expr - end (Compile.reflect x2) - | _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (x - x' v)%expr - | None => UnderLets.Base (x + x0)%expr - end) - | (s2 -> d2)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d2 => - UnderLets.Base (x + x0)%expr - end (Compile.reflect x2) - end - | None => - match f with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (x0 - x' v)%expr - | None => UnderLets.Base (x + x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x + x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x + x0)%expr - end - | _ => UnderLets.Base (x + x0)%expr - end - end - | @expr.App _ _ _ s0 _ ($_)%expr _ => - match f with - | #(idc)%expr_pat => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (x0 - x' v0)%expr - | None => UnderLets.Base (x + x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x + x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x + x0)%expr - end - | _ => UnderLets.Base (x + x0)%expr - end - | @expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 - _ (_ @ _)%expr_pat _ => - match f with - | #(idc)%expr_pat => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (x0 - x' v)%expr - | None => UnderLets.Base (x + x0)%expr - end) - | (s2 -> d2)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d2 => - UnderLets.Base (x + x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x + x0)%expr - end - | _ => UnderLets.Base (x + x0)%expr - end - | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - match f with - | #(idc)%expr_pat => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (x0 - x' v)%expr - | None => UnderLets.Base (x + x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x + x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x + x0)%expr - end - | _ => UnderLets.Base (x + x0)%expr - end - | @expr.LetIn _ _ _ _ _ _ _ => - match f with - | #(idc)%expr_pat => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (x0 - x' v)%expr - | None => UnderLets.Base (x + x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x + x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x + x0)%expr - end - | _ => UnderLets.Base (x + x0)%expr - end - end - | @expr.LetIn _ _ _ _ _ _ _ => - match x0 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match - t0 as t1 return (base.base_interp t1 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - if args =? 0 - then UnderLets.Base x - else UnderLets.Base (x + x0)%expr - | None => UnderLets.Base (x + x0)%expr - end - | @expr.App _ _ _ s _ #(idc)%expr_pat x2 => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (x - x' v)%expr - | None => UnderLets.Base (x + x0)%expr - end) - | (s0 -> d0)%ptype => - fun _ : Compile.value' false s0 -> Compile.value' true d0 - => UnderLets.Base (x + x0)%expr - end (Compile.reflect x2) - | None => UnderLets.Base (x + x0)%expr - end - | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base (x + x0)%expr - | _ => UnderLets.Base (x + x0)%expr - end - end -| ident.Z_mul => - fun x x0 : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => UnderLets.Base ##((args * args0)%Z)%expr - | None => - if args =? 0 - then UnderLets.Base ##(0)%expr - else - if args =? 1 - then UnderLets.Base x0 - else - if args =? -1 - then UnderLets.Base (- x0)%expr - else - if args <? 0 - then UnderLets.Base (- (##((- args)%Z) * x0))%expr - else - if args =? 2 ^ Z.log2 args - then UnderLets.Base (x0 << Z.log2 args)%expr - else UnderLets.Base (x * x0)%expr - end - | @expr.App _ _ _ s _ f x1 => - if args =? 0 - then UnderLets.Base ##(0)%expr - else - if args =? 1 - then UnderLets.Base x0 - else - match f with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) - t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args =? -1 - then UnderLets.Base (x' v) - else - if args =? -1 - then UnderLets.Base (- x0)%expr - else - if args <? 0 - then - UnderLets.Base - (- (##((- args)%Z) * x0))%expr - else - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type - ident var - (expr (type.base base.type.Z))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 - base.type.Z - (UnderLets.UnderLets base.type - ident var - (expr - (type.base base.type.Z))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base - base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.Base - (- (x * x'0 v0))%expr - | None => - UnderLets.Base - (x * x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x * x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) - | None => - if args =? -1 - then UnderLets.Base (- x0)%expr - else - if args <? 0 - then UnderLets.Base (- (##((- args)%Z) * x0))%expr - else - if args =? 2 ^ Z.log2 args - then UnderLets.Base (x0 << Z.log2 args)%expr - else UnderLets.Base (x * x0)%expr - end - | _ => - if args =? -1 - then UnderLets.Base (- x0)%expr - else - if args <? 0 - then UnderLets.Base (- (##((- args)%Z) * x0))%expr - else - if args =? 2 ^ Z.log2 args - then UnderLets.Base (x0 << Z.log2 args)%expr - else UnderLets.Base (x * x0)%expr - end - | _ => - if args =? 0 - then UnderLets.Base ##(0)%expr - else - if args =? 1 - then UnderLets.Base x0 - else - if args =? -1 - then UnderLets.Base (- x0)%expr - else - if args <? 0 - then UnderLets.Base (- (##((- args)%Z) * x0))%expr - else - if args =? 2 ^ Z.log2 args - then UnderLets.Base (x0 << Z.log2 args)%expr - else UnderLets.Base (x * x0)%expr - end - | None => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - if args =? 0 - then UnderLets.Base ##(0)%expr - else - if args =? 1 - then UnderLets.Base x - else - if args =? -1 - then UnderLets.Base (- x)%expr - else - if args <? 0 - then UnderLets.Base (- (x * ##((- args)%Z)))%expr - else - if args =? 2 ^ Z.log2 args - then UnderLets.Base (x << Z.log2 args)%expr - else UnderLets.Base (x * x0)%expr - | None => UnderLets.Base (x * x0)%expr - end - | @expr.App _ _ _ s _ #(idc0)%expr_pat x1 => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (- (x * x' v))%expr - | None => UnderLets.Base (x * x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x * x0)%expr - end - | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ - (_ @ _)%expr_pat _ | @expr.App _ _ _ s _ - (@expr.LetIn _ _ _ _ _ _ _) _ => UnderLets.Base (x * x0)%expr - | _ => UnderLets.Base (x * x0)%expr - end - end - | ($_)%expr => - match x0 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t1 v0 => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v1 : Z => Some v1 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v0 - | _ => None - end - with - | Some args => - if args =? 0 - then UnderLets.Base ##(0)%expr - else - if args =? 1 - then UnderLets.Base x - else - if args =? -1 - then UnderLets.Base (- x)%expr - else - if args <? 0 - then UnderLets.Base (- (x * ##((- args)%Z)))%expr - else - if args =? 2 ^ Z.log2 args - then UnderLets.Base (x << Z.log2 args)%expr - else UnderLets.Base (x * x0)%expr - | None => UnderLets.Base (x * x0)%expr - end - | @expr.App _ _ _ s _ #(idc)%expr_pat x1 => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (- (x * x' v0))%expr - | None => UnderLets.Base (x * x0)%expr - end) - | (s0 -> d0)%ptype => - fun _ : Compile.value' false s0 -> Compile.value' true d0 - => UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x * x0)%expr - end - | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base (x * x0)%expr - | _ => UnderLets.Base (x * x0)%expr - end - | @expr.Abs _ _ _ _ _ _ => - match x0 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match - t0 as t1 return (base.base_interp t1 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - if args =? 0 - then UnderLets.Base ##(0)%expr - else - if args =? 1 - then UnderLets.Base x - else - if args =? -1 - then UnderLets.Base (- x)%expr - else - if args <? 0 - then UnderLets.Base (- (x * ##((- args)%Z)))%expr - else - if args =? 2 ^ Z.log2 args - then UnderLets.Base (x << Z.log2 args)%expr - else UnderLets.Base (x * x0)%expr - | None => UnderLets.Base (x * x0)%expr - end - | @expr.App _ _ _ s0 _ #(idc)%expr_pat x1 => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (- (x * x' v))%expr - | None => UnderLets.Base (x * x0)%expr - end) - | (s1 -> d1)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d1 - => UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x * x0)%expr - end - | @expr.App _ _ _ s0 _ ($_)%expr _ | @expr.App _ _ _ s0 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base (x * x0)%expr - | _ => UnderLets.Base (x * x0)%expr - end - | @expr.App _ _ _ s _ f x1 => - match x0 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match - t0 as t1 return (base.base_interp t1 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - if args =? 0 - then UnderLets.Base ##(0)%expr - else - if args =? 1 - then UnderLets.Base x - else - match f with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) - t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args =? -1 - then UnderLets.Base (x' v) - else - if args =? -1 - then UnderLets.Base (- x)%expr - else - if args <? 0 - then - UnderLets.Base - (- (x * ##((- args)%Z)))%expr - else - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type - ident var - (expr (type.base base.type.Z))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 - base.type.Z - (UnderLets.UnderLets base.type - ident var - (expr - (type.base base.type.Z))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base - base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.Base - (- (x'0 v0 * x0))%expr - | None => - UnderLets.Base - (x * x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x * x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) - | None => - if args =? -1 - then UnderLets.Base (- x)%expr - else - if args <? 0 - then UnderLets.Base (- (x * ##((- args)%Z)))%expr - else - if args =? 2 ^ Z.log2 args - then UnderLets.Base (x << Z.log2 args)%expr - else UnderLets.Base (x * x0)%expr - end - | _ => - if args =? -1 - then UnderLets.Base (- x)%expr - else - if args <? 0 - then UnderLets.Base (- (x * ##((- args)%Z)))%expr - else - if args =? 2 ^ Z.log2 args - then UnderLets.Base (x << Z.log2 args)%expr - else UnderLets.Base (x * x0)%expr - end - | None => - match f with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - UnderLets.Base (- (x' v * x0))%expr - | None => UnderLets.Base (x * x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x * x0)%expr - end - | _ => UnderLets.Base (x * x0)%expr - end - end - | ($_)%expr => - match f with - | #(idc)%expr_pat => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (- (x' v0 * x0))%expr - | None => UnderLets.Base (x * x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x * x0)%expr - end - | _ => UnderLets.Base (x * x0)%expr - end - | @expr.Abs _ _ _ _ _ _ => - match f with - | #(idc)%expr_pat => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (- (x' v * x0))%expr - | None => UnderLets.Base (x * x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x * x0)%expr - end - | _ => UnderLets.Base (x * x0)%expr - end - | @expr.App _ _ _ s0 _ #(idc)%expr_pat x2 => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match f with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s0 as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident - var (expr (type.base base.type.Z))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 base.type.Z - (UnderLets.UnderLets base.type ident - var - (expr (type.base base.type.Z))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.Base - (x' v * x'0 v0)%expr - | None => - UnderLets.Base (x * x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x2) - | None => UnderLets.Base (x * x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) - | None => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - UnderLets.Base (- (x * x' v))%expr - | None => UnderLets.Base (x * x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x2) - end - | ($_)%expr => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (- (x * x' v0))%expr - | None => UnderLets.Base (x * x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x2) - | @expr.LetIn _ _ _ _ _ _ _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (- (x * x' v))%expr - | None => UnderLets.Base (x * x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x2) - | _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (- (x * x' v))%expr - | None => UnderLets.Base (x * x0)%expr - end) - | (s2 -> d2)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d2 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x2) - end - | None => - match f with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - UnderLets.Base (- (x' v * x0))%expr - | None => UnderLets.Base (x * x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x * x0)%expr - end - | _ => UnderLets.Base (x * x0)%expr - end - end - | @expr.App _ _ _ s0 _ ($_)%expr _ => - match f with - | #(idc)%expr_pat => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (- (x' v0 * x0))%expr - | None => UnderLets.Base (x * x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x * x0)%expr - end - | _ => UnderLets.Base (x * x0)%expr - end - | @expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 - _ (_ @ _)%expr_pat _ => - match f with - | #(idc)%expr_pat => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (- (x' v * x0))%expr - | None => UnderLets.Base (x * x0)%expr - end) - | (s2 -> d2)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d2 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x * x0)%expr - end - | _ => UnderLets.Base (x * x0)%expr - end - | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - match f with - | #(idc)%expr_pat => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (- (x' v * x0))%expr - | None => UnderLets.Base (x * x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x * x0)%expr - end - | _ => UnderLets.Base (x * x0)%expr - end - | @expr.LetIn _ _ _ _ _ _ _ => - match f with - | #(idc)%expr_pat => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (- (x' v * x0))%expr - | None => UnderLets.Base (x * x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x * x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x * x0)%expr - end - | _ => UnderLets.Base (x * x0)%expr - end - end - | @expr.LetIn _ _ _ _ _ _ _ => - match x0 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match - t0 as t1 return (base.base_interp t1 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - if args =? 0 - then UnderLets.Base ##(0)%expr - else - if args =? 1 - then UnderLets.Base x - else - if args =? -1 - then UnderLets.Base (- x)%expr - else - if args <? 0 - then UnderLets.Base (- (x * ##((- args)%Z)))%expr - else - if args =? 2 ^ Z.log2 args - then UnderLets.Base (x << Z.log2 args)%expr - else UnderLets.Base (x * x0)%expr - | None => UnderLets.Base (x * x0)%expr - end - | @expr.App _ _ _ s _ #(idc)%expr_pat x2 => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (- (x * x' v))%expr - | None => UnderLets.Base (x * x0)%expr - end) - | (s0 -> d0)%ptype => - fun _ : Compile.value' false s0 -> Compile.value' true d0 - => UnderLets.Base (x * x0)%expr - end (Compile.reflect x2) - | None => UnderLets.Base (x * x0)%expr - end - | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base (x * x0)%expr - | _ => UnderLets.Base (x * x0)%expr - end - end -| ident.Z_pow => - fun x x0 : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => UnderLets.Base ##(args ^ args0)%expr - | None => - UnderLets.Base (#(ident.Z_pow)%expr @ x @ x0)%expr_pat - end - | _ => UnderLets.Base (#(ident.Z_pow)%expr @ x @ x0)%expr_pat - end - | None => UnderLets.Base (#(ident.Z_pow)%expr @ x @ x0)%expr_pat - end - | _ => UnderLets.Base (#(ident.Z_pow)%expr @ x @ x0)%expr_pat - end -| ident.Z_sub => - fun x x0 : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => UnderLets.Base ##((args - args0)%Z)%expr - | None => - if args =? 0 - then UnderLets.Base (- x0)%expr - else - if args <? 0 - then UnderLets.Base (- (##((- args)%Z) + x0))%expr - else UnderLets.Base (x - x0)%expr - end - | @expr.App _ _ _ s _ #(idc0)%expr_pat x1 => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args =? 0 - then UnderLets.Base (x' v) - else - if args =? 0 - then UnderLets.Base (- x0)%expr - else - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 base.type.Z - (UnderLets.UnderLets base.type ident - var (expr (type.base base.type.Z))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) - => - match a0 with - | Some x'0 => - if args >? 0 - then - UnderLets.Base - (##(args) + x'0 v0)%expr - else - match - s as t4 - return - (Compile.value' false t4 -> - UnderLets.UnderLets - base.type ident var - (expr - (type.base base.type.Z))) - with - | type.base t4 => - fun v1 : expr (type.base t4) - => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t4 - base.type.Z - (UnderLets.UnderLets - base.type ident var - (expr - (type.base - base.type.Z))) - (fun - a1 : option - (expr - (type.base t4) -> - expr - (type.base - base.type.Z)) - => - match a1 with - | Some x'1 => - if args <? 0 - then - UnderLets.Base - (x'1 v1 - - ##((- args)%Z))%expr - else - if args <? 0 - then - UnderLets.Base - (- - (##((- args)%Z) + - x0))%expr - else - match - s as t5 - return - (Compile.value' - false t5 -> - UnderLets.UnderLets - base.type - ident var - (expr - (type.base - base.type.Z))) - with - | type.base t5 => - fun - v2 : - expr - (type.base - t5) => - base.try_make_transport_cps - (fun - t1 : base.type - => - expr - (type.base - t1)) t5 - base.type.Z - (UnderLets.UnderLets - base.type - ident var - (expr - (type.base - base.type.Z))) - (fun - a2 : - option - (expr - (type.base - t5) -> - expr - (type.base - base.type.Z)) - => - match - a2 - with - | Some - x'2 => - UnderLets.Base - (x + - x'2 v2)%expr - | None => - UnderLets.Base - (x - x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' - false s0 -> - Compile.value' - true d0 - => - UnderLets.Base - (x - x0)%expr - end - (Compile.reflect - x1) - | None => - UnderLets.Base - (x - x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false - s0 -> - Compile.value' true d0 - => - UnderLets.Base (x - x0)%expr - end (Compile.reflect x1) - | None => - UnderLets.Base (x - x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x - x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x - x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x - x0)%expr - end (Compile.reflect x1) - | None => - if args =? 0 - then UnderLets.Base (- x0)%expr - else - if args <? 0 - then UnderLets.Base (- (##((- args)%Z) + x0))%expr - else UnderLets.Base (x - x0)%expr - end - | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ - (_ @ _)%expr_pat _ | @expr.App _ _ _ s _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - if args =? 0 - then UnderLets.Base (- x0)%expr - else - if args <? 0 - then UnderLets.Base (- (##((- args)%Z) + x0))%expr - else UnderLets.Base (x - x0)%expr - | _ => - if args =? 0 - then UnderLets.Base (- x0)%expr - else - if args <? 0 - then UnderLets.Base (- (##((- args)%Z) + x0))%expr - else UnderLets.Base (x - x0)%expr - end - | None => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - if args =? 0 - then UnderLets.Base x - else - if args <? 0 - then UnderLets.Base (x + ##((- args)%Z))%expr - else UnderLets.Base (x - x0)%expr - | None => UnderLets.Base (x - x0)%expr - end - | @expr.App _ _ _ s _ #(idc0)%expr_pat x1 => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (x + x' v)%expr - | None => UnderLets.Base (x - x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x - x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x - x0)%expr - end - | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ - (_ @ _)%expr_pat _ | @expr.App _ _ _ s _ - (@expr.LetIn _ _ _ _ _ _ _) _ => UnderLets.Base (x - x0)%expr - | _ => UnderLets.Base (x - x0)%expr - end - end - | ($_)%expr => - match x0 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t1 v0 => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v1 : Z => Some v1 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v0 - | _ => None - end - with - | Some args => - if args =? 0 - then UnderLets.Base x - else - if args <? 0 - then UnderLets.Base (x + ##((- args)%Z))%expr - else UnderLets.Base (x - x0)%expr - | None => UnderLets.Base (x - x0)%expr - end - | @expr.App _ _ _ s _ #(idc)%expr_pat x1 => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (x + x' v0)%expr - | None => UnderLets.Base (x - x0)%expr - end) - | (s0 -> d0)%ptype => - fun _ : Compile.value' false s0 -> Compile.value' true d0 - => UnderLets.Base (x - x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x - x0)%expr - end - | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base (x - x0)%expr - | _ => UnderLets.Base (x - x0)%expr - end - | @expr.Abs _ _ _ _ _ _ => - match x0 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match - t0 as t1 return (base.base_interp t1 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - if args =? 0 - then UnderLets.Base x - else - if args <? 0 - then UnderLets.Base (x + ##((- args)%Z))%expr - else UnderLets.Base (x - x0)%expr - | None => UnderLets.Base (x - x0)%expr - end - | @expr.App _ _ _ s0 _ #(idc)%expr_pat x1 => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (x + x' v)%expr - | None => UnderLets.Base (x - x0)%expr - end) - | (s1 -> d1)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d1 - => UnderLets.Base (x - x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x - x0)%expr - end - | @expr.App _ _ _ s0 _ ($_)%expr _ | @expr.App _ _ _ s0 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base (x - x0)%expr - | _ => UnderLets.Base (x - x0)%expr - end - | @expr.App _ _ _ s _ f x1 => - match x0 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match - t0 as t1 return (base.base_interp t1 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - if args =? 0 - then UnderLets.Base x - else - match f with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args >? 0 - then - UnderLets.Base - (- (x' v + ##((- args)%Z)))%expr - else - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident - var - (expr (type.base base.type.Z))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 - base.type.Z - (UnderLets.UnderLets base.type - ident var - (expr (type.base base.type.Z))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base - base.type.Z)) => - match a0 with - | Some x'0 => - if args <? 0 - then - UnderLets.Base - (##((- args)%Z) - x'0 v0)%expr - else - if args <? 0 - then - UnderLets.Base - (x + ##((- args)%Z))%expr - else - match - s as t4 - return - (Compile.value' false - t4 -> - UnderLets.UnderLets - base.type ident var - (expr - (type.base - base.type.Z))) - with - | type.base t4 => - fun - v1 : expr - (type.base t4) - => - base.try_make_transport_cps - (fun t1 : base.type - => - expr (type.base t1)) - t4 base.type.Z - (UnderLets.UnderLets - base.type ident - var - (expr - (type.base - base.type.Z))) - (fun - a1 : option - (expr - (type.base - t4) -> - expr - (type.base - base.type.Z)) - => - match a1 with - | Some x'1 => - UnderLets.Base - (- - (x'1 v1 + x0))%expr - | None => - UnderLets.Base - (x - x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' - false s0 -> - Compile.value' - true d0 => - UnderLets.Base - (x - x0)%expr - end (Compile.reflect x1) - | None => - UnderLets.Base (x - x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x - x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x - x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x - x0)%expr - end (Compile.reflect x1) - | None => - if args <? 0 - then UnderLets.Base (x + ##((- args)%Z))%expr - else UnderLets.Base (x - x0)%expr - end - | _ => - if args <? 0 - then UnderLets.Base (x + ##((- args)%Z))%expr - else UnderLets.Base (x - x0)%expr - end - | None => - match f with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - UnderLets.Base (- (x' v + x0))%expr - | None => UnderLets.Base (x - x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x - x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x - x0)%expr - end - | _ => UnderLets.Base (x - x0)%expr - end - end - | ($_)%expr => - match f with - | #(idc)%expr_pat => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (- (x' v0 + x0))%expr - | None => UnderLets.Base (x - x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x - x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x - x0)%expr - end - | _ => UnderLets.Base (x - x0)%expr - end - | @expr.Abs _ _ _ _ _ _ => - match f with - | #(idc)%expr_pat => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (- (x' v + x0))%expr - | None => UnderLets.Base (x - x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x - x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x - x0)%expr - end - | _ => UnderLets.Base (x - x0)%expr - end - | @expr.App _ _ _ s0 _ #(idc)%expr_pat x2 => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match f with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s0 as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident - var (expr (type.base base.type.Z))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 base.type.Z - (UnderLets.UnderLets base.type ident - var - (expr (type.base base.type.Z))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.Base - (x'0 v0 - x' v)%expr - | None => - UnderLets.Base (x - x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x - x0)%expr - end (Compile.reflect x2) - | None => UnderLets.Base (x - x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x - x0)%expr - end (Compile.reflect x1) - | None => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (x + x' v)%expr - | None => UnderLets.Base (x - x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x - x0)%expr - end (Compile.reflect x2) - end - | ($_)%expr => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (x + x' v0)%expr - | None => UnderLets.Base (x - x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x - x0)%expr - end (Compile.reflect x2) - | @expr.LetIn _ _ _ _ _ _ _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (x + x' v)%expr - | None => UnderLets.Base (x - x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x - x0)%expr - end (Compile.reflect x2) - | _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (x + x' v)%expr - | None => UnderLets.Base (x - x0)%expr - end) - | (s2 -> d2)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d2 => - UnderLets.Base (x - x0)%expr - end (Compile.reflect x2) - end - | None => - match f with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - UnderLets.Base (- (x' v + x0))%expr - | None => UnderLets.Base (x - x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x - x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x - x0)%expr - end - | _ => UnderLets.Base (x - x0)%expr - end - end - | @expr.App _ _ _ s0 _ ($_)%expr _ => - match f with - | #(idc)%expr_pat => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (- (x' v0 + x0))%expr - | None => UnderLets.Base (x - x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x - x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x - x0)%expr - end - | _ => UnderLets.Base (x - x0)%expr - end - | @expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 - _ (_ @ _)%expr_pat _ => - match f with - | #(idc)%expr_pat => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (- (x' v + x0))%expr - | None => UnderLets.Base (x - x0)%expr - end) - | (s2 -> d2)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d2 => - UnderLets.Base (x - x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x - x0)%expr - end - | _ => UnderLets.Base (x - x0)%expr - end - | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - match f with - | #(idc)%expr_pat => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (- (x' v + x0))%expr - | None => UnderLets.Base (x - x0)%expr - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (x - x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x - x0)%expr - end - | _ => UnderLets.Base (x - x0)%expr - end - | @expr.LetIn _ _ _ _ _ _ _ => - match f with - | #(idc)%expr_pat => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (- (x' v + x0))%expr - | None => UnderLets.Base (x - x0)%expr - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base (x - x0)%expr - end (Compile.reflect x1) - | None => UnderLets.Base (x - x0)%expr - end - | _ => UnderLets.Base (x - x0)%expr - end - end - | @expr.LetIn _ _ _ _ _ _ _ => - match x0 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match - t0 as t1 return (base.base_interp t1 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - if args =? 0 - then UnderLets.Base x - else - if args <? 0 - then UnderLets.Base (x + ##((- args)%Z))%expr - else UnderLets.Base (x - x0)%expr - | None => UnderLets.Base (x - x0)%expr - end - | @expr.App _ _ _ s _ #(idc)%expr_pat x2 => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (x + x' v)%expr - | None => UnderLets.Base (x - x0)%expr - end) - | (s0 -> d0)%ptype => - fun _ : Compile.value' false s0 -> Compile.value' true d0 - => UnderLets.Base (x - x0)%expr - end (Compile.reflect x2) - | None => UnderLets.Base (x - x0)%expr - end - | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base (x - x0)%expr - | _ => UnderLets.Base (x - x0)%expr - end - end -| ident.Z_opp => - fun x : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => UnderLets.Base ##((- args)%Z)%expr - | None => UnderLets.Base (- x)%expr - end - | @expr.App _ _ _ s _ #(idc)%expr_pat x0 => - match match idc with - | ident.Z_opp => Some tt - | _ => None - end with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base base.type.Z))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => UnderLets.Base (x' v) - | None => UnderLets.Base (- x)%expr - end) - | (s0 -> d0)%ptype => - fun _ : Compile.value' false s0 -> Compile.value' true d0 => - UnderLets.Base (- x)%expr - end (Compile.reflect x0) - | None => UnderLets.Base (- x)%expr - end - | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ (_ @ _)%expr_pat _ | - @expr.App _ _ _ s _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base (- x)%expr - | _ => UnderLets.Base (- x)%expr - end -| ident.Z_div => - fun x x0 : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => UnderLets.Base ##((args / args0)%Z)%expr - | None => UnderLets.Base (x / x0)%expr - end - | _ => UnderLets.Base (x / x0)%expr - end - | None => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - if args =? 2 ^ Z.log2 args - then UnderLets.Base (x >> Z.log2 args)%expr - else UnderLets.Base (x / x0)%expr - | None => UnderLets.Base (x / x0)%expr - end - | _ => UnderLets.Base (x / x0)%expr - end - end - | ($_)%expr => - match x0 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t1 v0 => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v1 : Z => Some v1 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v0 - | _ => None - end - with - | Some args => - if args =? 2 ^ Z.log2 args - then UnderLets.Base (x >> Z.log2 args)%expr - else UnderLets.Base (x / x0)%expr - | None => UnderLets.Base (x / x0)%expr - end - | _ => UnderLets.Base (x / x0)%expr - end - | _ => - match x0 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match - t0 as t1 return (base.base_interp t1 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - if args =? 2 ^ Z.log2 args - then UnderLets.Base (x >> Z.log2 args)%expr - else UnderLets.Base (x / x0)%expr - | None => UnderLets.Base (x / x0)%expr - end - | _ => UnderLets.Base (x / x0)%expr - end - end -| ident.Z_modulo => - fun x x0 : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => UnderLets.Base ##((args mod args0)%Z)%expr - | None => UnderLets.Base (x mod x0)%expr - end - | _ => UnderLets.Base (x mod x0)%expr - end - | None => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - if args =? 2 ^ Z.log2 args - then - UnderLets.Base - (#(ident.Z_land (args - 1))%expr @ x)%expr_pat - else UnderLets.Base (x mod x0)%expr - | None => UnderLets.Base (x mod x0)%expr - end - | _ => UnderLets.Base (x mod x0)%expr - end - end - | ($_)%expr => - match x0 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t1 v0 => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v1 : Z => Some v1 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v0 - | _ => None - end - with - | Some args => - if args =? 2 ^ Z.log2 args - then - UnderLets.Base - (#(ident.Z_land (args - 1))%expr @ x)%expr_pat - else UnderLets.Base (x mod x0)%expr - | None => UnderLets.Base (x mod x0)%expr - end - | _ => UnderLets.Base (x mod x0)%expr - end - | _ => - match x0 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match - t0 as t1 return (base.base_interp t1 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - if args =? 2 ^ Z.log2 args - then - UnderLets.Base - (#(ident.Z_land (args - 1))%expr @ x)%expr_pat - else UnderLets.Base (x mod x0)%expr - | None => UnderLets.Base (x mod x0)%expr - end - | _ => UnderLets.Base (x mod x0)%expr - end - end -| ident.Z_eqb => - fun x x0 : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => UnderLets.Base ##(args =? args0)%expr - | None => - UnderLets.Base (#(ident.Z_eqb)%expr @ x @ x0)%expr_pat - end - | _ => UnderLets.Base (#(ident.Z_eqb)%expr @ x @ x0)%expr_pat - end - | None => UnderLets.Base (#(ident.Z_eqb)%expr @ x @ x0)%expr_pat - end - | _ => UnderLets.Base (#(ident.Z_eqb)%expr @ x @ x0)%expr_pat - end -| ident.Z_leb => - fun x x0 : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => UnderLets.Base ##(args <=? args0)%expr - | None => - UnderLets.Base (#(ident.Z_leb)%expr @ x @ x0)%expr_pat - end - | _ => UnderLets.Base (#(ident.Z_leb)%expr @ x @ x0)%expr_pat - end - | None => UnderLets.Base (#(ident.Z_leb)%expr @ x @ x0)%expr_pat - end - | _ => UnderLets.Base (#(ident.Z_leb)%expr @ x @ x0)%expr_pat - end -| ident.Z_of_nat => - fun x : expr (type.base base.type.nat) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option nat) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun _ : Z => None - | base.type.bool => fun _ : bool => None - | base.type.nat => fun v0 : nat => Some v0 - end v - | _ => None - end - with - | Some args => UnderLets.Base ##(Z.of_nat args)%expr - | None => UnderLets.Base (#(ident.Z_of_nat)%expr @ x)%expr_pat - end - | _ => UnderLets.Base (#(ident.Z_of_nat)%expr @ x)%expr_pat - end -| ident.Z_shiftr offset => - fun x : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => UnderLets.Base ##(Z.shiftr args offset)%expr - | None => UnderLets.Base (x >> offset)%expr - end - | _ => UnderLets.Base (x >> offset)%expr - end -| ident.Z_shiftl offset => - fun x : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => UnderLets.Base ##(Z.shiftl args offset)%expr - | None => UnderLets.Base (x << offset)%expr - end - | _ => UnderLets.Base (x << offset)%expr - end -| ident.Z_land mask => - fun x : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => UnderLets.Base ##(Z.land args mask)%expr - | None => UnderLets.Base (#(ident.Z_land mask)%expr @ x)%expr_pat - end - | _ => UnderLets.Base (#(ident.Z_land mask)%expr @ x)%expr_pat - end -| ident.Z_mul_split => - fun x x0 x1 : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match x1 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - UnderLets.Base - (let - '(a, b) := - Definitions.Z.mul_split args args0 args1 in - (##(a)%expr, ##(b)%expr)%expr_pat) - | None => - if args0 =? 0 - then - UnderLets.Base (##(0)%expr, ##(0)%expr)%expr_pat - else - if args0 =? 1 - then UnderLets.Base (x1, ##(0)%expr)%expr_pat - else - if args0 =? -1 - then - UnderLets.Base - ((- x1)%expr, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_mul_split_concrete args)%expr @ - x0 @ x1)%expr_pat - end - | _ => - if args0 =? 0 - then UnderLets.Base (##(0)%expr, ##(0)%expr)%expr_pat - else - if args0 =? 1 - then UnderLets.Base (x1, ##(0)%expr)%expr_pat - else - if args0 =? -1 - then - UnderLets.Base ((- x1)%expr, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_mul_split_concrete args)%expr @ x0 @ - x1)%expr_pat - end - | None => - match x1 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - if args0 =? 0 - then - UnderLets.Base (##(0)%expr, ##(0)%expr)%expr_pat - else - if args0 =? 1 - then UnderLets.Base (x0, ##(0)%expr)%expr_pat - else - if args0 =? -1 - then - UnderLets.Base - ((- x0)%expr, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_mul_split_concrete args)%expr @ - x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_mul_split_concrete args)%expr @ x0 @ - x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_mul_split_concrete args)%expr @ x0 @ x1)%expr_pat - end - end - | ($_)%expr => - match x1 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t2 v0 => - match - t2 as t3 return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v1 : Z => Some v1 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v0 - | _ => None - end - with - | Some args0 => - if args0 =? 0 - then UnderLets.Base (##(0)%expr, ##(0)%expr)%expr_pat - else - if args0 =? 1 - then UnderLets.Base (x0, ##(0)%expr)%expr_pat - else - if args0 =? -1 - then - UnderLets.Base ((- x0)%expr, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_mul_split_concrete args)%expr @ x0 @ - x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_mul_split_concrete args)%expr @ x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_mul_split_concrete args)%expr @ x0 @ x1)%expr_pat - end - | _ => - match x1 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - if args0 =? 0 - then UnderLets.Base (##(0)%expr, ##(0)%expr)%expr_pat - else - if args0 =? 1 - then UnderLets.Base (x0, ##(0)%expr)%expr_pat - else - if args0 =? -1 - then - UnderLets.Base ((- x0)%expr, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_mul_split_concrete args)%expr @ x0 @ - x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_mul_split_concrete args)%expr @ x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_mul_split_concrete args)%expr @ x0 @ x1)%expr_pat - end - end - | None => - UnderLets.Base (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat - end - | _ => UnderLets.Base (#(ident.Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat - end -| ident.Z_mul_split_concrete s => - fun x x0 : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - UnderLets.Base - (let - '(a, b) := Definitions.Z.mul_split s args args0 in - (##(a)%expr, ##(b)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_mul_split_concrete s)%expr @ x @ x0)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_mul_split_concrete s)%expr @ x @ x0)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_mul_split_concrete s)%expr @ x @ x0)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_mul_split_concrete s)%expr @ x @ x0)%expr_pat - end -| ident.Z_add_get_carry => - fun x x0 x1 : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match x1 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - UnderLets.Base - (let - '(a, b) := - Definitions.Z.add_get_carry_full args args0 - args1 in (##(a)%expr, ##(b)%expr)%expr_pat) - | None => - if args0 =? 0 - then UnderLets.Base (x1, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s _ f x2 => - if args0 =? 0 - then UnderLets.Base (x1, ##(0)%expr)%expr_pat - else - match f with - | #(idc1)%expr_pat => - match - match idc1 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => - expr (type.base t3)) t2 base.type.Z - (UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) - => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete - args)%expr @ x0 @ - x' v)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v0)%expr, - (- - (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ x @ - x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x0 @ x1)%expr_pat - end - | _ => - if args0 =? 0 - then UnderLets.Base (x1, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ x0 @ - x1)%expr_pat - end - | None => - match x1 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - if args0 =? 0 - then UnderLets.Base (x0, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s _ #(idc1)%expr_pat x2 => - match - match idc1 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => expr (type.base t3)) - t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete - args)%expr @ x0 @ x' v)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * - base.type.Z)%etype) => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- - (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ x @ - x0 @ x1)%expr_pat - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ x @ x0 @ - x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ - (_ @ _)%expr_pat _ | @expr.App _ _ _ s _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ x0 @ - x1)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ x0 @ - x1)%expr_pat - end - end - | ($_)%expr => - match x1 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t2 v0 => - match - t2 as t3 return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v1 : Z => Some v1 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v0 - | _ => None - end - with - | Some args0 => - if args0 =? 0 - then UnderLets.Base (x0, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ x0 @ - x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ x0 @ - x1)%expr_pat - end - | @expr.App _ _ _ s _ #(idc0)%expr_pat x2 => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => expr (type.base t3)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete args)%expr @ - x0 @ x' v0)%expr_pat - (fun - v1 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v1)%expr, - (- (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ x @ x0 @ - x1)%expr_pat - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ x0 @ - x1)%expr_pat - end - | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ - (_ @ _)%expr_pat _ | @expr.App _ _ _ s _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ x0 @ x1)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ x0 @ x1)%expr_pat - end - | @expr.Abs _ _ _ _ _ _ => - match x1 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - if args0 =? 0 - then UnderLets.Base (x0, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ x0 @ - x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ x0 @ - x1)%expr_pat - end - | @expr.App _ _ _ s0 _ #(idc0)%expr_pat x2 => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete args)%expr @ - x0 @ x' v)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ x @ x0 @ - x1)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ x0 @ - x1)%expr_pat - end - | @expr.App _ _ _ s0 _ ($_)%expr _ | @expr.App _ _ _ s0 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 _ - (_ @ _)%expr_pat _ | @expr.App _ _ _ s0 _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ x0 @ x1)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s _ f x2 => - match x1 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - if args0 =? 0 - then UnderLets.Base (x0, ##(0)%expr)%expr_pat - else - match f with - | #(idc1)%expr_pat => - match - match idc1 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => - expr (type.base t3)) t2 base.type.Z - (UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) - => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete - args)%expr @ x1 @ - x' v)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v0)%expr, - (- - (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ x @ - x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x0 @ x1)%expr_pat - end - | None => - match f with - | #(idc1)%expr_pat => - match - match idc1 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => - expr (type.base t3)) t2 base.type.Z - (UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) - => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete - args)%expr @ x1 @ x' v)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v0)%expr, - (- - (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ x @ x0 @ - x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x0 @ x1)%expr_pat - end - end - | ($_)%expr => - match f with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => expr (type.base t3)) - t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete - args)%expr @ x1 @ x' v0)%expr_pat - (fun - v1 : var - (type.base - (base.type.Z * - base.type.Z)%etype) => - UnderLets.Base - (#(ident.fst)%expr @ ($v1)%expr, - (- - (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ x @ - x0 @ x1)%expr_pat - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ x @ x0 @ - x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ x0 @ - x1)%expr_pat - end - | @expr.Abs _ _ _ _ _ _ => - match f with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) - t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete - args)%expr @ x1 @ x' v)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * - base.type.Z)%etype) => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- - (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ x @ - x0 @ x1)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ x @ x0 @ - x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ x0 @ - x1)%expr_pat - end - | @expr.App _ _ _ s0 _ f0 x3 => - match f with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) - t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete - args)%expr @ x1 @ x' v)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * - base.type.Z)%etype) => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- - (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ x @ - x0 @ x1)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ x @ x0 @ - x1)%expr_pat - end (Compile.reflect x2) - | None => - match f0 with - | #(idc1)%expr_pat => - match - match idc1 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => - expr (type.base t3)) t2 - base.type.Z - (UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr - (type.base base.type.Z)) - => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete - args)%expr @ x0 @ - x' v)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v0)%expr, - (- - (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ x @ - x0 @ x1)%expr_pat - end (Compile.reflect x3) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x0 @ x1)%expr_pat - end - end - | ($_)%expr => - match f0 with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => - expr (type.base t3)) t2 base.type.Z - (UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) - => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete - args)%expr @ x0 @ x' v0)%expr_pat - (fun - v1 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v1)%expr, - (- - (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ x @ x0 @ - x1)%expr_pat - end (Compile.reflect x3) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x0 @ x1)%expr_pat - end - | @expr.LetIn _ _ _ _ _ _ _ => - match f0 with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t2 base.type.Z - (UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) - => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete - args)%expr @ x0 @ x' v)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v0)%expr, - (- - (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ x @ x0 @ - x1)%expr_pat - end (Compile.reflect x3) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x0 @ x1)%expr_pat - end - | _ => - match f0 with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t2 base.type.Z - (UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) - => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete - args)%expr @ x0 @ x' v)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v0)%expr, - (- - (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s2 -> d2)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ x @ x0 @ - x1)%expr_pat - end (Compile.reflect x3) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x0 @ x1)%expr_pat - end - end - | @expr.LetIn _ _ _ _ _ _ _ => - match f with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) - t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete - args)%expr @ x1 @ x' v)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * - base.type.Z)%etype) => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- - (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ x @ - x0 @ x1)%expr_pat - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ x @ x0 @ - x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ x0 @ - x1)%expr_pat - end - end - | @expr.LetIn _ _ _ _ _ _ _ => - match x1 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - if args0 =? 0 - then UnderLets.Base (x0, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ x0 @ - x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ x0 @ - x1)%expr_pat - end - | @expr.App _ _ _ s _ #(idc0)%expr_pat x3 => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete args)%expr @ - x0 @ x' v)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ x @ x0 @ - x1)%expr_pat - end) - | (s0 -> d0)%ptype => - fun - _ : Compile.value' false s0 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat - end (Compile.reflect x3) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ x0 @ - x1)%expr_pat - end - | @expr.App _ _ _ s _ ($_)%expr _ | @expr.App _ _ _ s _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ - (_ @ _)%expr_pat _ | @expr.App _ _ _ s _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ x0 @ x1)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ x0 @ x1)%expr_pat - end - end - | None => - UnderLets.Base - (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base (#(ident.Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat - end -| ident.Z_add_get_carry_concrete s => - fun x x0 : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - UnderLets.Base - (let - '(a, b) := - Definitions.Z.add_get_carry_full s args args0 in - (##(a)%expr, ##(b)%expr)%expr_pat) - | None => - if args <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x0 @ - ##((- args)%Z)%expr)%expr_pat - (fun - v : var - (type.base (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v)%expr, - (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) - else - if args =? 0 - then UnderLets.Base (x0, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | ($_)%expr => - if args <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x0 @ - ##((- args)%Z)%expr)%expr_pat - (fun - v0 : var (type.base (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - else - if args =? 0 - then UnderLets.Base (x0, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | @expr.App _ _ _ s0 _ #(idc0)%expr_pat x1 => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ - x @ x' v)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end) - | (s1 -> d0)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x1) - | None => - if args <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x0 @ - ##((- args)%Z)%expr)%expr_pat - (fun - v : var - (type.base (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v)%expr, - (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) - else - if args =? 0 - then UnderLets.Base (x0, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s0 _ ($_)%expr _ => - if args <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x0 @ - ##((- args)%Z)%expr)%expr_pat - (fun - v0 : var (type.base (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - else - if args =? 0 - then UnderLets.Base (x0, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | @expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ - _ s0 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s0 _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - if args <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x0 @ - ##((- args)%Z)%expr)%expr_pat - (fun v : var (type.base (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v)%expr, - (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) - else - if args =? 0 - then UnderLets.Base (x0, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | _ => - if args <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x0 @ - ##((- args)%Z)%expr)%expr_pat - (fun v : var (type.base (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v)%expr, - (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) - else - if args =? 0 - then UnderLets.Base (x0, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | None => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - if args <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ - ##((- args)%Z)%expr)%expr_pat - (fun - v : var - (type.base (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v)%expr, - (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) - else - if args =? 0 - then UnderLets.Base (x, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s0 _ #(idc0)%expr_pat x1 => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ - x @ x' v)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end) - | (s1 -> d0)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x1) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s0 _ ($_)%expr _ | @expr.App _ _ _ s0 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 _ - (_ @ _)%expr_pat _ | @expr.App _ _ _ s0 _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - end - | ($_)%expr => - match x0 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t1 v0 => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v1 : Z => Some v1 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v0 - | _ => None - end - with - | Some args => - if args <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ - ##((- args)%Z)%expr)%expr_pat - (fun - v0 : var (type.base (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - else - if args =? 0 - then UnderLets.Base (x, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s0 _ #(idc)%expr_pat x1 => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ - x' v0)%expr_pat - (fun - v1 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v1)%expr, - (- (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - end) - | (s1 -> d0)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d0 - => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x1) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s0 _ ($_)%expr _ | @expr.App _ _ _ s0 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.Abs _ _ _ _ _ _ => - match x0 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match - t0 as t1 return (base.base_interp t1 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - if args <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ - ##((- args)%Z)%expr)%expr_pat - (fun v : var (type.base (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v)%expr, - (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) - else - if args =? 0 - then UnderLets.Base (x, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s1 _ #(idc)%expr_pat x1 => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s1 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ - x' v)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - end) - | (s2 -> d1)%ptype => - fun _ : Compile.value' false s2 -> Compile.value' true d1 - => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x1) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s1 _ ($_)%expr _ | @expr.App _ _ _ s1 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s1 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s0 _ #(idc)%expr_pat x1 => - match match idc with - | ident.Z_opp => Some tt - | _ => None - end with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x0 @ - x' v)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * base.type.Z)%etype) => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end) - | (s1 -> d0)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x1) - | None => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - if args <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ - ##((- args)%Z)%expr)%expr_pat - (fun - v : var - (type.base (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v)%expr, - (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) - else - if args =? 0 - then UnderLets.Base (x, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s1 _ #(idc0)%expr_pat x2 => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s1 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ - x @ x' v)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ - x @ x0)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s1 _ ($_)%expr _ | @expr.App _ _ _ s1 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s1 _ - (_ @ _)%expr_pat _ | @expr.App _ _ _ s1 _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - end - | @expr.App _ _ _ s0 _ ($_)%expr _ => - match x0 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t1 v0 => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v1 : Z => Some v1 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v0 - | _ => None - end - with - | Some args => - if args <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ - ##((- args)%Z)%expr)%expr_pat - (fun - v0 : var (type.base (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - else - if args =? 0 - then UnderLets.Base (x, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s1 _ #(idc)%expr_pat x2 => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s1 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ - x' v0)%expr_pat - (fun - v1 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v1)%expr, - (- (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - end) - | (s2 -> d1)%ptype => - fun _ : Compile.value' false s2 -> Compile.value' true d1 - => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s1 _ ($_)%expr _ | @expr.App _ _ _ s1 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s1 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ => - match x0 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match - t0 as t1 return (base.base_interp t1 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - if args <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ - ##((- args)%Z)%expr)%expr_pat - (fun v : var (type.base (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v)%expr, - (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) - else - if args =? 0 - then UnderLets.Base (x, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s2 _ #(idc)%expr_pat x2 => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s2 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ - x' v)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - end) - | (s3 -> d2)%ptype => - fun _ : Compile.value' false s3 -> Compile.value' true d2 - => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s2 _ ($_)%expr _ | @expr.App _ _ _ s2 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s2 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s0 _ (_ @ _)%expr_pat _ => - match x0 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match - t0 as t1 return (base.base_interp t1 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - if args <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ - ##((- args)%Z)%expr)%expr_pat - (fun v : var (type.base (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v)%expr, - (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) - else - if args =? 0 - then UnderLets.Base (x, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s2 _ #(idc)%expr_pat x3 => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s2 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ - x' v)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - end) - | (s3 -> d2)%ptype => - fun _ : Compile.value' false s3 -> Compile.value' true d2 - => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x3) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s2 _ ($_)%expr _ | @expr.App _ _ _ s2 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s2 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - match x0 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match - t0 as t1 return (base.base_interp t1 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - if args <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ - ##((- args)%Z)%expr)%expr_pat - (fun v : var (type.base (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v)%expr, - (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) - else - if args =? 0 - then UnderLets.Base (x, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s1 _ #(idc)%expr_pat x3 => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s1 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ - x' v)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - end) - | (s2 -> d1)%ptype => - fun _ : Compile.value' false s2 -> Compile.value' true d1 - => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x3) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s1 _ ($_)%expr _ | @expr.App _ _ _ s1 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s1 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.LetIn _ _ _ _ _ _ _ => - match x0 with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match - t0 as t1 return (base.base_interp t1 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - if args <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ - ##((- args)%Z)%expr)%expr_pat - (fun v : var (type.base (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v)%expr, - (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) - else - if args =? 0 - then UnderLets.Base (x, ##(0)%expr)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s0 _ #(idc)%expr_pat x2 => - match - match idc with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - UnderLets.UnderLet - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ - x' v)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ - x0)%expr_pat - end) - | (s1 -> d0)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d0 - => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - | @expr.App _ _ _ s0 _ ($_)%expr _ | @expr.App _ _ _ s0 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 _ (_ @ _)%expr_pat - _ | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_get_carry_concrete s)%expr @ x @ x0)%expr_pat - end - end -| ident.Z_add_with_carry => - fun x x0 x1 : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match x1 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - UnderLets.Base - ##(Definitions.Z.add_with_carry args args0 - args1)%expr - | None => - if args =? 0 - then UnderLets.Base (x0 + x1)%expr - else - UnderLets.Base - (#(ident.Z_add_with_carry)%expr @ x @ x0 @ x1)%expr_pat - end - | _ => - if args =? 0 - then UnderLets.Base (x0 + x1)%expr - else - UnderLets.Base - (#(ident.Z_add_with_carry)%expr @ x @ x0 @ x1)%expr_pat - end - | None => - if args =? 0 - then UnderLets.Base (x0 + x1)%expr - else - UnderLets.Base - (#(ident.Z_add_with_carry)%expr @ x @ x0 @ x1)%expr_pat - end - | _ => - if args =? 0 - then UnderLets.Base (x0 + x1)%expr - else - UnderLets.Base - (#(ident.Z_add_with_carry)%expr @ x @ x0 @ x1)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_add_with_carry)%expr @ x @ x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_with_carry)%expr @ x @ x0 @ x1)%expr_pat - end -| ident.Z_add_with_get_carry => - fun x x0 x1 x2 : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match x1 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - match x2 with - | #(idc2)%expr_pat => - match - match idc2 with - | @ident.Literal t3 v => - match - t3 as t4 - return - (base.base_interp t4 -> option Z) - with - | base.type.unit => - fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => - fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args2 => - UnderLets.Base - (let - '(a, b) := - Definitions.Z.add_with_get_carry_full - args args0 args1 args2 in - (##(a)%expr, ##(b)%expr)%expr_pat) - | None => - if (args0 =? 0) && (args1 =? 0) - then - UnderLets.Base (x2, ##(0)%expr)%expr_pat - else - if args0 =? 0 - then - UnderLets.Base - (#(ident.Z_add_get_carry_concrete - args)%expr @ x1 @ x2)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - end - | _ => - if (args0 =? 0) && (args1 =? 0) - then UnderLets.Base (x2, ##(0)%expr)%expr_pat - else - if args0 =? 0 - then - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x1 @ x2)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - end - | None => - match x2 with - | #(idc2)%expr_pat => - match - match idc2 with - | @ident.Literal t3 v => - match - t3 as t4 - return - (base.base_interp t4 -> option Z) - with - | base.type.unit => - fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => - fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - if (args0 =? 0) && (args1 =? 0) - then - UnderLets.Base (x1, ##(0)%expr)%expr_pat - else - if args0 =? 0 - then - UnderLets.Base - (#(ident.Z_add_get_carry_concrete - args)%expr @ x1 @ x2)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - | None => - if args0 =? 0 - then - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x1 @ x2)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - end - | _ => - if args0 =? 0 - then - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x1 @ x2)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - end - end - | ($_)%expr => - match x2 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t3 v0 => - match - t3 as t4 - return (base.base_interp t4 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v1 : Z => Some v1 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v0 - | _ => None - end - with - | Some args1 => - if (args0 =? 0) && (args1 =? 0) - then UnderLets.Base (x1, ##(0)%expr)%expr_pat - else - if args0 =? 0 - then - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x1 @ x2)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - | None => - if args0 =? 0 - then - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x1 @ x2)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - end - | _ => - if args0 =? 0 - then - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x1 @ x2)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | _ => - match x2 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - if (args0 =? 0) && (args1 =? 0) - then UnderLets.Base (x1, ##(0)%expr)%expr_pat - else - if args0 =? 0 - then - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x1 @ x2)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - | None => - if args0 =? 0 - then - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x1 @ x2)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - end - | _ => - if args0 =? 0 - then - UnderLets.Base - (#(ident.Z_add_get_carry_concrete args)%expr @ - x1 @ x2)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - end - | None => - match x1 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match x2 with - | #(idc2)%expr_pat => - match - match idc2 with - | @ident.Literal t3 v => - match - t3 as t4 - return - (base.base_interp t4 -> option Z) - with - | base.type.unit => - fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => - fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - if (args0 =? 0) && (args1 =? 0) - then - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - end - | ($_)%expr => - match x1 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t2 v0 => - match - t2 as t3 return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v1 : Z => Some v1 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v0 - | _ => None - end - with - | Some args0 => - match x2 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t3 v0 => - match - t3 as t4 - return (base.base_interp t4 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v1 : Z => Some v1 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v0 - | _ => None - end - with - | Some args1 => - if (args0 =? 0) && (args1 =? 0) - then - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ x0 @ - x1 @ x2)%expr_pat - end - | @expr.App _ _ _ s _ f x3 => - match x1 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match x2 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - if (args0 =? 0) && (args1 =? 0) - then - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | @expr.App _ _ _ s0 _ #(idc1)%expr_pat x4 => - match - match idc1 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match f with - | #(idc2)%expr_pat => - match - match idc2 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - with - | type.base t3 => - fun v : expr (type.base t3) => - base.try_make_transport_cps - (fun t4 : base.type => - expr (type.base t4)) t3 - base.type.Z - (UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - (fun - a : option - (expr (type.base t3) -> - expr - (type.base - base.type.Z)) => - match a with - | Some x' => - match - s0 as t4 - return - (Compile.value' false - t4 -> - UnderLets.UnderLets - base.type ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - with - | type.base t4 => - fun - v0 : expr - (type.base t4) - => - base.try_make_transport_cps - (fun t5 : base.type - => - expr (type.base t5)) - t4 base.type.Z - (UnderLets.UnderLets - base.type ident - var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - (fun - a0 : option - (expr - (type.base - t4) -> - expr - (type.base - base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - args)%expr @ - x' v @ x1 @ - x'0 v0)%expr_pat - (fun - v1 : - var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (# - (ident.fst)%expr @ - ($v1)%expr, - (- - (# - (ident.snd)%expr @ - $v1)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ - x2)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' - false s1 -> - Compile.value' - true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end (Compile.reflect x4) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end (Compile.reflect x3) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | @expr.App _ _ _ s0 _ ($_)%expr _ | @expr.App _ _ _ - s0 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 - _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s0 _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | None => - match f with - | #(idc1)%expr_pat => - match - match idc1 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match x2 with - | @expr.App _ _ _ s0 _ #(idc2)%expr_pat x4 => - match - match idc2 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - with - | type.base t3 => - fun v : expr (type.base t3) => - base.try_make_transport_cps - (fun t4 : base.type => - expr (type.base t4)) t3 - base.type.Z - (UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - (fun - a : option - (expr (type.base t3) -> - expr - (type.base - base.type.Z)) => - match a with - | Some x' => - match - s0 as t4 - return - (Compile.value' false - t4 -> - UnderLets.UnderLets - base.type ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - with - | type.base t4 => - fun - v0 : expr - (type.base t4) - => - base.try_make_transport_cps - (fun t5 : base.type - => - expr (type.base t5)) - t4 base.type.Z - (UnderLets.UnderLets - base.type ident - var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - (fun - a0 : option - (expr - (type.base - t4) -> - expr - (type.base - base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - args)%expr @ - x' v @ x1 @ - x'0 v0)%expr_pat - (fun - v1 : - var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (# - (ident.fst)%expr @ - ($v1)%expr, - (- - (# - (ident.snd)%expr @ - $v1)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ - x2)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' - false s1 -> - Compile.value' - true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end (Compile.reflect x4) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end (Compile.reflect x3) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - end - | @expr.App _ _ _ s0 _ ($_)%expr _ | - @expr.App _ _ _ s0 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ - s0 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ - s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - end - | ($_)%expr => - match f with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match x2 with - | @expr.App _ _ _ s0 _ #(idc1)%expr_pat x4 => - match - match idc1 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t4 : base.type => - expr (type.base t4)) t3 - base.type.Z - (UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) - => - match a with - | Some x' => - match - s0 as t4 - return - (Compile.value' false t4 -> - UnderLets.UnderLets - base.type ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - with - | type.base t4 => - fun - v1 : expr (type.base t4) - => - base.try_make_transport_cps - (fun t5 : base.type => - expr (type.base t5)) t4 - base.type.Z - (UnderLets.UnderLets - base.type ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - (fun - a0 : option - (expr - (type.base - t4) -> - expr - (type.base - base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - args)%expr @ - x' v0 @ x1 @ - x'0 v1)%expr_pat - (fun - v2 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v2)%expr, - (- - (#(ident.snd)%expr @ - $v2)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false - s1 -> - Compile.value' true - d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end (Compile.reflect x4) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end (Compile.reflect x3) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - end - | @expr.App _ _ _ s0 _ ($_)%expr _ | @expr.App _ - _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App - _ _ _ s0 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ - s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | @expr.Abs _ _ _ _ _ _ => - match f with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match x2 with - | @expr.App _ _ _ s1 _ #(idc1)%expr_pat x4 => - match - match idc1 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => - expr (type.base t3)) t2 - base.type.Z - (UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr - (type.base base.type.Z)) - => - match a with - | Some x' => - match - s1 as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets - base.type ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - with - | type.base t3 => - fun - v0 : expr (type.base t3) - => - base.try_make_transport_cps - (fun t4 : base.type => - expr (type.base t4)) t3 - base.type.Z - (UnderLets.UnderLets - base.type ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - (fun - a0 : option - (expr - (type.base - t3) -> - expr - (type.base - base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - args)%expr @ - x' v @ x1 @ - x'0 v0)%expr_pat - (fun - v1 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v1)%expr, - (- - (#(ident.snd)%expr @ - $v1)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end) - | (s2 -> d2)%ptype => - fun - _ : Compile.value' false - s2 -> - Compile.value' true - d2 => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end (Compile.reflect x4) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end) - | (s2 -> d2)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end (Compile.reflect x3) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - end - | @expr.App _ _ _ s1 _ ($_)%expr _ | @expr.App _ - _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App - _ _ _ s1 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ - s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | @expr.App _ _ _ s0 _ #(idc0)%expr_pat x4 => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match f with - | #(idc1)%expr_pat => - match - match idc1 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => - expr (type.base t3)) t2 base.type.Z - (UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) - => - match a with - | Some x' => - match - s0 as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - with - | type.base t3 => - fun v0 : expr (type.base t3) - => - base.try_make_transport_cps - (fun t4 : base.type => - expr (type.base t4)) t3 - base.type.Z - (UnderLets.UnderLets - base.type ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - (fun - a0 : option - (expr - (type.base t3) -> - expr - (type.base - base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - args)%expr @ - x' v @ x2 @ - x'0 v0)%expr_pat - (fun - v1 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v1)%expr, - (- - (#(ident.snd)%expr @ - $v1)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 - => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end (Compile.reflect x4) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ x @ - x0 @ x1 @ x2)%expr_pat - end (Compile.reflect x3) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | None => - match f with - | #(idc1)%expr_pat => - match - match idc1 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match x2 with - | @expr.App _ _ _ s1 _ #(idc2)%expr_pat x5 => - match - match idc2 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - with - | type.base t3 => - fun v : expr (type.base t3) => - base.try_make_transport_cps - (fun t4 : base.type => - expr (type.base t4)) t3 - base.type.Z - (UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - (fun - a : option - (expr (type.base t3) -> - expr - (type.base - base.type.Z)) => - match a with - | Some x' => - match - s1 as t4 - return - (Compile.value' false - t4 -> - UnderLets.UnderLets - base.type ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - with - | type.base t4 => - fun - v0 : expr - (type.base t4) - => - base.try_make_transport_cps - (fun t5 : base.type - => - expr (type.base t5)) - t4 base.type.Z - (UnderLets.UnderLets - base.type ident - var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - (fun - a0 : option - (expr - (type.base - t4) -> - expr - (type.base - base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - args)%expr @ - x' v @ x1 @ - x'0 v0)%expr_pat - (fun - v1 : - var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (# - (ident.fst)%expr @ - ($v1)%expr, - (- - (# - (ident.snd)%expr @ - $v1)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ - x2)%expr_pat - end) - | (s2 -> d2)%ptype => - fun - _ : Compile.value' - false s2 -> - Compile.value' - true d2 => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end (Compile.reflect x5) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end) - | (s2 -> d2)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end (Compile.reflect x3) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - end - | @expr.App _ _ _ s1 _ ($_)%expr _ | - @expr.App _ _ _ s1 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ - s1 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ - s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - end - | @expr.App _ _ _ s0 _ ($_)%expr _ => - match f with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match x2 with - | @expr.App _ _ _ s1 _ #(idc1)%expr_pat x5 => - match - match idc1 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t4 : base.type => - expr (type.base t4)) t3 - base.type.Z - (UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) - => - match a with - | Some x' => - match - s1 as t4 - return - (Compile.value' false t4 -> - UnderLets.UnderLets - base.type ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - with - | type.base t4 => - fun - v1 : expr (type.base t4) - => - base.try_make_transport_cps - (fun t5 : base.type => - expr (type.base t5)) t4 - base.type.Z - (UnderLets.UnderLets - base.type ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - (fun - a0 : option - (expr - (type.base - t4) -> - expr - (type.base - base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - args)%expr @ - x' v0 @ x1 @ - x'0 v1)%expr_pat - (fun - v2 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v2)%expr, - (- - (#(ident.snd)%expr @ - $v2)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end) - | (s2 -> d2)%ptype => - fun - _ : Compile.value' false - s2 -> - Compile.value' true - d2 => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end (Compile.reflect x5) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end) - | (s2 -> d2)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end (Compile.reflect x3) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - end - | @expr.App _ _ _ s1 _ ($_)%expr _ | @expr.App _ - _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App - _ _ _ s1 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ - s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | @expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ => - match f with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match x2 with - | @expr.App _ _ _ s2 _ #(idc1)%expr_pat x5 => - match - match idc1 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => - expr (type.base t3)) t2 - base.type.Z - (UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr - (type.base base.type.Z)) - => - match a with - | Some x' => - match - s2 as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets - base.type ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - with - | type.base t3 => - fun - v0 : expr (type.base t3) - => - base.try_make_transport_cps - (fun t4 : base.type => - expr (type.base t4)) t3 - base.type.Z - (UnderLets.UnderLets - base.type ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - (fun - a0 : option - (expr - (type.base - t3) -> - expr - (type.base - base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - args)%expr @ - x' v @ x1 @ - x'0 v0)%expr_pat - (fun - v1 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v1)%expr, - (- - (#(ident.snd)%expr @ - $v1)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end) - | (s3 -> d3)%ptype => - fun - _ : Compile.value' false - s3 -> - Compile.value' true - d3 => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end (Compile.reflect x5) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end) - | (s3 -> d3)%ptype => - fun - _ : Compile.value' false s3 -> - Compile.value' true d3 => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end (Compile.reflect x3) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - end - | @expr.App _ _ _ s2 _ ($_)%expr _ | @expr.App _ - _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App - _ _ _ s2 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ - s2 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | @expr.App _ _ _ s0 _ (_ @ _)%expr_pat _ => - match f with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match x2 with - | @expr.App _ _ _ s2 _ #(idc1)%expr_pat x6 => - match - match idc1 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => - expr (type.base t3)) t2 - base.type.Z - (UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr - (type.base base.type.Z)) - => - match a with - | Some x' => - match - s2 as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets - base.type ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - with - | type.base t3 => - fun - v0 : expr (type.base t3) - => - base.try_make_transport_cps - (fun t4 : base.type => - expr (type.base t4)) t3 - base.type.Z - (UnderLets.UnderLets - base.type ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - (fun - a0 : option - (expr - (type.base - t3) -> - expr - (type.base - base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - args)%expr @ - x' v @ x1 @ - x'0 v0)%expr_pat - (fun - v1 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v1)%expr, - (- - (#(ident.snd)%expr @ - $v1)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end) - | (s3 -> d3)%ptype => - fun - _ : Compile.value' false - s3 -> - Compile.value' true - d3 => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end (Compile.reflect x6) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end) - | (s3 -> d3)%ptype => - fun - _ : Compile.value' false s3 -> - Compile.value' true d3 => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end (Compile.reflect x3) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - end - | @expr.App _ _ _ s2 _ ($_)%expr _ | @expr.App _ - _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App - _ _ _ s2 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ - s2 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - match f with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match x2 with - | @expr.App _ _ _ s1 _ #(idc1)%expr_pat x6 => - match - match idc1 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => - expr (type.base t3)) t2 - base.type.Z - (UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr - (type.base base.type.Z)) - => - match a with - | Some x' => - match - s1 as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets - base.type ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - with - | type.base t3 => - fun - v0 : expr (type.base t3) - => - base.try_make_transport_cps - (fun t4 : base.type => - expr (type.base t4)) t3 - base.type.Z - (UnderLets.UnderLets - base.type ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - (fun - a0 : option - (expr - (type.base - t3) -> - expr - (type.base - base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - args)%expr @ - x' v @ x1 @ - x'0 v0)%expr_pat - (fun - v1 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v1)%expr, - (- - (#(ident.snd)%expr @ - $v1)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end) - | (s2 -> d2)%ptype => - fun - _ : Compile.value' false - s2 -> - Compile.value' true - d2 => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end (Compile.reflect x6) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end) - | (s2 -> d2)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end (Compile.reflect x3) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - end - | @expr.App _ _ _ s1 _ ($_)%expr _ | @expr.App _ - _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App - _ _ _ s1 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ - s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | @expr.LetIn _ _ _ _ _ _ _ => - match f with - | #(idc0)%expr_pat => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match x2 with - | @expr.App _ _ _ s0 _ #(idc1)%expr_pat x5 => - match - match idc1 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => - expr (type.base t3)) t2 - base.type.Z - (UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr - (type.base base.type.Z)) - => - match a with - | Some x' => - match - s0 as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets - base.type ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - with - | type.base t3 => - fun - v0 : expr (type.base t3) - => - base.try_make_transport_cps - (fun t4 : base.type => - expr (type.base t4)) t3 - base.type.Z - (UnderLets.UnderLets - base.type ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - (fun - a0 : option - (expr - (type.base - t3) -> - expr - (type.base - base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - args)%expr @ - x' v @ x1 @ - x'0 v0)%expr_pat - (fun - v1 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v1)%expr, - (- - (#(ident.snd)%expr @ - $v1)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false - s1 -> - Compile.value' true - d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end (Compile.reflect x5) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ - x @ x0 @ x1 @ x2)%expr_pat - end (Compile.reflect x3) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - end - | @expr.App _ _ _ s0 _ ($_)%expr _ | @expr.App _ - _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App - _ _ _ s0 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ - s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - end - | _ => - match x1 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match x2 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - if (args0 =? 0) && (args1 =? 0) - then - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete args)%expr @ x0 @ - x1 @ x2)%expr_pat - end - end - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat - end -| ident.Z_add_with_get_carry_concrete s => - fun x x0 x1 : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match x1 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - UnderLets.Base - (let - '(a, b) := - Definitions.Z.add_with_get_carry_full s args - args0 args1 in - (##(a)%expr, ##(b)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s0 _ #(idc)%expr_pat x2 => - match match idc with - | ident.Z_opp => Some tt - | _ => None - end with - | Some _ => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match x1 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => expr (type.base t3)) - t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args0 <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v @ x1 @ - ##((- args0)%Z)%expr)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- - (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - else - match - s0 as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t4 : base.type => - expr (type.base t4)) t3 - base.type.Z - (UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base - base.type.Z)) - => - match a0 with - | Some x'0 => - if args1 <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ - x'0 v0 @ x0 @ - ##((- args1)%Z)%expr)%expr_pat - (fun - v1 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v1)%expr, - (- - (#(ident.snd)%expr @ - $v1)%expr_pat)%expr)%expr_pat) - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ - x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ - x1)%expr_pat - end) - | (s1 -> d0)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end) - | (s1 -> d0)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => expr (type.base t3)) - t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args0 <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v @ x1 @ - ##((- args0)%Z)%expr)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- - (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end) - | (s1 -> d0)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - end - | ($_)%expr => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => expr (type.base t3)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args0 <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v0 @ x1 @ - ##((- args0)%Z)%expr)%expr_pat - (fun - v1 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v1)%expr, - (- - (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s1 -> d0)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | @expr.Abs _ _ _ _ _ _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args0 <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v @ x1 @ - ##((- args0)%Z)%expr)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- - (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | @expr.App _ _ _ s1 _ #(idc1)%expr_pat x3 => - match - match idc1 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => expr (type.base t3)) - t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s1 as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t4 : base.type => - expr (type.base t4)) t3 - base.type.Z - (UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base - base.type.Z)) => - match a0 with - | Some x'0 => - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v @ x0 @ - x'0 v0)%expr_pat - (fun - v1 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v1)%expr, - (- - (#(ident.snd)%expr @ - $v1)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ - x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end (Compile.reflect x3) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => expr (type.base t3)) - t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args0 <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v @ x1 @ - ##((- args0)%Z)%expr)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- - (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - end - | @expr.App _ _ _ s1 _ ($_)%expr _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => expr (type.base t3)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args0 <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v0 @ x1 @ - ##((- args0)%Z)%expr)%expr_pat - (fun - v1 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v1)%expr, - (- - (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | @expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _ | - @expr.App _ _ _ s1 _ (_ @ _)%expr_pat _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args0 <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v @ x1 @ - ##((- args0)%Z)%expr)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- - (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s3 -> d2)%ptype => - fun - _ : Compile.value' false s3 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | @expr.App _ _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args0 <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v @ x1 @ - ##((- args0)%Z)%expr)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- - (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | @expr.LetIn _ _ _ _ _ _ _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args0 <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v @ x1 @ - ##((- args0)%Z)%expr)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- - (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s1 -> d0)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - end - | None => - match x1 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => expr (type.base t3)) - t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args0 <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v @ x0 @ - ##((- args0)%Z)%expr)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- - (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end) - | (s1 -> d0)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s1 _ #(idc1)%expr_pat x3 => - match - match idc1 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => expr (type.base t3)) - t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s1 as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t4 : base.type => - expr (type.base t4)) t3 - base.type.Z - (UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base - base.type.Z)) => - match a0 with - | Some x'0 => - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v @ x0 @ - x'0 v0)%expr_pat - (fun - v1 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v1)%expr, - (- - (#(ident.snd)%expr @ - $v1)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ - x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end (Compile.reflect x3) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s1 _ ($_)%expr _ | @expr.App _ _ _ s1 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s1 _ - (_ @ _)%expr_pat _ | @expr.App _ _ _ s1 _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end - end - | ($_)%expr => - match x1 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t2 v0 => - match - t2 as t3 return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v1 : Z => Some v1 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v0 - | _ => None - end - with - | Some args0 => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => expr (type.base t3)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args0 <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v0 @ x0 @ - ##((- args0)%Z)%expr)%expr_pat - (fun - v1 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v1)%expr, - (- - (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s1 -> d0)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s1 _ #(idc0)%expr_pat x3 => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => expr (type.base t3)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s1 as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t3 => - fun v1 : expr (type.base t3) => - base.try_make_transport_cps - (fun t4 : base.type => - expr (type.base t4)) t3 base.type.Z - (UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v0 @ x0 @ - x'0 v1)%expr_pat - (fun - v2 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v2)%expr, - (- - (#(ident.snd)%expr @ $v2)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end (Compile.reflect x3) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s1 _ ($_)%expr _ | @expr.App _ _ _ s1 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s1 _ - (_ @ _)%expr_pat _ | @expr.App _ _ _ s1 _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - end - | @expr.Abs _ _ _ _ _ _ => - match x1 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args0 <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v @ x0 @ - ##((- args0)%Z)%expr)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- - (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s2 _ #(idc0)%expr_pat x3 => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s2 as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 base.type.Z - (UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v @ x0 @ - x'0 v0)%expr_pat - (fun - v1 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v1)%expr, - (- - (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end) - | (s3 -> d2)%ptype => - fun - _ : Compile.value' false s3 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end (Compile.reflect x3) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s3 -> d2)%ptype => - fun - _ : Compile.value' false s3 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s2 _ ($_)%expr _ | @expr.App _ _ _ s2 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s2 _ - (_ @ _)%expr_pat _ | @expr.App _ _ _ s2 _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - end - | @expr.App _ _ _ s1 _ #(idc0)%expr_pat x3 => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s1 as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr (type.base base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v @ x1 @ - x'0 v0)%expr_pat - (fun - v1 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v1)%expr, - (- - (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x3) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - match x1 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => expr (type.base t3)) - t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args0 <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v @ x0 @ - ##((- args0)%Z)%expr)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- - (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s2 _ #(idc1)%expr_pat x4 => - match - match idc1 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => expr (type.base t3)) - t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s2 as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t4 : base.type => - expr (type.base t4)) t3 - base.type.Z - (UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base - base.type.Z)) => - match a0 with - | Some x'0 => - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v @ x0 @ - x'0 v0)%expr_pat - (fun - v1 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v1)%expr, - (- - (#(ident.snd)%expr @ - $v1)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ - x1)%expr_pat - end) - | (s3 -> d2)%ptype => - fun - _ : Compile.value' false s3 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end (Compile.reflect x4) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end) - | (s3 -> d2)%ptype => - fun - _ : Compile.value' false s3 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s2 _ ($_)%expr _ | @expr.App _ _ _ s2 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s2 _ - (_ @ _)%expr_pat _ | @expr.App _ _ _ s2 _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end - end - | @expr.App _ _ _ s1 _ ($_)%expr _ => - match x1 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t2 v0 => - match - t2 as t3 return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v1 : Z => Some v1 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v0 - | _ => None - end - with - | Some args0 => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => expr (type.base t3)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args0 <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v0 @ x0 @ - ##((- args0)%Z)%expr)%expr_pat - (fun - v1 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v1)%expr, - (- - (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s2 _ #(idc0)%expr_pat x4 => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => expr (type.base t3)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s2 as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t3 => - fun v1 : expr (type.base t3) => - base.try_make_transport_cps - (fun t4 : base.type => - expr (type.base t4)) t3 base.type.Z - (UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v0 @ x0 @ - x'0 v1)%expr_pat - (fun - v2 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v2)%expr, - (- - (#(ident.snd)%expr @ $v2)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end) - | (s3 -> d2)%ptype => - fun - _ : Compile.value' false s3 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end (Compile.reflect x4) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s3 -> d2)%ptype => - fun - _ : Compile.value' false s3 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s2 _ ($_)%expr _ | @expr.App _ _ _ s2 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s2 _ - (_ @ _)%expr_pat _ | @expr.App _ _ _ s2 _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - end - | @expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _ => - match x1 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args0 <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v @ x0 @ - ##((- args0)%Z)%expr)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- - (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s3 -> d2)%ptype => - fun - _ : Compile.value' false s3 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s3 _ #(idc0)%expr_pat x4 => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s3 as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 base.type.Z - (UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v @ x0 @ - x'0 v0)%expr_pat - (fun - v1 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v1)%expr, - (- - (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end) - | (s4 -> d3)%ptype => - fun - _ : Compile.value' false s4 -> - Compile.value' true d3 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end (Compile.reflect x4) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s4 -> d3)%ptype => - fun - _ : Compile.value' false s4 -> - Compile.value' true d3 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s3 _ ($_)%expr _ | @expr.App _ _ _ s3 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s3 _ - (_ @ _)%expr_pat _ | @expr.App _ _ _ s3 _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - end - | @expr.App _ _ _ s1 _ (_ @ _)%expr_pat _ => - match x1 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args0 <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v @ x0 @ - ##((- args0)%Z)%expr)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- - (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s3 -> d2)%ptype => - fun - _ : Compile.value' false s3 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s3 _ #(idc0)%expr_pat x5 => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s3 as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 base.type.Z - (UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v @ x0 @ - x'0 v0)%expr_pat - (fun - v1 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v1)%expr, - (- - (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end) - | (s4 -> d3)%ptype => - fun - _ : Compile.value' false s4 -> - Compile.value' true d3 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end (Compile.reflect x5) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s4 -> d3)%ptype => - fun - _ : Compile.value' false s4 -> - Compile.value' true d3 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s3 _ ($_)%expr _ | @expr.App _ _ _ s3 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s3 _ - (_ @ _)%expr_pat _ | @expr.App _ _ _ s3 _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - end - | @expr.App _ _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - match x1 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args0 <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v @ x0 @ - ##((- args0)%Z)%expr)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- - (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s2 _ #(idc0)%expr_pat x5 => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s2 as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 base.type.Z - (UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v @ x0 @ - x'0 v0)%expr_pat - (fun - v1 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v1)%expr, - (- - (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end) - | (s3 -> d2)%ptype => - fun - _ : Compile.value' false s3 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end (Compile.reflect x5) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s3 -> d2)%ptype => - fun - _ : Compile.value' false s3 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s2 _ ($_)%expr _ | @expr.App _ _ _ s2 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s2 _ - (_ @ _)%expr_pat _ | @expr.App _ _ _ s2 _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - end - | @expr.LetIn _ _ _ _ _ _ _ => - match x1 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - if args0 <=? 0 - then - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v @ x0 @ - ##((- args0)%Z)%expr)%expr_pat - (fun - v0 : var - (type.base - (base.type.Z * base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- - (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - else - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s1 -> d0)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d0 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s1 _ #(idc0)%expr_pat x4 => - match - match idc0 with - | ident.Z_opp => Some tt - | _ => None - end - with - | Some _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s1 as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 base.type.Z - (UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.UnderLet - (#(ident.Z_sub_with_get_borrow_concrete - s)%expr @ x' v @ x0 @ - x'0 v0)%expr_pat - (fun - v1 : var - (type.base - (base.type.Z * - base.type.Z)%etype) - => - UnderLets.Base - (#(ident.fst)%expr @ - ($v1)%expr, - (- - (#(ident.snd)%expr @ $v1)%expr_pat)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete - s)%expr @ x @ x0 @ x1)%expr_pat - end (Compile.reflect x4) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end) - | (s2 -> d1)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end (Compile.reflect x2) - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s1 _ ($_)%expr _ | @expr.App _ _ _ s1 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s1 _ - (_ @ _)%expr_pat _ | @expr.App _ _ _ s1 _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - end - end - | None => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ x1)%expr_pat - end - | @expr.App _ _ _ s0 _ ($_)%expr _ | @expr.App _ _ _ s0 _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s0 _ (_ @ _)%expr_pat _ | - @expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ x1)%expr_pat - | _ => - UnderLets.Base - (#(ident.Z_add_with_get_carry_concrete s)%expr @ x @ x0 @ x1)%expr_pat - end -| ident.Z_sub_get_borrow => - fun x x0 x1 : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match x1 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - UnderLets.Base - (let - '(a, b) := - Definitions.Z.sub_get_borrow_full args args0 - args1 in (##(a)%expr, ##(b)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_sub_get_borrow_concrete args)%expr @ - x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_sub_get_borrow_concrete args)%expr @ x0 @ - x1)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_sub_get_borrow_concrete args)%expr @ x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_sub_get_borrow_concrete args)%expr @ x0 @ x1)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_sub_get_borrow)%expr @ x @ x0 @ x1)%expr_pat - end -| ident.Z_sub_get_borrow_concrete s => - fun x x0 : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - UnderLets.Base - (let - '(a, b) := - Definitions.Z.sub_get_borrow_full s args args0 in - (##(a)%expr, ##(b)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ x0)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ x0)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ x0)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_sub_get_borrow_concrete s)%expr @ x @ x0)%expr_pat - end -| ident.Z_sub_with_get_borrow => - fun x x0 x1 x2 : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match x1 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - match x2 with - | #(idc2)%expr_pat => - match - match idc2 with - | @ident.Literal t3 v => - match - t3 as t4 - return - (base.base_interp t4 -> option Z) - with - | base.type.unit => - fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => - fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args2 => - UnderLets.Base - (let - '(a, b) := - Definitions.Z.sub_with_get_borrow_full - args args0 args1 args2 in - (##(a)%expr, ##(b)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_sub_with_get_borrow_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_sub_with_get_borrow_concrete - args)%expr @ x0 @ x1 @ x2)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_sub_with_get_borrow_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_sub_with_get_borrow_concrete args)%expr @ - x0 @ x1 @ x2)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_sub_with_get_borrow_concrete args)%expr @ x0 @ - x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_sub_with_get_borrow_concrete args)%expr @ x0 @ - x1 @ x2)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_sub_with_get_borrow)%expr @ x @ x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_sub_with_get_borrow)%expr @ x @ x0 @ x1 @ x2)%expr_pat - end -| ident.Z_sub_with_get_borrow_concrete s => - fun x x0 x1 : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match x1 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - UnderLets.Base - (let - '(a, b) := - Definitions.Z.sub_with_get_borrow_full s args - args0 args1 in - (##(a)%expr, ##(b)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.Z_sub_with_get_borrow_concrete s)%expr @ - x @ x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_sub_with_get_borrow_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_sub_with_get_borrow_concrete s)%expr @ x @ - x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_sub_with_get_borrow_concrete s)%expr @ x @ x0 @ - x1)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_sub_with_get_borrow_concrete s)%expr @ x @ x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_sub_with_get_borrow_concrete s)%expr @ x @ x0 @ x1)%expr_pat - end -| ident.Z_zselect => - fun x x0 x1 : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match x1 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - UnderLets.Base - ##(Definitions.Z.zselect args args0 args1)%expr - | None => - UnderLets.Base - (#(ident.Z_zselect)%expr @ x @ x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_zselect)%expr @ x @ x0 @ x1)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_zselect)%expr @ x @ x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_zselect)%expr @ x @ x0 @ x1)%expr_pat - end - | None => - UnderLets.Base (#(ident.Z_zselect)%expr @ x @ x0 @ x1)%expr_pat - end - | _ => UnderLets.Base (#(ident.Z_zselect)%expr @ x @ x0 @ x1)%expr_pat - end -| ident.Z_add_modulo => - fun x x0 x1 : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match x1 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - UnderLets.Base - ##(Definitions.Z.add_modulo args args0 args1)%expr - | None => - UnderLets.Base - (#(ident.Z_add_modulo)%expr @ x @ x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_modulo)%expr @ x @ x0 @ x1)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_add_modulo)%expr @ x @ x0 @ x1)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_add_modulo)%expr @ x @ x0 @ x1)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_add_modulo)%expr @ x @ x0 @ x1)%expr_pat - end - | _ => UnderLets.Base (#(ident.Z_add_modulo)%expr @ x @ x0 @ x1)%expr_pat - end -| ident.Z_rshi => - fun x x0 x1 x2 : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match x1 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - match x2 with - | #(idc2)%expr_pat => - match - match idc2 with - | @ident.Literal t3 v => - match - t3 as t4 - return - (base.base_interp t4 -> option Z) - with - | base.type.unit => - fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => - fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args2 => - UnderLets.Base - ##(Definitions.Z.rshi args args0 args1 - args2)%expr - | None => - UnderLets.Base - (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ - x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat - end - | None => - match x2 with - | #(idc2)%expr_pat => - match - match idc2 with - | @ident.Literal t3 v => - match - t3 as t4 - return - (base.base_interp t4 -> option Z) - with - | base.type.unit => - fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => - fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - UnderLets.Base - (#(ident.Z_rshi_concrete args args1)%expr @ - x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ - x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat - end - end - | ($_)%expr => - match x2 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t3 v0 => - match - t3 as t4 - return (base.base_interp t4 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v1 : Z => Some v1 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v0 - | _ => None - end - with - | Some args1 => - UnderLets.Base - (#(ident.Z_rshi_concrete args args1)%expr @ - x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat - end - | _ => - match x2 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - UnderLets.Base - (#(ident.Z_rshi_concrete args args1)%expr @ - x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat - end - end - | None => - match x2 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - UnderLets.Base - (#(ident.Z_rshi_concrete args args0)%expr @ x0 @ - x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat - end - end - | ($_)%expr => - match x2 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t2 v0 => - match - t2 as t3 return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v1 : Z => Some v1 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v0 - | _ => None - end - with - | Some args0 => - UnderLets.Base - (#(ident.Z_rshi_concrete args args0)%expr @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat - end - | _ => - match x2 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - UnderLets.Base - (#(ident.Z_rshi_concrete args args0)%expr @ x0 @ x1)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat - end - end - | None => - UnderLets.Base (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat - end - | _ => UnderLets.Base (#(ident.Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat - end -| ident.Z_rshi_concrete s offset => - fun x x0 : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - UnderLets.Base - ##(Definitions.Z.rshi s args args0 offset)%expr - | None => - UnderLets.Base - (#(ident.Z_rshi_concrete s offset)%expr @ x @ x0)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_rshi_concrete s offset)%expr @ x @ x0)%expr_pat - end - | None => - UnderLets.Base - (#(ident.Z_rshi_concrete s offset)%expr @ x @ x0)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_rshi_concrete s offset)%expr @ x @ x0)%expr_pat - end -| ident.Z_cc_m => - fun x x0 : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - match x0 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - UnderLets.Base ##(Definitions.Z.cc_m args args0)%expr - | None => - UnderLets.Base - (#(ident.Z_cc_m_concrete args)%expr @ x0)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.Z_cc_m_concrete args)%expr @ x0)%expr_pat - end - | None => UnderLets.Base (#(ident.Z_cc_m)%expr @ x @ x0)%expr_pat - end - | _ => UnderLets.Base (#(ident.Z_cc_m)%expr @ x @ x0)%expr_pat - end -| ident.Z_cc_m_concrete s => - fun x : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => UnderLets.Base ##(Definitions.Z.cc_m s args)%expr - | None => - UnderLets.Base (#(ident.Z_cc_m_concrete s)%expr @ x)%expr_pat - end - | _ => UnderLets.Base (#(ident.Z_cc_m_concrete s)%expr @ x)%expr_pat - end -| ident.Z_neg_snd => - fun x : expr (type.base (base.type.Z * base.type.Z)%etype) => - match x with - | ($_)%expr => - UnderLets.UnderLet x - (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - | @expr.App _ _ _ s _ ($_)%expr _ => - UnderLets.UnderLet x - (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ #(idc)%expr_pat x1) x0 => - match - match idc with - | @ident.pair A B => Some (A, B) - | _ => None - end - with - | Some _ => - match x1 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match x0 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - UnderLets.Base - (##(args0)%expr, ##((- args1)%Z)%expr)%expr_pat - | None => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => expr (type.base t3)) - t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t4 : base.type => - expr (type.base t4)) t3 - base.type.Z - (UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base - base.type.Z)) => - match a0 with - | Some x'0 => - UnderLets.Base - (x' v, (- x'0 v0)%expr)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ - x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end (Compile.reflect x0) - | None => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end (Compile.reflect x1) - end - | ($_)%expr => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => expr (type.base t3)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t3 => - fun v1 : expr (type.base t3) => - base.try_make_transport_cps - (fun t4 : base.type => - expr (type.base t4)) t3 base.type.Z - (UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.Base - (x' v0, (- x'0 v1)%expr)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end (Compile.reflect x0) - | None => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end (Compile.reflect x1) - | @expr.LetIn _ _ _ _ _ _ _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 base.type.Z - (UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.Base - (x' v, (- x'0 v0)%expr)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end (Compile.reflect x0) - | None => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end (Compile.reflect x1) - | _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 base.type.Z - (UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.Base - (x' v, (- x'0 v0)%expr)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end) - | (s2 -> d2)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end (Compile.reflect x0) - | None => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end) - | (s2 -> d2)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end (Compile.reflect x1) - end - | None => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr (type.base base.type.Z)) - => - match a0 with - | Some x'0 => - UnderLets.Base - (x' v, (- x'0 v0)%expr)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end (Compile.reflect x0) - | None => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end (Compile.reflect x1) - end - | ($_)%expr => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t3 => - fun v1 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) - t3 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr (type.base base.type.Z)) => - match a0 with - | Some x'0 => - UnderLets.Base - (x' v0, (- x'0 v1)%expr)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end (Compile.reflect x0) - | None => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d1 - => UnderLets.Base (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end (Compile.reflect x1) - | @expr.LetIn _ _ _ _ _ _ _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) - t3 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr (type.base base.type.Z)) => - match a0 with - | Some x'0 => - UnderLets.Base - (x' v, (- x'0 v0)%expr)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end (Compile.reflect x0) - | None => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d1 - => UnderLets.Base (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end (Compile.reflect x1) - | _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) - t3 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr (type.base base.type.Z)) => - match a0 with - | Some x'0 => - UnderLets.Base - (x' v, (- x'0 v0)%expr)%expr_pat - | None => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end) - | (s2 -> d2)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end (Compile.reflect x0) - | None => - UnderLets.Base - (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end) - | (s2 -> d2)%ptype => - fun _ : Compile.value' false s2 -> Compile.value' true d2 - => UnderLets.Base (#(ident.Z_neg_snd)%expr @ x)%expr_pat - end (Compile.reflect x1) - end - | None => - UnderLets.UnderLet x - (fun v : var (type.base (base.type.Z * base.type.Z)%etype) => - UnderLets.Base - (#(ident.fst)%expr @ ($v)%expr, - (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) - end - | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ ($_)%expr _) _ => - UnderLets.UnderLet x - (fun v0 : var (type.base (base.type.Z * base.type.Z)%etype) => - UnderLets.Base - (#(ident.fst)%expr @ ($v0)%expr, - (- (#(ident.snd)%expr @ $v0)%expr_pat)%expr)%expr_pat) - | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _) - _ | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ (_ @ _)%expr_pat _) _ | - @expr.App _ _ _ s _ - (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _) _ => - UnderLets.UnderLet x - (fun v : var (type.base (base.type.Z * base.type.Z)%etype) => - UnderLets.Base - (#(ident.fst)%expr @ ($v)%expr, - (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) - | @expr.App _ _ _ s _ #(_)%expr_pat _ | @expr.App _ _ _ s _ - (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.UnderLet x - (fun v : var (type.base (base.type.Z * base.type.Z)%etype) => - UnderLets.Base - (#(ident.fst)%expr @ ($v)%expr, - (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) - | _ => - UnderLets.UnderLet x - (fun v : var (type.base (base.type.Z * base.type.Z)%etype) => - UnderLets.Base - (#(ident.fst)%expr @ ($v)%expr, - (- (#(ident.snd)%expr @ $v)%expr_pat)%expr)%expr_pat) - end -| ident.Z_cast range => - fun x : expr (type.base base.type.Z) => - match x with - | #(idc)%expr_pat => - match - match idc with - | @ident.Literal t0 v => - match t0 as t1 return (base.base_interp t1 -> option Z) with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args => - UnderLets.Base - ##(ident.cast ident.cast_outside_of_range range args)%expr - | None => UnderLets.Base (#(ident.Z_cast range)%expr @ x)%expr_pat - end - | _ => UnderLets.Base (#(ident.Z_cast range)%expr @ x)%expr_pat - end -| ident.Z_cast2 range => - fun x : expr (type.base (base.type.Z * base.type.Z)%etype) => - match x with - | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ #(idc)%expr_pat x1) x0 => - match - match idc with - | @ident.pair A B => Some (A, B) - | _ => None - end - with - | Some _ => - match x1 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match x0 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - UnderLets.Base - (let - '(a, b) := - (let (r1, r2) := range in - fun '(x2, x3) => - (ident.cast ident.cast_outside_of_range r1 - x2, - ident.cast ident.cast_outside_of_range r2 x3)) - (args0, args1) in - (##(a)%expr, ##(b)%expr)%expr_pat) - | None => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => expr (type.base t3)) - t2 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t4 : base.type => - expr (type.base t4)) t3 - base.type.Z - (UnderLets.UnderLets base.type - ident var - (expr - (type.base - (base.type.Z * - base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base - base.type.Z)) => - match a0 with - | Some x'0 => - (fv <-- do_again - (base.type.Z * - base.type.Z) - (#(ident.Z_cast - (fst range))%expr @ - ($(x' v))%expr, - #(ident.Z_cast - (snd range))%expr @ - ($(x'0 v0))%expr)%expr_pat; - UnderLets.Base - (id (id fv)))%under_lets - | None => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ - x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end (Compile.reflect x0) - | None => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end (Compile.reflect x1) - end - | ($_)%expr => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t3 : base.type => expr (type.base t3)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t3 => - fun v1 : expr (type.base t3) => - base.try_make_transport_cps - (fun t4 : base.type => - expr (type.base t4)) t3 base.type.Z - (UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) - => - match a0 with - | Some x'0 => - (fv <-- do_again - (base.type.Z * - base.type.Z) - (#(ident.Z_cast - (fst range))%expr @ - ($(x' v0))%expr, - #(ident.Z_cast - (snd range))%expr @ - ($(x'0 v1))%expr)%expr_pat; - UnderLets.Base (id (id fv)))%under_lets - | None => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ - x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end (Compile.reflect x0) - | None => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end (Compile.reflect x1) - | @expr.LetIn _ _ _ _ _ _ _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 base.type.Z - (UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) - => - match a0 with - | Some x'0 => - (fv <-- do_again - (base.type.Z * - base.type.Z) - (#(ident.Z_cast - (fst range))%expr @ - ($(x' v))%expr, - #(ident.Z_cast - (snd range))%expr @ - ($(x'0 v0))%expr)%expr_pat; - UnderLets.Base (id (id fv)))%under_lets - | None => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ - x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end (Compile.reflect x0) - | None => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end (Compile.reflect x1) - | _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 base.type.Z - (UnderLets.UnderLets base.type ident - var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr - (type.base base.type.Z)) - => - match a0 with - | Some x'0 => - (fv <-- do_again - (base.type.Z * - base.type.Z) - (#(ident.Z_cast - (fst range))%expr @ - ($(x' v))%expr, - #(ident.Z_cast - (snd range))%expr @ - ($(x'0 v0))%expr)%expr_pat; - UnderLets.Base (id (id fv)))%under_lets - | None => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ - x)%expr_pat - end) - | (s2 -> d2)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end (Compile.reflect x0) - | None => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end) - | (s2 -> d2)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end (Compile.reflect x1) - end - | None => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => - expr (type.base t1)) t3 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr (type.base base.type.Z)) - => - match a0 with - | Some x'0 => - (fv <-- do_again - (base.type.Z * - base.type.Z) - (#(ident.Z_cast - (fst range))%expr @ - ($(x' v))%expr, - #(ident.Z_cast - (snd range))%expr @ - ($(x'0 v0))%expr)%expr_pat; - UnderLets.Base (id (id fv)))%under_lets - | None => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end (Compile.reflect x0) - | None => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end (Compile.reflect x1) - end - | ($_)%expr => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v0 : expr (type.base t2) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t3 => - fun v1 : expr (type.base t3) => - base.try_make_transport_cps - (fun t1 : base.type => expr (type.base t1)) - t3 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr (type.base base.type.Z)) => - match a0 with - | Some x'0 => - (fv <-- do_again - (base.type.Z * base.type.Z) - (#(ident.Z_cast (fst range))%expr @ - ($(x' v0))%expr, - #(ident.Z_cast (snd range))%expr @ - ($(x'0 v1))%expr)%expr_pat; - UnderLets.Base (id (id fv)))%under_lets - | None => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end (Compile.reflect x0) - | None => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d1 - => - UnderLets.Base (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end (Compile.reflect x1) - | @expr.LetIn _ _ _ _ _ _ _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) - t3 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr (type.base base.type.Z)) => - match a0 with - | Some x'0 => - (fv <-- do_again - (base.type.Z * base.type.Z) - (#(ident.Z_cast (fst range))%expr @ - ($(x' v))%expr, - #(ident.Z_cast (snd range))%expr @ - ($(x'0 v0))%expr)%expr_pat; - UnderLets.Base (id (id fv)))%under_lets - | None => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun - _ : Compile.value' false s1 -> - Compile.value' true d1 => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end (Compile.reflect x0) - | None => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end) - | (s1 -> d1)%ptype => - fun _ : Compile.value' false s1 -> Compile.value' true d1 - => - UnderLets.Base (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end (Compile.reflect x1) - | _ => - match - s0 as t2 - return - (Compile.value' false t2 -> - UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - with - | type.base t2 => - fun v : expr (type.base t2) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) t2 - base.type.Z - (UnderLets.UnderLets base.type ident var - (expr (type.base (base.type.Z * base.type.Z)%etype))) - (fun - a : option - (expr (type.base t2) -> - expr (type.base base.type.Z)) => - match a with - | Some x' => - match - s as t3 - return - (Compile.value' false t3 -> - UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - with - | type.base t3 => - fun v0 : expr (type.base t3) => - base.try_make_transport_cps - (fun t0 : base.type => expr (type.base t0)) - t3 base.type.Z - (UnderLets.UnderLets base.type ident var - (expr - (type.base - (base.type.Z * base.type.Z)%etype))) - (fun - a0 : option - (expr (type.base t3) -> - expr (type.base base.type.Z)) => - match a0 with - | Some x'0 => - (fv <-- do_again - (base.type.Z * base.type.Z) - (#(ident.Z_cast (fst range))%expr @ - ($(x' v))%expr, - #(ident.Z_cast (snd range))%expr @ - ($(x'0 v0))%expr)%expr_pat; - UnderLets.Base (id (id fv)))%under_lets - | None => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end) - | (s2 -> d2)%ptype => - fun - _ : Compile.value' false s2 -> - Compile.value' true d2 => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end (Compile.reflect x0) - | None => - UnderLets.Base - (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end) - | (s2 -> d2)%ptype => - fun _ : Compile.value' false s2 -> Compile.value' true d2 - => - UnderLets.Base (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end (Compile.reflect x1) - end - | None => UnderLets.Base (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end - | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ ($_)%expr _) _ | @expr.App _ - _ _ s _ (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _) _ | @expr.App - _ _ _ s _ (@expr.App _ _ _ s0 _ (_ @ _)%expr_pat _) _ | @expr.App _ _ _ - s _ (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _) _ => - UnderLets.Base (#(ident.Z_cast2 range)%expr @ x)%expr_pat - | @expr.App _ _ _ s _ #(_)%expr_pat _ | @expr.App _ _ _ s _ ($_)%expr _ | - @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s _ - (@expr.LetIn _ _ _ _ _ _ _) _ => - UnderLets.Base (#(ident.Z_cast2 range)%expr @ x)%expr_pat - | _ => UnderLets.Base (#(ident.Z_cast2 range)%expr @ x)%expr_pat - end -| ident.fancy_add log2wordmax imm => - fun x : expr (type.base (base.type.Z * base.type.Z)%etype) => - match x with - | (#(idc) @ x1 @ x0)%expr_pat => - match - match idc with - | @ident.pair A B => Some (A, B) - | _ => None - end - with - | Some _ => - match x1 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match x0 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - UnderLets.Base - (let - '(a, b) := - ident.fancy.interp - (invert_Some - (ident.to_fancy - (ident.fancy_add log2wordmax imm))) - (args0, args1) in - (##(a)%expr, ##(b)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.fancy_add log2wordmax imm)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_add log2wordmax imm)%expr @ x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_add log2wordmax imm)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_add log2wordmax imm)%expr @ x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_add log2wordmax imm)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base (#(ident.fancy_add log2wordmax imm)%expr @ x)%expr_pat - end -| ident.fancy_addc log2wordmax imm => - fun x : expr (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) - => - match x with - | (#(idc) @ x1 @ x0)%expr_pat => - match - match idc with - | @ident.pair A B => Some (A, B) - | _ => None - end - with - | Some _ => - match x1 with - | (#(idc0) @ x3 @ x2)%expr_pat => - match - match idc0 with - | @ident.pair A B => Some (A, B) - | _ => None - end - with - | Some _ => - match x3 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - match x2 with - | #(idc2)%expr_pat => - match - match idc2 with - | @ident.Literal t3 v => - match - t3 as t4 - return - (base.base_interp t4 -> option Z) - with - | base.type.unit => - fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => - fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args2 => - match x0 with - | #(idc3)%expr_pat => - match - match idc3 with - | @ident.Literal t4 v => - match - t4 as t5 - return - (base.base_interp t5 -> - option Z) - with - | base.type.unit => - fun _ : unit => None - | base.type.Z => - fun v0 : Z => Some v0 - | base.type.bool => - fun _ : bool => None - | base.type.nat => - fun _ : nat => None - end v - | _ => None - end - with - | Some args3 => - UnderLets.Base - (let - '(a, b) := - ident.fancy.interp - (invert_Some - (ident.to_fancy - (ident.fancy_addc - log2wordmax imm))) - (args1, args2, args3) in - (##(a)%expr, ##(b)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.fancy_addc log2wordmax - imm)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_addc log2wordmax imm)%expr @ - x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_addc log2wordmax imm)%expr @ - x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_addc log2wordmax imm)%expr @ - x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_addc log2wordmax imm)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_addc log2wordmax imm)%expr @ x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_addc log2wordmax imm)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_addc log2wordmax imm)%expr @ x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_addc log2wordmax imm)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_addc log2wordmax imm)%expr @ x)%expr_pat - end -| ident.fancy_sub log2wordmax imm => - fun x : expr (type.base (base.type.Z * base.type.Z)%etype) => - match x with - | (#(idc) @ x1 @ x0)%expr_pat => - match - match idc with - | @ident.pair A B => Some (A, B) - | _ => None - end - with - | Some _ => - match x1 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match x0 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - UnderLets.Base - (let - '(a, b) := - ident.fancy.interp - (invert_Some - (ident.to_fancy - (ident.fancy_sub log2wordmax imm))) - (args0, args1) in - (##(a)%expr, ##(b)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.fancy_sub log2wordmax imm)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_sub log2wordmax imm)%expr @ x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_sub log2wordmax imm)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_sub log2wordmax imm)%expr @ x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_sub log2wordmax imm)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base (#(ident.fancy_sub log2wordmax imm)%expr @ x)%expr_pat - end -| ident.fancy_subb log2wordmax imm => - fun x : expr (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) - => - match x with - | (#(idc) @ x1 @ x0)%expr_pat => - match - match idc with - | @ident.pair A B => Some (A, B) - | _ => None - end - with - | Some _ => - match x1 with - | (#(idc0) @ x3 @ x2)%expr_pat => - match - match idc0 with - | @ident.pair A B => Some (A, B) - | _ => None - end - with - | Some _ => - match x3 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - match x2 with - | #(idc2)%expr_pat => - match - match idc2 with - | @ident.Literal t3 v => - match - t3 as t4 - return - (base.base_interp t4 -> option Z) - with - | base.type.unit => - fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => - fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args2 => - match x0 with - | #(idc3)%expr_pat => - match - match idc3 with - | @ident.Literal t4 v => - match - t4 as t5 - return - (base.base_interp t5 -> - option Z) - with - | base.type.unit => - fun _ : unit => None - | base.type.Z => - fun v0 : Z => Some v0 - | base.type.bool => - fun _ : bool => None - | base.type.nat => - fun _ : nat => None - end v - | _ => None - end - with - | Some args3 => - UnderLets.Base - (let - '(a, b) := - ident.fancy.interp - (invert_Some - (ident.to_fancy - (ident.fancy_subb - log2wordmax imm))) - (args1, args2, args3) in - (##(a)%expr, ##(b)%expr)%expr_pat) - | None => - UnderLets.Base - (#(ident.fancy_subb log2wordmax - imm)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_subb log2wordmax imm)%expr @ - x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_subb log2wordmax imm)%expr @ - x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_subb log2wordmax imm)%expr @ - x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_subb log2wordmax imm)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_subb log2wordmax imm)%expr @ x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_subb log2wordmax imm)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_subb log2wordmax imm)%expr @ x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_subb log2wordmax imm)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_subb log2wordmax imm)%expr @ x)%expr_pat - end -| ident.fancy_mulll log2wordmax => - fun x : expr (type.base (base.type.Z * base.type.Z)%etype) => - match x with - | (#(idc) @ x1 @ x0)%expr_pat => - match - match idc with - | @ident.pair A B => Some (A, B) - | _ => None - end - with - | Some _ => - match x1 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match x0 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - UnderLets.Base - ##(ident.fancy.interp - (invert_Some - (ident.to_fancy - (ident.fancy_mulll log2wordmax))) - (args0, args1)%core)%expr - | None => - UnderLets.Base - (#(ident.fancy_mulll log2wordmax)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_mulll log2wordmax)%expr @ x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_mulll log2wordmax)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_mulll log2wordmax)%expr @ x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_mulll log2wordmax)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base (#(ident.fancy_mulll log2wordmax)%expr @ x)%expr_pat - end -| ident.fancy_mullh log2wordmax => - fun x : expr (type.base (base.type.Z * base.type.Z)%etype) => - match x with - | (#(idc) @ x1 @ x0)%expr_pat => - match - match idc with - | @ident.pair A B => Some (A, B) - | _ => None - end - with - | Some _ => - match x1 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match x0 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - UnderLets.Base - ##(ident.fancy.interp - (invert_Some - (ident.to_fancy - (ident.fancy_mullh log2wordmax))) - (args0, args1)%core)%expr - | None => - UnderLets.Base - (#(ident.fancy_mullh log2wordmax)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_mullh log2wordmax)%expr @ x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_mullh log2wordmax)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_mullh log2wordmax)%expr @ x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_mullh log2wordmax)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base (#(ident.fancy_mullh log2wordmax)%expr @ x)%expr_pat - end -| ident.fancy_mulhl log2wordmax => - fun x : expr (type.base (base.type.Z * base.type.Z)%etype) => - match x with - | (#(idc) @ x1 @ x0)%expr_pat => - match - match idc with - | @ident.pair A B => Some (A, B) - | _ => None - end - with - | Some _ => - match x1 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match x0 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - UnderLets.Base - ##(ident.fancy.interp - (invert_Some - (ident.to_fancy - (ident.fancy_mulhl log2wordmax))) - (args0, args1)%core)%expr - | None => - UnderLets.Base - (#(ident.fancy_mulhl log2wordmax)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_mulhl log2wordmax)%expr @ x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_mulhl log2wordmax)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_mulhl log2wordmax)%expr @ x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_mulhl log2wordmax)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base (#(ident.fancy_mulhl log2wordmax)%expr @ x)%expr_pat - end -| ident.fancy_mulhh log2wordmax => - fun x : expr (type.base (base.type.Z * base.type.Z)%etype) => - match x with - | (#(idc) @ x1 @ x0)%expr_pat => - match - match idc with - | @ident.pair A B => Some (A, B) - | _ => None - end - with - | Some _ => - match x1 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match x0 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - UnderLets.Base - ##(ident.fancy.interp - (invert_Some - (ident.to_fancy - (ident.fancy_mulhh log2wordmax))) - (args0, args1)%core)%expr - | None => - UnderLets.Base - (#(ident.fancy_mulhh log2wordmax)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_mulhh log2wordmax)%expr @ x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_mulhh log2wordmax)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_mulhh log2wordmax)%expr @ x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_mulhh log2wordmax)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base (#(ident.fancy_mulhh log2wordmax)%expr @ x)%expr_pat - end -| ident.fancy_rshi log2wordmax x => - fun x0 : expr (type.base (base.type.Z * base.type.Z)%etype) => - match x0 with - | (#(idc) @ x2 @ x1)%expr_pat => - match - match idc with - | @ident.pair A B => Some (A, B) - | _ => None - end - with - | Some _ => - match x2 with - | #(idc0)%expr_pat => - match - match idc0 with - | @ident.Literal t1 v => - match - t1 as t2 return (base.base_interp t2 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args0 => - match x1 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - UnderLets.Base - ##(ident.fancy.interp - (invert_Some - (ident.to_fancy - (ident.fancy_rshi log2wordmax x))) - (args0, args1)%core)%expr - | None => - UnderLets.Base - (#(ident.fancy_rshi log2wordmax x)%expr @ x0)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_rshi log2wordmax x)%expr @ x0)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_rshi log2wordmax x)%expr @ x0)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_rshi log2wordmax x)%expr @ x0)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_rshi log2wordmax x)%expr @ x0)%expr_pat - end - | _ => - UnderLets.Base (#(ident.fancy_rshi log2wordmax x)%expr @ x0)%expr_pat - end -| ident.fancy_selc => - fun x : expr (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) - => - match x with - | (#(idc) @ x1 @ x0)%expr_pat => - match - match idc with - | @ident.pair A B => Some (A, B) - | _ => None - end - with - | Some _ => - match x1 with - | (#(idc0) @ x3 @ x2)%expr_pat => - match - match idc0 with - | @ident.pair A B => Some (A, B) - | _ => None - end - with - | Some _ => - match x3 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - match x2 with - | #(idc2)%expr_pat => - match - match idc2 with - | @ident.Literal t3 v => - match - t3 as t4 - return - (base.base_interp t4 -> option Z) - with - | base.type.unit => - fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => - fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args2 => - match x0 with - | #(idc3)%expr_pat => - match - match idc3 with - | @ident.Literal t4 v => - match - t4 as t5 - return - (base.base_interp t5 -> - option Z) - with - | base.type.unit => - fun _ : unit => None - | base.type.Z => - fun v0 : Z => Some v0 - | base.type.bool => - fun _ : bool => None - | base.type.nat => - fun _ : nat => None - end v - | _ => None - end - with - | Some args3 => - UnderLets.Base - ##(ident.fancy.interp - (invert_Some - (ident.to_fancy - ident.fancy_selc)) - (args1, args2, args3)%core)%expr - | None => - UnderLets.Base - (#(ident.fancy_selc)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_selc)%expr @ x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_selc)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_selc)%expr @ x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_selc)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_selc)%expr @ x)%expr_pat - end - | None => - UnderLets.Base (#(ident.fancy_selc)%expr @ x)%expr_pat - end - | _ => UnderLets.Base (#(ident.fancy_selc)%expr @ x)%expr_pat - end - | None => UnderLets.Base (#(ident.fancy_selc)%expr @ x)%expr_pat - end - | _ => UnderLets.Base (#(ident.fancy_selc)%expr @ x)%expr_pat - end -| ident.fancy_selm log2wordmax => - fun x : expr (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) - => - match x with - | (#(idc) @ x1 @ x0)%expr_pat => - match - match idc with - | @ident.pair A B => Some (A, B) - | _ => None - end - with - | Some _ => - match x1 with - | (#(idc0) @ x3 @ x2)%expr_pat => - match - match idc0 with - | @ident.pair A B => Some (A, B) - | _ => None - end - with - | Some _ => - match x3 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - match x2 with - | #(idc2)%expr_pat => - match - match idc2 with - | @ident.Literal t3 v => - match - t3 as t4 - return - (base.base_interp t4 -> option Z) - with - | base.type.unit => - fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => - fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args2 => - match x0 with - | #(idc3)%expr_pat => - match - match idc3 with - | @ident.Literal t4 v => - match - t4 as t5 - return - (base.base_interp t5 -> - option Z) - with - | base.type.unit => - fun _ : unit => None - | base.type.Z => - fun v0 : Z => Some v0 - | base.type.bool => - fun _ : bool => None - | base.type.nat => - fun _ : nat => None - end v - | _ => None - end - with - | Some args3 => - UnderLets.Base - ##(ident.fancy.interp - (invert_Some - (ident.to_fancy - (ident.fancy_selm - log2wordmax))) - (args1, args2, args3)%core)%expr - | None => - UnderLets.Base - (#(ident.fancy_selm log2wordmax)%expr @ - x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_selm log2wordmax)%expr @ - x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_selm log2wordmax)%expr @ - x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_selm log2wordmax)%expr @ x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_selm log2wordmax)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_selm log2wordmax)%expr @ x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_selm log2wordmax)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_selm log2wordmax)%expr @ x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_selm log2wordmax)%expr @ x)%expr_pat - end - | _ => UnderLets.Base (#(ident.fancy_selm log2wordmax)%expr @ x)%expr_pat - end -| ident.fancy_sell => - fun x : expr (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) - => - match x with - | (#(idc) @ x1 @ x0)%expr_pat => - match - match idc with - | @ident.pair A B => Some (A, B) - | _ => None - end - with - | Some _ => - match x1 with - | (#(idc0) @ x3 @ x2)%expr_pat => - match - match idc0 with - | @ident.pair A B => Some (A, B) - | _ => None - end - with - | Some _ => - match x3 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - match x2 with - | #(idc2)%expr_pat => - match - match idc2 with - | @ident.Literal t3 v => - match - t3 as t4 - return - (base.base_interp t4 -> option Z) - with - | base.type.unit => - fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => - fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args2 => - match x0 with - | #(idc3)%expr_pat => - match - match idc3 with - | @ident.Literal t4 v => - match - t4 as t5 - return - (base.base_interp t5 -> - option Z) - with - | base.type.unit => - fun _ : unit => None - | base.type.Z => - fun v0 : Z => Some v0 - | base.type.bool => - fun _ : bool => None - | base.type.nat => - fun _ : nat => None - end v - | _ => None - end - with - | Some args3 => - UnderLets.Base - ##(ident.fancy.interp - (invert_Some - (ident.to_fancy - ident.fancy_sell)) - (args1, args2, args3)%core)%expr - | None => - UnderLets.Base - (#(ident.fancy_sell)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_sell)%expr @ x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_sell)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_sell)%expr @ x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_sell)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_sell)%expr @ x)%expr_pat - end - | None => - UnderLets.Base (#(ident.fancy_sell)%expr @ x)%expr_pat - end - | _ => UnderLets.Base (#(ident.fancy_sell)%expr @ x)%expr_pat - end - | None => UnderLets.Base (#(ident.fancy_sell)%expr @ x)%expr_pat - end - | _ => UnderLets.Base (#(ident.fancy_sell)%expr @ x)%expr_pat - end -| ident.fancy_addm => - fun x : expr (type.base (base.type.Z * base.type.Z * base.type.Z)%etype) - => - match x with - | (#(idc) @ x1 @ x0)%expr_pat => - match - match idc with - | @ident.pair A B => Some (A, B) - | _ => None - end - with - | Some _ => - match x1 with - | (#(idc0) @ x3 @ x2)%expr_pat => - match - match idc0 with - | @ident.pair A B => Some (A, B) - | _ => None - end - with - | Some _ => - match x3 with - | #(idc1)%expr_pat => - match - match idc1 with - | @ident.Literal t2 v => - match - t2 as t3 - return (base.base_interp t3 -> option Z) - with - | base.type.unit => fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args1 => - match x2 with - | #(idc2)%expr_pat => - match - match idc2 with - | @ident.Literal t3 v => - match - t3 as t4 - return - (base.base_interp t4 -> option Z) - with - | base.type.unit => - fun _ : unit => None - | base.type.Z => fun v0 : Z => Some v0 - | base.type.bool => - fun _ : bool => None - | base.type.nat => fun _ : nat => None - end v - | _ => None - end - with - | Some args2 => - match x0 with - | #(idc3)%expr_pat => - match - match idc3 with - | @ident.Literal t4 v => - match - t4 as t5 - return - (base.base_interp t5 -> - option Z) - with - | base.type.unit => - fun _ : unit => None - | base.type.Z => - fun v0 : Z => Some v0 - | base.type.bool => - fun _ : bool => None - | base.type.nat => - fun _ : nat => None - end v - | _ => None - end - with - | Some args3 => - UnderLets.Base - ##(ident.fancy.interp - (invert_Some - (ident.to_fancy - ident.fancy_addm)) - (args1, args2, args3)%core)%expr - | None => - UnderLets.Base - (#(ident.fancy_addm)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_addm)%expr @ x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_addm)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_addm)%expr @ x)%expr_pat - end - | None => - UnderLets.Base - (#(ident.fancy_addm)%expr @ x)%expr_pat - end - | _ => - UnderLets.Base - (#(ident.fancy_addm)%expr @ x)%expr_pat - end - | None => - UnderLets.Base (#(ident.fancy_addm)%expr @ x)%expr_pat - end - | _ => UnderLets.Base (#(ident.fancy_addm)%expr @ x)%expr_pat - end - | None => UnderLets.Base (#(ident.fancy_addm)%expr @ x)%expr_pat - end - | _ => UnderLets.Base (#(ident.fancy_addm)%expr @ x)%expr_pat - end -end - : Compile.value' true t |