aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Jason Gross <jgross@mit.edu>2018-11-06 18:07:41 -0500
committerGravatar Jason Gross <jasongross9@gmail.com>2018-11-15 11:39:31 -0500
commit3dc52eb8beb2d36d42245991db56766e2d181d5f (patch)
tree2b31fc07e8c774b61911f7867af15d5d0df9dcc2 /src
parent440bf8d524069adb266024905ad3a45821729632 (diff)
Uncurry rewriter rules
This will hopefully make various proofs easier. We have to keep the rewrite-rule-specific proofs curried, however, because otherwise lookup in evar maps blocks reduction, and is both a pain and slow to deal with. After | File Name | Before || Change | % Change -------------------------------------------------------------------------------------------------------------------- 31m39.26s | Total | 33m01.82s || -1m22.55s | -4.16% -------------------------------------------------------------------------------------------------------------------- 0m36.85s | Experiments/NewPipeline/Rewriter.vo | 1m26.67s || -0m49.82s | -57.48% 1m10.16s | Experiments/NewPipeline/RewriterRulesGood.vo | 1m42.34s || -0m32.18s | -31.44% 1m46.01s | Experiments/NewPipeline/RewriterRulesInterpGood.vo | 2m12.58s || -0m26.57s | -20.04% 5m10.66s | Experiments/NewPipeline/Toplevel1.vo | 5m03.90s || +0m06.76s | +2.22% 2m09.11s | Experiments/NewPipeline/RewriterWf2.vo | 2m02.40s || +0m06.71s | +5.48% 7m01.32s | p384_32.c | 6m56.98s || +0m04.33s | +1.04% 1m44.69s | Experiments/NewPipeline/Toplevel2.vo | 1m42.84s || +0m01.84s | +1.79% 0m21.28s | p256_32.c | 0m19.93s || +0m01.35s | +6.77% 0m19.06s | Experiments/NewPipeline/RewriterWf1.vo | 0m17.64s || +0m01.41s | +8.04% 6m28.29s | Experiments/NewPipeline/SlowPrimeSynthesisExamples.vo | 6m28.50s || -0m00.20s | -0.05% 0m41.80s | Experiments/NewPipeline/ExtractionHaskell/word_by_word_montgomery | 0m42.08s || -0m00.28s | -0.66% 0m41.72s | p521_32.c | 0m41.20s || +0m00.51s | +1.26% 0m34.42s | p521_64.c | 0m34.30s || +0m00.12s | +0.34% 0m27.32s | Experiments/NewPipeline/ExtractionHaskell/unsaturated_solinas | 0m27.49s || -0m00.16s | -0.61% 0m20.66s | secp256k1_32.c | 0m20.20s || +0m00.46s | +2.27% 0m19.90s | Experiments/NewPipeline/ExtractionHaskell/saturated_solinas | 0m19.95s || -0m00.05s | -0.25% 0m16.11s | Experiments/NewPipeline/ExtractionOCaml/word_by_word_montgomery | 0m15.54s || +0m00.57s | +3.66% 0m12.50s | p384_64.c | 0m12.59s || -0m00.08s | -0.71% 0m09.90s | Experiments/NewPipeline/ExtractionOCaml/word_by_word_montgomery.ml | 0m09.42s || +0m00.48s | +5.09% 0m09.34s | Experiments/NewPipeline/ExtractionOCaml/unsaturated_solinas | 0m08.87s || +0m00.47s | +5.29% 0m08.47s | p224_32.c | 0m08.52s || -0m00.04s | -0.58% 0m06.94s | Experiments/NewPipeline/ExtractionOCaml/saturated_solinas | 0m05.96s || +0m00.98s | +16.44% 0m06.38s | Experiments/NewPipeline/ExtractionOCaml/unsaturated_solinas.ml | 0m06.19s || +0m00.18s | +3.06% 0m06.20s | Experiments/NewPipeline/ExtractionHaskell/word_by_word_montgomery.hs | 0m06.18s || +0m00.02s | +0.32% 0m05.02s | Experiments/NewPipeline/ExtractionHaskell/unsaturated_solinas.hs | 0m04.51s || +0m00.50s | +11.30% 0m04.88s | Experiments/NewPipeline/ExtractionOCaml/saturated_solinas.ml | 0m04.71s || +0m00.16s | +3.60% 0m03.82s | Experiments/NewPipeline/ExtractionHaskell/saturated_solinas.hs | 0m03.82s || +0m00.00s | +0.00% 0m02.32s | curve25519_32.c | 0m02.37s || -0m00.05s | -2.10% 0m02.12s | p224_64.c | 0m02.08s || +0m00.04s | +1.92% 0m02.02s | p256_64.c | 0m01.97s || +0m00.05s | +2.53% 0m02.02s | secp256k1_64.c | 0m02.16s || -0m00.14s | -6.48% 0m01.62s | curve25519_64.c | 0m01.57s || +0m00.05s | +3.18% 0m01.50s | Experiments/NewPipeline/CLI.vo | 0m01.53s || -0m00.03s | -1.96% 0m01.36s | Experiments/NewPipeline/StandaloneOCamlMain.vo | 0m01.29s || +0m00.07s | +5.42% 0m01.34s | Experiments/NewPipeline/StandaloneHaskellMain.vo | 0m01.42s || -0m00.07s | -5.63% 0m01.19s | Experiments/NewPipeline/CompilersTestCases.vo | 0m01.11s || +0m00.07s | +7.20% 0m00.97s | Experiments/NewPipeline/RewriterProofs.vo | 0m01.01s || -0m00.04s | -3.96%
Diffstat (limited to 'src')
-rw-r--r--src/Experiments/NewPipeline/Rewriter.v312
-rw-r--r--src/Experiments/NewPipeline/RewriterRulesGood.v3
-rw-r--r--src/Experiments/NewPipeline/RewriterRulesInterpGood.v5
-rw-r--r--src/Experiments/NewPipeline/RewriterWf1.v501
-rw-r--r--src/Experiments/NewPipeline/RewriterWf2.v325
-rw-r--r--src/Experiments/NewPipeline/arith_rewrite_head.out680
-rw-r--r--src/Experiments/NewPipeline/arith_with_casts_rewrite_head.out544
-rw-r--r--src/Experiments/NewPipeline/fancy_rewrite_head.out1457
-rw-r--r--src/Experiments/NewPipeline/nbe_rewrite_head.out2270
9 files changed, 2557 insertions, 3540 deletions
diff --git a/src/Experiments/NewPipeline/Rewriter.v b/src/Experiments/NewPipeline/Rewriter.v
index cadc48b50..af2d2617b 100644
--- a/src/Experiments/NewPipeline/Rewriter.v
+++ b/src/Experiments/NewPipeline/Rewriter.v
@@ -636,6 +636,15 @@ Module Compilers.
Definition reveal_rawexpr_cps (e : rawexpr) : ~> rawexpr
:= reveal_rawexpr_cps_gen None e.
+ (** First, the uncurried form *)
+ Fixpoint unification_resultT' {t} (p : pattern t) (evm : EvarMap) : Type
+ := match p return Type with
+ | pattern.Wildcard t => value (pattern.type.subst_default t evm)
+ | pattern.Ident t idc => type_of_list (pident_arg_types t idc)
+ | pattern.App s d f x
+ => @unification_resultT' _ f evm * @unification_resultT' _ x evm
+ end%type.
+
Fixpoint with_unification_resultT' {t} (p : pattern t) (evm : EvarMap) (K : Type) : Type
:= match p return Type with
| pattern.Wildcard t => value (pattern.type.subst_default t evm) -> K
@@ -644,6 +653,43 @@ Module Compilers.
=> @with_unification_resultT' _ f evm (@with_unification_resultT' _ x evm K)
end%type.
+ Fixpoint app_with_unification_resultT' {t p evm K} {struct p}
+ : @with_unification_resultT' t p evm K -> @unification_resultT' t p evm -> K
+ := match p return with_unification_resultT' p evm K -> unification_resultT' p evm -> K with
+ | pattern.Wildcard t => fun f x => f x
+ | pattern.Ident t idc => app_type_of_list
+ | pattern.App s d f x
+ => fun F (xy : unification_resultT' f _ * unification_resultT' x _)
+ => @app_with_unification_resultT'
+ _ x _ _
+ (@app_with_unification_resultT'
+ _ f _ _ F (fst xy))
+ (snd xy)
+ end.
+
+ (** TODO: Maybe have a fancier version of this that doesn't
+ actually need to insert casts, by doing a fixpoint on the
+ list of elements / the evar map *)
+ Fixpoint app_transport_with_unification_resultT'_cps {t p evm1 evm2 K} {struct p}
+ : @with_unification_resultT' t p evm1 K -> @unification_resultT' t p evm2 -> forall T, (K -> option T) -> option T
+ := fun f x T k
+ => match p return with_unification_resultT' p evm1 K -> unification_resultT' p evm2 -> option T with
+ | pattern.Wildcard t
+ => fun f x
+ => (tr <- type.try_make_transport_cps base.try_make_transport_cps value _ _;
+ (tr <- tr;
+ k (f (tr x)))%option)%cps
+ | pattern.Ident t idc => fun f x => k (app_type_of_list f x)
+ | pattern.App s d f x
+ => fun F (xy : unification_resultT' f _ * unification_resultT' x _)
+ => @app_transport_with_unification_resultT'_cps
+ _ f _ _ _ F (fst xy) T
+ (fun F'
+ => @app_transport_with_unification_resultT'_cps
+ _ x _ _ _ F' (snd xy) T
+ (fun x' => k x'))
+ end%option f x.
+
Fixpoint under_with_unification_resultT' {t p evm K1 K2}
(F : K1 -> K2)
{struct p}
@@ -657,46 +703,6 @@ Module Compilers.
(@under_with_unification_resultT' _ x evm _ _ F)
end.
- Fixpoint under_with_unification_resultT'_relation1_gen {t p evm K1}
- (FH : forall t, value t -> Prop)
- (F : K1 -> Prop)
- {struct p}
- : @with_unification_resultT' t p evm K1 -> Prop
- := match p return with_unification_resultT' p evm K1 -> Prop with
- | pattern.Wildcard t => fun f1 => forall v1, FH _ v1 -> F (f1 v1)
- | pattern.Ident t idc => under_type_of_list_relation1_cps F
- | pattern.App s d f x
- => @under_with_unification_resultT'_relation1_gen
- _ f evm _
- FH
- (@under_with_unification_resultT'_relation1_gen _ x evm _ FH F)
- end.
-
- Definition under_with_unification_resultT'_relation1 {t p evm K1}
- (F : K1 -> Prop)
- : @with_unification_resultT' t p evm K1 -> Prop
- := @under_with_unification_resultT'_relation1_gen t p evm K1 (fun _ _ => True) F.
-
- Fixpoint under_with_unification_resultT'_relation_hetero {t p evm K1 K2}
- (FH : forall t, value t -> value t -> Prop)
- (F : K1 -> K2 -> Prop)
- {struct p}
- : @with_unification_resultT' t p evm K1 -> @with_unification_resultT' t p evm K2 -> Prop
- := match p return with_unification_resultT' p evm K1 -> with_unification_resultT' p evm K2 -> Prop with
- | pattern.Wildcard t => fun f1 f2 => forall v1 v2, FH _ v1 v2 -> F (f1 v1) (f2 v2)
- | pattern.Ident t idc => under_type_of_list_relation_cps F
- | pattern.App s d f x
- => @under_with_unification_resultT'_relation_hetero
- _ f evm _ _
- FH
- (@under_with_unification_resultT'_relation_hetero _ x evm _ _ FH F)
- end.
-
- Definition under_with_unification_resultT'_relation {t p evm K1 K2}
- (F : K1 -> K2 -> Prop)
- : @with_unification_resultT' t p evm K1 -> @with_unification_resultT' t p evm K2 -> Prop
- := @under_with_unification_resultT'_relation_hetero t p evm K1 K2 (fun _ => eq) F.
-
Definition ident_collect_vars := (fun t idc => fold_right PositiveSet.union PositiveSet.empty (List.map pattern.type.collect_vars (type_vars_of_pident t idc))).
Definition with_unification_resultT {t} (p : pattern t) (K : type -> Type) : Type
@@ -706,38 +712,24 @@ Module Compilers.
t p)
(fun evm => with_unification_resultT' p evm (K (pattern.type.subst_default t evm))).
+ Definition unification_resultT {t} (p : pattern t) : Type
+ := { evm : EvarMap & unification_resultT' p evm }.
+
+ Definition app_with_unification_resultT_cps {t p K}
+ : @with_unification_resultT t p K -> @unification_resultT t p -> forall T, ({ evm' : _ & K (pattern.type.subst_default t evm') } -> option T) -> option T
+ := fun f x T k
+ => (f' <- pattern.type.app_forall_vars f (projT1 x);
+ app_transport_with_unification_resultT'_cps
+ f' (projT2 x) _
+ (fun fx
+ => k (existT _ _ fx)))%option.
+
Definition under_with_unification_resultT {t p K1 K2}
(F : forall evm, K1 (pattern.type.subst_default t evm) -> K2 (pattern.type.subst_default t evm))
: @with_unification_resultT t p K1 -> @with_unification_resultT t p K2
:= pattern.type.under_forall_vars
(fun evm => under_with_unification_resultT' (F evm)).
- Definition under_with_unification_resultT_relation1_gen {t p K1}
- (FH : forall t, value t -> Prop)
- (F : forall evm, K1 (pattern.type.subst_default t evm) -> Prop)
- : @with_unification_resultT t p K1 -> Prop
- := pattern.type.under_forall_vars_relation1
- (fun evm => under_with_unification_resultT'_relation1_gen FH (F evm)).
-
- Definition under_with_unification_resultT_relation1 {t p K1}
- (F : forall evm, K1 (pattern.type.subst_default t evm) -> Prop)
- : @with_unification_resultT t p K1 -> Prop
- := pattern.type.under_forall_vars_relation1
- (fun evm => under_with_unification_resultT'_relation1 (F evm)).
-
- Definition under_with_unification_resultT_relation_hetero {t p K1 K2}
- (FH : forall t, value t -> value t -> Prop)
- (F : forall evm, K1 (pattern.type.subst_default t evm) -> K2 (pattern.type.subst_default t evm) -> Prop)
- : @with_unification_resultT t p K1 -> @with_unification_resultT t p K2 -> Prop
- := pattern.type.under_forall_vars_relation
- (fun evm => under_with_unification_resultT'_relation_hetero FH (F evm)).
-
- Definition under_with_unification_resultT_relation {t p K1 K2}
- (F : forall evm, K1 (pattern.type.subst_default t evm) -> K2 (pattern.type.subst_default t evm) -> Prop)
- : @with_unification_resultT t p K1 -> @with_unification_resultT t p K2 -> Prop
- := pattern.type.under_forall_vars_relation
- (fun evm => under_with_unification_resultT'_relation (F evm)).
-
Fixpoint preunify_types {t} (e : rawexpr) (p : pattern t) {struct p}
: option (option (ptype * type))
:= match p, e with
@@ -787,49 +779,43 @@ Module Compilers.
Definition option_bind' {A B} := @Option.bind A B. (* for help with unfolding *)
- Fixpoint unify_pattern' {t} (e : rawexpr) (p : pattern t) {evm : EvarMap} {K : type -> Type} {struct p}
- : (with_unification_resultT' p evm (K (pattern.type.subst_default t evm)))
- -> forall T, (K (pattern.type.subst_default t evm) -> option T) -> option T
- := match p in pattern.pattern t, e return with_unification_resultT' p evm (K (pattern.type.subst_default t evm)) -> forall T, (K (pattern.type.subst_default t evm) -> option T) -> option T with
+ Fixpoint unify_pattern' {t} (e : rawexpr) (p : pattern t) (evm : EvarMap) {struct p}
+ : forall T, (unification_resultT' p evm -> option T) -> option T
+ := match p, e return forall T, (unification_resultT' p evm -> option T) -> option T with
| pattern.Wildcard t', _
- => fun k T k'
+ => fun T k
=> (tro <- type.try_make_transport_cps (@base.try_make_transport_cps) value _ _;
(tr <- tro;
- k' (k (tr (value_of_rawexpr e))))%option)
+ (k (tr (value_of_rawexpr e))))%option)%cps
| pattern.Ident t pidc, rIdent known _ idc _ _
- => fun k T k'
+ => fun T k
=> (if known
then Option.bind (pident_unify _ _ pidc idc)
else option_bind' (pident_unify_unknown _ _ pidc idc))
- (fun idc_args
- => k' (app_type_of_list k idc_args))
+ k
| pattern.App s d pf px, rApp f x _ _
- => fun k T k'
+ => fun T k
=> @unify_pattern'
- _ f pf evm (fun t => with_unification_resultT' px evm (K (type.codomain t))) k T
- (fun f'
+ _ f pf evm T
+ (fun fv
=> @unify_pattern'
- _ x px evm (fun _ => K _) f' T k')
+ _ x px evm T
+ (fun xv
+ => k (fv, xv)))
| pattern.Ident _ _, _
| pattern.App _ _ _ _, _
- => fun _ _ k => None
- end%cps.
+ => fun _ k => None
+ end%option.
- Definition unify_pattern {t} (e : rawexpr) (p : pattern t) {K : type -> Type}
- (k : with_unification_resultT p K)
- : forall T, (K (type_of_rawexpr e) -> option T) -> option T
+ Definition unify_pattern {t} (e : rawexpr) (p : pattern t)
+ : forall T, (unification_resultT p -> option T) -> option T
:= fun T cont
=> unify_types
e p _
(fun evm
=> evm <- evm;
- k' <- pattern.type.app_forall_vars k evm;
unify_pattern'
- e p k' _
- (fun res
- => tr <- type.try_make_transport_cps (@base.try_make_transport_cps) K _ _;
- (tr <- tr;
- cont (tr res))%option)%cps)%option.
+ e p evm T (fun v => cont (existT _ _ v)))%option.
(** We follow
http://moscova.inria.fr/~maranget/papers/ml05e-maranget.pdf,
@@ -954,42 +940,34 @@ Module Compilers.
end
end%option.
- Local Notation deep_rewrite_ruleTP_gen' should_do_again with_opt under_lets is_cps t
- := ((if is_cps
- then fun T => forall T', (T -> option T') -> option T'
- else fun T => T)
- match (@expr.expr base.type ident (if should_do_again then value else var) t) with
- | x0 => match (if under_lets then UnderLets x0 else x0) with
- | x1 => if with_opt then option x1 else x1
- end
- end).
-
- Definition deep_rewrite_ruleTP_gen (should_do_again : bool) (with_opt : bool) (under_lets : bool) (is_cps : bool) t
- := deep_rewrite_ruleTP_gen' should_do_again with_opt under_lets is_cps t.
-
- Definition normalize_deep_rewrite_rule {should_do_again with_opt under_lets is_cps t}
- : deep_rewrite_ruleTP_gen should_do_again with_opt under_lets is_cps t
- -> deep_rewrite_ruleTP_gen should_do_again true true true t
- := match with_opt, under_lets, is_cps with
- | true, true, true => fun x => x
- | false, true, true => fun x_cps _ k => x_cps _ (fun x => k (Some x))
- | true, false, true => fun x_cps _ k => x_cps _ (fun x => x <- x; k (Some (UnderLets.Base x)))%option
- | false, false, true => fun x_cps _ k => x_cps _ (fun x => k (Some (UnderLets.Base x)))
- | true, true, false => fun x _ k => k x
- | false, true, false => fun x _ k => k (Some x)
- | true, false, false => fun x _ k => (x <- x; k (Some (UnderLets.Base x)))%option
- | false, false, false => fun x _ k => k (Some (UnderLets.Base x))
+ Local Notation deep_rewrite_ruleTP_gen' should_do_again with_opt under_lets t
+ := (match (@expr.expr base.type ident (if should_do_again then value else var) t) with
+ | x0 => match (if under_lets then UnderLets x0 else x0) with
+ | x1 => if with_opt then option x1 else x1
+ end
+ end).
+
+ Definition deep_rewrite_ruleTP_gen (should_do_again : bool) (with_opt : bool) (under_lets : bool) t
+ := deep_rewrite_ruleTP_gen' should_do_again with_opt under_lets t.
+
+ Definition normalize_deep_rewrite_rule {should_do_again with_opt under_lets t}
+ : deep_rewrite_ruleTP_gen should_do_again with_opt under_lets t
+ -> deep_rewrite_ruleTP_gen should_do_again true true t
+ := match with_opt, under_lets with
+ | true , true => fun x => x
+ | false, true => fun x => Some x
+ | true , false => fun x => (x <- x; Some (UnderLets.Base x))%option
+ | false, false => fun x => Some (UnderLets.Base x)
end%cps.
- Definition with_unif_rewrite_ruleTP_gen {t} (p : pattern t) (should_do_again : bool) (with_opt : bool) (under_lets : bool) (is_cps : bool)
- := with_unification_resultT p (fun t => deep_rewrite_ruleTP_gen' should_do_again with_opt under_lets is_cps t).
+ Definition with_unif_rewrite_ruleTP_gen {t} (p : pattern t) (should_do_again : bool) (with_opt : bool) (under_lets : bool)
+ := with_unification_resultT p (fun t => deep_rewrite_ruleTP_gen' should_do_again with_opt under_lets t).
Record rewrite_rule_data {t} {p : pattern t} :=
{ rew_should_do_again : bool;
rew_with_opt : bool;
rew_under_lets : bool;
- rew_is_cps : bool;
- rew_replacement : with_unif_rewrite_ruleTP_gen p rew_should_do_again rew_with_opt rew_under_lets rew_is_cps }.
+ rew_replacement : with_unif_rewrite_ruleTP_gen p rew_should_do_again rew_with_opt rew_under_lets }.
Definition rewrite_ruleTP
:= (fun p : anypattern => @rewrite_rule_data _ (pattern.pattern_of_anypattern p)).
@@ -1019,37 +997,37 @@ Module Compilers.
:= let 'existT p f := pf in
let should_do_again := rew_should_do_again f in
unify_pattern
- e' (pattern.pattern_of_anypattern p) (rew_replacement f) _
- (fun fv
- => normalize_deep_rewrite_rule
- fv _
- (fun fv
- => option_bind'
- fv
- (fun fv
- => (tr <- type.try_make_transport_cps (@base.try_make_transport_cps) _ _ _;
- (tr <- tr;
- (tr' <- type.try_make_transport_cps (@base.try_make_transport_cps) _ _ _;
- (tr' <- tr';
- Some (fv <-- fv;
+ e' (pattern.pattern_of_anypattern p) _
+ (fun x
+ => app_with_unification_resultT_cps
+ (rew_replacement f) x _
+ (fun f'
+ => (tr <- type.try_make_transport_cps (@base.try_make_transport_cps) _ _ _;
+ (tr <- tr;
+ (tr' <- type.try_make_transport_cps (@base.try_make_transport_cps) _ _ _;
+ (tr' <- tr';
+ option_bind'
+ (normalize_deep_rewrite_rule (projT2 f'))
+ (fun fv
+ => Some (fv <-- fv;
fv <-- maybe_do_again should_do_again (base_type_of (type_of_rawexpr e')) (tr fv);
- UnderLets.Base (tr' fv))%under_lets)%option)%cps)%option)%cps)%cps)).
-
- Definition eval_rewrite_rules
- (d : decision_tree)
- (rews : rewrite_rulesT)
- (e : rawexpr)
- : UnderLets (expr (type_of_rawexpr e))
- := let defaulte := expr_of_rawexpr e in
- (eval_decision_tree
- (e::nil) d
- (fun k ctx
- => match ctx return option (UnderLets (expr (type_of_rawexpr e))) with
- | e'::nil
- => (pf <- nth_error rews k; rewrite_with_rule defaulte e' pf)%option
- | _ => None
- end);;;
- (UnderLets.Base defaulte))%option.
+ UnderLets.Base (tr' fv))%under_lets))%option)%cps)%option)%cps)%cps).
+
+ Definition eval_rewrite_rules
+ (d : decision_tree)
+ (rews : rewrite_rulesT)
+ (e : rawexpr)
+ : UnderLets (expr (type_of_rawexpr e))
+ := let defaulte := expr_of_rawexpr e in
+ (eval_decision_tree
+ (e::nil) d
+ (fun k ctx
+ => match ctx return option (UnderLets (expr (type_of_rawexpr e))) with
+ | e'::nil
+ => (pf <- nth_error rews k; rewrite_with_rule defaulte e' pf)%option
+ | _ => None
+ end);;;
+ (UnderLets.Base defaulte))%option.
End eval_rewrite_rules.
Local Notation enumerate ls
@@ -1418,7 +1396,6 @@ Module Compilers.
=> {| rew_should_do_again := false;
rew_with_opt := false;
rew_under_lets := false;
- rew_is_cps := false;
rew_replacement
:= under_with_unification_resultT
(fun evm v => ident.smart_Literal v)
@@ -1535,7 +1512,7 @@ Module Compilers.
:= (existT
rewrite_ruleTP
(@Build_anypattern _ p%pattern)
- (@Build_rewrite_rule_data _ p%pattern should_do_again with_opt under_lets false (* is_cps *) f)).
+ (@Build_rewrite_rule_data _ p%pattern should_do_again with_opt under_lets f)).
(* %cps%option%under_lets *)
Notation make_rewrite p f
:= (make_rewrite_gen false false false p f%rewrite%expr%list%Z%bool).
@@ -2256,18 +2233,23 @@ Z.mul @@ (?x >> 128, ?y >> 128) --> mulhh @@ (x, y)
End RewriterPrintingNotations.
Ltac make_rewrite_head1 rewrite_head0 pr2_rewrite_rules :=
- (eval cbv -[pr2_rewrite_rules
- base.interp base.try_make_transport_cps
- type.try_make_transport_cps type.try_transport_cps
- pattern.type.unify_extracted_cps
- Compile.option_type_type_beq
- Let_In Option.sequence Option.sequence_return
- UnderLets.splice UnderLets.to_expr
- Compile.option_bind' pident_unify_unknown invert_bind_args_unknown Compile.normalize_deep_rewrite_rule
- 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_cast
- ] in rewrite_head0).
+ let rewrite_head1
+ := (eval cbv -[pr2_rewrite_rules
+ base.interp base.try_make_transport_cps
+ type.try_make_transport_cps
+ pattern.type.unify_extracted_cps
+ Compile.option_type_type_beq
+ Let_In Option.sequence Option.sequence_return
+ UnderLets.splice UnderLets.to_expr
+ Compile.option_bind' pident_unify_unknown invert_bind_args_unknown Compile.normalize_deep_rewrite_rule
+ 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_cast
+ ] in rewrite_head0) in
+ let rewrite_head1
+ := (eval cbn [type.try_make_transport_cps base.try_make_transport_cps base.try_make_base_transport_cps]
+ in rewrite_head1) in
+ rewrite_head1.
Ltac timed_make_rewrite_head1 rewrite_head0 pr2_rewrite_rules :=
constr:(ltac:(time (idtac; let v := make_rewrite_head1 rewrite_head0 pr2_rewrite_rules in exact v))).
Ltac make_rewrite_head2 rewrite_head1 pr2_rewrite_rules :=
@@ -2276,6 +2258,9 @@ Z.mul @@ (?x >> 128, ?y >> 128) --> mulhh @@ (x, y)
projT1 projT2
cpsbind cpscall cps_option_bind cpsreturn
PrimitiveProd.Primitive.fst PrimitiveProd.Primitive.snd
+ pattern.type.subst_default pattern.base.subst_default
+ PositiveMap.add PositiveMap.find PositiveMap.empty
+ PositiveSet.rev PositiveSet.rev_append
pattern.ident.arg_types
Compile.eval_decision_tree
Compile.eval_rewrite_rules
@@ -2290,7 +2275,6 @@ Z.mul @@ (?x >> 128, ?y >> 128) --> mulhh @@ (x, y)
Compile.rew_with_opt
Compile.rew_under_lets
Compile.rew_replacement
- Compile.rew_is_cps
Compile.rValueOrExpr
Compile.swap_list
Compile.type_of_rawexpr
diff --git a/src/Experiments/NewPipeline/RewriterRulesGood.v b/src/Experiments/NewPipeline/RewriterRulesGood.v
index ec01917e7..359459764 100644
--- a/src/Experiments/NewPipeline/RewriterRulesGood.v
+++ b/src/Experiments/NewPipeline/RewriterRulesGood.v
@@ -206,6 +206,7 @@ Module Compilers.
Proof. induction n; cbn [nat_rect]; auto. Qed.
Local Ltac start_good :=
+ apply Compile.rewrite_rules_goodT_by_curried;
split; [ reflexivity | ];
lazymatch goal with
| [ |- forall x p x' p', In (@existT ?A ?P x p, @existT ?A' ?P' x' p') ?ls -> @?Q x x' p p' ]
@@ -213,7 +214,7 @@ Module Compilers.
end;
(exists eq_refl);
cbn [eq_rect];
- cbv [Compile.wf_deep_rewrite_ruleTP_gen Compile.wf_rewrite_rule_data Compile.rew_replacement Compile.rew_is_cps Compile.rew_should_do_again Compile.rew_with_opt Compile.rew_under_lets Compile.wf_with_unif_rewrite_ruleTP_gen Compile.wf_with_unification_resultT pattern.pattern_of_anypattern pattern.type_of_anypattern Compile.wf_maybe_under_lets_expr Compile.wf_maybe_do_again_expr Compile.wf_with_unification_resultT' pattern.type.under_forall_vars_relation Compile.with_unification_resultT' pattern.collect_vars Compile.ident_collect_vars pattern.ident.type_vars pattern.type.collect_vars pattern.base.collect_vars PositiveSet.empty PositiveSet.elements Compile.under_type_of_list_relation_cps pattern.ident.arg_types pattern.type.subst_default pattern.base.subst_default PositiveSet.rev PositiveMap.empty];
+ cbv [Compile.wf_deep_rewrite_ruleTP_gen Compile.wf_rewrite_rule_data_curried Compile.rew_replacement Compile.rew_should_do_again Compile.rew_with_opt Compile.rew_under_lets Compile.wf_with_unif_rewrite_ruleTP_gen_curried Compile.wf_with_unification_resultT pattern.pattern_of_anypattern pattern.type_of_anypattern Compile.wf_maybe_under_lets_expr Compile.wf_maybe_do_again_expr Compile.wf_with_unification_resultT pattern.type.under_forall_vars_relation Compile.with_unification_resultT' pattern.collect_vars Compile.ident_collect_vars pattern.ident.type_vars pattern.type.collect_vars pattern.base.collect_vars PositiveSet.empty PositiveSet.elements Compile.under_type_of_list_relation_cps pattern.ident.arg_types pattern.type.subst_default pattern.base.subst_default PositiveSet.rev PositiveMap.empty Compile.under_with_unification_resultT_relation_hetero Compile.under_with_unification_resultT'_relation_hetero Compile.maybe_option_eq];
cbn [List.map List.fold_right PositiveSet.union PositiveSet.xelements List.rev List.app projT1 projT2 list_rect PositiveSet.add PositiveSet.rev PositiveSet.rev_append PositiveMap.add PositiveMap.find orb];
repeat first [ progress intros
| match goal with
diff --git a/src/Experiments/NewPipeline/RewriterRulesInterpGood.v b/src/Experiments/NewPipeline/RewriterRulesInterpGood.v
index e5d0e040f..bb62228b6 100644
--- a/src/Experiments/NewPipeline/RewriterRulesInterpGood.v
+++ b/src/Experiments/NewPipeline/RewriterRulesInterpGood.v
@@ -100,13 +100,14 @@ Module Compilers.
Local Ltac do_cbv0 :=
cbv [id
- Compile.rewrite_rules_interp_goodT
- Compile.rewrite_rule_data_interp_goodT Compile.under_with_unification_resultT_relation_hetero Compile.under_with_unification_resultT_relation1_gen Compile.under_with_unification_resultT_relation1 Compile.under_with_unification_resultT'_relation_hetero Compile.wf_with_unification_resultT Compile.under_with_unification_resultT'_relation1 Compile.under_with_unification_resultT'_relation1_gen Compile.under_type_of_list_relation_cps Compile.under_type_of_list_relation1_cps pattern.pattern_of_anypattern pattern.type_of_anypattern Compile.rew_replacement Compile.rew_is_cps Compile.rew_should_do_again Compile.rew_with_opt Compile.rew_under_lets Compile.wf_with_unification_resultT' Compile.pattern_default_interp pattern.type.under_forall_vars_relation pattern.type.under_forall_vars_relation1 Compile.deep_rewrite_ruleTP_gen Compile.with_unification_resultT' pattern.ident.arg_types pattern.type.lam_forall_vars Compile.pattern_default_interp' pattern.collect_vars PositiveMap.empty Compile.ident_collect_vars pattern.ident.type_vars pattern.type.collect_vars PositiveSet.elements PositiveSet.union pattern.base.collect_vars PositiveSet.empty PositiveSet.xelements Compile.lam_type_of_list id pattern.ident.to_typed Compile.under_type_of_list_relation_cps Compile.deep_rewrite_ruleTP_gen_good_relation Compile.deep_rewrite_ruleTP_gen_ok_relation Compile.normalize_deep_rewrite_rule_cps_id_hypsT Compile.normalize_deep_rewrite_rule pattern.type.subst_default PositiveSet.add PositiveSet.rev PositiveSet.rev_append PositiveMap.add Compile.option_bind' Compile.wf_value Compile.value pattern.base.subst_default PositiveMap.find Compile.rewrite_ruleTP ident.smart_Literal Compile.value_interp_related Compile.value'_interp_related].
+ Compile.rewrite_rules_interp_goodT_curried
+ Compile.rewrite_rule_data_interp_goodT_curried Compile.under_with_unification_resultT_relation_hetero Compile.under_with_unification_resultT'_relation_hetero Compile.wf_with_unification_resultT Compile.under_type_of_list_relation_cps Compile.under_type_of_list_relation1_cps pattern.pattern_of_anypattern pattern.type_of_anypattern Compile.rew_replacement Compile.rew_should_do_again Compile.rew_with_opt Compile.rew_under_lets Compile.wf_with_unification_resultT Compile.pattern_default_interp pattern.type.under_forall_vars_relation pattern.type.under_forall_vars_relation1 Compile.deep_rewrite_ruleTP_gen Compile.with_unification_resultT' pattern.ident.arg_types pattern.type.lam_forall_vars Compile.pattern_default_interp' pattern.collect_vars PositiveMap.empty Compile.ident_collect_vars pattern.ident.type_vars pattern.type.collect_vars PositiveSet.elements PositiveSet.union pattern.base.collect_vars PositiveSet.empty PositiveSet.xelements Compile.lam_type_of_list id pattern.ident.to_typed Compile.under_type_of_list_relation_cps Compile.deep_rewrite_ruleTP_gen_good_relation Compile.normalize_deep_rewrite_rule pattern.type.subst_default PositiveSet.add PositiveSet.rev PositiveSet.rev_append PositiveMap.add Compile.option_bind' Compile.wf_value Compile.value pattern.base.subst_default PositiveMap.find Compile.rewrite_ruleTP ident.smart_Literal Compile.value_interp_related Compile.value'_interp_related].
Local Ltac do_cbv :=
do_cbv0;
cbv [List.map List.fold_right List.rev list_rect orb List.app].
Local Ltac start_interp_good :=
+ apply Compile.rewrite_rules_interp_goodT_by_curried;
do_cbv;
lazymatch goal with
| [ |- forall x p, In (@existT ?A ?P x p) ?ls -> @?Q x p ]
diff --git a/src/Experiments/NewPipeline/RewriterWf1.v b/src/Experiments/NewPipeline/RewriterWf1.v
index 7c91bc401..cedd56dc0 100644
--- a/src/Experiments/NewPipeline/RewriterWf1.v
+++ b/src/Experiments/NewPipeline/RewriterWf1.v
@@ -548,7 +548,9 @@ Module Compilers.
Local Notation reveal_rawexpr_gen assume_known e := (@reveal_rawexpr_cps_gen ident _ assume_known e _ id).
Local Notation reveal_rawexpr e := (@reveal_rawexpr_cps ident _ e _ id).
Local Notation unify_pattern' var := (@unify_pattern' ident var pident pident_arg_types pident_unify pident_unify_unknown).
- Local Notation unify_pattern var := (@unify_pattern ident var pident pident_arg_types pident_unify pident_unify_unknown type_vars_of_pident).
+ Local Notation unify_pattern var := (@unify_pattern ident var pident pident_arg_types pident_unify pident_unify_unknown).
+ Local Notation app_transport_with_unification_resultT'_cps var := (@app_transport_with_unification_resultT'_cps ident var pident pident_arg_types).
+ Local Notation app_with_unification_resultT_cps var := (@app_with_unification_resultT_cps ident var pident pident_arg_types type_vars_of_pident).
Definition lam_type_of_list {ls K} : (type_of_list ls -> K) -> type_of_list_cps K ls
:= list_rect
@@ -876,12 +878,12 @@ Module Compilers.
etransitivity; rewrite pattern.type.add_var_types_cps_id; [ reflexivity | ]; break_innermost_match; reflexivity.
Qed.
- Lemma unify_pattern'_cps_id {t e p evm K v T cont}
- : @unify_pattern' var t e p evm K v T cont
- = (v' <- @unify_pattern' var t e p evm K v _ (@Some _); cont v')%option.
+ Lemma unify_pattern'_cps_id {t e p evm T cont}
+ : @unify_pattern' var t e p evm T cont
+ = (v' <- @unify_pattern' var t e p evm _ (@Some _); cont v')%option.
Proof using Type.
clear.
- revert e evm K v T cont; induction p; intros; cbn in *;
+ revert e evm T cont; induction p; intros; cbn in *;
repeat first [ progress rewrite_type_transport_correct
| reflexivity
| progress cbv [Option.bind cpscall option_bind'] in *
@@ -889,9 +891,9 @@ Module Compilers.
| break_innermost_match_step ].
Qed.
- Lemma unify_pattern_cps_id {t e p K v T cont}
- : @unify_pattern var t e p K v T cont
- = (v' <- @unify_pattern var t e p K v _ (@Some _); cont v')%option.
+ Lemma unify_pattern_cps_id {t e p T cont}
+ : @unify_pattern var t e p T cont
+ = (v' <- @unify_pattern var t e p _ (@Some _); cont v')%option.
Proof using Type.
clear.
cbv [unify_pattern].
@@ -900,44 +902,46 @@ Module Compilers.
| progress rewrite_type_transport_correct
| progress cbv [Option.bind cpscall option_bind'] in *
| match goal with
- | [ |- @unify_pattern' _ _ _ _ _ _ _ _ _ = _ ]
+ | [ |- @unify_pattern' _ _ _ _ _ _ _ = _ ]
=> etransitivity; rewrite unify_pattern'_cps_id; [ | reflexivity ]
end
| break_innermost_match_step
| break_match_step ltac:(fun _ => idtac) ].
Qed.
- Section normalize_deep_rewrite_rule_cps_id.
- Context {should_do_again with_opt under_lets is_cps : bool}
- {t}
- {v : @deep_rewrite_ruleTP_gen should_do_again with_opt under_lets is_cps t}
- {T}
- {k : option (UnderLets var (@expr.expr base.type ident (if should_do_again then @value var else var) t)) -> option T}.
-
- Definition normalize_deep_rewrite_rule_cps_id_hypsT
- := ((match is_cps, with_opt return @deep_rewrite_ruleTP_gen should_do_again with_opt under_lets is_cps t -> Prop
- with
- | true, true => fun v => forall T k, v T k = k (v _ id)
- | true, false => fun v => forall T k, v T k = (v' <- v _ (@Some _); k v')%option
- | false, _ => fun _ => True
- end)
- v).
-
- Lemma normalize_deep_rewrite_rule_cps_id
- (Hk : k None = None)
- (Hv : normalize_deep_rewrite_rule_cps_id_hypsT)
- : @normalize_deep_rewrite_rule ident var should_do_again with_opt under_lets is_cps t v T k = k (@normalize_deep_rewrite_rule ident var should_do_again with_opt under_lets is_cps t v _ id).
- Proof using Type.
- clear -Hk Hv; cbv [normalize_deep_rewrite_rule_cps_id_hypsT] in *; cbn in *.
- repeat first [ progress cbn in *
- | progress destruct_head'_bool
- | reflexivity
- | progress cbv [id Option.bind] in *
- | solve [ auto ]
- | break_innermost_match_step
- | rewrite Hv; (solve [ auto ] + break_innermost_match_step) ].
- Qed.
- End normalize_deep_rewrite_rule_cps_id.
+ Lemma app_transport_with_unification_resultT'_cps_id {t p evm1 evm2 K f v T cont}
+ : @app_transport_with_unification_resultT'_cps var t p evm1 evm2 K f v T cont
+ = (res <- @app_transport_with_unification_resultT'_cps var t p evm1 evm2 K f v _ (@Some _); cont res)%option.
+ Proof using Type.
+ revert K f v T cont; induction p; cbn [app_transport_with_unification_resultT'_cps]; intros.
+ all: repeat first [ progress rewrite_type_transport_correct
+ | progress type_beq_to_eq
+ | progress cbn [Option.bind with_unification_resultT' unification_resultT'] in *
+ | progress subst
+ | reflexivity
+ | progress fold (@with_unification_resultT' ident var pident pident_arg_types)
+ | progress inversion_option
+ | break_innermost_match_step
+ | match goal with
+ | [ H : context G[fun x => ?f x] |- _ ] => let G' := context G[f] in change G' in H
+ | [ |- context G[fun x => ?f x] ] => let G' := context G[f] in change G'
+ | [ H : forall K f v T cont, _ cont = _ |- _ ] => progress cps_id'_with_option H
+ end
+ | progress cbv [Option.bind] ].
+ Qed.
+
+ Lemma app_with_unification_resultT_cps_id {t p K f v T cont}
+ : @app_with_unification_resultT_cps var t p K f v T cont
+ = (res <- @app_with_unification_resultT_cps var t p K f v _ (@Some _); cont res)%option.
+ Proof using Type.
+ cbv [app_with_unification_resultT_cps].
+ repeat first [ progress cbv [Option.bind] in *
+ | reflexivity
+ | progress subst
+ | progress inversion_option
+ | progress break_match
+ | progress cps_id'_with_option app_transport_with_unification_resultT'_cps_id ].
+ Qed.
Lemma reveal_rawexpr_cps_gen_id assume_known e T k
: @reveal_rawexpr_cps_gen ident var assume_known e T k = k (reveal_rawexpr_gen assume_known e).
@@ -1041,7 +1045,7 @@ Module Compilers.
cbv [under_type_of_list_relation1_cps] in *.
induction ls; cbn in *; eauto.
Qed.
-
+ (*
Lemma under_with_unification_resultT'_relation1_gen_always
{t p evm K1 FH F v}
(F_always : forall v, F v : Prop)
@@ -1051,6 +1055,7 @@ Module Compilers.
revert evm K1 F v F_always.
induction p; intros; cbn in *; eauto using @under_type_of_list_relation1_cps_always.
Qed.
+ *)
End with_var1.
Section with_var2.
@@ -1078,6 +1083,10 @@ Module Compilers.
Local Notation with_unification_resultT'2 := (@with_unification_resultT' ident var2 pident pident_arg_types).
Local Notation with_unification_resultT1 := (@with_unification_resultT ident var1 pident pident_arg_types type_vars_of_pident).
Local Notation with_unification_resultT2 := (@with_unification_resultT ident var2 pident pident_arg_types type_vars_of_pident).
+ Local Notation unification_resultT'1 := (@unification_resultT' ident var1 pident pident_arg_types).
+ Local Notation unification_resultT'2 := (@unification_resultT' ident var2 pident pident_arg_types).
+ Local Notation unification_resultT1 := (@unification_resultT ident var1 pident pident_arg_types).
+ Local Notation unification_resultT2 := (@unification_resultT ident var2 pident pident_arg_types).
Local Notation rewrite_rule_data1 := (@rewrite_rule_data ident var1 pident pident_arg_types type_vars_of_pident).
Local Notation rewrite_rule_data2 := (@rewrite_rule_data ident var2 pident pident_arg_types type_vars_of_pident).
Local Notation with_unif_rewrite_ruleTP_gen1 := (@with_unif_rewrite_ruleTP_gen ident var1 pident pident_arg_types type_vars_of_pident).
@@ -1287,52 +1296,163 @@ Module Compilers.
erewrite wf_unify_types by eassumption; reflexivity.
Qed.
- Fixpoint wf_with_unification_resultT'
- (G : list {t : _ & (var1 t * var2 t)%type})
- {t1 t2} {p1 : pattern t1} {p2 : pattern t2} {evm1 evm2 : EvarMap} {K1 K2}
- (P : K1 -> K2 -> Prop)
- {struct p1}
- : @with_unification_resultT'1 t1 p1 evm1 K1
- -> @with_unification_resultT'2 t2 p2 evm2 K2
- -> Prop
- := match p1 in pattern.pattern t1, p2 in pattern.pattern t2
- return @with_unification_resultT'1 t1 p1 evm1 K1
- -> @with_unification_resultT'2 t2 p2 evm2 K2
- -> Prop
- with
- | pattern.Wildcard t1, pattern.Wildcard t2
- => fun f1 f2
- => { pf : pattern.type.subst_default t1 evm1 = pattern.type.subst_default t2 evm2
- | forall v1 v2,
- wf_value G (rew [value] pf in v1) v2
- -> P (f1 v1) (f2 v2) }
- | pattern.Ident t1 idc1, pattern.Ident t2 idc2
- => fun v1 v2
- => { pf : existT pident t1 idc1 = existT pident t2 idc2
- | under_type_of_list_relation_cps
- P
- (rew [fun tidc => type_of_list_cps K1 (pident_arg_types (projT1 tidc) (projT2 tidc))] pf in (v1 : type_of_list_cps _ (pident_arg_types _ (projT2 (existT pident _ _)))))
- v2 }
- | pattern.App s1 d1 f1 x1, pattern.App s2 d2 f2 x2
- => fun (v1 : with_unification_resultT'1 f1 evm1 (with_unification_resultT'1 x1 evm1 K1))
- (v2 : with_unification_resultT'2 f2 evm2 (with_unification_resultT'2 x2 evm2 K2))
- => @wf_with_unification_resultT'
- G _ _ f1 f2 evm1 evm2 _ _
- (@wf_with_unification_resultT' G _ _ x1 x2 evm1 evm2 _ _ P)
- v1 v2
- | pattern.Wildcard _, _
- | pattern.Ident _ _, _
- | pattern.App _ _ _ _, _
- => fun _ _ => False
+ Fixpoint related_unification_resultT' (R : forall t, @value var1 t -> @value var2 t -> Prop) {t p evm}
+ : @unification_resultT'1 t p evm -> @unification_resultT'2 t p evm -> Prop
+ := match p return unification_resultT'1 p evm -> unification_resultT'2 p evm -> Prop with
+ | pattern.Wildcard t => R _
+ | pattern.Ident t idc => eq
+ | pattern.App s d f x
+ => fun (v1 : unification_resultT'1 f evm * unification_resultT'1 x evm)
+ (v2 : unification_resultT'2 f evm * unification_resultT'2 x evm)
+ => @related_unification_resultT' R _ _ _ (fst v1) (fst v2)
+ /\ @related_unification_resultT' R _ _ _ (snd v1) (snd v2)
end.
+ Definition wf_unification_resultT' (G : list {t1 : type & (var1 t1 * var2 t1)%type}) {t p evm}
+ : @unification_resultT'1 t p evm -> @unification_resultT'2 t p evm -> Prop
+ := @related_unification_resultT' (fun _ => wf_value G) t p evm.
+
+ (** TODO: MOVE ME? *)
+ Definition related_sigT_by_eq {A P1 P2} (R : forall x : A, P1 x -> P2 x -> Prop)
+ (x : @sigT A P1) (y : @sigT A P2)
+ : Prop
+ := { pf : projT1 x = projT1 y
+ | R _ (rew pf in projT2 x) (projT2 y) }.
+
+ Definition related_unification_resultT (R : forall t, @value var1 t -> @value var2 t -> Prop) {t p}
+ : @unification_resultT1 t p -> @unification_resultT2 t p -> Prop
+ := related_sigT_by_eq (@related_unification_resultT' R t p).
+
+ Definition wf_unification_resultT (G : list {t1 : type & (var1 t1 * var2 t1)%type}) {t p}
+ : @unification_resultT1 t p -> @unification_resultT2 t p -> Prop
+ := @related_unification_resultT (fun _ => wf_value G) t p.
+
+ Fixpoint under_with_unification_resultT'_relation_hetero {t p evm K1 K2}
+ (FH : forall t, value t -> value t -> Prop)
+ (F : K1 -> K2 -> Prop)
+ {struct p}
+ : @with_unification_resultT'1 t p evm K1 -> @with_unification_resultT'2 t p evm K2 -> Prop
+ := match p return with_unification_resultT'1 p evm K1 -> with_unification_resultT'2 p evm K2 -> Prop with
+ | pattern.Wildcard t => fun f1 f2 => forall v1 v2, FH _ v1 v2 -> F (f1 v1) (f2 v2)
+ | pattern.Ident t idc => under_type_of_list_relation_cps F
+ | pattern.App s d f x
+ => @under_with_unification_resultT'_relation_hetero
+ _ f evm _ _
+ FH
+ (@under_with_unification_resultT'_relation_hetero _ x evm _ _ FH F)
+ end.
+
+ Definition under_with_unification_resultT_relation_hetero {t p K1 K2}
+ (FH : forall t, value t -> value t -> Prop)
+ (F : forall evm, K1 (pattern.type.subst_default t evm) -> K2 (pattern.type.subst_default t evm) -> Prop)
+ : @with_unification_resultT1 t p K1 -> @with_unification_resultT2 t p K2 -> Prop
+ := pattern.type.under_forall_vars_relation
+ (fun evm => under_with_unification_resultT'_relation_hetero FH (F evm)).
+
Definition wf_with_unification_resultT
- G {t} {p : pattern t} {K1 K2 : type -> Type}
+ (G : list {t : _ & (var1 t * var2 t)%type})
+ {t} {p : pattern t} {K1 K2 : type -> Type}
(P : forall evm, K1 (pattern.type.subst_default t evm) -> K2 (pattern.type.subst_default t evm) -> Prop)
: @with_unification_resultT1 t p K1 -> @with_unification_resultT2 t p K2 -> Prop
- := pattern.type.under_forall_vars_relation
- (fun evm v1 v2
- => wf_with_unification_resultT' G (P _) v1 v2).
+ := under_with_unification_resultT_relation_hetero
+ (fun t => wf_value G)
+ P.
+
+ Lemma related_app_with_unification_resultT' {t p evm K1 K2}
+ R1 R2
+ f1 f2 v1 v2
+ : @under_with_unification_resultT'_relation_hetero
+ t p evm K1 K2 R1 R2 f1 f2
+ -> @related_unification_resultT' R1 t p evm v1 v2
+ -> R2 (@app_with_unification_resultT' _ _ _ _ t p evm K1 f1 v1)
+ (@app_with_unification_resultT' _ _ _ _ t p evm K2 f2 v2).
+ Proof using Type.
+ revert K1 K2 R1 R2 f1 f2 v1 v2; induction p; cbn in *; intros; subst; destruct_head'_and;
+ try apply related_app_type_of_list_of_under_type_of_list_relation_cps;
+ auto.
+ repeat match goal with H : _ |- _ => eapply H; eauto; clear H end.
+ Qed.
+
+ Lemma related_app_transport_with_unification_resultT' {t p evm1 evm2 K1 K2}
+ R1 R2
+ f1 f2 v1 v2
+ : @under_with_unification_resultT'_relation_hetero
+ t p evm1 K1 K2 R1 R2 f1 f2
+ -> @related_unification_resultT' R1 t p evm2 v1 v2
+ -> option_eq
+ R2
+ (@app_transport_with_unification_resultT'_cps _ t p evm1 evm2 K1 f1 v1 _ (@Some _))
+ (@app_transport_with_unification_resultT'_cps _ t p evm1 evm2 K2 f2 v2 _ (@Some _)).
+ Proof using Type.
+ revert K1 K2 R1 R2 f1 f2 v1 v2; induction p; cbn in *; intros; subst; destruct_head'_and;
+ try apply related_app_type_of_list_of_under_type_of_list_relation_cps;
+ auto.
+ all: repeat first [ progress rewrite_type_transport_correct
+ | progress type_beq_to_eq
+ | break_innermost_match_step
+ | reflexivity
+ | progress cbn [Option.bind option_eq] in *
+ | progress fold (@with_unification_resultT'1) (@with_unification_resultT'2)
+ | progress cps_id'_with_option app_transport_with_unification_resultT'_cps_id
+ | progress cbv [eq_rect]
+ | solve [ auto ]
+ | exfalso; assumption
+ | progress inversion_option
+ | match goal with
+ | [ H : (forall K1 K2 R1 R2 (f1 : with_unification_resultT'1 ?p1 ?evm1 K1), _)
+ |- context[@app_transport_with_unification_resultT'_cps _ ?t ?p1 ?evm1 ?evm2 ?K1' ?f1' ?v1' _ _] ]
+ => specialize (H K1' _ _ _ f1' _ v1' _ ltac:(eassumption) ltac:(eassumption))
+ | [ H : option_eq ?R ?x ?y |- _ ]
+ => destruct x eqn:?, y eqn:?; cbv [option_eq] in H
+ end ].
+ Qed.
+
+ Lemma related_app_with_unification_resultT {t p K1 K2}
+ R1 R2
+ f1 f2 v1 v2
+ : @under_with_unification_resultT_relation_hetero
+ t p K1 K2 R1 R2 f1 f2
+ -> @related_unification_resultT R1 t p v1 v2
+ -> option_eq
+ (related_sigT_by_eq R2)
+ (@app_with_unification_resultT_cps _ t p K1 f1 v1 _ (@Some _))
+ (@app_with_unification_resultT_cps _ t p K2 f2 v2 _ (@Some _)).
+ Proof using Type.
+ cbv [related_unification_resultT under_with_unification_resultT_relation_hetero app_with_unification_resultT_cps related_sigT_by_eq unification_resultT] in *.
+ repeat first [ progress destruct_head'_sigT
+ | progress destruct_head'_sig
+ | progress subst
+ | progress intros
+ | progress cbn [eq_rect Option.bind projT1 projT2 option_eq] in *
+ | exfalso; assumption
+ | progress inversion_option
+ | reflexivity
+ | (exists eq_refl)
+ | assumption
+ | match goal with
+ | [ H : pattern.type.under_forall_vars_relation ?R ?f1 ?f2
+ |- context[pattern.type.app_forall_vars ?f1 ?x] ]
+ => apply (pattern.type.app_forall_vars_under_forall_vars_relation (evm:=x)) in H
+ | [ H : option_eq ?R ?x ?y |- _ ]
+ => destruct x eqn:?, y eqn:?; cbv [option_eq] in H
+ end
+ | progress cps_id'_with_option app_transport_with_unification_resultT'_cps_id
+ | match goal with
+ | [ H : under_with_unification_resultT'_relation_hetero _ _ _ _, H' : related_unification_resultT' _ _ _ |- _ ]
+ => pose proof (related_app_transport_with_unification_resultT' _ _ _ _ _ _ H H'); clear H'
+ end ].
+ Qed.
+
+ Lemma wf_app_with_unification_resultT G {t p K1 K2}
+ R
+ f1 f2 v1 v2
+ : @wf_with_unification_resultT G t p K1 K2 R f1 f2
+ -> @wf_unification_resultT G t p v1 v2
+ -> option_eq
+ (related_sigT_by_eq R)
+ (@app_with_unification_resultT_cps _ t p K1 f1 v1 _ (@Some _))
+ (@app_with_unification_resultT_cps _ t p K2 f2 v2 _ (@Some _)).
+ Proof using Type. apply related_app_with_unification_resultT. Qed.
Definition wf_maybe_do_again_expr
{t}
@@ -1375,66 +1495,45 @@ Module Compilers.
| _, _ => fun _ _ => False
end.
+ Definition maybe_option_eq {A B} {opt1 opt2 : bool} (R : A -> B -> Prop)
+ : (if opt1 then option A else A) -> (if opt2 then option B else B) -> Prop
+ := match opt1, opt2 with
+ | true, true => option_eq R
+ | false, false => R
+ | _, _ => fun _ _ => False
+ end.
+
Definition wf_deep_rewrite_ruleTP_gen
(G : list {t : _ & (var1 t * var2 t)%type})
{t}
- {rew_should_do_again1 rew_with_opt1 rew_under_lets1 rew_is_cps1 : bool}
- {rew_should_do_again2 rew_with_opt2 rew_under_lets2 rew_is_cps2 : bool}
- : deep_rewrite_ruleTP_gen1 rew_should_do_again1 rew_with_opt1 rew_under_lets1 rew_is_cps1 t
- -> deep_rewrite_ruleTP_gen2 rew_should_do_again2 rew_with_opt2 rew_under_lets2 rew_is_cps2 t
+ {rew_should_do_again1 rew_with_opt1 rew_under_lets1 : bool}
+ {rew_should_do_again2 rew_with_opt2 rew_under_lets2 : bool}
+ : deep_rewrite_ruleTP_gen1 rew_should_do_again1 rew_with_opt1 rew_under_lets1 t
+ -> deep_rewrite_ruleTP_gen2 rew_should_do_again2 rew_with_opt2 rew_under_lets2 t
-> Prop
- := match rew_is_cps1, rew_is_cps2, rew_with_opt1, rew_with_opt2
- return (if rew_is_cps1
- then fun T => forall T', (T -> option T') -> option T'
- else fun T => T)
- (if rew_with_opt1 then option _ else _)
- -> (if rew_is_cps2
- then fun T => forall T', (T -> option T') -> option T'
- else fun T => T)
- (if rew_with_opt2 then option _ else _)
- -> Prop
- with
- | true, true, true, true
- => fun f1 f2
- => (forall T K, f1 T K = K (f1 _ id))
- /\ (forall T K, f2 T K = K (f2 _ id))
- /\ option_eq
- (wf_maybe_under_lets_expr
- wf_maybe_do_again_expr
- G)
- (f1 _ id) (f2 _ id)
- | true, true, false, false
- => fun (f1 f2 : forall T, _ -> option T)
- => (forall T K, f1 T K = (fv <- f1 _ (@Some _); K fv)%option)
- /\ (forall T K, f2 T K = (fv <- f2 _ (@Some _); K fv)%option)
- /\ option_eq
- (wf_maybe_under_lets_expr
- wf_maybe_do_again_expr
- G)
- (f1 _ (@Some _)) (f2 _ (@Some _))
- | false, false, true, true
- => option_eq
- (wf_maybe_under_lets_expr
- wf_maybe_do_again_expr
- G)
- | false, false, false, false
- => wf_maybe_under_lets_expr
- wf_maybe_do_again_expr
- G
- | _, _, _, _ => fun _ _ => False
- end.
+ := maybe_option_eq
+ (wf_maybe_under_lets_expr
+ wf_maybe_do_again_expr
+ G).
Definition wf_with_unif_rewrite_ruleTP_gen
(G : list {t : _ & (var1 t * var2 t)%type})
{t} {p : pattern t}
- {rew_should_do_again1 rew_with_opt1 rew_under_lets1 rew_is_cps1}
- {rew_should_do_again2 rew_with_opt2 rew_under_lets2 rew_is_cps2}
- : with_unif_rewrite_ruleTP_gen1 p rew_should_do_again1 rew_with_opt1 rew_under_lets1 rew_is_cps1
- -> with_unif_rewrite_ruleTP_gen2 p rew_should_do_again2 rew_with_opt2 rew_under_lets2 rew_is_cps2
+ {rew_should_do_again1 rew_with_opt1 rew_under_lets1}
+ {rew_should_do_again2 rew_with_opt2 rew_under_lets2}
+ : with_unif_rewrite_ruleTP_gen1 p rew_should_do_again1 rew_with_opt1 rew_under_lets1
+ -> with_unif_rewrite_ruleTP_gen2 p rew_should_do_again2 rew_with_opt2 rew_under_lets2
-> Prop
- := wf_with_unification_resultT
- G
- (fun evm => wf_deep_rewrite_ruleTP_gen G).
+ := fun f g
+ => forall x y,
+ wf_unification_resultT G x y
+ -> option_eq
+ (fun (fx : { evm : _ & deep_rewrite_ruleTP_gen1 rew_should_do_again1 rew_with_opt1 rew_under_lets1 _ })
+ (gy : { evm : _ & deep_rewrite_ruleTP_gen2 rew_should_do_again2 rew_with_opt2 rew_under_lets2 _ })
+ => related_sigT_by_eq
+ (fun _ => wf_deep_rewrite_ruleTP_gen G) fx gy)
+ (app_with_unification_resultT_cps _ f x _ (@Some _))
+ (app_with_unification_resultT_cps _ g y _ (@Some _)).
Definition wf_rewrite_rule_data
(G : list {t : _ & (var1 t * var2 t)%type})
@@ -1456,6 +1555,64 @@ Module Compilers.
G
(rew [fun tp => @rewrite_rule_data1 _ (pattern.pattern_of_anypattern tp)] pf in r1)
r2 }).
+
+ Definition wf_with_unif_rewrite_ruleTP_gen_curried
+ (G : list {t : _ & (var1 t * var2 t)%type})
+ {t} {p : pattern t}
+ {rew_should_do_again1 rew_with_opt1 rew_under_lets1}
+ {rew_should_do_again2 rew_with_opt2 rew_under_lets2}
+ : with_unif_rewrite_ruleTP_gen1 p rew_should_do_again1 rew_with_opt1 rew_under_lets1
+ -> with_unif_rewrite_ruleTP_gen2 p rew_should_do_again2 rew_with_opt2 rew_under_lets2
+ -> Prop
+ := wf_with_unification_resultT
+ G
+ (fun evm => wf_deep_rewrite_ruleTP_gen G).
+
+ Definition wf_rewrite_rule_data_curried
+ (G : list {t : _ & (var1 t * var2 t)%type})
+ {t} {p : pattern t}
+ (r1 : @rewrite_rule_data1 t p)
+ (r2 : @rewrite_rule_data2 t p)
+ : Prop
+ := wf_with_unif_rewrite_ruleTP_gen_curried G (rew_replacement _ _ r1) (rew_replacement _ _ r2).
+
+ Definition rewrite_rules_goodT_curried
+ (rew1 : rewrite_rulesT1) (rew2 : rewrite_rulesT2)
+ : Prop
+ := length rew1 = length rew2
+ /\ (forall p1 r1 p2 r2,
+ List.In (existT _ p1 r1, existT _ p2 r2) (combine rew1 rew2)
+ -> { pf : p1 = p2
+ | forall G,
+ wf_rewrite_rule_data_curried
+ G
+ (rew [fun tp => @rewrite_rule_data1 _ (pattern.pattern_of_anypattern tp)] pf in r1)
+ r2 }).
+
+ Lemma rewrite_rules_goodT_by_curried rew1 rew2
+ : rewrite_rules_goodT_curried rew1 rew2 -> rewrite_rules_goodT rew1 rew2.
+ Proof using Type.
+ cbv [rewrite_rules_goodT rewrite_rules_goodT_curried wf_rewrite_rule_data_curried wf_rewrite_rule_data wf_with_unif_rewrite_ruleTP_gen wf_with_unif_rewrite_ruleTP_gen_curried].
+ intros [Hlen H]; split; [ exact Hlen | clear Hlen ].
+ repeat (let x := fresh "x" in intro x; specialize (H x)).
+ destruct H as [H0 H]; exists H0.
+ repeat (let x := fresh "x" in intro x; specialize (H x)).
+ intros X Y HXY.
+ pose proof (wf_app_with_unification_resultT _ _ _ _ _ _ ltac:(eassumption) ltac:(eassumption)) as H'.
+ cps_id'_with_option app_with_unification_resultT_cps_id.
+ cbv [deep_rewrite_ruleTP_gen] in *.
+ let H1 := fresh in
+ let H2 := fresh in
+ lazymatch type of H' with
+ | option_eq ?R ?x ?y
+ => destruct x eqn:H1, y eqn:H2; cbv [option_eq] in H'
+ end.
+ all: repeat first [ progress cbn [option_eq]
+ | reflexivity
+ | progress inversion_option
+ | exfalso; assumption
+ | assumption ].
+ Qed.
End with_var2.
Section with_interp.
@@ -1468,10 +1625,6 @@ Module Compilers.
Local Notation with_unif_rewrite_ruleTP_gen := (@with_unif_rewrite_ruleTP_gen ident var pident pident_arg_types type_vars_of_pident).
Local Notation with_unification_resultT' := (@with_unification_resultT' ident var pident pident_arg_types).
Local Notation normalize_deep_rewrite_rule := (@normalize_deep_rewrite_rule ident var).
- Local Notation under_with_unification_resultT_relation := (@under_with_unification_resultT_relation ident var pident pident_arg_types type_vars_of_pident).
- Local Notation under_with_unification_resultT_relation_hetero := (@under_with_unification_resultT_relation_hetero ident var pident pident_arg_types type_vars_of_pident).
- Local Notation under_with_unification_resultT_relation1 := (@under_with_unification_resultT_relation1 ident var pident pident_arg_types type_vars_of_pident).
- Local Notation under_with_unification_resultT_relation1_gen := (@under_with_unification_resultT_relation1_gen ident var pident pident_arg_types type_vars_of_pident).
Local Notation deep_rewrite_ruleTP_gen := (@deep_rewrite_ruleTP_gen ident var).
@@ -1566,23 +1719,17 @@ Module Compilers.
=> k (expr.App ef ex)))
end.
- Definition pattern_default_interp {t} (p : pattern t) : @with_unif_rewrite_ruleTP_gen t p false false false false
+ Definition pattern_default_interp {t} (p : pattern t) : @with_unif_rewrite_ruleTP_gen t p false false false
:= pattern.type.lam_forall_vars
(fun evm
=> pattern_default_interp' p evm id).
- Definition deep_rewrite_ruleTP_gen_ok_relation
- {should_do_again with_opt under_lets is_cps : bool} {t}
- (v1 : @deep_rewrite_ruleTP_gen should_do_again with_opt under_lets is_cps t)
- : Prop
- := @normalize_deep_rewrite_rule_cps_id_hypsT var _ _ _ _ _ v1.
-
Definition deep_rewrite_ruleTP_gen_good_relation
- {should_do_again with_opt under_lets is_cps : bool} {t}
- (v1 : @deep_rewrite_ruleTP_gen should_do_again with_opt under_lets is_cps t)
+ {should_do_again with_opt under_lets : bool} {t}
+ (v1 : @deep_rewrite_ruleTP_gen should_do_again with_opt under_lets t)
(v2 : expr t)
: Prop
- := (let v1 := normalize_deep_rewrite_rule v1 _ id in
+ := (let v1 := normalize_deep_rewrite_rule v1 in
match v1 with
| None => True
| Some v1 => let v1 := UnderLets.interp ident_interp v1 in
@@ -1599,16 +1746,17 @@ Module Compilers.
Definition rewrite_rule_data_interp_goodT
{t} {p : pattern t} (r : @rewrite_rule_data t p)
: Prop
- := @under_with_unification_resultT_relation1
- _ _ _
- (fun evm => deep_rewrite_ruleTP_gen_ok_relation)
- (rew_replacement _ _ r)
- /\ @under_with_unification_resultT_relation_hetero
- _ _ _ _
- (fun _ => value_interp_related)
- (fun evm => deep_rewrite_ruleTP_gen_good_relation)
- (rew_replacement _ _ r)
- (pattern_default_interp p).
+ := forall x y,
+ related_unification_resultT (fun t => value_interp_related) x y
+ -> option_eq
+ (fun fx gy
+ => related_sigT_by_eq
+ (fun evm
+ => @deep_rewrite_ruleTP_gen_good_relation
+ (rew_should_do_again _ _ r) (rew_with_opt _ _ r) (rew_under_lets _ _ r) (pattern.type.subst_default t evm))
+ fx gy)
+ (app_with_unification_resultT_cps _ (rew_replacement _ _ r) x _ (@Some _))
+ (app_with_unification_resultT_cps _ (pattern_default_interp p) y _ (@Some _)).
Definition rewrite_rules_interp_goodT
(rews : rewrite_rulesT)
@@ -1616,6 +1764,45 @@ Module Compilers.
:= forall p r,
List.In (existT _ p r) rews
-> rewrite_rule_data_interp_goodT r.
+
+ Definition rewrite_rule_data_interp_goodT_curried
+ {t} {p : pattern t} (r : @rewrite_rule_data t p)
+ : Prop
+ := under_with_unification_resultT_relation_hetero
+ (fun _ => value_interp_related)
+ (fun evm => deep_rewrite_ruleTP_gen_good_relation)
+ (rew_replacement _ _ r)
+ (pattern_default_interp p).
+
+ Definition rewrite_rules_interp_goodT_curried
+ (rews : rewrite_rulesT)
+ : Prop
+ := forall p r,
+ List.In (existT _ p r) rews
+ -> rewrite_rule_data_interp_goodT_curried r.
+
+ Lemma rewrite_rules_interp_goodT_by_curried rews
+ : rewrite_rules_interp_goodT_curried rews -> rewrite_rules_interp_goodT rews.
+ Proof using Type.
+ cbv [rewrite_rules_interp_goodT rewrite_rules_interp_goodT_curried rewrite_rule_data_interp_goodT rewrite_rule_data_interp_goodT_curried].
+ intro H.
+ repeat (let x := fresh "x" in intro x; specialize (H x)).
+ intros X Y HXY.
+ pose proof (related_app_with_unification_resultT _ _ _ _ _ _ ltac:(eassumption) ltac:(eassumption)) as H'.
+ cps_id'_with_option app_with_unification_resultT_cps_id.
+ cbv [deep_rewrite_ruleTP_gen] in *.
+ let H1 := fresh in
+ let H2 := fresh in
+ lazymatch type of H' with
+ | option_eq ?R ?x ?y
+ => destruct x eqn:H1, y eqn:H2; cbv [option_eq] in H'
+ end.
+ all: repeat first [ progress cbn [option_eq]
+ | reflexivity
+ | progress inversion_option
+ | exfalso; assumption
+ | assumption ].
+ Qed.
End with_interp.
End with_var.
End Compile.
diff --git a/src/Experiments/NewPipeline/RewriterWf2.v b/src/Experiments/NewPipeline/RewriterWf2.v
index e7b1f179b..f8382f5ac 100644
--- a/src/Experiments/NewPipeline/RewriterWf2.v
+++ b/src/Experiments/NewPipeline/RewriterWf2.v
@@ -17,6 +17,7 @@ Require Import Crypto.Util.Tactics.SpecializeAllWays.
Require Import Crypto.Util.Tactics.SpecializeBy.
Require Import Crypto.Util.Tactics.RewriteHyp.
Require Import Crypto.Util.Tactics.Head.
+Require Import Crypto.Util.Tactics.CPSId.
Require Import Crypto.Util.Prod.
Require Import Crypto.Util.ListUtil.
Require Import Crypto.Util.Option.
@@ -130,53 +131,46 @@ Module Compilers.
(** TODO: Move Me up *)
Local Notation unify_pattern'1 := (@unify_pattern' ident var1 pident pident_arg_types pident_unify pident_unify_unknown).
Local Notation unify_pattern'2 := (@unify_pattern' ident var2 pident pident_arg_types pident_unify pident_unify_unknown).
- Local Notation unify_pattern1 := (@unify_pattern ident var1 pident pident_arg_types pident_unify pident_unify_unknown type_vars_of_pident).
- Local Notation unify_pattern2 := (@unify_pattern ident var2 pident pident_arg_types pident_unify pident_unify_unknown type_vars_of_pident).
- Local Notation wf_with_unification_resultT' := (@wf_with_unification_resultT' ident pident pident_arg_types var1 var2).
+ Local Notation unify_pattern1 := (@unify_pattern ident var1 pident pident_arg_types pident_unify pident_unify_unknown).
+ Local Notation unify_pattern2 := (@unify_pattern ident var2 pident pident_arg_types pident_unify pident_unify_unknown).
+ Local Notation wf_unification_resultT' := (@wf_unification_resultT' ident pident pident_arg_types var1 var2).
+ Local Notation wf_unification_resultT := (@wf_unification_resultT ident pident pident_arg_types var1 var2).
Local Notation wf_with_unification_resultT := (@wf_with_unification_resultT ident pident pident_arg_types type_vars_of_pident var1 var2).
Local Notation wf_with_unif_rewrite_ruleTP_gen := (@wf_with_unif_rewrite_ruleTP_gen ident pident pident_arg_types type_vars_of_pident var1 var2).
Local Notation wf_deep_rewrite_ruleTP_gen := (@wf_deep_rewrite_ruleTP_gen ident var1 var2).
+ Local Notation app_with_unification_resultT_cps1 := (@app_with_unification_resultT_cps ident var1 pident pident_arg_types type_vars_of_pident).
+ Local Notation app_with_unification_resultT_cps2 := (@app_with_unification_resultT_cps ident var2 pident pident_arg_types type_vars_of_pident).
+ Local Notation wf_app_with_unification_resultT := (@wf_app_with_unification_resultT ident pident pident_arg_types type_vars_of_pident var1 var2).
(* Because [proj1] and [proj2] in the stdlib are opaque *)
Local Notation proj1 x := (let (a, b) := x in a).
Local Notation proj2 x := (let (a, b) := x in b).
Lemma wf_unify_pattern'
- (G : list { t : _ & (var1 t * var2 t)%type })
- {t1 t2 t'} {p1 : pattern t1} {p2 : pattern t2} {evm1 evm2 : EvarMap} {re1 re2 e1 e2} {K1 K2}
- (PK : K1 (pattern.type.subst_default t1 evm1) -> K2 (pattern.type.subst_default t2 evm2) -> Prop)
- {T1 T2}
- (PT : T1 -> T2 -> Prop)
- {v1 v2}
- {cont1 : K1 _ -> option T1}
- {cont2 : K2 _ -> option T2}
+ {G : list { t : _ & (var1 t * var2 t)%type }}
+ {t t'} {p : pattern t} {evm : EvarMap} {re1 re2 e1 e2}
(He : @wf_rawexpr G t' re1 e1 re2 e2)
- (Hv : @wf_with_unification_resultT' G t1 t2 p1 p2 evm1 evm2 _ _ PK v1 v2)
- (HT : forall v1 v2, PK v1 v2 -> option_eq PT (cont1 v1) (cont2 v2))
: option_eq
- PT
- (@unify_pattern'1 t1 re1 p1 evm1 K1 v1 T1 cont1)
- (@unify_pattern'2 t2 re2 p2 evm2 K2 v2 T2 cont2).
- Proof using pident_unify_unknown_correct.
- revert dependent p2; intro p2; revert dependent re1; revert dependent re2; revert t' e1 e2; revert dependent evm1; revert dependent evm2; revert dependent K1; revert dependent K2; revert t2 p2.
- induction p1, p2; intros; cbn [unify_pattern'].
- all: repeat first [ progress cbn [with_unification_resultT' wf_with_unification_resultT' Option.bind eq_rect eq_sigT eq_sigT_uncurried eq_existT_uncurried] in *
- | progress cbv [option_bind'] in *
+ (wf_unification_resultT' G)
+ (@unify_pattern'1 _ re1 p evm _ (@Some _))
+ (@unify_pattern'2 _ re2 p evm _ (@Some _)).
+ Proof using Type.
+ revert t' e1 e2 re1 re2 He; induction p; intros; cbn [unify_pattern'].
+ all: repeat first [ progress cbn [Option.bind eq_rect option_eq] in *
| assumption
| reflexivity
| exfalso; assumption
| progress subst
- | progress destruct_head'_sig
- | progress inversion_sigma
| progress rewrite_type_transport_correct
| progress type_beq_to_eq
+ | progress inversion_option
| match goal with
| [ H : @wf_rawexpr ?G ?t ?re1 ?e1 ?re2 ?e2 |- context[match ?re1 with _ => _ end] ]
=> is_var t; is_var re1; is_var e1; is_var re2; is_var e2; is_var G;
destruct H
end
- | rewrite !pident_unify_unknown_correct
| break_innermost_match_step
+ | progress cps_id'_with_option unify_pattern'_cps_id
| match goal with
| [ |- context[rew ?pf in _] ]
=> is_var pf;
@@ -192,152 +186,78 @@ Module Compilers.
| [ He : wf_rawexpr ?G ?re1 _ ?re2 _
|- wf_value ?G (rew ?pf in value_of_rawexpr ?re1) (value_of_rawexpr ?re2) ]
=> apply (wf_value_of_wf_rawexpr_gen (pf2:=eq_refl) He)
+ | [ He : wf_rawexpr ?G ?re1 _ ?re2 _
+ |- wf_unification_resultT' ?G (rew ?pf in value_of_rawexpr ?re1) (rew ?pf2 in value_of_rawexpr ?re2) ]
+ => apply (wf_value_of_wf_rawexpr_gen He)
| [ H : wf_rawexpr _ _ _ _ _ |- _ ]
=> progress (try (unique pose proof (proj1 (eq_type_of_rawexpr_of_wf H)));
try (unique pose proof (proj2 (eq_type_of_rawexpr_of_wf H))))
| [ H : ?t1 <> ?t2 |- _ ]
=> exfalso; apply H; congruence
- end
- | solve [ eauto ]
- | progress cbv [Option.bind] in *
- | apply related_app_type_of_list_of_under_type_of_list_relation_cps ].
- Qed.
-
- Lemma wf_unify_pattern'_id
- (G : list { t : _ & (var1 t * var2 t)%type })
- {t1 t2 t'} {p1 : pattern t1} {p2 : pattern t2} {evm1 evm2 : EvarMap} {re1 re2 e1 e2} {K1 K2}
- (PK : K1 (pattern.type.subst_default t1 evm1) -> K2 (pattern.type.subst_default t2 evm2) -> Prop)
- {v1 v2}
- (He : @wf_rawexpr G t' re1 e1 re2 e2)
- (Hv : @wf_with_unification_resultT' G t1 t2 p1 p2 evm1 evm2 _ _ PK v1 v2)
- : option_eq
- PK
- (@unify_pattern'1 t1 re1 p1 evm1 K1 v1 _ (@Some _))
- (@unify_pattern'2 t2 re2 p2 evm2 K2 v2 _ (@Some _)).
- Proof using pident_unify_unknown_correct.
- eapply wf_unify_pattern'; try eassumption; eauto.
+ | [ |- context[(rew [?P] ?pf in ?f) ?v] ]
+ => lazymatch P with
+ | fun x : ?A => forall y : @?B x, @?C x y
+ => replace ((rew [P] pf in f) v) with (rew [fun x : A => C x v] pf in f v)
+ by (case pf; reflexivity)
+ end
+ | [ H : (forall t e1 e2 re1 re2, wf_rawexpr _ _ _ _ _ -> option_eq _ (unify_pattern'1 re1 ?p1 ?evm _ (@Some _)) _)
+ |- context[unify_pattern'1 ?re1' ?p1 ?evm _ (@Some _)] ]
+ => specialize (H _ _ _ re1' _ ltac:(eassumption))
+ | [ H : option_eq ?R ?x ?y |- _ ]
+ => destruct x eqn:?, y eqn:?; cbv [option_eq] in H
+ | [ |- wf_unification_resultT' _ (_, _) (_, _) ] => split; assumption
+ end ].
Qed.
Lemma wf_unify_pattern
- (G : list { t : _ & (var1 t * var2 t)%type })
- {t t'} {p : pattern t} {re1 re2 e1 e2} {K1 K2}
- (PK : forall t, K1 t -> K2 t -> Prop)
- {T1 T2}
- (PT : T1 -> T2 -> Prop)
- {v1 v2}
- {cont1 : K1 _ -> option T1}
- {cont2 : K2 _ -> option T2}
- (He : @wf_rawexpr G t' re1 e1 re2 e2)
- (Hv : @wf_with_unification_resultT G t p _ _ (fun evm => PK _) v1 v2)
- (HT : forall t v1 v2 pf1 pf2, PK t (rew [K1] pf1 in v1) (rew [K2] pf2 in v2) -> option_eq PT (cont1 v1) (cont2 v2))
- : option_eq
- PT
- (@unify_pattern1 t re1 p K1 v1 T1 cont1)
- (@unify_pattern2 t re2 p K2 v2 T2 cont2).
- Proof using pident_unify_unknown_correct.
- cbv [unify_pattern].
- erewrite wf_unify_types_cps by eassumption.
- repeat (rewrite unify_types_cps_id; set (unify_types _ _ _ id)).
- repeat match goal with v := unify_types _ _ _ id |- _ => subst v end.
- cbv [Compile.wf_with_unification_resultT] in *.
- revert dependent cont2; revert dependent cont1.
- let lem := constr:(eq_type_of_rawexpr_of_wf ltac:(eassumption)) in
- rewrite (proj1 lem), (proj2 lem).
- intros; specialize (fun v1 v2 => HT _ v1 v2 eq_refl eq_refl); cbn [eq_rect] in *.
- repeat first [ progress subst
- | progress intros
- | progress cbv beta in *
- | match goal with
- | [ |- ?R ?x ?x ] => reflexivity
- | [ |- option_eq ?RB (Option.bind ?a ?b) (Option.bind ?a' ?b') ]
- => eapply Option.bind_Proper_option_eq_hetero
- | [ |- option_eq _ (pattern.type.app_forall_vars _ _) (pattern.type.app_forall_vars _ _) ]
- => refine (pattern.type.app_forall_vars_under_forall_vars_relation _)
- | [ |- option_eq _ (@unify_pattern'1 _ _ _ _ _ _ _ _) (@unify_pattern'2 _ _ _ _ _ _ _ _) ]
- => eapply wf_unify_pattern'
- | [ H1 : forall v1 v2, ?PK _ v1 v2 -> option_eq ?PT (?f1 v1) (?f2 v2),
- H2 : ?RA ?a1 ?a2
- |- option_eq ?PT (?f1 (?a1 _)) (?f2 (?a2 _)) ]
- => eapply H1; refine H2
- end
- | eassumption
- | progress rewrite_type_transport_correct ].
- (* We separate this into two separate [repeat first] statements because we need to unify evars across goals before proceeding here *)
- repeat first [ reflexivity
- | exfalso; assumption
- | progress subst
- | progress cbn [eq_rect Option.bind option_eq] in *
- | progress type_beq_to_eq
- | assumption
- | progress break_match ].
- Qed.
-
- Lemma wf_unify_pattern_id
- (G : list { t : _ & (var1 t * var2 t)%type })
- {t t'} {p : pattern t} {re1 re2 e1 e2} {K1 K2}
- (PK : forall t1 t2, K1 t1 -> K2 t2 -> Prop)
- {v1 v2}
+ {G : list { t : _ & (var1 t * var2 t)%type }}
+ {t t'} {p : pattern t} {re1 re2 e1 e2}
(He : @wf_rawexpr G t' re1 e1 re2 e2)
- (Hv : @wf_with_unification_resultT G t p _ _ (fun evm => PK _ _) v1 v2)
: option_eq
- (PK _ _)
- (@unify_pattern1 t re1 p K1 v1 _ (@Some _))
- (@unify_pattern2 t re2 p K2 v2 _ (@Some _)).
- Proof using pident_unify_unknown_correct.
- eapply wf_unify_pattern with (PK:=fun t => PK t t); try eassumption.
- intros ? ? ? pf1 pf2; destruct pf1, pf2; cbn; trivial.
+ (wf_unification_resultT G)
+ (@unify_pattern1 t re1 p _ (@Some _))
+ (@unify_pattern2 t re2 p _ (@Some _)).
+ Proof using Type.
+ cbv [unify_pattern wf_unification_resultT].
+ cps_id'_with_option unify_types_cps_id.
+ rewrite <- (wf_unify_types He).
+ cbv [Option.bind]; break_innermost_match_step; [ | reflexivity ].
+ cps_id'_with_option unify_pattern'_cps_id.
+ pose proof (@wf_unify_pattern' G t t' p ltac:(assumption) re1 re2 e1 e2 He) as H'.
+ match goal with
+ | [ H : option_eq ?R ?x ?y |- _ ]
+ => destruct x eqn:?, y eqn:?; cbv [option_eq] in H
+ end; try solve [ reflexivity | inversion_option | exfalso; assumption ];
+ cbn [Option.bind option_eq].
+ cbv [related_unification_resultT related_sigT_by_eq]; exists eq_refl.
+ cbn [eq_rect projT1 projT2].
+ assumption.
Qed.
Lemma wf_normalize_deep_rewrite_rule
{G}
{t}
- {should_do_again1 with_opt1 under_lets1 is_cps1}
- {should_do_again2 with_opt2 under_lets2 is_cps2}
+ {should_do_again1 with_opt1 under_lets1}
+ {should_do_again2 with_opt2 under_lets2}
{r1 r2}
- (Hwf : @wf_deep_rewrite_ruleTP_gen G t should_do_again1 with_opt1 under_lets1 is_cps1 should_do_again2 with_opt2 under_lets2 is_cps2 r1 r2)
+ (Hwf : @wf_deep_rewrite_ruleTP_gen G t should_do_again1 with_opt1 under_lets1 should_do_again2 with_opt2 under_lets2 r1 r2)
: option_eq
(UnderLets.wf (fun G' => wf_maybe_do_again_expr G') G)
- (normalize_deep_rewrite_rule r1 _ id) (normalize_deep_rewrite_rule r2 _ id).
+ (normalize_deep_rewrite_rule r1) (normalize_deep_rewrite_rule r2).
Proof using Type.
clear -Hwf.
all: destruct_head'_bool.
- all: cbv [normalize_deep_rewrite_rule wf_deep_rewrite_ruleTP_gen deep_rewrite_ruleTP_gen] in *.
+ all: cbv [normalize_deep_rewrite_rule wf_deep_rewrite_ruleTP_gen deep_rewrite_ruleTP_gen maybe_option_eq] in *.
all: destruct_head'_and.
all: repeat first [ assumption
| exfalso; assumption
| progress cbv [Option.bind option_eq wf_maybe_under_lets_expr] in *
| progress inversion_option
- | progress subst
| match goal with
| [ |- ?x = ?x ] => reflexivity
- | [ H : forall T K, ?f T K = @?v T K, H' : context[?f ?T' ?K'] |- _ ]
- => lazymatch v with
- | context[f]
- => lazymatch K' with
- | id => fail
- | @Some _ => fail
- | _ => idtac
- end
- | _ => idtac
- end;
- rewrite (H T' K') in H'
- | [ H : forall T K, ?f T K = @?v T K |- context[?f ?T' ?K'] ]
- => lazymatch v with
- | context[f]
- => lazymatch K' with
- | id => fail
- | @Some _ => fail
- | _ => idtac
- end
- | _ => idtac
- end;
- rewrite (H T' K')
- | [ H : context[id ?x] |- _ ] => change (id x) with x in H
- | [ |- context[id ?x] ] => change (id x) with x
| [ |- UnderLets.wf _ _ _ _ ] => constructor
end
- | break_innermost_match_step
- | break_innermost_match_hyps_step ].
+ | break_innermost_match_step ].
Qed.
Local Ltac fin_handle_list :=
@@ -625,10 +545,15 @@ Module Compilers.
Local Notation wf_reflect := (@wf_reflect ident var1 var2).
Local Notation wf_reify := (@wf_reify ident var1 var2).
+ Local Lemma Some_neq_None_helper {A B x y} : @Some A x = None <-> @Some B y = None.
+ Proof using Type. clear; intuition congruence. Qed.
+
Local Ltac fin_t_common_step :=
first [ match goal with
- | [ |- (Some _ = None <-> Some _ = None) /\ _ ] => split; [ clear; solve [ intuition congruence ] | ]
- | [ |- (?x = ?x <-> ?y = ?y) /\ _ ] => split; [ clear; intuition congruence | ]
+ | [ |- (Some _ = None <-> Some _ = None) /\ _ ] => split; [ exact Some_neq_None_helper | ]
+ | [ |- (?x = ?x <-> ?y = ?y) /\ _ ] => split; [ clear; split; reflexivity | ]
+ | [ |- (Some _ = None <-> None = None) /\ _ ] => exfalso
+ | [ |- (None = None <-> Some _ = None) /\ _ ] => exfalso
end ].
Local Ltac handle_lists_of_rewrite_rules :=
repeat first [ match goal with
@@ -676,6 +601,8 @@ Module Compilers.
match goal with H : _ <> _ |- _ => idtac end;
exfalso;
repeat match goal with
+ | [ H : ?x <> ?x |- False ] => apply H, eq_refl
+ | [ H : ?x = ?y, H' : ?x <> ?y |- False ] => apply H', H
| [ H : ?T |- _ ]
=> lazymatch T with
| _ = _ :> type.type _ => fail
@@ -725,85 +652,49 @@ Module Compilers.
| [ |- context[rew [fun t => @UnderLets ?varp (@?P t)] ?pf in (@UnderLets.Base ?base_type ?ident ?var ?T ?a)] ]
=> rewrite ap_transport_Base
| [ |- True ] => exact I
+ | [ H : False |- _ ] => exfalso; exact H
end
- | progress cbv [wf_rewrite_rule_data wf_with_unif_rewrite_ruleTP_gen option_bind' normalize_deep_rewrite_rule_cps_id_hypsT] in *
- | lazymatch goal with
- | [ |- (@unify_pattern1 ?t ?re1 ?p ?K1 ?v1 ?T1 ?cont1 = None
- <-> @unify_pattern2 ?t ?re2 ?p ?K2 ?v2 ?T2 ?cont2 = None)
- /\ _ ]
- => let H := fresh in
- pose proof (fun PK PT => @wf_unify_pattern _ t _ p re1 re2 _ _ K1 K2 PK T1 T2 PT v1 v2 cont1 cont2 ltac:(eassumption)) as H;
- specialize (fun PK pf PT => H PK PT pf);
- cbv beta in *;
- (* grumble grumble dependent type hacking *)
- lazymatch type of H with
- | forall PK, wf_with_unification_resultT ?G (fun evm : ?EVM => PK (?t evm)) ?v1 ?v2 -> _
- => lazymatch goal with
- | [ H0 : wf_with_unification_resultT G (fun evm : EVM => ?PK') v1 v2 |- _ ]
- => let PK'' := fresh in
- let PK'
- := constr:(
- fun evm : EVM
- => match PK' with
- | PK''
- => ltac:(
- let PK' := (eval cbv delta [PK''] in PK'') in
- let PK' := match (eval pattern (t evm) in PK') with ?PK' _ => PK' end in
- exact PK'
- )
- end) in
- let PK' := lazymatch PK' with (fun _ => ?f) => f end in
- specialize (H PK' H0)
- end
- end;
- (* end grumbling *)
- (*rewrite unify_pattern_cps_id with (var:=var1), unify_pattern_cps_id with (var:=var2) in H |- *;*)
- (destruct (@unify_pattern1 t re1 p K1 v1 T1 cont1) eqn:?,
- (@unify_pattern2 t re2 p K2 v2 T2 cont2) eqn:?);
- cbn [Option.bind option_eq pattern.type_of_anypattern pattern.pattern_of_anypattern] in H |- *;
- [ split; [ clear; split | apply H; clear H ]
- | refine ((fun pf => _) _); [ exfalso | eapply (H (fun _ _ => True)) ]; [ (assumption || discriminate) | clear H ]..
- | ]
- | [ H : wf_deep_rewrite_ruleTP_gen _ _ _ |- option_eq ?R (normalize_deep_rewrite_rule _ _ (fun x => x)) (normalize_deep_rewrite_rule _ _ (fun y => y)) ]
- => exact (wf_normalize_deep_rewrite_rule H)
- | [ |- option_eq _ (normalize_deep_rewrite_rule _ _ _) (normalize_deep_rewrite_rule _ _ _) ]
- => rewrite @normalize_deep_rewrite_rule_cps_id with (var:=var1), @normalize_deep_rewrite_rule_cps_id with (var:=var2)
- | [ |- ?x = ?x ] => reflexivity
- end
- | progress intros
- | progress cbn [Option.bind option_eq eq_rect eq_sym eq_trans] in *
- | progress inversion_option
| progress subst
+ | progress cbn [Option.bind option_eq projT1 projT2 eq_rect eq_sym eq_trans] in *
+ | progress inversion_option
+ | progress destruct_head'_sigT
+ | progress destruct_head'_sig
+ | progress cbv [wf_rewrite_rule_data wf_with_unif_rewrite_ruleTP_gen option_bind' related_sigT_by_eq] in *
+ | progress intros
| match goal with
+ | [ H : wf_rawexpr _ ?r _ _ _ |- context[unify_pattern1 ?r ?pv _ (@Some _)] ]
+ => let H' := fresh in
+ pose proof (wf_unify_pattern (p:=pv) H) as H';
+ lazymatch type of H' with
+ | option_eq _ ?x ?y => destruct x eqn:?, y eqn:?; cbv [option_eq] in H'
+ end
+ | [ H : wf_deep_rewrite_ruleTP_gen _ ?r1 ?r2
+ |- context[normalize_deep_rewrite_rule ?r1] ]
+ => let H' := fresh in
+ pose proof (wf_normalize_deep_rewrite_rule H) as H';
+ lazymatch type of H' with
+ | option_eq _ ?x ?y => destruct x eqn:?, y eqn:?; cbv [option_eq] in H'
+ end
+ | [ H : (forall x y, wf_unification_resultT _ x y -> option_eq _ (app_with_unification_resultT_cps1 ?r1 x _ (@Some _)) (app_with_unification_resultT_cps2 ?r2 y _ (@Some _))),
+ H' : wf_unification_resultT _ ?xv ?yv
+ |- context[app_with_unification_resultT_cps1 ?r1 ?xv _ (@Some _)] ]
+ => specialize (H _ _ H')
+ | [ H : option_eq _ ?x ?y |- _ ] => destruct x eqn:?, y eqn:?; cbv [option_eq] in H
| [ |- UnderLets.wf _ _ _ _ ] => constructor
| [ |- expr.wf _ (rew _ in expr_of_rawexpr _) (rew _ in expr_of_rawexpr _) ]
=> apply wf_expr_of_wf_rawexpr'
- | [ H : wf_deep_rewrite_ruleTP_gen _ _ _ |- option_eq ?R (normalize_deep_rewrite_rule _ _ (fun x => x)) (normalize_deep_rewrite_rule _ _ (fun y => y)) ]
- => exact (wf_normalize_deep_rewrite_rule H)
- | [ H : wf_deep_rewrite_ruleTP_gen _ _ _ |- (match ?b with true => _ | false => _ end) _ ]
- => clear -H;
- solve [
- destruct_head' (@rewrite_ruleTP);
- repeat first [ exact I
- | exfalso; assumption
- | progress cbn [Compile.rew_should_do_again Compile.rew_under_lets Compile.rew_is_cps Compile.rew_with_opt Compile.rew_replacement] in *
- | progress destruct_head'_bool
- | progress cbv [wf_deep_rewrite_ruleTP_gen] in *
- | progress destruct_head'_and
- | solve [ auto ]
- | progress destruct_head' (@eq) ]
- ]
end
- | progress cbv [type.try_transport_cps(* type.try_make_transport_cps*)]
+ | progress cps_id'_with_option unify_pattern_cps_id
+ | progress cps_id'_with_option app_with_unification_resultT_cps_id
| lazymatch goal with
| [ |- context[type.try_make_transport_cps] ]
=> progress rewrite_type_transport_correct
| [ |- context[base.try_make_transport_cps] ]
=> progress rewrite_type_transport_correct
end
+ | progress type_beq_to_eq
+ | break_match_step ltac:(fun v => match v with Sumbool.sumbool_of_bool _ => idtac end)
| match goal with
- | [ |- context[match Sumbool.sumbool_of_bool ?b with _ => _ end] ]
- => destruct (Sumbool.sumbool_of_bool b)
| [ H : wf_rawexpr _ _ _ _ _ |- _ ]
=> let lem1 := constr:(proj1 (eq_type_of_rawexpr_of_wf H)) in
let lem2 := constr:(proj2 (eq_type_of_rawexpr_of_wf H)) in
@@ -815,23 +706,9 @@ Module Compilers.
| ?x = ?x => idtac
| _ => try (unique pose proof lem2)
end)
- | [ |- context[Option.bind _ (fun _ => None)] ] => rewrite !Option.bind_zero_r
end
- | progress type_beq_to_eq
| solve [ try_solve_by_type_of_rawexpr_eqn ]
| match goal with
- | [ H : unify_pattern1 _ _ _ _ _ = _ |- _ ] => clear H
- | [ H : unify_pattern2 _ _ _ _ _ = _ |- _ ] => clear H
- | [ H : ?x = ?x |- _ ] => clear H
- | [ |- option_eq _ (Option.bind _ _) (Option.bind _ _) ]
- => repeat match goal with
- | [ H : type_of_rawexpr _ = type_of_rawexpr _ |- _ ]
- => lazymatch goal with
- | [ |- context[H] ] => destruct H
- | [ H' : context[H] |- _ ] => destruct H
- end
- end;
- eapply Option.bind_Proper_option_eq_hetero
| [ |- context[rew ?pf in _] ]
=> lazymatch pf with
| context[eq_type_of_rawexpr_of_wf] => destruct pf
@@ -849,6 +726,12 @@ Module Compilers.
| match goal with
| [ H : wf_maybe_do_again_expr _ ?v _ |- context[?v] ] => clear -H wf_do_again; cbv [wf_maybe_do_again_expr maybe_do_again] in *
| [ |- UnderLets.wf _ _ _ _ ] => constructor
+ | [ |- context[type.decode _ _ ?pf ] ]
+ => is_var pf;
+ lazymatch type of pf with
+ | match ?t with type.base _ => _ | _ => _ end
+ => destruct t eqn:?
+ end
end
| progress destruct_head (@rewrite_ruleTP)
| solve [ eauto ] ].
diff --git a/src/Experiments/NewPipeline/arith_rewrite_head.out b/src/Experiments/NewPipeline/arith_rewrite_head.out
index ea72d9b26..4a3eb8e80 100644
--- a/src/Experiments/NewPipeline/arith_rewrite_head.out
+++ b/src/Experiments/NewPipeline/arith_rewrite_head.out
@@ -42,10 +42,11 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
_ <- ident.unify pattern.ident.pair pair;
v <- type.try_make_transport_cps s0 b3;
_ <- type.try_make_transport_cps s b2;
- v1 <- base.try_make_transport_cps b3 A;
- v2 <- base.try_make_transport_cps A A;
- v3 <- base.try_make_transport_cps A A;
- Some (Base (v3 (v2 (v1 (v (Compile.reflect x1))))))
+ v1 <- base.try_make_transport_cps b3 b3;
+ _ <- base.try_make_transport_cps b2 b2;
+ v3 <- base.try_make_transport_cps b3 A;
+ v4 <- base.try_make_transport_cps A A;
+ Some (Base (v4 (v3 (v1 (v (Compile.reflect x1))))))
else None
| None => None
end
@@ -93,10 +94,11 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
_ <- ident.unify pattern.ident.pair pair;
_ <- type.try_make_transport_cps s0 b3;
v0 <- type.try_make_transport_cps s b2;
- v1 <- base.try_make_transport_cps b2 B;
- v2 <- base.try_make_transport_cps B B;
- v3 <- base.try_make_transport_cps B B;
- Some (Base (v3 (v2 (v1 (v0 (Compile.reflect x0))))))
+ _ <- base.try_make_transport_cps b3 b3;
+ v2 <- base.try_make_transport_cps b2 b2;
+ v3 <- base.try_make_transport_cps b2 B;
+ v4 <- base.try_make_transport_cps B B;
+ Some (Base (v4 (v3 (v2 (v0 (Compile.reflect x0))))))
else None
| None => None
end
@@ -227,11 +229,13 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args) -> ℤ)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x1 <- (if (let (x1, _) := idc_args in x1) =? 0
- then Some x0
- else None);
- Some (Base x1)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x1 <- (if (let (x1, _) := xv in x1) =? 0
+ then Some x0
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -249,12 +253,13 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
(ℤ -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x1 <- (if (let (x1, _) := idc_args in x1) =? 0
- then Some x
- else None);
- Some (Base x1)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x1 <- (if (let (x1, _) := xv in x1) =? 0
+ then Some x
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end);;
@@ -273,15 +278,16 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(ℤ -> ℤ)%ptype (s -> (projT1 args0))%ptype
then
v <- type.try_make_transport_cps s ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- x2 <- (if (let (x2, _) := idc_args in x2) >? 0
- then
- Some
- (##(let (x2, _) := idc_args in x2) -
- v (Compile.reflect x1))%expr
- else None);
- Some (Base x2)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ fv <- (x2 <- (if (let (x2, _) := xv in x2) >? 0
+ then
+ Some
+ (##(let (x2, _) := xv in x2) -
+ v (Compile.reflect x1))%expr
+ else None);
+ Some (Base x2));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end);;
@@ -297,16 +303,17 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(s -> (projT1 args0))%ptype
then
v <- type.try_make_transport_cps s ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- x2 <- (if (let (x2, _) := idc_args in x2) <? 0
- then
- Some
- (-
- (v (Compile.reflect x1) +
- ##(- (let (x2, _) := idc_args in x2))%Z))%expr
- else None);
- Some (Base x2)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ fv <- (x2 <- (if (let (x2, _) := xv in x2) <? 0
+ then
+ Some
+ (-
+ (v (Compile.reflect x1) +
+ ##(- (let (x2, _) := xv in x2))%Z))%expr
+ else None);
+ Some (Base x2));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -329,16 +336,17 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq
(ℤ -> ℤ)%ptype ((projT1 args) -> s)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
v <- type.try_make_transport_cps s ℤ;
- x2 <- (if (let (x2, _) := idc_args in x2) >? 0
- then
- Some
- (##(let (x2, _) := idc_args in x2) -
- v (Compile.reflect x1))%expr
- else None);
- Some (Base x2)
+ fv <- (x2 <- (if (let (x2, _) := xv in x2) >? 0
+ then
+ Some
+ (##(let (x2, _) := xv in x2) -
+ v (Compile.reflect x1))%expr
+ else None);
+ Some (Base x2));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end);;
@@ -353,17 +361,18 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args) -> s)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
v <- type.try_make_transport_cps s ℤ;
- x2 <- (if (let (x2, _) := idc_args in x2) <? 0
- then
- Some
- (-
- (##(- (let (x2, _) := idc_args in x2))%Z +
- v (Compile.reflect x1)))%expr
- else None);
- Some (Base x2)
+ fv <- (x2 <- (if (let (x2, _) := xv in x2) <? 0
+ then
+ Some
+ (-
+ (##(- (let (x2, _) := xv in x2))%Z +
+ v (Compile.reflect x1)))%expr
+ else None);
+ Some (Base x2));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -463,14 +472,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args0) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
Some
(Base
- (##((let (x1, _) := idc_args in x1) *
- (let (x1, _) := idc_args0 in x1))%Z)%expr)
+ (##((let (x1, _) := xv in x1) *
+ (let (x1, _) := xv0 in x1))%Z)%expr)
else None
| None => None
end
@@ -486,11 +493,13 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args) -> ℤ)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x1 <- (if (let (x1, _) := idc_args in x1) =? 0
- then Some (##0)%expr
- else None);
- Some (Base x1)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x1 <- (if (let (x1, _) := xv in x1) =? 0
+ then Some (##0)%expr
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -508,11 +517,13 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
(ℤ -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x1 <- (if (let (x1, _) := idc_args in x1) =? 0
- then Some (##0)%expr
- else None);
- Some (Base x1)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x1 <- (if (let (x1, _) := xv in x1) =? 0
+ then Some (##0)%expr
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -530,11 +541,13 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args) -> ℤ)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x1 <- (if (let (x1, _) := idc_args in x1) =? 1
- then Some x0
- else None);
- Some (Base x1)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x1 <- (if (let (x1, _) := xv in x1) =? 1
+ then Some x0
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -552,12 +565,13 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
(ℤ -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x1 <- (if (let (x1, _) := idc_args in x1) =? 1
- then Some x
- else None);
- Some (Base x1)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x1 <- (if (let (x1, _) := xv in x1) =? 1
+ then Some x
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end);;
@@ -575,12 +589,13 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(s -> (projT1 args0))%ptype
then
v <- type.try_make_transport_cps s ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- x2 <- (if (let (x2, _) := idc_args in x2) =? -1
- then Some (v (Compile.reflect x1))
- else None);
- Some (Base x2)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ fv <- (x2 <- (if (let (x2, _) := xv in x2) =? -1
+ then Some (v (Compile.reflect x1))
+ else None);
+ Some (Base x2));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -603,13 +618,14 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args) -> s)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
v <- type.try_make_transport_cps s ℤ;
- x2 <- (if (let (x2, _) := idc_args in x2) =? -1
- then Some (v (Compile.reflect x1))
- else None);
- Some (Base x2)
+ fv <- (x2 <- (if (let (x2, _) := xv in x2) =? -1
+ then Some (v (Compile.reflect x1))
+ else None);
+ Some (Base x2));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -632,11 +648,13 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args) -> ℤ)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x1 <- (if (let (x1, _) := idc_args in x1) =? -1
- then Some (- x0)%expr
- else None);
- Some (Base x1)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x1 <- (if (let (x1, _) := xv in x1) =? -1
+ then Some (- x0)%expr
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -654,11 +672,13 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
(ℤ -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x1 <- (if (let (x1, _) := idc_args in x1) =? -1
- then Some (- x)%expr
- else None);
- Some (Base x1)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x1 <- (if (let (x1, _) := xv in x1) =? -1
+ then Some (- x)%expr
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -676,13 +696,15 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args) -> ℤ)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x1 <- (if (let (x1, _) := idc_args in x1) <? 0
- then
- Some
- (- (##(- (let (x1, _) := idc_args in x1))%Z * x0))%expr
- else None);
- Some (Base x1)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x1 <- (if (let (x1, _) := xv in x1) <? 0
+ then
+ Some
+ (- (##(- (let (x1, _) := xv in x1))%Z * x0))%expr
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -700,13 +722,15 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
(ℤ -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x1 <- (if (let (x1, _) := idc_args in x1) <? 0
- then
- Some
- (- (x * ##(- (let (x1, _) := idc_args in x1))%Z))%expr
- else None);
- Some (Base x1)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x1 <- (if (let (x1, _) := xv in x1) <? 0
+ then
+ Some
+ (- (x * ##(- (let (x1, _) := xv in x1))%Z))%expr
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -777,16 +801,18 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
(ℤ -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x1 <- (if
- ((let (x1, _) := idc_args in x1) =?
- 2 ^ Z.log2 (let (x1, _) := idc_args in x1)) &&
- negb ((let (x1, _) := idc_args in x1) =? 2)
- then
- Some
- (x << ##(Z.log2 (let (x1, _) := idc_args in x1)))%expr
- else None);
- Some (Base x1)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x1 <- (if
+ ((let (x1, _) := xv in x1) =?
+ 2 ^ Z.log2 (let (x1, _) := xv in x1)) &&
+ negb ((let (x1, _) := xv in x1) =? 2)
+ then
+ Some
+ (x << ##(Z.log2 (let (x1, _) := xv in x1)))%expr
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -823,17 +849,18 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args) -> ℤ)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x1 <- (if
- ((let (x1, _) := idc_args in x1) =?
- 2 ^ Z.log2 (let (x1, _) := idc_args in x1)) &&
- negb ((let (x1, _) := idc_args in x1) =? 2)
- then
- Some
- (x0 << ##(Z.log2 (let (x1, _) := idc_args in x1)))%expr
- else None);
- Some (Base x1)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x1 <- (if
+ ((let (x1, _) := xv in x1) =?
+ 2 ^ Z.log2 (let (x1, _) := xv in x1)) &&
+ negb ((let (x1, _) := xv in x1) =? 2)
+ then
+ Some
+ (x0 << ##(Z.log2 (let (x1, _) := xv in x1)))%expr
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end);;
@@ -862,25 +889,27 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(ℤ -> ℤ -> ℤ -> ℤ)%ptype
((projT1 args2) -> (projT1 args0) -> s2 -> s1)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args2);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
v <- type.try_make_transport_cps s2 ℤ;
v0 <- type.try_make_transport_cps s1 ℤ;
- x5 <- (if
- (Z.abs (let (x5, _) := idc_args in x5) <=?
- Z.abs max_const_val) &&
- (Z.abs (let (x5, _) := idc_args0 in x5) <=?
- Z.abs max_const_val)
- then
- Some
- (v (Compile.reflect x4) *
- (v0 (Compile.reflect x3) *
- (##(let (x5, _) := idc_args in x5) *
- ##(let (x5, _) := idc_args0 in x5))))%expr
- else None);
- Some (Base x5)
+ fv <- (x5 <- (if
+ (Z.abs (let (x5, _) := xv in x5) <=?
+ Z.abs max_const_val) &&
+ (Z.abs (let (x5, _) := xv0 in x5) <=?
+ Z.abs max_const_val)
+ then
+ Some
+ (v (Compile.reflect x4) *
+ (v0 (Compile.reflect x3) *
+ (##(let (x5, _) := xv in x5) *
+ ##(let (x5, _) := xv0 in x5))))%expr
+ else None);
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -919,25 +948,27 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(ℤ -> ℤ -> ℤ -> ℤ)%ptype
((projT1 args2) -> s0 -> s2 -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args2);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
v <- type.try_make_transport_cps s0 ℤ;
v0 <- type.try_make_transport_cps s2 ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x5 <- (if
- (Z.abs (let (x5, _) := idc_args in x5) <=?
- Z.abs max_const_val) &&
- (Z.abs (let (x5, _) := idc_args0 in x5) <=?
- Z.abs max_const_val)
- then
- Some
- (v (Compile.reflect x2) *
- (v0 (Compile.reflect x4) *
- (##(let (x5, _) := idc_args in x5) *
- ##(let (x5, _) := idc_args0 in x5))))%expr
- else None);
- Some (Base x5)
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x5 <- (if
+ (Z.abs (let (x5, _) := xv in x5) <=?
+ Z.abs max_const_val) &&
+ (Z.abs (let (x5, _) := xv0 in x5) <=?
+ Z.abs max_const_val)
+ then
+ Some
+ (v (Compile.reflect x2) *
+ (v0 (Compile.reflect x4) *
+ (##(let (x5, _) := xv in x5) *
+ ##(let (x5, _) := xv0 in x5))))%expr
+ else None);
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -968,20 +999,21 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq
(ℤ -> ℤ -> ℤ)%ptype ((projT1 args0) -> s0 -> s)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
v <- type.try_make_transport_cps s0 ℤ;
v0 <- type.try_make_transport_cps s ℤ;
- x3 <- (if
- Z.abs (let (x3, _) := idc_args in x3) <=?
- Z.abs max_const_val
- then
- Some
- (v (Compile.reflect x2) *
- (v0 (Compile.reflect x1) *
- ##(let (x3, _) := idc_args in x3)))%expr
- else None);
- Some (Base x3)
+ fv <- (x3 <- (if
+ Z.abs (let (x3, _) := xv in x3) <=?
+ Z.abs max_const_val
+ then
+ Some
+ (v (Compile.reflect x2) *
+ (v0 (Compile.reflect x1) *
+ ##(let (x3, _) := xv in x3)))%expr
+ else None);
+ Some (Base x3));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1006,14 +1038,16 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args) -> ℤ)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x1 <- (if
- Z.abs (let (x1, _) := idc_args in x1) <=?
- Z.abs max_const_val
- then
- Some (x0 * ##(let (x1, _) := idc_args in x1))%expr
- else None);
- Some (Base x1)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x1 <- (if
+ Z.abs (let (x1, _) := xv in x1) <=?
+ Z.abs max_const_val
+ then
+ Some (x0 * ##(let (x1, _) := xv in x1))%expr
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1039,13 +1073,14 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args0) -> s)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
v <- type.try_make_transport_cps s ℤ;
- x2 <- (if (let (x2, _) := idc_args in x2) =? 0
- then Some (v (Compile.reflect x1))
- else None);
- Some (Base x2)
+ fv <- (x2 <- (if (let (x2, _) := xv in x2) =? 0
+ then Some (v (Compile.reflect x1))
+ else None);
+ Some (Base x2));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1064,11 +1099,13 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args) -> ℤ)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x1 <- (if (let (x1, _) := idc_args in x1) =? 0
- then Some (- x0)%expr
- else None);
- Some (Base x1)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x1 <- (if (let (x1, _) := xv in x1) =? 0
+ then Some (- x0)%expr
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1086,11 +1123,13 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
(ℤ -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x1 <- (if (let (x1, _) := idc_args in x1) =? 0
- then Some x
- else None);
- Some (Base x1)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x1 <- (if (let (x1, _) := xv in x1) =? 0
+ then Some x
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1108,16 +1147,17 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq
(ℤ -> ℤ)%ptype ((projT1 args) -> s)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
v <- type.try_make_transport_cps s ℤ;
- x2 <- (if (let (x2, _) := idc_args in x2) >? 0
- then
- Some
- (##(let (x2, _) := idc_args in x2) +
- v (Compile.reflect x1))%expr
- else None);
- Some (Base x2)
+ fv <- (x2 <- (if (let (x2, _) := xv in x2) >? 0
+ then
+ Some
+ (##(let (x2, _) := xv in x2) +
+ v (Compile.reflect x1))%expr
+ else None);
+ Some (Base x2));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end);;
@@ -1132,16 +1172,17 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args) -> s)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
v <- type.try_make_transport_cps s ℤ;
- x2 <- (if (let (x2, _) := idc_args in x2) <? 0
- then
- Some
- (v (Compile.reflect x1) -
- ##(- (let (x2, _) := idc_args in x2))%Z)%expr
- else None);
- Some (Base x2)
+ fv <- (x2 <- (if (let (x2, _) := xv in x2) <? 0
+ then
+ Some
+ (v (Compile.reflect x1) -
+ ##(- (let (x2, _) := xv in x2))%Z)%expr
+ else None);
+ Some (Base x2));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1164,13 +1205,15 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args) -> ℤ)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x1 <- (if (let (x1, _) := idc_args in x1) <? 0
- then
- Some
- (- (##(- (let (x1, _) := idc_args in x1))%Z + x0))%expr
- else None);
- Some (Base x1)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x1 <- (if (let (x1, _) := xv in x1) <? 0
+ then
+ Some
+ (- (##(- (let (x1, _) := xv in x1))%Z + x0))%expr
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1189,16 +1232,17 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(ℤ -> ℤ)%ptype (s -> (projT1 args))%ptype
then
v <- type.try_make_transport_cps s ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x2 <- (if (let (x2, _) := idc_args in x2) >? 0
- then
- Some
- (-
- (v (Compile.reflect x1) +
- ##(let (x2, _) := idc_args in x2)))%expr
- else None);
- Some (Base x2)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x2 <- (if (let (x2, _) := xv in x2) >? 0
+ then
+ Some
+ (-
+ (v (Compile.reflect x1) +
+ ##(let (x2, _) := xv in x2)))%expr
+ else None);
+ Some (Base x2));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end);;
@@ -1214,15 +1258,16 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(s -> (projT1 args))%ptype
then
v <- type.try_make_transport_cps s ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x2 <- (if (let (x2, _) := idc_args in x2) <? 0
- then
- Some
- (##(- (let (x2, _) := idc_args in x2))%Z -
- v (Compile.reflect x1))%expr
- else None);
- Some (Base x2)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x2 <- (if (let (x2, _) := xv in x2) <? 0
+ then
+ Some
+ (##(- (let (x2, _) := xv in x2))%Z -
+ v (Compile.reflect x1))%expr
+ else None);
+ Some (Base x2));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1245,13 +1290,15 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
(ℤ -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x1 <- (if (let (x1, _) := idc_args in x1) <? 0
- then
- Some
- (x + ##(- (let (x1, _) := idc_args in x1))%Z)%expr
- else None);
- Some (Base x1)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x1 <- (if (let (x1, _) := xv in x1) <? 0
+ then
+ Some
+ (x + ##(- (let (x1, _) := xv in x1))%Z)%expr
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1363,14 +1410,7 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
if type.type_beq base.type base.type.type_beq ℤ ℤ
then
fv <- (if negb (SubstVarLike.is_var_fst_snd_pair_opp_cast x)
- then
- Some
- (UnderLet x
- (fun
- v : var
- (base.subst_default ℤ
- (PositiveMap.empty base.type)) =>
- Base (- $v)%expr))
+ then Some (UnderLet x (fun v : var ℤ => Base (- $v)%expr))
else None);
Some (fv0 <-- fv;
Base fv0)%under_lets
@@ -1393,11 +1433,13 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
(ℤ -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x1 <- (if (let (x1, _) := idc_args in x1) =? 1
- then Some x
- else None);
- Some (Base x1)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x1 <- (if (let (x1, _) := xv in x1) =? 1
+ then Some x
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end);;
@@ -1411,15 +1453,17 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
(ℤ -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x1 <- (if
- (let (x1, _) := idc_args in x1) =?
- 2 ^ Z.log2 (let (x1, _) := idc_args in x1)
- then
- Some
- (x >> ##(Z.log2 (let (x1, _) := idc_args in x1)))%expr
- else None);
- Some (Base x1)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x1 <- (if
+ (let (x1, _) := xv in x1) =?
+ 2 ^ Z.log2 (let (x1, _) := xv in x1)
+ then
+ Some
+ (x >> ##(Z.log2 (let (x1, _) := xv in x1)))%expr
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1441,11 +1485,13 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
(ℤ -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x1 <- (if (let (x1, _) := idc_args in x1) =? 1
- then Some (##0)%expr
- else None);
- Some (Base x1)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x1 <- (if (let (x1, _) := xv in x1) =? 1
+ then Some (##0)%expr
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end);;
@@ -1459,15 +1505,17 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
(ℤ -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x1 <- (if
- (let (x1, _) := idc_args in x1) =?
- 2 ^ Z.log2 (let (x1, _) := idc_args in x1)
- then
- Some
- (x &' ##((let (x1, _) := idc_args in x1) - 1)%Z)%expr
- else None);
- Some (Base x1)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x1 <- (if
+ (let (x1, _) := xv in x1) =?
+ 2 ^ Z.log2 (let (x1, _) := xv in x1)
+ then
+ Some
+ (x &' ##((let (x1, _) := xv in x1) - 1)%Z)%expr
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1497,11 +1545,13 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
(ℤ -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x1 <- (if (let (x1, _) := idc_args in x1) =? 0
- then Some (##0)%expr
- else None);
- Some (Base x1)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x1 <- (if (let (x1, _) := xv in x1) =? 0
+ then Some (##0)%expr
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1519,11 +1569,13 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args) -> ℤ)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x1 <- (if (let (x1, _) := idc_args in x1) =? 0
- then Some (##0)%expr
- else None);
- Some (Base x1)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x1 <- (if (let (x1, _) := xv in x1) =? 0
+ then Some (##0)%expr
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1589,12 +1641,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
v <- type.try_make_transport_cps s0 ℤ;
v0 <- type.try_make_transport_cps s ℤ;
Some
- (fv <-- do_again (ℤ * ℤ)
- (#(Z_cast (Datatypes.fst range))%expr @
- ($(v (Compile.reflect x1)))%expr,
- #(Z_cast (Datatypes.snd range))%expr @
- ($(v0 (Compile.reflect x0)))%expr)%expr_pat;
- Base fv)%under_lets
+ (fv0 <-- do_again (ℤ * ℤ)
+ (#(Z_cast (Datatypes.fst range))%expr @
+ ($(v (Compile.reflect x1)))%expr,
+ #(Z_cast (Datatypes.snd range))%expr @
+ ($(v0 (Compile.reflect x0)))%expr)%expr_pat;
+ Base fv0)%under_lets
else None
| None => None
end
diff --git a/src/Experiments/NewPipeline/arith_with_casts_rewrite_head.out b/src/Experiments/NewPipeline/arith_with_casts_rewrite_head.out
index 09b79718d..2baf1c5d2 100644
--- a/src/Experiments/NewPipeline/arith_with_casts_rewrite_head.out
+++ b/src/Experiments/NewPipeline/arith_with_casts_rewrite_head.out
@@ -42,10 +42,11 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
_ <- ident.unify pattern.ident.pair pair;
v <- type.try_make_transport_cps s0 b3;
_ <- type.try_make_transport_cps s b2;
- v1 <- base.try_make_transport_cps b3 A;
- v2 <- base.try_make_transport_cps A A;
- v3 <- base.try_make_transport_cps A A;
- Some (Base (v3 (v2 (v1 (v (Compile.reflect x1))))))
+ v1 <- base.try_make_transport_cps b3 b3;
+ _ <- base.try_make_transport_cps b2 b2;
+ v3 <- base.try_make_transport_cps b3 A;
+ v4 <- base.try_make_transport_cps A A;
+ Some (Base (v4 (v3 (v1 (v (Compile.reflect x1))))))
else None
| None => None
end
@@ -93,10 +94,11 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
_ <- ident.unify pattern.ident.pair pair;
_ <- type.try_make_transport_cps s0 b3;
v0 <- type.try_make_transport_cps s b2;
- v1 <- base.try_make_transport_cps b2 B;
- v2 <- base.try_make_transport_cps B B;
- v3 <- base.try_make_transport_cps B B;
- Some (Base (v3 (v2 (v1 (v0 (Compile.reflect x0))))))
+ _ <- base.try_make_transport_cps b3 b3;
+ v2 <- base.try_make_transport_cps b2 b2;
+ v3 <- base.try_make_transport_cps b2 B;
+ v4 <- base.try_make_transport_cps B B;
+ Some (Base (v4 (v3 (v2 (v0 (Compile.reflect x0))))))
else None
| None => None
end
@@ -237,18 +239,20 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args2) -> s1)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args2);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args2);
v <- type.try_make_transport_cps s1 ℤ;
- x4 <- (if
- ((let (x4, _) := idc_args in x4) =? 0) &&
- (ZRange.normalize args <=?
- - ZRange.normalize args1)%zrange
- then
- Some
- (#(Z_cast args)%expr @ v (Compile.reflect x3))%expr_pat
- else None);
- Some (Base x4)
+ fv <- (x4 <- (if
+ ((let (x4, _) := xv in x4) =? 0) &&
+ (ZRange.normalize args <=?
+ - ZRange.normalize args1)%zrange
+ then
+ Some
+ (#(Z_cast args)%expr @
+ v (Compile.reflect x3))%expr_pat
+ else None);
+ Some (Base x4));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -291,11 +295,13 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args) -> ℤ)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x1 <- (if (let (x1, _) := idc_args in x1) =? 0
- then Some (- x0)%expr
- else None);
- Some (Base x1)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x1 <- (if (let (x1, _) := xv in x1) =? 0
+ then Some (- x0)%expr
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -320,13 +326,16 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
if type.type_beq base.type base.type.type_beq ℤ s1
then
v <- type.try_make_transport_cps s1 ℤ;
- x3 <- (if
- (ZRange.normalize args <=? - ZRange.normalize args1)%zrange
- then
- Some
- (#(Z_cast args)%expr @ v (Compile.reflect x2))%expr_pat
- else None);
- Some (Base x3)
+ fv <- (x3 <- (if
+ (ZRange.normalize args <=?
+ - ZRange.normalize args1)%zrange
+ then
+ Some
+ (#(Z_cast args)%expr @ v (Compile.reflect x2))%expr_pat
+ else None);
+ Some (Base x3));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -384,11 +393,13 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args) -> ℤ)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x1 <- (if (let (x1, _) := idc_args in x1) =? 0
- then Some (##0)%expr
- else None);
- Some (Base x1)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x1 <- (if (let (x1, _) := xv in x1) =? 0
+ then Some (##0)%expr
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -420,12 +431,13 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(((projT1 args0) -> (projT1 args)) -> ℤ)%ptype
then
_ <- ident.unify pattern.ident.Literal ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x2 <- (if (let (x2, _) := idc_args0 in x2) =? 0
- then Some ((##0)%expr, (##0)%expr)%expr_pat
- else None);
- Some (Base x2)
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x2 <- (if (let (x2, _) := xv0 in x2) =? 0
+ then Some ((##0)%expr, (##0)%expr)%expr_pat
+ else None);
+ Some (Base x2));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -447,12 +459,13 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(((projT1 args0) -> ℤ) -> (projT1 args))%ptype
then
_ <- ident.unify pattern.ident.Literal ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x2 <- (if (let (x2, _) := idc_args0 in x2) =? 0
- then Some ((##0)%expr, (##0)%expr)%expr_pat
- else None);
- Some (Base x2)
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x2 <- (if (let (x2, _) := xv0 in x2) =? 0
+ then Some ((##0)%expr, (##0)%expr)%expr_pat
+ else None);
+ Some (Base x2));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end);;
@@ -472,21 +485,23 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((ℤ -> ℤ) -> ℤ)%ptype
(((projT1 args1) -> s) -> (projT1 args0))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
v <- type.try_make_transport_cps s ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- x3 <- (if
- ((let (x3, _) := idc_args0 in x3) =? 1) &&
- (ZRange.normalize args <=?
- r[0 ~> (let (x3, _) := idc_args in x3) - 1])%zrange
- then
- Some
- (#(Z_cast args)%expr @
- v (Compile.reflect x2), (##0)%expr)%expr_pat
- else None);
- Some (Base x3)
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ fv <- (x3 <- (if
+ ((let (x3, _) := xv0 in x3) =? 1) &&
+ (ZRange.normalize args <=?
+ r[0 ~> (let (x3, _) := xv in x3) - 1])%zrange
+ then
+ Some
+ (#(Z_cast args)%expr @
+ v (Compile.reflect x2), (##0)%expr)%expr_pat
+ else None);
+ Some (Base x3));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -513,21 +528,23 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((ℤ -> ℤ) -> ℤ)%ptype
(((projT1 args1) -> (projT1 args)) -> s)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
v <- type.try_make_transport_cps s ℤ;
- x3 <- (if
- ((let (x3, _) := idc_args0 in x3) =? 1) &&
- (ZRange.normalize args0 <=?
- r[0 ~> (let (x3, _) := idc_args in x3) - 1])%zrange
- then
- Some
- (#(Z_cast args0)%expr @
- v (Compile.reflect x2), (##0)%expr)%expr_pat
- else None);
- Some (Base x3)
+ fv <- (x3 <- (if
+ ((let (x3, _) := xv0 in x3) =? 1) &&
+ (ZRange.normalize args0 <=?
+ r[0 ~> (let (x3, _) := xv in x3) - 1])%zrange
+ then
+ Some
+ (#(Z_cast args0)%expr @
+ v (Compile.reflect x2), (##0)%expr)%expr_pat
+ else None);
+ Some (Base x3));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -564,20 +581,19 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((ℤ -> ℤ) -> ℤ)%ptype
(((projT1 args1) -> (projT1 args0)) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args1 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv1 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
Some
(Base
(let
'(a1, b1)%zrange :=
- Z.add_get_carry_full
- (let (x2, _) := idc_args in x2)
- (let (x2, _) := idc_args0 in x2)
- (let (x2, _) := idc_args1 in x2) in
+ Z.add_get_carry_full (let (x2, _) := xv in x2)
+ (let (x2, _) := xv0 in x2)
+ (let (x2, _) := xv1 in x2) in
((##a1)%expr, (##b1)%expr)%expr_pat))
else None
| None => None
@@ -597,21 +613,23 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((ℤ -> ℤ) -> ℤ)%ptype
(((projT1 args1) -> (projT1 args0)) -> s)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
v <- type.try_make_transport_cps s ℤ;
- x3 <- (if
- ((let (x3, _) := idc_args0 in x3) =? 0) &&
- (ZRange.normalize args <=?
- r[0 ~> (let (x3, _) := idc_args in x3) - 1])%zrange
- then
- Some
- (#(Z_cast args)%expr @
- v (Compile.reflect x2), (##0)%expr)%expr_pat
- else None);
- Some (Base x3)
+ fv <- (x3 <- (if
+ ((let (x3, _) := xv0 in x3) =? 0) &&
+ (ZRange.normalize args <=?
+ r[0 ~> (let (x3, _) := xv in x3) - 1])%zrange
+ then
+ Some
+ (#(Z_cast args)%expr @
+ v (Compile.reflect x2), (##0)%expr)%expr_pat
+ else None);
+ Some (Base x3));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -638,21 +656,23 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((ℤ -> ℤ) -> ℤ)%ptype
(((projT1 args1) -> s) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
v <- type.try_make_transport_cps s ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x3 <- (if
- ((let (x3, _) := idc_args0 in x3) =? 0) &&
- (ZRange.normalize args0 <=?
- r[0 ~> (let (x3, _) := idc_args in x3) - 1])%zrange
- then
- Some
- (#(Z_cast args0)%expr @
- v (Compile.reflect x2), (##0)%expr)%expr_pat
- else None);
- Some (Base x3)
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x3 <- (if
+ ((let (x3, _) := xv0 in x3) =? 0) &&
+ (ZRange.normalize args0 <=?
+ r[0 ~> (let (x3, _) := xv in x3) - 1])%zrange
+ then
+ Some
+ (#(Z_cast args0)%expr @
+ v (Compile.reflect x2), (##0)%expr)%expr_pat
+ else None);
+ Some (Base x3));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -681,11 +701,13 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq
((ℤ -> ℤ) -> ℤ)%ptype (((projT1 args) -> ℤ) -> ℤ)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x2 <- (if (let (x2, _) := idc_args in x2) =? 0
- then Some (x0 + x1)%expr
- else None);
- Some (Base x2)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x2 <- (if (let (x2, _) := xv in x2) =? 0
+ then Some (x0 + x1)%expr
+ else None);
+ Some (Base x2));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -720,23 +742,23 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((((projT1 args2) -> (projT1 args1)) ->
(projT1 args0)) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args2);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- idc_args1 <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args2 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ xv1 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv2 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
Some
(Base
(let
'(a2, b2)%zrange :=
Z.add_with_get_carry_full
- (let (x3, _) := idc_args in x3)
- (let (x3, _) := idc_args0 in x3)
- (let (x3, _) := idc_args1 in x3)
- (let (x3, _) := idc_args2 in x3) in
+ (let (x3, _) := xv in x3)
+ (let (x3, _) := xv0 in x3)
+ (let (x3, _) := xv1 in x3)
+ (let (x3, _) := xv2 in x3) in
((##a2)%expr, (##b2)%expr)%expr_pat))
else None
| None => None
@@ -760,24 +782,28 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((((projT1 args2) -> (projT1 args1)) ->
(projT1 args0)) -> s)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args2);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- idc_args1 <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ xv1 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
v <- type.try_make_transport_cps s ℤ;
- x4 <- (if
- ((let (x4, _) := idc_args0 in x4) =? 0) &&
- ((let (x4, _) := idc_args1 in x4) =? 0) &&
- (ZRange.normalize args <=?
- r[0 ~> (let (x4, _) := idc_args in x4) - 1])%zrange
- then
- Some
- (#(Z_cast args)%expr @
- v (Compile.reflect x3), (##0)%expr)%expr_pat
- else None);
- Some (Base x4)
+ fv <- (x4 <- (if
+ ((let (x4, _) := xv0 in x4) =? 0) &&
+ ((let (x4, _) := xv1 in x4) =? 0) &&
+ (ZRange.normalize args <=?
+ r[0 ~> (let (x4, _) := xv in x4) -
+ 1])%zrange
+ then
+ Some
+ (#(Z_cast args)%expr @
+ v (Compile.reflect x3),
+ (##0)%expr)%expr_pat
+ else None);
+ Some (Base x4));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -807,24 +833,28 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((((projT1 args2) -> (projT1 args1)) -> s) ->
(projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args2);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
v <- type.try_make_transport_cps s ℤ;
- idc_args1 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x4 <- (if
- ((let (x4, _) := idc_args0 in x4) =? 0) &&
- ((let (x4, _) := idc_args1 in x4) =? 0) &&
- (ZRange.normalize args0 <=?
- r[0 ~> (let (x4, _) := idc_args in x4) - 1])%zrange
- then
- Some
- (#(Z_cast args0)%expr @
- v (Compile.reflect x3), (##0)%expr)%expr_pat
- else None);
- Some (Base x4)
+ xv1 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x4 <- (if
+ ((let (x4, _) := xv0 in x4) =? 0) &&
+ ((let (x4, _) := xv1 in x4) =? 0) &&
+ (ZRange.normalize args0 <=?
+ r[0 ~> (let (x4, _) := xv in x4) -
+ 1])%zrange
+ then
+ Some
+ (#(Z_cast args0)%expr @
+ v (Compile.reflect x3),
+ (##0)%expr)%expr_pat
+ else None);
+ Some (Base x4));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -868,13 +898,15 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
| Some _ =>
if type.type_beq base.type base.type.type_beq ℤ (projT1 args)
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x0 <- (if
- is_bounded_by_bool (let (x0, _) := idc_args in x0)
- range
- then Some (##(let (x0, _) := idc_args in x0))%expr
- else None);
- Some (Base x0)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x0 <- (if
+ is_bounded_by_bool (let (x0, _) := xv in x0)
+ range
+ then Some (##(let (x0, _) := xv in x0))%expr
+ else None);
+ Some (Base x0));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -888,13 +920,16 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
if type.type_beq base.type base.type.type_beq ℤ s
then
v <- type.try_make_transport_cps s ℤ;
- x1 <- (if
- (ZRange.normalize args <=? ZRange.normalize range)%zrange
- then
- Some
- (#(Z_cast args)%expr @ v (Compile.reflect x0))%expr_pat
- else None);
- Some (Base x1)
+ fv <- (x1 <- (if
+ (ZRange.normalize args <=?
+ ZRange.normalize range)%zrange
+ then
+ Some
+ (#(Z_cast args)%expr @ v (Compile.reflect x0))%expr_pat
+ else None);
+ Some (Base x1));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -971,12 +1006,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
v <- type.try_make_transport_cps s0 ℤ;
v0 <- type.try_make_transport_cps s ℤ;
Some
- (fv <-- do_again (ℤ * ℤ)
- (#(Z_cast (Datatypes.fst range))%expr @
- ($(v (Compile.reflect x1)))%expr,
- #(Z_cast (Datatypes.snd range))%expr @
- ($(v0 (Compile.reflect x0)))%expr)%expr_pat;
- Base fv)%under_lets
+ (fv0 <-- do_again (ℤ * ℤ)
+ (#(Z_cast (Datatypes.fst range))%expr @
+ ($(v (Compile.reflect x1)))%expr,
+ #(Z_cast (Datatypes.snd range))%expr @
+ ($(v0 (Compile.reflect x0)))%expr)%expr_pat;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1169,10 +1204,9 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((s1 -> (projT1 args)) -> s)%ptype
then
v <- type.try_make_transport_cps s1 ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
v0 <- type.try_make_transport_cps s ℤ;
- fv <- (if (let (x3, _) := idc_args in x3) <? 0
+ fv <- (if (let (x3, _) := xv in x3) <? 0
then
Some
(UnderLet
@@ -1182,7 +1216,7 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(#(Z_sub_get_borrow)%expr @
v (Compile.reflect x2) @
v0 (Compile.reflect x0) @
- (##(- (let (x3, _) := idc_args in x3))%Z)%expr))%expr_pat
+ (##(- (let (x3, _) := xv in x3))%Z)%expr))%expr_pat
(fun vc : var (ℤ * ℤ)%etype =>
Base
(#(Z_cast (Datatypes.fst range))%expr @
@@ -1224,9 +1258,8 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
then
v <- type.try_make_transport_cps s1 ℤ;
v0 <- type.try_make_transport_cps s0 ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- fv <- (if (let (x3, _) := idc_args in x3) <? 0
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (if (let (x3, _) := xv in x3) <? 0
then
Some
(UnderLet
@@ -1236,7 +1269,7 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(#(Z_sub_get_borrow)%expr @
v (Compile.reflect x2) @
v0 (Compile.reflect x1) @
- (##(- (let (x3, _) := idc_args in x3))%Z)%expr))%expr_pat
+ (##(- (let (x3, _) := xv in x3))%Z)%expr))%expr_pat
(fun vc : var (ℤ * ℤ)%etype =>
Base
(#(Z_cast (Datatypes.fst range))%expr @
@@ -1370,12 +1403,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(((s2 -> (projT1 args2)) -> s5) -> s)%ptype
then
v <- type.try_make_transport_cps s2 ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args2);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
v0 <- type.try_make_transport_cps s5 ℤ;
v1 <- type.try_make_transport_cps s ℤ;
fv <- (if
- ((let (x7, _) := idc_args in x7) =? 0) &&
+ ((let (x7, _) := xv in x7) =? 0) &&
(ZRange.normalize args <=?
- ZRange.normalize args1)%zrange
then
@@ -1429,12 +1462,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(((s2 -> (projT1 args2)) -> s5) -> s)%ptype
then
v <- type.try_make_transport_cps s2 ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args2);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
v0 <- type.try_make_transport_cps s5 ℤ;
v1 <- type.try_make_transport_cps s ℤ;
fv <- (if
- ((let (x7, _) := idc_args in x7) <? 0) &&
+ ((let (x7, _) := xv in x7) <? 0) &&
(ZRange.normalize args <=?
- ZRange.normalize args1)%zrange
then
@@ -1445,7 +1478,7 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
- Datatypes.snd range))%expr @
(#(Z_sub_with_get_borrow)%expr @
v (Compile.reflect x3) @
- (##(- (let (x7, _) := idc_args in x7))%Z)%expr @
+ (##(- (let (x7, _) := xv in x7))%Z)%expr @
v1 (Compile.reflect x0) @
(#(Z_cast args)%expr @
v0 (Compile.reflect x6))))%expr_pat
@@ -1524,12 +1557,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(((s2 -> (projT1 args2)) -> s0) -> s5)%ptype
then
v <- type.try_make_transport_cps s2 ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args2);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
v0 <- type.try_make_transport_cps s0 ℤ;
v1 <- type.try_make_transport_cps s5 ℤ;
fv <- (if
- ((let (x7, _) := idc_args in x7) =? 0) &&
+ ((let (x7, _) := xv in x7) =? 0) &&
(ZRange.normalize args <=?
- ZRange.normalize args1)%zrange
then
@@ -1583,12 +1616,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(((s2 -> (projT1 args2)) -> s0) -> s5)%ptype
then
v <- type.try_make_transport_cps s2 ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args2);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
v0 <- type.try_make_transport_cps s0 ℤ;
v1 <- type.try_make_transport_cps s5 ℤ;
fv <- (if
- ((let (x7, _) := idc_args in x7) <? 0) &&
+ ((let (x7, _) := xv in x7) <? 0) &&
(ZRange.normalize args <=?
- ZRange.normalize args1)%zrange
then
@@ -1599,7 +1632,7 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
- Datatypes.snd range))%expr @
(#(Z_sub_with_get_borrow)%expr @
v (Compile.reflect x3) @
- (##(- (let (x7, _) := idc_args in x7))%Z)%expr @
+ (##(- (let (x7, _) := xv in x7))%Z)%expr @
v0 (Compile.reflect x1) @
(#(Z_cast args)%expr @
v1 (Compile.reflect x6))))%expr_pat
@@ -1674,16 +1707,16 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(((s2 -> (projT1 args0)) -> (projT1 args)) -> s)%ptype
then
v <- type.try_make_transport_cps s2 ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
v0 <- type.try_make_transport_cps s ℤ;
fv <- (if
- ((let (x4, _) := idc_args0 in x4) <=? 0) &&
- ((let (x4, _) := idc_args in x4) <=? 0) &&
- ((let (x4, _) := idc_args0 in x4) +
- (let (x4, _) := idc_args in x4) <? 0)
+ ((let (x4, _) := xv0 in x4) <=? 0) &&
+ ((let (x4, _) := xv in x4) <=? 0) &&
+ ((let (x4, _) := xv0 in x4) +
+ (let (x4, _) := xv in x4) <? 0)
then
Some
(UnderLet
@@ -1692,9 +1725,9 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
- Datatypes.snd range))%expr @
(#(Z_sub_with_get_borrow)%expr @
v (Compile.reflect x3) @
- (##(- (let (x4, _) := idc_args in x4))%Z)%expr @
+ (##(- (let (x4, _) := xv in x4))%Z)%expr @
v0 (Compile.reflect x0) @
- (##(- (let (x4, _) := idc_args0 in x4))%Z)%expr))%expr_pat
+ (##(- (let (x4, _) := xv0 in x4))%Z)%expr))%expr_pat
(fun vc : var (ℤ * ℤ)%etype =>
Base
(#(Z_cast (Datatypes.fst range))%expr @
@@ -1737,16 +1770,16 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(((s2 -> (projT1 args0)) -> s0) -> (projT1 args))%ptype
then
v <- type.try_make_transport_cps s2 ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
v0 <- type.try_make_transport_cps s0 ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
fv <- (if
- ((let (x4, _) := idc_args0 in x4) <=? 0) &&
- ((let (x4, _) := idc_args in x4) <=? 0) &&
- ((let (x4, _) := idc_args0 in x4) +
- (let (x4, _) := idc_args in x4) <? 0)
+ ((let (x4, _) := xv0 in x4) <=? 0) &&
+ ((let (x4, _) := xv in x4) <=? 0) &&
+ ((let (x4, _) := xv0 in x4) +
+ (let (x4, _) := xv in x4) <? 0)
then
Some
(UnderLet
@@ -1755,9 +1788,9 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
- Datatypes.snd range))%expr @
(#(Z_sub_with_get_borrow)%expr @
v (Compile.reflect x3) @
- (##(- (let (x4, _) := idc_args in x4))%Z)%expr @
+ (##(- (let (x4, _) := xv in x4))%Z)%expr @
v0 (Compile.reflect x1) @
- (##(- (let (x4, _) := idc_args0 in x4))%Z)%expr))%expr_pat
+ (##(- (let (x4, _) := xv0 in x4))%Z)%expr))%expr_pat
(fun vc : var (ℤ * ℤ)%etype =>
Base
(#(Z_cast (Datatypes.fst range))%expr @
@@ -1797,11 +1830,10 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(((s2 -> (projT1 args)) -> s0) -> s)%ptype
then
v <- type.try_make_transport_cps s2 ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
v0 <- type.try_make_transport_cps s0 ℤ;
v1 <- type.try_make_transport_cps s ℤ;
- fv <- (if (let (x4, _) := idc_args in x4) =? 0
+ fv <- (if (let (x4, _) := xv in x4) =? 0
then
Some
(UnderLet
@@ -2054,11 +2086,11 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
then
v <- type.try_make_transport_cps s2 ℤ;
v0 <- type.try_make_transport_cps s5 ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
v1 <- type.try_make_transport_cps s ℤ;
fv <- (if
- ((let (x7, _) := idc_args in x7) <=? 0) &&
+ ((let (x7, _) := xv in x7) <=? 0) &&
(ZRange.normalize args0 <=?
- ZRange.normalize args2)%zrange
then
@@ -2072,8 +2104,7 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(#(Z_cast args0)%expr @
v0 (Compile.reflect x6)) @
v1 (Compile.reflect x0) @
- (##(-
- (let (x7, _) := idc_args in x7))%Z)%expr))%expr_pat
+ (##(- (let (x7, _) := xv in x7))%Z)%expr))%expr_pat
(fun vc : var (ℤ * ℤ)%etype =>
Base
(#(Z_cast (Datatypes.fst range))%expr @
@@ -2122,10 +2153,10 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
v <- type.try_make_transport_cps s2 ℤ;
v0 <- type.try_make_transport_cps s5 ℤ;
v1 <- type.try_make_transport_cps s0 ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
fv <- (if
- ((let (x7, _) := idc_args in x7) <=? 0) &&
+ ((let (x7, _) := xv in x7) <=? 0) &&
(ZRange.normalize args0 <=?
- ZRange.normalize args2)%zrange
then
@@ -2139,8 +2170,7 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(#(Z_cast args0)%expr @
v0 (Compile.reflect x6)) @
v1 (Compile.reflect x1) @
- (##(-
- (let (x7, _) := idc_args in x7))%Z)%expr))%expr_pat
+ (##(- (let (x7, _) := xv in x7))%Z)%expr))%expr_pat
(fun vc : var (ℤ * ℤ)%etype =>
Base
(#(Z_cast (Datatypes.fst range))%expr @
@@ -2206,23 +2236,18 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((((projT1 args1) -> s3) -> (projT1 args0)) ->
(projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
v <- type.try_make_transport_cps s3 ℤ;
- idc_args0 <- ident.unify
- pattern.ident.Literal
- ##(projT2 args0);
- idc_args1 <- ident.unify
- pattern.ident.Literal
- ##(projT2 args);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv1 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
fv <- (if
- ((let (x5, _) := idc_args0 in x5) =?
- 0) &&
- ((let (x5, _) := idc_args1 in x5) =?
- 0) &&
+ ((let (x5, _) := xv0 in x5) =? 0) &&
+ ((let (x5, _) := xv1 in x5) =? 0) &&
(ZRange.normalize args2 <=?
- r[0 ~> (let (x5, _) := idc_args in
- x5) - 1])%zrange &&
+ r[0 ~> (let (x5, _) := xv in x5) - 1])%zrange &&
is_bounded_by_bool 0
(Datatypes.snd range)
then
@@ -2230,16 +2255,11 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(UnderLet
(#(Z_cast2 range)%expr @
(#(Z_add_with_get_carry)%expr @
- (##(let (x5, _) := idc_args in
- x5))%expr @
+ (##(let (x5, _) := xv in x5))%expr @
(#(Z_cast args2)%expr @
v (Compile.reflect x4)) @
- (##(let (x5, _) :=
- idc_args0 in
- x5))%expr @
- (##(let (x5, _) :=
- idc_args1 in
- x5))%expr))%expr_pat
+ (##(let (x5, _) := xv0 in x5))%expr @
+ (##(let (x5, _) := xv1 in x5))%expr))%expr_pat
(fun vc : var (ℤ * ℤ)%etype =>
Base
(#(Z_cast
diff --git a/src/Experiments/NewPipeline/fancy_rewrite_head.out b/src/Experiments/NewPipeline/fancy_rewrite_head.out
index afe8cab0f..6cc69132c 100644
--- a/src/Experiments/NewPipeline/fancy_rewrite_head.out
+++ b/src/Experiments/NewPipeline/fancy_rewrite_head.out
@@ -137,31 +137,34 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(ℤ -> ℤ -> ℤ)%ptype
((projT1 args1) -> s0 -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
v <- type.try_make_transport_cps s0 ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x3 <- (if
- (let (x3, _) := idc_args0 in x3) =?
- 2
- ^ (2 *
- Z.log2_up (let (x3, _) := idc_args0 in x3) /
- 2) - 1
- then
- x3 <- invert_low
- (2 *
- Z.log2_up
- (let (x3, _) := idc_args0 in x3))
- (let (x3, _) := idc_args in x3);
- Some
- (#(fancy_mulll
- (2 *
- Z.log2_up
- (let (x4, _) := idc_args0 in x4)))%expr @
- ((##x3)%expr, v (Compile.reflect x2)))%expr_pat
- else None);
- Some (Base x3)
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x3 <- (if
+ (let (x3, _) := xv0 in x3) =?
+ 2
+ ^ (2 *
+ Z.log2_up (let (x3, _) := xv0 in x3) /
+ 2) - 1
+ then
+ x3 <- invert_low
+ (2 *
+ Z.log2_up
+ (let (x3, _) := xv0 in x3))
+ (let (x3, _) := xv in x3);
+ Some
+ (#(fancy_mulll
+ (2 *
+ Z.log2_up
+ (let (x4, _) := xv0 in x4)))%expr @
+ ((##x3)%expr,
+ v (Compile.reflect x2)))%expr_pat
+ else None);
+ Some (Base x3));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -183,31 +186,35 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(ℤ -> ℤ -> ℤ)%ptype
((projT1 args1) -> (projT1 args) -> s)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
v <- type.try_make_transport_cps s ℤ;
- x3 <- (if
- (let (x3, _) := idc_args0 in x3) =?
- 2
- ^ (2 *
- Z.log2_up (let (x3, _) := idc_args0 in x3) /
- 2) - 1
- then
- x3 <- invert_low
- (2 *
- Z.log2_up
- (let (x3, _) := idc_args0 in x3))
- (let (x3, _) := idc_args in x3);
- Some
- (#(fancy_mulll
- (2 *
- Z.log2_up
- (let (x4, _) := idc_args0 in x4)))%expr @
- ((##x3)%expr, v (Compile.reflect x1)))%expr_pat
- else None);
- Some (Base x3)
+ fv <- (x3 <- (if
+ (let (x3, _) := xv0 in x3) =?
+ 2
+ ^ (2 *
+ Z.log2_up
+ (let (x3, _) := xv0 in x3) / 2) -
+ 1
+ then
+ x3 <- invert_low
+ (2 *
+ Z.log2_up
+ (let (x3, _) := xv0 in x3))
+ (let (x3, _) := xv in x3);
+ Some
+ (#(fancy_mulll
+ (2 *
+ Z.log2_up
+ (let (x4, _) := xv0 in x4)))%expr @
+ ((##x3)%expr,
+ v (Compile.reflect x1)))%expr_pat
+ else None);
+ Some (Base x3));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end);;
@@ -225,31 +232,34 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(ℤ -> ℤ -> ℤ)%ptype
((projT1 args1) -> (projT1 args) -> s)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
v <- type.try_make_transport_cps s ℤ;
- x3 <- (if
- (let (x3, _) := idc_args0 in x3) =?
- 2
- ^ (2 *
- Z.log2_up (let (x3, _) := idc_args0 in x3) /
- 2) - 1
- then
- x3 <- invert_high
- (2 *
- Z.log2_up
- (let (x3, _) := idc_args0 in x3))
- (let (x3, _) := idc_args in x3);
- Some
- (#(fancy_mulhl
- (2 *
- Z.log2_up
- (let (x4, _) := idc_args0 in x4)))%expr @
- ((##x3)%expr, v (Compile.reflect x1)))%expr_pat
- else None);
- Some (Base x3)
+ fv <- (x3 <- (if
+ (let (x3, _) := xv0 in x3) =?
+ 2
+ ^ (2 *
+ Z.log2_up (let (x3, _) := xv0 in x3) /
+ 2) - 1
+ then
+ x3 <- invert_high
+ (2 *
+ Z.log2_up
+ (let (x3, _) := xv0 in x3))
+ (let (x3, _) := xv in x3);
+ Some
+ (#(fancy_mulhl
+ (2 *
+ Z.log2_up
+ (let (x4, _) := xv0 in x4)))%expr @
+ ((##x3)%expr,
+ v (Compile.reflect x1)))%expr_pat
+ else None);
+ Some (Base x3));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -271,31 +281,34 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(ℤ -> ℤ -> ℤ)%ptype
((projT1 args1) -> s0 -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
v <- type.try_make_transport_cps s0 ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x3 <- (if
- (let (x3, _) := idc_args0 in x3) =?
- 2
- ^ (2 *
- Z.log2_up (let (x3, _) := idc_args0 in x3) /
- 2) - 1
- then
- x3 <- invert_high
- (2 *
- Z.log2_up
- (let (x3, _) := idc_args0 in x3))
- (let (x3, _) := idc_args in x3);
- Some
- (#(fancy_mulhl
- (2 *
- Z.log2_up
- (let (x4, _) := idc_args0 in x4)))%expr @
- ((##x3)%expr, v (Compile.reflect x2)))%expr_pat
- else None);
- Some (Base x3)
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x3 <- (if
+ (let (x3, _) := xv0 in x3) =?
+ 2
+ ^ (2 *
+ Z.log2_up (let (x3, _) := xv0 in x3) /
+ 2) - 1
+ then
+ x3 <- invert_high
+ (2 *
+ Z.log2_up
+ (let (x3, _) := xv0 in x3))
+ (let (x3, _) := xv in x3);
+ Some
+ (#(fancy_mulhl
+ (2 *
+ Z.log2_up
+ (let (x4, _) := xv0 in x4)))%expr @
+ ((##x3)%expr,
+ v (Compile.reflect x2)))%expr_pat
+ else None);
+ Some (Base x3));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -317,19 +330,21 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(ℤ -> ℤ -> ℤ)%ptype
((projT1 args1) -> s0 -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
v <- type.try_make_transport_cps s0 ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x3 <- (x3 <- invert_low
- (2 * (let (x3, _) := idc_args0 in x3))
- (let (x3, _) := idc_args in x3);
- Some
- (#(fancy_mullh
- (2 * (let (x4, _) := idc_args0 in x4)))%expr @
- ((##x3)%expr, v (Compile.reflect x2)))%expr_pat);
- Some (Base x3)
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x3 <- (x3 <- invert_low
+ (2 * (let (x3, _) := xv0 in x3))
+ (let (x3, _) := xv in x3);
+ Some
+ (#(fancy_mullh
+ (2 * (let (x4, _) := xv0 in x4)))%expr @
+ ((##x3)%expr, v (Compile.reflect x2)))%expr_pat);
+ Some (Base x3));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end);;
@@ -347,19 +362,21 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(ℤ -> ℤ -> ℤ)%ptype
((projT1 args1) -> s0 -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
v <- type.try_make_transport_cps s0 ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x3 <- (x3 <- invert_high
- (2 * (let (x3, _) := idc_args0 in x3))
- (let (x3, _) := idc_args in x3);
- Some
- (#(fancy_mulhh
- (2 * (let (x4, _) := idc_args0 in x4)))%expr @
- ((##x3)%expr, v (Compile.reflect x2)))%expr_pat);
- Some (Base x3)
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x3 <- (x3 <- invert_high
+ (2 * (let (x3, _) := xv0 in x3))
+ (let (x3, _) := xv in x3);
+ Some
+ (#(fancy_mulhh
+ (2 * (let (x4, _) := xv0 in x4)))%expr @
+ ((##x3)%expr, v (Compile.reflect x2)))%expr_pat);
+ Some (Base x3));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -396,31 +413,33 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((ℤ -> ℤ) -> ℤ)%ptype
(((projT1 args0) -> s) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
v <- type.try_make_transport_cps s ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x3 <- (if
- (let (x3, _) := idc_args in x3) =?
- 2
- ^ (2 *
- Z.log2_up (let (x3, _) := idc_args in x3) /
- 2) - 1
- then
- y <- invert_low
- (2 *
- Z.log2_up
- (let (x3, _) := idc_args in x3))
- (let (x3, _) := idc_args0 in x3);
- Some
- (#(fancy_mulll
- (2 *
- Z.log2_up
- (let (x3, _) := idc_args in x3)))%expr @
- (v (Compile.reflect x1), (##y)%expr))%expr_pat
- else None);
- Some (Base x3)
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x3 <- (if
+ (let (x3, _) := xv in x3) =?
+ 2
+ ^ (2 *
+ Z.log2_up (let (x3, _) := xv in x3) /
+ 2) - 1
+ then
+ y <- invert_low
+ (2 *
+ Z.log2_up
+ (let (x3, _) := xv in x3))
+ (let (x3, _) := xv0 in x3);
+ Some
+ (#(fancy_mulll
+ (2 *
+ Z.log2_up
+ (let (x3, _) := xv in x3)))%expr @
+ (v (Compile.reflect x1), (##y)%expr))%expr_pat
+ else None);
+ Some (Base x3));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -447,30 +466,32 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((s0 -> (projT1 args0)) -> (projT1 args))%ptype
then
v <- type.try_make_transport_cps s0 ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x3 <- (if
- (let (x3, _) := idc_args in x3) =?
- 2
- ^ (2 *
- Z.log2_up (let (x3, _) := idc_args in x3) /
- 2) - 1
- then
- y <- invert_low
- (2 *
- Z.log2_up
- (let (x3, _) := idc_args in x3))
- (let (x3, _) := idc_args0 in x3);
- Some
- (#(fancy_mulll
- (2 *
- Z.log2_up
- (let (x3, _) := idc_args in x3)))%expr @
- (v (Compile.reflect x2), (##y)%expr))%expr_pat
- else None);
- Some (Base x3)
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x3 <- (if
+ (let (x3, _) := xv in x3) =?
+ 2
+ ^ (2 *
+ Z.log2_up (let (x3, _) := xv in x3) /
+ 2) - 1
+ then
+ y <- invert_low
+ (2 *
+ Z.log2_up
+ (let (x3, _) := xv in x3))
+ (let (x3, _) := xv0 in x3);
+ Some
+ (#(fancy_mulll
+ (2 *
+ Z.log2_up
+ (let (x3, _) := xv in x3)))%expr @
+ (v (Compile.reflect x2), (##y)%expr))%expr_pat
+ else None);
+ Some (Base x3));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -496,31 +517,33 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((ℤ -> ℤ) -> ℤ)%ptype
(((projT1 args0) -> s) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
v <- type.try_make_transport_cps s ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x3 <- (if
- (let (x3, _) := idc_args in x3) =?
- 2
- ^ (2 *
- Z.log2_up (let (x3, _) := idc_args in x3) /
- 2) - 1
- then
- y <- invert_high
- (2 *
- Z.log2_up
- (let (x3, _) := idc_args in x3))
- (let (x3, _) := idc_args0 in x3);
- Some
- (#(fancy_mullh
- (2 *
- Z.log2_up
- (let (x3, _) := idc_args in x3)))%expr @
- (v (Compile.reflect x1), (##y)%expr))%expr_pat
- else None);
- Some (Base x3)
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x3 <- (if
+ (let (x3, _) := xv in x3) =?
+ 2
+ ^ (2 *
+ Z.log2_up (let (x3, _) := xv in x3) /
+ 2) - 1
+ then
+ y <- invert_high
+ (2 *
+ Z.log2_up
+ (let (x3, _) := xv in x3))
+ (let (x3, _) := xv0 in x3);
+ Some
+ (#(fancy_mullh
+ (2 *
+ Z.log2_up
+ (let (x3, _) := xv in x3)))%expr @
+ (v (Compile.reflect x1), (##y)%expr))%expr_pat
+ else None);
+ Some (Base x3));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -547,30 +570,32 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((s0 -> (projT1 args0)) -> (projT1 args))%ptype
then
v <- type.try_make_transport_cps s0 ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x3 <- (if
- (let (x3, _) := idc_args in x3) =?
- 2
- ^ (2 *
- Z.log2_up (let (x3, _) := idc_args in x3) /
- 2) - 1
- then
- y <- invert_high
- (2 *
- Z.log2_up
- (let (x3, _) := idc_args in x3))
- (let (x3, _) := idc_args0 in x3);
- Some
- (#(fancy_mullh
- (2 *
- Z.log2_up
- (let (x3, _) := idc_args in x3)))%expr @
- (v (Compile.reflect x2), (##y)%expr))%expr_pat
- else None);
- Some (Base x3)
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x3 <- (if
+ (let (x3, _) := xv in x3) =?
+ 2
+ ^ (2 *
+ Z.log2_up (let (x3, _) := xv in x3) /
+ 2) - 1
+ then
+ y <- invert_high
+ (2 *
+ Z.log2_up
+ (let (x3, _) := xv in x3))
+ (let (x3, _) := xv0 in x3);
+ Some
+ (#(fancy_mullh
+ (2 *
+ Z.log2_up
+ (let (x3, _) := xv in x3)))%expr @
+ (v (Compile.reflect x2), (##y)%expr))%expr_pat
+ else None);
+ Some (Base x3));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -600,33 +625,35 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
(((projT1 args1) -> s) -> (projT1 args) -> s1)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
v <- type.try_make_transport_cps s ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
v0 <- type.try_make_transport_cps s1 ℤ;
- x5 <- (if
- ((let (x5, _) := idc_args in x5) =?
- 2
- ^ (2 *
- Z.log2_up (let (x5, _) := idc_args in x5) /
- 2) - 1) &&
- ((let (x5, _) := idc_args0 in x5) =?
- 2
- ^ (2 *
- Z.log2_up (let (x5, _) := idc_args in x5) /
- 2) - 1)
- then
- Some
- (#(fancy_mulll
- (2 *
- Z.log2_up
- (let (x5, _) := idc_args in x5)))%expr @
- (v (Compile.reflect x1),
- v0 (Compile.reflect x3)))%expr_pat
- else None);
- Some (Base x5)
+ fv <- (x5 <- (if
+ ((let (x5, _) := xv in x5) =?
+ 2
+ ^ (2 *
+ Z.log2_up (let (x5, _) := xv in x5) /
+ 2) - 1) &&
+ ((let (x5, _) := xv0 in x5) =?
+ 2
+ ^ (2 *
+ Z.log2_up (let (x5, _) := xv in x5) /
+ 2) - 1)
+ then
+ Some
+ (#(fancy_mulll
+ (2 *
+ Z.log2_up
+ (let (x5, _) := xv in x5)))%expr @
+ (v (Compile.reflect x1),
+ v0 (Compile.reflect x3)))%expr_pat
+ else None);
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -673,32 +700,34 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((s0 -> (projT1 args1)) -> (projT1 args) -> s1)%ptype
then
v <- type.try_make_transport_cps s0 ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
v0 <- type.try_make_transport_cps s1 ℤ;
- x5 <- (if
- ((let (x5, _) := idc_args in x5) =?
- 2
- ^ (2 *
- Z.log2_up (let (x5, _) := idc_args in x5) /
- 2) - 1) &&
- ((let (x5, _) := idc_args0 in x5) =?
- 2
- ^ (2 *
- Z.log2_up (let (x5, _) := idc_args in x5) /
- 2) - 1)
- then
- Some
- (#(fancy_mulll
- (2 *
- Z.log2_up
- (let (x5, _) := idc_args in x5)))%expr @
- (v (Compile.reflect x2),
- v0 (Compile.reflect x3)))%expr_pat
- else None);
- Some (Base x5)
+ fv <- (x5 <- (if
+ ((let (x5, _) := xv in x5) =?
+ 2
+ ^ (2 *
+ Z.log2_up (let (x5, _) := xv in x5) /
+ 2) - 1) &&
+ ((let (x5, _) := xv0 in x5) =?
+ 2
+ ^ (2 *
+ Z.log2_up (let (x5, _) := xv in x5) /
+ 2) - 1)
+ then
+ Some
+ (#(fancy_mulll
+ (2 *
+ Z.log2_up
+ (let (x5, _) := xv in x5)))%expr @
+ (v (Compile.reflect x2),
+ v0 (Compile.reflect x3)))%expr_pat
+ else None);
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -743,33 +772,35 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
(((projT1 args1) -> s) -> s2 -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
v <- type.try_make_transport_cps s ℤ;
v0 <- type.try_make_transport_cps s2 ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x5 <- (if
- ((let (x5, _) := idc_args in x5) =?
- 2
- ^ (2 *
- Z.log2_up (let (x5, _) := idc_args in x5) /
- 2) - 1) &&
- ((let (x5, _) := idc_args0 in x5) =?
- 2
- ^ (2 *
- Z.log2_up (let (x5, _) := idc_args in x5) /
- 2) - 1)
- then
- Some
- (#(fancy_mulll
- (2 *
- Z.log2_up
- (let (x5, _) := idc_args in x5)))%expr @
- (v (Compile.reflect x1),
- v0 (Compile.reflect x4)))%expr_pat
- else None);
- Some (Base x5)
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x5 <- (if
+ ((let (x5, _) := xv in x5) =?
+ 2
+ ^ (2 *
+ Z.log2_up (let (x5, _) := xv in x5) /
+ 2) - 1) &&
+ ((let (x5, _) := xv0 in x5) =?
+ 2
+ ^ (2 *
+ Z.log2_up (let (x5, _) := xv in x5) /
+ 2) - 1)
+ then
+ Some
+ (#(fancy_mulll
+ (2 *
+ Z.log2_up
+ (let (x5, _) := xv in x5)))%expr @
+ (v (Compile.reflect x1),
+ v0 (Compile.reflect x4)))%expr_pat
+ else None);
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -812,32 +843,34 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((s0 -> (projT1 args1)) -> s2 -> (projT1 args))%ptype
then
v <- type.try_make_transport_cps s0 ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
v0 <- type.try_make_transport_cps s2 ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x5 <- (if
- ((let (x5, _) := idc_args in x5) =?
- 2
- ^ (2 *
- Z.log2_up (let (x5, _) := idc_args in x5) /
- 2) - 1) &&
- ((let (x5, _) := idc_args0 in x5) =?
- 2
- ^ (2 *
- Z.log2_up (let (x5, _) := idc_args in x5) /
- 2) - 1)
- then
- Some
- (#(fancy_mulll
- (2 *
- Z.log2_up
- (let (x5, _) := idc_args in x5)))%expr @
- (v (Compile.reflect x2),
- v0 (Compile.reflect x4)))%expr_pat
- else None);
- Some (Base x5)
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x5 <- (if
+ ((let (x5, _) := xv in x5) =?
+ 2
+ ^ (2 *
+ Z.log2_up (let (x5, _) := xv in x5) /
+ 2) - 1) &&
+ ((let (x5, _) := xv0 in x5) =?
+ 2
+ ^ (2 *
+ Z.log2_up (let (x5, _) := xv in x5) /
+ 2) - 1)
+ then
+ Some
+ (#(fancy_mulll
+ (2 *
+ Z.log2_up
+ (let (x5, _) := xv in x5)))%expr @
+ (v (Compile.reflect x2),
+ v0 (Compile.reflect x4)))%expr_pat
+ else None);
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -879,24 +912,27 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
(((projT1 args1) -> s) -> s2 -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
v <- type.try_make_transport_cps s ℤ;
v0 <- type.try_make_transport_cps s2 ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x5 <- (if
- (let (x5, _) := idc_args in x5) =?
- 2 ^ (2 * (let (x5, _) := idc_args0 in x5) / 2) -
- 1
- then
- Some
- (#(fancy_mullh
- (2 * (let (x5, _) := idc_args0 in x5)))%expr @
- (v (Compile.reflect x1),
- v0 (Compile.reflect x4)))%expr_pat
- else None);
- Some (Base x5)
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x5 <- (if
+ (let (x5, _) := xv in x5) =?
+ 2
+ ^ (2 * (let (x5, _) := xv0 in x5) / 2) -
+ 1
+ then
+ Some
+ (#(fancy_mullh
+ (2 * (let (x5, _) := xv0 in x5)))%expr @
+ (v (Compile.reflect x1),
+ v0 (Compile.reflect x4)))%expr_pat
+ else None);
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -939,23 +975,26 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((s0 -> (projT1 args1)) -> s2 -> (projT1 args))%ptype
then
v <- type.try_make_transport_cps s0 ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
v0 <- type.try_make_transport_cps s2 ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x5 <- (if
- (let (x5, _) := idc_args in x5) =?
- 2 ^ (2 * (let (x5, _) := idc_args0 in x5) / 2) -
- 1
- then
- Some
- (#(fancy_mullh
- (2 * (let (x5, _) := idc_args0 in x5)))%expr @
- (v (Compile.reflect x2),
- v0 (Compile.reflect x4)))%expr_pat
- else None);
- Some (Base x5)
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x5 <- (if
+ (let (x5, _) := xv in x5) =?
+ 2
+ ^ (2 * (let (x5, _) := xv0 in x5) / 2) -
+ 1
+ then
+ Some
+ (#(fancy_mullh
+ (2 * (let (x5, _) := xv0 in x5)))%expr @
+ (v (Compile.reflect x2),
+ v0 (Compile.reflect x4)))%expr_pat
+ else None);
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -995,18 +1034,20 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((s0 -> (projT1 args0)) -> (projT1 args))%ptype
then
v <- type.try_make_transport_cps s0 ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x3 <- (y <- invert_low
- (2 * (let (x3, _) := idc_args in x3))
- (let (x3, _) := idc_args0 in x3);
- Some
- (#(fancy_mulhl
- (2 * (let (x3, _) := idc_args in x3)))%expr @
- (v (Compile.reflect x2), (##y)%expr))%expr_pat);
- Some (Base x3)
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x3 <- (y <- invert_low
+ (2 * (let (x3, _) := xv in x3))
+ (let (x3, _) := xv0 in x3);
+ Some
+ (#(fancy_mulhl
+ (2 * (let (x3, _) := xv in x3)))%expr @
+ (v (Compile.reflect x2), (##y)%expr))%expr_pat);
+ Some (Base x3));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end);;
@@ -1025,18 +1066,20 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((s0 -> (projT1 args0)) -> (projT1 args))%ptype
then
v <- type.try_make_transport_cps s0 ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x3 <- (y <- invert_high
- (2 * (let (x3, _) := idc_args in x3))
- (let (x3, _) := idc_args0 in x3);
- Some
- (#(fancy_mulhh
- (2 * (let (x3, _) := idc_args in x3)))%expr @
- (v (Compile.reflect x2), (##y)%expr))%expr_pat);
- Some (Base x3)
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x3 <- (y <- invert_high
+ (2 * (let (x3, _) := xv in x3))
+ (let (x3, _) := xv0 in x3);
+ Some
+ (#(fancy_mulhh
+ (2 * (let (x3, _) := xv in x3)))%expr @
+ (v (Compile.reflect x2), (##y)%expr))%expr_pat);
+ Some (Base x3));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1061,25 +1104,27 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((s0 -> (projT1 args1)) -> (projT1 args) -> s1)%ptype
then
v <- type.try_make_transport_cps s0 ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
v0 <- type.try_make_transport_cps s1 ℤ;
- x5 <- (if
- (let (x5, _) := idc_args0 in x5) =?
- 2
- ^ (2 * (let (x5, _) := idc_args in x5) / 2) -
- 1
- then
- Some
- (#(fancy_mulhl
- (2 *
- (let (x5, _) := idc_args in x5)))%expr @
- (v (Compile.reflect x2),
- v0 (Compile.reflect x3)))%expr_pat
- else None);
- Some (Base x5)
+ fv <- (x5 <- (if
+ (let (x5, _) := xv0 in x5) =?
+ 2
+ ^ (2 * (let (x5, _) := xv in x5) /
+ 2) - 1
+ then
+ Some
+ (#(fancy_mulhl
+ (2 *
+ (let (x5, _) := xv in x5)))%expr @
+ (v (Compile.reflect x2),
+ v0 (Compile.reflect x3)))%expr_pat
+ else None);
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1104,25 +1149,27 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((s0 -> (projT1 args1)) -> s2 -> (projT1 args))%ptype
then
v <- type.try_make_transport_cps s0 ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
v0 <- type.try_make_transport_cps s2 ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x5 <- (if
- (let (x5, _) := idc_args0 in x5) =?
- 2
- ^ (2 * (let (x5, _) := idc_args in x5) / 2) -
- 1
- then
- Some
- (#(fancy_mulhl
- (2 *
- (let (x5, _) := idc_args in x5)))%expr @
- (v (Compile.reflect x2),
- v0 (Compile.reflect x4)))%expr_pat
- else None);
- Some (Base x5)
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x5 <- (if
+ (let (x5, _) := xv0 in x5) =?
+ 2
+ ^ (2 * (let (x5, _) := xv in x5) /
+ 2) - 1
+ then
+ Some
+ (#(fancy_mulhl
+ (2 *
+ (let (x5, _) := xv in x5)))%expr @
+ (v (Compile.reflect x2),
+ v0 (Compile.reflect x4)))%expr_pat
+ else None);
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1147,22 +1194,25 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((s0 -> (projT1 args1)) -> s2 -> (projT1 args))%ptype
then
v <- type.try_make_transport_cps s0 ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
v0 <- type.try_make_transport_cps s2 ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x5 <- (if
- (let (x5, _) := idc_args in x5) =?
- (let (x5, _) := idc_args0 in x5)
- then
- Some
- (#(fancy_mulhh
- (2 * (let (x5, _) := idc_args in x5)))%expr @
- (v (Compile.reflect x2),
- v0 (Compile.reflect x4)))%expr_pat
- else None);
- Some (Base x5)
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x5 <- (if
+ (let (x5, _) := xv in x5) =?
+ (let (x5, _) := xv0 in x5)
+ then
+ Some
+ (#(fancy_mulhh
+ (2 *
+ (let (x5, _) := xv in x5)))%expr @
+ (v (Compile.reflect x2),
+ v0 (Compile.reflect x4)))%expr_pat
+ else None);
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1233,22 +1283,22 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
(((projT1 args1) -> ℤ) -> s0 -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args1);
v <- type.try_make_transport_cps s0 ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x4 <- (if
- (let (x4, _) := idc_args in x4) =?
- 2 ^ Z.log2 (let (x4, _) := idc_args in x4)
- then
- Some
- (#(fancy_add
- (Z.log2 (let (x4, _) := idc_args in x4))
- (let (x4, _) := idc_args0 in x4))%expr @
- (x0, v (Compile.reflect x3)))%expr_pat
- else None);
- Some (Base x4)
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x4 <- (if
+ (let (x4, _) := xv in x4) =?
+ 2 ^ Z.log2 (let (x4, _) := xv in x4)
+ then
+ Some
+ (#(fancy_add
+ (Z.log2 (let (x4, _) := xv in x4))
+ (let (x4, _) := xv0 in x4))%expr @
+ (x0, v (Compile.reflect x3)))%expr_pat
+ else None);
+ Some (Base x4));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1282,22 +1332,22 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((ℤ -> ℤ -> ℤ) -> ℤ)%ptype
(((projT1 args1) -> s0 -> (projT1 args)) -> ℤ)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args1);
v <- type.try_make_transport_cps s0 ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x4 <- (if
- (let (x4, _) := idc_args in x4) =?
- 2 ^ Z.log2 (let (x4, _) := idc_args in x4)
- then
- Some
- (#(fancy_add
- (Z.log2 (let (x4, _) := idc_args in x4))
- (let (x4, _) := idc_args0 in x4))%expr @
- (x1, v (Compile.reflect x3)))%expr_pat
- else None);
- Some (Base x4)
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x4 <- (if
+ (let (x4, _) := xv in x4) =?
+ 2 ^ Z.log2 (let (x4, _) := xv in x4)
+ then
+ Some
+ (#(fancy_add
+ (Z.log2 (let (x4, _) := xv in x4))
+ (let (x4, _) := xv0 in x4))%expr @
+ (x1, v (Compile.reflect x3)))%expr_pat
+ else None);
+ Some (Base x4));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1331,22 +1381,22 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
(((projT1 args1) -> ℤ) -> s0 -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args1);
v <- type.try_make_transport_cps s0 ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x4 <- (if
- (let (x4, _) := idc_args in x4) =?
- 2 ^ Z.log2 (let (x4, _) := idc_args in x4)
- then
- Some
- (#(fancy_add
- (Z.log2 (let (x4, _) := idc_args in x4))
- (- (let (x4, _) := idc_args0 in x4)))%expr @
- (x0, v (Compile.reflect x3)))%expr_pat
- else None);
- Some (Base x4)
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x4 <- (if
+ (let (x4, _) := xv in x4) =?
+ 2 ^ Z.log2 (let (x4, _) := xv in x4)
+ then
+ Some
+ (#(fancy_add
+ (Z.log2 (let (x4, _) := xv in x4))
+ (- (let (x4, _) := xv0 in x4)))%expr @
+ (x0, v (Compile.reflect x3)))%expr_pat
+ else None);
+ Some (Base x4));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1380,22 +1430,22 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((ℤ -> ℤ -> ℤ) -> ℤ)%ptype
(((projT1 args1) -> s0 -> (projT1 args)) -> ℤ)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args1);
v <- type.try_make_transport_cps s0 ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x4 <- (if
- (let (x4, _) := idc_args in x4) =?
- 2 ^ Z.log2 (let (x4, _) := idc_args in x4)
- then
- Some
- (#(fancy_add
- (Z.log2 (let (x4, _) := idc_args in x4))
- (- (let (x4, _) := idc_args0 in x4)))%expr @
- (x1, v (Compile.reflect x3)))%expr_pat
- else None);
- Some (Base x4)
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x4 <- (if
+ (let (x4, _) := xv in x4) =?
+ 2 ^ Z.log2 (let (x4, _) := xv in x4)
+ then
+ Some
+ (#(fancy_add
+ (Z.log2 (let (x4, _) := xv in x4))
+ (- (let (x4, _) := xv0 in x4)))%expr @
+ (x1, v (Compile.reflect x3)))%expr_pat
+ else None);
+ Some (Base x4));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1423,17 +1473,19 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq
((ℤ -> ℤ) -> ℤ)%ptype (((projT1 args) -> ℤ) -> ℤ)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x2 <- (if
- (let (x2, _) := idc_args in x2) =?
- 2 ^ Z.log2 (let (x2, _) := idc_args in x2)
- then
- Some
- (#(fancy_add
- (Z.log2 (let (x2, _) := idc_args in x2)) 0)%expr @
- (x0, x1))%expr_pat
- else None);
- Some (Base x2)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x2 <- (if
+ (let (x2, _) := xv in x2) =?
+ 2 ^ Z.log2 (let (x2, _) := xv in x2)
+ then
+ Some
+ (#(fancy_add
+ (Z.log2 (let (x2, _) := xv in x2)) 0)%expr @
+ (x0, x1))%expr_pat
+ else None);
+ Some (Base x2));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1466,22 +1518,22 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
((((projT1 args1) -> ℤ) -> ℤ) -> s0 -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args1);
v <- type.try_make_transport_cps s0 ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x5 <- (if
- (let (x5, _) := idc_args in x5) =?
- 2 ^ Z.log2 (let (x5, _) := idc_args in x5)
- then
- Some
- (#(fancy_addc
- (Z.log2 (let (x5, _) := idc_args in x5))
- (let (x5, _) := idc_args0 in x5))%expr @
- (x0, x1, v (Compile.reflect x4)))%expr_pat
- else None);
- Some (Base x5)
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x5 <- (if
+ (let (x5, _) := xv in x5) =?
+ 2 ^ Z.log2 (let (x5, _) := xv in x5)
+ then
+ Some
+ (#(fancy_addc
+ (Z.log2 (let (x5, _) := xv in x5))
+ (let (x5, _) := xv0 in x5))%expr @
+ (x0, x1, v (Compile.reflect x4)))%expr_pat
+ else None);
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1516,22 +1568,22 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(((ℤ -> ℤ) -> ℤ -> ℤ) -> ℤ)%ptype
((((projT1 args1) -> ℤ) -> s0 -> (projT1 args)) -> ℤ)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args1);
v <- type.try_make_transport_cps s0 ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x5 <- (if
- (let (x5, _) := idc_args in x5) =?
- 2 ^ Z.log2 (let (x5, _) := idc_args in x5)
- then
- Some
- (#(fancy_addc
- (Z.log2 (let (x5, _) := idc_args in x5))
- (let (x5, _) := idc_args0 in x5))%expr @
- (x0, x2, v (Compile.reflect x4)))%expr_pat
- else None);
- Some (Base x5)
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x5 <- (if
+ (let (x5, _) := xv in x5) =?
+ 2 ^ Z.log2 (let (x5, _) := xv in x5)
+ then
+ Some
+ (#(fancy_addc
+ (Z.log2 (let (x5, _) := xv in x5))
+ (let (x5, _) := xv0 in x5))%expr @
+ (x0, x2, v (Compile.reflect x4)))%expr_pat
+ else None);
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1566,22 +1618,22 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
((((projT1 args1) -> ℤ) -> ℤ) -> s0 -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args1);
v <- type.try_make_transport_cps s0 ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x5 <- (if
- (let (x5, _) := idc_args in x5) =?
- 2 ^ Z.log2 (let (x5, _) := idc_args in x5)
- then
- Some
- (#(fancy_addc
- (Z.log2 (let (x5, _) := idc_args in x5))
- (- (let (x5, _) := idc_args0 in x5)))%expr @
- (x0, x1, v (Compile.reflect x4)))%expr_pat
- else None);
- Some (Base x5)
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x5 <- (if
+ (let (x5, _) := xv in x5) =?
+ 2 ^ Z.log2 (let (x5, _) := xv in x5)
+ then
+ Some
+ (#(fancy_addc
+ (Z.log2 (let (x5, _) := xv in x5))
+ (- (let (x5, _) := xv0 in x5)))%expr @
+ (x0, x1, v (Compile.reflect x4)))%expr_pat
+ else None);
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1616,22 +1668,22 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(((ℤ -> ℤ) -> ℤ -> ℤ) -> ℤ)%ptype
((((projT1 args1) -> ℤ) -> s0 -> (projT1 args)) -> ℤ)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args1);
v <- type.try_make_transport_cps s0 ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x5 <- (if
- (let (x5, _) := idc_args in x5) =?
- 2 ^ Z.log2 (let (x5, _) := idc_args in x5)
- then
- Some
- (#(fancy_addc
- (Z.log2 (let (x5, _) := idc_args in x5))
- (- (let (x5, _) := idc_args0 in x5)))%expr @
- (x0, x2, v (Compile.reflect x4)))%expr_pat
- else None);
- Some (Base x5)
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x5 <- (if
+ (let (x5, _) := xv in x5) =?
+ 2 ^ Z.log2 (let (x5, _) := xv in x5)
+ then
+ Some
+ (#(fancy_addc
+ (Z.log2 (let (x5, _) := xv in x5))
+ (- (let (x5, _) := xv0 in x5)))%expr @
+ (x0, x2, v (Compile.reflect x4)))%expr_pat
+ else None);
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1660,17 +1712,19 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
((((projT1 args) -> ℤ) -> ℤ) -> ℤ)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x3 <- (if
- (let (x3, _) := idc_args in x3) =?
- 2 ^ Z.log2 (let (x3, _) := idc_args in x3)
- then
- Some
- (#(fancy_addc
- (Z.log2 (let (x3, _) := idc_args in x3)) 0)%expr @
- (x0, x1, x2))%expr_pat
- else None);
- Some (Base x3)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x3 <- (if
+ (let (x3, _) := xv in x3) =?
+ 2 ^ Z.log2 (let (x3, _) := xv in x3)
+ then
+ Some
+ (#(fancy_addc
+ (Z.log2 (let (x3, _) := xv in x3)) 0)%expr @
+ (x0, x1, x2))%expr_pat
+ else None);
+ Some (Base x3));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1701,22 +1755,25 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
(((projT1 args1) -> ℤ) -> s0 -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
v <- type.try_make_transport_cps s0 ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x4 <- (if
- (let (x4, _) := idc_args in x4) =?
- 2 ^ Z.log2 (let (x4, _) := idc_args in x4)
- then
- Some
- (#(fancy_sub
- (Z.log2 (let (x4, _) := idc_args in x4))
- (let (x4, _) := idc_args0 in x4))%expr @
- (x0, v (Compile.reflect x3)))%expr_pat
- else None);
- Some (Base x4)
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x4 <- (if
+ (let (x4, _) := xv in x4) =?
+ 2 ^ Z.log2 (let (x4, _) := xv in x4)
+ then
+ Some
+ (#(fancy_sub
+ (Z.log2
+ (let (x4, _) := xv in x4))
+ (let (x4, _) := xv0 in x4))%expr @
+ (x0, v (Compile.reflect x3)))%expr_pat
+ else None);
+ Some (Base x4));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1739,22 +1796,25 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
(((projT1 args1) -> ℤ) -> s0 -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
v <- type.try_make_transport_cps s0 ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x4 <- (if
- (let (x4, _) := idc_args in x4) =?
- 2 ^ Z.log2 (let (x4, _) := idc_args in x4)
- then
- Some
- (#(fancy_sub
- (Z.log2 (let (x4, _) := idc_args in x4))
- (- (let (x4, _) := idc_args0 in x4)))%expr @
- (x0, v (Compile.reflect x3)))%expr_pat
- else None);
- Some (Base x4)
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x4 <- (if
+ (let (x4, _) := xv in x4) =?
+ 2 ^ Z.log2 (let (x4, _) := xv in x4)
+ then
+ Some
+ (#(fancy_sub
+ (Z.log2
+ (let (x4, _) := xv in x4))
+ (- (let (x4, _) := xv0 in x4)))%expr @
+ (x0, v (Compile.reflect x3)))%expr_pat
+ else None);
+ Some (Base x4));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1778,17 +1838,19 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq
((ℤ -> ℤ) -> ℤ)%ptype (((projT1 args) -> ℤ) -> ℤ)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x2 <- (if
- (let (x2, _) := idc_args in x2) =?
- 2 ^ Z.log2 (let (x2, _) := idc_args in x2)
- then
- Some
- (#(fancy_sub
- (Z.log2 (let (x2, _) := idc_args in x2)) 0)%expr @
- (x0, x1))%expr_pat
- else None);
- Some (Base x2)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x2 <- (if
+ (let (x2, _) := xv in x2) =?
+ 2 ^ Z.log2 (let (x2, _) := xv in x2)
+ then
+ Some
+ (#(fancy_sub
+ (Z.log2 (let (x2, _) := xv in x2)) 0)%expr @
+ (x0, x1))%expr_pat
+ else None);
+ Some (Base x2));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1819,22 +1881,25 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
((((projT1 args1) -> ℤ) -> ℤ) -> s0 -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
v <- type.try_make_transport_cps s0 ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x5 <- (if
- (let (x5, _) := idc_args in x5) =?
- 2 ^ Z.log2 (let (x5, _) := idc_args in x5)
- then
- Some
- (#(fancy_subb
- (Z.log2 (let (x5, _) := idc_args in x5))
- (let (x5, _) := idc_args0 in x5))%expr @
- (x0, x1, v (Compile.reflect x4)))%expr_pat
- else None);
- Some (Base x5)
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x5 <- (if
+ (let (x5, _) := xv in x5) =?
+ 2 ^ Z.log2 (let (x5, _) := xv in x5)
+ then
+ Some
+ (#(fancy_subb
+ (Z.log2
+ (let (x5, _) := xv in x5))
+ (let (x5, _) := xv0 in x5))%expr @
+ (x0, x1, v (Compile.reflect x4)))%expr_pat
+ else None);
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1857,22 +1922,25 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
((((projT1 args1) -> ℤ) -> ℤ) -> s0 -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
v <- type.try_make_transport_cps s0 ℤ;
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x5 <- (if
- (let (x5, _) := idc_args in x5) =?
- 2 ^ Z.log2 (let (x5, _) := idc_args in x5)
- then
- Some
- (#(fancy_subb
- (Z.log2 (let (x5, _) := idc_args in x5))
- (- (let (x5, _) := idc_args0 in x5)))%expr @
- (x0, x1, v (Compile.reflect x4)))%expr_pat
- else None);
- Some (Base x5)
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x5 <- (if
+ (let (x5, _) := xv in x5) =?
+ 2 ^ Z.log2 (let (x5, _) := xv in x5)
+ then
+ Some
+ (#(fancy_subb
+ (Z.log2
+ (let (x5, _) := xv in x5))
+ (- (let (x5, _) := xv0 in x5)))%expr @
+ (x0, x1, v (Compile.reflect x4)))%expr_pat
+ else None);
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1897,17 +1965,19 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
((((projT1 args) -> ℤ) -> ℤ) -> ℤ)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- x3 <- (if
- (let (x3, _) := idc_args in x3) =?
- 2 ^ Z.log2 (let (x3, _) := idc_args in x3)
- then
- Some
- (#(fancy_subb
- (Z.log2 (let (x3, _) := idc_args in x3)) 0)%expr @
- (x0, x1, x2))%expr_pat
- else None);
- Some (Base x3)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x3 <- (if
+ (let (x3, _) := xv in x3) =?
+ 2 ^ Z.log2 (let (x3, _) := xv in x3)
+ then
+ Some
+ (#(fancy_subb
+ (Z.log2 (let (x3, _) := xv in x3)) 0)%expr @
+ (x0, x1, x2))%expr_pat
+ else None);
+ Some (Base x3));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1936,19 +2006,20 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
((((projT1 args) -> s) -> ℤ) -> ℤ)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
v <- type.try_make_transport_cps s ℤ;
- x4 <- (if
- (let (x4, _) := idc_args in x4) =?
- 2 ^ Z.log2 (let (x4, _) := idc_args in x4)
- then
- Some
- (#(fancy_selm
- (Z.log2 (let (x4, _) := idc_args in x4)))%expr @
- (v (Compile.reflect x2), x0, x1))%expr_pat
- else None);
- Some (Base x4)
+ fv <- (x4 <- (if
+ (let (x4, _) := xv in x4) =?
+ 2 ^ Z.log2 (let (x4, _) := xv in x4)
+ then
+ Some
+ (#(fancy_selm
+ (Z.log2 (let (x4, _) := xv in x4)))%expr @
+ (v (Compile.reflect x2), x0, x1))%expr_pat
+ else None);
+ Some (Base x4));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -1970,16 +2041,17 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
((((projT1 args) -> s) -> ℤ) -> ℤ)%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
v <- type.try_make_transport_cps s ℤ;
- x4 <- (if (let (x4, _) := idc_args in x4) =? 1
- then
- Some
- (#(fancy_sell)%expr @
- (v (Compile.reflect x2), x0, x1))%expr_pat
- else None);
- Some (Base x4)
+ fv <- (x4 <- (if (let (x4, _) := xv in x4) =? 1
+ then
+ Some
+ (#(fancy_sell)%expr @
+ (v (Compile.reflect x2), x0, x1))%expr_pat
+ else None);
+ Some (Base x4));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -2002,15 +2074,16 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(((s0 -> (projT1 args)) -> ℤ) -> ℤ)%ptype
then
v <- type.try_make_transport_cps s0 ℤ;
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x4 <- (if (let (x4, _) := idc_args in x4) =? 1
- then
- Some
- (#(fancy_sell)%expr @
- (v (Compile.reflect x3), x0, x1))%expr_pat
- else None);
- Some (Base x4)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x4 <- (if (let (x4, _) := xv in x4) =? 1
+ then
+ Some
+ (#(fancy_sell)%expr @
+ (v (Compile.reflect x3), x0, x1))%expr_pat
+ else None);
+ Some (Base x4));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
@@ -2074,21 +2147,21 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
((((projT1 args0) -> ℤ) -> ℤ) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- x3 <- (if
- (let (x3, _) := idc_args in x3) =?
- 2 ^ Z.log2 (let (x3, _) := idc_args in x3)
- then
- Some
- (#(fancy_rshi
- (Z.log2 (let (x3, _) := idc_args in x3))
- (let (x3, _) := idc_args0 in x3))%expr @
- (x0, x1))%expr_pat
- else None);
- Some (Base x3)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x3 <- (if
+ (let (x3, _) := xv in x3) =?
+ 2 ^ Z.log2 (let (x3, _) := xv in x3)
+ then
+ Some
+ (#(fancy_rshi
+ (Z.log2 (let (x3, _) := xv in x3))
+ (let (x3, _) := xv0 in x3))%expr @
+ (x0, x1))%expr_pat
+ else None);
+ Some (Base x3));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
else None
| None => None
end
diff --git a/src/Experiments/NewPipeline/nbe_rewrite_head.out b/src/Experiments/NewPipeline/nbe_rewrite_head.out
index 2eb887afe..cbd282f50 100644
--- a/src/Experiments/NewPipeline/nbe_rewrite_head.out
+++ b/src/Experiments/NewPipeline/nbe_rewrite_head.out
@@ -13,9 +13,8 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
| Some _ =>
if type.type_beq base.type base.type.type_beq ℕ (projT1 args)
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- Some
- (Base (##(Nat.succ (let (x0, _) := idc_args in x0)))%expr)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ Some (Base (##(Nat.succ (let (x0, _) := xv in x0)))%expr)
else None
| None => None
end
@@ -35,9 +34,8 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
| Some _ =>
if type.type_beq base.type base.type.type_beq ℕ (projT1 args)
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- Some
- (Base (##(Nat.pred (let (x0, _) := idc_args in x0)))%expr)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ Some (Base (##(Nat.pred (let (x0, _) := xv in x0)))%expr)
else None
| None => None
end
@@ -63,14 +61,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℕ -> ℕ)%ptype
((projT1 args0) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
Some
(Base
- (##(Nat.max (let (x1, _) := idc_args in x1)
- (let (x1, _) := idc_args0 in x1)))%expr)
+ (##(Nat.max (let (x1, _) := xv in x1)
+ (let (x1, _) := xv0 in x1)))%expr)
else None
| None => None
end
@@ -98,14 +94,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℕ -> ℕ)%ptype
((projT1 args0) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
Some
(Base
- (##((let (x1, _) := idc_args in x1) *
- (let (x1, _) := idc_args0 in x1))%nat)%expr)
+ (##((let (x1, _) := xv in x1) *
+ (let (x1, _) := xv0 in x1))%nat)%expr)
else None
| None => None
end
@@ -133,14 +127,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℕ -> ℕ)%ptype
((projT1 args0) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
Some
(Base
- (##((let (x1, _) := idc_args in x1) +
- (let (x1, _) := idc_args0 in x1))%nat)%expr)
+ (##((let (x1, _) := xv in x1) +
+ (let (x1, _) := xv0 in x1))%nat)%expr)
else None
| None => None
end
@@ -168,14 +160,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℕ -> ℕ)%ptype
((projT1 args0) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
Some
(Base
- (##((let (x1, _) := idc_args in x1) -
- (let (x1, _) := idc_args0 in x1))%nat)%expr)
+ (##((let (x1, _) := xv in x1) -
+ (let (x1, _) := xv0 in x1))%nat)%expr)
else None
| None => None
end
@@ -220,10 +210,11 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
_ <- ident.unify pattern.ident.pair pair;
v <- type.try_make_transport_cps s0 b3;
_ <- type.try_make_transport_cps s b2;
- v1 <- base.try_make_transport_cps b3 A;
- v2 <- base.try_make_transport_cps A A;
- v3 <- base.try_make_transport_cps A A;
- Some (Base (v3 (v2 (v1 (v (Compile.reflect x1))))))
+ v1 <- base.try_make_transport_cps b3 b3;
+ _ <- base.try_make_transport_cps b2 b2;
+ v3 <- base.try_make_transport_cps b3 A;
+ v4 <- base.try_make_transport_cps A A;
+ Some (Base (v4 (v3 (v1 (v (Compile.reflect x1))))))
else None
| None => None
end
@@ -271,10 +262,11 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
_ <- ident.unify pattern.ident.pair pair;
_ <- type.try_make_transport_cps s0 b3;
v0 <- type.try_make_transport_cps s b2;
- v1 <- base.try_make_transport_cps b2 B;
- v2 <- base.try_make_transport_cps B B;
- v3 <- base.try_make_transport_cps B B;
- Some (Base (v3 (v2 (v1 (v0 (Compile.reflect x0))))))
+ _ <- base.try_make_transport_cps b3 b3;
+ v2 <- base.try_make_transport_cps b2 b2;
+ v3 <- base.try_make_transport_cps b2 B;
+ v4 <- base.try_make_transport_cps B B;
+ Some (Base (v4 (v3 (v2 (v0 (Compile.reflect x0))))))
else None
| None => None
end
@@ -324,71 +316,24 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
s0) -> s)%ptype
then
_ <- ident.unify pattern.ident.prod_rect prod_rect;
- base.try_make_transport_cps A b9
- (fun a13 : option =>
- (fa <- (fun (T0 : Type) (k : option -> T0) =>
- match a13 with
- | Some x' =>
- base.try_make_transport_cps B b8
- (fun a14 : option =>
- fa <- (fun (T1 : Type) (k0 : option -> T1)
- =>
- match a14 with
- | Some x'0 =>
- base.try_make_transport_cps T b7
- (fun a15 : option =>
- fa <- (fun (T2 : Type)
- (k1 : option -> T2)
- =>
- match a15 with
- | Some x'1 =>
- (return Some
- (fun
- v :
- expr b9 ->
- expr B ->
- UnderLets
- (expr T)
- =>
- x'1
- (x'0 v)))
- T2 k1
- | None => k1 None
- end);
- k0 fa)
- | None => k0 None
- end);
- fa0 <- (fun (T1 : Type) (k0 : option -> T1)
- =>
- match fa with
- | Some x'0 =>
- (return Some
- (fun
- v : expr A ->
- expr B ->
- UnderLets
- (expr T) =>
- x'0 (x' v))) T1 k0
- | None => k0 None
- end);
- k fa0)
- | None => k None
- end);
- match fa with
- | Some v =>
- (_ <- ident.unify pattern.ident.pair pair;
- v0 <- type.try_make_transport_cps s0 b9;
- v1 <- type.try_make_transport_cps s b8;
- v2 <- base.try_make_transport_cps b7 T;
- v3 <- base.try_make_transport_cps T T;
- v4 <- base.try_make_transport_cps T T;
- Some
- (fv <-- v2
- (v x (v0 (Compile.reflect x2))
- (v1 (Compile.reflect x1)));
- Base (v4 (v3 fv)))%under_lets)%option
- | None => None
- end)%cps)
+ x' <- base.try_make_transport_cps A b9;
+ x'0 <- base.try_make_transport_cps B b8;
+ x'1 <- base.try_make_transport_cps T b7;
+ _ <- ident.unify pattern.ident.pair pair;
+ v <- type.try_make_transport_cps s0 b9;
+ v0 <- type.try_make_transport_cps s b8;
+ x'2 <- base.try_make_transport_cps b9 b9;
+ x'3 <- base.try_make_transport_cps b8 b8;
+ x'4 <- base.try_make_transport_cps b7 b7;
+ v1 <- base.try_make_transport_cps b9 b9;
+ v2 <- base.try_make_transport_cps b8 b8;
+ v3 <- base.try_make_transport_cps b7 T;
+ v4 <- base.try_make_transport_cps T T;
+ Some
+ (fv1 <-- x'4 (x'3 (x'2 (x'1 (x'0 (x' x)))))
+ (v1 (v (Compile.reflect x2)))
+ (v2 (v0 (Compile.reflect x1)));
+ Base (v4 (v3 fv1)))%under_lets
else None
| None => None
end
@@ -430,49 +375,18 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
unit -> T) -> (projT1 args))%ptype
then
_ <- ident.unify pattern.ident.bool_rect bool_rect;
- base.try_make_transport_cps T b8
- (fun a9 : option =>
- (fa <- (fun (T0 : Type) (k : option -> T0) =>
- match a9 with
- | Some x' =>
- (return Some
- (fun
- v : expr unit ->
- UnderLets (expr T) =>
- x' v)) T0 k
- | None => k None
- end);
- match fa with
- | Some v =>
- base.try_make_transport_cps T b8
- (fun a10 : option =>
- fa0 <- (fun (T0 : Type) (k : option -> T0) =>
- match a10 with
- | Some x' =>
- (return Some
- (fun
- v0 : expr unit ->
- UnderLets (expr T) =>
- x' v0)) T0 k
- | None => k None
- end);
- match fa0 with
- | Some v0 =>
- (idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- v1 <- base.try_make_transport_cps b8 T;
- v2 <- base.try_make_transport_cps T T;
- v3 <- base.try_make_transport_cps T T;
- Some
- (fv <-- v1
- (if let (x2, _) := idc_args0 in x2
- then v x (##tt)%expr
- else v0 x0 (##tt)%expr);
- Base (v3 (v2 fv)))%under_lets)%option
- | None => None
- end)
- | None => None
- end)%cps)
+ x' <- base.try_make_transport_cps T b8;
+ x'0 <- base.try_make_transport_cps T b8;
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ x'1 <- base.try_make_transport_cps b8 b8;
+ x'2 <- base.try_make_transport_cps b8 b8;
+ v <- base.try_make_transport_cps b8 T;
+ v0 <- base.try_make_transport_cps T T;
+ Some
+ (fv0 <-- (if let (x2, _) := xv in x2
+ then x'1 (x' x) (##tt)%expr
+ else x'2 (x'0 x0) (##tt)%expr);
+ Base (v0 (v fv0)))%under_lets
else None
| None => None
end
@@ -510,98 +424,24 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
ℕ -> P -> P) -> (projT1 args))%ptype
then
_ <- ident.unify pattern.ident.nat_rect nat_rect;
- base.try_make_transport_cps P b10
- (fun a11 : option =>
- (fa <- (fun (T : Type) (k : option -> T) =>
- match a11 with
- | Some x' =>
- (return Some
- (fun
- v : expr unit ->
- UnderLets (expr P) =>
- x' v)) T k
- | None => k None
- end);
- match fa with
- | Some v =>
- base.try_make_transport_cps P b10
- (fun a12 : option =>
- fa0 <- (fun (T : Type) (k : option -> T) =>
- match a12 with
- | Some x' =>
- base.try_make_transport_cps P b10
- (fun a13 : option =>
- fa0 <- (fun (T0 : Type)
- (k0 : option -> T0) =>
- match a13 with
- | Some x'0 =>
- (return Some
- (fun
- v0 :
- expr ℕ ->
- expr P ->
- UnderLets
- (expr P)
- =>
- x'0 (x' v0)))
- T0 k0
- | None => k0 None
- end);
- k fa0)
- | None => k None
- end);
- fa1 <- (fun (T : Type) (k : option -> T) =>
- match fa0 with
- | Some x' =>
- (return Some
- (fun
- v0 : expr ℕ ->
- expr P ->
- UnderLets (expr P) =>
- x' v0)) T k
- | None => k None
- end);
- match fa1 with
- | Some v0 =>
- (idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- v1 <- base.try_make_transport_cps b10 P;
- v2 <- base.try_make_transport_cps P P;
- v3 <- base.try_make_transport_cps P P;
- Some
- (fv <-- v1
- (Datatypes.nat_rect
- (fun _ : nat =>
- UnderLets
- (expr
- (base.subst_default
- '1
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive) b10
- (PositiveMap.empty
- base.type)))))
- (v x (##tt)%expr)
- (fun (n' : nat)
- (rec : UnderLets
- (expr
- (base.subst_default
- '1
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive)
- b10
- (PositiveMap.empty
- base.type)))))
- =>
- rec0 <-- rec;
- v0 x0 (##n')%expr rec0)
- (let (x2, _) := idc_args0 in x2));
- Base (v3 (v2 fv)))%under_lets)%option
- | None => None
- end)
- | None => None
- end)%cps)
+ x' <- base.try_make_transport_cps P b10;
+ x'0 <- base.try_make_transport_cps P b10;
+ x'1 <- base.try_make_transport_cps P b10;
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ x'2 <- base.try_make_transport_cps b10 b10;
+ x'3 <- base.try_make_transport_cps b10 b10;
+ x'4 <- base.try_make_transport_cps b10 b10;
+ v <- base.try_make_transport_cps b10 P;
+ v0 <- base.try_make_transport_cps P P;
+ Some
+ (fv0 <-- Datatypes.nat_rect
+ (fun _ : nat => UnderLets (expr b10))
+ (x'2 (x' x) (##tt)%expr)
+ (fun (n' : nat) (rec : UnderLets (expr b10)) =>
+ rec0 <-- rec;
+ x'4 (x'3 (x'1 (x'0 x0))) (##n')%expr rec0)
+ (let (x2, _) := xv in x2);
+ Base (v0 (v fv0)))%under_lets
else None
| None => None
end
@@ -646,215 +486,34 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
P)%ptype
then
_ <- ident.unify pattern.ident.nat_rect_arrow nat_rect_arrow;
- base.try_make_transport_cps P b
- (fun a17 : option =>
- (fa <- (fun (T : Type) (k : option -> T) =>
- match a17 with
- | Some x' =>
- base.try_make_transport_cps Q b16
- (fun a18 : option =>
- fa <- (fun (T0 : Type) (k0 : option -> T0) =>
- match a18 with
- | Some x'0 =>
- (return Some
- (fun
- v : expr P ->
- UnderLets
- (expr Q) =>
- x'0 (x' v))) T0 k0
- | None => k0 None
- end);
- k fa)
- | None => k None
- end);
- match fa with
- | Some v =>
- base.try_make_transport_cps P b
- (fun a18 : option =>
- fa0 <- (fun (T : Type) (k : option -> T) =>
- match a18 with
- | Some x' =>
- base.try_make_transport_cps Q b16
- (fun a19 : option =>
- fa0 <- (fun (T0 : Type)
- (k0 : option -> T0) =>
- match a19 with
- | Some x'0 =>
- (return Some
- (fun
- v0 :
- expr ℕ ->
- (expr P ->
- UnderLets
- (expr Q)) ->
- expr P ->
- UnderLets
- (expr Q)
- => x'0 (x' v0)))
- T0 k0
- | None => k0 None
- end);
- k fa0)
- | None => k None
- end);
- fa1 <- (fun (T : Type) (k : option -> T) =>
- match fa0 with
- | Some x' =>
- base.try_make_transport_cps P b
- (fun a19 : option =>
- fa1 <- (fun (T0 : Type)
- (k0 : option -> T0) =>
- match a19 with
- | Some x'0 =>
- base.try_make_transport_cps
- Q b16
- (fun a20 : option =>
- fa1 <- (fun
- (T1 : Type)
- (k1 :
- option ->
- T1) =>
- match a20 with
- | Some x'1 =>
- (return
- Some
- (fun
- v0 :
- expr ℕ ->
- (expr b ->
- UnderLets
- (expr b16)) ->
- expr P ->
- UnderLets
- (expr Q)
- =>
- x'1
- (x'0 v0)))
- T1 k1
- | None =>
- k1 None
- end);
- k0 fa1)
- | None => k0 None
- end);
- fa2 <- (fun (T0 : Type)
- (k0 : option -> T0) =>
- match fa1 with
- | Some x'0 =>
- (return Some
- (fun
- v0 :
- expr ℕ ->
- (expr P ->
- UnderLets
- (expr Q)) ->
- expr P ->
- UnderLets
- (expr Q)
- => x'0 (x' v0)))
- T0 k0
- | None => k0 None
- end);
- k fa2)
- | None => k None
- end);
- fa2 <- (fun (T : Type) (k : option -> T) =>
- match fa1 with
- | Some x' =>
- (return Some
- (fun
- v0 : expr ℕ ->
- (expr P ->
- UnderLets (expr Q)) ->
- expr P ->
- UnderLets (expr Q) =>
- x' v0)) T k
- | None => k None
- end);
- match fa2 with
- | Some v0 =>
- (idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- v1 <- base.try_make_transport_cps P b;
- v2 <- base.try_make_transport_cps b16 Q;
- v3 <- base.try_make_transport_cps Q Q;
- v4 <- base.try_make_transport_cps Q Q;
- Some
- (fv <-- v2
- (Datatypes.nat_rect
- (fun _ : nat =>
- expr
- (base.subst_default '1
- (PositiveMap.add
- (PositiveSet.rev
- 2%positive) b16
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive) b
- (PositiveMap.empty
- base.type)))) ->
- UnderLets
- (expr
- (base.subst_default
- '2
- (PositiveMap.add
- (PositiveSet.rev
- 2%positive) b16
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive) b
- (PositiveMap.empty
- base.type))))))
- (v x)
- (fun (n' : nat)
- (rec : expr
- (base.subst_default
- '1
- (PositiveMap.add
- (PositiveSet.rev
- 2%positive)
- b16
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive)
- b
- (PositiveMap.empty
- base.type)))) ->
- UnderLets
- (expr
- (base.subst_default
- '2
- (PositiveMap.add
- (PositiveSet.rev
- 2%positive)
- b16
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive)
- b
- (PositiveMap.empty
- base.type))))))
- (v5 : expr
- (base.subst_default
- '1
- (PositiveMap.add
- (PositiveSet.rev
- 2%positive)
- b16
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive)
- b
- (PositiveMap.empty
- base.type)))))
- => v0 x0 (##n')%expr rec v5)
- (let (x3, _) := idc_args0 in x3)
- (v1 x2));
- Base (v4 (v3 fv)))%under_lets)%option
- | None => None
- end)
- | None => None
- end)%cps)
+ x' <- base.try_make_transport_cps P b;
+ x'0 <- base.try_make_transport_cps Q b16;
+ x'1 <- base.try_make_transport_cps P b;
+ x'2 <- base.try_make_transport_cps Q b16;
+ x'3 <- base.try_make_transport_cps P b;
+ x'4 <- base.try_make_transport_cps Q b16;
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ v <- base.try_make_transport_cps P b;
+ x'5 <- base.try_make_transport_cps b b;
+ x'6 <- base.try_make_transport_cps b16 b16;
+ x'7 <- base.try_make_transport_cps b b;
+ x'8 <- base.try_make_transport_cps b16 b16;
+ x'9 <- base.try_make_transport_cps b b;
+ x'10 <- base.try_make_transport_cps b16 b16;
+ v0 <- base.try_make_transport_cps b b;
+ v1 <- base.try_make_transport_cps b16 Q;
+ v2 <- base.try_make_transport_cps Q Q;
+ Some
+ (fv0 <-- Datatypes.nat_rect
+ (fun _ : nat => expr b -> UnderLets (expr b16))
+ (x'6 (x'5 (x'0 (x' x))))
+ (fun (n' : nat)
+ (rec : expr b -> UnderLets (expr b16))
+ (v3 : expr b) =>
+ x'10 (x'9 (x'8 (x'7 (x'4 (x'3 (x'2 (x'1 x0)))))))
+ (##n')%expr rec v3) (let (x3, _) := xv in x3)
+ (v0 (v x2));
+ Base (v2 (v1 fv0)))%under_lets
else None
| None => None
end
@@ -895,203 +554,32 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
unit -> P) -> A -> (list A) -> P -> P) -> (list A))%ptype
then
_ <- ident.unify pattern.ident.list_rect list_rect;
- base.try_make_transport_cps P b12
- (fun a13 : option =>
- (fa <- (fun (T : Type) (k : option -> T) =>
- match a13 with
- | Some x' =>
- (return Some
- (fun v : expr unit -> UnderLets (expr P)
- => x' v)) T k
- | None => k None
- end);
- match fa with
- | Some v =>
- base.try_make_transport_cps A b
- (fun a14 : option =>
- fa0 <- (fun (T : Type) (k : option -> T) =>
- match a14 with
- | Some x' =>
- base.try_make_transport_cps A b
- (fun a15 : option =>
- fa0 <- (fun (T0 : Type)
- (k0 : option -> T0) =>
- match a15 with
- | Some x'0 =>
- base.try_make_transport_cps
- P b12
- (fun a16 : option =>
- fa0 <- (fun (T1 : Type)
- (k1 : option ->
- T1) =>
- match a16 with
- | Some x'1 =>
- base.try_make_transport_cps
- P b12
- (fun
- a17 : option
- =>
- fa0 <-
- (fun
- (T2 : Type)
- (k2 :
- option ->
- T2) =>
- match
- a17
- with
- | Some
- x'2 =>
- (return
- Some
- (fun
- v0 :
- expr b ->
- expr
- (list b) ->
- expr P ->
- UnderLets
- (expr P)
- =>
- x'2
- (x'1 v0)))
- T2 k2
- | None =>
- k2 None
- end);
- k1 fa0)
- | None => k1 None
- end);
- fa1 <- (fun (T1 : Type)
- (k1 : option ->
- T1) =>
- match fa0 with
- | Some x'1 =>
- (return
- Some
- (fun
- v0 :
- expr b ->
- expr
- (list A) ->
- expr P ->
- UnderLets
- (expr P)
- =>
- x'1
- (x'0 v0)))
- T1 k1
- | None => k1 None
- end);
- k0 fa1)
- | None => k0 None
- end);
- fa1 <- (fun (T0 : Type)
- (k0 : option -> T0) =>
- match fa0 with
- | Some x'0 =>
- (return Some
- (fun
- v0 : expr A ->
- expr
- (list A) ->
- expr P ->
- UnderLets
- (expr P)
- => x'0 (x' v0)))
- T0 k0
- | None => k0 None
- end);
- k fa1)
- | None => k None
- end);
- match fa0 with
- | Some v0 =>
- v1 <- base.try_make_transport_cps A b;
- v2 <- base.try_make_transport_cps b12 P;
- (fv <- v2
- (ls <- reflect_list (v1 x1);
- Some
- (Datatypes.list_rect
- (fun
- _ : Datatypes.list
- (expr
- (base.subst_default
- '1
- (PositiveMap.add
- (PositiveSet.rev
- 2%positive) b12
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive)
- b
- (PositiveMap.empty
- base.type)))))
- =>
- UnderLets
- (expr
- (base.subst_default '2
- (PositiveMap.add
- (PositiveSet.rev
- 2%positive) b12
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive) b
- (PositiveMap.empty
- base.type))))))
- (v x (##tt)%expr)
- (fun
- (x2 : expr
- (base.subst_default
- '1
- (PositiveMap.add
- (PositiveSet.rev
- 2%positive) b12
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive) b
- (PositiveMap.empty
- base.type)))))
- (xs : Datatypes.list
- (expr
- (base.subst_default
- '1
- (PositiveMap.add
- (PositiveSet.rev
- 2%positive)
- b12
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive)
- b
- (PositiveMap.empty
- base.type))))))
- (rec : UnderLets
- (expr
- (base.subst_default
- '2
- (PositiveMap.add
- (PositiveSet.rev
- 2%positive)
- b12
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive)
- b
- (PositiveMap.empty
- base.type))))))
- =>
- (rec' <-- rec;
- v0 x0 x2 (Compilers.reify_list xs)
- rec')%under_lets) ls));
- v3 <- base.try_make_transport_cps P P;
- v4 <- base.try_make_transport_cps P P;
- Some (fv0 <-- fv;
- Base (v4 (v3 fv0)))%under_lets)%option
- | None => None
- end)
- | None => None
- end)%cps)
+ x' <- base.try_make_transport_cps P b12;
+ x'0 <- base.try_make_transport_cps A b;
+ x'1 <- base.try_make_transport_cps A b;
+ x'2 <- base.try_make_transport_cps P b12;
+ x'3 <- base.try_make_transport_cps P b12;
+ v <- base.try_make_transport_cps A b;
+ x'4 <- base.try_make_transport_cps b12 b12;
+ x'5 <- base.try_make_transport_cps b b;
+ x'6 <- base.try_make_transport_cps b b;
+ x'7 <- base.try_make_transport_cps b12 b12;
+ x'8 <- base.try_make_transport_cps b12 b12;
+ v0 <- base.try_make_transport_cps b b;
+ v1 <- base.try_make_transport_cps b12 P;
+ v2 <- base.try_make_transport_cps P P;
+ fv0 <- (ls <- reflect_list (v0 (v x1));
+ Some
+ (Datatypes.list_rect
+ (fun _ : Datatypes.list (expr b) =>
+ UnderLets (expr b12)) (x'4 (x' x) (##tt)%expr)
+ (fun (x2 : expr b) (xs : Datatypes.list (expr b))
+ (rec : UnderLets (expr b12)) =>
+ (rec' <-- rec;
+ x'8 (x'7 (x'6 (x'5 (x'3 (x'2 (x'1 (x'0 x0))))))) x2
+ (Compilers.reify_list xs) rec')%under_lets) ls));
+ Some (fv1 <-- fv0;
+ Base (v2 (v1 fv1)))%under_lets
else None
| None => None
end;;
@@ -1131,95 +619,20 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
unit -> P) -> A -> (list A) -> P) -> (list args))%ptype
then
_ <- ident.unify pattern.ident.list_case list_case;
- base.try_make_transport_cps P b10
- (fun a11 : option =>
- (fa <- (fun (T : Type) (k : option -> T) =>
- match a11 with
- | Some x' =>
- (return Some
- (fun
- v : expr unit ->
- UnderLets (expr P) =>
- x' v)) T k
- | None => k None
- end);
- match fa with
- | Some v =>
- base.try_make_transport_cps A b
- (fun a12 : option =>
- fa0 <- (fun (T : Type) (k : option -> T) =>
- match a12 with
- | Some x' =>
- base.try_make_transport_cps A b
- (fun a13 : option =>
- fa0 <- (fun (T0 : Type)
- (k0 : option -> T0) =>
- match a13 with
- | Some x'0 =>
- base.try_make_transport_cps
- P b10
- (fun a14 : option =>
- fa0 <- (fun
- (T1 : Type)
- (k1 :
- option ->
- T1) =>
- match
- a14
- with
- | Some x'1 =>
- (return
- Some
- (fun
- v0 :
- expr b ->
- expr
- (list A) ->
- UnderLets
- (expr P)
- =>
- x'1
- (x'0 v0)))
- T1 k1
- | None =>
- k1 None
- end);
- k0 fa0)
- | None => k0 None
- end);
- fa1 <- (fun (T0 : Type)
- (k0 : option -> T0) =>
- match fa0 with
- | Some x'0 =>
- (return Some
- (fun
- v0 :
- expr A ->
- expr
- (list A) ->
- UnderLets
- (expr P)
- =>
- x'0 (x' v0)))
- T0 k0
- | None => k0 None
- end);
- k fa1)
- | None => k None
- end);
- match fa0 with
- | Some _ =>
- (_ <- ident.unify pattern.ident.nil nil;
- v1 <- base.try_make_transport_cps b10 P;
- v2 <- base.try_make_transport_cps P P;
- v3 <- base.try_make_transport_cps P P;
- Some
- (fv <-- v1 (v x (##tt)%expr);
- Base (v3 (v2 fv)))%under_lets)%option
- | None => None
- end)
- | None => None
- end)%cps)
+ x' <- base.try_make_transport_cps P b10;
+ _ <- base.try_make_transport_cps A b;
+ _ <- base.try_make_transport_cps A b;
+ _ <- base.try_make_transport_cps P b10;
+ _ <- ident.unify pattern.ident.nil nil;
+ x'3 <- base.try_make_transport_cps b10 b10;
+ _ <- base.try_make_transport_cps b b;
+ _ <- base.try_make_transport_cps b b;
+ _ <- base.try_make_transport_cps b10 b10;
+ v <- base.try_make_transport_cps b10 P;
+ v0 <- base.try_make_transport_cps P P;
+ Some
+ (fv0 <-- x'3 (x' x) (##tt)%expr;
+ Base (v0 (v fv0)))%under_lets
else None
| None => None
end
@@ -1255,99 +668,26 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((args -> (list args) -> (list args)) -> s0) -> s)%ptype
then
_ <- ident.unify pattern.ident.list_case list_case;
- base.try_make_transport_cps P b10
- (fun a15 : option =>
- (fa <- (fun (T : Type) (k : option -> T) =>
- match a15 with
- | Some x' =>
- (return Some
- (fun
- v : expr unit ->
- UnderLets (expr P) =>
- x' v)) T k
- | None => k None
- end);
- match fa with
- | Some _ =>
- base.try_make_transport_cps A b11
- (fun a16 : option =>
- fa0 <- (fun (T : Type) (k : option -> T) =>
- match a16 with
- | Some x' =>
- base.try_make_transport_cps A b11
- (fun a17 : option =>
- fa0 <- (fun (T0 : Type)
- (k0 : option -> T0) =>
- match a17 with
- | Some x'0 =>
- base.try_make_transport_cps
- P b10
- (fun a18 : option =>
- fa0 <- (fun
- (T1 : Type)
- (k1 :
- option ->
- T1) =>
- match
- a18
- with
- | Some x'1 =>
- (return
- Some
- (fun
- v0 :
- expr b11 ->
- expr
- (list A) ->
- UnderLets
- (expr P)
- =>
- x'1
- (x'0 v0)))
- T1 k1
- | None =>
- k1 None
- end);
- k0 fa0)
- | None => k0 None
- end);
- fa1 <- (fun (T0 : Type)
- (k0 : option -> T0) =>
- match fa0 with
- | Some x'0 =>
- (return Some
- (fun
- v0 :
- expr A ->
- expr
- (list A) ->
- UnderLets
- (expr P)
- =>
- x'0 (x' v0)))
- T0 k0
- | None => k0 None
- end);
- k fa1)
- | None => k None
- end);
- match fa0 with
- | Some v0 =>
- (_ <- ident.unify pattern.ident.cons cons;
- v1 <- type.try_make_transport_cps s0 b11;
- v2 <- type.try_make_transport_cps s (list b11);
- v3 <- base.try_make_transport_cps b10 P;
- v4 <- base.try_make_transport_cps P P;
- v5 <- base.try_make_transport_cps P P;
- Some
- (fv <-- v3
- (v0 x0 (v1 (Compile.reflect x3))
- (v2 (Compile.reflect x2)));
- Base (v5 (v4 fv)))%under_lets)%option
- | None => None
- end)
- | None => None
- end)%cps)
+ _ <- base.try_make_transport_cps P b10;
+ x'0 <- base.try_make_transport_cps A b11;
+ x'1 <- base.try_make_transport_cps A b11;
+ x'2 <- base.try_make_transport_cps P b10;
+ _ <- ident.unify pattern.ident.cons cons;
+ v <- type.try_make_transport_cps s0 b11;
+ v0 <- type.try_make_transport_cps s (list b11);
+ _ <- base.try_make_transport_cps b10 b10;
+ x'4 <- base.try_make_transport_cps b11 b11;
+ x'5 <- base.try_make_transport_cps b11 b11;
+ x'6 <- base.try_make_transport_cps b10 b10;
+ v1 <- base.try_make_transport_cps b11 b11;
+ v2 <- base.try_make_transport_cps b11 b11;
+ v3 <- base.try_make_transport_cps b10 P;
+ v4 <- base.try_make_transport_cps P P;
+ Some
+ (fv1 <-- x'6 (x'5 (x'4 (x'2 (x'1 (x'0 x0)))))
+ (v1 (v (Compile.reflect x3)))
+ (v2 (v0 (Compile.reflect x2)));
+ Base (v4 (v3 fv1)))%under_lets
else None
| None => None
end
@@ -1382,9 +722,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
then
_ <- ident.unify pattern.ident.List_length List_length;
v <- base.try_make_transport_cps T b;
- x0 <- (xs <- reflect_list (v x);
- Some (##(length xs))%expr);
- Some (Base x0)
+ v0 <- base.try_make_transport_cps b b;
+ fv0 <- (x0 <- (xs <- reflect_list (v0 (v x));
+ Some (##(length xs))%expr);
+ Some (Base x0));
+ Some (fv1 <-- fv0;
+ Base fv1)%under_lets
else None
| None => None
end;;;
@@ -1407,16 +750,14 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℕ -> ℕ)%ptype
((projT1 args0) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
Some
(Base
(Compilers.reify_list
(map (fun v : nat => (##v)%expr)
- (seq (let (x1, _) := idc_args in x1)
- (let (x1, _) := idc_args0 in x1)))))
+ (seq (let (x1, _) := xv in x1)
+ (let (x1, _) := xv0 in x1)))))
else None
| None => None
end
@@ -1446,19 +787,18 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(((ℕ -> (list A) -> (list A)) -> (projT1 args)) -> (list A))%ptype
then
_ <- ident.unify pattern.ident.List_firstn List_firstn;
- idc_args0 <- ident.unify pattern.ident.Literal ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
v <- base.try_make_transport_cps A b;
- v0 <- base.try_make_transport_cps b A;
- fv <- v0
- (xs <- reflect_list (v x0);
- Some
- (Base
- (Compilers.reify_list
- (firstn (let (x1, _) := idc_args0 in x1) xs))));
- v1 <- base.try_make_transport_cps A A;
+ v0 <- base.try_make_transport_cps b b;
+ v1 <- base.try_make_transport_cps b A;
v2 <- base.try_make_transport_cps A A;
- Some (fv0 <-- fv;
- Base (v2 (v1 fv0)))%under_lets
+ fv0 <- (xs <- reflect_list (v0 (v x0));
+ Some
+ (Base
+ (Compilers.reify_list
+ (firstn (let (x1, _) := xv in x1) xs))));
+ Some (fv1 <-- fv0;
+ Base (v2 (v1 fv1)))%under_lets
else None
| None => None
end
@@ -1486,19 +826,18 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(((ℕ -> (list A) -> (list A)) -> (projT1 args)) -> (list A))%ptype
then
_ <- ident.unify pattern.ident.List_skipn List_skipn;
- idc_args0 <- ident.unify pattern.ident.Literal ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
v <- base.try_make_transport_cps A b;
- v0 <- base.try_make_transport_cps b A;
- fv <- v0
- (xs <- reflect_list (v x0);
- Some
- (Base
- (Compilers.reify_list
- (skipn (let (x1, _) := idc_args0 in x1) xs))));
- v1 <- base.try_make_transport_cps A A;
+ v0 <- base.try_make_transport_cps b b;
+ v1 <- base.try_make_transport_cps b A;
v2 <- base.try_make_transport_cps A A;
- Some (fv0 <-- fv;
- Base (v2 (v1 fv0)))%under_lets
+ fv0 <- (xs <- reflect_list (v0 (v x0));
+ Some
+ (Base
+ (Compilers.reify_list
+ (skipn (let (x1, _) := xv in x1) xs))));
+ Some (fv1 <-- fv0;
+ Base (v2 (v1 fv1)))%under_lets
else None
| None => None
end
@@ -1525,18 +864,16 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
then
_ <- ident.unify pattern.ident.List_repeat List_repeat;
v <- base.try_make_transport_cps A b0;
- idc_args0 <- ident.unify pattern.ident.Literal ##(projT2 args);
- v0 <- base.try_make_transport_cps b0 A;
- v1 <- base.try_make_transport_cps A A;
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ v0 <- base.try_make_transport_cps b0 b0;
+ v1 <- base.try_make_transport_cps b0 A;
v2 <- base.try_make_transport_cps A A;
Some
(Base
(v2
(v1
- (v0
- (Compilers.reify_list
- (repeat (v x)
- (let (x1, _) := idc_args0 in x1)))))))
+ (Compilers.reify_list
+ (repeat (v0 (v x)) (let (x1, _) := xv in x1))))))
else None
| None => None
end
@@ -1565,48 +902,21 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
_ <- ident.unify pattern.ident.List_combine List_combine;
v <- base.try_make_transport_cps A b0;
v0 <- base.try_make_transport_cps B b;
- (trA <-- @base.try_make_transport_cps
- (fun A0 : base.type => option) b0 A;
- trB <-- @base.try_make_transport_cps
- (fun B0 : base.type => option) b B;
- return Some (fun v1 : option => trB (trA v1)))%cps option
- (fun tr : option =>
- match tr with
- | Some v1 =>
- x1 <- v1
- (xs <- reflect_list (v x);
- ys <- reflect_list (v0 x0);
- Some
- (Compilers.reify_list
- (map (fun '(x1, y)%zrange => (x1, y)%expr_pat)
- (combine xs ys))));
- (trA <-- @base.try_make_transport_cps
- (fun A0 : base.type => expr (list (A0 * B))) A A;
- trB <-- @base.try_make_transport_cps
- (fun B0 : base.type => expr (list (A * B0))) B B;
- return Some (fun v2 : expr (list (A * B)) => trB (trA v2)))%cps
- option
- (fun tr0 : option =>
- match tr0 with
- | Some v2 =>
- (trA <-- @base.try_make_transport_cps
- (fun A0 : base.type =>
- expr (list (A0 * B))) A A;
- trB <-- @base.try_make_transport_cps
- (fun B0 : base.type =>
- expr (list (A * B0))) B B;
- return Some
- (fun v3 : expr (list (A * B)) =>
- trB (trA v3)))%cps option
- (fun tr' : option =>
- match tr' with
- | Some v3 => Some (Base (v3 (v2 x1)))
- | None => None
- end)
- | None => None
- end)
- | None => None
- end)
+ v1 <- base.try_make_transport_cps b0 b0;
+ v2 <- base.try_make_transport_cps b b;
+ x' <- base.try_make_transport_cps b0 A;
+ x'0 <- base.try_make_transport_cps b B;
+ x'1 <- base.try_make_transport_cps A A;
+ x'2 <- base.try_make_transport_cps B B;
+ fv0 <- (x1 <- (xs <- reflect_list (v1 (v x));
+ ys <- reflect_list (v2 (v0 x0));
+ Some
+ (Compilers.reify_list
+ (map (fun '(x1, y)%zrange => (x1, y)%expr_pat)
+ (combine xs ys))));
+ Some (Base x1));
+ Some (fv1 <-- fv0;
+ Base (x'2 (x'1 (x'0 (x' fv1)))))%under_lets
else None
| None => None
end;;;
@@ -1628,105 +938,26 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((((A -> B) -> (list A) -> (list B)) -> A -> B) -> (list A))%ptype
then
_ <- ident.unify pattern.ident.List_map List_map;
- base.try_make_transport_cps A b
- (fun a5 : option =>
- (fa <- (fun (T : Type) (k : option -> T) =>
- match a5 with
- | Some x' =>
- base.try_make_transport_cps B b4
- (fun a6 : option =>
- fa <- (fun (T0 : Type) (k0 : option -> T0) =>
- match a6 with
- | Some x'0 =>
- (return Some
- (fun
- v : expr A ->
- UnderLets (expr B)
- => x'0 (x' v))) T0 k0
- | None => k0 None
- end);
- k fa)
- | None => k None
- end);
- match fa with
- | Some v =>
- v0 <- base.try_make_transport_cps A b;
- v1 <- base.try_make_transport_cps b4 B;
- (fv <- v1
- (ls <- reflect_list (v0 x0);
- Some
- (Datatypes.list_rect
- (fun
- _ : Datatypes.list
- (expr
- (base.subst_default '1
- (PositiveMap.add
- (PositiveSet.rev
- 2%positive) b4
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive) b
- (PositiveMap.empty
- base.type))))) =>
- UnderLets
- (expr
- (list
- (base.subst_default '2
- (PositiveMap.add
- (PositiveSet.rev 2%positive)
- b4
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive) b
- (PositiveMap.empty
- base.type)))))))
- (Base []%expr_pat)
- (fun
- (x1 : expr
- (base.subst_default '1
- (PositiveMap.add
- (PositiveSet.rev
- 2%positive) b4
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive) b
- (PositiveMap.empty
- base.type)))))
- (_ : Datatypes.list
- (expr
- (base.subst_default '1
- (PositiveMap.add
- (PositiveSet.rev
- 2%positive) b4
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive) b
- (PositiveMap.empty
- base.type))))))
- (rec : UnderLets
- (expr
- (list
- (base.subst_default
- '2
- (PositiveMap.add
- (PositiveSet.rev
- 2%positive) b4
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive) b
- (PositiveMap.empty
- base.type)))))))
- =>
- (rec' <-- rec;
- fx <-- v x x1;
- Base (fx :: rec')%expr_pat)%under_lets)
- ls));
- v2 <- base.try_make_transport_cps B B;
- v3 <- base.try_make_transport_cps B B;
- Some (fv0 <-- fv;
- Base (v3 (v2 fv0)))%under_lets)%option
- | None => None
- end)%cps)
+ x' <- base.try_make_transport_cps A b;
+ x'0 <- base.try_make_transport_cps B b4;
+ v <- base.try_make_transport_cps A b;
+ x'1 <- base.try_make_transport_cps b b;
+ x'2 <- base.try_make_transport_cps b4 b4;
+ v0 <- base.try_make_transport_cps b b;
+ v1 <- base.try_make_transport_cps b4 B;
+ v2 <- base.try_make_transport_cps B B;
+ fv0 <- (ls <- reflect_list (v0 (v x0));
+ Some
+ (Datatypes.list_rect
+ (fun _ : Datatypes.list (expr b) =>
+ UnderLets (expr (list b4))) (Base []%expr_pat)
+ (fun (x1 : expr b) (_ : Datatypes.list (expr b))
+ (rec : UnderLets (expr (list b4))) =>
+ (rec' <-- rec;
+ fx <-- x'2 (x'1 (x'0 (x' x))) x1;
+ Base (fx :: rec')%expr_pat)%under_lets) ls));
+ Some (fv1 <-- fv0;
+ Base (v2 (v1 fv1)))%under_lets
else None
| None => None
end;;
@@ -1753,35 +984,21 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
_ <- ident.unify pattern.ident.List_app List_app;
v <- base.try_make_transport_cps A b;
v0 <- base.try_make_transport_cps A b;
- v1 <- base.try_make_transport_cps b A;
- fv <- v1
- (ls <- reflect_list (v x);
- Some
- (Datatypes.list_rect
- (fun _ : Datatypes.list (expr b) =>
- UnderLets
- (expr
- (base.subst_default
- (pattern.base.type.list '1)
- (PositiveMap.add
- (PositiveSet.rev 1%positive) b
- (PositiveMap.empty base.type)))))
- (Base (v0 x0))
- (fun (x1 : expr b) (_ : Datatypes.list (expr b))
- (rec : UnderLets
- (expr
- (base.subst_default
- (pattern.base.type.list '1)
- (PositiveMap.add
- (PositiveSet.rev 1%positive) b
- (PositiveMap.empty base.type)))))
- =>
- (rec' <-- rec;
- Base (x1 :: rec')%expr_pat)%under_lets) ls));
- v2 <- base.try_make_transport_cps A A;
- v3 <- base.try_make_transport_cps A A;
- Some (fv0 <-- fv;
- Base (v3 (v2 fv0)))%under_lets
+ v1 <- base.try_make_transport_cps b b;
+ v2 <- base.try_make_transport_cps b b;
+ v3 <- base.try_make_transport_cps b A;
+ v4 <- base.try_make_transport_cps A A;
+ fv0 <- (ls <- reflect_list (v1 (v x));
+ Some
+ (Datatypes.list_rect
+ (fun _ : Datatypes.list (expr b) =>
+ UnderLets (expr (list b))) (Base (v2 (v0 x0)))
+ (fun (x1 : expr b) (_ : Datatypes.list (expr b))
+ (rec : UnderLets (expr (list b))) =>
+ (rec' <-- rec;
+ Base (x1 :: rec')%expr_pat)%under_lets) ls));
+ Some (fv1 <-- fv0;
+ Base (v4 (v3 fv1)))%under_lets
else None
| None => None
end;;
@@ -1804,14 +1021,13 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
then
_ <- ident.unify pattern.ident.List_rev List_rev;
v <- base.try_make_transport_cps A b;
- v0 <- base.try_make_transport_cps b A;
- fv <- v0
- (xs <- reflect_list (v x);
- Some (Base (Compilers.reify_list (rev xs))));
- v1 <- base.try_make_transport_cps A A;
+ v0 <- base.try_make_transport_cps b b;
+ v1 <- base.try_make_transport_cps b A;
v2 <- base.try_make_transport_cps A A;
- Some (fv0 <-- fv;
- Base (v2 (v1 fv0)))%under_lets
+ fv0 <- (xs <- reflect_list (v0 (v x));
+ Some (Base (Compilers.reify_list (rev xs))));
+ Some (fv1 <-- fv0;
+ Base (v2 (v1 fv1)))%under_lets
else None
| None => None
end;;
@@ -1837,83 +1053,28 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(list A))%ptype
then
_ <- ident.unify pattern.ident.List_flat_map List_flat_map;
- base.try_make_transport_cps A b
- (fun a5 : option =>
- (fa <- (fun (T : Type) (k : option -> T) =>
- match a5 with
- | Some x' =>
- base.try_make_transport_cps B b4
- (fun a6 : option =>
- fa <- (fun (T0 : Type) (k0 : option -> T0) =>
- match a6 with
- | Some x'0 =>
- (return Some
- (fun
- v : expr A ->
- UnderLets
- (expr (list B)) =>
- x'0 (x' v))) T0 k0
- | None => k0 None
- end);
- k fa)
- | None => k None
- end);
- match fa with
- | Some v =>
- v0 <- base.try_make_transport_cps A b;
- v1 <- base.try_make_transport_cps b4 B;
- (fv <- v1
- (ls <- reflect_list (v0 x0);
- Some
- (Datatypes.list_rect
- (fun
- _ : Datatypes.list
- (expr
- (base.subst_default '1
- (PositiveMap.add
- (PositiveSet.rev
- 2%positive) b4
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive) b
- (PositiveMap.empty
- base.type))))) =>
- UnderLets (expr (list b4)))
- (Base []%expr_pat)
- (fun
- (x1 : expr
- (base.subst_default '1
- (PositiveMap.add
- (PositiveSet.rev
- 2%positive) b4
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive) b
- (PositiveMap.empty
- base.type)))))
- (_ : Datatypes.list
- (expr
- (base.subst_default '1
- (PositiveMap.add
- (PositiveSet.rev
- 2%positive) b4
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive) b
- (PositiveMap.empty
- base.type))))))
- (rec : UnderLets (expr (list b4))) =>
- (rec' <-- rec;
- fx <-- v x x1;
- Base ($fx ++ rec')%expr)%under_lets) ls));
- v2 <- base.try_make_transport_cps B B;
- v3 <- base.try_make_transport_cps B B;
- Some
- (fv0 <-- fv;
- fv1 <-- do_again (list B) (v2 fv0);
- Base (v3 fv1))%under_lets)%option
- | None => None
- end)%cps)
+ x' <- base.try_make_transport_cps A b;
+ x'0 <- base.try_make_transport_cps B b4;
+ v <- base.try_make_transport_cps A b;
+ x'1 <- base.try_make_transport_cps b b;
+ x'2 <- base.try_make_transport_cps b4 b4;
+ v0 <- base.try_make_transport_cps b b;
+ v1 <- base.try_make_transport_cps b4 B;
+ v2 <- base.try_make_transport_cps B B;
+ fv0 <- (ls <- reflect_list (v0 (v x0));
+ Some
+ (Datatypes.list_rect
+ (fun _ : Datatypes.list (expr b) =>
+ UnderLets (expr (list b4))) (Base []%expr_pat)
+ (fun (x1 : expr b) (_ : Datatypes.list (expr b))
+ (rec : UnderLets (expr (list b4))) =>
+ (rec' <-- rec;
+ fx <-- x'2 (x'1 (x'0 (x' x))) x1;
+ Base ($fx ++ rec')%expr)%under_lets) ls));
+ Some
+ (fv1 <-- fv0;
+ fv2 <-- do_again (list B) (v1 fv1);
+ Base (v2 fv2))%under_lets
else None
| None => None
end;;
@@ -1941,213 +1102,38 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
A -> bool) -> (list A))%ptype
then
_ <- ident.unify pattern.ident.List_partition List_partition;
- base.try_make_transport_cps A b
- (fun a6 : option =>
- (fa <- (fun (T : Type) (k : option -> T) =>
- match a6 with
- | Some x' =>
- (return Some
- (fun v : expr A -> UnderLets (expr bool)
- => x' v)) T (fun fa : option => k fa)
- | None => k None
- end);
- match fa with
- | Some v =>
- v0 <- base.try_make_transport_cps A b;
- base.try_make_transport_cps b A
- (fun a7 : option =>
- fa0 <- (fun (T : Type) (k : option -> T) =>
- match a7 with
- | Some x' =>
- base.try_make_transport_cps b A
- (fun a8 : option =>
- fa0 <- (fun (T0 : Type)
- (k0 : option -> T0) =>
- match a8 with
- | Some x'0 =>
- (return Some
- (fun v1 : option
- => x'0 (x' v1)))
- T0 k0
- | None => k0 None
- end);
- k fa0)
- | None => k None
- end);
- match fa0 with
- | Some v1 =>
- (fv <- v1
- (ls <- reflect_list (v0 x0);
- Some
- (Datatypes.list_rect
- (fun
- _ : Datatypes.list
- (expr
- (base.subst_default
- '1
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive) b
- (PositiveMap.empty
- base.type))))
- =>
- UnderLets
- (expr
- (list
- (base.subst_default
- '1
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive) b
- (PositiveMap.empty
- base.type))) *
- list
- (base.subst_default
- '1
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive) b
- (PositiveMap.empty
- base.type))))%etype))
- (Base ([], [])%expr_pat)
- (fun
- (x1 : expr
- (base.subst_default
- '1
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive) b
- (PositiveMap.empty
- base.type))))
- (_ : Datatypes.list
- (expr
- (base.subst_default
- '1
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive) b
- (PositiveMap.empty
- base.type)))))
- (rec : UnderLets
- (expr
- (list
- (base.subst_default
- '1
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive)
- b
- (PositiveMap.empty
- base.type))) *
- list
- (base.subst_default
- '1
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive)
- b
- (PositiveMap.empty
- base.type))))%etype))
- =>
- (rec' <-- rec;
- fx <-- v x x1;
- Base
- (#(prod_rect)%expr @
- (λ g
- d : expr
- (list
- (base.subst_default
- '1
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive)
- b
- (PositiveMap.empty
- base.type)))),
- (#(bool_rect)%expr @
- (λ _ : expr unit,
- ($x1 :: $g, $d)%expr_pat) @
- (λ _ : expr unit,
- ($g, $x1 :: $d)%expr_pat) @
- $fx)%expr_pat)%expr @ rec')%expr_pat)%under_lets)
- ls));
- base.try_make_transport_cps A A
- (fun a8 : option =>
- (fa1 <- (fun (T : Type) (k : option -> T) =>
- match a8 with
- | Some x' =>
- base.try_make_transport_cps A A
- (fun a9 : option =>
- fa1 <- (fun (T0 : Type)
- (k0 : option -> T0)
- =>
- match a9 with
- | Some x'0 =>
- (return Some
- (fun
- v2 :
- expr
- (list A *
- list A)%etype
- =>
- x'0
- (x' v2)))
- T0 k0
- | None => k0 None
- end);
- k fa1)
- | None => k None
- end);
- match fa1 with
- | Some v2 =>
- base.try_make_transport_cps A A
- (fun a9 : option =>
- fa2 <- (fun (T : Type)
- (k : option -> T) =>
- match a9 with
- | Some x' =>
- base.try_make_transport_cps
- A A
- (fun a10 : option =>
- fa2 <- (fun (T0 : Type)
- (k0 :
- option -> T0)
- =>
- match a10 with
- | Some x'0 =>
- (return
- Some
- (fun
- v3 :
- expr
- (list A *
- list A)%etype
- =>
- x'0
- (x' v3)))
- T0 k0
- | None =>
- k0 None
- end);
- k fa2)
- | None => k None
- end);
- match fa2 with
- | Some v3 =>
- Some
- (fv0 <-- fv;
- fv1 <-- do_again
- (list A * list A)
- (v2 fv0);
- Base (v3 fv1))%under_lets
- | None => None
- end)
- | None => None
- end)%cps))%option
- | None => None
- end)
- | None => None
- end)%cps)
+ x' <- base.try_make_transport_cps A b;
+ v <- base.try_make_transport_cps A b;
+ x'0 <- base.try_make_transport_cps b b;
+ v0 <- base.try_make_transport_cps b b;
+ x'1 <- base.try_make_transport_cps b A;
+ x'2 <- base.try_make_transport_cps b A;
+ x'3 <- base.try_make_transport_cps A A;
+ x'4 <- base.try_make_transport_cps A A;
+ fv0 <- (ls <- reflect_list (v0 (v x0));
+ Some
+ (Datatypes.list_rect
+ (fun _ : Datatypes.list (expr b) =>
+ UnderLets (expr (list b * list b)%etype))
+ (Base ([], [])%expr_pat)
+ (fun (x1 : expr b) (_ : Datatypes.list (expr b))
+ (rec : UnderLets (expr (list b * list b)%etype))
+ =>
+ (rec' <-- rec;
+ fx <-- x'0 (x' x) x1;
+ Base
+ (#(prod_rect)%expr @
+ (λ g d : expr (list b),
+ (#(bool_rect)%expr @
+ (λ _ : expr unit,
+ ($x1 :: $g, $d)%expr_pat) @
+ (λ _ : expr unit,
+ ($g, $x1 :: $d)%expr_pat) @ $fx)%expr_pat)%expr @
+ rec')%expr_pat)%under_lets) ls));
+ Some
+ (fv1 <-- fv0;
+ fv2 <-- do_again (list A * list A) (x'2 (x'1 fv1));
+ Base (x'4 (x'3 fv2)))%under_lets
else None
| None => None
end;;
@@ -2176,124 +1162,30 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
(list B))%ptype
then
_ <- ident.unify pattern.ident.List_fold_right List_fold_right;
- base.try_make_transport_cps B b
- (fun a9 : option =>
- (fa <- (fun (T : Type) (k : option -> T) =>
- match a9 with
- | Some x' =>
- base.try_make_transport_cps A b0
- (fun a10 : option =>
- fa <- (fun (T0 : Type) (k0 : option -> T0) =>
- match a10 with
- | Some x'0 =>
- base.try_make_transport_cps A b0
- (fun a11 : option =>
- fa <- (fun (T1 : Type)
- (k1 : option -> T1) =>
- match a11 with
- | Some x'1 =>
- (return Some
- (fun
- v :
- expr b ->
- expr A ->
- UnderLets
- (expr A)
- =>
- x'1 (x'0 v)))
- T1 k1
- | None => k1 None
- end);
- k0 fa)
- | None => k0 None
- end);
- fa0 <- (fun (T0 : Type) (k0 : option -> T0) =>
- match fa with
- | Some x'0 =>
- (return Some
- (fun
- v : expr B ->
- expr A ->
- UnderLets (expr A)
- => x'0 (x' v))) T0 k0
- | None => k0 None
- end);
- k fa0)
- | None => k None
- end);
- match fa with
- | Some v =>
- v0 <- base.try_make_transport_cps A b0;
- v1 <- base.try_make_transport_cps B b;
- v2 <- base.try_make_transport_cps b0 A;
- (fv <- v2
- (ls <- reflect_list (v1 x1);
- Some
- (Datatypes.list_rect
- (fun
- _ : Datatypes.list
- (expr
- (base.subst_default '2
- (PositiveMap.add
- (PositiveSet.rev
- 2%positive) b
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive) b0
- (PositiveMap.empty
- base.type))))) =>
- UnderLets
- (expr
- (base.subst_default '1
- (PositiveMap.add
- (PositiveSet.rev 2%positive) b
- (PositiveMap.add
- (PositiveSet.rev 1%positive)
- b0
- (PositiveMap.empty base.type))))))
- (Base (v0 x0))
- (fun
- (x2 : expr
- (base.subst_default '2
- (PositiveMap.add
- (PositiveSet.rev
- 2%positive) b
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive) b0
- (PositiveMap.empty
- base.type)))))
- (_ : Datatypes.list
- (expr
- (base.subst_default '2
- (PositiveMap.add
- (PositiveSet.rev
- 2%positive) b
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive) b0
- (PositiveMap.empty
- base.type))))))
- (rec : UnderLets
- (expr
- (base.subst_default
- '1
- (PositiveMap.add
- (PositiveSet.rev
- 2%positive) b
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive) b0
- (PositiveMap.empty
- base.type))))))
- => (rec' <-- rec;
- v x x2 rec')%under_lets) ls));
- v3 <- base.try_make_transport_cps A A;
- v4 <- base.try_make_transport_cps A A;
- Some (fv0 <-- fv;
- Base (v4 (v3 fv0)))%under_lets)%option
- | None => None
- end)%cps)
+ x' <- base.try_make_transport_cps B b;
+ x'0 <- base.try_make_transport_cps A b0;
+ x'1 <- base.try_make_transport_cps A b0;
+ v <- base.try_make_transport_cps A b0;
+ v0 <- base.try_make_transport_cps B b;
+ x'2 <- base.try_make_transport_cps b b;
+ x'3 <- base.try_make_transport_cps b0 b0;
+ x'4 <- base.try_make_transport_cps b0 b0;
+ v1 <- base.try_make_transport_cps b0 b0;
+ v2 <- base.try_make_transport_cps b b;
+ v3 <- base.try_make_transport_cps b0 A;
+ v4 <- base.try_make_transport_cps A A;
+ fv0 <- (ls <- reflect_list (v2 (v0 x1));
+ Some
+ (Datatypes.list_rect
+ (fun _ : Datatypes.list (expr b) =>
+ UnderLets (expr b0)) (Base (v1 (v x0)))
+ (fun (x2 : expr b) (_ : Datatypes.list (expr b))
+ (rec : UnderLets (expr b0)) =>
+ (rec' <-- rec;
+ x'4 (x'3 (x'2 (x'1 (x'0 (x' x))))) x2 rec')%under_lets)
+ ls));
+ Some (fv1 <-- fv0;
+ Base (v4 (v3 fv1)))%under_lets
else None
| None => None
end;;
@@ -2326,58 +1218,25 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
T -> T) -> (list T))%ptype
then
_ <- ident.unify pattern.ident.List_update_nth List_update_nth;
- idc_args0 <- ident.unify pattern.ident.Literal ##(projT2 args);
- base.try_make_transport_cps T b
- (fun a7 : option =>
- (fa <- (fun (T0 : Type) (k : option -> T0) =>
- match a7 with
- | Some x' =>
- base.try_make_transport_cps T b
- (fun a8 : option =>
- fa <- (fun (T1 : Type) (k0 : option -> T1) =>
- match a8 with
- | Some x'0 =>
- (return Some
- (fun
- v : expr T ->
- UnderLets
- (expr T) =>
- x'0 (x' v))) T1 k0
- | None => k0 None
- end);
- k fa)
- | None => k None
- end);
- match fa with
- | Some v =>
- v0 <- base.try_make_transport_cps T b;
- v1 <- base.try_make_transport_cps b T;
- (fv <- v1
- (ls <- reflect_list (v0 x1);
- Some
- (retv <---- update_nth
- (let (x2, _) := idc_args0 in
- x2)
- (fun
- x2 : UnderLets
- (expr
- (base.subst_default
- '1
- (PositiveMap.add
- (PositiveSet.rev
- 1%positive)
- b
- (PositiveMap.empty
- base.type))))
- => x3 <-- x2;
- v x0 x3) (map Base ls);
- Base (Compilers.reify_list retv))%under_lets);
- v2 <- base.try_make_transport_cps T T;
- v3 <- base.try_make_transport_cps T T;
- Some (fv0 <-- fv;
- Base (v3 (v2 fv0)))%under_lets)%option
- | None => None
- end)%cps)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ x' <- base.try_make_transport_cps T b;
+ x'0 <- base.try_make_transport_cps T b;
+ v <- base.try_make_transport_cps T b;
+ x'1 <- base.try_make_transport_cps b b;
+ x'2 <- base.try_make_transport_cps b b;
+ v0 <- base.try_make_transport_cps b b;
+ v1 <- base.try_make_transport_cps b T;
+ v2 <- base.try_make_transport_cps T T;
+ fv0 <- (ls <- reflect_list (v0 (v x1));
+ Some
+ (retv <---- update_nth (let (x2, _) := xv in x2)
+ (fun x2 : UnderLets (expr b) =>
+ x3 <-- x2;
+ x'2 (x'1 (x'0 (x' x0))) x3)
+ (map Base ls);
+ Base (Compilers.reify_list retv))%under_lets);
+ Some (fv1 <-- fv0;
+ Base (v2 (v1 fv1)))%under_lets
else None
| None => None
end
@@ -2409,16 +1268,18 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
List_nth_default;
v <- base.try_make_transport_cps T b0;
v0 <- base.try_make_transport_cps T b0;
- idc_args0 <- ident.unify pattern.ident.Literal ##(projT2 args);
- v1 <- base.try_make_transport_cps b0 T;
- x2 <- v1
- (ls <- reflect_list (v0 x0);
- Some
- (nth_default (v x) ls
- (let (x2, _) := idc_args0 in x2)));
- v2 <- base.try_make_transport_cps T T;
- v3 <- base.try_make_transport_cps T T;
- Some (Base (v3 (v2 x2)))
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ v1 <- base.try_make_transport_cps b0 b0;
+ v2 <- base.try_make_transport_cps b0 b0;
+ v3 <- base.try_make_transport_cps b0 T;
+ v4 <- base.try_make_transport_cps T T;
+ fv0 <- (x2 <- (ls <- reflect_list (v2 (v0 x0));
+ Some
+ (nth_default (v1 (v x)) ls
+ (let (x2, _) := xv in x2)));
+ Some (Base x2));
+ Some (fv1 <-- fv0;
+ Base (v4 (v3 fv1)))%under_lets
else None
| None => None
end
@@ -2444,14 +1305,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args0) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
Some
(Base
- (##((let (x1, _) := idc_args in x1) +
- (let (x1, _) := idc_args0 in x1))%Z)%expr)
+ (##((let (x1, _) := xv in x1) +
+ (let (x1, _) := xv0 in x1))%Z)%expr)
else None
| None => None
end
@@ -2479,14 +1338,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args0) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
Some
(Base
- (##((let (x1, _) := idc_args in x1) *
- (let (x1, _) := idc_args0 in x1))%Z)%expr)
+ (##((let (x1, _) := xv in x1) *
+ (let (x1, _) := xv0 in x1))%Z)%expr)
else None
| None => None
end
@@ -2514,14 +1371,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args0) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
Some
(Base
- (##((let (x1, _) := idc_args in x1)
- ^ (let (x1, _) := idc_args0 in x1)))%expr)
+ (##((let (x1, _) := xv in x1)
+ ^ (let (x1, _) := xv0 in x1)))%expr)
else None
| None => None
end
@@ -2549,14 +1404,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args0) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
Some
(Base
- (##((let (x1, _) := idc_args in x1) -
- (let (x1, _) := idc_args0 in x1))%Z)%expr)
+ (##((let (x1, _) := xv in x1) -
+ (let (x1, _) := xv0 in x1))%Z)%expr)
else None
| None => None
end
@@ -2578,8 +1431,8 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
| Some _ =>
if type.type_beq base.type base.type.type_beq ℤ (projT1 args)
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- Some (Base (##(- (let (x0, _) := idc_args in x0))%Z)%expr)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ Some (Base (##(- (let (x0, _) := xv in x0))%Z)%expr)
else None
| None => None
end
@@ -2605,14 +1458,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args0) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
Some
(Base
- (##((let (x1, _) := idc_args in x1) /
- (let (x1, _) := idc_args0 in x1))%Z)%expr)
+ (##((let (x1, _) := xv in x1) /
+ (let (x1, _) := xv0 in x1))%Z)%expr)
else None
| None => None
end
@@ -2640,14 +1491,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args0) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
Some
(Base
- (##((let (x1, _) := idc_args in x1)
- mod (let (x1, _) := idc_args0 in x1))%Z)%expr)
+ (##((let (x1, _) := xv in x1)
+ mod (let (x1, _) := xv0 in x1))%Z)%expr)
else None
| None => None
end
@@ -2669,8 +1518,8 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
| Some _ =>
if type.type_beq base.type base.type.type_beq ℤ (projT1 args)
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- Some (Base (##(Z.log2 (let (x0, _) := idc_args in x0)))%expr)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ Some (Base (##(Z.log2 (let (x0, _) := xv in x0)))%expr)
else None
| None => None
end
@@ -2690,9 +1539,8 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
| Some _ =>
if type.type_beq base.type base.type.type_beq ℤ (projT1 args)
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- Some
- (Base (##(Z.log2_up (let (x0, _) := idc_args in x0)))%expr)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ Some (Base (##(Z.log2_up (let (x0, _) := xv in x0)))%expr)
else None
| None => None
end
@@ -2718,14 +1566,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args0) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
Some
(Base
- (##((let (x1, _) := idc_args in x1) =?
- (let (x1, _) := idc_args0 in x1)))%expr)
+ (##((let (x1, _) := xv in x1) =?
+ (let (x1, _) := xv0 in x1)))%expr)
else None
| None => None
end
@@ -2753,14 +1599,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args0) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
Some
(Base
- (##((let (x1, _) := idc_args in x1) <=?
- (let (x1, _) := idc_args0 in x1)))%expr)
+ (##((let (x1, _) := xv in x1) <=?
+ (let (x1, _) := xv0 in x1)))%expr)
else None
| None => None
end
@@ -2788,14 +1632,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args0) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
Some
(Base
- (##((let (x1, _) := idc_args in x1) >=?
- (let (x1, _) := idc_args0 in x1)))%expr)
+ (##((let (x1, _) := xv in x1) >=?
+ (let (x1, _) := xv0 in x1)))%expr)
else None
| None => None
end
@@ -2817,9 +1659,8 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
| Some _ =>
if type.type_beq base.type base.type.type_beq ℕ (projT1 args)
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- Some
- (Base (##(Z.of_nat (let (x0, _) := idc_args in x0)))%expr)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ Some (Base (##(Z.of_nat (let (x0, _) := xv in x0)))%expr)
else None
| None => None
end
@@ -2839,9 +1680,8 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
| Some _ =>
if type.type_beq base.type base.type.type_beq ℤ (projT1 args)
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- Some
- (Base (##(Z.to_nat (let (x0, _) := idc_args in x0)))%expr)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ Some (Base (##(Z.to_nat (let (x0, _) := xv in x0)))%expr)
else None
| None => None
end
@@ -2867,14 +1707,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args0) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
Some
(Base
- (##(Z.shiftr (let (x1, _) := idc_args in x1)
- (let (x1, _) := idc_args0 in x1)))%expr)
+ (##(Z.shiftr (let (x1, _) := xv in x1)
+ (let (x1, _) := xv0 in x1)))%expr)
else None
| None => None
end
@@ -2902,14 +1740,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args0) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
Some
(Base
- (##(Z.shiftl (let (x1, _) := idc_args in x1)
- (let (x1, _) := idc_args0 in x1)))%expr)
+ (##(Z.shiftl (let (x1, _) := xv in x1)
+ (let (x1, _) := xv0 in x1)))%expr)
else None
| None => None
end
@@ -2937,14 +1773,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args0) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
Some
(Base
- (##(Z.land (let (x1, _) := idc_args in x1)
- (let (x1, _) := idc_args0 in x1)))%expr)
+ (##(Z.land (let (x1, _) := xv in x1)
+ (let (x1, _) := xv0 in x1)))%expr)
else None
| None => None
end
@@ -2972,14 +1806,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args0) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
Some
(Base
- (##(Z.lor (let (x1, _) := idc_args in x1)
- (let (x1, _) := idc_args0 in x1)))%expr)
+ (##(Z.lor (let (x1, _) := xv in x1)
+ (let (x1, _) := xv0 in x1)))%expr)
else None
| None => None
end
@@ -3001,8 +1833,8 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
| Some _ =>
if type.type_beq base.type base.type.type_beq ℤ (projT1 args)
then
- idc_args <- ident.unify pattern.ident.Literal ##(projT2 args);
- Some (Base (##(Z.bneg (let (x0, _) := idc_args in x0)))%expr)
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args);
+ Some (Base (##(Z.bneg (let (x0, _) := xv in x0)))%expr)
else None
| None => None
end
@@ -3028,14 +1860,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args0) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
Some
(Base
- (##(Z.lnot_modulo (let (x1, _) := idc_args in x1)
- (let (x1, _) := idc_args0 in x1)))%expr)
+ (##(Z.lnot_modulo (let (x1, _) := xv in x1)
+ (let (x1, _) := xv0 in x1)))%expr)
else None
| None => None
end
@@ -3067,19 +1897,19 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((ℤ -> ℤ) -> ℤ)%ptype
(((projT1 args1) -> (projT1 args0)) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args1 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv1 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
Some
(Base
(let
'(a1, b1)%zrange :=
- Z.mul_split (let (x2, _) := idc_args in x2)
- (let (x2, _) := idc_args0 in x2)
- (let (x2, _) := idc_args1 in x2) in
+ Z.mul_split (let (x2, _) := xv in x2)
+ (let (x2, _) := xv0 in x2)
+ (let (x2, _) := xv1 in x2) in
((##a1)%expr, (##b1)%expr)%expr_pat))
else None
| None => None
@@ -3114,20 +1944,19 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((ℤ -> ℤ) -> ℤ)%ptype
(((projT1 args1) -> (projT1 args0)) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args1 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv1 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
Some
(Base
(let
'(a1, b1)%zrange :=
- Z.add_get_carry_full
- (let (x2, _) := idc_args in x2)
- (let (x2, _) := idc_args0 in x2)
- (let (x2, _) := idc_args1 in x2) in
+ Z.add_get_carry_full (let (x2, _) := xv in x2)
+ (let (x2, _) := xv0 in x2)
+ (let (x2, _) := xv1 in x2) in
((##a1)%expr, (##b1)%expr)%expr_pat))
else None
| None => None
@@ -3162,18 +1991,17 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((ℤ -> ℤ) -> ℤ)%ptype
(((projT1 args1) -> (projT1 args0)) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args1 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv1 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
Some
(Base
- (##(Z.add_with_carry
- (let (x2, _) := idc_args in x2)
- (let (x2, _) := idc_args0 in x2)
- (let (x2, _) := idc_args1 in x2)))%expr)
+ (##(Z.add_with_carry (let (x2, _) := xv in x2)
+ (let (x2, _) := xv0 in x2)
+ (let (x2, _) := xv1 in x2)))%expr)
else None
| None => None
end
@@ -3213,23 +2041,23 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((((projT1 args2) -> (projT1 args1)) ->
(projT1 args0)) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args2);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- idc_args1 <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args2 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ xv1 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv2 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
Some
(Base
(let
'(a2, b2)%zrange :=
Z.add_with_get_carry_full
- (let (x3, _) := idc_args in x3)
- (let (x3, _) := idc_args0 in x3)
- (let (x3, _) := idc_args1 in x3)
- (let (x3, _) := idc_args2 in x3) in
+ (let (x3, _) := xv in x3)
+ (let (x3, _) := xv0 in x3)
+ (let (x3, _) := xv1 in x3)
+ (let (x3, _) := xv2 in x3) in
((##a2)%expr, (##b2)%expr)%expr_pat))
else None
| None => None
@@ -3266,20 +2094,19 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((ℤ -> ℤ) -> ℤ)%ptype
(((projT1 args1) -> (projT1 args0)) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args1 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv1 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
Some
(Base
(let
'(a1, b1)%zrange :=
- Z.sub_get_borrow_full
- (let (x2, _) := idc_args in x2)
- (let (x2, _) := idc_args0 in x2)
- (let (x2, _) := idc_args1 in x2) in
+ Z.sub_get_borrow_full (let (x2, _) := xv in x2)
+ (let (x2, _) := xv0 in x2)
+ (let (x2, _) := xv1 in x2) in
((##a1)%expr, (##b1)%expr)%expr_pat))
else None
| None => None
@@ -3320,23 +2147,23 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((((projT1 args2) -> (projT1 args1)) ->
(projT1 args0)) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args2);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- idc_args1 <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args2 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ xv1 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv2 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
Some
(Base
(let
'(a2, b2)%zrange :=
Z.sub_with_get_borrow_full
- (let (x3, _) := idc_args in x3)
- (let (x3, _) := idc_args0 in x3)
- (let (x3, _) := idc_args1 in x3)
- (let (x3, _) := idc_args2 in x3) in
+ (let (x3, _) := xv in x3)
+ (let (x3, _) := xv0 in x3)
+ (let (x3, _) := xv1 in x3)
+ (let (x3, _) := xv2 in x3) in
((##a2)%expr, (##b2)%expr)%expr_pat))
else None
| None => None
@@ -3373,17 +2200,17 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((ℤ -> ℤ) -> ℤ)%ptype
(((projT1 args1) -> (projT1 args0)) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args1 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv1 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
Some
(Base
- (##(Z.zselect (let (x2, _) := idc_args in x2)
- (let (x2, _) := idc_args0 in x2)
- (let (x2, _) := idc_args1 in x2)))%expr)
+ (##(Z.zselect (let (x2, _) := xv in x2)
+ (let (x2, _) := xv0 in x2)
+ (let (x2, _) := xv1 in x2)))%expr)
else None
| None => None
end
@@ -3417,17 +2244,17 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((ℤ -> ℤ) -> ℤ)%ptype
(((projT1 args1) -> (projT1 args0)) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args1 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv1 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
Some
(Base
- (##(Z.add_modulo (let (x2, _) := idc_args in x2)
- (let (x2, _) := idc_args0 in x2)
- (let (x2, _) := idc_args1 in x2)))%expr)
+ (##(Z.add_modulo (let (x2, _) := xv in x2)
+ (let (x2, _) := xv0 in x2)
+ (let (x2, _) := xv1 in x2)))%expr)
else None
| None => None
end
@@ -3467,20 +2294,20 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
((((projT1 args2) -> (projT1 args1)) ->
(projT1 args0)) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args2);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- idc_args1 <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args2 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ xv1 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv2 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
Some
(Base
- (##(Z.rshi (let (x3, _) := idc_args in x3)
- (let (x3, _) := idc_args0 in x3)
- (let (x3, _) := idc_args1 in x3)
- (let (x3, _) := idc_args2 in x3)))%expr)
+ (##(Z.rshi (let (x3, _) := xv in x3)
+ (let (x3, _) := xv0 in x3)
+ (let (x3, _) := xv1 in x3)
+ (let (x3, _) := xv2 in x3)))%expr)
else None
| None => None
end
@@ -3512,14 +2339,12 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
type.type_beq base.type base.type.type_beq (ℤ -> ℤ)%ptype
((projT1 args0) -> (projT1 args))%ptype
then
- idc_args <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
Some
(Base
- (##(Z.cc_m (let (x1, _) := idc_args in x1)
- (let (x1, _) := idc_args0 in x1)))%expr)
+ (##(Z.cc_m (let (x1, _) := xv in x1)
+ (let (x1, _) := xv0 in x1)))%expr)
else None
| None => None
end
@@ -3600,17 +2425,14 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
then
_ <- ident.unify pattern.ident.pair pair;
_ <- ident.unify pattern.ident.pair pair;
- idc_args1 <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- idc_args2 <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args3 <- ident.unify pattern.ident.Literal ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args1);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv1 <- ident.unify pattern.ident.Literal ##(projT2 args);
Some
(Base
(##(fancy.interp (invert_Some (to_fancy fancy_selc))
- (let (x4, _) := idc_args1 in x4,
- let (x4, _) := idc_args2 in x4,
- let (x4, _) := idc_args3 in x4)%zrange))%expr)
+ (let (x4, _) := xv in x4, let (x4, _) := xv0 in x4,
+ let (x4, _) := xv1 in x4)%zrange))%expr)
else None
| None => None
end
@@ -3708,17 +2530,14 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
then
_ <- ident.unify pattern.ident.pair pair;
_ <- ident.unify pattern.ident.pair pair;
- idc_args1 <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- idc_args2 <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args3 <- ident.unify pattern.ident.Literal ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args1);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv1 <- ident.unify pattern.ident.Literal ##(projT2 args);
Some
(Base
(##(fancy.interp (invert_Some (to_fancy fancy_sell))
- (let (x4, _) := idc_args1 in x4,
- let (x4, _) := idc_args2 in x4,
- let (x4, _) := idc_args3 in x4)%zrange))%expr)
+ (let (x4, _) := xv in x4, let (x4, _) := xv0 in x4,
+ let (x4, _) := xv1 in x4)%zrange))%expr)
else None
| None => None
end
@@ -3813,17 +2632,14 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
then
_ <- ident.unify pattern.ident.pair pair;
_ <- ident.unify pattern.ident.pair pair;
- idc_args1 <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- idc_args2 <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- idc_args3 <- ident.unify pattern.ident.Literal ##(projT2 args);
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args1);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv1 <- ident.unify pattern.ident.Literal ##(projT2 args);
Some
(Base
(##(fancy.interp (invert_Some (to_fancy fancy_addm))
- (let (x4, _) := idc_args1 in x4,
- let (x4, _) := idc_args2 in x4,
- let (x4, _) := idc_args3 in x4)%zrange))%expr)
+ (let (x4, _) := xv in x4, let (x4, _) := xv0 in x4,
+ let (x4, _) := xv1 in x4)%zrange))%expr)
else None
| None => None
end
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-06 02:27:03 +0000