aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorGravatar Jason Gross <jgross@mit.edu>2018-12-11 16:53:48 -0500
committerGravatar Jason Gross <jasongross9@gmail.com>2018-12-12 18:40:41 -0500
commit2688eef101a504648f627b78485b2b87faa12bd7 (patch)
tree48d91e415c276fee89fb10f00cb9781b3c24c9c7 /src
parentd05f8ec1acb3935af95c80f502af6f2f1fdd5bf6 (diff)
Move fancy rewrites after bounds analysis
Now they are all actually proven. We also add zrange arguments for value and flag, in preparation for things Jade wants to do. Unfortunately, some things got much slower, because the rewriter meta-compilation phase is nonlinear in the number of rewrite rules. After | File Name | Before || Change | % Change -------------------------------------------------------------------------------------------------------------------- 29m31.98s | Total | 26m34.58s || +2m57.39s | +11.12% -------------------------------------------------------------------------------------------------------------------- 2m06.72s | Experiments/NewPipeline/Rewriter.vo | 0m34.70s || +1m32.01s | +265.18% 1m44.58s | Experiments/NewPipeline/RewriterRulesGood.vo | 0m55.12s || +0m49.46s | +89.73% 1m51.98s | Experiments/NewPipeline/RewriterRulesInterpGood.vo | 1m47.38s || +0m04.59s | +4.28% 0m44.83s | Experiments/NewPipeline/ExtractionOCaml/word_by_word_montgomery | 0m40.58s || +0m04.25s | +10.47% 0m29.46s | Experiments/NewPipeline/ExtractionHaskell/unsaturated_solinas | 0m24.94s || +0m04.51s | +18.12% 0m26.62s | Experiments/NewPipeline/ExtractionOCaml/unsaturated_solinas | 0m21.95s || +0m04.67s | +21.27% 0m22.75s | Experiments/NewPipeline/ExtractionHaskell/saturated_solinas | 0m18.07s || +0m04.67s | +25.89% 0m18.44s | Experiments/NewPipeline/ExtractionOCaml/saturated_solinas | 0m13.97s || +0m04.47s | +31.99% 0m43.64s | Experiments/NewPipeline/ExtractionHaskell/word_by_word_montgomery | 0m40.11s || +0m03.53s | +8.80% 1m58.64s | Experiments/NewPipeline/RewriterWf2.vo | 1m55.94s || +0m02.70s | +2.32% 6m13.06s | Experiments/NewPipeline/SlowPrimeSynthesisExamples.vo | 6m11.83s || +0m01.23s | +0.33% 4m37.06s | Experiments/NewPipeline/Toplevel1.vo | 4m38.14s || -0m01.07s | -0.38% 3m13.92s | p384_32.c | 3m15.11s || -0m01.19s | -0.60% 1m32.26s | Experiments/NewPipeline/Toplevel2.vo | 1m31.34s || +0m00.91s | +1.00% 0m39.36s | p521_32.c | 0m39.90s || -0m00.53s | -1.35% 0m32.61s | p521_64.c | 0m33.49s || -0m00.88s | -2.62% 0m19.77s | Experiments/NewPipeline/RewriterWf1.vo | 0m19.44s || +0m00.32s | +1.69% 0m13.76s | secp256k1_32.c | 0m13.43s || +0m00.33s | +2.45% 0m13.50s | p256_32.c | 0m13.55s || -0m00.05s | -0.36% 0m10.64s | p384_64.c | 0m10.62s || +0m00.02s | +0.18% 0m09.70s | Experiments/NewPipeline/ExtractionOCaml/word_by_word_montgomery.ml | 0m09.04s || +0m00.66s | +7.30% 0m06.47s | Experiments/NewPipeline/ExtractionOCaml/unsaturated_solinas.ml | 0m06.05s || +0m00.41s | +6.94% 0m06.39s | Experiments/NewPipeline/ExtractionHaskell/word_by_word_montgomery.hs | 0m05.87s || +0m00.51s | +8.85% 0m06.24s | p224_32.c | 0m06.23s || +0m00.00s | +0.16% 0m04.98s | Experiments/NewPipeline/ExtractionOCaml/saturated_solinas.ml | 0m04.47s || +0m00.51s | +11.40% 0m04.88s | Experiments/NewPipeline/ExtractionHaskell/unsaturated_solinas.hs | 0m04.26s || +0m00.62s | +14.55% 0m04.08s | Experiments/NewPipeline/ExtractionHaskell/saturated_solinas.hs | 0m03.58s || +0m00.50s | +13.96% 0m02.22s | curve25519_32.c | 0m02.37s || -0m00.14s | -6.32% 0m02.04s | p224_64.c | 0m01.92s || +0m00.12s | +6.25% 0m01.99s | secp256k1_64.c | 0m01.91s || +0m00.08s | +4.18% 0m01.84s | p256_64.c | 0m02.01s || -0m00.16s | -8.45% 0m01.50s | curve25519_64.c | 0m01.49s || +0m00.01s | +0.67% 0m01.42s | Experiments/NewPipeline/CLI.vo | 0m01.42s || +0m00.00s | +0.00% 0m01.29s | Experiments/NewPipeline/StandaloneHaskellMain.vo | 0m01.27s || +0m00.02s | +1.57% 0m01.26s | Experiments/NewPipeline/StandaloneOCamlMain.vo | 0m01.23s || +0m00.03s | +2.43% 0m01.12s | Experiments/NewPipeline/CompilersTestCases.vo | 0m00.92s || +0m00.20s | +21.73% 0m00.96s | Experiments/NewPipeline/RewriterProofs.vo | 0m00.94s || +0m00.02s | +2.12%
Diffstat (limited to 'src')
-rw-r--r--src/Experiments/NewPipeline/Rewriter.v384
-rw-r--r--src/Experiments/NewPipeline/RewriterProofs.v11
-rw-r--r--src/Experiments/NewPipeline/RewriterRulesGood.v17
-rw-r--r--src/Experiments/NewPipeline/RewriterRulesInterpGood.v405
-rw-r--r--src/Experiments/NewPipeline/Toplevel1.v21
-rw-r--r--src/Experiments/NewPipeline/fancy_rewrite_head.out2027
-rw-r--r--src/Experiments/NewPipeline/fancy_with_casts_rewrite_head.out8130
7 files changed, 8693 insertions, 2302 deletions
diff --git a/src/Experiments/NewPipeline/Rewriter.v b/src/Experiments/NewPipeline/Rewriter.v
index 1acc614eb..c1ef61e39 100644
--- a/src/Experiments/NewPipeline/Rewriter.v
+++ b/src/Experiments/NewPipeline/Rewriter.v
@@ -2008,8 +2008,28 @@ Module Compilers.
:= @assemble_identifier_rewriters arith_with_casts_dtree arith_with_casts_all_rewrite_rules do_again t idc.
Section fancy.
- Context (invert_low invert_high : Z (*log2wordmax*) -> Z -> option Z).
+ Context (invert_low invert_high : Z (*log2wordmax*) -> Z -> option Z)
+ (value_range flag_range : zrange).
Definition fancy_rewrite_rules : rewrite_rulesT
+ := [].
+
+ Local Notation pcst v := (#pattern.ident.Z_cast @ v)%pattern.
+ Local Notation pcst2 v := (#pattern.ident.Z_cast2 @ v)%pattern.
+
+ Local Coercion ZRange.constant : Z >-> zrange. (* for ease of use with sanity-checking bounds *)
+ Let bounds1_good (f : zrange -> zrange) (output x_bs : zrange)
+ := is_tighter_than_bool (f (ZRange.normalize x_bs)) (ZRange.normalize output).
+ Let bounds2_good (f : zrange -> zrange -> zrange) (output x_bs y_bs : zrange)
+ := is_tighter_than_bool (f (ZRange.normalize x_bs) (ZRange.normalize y_bs)) (ZRange.normalize output).
+ Let range_in_bitwidth r s
+ := is_tighter_than_bool (ZRange.normalize r) r[0~>s-1]%zrange.
+ Local Notation shiftl_good := (bounds2_good ZRange.shiftl).
+ Local Notation shiftr_good := (bounds2_good ZRange.shiftr).
+ Local Notation land_good := (bounds2_good ZRange.land).
+ Local Notation mul_good := (bounds2_good ZRange.mul).
+ Local Notation cc_m_good output s := (bounds1_good (ZRange.cc_m s) output).
+
+ Definition fancy_with_casts_rewrite_rules : rewrite_rulesT
:= [
(*
(Z.add_get_carry_concrete 2^256) @@ (?x, ?y << 128) --> (add 128) @@ (x, y)
@@ -2019,20 +2039,42 @@ Module Compilers.
(Z.add_get_carry_concrete 2^256) @@ (?x, ?y) --> (add 0) @@ (y, x)
*)
make_rewriteo
- (#pattern.ident.Z_add_get_carry @ #?ℤ @ ?? @ (#pattern.ident.Z_shiftl @ ?? @ #?ℤ))
- (fun s x y offset => #(ident.fancy_add (Z.log2 s) offset) @ (x, y) when s =? 2^Z.log2 s)
+ (pcst2 (#pattern.ident.Z_add_get_carry @ #?ℤ @ ??' @ (pcst (#pattern.ident.Z_shiftl @ ??' @ #?ℤ))))
+ (fun '((r1, r2)%core) s rx x rshiftl ry y offset => cst2 (r1, r2)%core (#(ident.fancy_add (Z.log2 s) offset) @ (cst rx x, cst ry y)) when (s =? 2^Z.log2 s) && shiftl_good rshiftl ry offset && range_in_bitwidth rshiftl s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_add_get_carry @ #?ℤ @ #?ℤ @ (pcst (#pattern.ident.Z_shiftl @ ??' @ #?ℤ))))
+ (fun '((r1, r2)%core) s xx rshiftl ry y offset => cst2 (r1, r2)%core (#(ident.fancy_add (Z.log2 s) offset) @ (##xx, cst ry y)) when (s =? 2^Z.log2 s) && shiftl_good rshiftl ry offset && range_in_bitwidth rshiftl s)
+
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_add_get_carry @ #?ℤ @ (pcst (#pattern.ident.Z_shiftl @ ??' @ #?ℤ)) @ ??'))
+ (fun '((r1, r2)%core) s rshiftl ry y offset rx x => cst2 (r1, r2)%core (#(ident.fancy_add (Z.log2 s) offset) @ (cst rx x, cst ry y)) when (s =? 2^Z.log2 s) && shiftl_good rshiftl ry offset && range_in_bitwidth rshiftl s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_add_get_carry @ #?ℤ @ (pcst (#pattern.ident.Z_shiftl @ ??' @ #?ℤ)) @ #?ℤ))
+ (fun '((r1, r2)%core) s rshiftl ry y offset xx => cst2 (r1, r2)%core (#(ident.fancy_add (Z.log2 s) offset) @ (##xx, cst ry y)) when (s =? 2^Z.log2 s) && shiftl_good rshiftl ry offset && range_in_bitwidth rshiftl s)
+
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_add_get_carry @ #?ℤ @ ??' @ (pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ))))
+ (fun '((r1, r2)%core) s rx x rshiftr ry y offset => cst2 (r1, r2)%core (#(ident.fancy_add (Z.log2 s) (-offset)) @ (cst rx x, cst ry y)) when (s =? 2^Z.log2 s) && shiftr_good rshiftr ry offset && range_in_bitwidth rshiftr s)
; make_rewriteo
- (#pattern.ident.Z_add_get_carry @ #?ℤ @ (#pattern.ident.Z_shiftl @ ?? @ #?ℤ) @ ??)
- (fun s y offset x => #(ident.fancy_add (Z.log2 s) offset) @ (x, y) when s =? 2^Z.log2 s)
+ (pcst2 (#pattern.ident.Z_add_get_carry @ #?ℤ @ #?ℤ @ (pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ))))
+ (fun '((r1, r2)%core) s xx rshiftr ry y offset => cst2 (r1, r2)%core (#(ident.fancy_add (Z.log2 s) (-offset)) @ (##xx, cst ry y)) when (s =? 2^Z.log2 s) && shiftr_good rshiftr ry offset && range_in_bitwidth rshiftr s)
+
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_add_get_carry @ #?ℤ @ pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ) @ ??'))
+ (fun '((r1, r2)%core) s rshiftr ry y offset rx x => cst2 (r1, r2)%core (#(ident.fancy_add (Z.log2 s) (-offset)) @ (cst rx x, cst ry y)) when (s =? 2^Z.log2 s) && shiftr_good rshiftr ry offset && range_in_bitwidth rshiftr s)
; make_rewriteo
- (#pattern.ident.Z_add_get_carry @ #?ℤ @ ?? @ (#pattern.ident.Z_shiftr @ ?? @ #?ℤ))
- (fun s x y offset => #(ident.fancy_add (Z.log2 s) (-offset)) @ (x, y) when s =? 2^Z.log2 s)
+ (pcst2 (#pattern.ident.Z_add_get_carry @ #?ℤ @ pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ) @ #?ℤ))
+ (fun '((r1, r2)%core) s rshiftr ry y offset xx => cst2 (r1, r2)%core (#(ident.fancy_add (Z.log2 s) (-offset)) @ (##xx, cst ry y)) when (s =? 2^Z.log2 s) && shiftr_good rshiftr ry offset && range_in_bitwidth rshiftr s)
+
; make_rewriteo
- (#pattern.ident.Z_add_get_carry @ #?ℤ @ (#pattern.ident.Z_shiftr @ ?? @ #?ℤ) @ ??)
- (fun s y offset x => #(ident.fancy_add (Z.log2 s) (-offset)) @ (x, y) when s =? 2^Z.log2 s)
+ (pcst2 (#pattern.ident.Z_add_get_carry @ #?ℤ @ ??' @ ??'))
+ (fun '((r1, r2)%core) s rx x ry y => cst2 (r1, r2)%core (#(ident.fancy_add (Z.log2 s) 0) @ (cst rx x, cst ry y)) when (s =? 2^Z.log2 s) && range_in_bitwidth ry s)
; make_rewriteo
- (#pattern.ident.Z_add_get_carry @ #?ℤ @ ?? @ ??)
- (fun s x y => #(ident.fancy_add (Z.log2 s) 0) @ (x, y) when s =? 2^Z.log2 s)
+ (pcst2 (#pattern.ident.Z_add_get_carry @ #?ℤ @ ??' @ #?ℤ))
+ (fun '((r1, r2)%core) s rx x yy => cst2 (r1, r2)%core (#(ident.fancy_add (Z.log2 s) 0) @ (cst rx x, ##yy)) when (s =? 2^Z.log2 s) && range_in_bitwidth yy s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_add_get_carry @ #?ℤ @ #?ℤ @ ??'))
+ (fun '((r1, r2)%core) s xx ry y => cst2 (r1, r2)%core (#(ident.fancy_add (Z.log2 s) 0) @ (##xx, cst ry y)) when (s =? 2^Z.log2 s) && range_in_bitwidth ry s)
(*
(Z.add_with_get_carry_concrete 2^256) @@ (?c, ?x, ?y << 128) --> (addc 128) @@ (c, x, y)
(Z.add_with_get_carry_concrete 2^256) @@ (?c, ?x << 128, ?y) --> (addc 128) @@ (c, y, x)
@@ -2041,69 +2083,217 @@ Module Compilers.
(Z.add_with_get_carry_concrete 2^256) @@ (?c, ?x, ?y) --> (addc 0) @@ (c, y, x)
*)
; make_rewriteo
- (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ ?? @ ?? @ (#pattern.ident.Z_shiftl @ ?? @ #?ℤ))
- (fun s c x y offset => #(ident.fancy_addc (Z.log2 s) offset) @ (c, x, y) when s =? 2^Z.log2 s)
+ (pcst2 (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ ??' @ ??' @ pcst (#pattern.ident.Z_shiftl @ ??' @ #?ℤ)))
+ (fun '((r1, r2)%core) s rc c rx x rshiftl ry y offset => cst2 (r1, r2)%core (#(ident.fancy_addc (Z.log2 s) offset) @ (cst rc c, cst rx x, cst ry y)) when (s =? 2^Z.log2 s) && shiftl_good rshiftl ry offset && range_in_bitwidth rshiftl s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ #?ℤ @ ??' @ pcst (#pattern.ident.Z_shiftl @ ??' @ #?ℤ)))
+ (fun '((r1, r2)%core) s cc rx x rshiftl ry y offset => cst2 (r1, r2)%core (#(ident.fancy_addc (Z.log2 s) offset) @ (##cc, cst rx x, cst ry y)) when (s =? 2^Z.log2 s) && shiftl_good rshiftl ry offset && range_in_bitwidth rshiftl s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ ??' @ #?ℤ @ pcst (#pattern.ident.Z_shiftl @ ??' @ #?ℤ)))
+ (fun '((r1, r2)%core) s rc c xx rshiftl ry y offset => cst2 (r1, r2)%core (#(ident.fancy_addc (Z.log2 s) offset) @ (cst rc c, ##xx, cst ry y)) when (s =? 2^Z.log2 s) && shiftl_good rshiftl ry offset && range_in_bitwidth rshiftl s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ #?ℤ @ #?ℤ @ pcst (#pattern.ident.Z_shiftl @ ??' @ #?ℤ)))
+ (fun '((r1, r2)%core) s cc xx rshiftl ry y offset => cst2 (r1, r2)%core (#(ident.fancy_addc (Z.log2 s) offset) @ (##cc, ##xx, cst ry y)) when (s =? 2^Z.log2 s) && shiftl_good rshiftl ry offset && range_in_bitwidth rshiftl s)
+
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ ??' @ pcst (#pattern.ident.Z_shiftl @ ??' @ #?ℤ) @ ??'))
+ (fun '((r1, r2)%core) s rc c rshiftl ry y offset rx x => cst2 (r1, r2)%core (#(ident.fancy_addc (Z.log2 s) offset) @ (cst rc c, cst rx x, cst ry y)) when (s =? 2^Z.log2 s) && shiftl_good rshiftl ry offset && range_in_bitwidth rshiftl s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ #?ℤ @ pcst (#pattern.ident.Z_shiftl @ ??' @ #?ℤ) @ ??'))
+ (fun '((r1, r2)%core) s cc rshiftl ry y offset rx x => cst2 (r1, r2)%core (#(ident.fancy_addc (Z.log2 s) offset) @ (##cc, cst rx x, cst ry y)) when (s =? 2^Z.log2 s) && shiftl_good rshiftl ry offset && range_in_bitwidth rshiftl s)
; make_rewriteo
- (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ ?? @ (#pattern.ident.Z_shiftl @ ?? @ #?ℤ) @ ??)
- (fun s c y offset x => #(ident.fancy_addc (Z.log2 s) offset) @ (c, x, y) when s =? 2^Z.log2 s)
+ (pcst2 (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ ??' @ pcst (#pattern.ident.Z_shiftl @ ??' @ #?ℤ) @ #?ℤ))
+ (fun '((r1, r2)%core) s rc c rshiftl ry y offset xx => cst2 (r1, r2)%core (#(ident.fancy_addc (Z.log2 s) offset) @ (cst rc c, ##xx, cst ry y)) when (s =? 2^Z.log2 s) && shiftl_good rshiftl ry offset && range_in_bitwidth rshiftl s)
; make_rewriteo
- (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ ?? @ ?? @ (#pattern.ident.Z_shiftr @ ?? @ #?ℤ))
- (fun s c x y offset => #(ident.fancy_addc (Z.log2 s) (-offset)) @ (c, x, y) when s =? 2^Z.log2 s)
+ (pcst2 (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ #?ℤ @ pcst (#pattern.ident.Z_shiftl @ ??' @ #?ℤ) @ #?ℤ))
+ (fun '((r1, r2)%core) s cc rshiftl ry y offset xx => cst2 (r1, r2)%core (#(ident.fancy_addc (Z.log2 s) offset) @ (##cc, ##xx, cst ry y)) when (s =? 2^Z.log2 s) && shiftl_good rshiftl ry offset && range_in_bitwidth rshiftl s)
+
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ ??' @ ??' @ pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ)))
+ (fun '((r1, r2)%core) s rc c rx x rshiftr ry y offset => cst2 (r1, r2)%core (#(ident.fancy_addc (Z.log2 s) (-offset)) @ (cst rc c, cst rx x, cst ry y)) when (s =? 2^Z.log2 s) && shiftr_good rshiftr ry offset && range_in_bitwidth rshiftr s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ #?ℤ @ ??' @ pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ)))
+ (fun '((r1, r2)%core) s cc rx x rshiftr ry y offset => cst2 (r1, r2)%core (#(ident.fancy_addc (Z.log2 s) (-offset)) @ (##cc, cst rx x, cst ry y)) when (s =? 2^Z.log2 s) && shiftr_good rshiftr ry offset && range_in_bitwidth rshiftr s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ ??' @ #?ℤ @ pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ)))
+ (fun '((r1, r2)%core) s rc c xx rshiftr ry y offset => cst2 (r1, r2)%core (#(ident.fancy_addc (Z.log2 s) (-offset)) @ (cst rc c, ##xx, cst ry y)) when (s =? 2^Z.log2 s) && shiftr_good rshiftr ry offset && range_in_bitwidth rshiftr s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ #?ℤ @ #?ℤ @ pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ)))
+ (fun '((r1, r2)%core) s cc xx rshiftr ry y offset => cst2 (r1, r2)%core (#(ident.fancy_addc (Z.log2 s) (-offset)) @ (##cc, ##xx, cst ry y)) when (s =? 2^Z.log2 s) && shiftr_good rshiftr ry offset && range_in_bitwidth rshiftr s)
+
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ ??' @ pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ) @ ??'))
+ (fun '((r1, r2)%core) s rc c rshiftr ry y offset rx x => cst2 (r1, r2)%core (#(ident.fancy_addc (Z.log2 s) (-offset)) @ (cst rc c, cst rx x, cst ry y)) when (s =? 2^Z.log2 s) && shiftr_good rshiftr ry offset && range_in_bitwidth rshiftr s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ #?ℤ @ pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ) @ ??'))
+ (fun '((r1, r2)%core) s cc rshiftr ry y offset rx x => cst2 (r1, r2)%core (#(ident.fancy_addc (Z.log2 s) (-offset)) @ (##cc, cst rx x, cst ry y)) when (s =? 2^Z.log2 s) && shiftr_good rshiftr ry offset && range_in_bitwidth rshiftr s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ ??' @ pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ) @ #?ℤ))
+ (fun '((r1, r2)%core) s rc c rshiftr ry y offset xx => cst2 (r1, r2)%core (#(ident.fancy_addc (Z.log2 s) (-offset)) @ (cst rc c, ##xx, cst ry y)) when (s =? 2^Z.log2 s) && shiftr_good rshiftr ry offset && range_in_bitwidth rshiftr s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ #?ℤ @ pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ) @ #?ℤ))
+ (fun '((r1, r2)%core) s cc rshiftr ry y offset xx => cst2 (r1, r2)%core (#(ident.fancy_addc (Z.log2 s) (-offset)) @ (##cc, ##xx, cst ry y)) when (s =? 2^Z.log2 s) && shiftr_good rshiftr ry offset && range_in_bitwidth rshiftr s)
+
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ ??' @ ??' @ ??'))
+ (fun '((r1, r2)%core) s rc c rx x ry y => cst2 (r1, r2)%core (#(ident.fancy_addc (Z.log2 s) 0) @ (cst rc c, cst rx x, cst ry y)) when (s =? 2^Z.log2 s) && range_in_bitwidth ry s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ #?ℤ @ ??' @ ??'))
+ (fun '((r1, r2)%core) s cc rx x ry y => cst2 (r1, r2)%core (#(ident.fancy_addc (Z.log2 s) 0) @ (##cc, cst rx x, cst ry y)) when (s =? 2^Z.log2 s) && range_in_bitwidth ry s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ ??' @ #?ℤ @ ??'))
+ (fun '((r1, r2)%core) s rc c xx ry y => cst2 (r1, r2)%core (#(ident.fancy_addc (Z.log2 s) 0) @ (cst rc c, ##xx, cst ry y)) when (s =? 2^Z.log2 s) && range_in_bitwidth ry s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ ??' @ ??' @ #?ℤ))
+ (fun '((r1, r2)%core) s rc c rx x yy => cst2 (r1, r2)%core (#(ident.fancy_addc (Z.log2 s) 0) @ (cst rc c, cst rx x, ##yy)) when (s =? 2^Z.log2 s) && range_in_bitwidth yy s)
; make_rewriteo
- (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ ?? @ (#pattern.ident.Z_shiftr @ ?? @ #?ℤ) @ ??)
- (fun s c y offset x => #(ident.fancy_addc (Z.log2 s) (-offset)) @ (c, x, y) when s =? 2^Z.log2 s)
+ (pcst2 (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ #?ℤ @ #?ℤ @ ??'))
+ (fun '((r1, r2)%core) s cc xx ry y => cst2 (r1, r2)%core (#(ident.fancy_addc (Z.log2 s) 0) @ (##cc, ##xx, cst ry y)) when (s =? 2^Z.log2 s) && range_in_bitwidth ry s)
; make_rewriteo
- (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ ?? @ ?? @ ??)
- (fun s c x y => #(ident.fancy_addc (Z.log2 s) 0) @ (c, x, y) when s =? 2^Z.log2 s)
+ (pcst2 (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ #?ℤ @ ??' @ #?ℤ))
+ (fun '((r1, r2)%core) s cc rx x yy => cst2 (r1, r2)%core (#(ident.fancy_addc (Z.log2 s) 0) @ (##cc, cst rx x, ##yy)) when (s =? 2^Z.log2 s) && range_in_bitwidth yy s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_add_with_get_carry @ #?ℤ @ ??' @ #?ℤ @ #?ℤ))
+ (fun '((r1, r2)%core) s rc c xx yy => cst2 (r1, r2)%core (#(ident.fancy_addc (Z.log2 s) 0) @ (cst rc c, ##xx, ##yy)) when (s =? 2^Z.log2 s) && range_in_bitwidth yy s)
(*
(Z.sub_get_borrow_concrete 2^256) @@ (?x, ?y << 128) --> (sub 128) @@ (x, y)
(Z.sub_get_borrow_concrete 2^256) @@ (?x, ?y >> 128) --> (sub (- 128)) @@ (x, y)
(Z.sub_get_borrow_concrete 2^256) @@ (?x, ?y) --> (sub 0) @@ (y, x)
*)
; make_rewriteo
- (#pattern.ident.Z_sub_get_borrow @ #?ℤ @ ?? @ (#pattern.ident.Z_shiftl @ ?? @ #?ℤ))
- (fun s x y offset => #(ident.fancy_sub (Z.log2 s) offset) @ (x, y) when s =? 2^Z.log2 s)
+ (pcst2 (#pattern.ident.Z_sub_get_borrow @ #?ℤ @ ??' @ pcst (#pattern.ident.Z_shiftl @ ??' @ #?ℤ)))
+ (fun '((r1, r2)%core) s rx x rshiftl ry y offset => cst2 (r1, r2)%core (#(ident.fancy_sub (Z.log2 s) offset) @ (cst rx x, cst ry y)) when (s =? 2^Z.log2 s) && shiftl_good rshiftl ry offset && range_in_bitwidth rshiftl s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_sub_get_borrow @ #?ℤ @ #?ℤ @ pcst (#pattern.ident.Z_shiftl @ ??' @ #?ℤ)))
+ (fun '((r1, r2)%core) s xx rshiftl ry y offset => cst2 (r1, r2)%core (#(ident.fancy_sub (Z.log2 s) offset) @ (##xx, cst ry y)) when (s =? 2^Z.log2 s) && shiftl_good rshiftl ry offset && range_in_bitwidth rshiftl s)
+
; make_rewriteo
- (#pattern.ident.Z_sub_get_borrow @ #?ℤ @ ?? @ (#pattern.ident.Z_shiftr @ ?? @ #?ℤ))
- (fun s x y offset => #(ident.fancy_sub (Z.log2 s) (-offset)) @ (x, y) when s =? 2^Z.log2 s)
+ (pcst2 (#pattern.ident.Z_sub_get_borrow @ #?ℤ @ ??' @ pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ)))
+ (fun '((r1, r2)%core) s rx x rshiftr ry y offset => cst2 (r1, r2)%core (#(ident.fancy_sub (Z.log2 s) (-offset)) @ (cst rx x, cst ry y)) when (s =? 2^Z.log2 s) && shiftr_good rshiftr ry offset && range_in_bitwidth rshiftr s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_sub_get_borrow @ #?ℤ @ #?ℤ @ pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ)))
+ (fun '((r1, r2)%core) s xx rshiftr ry y offset => cst2 (r1, r2)%core (#(ident.fancy_sub (Z.log2 s) (-offset)) @ (##xx, cst ry y)) when (s =? 2^Z.log2 s) && shiftr_good rshiftr ry offset && range_in_bitwidth rshiftr s)
+
; make_rewriteo
- (#pattern.ident.Z_sub_get_borrow @ #?ℤ @ ?? @ ??)
- (fun s x y => #(ident.fancy_sub (Z.log2 s) 0) @ (x, y) when s =? 2^Z.log2 s)
+ (pcst2 (#pattern.ident.Z_sub_get_borrow @ #?ℤ @ ??' @ ??'))
+ (fun '((r1, r2)%core) s rx x ry y => cst2 (r1, r2)%core (#(ident.fancy_sub (Z.log2 s) 0) @ (cst rx x, cst ry y)) when (s =? 2^Z.log2 s) && range_in_bitwidth ry s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_sub_get_borrow @ #?ℤ @ #?ℤ @ ??'))
+ (fun '((r1, r2)%core) s xx ry y => cst2 (r1, r2)%core (#(ident.fancy_sub (Z.log2 s) 0) @ (##xx, cst ry y)) when (s =? 2^Z.log2 s) && range_in_bitwidth ry s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_sub_get_borrow @ #?ℤ @ ??' @ #?ℤ))
+ (fun '((r1, r2)%core) s rx x yy => cst2 (r1, r2)%core (#(ident.fancy_sub (Z.log2 s) 0) @ (cst rx x, ##yy)) when (s =? 2^Z.log2 s) && range_in_bitwidth yy s)
(*
(Z.sub_with_get_borrow_concrete 2^256) @@ (?c, ?x, ?y << 128) --> (subb 128) @@ (c, x, y)
(Z.sub_with_get_borrow_concrete 2^256) @@ (?c, ?x, ?y >> 128) --> (subb (- 128)) @@ (c, x, y)
(Z.sub_with_get_borrow_concrete 2^256) @@ (?c, ?x, ?y) --> (subb 0) @@ (c, y, x)
*)
; make_rewriteo
- (#pattern.ident.Z_sub_with_get_borrow @ #?ℤ @ ?? @ ?? @ (#pattern.ident.Z_shiftl @ ?? @ #?ℤ))
- (fun s b x y offset => #(ident.fancy_subb (Z.log2 s) offset) @ (b, x, y) when s =? 2^Z.log2 s)
+ (pcst2 (#pattern.ident.Z_sub_with_get_borrow @ #?ℤ @ ??' @ ??' @ pcst (#pattern.ident.Z_shiftl @ ??' @ #?ℤ)))
+ (fun '((r1, r2)%core) s rb b rx x rshiftl ry y offset => cst2 (r1, r2)%core (#(ident.fancy_subb (Z.log2 s) offset) @ (cst rb b, cst rx x, cst ry y)) when (s =? 2^Z.log2 s) && shiftl_good rshiftl ry offset && range_in_bitwidth rshiftl s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_sub_with_get_borrow @ #?ℤ @ #?ℤ @ ??' @ pcst (#pattern.ident.Z_shiftl @ ??' @ #?ℤ)))
+ (fun '((r1, r2)%core) s bb rx x rshiftl ry y offset => cst2 (r1, r2)%core (#(ident.fancy_subb (Z.log2 s) offset) @ (##bb, cst rx x, cst ry y)) when (s =? 2^Z.log2 s) && shiftl_good rshiftl ry offset && range_in_bitwidth rshiftl s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_sub_with_get_borrow @ #?ℤ @ ??' @ #?ℤ @ pcst (#pattern.ident.Z_shiftl @ ??' @ #?ℤ)))
+ (fun '((r1, r2)%core) s rb b xx rshiftl ry y offset => cst2 (r1, r2)%core (#(ident.fancy_subb (Z.log2 s) offset) @ (cst rb b, ##xx, cst ry y)) when (s =? 2^Z.log2 s) && shiftl_good rshiftl ry offset && range_in_bitwidth rshiftl s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_sub_with_get_borrow @ #?ℤ @ #?ℤ @ #?ℤ @ pcst (#pattern.ident.Z_shiftl @ ??' @ #?ℤ)))
+ (fun '((r1, r2)%core) s bb xx rshiftl ry y offset => cst2 (r1, r2)%core (#(ident.fancy_subb (Z.log2 s) offset) @ (##bb, ##xx, cst ry y)) when (s =? 2^Z.log2 s) && shiftl_good rshiftl ry offset && range_in_bitwidth rshiftl s)
+
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_sub_with_get_borrow @ #?ℤ @ ??' @ ??' @ pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ)))
+ (fun '((r1, r2)%core) s rb b rx x rshiftr ry y offset => cst2 (r1, r2)%core (#(ident.fancy_subb (Z.log2 s) (-offset)) @ (cst rb b, cst rx x, cst ry y)) when (s =? 2^Z.log2 s) && shiftr_good rshiftr ry offset && range_in_bitwidth rshiftr s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_sub_with_get_borrow @ #?ℤ @ #?ℤ @ ??' @ pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ)))
+ (fun '((r1, r2)%core) s bb rx x rshiftr ry y offset => cst2 (r1, r2)%core (#(ident.fancy_subb (Z.log2 s) (-offset)) @ (##bb, cst rx x, cst ry y)) when (s =? 2^Z.log2 s) && shiftr_good rshiftr ry offset && range_in_bitwidth rshiftr s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_sub_with_get_borrow @ #?ℤ @ ??' @ #?ℤ @ pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ)))
+ (fun '((r1, r2)%core) s rb b xx rshiftr ry y offset => cst2 (r1, r2)%core (#(ident.fancy_subb (Z.log2 s) (-offset)) @ (cst rb b, ##xx, cst ry y)) when (s =? 2^Z.log2 s) && shiftr_good rshiftr ry offset && range_in_bitwidth rshiftr s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_sub_with_get_borrow @ #?ℤ @ #?ℤ @ #?ℤ @ pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ)))
+ (fun '((r1, r2)%core) s bb xx rshiftr ry y offset => cst2 (r1, r2)%core (#(ident.fancy_subb (Z.log2 s) (-offset)) @ (##bb, ##xx, cst ry y)) when (s =? 2^Z.log2 s) && shiftr_good rshiftr ry offset && range_in_bitwidth rshiftr s)
+
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_sub_with_get_borrow @ #?ℤ @ ??' @ ??' @ ??'))
+ (fun '((r1, r2)%core) s rb b rx x ry y => cst2 (r1, r2)%core (#(ident.fancy_subb (Z.log2 s) 0) @ (cst rb b, cst rx x, cst ry y)) when (s =? 2^Z.log2 s) && range_in_bitwidth ry s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_sub_with_get_borrow @ #?ℤ @ #?ℤ @ ??' @ ??'))
+ (fun '((r1, r2)%core) s bb rx x ry y => cst2 (r1, r2)%core (#(ident.fancy_subb (Z.log2 s) 0) @ (##bb, cst rx x, cst ry y)) when (s =? 2^Z.log2 s) && range_in_bitwidth ry s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_sub_with_get_borrow @ #?ℤ @ ??' @ #?ℤ @ ??'))
+ (fun '((r1, r2)%core) s rb b xx ry y => cst2 (r1, r2)%core (#(ident.fancy_subb (Z.log2 s) 0) @ (cst rb b, ##xx, cst ry y)) when (s =? 2^Z.log2 s) && range_in_bitwidth ry s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_sub_with_get_borrow @ #?ℤ @ ??' @ ??' @ #?ℤ))
+ (fun '((r1, r2)%core) s rb b rx x yy => cst2 (r1, r2)%core (#(ident.fancy_subb (Z.log2 s) 0) @ (cst rb b, cst rx x, ##yy)) when (s =? 2^Z.log2 s) && range_in_bitwidth yy s)
; make_rewriteo
- (#pattern.ident.Z_sub_with_get_borrow @ #?ℤ @ ?? @ ?? @ (#pattern.ident.Z_shiftr @ ?? @ #?ℤ))
- (fun s b x y offset => #(ident.fancy_subb (Z.log2 s) (-offset)) @ (b, x, y) when s =? 2^Z.log2 s)
+ (pcst2 (#pattern.ident.Z_sub_with_get_borrow @ #?ℤ @ #?ℤ @ #?ℤ @ ??'))
+ (fun '((r1, r2)%core) s bb xx ry y => cst2 (r1, r2)%core (#(ident.fancy_subb (Z.log2 s) 0) @ (##bb, ##xx, cst ry y)) when (s =? 2^Z.log2 s) && range_in_bitwidth ry s)
; make_rewriteo
- (#pattern.ident.Z_sub_with_get_borrow @ #?ℤ @ ?? @ ?? @ ??)
- (fun s b x y => #(ident.fancy_subb (Z.log2 s) 0) @ (b, x, y) when s =? 2^Z.log2 s)
+ (pcst2 (#pattern.ident.Z_sub_with_get_borrow @ #?ℤ @ #?ℤ @ ??' @ #?ℤ))
+ (fun '((r1, r2)%core) s bb rx x yy => cst2 (r1, r2)%core (#(ident.fancy_subb (Z.log2 s) 0) @ (##bb, cst rx x, ##yy)) when (s =? 2^Z.log2 s) && range_in_bitwidth yy s)
+ ; make_rewriteo
+ (pcst2 (#pattern.ident.Z_sub_with_get_borrow @ #?ℤ @ ??' @ #?ℤ @ #?ℤ))
+ (fun '((r1, r2)%core) s rb b xx yy => cst2 (r1, r2)%core (#(ident.fancy_subb (Z.log2 s) 0) @ (cst rb b, ##xx, ##yy)) when (s =? 2^Z.log2 s) && range_in_bitwidth yy s)
+
(*(Z.rshi_concrete 2^256 ?n) @@ (?c, ?x, ?y) --> (rshi n) @@ (x, y)*)
; make_rewriteo
- (#pattern.ident.Z_rshi @ #?ℤ @ ?? @ ?? @ #?ℤ)
- (fun s x y n => #(ident.fancy_rshi (Z.log2 s) n) @ (x, y) when s =? 2^Z.log2 s)
+ (pcst (#pattern.ident.Z_rshi @ #?ℤ @ ??' @ ??' @ #?ℤ))
+ (fun r s rx x ry y n => cst r (#(ident.fancy_rshi (Z.log2 s) n) @ (cst rx x, cst ry y)) when (s =? 2^Z.log2 s))
+ ; make_rewriteo
+ (pcst (#pattern.ident.Z_rshi @ #?ℤ @ #?ℤ @ ??' @ #?ℤ))
+ (fun r s xx ry y n => cst r (#(ident.fancy_rshi (Z.log2 s) n) @ (##xx, cst ry y)) when (s =? 2^Z.log2 s))
+ ; make_rewriteo
+ (pcst (#pattern.ident.Z_rshi @ #?ℤ @ ??' @ #?ℤ @ #?ℤ))
+ (fun r s rx x yy n => cst r (#(ident.fancy_rshi (Z.log2 s) n) @ (cst rx x, ##yy)) when (s =? 2^Z.log2 s))
(*
Z.zselect @@ (Z.cc_m_concrete 2^256 ?c, ?x, ?y) --> selm @@ (c, x, y)
Z.zselect @@ (?c &' 1, ?x, ?y) --> sell @@ (c, x, y)
Z.zselect @@ (?c, ?x, ?y) --> selc @@ (c, x, y)
*)
; make_rewriteo
- (#pattern.ident.Z_zselect @ (#pattern.ident.Z_cc_m @ #?ℤ @ ??) @ ?? @ ??)
- (fun s c x y => #(ident.fancy_selm (Z.log2 s)) @ (c, x, y) when s =? 2^Z.log2 s)
+ (pcst (#pattern.ident.Z_zselect @ pcst (#pattern.ident.Z_cc_m @ #?ℤ @ ??') @ ??' @ ??'))
+ (fun r rccm s rc c rx x ry y => cst r (#(ident.fancy_selm (Z.log2 s)) @ (cst rc c, cst rx x, cst ry y)) when (s =? 2^Z.log2 s) && cc_m_good rccm s rc)
+ ; make_rewriteo
+ (pcst (#pattern.ident.Z_zselect @ pcst (#pattern.ident.Z_cc_m @ #?ℤ @ ??') @ #?ℤ @ ??'))
+ (fun r rccm s rc c xx ry y => cst r (#(ident.fancy_selm (Z.log2 s)) @ (cst rc c, ##xx, cst ry y)) when (s =? 2^Z.log2 s) && cc_m_good rccm s rc)
; make_rewriteo
- (#pattern.ident.Z_zselect @ (#pattern.ident.Z_land @ #?ℤ @ ??) @ ?? @ ??)
- (fun mask c x y => #ident.fancy_sell @ (c, x, y) when mask =? 1)
+ (pcst (#pattern.ident.Z_zselect @ pcst (#pattern.ident.Z_cc_m @ #?ℤ @ ??') @ ??' @ #?ℤ))
+ (fun r rccm s rc c rx x yy => cst r (#(ident.fancy_selm (Z.log2 s)) @ (cst rc c, cst rx x, ##yy)) when (s =? 2^Z.log2 s) && cc_m_good rccm s rc)
; make_rewriteo
- (#pattern.ident.Z_zselect @ (#pattern.ident.Z_land @ ?? @ #?ℤ) @ ?? @ ??)
- (fun c mask x y => #ident.fancy_sell @ (c, x, y) when mask =? 1)
+ (pcst (#pattern.ident.Z_zselect @ pcst (#pattern.ident.Z_cc_m @ #?ℤ @ ??') @ #?ℤ @ #?ℤ))
+ (fun r rccm s rc c xx yy => cst r (#(ident.fancy_selm (Z.log2 s)) @ (cst rc c, ##xx, ##yy)) when (s =? 2^Z.log2 s) && cc_m_good rccm s rc)
+
+ ; make_rewriteo
+ (pcst (#pattern.ident.Z_zselect @ pcst (#pattern.ident.Z_land @ #?ℤ @ ??') @ ??' @ ??'))
+ (fun r rland mask rc c rx x ry y => cst r (#ident.fancy_sell @ (cst rc c, cst rx x, cst ry y)) when (mask =? 1) && land_good rland mask rc)
+ ; make_rewriteo
+ (pcst (#pattern.ident.Z_zselect @ pcst (#pattern.ident.Z_land @ #?ℤ @ ??') @ #?ℤ @ ??'))
+ (fun r rland mask rc c xx ry y => cst r (#ident.fancy_sell @ (cst rc c, ##xx, cst ry y)) when (mask =? 1) && land_good rland mask rc)
+ ; make_rewriteo
+ (pcst (#pattern.ident.Z_zselect @ pcst (#pattern.ident.Z_land @ #?ℤ @ ??') @ ??' @ #?ℤ))
+ (fun r rland mask rc c rx x yy => cst r (#ident.fancy_sell @ (cst rc c, cst rx x, ##yy)) when (mask =? 1) && land_good rland mask rc)
+ ; make_rewriteo
+ (pcst (#pattern.ident.Z_zselect @ pcst (#pattern.ident.Z_land @ #?ℤ @ ??') @ #?ℤ @ #?ℤ))
+ (fun r rland mask rc c xx yy => cst r (#ident.fancy_sell @ (cst rc c, ##xx, ##yy)) when (mask =? 1) && land_good rland mask rc)
+
+ ; make_rewriteo
+ (pcst (#pattern.ident.Z_zselect @ pcst (#pattern.ident.Z_land @ ??' @ #?ℤ) @ ??' @ ??'))
+ (fun r rland rc c mask rx x ry y => cst r (#ident.fancy_sell @ (cst rc c, cst rx x, cst ry y)) when (mask =? 1) && land_good rland rc mask)
+ ; make_rewriteo
+ (pcst (#pattern.ident.Z_zselect @ pcst (#pattern.ident.Z_land @ ??' @ #?ℤ) @ #?ℤ @ ??'))
+ (fun r rland rc c mask xx ry y => cst r (#ident.fancy_sell @ (cst rc c, ##xx, cst ry y)) when (mask =? 1) && land_good rland rc mask)
+ ; make_rewriteo
+ (pcst (#pattern.ident.Z_zselect @ pcst (#pattern.ident.Z_land @ ??' @ #?ℤ) @ ??' @ #?ℤ))
+ (fun r rland rc c mask rx x yy => cst r (#ident.fancy_sell @ (cst rc c, cst rx x, ##yy)) when (mask =? 1) && land_good rland rc mask)
+ ; make_rewriteo
+ (pcst (#pattern.ident.Z_zselect @ pcst (#pattern.ident.Z_land @ ??' @ #?ℤ) @ #?ℤ @ #?ℤ))
+ (fun r rland rc c mask xx yy => cst r (#ident.fancy_sell @ (cst rc c, ##xx, ##yy)) when (mask =? 1) && land_good rland rc mask)
+
; make_rewrite
- (#pattern.ident.Z_zselect @ ?? @ ?? @ ??)
- (fun c x y => #ident.fancy_selc @ (c, x, y))
+ (pcst (#pattern.ident.Z_zselect @ ?? @ ?? @ ??))
+ (fun r c x y => cst r (#ident.fancy_selc @ (c, x, y)))
+
(*Z.add_modulo @@ (?x, ?y, ?m) --> addm @@ (x, y, m)*)
; make_rewrite
(#pattern.ident.Z_add_modulo @ ?? @ ?? @ ??)
@@ -2116,73 +2306,79 @@ Z.mul @@ (?x >> 128, ?y >> 128) --> mulhh @@ (x, y)
*)
(* literal on left *)
; make_rewriteo
- (#?ℤ * (#pattern.ident.Z_land @ ?? @ #?ℤ))
- (fun x y mask => let s := (2*Z.log2_up mask)%Z in x <- invert_low s x; #(ident.fancy_mulll s) @ (##x, y) when (mask =? 2^(s/2)-1))
+ (#?ℤ *' pcst (#pattern.ident.Z_land @ ??' @ #?ℤ))
+ (fun r x rland ry y mask => let s := (2*Z.log2_up mask)%Z in x <- invert_low s x; cst r (#(ident.fancy_mulll s) @ (##x, cst ry y)) when (mask =? 2^(s/2)-1) && land_good rland ry mask)
; make_rewriteo
- (#?ℤ * (#pattern.ident.Z_land @ #?ℤ @ ??))
- (fun x mask y => let s := (2*Z.log2_up mask)%Z in x <- invert_low s x; #(ident.fancy_mulll s) @ (##x, y) when (mask =? 2^(s/2)-1))
+ (#?ℤ *' pcst (#pattern.ident.Z_land @ #?ℤ @ ??'))
+ (fun r x rland mask ry y => let s := (2*Z.log2_up mask)%Z in x <- invert_low s x; cst r (#(ident.fancy_mulll s) @ (##x, cst ry y)) when (mask =? 2^(s/2)-1) && land_good rland mask ry)
; make_rewriteo
- (#?ℤ * (#pattern.ident.Z_shiftr @ ?? @ #?ℤ))
- (fun x y offset => let s := (2*offset)%Z in x <- invert_low s x; #(ident.fancy_mullh s) @ (##x, y))
+ (#?ℤ *' pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ))
+ (fun r x rshiftr ry y offset => let s := (2*offset)%Z in x <- invert_low s x; cst r (#(ident.fancy_mullh s) @ (##x, cst ry y)) when shiftr_good rshiftr ry offset)
; make_rewriteo
- (#?ℤ * (#pattern.ident.Z_land @ #?ℤ @ ??))
- (fun x mask y => let s := (2*Z.log2_up mask)%Z in x <- invert_high s x; #(ident.fancy_mulhl s) @ (##x, y) when mask =? 2^(s/2)-1)
+ (#?ℤ *' pcst (#pattern.ident.Z_land @ #?ℤ @ ??'))
+ (fun r x rland mask ry y => let s := (2*Z.log2_up mask)%Z in x <- invert_high s x; cst r (#(ident.fancy_mulhl s) @ (##x, cst ry y)) when (mask =? 2^(s/2)-1) && land_good rland mask ry)
; make_rewriteo
- (#?ℤ * (#pattern.ident.Z_land @ ?? @ #?ℤ))
- (fun x y mask => let s := (2*Z.log2_up mask)%Z in x <- invert_high s x; #(ident.fancy_mulhl s) @ (##x, y) when mask =? 2^(s/2)-1)
+ (#?ℤ *' pcst (#pattern.ident.Z_land @ ??' @ #?ℤ))
+ (fun r x rland ry y mask => let s := (2*Z.log2_up mask)%Z in x <- invert_high s x; cst r (#(ident.fancy_mulhl s) @ (##x, cst ry y)) when (mask =? 2^(s/2)-1) && land_good rland ry mask)
; make_rewriteo
- (#?ℤ * (#pattern.ident.Z_shiftr @ ?? @ #?ℤ))
- (fun x y offset => let s := (2*offset)%Z in x <- invert_high s x; #(ident.fancy_mulhh s) @ (##x, y))
+ (#?ℤ *' pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ))
+ (fun r x rshiftr ry y offset => let s := (2*offset)%Z in x <- invert_high s x; cst r (#(ident.fancy_mulhh s) @ (##x, cst ry y)) when shiftr_good rshiftr ry offset)
(* literal on right *)
; make_rewriteo
- ((#pattern.ident.Z_land @ #?ℤ @ ??) * #?ℤ)
- (fun mask x y => let s := (2*Z.log2_up mask)%Z in y <- invert_low s y; #(ident.fancy_mulll s) @ (x, ##y) when (mask =? 2^(s/2)-1))
+ (pcst (#pattern.ident.Z_land @ #?ℤ @ ??') *' #?ℤ)
+ (fun r rland mask rx x y => let s := (2*Z.log2_up mask)%Z in y <- invert_low s y; cst r (#(ident.fancy_mulll s) @ (cst rx x, ##y)) when (mask =? 2^(s/2)-1) && land_good rland mask rx)
; make_rewriteo
- ((#pattern.ident.Z_land @ ?? @ #?ℤ) * #?ℤ)
- (fun x mask y => let s := (2*Z.log2_up mask)%Z in y <- invert_low s y; #(ident.fancy_mulll s) @ (x, ##y) when (mask =? 2^(s/2)-1))
+ (pcst (#pattern.ident.Z_land @ ??' @ #?ℤ) *' #?ℤ)
+ (fun r rland rx x mask y => let s := (2*Z.log2_up mask)%Z in y <- invert_low s y; cst r (#(ident.fancy_mulll s) @ (cst rx x, ##y)) when (mask =? 2^(s/2)-1) && land_good rland rx mask)
; make_rewriteo
- ((#pattern.ident.Z_land @ #?ℤ @ ??) * #?ℤ)
- (fun mask x y => let s := (2*Z.log2_up mask)%Z in y <- invert_high s y; #(ident.fancy_mullh s) @ (x, ##y) when mask =? 2^(s/2)-1)
+ (pcst (#pattern.ident.Z_land @ #?ℤ @ ??') *' #?ℤ)
+ (fun r rland mask rx x y => let s := (2*Z.log2_up mask)%Z in y <- invert_high s y; cst r (#(ident.fancy_mullh s) @ (cst rx x, ##y)) when (mask =? 2^(s/2)-1) && land_good rland mask rx)
; make_rewriteo
- ((#pattern.ident.Z_land @ ?? @ #?ℤ) * #?ℤ)
- (fun x mask y => let s := (2*Z.log2_up mask)%Z in y <- invert_high s y; #(ident.fancy_mullh s) @ (x, ##y) when mask =? 2^(s/2)-1)
+ (pcst (#pattern.ident.Z_land @ ??' @ #?ℤ) *' #?ℤ)
+ (fun r rland rx x mask y => let s := (2*Z.log2_up mask)%Z in y <- invert_high s y; cst r (#(ident.fancy_mullh s) @ (cst rx x, ##y)) when (mask =? 2^(s/2)-1) && land_good rland rx mask)
; make_rewriteo
- ((#pattern.ident.Z_shiftr @ ?? @ #?ℤ) * #?ℤ)
- (fun x offset y => let s := (2*offset)%Z in y <- invert_low s y; #(ident.fancy_mulhl s) @ (x, ##y))
+ (pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ) *' #?ℤ)
+ (fun r rshiftr rx x offset y => let s := (2*offset)%Z in y <- invert_low s y; cst r (#(ident.fancy_mulhl s) @ (cst rx x, ##y)) when shiftr_good rshiftr rx offset)
; make_rewriteo
- ((#pattern.ident.Z_shiftr @ ?? @ #?ℤ) * #?ℤ)
- (fun x offset y => let s := (2*offset)%Z in y <- invert_high s y; #(ident.fancy_mulhh s) @ (x, ##y))
+ (pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ) *' #?ℤ)
+ (fun r rshiftr rx x offset y => let s := (2*offset)%Z in y <- invert_high s y; cst r (#(ident.fancy_mulhh s) @ (cst rx x, ##y)) when shiftr_good rshiftr rx offset)
(* no literal *)
; make_rewriteo
- ((#pattern.ident.Z_land @ #?ℤ @ ??) * (#pattern.ident.Z_land @ #?ℤ @ ??))
- (fun mask1 x mask2 y => let s := (2*Z.log2_up mask1)%Z in #(ident.fancy_mulll s) @ (x, y) when (mask1 =? 2^(s/2)-1) && (mask2 =? 2^(s/2)-1))
+ (pcst (#pattern.ident.Z_land @ #?ℤ @ ??') *' pcst (#pattern.ident.Z_land @ #?ℤ @ ??'))
+ (fun r rland1 mask1 rx x rland2 mask2 ry y => let s := (2*Z.log2_up mask1)%Z in cst r (#(ident.fancy_mulll s) @ (cst rx x, cst ry y)) when (mask1 =? 2^(s/2)-1) && (mask2 =? 2^(s/2)-1) && land_good rland1 mask1 rx && land_good rland2 mask2 ry)
; make_rewriteo
- ((#pattern.ident.Z_land @ ?? @ #?ℤ) * (#pattern.ident.Z_land @ #?ℤ @ ??))
- (fun x mask1 mask2 y => let s := (2*Z.log2_up mask1)%Z in #(ident.fancy_mulll s) @ (x, y) when (mask1 =? 2^(s/2)-1) && (mask2 =? 2^(s/2)-1))
+ (pcst (#pattern.ident.Z_land @ ??' @ #?ℤ) *' pcst (#pattern.ident.Z_land @ #?ℤ @ ??'))
+ (fun r rland1 rx x mask1 rland2 mask2 ry y => let s := (2*Z.log2_up mask1)%Z in cst r (#(ident.fancy_mulll s) @ (cst rx x, cst ry y)) when (mask1 =? 2^(s/2)-1) && (mask2 =? 2^(s/2)-1) && land_good rland1 rx mask1 && land_good rland2 mask2 ry)
; make_rewriteo
- ((#pattern.ident.Z_land @ #?ℤ @ ??) * (#pattern.ident.Z_land @ ?? @ #?ℤ))
- (fun mask1 x y mask2 => let s := (2*Z.log2_up mask1)%Z in #(ident.fancy_mulll s) @ (x, y) when (mask1 =? 2^(s/2)-1) && (mask2 =? 2^(s/2)-1))
+ (pcst (#pattern.ident.Z_land @ #?ℤ @ ??') *' pcst (#pattern.ident.Z_land @ ??' @ #?ℤ))
+ (fun r rland1 mask1 rx x rland2 ry y mask2 => let s := (2*Z.log2_up mask1)%Z in cst r (#(ident.fancy_mulll s) @ (cst rx x, cst ry y)) when (mask1 =? 2^(s/2)-1) && (mask2 =? 2^(s/2)-1) && land_good rland1 mask1 rx && land_good rland2 ry mask2)
; make_rewriteo
- ((#pattern.ident.Z_land @ ?? @ #?ℤ) * (#pattern.ident.Z_land @ ?? @ #?ℤ))
- (fun x mask1 y mask2 => let s := (2*Z.log2_up mask1)%Z in #(ident.fancy_mulll s) @ (x, y) when (mask1 =? 2^(s/2)-1) && (mask2 =? 2^(s/2)-1))
+ (pcst (#pattern.ident.Z_land @ ??' @ #?ℤ) *' pcst (#pattern.ident.Z_land @ ??' @ #?ℤ))
+ (fun r rland1 rx x mask1 rland2 ry y mask2 => let s := (2*Z.log2_up mask1)%Z in cst r (#(ident.fancy_mulll s) @ (cst rx x, cst ry y)) when (mask1 =? 2^(s/2)-1) && (mask2 =? 2^(s/2)-1) && land_good rland1 rx mask1 && land_good rland2 ry mask2)
; make_rewriteo
- ((#pattern.ident.Z_land @ #?ℤ @ ??) * (#pattern.ident.Z_shiftr @ ?? @ #?ℤ))
- (fun mask x y offset => let s := (2*offset)%Z in #(ident.fancy_mullh s) @ (x, y) when mask =? 2^(s/2)-1)
+ (pcst (#pattern.ident.Z_land @ #?ℤ @ ??') *' pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ))
+ (fun r rland1 mask rx x rshiftr2 ry y offset => let s := (2*offset)%Z in cst r (#(ident.fancy_mullh s) @ (cst rx x, cst ry y)) when (mask =? 2^(s/2)-1) && land_good rland1 mask rx && shiftr_good rshiftr2 ry offset)
; make_rewriteo
- ((#pattern.ident.Z_land @ ?? @ #?ℤ) * (#pattern.ident.Z_shiftr @ ?? @ #?ℤ))
- (fun x mask y offset => let s := (2*offset)%Z in #(ident.fancy_mullh s) @ (x, y) when mask =? 2^(s/2)-1)
+ (pcst (#pattern.ident.Z_land @ ??' @ #?ℤ) *' pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ))
+ (fun r rland1 rx x mask rshiftr2 ry y offset => let s := (2*offset)%Z in cst r (#(ident.fancy_mullh s) @ (cst rx x, cst ry y)) when (mask =? 2^(s/2)-1) && land_good rland1 rx mask && shiftr_good rshiftr2 ry offset)
; make_rewriteo
- ((#pattern.ident.Z_shiftr @ ?? @ #?ℤ) * (#pattern.ident.Z_land @ #?ℤ @ ??))
- (fun x offset mask y => let s := (2*offset)%Z in #(ident.fancy_mulhl s) @ (x, y) when mask =? 2^(s/2)-1)
+ (pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ) *' pcst (#pattern.ident.Z_land @ #?ℤ @ ??'))
+ (fun r rshiftr1 rx x offset rland2 mask ry y => let s := (2*offset)%Z in cst r (#(ident.fancy_mulhl s) @ (cst rx x, cst ry y)) when (mask =? 2^(s/2)-1) && shiftr_good rshiftr1 rx offset && land_good rland2 mask ry)
; make_rewriteo
- ((#pattern.ident.Z_shiftr @ ?? @ #?ℤ) * (#pattern.ident.Z_land @ ?? @ #?ℤ))
- (fun x offset y mask => let s := (2*offset)%Z in #(ident.fancy_mulhl s) @ (x, y) when mask =? 2^(s/2)-1)
+ (pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ) *' pcst (#pattern.ident.Z_land @ ??' @ #?ℤ))
+ (fun r rshiftr1 rx x offset rland2 ry y mask => let s := (2*offset)%Z in cst r (#(ident.fancy_mulhl s) @ (cst rx x, cst ry y)) when (mask =? 2^(s/2)-1) && shiftr_good rshiftr1 rx offset && land_good rland2 ry mask)
; make_rewriteo
- ((#pattern.ident.Z_shiftr @ ?? @ #?ℤ) * (#pattern.ident.Z_shiftr @ ?? @ #?ℤ))
- (fun x offset1 y offset2 => let s := (2*offset1)%Z in #(ident.fancy_mulhh s) @ (x, y) when offset1 =? offset2)
+ (pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ) *' pcst (#pattern.ident.Z_shiftr @ ??' @ #?ℤ))
+ (fun r rshiftr1 rx x offset1 rshiftr2 ry y offset2 => let s := (2*offset1)%Z in cst r (#(ident.fancy_mulhh s) @ (cst rx x, cst ry y)) when (offset1 =? offset2) && shiftr_good rshiftr1 rx offset1 && shiftr_good rshiftr2 ry offset2)
+
+
+
+ (** Dummy rule to make sure we use the two value ranges; this can be removed *)
+ ; make_rewriteo
+ (??')
+ (fun rx x => cst rx x when is_tighter_than_bool rx value_range || is_tighter_than_bool rx flag_range)
+
].
- Definition fancy_with_casts_rewrite_rules : rewrite_rulesT
- := [].
Definition fancy_dtree'
:= Eval compute in @compile_rewrites ident var pattern.ident (@pattern.ident.arg_types) pattern.Raw.ident (@pattern.ident.strip_types) pattern.Raw.ident.ident_beq 100 fancy_rewrite_rules.
@@ -2348,7 +2544,7 @@ Z.mul @@ (?x >> 128, ?y >> 128) --> mulhh @@ (x, y)
{t} (idc : ident t).
Time Definition fancy_rewrite_head
- := make_rewrite_head (@fancy_rewrite_head0 var invert_low invert_high do_again t idc) (@fancy_pr2_rewrite_rules).
+ := make_rewrite_head (@fancy_rewrite_head0 var do_again t idc) (@fancy_pr2_rewrite_rules).
(* Tactic call ran for 0.19 secs (0.187u,0.s) (success)
Tactic call ran for 10.297 secs (10.3u,0.s) (success)
Tactic call ran for 1.746 secs (1.747u,0.s) (success)
@@ -2361,12 +2557,17 @@ Z.mul @@ (?x >> 128, ?y >> 128) --> mulhh @@ (x, y)
End red_fancy.
Section red_fancy_with_casts.
Context (invert_low invert_high : Z (*log2wordmax*) -> Z -> @option Z)
+ (value_range flag_range : zrange)
{var : type.type base.type -> Type}
(do_again : forall t : base.type, @expr base.type ident (@Compile.value base.type ident var) (type.base t)
-> @UnderLets.UnderLets base.type ident var (@expr base.type ident var (type.base t)))
{t} (idc : ident t).
Time Definition fancy_with_casts_rewrite_head
- := make_rewrite_head (@fancy_with_casts_rewrite_head0 var (*invert_low invert_high*) do_again t idc) (@fancy_with_casts_pr2_rewrite_rules).
+ := make_rewrite_head (@fancy_with_casts_rewrite_head0 var invert_low invert_high value_range flag_range do_again t idc) (@fancy_with_casts_pr2_rewrite_rules).
+ (* Tactic call ran for 4.142 secs (4.143u,0.s) (success)
+ Tactic call ran for 80.563 secs (80.56u,0.s) (success)
+ Tactic call ran for 0.154 secs (0.156u,0.s) (success)
+ Finished transaction in 85.431 secs (85.427u,0.s) (successful) *)
Local Set Printing Depth 1000000.
Local Set Printing Width 200.
@@ -2435,11 +2636,12 @@ Z.mul @@ (?x >> 128, ?y >> 128) --> mulhh @@ (x, y)
Definition RewriteToFancy
(invert_low invert_high : Z (*log2wordmax*) -> Z -> @option Z)
{t} (e : expr.Expr (ident:=ident) t) : expr.Expr (ident:=ident) t
- := @Compile.Rewrite (fun var _ => @fancy_rewrite_head invert_low invert_high var) fancy_default_fuel t e.
+ := @Compile.Rewrite (fun var _ => @fancy_rewrite_head var) fancy_default_fuel t e.
Definition RewriteToFancyWithCasts
(invert_low invert_high : Z (*log2wordmax*) -> Z -> @option Z)
+ (value_range flag_range : zrange)
{t} (e : expr.Expr (ident:=ident) t) : expr.Expr (ident:=ident) t
- := @Compile.Rewrite (fun var _ => @fancy_with_casts_rewrite_head (*invert_low invert_high*) var) fancy_with_casts_default_fuel t e.
+ := @Compile.Rewrite (fun var _ => @fancy_with_casts_rewrite_head invert_low invert_high value_range flag_range var) fancy_with_casts_default_fuel t e.
End RewriteRules.
Import defaults.
diff --git a/src/Experiments/NewPipeline/RewriterProofs.v b/src/Experiments/NewPipeline/RewriterProofs.v
index df51ea28d..3857c8520 100644
--- a/src/Experiments/NewPipeline/RewriterProofs.v
+++ b/src/Experiments/NewPipeline/RewriterProofs.v
@@ -88,13 +88,14 @@ Module Compilers.
{t} e (Hwf : Wf e) : Wf (@RewriteToFancy invert_low invert_high t e).
Proof.
start_Wf_proof fancy_rewrite_head_eq fancy_all_rewrite_rules_eq (@fancy_rewrite_head0).
- apply fancy_rewrite_rules_good; assumption.
+ eapply fancy_rewrite_rules_good; eassumption.
Qed.
Lemma Wf_RewriteToFancyWithCasts (invert_low invert_high : Z -> Z -> option Z)
+ (value_range flag_range : ZRange.zrange)
(Hlow : forall s v v', invert_low s v = Some v' -> v = Z.land v' (2^(s/2)-1))
(Hhigh : forall s v v', invert_high s v = Some v' -> v = Z.shiftr v' (s/2))
- {t} e (Hwf : Wf e) : Wf (@RewriteToFancyWithCasts invert_low invert_high t e).
+ {t} e (Hwf : Wf e) : Wf (@RewriteToFancyWithCasts invert_low invert_high value_range flag_range t e).
Proof.
start_Wf_proof fancy_with_casts_rewrite_head_eq fancy_with_casts_all_rewrite_rules_eq (@fancy_with_casts_rewrite_head0).
eapply fancy_with_casts_rewrite_rules_good; eassumption.
@@ -131,10 +132,11 @@ Module Compilers.
Admitted.
Lemma Interp_gen_RewriteToFancyWithCasts {cast_outside_of_range} (invert_low invert_high : Z -> Z -> option Z)
+ (value_range flag_range : ZRange.zrange)
(Hlow : forall s v v', invert_low s v = Some v' -> v = Z.land v' (2^(s/2)-1))
(Hhigh : forall s v v', invert_high s v = Some v' -> v = Z.shiftr v' (s/2))
{t} e (Hwf : Wf e)
- : expr.Interp (@ident.gen_interp cast_outside_of_range) (@RewriteToFancyWithCasts invert_low invert_high t e)
+ : expr.Interp (@ident.gen_interp cast_outside_of_range) (@RewriteToFancyWithCasts invert_low invert_high value_range flag_range t e)
== expr.Interp (@ident.gen_interp cast_outside_of_range) e.
Proof.
start_Interp_proof fancy_with_casts_rewrite_head_eq fancy_with_casts_all_rewrite_rules_eq (@fancy_with_casts_rewrite_head0).
@@ -155,10 +157,11 @@ Module Compilers.
: Interp (@RewriteToFancy invert_low invert_high t e) == Interp e.
Proof. apply Interp_gen_RewriteToFancy; assumption. Qed.
Lemma Interp_RewriteToFancyWithCasts (invert_low invert_high : Z -> Z -> option Z)
+ (value_range flag_range : ZRange.zrange)
(Hlow : forall s v v', invert_low s v = Some v' -> v = Z.land v' (2^(s/2)-1))
(Hhigh : forall s v v', invert_high s v = Some v' -> v = Z.shiftr v' (s/2))
{t} e (Hwf : Wf e)
- : Interp (@RewriteToFancyWithCasts invert_low invert_high t e) == Interp e.
+ : Interp (@RewriteToFancyWithCasts invert_low invert_high value_range flag_range t e) == Interp e.
Proof. apply Interp_gen_RewriteToFancyWithCasts; assumption. Qed.
End RewriteRules.
diff --git a/src/Experiments/NewPipeline/RewriterRulesGood.v b/src/Experiments/NewPipeline/RewriterRulesGood.v
index fd7facb3d..f9e20ebb0 100644
--- a/src/Experiments/NewPipeline/RewriterRulesGood.v
+++ b/src/Experiments/NewPipeline/RewriterRulesGood.v
@@ -46,17 +46,17 @@ Module Compilers.
Lemma nbe_rewrite_head_eq : @nbe_rewrite_head = @nbe_rewrite_head0.
Proof. reflexivity. Qed.
- Lemma fancy_rewrite_head_eq invert_low invert_high
- : (fun var do_again => @fancy_rewrite_head invert_low invert_high var)
- = (fun var => @fancy_rewrite_head0 var invert_low invert_high).
+ Lemma fancy_rewrite_head_eq
+ : (fun var do_again => @fancy_rewrite_head var)
+ = @fancy_rewrite_head0.
Proof. reflexivity. Qed.
Lemma arith_rewrite_head_eq max_const_val : @arith_rewrite_head max_const_val = (fun var => @arith_rewrite_head0 var max_const_val).
Proof. reflexivity. Qed.
- Lemma fancy_with_casts_rewrite_head_eq (*invert_low invert_high*)
- : (fun var do_again => @fancy_with_casts_rewrite_head (*invert_low invert_high*) var)
- = (fun var => @fancy_with_casts_rewrite_head0 var (*invert_low invert_high*)).
+ Lemma fancy_with_casts_rewrite_head_eq invert_low invert_high value_range flag_range
+ : (fun var do_again => @fancy_with_casts_rewrite_head invert_low invert_high value_range flag_range var)
+ = (fun var => @fancy_with_casts_rewrite_head0 var invert_low invert_high value_range flag_range).
Proof. reflexivity. Qed.
Lemma arith_with_casts_rewrite_head_eq : @arith_with_casts_rewrite_head = @arith_with_casts_rewrite_head0.
@@ -362,7 +362,7 @@ Module Compilers.
(invert_low invert_high : Z -> Z -> option Z)
(Hlow : forall s v v', invert_low s v = Some v' -> v = Z.land v' (2^(s/2)-1))
(Hhigh : forall s v v', invert_high s v = Some v' -> v = Z.shiftr v' (s/2))
- : rewrite_rules_goodT (fancy_rewrite_rules invert_low invert_high) (fancy_rewrite_rules invert_low invert_high).
+ : rewrite_rules_goodT fancy_rewrite_rules fancy_rewrite_rules.
Proof using Type.
Time start_good.
Time all: repeat good_t_step.
@@ -372,9 +372,10 @@ Module Compilers.
Lemma fancy_with_casts_rewrite_rules_good
(invert_low invert_high : Z -> Z -> option Z)
+ (value_range flag_range : ZRange.zrange)
(Hlow : forall s v v', invert_low s v = Some v' -> v = Z.land v' (2^(s/2)-1))
(Hhigh : forall s v v', invert_high s v = Some v' -> v = Z.shiftr v' (s/2))
- : rewrite_rules_goodT (fancy_with_casts_rewrite_rules (*invert_low invert_high*)) (fancy_with_casts_rewrite_rules (*invert_low invert_high*)).
+ : rewrite_rules_goodT (fancy_with_casts_rewrite_rules invert_low invert_high value_range flag_range) (fancy_with_casts_rewrite_rules invert_low invert_high value_range flag_range).
Proof using Type.
Time start_good.
Time all: repeat good_t_step.
diff --git a/src/Experiments/NewPipeline/RewriterRulesInterpGood.v b/src/Experiments/NewPipeline/RewriterRulesInterpGood.v
index b002bfcb2..962161102 100644
--- a/src/Experiments/NewPipeline/RewriterRulesInterpGood.v
+++ b/src/Experiments/NewPipeline/RewriterRulesInterpGood.v
@@ -23,9 +23,11 @@ Require Import Crypto.Util.ZUtil.Definitions.
Require Import Crypto.Util.ZUtil.AddGetCarry.
Require Import Crypto.Util.ZUtil.MulSplit.
Require Import Crypto.Util.ZUtil.Zselect.
+Require Import Crypto.Util.ZUtil.Div.
Require Import Crypto.Util.ZRange.
Require Import Crypto.Util.ZRange.Operations.
Require Import Crypto.Util.ZRange.BasicLemmas.
+Require Import Crypto.Util.ZRange.OperationsBounds.
Require Import Crypto.Util.Tactics.NormalizeCommutativeIdentifier.
Require Import Crypto.Util.Tactics.BreakMatch.
Require Import Crypto.Util.Tactics.SplitInContext.
@@ -99,6 +101,18 @@ Module Compilers.
rewrite UnderLets.interp_splice, IHxs; reflexivity.
Qed.
+ Local Lemma unfold_is_bounded_by_bool v r
+ : is_bounded_by_bool v r = true -> lower r <= v <= upper r.
+ Proof using Type.
+ cbv [is_bounded_by_bool]; intro; split_andb; Z.ltb_to_lt; split; assumption.
+ Qed.
+
+ Local Lemma unfold_is_tighter_than_bool r1 r2
+ : is_tighter_than_bool r1 r2 = true -> lower r2 <= lower r1 /\ upper r1 <= upper r2.
+ Proof using Type.
+ cbv [is_tighter_than_bool]; intro; split_andb; Z.ltb_to_lt; split; assumption.
+ Qed.
+
Local Notation rewrite_rules_interp_goodT := (@Compile.rewrite_rules_interp_goodT ident pattern.ident (@pattern.ident.arg_types) (@pattern.ident.to_typed) (@ident_interp)).
Local Ltac do_cbv0 :=
@@ -117,8 +131,7 @@ Module Compilers.
=> let Q' := fresh in
pose Q as Q';
change (forall x p, In (@existT A P x p) ls -> Q' x p);
- apply (@forall_In_existT A P Q' ls); cbn [projT1 projT2]; cbv [id];
- subst Q'; cbn [projT1 projT2]
+ apply (@forall_In_existT A P Q' ls); subst Q'; cbv [projT1 projT2 id]
end;
do_cbv0;
repeat first [ progress intros
@@ -173,12 +186,16 @@ Module Compilers.
| [ |- _ = ?ev ] => is_evar ev; reflexivity
end.
- Local Ltac interp_good_t_step :=
- first [ reflexivity
- | match goal with
+ Local Ltac interp_good_t_step_related :=
+ first [ lazymatch goal with
+ | [ |- ?x = ?x ] => reflexivity
+ | [ |- True ] => exact I
+ | [ H : ?x = true, H' : ?x = false |- _ ] => exfalso; clear -H H'; congruence
+ | [ |- ?G ] => has_evar G; reflexivity
+ | [ |- context[expr.interp_related _ _ _] ] => reflexivity
+ | [ |- context[_ == _] ] => reflexivity
(*| [ |- context[(fst ?x, snd ?x)] ] => progress eta_expand
| [ |- context[match ?x with pair a b => _ end] ] => progress eta_expand*)
- | [ H : ?x = true, H' : ?x = false |- _ ] => exfalso; clear -H H'; congruence
end
| progress cbn [expr.interp ident.gen_interp fst snd Compile.reify Compile.reflect Compile.wf_value' Compile.value' Option.bind UnderLets.interp list_case type.interp base.interp base.base_interp ident.to_fancy invert_Some ident.fancy.interp ident.fancy.interp_with_wordmax Compile.reify_expr bool_rect UnderLets.interp_related type.related] in *
| progress cbv [Compile.option_bind' respectful] in *
@@ -232,7 +249,7 @@ Module Compilers.
| [ H : List.Forall2 _ ?x ?y |- List.length ?x = List.length ?y ]
=> eapply eq_length_Forall2, H
| [ |- exists fv xv, _ /\ _ /\ fv xv = ?f ?x ]
- => exists f, x; repeat apply conj; [ solve [ repeat interp_good_t_step ] | | reflexivity ]
+ => exists f, x; repeat apply conj; [ solve [ repeat interp_good_t_step_related ] | | reflexivity ]
| [ |- _ /\ ?x = ?x ] => split; [ | reflexivity ]
| [ |- UnderLets.interp_related
?ident_interp ?R
@@ -312,31 +329,6 @@ Module Compilers.
exists f', x'; repeat apply conj;
[ | exact H | reflexivity ]
| [ |- List.Forall2 _ (update_nth _ _ _) (update_nth _ _ _) ] => apply Forall2_update_nth
- | [ H : context[ZRange.normalize (ZRange.normalize _)] |- _ ]
- => rewrite ZRange.normalize_idempotent in H
- | [ |- context[ZRange.normalize (ZRange.normalize _)] ]
- => rewrite ZRange.normalize_idempotent
- | [ |- context[ident.cast (ZRange.normalize ?r)] ]
- => rewrite ident.cast_normalize
- | [ H : context[ident.cast (ZRange.normalize ?r)] |- _ ]
- => rewrite ident.cast_normalize in H
- | [ H : ?T, H' : ?T |- _ ] => clear H'
- | [ H : context[is_bounded_by_bool _ (ZRange.normalize (-_))] |- _ ]
- => rewrite ZRange.is_bounded_by_bool_move_opp_normalize in H
- | [ |- context[is_bounded_by_bool _ (ZRange.normalize (-_))] ]
- => rewrite ZRange.is_bounded_by_bool_move_opp_normalize
- | [ H : is_bounded_by_bool ?v (ZRange.normalize ?r) = true |- context[ident.cast _ ?r ?v] ]
- => rewrite (@ident.cast_in_normalized_bounds _ r v) by exact H
- | [ H : is_bounded_by_bool ?v (ZRange.normalize ?r) = true |- context[ident.cast _ (-?r) (-?v)] ]
- => rewrite (@ident.cast_in_normalized_bounds _ (-r) (-v));
- [ | clear -H ]
- | [ |- context[ident.cast _ ?r (-ident.cast _ (-?r) ?v)] ]
- => rewrite (ident.cast_in_normalized_bounds r (-ident.cast _ (-r) v))
- by (rewrite <- ZRange.is_bounded_by_bool_move_opp_normalize; apply ident.cast_always_bounded)
- | [ |- context[ident.cast _ ?r (ident.cast _ ?r _)] ]
- => rewrite (@ident.cast_idempotent _ _ r)
- | [ H : is_bounded_by_bool _ ?r = true |- _]
- => is_var r; unique pose proof (ZRange.is_bounded_by_normalize _ _ H)
| [ H : zrange * zrange |- _ ] => destruct H
end
| progress intros
@@ -344,7 +336,6 @@ Module Compilers.
| assumption
| progress inversion_option
| progress destruct_head'_and
- | progress Z.ltb_to_lt
| progress split_andb
| match goal with
| [ |- Lists.List.repeat _ _ = Lists.List.repeat _ _ ] => apply f_equal2
@@ -357,7 +348,7 @@ Module Compilers.
| [ |- list_rect _ ?Pnil ?Pcons ?ls = list_rect _ ?Pnil ?Pcons' ?ls ]
=> apply list_rect_Proper; [ reflexivity | repeat intro | reflexivity ]
| [ |- bool_rect _ ?x ?y ?b = bool_rect _ ?x ?y ?b' ]
- => apply f_equal3; [ reflexivity | reflexivity | solve [ repeat interp_good_t_step ] ]
+ => apply f_equal3; [ reflexivity | reflexivity | solve [ repeat interp_good_t_step_related ] ]
| [ H : expr.wf _ ?v1 ?v2 |- expr.interp _ ?v1 = expr.interp _ ?v2 ]
=> apply (expr.wf_interp_Proper _ _ _ H ltac:(assumption))
| [ |- ?R (?f (?g (if ?b then ?x else ?y))) (bool_rect ?A ?B ?C ?D) ]
@@ -460,6 +451,71 @@ Module Compilers.
| break_innermost_match_step
| break_innermost_match_hyps_step
| progress destruct_head'_or
+ | progress cbn [expr.interp_related] in *
+ | match goal with
+ | [ H : context[expr.interp _ (UnderLets.interp _ (?f _ _ _))]
+ |- expr.interp _ (UnderLets.interp _ (?f _ _ _)) = _ ]
+ => apply H
+ | [ H : forall x1 x2, ?R1 x1 x2 -> ?R2 (?f1 x1) (?f2 x2) |- ?R2 (?f1 _) (?f2 _) ]
+ => apply H
+ | [ H : forall x1 x2, ?R1 x1 x2 -> forall y1 y2, ?R2 y1 y2 -> ?R3 (?f1 x1 y1) (?f2 x2 y2) |- ?R3 (?f1 _ _) (?f2 _ _) ]
+ => apply H
+ | [ H : forall x x', ?Rx x x' -> forall y y', _ -> forall z z', ?Rz z z' -> ?R (?f x y z) (?f' x' y' z') |- ?R (?f _ _ _) (?f' _ _ _) ]
+ => apply H; clear H
+ end
+ | progress cbv [Option.bind] in *
+ | match goal with
+ | [ H : expr.interp_related _ ?e ?v |- _ ] => is_var e; clear H e
+ end ].
+
+ Local Ltac interp_good_t_step_arith :=
+ first [ lazymatch goal with
+ | [ |- ?x = ?x ] => reflexivity
+ | [ |- True ] => exact I
+ | [ H : ?x = true, H' : ?x = false |- _ ] => exfalso; clear -H H'; congruence
+ end
+ | match goal with
+ | [ H : context[ZRange.normalize (ZRange.normalize _)] |- _ ]
+ => rewrite ZRange.normalize_idempotent in H
+ | [ |- context[ZRange.normalize (ZRange.normalize _)] ]
+ => rewrite ZRange.normalize_idempotent
+ | [ |- context[ident.cast (ZRange.normalize ?r)] ]
+ => rewrite ident.cast_normalize
+ | [ H : context[ident.cast (ZRange.normalize ?r)] |- _ ]
+ => rewrite ident.cast_normalize in H
+ | [ H : ?T, H' : ?T |- _ ] => clear H'
+ | [ H : context[is_bounded_by_bool _ (ZRange.normalize (-_))] |- _ ]
+ => rewrite ZRange.is_bounded_by_bool_move_opp_normalize in H
+ | [ |- context[is_bounded_by_bool _ (ZRange.normalize (-_))] ]
+ => rewrite ZRange.is_bounded_by_bool_move_opp_normalize
+ | [ H : is_bounded_by_bool ?v (ZRange.normalize ?r) = true |- context[ident.cast _ ?r ?v] ]
+ => rewrite (@ident.cast_in_normalized_bounds _ r v) by exact H
+ | [ H : is_bounded_by_bool ?v (ZRange.normalize ?r) = true |- context[ident.cast _ (-?r) (-?v)] ]
+ => rewrite (@ident.cast_in_normalized_bounds _ (-r) (-v));
+ [ | clear -H ]
+ | [ |- context[ident.cast _ ?r (-ident.cast _ (-?r) ?v)] ]
+ => rewrite (ident.cast_in_normalized_bounds r (-ident.cast _ (-r) v))
+ by (rewrite <- ZRange.is_bounded_by_bool_move_opp_normalize; apply ident.cast_always_bounded)
+ | [ |- context[ident.cast _ ?r (ident.cast _ ?r _)] ]
+ => rewrite (@ident.cast_idempotent _ _ r)
+ | [ H : is_bounded_by_bool _ ?r = true |- _]
+ => is_var r; unique pose proof (ZRange.is_bounded_by_normalize _ _ H)
+
+ end
+ | progress intros
+ | progress subst
+ | assumption
+ | progress destruct_head'_and
+ | progress Z.ltb_to_lt
+ | progress split_andb
+ | match goal with
+ | [ |- ?a mod ?b = ?a' mod ?b ] => apply f_equal2; lia
+ | [ |- ?a / ?b = ?a' / ?b ] => apply f_equal2; lia
+ | [ |- Z.opp _ = Z.opp _ ] => apply f_equal
+ end
+ | break_innermost_match_step
+ | break_innermost_match_hyps_step
+ | progress destruct_head'_or
| match goal with
| [ |- context[-ident.cast _ (-?r) (-?v)] ] => rewrite (ident.cast_opp' r v)
| [ |- context[ident.cast ?coor ?r ?v] ]
@@ -485,11 +541,7 @@ Module Compilers.
[ clear -H; cbv [is_bounded_by_bool] in H; cbn [lower upper] in H; Bool.split_andb; Z.ltb_to_lt; lia..
| ]
end
- | progress cbn [expr.interp_related] in *
| match goal with
- | [ H : context[expr.interp _ (UnderLets.interp _ (?f _ _ _))]
- |- expr.interp _ (UnderLets.interp _ (?f _ _ _)) = _ ]
- => apply H
| [ |- context[Z.shiftl] ] => rewrite Z.shiftl_mul_pow2 by auto with zarith
| [ |- context[Z.shiftr] ] => rewrite Z.shiftr_div_pow2 by auto with zarith
| [ |- context[Z.shiftl _ (-_)] ] => rewrite Z.shiftl_opp_r
@@ -503,19 +555,25 @@ Module Compilers.
| [ H : ?x = 2^Z.log2 ?x, H' : context[2^Z.log2 ?x] |- _ = _ :> BinInt.Z ]
=> rewrite <- H in H'
| [ |- _ = _ :> BinInt.Z ] => progress autorewrite with zsimplify_const
- | [ |- ?f (?g (nat_rect _ _ _ ?n ?v)) = nat_rect _ _ _ ?n _ ]
- => revert v; is_var n; induction n; intro v; cbn [nat_rect]
| [ H : 0 <= ?x, H' : ?x <= ?r - 1 |- context[?x mod ?r] ]
=> rewrite (Z.mod_small x r) by (clear -H H'; lia)
| [ H : 0 <= ?x, H' : ?x <= ?y - 1 |- context[?x / ?y] ]
=> rewrite (Z.div_small x y) by (clear -H H'; lia)
+ | [ H : ?x = 2^Z.log2 ?x |- _ ]
+ => unique assert (0 <= x) by (rewrite H; auto with zarith)
| [ |- _ mod ?x = _ mod ?x ]
=> progress (push_Zmod; pull_Zmod)
+ | [ |- ?f (_ mod ?x) = ?f (_ mod ?x) ]
+ => progress (push_Zmod; pull_Zmod)
| [ |- _ mod ?x = _ mod ?x ]
=> apply f_equal2; (lia + nia)
| [ |- context[-?x + ?y] ] => rewrite !Z.add_opp_l
| [ |- context[?n + - ?m] ] => rewrite !Z.add_opp_r
| [ |- context[?n - - ?m] ] => rewrite !Z.sub_opp_r
+ | [ |- context[Zpos ?p * ?x / Zpos ?p] ]
+ => rewrite (@Z.div_mul' x (Zpos p)) in * by (clear; lia)
+ | [ H : context[Zpos ?p * ?x / Zpos ?p] |- _ ]
+ => rewrite (@Z.div_mul' x (Zpos p)) in * by (clear; lia)
| [ |- ?f (?a mod ?r) = ?f (?b mod ?r) ] => apply f_equal; apply f_equal2; lia
| [ |- context[-?a - ?b + ?c] ] => replace (-a - b + c) with (c - a - b) by (clear; lia)
| [ |- context[?x - ?y + ?z] ]
@@ -528,175 +586,180 @@ Module Compilers.
| [ |- context[x - z - y] ]
=> progress replace (x - z - y) with (x - y - z) by (clear; lia)
end
+ | [ |- context[?x + ?y] ]
+ => lazymatch goal with
+ | [ |- context[y + x] ]
+ => progress replace (y + x) with (x + y) by (clear; lia)
+ end
+ | [ |- context[?x + ?y + ?z] ]
+ => lazymatch goal with
+ | [ |- context[x + z + y] ]
+ => progress replace (x + z + y) with (x + y + z) by (clear; lia)
+ | [ |- context[z + x + y] ]
+ => progress replace (z + x + y) with (x + y + z) by (clear; lia)
+ | [ |- context[z + y + x] ]
+ => progress replace (z + y + x) with (x + y + z) by (clear; lia)
+ | [ |- context[y + x + z] ]
+ => progress replace (y + x + z) with (x + y + z) by (clear; lia)
+ | [ |- context[y + z + x] ]
+ => progress replace (y + z + x) with (x + y + z) by (clear; lia)
+ end
| [ |- - ident.cast _ (-?r) (- (?x / ?y)) = ident.cast _ ?r (?x' / ?y) ]
=> tryif constr_eq x x' then fail else replace x with x' by lia
| [ |- _ = _ :> BinInt.Z ] => progress autorewrite with zsimplify_fast
- | [ |- ident.cast _ ?r _ = ident.cast _ ?r _ ] => apply f_equal; Z.div_mod_to_quot_rem; nia
- | [ H : forall x1 x2, ?R1 x1 x2 -> ?R2 (?f1 x1) (?f2 x2) |- ?R2 (?f1 _) (?f2 _) ]
- => apply H
- | [ H : forall x1 x2, ?R1 x1 x2 -> forall y1 y2, ?R2 y1 y2 -> ?R3 (?f1 x1 y1) (?f2 x2 y2) |- ?R3 (?f1 _ _) (?f2 _ _) ]
- => apply H
- | [ H : forall x x', ?Rx x x' -> forall y y', _ -> forall z z', ?Rz z z' -> ?R (?f x y z) (?f' x' y' z') |- ?R (?f _ _ _) (?f' _ _ _) ]
- => apply H; clear H
end ].
+ Local Ltac remove_casts :=
+ repeat match goal with
+ | [ |- context[ident.cast _ ?r (ident.cast _ ?r _)] ]
+ => rewrite ident.cast_idempotent
+ | [ H : context[ident.cast _ ?r (ident.cast _ ?r _)] |- _ ]
+ => rewrite ident.cast_idempotent in H
+ | [ |- context[ident.cast ?coor ?r ?v] ]
+ => is_var v;
+ pose proof (@ident.cast_always_bounded coor r v);
+ generalize dependent (ident.cast coor r v);
+ clear v; intro v; intros
+ | [ H : context[ident.cast ?coor ?r ?v] |- _ ]
+ => is_var v;
+ pose proof (@ident.cast_always_bounded coor r v);
+ generalize dependent (ident.cast coor r v);
+ clear v; intro v; intros
+ | [ H : context[ZRange.constant ?v] |- _ ] => unique pose proof (ZRange.is_bounded_by_bool_normalize_constant v)
+ | [ H : is_tighter_than_bool (?ZRf ?r1 ?r2) (ZRange.normalize ?rs) = true,
+ H1 : is_bounded_by_bool ?v1 ?r1 = true,
+ H2 : is_bounded_by_bool ?v2 ?r2 = true
+ |- _ ]
+ => let cst := multimatch goal with
+ | [ |- context[ident.cast ?coor rs (?Zf v1 v2)] ] => constr:(ident.cast coor rs (Zf v1 v2))
+ | [ H : context[ident.cast ?coor rs (?Zf v1 v2)] |- _ ] => constr:(ident.cast coor rs (Zf v1 v2))
+ end in
+ lazymatch cst with
+ | ident.cast ?coor rs (?Zf v1 v2)
+ => let lem := lazymatch constr:((ZRf, Zf)%core) with
+ | (ZRange.shiftl, Z.shiftl)%core => constr:(@ZRange.is_bounded_by_bool_shiftl v1 r1 v2 r2 H1 H2)
+ | (ZRange.shiftr, Z.shiftr)%core => constr:(@ZRange.is_bounded_by_bool_shiftr v1 r1 v2 r2 H1 H2)
+ | (ZRange.land, Z.land)%core => constr:(@ZRange.is_bounded_by_bool_land v1 r1 v2 r2 H1 H2)
+ end in
+ try unique pose proof (@ZRange.is_bounded_by_of_is_tighter_than _ _ H _ lem);
+ clear H;
+ rewrite (@ident.cast_in_normalized_bounds coor rs (Zf v1 v2)) in * by assumption
+ end
+ | [ H : is_tighter_than_bool (?ZRf ?r1) (ZRange.normalize ?rs) = true,
+ H1 : is_bounded_by_bool ?v1 ?r1 = true
+ |- _ ]
+ => let cst := multimatch goal with
+ | [ |- context[ident.cast ?coor rs (?Zf v1)] ] => constr:(ident.cast coor rs (Zf v1))
+ | [ H : context[ident.cast ?coor rs (?Zf v1)] |- _ ] => constr:(ident.cast coor rs (Zf v1))
+ end in
+ lazymatch cst with
+ | ident.cast ?coor rs (?Zf v1)
+ => let lem := lazymatch constr:((ZRf, Zf)%core) with
+ | (ZRange.cc_m ?s, Z.cc_m ?s)%core => constr:(@ZRange.is_bounded_by_bool_cc_m s v1 r1 H1)
+ end in
+ try unique pose proof (@ZRange.is_bounded_by_of_is_tighter_than _ _ H _ lem);
+ clear H;
+ rewrite (@ident.cast_in_normalized_bounds coor rs (Zf v1)) in * by assumption
+ end
+ | [ H : is_bounded_by_bool ?v (ZRange.normalize ?r) |- context[ident.cast ?coor ?r ?v] ]
+ => rewrite (@ident.cast_in_normalized_bounds coor r v) in * by assumption
+ | [ H : is_bounded_by_bool ?v (ZRange.normalize ?r), H' : context[ident.cast ?coor ?r ?v] |- _ ]
+ => rewrite (@ident.cast_in_normalized_bounds coor r v) in * by assumption
+ | [ H : is_bounded_by_bool ?v ?r = true,
+ H' : is_tighter_than_bool ?r r[0~>?x-1]%zrange = true,
+ H'' : Z.eqb ?x ?m = true
+ |- context[?v mod ?m] ]
+ => unique assert (is_bounded_by_bool v r[0~>x-1] = true)
+ by (eapply ZRange.is_bounded_by_of_is_tighter_than; eassumption)
+ end.
+
+ Local Ltac unfold_cast_lemmas :=
+ repeat match goal with
+ | [ H : context[ZRange.normalize (ZRange.constant _)] |- _ ]
+ => rewrite ZRange.normalize_constant in H
+ | [ H : is_bounded_by_bool _ (ZRange.normalize ?r) = true |- _ ]
+ => is_var r; generalize dependent (ZRange.normalize r); clear r; intro r; intros
+ | [ H : is_bounded_by_bool ?x (ZRange.constant ?x) = true |- _ ]
+ => clear H
+ | [ H : is_bounded_by_bool ?x ?r = true |- _ ]
+ => is_var r; apply unfold_is_bounded_by_bool in H
+ | [ H : is_bounded_by_bool ?x r[_~>_] = true |- _ ]
+ => apply unfold_is_bounded_by_bool in H
+ | [ H : is_tighter_than_bool r[_~>_] r[_~>_] = true |- _ ]
+ => apply unfold_is_tighter_than_bool in H
+ | _ => progress cbn [lower upper] in *
+ | [ H : context[lower ?r] |- _ ]
+ => is_var r; let l := fresh "l" in let u := fresh "u" in destruct r as [l u]
+ | [ H : context[upper ?r] |- _ ]
+ => is_var r; let l := fresh "l" in let u := fresh "u" in destruct r as [l u]
+ | _ => progress Z.ltb_to_lt
+ end.
+
+ Local Ltac systematically_handle_casts :=
+ remove_casts; unfold_cast_lemmas.
+
+ Local Ltac fin_with_nia :=
+ lazymatch goal with
+ | [ |- ident.cast _ ?r _ = ident.cast _ ?r _ ] => apply f_equal; Z.div_mod_to_quot_rem; nia
+ | _ => reflexivity || (Z.div_mod_to_quot_rem; (lia + nia))
+ end.
+
Lemma nbe_rewrite_rules_interp_good
: rewrite_rules_interp_goodT nbe_rewrite_rules.
Proof using Type.
Time start_interp_good.
- Time all: try solve [ repeat interp_good_t_step ].
+ Time all: try solve [ repeat interp_good_t_step_related ].
Qed.
Lemma arith_rewrite_rules_interp_good max_const
: rewrite_rules_interp_goodT (arith_rewrite_rules max_const).
Proof using Type.
Time start_interp_good.
- Time all: try solve [ repeat interp_good_t_step; (lia + nia) ].
+ Time all: try solve [ repeat interp_good_t_step_related; repeat interp_good_t_step_arith; fin_with_nia ].
Qed.
Lemma arith_with_casts_rewrite_rules_interp_good
: rewrite_rules_interp_goodT arith_with_casts_rewrite_rules.
Proof using Type.
Time start_interp_good.
- Time all: try solve [ repeat interp_good_t_step; Z.div_mod_to_quot_rem; (lia + nia) ].
+ Time all: try solve [ repeat interp_good_t_step_related; repeat interp_good_t_step_arith; fin_with_nia ].
Qed.
Local Ltac fancy_local_t :=
- repeat first [ match goal with
- | [ H : forall s v v', ?invert_low s v = Some v' -> v = _,
- H' : ?invert_low _ _ = Some _ |- _ ] => apply H in H'
- end
- | progress autorewrite with zsimplify in * ].
-
- Axiom proof_admitted : False.
- Local Notation admit := (match proof_admitted with end).
+ repeat match goal with
+ | [ H : forall s v v', ?invert_low s v = Some v' -> v = _,
+ H' : ?invert_low _ _ = Some _ |- _ ] => apply H in H'
+ | [ H : forall s v v', ?invert_low s v = Some v' -> v = _ |- _ ]
+ => clear invert_low H
+ end.
+ Local Ltac more_fancy_arith_t := repeat autorewrite with zsimplify in *.
Lemma fancy_rewrite_rules_interp_good
(invert_low invert_high : Z -> Z -> option Z)
+ (value_range flag_range : zrange)
(Hlow : forall s v v', invert_low s v = Some v' -> v = Z.land v' (2^(s/2)-1))
(Hhigh : forall s v v', invert_high s v = Some v' -> v = Z.shiftr v' (s/2))
- : rewrite_rules_interp_goodT (fancy_rewrite_rules invert_low invert_high).
+ : rewrite_rules_interp_goodT fancy_rewrite_rules.
Proof using Type.
Time start_interp_good.
- Time all: try solve [
- repeat interp_good_t_step;
- cbv [Option.bind] in *;
- repeat interp_good_t_step;
- fancy_local_t;
- repeat interp_good_t_step ].
- Time all: repeat interp_good_t_step.
- Time all: cbv [Option.bind] in *.
- Time all: repeat interp_good_t_step.
- Time all: fancy_local_t.
- Time all: repeat interp_good_t_step.
- all: repeat first [ progress cbn [Compile.value' Compile.reify] in *
- | progress subst
- | match goal with
- | [ H : expr.interp_related _ ?x ?y |- _ ]
- => clear H x
- end ].
- all: repeat match goal with
- | [ H : _ = _ :> BinInt.Z |- _ ] => revert H
- | [ |- context[?v] ]
- => is_var v; match type of v with BinInt.Z => idtac end;
- revert v
- | [ v : BinInt.Z |- _ ] => clear v || revert v
- end.
- all: repeat match goal with
- | [ |- forall n : BinInt.Z, _ ] => let x := fresh "xx" in intro x
- | [ |- forall n : _ = _ :> BinInt.Z, _ ] => let H := fresh "H" in intro H
- end.
- all: repeat match goal with
- | [ H : _ = _ :> BinInt.Z |- _ ] => revert H
- | [ v : BinInt.Z |- _ ] => clear v || revert v
- end.
- all: repeat match goal with
- | [ |- forall n : BinInt.Z, _ ] => let x := fresh "x" in intro x
- | [ |- forall n : _ = _ :> BinInt.Z, _ ] => let H := fresh "H" in intro H
- end.
- all: repeat match goal with
- | [ H : _ = _ :> BinInt.Z |- _ ] => revert H
- | [ v : BinInt.Z |- _ ] => clear v || revert v
- end.
- Set Printing Width 80.
- (* 16 subgoals (ID 124724)
-
- cast_outside_of_range : zrange -> Z -> Z
- invert_low, invert_high : Z -> Z -> option Z
- Hlow : forall s v v' : Z,
- invert_low s v = Some v' -> v = Z.land v' (2 ^ (s / 2) - 1)
- Hhigh : forall s v v' : Z, invert_high s v = Some v' -> v = Z.shiftr v' (s / 2)
- ============================
- forall x x0 x1 x2 : Z,
- x2 = 2 ^ Z.log2 x2 ->
- (x1 + Z.shiftl x0 x mod x2) / x2 = (x1 + Z.shiftl x0 x) / x2
-
-subgoal 2 (ID 124734) is:
- forall x x0 x1 x2 : Z,
- x2 = 2 ^ Z.log2 x2 ->
- (x1 + Z.shiftl x0 x mod x2) / x2 = (Z.shiftl x0 x + x1) / x2
-subgoal 3 (ID 124744) is:
- forall x x0 x1 x2 : Z,
- x2 = 2 ^ Z.log2 x2 ->
- (x1 + Z.shiftr x0 x mod x2) / x2 = (x1 + Z.shiftr x0 x) / x2
-subgoal 4 (ID 124754) is:
- forall x x0 x1 x2 : Z,
- x2 = 2 ^ Z.log2 x2 ->
- (x1 + Z.shiftr x0 x mod x2) / x2 = (Z.shiftr x0 x + x1) / x2
-subgoal 5 (ID 124762) is:
- forall x x0 x1 : Z, x1 = 2 ^ Z.log2 x1 -> (x0 + x mod x1) / x1 = (x0 + x) / x1
-subgoal 6 (ID 124774) is:
- forall x x0 x1 x2 x3 : Z,
- x3 = 2 ^ Z.log2 x3 ->
- (x2 + x1 + Z.shiftl x0 x mod x3) / x3 = (x2 + x1 + Z.shiftl x0 x) / x3
-subgoal 7 (ID 124786) is:
- forall x x0 x1 x2 x3 : Z,
- x3 = 2 ^ Z.log2 x3 ->
- (x2 + x1 + Z.shiftl x0 x mod x3) / x3 = (x2 + Z.shiftl x0 x + x1) / x3
-subgoal 8 (ID 124798) is:
- forall x x0 x1 x2 x3 : Z,
- x3 = 2 ^ Z.log2 x3 ->
- (x2 + x1 + Z.shiftr x0 x mod x3) / x3 = (x2 + x1 + Z.shiftr x0 x) / x3
-subgoal 9 (ID 124810) is:
- forall x x0 x1 x2 x3 : Z,
- x3 = 2 ^ Z.log2 x3 ->
- (x2 + x1 + Z.shiftr x0 x mod x3) / x3 = (x2 + Z.shiftr x0 x + x1) / x3
-subgoal 10 (ID 124820) is:
- forall x x0 x1 x2 : Z,
- x2 = 2 ^ Z.log2 x2 -> (x1 + x0 + x mod x2) / x2 = (x1 + x0 + x) / x2
-subgoal 11 (ID 124830) is:
- forall x x0 x1 x2 : Z,
- x2 = 2 ^ Z.log2 x2 ->
- (x1 - Z.shiftl x0 x mod x2) / x2 = (x1 - Z.shiftl x0 x) / x2
-subgoal 12 (ID 124840) is:
- forall x x0 x1 x2 : Z,
- x2 = 2 ^ Z.log2 x2 ->
- (x1 - Z.shiftr x0 x mod x2) / x2 = (x1 - Z.shiftr x0 x) / x2
-subgoal 13 (ID 124848) is:
- forall x x0 x1 : Z, x1 = 2 ^ Z.log2 x1 -> (x0 - x mod x1) / x1 = (x0 - x) / x1
-subgoal 14 (ID 124860) is:
- forall x x0 x1 x2 x3 : Z,
- x3 = 2 ^ Z.log2 x3 ->
- (x2 - Z.shiftl x1 x0 mod x3 - x) / x3 = (x2 - Z.shiftl x1 x0 - x) / x3
-subgoal 15 (ID 124872) is:
- forall x x0 x1 x2 x3 : Z,
- x3 = 2 ^ Z.log2 x3 ->
- (x2 - Z.shiftr x1 x0 mod x3 - x) / x3 = (x2 - Z.shiftr x1 x0 - x) / x3
-subgoal 16 (ID 124882) is:
- forall x x0 x1 x2 : Z,
- x2 = 2 ^ Z.log2 x2 -> (x1 - x0 mod x2 - x) / x2 = (x1 - x0 - x) / x2
- *)
- 1-16: exact admit.
+ Time all: try solve [ repeat interp_good_t_step_related ].
Qed.
Lemma fancy_with_casts_rewrite_rules_interp_good
(invert_low invert_high : Z -> Z -> option Z)
+ (value_range flag_range : zrange)
(Hlow : forall s v v', invert_low s v = Some v' -> v = Z.land v' (2^(s/2)-1))
(Hhigh : forall s v v', invert_high s v = Some v' -> v = Z.shiftr v' (s/2))
- : rewrite_rules_interp_goodT (fancy_with_casts_rewrite_rules (*invert_low invert_high*)).
+ : rewrite_rules_interp_goodT (fancy_with_casts_rewrite_rules invert_low invert_high value_range flag_range).
Proof using Type.
- Time start_interp_good.
- Time all: repeat interp_good_t_step.
+ Time start_interp_good. (* Finished transaction in 1.206 secs (1.207u,0.s) (successful) *)
+ Set Ltac Profiling.
+ Reset Ltac Profile.
+ Time all: repeat interp_good_t_step_related. (* Finished transaction in 13.259 secs (13.128u,0.132s) (successful) *)
+ Reset Ltac Profile.
+ Time all: fancy_local_t. (* Finished transaction in 0.051 secs (0.052u,0.s) (successful) *)
+ Time all: systematically_handle_casts. (* Finished transaction in 2.004 secs (1.952u,0.052s) (successful) *)
+ Time all: try solve [ repeat interp_good_t_step_arith ]. (* Finished transaction in 26.754 secs (26.455u,0.299s) (successful) *)
Qed.
End with_cast.
End RewriteRules.
diff --git a/src/Experiments/NewPipeline/Toplevel1.v b/src/Experiments/NewPipeline/Toplevel1.v
index 8cf5687e6..cd55a4472 100644
--- a/src/Experiments/NewPipeline/Toplevel1.v
+++ b/src/Experiments/NewPipeline/Toplevel1.v
@@ -673,7 +673,7 @@ Module Pipeline.
| Error msg => msg
end.
- Record to_fancy_args := { invert_low : Z (*log2wordmax*) -> Z -> option Z ; invert_high : Z (*log2wordmax*) -> Z -> option Z }.
+ Record to_fancy_args := { invert_low : Z (*log2wordmax*) -> Z -> option Z ; invert_high : Z (*log2wordmax*) -> Z -> option Z ; value_range : zrange ; flag_range : zrange }.
Definition RewriteAndEliminateDeadAndInline {t}
(DoRewrite : Expr t -> Expr t)
@@ -724,7 +724,8 @@ Module Pipeline.
| inl E
=> let E := RewriteAndEliminateDeadAndInline RewriteRules.RewriteArithWithCasts with_dead_code_elimination with_subst01 E in
let E := match translate_to_fancy with
- | Some {| invert_low := invert_low ; invert_high := invert_high |} => RewriteRules.RewriteToFancyWithCasts invert_low invert_high E
+ | Some {| invert_low := invert_low ; invert_high := invert_high ; value_range := value_range ; flag_range := flag_range |}
+ => RewriteRules.RewriteToFancyWithCasts invert_low invert_high value_range flag_range E
| None => E
end in
Success E
@@ -3790,7 +3791,9 @@ Module BarrettReduction.
Context (M : Z)
(machine_wordsize : Z).
- Let bound := Some r[0 ~> (2^machine_wordsize - 1)%Z]%zrange.
+ Let value_range := r[0 ~> (2^machine_wordsize - 1)%Z]%zrange.
+ Let flag_range := r[0 ~> 1]%zrange.
+ Let bound := Some value_range.
Let mu := (2 ^ (2 * machine_wordsize)) / M.
Let muLow := mu mod (2 ^ machine_wordsize).
Let consts_list := [M; muLow].
@@ -3833,7 +3836,9 @@ Module BarrettReduction.
Let fancy_args
:= (Some {| Pipeline.invert_low log2wordsize := invert_low log2wordsize consts_list;
- Pipeline.invert_high log2wordsize := invert_high log2wordsize consts_list |}).
+ Pipeline.invert_high log2wordsize := invert_high log2wordsize consts_list;
+ Pipeline.value_range := value_range;
+ Pipeline.flag_range := flag_range |}).
Lemma fancy_args_good
: match fancy_args with
@@ -3990,7 +3995,9 @@ Module MontgomeryReduction.
Context (N R N' : Z)
(machine_wordsize : Z).
- Let bound := Some r[0 ~> (2^machine_wordsize - 1)%Z]%zrange.
+ Let value_range := r[0 ~> (2^machine_wordsize - 1)%Z]%zrange.
+ Let flag_range := r[0 ~> 1]%zrange.
+ Let bound := Some value_range.
Let consts_list := [N; N'].
Definition relax_zrange_of_machine_wordsize
@@ -4005,7 +4012,9 @@ Module MontgomeryReduction.
Let fancy_args
:= (Some {| Pipeline.invert_low log2wordsize := invert_low log2wordsize consts_list;
- Pipeline.invert_high log2wordsize := invert_high log2wordsize consts_list |}).
+ Pipeline.invert_high log2wordsize := invert_high log2wordsize consts_list;
+ Pipeline.value_range := value_range;
+ Pipeline.flag_range := flag_range |}).
Lemma fancy_args_good
: match fancy_args with
diff --git a/src/Experiments/NewPipeline/fancy_rewrite_head.out b/src/Experiments/NewPipeline/fancy_rewrite_head.out
index 6cc69132c..414237570 100644
--- a/src/Experiments/NewPipeline/fancy_rewrite_head.out
+++ b/src/Experiments/NewPipeline/fancy_rewrite_head.out
@@ -114,1133 +114,7 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
fun (x : expr T) (x0 : expr (list T)) (x1 : expr ℕ) =>
Base (#(List_nth_default)%expr @ x @ x0 @ x1)%expr_pat
| Z_add => fun x x0 : expr ℤ => Base (x + x0)%expr
-| Z_mul =>
- fun x x0 : expr ℤ =>
- (match x with
- | @expr.Ident _ _ _ t idc =>
- match x0 with
- | @expr.App _ _ _ s _
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x2) x1 =>
- (match x1 with
- | @expr.Ident _ _ _ t1 idc1 =>
- args <- invert_bind_args idc1 Raw.ident.Literal;
- _ <- invert_bind_args idc0 Raw.ident.Z_land;
- args1 <- invert_bind_args idc Raw.ident.Literal;
- match
- pattern.type.unify_extracted_cps (ℤ -> ℤ -> ℤ)%ptype
- ((projT1 args1) -> s0 -> (projT1 args))%ptype option
- (fun x3 : option => x3)
- with
- | Some (_, (_, _))%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- (ℤ -> ℤ -> ℤ)%ptype
- ((projT1 args1) -> s0 -> (projT1 args))%ptype
- then
- xv <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- v <- type.try_make_transport_cps s0 ℤ;
- 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
- | _ => None
- end;;
- match x2 with
- | @expr.Ident _ _ _ t1 idc1 =>
- (args <- invert_bind_args idc1 Raw.ident.Literal;
- _ <- invert_bind_args idc0 Raw.ident.Z_land;
- args1 <- invert_bind_args idc Raw.ident.Literal;
- match
- pattern.type.unify_extracted_cps (ℤ -> ℤ -> ℤ)%ptype
- ((projT1 args1) -> (projT1 args) -> s)%ptype option
- (fun x3 : option => x3)
- with
- | Some (_, (_, _))%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- (ℤ -> ℤ -> ℤ)%ptype
- ((projT1 args1) -> (projT1 args) -> s)%ptype
- then
- xv <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- xv0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- v <- type.try_make_transport_cps s ℤ;
- 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);;
- args <- invert_bind_args idc1 Raw.ident.Literal;
- _ <- invert_bind_args idc0 Raw.ident.Z_land;
- args1 <- invert_bind_args idc Raw.ident.Literal;
- match
- pattern.type.unify_extracted_cps (ℤ -> ℤ -> ℤ)%ptype
- ((projT1 args1) -> (projT1 args) -> s)%ptype option
- (fun x3 : option => x3)
- with
- | Some (_, (_, _))%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- (ℤ -> ℤ -> ℤ)%ptype
- ((projT1 args1) -> (projT1 args) -> s)%ptype
- then
- xv <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- xv0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- v <- type.try_make_transport_cps s ℤ;
- 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
- | _ => None
- end;;
- match x1 with
- | @expr.Ident _ _ _ t1 idc1 =>
- args <- invert_bind_args idc1 Raw.ident.Literal;
- _ <- invert_bind_args idc0 Raw.ident.Z_land;
- args1 <- invert_bind_args idc Raw.ident.Literal;
- match
- pattern.type.unify_extracted_cps (ℤ -> ℤ -> ℤ)%ptype
- ((projT1 args1) -> s0 -> (projT1 args))%ptype option
- (fun x3 : option => x3)
- with
- | Some (_, (_, _))%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- (ℤ -> ℤ -> ℤ)%ptype
- ((projT1 args1) -> s0 -> (projT1 args))%ptype
- then
- xv <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- v <- type.try_make_transport_cps s0 ℤ;
- 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
- | _ => None
- end);;
- match x1 with
- | @expr.Ident _ _ _ t1 idc1 =>
- (args <- invert_bind_args idc1 Raw.ident.Literal;
- _ <- invert_bind_args idc0 Raw.ident.Z_shiftr;
- args1 <- invert_bind_args idc Raw.ident.Literal;
- match
- pattern.type.unify_extracted_cps (ℤ -> ℤ -> ℤ)%ptype
- ((projT1 args1) -> s0 -> (projT1 args))%ptype option
- (fun x3 : option => x3)
- with
- | Some (_, (_, _))%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- (ℤ -> ℤ -> ℤ)%ptype
- ((projT1 args1) -> s0 -> (projT1 args))%ptype
- then
- xv <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- v <- type.try_make_transport_cps s0 ℤ;
- 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);;
- args <- invert_bind_args idc1 Raw.ident.Literal;
- _ <- invert_bind_args idc0 Raw.ident.Z_shiftr;
- args1 <- invert_bind_args idc Raw.ident.Literal;
- match
- pattern.type.unify_extracted_cps (ℤ -> ℤ -> ℤ)%ptype
- ((projT1 args1) -> s0 -> (projT1 args))%ptype option
- (fun x3 : option => x3)
- with
- | Some (_, (_, _))%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- (ℤ -> ℤ -> ℤ)%ptype
- ((projT1 args1) -> s0 -> (projT1 args))%ptype
- then
- xv <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- v <- type.try_make_transport_cps s0 ℤ;
- 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
- | _ => None
- end
- | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ ($_)%expr _) _ |
- @expr.App _ _ _ s _
- (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _) _ | @expr.App _ _
- _ s _ (@expr.App _ _ _ s0 _ (_ @ _)%expr_pat _) _ | @expr.App _ _
- _ s _ (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _) _ =>
- None
- | @expr.App _ _ _ s _ #(_)%expr_pat _ | @expr.App _ _ _ s _
- ($_)%expr _ | @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ |
- @expr.App _ _ _ s _ (@expr.LetIn _ _ _ _ _ _ _) _ => None
- | _ => None
- end
- | @expr.App _ _ _ s _
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc) x2) x1 =>
- (match x2 with
- | @expr.Ident _ _ _ t0 idc0 =>
- match x0 with
- | @expr.Ident _ _ _ t1 idc1 =>
- args <- invert_bind_args idc1 Raw.ident.Literal;
- args0 <- invert_bind_args idc0 Raw.ident.Literal;
- _ <- invert_bind_args idc Raw.ident.Z_land;
- match
- pattern.type.unify_extracted_cps ((ℤ -> ℤ) -> ℤ)%ptype
- (((projT1 args0) -> s) -> (projT1 args))%ptype option
- (fun x3 : option => x3)
- with
- | Some (_, _, _)%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- ((ℤ -> ℤ) -> ℤ)%ptype
- (((projT1 args0) -> s) -> (projT1 args))%ptype
- then
- xv <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- v <- type.try_make_transport_cps s ℤ;
- 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
- | _ => None
- end
- | _ => None
- end;;
- match x1 with
- | @expr.Ident _ _ _ t0 idc0 =>
- match x0 with
- | @expr.Ident _ _ _ t1 idc1 =>
- args <- invert_bind_args idc1 Raw.ident.Literal;
- args0 <- invert_bind_args idc0 Raw.ident.Literal;
- _ <- invert_bind_args idc Raw.ident.Z_land;
- match
- pattern.type.unify_extracted_cps ((ℤ -> ℤ) -> ℤ)%ptype
- ((s0 -> (projT1 args0)) -> (projT1 args))%ptype option
- (fun x3 : option => x3)
- with
- | Some (_, _, _)%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- ((ℤ -> ℤ) -> ℤ)%ptype
- ((s0 -> (projT1 args0)) -> (projT1 args))%ptype
- then
- v <- type.try_make_transport_cps s0 ℤ;
- 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
- | _ => None
- end
- | _ => None
- end;;
- match x2 with
- | @expr.Ident _ _ _ t0 idc0 =>
- match x0 with
- | @expr.Ident _ _ _ t1 idc1 =>
- args <- invert_bind_args idc1 Raw.ident.Literal;
- args0 <- invert_bind_args idc0 Raw.ident.Literal;
- _ <- invert_bind_args idc Raw.ident.Z_land;
- match
- pattern.type.unify_extracted_cps ((ℤ -> ℤ) -> ℤ)%ptype
- (((projT1 args0) -> s) -> (projT1 args))%ptype option
- (fun x3 : option => x3)
- with
- | Some (_, _, _)%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- ((ℤ -> ℤ) -> ℤ)%ptype
- (((projT1 args0) -> s) -> (projT1 args))%ptype
- then
- xv <- ident.unify pattern.ident.Literal
- ##(projT2 args0);
- v <- type.try_make_transport_cps s ℤ;
- 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
- | _ => None
- end
- | _ => None
- end;;
- match x1 with
- | @expr.Ident _ _ _ t0 idc0 =>
- match x0 with
- | @expr.Ident _ _ _ t1 idc1 =>
- args <- invert_bind_args idc1 Raw.ident.Literal;
- args0 <- invert_bind_args idc0 Raw.ident.Literal;
- _ <- invert_bind_args idc Raw.ident.Z_land;
- match
- pattern.type.unify_extracted_cps ((ℤ -> ℤ) -> ℤ)%ptype
- ((s0 -> (projT1 args0)) -> (projT1 args))%ptype option
- (fun x3 : option => x3)
- with
- | Some (_, _, _)%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- ((ℤ -> ℤ) -> ℤ)%ptype
- ((s0 -> (projT1 args0)) -> (projT1 args))%ptype
- then
- v <- type.try_make_transport_cps s0 ℤ;
- 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
- | _ => None
- end
- | _ => None
- end;;
- match x2 with
- | @expr.Ident _ _ _ t0 idc0 =>
- match x0 with
- | @expr.App _ _ _ s1 _
- (@expr.Ident _ _ _ t1 idc1 @ @expr.Ident _ _ _ t2 idc2)%expr_pat
- x3 =>
- args <- invert_bind_args idc2 Raw.ident.Literal;
- _ <- invert_bind_args idc1 Raw.ident.Z_land;
- args1 <- invert_bind_args idc0 Raw.ident.Literal;
- _ <- invert_bind_args idc Raw.ident.Z_land;
- match
- pattern.type.unify_extracted_cps
- ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- (((projT1 args1) -> s) -> (projT1 args) -> s1)%ptype
- option (fun x5 : option => x5)
- with
- | Some (_, _, (_, _))%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- (((projT1 args1) -> s) -> (projT1 args) -> s1)%ptype
- then
- xv <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- v <- type.try_make_transport_cps s ℤ;
- xv0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- v0 <- type.try_make_transport_cps s1 ℤ;
- 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
- | @expr.App _ _ _ s1 _
- (@expr.Ident _ _ _ t1 idc1 @ ($_)%expr)%expr_pat _ |
- @expr.App _ _ _ s1 _
- (@expr.Ident _ _ _ t1 idc1 @ @expr.Abs _ _ _ _ _ _)%expr_pat
- _ | @expr.App _ _ _ s1 _
- (@expr.Ident _ _ _ t1 idc1 @ (_ @ _))%expr_pat _ | @expr.App
- _ _ _ s1 _
- (@expr.Ident _ _ _ t1 idc1 @ @expr.LetIn _ _ _ _ _ _ _)%expr_pat
- _ => None
- | @expr.App _ _ _ s1 _ #(_)%expr_pat _ | @expr.App _ _ _ s1 _
- ($_)%expr _ | @expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _)
- _ | @expr.App _ _ _ s1 _ (($_)%expr @ _)%expr_pat _ |
- @expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _ @ _)%expr_pat _ |
- @expr.App _ _ _ s1 _ (_ @ _ @ _)%expr_pat _ | @expr.App _ _ _
- s1 _ (@expr.LetIn _ _ _ _ _ _ _ @ _)%expr_pat _ | @expr.App _
- _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ => None
- | _ => None
- end
- | _ => None
- end;;
- match x1 with
- | @expr.Ident _ _ _ t0 idc0 =>
- match x0 with
- | @expr.App _ _ _ s1 _
- (@expr.Ident _ _ _ t1 idc1 @ @expr.Ident _ _ _ t2 idc2)%expr_pat
- x3 =>
- args <- invert_bind_args idc2 Raw.ident.Literal;
- _ <- invert_bind_args idc1 Raw.ident.Z_land;
- args1 <- invert_bind_args idc0 Raw.ident.Literal;
- _ <- invert_bind_args idc Raw.ident.Z_land;
- match
- pattern.type.unify_extracted_cps
- ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- ((s0 -> (projT1 args1)) -> (projT1 args) -> s1)%ptype
- option (fun x5 : option => x5)
- with
- | Some (_, _, (_, _))%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- ((s0 -> (projT1 args1)) -> (projT1 args) -> s1)%ptype
- then
- v <- type.try_make_transport_cps s0 ℤ;
- xv <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- xv0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- v0 <- type.try_make_transport_cps s1 ℤ;
- 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
- | @expr.App _ _ _ s1 _
- (@expr.Ident _ _ _ t1 idc1 @ ($_)%expr)%expr_pat _ |
- @expr.App _ _ _ s1 _
- (@expr.Ident _ _ _ t1 idc1 @ @expr.Abs _ _ _ _ _ _)%expr_pat
- _ | @expr.App _ _ _ s1 _
- (@expr.Ident _ _ _ t1 idc1 @ (_ @ _))%expr_pat _ | @expr.App
- _ _ _ s1 _
- (@expr.Ident _ _ _ t1 idc1 @ @expr.LetIn _ _ _ _ _ _ _)%expr_pat
- _ => None
- | @expr.App _ _ _ s1 _ #(_)%expr_pat _ | @expr.App _ _ _ s1 _
- ($_)%expr _ | @expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _)
- _ | @expr.App _ _ _ s1 _ (($_)%expr @ _)%expr_pat _ |
- @expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _ @ _)%expr_pat _ |
- @expr.App _ _ _ s1 _ (_ @ _ @ _)%expr_pat _ | @expr.App _ _ _
- s1 _ (@expr.LetIn _ _ _ _ _ _ _ @ _)%expr_pat _ | @expr.App _
- _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ => None
- | _ => None
- end
- | _ => None
- end;;
- match x2 with
- | @expr.Ident _ _ _ t0 idc0 =>
- match x0 with
- | (@expr.App _ _ _ s2 _ (@expr.Ident _ _ _ t1 idc1) x4 @
- @expr.Ident _ _ _ t2 idc2)%expr_pat =>
- args <- invert_bind_args idc2 Raw.ident.Literal;
- _ <- invert_bind_args idc1 Raw.ident.Z_land;
- args1 <- invert_bind_args idc0 Raw.ident.Literal;
- _ <- invert_bind_args idc Raw.ident.Z_land;
- match
- pattern.type.unify_extracted_cps
- ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- (((projT1 args1) -> s) -> s2 -> (projT1 args))%ptype
- option (fun x5 : option => x5)
- with
- | Some (_, _, (_, _))%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- (((projT1 args1) -> s) -> s2 -> (projT1 args))%ptype
- then
- xv <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- v <- type.try_make_transport_cps s ℤ;
- v0 <- type.try_make_transport_cps s2 ℤ;
- 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
- | (@expr.App _ _ _ s2 _ (@expr.Ident _ _ _ t1 idc1) x4 @
- ($_)%expr)%expr_pat |
- (@expr.App _ _ _ s2 _ (@expr.Ident _ _ _ t1 idc1) x4 @
- @expr.Abs _ _ _ _ _ _)%expr_pat |
- (@expr.App _ _ _ s2 _ (@expr.Ident _ _ _ t1 idc1) x4 @
- (_ @ _))%expr_pat |
- (@expr.App _ _ _ s2 _ (@expr.Ident _ _ _ t1 idc1) x4 @
- @expr.LetIn _ _ _ _ _ _ _)%expr_pat => None
- | (@expr.App _ _ _ s2 _ ($_)%expr _ @ _)%expr_pat |
- (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s2 _ (_ @ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat =>
- None
- | _ => None
- end
- | _ => None
- end;;
- match x1 with
- | @expr.Ident _ _ _ t0 idc0 =>
- match x0 with
- | (@expr.App _ _ _ s2 _ (@expr.Ident _ _ _ t1 idc1) x4 @
- @expr.Ident _ _ _ t2 idc2)%expr_pat =>
- args <- invert_bind_args idc2 Raw.ident.Literal;
- _ <- invert_bind_args idc1 Raw.ident.Z_land;
- args1 <- invert_bind_args idc0 Raw.ident.Literal;
- _ <- invert_bind_args idc Raw.ident.Z_land;
- match
- pattern.type.unify_extracted_cps
- ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- ((s0 -> (projT1 args1)) -> s2 -> (projT1 args))%ptype
- option (fun x5 : option => x5)
- with
- | Some (_, _, (_, _))%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- ((s0 -> (projT1 args1)) -> s2 -> (projT1 args))%ptype
- then
- v <- type.try_make_transport_cps s0 ℤ;
- xv <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- v0 <- type.try_make_transport_cps s2 ℤ;
- 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
- | (@expr.App _ _ _ s2 _ (@expr.Ident _ _ _ t1 idc1) x4 @
- ($_)%expr)%expr_pat |
- (@expr.App _ _ _ s2 _ (@expr.Ident _ _ _ t1 idc1) x4 @
- @expr.Abs _ _ _ _ _ _)%expr_pat |
- (@expr.App _ _ _ s2 _ (@expr.Ident _ _ _ t1 idc1) x4 @
- (_ @ _))%expr_pat |
- (@expr.App _ _ _ s2 _ (@expr.Ident _ _ _ t1 idc1) x4 @
- @expr.LetIn _ _ _ _ _ _ _)%expr_pat => None
- | (@expr.App _ _ _ s2 _ ($_)%expr _ @ _)%expr_pat |
- (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s2 _ (_ @ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat =>
- None
- | _ => None
- end
- | _ => None
- end;;
- match x2 with
- | @expr.Ident _ _ _ t0 idc0 =>
- match x0 with
- | (@expr.App _ _ _ s2 _ (@expr.Ident _ _ _ t1 idc1) x4 @
- @expr.Ident _ _ _ t2 idc2)%expr_pat =>
- args <- invert_bind_args idc2 Raw.ident.Literal;
- _ <- invert_bind_args idc1 Raw.ident.Z_shiftr;
- args1 <- invert_bind_args idc0 Raw.ident.Literal;
- _ <- invert_bind_args idc Raw.ident.Z_land;
- match
- pattern.type.unify_extracted_cps
- ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- (((projT1 args1) -> s) -> s2 -> (projT1 args))%ptype
- option (fun x5 : option => x5)
- with
- | Some (_, _, (_, _))%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- (((projT1 args1) -> s) -> s2 -> (projT1 args))%ptype
- then
- xv <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- v <- type.try_make_transport_cps s ℤ;
- v0 <- type.try_make_transport_cps s2 ℤ;
- 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
- | (@expr.App _ _ _ s2 _ (@expr.Ident _ _ _ t1 idc1) x4 @
- ($_)%expr)%expr_pat |
- (@expr.App _ _ _ s2 _ (@expr.Ident _ _ _ t1 idc1) x4 @
- @expr.Abs _ _ _ _ _ _)%expr_pat |
- (@expr.App _ _ _ s2 _ (@expr.Ident _ _ _ t1 idc1) x4 @
- (_ @ _))%expr_pat |
- (@expr.App _ _ _ s2 _ (@expr.Ident _ _ _ t1 idc1) x4 @
- @expr.LetIn _ _ _ _ _ _ _)%expr_pat => None
- | (@expr.App _ _ _ s2 _ ($_)%expr _ @ _)%expr_pat |
- (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s2 _ (_ @ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat =>
- None
- | _ => None
- end
- | _ => None
- end;;
- match x1 with
- | @expr.Ident _ _ _ t0 idc0 =>
- match x0 with
- | (@expr.App _ _ _ s2 _ (@expr.Ident _ _ _ t1 idc1) x4 @
- @expr.Ident _ _ _ t2 idc2)%expr_pat =>
- args <- invert_bind_args idc2 Raw.ident.Literal;
- _ <- invert_bind_args idc1 Raw.ident.Z_shiftr;
- args1 <- invert_bind_args idc0 Raw.ident.Literal;
- _ <- invert_bind_args idc Raw.ident.Z_land;
- match
- pattern.type.unify_extracted_cps
- ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- ((s0 -> (projT1 args1)) -> s2 -> (projT1 args))%ptype
- option (fun x5 : option => x5)
- with
- | Some (_, _, (_, _))%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- ((s0 -> (projT1 args1)) -> s2 -> (projT1 args))%ptype
- then
- v <- type.try_make_transport_cps s0 ℤ;
- xv <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- v0 <- type.try_make_transport_cps s2 ℤ;
- 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
- | (@expr.App _ _ _ s2 _ (@expr.Ident _ _ _ t1 idc1) x4 @
- ($_)%expr)%expr_pat |
- (@expr.App _ _ _ s2 _ (@expr.Ident _ _ _ t1 idc1) x4 @
- @expr.Abs _ _ _ _ _ _)%expr_pat |
- (@expr.App _ _ _ s2 _ (@expr.Ident _ _ _ t1 idc1) x4 @
- (_ @ _))%expr_pat |
- (@expr.App _ _ _ s2 _ (@expr.Ident _ _ _ t1 idc1) x4 @
- @expr.LetIn _ _ _ _ _ _ _)%expr_pat => None
- | (@expr.App _ _ _ s2 _ ($_)%expr _ @ _)%expr_pat |
- (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s2 _ (_ @ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat =>
- None
- | _ => None
- end
- | _ => None
- end);;
- match x1 with
- | @expr.Ident _ _ _ t0 idc0 =>
- match x0 with
- | @expr.Ident _ _ _ t1 idc1 =>
- (args <- invert_bind_args idc1 Raw.ident.Literal;
- args0 <- invert_bind_args idc0 Raw.ident.Literal;
- _ <- invert_bind_args idc Raw.ident.Z_shiftr;
- match
- pattern.type.unify_extracted_cps ((ℤ -> ℤ) -> ℤ)%ptype
- ((s0 -> (projT1 args0)) -> (projT1 args))%ptype option
- (fun x3 : option => x3)
- with
- | Some (_, _, _)%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- ((ℤ -> ℤ) -> ℤ)%ptype
- ((s0 -> (projT1 args0)) -> (projT1 args))%ptype
- then
- v <- type.try_make_transport_cps s0 ℤ;
- 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);;
- args <- invert_bind_args idc1 Raw.ident.Literal;
- args0 <- invert_bind_args idc0 Raw.ident.Literal;
- _ <- invert_bind_args idc Raw.ident.Z_shiftr;
- match
- pattern.type.unify_extracted_cps ((ℤ -> ℤ) -> ℤ)%ptype
- ((s0 -> (projT1 args0)) -> (projT1 args))%ptype option
- (fun x3 : option => x3)
- with
- | Some (_, _, _)%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- ((ℤ -> ℤ) -> ℤ)%ptype
- ((s0 -> (projT1 args0)) -> (projT1 args))%ptype
- then
- v <- type.try_make_transport_cps s0 ℤ;
- 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
- | @expr.App _ _ _ s1 _
- (@expr.App _ _ _ s2 _ (@expr.Ident _ _ _ t1 idc1) x4) x3 =>
- (match x4 with
- | @expr.Ident _ _ _ t2 idc2 =>
- args <- invert_bind_args idc2 Raw.ident.Literal;
- _ <- invert_bind_args idc1 Raw.ident.Z_land;
- args1 <- invert_bind_args idc0 Raw.ident.Literal;
- _ <- invert_bind_args idc Raw.ident.Z_shiftr;
- match
- pattern.type.unify_extracted_cps
- ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- ((s0 -> (projT1 args1)) -> (projT1 args) -> s1)%ptype
- option (fun x5 : option => x5)
- with
- | Some (_, _, (_, _))%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- ((s0 -> (projT1 args1)) -> (projT1 args) -> s1)%ptype
- then
- v <- type.try_make_transport_cps s0 ℤ;
- xv <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- xv0 <- ident.unify pattern.ident.Literal
- ##(projT2 args);
- v0 <- type.try_make_transport_cps s1 ℤ;
- 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
- | _ => None
- end;;
- match x3 with
- | @expr.Ident _ _ _ t2 idc2 =>
- args <- invert_bind_args idc2 Raw.ident.Literal;
- _ <- invert_bind_args idc1 Raw.ident.Z_land;
- args1 <- invert_bind_args idc0 Raw.ident.Literal;
- _ <- invert_bind_args idc Raw.ident.Z_shiftr;
- match
- pattern.type.unify_extracted_cps
- ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- ((s0 -> (projT1 args1)) -> s2 -> (projT1 args))%ptype
- option (fun x5 : option => x5)
- with
- | Some (_, _, (_, _))%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- ((s0 -> (projT1 args1)) -> s2 -> (projT1 args))%ptype
- then
- v <- type.try_make_transport_cps s0 ℤ;
- xv <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- v0 <- type.try_make_transport_cps s2 ℤ;
- 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
- | _ => None
- end);;
- match x3 with
- | @expr.Ident _ _ _ t2 idc2 =>
- args <- invert_bind_args idc2 Raw.ident.Literal;
- _ <- invert_bind_args idc1 Raw.ident.Z_shiftr;
- args1 <- invert_bind_args idc0 Raw.ident.Literal;
- _ <- invert_bind_args idc Raw.ident.Z_shiftr;
- match
- pattern.type.unify_extracted_cps
- ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- ((s0 -> (projT1 args1)) -> s2 -> (projT1 args))%ptype
- option (fun x5 : option => x5)
- with
- | Some (_, _, (_, _))%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- ((s0 -> (projT1 args1)) -> s2 -> (projT1 args))%ptype
- then
- v <- type.try_make_transport_cps s0 ℤ;
- xv <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- v0 <- type.try_make_transport_cps s2 ℤ;
- 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
- | _ => None
- end
- | @expr.App _ _ _ s1 _ (@expr.App _ _ _ s2 _ ($_)%expr _) _ |
- @expr.App _ _ _ s1 _
- (@expr.App _ _ _ s2 _ (@expr.Abs _ _ _ _ _ _) _) _ | @expr.App
- _ _ _ s1 _ (@expr.App _ _ _ s2 _ (_ @ _)%expr_pat _) _ |
- @expr.App _ _ _ s1 _
- (@expr.App _ _ _ s2 _ (@expr.LetIn _ _ _ _ _ _ _) _) _ => None
- | @expr.App _ _ _ s1 _ #(_)%expr_pat _ | @expr.App _ _ _ s1 _
- ($_)%expr _ | @expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _ |
- @expr.App _ _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _ => None
- | _ => None
- end
- | _ => None
- end
- | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ ($_)%expr _) _ | @expr.App _
- _ _ s _ (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _) _ | @expr.App
- _ _ _ s _ (@expr.App _ _ _ s0 _ (_ @ _)%expr_pat _) _ | @expr.App _ _
- _ s _ (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _) _ => None
- | @expr.App _ _ _ s _ #(_)%expr_pat _ | @expr.App _ _ _ s _ ($_)%expr
- _ | @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s
- _ (@expr.LetIn _ _ _ _ _ _ _) _ => None
- | _ => None
- end;;;
- Base (x * x0)%expr)%option
+| Z_mul => fun x x0 : expr ℤ => Base (x * x0)%expr
| Z_pow => fun x x0 : expr ℤ => Base (#(Z_pow)%expr @ x @ x0)%expr_pat
| Z_sub => fun x x0 : expr ℤ => Base (x - x0)%expr
| Z_opp => fun x : expr ℤ => Base (- x)%expr
@@ -1264,912 +138,27 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
fun x x0 x1 : expr ℤ => Base (#(Z_mul_split)%expr @ x @ x0 @ x1)%expr_pat
| Z_add_get_carry =>
fun x x0 x1 : expr ℤ =>
- ((match x with
- | @expr.Ident _ _ _ t idc =>
- match x1 with
- | (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x3 @
- @expr.Ident _ _ _ t1 idc1)%expr_pat =>
- args <- invert_bind_args idc1 Raw.ident.Literal;
- _ <- invert_bind_args idc0 Raw.ident.Z_shiftl;
- args1 <- invert_bind_args idc Raw.ident.Literal;
- match
- pattern.type.unify_extracted_cps ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- (((projT1 args1) -> ℤ) -> s0 -> (projT1 args))%ptype option
- (fun x4 : option => x4)
- with
- | Some (_, _, (_, _))%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- (((projT1 args1) -> ℤ) -> s0 -> (projT1 args))%ptype
- then
- xv <- ident.unify pattern.ident.Literal ##(projT2 args1);
- v <- type.try_make_transport_cps s0 ℤ;
- 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
- | (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x3 @ ($_)%expr)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x3 @ @expr.Abs
- _ _ _ _ _ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x3 @ (_ @ _))%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x3 @
- @expr.LetIn _ _ _ _ _ _ _)%expr_pat => None
- | (@expr.App _ _ _ s0 _ ($_)%expr _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (_ @ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat =>
- None
- | _ => None
- end;;
- match x0 with
- | (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x3 @
- @expr.Ident _ _ _ t1 idc1)%expr_pat =>
- args <- invert_bind_args idc1 Raw.ident.Literal;
- _ <- invert_bind_args idc0 Raw.ident.Z_shiftl;
- args1 <- invert_bind_args idc Raw.ident.Literal;
- match
- pattern.type.unify_extracted_cps ((ℤ -> ℤ -> ℤ) -> ℤ)%ptype
- (((projT1 args1) -> s0 -> (projT1 args)) -> ℤ)%ptype option
- (fun x4 : option => x4)
- with
- | Some (_, (_, _), _)%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- ((ℤ -> ℤ -> ℤ) -> ℤ)%ptype
- (((projT1 args1) -> s0 -> (projT1 args)) -> ℤ)%ptype
- then
- xv <- ident.unify pattern.ident.Literal ##(projT2 args1);
- v <- type.try_make_transport_cps s0 ℤ;
- 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
- | (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x3 @ ($_)%expr)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x3 @ @expr.Abs
- _ _ _ _ _ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x3 @ (_ @ _))%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x3 @
- @expr.LetIn _ _ _ _ _ _ _)%expr_pat => None
- | (@expr.App _ _ _ s0 _ ($_)%expr _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (_ @ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat =>
- None
- | _ => None
- end;;
- match x1 with
- | (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x3 @
- @expr.Ident _ _ _ t1 idc1)%expr_pat =>
- args <- invert_bind_args idc1 Raw.ident.Literal;
- _ <- invert_bind_args idc0 Raw.ident.Z_shiftr;
- args1 <- invert_bind_args idc Raw.ident.Literal;
- match
- pattern.type.unify_extracted_cps ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- (((projT1 args1) -> ℤ) -> s0 -> (projT1 args))%ptype option
- (fun x4 : option => x4)
- with
- | Some (_, _, (_, _))%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- (((projT1 args1) -> ℤ) -> s0 -> (projT1 args))%ptype
- then
- xv <- ident.unify pattern.ident.Literal ##(projT2 args1);
- v <- type.try_make_transport_cps s0 ℤ;
- 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
- | (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x3 @ ($_)%expr)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x3 @ @expr.Abs
- _ _ _ _ _ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x3 @ (_ @ _))%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x3 @
- @expr.LetIn _ _ _ _ _ _ _)%expr_pat => None
- | (@expr.App _ _ _ s0 _ ($_)%expr _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (_ @ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat =>
- None
- | _ => None
- end;;
- match x0 with
- | (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x3 @
- @expr.Ident _ _ _ t1 idc1)%expr_pat =>
- args <- invert_bind_args idc1 Raw.ident.Literal;
- _ <- invert_bind_args idc0 Raw.ident.Z_shiftr;
- args1 <- invert_bind_args idc Raw.ident.Literal;
- match
- pattern.type.unify_extracted_cps ((ℤ -> ℤ -> ℤ) -> ℤ)%ptype
- (((projT1 args1) -> s0 -> (projT1 args)) -> ℤ)%ptype option
- (fun x4 : option => x4)
- with
- | Some (_, (_, _), _)%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- ((ℤ -> ℤ -> ℤ) -> ℤ)%ptype
- (((projT1 args1) -> s0 -> (projT1 args)) -> ℤ)%ptype
- then
- xv <- ident.unify pattern.ident.Literal ##(projT2 args1);
- v <- type.try_make_transport_cps s0 ℤ;
- 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
- | (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x3 @ ($_)%expr)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x3 @ @expr.Abs
- _ _ _ _ _ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x3 @ (_ @ _))%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x3 @
- @expr.LetIn _ _ _ _ _ _ _)%expr_pat => None
- | (@expr.App _ _ _ s0 _ ($_)%expr _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (_ @ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat =>
- None
- | _ => None
- end;;
- args <- invert_bind_args idc Raw.ident.Literal;
- match
- pattern.type.unify_extracted_cps ((ℤ -> ℤ) -> ℤ)%ptype
- (((projT1 args) -> ℤ) -> ℤ)%ptype option
- (fun x2 : option => x2)
- with
- | Some (_, _, _)%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- ((ℤ -> ℤ) -> ℤ)%ptype (((projT1 args) -> ℤ) -> ℤ)%ptype
- then
- 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
- | _ => None
- end;;
- None);;;
- Base (#(Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat)%option
+ Base (#(Z_add_get_carry)%expr @ x @ x0 @ x1)%expr_pat
| Z_add_with_carry =>
fun x x0 x1 : expr ℤ =>
Base (#(Z_add_with_carry)%expr @ x @ x0 @ x1)%expr_pat
| Z_add_with_get_carry =>
fun x x0 x1 x2 : expr ℤ =>
- ((match x with
- | @expr.Ident _ _ _ t idc =>
- match x2 with
- | (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x4 @
- @expr.Ident _ _ _ t1 idc1)%expr_pat =>
- args <- invert_bind_args idc1 Raw.ident.Literal;
- _ <- invert_bind_args idc0 Raw.ident.Z_shiftl;
- args1 <- invert_bind_args idc Raw.ident.Literal;
- match
- pattern.type.unify_extracted_cps
- (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
- ((((projT1 args1) -> ℤ) -> ℤ) -> s0 -> (projT1 args))%ptype
- option (fun x5 : option => x5)
- with
- | Some (_, _, _, (_, _))%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
- ((((projT1 args1) -> ℤ) -> ℤ) -> s0 -> (projT1 args))%ptype
- then
- xv <- ident.unify pattern.ident.Literal ##(projT2 args1);
- v <- type.try_make_transport_cps s0 ℤ;
- 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
- | (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x4 @ ($_)%expr)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x4 @ @expr.Abs
- _ _ _ _ _ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x4 @ (_ @ _))%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x4 @
- @expr.LetIn _ _ _ _ _ _ _)%expr_pat => None
- | (@expr.App _ _ _ s0 _ ($_)%expr _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (_ @ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat =>
- None
- | _ => None
- end;;
- match x1 with
- | (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x4 @
- @expr.Ident _ _ _ t1 idc1)%expr_pat =>
- args <- invert_bind_args idc1 Raw.ident.Literal;
- _ <- invert_bind_args idc0 Raw.ident.Z_shiftl;
- args1 <- invert_bind_args idc Raw.ident.Literal;
- match
- pattern.type.unify_extracted_cps
- (((ℤ -> ℤ) -> ℤ -> ℤ) -> ℤ)%ptype
- ((((projT1 args1) -> ℤ) -> s0 -> (projT1 args)) -> ℤ)%ptype
- option (fun x5 : option => x5)
- with
- | Some (_, _, (_, _), _)%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- (((ℤ -> ℤ) -> ℤ -> ℤ) -> ℤ)%ptype
- ((((projT1 args1) -> ℤ) -> s0 -> (projT1 args)) -> ℤ)%ptype
- then
- xv <- ident.unify pattern.ident.Literal ##(projT2 args1);
- v <- type.try_make_transport_cps s0 ℤ;
- 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
- | (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x4 @ ($_)%expr)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x4 @ @expr.Abs
- _ _ _ _ _ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x4 @ (_ @ _))%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x4 @
- @expr.LetIn _ _ _ _ _ _ _)%expr_pat => None
- | (@expr.App _ _ _ s0 _ ($_)%expr _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (_ @ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat =>
- None
- | _ => None
- end;;
- match x2 with
- | (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x4 @
- @expr.Ident _ _ _ t1 idc1)%expr_pat =>
- args <- invert_bind_args idc1 Raw.ident.Literal;
- _ <- invert_bind_args idc0 Raw.ident.Z_shiftr;
- args1 <- invert_bind_args idc Raw.ident.Literal;
- match
- pattern.type.unify_extracted_cps
- (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
- ((((projT1 args1) -> ℤ) -> ℤ) -> s0 -> (projT1 args))%ptype
- option (fun x5 : option => x5)
- with
- | Some (_, _, _, (_, _))%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
- ((((projT1 args1) -> ℤ) -> ℤ) -> s0 -> (projT1 args))%ptype
- then
- xv <- ident.unify pattern.ident.Literal ##(projT2 args1);
- v <- type.try_make_transport_cps s0 ℤ;
- 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
- | (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x4 @ ($_)%expr)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x4 @ @expr.Abs
- _ _ _ _ _ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x4 @ (_ @ _))%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x4 @
- @expr.LetIn _ _ _ _ _ _ _)%expr_pat => None
- | (@expr.App _ _ _ s0 _ ($_)%expr _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (_ @ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat =>
- None
- | _ => None
- end;;
- match x1 with
- | (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x4 @
- @expr.Ident _ _ _ t1 idc1)%expr_pat =>
- args <- invert_bind_args idc1 Raw.ident.Literal;
- _ <- invert_bind_args idc0 Raw.ident.Z_shiftr;
- args1 <- invert_bind_args idc Raw.ident.Literal;
- match
- pattern.type.unify_extracted_cps
- (((ℤ -> ℤ) -> ℤ -> ℤ) -> ℤ)%ptype
- ((((projT1 args1) -> ℤ) -> s0 -> (projT1 args)) -> ℤ)%ptype
- option (fun x5 : option => x5)
- with
- | Some (_, _, (_, _), _)%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- (((ℤ -> ℤ) -> ℤ -> ℤ) -> ℤ)%ptype
- ((((projT1 args1) -> ℤ) -> s0 -> (projT1 args)) -> ℤ)%ptype
- then
- xv <- ident.unify pattern.ident.Literal ##(projT2 args1);
- v <- type.try_make_transport_cps s0 ℤ;
- 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
- | (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x4 @ ($_)%expr)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x4 @ @expr.Abs
- _ _ _ _ _ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x4 @ (_ @ _))%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x4 @
- @expr.LetIn _ _ _ _ _ _ _)%expr_pat => None
- | (@expr.App _ _ _ s0 _ ($_)%expr _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (_ @ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat =>
- None
- | _ => None
- end;;
- args <- invert_bind_args idc Raw.ident.Literal;
- match
- pattern.type.unify_extracted_cps (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
- ((((projT1 args) -> ℤ) -> ℤ) -> ℤ)%ptype option
- (fun x3 : option => x3)
- with
- | Some (_, _, _, _)%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
- ((((projT1 args) -> ℤ) -> ℤ) -> ℤ)%ptype
- then
- 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
- | _ => None
- end;;
- None);;;
- Base (#(Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat)%option
+ Base (#(Z_add_with_get_carry)%expr @ x @ x0 @ x1 @ x2)%expr_pat
| Z_sub_get_borrow =>
fun x x0 x1 : expr ℤ =>
- ((match x with
- | @expr.Ident _ _ _ t idc =>
- match x1 with
- | (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x3 @ x2)%expr_pat =>
- match x2 with
- | @expr.Ident _ _ _ t1 idc1 =>
- args <- invert_bind_args idc1 Raw.ident.Literal;
- _ <- invert_bind_args idc0 Raw.ident.Z_shiftl;
- args1 <- invert_bind_args idc Raw.ident.Literal;
- match
- pattern.type.unify_extracted_cps
- ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- (((projT1 args1) -> ℤ) -> s0 -> (projT1 args))%ptype
- option (fun x4 : option => x4)
- with
- | Some (_, _, (_, _))%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- (((projT1 args1) -> ℤ) -> s0 -> (projT1 args))%ptype
- then
- xv <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- v <- type.try_make_transport_cps s0 ℤ;
- 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
- | _ => None
- end;;
- match x2 with
- | @expr.Ident _ _ _ t1 idc1 =>
- args <- invert_bind_args idc1 Raw.ident.Literal;
- _ <- invert_bind_args idc0 Raw.ident.Z_shiftr;
- args1 <- invert_bind_args idc Raw.ident.Literal;
- match
- pattern.type.unify_extracted_cps
- ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- (((projT1 args1) -> ℤ) -> s0 -> (projT1 args))%ptype
- option (fun x4 : option => x4)
- with
- | Some (_, _, (_, _))%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
- (((projT1 args1) -> ℤ) -> s0 -> (projT1 args))%ptype
- then
- xv <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- v <- type.try_make_transport_cps s0 ℤ;
- 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
- | _ => None
- end
- | (@expr.App _ _ _ s0 _ ($_)%expr _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (_ @ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat =>
- None
- | _ => None
- end;;
- args <- invert_bind_args idc Raw.ident.Literal;
- match
- pattern.type.unify_extracted_cps ((ℤ -> ℤ) -> ℤ)%ptype
- (((projT1 args) -> ℤ) -> ℤ)%ptype option
- (fun x2 : option => x2)
- with
- | Some (_, _, _)%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- ((ℤ -> ℤ) -> ℤ)%ptype (((projT1 args) -> ℤ) -> ℤ)%ptype
- then
- 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
- | _ => None
- end;;
- None);;;
- Base (#(Z_sub_get_borrow)%expr @ x @ x0 @ x1)%expr_pat)%option
+ Base (#(Z_sub_get_borrow)%expr @ x @ x0 @ x1)%expr_pat
| Z_sub_with_get_borrow =>
fun x x0 x1 x2 : expr ℤ =>
- ((match x with
- | @expr.Ident _ _ _ t idc =>
- match x2 with
- | (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t0 idc0) x4 @ x3)%expr_pat =>
- match x3 with
- | @expr.Ident _ _ _ t1 idc1 =>
- args <- invert_bind_args idc1 Raw.ident.Literal;
- _ <- invert_bind_args idc0 Raw.ident.Z_shiftl;
- args1 <- invert_bind_args idc Raw.ident.Literal;
- match
- pattern.type.unify_extracted_cps
- (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
- ((((projT1 args1) -> ℤ) -> ℤ) -> s0 -> (projT1 args))%ptype
- option (fun x5 : option => x5)
- with
- | Some (_, _, _, (_, _))%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
- ((((projT1 args1) -> ℤ) -> ℤ) -> s0 -> (projT1 args))%ptype
- then
- xv <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- v <- type.try_make_transport_cps s0 ℤ;
- 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
- | _ => None
- end;;
- match x3 with
- | @expr.Ident _ _ _ t1 idc1 =>
- args <- invert_bind_args idc1 Raw.ident.Literal;
- _ <- invert_bind_args idc0 Raw.ident.Z_shiftr;
- args1 <- invert_bind_args idc Raw.ident.Literal;
- match
- pattern.type.unify_extracted_cps
- (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
- ((((projT1 args1) -> ℤ) -> ℤ) -> s0 -> (projT1 args))%ptype
- option (fun x5 : option => x5)
- with
- | Some (_, _, _, (_, _))%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
- ((((projT1 args1) -> ℤ) -> ℤ) -> s0 -> (projT1 args))%ptype
- then
- xv <- ident.unify pattern.ident.Literal
- ##(projT2 args1);
- v <- type.try_make_transport_cps s0 ℤ;
- 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
- | _ => None
- end
- | (@expr.App _ _ _ s0 _ ($_)%expr _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (_ @ _) _ @ _)%expr_pat |
- (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat =>
- None
- | _ => None
- end;;
- args <- invert_bind_args idc Raw.ident.Literal;
- match
- pattern.type.unify_extracted_cps (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
- ((((projT1 args) -> ℤ) -> ℤ) -> ℤ)%ptype option
- (fun x3 : option => x3)
- with
- | Some (_, _, _, _)%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
- ((((projT1 args) -> ℤ) -> ℤ) -> ℤ)%ptype
- then
- 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
- | _ => None
- end;;
- None);;;
- Base (#(Z_sub_with_get_borrow)%expr @ x @ x0 @ x1 @ x2)%expr_pat)%option
+ Base (#(Z_sub_with_get_borrow)%expr @ x @ x0 @ x1 @ x2)%expr_pat
| Z_zselect =>
- fun x x0 x1 : expr ℤ =>
- (((match x with
- | @expr.App _ _ _ s _
- (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc) x3) x2 =>
- match x3 with
- | @expr.Ident _ _ _ t0 idc0 =>
- args <- invert_bind_args idc0 Raw.ident.Literal;
- _ <- invert_bind_args idc Raw.ident.Z_cc_m;
- match
- pattern.type.unify_extracted_cps
- (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
- ((((projT1 args) -> s) -> ℤ) -> ℤ)%ptype option
- (fun x4 : option => x4)
- with
- | Some (_, _, _, _)%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
- ((((projT1 args) -> s) -> ℤ) -> ℤ)%ptype
- then
- xv <- ident.unify pattern.ident.Literal ##(projT2 args);
- v <- type.try_make_transport_cps s ℤ;
- 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
- | _ => None
- end;;
- match x3 with
- | @expr.Ident _ _ _ t0 idc0 =>
- args <- invert_bind_args idc0 Raw.ident.Literal;
- _ <- invert_bind_args idc Raw.ident.Z_land;
- match
- pattern.type.unify_extracted_cps
- (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
- ((((projT1 args) -> s) -> ℤ) -> ℤ)%ptype option
- (fun x4 : option => x4)
- with
- | Some (_, _, _, _)%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
- ((((projT1 args) -> s) -> ℤ) -> ℤ)%ptype
- then
- xv <- ident.unify pattern.ident.Literal ##(projT2 args);
- v <- type.try_make_transport_cps s ℤ;
- 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
- | _ => None
- end;;
- match x2 with
- | @expr.Ident _ _ _ t0 idc0 =>
- args <- invert_bind_args idc0 Raw.ident.Literal;
- _ <- invert_bind_args idc Raw.ident.Z_land;
- match
- pattern.type.unify_extracted_cps
- (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
- (((s0 -> (projT1 args)) -> ℤ) -> ℤ)%ptype option
- (fun x4 : option => x4)
- with
- | Some (_, _, _, _)%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
- (((s0 -> (projT1 args)) -> ℤ) -> ℤ)%ptype
- then
- v <- type.try_make_transport_cps s0 ℤ;
- 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
- | _ => None
- end
- | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ ($_)%expr _) _ | @expr.App
- _ _ _ s _ (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _) _ |
- @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ (_ @ _)%expr_pat _) _ |
- @expr.App _ _ _ s _
- (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _) _ => None
- | @expr.App _ _ _ s _ #(_)%expr_pat _ | @expr.App _ _ _ s _ ($_)%expr
- _ | @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _
- s _ (@expr.LetIn _ _ _ _ _ _ _) _ => None
- | _ => None
- end;;
- match
- pattern.type.unify_extracted_cps ((ℤ -> ℤ) -> ℤ)%ptype
- ((ℤ -> ℤ) -> ℤ)%ptype option (fun x2 : option => x2)
- with
- | Some (_, _, _)%zrange =>
- if
- type.type_beq base.type base.type.type_beq ((ℤ -> ℤ) -> ℤ)%ptype
- ((ℤ -> ℤ) -> ℤ)%ptype
- then Some (Base (#(fancy_selc)%expr @ (x, x0, x1))%expr_pat)
- else None
- | None => None
- end);;
- None);;;
- Base (#(Z_zselect)%expr @ x @ x0 @ x1)%expr_pat)%option
+ fun x x0 x1 : expr ℤ => Base (#(Z_zselect)%expr @ x @ x0 @ x1)%expr_pat
| Z_add_modulo =>
fun x x0 x1 : expr ℤ =>
- (match
- pattern.type.unify_extracted_cps ((ℤ -> ℤ) -> ℤ)%ptype
- ((ℤ -> ℤ) -> ℤ)%ptype option (fun x2 : option => x2)
- with
- | Some (_, _, _)%zrange =>
- if
- type.type_beq base.type base.type.type_beq ((ℤ -> ℤ) -> ℤ)%ptype
- ((ℤ -> ℤ) -> ℤ)%ptype
- then Some (Base (#(fancy_addm)%expr @ (x, x0, x1))%expr_pat)
- else None
- | None => None
- end;;;
- Base (#(Z_add_modulo)%expr @ x @ x0 @ x1)%expr_pat)%option
+ Base (#(Z_add_modulo)%expr @ x @ x0 @ x1)%expr_pat
| Z_rshi =>
fun x x0 x1 x2 : expr ℤ =>
- (match x with
- | @expr.Ident _ _ _ t idc =>
- match x2 with
- | @expr.Ident _ _ _ t0 idc0 =>
- args <- invert_bind_args idc0 Raw.ident.Literal;
- args0 <- invert_bind_args idc Raw.ident.Literal;
- match
- pattern.type.unify_extracted_cps (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
- ((((projT1 args0) -> ℤ) -> ℤ) -> (projT1 args))%ptype option
- (fun x3 : option => x3)
- with
- | Some (_, _, _, _)%zrange =>
- if
- type.type_beq base.type base.type.type_beq
- (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
- ((((projT1 args0) -> ℤ) -> ℤ) -> (projT1 args))%ptype
- then
- 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
- | _ => None
- end
- | _ => None
- end;;;
- Base (#(Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat)%option
+ Base (#(Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat
| Z_cc_m => fun x x0 : expr ℤ => Base (#(Z_cc_m)%expr @ x @ x0)%expr_pat
| Z_cast range => fun x : expr ℤ => Base (#(Z_cast range)%expr @ x)%expr_pat
| Z_cast2 range =>
diff --git a/src/Experiments/NewPipeline/fancy_with_casts_rewrite_head.out b/src/Experiments/NewPipeline/fancy_with_casts_rewrite_head.out
index 5efd5dfb1..7abfcbfbf 100644
--- a/src/Experiments/NewPipeline/fancy_with_casts_rewrite_head.out
+++ b/src/Experiments/NewPipeline/fancy_with_casts_rewrite_head.out
@@ -155,14 +155,8138 @@ match idc in (Compilers.ident t) return (Compile.value' true t) with
fun x x0 x1 : expr ℤ => Base (#(Z_zselect)%expr @ x @ x0 @ x1)%expr_pat
| Z_add_modulo =>
fun x x0 x1 : expr ℤ =>
- Base (#(Z_add_modulo)%expr @ x @ x0 @ x1)%expr_pat
+ (match
+ pattern.type.unify_extracted_cps ((ℤ -> ℤ) -> ℤ)%ptype
+ ((ℤ -> ℤ) -> ℤ)%ptype option (fun x2 : option => x2)
+ with
+ | Some (_, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq ((ℤ -> ℤ) -> ℤ)%ptype
+ ((ℤ -> ℤ) -> ℤ)%ptype
+ then Some (Base (#(fancy_addm)%expr @ (x, x0, x1))%expr_pat)
+ else None
+ | None => None
+ end;;;
+ Base (#(Z_add_modulo)%expr @ x @ x0 @ x1)%expr_pat)%option
| Z_rshi =>
fun x x0 x1 x2 : expr ℤ =>
Base (#(Z_rshi)%expr @ x @ x0 @ x1 @ x2)%expr_pat
| Z_cc_m => fun x x0 : expr ℤ => Base (#(Z_cc_m)%expr @ x @ x0)%expr_pat
-| Z_cast range => fun x : expr ℤ => Base (#(Z_cast range)%expr @ x)%expr_pat
+| Z_cast range =>
+ fun x : expr ℤ =>
+ ((match x with
+ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0))
+ (@expr.Ident _ _ _ t1 idc1 @ (@expr.Ident _ _ _ t2 idc2 @ x4 @ x3))%expr_pat =>
+ match x4 with
+ | @expr.Ident _ _ _ t3 idc3 =>
+ match x3 with
+ | @expr.App _ _ _ s4 _ (@expr.Ident _ _ _ t4 idc4) x5 =>
+ (args <- invert_bind_args idc4 Raw.ident.Z_cast;
+ args0 <- invert_bind_args idc3 Raw.ident.Literal;
+ _ <- invert_bind_args idc2 Raw.ident.Z_land;
+ args2 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc Raw.ident.Z_mul;
+ match
+ pattern.type.unify_extracted_cps (ℤ -> ℤ -> ℤ)%ptype
+ ((projT1 args3) -> (projT1 args0) -> s4)%ptype option
+ (fun x6 : option => x6)
+ with
+ | Some (_, (_, _))%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (ℤ -> ℤ -> ℤ)%ptype
+ ((projT1 args3) -> (projT1 args0) -> s4)%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args3);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ v <- type.try_make_transport_cps s4 ℤ;
+ fv <- (x6 <- (if
+ ((let (x6, _) := xv0 in x6) =?
+ 2
+ ^ (2 *
+ Z.log2_up
+ (let (x6, _) := xv0 in x6) / 2) -
+ 1) &&
+ (ZRange.normalize
+ (ZRange.constant
+ (let (x6, _) := xv0 in x6)) &'
+ ZRange.normalize args <=?
+ ZRange.normalize args2)%zrange
+ then
+ x6 <- invert_low
+ (2 *
+ Z.log2_up
+ (let (x6, _) := xv0 in x6))
+ (let (x6, _) := xv in x6);
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_mulll
+ (2 *
+ Z.log2_up
+ (let (x7, _) := xv0 in x7)))%expr @
+ ((##x6)%expr,
+ #(Z_cast args)%expr @
+ v (Compile.reflect x5))))%expr_pat
+ else None);
+ Some (Base x6));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end);;
+ args <- invert_bind_args idc4 Raw.ident.Z_cast;
+ args0 <- invert_bind_args idc3 Raw.ident.Literal;
+ _ <- invert_bind_args idc2 Raw.ident.Z_land;
+ args2 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc Raw.ident.Z_mul;
+ match
+ pattern.type.unify_extracted_cps (ℤ -> ℤ -> ℤ)%ptype
+ ((projT1 args3) -> (projT1 args0) -> s4)%ptype option
+ (fun x6 : option => x6)
+ with
+ | Some (_, (_, _))%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (ℤ -> ℤ -> ℤ)%ptype
+ ((projT1 args3) -> (projT1 args0) -> s4)%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args3);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ v <- type.try_make_transport_cps s4 ℤ;
+ fv <- (x6 <- (if
+ ((let (x6, _) := xv0 in x6) =?
+ 2
+ ^ (2 *
+ Z.log2_up
+ (let (x6, _) := xv0 in x6) / 2) -
+ 1) &&
+ (ZRange.normalize
+ (ZRange.constant
+ (let (x6, _) := xv0 in x6)) &'
+ ZRange.normalize args <=?
+ ZRange.normalize args2)%zrange
+ then
+ x6 <- invert_high
+ (2 *
+ Z.log2_up
+ (let (x6, _) := xv0 in x6))
+ (let (x6, _) := xv in x6);
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_mulhl
+ (2 *
+ Z.log2_up
+ (let (x7, _) := xv0 in x7)))%expr @
+ ((##x6)%expr,
+ #(Z_cast args)%expr @
+ v (Compile.reflect x5))))%expr_pat
+ else None);
+ Some (Base x6));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s4 _ ($_)%expr _ | @expr.App _ _ _ s4 _
+ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s4 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s4 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s4 _ (@expr.Ident _ _ _ t3 idc3) x5 =>
+ match x3 with
+ | @expr.Ident _ _ _ t4 idc4 =>
+ (args <- invert_bind_args idc4 Raw.ident.Literal;
+ args0 <- invert_bind_args idc3 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc2 Raw.ident.Z_land;
+ args2 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc Raw.ident.Z_mul;
+ match
+ pattern.type.unify_extracted_cps (ℤ -> ℤ -> ℤ)%ptype
+ ((projT1 args3) -> s4 -> (projT1 args))%ptype option
+ (fun x6 : option => x6)
+ with
+ | Some (_, (_, _))%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (ℤ -> ℤ -> ℤ)%ptype
+ ((projT1 args3) -> s4 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args3);
+ v <- type.try_make_transport_cps s4 ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x6 <- (if
+ ((let (x6, _) := xv0 in x6) =?
+ 2
+ ^ (2 *
+ Z.log2_up
+ (let (x6, _) := xv0 in x6) / 2) -
+ 1) &&
+ (ZRange.normalize args0 &'
+ ZRange.normalize
+ (ZRange.constant
+ (let (x6, _) := xv0 in x6)) <=?
+ ZRange.normalize args2)%zrange
+ then
+ x6 <- invert_low
+ (2 *
+ Z.log2_up
+ (let (x6, _) := xv0 in x6))
+ (let (x6, _) := xv in x6);
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_mulll
+ (2 *
+ Z.log2_up
+ (let (x7, _) := xv0 in x7)))%expr @
+ ((##x6)%expr,
+ #(Z_cast args0)%expr @
+ v (Compile.reflect x5))))%expr_pat
+ else None);
+ Some (Base x6));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end);;
+ args <- invert_bind_args idc4 Raw.ident.Literal;
+ args0 <- invert_bind_args idc3 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc2 Raw.ident.Z_land;
+ args2 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc Raw.ident.Z_mul;
+ match
+ pattern.type.unify_extracted_cps (ℤ -> ℤ -> ℤ)%ptype
+ ((projT1 args3) -> s4 -> (projT1 args))%ptype option
+ (fun x6 : option => x6)
+ with
+ | Some (_, (_, _))%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (ℤ -> ℤ -> ℤ)%ptype
+ ((projT1 args3) -> s4 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args3);
+ v <- type.try_make_transport_cps s4 ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x6 <- (if
+ ((let (x6, _) := xv0 in x6) =?
+ 2
+ ^ (2 *
+ Z.log2_up
+ (let (x6, _) := xv0 in x6) / 2) -
+ 1) &&
+ (ZRange.normalize args0 &'
+ ZRange.normalize
+ (ZRange.constant
+ (let (x6, _) := xv0 in x6)) <=?
+ ZRange.normalize args2)%zrange
+ then
+ x6 <- invert_high
+ (2 *
+ Z.log2_up
+ (let (x6, _) := xv0 in x6))
+ (let (x6, _) := xv in x6);
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_mulhl
+ (2 *
+ Z.log2_up
+ (let (x7, _) := xv0 in x7)))%expr @
+ ((##x6)%expr,
+ #(Z_cast args0)%expr @
+ v (Compile.reflect x5))))%expr_pat
+ else None);
+ Some (Base x6));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s4 _ ($_)%expr _ | @expr.App _ _ _ s4 _
+ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s4 _ (_ @ _)%expr_pat
+ _ | @expr.App _ _ _ s4 _ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end;;
+ match x4 with
+ | @expr.App _ _ _ s4 _ (@expr.Ident _ _ _ t3 idc3) x5 =>
+ match x3 with
+ | @expr.Ident _ _ _ t4 idc4 =>
+ (args <- invert_bind_args idc4 Raw.ident.Literal;
+ args0 <- invert_bind_args idc3 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc2 Raw.ident.Z_shiftr;
+ args2 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc Raw.ident.Z_mul;
+ match
+ pattern.type.unify_extracted_cps (ℤ -> ℤ -> ℤ)%ptype
+ ((projT1 args3) -> s4 -> (projT1 args))%ptype option
+ (fun x6 : option => x6)
+ with
+ | Some (_, (_, _))%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (ℤ -> ℤ -> ℤ)%ptype
+ ((projT1 args3) -> s4 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args3);
+ v <- type.try_make_transport_cps s4 ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x6 <- (if
+ (ZRange.normalize args0 >>
+ ZRange.normalize
+ (ZRange.constant
+ (let (x6, _) := xv0 in x6)) <=?
+ ZRange.normalize args2)%zrange
+ then
+ x6 <- invert_low
+ (2 *
+ (let (x6, _) := xv0 in x6))
+ (let (x6, _) := xv in x6);
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_mullh
+ (2 *
+ (let (x7, _) := xv0 in x7)))%expr @
+ ((##x6)%expr,
+ #(Z_cast args0)%expr @
+ v (Compile.reflect x5))))%expr_pat
+ else None);
+ Some (Base x6));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end);;
+ args <- invert_bind_args idc4 Raw.ident.Literal;
+ args0 <- invert_bind_args idc3 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc2 Raw.ident.Z_shiftr;
+ args2 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc Raw.ident.Z_mul;
+ match
+ pattern.type.unify_extracted_cps (ℤ -> ℤ -> ℤ)%ptype
+ ((projT1 args3) -> s4 -> (projT1 args))%ptype option
+ (fun x6 : option => x6)
+ with
+ | Some (_, (_, _))%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (ℤ -> ℤ -> ℤ)%ptype
+ ((projT1 args3) -> s4 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args3);
+ v <- type.try_make_transport_cps s4 ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x6 <- (if
+ (ZRange.normalize args0 >>
+ ZRange.normalize
+ (ZRange.constant
+ (let (x6, _) := xv0 in x6)) <=?
+ ZRange.normalize args2)%zrange
+ then
+ x6 <- invert_high
+ (2 * (let (x6, _) := xv0 in x6))
+ (let (x6, _) := xv in x6);
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_mulhh
+ (2 * (let (x7, _) := xv0 in x7)))%expr @
+ ((##x6)%expr,
+ #(Z_cast args0)%expr @
+ v (Compile.reflect x5))))%expr_pat
+ else None);
+ Some (Base x6));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s4 _ ($_)%expr _ | @expr.App _ _ _ s4 _
+ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s4 _ (_ @ _)%expr_pat
+ _ | @expr.App _ _ _ s4 _ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0))
+ (@expr.Ident _ _ _ t1 idc1 @ #(_))%expr_pat | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0))
+ (@expr.Ident _ _ _ t1 idc1 @ ($_)%expr)%expr_pat | @expr.App _ _ _ s
+ _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0))
+ (@expr.Ident _ _ _ t1 idc1 @ @expr.Abs _ _ _ _ _ _)%expr_pat |
+ @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0))
+ (@expr.Ident _ _ _ t1 idc1 @ (#(_) @ _))%expr_pat | @expr.App _ _ _ s
+ _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0))
+ (@expr.Ident _ _ _ t1 idc1 @ (($_)%expr @ _))%expr_pat | @expr.App _
+ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0))
+ (@expr.Ident _ _ _ t1 idc1 @ (@expr.Abs _ _ _ _ _ _ @ _))%expr_pat |
+ @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0))
+ (@expr.Ident _ _ _ t1 idc1 @ (($_)%expr @ _ @ _))%expr_pat |
+ @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0))
+ (@expr.Ident _ _ _ t1 idc1 @ (@expr.Abs _ _ _ _ _ _ @ _ @ _))%expr_pat |
+ @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0))
+ (@expr.Ident _ _ _ t1 idc1 @ (_ @ _ @ _ @ _))%expr_pat | @expr.App _
+ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0))
+ (@expr.Ident _ _ _ t1 idc1 @ (@expr.LetIn _ _ _ _ _ _ _ @ _ @ _))%expr_pat |
+ @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0))
+ (@expr.Ident _ _ _ t1 idc1 @ (@expr.LetIn _ _ _ _ _ _ _ @ _))%expr_pat |
+ @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0))
+ (@expr.Ident _ _ _ t1 idc1 @ @expr.LetIn _ _ _ _ _ _ _)%expr_pat =>
+ None
+ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0 @ (@expr.Ident _ _ _ t1 idc1 @ x4 @ x3))%expr_pat)
+ x0 =>
+ match x4 with
+ | @expr.Ident _ _ _ t2 idc2 =>
+ match x3 with
+ | @expr.App _ _ _ s4 _ (@expr.Ident _ _ _ t3 idc3) x5 =>
+ match x0 with
+ | @expr.Ident _ _ _ t4 idc4 =>
+ (args <- invert_bind_args idc4 Raw.ident.Literal;
+ args0 <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args1 <- invert_bind_args idc2 Raw.ident.Literal;
+ _ <- invert_bind_args idc1 Raw.ident.Z_land;
+ args3 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_mul;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ)%ptype
+ (((projT1 args1) -> s4) -> (projT1 args))%ptype
+ option (fun x6 : option => x6)
+ with
+ | Some (_, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ)%ptype
+ (((projT1 args1) -> s4) -> (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ v <- type.try_make_transport_cps s4 ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x6 <- (if
+ ((let (x6, _) := xv in x6) =?
+ 2
+ ^ (2 *
+ Z.log2_up
+ (let (x6, _) := xv in x6) /
+ 2) - 1) &&
+ (ZRange.normalize
+ (ZRange.constant
+ (let (x6, _) := xv in x6)) &'
+ ZRange.normalize args0 <=?
+ ZRange.normalize args3)%zrange
+ then
+ y <- invert_low
+ (2 *
+ Z.log2_up
+ (let (x6, _) := xv in x6))
+ (let (x6, _) := xv0 in x6);
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_mulll
+ (2 *
+ Z.log2_up
+ (let (x6, _) := xv in
+ x6)))%expr @
+ (#(Z_cast args0)%expr @
+ v (Compile.reflect x5),
+ (##y)%expr)))%expr_pat
+ else None);
+ Some (Base x6));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end);;
+ args <- invert_bind_args idc4 Raw.ident.Literal;
+ args0 <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args1 <- invert_bind_args idc2 Raw.ident.Literal;
+ _ <- invert_bind_args idc1 Raw.ident.Z_land;
+ args3 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_mul;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ)%ptype
+ (((projT1 args1) -> s4) -> (projT1 args))%ptype
+ option (fun x6 : option => x6)
+ with
+ | Some (_, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ)%ptype
+ (((projT1 args1) -> s4) -> (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ v <- type.try_make_transport_cps s4 ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x6 <- (if
+ ((let (x6, _) := xv in x6) =?
+ 2
+ ^ (2 *
+ Z.log2_up
+ (let (x6, _) := xv in x6) / 2) -
+ 1) &&
+ (ZRange.normalize
+ (ZRange.constant
+ (let (x6, _) := xv in x6)) &'
+ ZRange.normalize args0 <=?
+ ZRange.normalize args3)%zrange
+ then
+ y <- invert_high
+ (2 *
+ Z.log2_up
+ (let (x6, _) := xv in x6))
+ (let (x6, _) := xv0 in x6);
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_mullh
+ (2 *
+ Z.log2_up
+ (let (x6, _) := xv in x6)))%expr @
+ (#(Z_cast args0)%expr @
+ v (Compile.reflect x5),
+ (##y)%expr)))%expr_pat
+ else None);
+ Some (Base x6));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | (@expr.Ident _ _ _ t4 idc4 @
+ (@expr.Ident _ _ _ t5 idc5 @ x8 @ x7))%expr_pat =>
+ match x8 with
+ | @expr.Ident _ _ _ t6 idc6 =>
+ match x7 with
+ | @expr.App _ _ _ s8 _ (@expr.Ident _ _ _ t7 idc7)
+ x9 =>
+ args <- invert_bind_args idc7 Raw.ident.Z_cast;
+ args0 <- invert_bind_args idc6
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc5 Raw.ident.Z_land;
+ args2 <- invert_bind_args idc4 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc2
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc1 Raw.ident.Z_land;
+ args6 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_mul;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ (((projT1 args4) -> s4) ->
+ (projT1 args0) -> s8)%ptype option
+ (fun x10 : option => x10)
+ with
+ | Some (_, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ (((projT1 args4) -> s4) ->
+ (projT1 args0) -> s8)%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args4);
+ v <- type.try_make_transport_cps s4
+ ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ v0 <- type.try_make_transport_cps s8
+ ℤ;
+ fv <- (x10 <- (if
+ ((let (x10, _) := xv in
+ x10) =?
+ 2
+ ^ (2 *
+ Z.log2_up
+ (let (x10, _) :=
+ xv in
+ x10) / 2) - 1) &&
+ ((let (x10, _) := xv0 in
+ x10) =?
+ 2
+ ^ (2 *
+ Z.log2_up
+ (let (x10, _) :=
+ xv in
+ x10) / 2) - 1) &&
+ (ZRange.normalize
+ (ZRange.constant
+ (let (x10, _) :=
+ xv in
+ x10)) &'
+ ZRange.normalize args3 <=?
+ ZRange.normalize args6)%zrange &&
+ (ZRange.normalize
+ (ZRange.constant
+ (let (x10, _) :=
+ xv0 in
+ x10)) &'
+ ZRange.normalize args <=?
+ ZRange.normalize args2)%zrange
+ then
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_mulll
+ (2 *
+ Z.log2_up
+ (let
+ (x10, _) :=
+ xv in
+ x10)))%expr @
+ (#(Z_cast args3)%expr @
+ v
+ (Compile.reflect x5),
+ #(Z_cast args)%expr @
+ v0
+ (Compile.reflect x9))))%expr_pat
+ else None);
+ Some (Base x10));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s8 _ ($_)%expr _ | @expr.App _ _
+ _ s8 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _
+ _ s8 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s8 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s8 _ (@expr.Ident _ _ _ t6 idc6)
+ x9 =>
+ match x7 with
+ | @expr.Ident _ _ _ t7 idc7 =>
+ args <- invert_bind_args idc7 Raw.ident.Literal;
+ args0 <- invert_bind_args idc6 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc5 Raw.ident.Z_land;
+ args2 <- invert_bind_args idc4 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc2
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc1 Raw.ident.Z_land;
+ args6 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_mul;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ (((projT1 args4) -> s4) ->
+ s8 -> (projT1 args))%ptype option
+ (fun x10 : option => x10)
+ with
+ | Some (_, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ (((projT1 args4) -> s4) ->
+ s8 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args4);
+ v <- type.try_make_transport_cps s4
+ ℤ;
+ v0 <- type.try_make_transport_cps s8
+ ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x10 <- (if
+ ((let (x10, _) := xv in
+ x10) =?
+ 2
+ ^ (2 *
+ Z.log2_up
+ (let (x10, _) :=
+ xv in
+ x10) / 2) - 1) &&
+ ((let (x10, _) := xv0 in
+ x10) =?
+ 2
+ ^ (2 *
+ Z.log2_up
+ (let (x10, _) :=
+ xv in
+ x10) / 2) - 1) &&
+ (ZRange.normalize
+ (ZRange.constant
+ (let (x10, _) :=
+ xv in
+ x10)) &'
+ ZRange.normalize args3 <=?
+ ZRange.normalize args6)%zrange &&
+ (ZRange.normalize args0 &'
+ ZRange.normalize
+ (ZRange.constant
+ (let (x10, _) :=
+ xv0 in
+ x10)) <=?
+ ZRange.normalize args2)%zrange
+ then
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_mulll
+ (2 *
+ Z.log2_up
+ (let
+ (x10, _) :=
+ xv in
+ x10)))%expr @
+ (#(Z_cast args3)%expr @
+ v
+ (Compile.reflect x5),
+ #(Z_cast args0)%expr @
+ v0
+ (Compile.reflect x9))))%expr_pat
+ else None);
+ Some (Base x10));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s8 _ ($_)%expr _ | @expr.App _ _ _ s8
+ _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s8 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s8 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end;;
+ match x8 with
+ | @expr.App _ _ _ s8 _ (@expr.Ident _ _ _ t6 idc6)
+ x9 =>
+ match x7 with
+ | @expr.Ident _ _ _ t7 idc7 =>
+ args <- invert_bind_args idc7 Raw.ident.Literal;
+ args0 <- invert_bind_args idc6 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc5 Raw.ident.Z_shiftr;
+ args2 <- invert_bind_args idc4 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc2
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc1 Raw.ident.Z_land;
+ args6 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_mul;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ (((projT1 args4) -> s4) ->
+ s8 -> (projT1 args))%ptype option
+ (fun x10 : option => x10)
+ with
+ | Some (_, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ (((projT1 args4) -> s4) ->
+ s8 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args4);
+ v <- type.try_make_transport_cps s4
+ ℤ;
+ v0 <- type.try_make_transport_cps s8
+ ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x10 <- (if
+ ((let (x10, _) := xv in
+ x10) =?
+ 2
+ ^ (2 *
+ (let (x10, _) :=
+ xv0 in
+ x10) / 2) - 1) &&
+ (ZRange.normalize
+ (ZRange.constant
+ (let (x10, _) :=
+ xv in
+ x10)) &'
+ ZRange.normalize args3 <=?
+ ZRange.normalize args6)%zrange &&
+ (ZRange.normalize args0 >>
+ ZRange.normalize
+ (ZRange.constant
+ (let (x10, _) :=
+ xv0 in
+ x10)) <=?
+ ZRange.normalize args2)%zrange
+ then
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_mullh
+ (2 *
+ (let (x10, _) :=
+ xv0 in
+ x10)))%expr @
+ (#(Z_cast args3)%expr @
+ v
+ (Compile.reflect x5),
+ #(Z_cast args0)%expr @
+ v0
+ (Compile.reflect x9))))%expr_pat
+ else None);
+ Some (Base x10));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s8 _ ($_)%expr _ | @expr.App _ _ _ s8
+ _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s8 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s8 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | (@expr.Ident _ _ _ t4 idc4 @ #(_))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ ($_)%expr)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.Abs _ _ _ _ _ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ (#(_) @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ (($_)%expr @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ (@expr.Abs _ _ _ _ _ _ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ (($_)%expr @ _ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @
+ (@expr.Abs _ _ _ _ _ _ @ _ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ (_ @ _ @ _ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @
+ (@expr.LetIn _ _ _ _ _ _ _ @ _ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @
+ (@expr.LetIn _ _ _ _ _ _ _ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.LetIn _ _ _ _ _ _ _)%expr_pat =>
+ None
+ | _ => None
+ end
+ | @expr.App _ _ _ s4 _ ($_)%expr _ | @expr.App _ _ _ s4 _
+ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s4 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s4 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s4 _ (@expr.Ident _ _ _ t2 idc2) x5 =>
+ match x3 with
+ | @expr.Ident _ _ _ t3 idc3 =>
+ match x0 with
+ | @expr.Ident _ _ _ t4 idc4 =>
+ (args <- invert_bind_args idc4 Raw.ident.Literal;
+ args0 <- invert_bind_args idc3 Raw.ident.Literal;
+ args1 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc1 Raw.ident.Z_land;
+ args3 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_mul;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ)%ptype
+ ((s4 -> (projT1 args0)) -> (projT1 args))%ptype
+ option (fun x6 : option => x6)
+ with
+ | Some (_, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ)%ptype
+ ((s4 -> (projT1 args0)) -> (projT1 args))%ptype
+ then
+ v <- type.try_make_transport_cps s4 ℤ;
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x6 <- (if
+ ((let (x6, _) := xv in x6) =?
+ 2
+ ^ (2 *
+ Z.log2_up
+ (let (x6, _) := xv in x6) /
+ 2) - 1) &&
+ (ZRange.normalize args1 &'
+ ZRange.normalize
+ (ZRange.constant
+ (let (x6, _) := xv in x6)) <=?
+ ZRange.normalize args3)%zrange
+ then
+ y <- invert_low
+ (2 *
+ Z.log2_up
+ (let (x6, _) := xv in x6))
+ (let (x6, _) := xv0 in x6);
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_mulll
+ (2 *
+ Z.log2_up
+ (let (x6, _) := xv in
+ x6)))%expr @
+ (#(Z_cast args1)%expr @
+ v (Compile.reflect x5),
+ (##y)%expr)))%expr_pat
+ else None);
+ Some (Base x6));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end);;
+ args <- invert_bind_args idc4 Raw.ident.Literal;
+ args0 <- invert_bind_args idc3 Raw.ident.Literal;
+ args1 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc1 Raw.ident.Z_land;
+ args3 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_mul;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ)%ptype
+ ((s4 -> (projT1 args0)) -> (projT1 args))%ptype
+ option (fun x6 : option => x6)
+ with
+ | Some (_, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ)%ptype
+ ((s4 -> (projT1 args0)) -> (projT1 args))%ptype
+ then
+ v <- type.try_make_transport_cps s4 ℤ;
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x6 <- (if
+ ((let (x6, _) := xv in x6) =?
+ 2
+ ^ (2 *
+ Z.log2_up
+ (let (x6, _) := xv in x6) / 2) -
+ 1) &&
+ (ZRange.normalize args1 &'
+ ZRange.normalize
+ (ZRange.constant
+ (let (x6, _) := xv in x6)) <=?
+ ZRange.normalize args3)%zrange
+ then
+ y <- invert_high
+ (2 *
+ Z.log2_up
+ (let (x6, _) := xv in x6))
+ (let (x6, _) := xv0 in x6);
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_mullh
+ (2 *
+ Z.log2_up
+ (let (x6, _) := xv in x6)))%expr @
+ (#(Z_cast args1)%expr @
+ v (Compile.reflect x5),
+ (##y)%expr)))%expr_pat
+ else None);
+ Some (Base x6));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | (@expr.Ident _ _ _ t4 idc4 @
+ (@expr.Ident _ _ _ t5 idc5 @ x8 @ x7))%expr_pat =>
+ match x8 with
+ | @expr.Ident _ _ _ t6 idc6 =>
+ match x7 with
+ | @expr.App _ _ _ s8 _ (@expr.Ident _ _ _ t7 idc7)
+ x9 =>
+ args <- invert_bind_args idc7 Raw.ident.Z_cast;
+ args0 <- invert_bind_args idc6
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc5 Raw.ident.Z_land;
+ args2 <- invert_bind_args idc4 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc3
+ Raw.ident.Literal;
+ args4 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc1 Raw.ident.Z_land;
+ args6 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_mul;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ ((s4 -> (projT1 args3)) ->
+ (projT1 args0) -> s8)%ptype option
+ (fun x10 : option => x10)
+ with
+ | Some (_, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ ((s4 -> (projT1 args3)) ->
+ (projT1 args0) -> s8)%ptype
+ then
+ v <- type.try_make_transport_cps s4
+ ℤ;
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args3);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ v0 <- type.try_make_transport_cps s8
+ ℤ;
+ fv <- (x10 <- (if
+ ((let (x10, _) := xv in
+ x10) =?
+ 2
+ ^ (2 *
+ Z.log2_up
+ (let (x10, _) :=
+ xv in
+ x10) / 2) - 1) &&
+ ((let (x10, _) := xv0 in
+ x10) =?
+ 2
+ ^ (2 *
+ Z.log2_up
+ (let (x10, _) :=
+ xv in
+ x10) / 2) - 1) &&
+ (ZRange.normalize args4 &'
+ ZRange.normalize
+ (ZRange.constant
+ (let (x10, _) :=
+ xv in
+ x10)) <=?
+ ZRange.normalize args6)%zrange &&
+ (ZRange.normalize
+ (ZRange.constant
+ (let (x10, _) :=
+ xv0 in
+ x10)) &'
+ ZRange.normalize args <=?
+ ZRange.normalize args2)%zrange
+ then
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_mulll
+ (2 *
+ Z.log2_up
+ (let
+ (x10, _) :=
+ xv in
+ x10)))%expr @
+ (#(Z_cast args4)%expr @
+ v
+ (Compile.reflect x5),
+ #(Z_cast args)%expr @
+ v0
+ (Compile.reflect x9))))%expr_pat
+ else None);
+ Some (Base x10));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s8 _ ($_)%expr _ | @expr.App _ _
+ _ s8 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _
+ _ s8 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s8 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s8 _ (@expr.Ident _ _ _ t6 idc6)
+ x9 =>
+ match x7 with
+ | @expr.Ident _ _ _ t7 idc7 =>
+ args <- invert_bind_args idc7 Raw.ident.Literal;
+ args0 <- invert_bind_args idc6 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc5 Raw.ident.Z_land;
+ args2 <- invert_bind_args idc4 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc3
+ Raw.ident.Literal;
+ args4 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc1 Raw.ident.Z_land;
+ args6 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_mul;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ ((s4 -> (projT1 args3)) ->
+ s8 -> (projT1 args))%ptype option
+ (fun x10 : option => x10)
+ with
+ | Some (_, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ ((s4 -> (projT1 args3)) ->
+ s8 -> (projT1 args))%ptype
+ then
+ v <- type.try_make_transport_cps s4
+ ℤ;
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args3);
+ v0 <- type.try_make_transport_cps s8
+ ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x10 <- (if
+ ((let (x10, _) := xv in
+ x10) =?
+ 2
+ ^ (2 *
+ Z.log2_up
+ (let (x10, _) :=
+ xv in
+ x10) / 2) - 1) &&
+ ((let (x10, _) := xv0 in
+ x10) =?
+ 2
+ ^ (2 *
+ Z.log2_up
+ (let (x10, _) :=
+ xv in
+ x10) / 2) - 1) &&
+ (ZRange.normalize args4 &'
+ ZRange.normalize
+ (ZRange.constant
+ (let (x10, _) :=
+ xv in
+ x10)) <=?
+ ZRange.normalize args6)%zrange &&
+ (ZRange.normalize args0 &'
+ ZRange.normalize
+ (ZRange.constant
+ (let (x10, _) :=
+ xv0 in
+ x10)) <=?
+ ZRange.normalize args2)%zrange
+ then
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_mulll
+ (2 *
+ Z.log2_up
+ (let
+ (x10, _) :=
+ xv in
+ x10)))%expr @
+ (#(Z_cast args4)%expr @
+ v
+ (Compile.reflect x5),
+ #(Z_cast args0)%expr @
+ v0
+ (Compile.reflect x9))))%expr_pat
+ else None);
+ Some (Base x10));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s8 _ ($_)%expr _ | @expr.App _ _ _ s8
+ _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s8 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s8 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end;;
+ match x8 with
+ | @expr.App _ _ _ s8 _ (@expr.Ident _ _ _ t6 idc6)
+ x9 =>
+ match x7 with
+ | @expr.Ident _ _ _ t7 idc7 =>
+ args <- invert_bind_args idc7 Raw.ident.Literal;
+ args0 <- invert_bind_args idc6 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc5 Raw.ident.Z_shiftr;
+ args2 <- invert_bind_args idc4 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc3
+ Raw.ident.Literal;
+ args4 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc1 Raw.ident.Z_land;
+ args6 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_mul;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ ((s4 -> (projT1 args3)) ->
+ s8 -> (projT1 args))%ptype option
+ (fun x10 : option => x10)
+ with
+ | Some (_, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ ((s4 -> (projT1 args3)) ->
+ s8 -> (projT1 args))%ptype
+ then
+ v <- type.try_make_transport_cps s4
+ ℤ;
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args3);
+ v0 <- type.try_make_transport_cps s8
+ ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x10 <- (if
+ ((let (x10, _) := xv in
+ x10) =?
+ 2
+ ^ (2 *
+ (let (x10, _) :=
+ xv0 in
+ x10) / 2) - 1) &&
+ (ZRange.normalize args4 &'
+ ZRange.normalize
+ (ZRange.constant
+ (let (x10, _) :=
+ xv in
+ x10)) <=?
+ ZRange.normalize args6)%zrange &&
+ (ZRange.normalize args0 >>
+ ZRange.normalize
+ (ZRange.constant
+ (let (x10, _) :=
+ xv0 in
+ x10)) <=?
+ ZRange.normalize args2)%zrange
+ then
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_mullh
+ (2 *
+ (let (x10, _) :=
+ xv0 in
+ x10)))%expr @
+ (#(Z_cast args4)%expr @
+ v
+ (Compile.reflect x5),
+ #(Z_cast args0)%expr @
+ v0
+ (Compile.reflect x9))))%expr_pat
+ else None);
+ Some (Base x10));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s8 _ ($_)%expr _ | @expr.App _ _ _ s8
+ _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s8 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s8 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | (@expr.Ident _ _ _ t4 idc4 @ #(_))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ ($_)%expr)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.Abs _ _ _ _ _ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ (#(_) @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ (($_)%expr @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ (@expr.Abs _ _ _ _ _ _ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ (($_)%expr @ _ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @
+ (@expr.Abs _ _ _ _ _ _ @ _ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ (_ @ _ @ _ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @
+ (@expr.LetIn _ _ _ _ _ _ _ @ _ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @
+ (@expr.LetIn _ _ _ _ _ _ _ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.LetIn _ _ _ _ _ _ _)%expr_pat =>
+ None
+ | _ => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s4 _ ($_)%expr _ | @expr.App _ _ _ s4 _
+ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s4 _ (_ @ _)%expr_pat
+ _ | @expr.App _ _ _ s4 _ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end;;
+ match x4 with
+ | @expr.App _ _ _ s4 _ (@expr.Ident _ _ _ t2 idc2) x5 =>
+ match x3 with
+ | @expr.Ident _ _ _ t3 idc3 =>
+ match x0 with
+ | @expr.Ident _ _ _ t4 idc4 =>
+ (args <- invert_bind_args idc4 Raw.ident.Literal;
+ args0 <- invert_bind_args idc3 Raw.ident.Literal;
+ args1 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc1 Raw.ident.Z_shiftr;
+ args3 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_mul;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ)%ptype
+ ((s4 -> (projT1 args0)) -> (projT1 args))%ptype
+ option (fun x6 : option => x6)
+ with
+ | Some (_, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ)%ptype
+ ((s4 -> (projT1 args0)) -> (projT1 args))%ptype
+ then
+ v <- type.try_make_transport_cps s4 ℤ;
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x6 <- (if
+ (ZRange.normalize args1 >>
+ ZRange.normalize
+ (ZRange.constant
+ (let (x6, _) := xv in x6)) <=?
+ ZRange.normalize args3)%zrange
+ then
+ y <- invert_low
+ (2 *
+ (let (x6, _) := xv in x6))
+ (let (x6, _) := xv0 in x6);
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_mulhl
+ (2 *
+ (let (x6, _) := xv in x6)))%expr @
+ (#(Z_cast args1)%expr @
+ v (Compile.reflect x5),
+ (##y)%expr)))%expr_pat
+ else None);
+ Some (Base x6));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end);;
+ args <- invert_bind_args idc4 Raw.ident.Literal;
+ args0 <- invert_bind_args idc3 Raw.ident.Literal;
+ args1 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc1 Raw.ident.Z_shiftr;
+ args3 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_mul;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ)%ptype
+ ((s4 -> (projT1 args0)) -> (projT1 args))%ptype
+ option (fun x6 : option => x6)
+ with
+ | Some (_, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ)%ptype
+ ((s4 -> (projT1 args0)) -> (projT1 args))%ptype
+ then
+ v <- type.try_make_transport_cps s4 ℤ;
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x6 <- (if
+ (ZRange.normalize args1 >>
+ ZRange.normalize
+ (ZRange.constant
+ (let (x6, _) := xv in x6)) <=?
+ ZRange.normalize args3)%zrange
+ then
+ y <- invert_high
+ (2 *
+ (let (x6, _) := xv in x6))
+ (let (x6, _) := xv0 in x6);
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_mulhh
+ (2 *
+ (let (x6, _) := xv in x6)))%expr @
+ (#(Z_cast args1)%expr @
+ v (Compile.reflect x5),
+ (##y)%expr)))%expr_pat
+ else None);
+ Some (Base x6));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | (@expr.Ident _ _ _ t4 idc4 @
+ (@expr.Ident _ _ _ t5 idc5 @ x8 @ x7))%expr_pat =>
+ match x8 with
+ | @expr.Ident _ _ _ t6 idc6 =>
+ match x7 with
+ | @expr.App _ _ _ s8 _ (@expr.Ident _ _ _ t7 idc7)
+ x9 =>
+ args <- invert_bind_args idc7 Raw.ident.Z_cast;
+ args0 <- invert_bind_args idc6
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc5 Raw.ident.Z_land;
+ args2 <- invert_bind_args idc4 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc3
+ Raw.ident.Literal;
+ args4 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc1 Raw.ident.Z_shiftr;
+ args6 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_mul;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ ((s4 -> (projT1 args3)) ->
+ (projT1 args0) -> s8)%ptype option
+ (fun x10 : option => x10)
+ with
+ | Some (_, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ ((s4 -> (projT1 args3)) ->
+ (projT1 args0) -> s8)%ptype
+ then
+ v <- type.try_make_transport_cps s4
+ ℤ;
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args3);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ v0 <- type.try_make_transport_cps s8
+ ℤ;
+ fv <- (x10 <- (if
+ ((let (x10, _) := xv0 in
+ x10) =?
+ 2
+ ^ (2 *
+ (let (x10, _) := xv in
+ x10) / 2) - 1) &&
+ (ZRange.normalize args4 >>
+ ZRange.normalize
+ (ZRange.constant
+ (let (x10, _) :=
+ xv in
+ x10)) <=?
+ ZRange.normalize args6)%zrange &&
+ (ZRange.normalize
+ (ZRange.constant
+ (let (x10, _) :=
+ xv0 in
+ x10)) &'
+ ZRange.normalize args <=?
+ ZRange.normalize args2)%zrange
+ then
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_mulhl
+ (2 *
+ (let (x10, _) :=
+ xv in
+ x10)))%expr @
+ (#(Z_cast args4)%expr @
+ v
+ (Compile.reflect x5),
+ #(Z_cast args)%expr @
+ v0
+ (Compile.reflect x9))))%expr_pat
+ else None);
+ Some (Base x10));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s8 _ ($_)%expr _ | @expr.App _ _
+ _ s8 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _
+ _ s8 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s8 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s8 _ (@expr.Ident _ _ _ t6 idc6)
+ x9 =>
+ match x7 with
+ | @expr.Ident _ _ _ t7 idc7 =>
+ args <- invert_bind_args idc7 Raw.ident.Literal;
+ args0 <- invert_bind_args idc6 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc5 Raw.ident.Z_land;
+ args2 <- invert_bind_args idc4 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc3
+ Raw.ident.Literal;
+ args4 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc1 Raw.ident.Z_shiftr;
+ args6 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_mul;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ ((s4 -> (projT1 args3)) ->
+ s8 -> (projT1 args))%ptype option
+ (fun x10 : option => x10)
+ with
+ | Some (_, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ ((s4 -> (projT1 args3)) ->
+ s8 -> (projT1 args))%ptype
+ then
+ v <- type.try_make_transport_cps s4
+ ℤ;
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args3);
+ v0 <- type.try_make_transport_cps s8
+ ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x10 <- (if
+ ((let (x10, _) := xv0 in
+ x10) =?
+ 2
+ ^ (2 *
+ (let (x10, _) := xv in
+ x10) / 2) - 1) &&
+ (ZRange.normalize args4 >>
+ ZRange.normalize
+ (ZRange.constant
+ (let (x10, _) :=
+ xv in
+ x10)) <=?
+ ZRange.normalize args6)%zrange &&
+ (ZRange.normalize args0 &'
+ ZRange.normalize
+ (ZRange.constant
+ (let (x10, _) :=
+ xv0 in
+ x10)) <=?
+ ZRange.normalize args2)%zrange
+ then
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_mulhl
+ (2 *
+ (let (x10, _) :=
+ xv in
+ x10)))%expr @
+ (#(Z_cast args4)%expr @
+ v
+ (Compile.reflect x5),
+ #(Z_cast args0)%expr @
+ v0
+ (Compile.reflect x9))))%expr_pat
+ else None);
+ Some (Base x10));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s8 _ ($_)%expr _ | @expr.App _ _ _ s8
+ _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s8 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s8 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end;;
+ match x8 with
+ | @expr.App _ _ _ s8 _ (@expr.Ident _ _ _ t6 idc6)
+ x9 =>
+ match x7 with
+ | @expr.Ident _ _ _ t7 idc7 =>
+ args <- invert_bind_args idc7 Raw.ident.Literal;
+ args0 <- invert_bind_args idc6 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc5 Raw.ident.Z_shiftr;
+ args2 <- invert_bind_args idc4 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc3
+ Raw.ident.Literal;
+ args4 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc1 Raw.ident.Z_shiftr;
+ args6 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_mul;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ ((s4 -> (projT1 args3)) ->
+ s8 -> (projT1 args))%ptype option
+ (fun x10 : option => x10)
+ with
+ | Some (_, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ ((s4 -> (projT1 args3)) ->
+ s8 -> (projT1 args))%ptype
+ then
+ v <- type.try_make_transport_cps s4
+ ℤ;
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args3);
+ v0 <- type.try_make_transport_cps s8
+ ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x10 <- (if
+ ((let (x10, _) := xv in
+ x10) =?
+ (let (x10, _) := xv0 in
+ x10)) &&
+ (ZRange.normalize args4 >>
+ ZRange.normalize
+ (ZRange.constant
+ (let (x10, _) :=
+ xv in
+ x10)) <=?
+ ZRange.normalize args6)%zrange &&
+ (ZRange.normalize args0 >>
+ ZRange.normalize
+ (ZRange.constant
+ (let (x10, _) :=
+ xv0 in
+ x10)) <=?
+ ZRange.normalize args2)%zrange
+ then
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_mulhh
+ (2 *
+ (let (x10, _) :=
+ xv in
+ x10)))%expr @
+ (#(Z_cast args4)%expr @
+ v
+ (Compile.reflect x5),
+ #(Z_cast args0)%expr @
+ v0
+ (Compile.reflect x9))))%expr_pat
+ else None);
+ Some (Base x10));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s8 _ ($_)%expr _ | @expr.App _ _ _ s8
+ _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s8 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s8 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | (@expr.Ident _ _ _ t4 idc4 @ #(_))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ ($_)%expr)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.Abs _ _ _ _ _ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ (#(_) @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ (($_)%expr @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ (@expr.Abs _ _ _ _ _ _ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ (($_)%expr @ _ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @
+ (@expr.Abs _ _ _ _ _ _ @ _ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ (_ @ _ @ _ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @
+ (@expr.LetIn _ _ _ _ _ _ _ @ _ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @
+ (@expr.LetIn _ _ _ _ _ _ _ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.LetIn _ _ _ _ _ _ _)%expr_pat =>
+ None
+ | _ => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s4 _ ($_)%expr _ | @expr.App _ _ _ s4 _
+ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s4 _ (_ @ _)%expr_pat
+ _ | @expr.App _ _ _ s4 _ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0)) #(_)%expr_pat | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0)) ($_)%expr | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0)) (@expr.Abs _ _ _ _ _ _) | @expr.App _ _
+ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0)) (($_)%expr @ _)%expr_pat | @expr.App _
+ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0)) (@expr.Abs _ _ _ _ _ _ @ _)%expr_pat |
+ @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0)) (_ @ _ @ _)%expr_pat | @expr.App _ _ _
+ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0))
+ (@expr.LetIn _ _ _ _ _ _ _ @ _)%expr_pat | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0)) (@expr.LetIn _ _ _ _ _ _ _) | @expr.App
+ _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0 @ #(_))%expr_pat) _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0 @ ($_)%expr)%expr_pat) _ | @expr.App _ _
+ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0 @ @expr.Abs _ _ _ _ _ _)%expr_pat) _ |
+ @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0 @ (#(_) @ _))%expr_pat) _ | @expr.App _ _
+ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0 @ (($_)%expr @ _))%expr_pat) _ |
+ @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0 @ (@expr.Abs _ _ _ _ _ _ @ _))%expr_pat)
+ _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0 @ (($_)%expr @ _ @ _))%expr_pat) _ |
+ @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0 @ (@expr.Abs _ _ _ _ _ _ @ _ @ _))%expr_pat)
+ _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0 @ (_ @ _ @ _ @ _))%expr_pat) _ |
+ @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0 @ (@expr.LetIn _ _ _ _ _ _ _ @ _ @ _))%expr_pat)
+ _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0 @ (@expr.LetIn _ _ _ _ _ _ _ @ _))%expr_pat)
+ _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Ident _ _ _ t0 idc0 @ @expr.LetIn _ _ _ _ _ _ _)%expr_pat)
+ _ => None
+ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc) ($_)%expr) _ |
+ @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Abs _ _ _ _ _ _)) _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (($_)%expr @ _)%expr_pat) _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.Abs _ _ _ _ _ _ @ _)%expr_pat) _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc) (_ @ _ @ _)%expr_pat)
+ _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.LetIn _ _ _ _ _ _ _ @ _)%expr_pat) _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.Ident _ _ _ t idc)
+ (@expr.LetIn _ _ _ _ _ _ _)) _ => None
+ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _ (@expr.Ident _ _ _ t idc) x2) x1) x0 =>
+ match x2 with
+ | (@expr.Ident _ _ _ t0 idc0 @
+ (@expr.Ident _ _ _ t1 idc1 @ x5 @ x4))%expr_pat =>
+ match x5 with
+ | @expr.Ident _ _ _ t2 idc2 =>
+ match x4 with
+ | @expr.App _ _ _ s5 _ (@expr.Ident _ _ _ t3 idc3) x6 =>
+ match x1 with
+ | @expr.Ident _ _ _ t4 idc4 =>
+ match x0 with
+ | @expr.Ident _ _ _ t5 idc5 =>
+ args <- invert_bind_args idc5 Raw.ident.Literal;
+ args0 <- invert_bind_args idc4
+ Raw.ident.Literal;
+ args1 <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args2 <- invert_bind_args idc2
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc1 Raw.ident.Z_cc_m;
+ args4 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_zselect;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s5) -> (projT1 args0)) ->
+ (projT1 args))%ptype option
+ (fun x7 : option => x7)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s5) ->
+ (projT1 args0)) -> (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ v <- type.try_make_transport_cps s5
+ ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv1 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x7 <- (if
+ ((let (x7, _) := xv in x7) =?
+ 2
+ ^ Z.log2
+ (let (x7, _) := xv in
+ x7)) &&
+ ((ZRange.cc_m
+ (let (x7, _) := xv in
+ x7))
+ (ZRange.normalize args1) <=?
+ ZRange.normalize args4)%zrange
+ then
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_selm
+ (Z.log2
+ (let (x7, _) :=
+ xv in
+ x7)))%expr @
+ (#(Z_cast args1)%expr @
+ v (Compile.reflect x6),
+ (##(let (x7, _) :=
+ xv0 in
+ x7))%expr,
+ (##(let (x7, _) :=
+ xv1 in
+ x7))%expr)))%expr_pat
+ else None);
+ Some (Base x7));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s6 _ (@expr.Ident _ _ _ t5 idc5)
+ x7 =>
+ args <- invert_bind_args idc5 Raw.ident.Z_cast;
+ args0 <- invert_bind_args idc4
+ Raw.ident.Literal;
+ args1 <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args2 <- invert_bind_args idc2
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc1 Raw.ident.Z_cc_m;
+ args4 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_zselect;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s5) -> (projT1 args0)) ->
+ s6)%ptype option (fun x8 : option => x8)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s5) ->
+ (projT1 args0)) -> s6)%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ v <- type.try_make_transport_cps s5
+ ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ v0 <- type.try_make_transport_cps s6
+ ℤ;
+ fv <- (x8 <- (if
+ ((let (x8, _) := xv in x8) =?
+ 2
+ ^ Z.log2
+ (let (x8, _) := xv in
+ x8)) &&
+ ((ZRange.cc_m
+ (let (x8, _) := xv in
+ x8))
+ (ZRange.normalize args1) <=?
+ ZRange.normalize args4)%zrange
+ then
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_selm
+ (Z.log2
+ (let (x8, _) :=
+ xv in
+ x8)))%expr @
+ (#(Z_cast args1)%expr @
+ v (Compile.reflect x6),
+ (##(let (x8, _) :=
+ xv0 in
+ x8))%expr,
+ #(Z_cast args)%expr @
+ v0 (Compile.reflect x7))))%expr_pat
+ else None);
+ Some (Base x8));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s6 _ ($_)%expr _ | @expr.App _ _
+ _ s6 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _
+ _ s6 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s6 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s6 _ (@expr.Ident _ _ _ t4 idc4)
+ x7 =>
+ match x0 with
+ | @expr.Ident _ _ _ t5 idc5 =>
+ args <- invert_bind_args idc5 Raw.ident.Literal;
+ args0 <- invert_bind_args idc4 Raw.ident.Z_cast;
+ args1 <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args2 <- invert_bind_args idc2
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc1 Raw.ident.Z_cc_m;
+ args4 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_zselect;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s5) -> s6) ->
+ (projT1 args))%ptype option
+ (fun x8 : option => x8)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s5) -> s6) ->
+ (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ v <- type.try_make_transport_cps s5
+ ℤ;
+ v0 <- type.try_make_transport_cps s6
+ ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x8 <- (if
+ ((let (x8, _) := xv in x8) =?
+ 2
+ ^ Z.log2
+ (let (x8, _) := xv in
+ x8)) &&
+ ((ZRange.cc_m
+ (let (x8, _) := xv in
+ x8))
+ (ZRange.normalize args1) <=?
+ ZRange.normalize args4)%zrange
+ then
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_selm
+ (Z.log2
+ (let (x8, _) :=
+ xv in
+ x8)))%expr @
+ (#(Z_cast args1)%expr @
+ v (Compile.reflect x6),
+ #(Z_cast args0)%expr @
+ v0 (Compile.reflect x7),
+ (##(let (x8, _) :=
+ xv0 in
+ x8))%expr)))%expr_pat
+ else None);
+ Some (Base x8));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s7 _ (@expr.Ident _ _ _ t5 idc5)
+ x8 =>
+ args <- invert_bind_args idc5 Raw.ident.Z_cast;
+ args0 <- invert_bind_args idc4 Raw.ident.Z_cast;
+ args1 <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args2 <- invert_bind_args idc2
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc1 Raw.ident.Z_cc_m;
+ args4 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_zselect;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s5) -> s6) -> s7)%ptype
+ option (fun x9 : option => x9)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s5) -> s6) -> s7)%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ v <- type.try_make_transport_cps s5
+ ℤ;
+ v0 <- type.try_make_transport_cps s6
+ ℤ;
+ v1 <- type.try_make_transport_cps s7
+ ℤ;
+ fv <- (x9 <- (if
+ ((let (x9, _) := xv in x9) =?
+ 2
+ ^ Z.log2
+ (let (x9, _) := xv in
+ x9)) &&
+ ((ZRange.cc_m
+ (let (x9, _) := xv in
+ x9))
+ (ZRange.normalize args1) <=?
+ ZRange.normalize args4)%zrange
+ then
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_selm
+ (Z.log2
+ (let (x9, _) :=
+ xv in
+ x9)))%expr @
+ (#(Z_cast args1)%expr @
+ v (Compile.reflect x6),
+ #(Z_cast args0)%expr @
+ v0 (Compile.reflect x7),
+ #(Z_cast args)%expr @
+ v1 (Compile.reflect x8))))%expr_pat
+ else None);
+ Some (Base x9));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s7 _ ($_)%expr _ | @expr.App _ _
+ _ s7 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _
+ _ s7 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s7 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s6 _ ($_)%expr _ | @expr.App _ _ _ s6
+ _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s6 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s6 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s5 _ ($_)%expr _ | @expr.App _ _ _ s5 _
+ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s5 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s5 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | _ => None
+ end;;
+ match x5 with
+ | @expr.Ident _ _ _ t2 idc2 =>
+ match x4 with
+ | @expr.App _ _ _ s5 _ (@expr.Ident _ _ _ t3 idc3) x6 =>
+ match x1 with
+ | @expr.Ident _ _ _ t4 idc4 =>
+ match x0 with
+ | @expr.Ident _ _ _ t5 idc5 =>
+ args <- invert_bind_args idc5 Raw.ident.Literal;
+ args0 <- invert_bind_args idc4
+ Raw.ident.Literal;
+ args1 <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args2 <- invert_bind_args idc2
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc1 Raw.ident.Z_land;
+ args4 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_zselect;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s5) -> (projT1 args0)) ->
+ (projT1 args))%ptype option
+ (fun x7 : option => x7)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s5) ->
+ (projT1 args0)) -> (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ v <- type.try_make_transport_cps s5
+ ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv1 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x7 <- (if
+ ((let (x7, _) := xv in x7) =?
+ 1) &&
+ (ZRange.normalize
+ (ZRange.constant
+ (let (x7, _) := xv in
+ x7)) &'
+ ZRange.normalize args1 <=?
+ ZRange.normalize args4)%zrange
+ then
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_sell)%expr @
+ (#(Z_cast args1)%expr @
+ v (Compile.reflect x6),
+ (##(let (x7, _) :=
+ xv0 in
+ x7))%expr,
+ (##(let (x7, _) :=
+ xv1 in
+ x7))%expr)))%expr_pat
+ else None);
+ Some (Base x7));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s6 _ (@expr.Ident _ _ _ t5 idc5)
+ x7 =>
+ args <- invert_bind_args idc5 Raw.ident.Z_cast;
+ args0 <- invert_bind_args idc4
+ Raw.ident.Literal;
+ args1 <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args2 <- invert_bind_args idc2
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc1 Raw.ident.Z_land;
+ args4 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_zselect;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s5) -> (projT1 args0)) ->
+ s6)%ptype option (fun x8 : option => x8)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s5) ->
+ (projT1 args0)) -> s6)%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ v <- type.try_make_transport_cps s5
+ ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ v0 <- type.try_make_transport_cps s6
+ ℤ;
+ fv <- (x8 <- (if
+ ((let (x8, _) := xv in x8) =?
+ 1) &&
+ (ZRange.normalize
+ (ZRange.constant
+ (let (x8, _) := xv in
+ x8)) &'
+ ZRange.normalize args1 <=?
+ ZRange.normalize args4)%zrange
+ then
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_sell)%expr @
+ (#(Z_cast args1)%expr @
+ v (Compile.reflect x6),
+ (##(let (x8, _) :=
+ xv0 in
+ x8))%expr,
+ #(Z_cast args)%expr @
+ v0 (Compile.reflect x7))))%expr_pat
+ else None);
+ Some (Base x8));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s6 _ ($_)%expr _ | @expr.App _ _
+ _ s6 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _
+ _ s6 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s6 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s6 _ (@expr.Ident _ _ _ t4 idc4)
+ x7 =>
+ match x0 with
+ | @expr.Ident _ _ _ t5 idc5 =>
+ args <- invert_bind_args idc5 Raw.ident.Literal;
+ args0 <- invert_bind_args idc4 Raw.ident.Z_cast;
+ args1 <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args2 <- invert_bind_args idc2
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc1 Raw.ident.Z_land;
+ args4 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_zselect;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s5) -> s6) ->
+ (projT1 args))%ptype option
+ (fun x8 : option => x8)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s5) -> s6) ->
+ (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ v <- type.try_make_transport_cps s5
+ ℤ;
+ v0 <- type.try_make_transport_cps s6
+ ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x8 <- (if
+ ((let (x8, _) := xv in x8) =?
+ 1) &&
+ (ZRange.normalize
+ (ZRange.constant
+ (let (x8, _) := xv in
+ x8)) &'
+ ZRange.normalize args1 <=?
+ ZRange.normalize args4)%zrange
+ then
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_sell)%expr @
+ (#(Z_cast args1)%expr @
+ v (Compile.reflect x6),
+ #(Z_cast args0)%expr @
+ v0 (Compile.reflect x7),
+ (##(let (x8, _) :=
+ xv0 in
+ x8))%expr)))%expr_pat
+ else None);
+ Some (Base x8));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s7 _ (@expr.Ident _ _ _ t5 idc5)
+ x8 =>
+ args <- invert_bind_args idc5 Raw.ident.Z_cast;
+ args0 <- invert_bind_args idc4 Raw.ident.Z_cast;
+ args1 <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args2 <- invert_bind_args idc2
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc1 Raw.ident.Z_land;
+ args4 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_zselect;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s5) -> s6) -> s7)%ptype
+ option (fun x9 : option => x9)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s5) -> s6) -> s7)%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ v <- type.try_make_transport_cps s5
+ ℤ;
+ v0 <- type.try_make_transport_cps s6
+ ℤ;
+ v1 <- type.try_make_transport_cps s7
+ ℤ;
+ fv <- (x9 <- (if
+ ((let (x9, _) := xv in x9) =?
+ 1) &&
+ (ZRange.normalize
+ (ZRange.constant
+ (let (x9, _) := xv in
+ x9)) &'
+ ZRange.normalize args1 <=?
+ ZRange.normalize args4)%zrange
+ then
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_sell)%expr @
+ (#(Z_cast args1)%expr @
+ v (Compile.reflect x6),
+ #(Z_cast args0)%expr @
+ v0 (Compile.reflect x7),
+ #(Z_cast args)%expr @
+ v1 (Compile.reflect x8))))%expr_pat
+ else None);
+ Some (Base x9));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s7 _ ($_)%expr _ | @expr.App _ _
+ _ s7 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _
+ _ s7 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s7 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s6 _ ($_)%expr _ | @expr.App _ _ _ s6
+ _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s6 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s6 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s5 _ ($_)%expr _ | @expr.App _ _ _ s5 _
+ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s5 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s5 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s5 _ (@expr.Ident _ _ _ t2 idc2) x6 =>
+ match x4 with
+ | @expr.Ident _ _ _ t3 idc3 =>
+ match x1 with
+ | @expr.Ident _ _ _ t4 idc4 =>
+ match x0 with
+ | @expr.Ident _ _ _ t5 idc5 =>
+ args <- invert_bind_args idc5 Raw.ident.Literal;
+ args0 <- invert_bind_args idc4
+ Raw.ident.Literal;
+ args1 <- invert_bind_args idc3
+ Raw.ident.Literal;
+ args2 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc1 Raw.ident.Z_land;
+ args4 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_zselect;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ (((s5 -> (projT1 args1)) -> (projT1 args0)) ->
+ (projT1 args))%ptype option
+ (fun x7 : option => x7)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ (((s5 -> (projT1 args1)) ->
+ (projT1 args0)) -> (projT1 args))%ptype
+ then
+ v <- type.try_make_transport_cps s5
+ ℤ;
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv1 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x7 <- (if
+ ((let (x7, _) := xv in x7) =?
+ 1) &&
+ (ZRange.normalize args2 &'
+ ZRange.normalize
+ (ZRange.constant
+ (let (x7, _) := xv in
+ x7)) <=?
+ ZRange.normalize args4)%zrange
+ then
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_sell)%expr @
+ (#(Z_cast args2)%expr @
+ v (Compile.reflect x6),
+ (##(let (x7, _) :=
+ xv0 in
+ x7))%expr,
+ (##(let (x7, _) :=
+ xv1 in
+ x7))%expr)))%expr_pat
+ else None);
+ Some (Base x7));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s6 _ (@expr.Ident _ _ _ t5 idc5)
+ x7 =>
+ args <- invert_bind_args idc5 Raw.ident.Z_cast;
+ args0 <- invert_bind_args idc4
+ Raw.ident.Literal;
+ args1 <- invert_bind_args idc3
+ Raw.ident.Literal;
+ args2 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc1 Raw.ident.Z_land;
+ args4 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_zselect;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ (((s5 -> (projT1 args1)) -> (projT1 args0)) ->
+ s6)%ptype option (fun x8 : option => x8)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ (((s5 -> (projT1 args1)) ->
+ (projT1 args0)) -> s6)%ptype
+ then
+ v <- type.try_make_transport_cps s5
+ ℤ;
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ v0 <- type.try_make_transport_cps s6
+ ℤ;
+ fv <- (x8 <- (if
+ ((let (x8, _) := xv in x8) =?
+ 1) &&
+ (ZRange.normalize args2 &'
+ ZRange.normalize
+ (ZRange.constant
+ (let (x8, _) := xv in
+ x8)) <=?
+ ZRange.normalize args4)%zrange
+ then
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_sell)%expr @
+ (#(Z_cast args2)%expr @
+ v (Compile.reflect x6),
+ (##(let (x8, _) :=
+ xv0 in
+ x8))%expr,
+ #(Z_cast args)%expr @
+ v0 (Compile.reflect x7))))%expr_pat
+ else None);
+ Some (Base x8));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s6 _ ($_)%expr _ | @expr.App _ _
+ _ s6 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _
+ _ s6 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s6 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s6 _ (@expr.Ident _ _ _ t4 idc4)
+ x7 =>
+ match x0 with
+ | @expr.Ident _ _ _ t5 idc5 =>
+ args <- invert_bind_args idc5 Raw.ident.Literal;
+ args0 <- invert_bind_args idc4 Raw.ident.Z_cast;
+ args1 <- invert_bind_args idc3
+ Raw.ident.Literal;
+ args2 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc1 Raw.ident.Z_land;
+ args4 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_zselect;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ (((s5 -> (projT1 args1)) -> s6) ->
+ (projT1 args))%ptype option
+ (fun x8 : option => x8)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ (((s5 -> (projT1 args1)) -> s6) ->
+ (projT1 args))%ptype
+ then
+ v <- type.try_make_transport_cps s5
+ ℤ;
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ v0 <- type.try_make_transport_cps s6
+ ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x8 <- (if
+ ((let (x8, _) := xv in x8) =?
+ 1) &&
+ (ZRange.normalize args2 &'
+ ZRange.normalize
+ (ZRange.constant
+ (let (x8, _) := xv in
+ x8)) <=?
+ ZRange.normalize args4)%zrange
+ then
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_sell)%expr @
+ (#(Z_cast args2)%expr @
+ v (Compile.reflect x6),
+ #(Z_cast args0)%expr @
+ v0 (Compile.reflect x7),
+ (##(let (x8, _) :=
+ xv0 in
+ x8))%expr)))%expr_pat
+ else None);
+ Some (Base x8));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s7 _ (@expr.Ident _ _ _ t5 idc5)
+ x8 =>
+ args <- invert_bind_args idc5 Raw.ident.Z_cast;
+ args0 <- invert_bind_args idc4 Raw.ident.Z_cast;
+ args1 <- invert_bind_args idc3
+ Raw.ident.Literal;
+ args2 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc1 Raw.ident.Z_land;
+ args4 <- invert_bind_args idc0 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc Raw.ident.Z_zselect;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ (((s5 -> (projT1 args1)) -> s6) -> s7)%ptype
+ option (fun x9 : option => x9)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ (((s5 -> (projT1 args1)) -> s6) -> s7)%ptype
+ then
+ v <- type.try_make_transport_cps s5
+ ℤ;
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ v0 <- type.try_make_transport_cps s6
+ ℤ;
+ v1 <- type.try_make_transport_cps s7
+ ℤ;
+ fv <- (x9 <- (if
+ ((let (x9, _) := xv in x9) =?
+ 1) &&
+ (ZRange.normalize args2 &'
+ ZRange.normalize
+ (ZRange.constant
+ (let (x9, _) := xv in
+ x9)) <=?
+ ZRange.normalize args4)%zrange
+ then
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_sell)%expr @
+ (#(Z_cast args2)%expr @
+ v (Compile.reflect x6),
+ #(Z_cast args0)%expr @
+ v0 (Compile.reflect x7),
+ #(Z_cast args)%expr @
+ v1 (Compile.reflect x8))))%expr_pat
+ else None);
+ Some (Base x9));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s7 _ ($_)%expr _ | @expr.App _ _
+ _ s7 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _
+ _ s7 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s7 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s6 _ ($_)%expr _ | @expr.App _ _ _ s6
+ _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s6 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s6 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s5 _ ($_)%expr _ | @expr.App _ _ _ s5 _
+ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s5 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s5 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | (@expr.Ident _ _ _ t0 idc0 @ #(_))%expr_pat |
+ (@expr.Ident _ _ _ t0 idc0 @ ($_)%expr)%expr_pat |
+ (@expr.Ident _ _ _ t0 idc0 @ @expr.Abs _ _ _ _ _ _)%expr_pat |
+ (@expr.Ident _ _ _ t0 idc0 @ (#(_) @ _))%expr_pat |
+ (@expr.Ident _ _ _ t0 idc0 @ (($_)%expr @ _))%expr_pat |
+ (@expr.Ident _ _ _ t0 idc0 @ (@expr.Abs _ _ _ _ _ _ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t0 idc0 @ (($_)%expr @ _ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t0 idc0 @ (@expr.Abs _ _ _ _ _ _ @ _ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t0 idc0 @ (_ @ _ @ _ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t0 idc0 @ (@expr.LetIn _ _ _ _ _ _ _ @ _ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t0 idc0 @ (@expr.LetIn _ _ _ _ _ _ _ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t0 idc0 @ @expr.LetIn _ _ _ _ _ _ _)%expr_pat =>
+ None
+ | _ => None
+ end;;
+ _ <- invert_bind_args idc Raw.ident.Z_zselect;
+ match
+ pattern.type.unify_extracted_cps ((ℤ -> ℤ) -> ℤ)%ptype
+ ((s1 -> s0) -> s)%ptype option (fun x3 : option => x3)
+ with
+ | Some (_, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ)%ptype ((s1 -> s0) -> s)%ptype
+ then
+ v <- type.try_make_transport_cps s1 ℤ;
+ v0 <- type.try_make_transport_cps s0 ℤ;
+ v1 <- type.try_make_transport_cps s ℤ;
+ Some
+ (Base
+ (#(Z_cast range)%expr @
+ (#(fancy_selc)%expr @
+ (v (Compile.reflect x2), v0 (Compile.reflect x1),
+ v1 (Compile.reflect x0))))%expr_pat)
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.Ident _ _ _ t1 idc1))
+ (@expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t2 idc2) x4))
+ (@expr.Ident _ _ _ t3 idc3) =>
+ args <- invert_bind_args idc3 Raw.ident.Literal;
+ args0 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args1 <- invert_bind_args idc1 Raw.ident.Literal;
+ args2 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc Raw.ident.Z_rshi;
+ match
+ pattern.type.unify_extracted_cps (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> (projT1 args1)) -> s3) -> (projT1 args))%ptype
+ option (fun x5 : option => x5)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> (projT1 args1)) -> s3) -> (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args2);
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args1);
+ v <- type.try_make_transport_cps s3 ℤ;
+ xv1 <- 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
+ (#(Z_cast range)%expr @
+ (#(fancy_rshi
+ (Z.log2 (let (x5, _) := xv in x5))
+ (let (x5, _) := xv1 in x5))%expr @
+ ((##(let (x5, _) := xv0 in x5))%expr,
+ #(Z_cast args0)%expr @
+ v (Compile.reflect x4))))%expr_pat
+ else None);
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.Ident _ _ _ t1 idc1)) (@expr.App _ _ _ s3 _ ($_)%expr _))
+ _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.Ident _ _ _ t1 idc1))
+ (@expr.App _ _ _ s3 _ (@expr.Abs _ _ _ _ _ _) _)) _ | @expr.App _ _
+ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.Ident _ _ _ t1 idc1))
+ (@expr.App _ _ _ s3 _ (_ @ _)%expr_pat _)) _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.Ident _ _ _ t1 idc1))
+ (@expr.App _ _ _ s3 _ (@expr.LetIn _ _ _ _ _ _ _) _)) _ => None
+ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.Ident _ _ _ t1 idc1)) #(_)%expr_pat) _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.Ident _ _ _ t1 idc1)) ($_)%expr) _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.Ident _ _ _ t1 idc1)) (@expr.Abs _ _ _ _ _ _)) _ | @expr.App
+ _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.Ident _ _ _ t1 idc1)) (@expr.LetIn _ _ _ _ _ _ _)) _ => None
+ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t1 idc1) x4))
+ (@expr.Ident _ _ _ t2 idc2)) (@expr.Ident _ _ _ t3 idc3) =>
+ args <- invert_bind_args idc3 Raw.ident.Literal;
+ args0 <- invert_bind_args idc2 Raw.ident.Literal;
+ args1 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args2 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc Raw.ident.Z_rshi;
+ match
+ pattern.type.unify_extracted_cps (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s3) -> (projT1 args0)) -> (projT1 args))%ptype
+ option (fun x5 : option => x5)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s3) -> (projT1 args0)) -> (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args2);
+ v <- type.try_make_transport_cps s3 ℤ;
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args0);
+ xv1 <- 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
+ (#(Z_cast range)%expr @
+ (#(fancy_rshi
+ (Z.log2 (let (x5, _) := xv in x5))
+ (let (x5, _) := xv1 in x5))%expr @
+ (#(Z_cast args1)%expr @
+ v (Compile.reflect x4),
+ (##(let (x5, _) := xv0 in x5))%expr)))%expr_pat
+ else None);
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.Ident _ _ _ t1 idc1))
+ (@expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t2 idc2) x4)) ($_)%expr |
+ @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.Ident _ _ _ t1 idc1))
+ (@expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t2 idc2) x4))
+ (@expr.Abs _ _ _ _ _ _) | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.Ident _ _ _ t1 idc1))
+ (@expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t2 idc2) x4))
+ (_ @ _)%expr_pat | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.Ident _ _ _ t1 idc1))
+ (@expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t2 idc2) x4))
+ (@expr.LetIn _ _ _ _ _ _ _) | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t1 idc1) x4))
+ (@expr.Ident _ _ _ t2 idc2)) ($_)%expr | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t1 idc1) x4))
+ (@expr.Ident _ _ _ t2 idc2)) (@expr.Abs _ _ _ _ _ _) | @expr.App _ _
+ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t1 idc1) x4))
+ (@expr.Ident _ _ _ t2 idc2)) (_ @ _)%expr_pat | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t1 idc1) x4))
+ (@expr.Ident _ _ _ t2 idc2)) (@expr.LetIn _ _ _ _ _ _ _) => None
+ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t1 idc1) x4))
+ (@expr.App _ _ _ s4 _ (@expr.Ident _ _ _ t2 idc2) x5))
+ (@expr.Ident _ _ _ t3 idc3) =>
+ args <- invert_bind_args idc3 Raw.ident.Literal;
+ args0 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args1 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args2 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc Raw.ident.Z_rshi;
+ match
+ pattern.type.unify_extracted_cps (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s3) -> s4) -> (projT1 args))%ptype option
+ (fun x6 : option => x6)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s3) -> s4) -> (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal ##(projT2 args2);
+ v <- type.try_make_transport_cps s3 ℤ;
+ v0 <- type.try_make_transport_cps s4 ℤ;
+ xv0 <- ident.unify pattern.ident.Literal ##(projT2 args);
+ fv <- (x6 <- (if
+ (let (x6, _) := xv in x6) =?
+ 2 ^ Z.log2 (let (x6, _) := xv in x6)
+ then
+ Some
+ (#(Z_cast range)%expr @
+ (#(fancy_rshi
+ (Z.log2 (let (x6, _) := xv in x6))
+ (let (x6, _) := xv0 in x6))%expr @
+ (#(Z_cast args1)%expr @
+ v (Compile.reflect x4),
+ #(Z_cast args0)%expr @
+ v0 (Compile.reflect x5))))%expr_pat
+ else None);
+ Some (Base x6));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t1 idc1) x4))
+ (@expr.App _ _ _ s4 _ (@expr.Ident _ _ _ t2 idc2) x5)) ($_)%expr |
+ @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t1 idc1) x4))
+ (@expr.App _ _ _ s4 _ (@expr.Ident _ _ _ t2 idc2) x5))
+ (@expr.Abs _ _ _ _ _ _) | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t1 idc1) x4))
+ (@expr.App _ _ _ s4 _ (@expr.Ident _ _ _ t2 idc2) x5))
+ (_ @ _)%expr_pat | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t1 idc1) x4))
+ (@expr.App _ _ _ s4 _ (@expr.Ident _ _ _ t2 idc2) x5))
+ (@expr.LetIn _ _ _ _ _ _ _) => None
+ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t1 idc1) x4))
+ (@expr.App _ _ _ s4 _ ($_)%expr _)) _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t1 idc1) x4))
+ (@expr.App _ _ _ s4 _ (@expr.Abs _ _ _ _ _ _) _)) _ | @expr.App _ _
+ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t1 idc1) x4))
+ (@expr.App _ _ _ s4 _ (_ @ _)%expr_pat _)) _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t1 idc1) x4))
+ (@expr.App _ _ _ s4 _ (@expr.LetIn _ _ _ _ _ _ _) _)) _ => None
+ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t1 idc1) x4)) ($_)%expr)
+ _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t1 idc1) x4))
+ (@expr.Abs _ _ _ _ _ _)) _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t1 idc1) x4))
+ (@expr.LetIn _ _ _ _ _ _ _)) _ => None
+ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.App _ _ _ s3 _ ($_)%expr _)) _) _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.App _ _ _ s3 _ (@expr.Abs _ _ _ _ _ _) _)) _) _ | @expr.App
+ _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.App _ _ _ s3 _ (_ @ _)%expr_pat _)) _) _ | @expr.App _ _ _ s
+ _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.App _ _ _ s3 _ (@expr.LetIn _ _ _ _ _ _ _) _)) _) _ => None
+ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ ($_)%expr) _) _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.Abs _ _ _ _ _ _)) _) _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Ident _ _ _ t0 idc0)%expr_pat
+ (@expr.LetIn _ _ _ _ _ _ _)) _) _ => None
+ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _ (@expr.Ident _ _ _ t idc @ ($_)%expr)%expr_pat
+ _) _) _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.Abs _ _ _ _ _ _)%expr_pat _) _)
+ _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _ (@expr.Ident _ _ _ t idc @ (_ @ _))%expr_pat
+ _) _) _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _
+ (@expr.Ident _ _ _ t idc @ @expr.LetIn _ _ _ _ _ _ _)%expr_pat _)
+ _) _ => None
+ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.App _ _ _ s1 _ ($_)%expr _) _) _ |
+ @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _) _) _) _ | @expr.App _
+ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _ (($_)%expr @ _)%expr_pat _) _) _ | @expr.App _
+ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _ (@expr.Abs _ _ _ _ _ _ @ _)%expr_pat _) _) _ |
+ @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.App _ _ _ s1 _ (_ @ _ @ _)%expr_pat _)
+ _) _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _ @ _)%expr_pat _) _)
+ _ | @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _
+ (@expr.App _ _ _ s1 _ (@expr.LetIn _ _ _ _ _ _ _) _) _) _ => None
+ | @expr.App _ _ _ s _ (@expr.App _ _ _ s0 _ ($_)%expr _) _ | @expr.App
+ _ _ _ s _ (@expr.App _ _ _ s0 _ (@expr.Abs _ _ _ _ _ _) _) _ |
+ @expr.App _ _ _ s _
+ (@expr.App _ _ _ s0 _ (@expr.LetIn _ _ _ _ _ _ _) _) _ => None
+ | @expr.App _ _ _ s _ #(_)%expr_pat _ | @expr.App _ _ _ s _ ($_)%expr
+ _ | @expr.App _ _ _ s _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s
+ _ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end;;
+ match
+ pattern.type.unify_extracted_cps ℤ ℤ option (fun x0 : option => x0)
+ with
+ | Some _ =>
+ if type.type_beq base.type base.type.type_beq ℤ ℤ
+ then
+ fv <- (x0 <- (if
+ (range <=? value_range)%zrange
+ || (range <=? flag_range)%zrange
+ then Some (#(Z_cast range)%expr @ x)%expr_pat
+ else None);
+ Some (Base x0));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end);;;
+ Base (#(Z_cast range)%expr @ x)%expr_pat)%option
| Z_cast2 range =>
- fun x : expr (ℤ * ℤ)%etype => Base (#(Z_cast2 range)%expr @ x)%expr_pat
+ fun x : expr (ℤ * ℤ)%etype =>
+ ((match x with
+ | (@expr.Ident _ _ _ t idc @ x2 @ x1 @ x0)%expr_pat =>
+ match x2 with
+ | @expr.Ident _ _ _ t0 idc0 =>
+ match x1 with
+ | @expr.Ident _ _ _ t1 idc1 =>
+ match x0 with
+ | @expr.App _ _ _ s2 _ (@expr.Ident _ _ _ t2 idc2) x3 =>
+ match x3 with
+ | (@expr.Ident _ _ _ t3 idc3 @ x5 @ x4)%expr_pat =>
+ match x5 with
+ | @expr.App _ _ _ s5 _ (@expr.Ident _ _ _ t4 idc4)
+ x6 =>
+ match x4 with
+ | @expr.Ident _ _ _ t5 idc5 =>
+ args <- invert_bind_args idc5
+ Raw.ident.Literal;
+ args0 <- invert_bind_args idc4
+ Raw.ident.Z_cast;
+ _ <- invert_bind_args idc3
+ Raw.ident.Z_shiftl;
+ args2 <- invert_bind_args idc2
+ Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc1
+ Raw.ident.Literal;
+ args4 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ (((projT1 args4) -> (projT1 args3)) ->
+ s5 -> (projT1 args))%ptype option
+ (fun x7 : option => x7)
+ with
+ | Some (_, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type
+ base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ (((projT1 args4) -> (projT1 args3)) ->
+ s5 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args4);
+ xv0 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args3);
+ v <- type.try_make_transport_cps s5
+ ℤ;
+ xv1 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x7 <- (let
+ '(r1, r2)%zrange :=
+ range in
+ fun (s6 xx : Z)
+ (rshiftl ry : zrange)
+ (y : expr ℤ)
+ (offset : Z) =>
+ if
+ (s6 =? 2 ^ Z.log2 s6) &&
+ (ZRange.normalize ry <<
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize
+ rshiftl)%zrange &&
+ (ZRange.normalize
+ rshiftl <=?
+ r[0 ~> s6 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_add
+ (Z.log2 s6)
+ offset)%expr @
+ ((##xx)%expr,
+ #(Z_cast ry)%expr @
+ y)))%expr_pat
+ else None)
+ (let (x7, _) := xv in
+ x7)
+ (let (x7, _) := xv0 in
+ x7) args2 args0
+ (v (Compile.reflect x6))
+ (let (x7, _) := xv1 in
+ x7);
+ Some (Base x7));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s5 _ ($_)%expr _ | @expr.App _ _
+ _ s5 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _
+ _ s5 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s5 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end;;
+ match x5 with
+ | @expr.App _ _ _ s5 _ (@expr.Ident _ _ _ t4 idc4)
+ x6 =>
+ match x4 with
+ | @expr.Ident _ _ _ t5 idc5 =>
+ args <- invert_bind_args idc5
+ Raw.ident.Literal;
+ args0 <- invert_bind_args idc4
+ Raw.ident.Z_cast;
+ _ <- invert_bind_args idc3
+ Raw.ident.Z_shiftr;
+ args2 <- invert_bind_args idc2
+ Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc1
+ Raw.ident.Literal;
+ args4 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ (((projT1 args4) -> (projT1 args3)) ->
+ s5 -> (projT1 args))%ptype option
+ (fun x7 : option => x7)
+ with
+ | Some (_, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type
+ base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ (((projT1 args4) -> (projT1 args3)) ->
+ s5 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args4);
+ xv0 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args3);
+ v <- type.try_make_transport_cps s5
+ ℤ;
+ xv1 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x7 <- (let
+ '(r1, r2)%zrange :=
+ range in
+ fun (s6 xx : Z)
+ (rshiftr ry : zrange)
+ (y : expr ℤ)
+ (offset : Z) =>
+ if
+ (s6 =? 2 ^ Z.log2 s6) &&
+ (ZRange.normalize ry >>
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize
+ rshiftr)%zrange &&
+ (ZRange.normalize
+ rshiftr <=?
+ r[0 ~> s6 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_add
+ (Z.log2 s6)
+ (- offset))%expr @
+ ((##xx)%expr,
+ #(Z_cast ry)%expr @
+ y)))%expr_pat
+ else None)
+ (let (x7, _) := xv in
+ x7)
+ (let (x7, _) := xv0 in
+ x7) args2 args0
+ (v (Compile.reflect x6))
+ (let (x7, _) := xv1 in
+ x7);
+ Some (Base x7));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s5 _ ($_)%expr _ | @expr.App _ _
+ _ s5 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _
+ _ s5 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s5 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | _ => None
+ end;;
+ args <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args0 <- invert_bind_args idc1 Raw.ident.Literal;
+ args1 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc Raw.ident.Z_add_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ)%ptype
+ (((projT1 args1) -> (projT1 args0)) -> s2)%ptype
+ option (fun x4 : option => x4)
+ with
+ | Some (_, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ)%ptype
+ (((projT1 args1) -> (projT1 args0)) -> s2)%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ v <- type.try_make_transport_cps s2 ℤ;
+ fv <- (x4 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s3 xx : Z) (ry : zrange)
+ (y : expr ℤ) =>
+ if
+ (s3 =? 2 ^ Z.log2 s3) &&
+ (ZRange.normalize ry <=?
+ r[0 ~> s3 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_add (Z.log2 s3) 0)%expr @
+ ((##xx)%expr,
+ #(Z_cast ry)%expr @ y)))%expr_pat
+ else None)
+ (let (x4, _) := xv in x4)
+ (let (x4, _) := xv0 in x4) args
+ (v (Compile.reflect x3));
+ Some (Base x4));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s2 _ ($_)%expr _ | @expr.App _ _ _ s2 _
+ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s2 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s2 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s2 _ (@expr.Ident _ _ _ t1 idc1) x3 =>
+ match x0 with
+ | @expr.Ident _ _ _ t2 idc2 =>
+ match x3 with
+ | (@expr.Ident _ _ _ t3 idc3 @ x5 @ x4)%expr_pat =>
+ match x5 with
+ | @expr.App _ _ _ s5 _ (@expr.Ident _ _ _ t4 idc4)
+ x6 =>
+ match x4 with
+ | @expr.Ident _ _ _ t5 idc5 =>
+ args <- invert_bind_args idc5
+ Raw.ident.Literal;
+ args0 <- invert_bind_args idc4
+ Raw.ident.Z_cast;
+ _ <- invert_bind_args idc3
+ Raw.ident.Z_shiftl;
+ args2 <- invert_bind_args idc2
+ Raw.ident.Literal;
+ args3 <- invert_bind_args idc1
+ Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ -> ℤ) -> ℤ)%ptype
+ (((projT1 args4) -> s5 -> (projT1 args)) ->
+ (projT1 args2))%ptype option
+ (fun x7 : option => x7)
+ with
+ | Some (_, (_, _), _)%zrange =>
+ if
+ type.type_beq base.type
+ base.type.type_beq
+ ((ℤ -> ℤ -> ℤ) -> ℤ)%ptype
+ (((projT1 args4) ->
+ s5 -> (projT1 args)) ->
+ (projT1 args2))%ptype
+ then
+ xv <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args4);
+ v <- type.try_make_transport_cps s5
+ ℤ;
+ xv0 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args);
+ xv1 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args2);
+ fv <- (x7 <- (let
+ '(r1, r2)%zrange :=
+ range in
+ fun (s6 : Z)
+ (rshiftl ry : zrange)
+ (y : expr ℤ)
+ (offset xx : Z) =>
+ if
+ (s6 =? 2 ^ Z.log2 s6) &&
+ (ZRange.normalize ry <<
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize
+ rshiftl)%zrange &&
+ (ZRange.normalize
+ rshiftl <=?
+ r[0 ~> s6 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_add
+ (Z.log2 s6)
+ offset)%expr @
+ ((##xx)%expr,
+ #(Z_cast ry)%expr @
+ y)))%expr_pat
+ else None)
+ (let (x7, _) := xv in
+ x7) args3 args0
+ (v (Compile.reflect x6))
+ (let (x7, _) := xv0 in
+ x7)
+ (let (x7, _) := xv1 in
+ x7);
+ Some (Base x7));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s5 _ ($_)%expr _ | @expr.App _ _
+ _ s5 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _
+ _ s5 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s5 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end;;
+ match x5 with
+ | @expr.App _ _ _ s5 _ (@expr.Ident _ _ _ t4 idc4)
+ x6 =>
+ match x4 with
+ | @expr.Ident _ _ _ t5 idc5 =>
+ args <- invert_bind_args idc5
+ Raw.ident.Literal;
+ args0 <- invert_bind_args idc4
+ Raw.ident.Z_cast;
+ _ <- invert_bind_args idc3
+ Raw.ident.Z_shiftr;
+ args2 <- invert_bind_args idc2
+ Raw.ident.Literal;
+ args3 <- invert_bind_args idc1
+ Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ -> ℤ) -> ℤ)%ptype
+ (((projT1 args4) -> s5 -> (projT1 args)) ->
+ (projT1 args2))%ptype option
+ (fun x7 : option => x7)
+ with
+ | Some (_, (_, _), _)%zrange =>
+ if
+ type.type_beq base.type
+ base.type.type_beq
+ ((ℤ -> ℤ -> ℤ) -> ℤ)%ptype
+ (((projT1 args4) ->
+ s5 -> (projT1 args)) ->
+ (projT1 args2))%ptype
+ then
+ xv <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args4);
+ v <- type.try_make_transport_cps s5
+ ℤ;
+ xv0 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args);
+ xv1 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args2);
+ fv <- (x7 <- (let
+ '(r1, r2)%zrange :=
+ range in
+ fun (s6 : Z)
+ (rshiftr ry : zrange)
+ (y : expr ℤ)
+ (offset xx : Z) =>
+ if
+ (s6 =? 2 ^ Z.log2 s6) &&
+ (ZRange.normalize ry >>
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize
+ rshiftr)%zrange &&
+ (ZRange.normalize
+ rshiftr <=?
+ r[0 ~> s6 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_add
+ (Z.log2 s6)
+ (- offset))%expr @
+ ((##xx)%expr,
+ #(Z_cast ry)%expr @
+ y)))%expr_pat
+ else None)
+ (let (x7, _) := xv in
+ x7) args3 args0
+ (v (Compile.reflect x6))
+ (let (x7, _) := xv0 in
+ x7)
+ (let (x7, _) := xv1 in
+ x7);
+ Some (Base x7));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s5 _ ($_)%expr _ | @expr.App _ _
+ _ s5 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _
+ _ s5 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s5 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | _ => None
+ end;;
+ args <- invert_bind_args idc2 Raw.ident.Literal;
+ args0 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args1 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc Raw.ident.Z_add_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ)%ptype
+ (((projT1 args1) -> s2) -> (projT1 args))%ptype
+ option (fun x4 : option => x4)
+ with
+ | Some (_, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ)%ptype
+ (((projT1 args1) -> s2) -> (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ v <- type.try_make_transport_cps s2 ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x4 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s3 : Z) (rx : zrange)
+ (x4 : expr ℤ) (yy : Z) =>
+ if
+ (s3 =? 2 ^ Z.log2 s3) &&
+ (ZRange.normalize
+ (ZRange.constant yy) <=?
+ r[0 ~> s3 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_add (Z.log2 s3) 0)%expr @
+ (#(Z_cast rx)%expr @ x4,
+ (##yy)%expr)))%expr_pat
+ else None)
+ (let (x4, _) := xv in x4) args0
+ (v (Compile.reflect x3))
+ (let (x4, _) := xv0 in x4);
+ Some (Base x4));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t2 idc2) x4 =>
+ match x4 with
+ | (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t4 idc4) x7 @ @expr.Ident _ _ _
+ t5 idc5)%expr_pat =>
+ args <- invert_bind_args idc5 Raw.ident.Literal;
+ args0 <- invert_bind_args idc4 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc3 Raw.ident.Z_shiftl;
+ args2 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc Raw.ident.Z_add_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ (((projT1 args4) -> s2) -> s6 -> (projT1 args))%ptype
+ option (fun x8 : option => x8)
+ with
+ | Some (_, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ (((projT1 args4) -> s2) ->
+ s6 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args4);
+ v <- type.try_make_transport_cps s2 ℤ;
+ v0 <- type.try_make_transport_cps s6 ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x8 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s7 : Z) (rx : zrange)
+ (x8 : expr ℤ)
+ (rshiftl ry : zrange)
+ (y : expr ℤ) (offset : Z) =>
+ if
+ (s7 =? 2 ^ Z.log2 s7) &&
+ (ZRange.normalize ry <<
+ ZRange.normalize
+ (ZRange.constant offset) <=?
+ ZRange.normalize rshiftl)%zrange &&
+ (ZRange.normalize rshiftl <=?
+ r[0 ~> s7 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_add (Z.log2 s7)
+ offset)%expr @
+ (#(Z_cast rx)%expr @ x8,
+ #(Z_cast ry)%expr @ y)))%expr_pat
+ else None)
+ (let (x8, _) := xv in x8) args3
+ (v (Compile.reflect x3)) args2
+ args0 (v0 (Compile.reflect x7))
+ (let (x8, _) := xv0 in x8);
+ Some (Base x8));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t4 idc4) x7 @ ($_)%expr)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t4 idc4) x7 @ @expr.Abs _ _ _ _ _
+ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t4 idc4) x7 @ (_ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t4 idc4) x7 @ @expr.LetIn _ _ _ _
+ _ _ _)%expr_pat => None
+ | (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ ($_)%expr _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (_ @ _) _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => None
+ | (@expr.Ident _ _ _ t3 idc3 @ #(_) @ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ ($_)%expr @ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.Abs _ _ _ _ _ _ @
+ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.LetIn _ _ _ _ _ _
+ _ @ _)%expr_pat => None
+ | _ => None
+ end;;
+ match x3 with
+ | (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t4 idc4) x7 @ @expr.Ident _ _ _
+ t5 idc5)%expr_pat =>
+ args <- invert_bind_args idc5 Raw.ident.Literal;
+ args0 <- invert_bind_args idc4 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc3 Raw.ident.Z_shiftl;
+ args2 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc Raw.ident.Z_add_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ -> ℤ) -> ℤ)%ptype
+ (((projT1 args4) -> s6 -> (projT1 args)) -> s3)%ptype
+ option (fun x8 : option => x8)
+ with
+ | Some (_, (_, _), _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ -> ℤ) -> ℤ)%ptype
+ (((projT1 args4) -> s6 -> (projT1 args)) ->
+ s3)%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args4);
+ v <- type.try_make_transport_cps s6 ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ v0 <- type.try_make_transport_cps s3 ℤ;
+ fv <- (x8 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s7 : Z)
+ (rshiftl ry : zrange)
+ (y : expr ℤ) (offset : Z)
+ (rx : zrange) (x8 : expr ℤ)
+ =>
+ if
+ (s7 =? 2 ^ Z.log2 s7) &&
+ (ZRange.normalize ry <<
+ ZRange.normalize
+ (ZRange.constant offset) <=?
+ ZRange.normalize rshiftl)%zrange &&
+ (ZRange.normalize rshiftl <=?
+ r[0 ~> s7 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_add (Z.log2 s7)
+ offset)%expr @
+ (#(Z_cast rx)%expr @ x8,
+ #(Z_cast ry)%expr @ y)))%expr_pat
+ else None)
+ (let (x8, _) := xv in x8) args3
+ args0 (v (Compile.reflect x7))
+ (let (x8, _) := xv0 in x8)
+ args2 (v0 (Compile.reflect x4));
+ Some (Base x8));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t4 idc4) x7 @ ($_)%expr)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t4 idc4) x7 @ @expr.Abs _ _ _ _ _
+ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t4 idc4) x7 @ (_ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t4 idc4) x7 @ @expr.LetIn _ _ _ _
+ _ _ _)%expr_pat => None
+ | (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ ($_)%expr _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (_ @ _) _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => None
+ | (@expr.Ident _ _ _ t3 idc3 @ #(_) @ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ ($_)%expr @ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.Abs _ _ _ _ _ _ @
+ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.LetIn _ _ _ _ _ _
+ _ @ _)%expr_pat => None
+ | _ => None
+ end;;
+ match x4 with
+ | (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t4 idc4) x7 @ @expr.Ident _ _ _
+ t5 idc5)%expr_pat =>
+ args <- invert_bind_args idc5 Raw.ident.Literal;
+ args0 <- invert_bind_args idc4 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc3 Raw.ident.Z_shiftr;
+ args2 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc Raw.ident.Z_add_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ (((projT1 args4) -> s2) -> s6 -> (projT1 args))%ptype
+ option (fun x8 : option => x8)
+ with
+ | Some (_, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ (((projT1 args4) -> s2) ->
+ s6 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args4);
+ v <- type.try_make_transport_cps s2 ℤ;
+ v0 <- type.try_make_transport_cps s6 ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x8 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s7 : Z) (rx : zrange)
+ (x8 : expr ℤ)
+ (rshiftr ry : zrange)
+ (y : expr ℤ) (offset : Z) =>
+ if
+ (s7 =? 2 ^ Z.log2 s7) &&
+ (ZRange.normalize ry >>
+ ZRange.normalize
+ (ZRange.constant offset) <=?
+ ZRange.normalize rshiftr)%zrange &&
+ (ZRange.normalize rshiftr <=?
+ r[0 ~> s7 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_add (Z.log2 s7)
+ (- offset))%expr @
+ (#(Z_cast rx)%expr @ x8,
+ #(Z_cast ry)%expr @ y)))%expr_pat
+ else None)
+ (let (x8, _) := xv in x8) args3
+ (v (Compile.reflect x3)) args2
+ args0 (v0 (Compile.reflect x7))
+ (let (x8, _) := xv0 in x8);
+ Some (Base x8));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t4 idc4) x7 @ ($_)%expr)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t4 idc4) x7 @ @expr.Abs _ _ _ _ _
+ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t4 idc4) x7 @ (_ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t4 idc4) x7 @ @expr.LetIn _ _ _ _
+ _ _ _)%expr_pat => None
+ | (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ ($_)%expr _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (_ @ _) _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => None
+ | (@expr.Ident _ _ _ t3 idc3 @ #(_) @ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ ($_)%expr @ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.Abs _ _ _ _ _ _ @
+ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.LetIn _ _ _ _ _ _
+ _ @ _)%expr_pat => None
+ | _ => None
+ end;;
+ match x3 with
+ | (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t4 idc4) x7 @ @expr.Ident _ _ _
+ t5 idc5)%expr_pat =>
+ args <- invert_bind_args idc5 Raw.ident.Literal;
+ args0 <- invert_bind_args idc4 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc3 Raw.ident.Z_shiftr;
+ args2 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc Raw.ident.Z_add_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ -> ℤ) -> ℤ)%ptype
+ (((projT1 args4) -> s6 -> (projT1 args)) -> s3)%ptype
+ option (fun x8 : option => x8)
+ with
+ | Some (_, (_, _), _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ -> ℤ) -> ℤ)%ptype
+ (((projT1 args4) -> s6 -> (projT1 args)) ->
+ s3)%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args4);
+ v <- type.try_make_transport_cps s6 ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ v0 <- type.try_make_transport_cps s3 ℤ;
+ fv <- (x8 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s7 : Z)
+ (rshiftr ry : zrange)
+ (y : expr ℤ) (offset : Z)
+ (rx : zrange) (x8 : expr ℤ)
+ =>
+ if
+ (s7 =? 2 ^ Z.log2 s7) &&
+ (ZRange.normalize ry >>
+ ZRange.normalize
+ (ZRange.constant offset) <=?
+ ZRange.normalize rshiftr)%zrange &&
+ (ZRange.normalize rshiftr <=?
+ r[0 ~> s7 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_add (Z.log2 s7)
+ (- offset))%expr @
+ (#(Z_cast rx)%expr @ x8,
+ #(Z_cast ry)%expr @ y)))%expr_pat
+ else None)
+ (let (x8, _) := xv in x8) args3
+ args0 (v (Compile.reflect x7))
+ (let (x8, _) := xv0 in x8)
+ args2 (v0 (Compile.reflect x4));
+ Some (Base x8));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t4 idc4) x7 @ ($_)%expr)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t4 idc4) x7 @ @expr.Abs _ _ _ _ _
+ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t4 idc4) x7 @ (_ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t4 idc4) x7 @ @expr.LetIn _ _ _ _
+ _ _ _)%expr_pat => None
+ | (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ ($_)%expr _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (_ @ _) _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.App _ _ _ s6 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat => None
+ | (@expr.Ident _ _ _ t3 idc3 @ #(_) @ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ ($_)%expr @ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.Abs _ _ _ _ _ _ @
+ _)%expr_pat |
+ (@expr.Ident _ _ _ t3 idc3 @ @expr.LetIn _ _ _ _ _ _
+ _ @ _)%expr_pat => None
+ | _ => None
+ end;;
+ args <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args0 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args1 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc Raw.ident.Z_add_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ)%ptype
+ (((projT1 args1) -> s2) -> s3)%ptype option
+ (fun x5 : option => x5)
+ with
+ | Some (_, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ)%ptype
+ (((projT1 args1) -> s2) -> s3)%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ v <- type.try_make_transport_cps s2 ℤ;
+ v0 <- type.try_make_transport_cps s3 ℤ;
+ fv <- (x5 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s4 : Z) (rx : zrange)
+ (x5 : expr ℤ) (ry : zrange)
+ (y : expr ℤ) =>
+ if
+ (s4 =? 2 ^ Z.log2 s4) &&
+ (ZRange.normalize ry <=?
+ r[0 ~> s4 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_add (Z.log2 s4) 0)%expr @
+ (#(Z_cast rx)%expr @ x5,
+ #(Z_cast ry)%expr @ y)))%expr_pat
+ else None)
+ (let (x5, _) := xv in x5) args0
+ (v (Compile.reflect x3)) args
+ (v0 (Compile.reflect x4));
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s3 _ ($_)%expr _ | @expr.App _ _ _ s3 _
+ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s3 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s3 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s2 _ ($_)%expr _ | @expr.App _ _ _ s2 _
+ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s2 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s2 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | _ => None
+ end;;
+ match x2 with
+ | @expr.Ident _ _ _ t0 idc0 =>
+ match x1 with
+ | @expr.Ident _ _ _ t1 idc1 =>
+ match x0 with
+ | @expr.App _ _ _ s2 _ (@expr.Ident _ _ _ t2 idc2) x3 =>
+ match x3 with
+ | (@expr.Ident _ _ _ t3 idc3 @ x5 @ x4)%expr_pat =>
+ match x5 with
+ | @expr.App _ _ _ s5 _ (@expr.Ident _ _ _ t4 idc4)
+ x6 =>
+ match x4 with
+ | @expr.Ident _ _ _ t5 idc5 =>
+ args <- invert_bind_args idc5
+ Raw.ident.Literal;
+ args0 <- invert_bind_args idc4
+ Raw.ident.Z_cast;
+ _ <- invert_bind_args idc3
+ Raw.ident.Z_shiftl;
+ args2 <- invert_bind_args idc2
+ Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc1
+ Raw.ident.Literal;
+ args4 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_sub_get_borrow;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ (((projT1 args4) -> (projT1 args3)) ->
+ s5 -> (projT1 args))%ptype option
+ (fun x7 : option => x7)
+ with
+ | Some (_, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type
+ base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ (((projT1 args4) -> (projT1 args3)) ->
+ s5 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args4);
+ xv0 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args3);
+ v <- type.try_make_transport_cps s5
+ ℤ;
+ xv1 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x7 <- (let
+ '(r1, r2)%zrange :=
+ range in
+ fun (s6 xx : Z)
+ (rshiftl ry : zrange)
+ (y : expr ℤ)
+ (offset : Z) =>
+ if
+ (s6 =? 2 ^ Z.log2 s6) &&
+ (ZRange.normalize ry <<
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize
+ rshiftl)%zrange &&
+ (ZRange.normalize
+ rshiftl <=?
+ r[0 ~> s6 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_sub
+ (Z.log2 s6)
+ offset)%expr @
+ ((##xx)%expr,
+ #(Z_cast ry)%expr @
+ y)))%expr_pat
+ else None)
+ (let (x7, _) := xv in
+ x7)
+ (let (x7, _) := xv0 in
+ x7) args2 args0
+ (v (Compile.reflect x6))
+ (let (x7, _) := xv1 in
+ x7);
+ Some (Base x7));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s5 _ ($_)%expr _ | @expr.App _ _
+ _ s5 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _
+ _ s5 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s5 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end;;
+ match x5 with
+ | @expr.App _ _ _ s5 _ (@expr.Ident _ _ _ t4 idc4)
+ x6 =>
+ match x4 with
+ | @expr.Ident _ _ _ t5 idc5 =>
+ args <- invert_bind_args idc5
+ Raw.ident.Literal;
+ args0 <- invert_bind_args idc4
+ Raw.ident.Z_cast;
+ _ <- invert_bind_args idc3
+ Raw.ident.Z_shiftr;
+ args2 <- invert_bind_args idc2
+ Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc1
+ Raw.ident.Literal;
+ args4 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_sub_get_borrow;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ (((projT1 args4) -> (projT1 args3)) ->
+ s5 -> (projT1 args))%ptype option
+ (fun x7 : option => x7)
+ with
+ | Some (_, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type
+ base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ (((projT1 args4) -> (projT1 args3)) ->
+ s5 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args4);
+ xv0 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args3);
+ v <- type.try_make_transport_cps s5
+ ℤ;
+ xv1 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x7 <- (let
+ '(r1, r2)%zrange :=
+ range in
+ fun (s6 xx : Z)
+ (rshiftr ry : zrange)
+ (y : expr ℤ)
+ (offset : Z) =>
+ if
+ (s6 =? 2 ^ Z.log2 s6) &&
+ (ZRange.normalize ry >>
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize
+ rshiftr)%zrange &&
+ (ZRange.normalize
+ rshiftr <=?
+ r[0 ~> s6 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_sub
+ (Z.log2 s6)
+ (- offset))%expr @
+ ((##xx)%expr,
+ #(Z_cast ry)%expr @
+ y)))%expr_pat
+ else None)
+ (let (x7, _) := xv in
+ x7)
+ (let (x7, _) := xv0 in
+ x7) args2 args0
+ (v (Compile.reflect x6))
+ (let (x7, _) := xv1 in
+ x7);
+ Some (Base x7));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s5 _ ($_)%expr _ | @expr.App _ _
+ _ s5 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _
+ _ s5 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s5 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | _ => None
+ end;;
+ args <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args0 <- invert_bind_args idc1 Raw.ident.Literal;
+ args1 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc Raw.ident.Z_sub_get_borrow;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ)%ptype
+ (((projT1 args1) -> (projT1 args0)) -> s2)%ptype
+ option (fun x4 : option => x4)
+ with
+ | Some (_, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ)%ptype
+ (((projT1 args1) -> (projT1 args0)) -> s2)%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ v <- type.try_make_transport_cps s2 ℤ;
+ fv <- (x4 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s3 xx : Z) (ry : zrange)
+ (y : expr ℤ) =>
+ if
+ (s3 =? 2 ^ Z.log2 s3) &&
+ (ZRange.normalize ry <=?
+ r[0 ~> s3 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_sub (Z.log2 s3) 0)%expr @
+ ((##xx)%expr,
+ #(Z_cast ry)%expr @ y)))%expr_pat
+ else None)
+ (let (x4, _) := xv in x4)
+ (let (x4, _) := xv0 in x4) args
+ (v (Compile.reflect x3));
+ Some (Base x4));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s2 _ ($_)%expr _ | @expr.App _ _ _ s2 _
+ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s2 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s2 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s2 _ (@expr.Ident _ _ _ t1 idc1) x3 =>
+ match x0 with
+ | @expr.Ident _ _ _ t2 idc2 =>
+ args <- invert_bind_args idc2 Raw.ident.Literal;
+ args0 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args1 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc Raw.ident.Z_sub_get_borrow;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ)%ptype
+ (((projT1 args1) -> s2) -> (projT1 args))%ptype
+ option (fun x4 : option => x4)
+ with
+ | Some (_, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ)%ptype
+ (((projT1 args1) -> s2) -> (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ v <- type.try_make_transport_cps s2 ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x4 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s3 : Z) (rx : zrange)
+ (x4 : expr ℤ) (yy : Z) =>
+ if
+ (s3 =? 2 ^ Z.log2 s3) &&
+ (ZRange.normalize
+ (ZRange.constant yy) <=?
+ r[0 ~> s3 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_sub (Z.log2 s3) 0)%expr @
+ (#(Z_cast rx)%expr @ x4,
+ (##yy)%expr)))%expr_pat
+ else None)
+ (let (x4, _) := xv in x4) args0
+ (v (Compile.reflect x3))
+ (let (x4, _) := xv0 in x4);
+ Some (Base x4));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t2 idc2) x4 =>
+ match x4 with
+ | (@expr.Ident _ _ _ t3 idc3 @ x6 @ x5)%expr_pat =>
+ match x6 with
+ | @expr.App _ _ _ s6 _ (@expr.Ident _ _ _ t4 idc4)
+ x7 =>
+ match x5 with
+ | @expr.Ident _ _ _ t5 idc5 =>
+ args <- invert_bind_args idc5
+ Raw.ident.Literal;
+ args0 <- invert_bind_args idc4
+ Raw.ident.Z_cast;
+ _ <- invert_bind_args idc3
+ Raw.ident.Z_shiftl;
+ args2 <- invert_bind_args idc2
+ Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc1
+ Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_sub_get_borrow;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ (((projT1 args4) -> s2) ->
+ s6 -> (projT1 args))%ptype option
+ (fun x8 : option => x8)
+ with
+ | Some (_, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type
+ base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ (((projT1 args4) -> s2) ->
+ s6 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args4);
+ v <- type.try_make_transport_cps s2
+ ℤ;
+ v0 <- type.try_make_transport_cps s6
+ ℤ;
+ xv0 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x8 <- (let
+ '(r1, r2)%zrange :=
+ range in
+ fun (s7 : Z)
+ (rx : zrange)
+ (x8 : expr ℤ)
+ (rshiftl ry : zrange)
+ (y : expr ℤ)
+ (offset : Z) =>
+ if
+ (s7 =? 2 ^ Z.log2 s7) &&
+ (ZRange.normalize ry <<
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize
+ rshiftl)%zrange &&
+ (ZRange.normalize
+ rshiftl <=?
+ r[0 ~> s7 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_sub
+ (Z.log2 s7)
+ offset)%expr @
+ (#(Z_cast rx)%expr @
+ x8,
+ #(Z_cast ry)%expr @
+ y)))%expr_pat
+ else None)
+ (let (x8, _) := xv in
+ x8) args3
+ (v (Compile.reflect x3))
+ args2 args0
+ (v0
+ (Compile.reflect x7))
+ (let (x8, _) := xv0 in
+ x8);
+ Some (Base x8));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s6 _ ($_)%expr _ | @expr.App _ _
+ _ s6 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _
+ _ s6 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s6 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end;;
+ match x6 with
+ | @expr.App _ _ _ s6 _ (@expr.Ident _ _ _ t4 idc4)
+ x7 =>
+ match x5 with
+ | @expr.Ident _ _ _ t5 idc5 =>
+ args <- invert_bind_args idc5
+ Raw.ident.Literal;
+ args0 <- invert_bind_args idc4
+ Raw.ident.Z_cast;
+ _ <- invert_bind_args idc3
+ Raw.ident.Z_shiftr;
+ args2 <- invert_bind_args idc2
+ Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc1
+ Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_sub_get_borrow;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ (((projT1 args4) -> s2) ->
+ s6 -> (projT1 args))%ptype option
+ (fun x8 : option => x8)
+ with
+ | Some (_, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type
+ base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ -> ℤ)%ptype
+ (((projT1 args4) -> s2) ->
+ s6 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args4);
+ v <- type.try_make_transport_cps s2
+ ℤ;
+ v0 <- type.try_make_transport_cps s6
+ ℤ;
+ xv0 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x8 <- (let
+ '(r1, r2)%zrange :=
+ range in
+ fun (s7 : Z)
+ (rx : zrange)
+ (x8 : expr ℤ)
+ (rshiftr ry : zrange)
+ (y : expr ℤ)
+ (offset : Z) =>
+ if
+ (s7 =? 2 ^ Z.log2 s7) &&
+ (ZRange.normalize ry >>
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize
+ rshiftr)%zrange &&
+ (ZRange.normalize
+ rshiftr <=?
+ r[0 ~> s7 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_sub
+ (Z.log2 s7)
+ (- offset))%expr @
+ (#(Z_cast rx)%expr @
+ x8,
+ #(Z_cast ry)%expr @
+ y)))%expr_pat
+ else None)
+ (let (x8, _) := xv in
+ x8) args3
+ (v (Compile.reflect x3))
+ args2 args0
+ (v0
+ (Compile.reflect x7))
+ (let (x8, _) := xv0 in
+ x8);
+ Some (Base x8));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s6 _ ($_)%expr _ | @expr.App _ _
+ _ s6 _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _
+ _ s6 _ (_ @ _)%expr_pat _ | @expr.App _ _ _ s6 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | _ => None
+ end;;
+ args <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args0 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args1 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc Raw.ident.Z_sub_get_borrow;
+ match
+ pattern.type.unify_extracted_cps
+ ((ℤ -> ℤ) -> ℤ)%ptype
+ (((projT1 args1) -> s2) -> s3)%ptype option
+ (fun x5 : option => x5)
+ with
+ | Some (_, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ ((ℤ -> ℤ) -> ℤ)%ptype
+ (((projT1 args1) -> s2) -> s3)%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ v <- type.try_make_transport_cps s2 ℤ;
+ v0 <- type.try_make_transport_cps s3 ℤ;
+ fv <- (x5 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s4 : Z) (rx : zrange)
+ (x5 : expr ℤ) (ry : zrange)
+ (y : expr ℤ) =>
+ if
+ (s4 =? 2 ^ Z.log2 s4) &&
+ (ZRange.normalize ry <=?
+ r[0 ~> s4 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_sub (Z.log2 s4) 0)%expr @
+ (#(Z_cast rx)%expr @ x5,
+ #(Z_cast ry)%expr @ y)))%expr_pat
+ else None)
+ (let (x5, _) := xv in x5) args0
+ (v (Compile.reflect x3)) args
+ (v0 (Compile.reflect x4));
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s3 _ ($_)%expr _ | @expr.App _ _ _ s3 _
+ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s3 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s3 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s2 _ ($_)%expr _ | @expr.App _ _ _ s2 _
+ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s2 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s2 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | _ => None
+ end
+ | (@expr.Ident _ _ _ t idc @ x3 @ x2 @ x1 @ x0)%expr_pat =>
+ match x3 with
+ | @expr.Ident _ _ _ t0 idc0 =>
+ match x2 with
+ | @expr.Ident _ _ _ t1 idc1 =>
+ match x1 with
+ | @expr.Ident _ _ _ t2 idc2 =>
+ match x0 with
+ | @expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t3 idc3)
+ x4 =>
+ match x4 with
+ | (@expr.Ident _ _ _ t4 idc4 @ x6 @ x5)%expr_pat =>
+ match x6 with
+ | @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t5 idc5) x7 =>
+ match x5 with
+ | @expr.Ident _ _ _ t6 idc6 =>
+ args <- invert_bind_args idc6
+ Raw.ident.Literal;
+ args0 <- invert_bind_args idc5
+ Raw.ident.Z_cast;
+ _ <- invert_bind_args idc4
+ Raw.ident.Z_shiftl;
+ args2 <- invert_bind_args idc3
+ Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc2
+ Raw.ident.Literal;
+ args4 <- invert_bind_args idc1
+ Raw.ident.Literal;
+ args5 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_with_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> (projT1 args4)) ->
+ (projT1 args3)) ->
+ s6 -> (projT1 args))%ptype option
+ (fun x8 : option => x8)
+ with
+ | Some (_, _, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type
+ base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) ->
+ (projT1 args4)) ->
+ (projT1 args3)) ->
+ s6 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args5);
+ xv0 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args4);
+ xv1 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args3);
+ v <- type.try_make_transport_cps s6
+ ℤ;
+ xv2 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x8 <- (let
+ '(r1, r2)%zrange :=
+ range in
+ fun (s7 cc xx : Z)
+ (rshiftl
+ ry : zrange)
+ (y : expr ℤ)
+ (offset : Z) =>
+ if
+ (s7 =?
+ 2 ^ Z.log2 s7) &&
+ (ZRange.normalize
+ ry <<
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize
+ rshiftl)%zrange &&
+ (ZRange.normalize
+ rshiftl <=?
+ r[0 ~> s7 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2
+ (r1, r2))%expr @
+ (#(fancy_addc
+ (Z.log2 s7)
+ offset)%expr @
+ ((##cc)%expr,
+ (##xx)%expr,
+ #(Z_cast ry)%expr @
+ y)))%expr_pat
+ else None)
+ (let (x8, _) :=
+ xv in
+ x8)
+ (let (x8, _) :=
+ xv0 in
+ x8)
+ (let (x8, _) :=
+ xv1 in
+ x8) args2 args0
+ (v
+ (Compile.reflect
+ x7))
+ (let (x8, _) :=
+ xv2 in
+ x8);
+ Some (Base x8));
+ Some
+ (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s6 _ ($_)%expr _ | @expr.App
+ _ _ _ s6 _ (@expr.Abs _ _ _ _ _ _) _ |
+ @expr.App _ _ _ s6 _ (_ @ _)%expr_pat _ |
+ @expr.App _ _ _ s6 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end;;
+ match x6 with
+ | @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t5 idc5) x7 =>
+ match x5 with
+ | @expr.Ident _ _ _ t6 idc6 =>
+ args <- invert_bind_args idc6
+ Raw.ident.Literal;
+ args0 <- invert_bind_args idc5
+ Raw.ident.Z_cast;
+ _ <- invert_bind_args idc4
+ Raw.ident.Z_shiftr;
+ args2 <- invert_bind_args idc3
+ Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc2
+ Raw.ident.Literal;
+ args4 <- invert_bind_args idc1
+ Raw.ident.Literal;
+ args5 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_with_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> (projT1 args4)) ->
+ (projT1 args3)) ->
+ s6 -> (projT1 args))%ptype option
+ (fun x8 : option => x8)
+ with
+ | Some (_, _, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type
+ base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) ->
+ (projT1 args4)) ->
+ (projT1 args3)) ->
+ s6 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args5);
+ xv0 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args4);
+ xv1 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args3);
+ v <- type.try_make_transport_cps s6
+ ℤ;
+ xv2 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x8 <- (let
+ '(r1, r2)%zrange :=
+ range in
+ fun (s7 cc xx : Z)
+ (rshiftr
+ ry : zrange)
+ (y : expr ℤ)
+ (offset : Z) =>
+ if
+ (s7 =?
+ 2 ^ Z.log2 s7) &&
+ (ZRange.normalize
+ ry >>
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize
+ rshiftr)%zrange &&
+ (ZRange.normalize
+ rshiftr <=?
+ r[0 ~> s7 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2
+ (r1, r2))%expr @
+ (#(fancy_addc
+ (Z.log2 s7)
+ (- offset))%expr @
+ ((##cc)%expr,
+ (##xx)%expr,
+ #(Z_cast ry)%expr @
+ y)))%expr_pat
+ else None)
+ (let (x8, _) :=
+ xv in
+ x8)
+ (let (x8, _) :=
+ xv0 in
+ x8)
+ (let (x8, _) :=
+ xv1 in
+ x8) args2 args0
+ (v
+ (Compile.reflect
+ x7))
+ (let (x8, _) :=
+ xv2 in
+ x8);
+ Some (Base x8));
+ Some
+ (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s6 _ ($_)%expr _ | @expr.App
+ _ _ _ s6 _ (@expr.Abs _ _ _ _ _ _) _ |
+ @expr.App _ _ _ s6 _ (_ @ _)%expr_pat _ |
+ @expr.App _ _ _ s6 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | _ => None
+ end;;
+ args <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args0 <- invert_bind_args idc2 Raw.ident.Literal;
+ args1 <- invert_bind_args idc1 Raw.ident.Literal;
+ args2 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_with_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> (projT1 args1)) ->
+ (projT1 args0)) -> s3)%ptype option
+ (fun x5 : option => x5)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> (projT1 args1)) ->
+ (projT1 args0)) -> s3)%ptype
+ then
+ 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 s3 ℤ;
+ fv <- (x5 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s4 cc xx : Z)
+ (ry : zrange) (y : expr ℤ) =>
+ if
+ (s4 =? 2 ^ Z.log2 s4) &&
+ (ZRange.normalize ry <=?
+ r[0 ~> s4 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_addc (Z.log2 s4) 0)%expr @
+ ((##cc)%expr, (##xx)%expr,
+ #(Z_cast ry)%expr @ y)))%expr_pat
+ else None)
+ (let (x5, _) := xv in x5)
+ (let (x5, _) := xv0 in x5)
+ (let (x5, _) := xv1 in x5) args
+ (v (Compile.reflect x4));
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s3 _ ($_)%expr _ | @expr.App _ _ _ s3
+ _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s3 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s3 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t2 idc2) x4 =>
+ match x0 with
+ | @expr.Ident _ _ _ t3 idc3 =>
+ match x4 with
+ | (@expr.Ident _ _ _ t4 idc4 @ x6 @ x5)%expr_pat =>
+ match x6 with
+ | @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t5 idc5) x7 =>
+ match x5 with
+ | @expr.Ident _ _ _ t6 idc6 =>
+ args <- invert_bind_args idc6
+ Raw.ident.Literal;
+ args0 <- invert_bind_args idc5
+ Raw.ident.Z_cast;
+ _ <- invert_bind_args idc4
+ Raw.ident.Z_shiftl;
+ args2 <- invert_bind_args idc3
+ Raw.ident.Literal;
+ args3 <- invert_bind_args idc2
+ Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc1
+ Raw.ident.Literal;
+ args5 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_with_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ -> ℤ) -> ℤ)%ptype
+ ((((projT1 args5) -> (projT1 args4)) ->
+ s6 -> (projT1 args)) ->
+ (projT1 args2))%ptype option
+ (fun x8 : option => x8)
+ with
+ | Some (_, _, (_, _), _)%zrange =>
+ if
+ type.type_beq base.type
+ base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ -> ℤ) -> ℤ)%ptype
+ ((((projT1 args5) ->
+ (projT1 args4)) ->
+ s6 -> (projT1 args)) ->
+ (projT1 args2))%ptype
+ then
+ xv <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args5);
+ xv0 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args4);
+ v <- type.try_make_transport_cps s6
+ ℤ;
+ xv1 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args);
+ xv2 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args2);
+ fv <- (x8 <- (let
+ '(r1, r2)%zrange :=
+ range in
+ fun (s7 cc : Z)
+ (rshiftl
+ ry : zrange)
+ (y : expr ℤ)
+ (offset xx : Z)
+ =>
+ if
+ (s7 =?
+ 2 ^ Z.log2 s7) &&
+ (ZRange.normalize
+ ry <<
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize
+ rshiftl)%zrange &&
+ (ZRange.normalize
+ rshiftl <=?
+ r[0 ~> s7 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2
+ (r1, r2))%expr @
+ (#(fancy_addc
+ (Z.log2 s7)
+ offset)%expr @
+ ((##cc)%expr,
+ (##xx)%expr,
+ #(Z_cast ry)%expr @
+ y)))%expr_pat
+ else None)
+ (let (x8, _) :=
+ xv in
+ x8)
+ (let (x8, _) :=
+ xv0 in
+ x8) args3 args0
+ (v
+ (Compile.reflect
+ x7))
+ (let (x8, _) :=
+ xv1 in
+ x8)
+ (let (x8, _) :=
+ xv2 in
+ x8);
+ Some (Base x8));
+ Some
+ (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s6 _ ($_)%expr _ | @expr.App
+ _ _ _ s6 _ (@expr.Abs _ _ _ _ _ _) _ |
+ @expr.App _ _ _ s6 _ (_ @ _)%expr_pat _ |
+ @expr.App _ _ _ s6 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end;;
+ match x6 with
+ | @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t5 idc5) x7 =>
+ match x5 with
+ | @expr.Ident _ _ _ t6 idc6 =>
+ args <- invert_bind_args idc6
+ Raw.ident.Literal;
+ args0 <- invert_bind_args idc5
+ Raw.ident.Z_cast;
+ _ <- invert_bind_args idc4
+ Raw.ident.Z_shiftr;
+ args2 <- invert_bind_args idc3
+ Raw.ident.Literal;
+ args3 <- invert_bind_args idc2
+ Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc1
+ Raw.ident.Literal;
+ args5 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_with_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ -> ℤ) -> ℤ)%ptype
+ ((((projT1 args5) -> (projT1 args4)) ->
+ s6 -> (projT1 args)) ->
+ (projT1 args2))%ptype option
+ (fun x8 : option => x8)
+ with
+ | Some (_, _, (_, _), _)%zrange =>
+ if
+ type.type_beq base.type
+ base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ -> ℤ) -> ℤ)%ptype
+ ((((projT1 args5) ->
+ (projT1 args4)) ->
+ s6 -> (projT1 args)) ->
+ (projT1 args2))%ptype
+ then
+ xv <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args5);
+ xv0 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args4);
+ v <- type.try_make_transport_cps s6
+ ℤ;
+ xv1 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args);
+ xv2 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args2);
+ fv <- (x8 <- (let
+ '(r1, r2)%zrange :=
+ range in
+ fun (s7 cc : Z)
+ (rshiftr
+ ry : zrange)
+ (y : expr ℤ)
+ (offset xx : Z)
+ =>
+ if
+ (s7 =?
+ 2 ^ Z.log2 s7) &&
+ (ZRange.normalize
+ ry >>
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize
+ rshiftr)%zrange &&
+ (ZRange.normalize
+ rshiftr <=?
+ r[0 ~> s7 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2
+ (r1, r2))%expr @
+ (#(fancy_addc
+ (Z.log2 s7)
+ (- offset))%expr @
+ ((##cc)%expr,
+ (##xx)%expr,
+ #(Z_cast ry)%expr @
+ y)))%expr_pat
+ else None)
+ (let (x8, _) :=
+ xv in
+ x8)
+ (let (x8, _) :=
+ xv0 in
+ x8) args3 args0
+ (v
+ (Compile.reflect
+ x7))
+ (let (x8, _) :=
+ xv1 in
+ x8)
+ (let (x8, _) :=
+ xv2 in
+ x8);
+ Some (Base x8));
+ Some
+ (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s6 _ ($_)%expr _ | @expr.App
+ _ _ _ s6 _ (@expr.Abs _ _ _ _ _ _) _ |
+ @expr.App _ _ _ s6 _ (_ @ _)%expr_pat _ |
+ @expr.App _ _ _ s6 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | _ => None
+ end;;
+ args <- invert_bind_args idc3 Raw.ident.Literal;
+ args0 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args1 <- invert_bind_args idc1 Raw.ident.Literal;
+ args2 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_with_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> (projT1 args1)) -> s3) ->
+ (projT1 args))%ptype option
+ (fun x5 : option => x5)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> (projT1 args1)) -> s3) ->
+ (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ v <- type.try_make_transport_cps s3 ℤ;
+ xv1 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x5 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s4 cc : Z) (rx : zrange)
+ (x5 : expr ℤ) (yy : Z) =>
+ if
+ (s4 =? 2 ^ Z.log2 s4) &&
+ (ZRange.normalize
+ (ZRange.constant yy) <=?
+ r[0 ~> s4 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_addc (Z.log2 s4) 0)%expr @
+ ((##cc)%expr,
+ #(Z_cast rx)%expr @ x5,
+ (##yy)%expr)))%expr_pat
+ else None)
+ (let (x5, _) := xv in x5)
+ (let (x5, _) := xv0 in x5)
+ args0 (v (Compile.reflect x4))
+ (let (x5, _) := xv1 in x5);
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s4 _ (@expr.Ident _ _ _ t3 idc3)
+ x5 =>
+ match x5 with
+ | (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 @ @expr.Ident _ _
+ _ t6 idc6)%expr_pat =>
+ args <- invert_bind_args idc6 Raw.ident.Literal;
+ args0 <- invert_bind_args idc5 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc4 Raw.ident.Z_shiftl;
+ args2 <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc1
+ Raw.ident.Literal;
+ args5 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_with_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> (projT1 args4)) -> s3) ->
+ s7 -> (projT1 args))%ptype option
+ (fun x9 : option => x9)
+ with
+ | Some (_, _, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> (projT1 args4)) ->
+ s3) -> s7 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args5);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args4);
+ v <- type.try_make_transport_cps s3
+ ℤ;
+ v0 <- type.try_make_transport_cps s7
+ ℤ;
+ xv1 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x9 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s8 cc : Z)
+ (rx : zrange)
+ (x9 : expr ℤ)
+ (rshiftl ry : zrange)
+ (y : expr ℤ) (offset : Z)
+ =>
+ if
+ (s8 =? 2 ^ Z.log2 s8) &&
+ (ZRange.normalize ry <<
+ ZRange.normalize
+ (ZRange.constant offset) <=?
+ ZRange.normalize rshiftl)%zrange &&
+ (ZRange.normalize rshiftl <=?
+ r[0 ~> s8 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_addc
+ (Z.log2 s8) offset)%expr @
+ ((##cc)%expr,
+ #(Z_cast rx)%expr @ x9,
+ #(Z_cast ry)%expr @ y)))%expr_pat
+ else None)
+ (let (x9, _) := xv in x9)
+ (let (x9, _) := xv0 in x9)
+ args3
+ (v (Compile.reflect x4))
+ args2 args0
+ (v0 (Compile.reflect x8))
+ (let (x9, _) := xv1 in x9);
+ Some (Base x9));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 @ ($_)%expr)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 @ @expr.Abs _ _ _
+ _ _ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 @ (_ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 @ @expr.LetIn _ _
+ _ _ _ _ _)%expr_pat => None
+ | (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ ($_)%expr _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (_ @ _) _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat =>
+ None
+ | (@expr.Ident _ _ _ t4 idc4 @ #(_) @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ ($_)%expr @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.Abs _ _ _ _ _
+ _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.LetIn _ _ _ _
+ _ _ _ @ _)%expr_pat => None
+ | _ => None
+ end;;
+ match x4 with
+ | (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 @ @expr.Ident _ _
+ _ t6 idc6)%expr_pat =>
+ args <- invert_bind_args idc6 Raw.ident.Literal;
+ args0 <- invert_bind_args idc5 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc4 Raw.ident.Z_shiftl;
+ args2 <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc1
+ Raw.ident.Literal;
+ args5 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_with_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ -> ℤ) -> ℤ)%ptype
+ ((((projT1 args5) -> (projT1 args4)) ->
+ s7 -> (projT1 args)) -> s4)%ptype option
+ (fun x9 : option => x9)
+ with
+ | Some (_, _, (_, _), _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ -> ℤ) -> ℤ)%ptype
+ ((((projT1 args5) -> (projT1 args4)) ->
+ s7 -> (projT1 args)) -> s4)%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args5);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args4);
+ v <- type.try_make_transport_cps s7
+ ℤ;
+ xv1 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ v0 <- type.try_make_transport_cps s4
+ ℤ;
+ fv <- (x9 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s8 cc : Z)
+ (rshiftl ry : zrange)
+ (y : expr ℤ) (offset : Z)
+ (rx : zrange)
+ (x9 : expr ℤ) =>
+ if
+ (s8 =? 2 ^ Z.log2 s8) &&
+ (ZRange.normalize ry <<
+ ZRange.normalize
+ (ZRange.constant offset) <=?
+ ZRange.normalize rshiftl)%zrange &&
+ (ZRange.normalize rshiftl <=?
+ r[0 ~> s8 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_addc
+ (Z.log2 s8) offset)%expr @
+ ((##cc)%expr,
+ #(Z_cast rx)%expr @ x9,
+ #(Z_cast ry)%expr @ y)))%expr_pat
+ else None)
+ (let (x9, _) := xv in x9)
+ (let (x9, _) := xv0 in x9)
+ args3 args0
+ (v (Compile.reflect x8))
+ (let (x9, _) := xv1 in x9)
+ args2
+ (v0 (Compile.reflect x5));
+ Some (Base x9));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 @ ($_)%expr)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 @ @expr.Abs _ _ _
+ _ _ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 @ (_ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 @ @expr.LetIn _ _
+ _ _ _ _ _)%expr_pat => None
+ | (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ ($_)%expr _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (_ @ _) _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat =>
+ None
+ | (@expr.Ident _ _ _ t4 idc4 @ #(_) @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ ($_)%expr @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.Abs _ _ _ _ _
+ _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.LetIn _ _ _ _
+ _ _ _ @ _)%expr_pat => None
+ | _ => None
+ end;;
+ match x5 with
+ | (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 @ @expr.Ident _ _
+ _ t6 idc6)%expr_pat =>
+ args <- invert_bind_args idc6 Raw.ident.Literal;
+ args0 <- invert_bind_args idc5 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc4 Raw.ident.Z_shiftr;
+ args2 <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc1
+ Raw.ident.Literal;
+ args5 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_with_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> (projT1 args4)) -> s3) ->
+ s7 -> (projT1 args))%ptype option
+ (fun x9 : option => x9)
+ with
+ | Some (_, _, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> (projT1 args4)) ->
+ s3) -> s7 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args5);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args4);
+ v <- type.try_make_transport_cps s3
+ ℤ;
+ v0 <- type.try_make_transport_cps s7
+ ℤ;
+ xv1 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x9 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s8 cc : Z)
+ (rx : zrange)
+ (x9 : expr ℤ)
+ (rshiftr ry : zrange)
+ (y : expr ℤ) (offset : Z)
+ =>
+ if
+ (s8 =? 2 ^ Z.log2 s8) &&
+ (ZRange.normalize ry >>
+ ZRange.normalize
+ (ZRange.constant offset) <=?
+ ZRange.normalize rshiftr)%zrange &&
+ (ZRange.normalize rshiftr <=?
+ r[0 ~> s8 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_addc
+ (Z.log2 s8)
+ (- offset))%expr @
+ ((##cc)%expr,
+ #(Z_cast rx)%expr @ x9,
+ #(Z_cast ry)%expr @ y)))%expr_pat
+ else None)
+ (let (x9, _) := xv in x9)
+ (let (x9, _) := xv0 in x9)
+ args3
+ (v (Compile.reflect x4))
+ args2 args0
+ (v0 (Compile.reflect x8))
+ (let (x9, _) := xv1 in x9);
+ Some (Base x9));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 @ ($_)%expr)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 @ @expr.Abs _ _ _
+ _ _ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 @ (_ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 @ @expr.LetIn _ _
+ _ _ _ _ _)%expr_pat => None
+ | (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ ($_)%expr _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (_ @ _) _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat =>
+ None
+ | (@expr.Ident _ _ _ t4 idc4 @ #(_) @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ ($_)%expr @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.Abs _ _ _ _ _
+ _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.LetIn _ _ _ _
+ _ _ _ @ _)%expr_pat => None
+ | _ => None
+ end;;
+ match x4 with
+ | (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 @ @expr.Ident _ _
+ _ t6 idc6)%expr_pat =>
+ args <- invert_bind_args idc6 Raw.ident.Literal;
+ args0 <- invert_bind_args idc5 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc4 Raw.ident.Z_shiftr;
+ args2 <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc1
+ Raw.ident.Literal;
+ args5 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_with_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ -> ℤ) -> ℤ)%ptype
+ ((((projT1 args5) -> (projT1 args4)) ->
+ s7 -> (projT1 args)) -> s4)%ptype option
+ (fun x9 : option => x9)
+ with
+ | Some (_, _, (_, _), _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ -> ℤ) -> ℤ)%ptype
+ ((((projT1 args5) -> (projT1 args4)) ->
+ s7 -> (projT1 args)) -> s4)%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args5);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args4);
+ v <- type.try_make_transport_cps s7
+ ℤ;
+ xv1 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ v0 <- type.try_make_transport_cps s4
+ ℤ;
+ fv <- (x9 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s8 cc : Z)
+ (rshiftr ry : zrange)
+ (y : expr ℤ) (offset : Z)
+ (rx : zrange)
+ (x9 : expr ℤ) =>
+ if
+ (s8 =? 2 ^ Z.log2 s8) &&
+ (ZRange.normalize ry >>
+ ZRange.normalize
+ (ZRange.constant offset) <=?
+ ZRange.normalize rshiftr)%zrange &&
+ (ZRange.normalize rshiftr <=?
+ r[0 ~> s8 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_addc
+ (Z.log2 s8)
+ (- offset))%expr @
+ ((##cc)%expr,
+ #(Z_cast rx)%expr @ x9,
+ #(Z_cast ry)%expr @ y)))%expr_pat
+ else None)
+ (let (x9, _) := xv in x9)
+ (let (x9, _) := xv0 in x9)
+ args3 args0
+ (v (Compile.reflect x8))
+ (let (x9, _) := xv1 in x9)
+ args2
+ (v0 (Compile.reflect x5));
+ Some (Base x9));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 @ ($_)%expr)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 @ @expr.Abs _ _ _
+ _ _ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 @ (_ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 @ @expr.LetIn _ _
+ _ _ _ _ _)%expr_pat => None
+ | (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ ($_)%expr _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (_ @ _) _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s7 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat =>
+ None
+ | (@expr.Ident _ _ _ t4 idc4 @ #(_) @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ ($_)%expr @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.Abs _ _ _ _ _
+ _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.LetIn _ _ _ _
+ _ _ _ @ _)%expr_pat => None
+ | _ => None
+ end;;
+ args <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args0 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args1 <- invert_bind_args idc1 Raw.ident.Literal;
+ args2 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_with_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> (projT1 args1)) -> s3) ->
+ s4)%ptype option (fun x6 : option => x6)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> (projT1 args1)) -> s3) ->
+ s4)%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ v <- type.try_make_transport_cps s3 ℤ;
+ v0 <- type.try_make_transport_cps s4 ℤ;
+ fv <- (x6 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s5 cc : Z) (rx : zrange)
+ (x6 : expr ℤ) (ry : zrange)
+ (y : expr ℤ) =>
+ if
+ (s5 =? 2 ^ Z.log2 s5) &&
+ (ZRange.normalize ry <=?
+ r[0 ~> s5 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_addc (Z.log2 s5) 0)%expr @
+ ((##cc)%expr,
+ #(Z_cast rx)%expr @ x6,
+ #(Z_cast ry)%expr @ y)))%expr_pat
+ else None)
+ (let (x6, _) := xv in x6)
+ (let (x6, _) := xv0 in x6)
+ args0 (v (Compile.reflect x4))
+ args (v0 (Compile.reflect x5));
+ Some (Base x6));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s4 _ ($_)%expr _ | @expr.App _ _ _ s4
+ _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s4 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s4 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s3 _ ($_)%expr _ | @expr.App _ _ _ s3 _
+ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s3 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s3 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t1 idc1) x4 =>
+ match x1 with
+ | @expr.Ident _ _ _ t2 idc2 =>
+ match x0 with
+ | @expr.Ident _ _ _ t3 idc3 =>
+ args <- invert_bind_args idc3 Raw.ident.Literal;
+ args0 <- invert_bind_args idc2 Raw.ident.Literal;
+ args1 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args2 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_with_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s3) -> (projT1 args0)) ->
+ (projT1 args))%ptype option
+ (fun x5 : option => x5)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s3) -> (projT1 args0)) ->
+ (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ v <- type.try_make_transport_cps s3 ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv1 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x5 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s4 : Z) (rc : zrange)
+ (c : expr ℤ) (xx yy : Z) =>
+ if
+ (s4 =? 2 ^ Z.log2 s4) &&
+ (ZRange.normalize
+ (ZRange.constant yy) <=?
+ r[0 ~> s4 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_addc (Z.log2 s4) 0)%expr @
+ (#(Z_cast rc)%expr @ c,
+ (##xx)%expr, (##yy)%expr)))%expr_pat
+ else None)
+ (let (x5, _) := xv in x5) args1
+ (v (Compile.reflect x4))
+ (let (x5, _) := xv0 in x5)
+ (let (x5, _) := xv1 in x5);
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s4 _ (@expr.Ident _ _ _ t3 idc3)
+ x5 =>
+ match x5 with
+ | (@expr.Ident _ _ _ t4 idc4 @ x7 @ x6)%expr_pat =>
+ match x7 with
+ | @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 =>
+ match x6 with
+ | @expr.Ident _ _ _ t6 idc6 =>
+ args <- invert_bind_args idc6
+ Raw.ident.Literal;
+ args0 <- invert_bind_args idc5
+ Raw.ident.Z_cast;
+ _ <- invert_bind_args idc4
+ Raw.ident.Z_shiftl;
+ args2 <- invert_bind_args idc3
+ Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc2
+ Raw.ident.Literal;
+ args4 <- invert_bind_args idc1
+ Raw.ident.Z_cast;
+ args5 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_with_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> s3) ->
+ (projT1 args3)) ->
+ s7 -> (projT1 args))%ptype option
+ (fun x9 : option => x9)
+ with
+ | Some (_, _, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type
+ base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> s3) ->
+ (projT1 args3)) ->
+ s7 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args5);
+ v <- type.try_make_transport_cps s3
+ ℤ;
+ xv0 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args3);
+ v0 <- type.try_make_transport_cps s7
+ ℤ;
+ xv1 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x9 <- (let
+ '(r1, r2)%zrange :=
+ range in
+ fun (s8 : Z)
+ (rc : zrange)
+ (c : expr ℤ)
+ (xx : Z)
+ (rshiftl
+ ry : zrange)
+ (y : expr ℤ)
+ (offset : Z) =>
+ if
+ (s8 =?
+ 2 ^ Z.log2 s8) &&
+ (ZRange.normalize
+ ry <<
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize
+ rshiftl)%zrange &&
+ (ZRange.normalize
+ rshiftl <=?
+ r[0 ~> s8 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2
+ (r1, r2))%expr @
+ (#(fancy_addc
+ (Z.log2 s8)
+ offset)%expr @
+ (#(Z_cast rc)%expr @
+ c,
+ (##xx)%expr,
+ #(Z_cast ry)%expr @
+ y)))%expr_pat
+ else None)
+ (let (x9, _) :=
+ xv in
+ x9) args4
+ (v
+ (Compile.reflect
+ x4))
+ (let (x9, _) :=
+ xv0 in
+ x9) args2 args0
+ (v0
+ (Compile.reflect
+ x8))
+ (let (x9, _) :=
+ xv1 in
+ x9);
+ Some (Base x9));
+ Some
+ (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s7 _ ($_)%expr _ | @expr.App
+ _ _ _ s7 _ (@expr.Abs _ _ _ _ _ _) _ |
+ @expr.App _ _ _ s7 _ (_ @ _)%expr_pat _ |
+ @expr.App _ _ _ s7 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end;;
+ match x7 with
+ | @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 =>
+ match x6 with
+ | @expr.Ident _ _ _ t6 idc6 =>
+ args <- invert_bind_args idc6
+ Raw.ident.Literal;
+ args0 <- invert_bind_args idc5
+ Raw.ident.Z_cast;
+ _ <- invert_bind_args idc4
+ Raw.ident.Z_shiftr;
+ args2 <- invert_bind_args idc3
+ Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc2
+ Raw.ident.Literal;
+ args4 <- invert_bind_args idc1
+ Raw.ident.Z_cast;
+ args5 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_with_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> s3) ->
+ (projT1 args3)) ->
+ s7 -> (projT1 args))%ptype option
+ (fun x9 : option => x9)
+ with
+ | Some (_, _, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type
+ base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> s3) ->
+ (projT1 args3)) ->
+ s7 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args5);
+ v <- type.try_make_transport_cps s3
+ ℤ;
+ xv0 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args3);
+ v0 <- type.try_make_transport_cps s7
+ ℤ;
+ xv1 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x9 <- (let
+ '(r1, r2)%zrange :=
+ range in
+ fun (s8 : Z)
+ (rc : zrange)
+ (c : expr ℤ)
+ (xx : Z)
+ (rshiftr
+ ry : zrange)
+ (y : expr ℤ)
+ (offset : Z) =>
+ if
+ (s8 =?
+ 2 ^ Z.log2 s8) &&
+ (ZRange.normalize
+ ry >>
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize
+ rshiftr)%zrange &&
+ (ZRange.normalize
+ rshiftr <=?
+ r[0 ~> s8 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2
+ (r1, r2))%expr @
+ (#(fancy_addc
+ (Z.log2 s8)
+ (- offset))%expr @
+ (#(Z_cast rc)%expr @
+ c,
+ (##xx)%expr,
+ #(Z_cast ry)%expr @
+ y)))%expr_pat
+ else None)
+ (let (x9, _) :=
+ xv in
+ x9) args4
+ (v
+ (Compile.reflect
+ x4))
+ (let (x9, _) :=
+ xv0 in
+ x9) args2 args0
+ (v0
+ (Compile.reflect
+ x8))
+ (let (x9, _) :=
+ xv1 in
+ x9);
+ Some (Base x9));
+ Some
+ (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s7 _ ($_)%expr _ | @expr.App
+ _ _ _ s7 _ (@expr.Abs _ _ _ _ _ _) _ |
+ @expr.App _ _ _ s7 _ (_ @ _)%expr_pat _ |
+ @expr.App _ _ _ s7 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | _ => None
+ end;;
+ args <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args0 <- invert_bind_args idc2 Raw.ident.Literal;
+ args1 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args2 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_with_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s3) -> (projT1 args0)) ->
+ s4)%ptype option (fun x6 : option => x6)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s3) -> (projT1 args0)) ->
+ s4)%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ v <- type.try_make_transport_cps s3 ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ v0 <- type.try_make_transport_cps s4 ℤ;
+ fv <- (x6 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s5 : Z) (rc : zrange)
+ (c : expr ℤ) (xx : Z)
+ (ry : zrange) (y : expr ℤ) =>
+ if
+ (s5 =? 2 ^ Z.log2 s5) &&
+ (ZRange.normalize ry <=?
+ r[0 ~> s5 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_addc (Z.log2 s5) 0)%expr @
+ (#(Z_cast rc)%expr @ c,
+ (##xx)%expr,
+ #(Z_cast ry)%expr @ y)))%expr_pat
+ else None)
+ (let (x6, _) := xv in x6) args1
+ (v (Compile.reflect x4))
+ (let (x6, _) := xv0 in x6) args
+ (v0 (Compile.reflect x5));
+ Some (Base x6));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s4 _ ($_)%expr _ | @expr.App _ _ _ s4
+ _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s4 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s4 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s4 _ (@expr.Ident _ _ _ t2 idc2) x5 =>
+ match x0 with
+ | @expr.Ident _ _ _ t3 idc3 =>
+ match x5 with
+ | (@expr.Ident _ _ _ t4 idc4 @ x7 @ x6)%expr_pat =>
+ match x7 with
+ | @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 =>
+ match x6 with
+ | @expr.Ident _ _ _ t6 idc6 =>
+ args <- invert_bind_args idc6
+ Raw.ident.Literal;
+ args0 <- invert_bind_args idc5
+ Raw.ident.Z_cast;
+ _ <- invert_bind_args idc4
+ Raw.ident.Z_shiftl;
+ args2 <- invert_bind_args idc3
+ Raw.ident.Literal;
+ args3 <- invert_bind_args idc2
+ Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc1
+ Raw.ident.Z_cast;
+ args5 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_with_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ -> ℤ) -> ℤ)%ptype
+ ((((projT1 args5) -> s3) ->
+ s7 -> (projT1 args)) ->
+ (projT1 args2))%ptype option
+ (fun x9 : option => x9)
+ with
+ | Some (_, _, (_, _), _)%zrange =>
+ if
+ type.type_beq base.type
+ base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ -> ℤ) -> ℤ)%ptype
+ ((((projT1 args5) -> s3) ->
+ s7 -> (projT1 args)) ->
+ (projT1 args2))%ptype
+ then
+ xv <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args5);
+ v <- type.try_make_transport_cps s3
+ ℤ;
+ v0 <- type.try_make_transport_cps s7
+ ℤ;
+ xv0 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args);
+ xv1 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args2);
+ fv <- (x9 <- (let
+ '(r1, r2)%zrange :=
+ range in
+ fun (s8 : Z)
+ (rc : zrange)
+ (c : expr ℤ)
+ (rshiftl
+ ry : zrange)
+ (y : expr ℤ)
+ (offset xx : Z)
+ =>
+ if
+ (s8 =?
+ 2 ^ Z.log2 s8) &&
+ (ZRange.normalize
+ ry <<
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize
+ rshiftl)%zrange &&
+ (ZRange.normalize
+ rshiftl <=?
+ r[0 ~> s8 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2
+ (r1, r2))%expr @
+ (#(fancy_addc
+ (Z.log2 s8)
+ offset)%expr @
+ (#(Z_cast rc)%expr @
+ c,
+ (##xx)%expr,
+ #(Z_cast ry)%expr @
+ y)))%expr_pat
+ else None)
+ (let (x9, _) :=
+ xv in
+ x9) args4
+ (v
+ (Compile.reflect
+ x4)) args3
+ args0
+ (v0
+ (Compile.reflect
+ x8))
+ (let (x9, _) :=
+ xv0 in
+ x9)
+ (let (x9, _) :=
+ xv1 in
+ x9);
+ Some (Base x9));
+ Some
+ (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s7 _ ($_)%expr _ | @expr.App
+ _ _ _ s7 _ (@expr.Abs _ _ _ _ _ _) _ |
+ @expr.App _ _ _ s7 _ (_ @ _)%expr_pat _ |
+ @expr.App _ _ _ s7 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end;;
+ match x7 with
+ | @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 =>
+ match x6 with
+ | @expr.Ident _ _ _ t6 idc6 =>
+ args <- invert_bind_args idc6
+ Raw.ident.Literal;
+ args0 <- invert_bind_args idc5
+ Raw.ident.Z_cast;
+ _ <- invert_bind_args idc4
+ Raw.ident.Z_shiftr;
+ args2 <- invert_bind_args idc3
+ Raw.ident.Literal;
+ args3 <- invert_bind_args idc2
+ Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc1
+ Raw.ident.Z_cast;
+ args5 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_with_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ -> ℤ) -> ℤ)%ptype
+ ((((projT1 args5) -> s3) ->
+ s7 -> (projT1 args)) ->
+ (projT1 args2))%ptype option
+ (fun x9 : option => x9)
+ with
+ | Some (_, _, (_, _), _)%zrange =>
+ if
+ type.type_beq base.type
+ base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ -> ℤ) -> ℤ)%ptype
+ ((((projT1 args5) -> s3) ->
+ s7 -> (projT1 args)) ->
+ (projT1 args2))%ptype
+ then
+ xv <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args5);
+ v <- type.try_make_transport_cps s3
+ ℤ;
+ v0 <- type.try_make_transport_cps s7
+ ℤ;
+ xv0 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args);
+ xv1 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args2);
+ fv <- (x9 <- (let
+ '(r1, r2)%zrange :=
+ range in
+ fun (s8 : Z)
+ (rc : zrange)
+ (c : expr ℤ)
+ (rshiftr
+ ry : zrange)
+ (y : expr ℤ)
+ (offset xx : Z)
+ =>
+ if
+ (s8 =?
+ 2 ^ Z.log2 s8) &&
+ (ZRange.normalize
+ ry >>
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize
+ rshiftr)%zrange &&
+ (ZRange.normalize
+ rshiftr <=?
+ r[0 ~> s8 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2
+ (r1, r2))%expr @
+ (#(fancy_addc
+ (Z.log2 s8)
+ (- offset))%expr @
+ (#(Z_cast rc)%expr @
+ c,
+ (##xx)%expr,
+ #(Z_cast ry)%expr @
+ y)))%expr_pat
+ else None)
+ (let (x9, _) :=
+ xv in
+ x9) args4
+ (v
+ (Compile.reflect
+ x4)) args3
+ args0
+ (v0
+ (Compile.reflect
+ x8))
+ (let (x9, _) :=
+ xv0 in
+ x9)
+ (let (x9, _) :=
+ xv1 in
+ x9);
+ Some (Base x9));
+ Some
+ (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s7 _ ($_)%expr _ | @expr.App
+ _ _ _ s7 _ (@expr.Abs _ _ _ _ _ _) _ |
+ @expr.App _ _ _ s7 _ (_ @ _)%expr_pat _ |
+ @expr.App _ _ _ s7 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | _ => None
+ end;;
+ args <- invert_bind_args idc3 Raw.ident.Literal;
+ args0 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args1 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args2 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_with_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s3) -> s4) ->
+ (projT1 args))%ptype option
+ (fun x6 : option => x6)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s3) -> s4) ->
+ (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ v <- type.try_make_transport_cps s3 ℤ;
+ v0 <- type.try_make_transport_cps s4 ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x6 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s5 : Z) (rc : zrange)
+ (c : expr ℤ) (rx : zrange)
+ (x6 : expr ℤ) (yy : Z) =>
+ if
+ (s5 =? 2 ^ Z.log2 s5) &&
+ (ZRange.normalize
+ (ZRange.constant yy) <=?
+ r[0 ~> s5 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_addc (Z.log2 s5) 0)%expr @
+ (#(Z_cast rc)%expr @ c,
+ #(Z_cast rx)%expr @ x6,
+ (##yy)%expr)))%expr_pat
+ else None)
+ (let (x6, _) := xv in x6) args1
+ (v (Compile.reflect x4)) args0
+ (v0 (Compile.reflect x5))
+ (let (x6, _) := xv0 in x6);
+ Some (Base x6));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s5 _ (@expr.Ident _ _ _ t3 idc3)
+ x6 =>
+ match x6 with
+ | (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.Ident _ _ _ t5 idc5) x9 @ @expr.Ident _ _
+ _ t6 idc6)%expr_pat =>
+ args <- invert_bind_args idc6 Raw.ident.Literal;
+ args0 <- invert_bind_args idc5 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc4 Raw.ident.Z_shiftl;
+ args2 <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args5 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_with_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> s3) -> s4) ->
+ s8 -> (projT1 args))%ptype option
+ (fun x10 : option => x10)
+ with
+ | Some (_, _, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> s3) -> s4) ->
+ s8 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args5);
+ v <- type.try_make_transport_cps s3
+ ℤ;
+ v0 <- type.try_make_transport_cps s4
+ ℤ;
+ v1 <- type.try_make_transport_cps s8
+ ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x10 <- (let
+ '(r1, r2)%zrange := range
+ in
+ fun (s9 : Z) (rc : zrange)
+ (c : expr ℤ)
+ (rx : zrange)
+ (x10 : expr ℤ)
+ (rshiftl ry : zrange)
+ (y : expr ℤ)
+ (offset : Z) =>
+ if
+ (s9 =? 2 ^ Z.log2 s9) &&
+ (ZRange.normalize ry <<
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize rshiftl)%zrange &&
+ (ZRange.normalize rshiftl <=?
+ r[0 ~> s9 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_addc
+ (Z.log2 s9)
+ offset)%expr @
+ (#(Z_cast rc)%expr @
+ c,
+ #(Z_cast rx)%expr @
+ x10,
+ #(Z_cast ry)%expr @ y)))%expr_pat
+ else None)
+ (let (x10, _) := xv in x10)
+ args4
+ (v (Compile.reflect x4))
+ args3
+ (v0 (Compile.reflect x5))
+ args2 args0
+ (v1 (Compile.reflect x9))
+ (let (x10, _) := xv0 in
+ x10);
+ Some (Base x10));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.Ident _ _ _ t5 idc5) x9 @ ($_)%expr)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.Ident _ _ _ t5 idc5) x9 @ @expr.Abs _ _ _
+ _ _ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.Ident _ _ _ t5 idc5) x9 @ (_ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.Ident _ _ _ t5 idc5) x9 @ @expr.LetIn _ _
+ _ _ _ _ _)%expr_pat => None
+ | (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ ($_)%expr _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (_ @ _) _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat =>
+ None
+ | (@expr.Ident _ _ _ t4 idc4 @ #(_) @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ ($_)%expr @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.Abs _ _ _ _ _
+ _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.LetIn _ _ _ _
+ _ _ _ @ _)%expr_pat => None
+ | _ => None
+ end;;
+ match x5 with
+ | (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.Ident _ _ _ t5 idc5) x9 @ @expr.Ident _ _
+ _ t6 idc6)%expr_pat =>
+ args <- invert_bind_args idc6 Raw.ident.Literal;
+ args0 <- invert_bind_args idc5 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc4 Raw.ident.Z_shiftl;
+ args2 <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args5 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_with_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ -> ℤ) -> ℤ)%ptype
+ ((((projT1 args5) -> s3) ->
+ s8 -> (projT1 args)) -> s5)%ptype option
+ (fun x10 : option => x10)
+ with
+ | Some (_, _, (_, _), _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ -> ℤ) -> ℤ)%ptype
+ ((((projT1 args5) -> s3) ->
+ s8 -> (projT1 args)) -> s5)%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args5);
+ v <- type.try_make_transport_cps s3
+ ℤ;
+ v0 <- type.try_make_transport_cps s8
+ ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ v1 <- type.try_make_transport_cps s5
+ ℤ;
+ fv <- (x10 <- (let
+ '(r1, r2)%zrange := range
+ in
+ fun (s9 : Z) (rc : zrange)
+ (c : expr ℤ)
+ (rshiftl ry : zrange)
+ (y : expr ℤ)
+ (offset : Z)
+ (rx : zrange)
+ (x10 : expr ℤ) =>
+ if
+ (s9 =? 2 ^ Z.log2 s9) &&
+ (ZRange.normalize ry <<
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize rshiftl)%zrange &&
+ (ZRange.normalize rshiftl <=?
+ r[0 ~> s9 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_addc
+ (Z.log2 s9)
+ offset)%expr @
+ (#(Z_cast rc)%expr @
+ c,
+ #(Z_cast rx)%expr @
+ x10,
+ #(Z_cast ry)%expr @ y)))%expr_pat
+ else None)
+ (let (x10, _) := xv in x10)
+ args4
+ (v (Compile.reflect x4))
+ args3 args0
+ (v0 (Compile.reflect x9))
+ (let (x10, _) := xv0 in
+ x10) args2
+ (v1 (Compile.reflect x6));
+ Some (Base x10));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.Ident _ _ _ t5 idc5) x9 @ ($_)%expr)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.Ident _ _ _ t5 idc5) x9 @ @expr.Abs _ _ _
+ _ _ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.Ident _ _ _ t5 idc5) x9 @ (_ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.Ident _ _ _ t5 idc5) x9 @ @expr.LetIn _ _
+ _ _ _ _ _)%expr_pat => None
+ | (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ ($_)%expr _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (_ @ _) _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat =>
+ None
+ | (@expr.Ident _ _ _ t4 idc4 @ #(_) @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ ($_)%expr @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.Abs _ _ _ _ _
+ _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.LetIn _ _ _ _
+ _ _ _ @ _)%expr_pat => None
+ | _ => None
+ end;;
+ match x6 with
+ | (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.Ident _ _ _ t5 idc5) x9 @ @expr.Ident _ _
+ _ t6 idc6)%expr_pat =>
+ args <- invert_bind_args idc6 Raw.ident.Literal;
+ args0 <- invert_bind_args idc5 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc4 Raw.ident.Z_shiftr;
+ args2 <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args5 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_with_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> s3) -> s4) ->
+ s8 -> (projT1 args))%ptype option
+ (fun x10 : option => x10)
+ with
+ | Some (_, _, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> s3) -> s4) ->
+ s8 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args5);
+ v <- type.try_make_transport_cps s3
+ ℤ;
+ v0 <- type.try_make_transport_cps s4
+ ℤ;
+ v1 <- type.try_make_transport_cps s8
+ ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x10 <- (let
+ '(r1, r2)%zrange := range
+ in
+ fun (s9 : Z) (rc : zrange)
+ (c : expr ℤ)
+ (rx : zrange)
+ (x10 : expr ℤ)
+ (rshiftr ry : zrange)
+ (y : expr ℤ)
+ (offset : Z) =>
+ if
+ (s9 =? 2 ^ Z.log2 s9) &&
+ (ZRange.normalize ry >>
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize rshiftr)%zrange &&
+ (ZRange.normalize rshiftr <=?
+ r[0 ~> s9 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_addc
+ (Z.log2 s9)
+ (- offset))%expr @
+ (#(Z_cast rc)%expr @
+ c,
+ #(Z_cast rx)%expr @
+ x10,
+ #(Z_cast ry)%expr @ y)))%expr_pat
+ else None)
+ (let (x10, _) := xv in x10)
+ args4
+ (v (Compile.reflect x4))
+ args3
+ (v0 (Compile.reflect x5))
+ args2 args0
+ (v1 (Compile.reflect x9))
+ (let (x10, _) := xv0 in
+ x10);
+ Some (Base x10));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.Ident _ _ _ t5 idc5) x9 @ ($_)%expr)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.Ident _ _ _ t5 idc5) x9 @ @expr.Abs _ _ _
+ _ _ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.Ident _ _ _ t5 idc5) x9 @ (_ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.Ident _ _ _ t5 idc5) x9 @ @expr.LetIn _ _
+ _ _ _ _ _)%expr_pat => None
+ | (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ ($_)%expr _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (_ @ _) _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat =>
+ None
+ | (@expr.Ident _ _ _ t4 idc4 @ #(_) @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ ($_)%expr @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.Abs _ _ _ _ _
+ _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.LetIn _ _ _ _
+ _ _ _ @ _)%expr_pat => None
+ | _ => None
+ end;;
+ match x5 with
+ | (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.Ident _ _ _ t5 idc5) x9 @ @expr.Ident _ _
+ _ t6 idc6)%expr_pat =>
+ args <- invert_bind_args idc6 Raw.ident.Literal;
+ args0 <- invert_bind_args idc5 Raw.ident.Z_cast;
+ _ <- invert_bind_args idc4 Raw.ident.Z_shiftr;
+ args2 <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args5 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_with_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ -> ℤ) -> ℤ)%ptype
+ ((((projT1 args5) -> s3) ->
+ s8 -> (projT1 args)) -> s5)%ptype option
+ (fun x10 : option => x10)
+ with
+ | Some (_, _, (_, _), _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ -> ℤ) -> ℤ)%ptype
+ ((((projT1 args5) -> s3) ->
+ s8 -> (projT1 args)) -> s5)%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args5);
+ v <- type.try_make_transport_cps s3
+ ℤ;
+ v0 <- type.try_make_transport_cps s8
+ ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ v1 <- type.try_make_transport_cps s5
+ ℤ;
+ fv <- (x10 <- (let
+ '(r1, r2)%zrange := range
+ in
+ fun (s9 : Z) (rc : zrange)
+ (c : expr ℤ)
+ (rshiftr ry : zrange)
+ (y : expr ℤ)
+ (offset : Z)
+ (rx : zrange)
+ (x10 : expr ℤ) =>
+ if
+ (s9 =? 2 ^ Z.log2 s9) &&
+ (ZRange.normalize ry >>
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize rshiftr)%zrange &&
+ (ZRange.normalize rshiftr <=?
+ r[0 ~> s9 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_addc
+ (Z.log2 s9)
+ (- offset))%expr @
+ (#(Z_cast rc)%expr @
+ c,
+ #(Z_cast rx)%expr @
+ x10,
+ #(Z_cast ry)%expr @ y)))%expr_pat
+ else None)
+ (let (x10, _) := xv in x10)
+ args4
+ (v (Compile.reflect x4))
+ args3 args0
+ (v0 (Compile.reflect x9))
+ (let (x10, _) := xv0 in
+ x10) args2
+ (v1 (Compile.reflect x6));
+ Some (Base x10));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.Ident _ _ _ t5 idc5) x9 @ ($_)%expr)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.Ident _ _ _ t5 idc5) x9 @ @expr.Abs _ _ _
+ _ _ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.Ident _ _ _ t5 idc5) x9 @ (_ @ _))%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.Ident _ _ _ t5 idc5) x9 @ @expr.LetIn _ _
+ _ _ _ _ _)%expr_pat => None
+ | (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ ($_)%expr _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.Abs _ _ _ _ _ _) _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (_ @ _) _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.App _ _ _ s8 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ @ _)%expr_pat =>
+ None
+ | (@expr.Ident _ _ _ t4 idc4 @ #(_) @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ ($_)%expr @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.Abs _ _ _ _ _
+ _ @ _)%expr_pat |
+ (@expr.Ident _ _ _ t4 idc4 @ @expr.LetIn _ _ _ _
+ _ _ _ @ _)%expr_pat => None
+ | _ => None
+ end;;
+ args <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args0 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args1 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args2 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_add_with_get_carry;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s3) -> s4) -> s5)%ptype
+ option (fun x7 : option => x7)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s3) -> s4) -> s5)%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ v <- type.try_make_transport_cps s3 ℤ;
+ v0 <- type.try_make_transport_cps s4 ℤ;
+ v1 <- type.try_make_transport_cps s5 ℤ;
+ fv <- (x7 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s6 : Z) (rc : zrange)
+ (c : expr ℤ) (rx : zrange)
+ (x7 : expr ℤ) (ry : zrange)
+ (y : expr ℤ) =>
+ if
+ (s6 =? 2 ^ Z.log2 s6) &&
+ (ZRange.normalize ry <=?
+ r[0 ~> s6 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_addc (Z.log2 s6) 0)%expr @
+ (#(Z_cast rc)%expr @ c,
+ #(Z_cast rx)%expr @ x7,
+ #(Z_cast ry)%expr @ y)))%expr_pat
+ else None)
+ (let (x7, _) := xv in x7) args1
+ (v (Compile.reflect x4)) args0
+ (v0 (Compile.reflect x5)) args
+ (v1 (Compile.reflect x6));
+ Some (Base x7));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s5 _ ($_)%expr _ | @expr.App _ _ _ s5
+ _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s5 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s5 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s4 _ ($_)%expr _ | @expr.App _ _ _ s4 _
+ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s4 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s4 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s3 _ ($_)%expr _ | @expr.App _ _ _ s3 _
+ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s3 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s3 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | _ => None
+ end;;
+ match x3 with
+ | @expr.Ident _ _ _ t0 idc0 =>
+ match x2 with
+ | @expr.Ident _ _ _ t1 idc1 =>
+ match x1 with
+ | @expr.Ident _ _ _ t2 idc2 =>
+ match x0 with
+ | @expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t3 idc3)
+ x4 =>
+ match x4 with
+ | (@expr.Ident _ _ _ t4 idc4 @ x6 @ x5)%expr_pat =>
+ match x6 with
+ | @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t5 idc5) x7 =>
+ match x5 with
+ | @expr.Ident _ _ _ t6 idc6 =>
+ args <- invert_bind_args idc6
+ Raw.ident.Literal;
+ args0 <- invert_bind_args idc5
+ Raw.ident.Z_cast;
+ _ <- invert_bind_args idc4
+ Raw.ident.Z_shiftl;
+ args2 <- invert_bind_args idc3
+ Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc2
+ Raw.ident.Literal;
+ args4 <- invert_bind_args idc1
+ Raw.ident.Literal;
+ args5 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_sub_with_get_borrow;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> (projT1 args4)) ->
+ (projT1 args3)) ->
+ s6 -> (projT1 args))%ptype option
+ (fun x8 : option => x8)
+ with
+ | Some (_, _, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type
+ base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) ->
+ (projT1 args4)) ->
+ (projT1 args3)) ->
+ s6 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args5);
+ xv0 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args4);
+ xv1 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args3);
+ v <- type.try_make_transport_cps s6
+ ℤ;
+ xv2 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x8 <- (let
+ '(r1, r2)%zrange :=
+ range in
+ fun (s7 bb xx : Z)
+ (rshiftl
+ ry : zrange)
+ (y : expr ℤ)
+ (offset : Z) =>
+ if
+ (s7 =?
+ 2 ^ Z.log2 s7) &&
+ (ZRange.normalize
+ ry <<
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize
+ rshiftl)%zrange &&
+ (ZRange.normalize
+ rshiftl <=?
+ r[0 ~> s7 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2
+ (r1, r2))%expr @
+ (#(fancy_subb
+ (Z.log2 s7)
+ offset)%expr @
+ ((##bb)%expr,
+ (##xx)%expr,
+ #(Z_cast ry)%expr @
+ y)))%expr_pat
+ else None)
+ (let (x8, _) :=
+ xv in
+ x8)
+ (let (x8, _) :=
+ xv0 in
+ x8)
+ (let (x8, _) :=
+ xv1 in
+ x8) args2 args0
+ (v
+ (Compile.reflect
+ x7))
+ (let (x8, _) :=
+ xv2 in
+ x8);
+ Some (Base x8));
+ Some
+ (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s6 _ ($_)%expr _ | @expr.App
+ _ _ _ s6 _ (@expr.Abs _ _ _ _ _ _) _ |
+ @expr.App _ _ _ s6 _ (_ @ _)%expr_pat _ |
+ @expr.App _ _ _ s6 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end;;
+ match x6 with
+ | @expr.App _ _ _ s6 _
+ (@expr.Ident _ _ _ t5 idc5) x7 =>
+ match x5 with
+ | @expr.Ident _ _ _ t6 idc6 =>
+ args <- invert_bind_args idc6
+ Raw.ident.Literal;
+ args0 <- invert_bind_args idc5
+ Raw.ident.Z_cast;
+ _ <- invert_bind_args idc4
+ Raw.ident.Z_shiftr;
+ args2 <- invert_bind_args idc3
+ Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc2
+ Raw.ident.Literal;
+ args4 <- invert_bind_args idc1
+ Raw.ident.Literal;
+ args5 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_sub_with_get_borrow;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> (projT1 args4)) ->
+ (projT1 args3)) ->
+ s6 -> (projT1 args))%ptype option
+ (fun x8 : option => x8)
+ with
+ | Some (_, _, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type
+ base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) ->
+ (projT1 args4)) ->
+ (projT1 args3)) ->
+ s6 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args5);
+ xv0 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args4);
+ xv1 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args3);
+ v <- type.try_make_transport_cps s6
+ ℤ;
+ xv2 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x8 <- (let
+ '(r1, r2)%zrange :=
+ range in
+ fun (s7 bb xx : Z)
+ (rshiftr
+ ry : zrange)
+ (y : expr ℤ)
+ (offset : Z) =>
+ if
+ (s7 =?
+ 2 ^ Z.log2 s7) &&
+ (ZRange.normalize
+ ry >>
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize
+ rshiftr)%zrange &&
+ (ZRange.normalize
+ rshiftr <=?
+ r[0 ~> s7 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2
+ (r1, r2))%expr @
+ (#(fancy_subb
+ (Z.log2 s7)
+ (- offset))%expr @
+ ((##bb)%expr,
+ (##xx)%expr,
+ #(Z_cast ry)%expr @
+ y)))%expr_pat
+ else None)
+ (let (x8, _) :=
+ xv in
+ x8)
+ (let (x8, _) :=
+ xv0 in
+ x8)
+ (let (x8, _) :=
+ xv1 in
+ x8) args2 args0
+ (v
+ (Compile.reflect
+ x7))
+ (let (x8, _) :=
+ xv2 in
+ x8);
+ Some (Base x8));
+ Some
+ (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s6 _ ($_)%expr _ | @expr.App
+ _ _ _ s6 _ (@expr.Abs _ _ _ _ _ _) _ |
+ @expr.App _ _ _ s6 _ (_ @ _)%expr_pat _ |
+ @expr.App _ _ _ s6 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | _ => None
+ end;;
+ args <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args0 <- invert_bind_args idc2 Raw.ident.Literal;
+ args1 <- invert_bind_args idc1 Raw.ident.Literal;
+ args2 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_sub_with_get_borrow;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> (projT1 args1)) ->
+ (projT1 args0)) -> s3)%ptype option
+ (fun x5 : option => x5)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> (projT1 args1)) ->
+ (projT1 args0)) -> s3)%ptype
+ then
+ 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 s3 ℤ;
+ fv <- (x5 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s4 bb xx : Z)
+ (ry : zrange) (y : expr ℤ) =>
+ if
+ (s4 =? 2 ^ Z.log2 s4) &&
+ (ZRange.normalize ry <=?
+ r[0 ~> s4 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_subb (Z.log2 s4) 0)%expr @
+ ((##bb)%expr, (##xx)%expr,
+ #(Z_cast ry)%expr @ y)))%expr_pat
+ else None)
+ (let (x5, _) := xv in x5)
+ (let (x5, _) := xv0 in x5)
+ (let (x5, _) := xv1 in x5) args
+ (v (Compile.reflect x4));
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s3 _ ($_)%expr _ | @expr.App _ _ _ s3
+ _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s3 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s3 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t2 idc2) x4 =>
+ match x0 with
+ | @expr.Ident _ _ _ t3 idc3 =>
+ args <- invert_bind_args idc3 Raw.ident.Literal;
+ args0 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args1 <- invert_bind_args idc1 Raw.ident.Literal;
+ args2 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_sub_with_get_borrow;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> (projT1 args1)) -> s3) ->
+ (projT1 args))%ptype option
+ (fun x5 : option => x5)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> (projT1 args1)) -> s3) ->
+ (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ v <- type.try_make_transport_cps s3 ℤ;
+ xv1 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x5 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s4 bb : Z) (rx : zrange)
+ (x5 : expr ℤ) (yy : Z) =>
+ if
+ (s4 =? 2 ^ Z.log2 s4) &&
+ (ZRange.normalize
+ (ZRange.constant yy) <=?
+ r[0 ~> s4 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_subb (Z.log2 s4) 0)%expr @
+ ((##bb)%expr,
+ #(Z_cast rx)%expr @ x5,
+ (##yy)%expr)))%expr_pat
+ else None)
+ (let (x5, _) := xv in x5)
+ (let (x5, _) := xv0 in x5)
+ args0 (v (Compile.reflect x4))
+ (let (x5, _) := xv1 in x5);
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s4 _ (@expr.Ident _ _ _ t3 idc3)
+ x5 =>
+ match x5 with
+ | (@expr.Ident _ _ _ t4 idc4 @ x7 @ x6)%expr_pat =>
+ match x7 with
+ | @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 =>
+ match x6 with
+ | @expr.Ident _ _ _ t6 idc6 =>
+ args <- invert_bind_args idc6
+ Raw.ident.Literal;
+ args0 <- invert_bind_args idc5
+ Raw.ident.Z_cast;
+ _ <- invert_bind_args idc4
+ Raw.ident.Z_shiftl;
+ args2 <- invert_bind_args idc3
+ Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc2
+ Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc1
+ Raw.ident.Literal;
+ args5 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_sub_with_get_borrow;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> (projT1 args4)) ->
+ s3) -> s7 -> (projT1 args))%ptype
+ option (fun x9 : option => x9)
+ with
+ | Some (_, _, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type
+ base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) ->
+ (projT1 args4)) -> s3) ->
+ s7 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args5);
+ xv0 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args4);
+ v <- type.try_make_transport_cps s3
+ ℤ;
+ v0 <- type.try_make_transport_cps s7
+ ℤ;
+ xv1 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x9 <- (let
+ '(r1, r2)%zrange :=
+ range in
+ fun (s8 bb : Z)
+ (rx : zrange)
+ (x9 : expr ℤ)
+ (rshiftl
+ ry : zrange)
+ (y : expr ℤ)
+ (offset : Z) =>
+ if
+ (s8 =?
+ 2 ^ Z.log2 s8) &&
+ (ZRange.normalize
+ ry <<
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize
+ rshiftl)%zrange &&
+ (ZRange.normalize
+ rshiftl <=?
+ r[0 ~> s8 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2
+ (r1, r2))%expr @
+ (#(fancy_subb
+ (Z.log2 s8)
+ offset)%expr @
+ ((##bb)%expr,
+ #(Z_cast rx)%expr @
+ x9,
+ #(Z_cast ry)%expr @
+ y)))%expr_pat
+ else None)
+ (let (x9, _) :=
+ xv in
+ x9)
+ (let (x9, _) :=
+ xv0 in
+ x9) args3
+ (v
+ (Compile.reflect
+ x4)) args2
+ args0
+ (v0
+ (Compile.reflect
+ x8))
+ (let (x9, _) :=
+ xv1 in
+ x9);
+ Some (Base x9));
+ Some
+ (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s7 _ ($_)%expr _ | @expr.App
+ _ _ _ s7 _ (@expr.Abs _ _ _ _ _ _) _ |
+ @expr.App _ _ _ s7 _ (_ @ _)%expr_pat _ |
+ @expr.App _ _ _ s7 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end;;
+ match x7 with
+ | @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 =>
+ match x6 with
+ | @expr.Ident _ _ _ t6 idc6 =>
+ args <- invert_bind_args idc6
+ Raw.ident.Literal;
+ args0 <- invert_bind_args idc5
+ Raw.ident.Z_cast;
+ _ <- invert_bind_args idc4
+ Raw.ident.Z_shiftr;
+ args2 <- invert_bind_args idc3
+ Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc2
+ Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc1
+ Raw.ident.Literal;
+ args5 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_sub_with_get_borrow;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> (projT1 args4)) ->
+ s3) -> s7 -> (projT1 args))%ptype
+ option (fun x9 : option => x9)
+ with
+ | Some (_, _, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type
+ base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) ->
+ (projT1 args4)) -> s3) ->
+ s7 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args5);
+ xv0 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args4);
+ v <- type.try_make_transport_cps s3
+ ℤ;
+ v0 <- type.try_make_transport_cps s7
+ ℤ;
+ xv1 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x9 <- (let
+ '(r1, r2)%zrange :=
+ range in
+ fun (s8 bb : Z)
+ (rx : zrange)
+ (x9 : expr ℤ)
+ (rshiftr
+ ry : zrange)
+ (y : expr ℤ)
+ (offset : Z) =>
+ if
+ (s8 =?
+ 2 ^ Z.log2 s8) &&
+ (ZRange.normalize
+ ry >>
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize
+ rshiftr)%zrange &&
+ (ZRange.normalize
+ rshiftr <=?
+ r[0 ~> s8 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2
+ (r1, r2))%expr @
+ (#(fancy_subb
+ (Z.log2 s8)
+ (- offset))%expr @
+ ((##bb)%expr,
+ #(Z_cast rx)%expr @
+ x9,
+ #(Z_cast ry)%expr @
+ y)))%expr_pat
+ else None)
+ (let (x9, _) :=
+ xv in
+ x9)
+ (let (x9, _) :=
+ xv0 in
+ x9) args3
+ (v
+ (Compile.reflect
+ x4)) args2
+ args0
+ (v0
+ (Compile.reflect
+ x8))
+ (let (x9, _) :=
+ xv1 in
+ x9);
+ Some (Base x9));
+ Some
+ (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s7 _ ($_)%expr _ | @expr.App
+ _ _ _ s7 _ (@expr.Abs _ _ _ _ _ _) _ |
+ @expr.App _ _ _ s7 _ (_ @ _)%expr_pat _ |
+ @expr.App _ _ _ s7 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | _ => None
+ end;;
+ args <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args0 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args1 <- invert_bind_args idc1 Raw.ident.Literal;
+ args2 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_sub_with_get_borrow;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> (projT1 args1)) -> s3) ->
+ s4)%ptype option (fun x6 : option => x6)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> (projT1 args1)) -> s3) ->
+ s4)%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args1);
+ v <- type.try_make_transport_cps s3 ℤ;
+ v0 <- type.try_make_transport_cps s4 ℤ;
+ fv <- (x6 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s5 bb : Z) (rx : zrange)
+ (x6 : expr ℤ) (ry : zrange)
+ (y : expr ℤ) =>
+ if
+ (s5 =? 2 ^ Z.log2 s5) &&
+ (ZRange.normalize ry <=?
+ r[0 ~> s5 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_subb (Z.log2 s5) 0)%expr @
+ ((##bb)%expr,
+ #(Z_cast rx)%expr @ x6,
+ #(Z_cast ry)%expr @ y)))%expr_pat
+ else None)
+ (let (x6, _) := xv in x6)
+ (let (x6, _) := xv0 in x6)
+ args0 (v (Compile.reflect x4))
+ args (v0 (Compile.reflect x5));
+ Some (Base x6));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s4 _ ($_)%expr _ | @expr.App _ _ _ s4
+ _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s4 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s4 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s3 _ ($_)%expr _ | @expr.App _ _ _ s3 _
+ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s3 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s3 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s3 _ (@expr.Ident _ _ _ t1 idc1) x4 =>
+ match x1 with
+ | @expr.Ident _ _ _ t2 idc2 =>
+ match x0 with
+ | @expr.Ident _ _ _ t3 idc3 =>
+ args <- invert_bind_args idc3 Raw.ident.Literal;
+ args0 <- invert_bind_args idc2 Raw.ident.Literal;
+ args1 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args2 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_sub_with_get_borrow;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s3) -> (projT1 args0)) ->
+ (projT1 args))%ptype option
+ (fun x5 : option => x5)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s3) -> (projT1 args0)) ->
+ (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ v <- type.try_make_transport_cps s3 ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ xv1 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x5 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s4 : Z) (rb : zrange)
+ (b2 : expr ℤ) (xx yy : Z) =>
+ if
+ (s4 =? 2 ^ Z.log2 s4) &&
+ (ZRange.normalize
+ (ZRange.constant yy) <=?
+ r[0 ~> s4 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_subb (Z.log2 s4) 0)%expr @
+ (#(Z_cast rb)%expr @ b2,
+ (##xx)%expr, (##yy)%expr)))%expr_pat
+ else None)
+ (let (x5, _) := xv in x5) args1
+ (v (Compile.reflect x4))
+ (let (x5, _) := xv0 in x5)
+ (let (x5, _) := xv1 in x5);
+ Some (Base x5));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s4 _ (@expr.Ident _ _ _ t3 idc3)
+ x5 =>
+ match x5 with
+ | (@expr.Ident _ _ _ t4 idc4 @ x7 @ x6)%expr_pat =>
+ match x7 with
+ | @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 =>
+ match x6 with
+ | @expr.Ident _ _ _ t6 idc6 =>
+ args <- invert_bind_args idc6
+ Raw.ident.Literal;
+ args0 <- invert_bind_args idc5
+ Raw.ident.Z_cast;
+ _ <- invert_bind_args idc4
+ Raw.ident.Z_shiftl;
+ args2 <- invert_bind_args idc3
+ Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc2
+ Raw.ident.Literal;
+ args4 <- invert_bind_args idc1
+ Raw.ident.Z_cast;
+ args5 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_sub_with_get_borrow;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> s3) ->
+ (projT1 args3)) ->
+ s7 -> (projT1 args))%ptype option
+ (fun x9 : option => x9)
+ with
+ | Some (_, _, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type
+ base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> s3) ->
+ (projT1 args3)) ->
+ s7 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args5);
+ v <- type.try_make_transport_cps s3
+ ℤ;
+ xv0 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args3);
+ v0 <- type.try_make_transport_cps s7
+ ℤ;
+ xv1 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x9 <- (let
+ '(r1, r2)%zrange :=
+ range in
+ fun (s8 : Z)
+ (rb : zrange)
+ (b3 : expr ℤ)
+ (xx : Z)
+ (rshiftl
+ ry : zrange)
+ (y : expr ℤ)
+ (offset : Z) =>
+ if
+ (s8 =?
+ 2 ^ Z.log2 s8) &&
+ (ZRange.normalize
+ ry <<
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize
+ rshiftl)%zrange &&
+ (ZRange.normalize
+ rshiftl <=?
+ r[0 ~> s8 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2
+ (r1, r2))%expr @
+ (#(fancy_subb
+ (Z.log2 s8)
+ offset)%expr @
+ (#(Z_cast rb)%expr @
+ b3,
+ (##xx)%expr,
+ #(Z_cast ry)%expr @
+ y)))%expr_pat
+ else None)
+ (let (x9, _) :=
+ xv in
+ x9) args4
+ (v
+ (Compile.reflect
+ x4))
+ (let (x9, _) :=
+ xv0 in
+ x9) args2 args0
+ (v0
+ (Compile.reflect
+ x8))
+ (let (x9, _) :=
+ xv1 in
+ x9);
+ Some (Base x9));
+ Some
+ (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s7 _ ($_)%expr _ | @expr.App
+ _ _ _ s7 _ (@expr.Abs _ _ _ _ _ _) _ |
+ @expr.App _ _ _ s7 _ (_ @ _)%expr_pat _ |
+ @expr.App _ _ _ s7 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end;;
+ match x7 with
+ | @expr.App _ _ _ s7 _
+ (@expr.Ident _ _ _ t5 idc5) x8 =>
+ match x6 with
+ | @expr.Ident _ _ _ t6 idc6 =>
+ args <- invert_bind_args idc6
+ Raw.ident.Literal;
+ args0 <- invert_bind_args idc5
+ Raw.ident.Z_cast;
+ _ <- invert_bind_args idc4
+ Raw.ident.Z_shiftr;
+ args2 <- invert_bind_args idc3
+ Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc2
+ Raw.ident.Literal;
+ args4 <- invert_bind_args idc1
+ Raw.ident.Z_cast;
+ args5 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_sub_with_get_borrow;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> s3) ->
+ (projT1 args3)) ->
+ s7 -> (projT1 args))%ptype option
+ (fun x9 : option => x9)
+ with
+ | Some (_, _, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type
+ base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> s3) ->
+ (projT1 args3)) ->
+ s7 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args5);
+ v <- type.try_make_transport_cps s3
+ ℤ;
+ xv0 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args3);
+ v0 <- type.try_make_transport_cps s7
+ ℤ;
+ xv1 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x9 <- (let
+ '(r1, r2)%zrange :=
+ range in
+ fun (s8 : Z)
+ (rb : zrange)
+ (b3 : expr ℤ)
+ (xx : Z)
+ (rshiftr
+ ry : zrange)
+ (y : expr ℤ)
+ (offset : Z) =>
+ if
+ (s8 =?
+ 2 ^ Z.log2 s8) &&
+ (ZRange.normalize
+ ry >>
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize
+ rshiftr)%zrange &&
+ (ZRange.normalize
+ rshiftr <=?
+ r[0 ~> s8 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2
+ (r1, r2))%expr @
+ (#(fancy_subb
+ (Z.log2 s8)
+ (- offset))%expr @
+ (#(Z_cast rb)%expr @
+ b3,
+ (##xx)%expr,
+ #(Z_cast ry)%expr @
+ y)))%expr_pat
+ else None)
+ (let (x9, _) :=
+ xv in
+ x9) args4
+ (v
+ (Compile.reflect
+ x4))
+ (let (x9, _) :=
+ xv0 in
+ x9) args2 args0
+ (v0
+ (Compile.reflect
+ x8))
+ (let (x9, _) :=
+ xv1 in
+ x9);
+ Some (Base x9));
+ Some
+ (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s7 _ ($_)%expr _ | @expr.App
+ _ _ _ s7 _ (@expr.Abs _ _ _ _ _ _) _ |
+ @expr.App _ _ _ s7 _ (_ @ _)%expr_pat _ |
+ @expr.App _ _ _ s7 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | _ => None
+ end;;
+ args <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args0 <- invert_bind_args idc2 Raw.ident.Literal;
+ args1 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args2 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_sub_with_get_borrow;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s3) -> (projT1 args0)) ->
+ s4)%ptype option (fun x6 : option => x6)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s3) -> (projT1 args0)) ->
+ s4)%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ v <- type.try_make_transport_cps s3 ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args0);
+ v0 <- type.try_make_transport_cps s4 ℤ;
+ fv <- (x6 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s5 : Z) (rb : zrange)
+ (b2 : expr ℤ) (xx : Z)
+ (ry : zrange) (y : expr ℤ) =>
+ if
+ (s5 =? 2 ^ Z.log2 s5) &&
+ (ZRange.normalize ry <=?
+ r[0 ~> s5 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_subb (Z.log2 s5) 0)%expr @
+ (#(Z_cast rb)%expr @ b2,
+ (##xx)%expr,
+ #(Z_cast ry)%expr @ y)))%expr_pat
+ else None)
+ (let (x6, _) := xv in x6) args1
+ (v (Compile.reflect x4))
+ (let (x6, _) := xv0 in x6) args
+ (v0 (Compile.reflect x5));
+ Some (Base x6));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s4 _ ($_)%expr _ | @expr.App _ _ _ s4
+ _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s4 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s4 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s4 _ (@expr.Ident _ _ _ t2 idc2) x5 =>
+ match x0 with
+ | @expr.Ident _ _ _ t3 idc3 =>
+ args <- invert_bind_args idc3 Raw.ident.Literal;
+ args0 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args1 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args2 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_sub_with_get_borrow;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s3) -> s4) ->
+ (projT1 args))%ptype option
+ (fun x6 : option => x6)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s3) -> s4) ->
+ (projT1 args))%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ v <- type.try_make_transport_cps s3 ℤ;
+ v0 <- type.try_make_transport_cps s4 ℤ;
+ xv0 <- ident.unify pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x6 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s5 : Z) (rb : zrange)
+ (b2 : expr ℤ) (rx : zrange)
+ (x6 : expr ℤ) (yy : Z) =>
+ if
+ (s5 =? 2 ^ Z.log2 s5) &&
+ (ZRange.normalize
+ (ZRange.constant yy) <=?
+ r[0 ~> s5 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_subb (Z.log2 s5) 0)%expr @
+ (#(Z_cast rb)%expr @ b2,
+ #(Z_cast rx)%expr @ x6,
+ (##yy)%expr)))%expr_pat
+ else None)
+ (let (x6, _) := xv in x6) args1
+ (v (Compile.reflect x4)) args0
+ (v0 (Compile.reflect x5))
+ (let (x6, _) := xv0 in x6);
+ Some (Base x6));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s5 _ (@expr.Ident _ _ _ t3 idc3)
+ x6 =>
+ match x6 with
+ | (@expr.Ident _ _ _ t4 idc4 @ x8 @ x7)%expr_pat =>
+ match x8 with
+ | @expr.App _ _ _ s8 _
+ (@expr.Ident _ _ _ t5 idc5) x9 =>
+ match x7 with
+ | @expr.Ident _ _ _ t6 idc6 =>
+ args <- invert_bind_args idc6
+ Raw.ident.Literal;
+ args0 <- invert_bind_args idc5
+ Raw.ident.Z_cast;
+ _ <- invert_bind_args idc4
+ Raw.ident.Z_shiftl;
+ args2 <- invert_bind_args idc3
+ Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc2
+ Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc1
+ Raw.ident.Z_cast;
+ args5 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_sub_with_get_borrow;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> s3) -> s4) ->
+ s8 -> (projT1 args))%ptype option
+ (fun x10 : option => x10)
+ with
+ | Some (_, _, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type
+ base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> s3) -> s4) ->
+ s8 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args5);
+ v <- type.try_make_transport_cps s3
+ ℤ;
+ v0 <- type.try_make_transport_cps s4
+ ℤ;
+ v1 <- type.try_make_transport_cps s8
+ ℤ;
+ xv0 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x10 <- (let
+ '(r1, r2)%zrange :=
+ range in
+ fun (s9 : Z)
+ (rb : zrange)
+ (b3 : expr ℤ)
+ (rx : zrange)
+ (x10 : expr ℤ)
+ (rshiftl
+ ry : zrange)
+ (y : expr ℤ)
+ (offset : Z) =>
+ if
+ (s9 =?
+ 2 ^ Z.log2 s9) &&
+ (ZRange.normalize
+ ry <<
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize
+ rshiftl)%zrange &&
+ (ZRange.normalize
+ rshiftl <=?
+ r[0 ~> s9 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2
+ (r1, r2))%expr @
+ (#(fancy_subb
+ (Z.log2
+ s9)
+ offset)%expr @
+ (#(Z_cast rb)%expr @
+ b3,
+ #(Z_cast rx)%expr @
+ x10,
+ #(Z_cast ry)%expr @
+ y)))%expr_pat
+ else None)
+ (let (x10, _) :=
+ xv in
+ x10) args4
+ (v
+ (Compile.reflect
+ x4)) args3
+ (v0
+ (Compile.reflect
+ x5)) args2
+ args0
+ (v1
+ (Compile.reflect
+ x9))
+ (let (x10, _) :=
+ xv0 in
+ x10);
+ Some (Base x10));
+ Some
+ (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s8 _ ($_)%expr _ | @expr.App
+ _ _ _ s8 _ (@expr.Abs _ _ _ _ _ _) _ |
+ @expr.App _ _ _ s8 _ (_ @ _)%expr_pat _ |
+ @expr.App _ _ _ s8 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end;;
+ match x8 with
+ | @expr.App _ _ _ s8 _
+ (@expr.Ident _ _ _ t5 idc5) x9 =>
+ match x7 with
+ | @expr.Ident _ _ _ t6 idc6 =>
+ args <- invert_bind_args idc6
+ Raw.ident.Literal;
+ args0 <- invert_bind_args idc5
+ Raw.ident.Z_cast;
+ _ <- invert_bind_args idc4
+ Raw.ident.Z_shiftr;
+ args2 <- invert_bind_args idc3
+ Raw.ident.Z_cast;
+ args3 <- invert_bind_args idc2
+ Raw.ident.Z_cast;
+ args4 <- invert_bind_args idc1
+ Raw.ident.Z_cast;
+ args5 <- invert_bind_args idc0
+ Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_sub_with_get_borrow;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> s3) -> s4) ->
+ s8 -> (projT1 args))%ptype option
+ (fun x10 : option => x10)
+ with
+ | Some (_, _, _, (_, _))%zrange =>
+ if
+ type.type_beq base.type
+ base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ -> ℤ)%ptype
+ ((((projT1 args5) -> s3) -> s4) ->
+ s8 -> (projT1 args))%ptype
+ then
+ xv <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args5);
+ v <- type.try_make_transport_cps s3
+ ℤ;
+ v0 <- type.try_make_transport_cps s4
+ ℤ;
+ v1 <- type.try_make_transport_cps s8
+ ℤ;
+ xv0 <- ident.unify
+ pattern.ident.Literal
+ ##(projT2 args);
+ fv <- (x10 <- (let
+ '(r1, r2)%zrange :=
+ range in
+ fun (s9 : Z)
+ (rb : zrange)
+ (b3 : expr ℤ)
+ (rx : zrange)
+ (x10 : expr ℤ)
+ (rshiftr
+ ry : zrange)
+ (y : expr ℤ)
+ (offset : Z) =>
+ if
+ (s9 =?
+ 2 ^ Z.log2 s9) &&
+ (ZRange.normalize
+ ry >>
+ ZRange.normalize
+ (ZRange.constant
+ offset) <=?
+ ZRange.normalize
+ rshiftr)%zrange &&
+ (ZRange.normalize
+ rshiftr <=?
+ r[0 ~> s9 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2
+ (r1, r2))%expr @
+ (#(fancy_subb
+ (Z.log2
+ s9)
+ (- offset))%expr @
+ (#(Z_cast rb)%expr @
+ b3,
+ #(Z_cast rx)%expr @
+ x10,
+ #(Z_cast ry)%expr @
+ y)))%expr_pat
+ else None)
+ (let (x10, _) :=
+ xv in
+ x10) args4
+ (v
+ (Compile.reflect
+ x4)) args3
+ (v0
+ (Compile.reflect
+ x5)) args2
+ args0
+ (v1
+ (Compile.reflect
+ x9))
+ (let (x10, _) :=
+ xv0 in
+ x10);
+ Some (Base x10));
+ Some
+ (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | _ => None
+ end
+ | @expr.App _ _ _ s8 _ ($_)%expr _ | @expr.App
+ _ _ _ s8 _ (@expr.Abs _ _ _ _ _ _) _ |
+ @expr.App _ _ _ s8 _ (_ @ _)%expr_pat _ |
+ @expr.App _ _ _ s8 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | _ => None
+ end;;
+ args <- invert_bind_args idc3 Raw.ident.Z_cast;
+ args0 <- invert_bind_args idc2 Raw.ident.Z_cast;
+ args1 <- invert_bind_args idc1 Raw.ident.Z_cast;
+ args2 <- invert_bind_args idc0 Raw.ident.Literal;
+ _ <- invert_bind_args idc
+ Raw.ident.Z_sub_with_get_borrow;
+ match
+ pattern.type.unify_extracted_cps
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s3) -> s4) -> s5)%ptype
+ option (fun x7 : option => x7)
+ with
+ | Some (_, _, _, _)%zrange =>
+ if
+ type.type_beq base.type base.type.type_beq
+ (((ℤ -> ℤ) -> ℤ) -> ℤ)%ptype
+ ((((projT1 args2) -> s3) -> s4) -> s5)%ptype
+ then
+ xv <- ident.unify pattern.ident.Literal
+ ##(projT2 args2);
+ v <- type.try_make_transport_cps s3 ℤ;
+ v0 <- type.try_make_transport_cps s4 ℤ;
+ v1 <- type.try_make_transport_cps s5 ℤ;
+ fv <- (x7 <- (let
+ '(r1, r2)%zrange := range in
+ fun (s6 : Z) (rb : zrange)
+ (b2 : expr ℤ) (rx : zrange)
+ (x7 : expr ℤ) (ry : zrange)
+ (y : expr ℤ) =>
+ if
+ (s6 =? 2 ^ Z.log2 s6) &&
+ (ZRange.normalize ry <=?
+ r[0 ~> s6 - 1])%zrange
+ then
+ Some
+ (#(Z_cast2 (r1, r2))%expr @
+ (#(fancy_subb (Z.log2 s6) 0)%expr @
+ (#(Z_cast rb)%expr @ b2,
+ #(Z_cast rx)%expr @ x7,
+ #(Z_cast ry)%expr @ y)))%expr_pat
+ else None)
+ (let (x7, _) := xv in x7) args1
+ (v (Compile.reflect x4)) args0
+ (v0 (Compile.reflect x5)) args
+ (v1 (Compile.reflect x6));
+ Some (Base x7));
+ Some (fv0 <-- fv;
+ Base fv0)%under_lets
+ else None
+ | None => None
+ end
+ | @expr.App _ _ _ s5 _ ($_)%expr _ | @expr.App _ _ _ s5
+ _ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s5 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s5 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s4 _ ($_)%expr _ | @expr.App _ _ _ s4 _
+ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s4 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s4 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | @expr.App _ _ _ s3 _ ($_)%expr _ | @expr.App _ _ _ s3 _
+ (@expr.Abs _ _ _ _ _ _) _ | @expr.App _ _ _ s3 _
+ (_ @ _)%expr_pat _ | @expr.App _ _ _ s3 _
+ (@expr.LetIn _ _ _ _ _ _ _) _ => None
+ | _ => None
+ end
+ | _ => None
+ end
+ | _ => None
+ end;;
+ None);;;
+ Base (#(Z_cast2 range)%expr @ x)%expr_pat)%option
| fancy_add log2wordmax imm =>
fun x : expr (ℤ * ℤ)%etype =>
Base (#(fancy_add log2wordmax imm)%expr @ x)%expr_pat