From 53da8ba4d1c305bedb55a3a020fcf80f913a174a Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Fri, 2 Sep 2022 10:14:02 +0530 Subject: [PATCH 01/74] Localize extraction of reification tactics This will allow a more local translation of tactics into Ltac2.
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m01.90s | 1376864 ko | Total Time / Peak Mem | 4m02.13s | 1376812 ko || -0m00.23s || 52 ko | -0.09% | +0.00% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.02s | 1103120 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.17s | 1103144 ko || -0m00.14s || -24 ko | -0.27% | -0.00% 0m53.54s | 1376864 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m53.54s | 1376812 ko || +0m00.00s || 52 ko | +0.00% | +0.00% 0m51.74s | 1039212 ko | Rewriter/Rewriter/Examples.vo | 0m51.68s | 1039128 ko || +0m00.06s || 84 ko | +0.11% | +0.00% 0m27.65s | 908896 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.67s | 908964 ko || -0m00.02s || -68 ko | -0.07% | -0.00% 0m23.68s | 885896 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.81s | 885964 ko || -0m00.12s || -68 ko | -0.54% | -0.00% 0m15.73s | 721932 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.68s | 722132 ko || +0m00.05s || -200 ko | +0.31% | -0.02% 0m11.99s | 646256 ko | Rewriter/Demo.vo | 0m12.09s | 646288 ko || -0m00.09s || -32 ko | -0.82% | -0.00% 0m00.79s | 470552 ko | Rewriter/Rewriter/Reify.vo | 0m00.76s | 468044 ko || +0m00.03s || 2508 ko | +3.94% | +0.53% 0m00.72s | 487440 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.74s | 487484 ko || -0m00.02s || -44 ko | -2.70% | -0.00% 0m00.54s | 478328 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.54s | 478340 ko || +0m00.00s || -12 ko | +0.00% | -0.00% 0m00.52s | 492736 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.47s | 492668 ko || +0m00.05s || 68 ko | +10.63% | +0.01% 0m00.52s | 490812 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.53s | 490844 ko || -0m00.01s || -32 ko | -1.88% | -0.00% 0m00.46s | 479456 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.46s | 479140 ko || +0m00.00s || 316 ko | +0.00% | +0.06% ```

--- src/Rewriter/Rewriter/AllTactics.v | 4 +--- src/Rewriter/Rewriter/Reify.v | 22 ++++++++++++++-------- 2 files changed, 15 insertions(+), 11 deletions(-) diff --git a/src/Rewriter/Rewriter/AllTactics.v b/src/Rewriter/Rewriter/AllTactics.v index 43387ccc8..22e4d621e 100644 --- a/src/Rewriter/Rewriter/AllTactics.v +++ b/src/Rewriter/Rewriter/AllTactics.v @@ -146,8 +146,6 @@ Module Compilers. let exprReifyInfo := (eval hnf in (Basic.GoalType.exprReifyInfo basic_package)) in let ident_is_var_like := lazymatch basic_package with {| Basic.GoalType.ident_is_var_like := ?ident_is_var_like |} => ident_is_var_like end in let reify_package := Basic.Tactic.reify_package_of_package basic_package in - let reify_base := Basic.Tactic.reify_base_via_reify_package reify_package in - let reify_ident := Basic.Tactic.reify_ident_via_reify_package reify_package in let pkg_proofs_type := type of pkg_proofs in let pkg := lazymatch (eval hnf in pkg_proofs_type) with @package_proofs ?base ?ident ?pkg => pkg end in let specs := lazymatch type of specs_proofs with @@ -157,7 +155,7 @@ Module Compilers. constr_fail_with ltac:(fun _ => fail 1 "Invalid type for specs_proofs:" T "Expected:" expected_type) end in let R_name := fresh "Rewriter_data" in - let R := Build_RewriterT reify_base reify_ident exprInfo exprExtraInfo pkg ident_is_var_like include_interp skip_early_reduction skip_early_reduction_no_dtree specs in + let R := Build_RewriterT reify_package exprInfo exprExtraInfo pkg ident_is_var_like include_interp skip_early_reduction skip_early_reduction_no_dtree specs in let R := cache_term R R_name in let __ := Make.debug1 ltac:(fun _ => idtac "Proving Rewriter_Wf...") in let Rwf := fresh "Rewriter_Wf" in diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 70530f39f..b3f73064a 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -11,6 +11,7 @@ Require Import Rewriter.Language.Language. Require Import Rewriter.Language.Reify. Require Import Rewriter.Language.UnderLets. Require Import Rewriter.Language.IdentifiersLibrary. +Require Import Rewriter.Language.IdentifiersBasicGenerate. (* For reify*_via_reify_package *) Require Import Rewriter.Rewriter.Rewriter. Require Import Rewriter.Util.LetIn. Require Import Rewriter.Util.Tactics.BreakMatch. @@ -31,6 +32,7 @@ Module Compilers. Export Language.Reify.Compilers. Export UnderLets.Compilers. Export IdentifiersLibrary.Compilers. + Export IdentifiersBasicGenerate.Compilers. Import invert_expr. Export Rewriter.Compilers. @@ -1163,7 +1165,7 @@ Module Compilers. exact v)) in cache_term v rewrite_head. - Ltac Build_rewriter_dataT reify_base reify_ident exprInfo exprExtraInfo pkg ident_is_var_like include_interp skip_early_reduction skip_early_reduction_no_dtree specs := + Ltac Build_rewriter_dataT reify_package exprInfo exprExtraInfo pkg ident_is_var_like include_interp skip_early_reduction skip_early_reduction_no_dtree specs := let pkg_type := type of pkg in let base := lazymatch (eval hnf in pkg_type) with @package ?base ?ident => base end in let ident := lazymatch (eval hnf in pkg_type) with @package ?base ?ident => ident end in @@ -1173,7 +1175,11 @@ Module Compilers. let invert_bind_args_unknown := lazymatch (eval hnf in pkg) with {| invert_bind_args_unknown := ?v |} => v end in let pident_unify_unknown := lazymatch (eval hnf in pkg) with {| unify_unknown := ?v |} => v end in let __ := debug1 ltac:(fun _ => idtac "Reifying...") in - let specs_lems := Reify reify_base reify_ident exprInfo exprExtraInfo pkg ident_is_var_like include_interp specs in + let specs_lems := + let reify_base := Basic.Tactic.reify_base_via_reify_package reify_package in + let reify_ident := Basic.Tactic.reify_ident_via_reify_package reify_package in + + Reify reify_base reify_ident exprInfo exprExtraInfo pkg ident_is_var_like include_interp specs in let dummy_count := lazymatch specs_lems with (?n, ?specs, ?lems) => n end in let specs := lazymatch specs_lems with (?n, ?specs, ?lems) => specs end in let rewrite_rules := lazymatch specs_lems with (?n, ?specs, ?lems) => lems end in @@ -1227,17 +1233,17 @@ Module Compilers. Global Arguments id / . End Settings. - Tactic Notation "make_rewriter_data" tactic3(reify_base) tactic3(reify_ident) constr(exprInfo) constr(exprExtraInfo) constr(pkg) constr(ident_is_var_like) constr(include_interp) constr(skip_early_reduction) constr(skip_early_reduction_no_dtree) constr(specs) := - let res := Build_rewriter_dataT reify_base reify_ident exprInfo exprExtraInfo pkg ident_is_var_like include_interp skip_early_reduction skip_early_reduction_no_dtree specs in refine res. + Tactic Notation "make_rewriter_data" constr(reify_package) constr(exprInfo) constr(exprExtraInfo) constr(pkg) constr(ident_is_var_like) constr(include_interp) constr(skip_early_reduction) constr(skip_early_reduction_no_dtree) constr(specs) := + let res := Build_rewriter_dataT reify_package exprInfo exprExtraInfo pkg ident_is_var_like include_interp skip_early_reduction skip_early_reduction_no_dtree specs in refine res. End Tactic. End Make. Export Make.GoalType. Import Make.Tactic. - Ltac Build_RewriterT reify_base reify_ident exprInfo exprExtraInfo pkg ident_is_var_like include_interp skip_early_reduction skip_early_reduction_no_dtree specs := + Ltac Build_RewriterT reify_package exprInfo exprExtraInfo pkg ident_is_var_like include_interp skip_early_reduction skip_early_reduction_no_dtree specs := let pkg := (eval hnf in pkg) in let rewriter_data := fresh "rewriter_data" in - let data := Make.Build_rewriter_dataT reify_base reify_ident exprInfo exprExtraInfo pkg ident_is_var_like include_interp skip_early_reduction skip_early_reduction_no_dtree specs in + let data := Make.Build_rewriter_dataT reify_package exprInfo exprExtraInfo pkg ident_is_var_like include_interp skip_early_reduction skip_early_reduction_no_dtree specs in let Rewrite_name := fresh "Rewriter" in let Rewrite := (eval cbv [Make.Rewrite rewrite_head Make.GoalType.ident_is_var_like Classes.base Classes.base_interp Classes.ident Classes.buildIdent Classes.invertIdent Classes.try_make_transport_base_cps default_fuel] in (@Make.Rewrite exprInfo exprExtraInfo pkg data)) in let Rewrite := cache_term Rewrite Rewrite_name in @@ -1248,8 +1254,8 @@ Module Compilers. Export Make.Tactic.Settings. End Settings. - Tactic Notation "make_Rewriter" tactic3(reify_base) tactic3(reify_ident) constr(exprInfo) constr(exprExtraInfo) constr(pkg) constr(ident_is_var_like) constr(include_interp) constr(skip_early_reduction) constr(skip_early_reduction_no_dtree) constr(specs) := - let res := Build_RewriterT reify_base reify_ident exprInfo exprExtraInfo pkg ident_is_var_like include_interp skip_early_reduction skip_early_reduction_no_dtree specs in refine res. + Tactic Notation "make_Rewriter" constr(reify_package) constr(exprInfo) constr(exprExtraInfo) constr(pkg) constr(ident_is_var_like) constr(include_interp) constr(skip_early_reduction) constr(skip_early_reduction_no_dtree) constr(specs) := + let res := Build_RewriterT reify_package exprInfo exprExtraInfo pkg ident_is_var_like include_interp skip_early_reduction skip_early_reduction_no_dtree specs in refine res. End Tactic. End RewriteRules. End Compilers. From 56bf995a42b8735b5fdf65aa7104e6cb154311cc Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Fri, 2 Sep 2022 10:37:31 +0530 Subject: [PATCH 02/74] Introduce constr-copying in rewrite reification for Ltac2 perf comparison
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m02.79s | 1401496 ko | Total Time / Peak Mem | 4m02.15s | 1376992 ko || +0m00.63s || 24504 ko | +0.26% | +1.77% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.31s | 1116536 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.04s | 1103040 ko || +0m00.27s || 13496 ko | +0.49% | +1.22% 0m53.62s | 1401496 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m53.77s | 1376992 ko || -0m00.15s || 24504 ko | -0.27% | +1.77% 0m51.84s | 1040520 ko | Rewriter/Rewriter/Examples.vo | 0m51.76s | 1039112 ko || +0m00.08s || 1408 ko | +0.15% | +0.13% 0m27.69s | 897580 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.66s | 908776 ko || +0m00.03s || -11196 ko | +0.10% | -1.23% 0m23.79s | 888660 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.66s | 885944 ko || +0m00.12s || 2716 ko | +0.54% | +0.30% 0m15.80s | 723000 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.61s | 722136 ko || +0m00.19s || 864 ko | +1.21% | +0.11% 0m12.09s | 646684 ko | Rewriter/Demo.vo | 0m12.14s | 646244 ko || -0m00.05s || 440 ko | -0.41% | +0.06% 0m00.85s | 470412 ko | Rewriter/Rewriter/Reify.vo | 0m00.87s | 470296 ko || -0m00.02s || 116 ko | -2.29% | +0.02% 0m00.81s | 487456 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.77s | 487528 ko || +0m00.04s || -72 ko | +5.19% | -0.01% 0m00.55s | 492708 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.48s | 492684 ko || +0m00.07s || 24 ko | +14.58% | +0.00% 0m00.52s | 479364 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.50s | 479412 ko || +0m00.02s || -48 ko | +4.00% | -0.01% 0m00.49s | 490952 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.47s | 490796 ko || +0m00.02s || 156 ko | +4.25% | +0.03% 0m00.43s | 478440 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.43s | 478376 ko || +0m00.00s || 64 ko | +0.00% | +0.01% ```

--- src/Rewriter/Rewriter/Reify.v | 34 ++++++++++++++++++++++++---------- 1 file changed, 24 insertions(+), 10 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index b3f73064a..d32d65662 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -296,9 +296,11 @@ Module Compilers. | ?pat => pat end. - Ltac adjust_pattern_type_variables pat := + Ltac adjust_pattern_type_variables_internal pat := let pat := preadjust_pattern_type_variables pat in adjust_pattern_type_variables' pat. + Ltac adjust_pattern_type_variables pat := + constr:(ltac:(let v := adjust_pattern_type_variables_internal pat in refine v)). Ltac walk_term_under_binders_fail_invalid invalid term fv := lazymatch fv with @@ -341,7 +343,7 @@ Module Compilers. Definition pattern_base_unsubst_default_relax' {base} t evm P := @pattern.base.unsubst_default_relax base P t evm. - Ltac change_pattern_base_subst_default_relax term := + Ltac change_pattern_base_subst_default_relax_internal term := lazymatch (eval pattern (@pattern.base.subst_default_relax), (@pattern.base.unsubst_default_relax) in term) with | ?f _ _ => let base := fresh "base" in @@ -350,8 +352,10 @@ Module Compilers. let evm := fresh "evm" in (eval cbv beta in (f (fun base P t evm => @pattern_base_subst_default_relax' base t evm P) (fun base P t evm => @pattern_base_unsubst_default_relax' base t evm P))) end. + Ltac change_pattern_base_subst_default_relax term := + constr:(ltac:(let v := change_pattern_base_subst_default_relax_internal term in refine v)). - Ltac adjust_lookup_default rewr := + Ltac adjust_lookup_default_internal rewr := lazymatch (eval pattern (@pattern.base.lookup_default) in rewr) with | ?rewr _ => let base := fresh "base" in @@ -359,8 +363,10 @@ Module Compilers. let evm := fresh "evm" in (eval cbv beta in (rewr (fun base p evm => @pattern.base.subst_default base (pattern.base.type.var p) evm))) end. + Ltac adjust_lookup_default rewr := + constr:(ltac:(let v := adjust_lookup_default_internal rewr in refine v)). - Ltac replace_evar_map evm rewr := + Ltac replace_evar_map_internal evm rewr := let evm' := match rewr with | context[pattern.base.lookup_default _ ?evm'] => let __ := match goal with _ => tryif constr_eq evm evm' then fail else idtac end in @@ -376,10 +382,12 @@ Module Compilers. => let rewr := lazymatch (eval pattern evm' in rewr) with | ?rewr _ => (eval cbv beta in (rewr evm)) end in - replace_evar_map evm rewr + replace_evar_map_internal evm rewr end. + Ltac replace_evar_map evm rewr := + constr:(ltac:(let v := replace_evar_map_internal evm rewr in refine v)). - Ltac adjust_type_variables rewr := + Ltac adjust_type_variables_internal rewr := lazymatch rewr with | context[@pattern.base.subst_default ?base (pattern.base.relax ?t) ?evm''] => let t' := constr:(@pattern.base.subst_default base (pattern.base.relax t) evm'') in @@ -393,20 +401,24 @@ Module Compilers. | ?rewr _ _ _ => (eval cbv beta in (rewr t (fun P x => x) (fun P x => x))) end in - adjust_type_variables rewr + adjust_type_variables_internal rewr | _ => rewr end. + Ltac adjust_type_variables rewr := + constr:(ltac:(let v := adjust_type_variables_internal rewr in refine v)). - Ltac replace_type_try_transport term := + Ltac replace_type_try_transport_internal term := lazymatch term with | context[@type.try_transport ?base_type ?try_make_transport_base_type_cps ?P ?t ?t] => let v := constr:(@type.try_transport base_type try_make_transport_base_type_cps P t t) in let term := lazymatch (eval pattern v in term) with | ?term _ => (eval cbv beta in (term (@Some _))) end in - replace_type_try_transport term + replace_type_try_transport_internal term | _ => term end. + Ltac replace_type_try_transport term := + constr:(ltac:(let v := replace_type_try_transport_internal term in refine v)). Ltac under_binders payload term cont ctx := lazymatch term with @@ -526,7 +538,7 @@ Module Compilers. term end. - Ltac clean_beq base_interp_beq only_eliminate_in_ctx term := + Ltac clean_beq_internal base_interp_beq only_eliminate_in_ctx term := let base_interp_beq_head := head base_interp_beq in let term := (eval cbn [Prod.prod_beq] in term) in let term := (eval cbv [ident.literal] in term) in @@ -534,6 +546,8 @@ Module Compilers. let term := (eval cbv [base.interp_beq base_interp_beq_head] in term) in let term := remove_andb_true term in term. + Ltac clean_beq base_interp_beq only_eliminate_in_ctx term := + constr:(ltac:(let v := clean_beq_internal base_interp_beq only_eliminate_in_ctx term in refine v)). Ltac adjust_side_conditions_for_gets_inlined' value_ctx side_conditions lookup_gets_inlined := lazymatch side_conditions with From 0b4cc6ca4d412002bf09b49ee7bdba3219a52821 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sun, 25 Sep 2022 19:47:08 +0530 Subject: [PATCH 03/74] Use Constr.equal_nounivs instead of Constr.equal to fix lookup
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m03.03s | 1382744 ko | Total Time / Peak Mem | 4m03.36s | 1401484 ko || -0m00.33s || -18740 ko | -0.13% | -1.33% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.33s | 1104396 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.41s | 1116644 ko || -0m00.07s || -12248 ko | -0.14% | -1.09% 0m53.55s | 1382744 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m53.69s | 1401484 ko || -0m00.14s || -18740 ko | -0.26% | -1.33% 0m51.58s | 1056016 ko | Rewriter/Rewriter/Examples.vo | 0m51.59s | 1040380 ko || -0m00.01s || 15636 ko | -0.01% | +1.50% 0m27.73s | 914752 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.69s | 897600 ko || +0m00.03s || 17152 ko | +0.14% | +1.91% 0m23.79s | 875732 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.81s | 888612 ko || -0m00.01s || -12880 ko | -0.08% | -1.44% 0m15.78s | 729904 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.79s | 723052 ko || -0m00.00s || 6852 ko | -0.06% | +0.94% 0m12.03s | 634432 ko | Rewriter/Demo.vo | 0m12.09s | 646828 ko || -0m00.06s || -12396 ko | -0.49% | -1.91% 0m00.86s | 470988 ko | Rewriter/Rewriter/Reify.vo | 0m00.79s | 470580 ko || +0m00.06s || 408 ko | +8.86% | +0.08% 0m00.75s | 488012 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.74s | 487452 ko || +0m00.01s || 560 ko | +1.35% | +0.11% 0m00.51s | 481836 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.52s | 492544 ko || -0m00.01s || -10708 ko | -1.92% | -2.17% 0m00.48s | 479952 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.47s | 479456 ko || +0m00.01s || 496 ko | +2.12% | +0.10% 0m00.46s | 491400 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.46s | 490744 ko || +0m00.00s || 656 ko | +0.00% | +0.13% 0m00.46s | 478616 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.51s | 478332 ko || -0m00.04s || 284 ko | -9.80% | +0.05% 0m00.39s | 440952 ko | Rewriter/Language/IdentifiersBasicGenerate.vo | 0m00.44s | 440700 ko || -0m00.04s || 252 ko | -11.36% | +0.05% 0m00.34s | 426516 ko | Rewriter/Language/Reify.vo | 0m00.37s | 426284 ko || -0m00.02s || 232 ko | -8.10% | +0.05% ```

--- .../Language/IdentifiersBasicGenerate.v | 21 ++++++++++--------- src/Rewriter/Language/Reify.v | 7 ++++--- 2 files changed, 15 insertions(+), 13 deletions(-) diff --git a/src/Rewriter/Language/IdentifiersBasicGenerate.v b/src/Rewriter/Language/IdentifiersBasicGenerate.v index 24116376c..32efc57a8 100644 --- a/src/Rewriter/Language/IdentifiersBasicGenerate.v +++ b/src/Rewriter/Language/IdentifiersBasicGenerate.v @@ -19,6 +19,7 @@ Require Import Rewriter.Util.Bool. Require Import Rewriter.Util.Bool.Reflect. Require Rewriter.Util.TypeList. Require Rewriter.Util.PrimitiveHList. +Require Rewriter.Util.Tactics2.Constr. Require Import Rewriter.Util.Notations. Require Import Rewriter.Util.Tactics.RunTacticAsConstr. Require Import Rewriter.Util.Tactics.DebugPrint. @@ -500,7 +501,7 @@ Module Compilers. Reify.debug_enter_reify "reify_base_via_list" ty; let rty := match! all_base_and_interp with | context[Datatypes.cons (?rty, ?ty')] - => if Constr.equal ty ty' + => if Constr.equal_nounivs ty ty' then Some rty else Control.zero Match_failure | _ => None @@ -511,15 +512,15 @@ Module Compilers. => (* work around COQBUG(https://github.com/coq/coq/issues/13962) *) match! ty with | ?base_interp' ?t - => if Constr.equal base_interp' base_interp + => if Constr.equal_nounivs base_interp' base_interp then Some t else Control.zero Match_failure | @base.interp ?base' ?base_interp' (@base.type.type_base ?base' ?t) - => if Constr.equal base_interp' base_interp && Constr.equal base base + => if Constr.equal_nounivs base_interp' base_interp && Constr.equal_nounivs base' base then Some t else Control.zero Match_failure | @type.interp (base.type ?base') (@base.interp ?base' ?base_interp') (@Compilers.type.base (base.type ?base') (@base.type.type_base ?base' ?t)) - => if Constr.equal base_interp' base_interp && Constr.equal base base + => if Constr.equal_nounivs base_interp' base_interp && Constr.equal_nounivs base' base then Some t else Control.zero Match_failure | _ => None @@ -1100,7 +1101,7 @@ Module Compilers. Ltac2 base_type_reified_hint (base_type : constr) (reify_type : constr -> constr) : unit := lazy_match! goal with | [ |- @type.reified_of ?base_type' _ ?t ?e ] - => if Constr.equal base_type' base_type + => if Constr.equal_nounivs base_type' base_type then (* solve [ *) let rt := reify_type t in unify $e $rt; reflexivity (* | idtac "ERROR: Failed to reify" T ] *) else Control.zero Match_failure end. @@ -1108,7 +1109,7 @@ Module Compilers. Ltac2 expr_reified_hint (base_type : constr) (ident : constr) (reify_base_type : constr -> constr) (reify_ident_opt : binder list -> constr -> constr option) := lazy_match! goal with | [ |- @expr.Reified_of _ ?ident' _ _ ?t ?v ?e ] - => if Constr.equal ident ident' + => if Constr.equal_nounivs ident ident' then (*solve [ *) let rv := expr._Reify base_type ident reify_base_type reify_ident_opt v in unify $e $rv; reflexivity (* | idtac "ERROR: Failed to reify" v "(of type" t "); try setting Reify.debug_level to see output" ] *) else Control.zero Match_failure end. @@ -1189,7 +1190,7 @@ Module Compilers. match Constr.Unsafe.kind term with | Constr.Unsafe.Cast term _ _ => is_recursively_constructor_or_literal term | Constr.Unsafe.App f args - => if Constr.equal f '@ident.literal + => if Constr.equal_nounivs f '@ident.literal then true else is_recursively_constructor_or_literal f @@ -1225,7 +1226,7 @@ Module Compilers. (* [match term with ident_interp _ ?idc => Some idc | _ => None end], except robust against open terms *) lazy_match! term with | ?ident_interp' _ ?idc - => if Constr.equal ident_interp ident_interp' + => if Constr.equal_nounivs ident_interp ident_interp' then Some idc else None | _ => None @@ -1239,7 +1240,7 @@ Module Compilers. let ident_Literal := let idc := '(@ident.literal) in let found := match! all_ident_and_interp with | context[GallinaAndReifiedIdentList.cons ?ridc ?idc'] - => if Constr.equal idc idc' + => if Constr.equal_nounivs idc idc' then Some ridc else Control.zero Match_failure | _ => None @@ -1272,7 +1273,7 @@ Module Compilers. => Reify.debug_enter_lookup_ident "reify_ident_via_list_opt" idc; let found := match! all_ident_and_interp with | context[GallinaAndReifiedIdentList.cons ?ridc ?idc'] - => if Constr.equal idc idc' + => if Constr.equal_nounivs idc idc' then Some ridc else Control.zero Match_failure | _ => None diff --git a/src/Rewriter/Language/Reify.v b/src/Rewriter/Language/Reify.v index b370fa3d7..f65b0342a 100644 --- a/src/Rewriter/Language/Reify.v +++ b/src/Rewriter/Language/Reify.v @@ -28,6 +28,7 @@ Require Rewriter.Util.Tactics2.Ltac1. Require Rewriter.Util.Tactics2.Message. Require Rewriter.Util.Tactics2.Ident. Require Rewriter.Util.Tactics2.String. +Require Rewriter.Util.Tactics2.Constr. Require Import Rewriter.Util.Tactics2.Constr.Unsafe.MakeAbbreviations. Import Coq.Lists.List ListNotations. Export Language.PreCommon. @@ -679,11 +680,11 @@ Module Compilers. { contents := (avoid, []) }. Ltac2 find_opt (term : constr) (cache : t) : elem option := let (_, cache) := cache.(contents) in - List.assoc_opt Constr.equal term cache. + List.assoc_opt Constr.equal_nounivs term cache. Ltac2 Type exn ::= [ Cache_contains_element (constr, constr, constr, elem) ]. Ltac2 add (head_constant : constr) (term : constr) (rterm : constr) (cache : t) : ident (* newly bound name *) := let (avoid, known) := cache.(contents) in - match List.assoc_opt Constr.equal term known with + match List.assoc_opt Constr.equal_nounivs term known with | Some e => Control.throw (Cache_contains_element head_constant term rterm e) | None @@ -789,7 +790,7 @@ Module Compilers. (reify_rec_gen f (x :: ctx_tys) (rt :: var_ty_ctx) template_ctx))) | Constr.Unsafe.App c args => Reify.debug_enter_reify_case "expr.reify_in_context" "App (check LetIn)" term; - if Constr.equal c '@Let_In + if Constr.equal_nounivs c '@Let_In then if Int.equal (Array.length args) 4 then Reify.debug_enter_reify_case "expr.reify_in_context" "LetIn" term; let (ta, tb, a, b) := (Array.get args 0, Array.get args 1, Array.get args 2, Array.get args 3) in From 50dc8a24f9dec4c7d14e5eee0c4bf1dfed96550d Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 12:24:59 +0530 Subject: [PATCH 04/74] Use external `Ltac2.Constr.eq_nounivs` instead
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m03.26s | 1402364 ko | Total Time / Peak Mem | 4m03.47s | 1382724 ko || -0m00.21s || 19640 ko | -0.09% | +1.42% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.60s | 1117092 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.47s | 1104192 ko || +0m00.13s || 12900 ko | +0.23% | +1.16% 0m53.42s | 1402364 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m53.69s | 1382724 ko || -0m00.26s || 19640 ko | -0.50% | +1.42% 0m51.55s | 1040576 ko | Rewriter/Rewriter/Examples.vo | 0m51.54s | 1055888 ko || +0m00.00s || -15312 ko | +0.01% | -1.45% 0m27.66s | 898700 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.65s | 914664 ko || +0m00.01s || -15964 ko | +0.03% | -1.74% 0m23.66s | 888832 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.82s | 875620 ko || -0m00.16s || 13212 ko | -0.67% | +1.50% 0m15.63s | 723296 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.79s | 730012 ko || -0m00.15s || -6716 ko | -1.01% | -0.91% 0m12.07s | 637060 ko | Rewriter/Demo.vo | 0m12.08s | 634364 ko || -0m00.00s || 2696 ko | -0.08% | +0.42% 0m00.83s | 488144 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.81s | 488024 ko || +0m00.01s || 120 ko | +2.46% | +0.02% 0m00.77s | 471036 ko | Rewriter/Rewriter/Reify.vo | 0m00.79s | 470944 ko || -0m00.02s || 92 ko | -2.53% | +0.01% 0m00.58s | 481688 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.52s | 481872 ko || +0m00.05s || -184 ko | +11.53% | -0.03% 0m00.57s | 478404 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.49s | 478388 ko || +0m00.07s || 16 ko | +16.32% | +0.00% 0m00.51s | 480104 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.42s | 479912 ko || +0m00.09s || 192 ko | +21.42% | +0.04% 0m00.47s | 480020 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.49s | 491188 ko || -0m00.02s || -11168 ko | -4.08% | -2.27% 0m00.44s | 441072 ko | Rewriter/Language/IdentifiersBasicGenerate.vo | 0m00.38s | 440868 ko || +0m00.06s || 204 ko | +15.78% | +0.04% 0m00.39s | 426368 ko | Rewriter/Language/Reify.vo | 0m00.39s | 426576 ko || +0m00.00s || -208 ko | +0.00% | -0.04% 0m00.04s | 75656 ko | Rewriter/Util/Tactics2/DecomposeLambda.vo | 0m00.07s | 75896 ko || -0m00.03s || -240 ko | -42.85% | -0.31% 0m00.04s | 76032 ko | Rewriter/Util/Tactics2/ReplaceByPattern.vo | 0m00.05s | 75892 ko || -0m00.01s || 140 ko | -20.00% | +0.18% 0m00.03s | 75792 ko | Rewriter/Util/Tactics2/Constr.vo | 0m00.03s | 75920 ko || +0m00.00s || -128 ko | +0.00% | -0.16% ```

--- src/Rewriter/Util/Tactics2/Constr.v | 120 +--------------------------- 1 file changed, 3 insertions(+), 117 deletions(-) diff --git a/src/Rewriter/Util/Tactics2/Constr.v b/src/Rewriter/Util/Tactics2/Constr.v index 6442abe5f..ba97e745e 100644 --- a/src/Rewriter/Util/Tactics2/Constr.v +++ b/src/Rewriter/Util/Tactics2/Constr.v @@ -4,6 +4,8 @@ Require Rewriter.Util.Tactics2.Array. Require Rewriter.Util.Tactics2.Proj. Require Rewriter.Util.Tactics2.Option. Require Import Rewriter.Util.Tactics2.Iterate. +Local Set Warnings Append "-masking-absolute-name". +Require Import Rewriter.Util.plugins.Ltac2Extra. Import Ltac2.Constr. Import Ltac2.Bool. @@ -66,120 +68,4 @@ Module Unsafe. End Unsafe. Import Unsafe. -Ltac2 rec equal_nounivs (x : constr) (y : constr) : bool := - let kind := Unsafe.kind_nocast in - if Constr.equal x y - then true - else match kind x with - | Cast x _ _ => equal_nounivs x y - | App fx xs - => match kind y with - | App fy ys - => equal_nounivs fx fy - && Array.equal equal_nounivs xs ys - | _ => false - end - | Rel _ => false - | Var _ => false - | Meta _ => false - | Uint63 _ => false - | Float _ => false - | Evar ex instx - => match kind y with - | Evar ey insty - => let inst := Array.empty () in - if Constr.equal (make (Evar ex inst)) (make (Evar ey inst)) - then Array.equal equal_nounivs instx insty - else false - | _ => false - end - | Sort sx - => match kind y with - | Sort sy => true - | _ => false - end - | Prod xb fx - => match kind y with - | Prod yb fy - => equal_nounivs (Binder.type xb) (Binder.type yb) && equal_nounivs fx fy - | _ => false - end - | Lambda xb fx - => match kind y with - | Lambda yb fy - => equal_nounivs (Binder.type xb) (Binder.type yb) && equal_nounivs fx fy - | _ => false - end - | LetIn xb xv fx - => match kind y with - | LetIn yb yv fy - => equal_nounivs (Binder.type xb) (Binder.type yb) && equal_nounivs xv yv && equal_nounivs fx fy - | _ => false - end - | Constant cx instx - => match kind y with - | Constant cy insty - => Constr.equal (make (Constant cx instx)) (make (Constant cy instx)) - | _ => false - end - | Ind ix instx - => match kind y with - | Ind iy insty - => Ind.equal ix iy - | _ => false - end - | Constructor cx instx - => match kind y with - | Constructor cy insty - => Constr.equal (make (Constructor cx instx)) (make (Constructor cy instx)) - | _ => false - end - | Fix xa xi xb xf - => match kind y with - | Fix ya yi yb yf - => Array.equal Int.equal xa ya - && Int.equal xi yi - && Array.equal (fun b1 b2 => equal_nounivs (Binder.type b1) (Binder.type b2)) xb yb - && Array.equal equal_nounivs xf yf - | _ => false - end - | CoFix xi xb xf - => match kind y with - | CoFix yi yb yf - => Int.equal xi yi - && Array.equal (fun b1 b2 => equal_nounivs (Binder.type b1) (Binder.type b2)) xb yb - && Array.equal equal_nounivs xf yf - | _ => false - end - | Proj px cx - => match kind y with - | Proj py cy - => Proj.equal px py && equal_nounivs cx cy - | _ => false - end - | Array _ x1 x2 x3 - => match kind y with - | Array _ y1 y2 y3 - => Array.equal equal_nounivs x1 y1 - && equal_nounivs x2 y2 - && equal_nounivs x3 y3 - | _ => false - end - | Case cx x1 cix x2 x3 - => match kind y with - | Case cy y1 ciy y2 y3 - => Option.equal (Array.equal equal_nounivs) - (match cix with - | NoInvert => None - | CaseInvert cix => Some cix - end) - (match cix with - | NoInvert => None - | CaseInvert ciy => Some ciy - end) - && equal_nounivs x1 y1 - && equal_nounivs x2 y2 - && Array.equal equal_nounivs x3 y3 - | _ => false - end - end. +Ltac2 equal_nounivs : constr -> constr -> bool := Ltac2.Constr.equal_nounivs. From f92ad79ede4382ea7a71b1b4e5a3eb3cbda862ff Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 12:27:18 +0530 Subject: [PATCH 05/74] Import Rewriter.Util.Tactics2.FixNotationsForPerformance in Language.Reify
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m03.28s | 1402504 ko | Total Time / Peak Mem | 4m03.80s | 1402288 ko || -0m00.51s || 216 ko | -0.20% | +0.01% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.52s | 1117128 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.41s | 1117188 ko || +0m00.11s || -60 ko | +0.20% | -0.00% 0m53.55s | 1402504 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m53.81s | 1402288 ko || -0m00.26s || 216 ko | -0.48% | +0.01% 0m51.68s | 1066048 ko | Rewriter/Rewriter/Examples.vo | 0m51.68s | 1040780 ko || +0m00.00s || 25268 ko | +0.00% | +2.42% 0m27.71s | 898760 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.72s | 898688 ko || -0m00.00s || 72 ko | -0.03% | +0.00% 0m23.84s | 888908 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.87s | 888892 ko || -0m00.03s || 16 ko | -0.12% | +0.00% 0m15.76s | 723340 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.79s | 723320 ko || -0m00.02s || 20 ko | -0.18% | +0.00% 0m12.05s | 637304 ko | Rewriter/Demo.vo | 0m12.07s | 637020 ko || -0m00.01s || 284 ko | -0.16% | +0.04% 0m00.75s | 488220 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.81s | 487996 ko || -0m00.06s || 224 ko | -7.40% | +0.04% 0m00.74s | 471072 ko | Rewriter/Rewriter/Reify.vo | 0m00.84s | 471024 ko || -0m00.09s || 48 ko | -11.90% | +0.01% 0m00.52s | 478596 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.57s | 478560 ko || -0m00.04s || 36 ko | -8.77% | +0.00% 0m00.49s | 481904 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.57s | 481824 ko || -0m00.07s || 80 ko | -14.03% | +0.01% 0m00.47s | 480212 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.45s | 479716 ko || +0m00.01s || 496 ko | +4.44% | +0.10% 0m00.43s | 480272 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.48s | 480048 ko || -0m00.04s || 224 ko | -10.41% | +0.04% 0m00.40s | 428104 ko | Rewriter/Language/Reify.vo | 0m00.32s | 426460 ko || +0m00.08s || 1644 ko | +25.00% | +0.38% 0m00.38s | 441196 ko | Rewriter/Language/IdentifiersBasicGenerate.vo | 0m00.41s | 441020 ko || -0m00.02s || 176 ko | -7.31% | +0.03% ```

--- src/Rewriter/Language/Reify.v | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Rewriter/Language/Reify.v b/src/Rewriter/Language/Reify.v index f65b0342a..79fec24d1 100644 --- a/src/Rewriter/Language/Reify.v +++ b/src/Rewriter/Language/Reify.v @@ -30,6 +30,7 @@ Require Rewriter.Util.Tactics2.Ident. Require Rewriter.Util.Tactics2.String. Require Rewriter.Util.Tactics2.Constr. Require Import Rewriter.Util.Tactics2.Constr.Unsafe.MakeAbbreviations. +Require Import Rewriter.Util.Tactics2.FixNotationsForPerformance. Import Coq.Lists.List ListNotations. Export Language.PreCommon. From 5ed770b639cf6af4267a699827d83fbbcdc5531a Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 12:27:58 +0530 Subject: [PATCH 06/74] Less retyping in Language.Reify..type.reify
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m03.92s | 1398340 ko | Total Time / Peak Mem | 4m03.08s | 1402496 ko || +0m00.84s || -4156 ko | +0.34% | -0.29% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.47s | 1109872 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.15s | 1117172 ko || +0m00.32s || -7300 ko | +0.59% | -0.65% 0m53.77s | 1398340 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m53.58s | 1402496 ko || +0m00.19s || -4156 ko | +0.35% | -0.29% 0m51.79s | 1066608 ko | Rewriter/Rewriter/Examples.vo | 0m51.77s | 1066076 ko || +0m00.01s || 532 ko | +0.03% | +0.04% 0m27.80s | 898076 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.77s | 898748 ko || +0m00.03s || -672 ko | +0.10% | -0.07% 0m23.80s | 882992 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.73s | 888732 ko || +0m00.07s || -5740 ko | +0.29% | -0.64% 0m15.74s | 724440 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.72s | 723316 ko || +0m00.01s || 1124 ko | +0.12% | +0.15% 0m12.12s | 637516 ko | Rewriter/Demo.vo | 0m12.01s | 637264 ko || +0m00.10s || 252 ko | +0.91% | +0.03% 0m00.83s | 471136 ko | Rewriter/Rewriter/Reify.vo | 0m00.80s | 471132 ko || +0m00.02s || 4 ko | +3.74% | +0.00% 0m00.75s | 488100 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.79s | 488000 ko || -0m00.04s || 100 ko | -5.06% | +0.02% 0m00.54s | 478548 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.48s | 478664 ko || +0m00.06s || -116 ko | +12.50% | -0.02% 0m00.52s | 481920 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.51s | 481904 ko || +0m00.01s || 16 ko | +1.96% | +0.00% 0m00.48s | 480208 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.49s | 480336 ko || -0m00.01s || -128 ko | -2.04% | -0.02% 0m00.47s | 480180 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.51s | 480028 ko || -0m00.04s || 152 ko | -7.84% | +0.03% 0m00.44s | 441224 ko | Rewriter/Language/IdentifiersBasicGenerate.vo | 0m00.43s | 441176 ko || +0m00.01s || 48 ko | +2.32% | +0.01% 0m00.40s | 427988 ko | Rewriter/Language/Reify.vo | 0m00.34s | 428092 ko || +0m00.06s || -104 ko | +17.64% | -0.02% ```

--- src/Rewriter/Language/Reify.v | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Rewriter/Language/Reify.v b/src/Rewriter/Language/Reify.v index 79fec24d1..841d30338 100644 --- a/src/Rewriter/Language/Reify.v +++ b/src/Rewriter/Language/Reify.v @@ -286,7 +286,7 @@ Module Compilers. Reify.debug_enter_reify "type.reify" ty; let reify_rec (t : constr) := reify base_reify base_type t in let res := - lazy_match! (eval cbv beta in $ty) with + lazy_match! (eval cbv beta in ty) with | ?a -> ?b => let ra := reify_rec a in let rb := reify_rec b in From 616b77af807fd2faa22d6d629aeef675910a9cde Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 12:29:38 +0530 Subject: [PATCH 07/74] Less constr subst in Language.Reify..type.reify
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m03.68s | 1419796 ko | Total Time / Peak Mem | 4m01.59s | 1398400 ko || +0m02.09s || 21396 ko | +0.86% | +1.53% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m53.60s | 1419796 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m52.15s | 1398400 ko || +0m01.45s || 21396 ko | +2.78% | +1.53% 0m54.70s | 1073328 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.38s | 1109760 ko || +0m00.32s || -36432 ko | +0.58% | -3.28% 0m51.79s | 1067168 ko | Rewriter/Rewriter/Examples.vo | 0m51.61s | 1066552 ko || +0m00.17s || 616 ko | +0.34% | +0.05% 0m27.83s | 908216 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.69s | 898004 ko || +0m00.13s || 10212 ko | +0.50% | +1.13% 0m23.59s | 873784 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.69s | 882832 ko || -0m00.10s || -9048 ko | -0.42% | -1.02% 0m15.75s | 730200 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.75s | 723640 ko || +0m00.00s || 6560 ko | +0.00% | +0.90% 0m12.12s | 638704 ko | Rewriter/Demo.vo | 0m12.10s | 637432 ko || +0m00.01s || 1272 ko | +0.16% | +0.19% 0m00.86s | 471204 ko | Rewriter/Rewriter/Reify.vo | 0m00.82s | 471216 ko || +0m00.04s || -12 ko | +4.87% | -0.00% 0m00.73s | 488168 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.78s | 488160 ko || -0m00.05s || 8 ko | -6.41% | +0.00% 0m00.53s | 480044 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.40s | 480016 ko || +0m00.13s || 28 ko | +32.50% | +0.00% 0m00.49s | 481848 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.53s | 481932 ko || -0m00.04s || -84 ko | -7.54% | -0.01% 0m00.47s | 478656 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.44s | 478712 ko || +0m00.02s || -56 ko | +6.81% | -0.01% 0m00.46s | 480328 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.45s | 480304 ko || +0m00.01s || 24 ko | +2.22% | +0.00% 0m00.39s | 440996 ko | Rewriter/Language/IdentifiersBasicGenerate.vo | 0m00.42s | 441160 ko || -0m00.02s || -164 ko | -7.14% | -0.03% 0m00.38s | 428424 ko | Rewriter/Language/Reify.vo | 0m00.39s | 428224 ko || -0m00.01s || 200 ko | -2.56% | +0.04% ```

--- src/Rewriter/Language/Reify.v | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Rewriter/Language/Reify.v b/src/Rewriter/Language/Reify.v index 841d30338..ca8175402 100644 --- a/src/Rewriter/Language/Reify.v +++ b/src/Rewriter/Language/Reify.v @@ -284,16 +284,17 @@ Module Compilers. Import Language.Compilers.type. Ltac2 rec reify (base_reify : constr -> constr) (base_type : constr) (ty : constr) := Reify.debug_enter_reify "type.reify" ty; + let debug_Constr_check := Reify.Constr.debug_check_strict "type.reify" in let reify_rec (t : constr) := reify base_reify base_type t in let res := lazy_match! (eval cbv beta in ty) with | ?a -> ?b => let ra := reify_rec a in let rb := reify_rec b in - '(@arrow $base_type $ra $rb) + debug_Constr_check (fun () => mkApp '@arrow [base_type; ra; rb]) | @interp _ _ ?t => t | _ => let rt := base_reify ty in - '(@base $base_type $rt) + debug_Constr_check (fun () => mkApp '@base [base_type; rt]) end in Reify.debug_leave_reify_success "type.reify" ty res; res. From 3796d14723b593910d2747a80cc424aff6c883b4 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 20:41:35 +0530 Subject: [PATCH 08/74] Remove debug if statements from Language.Reify..type.reify
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m03.25s | 1428916 ko | Total Time / Peak Mem | 4m03.51s | 1420016 ko || -0m00.25s || 8900 ko | -0.10% | +0.62% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.30s | 1112884 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.60s | 1073428 ko || -0m00.30s || 39456 ko | -0.54% | +3.67% 0m53.72s | 1428916 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m53.79s | 1420016 ko || -0m00.07s || 8900 ko | -0.13% | +0.62% 0m51.62s | 1067680 ko | Rewriter/Rewriter/Examples.vo | 0m51.72s | 1067096 ko || -0m00.10s || 584 ko | -0.19% | +0.05% 0m27.95s | 905604 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.86s | 908320 ko || +0m00.08s || -2716 ko | +0.32% | -0.29% 0m23.73s | 884116 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.61s | 873692 ko || +0m00.12s || 10424 ko | +0.50% | +1.19% 0m15.73s | 727240 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.58s | 730048 ko || +0m00.15s || -2808 ko | +0.96% | -0.38% 0m11.98s | 632632 ko | Rewriter/Demo.vo | 0m11.99s | 638760 ko || -0m00.00s || -6128 ko | -0.08% | -0.95% 0m00.81s | 471184 ko | Rewriter/Rewriter/Reify.vo | 0m00.80s | 471240 ko || +0m00.01s || -56 ko | +1.25% | -0.01% 0m00.77s | 488224 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.74s | 488200 ko || +0m00.03s || 24 ko | +4.05% | +0.00% 0m00.51s | 482036 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.56s | 481752 ko || -0m00.05s || 284 ko | -8.92% | +0.05% 0m00.50s | 478624 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.46s | 478696 ko || +0m00.03s || -72 ko | +8.69% | -0.01% 0m00.49s | 480388 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.52s | 480160 ko || -0m00.03s || 228 ko | -5.76% | +0.04% 0m00.42s | 480036 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.52s | 479976 ko || -0m00.10s || 60 ko | -19.23% | +0.01% 0m00.41s | 441196 ko | Rewriter/Language/IdentifiersBasicGenerate.vo | 0m00.38s | 441068 ko || +0m00.02s || 128 ko | +7.89% | +0.02% 0m00.32s | 428048 ko | Rewriter/Language/Reify.vo | 0m00.39s | 428404 ko || -0m00.07s || -356 ko | -17.94% | -0.08% ```

--- src/Rewriter/Language/Reify.v | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/Rewriter/Language/Reify.v b/src/Rewriter/Language/Reify.v index ca8175402..2e8c8a003 100644 --- a/src/Rewriter/Language/Reify.v +++ b/src/Rewriter/Language/Reify.v @@ -284,17 +284,16 @@ Module Compilers. Import Language.Compilers.type. Ltac2 rec reify (base_reify : constr -> constr) (base_type : constr) (ty : constr) := Reify.debug_enter_reify "type.reify" ty; - let debug_Constr_check := Reify.Constr.debug_check_strict "type.reify" in let reify_rec (t : constr) := reify base_reify base_type t in let res := lazy_match! (eval cbv beta in ty) with | ?a -> ?b => let ra := reify_rec a in let rb := reify_rec b in - debug_Constr_check (fun () => mkApp '@arrow [base_type; ra; rb]) + (mkApp '@arrow [base_type; ra; rb]) | @interp _ _ ?t => t | _ => let rt := base_reify ty in - debug_Constr_check (fun () => mkApp '@base [base_type; rt]) + (mkApp '@base [base_type; rt]) end in Reify.debug_leave_reify_success "type.reify" ty res; res. From aa6b80ba9f0c0ca2ba8a84388e562fd01de7a772 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 20:42:35 +0530 Subject: [PATCH 09/74] Revert "Less constr subst in Language.Reify..type.reify" This reverts commit 94c05f0ac693d6bdfad795c6a3ea5e3a03799bba. Seems maybe not that helpful?
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m03.48s | 1398540 ko | Total Time / Peak Mem | 4m03.23s | 1429052 ko || +0m00.25s || -30512 ko | +0.10% | -2.13% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.38s | 1110000 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.35s | 1112812 ko || +0m00.03s || -2812 ko | +0.05% | -0.25% 0m53.74s | 1398540 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m53.52s | 1429052 ko || +0m00.21s || -30512 ko | +0.41% | -2.13% 0m51.52s | 1066608 ko | Rewriter/Rewriter/Examples.vo | 0m51.65s | 1067736 ko || -0m00.12s || -1128 ko | -0.25% | -0.10% 0m27.78s | 898012 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.83s | 905660 ko || -0m00.04s || -7648 ko | -0.17% | -0.84% 0m23.75s | 882756 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.60s | 884264 ko || +0m00.14s || -1508 ko | +0.63% | -0.17% 0m15.68s | 723596 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.77s | 727128 ko || -0m00.08s || -3532 ko | -0.57% | -0.48% 0m12.13s | 637356 ko | Rewriter/Demo.vo | 0m12.06s | 632704 ko || +0m00.07s || 4652 ko | +0.58% | +0.73% 0m00.84s | 471272 ko | Rewriter/Rewriter/Reify.vo | 0m00.86s | 471268 ko || -0m00.02s || 4 ko | -2.32% | +0.00% 0m00.77s | 488124 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.77s | 488116 ko || +0m00.00s || 8 ko | +0.00% | +0.00% 0m00.55s | 478556 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.49s | 478644 ko || +0m00.06s || -88 ko | +12.24% | -0.01% 0m00.52s | 482016 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.51s | 481952 ko || +0m00.01s || 64 ko | +1.96% | +0.01% 0m00.50s | 480112 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.54s | 480172 ko || -0m00.04s || -60 ko | -7.40% | -0.01% 0m00.48s | 441260 ko | Rewriter/Language/IdentifiersBasicGenerate.vo | 0m00.40s | 441308 ko || +0m00.07s || -48 ko | +19.99% | -0.01% 0m00.48s | 480388 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.54s | 480244 ko || -0m00.06s || 144 ko | -11.11% | +0.02% 0m00.36s | 428012 ko | Rewriter/Language/Reify.vo | 0m00.34s | 428100 ko || +0m00.01s || -88 ko | +5.88% | -0.02% ```

--- src/Rewriter/Language/Reify.v | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Rewriter/Language/Reify.v b/src/Rewriter/Language/Reify.v index 2e8c8a003..841d30338 100644 --- a/src/Rewriter/Language/Reify.v +++ b/src/Rewriter/Language/Reify.v @@ -290,10 +290,10 @@ Module Compilers. | ?a -> ?b => let ra := reify_rec a in let rb := reify_rec b in - (mkApp '@arrow [base_type; ra; rb]) + '(@arrow $base_type $ra $rb) | @interp _ _ ?t => t | _ => let rt := base_reify ty in - (mkApp '@base [base_type; rt]) + '(@base $base_type $rt) end in Reify.debug_leave_reify_success "type.reify" ty res; res. From 3944fa1a017f7e52b0b6243b3723985513749c5d Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 12:30:09 +0530 Subject: [PATCH 10/74] Fix tc in reify_via_tc
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m03.22s | 1398420 ko | Total Time / Peak Mem | 4m03.08s | 1398340 ko || +0m00.14s || 80 ko | +0.06% | +0.00% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.35s | 1109892 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.27s | 1109936 ko || +0m00.07s || -44 ko | +0.14% | -0.00% 0m53.85s | 1398420 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m53.81s | 1398340 ko || +0m00.03s || 80 ko | +0.07% | +0.00% 0m51.65s | 1066448 ko | Rewriter/Rewriter/Examples.vo | 0m51.68s | 1066548 ko || -0m00.03s || -100 ko | -0.05% | -0.00% 0m27.74s | 898052 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.66s | 898028 ko || +0m00.07s || 24 ko | +0.28% | +0.00% 0m23.47s | 882968 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.76s | 883008 ko || -0m00.29s || -40 ko | -1.22% | -0.00% 0m15.75s | 723828 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.63s | 723824 ko || +0m00.11s || 4 ko | +0.76% | +0.00% 0m12.05s | 637488 ko | Rewriter/Demo.vo | 0m12.02s | 637364 ko || +0m00.03s || 124 ko | +0.24% | +0.01% 0m00.80s | 471288 ko | Rewriter/Rewriter/Reify.vo | 0m00.81s | 471248 ko || -0m00.01s || 40 ko | -1.23% | +0.00% 0m00.74s | 487972 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.81s | 488204 ko || -0m00.07s || -232 ko | -8.64% | -0.04% 0m00.56s | 478516 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.44s | 478628 ko || +0m00.12s || -112 ko | +27.27% | -0.02% 0m00.52s | 480180 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.47s | 480296 ko || +0m00.05s || -116 ko | +10.63% | -0.02% 0m00.51s | 481844 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.55s | 482036 ko || -0m00.04s || -192 ko | -7.27% | -0.03% 0m00.50s | 480060 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.39s | 480120 ko || +0m00.10s || -60 ko | +28.20% | -0.01% 0m00.45s | 441016 ko | Rewriter/Language/IdentifiersBasicGenerate.vo | 0m00.36s | 441080 ko || +0m00.09s || -64 ko | +25.00% | -0.01% 0m00.29s | 428160 ko | Rewriter/Language/Reify.vo | 0m00.42s | 428108 ko || -0m00.13s || 52 ko | -30.95% | +0.01% ```

--- src/Rewriter/Language/Reify.v | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Rewriter/Language/Reify.v b/src/Rewriter/Language/Reify.v index 841d30338..30b8c8ccc 100644 --- a/src/Rewriter/Language/Reify.v +++ b/src/Rewriter/Language/Reify.v @@ -307,7 +307,7 @@ Module Compilers. := reified_ok : @interp base_type interp_base_type rv = v. Ltac2 reify_via_tc (base_type : constr) (interp_base_type : constr) (ty : constr) := - let rv := '(_ : @reified_of $base_type $interp_base_type $ty _) in + let rv := constr:(_ : @reified_of $base_type $interp_base_type $ty _) in lazy_match! Constr.type rv with | @reified_of _ _ _ ?rv => rv end. From fadcd6a8a4a5daf8e2bcc8abf4840466cdc5d49f Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 12:32:29 +0530 Subject: [PATCH 11/74] Less retyping in Language.Reify..base.reify
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m03.20s | 1392132 ko | Total Time / Peak Mem | 4m03.15s | 1398484 ko || +0m00.04s || -6352 ko | +0.02% | -0.45% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.20s | 1109776 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.35s | 1109804 ko || -0m00.14s || -28 ko | -0.27% | -0.00% 0m53.83s | 1392132 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m53.67s | 1398484 ko || +0m00.15s || -6352 ko | +0.29% | -0.45% 0m51.76s | 1039432 ko | Rewriter/Rewriter/Examples.vo | 0m51.53s | 1066600 ko || +0m00.22s || -27168 ko | +0.44% | -2.54% 0m27.68s | 897548 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.78s | 898112 ko || -0m00.10s || -564 ko | -0.35% | -0.06% 0m23.59s | 884012 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.59s | 882812 ko || +0m00.00s || 1200 ko | +0.00% | +0.13% 0m15.59s | 726560 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.75s | 723576 ko || -0m00.16s || 2984 ko | -1.01% | +0.41% 0m12.12s | 637656 ko | Rewriter/Demo.vo | 0m12.02s | 637388 ko || +0m00.09s || 268 ko | +0.83% | +0.04% 0m00.87s | 471248 ko | Rewriter/Rewriter/Reify.vo | 0m00.87s | 471104 ko || +0m00.00s || 144 ko | +0.00% | +0.03% 0m00.85s | 488104 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.79s | 488036 ko || +0m00.05s || 68 ko | +7.59% | +0.01% 0m00.51s | 478604 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.47s | 478676 ko || +0m00.04s || -72 ko | +8.51% | -0.01% 0m00.50s | 481988 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.51s | 481992 ko || -0m00.01s || -4 ko | -1.96% | -0.00% 0m00.50s | 480340 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.48s | 479784 ko || +0m00.02s || 556 ko | +4.16% | +0.11% 0m00.48s | 480068 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.51s | 480100 ko || -0m00.03s || -32 ko | -5.88% | -0.00% 0m00.38s | 441200 ko | Rewriter/Language/IdentifiersBasicGenerate.vo | 0m00.47s | 441304 ko || -0m00.08s || -104 ko | -19.14% | -0.02% 0m00.35s | 428268 ko | Rewriter/Language/Reify.vo | 0m00.37s | 428128 ko || -0m00.02s || 140 ko | -5.40% | +0.03% ```

--- src/Rewriter/Language/Reify.v | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/Rewriter/Language/Reify.v b/src/Rewriter/Language/Reify.v index 30b8c8ccc..ce343bd15 100644 --- a/src/Rewriter/Language/Reify.v +++ b/src/Rewriter/Language/Reify.v @@ -318,24 +318,25 @@ Module Compilers. Ltac2 rec reify (base : constr) (reify_base : constr -> constr) (ty : constr) := let reify_rec (ty : constr) := reify base reify_base ty in + let debug_Constr_check := Reify.Constr.debug_check_strict "base.reify" in Reify.debug_enter_reify "base.reify" ty; let res := - lazy_match! (eval cbv beta in $ty) with - | Datatypes.unit => '(@type.unit $base) + lazy_match! (eval cbv beta in ty) with + | Datatypes.unit => debug_Constr_check (fun () => mkApp '@type.unit [base]) | Datatypes.prod ?a ?b => let ra := reify_rec a in let rb := reify_rec b in - '(@type.prod $base $ra $rb) + debug_Constr_check (fun () => mkApp '@type.prod [base; ra; rb]) | Datatypes.list ?t => let rt := reify_rec t in - '(@type.list $base $rt) + debug_Constr_check (fun () => mkApp '@type.list [base; rt]) | Datatypes.option ?t => let rt := reify_rec t in - '(@type.option $base $rt) + debug_Constr_check (fun () => mkApp '@type.option [base; rt]) | @interp (*$base*)?base' ?base_interp ?t => t | @einterp (@type (*$base*)?base') (@interp (*$base*)?base' ?base_interp) (@Compilers.type.base (@type (*$base*)?base') ?t) => t | ?ty => let rt := reify_base ty in - '(@type.type_base $base $rt) + debug_Constr_check (fun () => mkApp '@type.type_base [base; rt]) end in Reify.debug_leave_reify_success "base.reify" ty res; res. From e2586df18238db3302acb129fe24f768305969e8 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 12:34:03 +0530 Subject: [PATCH 12/74] Less retyping in Language.Reify..pattern.base.reify
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m03.18s | 1397100 ko | Total Time / Peak Mem | 4m03.70s | 1392124 ko || -0m00.51s || 4976 ko | -0.21% | +0.35% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.30s | 1117268 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.55s | 1109724 ko || -0m00.25s || 7544 ko | -0.45% | +0.67% 0m53.83s | 1397100 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m53.81s | 1392124 ko || +0m00.01s || 4976 ko | +0.03% | +0.35% 0m51.62s | 1043340 ko | Rewriter/Rewriter/Examples.vo | 0m51.72s | 1039492 ko || -0m00.10s || 3848 ko | -0.19% | +0.37% 0m27.84s | 897460 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.78s | 897640 ko || +0m00.05s || -180 ko | +0.21% | -0.02% 0m23.51s | 878760 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.77s | 884016 ko || -0m00.25s || -5256 ko | -1.09% | -0.59% 0m15.67s | 726632 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.59s | 726528 ko || +0m00.08s || 104 ko | +0.51% | +0.01% 0m12.00s | 636608 ko | Rewriter/Demo.vo | 0m12.02s | 637684 ko || -0m00.01s || -1076 ko | -0.16% | -0.16% 0m00.86s | 471168 ko | Rewriter/Rewriter/Reify.vo | 0m00.83s | 471248 ko || +0m00.03s || -80 ko | +3.61% | -0.01% 0m00.79s | 488228 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.82s | 488012 ko || -0m00.02s || 216 ko | -3.65% | +0.04% 0m00.55s | 481960 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.44s | 481864 ko || +0m00.11s || 96 ko | +25.00% | +0.01% 0m00.50s | 478640 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.50s | 478712 ko || +0m00.00s || -72 ko | +0.00% | -0.01% 0m00.48s | 480332 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.52s | 480384 ko || -0m00.04s || -52 ko | -7.69% | -0.01% 0m00.44s | 480040 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.51s | 480068 ko || -0m00.07s || -28 ko | -13.72% | -0.00% 0m00.43s | 441156 ko | Rewriter/Language/IdentifiersBasicGenerate.vo | 0m00.49s | 441260 ko || -0m00.06s || -104 ko | -12.24% | -0.02% 0m00.37s | 428536 ko | Rewriter/Language/Reify.vo | 0m00.36s | 428496 ko || +0m00.01s || 40 ko | +2.77% | +0.00% ```

--- src/Rewriter/Language/Reify.v | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/Rewriter/Language/Reify.v b/src/Rewriter/Language/Reify.v index ce343bd15..616740f33 100644 --- a/src/Rewriter/Language/Reify.v +++ b/src/Rewriter/Language/Reify.v @@ -355,24 +355,25 @@ Module Compilers. Ltac2 rec reify (base : constr) (reify_base : constr -> constr) (ty : constr) := let reify_rec (ty : constr) := reify base reify_base ty in + let debug_Constr_check := Reify.Constr.debug_check_strict "pattern.base.reify" in Reify.debug_enter_reify "pattern.base.reify" ty; let res := lazy_match! (eval cbv beta in $ty) with - | Datatypes.unit => '(@type.unit $base) + | Datatypes.unit => debug_Constr_check (fun () => mkApp '@type.unit [base]) | Datatypes.prod ?a ?b => let ra := reify_rec a in let rb := reify_rec b in - '(@type.prod $base $ra $rb) + debug_Constr_check (fun () => mkApp '@type.prod [base; ra; rb]) | Datatypes.list ?t => let rt := reify_rec t in - '(@type.list $base $rt) + debug_Constr_check (fun () => mkApp '@type.list [base; rt]) | Datatypes.option ?t => let rt := reify_rec t in - '(@type.option $base $rt) + debug_Constr_check (fun () => mkApp '@type.option [base; rt]) | @interp (*$base*)?base' ?base_interp ?lookup ?t => t | @einterp (@type (*$base*)?base') (@interp (*$base*)?base' ?base_interp ?lookup) (@Compilers.type.base (@type (*$base*)?base') ?t) => t | ?ty => let rt := reify_base ty in - '(@type.type_base $base $rt) + debug_Constr_check (fun () => mkApp '@type.type_base [base; rt]) end in Reify.debug_leave_reify_success "pattern.base.reify" ty res; res. From e8e24e396d05cfff562be4d2dc5d023ef7b79a8d Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 12:34:37 +0530 Subject: [PATCH 13/74] Use notation in is_template_parameter
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m03.56s | 1397340 ko | Total Time / Peak Mem | 4m03.44s | 1397196 ko || +0m00.11s || 144 ko | +0.04% | +0.01% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.29s | 1105356 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.45s | 1117368 ko || -0m00.16s || -12012 ko | -0.29% | -1.07% 0m54.03s | 1397340 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m53.86s | 1397196 ko || +0m00.17s || 144 ko | +0.31% | +0.01% 0m51.68s | 1043672 ko | Rewriter/Rewriter/Examples.vo | 0m51.60s | 1043540 ko || +0m00.07s || 132 ko | +0.15% | +0.01% 0m27.84s | 898212 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.76s | 897380 ko || +0m00.07s || 832 ko | +0.28% | +0.09% 0m23.58s | 878752 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.52s | 878964 ko || +0m00.05s || -212 ko | +0.25% | -0.02% 0m15.68s | 726492 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.78s | 726584 ko || -0m00.09s || -92 ko | -0.63% | -0.01% 0m12.01s | 636496 ko | Rewriter/Demo.vo | 0m12.08s | 636516 ko || -0m00.07s || -20 ko | -0.57% | -0.00% 0m00.84s | 471320 ko | Rewriter/Rewriter/Reify.vo | 0m00.84s | 471120 ko || +0m00.00s || 200 ko | +0.00% | +0.04% 0m00.75s | 488076 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.72s | 488180 ko || +0m00.03s || -104 ko | +4.16% | -0.02% 0m00.52s | 482028 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.52s | 481892 ko || +0m00.00s || 136 ko | +0.00% | +0.02% 0m00.49s | 480012 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.54s | 480324 ko || -0m00.05s || -312 ko | -9.25% | -0.06% 0m00.49s | 480112 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.51s | 480156 ko || -0m00.02s || -44 ko | -3.92% | -0.00% 0m00.48s | 441084 ko | Rewriter/Language/IdentifiersBasicGenerate.vo | 0m00.35s | 441168 ko || +0m00.13s || -84 ko | +37.14% | -0.01% 0m00.48s | 478632 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.48s | 478536 ko || +0m00.00s || 96 ko | +0.00% | +0.02% 0m00.40s | 428380 ko | Rewriter/Language/Reify.vo | 0m00.44s | 428528 ko || -0m00.03s || -148 ko | -9.09% | -0.03% ```

--- src/Rewriter/Language/Reify.v | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Rewriter/Language/Reify.v b/src/Rewriter/Language/Reify.v index 616740f33..531675f44 100644 --- a/src/Rewriter/Language/Reify.v +++ b/src/Rewriter/Language/Reify.v @@ -406,7 +406,7 @@ Module Compilers. parameters as necessary. *) Ltac2 rec is_template_parameter (ctx_tys : binder list) (parameter_type : constr) : bool := let do_red () := - let t := Std.eval_hnf parameter_type in + let t := eval hnf in parameter_type in if Constr.equal t parameter_type then false else is_template_parameter ctx_tys t in From c60172367a873d20d8032d4ab603da8fa4d0da53 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 12:36:24 +0530 Subject: [PATCH 14/74] Drop old notations for eval_cbv_delta_only
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m03.05s | 1378752 ko | Total Time / Peak Mem | 4m03.39s | 1397116 ko || -0m00.34s || -18364 ko | -0.14% | -1.31% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m53.95s | 1117392 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.50s | 1105432 ko || -0m00.54s || 11960 ko | -1.00% | +1.08% 0m53.70s | 1378752 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m53.83s | 1397116 ko || -0m00.12s || -18364 ko | -0.24% | -1.31% 0m51.65s | 1043576 ko | Rewriter/Rewriter/Examples.vo | 0m51.64s | 1043568 ko || +0m00.00s || 8 ko | +0.01% | +0.00% 0m27.80s | 898280 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.81s | 898256 ko || -0m00.00s || 24 ko | -0.03% | +0.00% 0m23.61s | 878916 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.48s | 878744 ko || +0m00.12s || 172 ko | +0.55% | +0.01% 0m15.70s | 726636 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.66s | 726624 ko || +0m00.03s || 12 ko | +0.25% | +0.00% 0m12.11s | 636632 ko | Rewriter/Demo.vo | 0m12.09s | 636488 ko || +0m00.01s || 144 ko | +0.16% | +0.02% 0m00.81s | 488028 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.74s | 487956 ko || +0m00.07s || 72 ko | +9.45% | +0.01% 0m00.80s | 471172 ko | Rewriter/Rewriter/Reify.vo | 0m00.81s | 471192 ko || -0m00.01s || -20 ko | -1.23% | -0.00% 0m00.55s | 480024 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.47s | 479980 ko || +0m00.08s || 44 ko | +17.02% | +0.00% 0m00.53s | 482080 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.50s | 481928 ko || +0m00.03s || 152 ko | +6.00% | +0.03% 0m00.52s | 480024 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.52s | 480156 ko || +0m00.00s || -132 ko | +0.00% | -0.02% 0m00.51s | 478636 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.55s | 478540 ko || -0m00.04s || 96 ko | -7.27% | +0.02% 0m00.41s | 428104 ko | Rewriter/Language/Reify.vo | 0m00.38s | 428496 ko || +0m00.02s || -392 ko | +7.89% | -0.09% 0m00.40s | 441228 ko | Rewriter/Language/IdentifiersBasicGenerate.vo | 0m00.42s | 441052 ko || -0m00.01s || 176 ko | -4.76% | +0.03% ```

--- src/Rewriter/Language/Reify.v | 15 +-------------- 1 file changed, 1 insertion(+), 14 deletions(-) diff --git a/src/Rewriter/Language/Reify.v b/src/Rewriter/Language/Reify.v index 531675f44..d88fac035 100644 --- a/src/Rewriter/Language/Reify.v +++ b/src/Rewriter/Language/Reify.v @@ -450,19 +450,6 @@ Module Compilers. :: value_ctx_to_list rest end. - Ltac2 eval_cbv_delta_only (i : Std.reference list) (c : constr) := - Std.eval_cbv { Std.rBeta := false; Std.rMatch := false; - Std.rFix := false; Std.rCofix := false; - Std.rZeta := false; Std.rDelta := false; - Std.rConst := i } - c. - Ltac2 eval_cbv_beta (c : constr) := - Std.eval_cbv { Std.rBeta := true; Std.rMatch := false; - Std.rFix := false; Std.rCofix := false; - Std.rZeta := false; Std.rDelta := false; - Std.rConst := [] } - c. - (* f, f_ty, arg *) Ltac2 Type exn ::= [ Template_ctx_mismatch (constr, constr, constr) ]. Ltac2 plug_template_ctx (ctx_tys : binder list) (f : constr) (template_ctx : constr list) := @@ -863,7 +850,7 @@ Module Compilers. | Val c => let (c, h) := c in Reify.debug_enter_reify_case "expr.reify_in_context" "App Constant (unfold)" term; - let term' := eval_cbv_delta_only [c] term in + let term' := (eval cbv delta [$c] in term) in if Constr.equal term term' then printf "Unrecognized (non-unfoldable) term: %t" term; None From d7af66da123fc5f1bd59740b0adadb88636e2450 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 12:42:50 +0530 Subject: [PATCH 15/74] Adjust some notations
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m03.05s | 1378724 ko | Total Time / Peak Mem | 4m03.45s | 1378784 ko || -0m00.40s || -60 ko | -0.16% | -0.00% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.20s | 1117328 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.40s | 1117368 ko || -0m00.19s || -40 ko | -0.36% | -0.00% 0m53.80s | 1378724 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m53.77s | 1378784 ko || +0m00.02s || -60 ko | +0.05% | -0.00% 0m51.76s | 1043448 ko | Rewriter/Rewriter/Examples.vo | 0m51.79s | 1043636 ko || -0m00.03s || -188 ko | -0.05% | -0.01% 0m27.81s | 897396 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.82s | 898060 ko || -0m00.01s || -664 ko | -0.03% | -0.07% 0m23.41s | 878908 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.52s | 878856 ko || -0m00.10s || 52 ko | -0.46% | +0.00% 0m15.61s | 726552 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.72s | 726456 ko || -0m00.11s || 96 ko | -0.69% | +0.01% 0m12.07s | 636472 ko | Rewriter/Demo.vo | 0m12.08s | 636416 ko || -0m00.00s || 56 ko | -0.08% | +0.00% 0m00.84s | 471148 ko | Rewriter/Rewriter/Reify.vo | 0m00.86s | 471208 ko || -0m00.02s || -60 ko | -2.32% | -0.01% 0m00.76s | 488028 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.72s | 488244 ko || +0m00.04s || -216 ko | +5.55% | -0.04% 0m00.51s | 481980 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.56s | 481876 ko || -0m00.05s || 104 ko | -8.92% | +0.02% 0m00.50s | 479932 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.46s | 480060 ko || +0m00.03s || -128 ko | +8.69% | -0.02% 0m00.50s | 478680 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.47s | 478708 ko || +0m00.03s || -28 ko | +6.38% | -0.00% 0m00.48s | 480088 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.50s | 480096 ko || -0m00.02s || -8 ko | -4.00% | -0.00% 0m00.43s | 441168 ko | Rewriter/Language/IdentifiersBasicGenerate.vo | 0m00.40s | 441136 ko || +0m00.02s || 32 ko | +7.49% | +0.00% 0m00.37s | 428060 ko | Rewriter/Language/Reify.vo | 0m00.38s | 428212 ko || -0m00.01s || -152 ko | -2.63% | -0.03% ```

--- src/Rewriter/Language/Reify.v | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Rewriter/Language/Reify.v b/src/Rewriter/Language/Reify.v index d88fac035..2bf853cf6 100644 --- a/src/Rewriter/Language/Reify.v +++ b/src/Rewriter/Language/Reify.v @@ -580,7 +580,7 @@ Module Compilers. let handle_eliminator (motive : constr) (rect_arrow_nodep : constr option) (rect_nodep : constr option) (rect : constr) (mid_args : constr list) (cases_to_thunk : constr list) := let mkApp_thunked_cases f pre_args := Control.with_holes - (fun () => mkApp f (List.append pre_args (List.append mid_args (List.map (fun arg => open_constr:(fun _ => $arg)) cases_to_thunk)))) + (fun () => mkApp f (List.append pre_args (List.append mid_args (List.map (fun arg => '(fun _ => $arg)) cases_to_thunk)))) (fun fv => match Constr.Unsafe.check fv with | Val fv => fv | Err err => Control.throw err @@ -593,7 +593,7 @@ Module Compilers. else mkApp rect (List.append args (List.append mid_args cases_to_thunk))) | None => Control.zero Match_failure end in - let (f, x) := match! (eval cbv beta in $motive) with + let (f, x) := match! (eval cbv beta in motive) with | fun _ => ?a -> ?b => opt_recr false rect_arrow_nodep [a; b] | fun _ => ?t From be955df7319471bda17b47971ab1056ce232fcfe Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 12:45:48 +0530 Subject: [PATCH 16/74] Adjust notations
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m03.56s | 1378604 ko | Total Time / Peak Mem | 4m01.37s | 1378668 ko || +0m02.18s || -64 ko | +0.90% | -0.00% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m51.77s | 1043372 ko | Rewriter/Rewriter/Examples.vo | 0m50.31s | 1043388 ko || +0m01.46s || -16 ko | +2.90% | -0.00% 0m54.49s | 1105408 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m53.76s | 1117320 ko || +0m00.73s || -11912 ko | +1.35% | -1.06% 0m54.00s | 1378604 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m53.96s | 1378668 ko || +0m00.03s || -64 ko | +0.07% | -0.00% 0m27.88s | 897392 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.90s | 897300 ko || -0m00.01s || 92 ko | -0.07% | +0.01% 0m23.15s | 878764 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.49s | 878892 ko || -0m00.33s || -128 ko | -1.44% | -0.01% 0m15.73s | 726576 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.70s | 726512 ko || +0m00.03s || 64 ko | +0.19% | +0.00% 0m12.11s | 636596 ko | Rewriter/Demo.vo | 0m11.95s | 636480 ko || +0m00.16s || 116 ko | +1.33% | +0.01% 0m00.82s | 488228 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.78s | 488136 ko || +0m00.03s || 92 ko | +5.12% | +0.01% 0m00.81s | 471252 ko | Rewriter/Rewriter/Reify.vo | 0m00.78s | 471276 ko || +0m00.03s || -24 ko | +3.84% | -0.00% 0m00.52s | 478680 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.49s | 478760 ko || +0m00.03s || -80 ko | +6.12% | -0.01% 0m00.51s | 480120 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.47s | 480160 ko || +0m00.04s || -40 ko | +8.51% | -0.00% 0m00.49s | 481884 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.50s | 481892 ko || -0m00.01s || -8 ko | -2.00% | -0.00% 0m00.46s | 441164 ko | Rewriter/Language/IdentifiersBasicGenerate.vo | 0m00.41s | 441212 ko || +0m00.05s || -48 ko | +12.19% | -0.01% 0m00.45s | 480148 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.53s | 480356 ko || -0m00.08s || -208 ko | -15.09% | -0.04% 0m00.37s | 428144 ko | Rewriter/Language/Reify.vo | 0m00.35s | 428052 ko || +0m00.02s || 92 ko | +5.71% | +0.02% ```

--- src/Rewriter/Language/Reify.v | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Rewriter/Language/Reify.v b/src/Rewriter/Language/Reify.v index 2bf853cf6..defd31a7e 100644 --- a/src/Rewriter/Language/Reify.v +++ b/src/Rewriter/Language/Reify.v @@ -719,7 +719,7 @@ Module Compilers. (Cache.to_thunked_binder_context cache) var_ty_ctx e in let reify_ident_opt term - := Option.map (fun idc => debug_check (mkApp '(@Ident) [base_type; ident; var; open_constr:(_); idc])) + := Option.map (fun idc => debug_check (mkApp '@Ident [base_type; ident; var; '_; idc])) (reify_ident_opt ctx_tys term) in Reify.debug_enter_reify "expr.reify_in_context" term; Reify.debug_print_args From ded4531aa3e9e5d06b1ecbb711a476bde2629c4c Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 12:47:41 +0530 Subject: [PATCH 17/74] Import Rewriter.Util.Tactics2.FixNotationsForPerformance in Rewriter.Reify
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m01.93s | 1378696 ko | Total Time / Peak Mem | 4m02.71s | 1378504 ko || -0m00.78s || 192 ko | -0.32% | +0.01% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.34s | 1117292 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.54s | 1105200 ko || -0m00.19s || 12092 ko | -0.36% | +1.09% 0m53.72s | 1378696 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m53.94s | 1378504 ko || -0m00.21s || 192 ko | -0.40% | +0.01% 0m51.41s | 1043312 ko | Rewriter/Rewriter/Examples.vo | 0m51.70s | 1043436 ko || -0m00.29s || -124 ko | -0.56% | -0.01% 0m27.71s | 897280 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.80s | 897392 ko || -0m00.08s || -112 ko | -0.32% | -0.01% 0m23.53s | 878816 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.41s | 878884 ko || +0m00.12s || -68 ko | +0.51% | -0.00% 0m15.66s | 726500 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.68s | 726572 ko || -0m00.01s || -72 ko | -0.12% | -0.00% 0m12.03s | 636708 ko | Rewriter/Demo.vo | 0m12.08s | 636520 ko || -0m00.05s || 188 ko | -0.41% | +0.02% 0m00.78s | 488172 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.81s | 488080 ko || -0m00.03s || 92 ko | -3.70% | +0.01% 0m00.78s | 471672 ko | Rewriter/Rewriter/Reify.vo | 0m00.80s | 471204 ko || -0m00.02s || 468 ko | -2.50% | +0.09% 0m00.52s | 480000 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.44s | 480128 ko || +0m00.08s || -128 ko | +18.18% | -0.02% 0m00.50s | 481948 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.54s | 482060 ko || -0m00.04s || -112 ko | -7.40% | -0.02% 0m00.50s | 480328 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.45s | 480316 ko || +0m00.04s || 12 ko | +11.11% | +0.00% 0m00.45s | 478656 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.52s | 478660 ko || -0m00.07s || -4 ko | -13.46% | -0.00% ```

--- src/Rewriter/Rewriter/Reify.v | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index d32d65662..272f2f492 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -22,6 +22,7 @@ Require Import Rewriter.Util.Tactics.CacheTerm. Require Import Rewriter.Util.Tactics.DebugPrint. Require Import Rewriter.Util.CPSNotations. Require Import Rewriter.Util.Notations. +Require Import Rewriter.Util.Tactics2.FixNotationsForPerformance. Require Import Rewriter.Util.Tactics2.InFreshContext. Import ListNotations. Local Open Scope bool_scope. Local Open Scope Z_scope. From 60a85ae1b29ff0f25985d769a776bf1e14ba6c3e Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Tue, 6 Sep 2022 09:39:33 +0530 Subject: [PATCH 18/74] Port reify_under_forall_types to Ltac2 Important: Don't create evars without calling Constr.Unsafe.check
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m02.44s | 1376624 ko | Total Time / Peak Mem | 4m02.19s | 1378700 ko || +0m00.25s || -2076 ko | +0.10% | -0.15% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.18s | 1107228 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.22s | 1105400 ko || -0m00.03s || 1828 ko | -0.07% | +0.16% 0m53.82s | 1376624 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m53.91s | 1378700 ko || -0m00.08s || -2076 ko | -0.16% | -0.15% 0m51.66s | 1032540 ko | Rewriter/Rewriter/Examples.vo | 0m51.70s | 1043312 ko || -0m00.04s || -10772 ko | -0.07% | -1.03% 0m27.75s | 907984 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.80s | 897252 ko || -0m00.05s || 10732 ko | -0.17% | +1.19% 0m23.56s | 875732 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.43s | 878896 ko || +0m00.12s || -3164 ko | +0.55% | -0.35% 0m15.78s | 730084 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.69s | 726400 ko || +0m00.08s || 3684 ko | +0.57% | +0.50% 0m12.01s | 636320 ko | Rewriter/Demo.vo | 0m12.00s | 636572 ko || +0m00.00s || -252 ko | +0.08% | -0.03% 0m00.85s | 488316 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.71s | 488140 ko || +0m00.14s || 176 ko | +19.71% | +0.03% 0m00.82s | 470848 ko | Rewriter/Rewriter/Reify.vo | 0m00.85s | 471780 ko || -0m00.03s || -932 ko | -3.52% | -0.19% 0m00.54s | 482008 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.50s | 482072 ko || +0m00.04s || -64 ko | +8.00% | -0.01% 0m00.51s | 480128 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.47s | 480272 ko || +0m00.04s || -144 ko | +8.51% | -0.02% 0m00.50s | 478716 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.46s | 478636 ko || +0m00.03s || 80 ko | +8.69% | +0.01% 0m00.47s | 480048 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.46s | 480252 ko || +0m00.00s || -204 ko | +2.17% | -0.04% ```

--- src/Rewriter/Rewriter/Reify.v | 97 +++++++++++++++++++++++------------ 1 file changed, 65 insertions(+), 32 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 272f2f492..094082d89 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -2,6 +2,8 @@ Require Import Coq.ZArith.ZArith. Require Import Coq.FSets.FMapPositive. Require Import Coq.MSets.MSetPositive. Require Import Coq.Lists.List. +Require Import Ltac2.Ltac2. +Require Import Ltac2.Printf. Require Import Rewriter.Util.Option. Require Import Rewriter.Util.OptionList. Require Import Rewriter.Util.Bool.Reflect. @@ -22,11 +24,16 @@ Require Import Rewriter.Util.Tactics.CacheTerm. Require Import Rewriter.Util.Tactics.DebugPrint. Require Import Rewriter.Util.CPSNotations. Require Import Rewriter.Util.Notations. +Require Import Rewriter.Util.Tactics2.Head. +Require Import Rewriter.Util.Tactics2.Constr.Unsafe.MakeAbbreviations. Require Import Rewriter.Util.Tactics2.FixNotationsForPerformance. Require Import Rewriter.Util.Tactics2.InFreshContext. +Require Rewriter.Util.Tactics2.Ltac1. +Require Rewriter.Util.Tactics2.Constr. Import ListNotations. Local Open Scope bool_scope. Local Open Scope Z_scope. Local Set Primitive Projections. +Local Set Default Proof Mode "Classic". Import EqNotations. Module Compilers. Export Language.Compilers. @@ -202,38 +209,67 @@ Module Compilers. in @partial_lam_unif_rewrite_ruleTP_gen base ident var pident pident_arg_types value t p should_do_again true true. End with_var. - Ltac strip_functional_dependency term := - lazymatch term with - | fun _ => ?P => P - | _ => constr_fail_with ltac:(fun _ => idtac "Cannot eliminate functional dependencies of" term; - fail 1 "Cannot eliminate functional dependencies of" term) + (* TODO: move? *) + Ltac2 binder_name_or_fresh_default (b : binder) (avoid : constr) (default_base : ident) : ident + := match Constr.Binder.name b with + | Some n => n + | None => Fresh.fresh (Fresh.Free.union (Fresh.Free.of_goal ()) (Fresh.Free.of_constr avoid)) default_base + end. + + Ltac2 Type exn ::= [ Cannot_eliminate_functional_dependencies (constr) ]. + Ltac2 strip_functional_dependency (term : constr) : constr := + lazy_match! term with + | fun _ => ?p => p + | _ => Control.zero (Cannot_eliminate_functional_dependencies term) end. - Ltac reify_under_forall_types' base_type base_type_interp ty_ctx cur_i lem cont := - lazymatch lem with - | forall T : Type, ?P - => let P' := fresh in - let ty_ctx' := fresh "ty_ctx" in - let t := fresh "t" in - strip_functional_dependency - (fun t : base_type - => match PositiveMap.add cur_i t ty_ctx return _ with - | ty_ctx' - => match base_type_interp (pattern.base.lookup_default cur_i ty_ctx') return _ with - | T - => match P return _ with - | P' - => ltac:(let P := (eval cbv delta [P' T ty_ctx'] in P') in - let ty_ctx := (eval cbv delta [ty_ctx'] in ty_ctx') in - clear P' T ty_ctx'; - let cur_i := (eval vm_compute in (Pos.succ cur_i)) in - let res := reify_under_forall_types' base_type base_type_interp ty_ctx cur_i P cont in - exact res) - end - end - end) - | ?lem => cont ty_ctx cur_i lem + Ltac2 rec refine_reify_under_forall_types' (base : constr) (base_type : constr) (base_type_interp : constr) (ty_ctx : constr) (cur_i : constr) (lem : constr) (cont : constr (* ty_ctx *) -> constr (* cur_i *) -> constr (* lem *) -> unit) : unit := + Reify.debug_wrap + "refine_reify_under_forall_types'" Message.of_constr lem + Reify.should_debug_fine_grained Reify.should_debug_fine_grained None + (fun () + => let debug_Constr_check := Reify.Constr.debug_check_strict "refine_reify_under_forall_types'" in + let default () := cont ty_ctx cur_i lem in + match Constr.Unsafe.kind lem with + | Constr.Unsafe.Cast lem _ _ => refine_reify_under_forall_types' base base_type base_type_interp ty_ctx cur_i lem cont + | Constr.Unsafe.Prod b p + => let n := binder_name_or_fresh_default b lem @T in + if Constr.is_sort (Constr.Binder.type b) + then + Control.refine + (fun () + => strip_functional_dependency + (Constr.in_context + n base_type + (fun () + => let rt := mkVar n in + let ty_ctx := debug_Constr_check (fun () => mkApp '@PositiveMap.add [base_type; cur_i; rt; ty_ctx]) in + let t := debug_Constr_check (fun () => mkApp base_type_interp [mkApp '@pattern.base.lookup_default [base; cur_i; ty_ctx] ]) in + let p := debug_Constr_check (fun () => Constr.Unsafe.substnl [t] 0 p) in + let cur_i := (eval vm_compute in (mkApp 'Pos.succ [cur_i])) in + refine_reify_under_forall_types' base base_type base_type_interp ty_ctx cur_i p cont))) + else + default () + | _ => default () + end). + + Ltac2 refine_reify_under_forall_types (base_type : constr) (base_type_interp : constr) (lem : constr) (cont : constr (* ty_ctx *) -> constr (* cur_i *) -> constr (* lem *) -> unit) : unit := + let err () := Control.throw (Reification_panic (fprintf "refine_reify_under_forall_types: Invalid Argument: base_type (%t) not of the form `%t ?base`" base_type 'base.type)) in + lazy_match! base_type with + | base.type ?base + => refine_reify_under_forall_types' base base_type base_type_interp '(@PositiveMap.empty $base_type) '(1%positive) lem cont + | _ => err () end. + Ltac2 reify_under_forall_types (base_type : constr) (base_type_interp : constr) (lem : constr) (cont : constr (* ty_ctx *) -> constr (* cur_i *) -> constr (* lem *) -> constr) : constr := + '(ltac2:(refine_reify_under_forall_types base_type base_type_interp lem (fun ty_ctx cur_i lem => Control.refine (fun () => cont ty_ctx cur_i lem)))). + + #[deprecated(since="8.15",note="Use Ltac2 instead.")] + Ltac reify_under_forall_types base_type base_type_interp lem cont := + let f := ltac2:(base_type base_type_interp lem cont + |- let cont ty_ctx cur_i lem + := Ltac1.apply cont [Ltac1.of_constr ty_ctx; Ltac1.of_constr cur_i; Ltac1.of_constr lem] Ltac1.run in + refine_reify_under_forall_types (Ltac1.get_to_constr "base_type" base_type) (Ltac1.get_to_constr "base_type_interp" base_type_interp) (Ltac1.get_to_constr "lem" lem) cont) in + constr:(ltac:(f base_type base_type_interp lem ltac:(fun ty_ctx cur_i lem => let v := cont ty_ctx cur_i lem in refine v))). Ltac prop_to_bool H := eval cbv [decb] in (decb H). @@ -269,9 +305,6 @@ Module Compilers. Ltac equation_to_parts lem := equation_to_parts' lem (@nil bool). - Ltac reify_under_forall_types base_type base_type_interp lem cont := - reify_under_forall_types' base_type base_type_interp (@PositiveMap.empty base_type) (1%positive) lem cont. - Ltac preadjust_pattern_type_variables pat := let pat := (eval cbv [pattern.type.relax pattern.type.subst_default pattern.type.subst_default_relax pattern.type.unsubst_default_relax] in pat) in let pat := (eval cbn [pattern.base.relax pattern.base.subst_default pattern.base.subst_default_relax pattern.base.unsubst_default_relax] in pat) in From 38f29ffe1deeda731762e0fe4762194008dabe5a Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 13:15:37 +0530 Subject: [PATCH 19/74] Faster fresh in refine_reify_under_forall_types'
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m02.32s | 1375852 ko | Total Time / Peak Mem | 4m02.15s | 1376540 ko || +0m00.17s || -688 ko | +0.07% | -0.04% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.37s | 1106872 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.32s | 1107164 ko || +0m00.04s || -292 ko | +0.09% | -0.02% 0m53.72s | 1375852 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m53.72s | 1376540 ko || +0m00.00s || -688 ko | +0.00% | -0.04% 0m51.51s | 1033016 ko | Rewriter/Rewriter/Examples.vo | 0m51.72s | 1032588 ko || -0m00.21s || 428 ko | -0.40% | +0.04% 0m27.77s | 908972 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.74s | 908048 ko || +0m00.03s || 924 ko | +0.10% | +0.10% 0m23.66s | 875492 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.56s | 875780 ko || +0m00.10s || -288 ko | +0.42% | -0.03% 0m15.69s | 729912 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.63s | 729940 ko || +0m00.05s || -28 ko | +0.38% | -0.00% 0m11.99s | 636324 ko | Rewriter/Demo.vo | 0m11.98s | 636456 ko || +0m00.00s || -132 ko | +0.08% | -0.02% 0m00.83s | 470928 ko | Rewriter/Rewriter/Reify.vo | 0m00.70s | 471016 ko || +0m00.13s || -88 ko | +18.57% | -0.01% 0m00.76s | 488288 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.73s | 488192 ko || +0m00.03s || 96 ko | +4.10% | +0.01% 0m00.53s | 482056 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.46s | 481948 ko || +0m00.07s || 108 ko | +15.21% | +0.02% 0m00.52s | 480200 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.52s | 480128 ko || +0m00.00s || 72 ko | +0.00% | +0.01% 0m00.51s | 480208 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.51s | 480164 ko || +0m00.00s || 44 ko | +0.00% | +0.00% 0m00.47s | 478724 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.56s | 478668 ko || -0m00.09s || 56 ko | -16.07% | +0.01% ```

--- src/Rewriter/Rewriter/Reify.v | 33 +++++++++++++-------------------- 1 file changed, 13 insertions(+), 20 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 094082d89..a251ca1d6 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -209,13 +209,6 @@ Module Compilers. in @partial_lam_unif_rewrite_ruleTP_gen base ident var pident pident_arg_types value t p should_do_again true true. End with_var. - (* TODO: move? *) - Ltac2 binder_name_or_fresh_default (b : binder) (avoid : constr) (default_base : ident) : ident - := match Constr.Binder.name b with - | Some n => n - | None => Fresh.fresh (Fresh.Free.union (Fresh.Free.of_goal ()) (Fresh.Free.of_constr avoid)) default_base - end. - Ltac2 Type exn ::= [ Cannot_eliminate_functional_dependencies (constr) ]. Ltac2 strip_functional_dependency (term : constr) : constr := lazy_match! term with @@ -223,17 +216,16 @@ Module Compilers. | _ => Control.zero (Cannot_eliminate_functional_dependencies term) end. - Ltac2 rec refine_reify_under_forall_types' (base : constr) (base_type : constr) (base_type_interp : constr) (ty_ctx : constr) (cur_i : constr) (lem : constr) (cont : constr (* ty_ctx *) -> constr (* cur_i *) -> constr (* lem *) -> unit) : unit := + Ltac2 rec refine_reify_under_forall_types' (base : constr) (base_type : constr) (base_type_interp : constr) (ty_ctx : constr) (avoid : Fresh.Free.t) (cur_i : constr) (lem : constr) (cont : Fresh.Free.t -> constr (* ty_ctx *) -> constr (* cur_i *) -> constr (* lem *) -> unit) : unit := Reify.debug_wrap "refine_reify_under_forall_types'" Message.of_constr lem Reify.should_debug_fine_grained Reify.should_debug_fine_grained None (fun () => let debug_Constr_check := Reify.Constr.debug_check_strict "refine_reify_under_forall_types'" in - let default () := cont ty_ctx cur_i lem in - match Constr.Unsafe.kind lem with - | Constr.Unsafe.Cast lem _ _ => refine_reify_under_forall_types' base base_type base_type_interp ty_ctx cur_i lem cont + let default () := cont avoid ty_ctx cur_i lem in + match Constr.Unsafe.kind_nocast lem with | Constr.Unsafe.Prod b p - => let n := binder_name_or_fresh_default b lem @T in + => let n := Fresh.fresh avoid (Option.default @T (Constr.Binder.name b)) in if Constr.is_sort (Constr.Binder.type b) then Control.refine @@ -242,33 +234,34 @@ Module Compilers. (Constr.in_context n base_type (fun () - => let rt := mkVar n in + => let avoid := Fresh.Free.union avoid (Fresh.Free.of_ids [n]) in + let rt := mkVar n in let ty_ctx := debug_Constr_check (fun () => mkApp '@PositiveMap.add [base_type; cur_i; rt; ty_ctx]) in let t := debug_Constr_check (fun () => mkApp base_type_interp [mkApp '@pattern.base.lookup_default [base; cur_i; ty_ctx] ]) in let p := debug_Constr_check (fun () => Constr.Unsafe.substnl [t] 0 p) in let cur_i := (eval vm_compute in (mkApp 'Pos.succ [cur_i])) in - refine_reify_under_forall_types' base base_type base_type_interp ty_ctx cur_i p cont))) + refine_reify_under_forall_types' base base_type base_type_interp ty_ctx avoid cur_i p cont))) else default () | _ => default () end). - Ltac2 refine_reify_under_forall_types (base_type : constr) (base_type_interp : constr) (lem : constr) (cont : constr (* ty_ctx *) -> constr (* cur_i *) -> constr (* lem *) -> unit) : unit := + Ltac2 refine_reify_under_forall_types (base_type : constr) (base_type_interp : constr) (avoid : Fresh.Free.t) (lem : constr) (cont : Fresh.Free.t -> constr (* ty_ctx *) -> constr (* cur_i *) -> constr (* lem *) -> unit) : unit := let err () := Control.throw (Reification_panic (fprintf "refine_reify_under_forall_types: Invalid Argument: base_type (%t) not of the form `%t ?base`" base_type 'base.type)) in lazy_match! base_type with | base.type ?base - => refine_reify_under_forall_types' base base_type base_type_interp '(@PositiveMap.empty $base_type) '(1%positive) lem cont + => refine_reify_under_forall_types' base base_type base_type_interp '(@PositiveMap.empty $base_type) avoid '(1%positive) lem cont | _ => err () end. - Ltac2 reify_under_forall_types (base_type : constr) (base_type_interp : constr) (lem : constr) (cont : constr (* ty_ctx *) -> constr (* cur_i *) -> constr (* lem *) -> constr) : constr := - '(ltac2:(refine_reify_under_forall_types base_type base_type_interp lem (fun ty_ctx cur_i lem => Control.refine (fun () => cont ty_ctx cur_i lem)))). + Ltac2 reify_under_forall_types (base_type : constr) (base_type_interp : constr) (avoid : Fresh.Free.t) (lem : constr) (cont : Fresh.Free.t -> constr (* ty_ctx *) -> constr (* cur_i *) -> constr (* lem *) -> constr) : constr := + '(ltac2:(refine_reify_under_forall_types base_type base_type_interp avoid lem (fun avoid ty_ctx cur_i lem => Control.refine (fun () => cont avoid ty_ctx cur_i lem)))). #[deprecated(since="8.15",note="Use Ltac2 instead.")] Ltac reify_under_forall_types base_type base_type_interp lem cont := let f := ltac2:(base_type base_type_interp lem cont - |- let cont ty_ctx cur_i lem + |- let cont avoid ty_ctx cur_i lem := Ltac1.apply cont [Ltac1.of_constr ty_ctx; Ltac1.of_constr cur_i; Ltac1.of_constr lem] Ltac1.run in - refine_reify_under_forall_types (Ltac1.get_to_constr "base_type" base_type) (Ltac1.get_to_constr "base_type_interp" base_type_interp) (Ltac1.get_to_constr "lem" lem) cont) in + refine_reify_under_forall_types (Ltac1.get_to_constr "base_type" base_type) (Ltac1.get_to_constr "base_type_interp" base_type_interp) (Fresh.Free.of_goal ()) (Ltac1.get_to_constr "lem" lem) cont) in constr:(ltac:(f base_type base_type_interp lem ltac:(fun ty_ctx cur_i lem => let v := cont ty_ctx cur_i lem in refine v))). Ltac prop_to_bool H := eval cbv [decb] in (decb H). From 2ba3a18301f74192ded16a13ed576c79242efd13 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Tue, 6 Sep 2022 11:26:05 +0530 Subject: [PATCH 20/74] Port equation_to_parts to Ltac2
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m02.40s | 1382528 ko | Total Time / Peak Mem | 4m01.88s | 1375752 ko || +0m00.51s || 6776 ko | +0.21% | +0.49% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.11s | 1113204 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.18s | 1106992 ko || -0m00.07s || 6212 ko | -0.12% | +0.56% 0m54.03s | 1382528 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m53.85s | 1375752 ko || +0m00.17s || 6776 ko | +0.33% | +0.49% 0m51.78s | 1033788 ko | Rewriter/Rewriter/Examples.vo | 0m51.57s | 1033128 ko || +0m00.21s || 660 ko | +0.40% | +0.06% 0m27.88s | 909444 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.77s | 908936 ko || +0m00.10s || 508 ko | +0.39% | +0.05% 0m23.56s | 881316 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.53s | 875576 ko || +0m00.02s || 5740 ko | +0.12% | +0.65% 0m15.59s | 737684 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.57s | 729844 ko || +0m00.01s || 7840 ko | +0.12% | +1.07% 0m12.03s | 636536 ko | Rewriter/Demo.vo | 0m12.03s | 636356 ko || +0m00.00s || 180 ko | +0.00% | +0.02% 0m00.81s | 471092 ko | Rewriter/Rewriter/Reify.vo | 0m00.73s | 470928 ko || +0m00.08s || 164 ko | +10.95% | +0.03% 0m00.68s | 488236 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.74s | 488220 ko || -0m00.05s || 16 ko | -8.10% | +0.00% 0m00.51s | 478536 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.46s | 478620 ko || +0m00.04s || -84 ko | +10.86% | -0.01% 0m00.50s | 480236 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.48s | 480064 ko || +0m00.02s || 172 ko | +4.16% | +0.03% 0m00.47s | 480280 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.47s | 480124 ko || +0m00.00s || 156 ko | +0.00% | +0.03% 0m00.46s | 482136 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.51s | 481932 ko || -0m00.04s || 204 ko | -9.80% | +0.04% ```

--- src/Rewriter/Rewriter/Reify.v | 79 +++++++++++++++++++++-------------- 1 file changed, 47 insertions(+), 32 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index a251ca1d6..66370d5d5 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -264,39 +264,54 @@ Module Compilers. refine_reify_under_forall_types (Ltac1.get_to_constr "base_type" base_type) (Ltac1.get_to_constr "base_type_interp" base_type_interp) (Fresh.Free.of_goal ()) (Ltac1.get_to_constr "lem" lem) cont) in constr:(ltac:(f base_type base_type_interp lem ltac:(fun ty_ctx cur_i lem => let v := cont ty_ctx cur_i lem in refine v))). - Ltac prop_to_bool H := eval cbv [decb] in (decb H). - - - Ltac push_side_conditions H side_conditions := - constr:(H :: side_conditions). - - Ltac equation_to_parts' lem side_conditions := - lazymatch lem with - | ?H -> ?P - => let __ := lazymatch type of H with - | Prop => constr:(I) - | ?T => constr_fail_with ltac:(fun _ => fail 1 "Invalid non-Prop non-dependent hypothesis of type" H ":" T "when reifying a lemma of type" lem) - end in - let H := prop_to_bool H in - let side_conditions := push_side_conditions H side_conditions in - equation_to_parts' P side_conditions - | forall x : ?T, ?P - => let P' := fresh in - constr:( - fun x : T - => match P return _ with - | P' - => ltac:(let P := (eval cbv delta [P'] in P') in - clear P'; - let res := equation_to_parts' P side_conditions in - exact res) - end) - | @eq ?T ?A ?B - => constr:((@eq T A B, side_conditions)) - | ?T => constr_fail_with ltac:(fun _ => fail 1 "Invalid type of equation:" T) - end. + (* uses typeclass resolution *) + Ltac2 prop_to_bool (h : constr) : constr := eval cbv [decb] in constr:(decb $h). + + Ltac2 push_side_conditions (h : constr) (side_conditions : constr) : constr := + Reify.Constr.debug_check_strict "push_side_conditions" (fun () => mkApp '@cons ['bool; h; side_conditions]). + + Ltac2 Type exn ::= [ Reification_missing_reflect_instance (constr, exn) ]. + Ltac2 rec equation_to_parts' (lem : constr) (side_conditions : constr) : constr := + Reify.debug_wrap + "equation_to_parts'" (fun (lem, side_conditions) => fprintf "%t (side: %t)" lem side_conditions) (lem, side_conditions) + Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) + (fun () + => let debug_Constr_check := Reify.Constr.debug_check_strict "equation_to_parts'" in + lazy_match! lem with + | ?h -> ?p + => let t := Constr.type h in + (if Constr.equal t 'Prop + then () + else Control.zero (Reification_failure (fprintf "Invalid non-Prop non-dependent hypothesis of type %t : %t when reifying a lemma of type %t" h t lem))); + let h := match Control.case (fun () => prop_to_bool h) with + | Val h => let (h, _) := h in h + | Err err => Control.zero (Reification_failure (fprintf "Missing Bool.reflect instance for %t: %a" lem (fun () => Message.of_exn) err)) + end in + let side_conditions := push_side_conditions h side_conditions in + equation_to_parts' p side_conditions + | @eq ?t ?a ?b + => '((@eq $t $a $b, $side_conditions)) + | ?t + => match Constr.Unsafe.kind t with + | Constr.Unsafe.Cast t _ _ => equation_to_parts' t side_conditions + | Constr.Unsafe.Prod b p + => (* we use in_context so we can do typeclass resolution later *) + Constr.in_fresh_context_avoiding + @x true (Some (Fresh.Free.of_constr lem)) [b] + (fun ns + => let p := debug_Constr_check (fun () => Constr.Unsafe.substnl (List.map (fun (n, _) => mkVar n) ns) 0 p) in + let res := equation_to_parts' p side_conditions in + Control.refine (fun () => res)) + | _ => Control.zero (Reification_failure (fprintf "Invalid type of equation: %t" t)) + end + end). + Ltac2 equation_to_parts (lem : constr) : constr := + equation_to_parts' lem '(@nil bool). + #[deprecated(since="8.15",note="Use Ltac2 instead.")] Ltac equation_to_parts lem := - equation_to_parts' lem (@nil bool). + let f := ltac2:(lem + |- Control.refine (fun () => equation_to_parts (Ltac1.get_to_constr "lem" lem))) in + constr:(ltac:(f lem)). Ltac preadjust_pattern_type_variables pat := let pat := (eval cbv [pattern.type.relax pattern.type.subst_default pattern.type.subst_default_relax pattern.type.unsubst_default_relax] in pat) in From 665eb10e62f2fcaf4f1ed9486d60095cd63d9598 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 13:18:05 +0530 Subject: [PATCH 21/74] Faster fresh in equation_to_parts
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m02.73s | 1383440 ko | Total Time / Peak Mem | 4m02.34s | 1382500 ko || +0m00.39s || 940 ko | +0.16% | +0.06% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.14s | 1112052 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m53.98s | 1113036 ko || +0m00.16s || -984 ko | +0.29% | -0.08% 0m53.78s | 1383440 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m53.96s | 1382500 ko || -0m00.17s || 940 ko | -0.33% | +0.06% 0m51.83s | 1034728 ko | Rewriter/Rewriter/Examples.vo | 0m51.76s | 1033924 ko || +0m00.07s || 804 ko | +0.13% | +0.07% 0m27.98s | 907556 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.89s | 909488 ko || +0m00.08s || -1932 ko | +0.32% | -0.21% 0m23.62s | 881644 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.55s | 881600 ko || +0m00.07s || 44 ko | +0.29% | +0.00% 0m15.67s | 737744 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.64s | 737676 ko || +0m00.02s || 68 ko | +0.19% | +0.00% 0m12.13s | 636456 ko | Rewriter/Demo.vo | 0m12.08s | 636532 ko || +0m00.05s || -76 ko | +0.41% | -0.01% 0m00.81s | 471172 ko | Rewriter/Rewriter/Reify.vo | 0m00.78s | 471004 ko || +0m00.03s || 168 ko | +3.84% | +0.03% 0m00.69s | 488100 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.71s | 488088 ko || -0m00.02s || 12 ko | -2.81% | +0.00% 0m00.56s | 481996 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.52s | 482136 ko || +0m00.04s || -140 ko | +7.69% | -0.02% 0m00.53s | 480128 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.49s | 480240 ko || +0m00.04s || -112 ko | +8.16% | -0.02% 0m00.51s | 478776 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.50s | 478696 ko || +0m00.01s || 80 ko | +2.00% | +0.01% 0m00.48s | 480172 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.48s | 480220 ko || +0m00.00s || -48 ko | +0.00% | -0.00% ```

--- src/Rewriter/Rewriter/Reify.v | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 66370d5d5..66312b9d5 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -271,7 +271,7 @@ Module Compilers. Reify.Constr.debug_check_strict "push_side_conditions" (fun () => mkApp '@cons ['bool; h; side_conditions]). Ltac2 Type exn ::= [ Reification_missing_reflect_instance (constr, exn) ]. - Ltac2 rec equation_to_parts' (lem : constr) (side_conditions : constr) : constr := + Ltac2 rec equation_to_parts' (avoid : Fresh.Free.t) (lem : constr) (side_conditions : constr) : constr := Reify.debug_wrap "equation_to_parts'" (fun (lem, side_conditions) => fprintf "%t (side: %t)" lem side_conditions) (lem, side_conditions) Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) @@ -288,29 +288,30 @@ Module Compilers. | Err err => Control.zero (Reification_failure (fprintf "Missing Bool.reflect instance for %t: %a" lem (fun () => Message.of_exn) err)) end in let side_conditions := push_side_conditions h side_conditions in - equation_to_parts' p side_conditions + equation_to_parts' avoid p side_conditions | @eq ?t ?a ?b => '((@eq $t $a $b, $side_conditions)) | ?t - => match Constr.Unsafe.kind t with - | Constr.Unsafe.Cast t _ _ => equation_to_parts' t side_conditions + => match Constr.Unsafe.kind_nocast t with | Constr.Unsafe.Prod b p => (* we use in_context so we can do typeclass resolution later *) Constr.in_fresh_context_avoiding - @x true (Some (Fresh.Free.of_constr lem)) [b] + @x false (Some avoid) [b] (fun ns - => let p := debug_Constr_check (fun () => Constr.Unsafe.substnl (List.map (fun (n, _) => mkVar n) ns) 0 p) in - let res := equation_to_parts' p side_conditions in + => let ns := List.map (fun (n, _) => n) ns in + let avoid := Fresh.Free.union avoid (Fresh.Free.of_ids ns) in + let p := debug_Constr_check (fun () => Constr.Unsafe.substnl (List.map mkVar ns) 0 p) in + let res := equation_to_parts' avoid p side_conditions in Control.refine (fun () => res)) | _ => Control.zero (Reification_failure (fprintf "Invalid type of equation: %t" t)) end end). - Ltac2 equation_to_parts (lem : constr) : constr := - equation_to_parts' lem '(@nil bool). + Ltac2 equation_to_parts (avoid : Fresh.Free.t) (lem : constr) : constr := + equation_to_parts' avoid lem '(@nil bool). #[deprecated(since="8.15",note="Use Ltac2 instead.")] Ltac equation_to_parts lem := let f := ltac2:(lem - |- Control.refine (fun () => equation_to_parts (Ltac1.get_to_constr "lem" lem))) in + |- Control.refine (fun () => equation_to_parts (Fresh.Free.of_goal ()) (Ltac1.get_to_constr "lem" lem))) in constr:(ltac:(f lem)). Ltac preadjust_pattern_type_variables pat := From 001be123aaec8ba0eef779e2225afb09868d001d Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sun, 25 Sep 2022 21:14:00 +0530 Subject: [PATCH 22/74] Port adjust_pattern_type_variables to Ltac2
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m03.27s | 1375696 ko | Total Time / Peak Mem | 4m01.33s | 1383628 ko || +0m01.94s || -7932 ko | +0.80% | -0.57% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m51.92s | 1038332 ko | Rewriter/Rewriter/Examples.vo | 0m50.44s | 1034712 ko || +0m01.48s || 3620 ko | +2.93% | +0.34% 0m54.44s | 1119076 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.00s | 1112104 ko || +0m00.43s || 6972 ko | +0.81% | +0.62% 0m53.95s | 1375696 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m53.90s | 1383628 ko || +0m00.05s || -7932 ko | +0.09% | -0.57% 0m27.92s | 909124 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.88s | 907396 ko || +0m00.04s || 1728 ko | +0.14% | +0.19% 0m23.64s | 877916 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.72s | 881420 ko || -0m00.07s || -3504 ko | -0.33% | -0.39% 0m15.79s | 732964 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.69s | 737752 ko || +0m00.09s || -4788 ko | +0.63% | -0.64% 0m12.05s | 637912 ko | Rewriter/Demo.vo | 0m12.07s | 636484 ko || -0m00.01s || 1428 ko | -0.16% | +0.22% 0m00.84s | 471064 ko | Rewriter/Rewriter/Reify.vo | 0m00.82s | 471044 ko || +0m00.02s || 20 ko | +2.43% | +0.00% 0m00.77s | 488248 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.79s | 488200 ko || -0m00.02s || 48 ko | -2.53% | +0.00% 0m00.53s | 481988 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.52s | 482028 ko || +0m00.01s || -40 ko | +1.92% | -0.00% 0m00.50s | 480116 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.46s | 480028 ko || +0m00.03s || 88 ko | +8.69% | +0.01% 0m00.47s | 479948 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.51s | 480020 ko || -0m00.04s || -72 ko | -7.84% | -0.01% 0m00.46s | 478720 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.53s | 478612 ko || -0m00.07s || 108 ko | -13.20% | +0.02% ```

--- src/Rewriter/Rewriter/Reify.v | 72 ++++++++++++++++++++++------------- 1 file changed, 46 insertions(+), 26 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 66312b9d5..7f7c0915b 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -4,6 +4,7 @@ Require Import Coq.MSets.MSetPositive. Require Import Coq.Lists.List. Require Import Ltac2.Ltac2. Require Import Ltac2.Printf. +Require Import Ltac2.Bool. Require Import Rewriter.Util.Option. Require Import Rewriter.Util.OptionList. Require Import Rewriter.Util.Bool.Reflect. @@ -28,6 +29,7 @@ Require Import Rewriter.Util.Tactics2.Head. Require Import Rewriter.Util.Tactics2.Constr.Unsafe.MakeAbbreviations. Require Import Rewriter.Util.Tactics2.FixNotationsForPerformance. Require Import Rewriter.Util.Tactics2.InFreshContext. +Require Import Rewriter.Util.Tactics2.Notations. Require Rewriter.Util.Tactics2.Ltac1. Require Rewriter.Util.Tactics2.Constr. Import ListNotations. Local Open Scope bool_scope. Local Open Scope Z_scope. @@ -314,36 +316,54 @@ Module Compilers. |- Control.refine (fun () => equation_to_parts (Fresh.Free.of_goal ()) (Ltac1.get_to_constr "lem" lem))) in constr:(ltac:(f lem)). - Ltac preadjust_pattern_type_variables pat := - let pat := (eval cbv [pattern.type.relax pattern.type.subst_default pattern.type.subst_default_relax pattern.type.unsubst_default_relax] in pat) in - let pat := (eval cbn [pattern.base.relax pattern.base.subst_default pattern.base.subst_default_relax pattern.base.unsubst_default_relax] in pat) in - pat. - - Ltac adjust_pattern_type_variables' pat := - lazymatch pat with - | context[@pattern.base.relax ?base (pattern.base.lookup_default ?p ?evm')] - => let t := constr:(@pattern.base.relax base (pattern.base.lookup_default p evm')) in - let T := fresh in - let pat := - lazymatch (eval pattern t in pat) with - | ?pat _ - => let P := match type of pat with forall x, @?P x => P end in - lazymatch pat with - | fun T => ?pat - => constr:(match pattern.base.type.var p as T return P T with - | T => pat - end) - end - end in - adjust_pattern_type_variables' pat - | ?pat => pat - end. + Ltac2 preadjust_pattern_type_variables (pat : constr) : constr := + Reify.debug_wrap + "preadjust_pattern_type_variables'" Message.of_constr pat + Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) + (fun () + => let s := strategy:([pattern.type.relax pattern.type.subst_default pattern.type.subst_default_relax pattern.type.unsubst_default_relax]) in + let pat := Std.eval_cbv s pat in + let pat := Std.eval_cbn s pat in + pat). - Ltac adjust_pattern_type_variables_internal pat := + Ltac2 rec adjust_pattern_type_variables' (pat : constr) : constr := + Reify.debug_wrap + "adjust_pattern_type_variables'" Message.of_constr pat + Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) + (fun () + => let debug_Constr_check := Reify.Constr.debug_check_strict "adjust_pattern_type_variables'" in + let t_base_p_evm' := match! pat with + | context[?t] + => lazy_match! t with + | @pattern.base.relax ?base (@pattern.base.lookup_default ?base ?p ?evm') + => Some (t, base, p, evm') + end + | _ => None + end in + match t_base_p_evm' with + | Some t_base_p_evm' + => let (t, base, p, evm') := t_base_p_evm' in + let pat := + lazy_match! (eval pattern t in pat) with + | ?pat _ + => match Constr.Unsafe.kind_nocast pat with + | Constr.Unsafe.Lambda _ pat + => debug_Constr_check (fun () => Constr.Unsafe.substnl [mkApp '@pattern.base.type.var [base; p] ] 0 pat) + | _ => Control.throw (Reification_panic (fprintf "adjust_pattern_type_variables': pattern produced a non-Lambda: %t" pat)) + end + end in + adjust_pattern_type_variables' pat + | None => pat + end). + + Ltac2 adjust_pattern_type_variables (pat : constr) : constr := let pat := preadjust_pattern_type_variables pat in adjust_pattern_type_variables' pat. + #[deprecated(since="8.15",note="Use Ltac2 instead.")] Ltac adjust_pattern_type_variables pat := - constr:(ltac:(let v := adjust_pattern_type_variables_internal pat in refine v)). + let f := ltac2:(pat + |- Control.refine (fun () => adjust_pattern_type_variables (Ltac1.get_to_constr "pat" pat))) in + constr:(ltac:(f pat)). Ltac walk_term_under_binders_fail_invalid invalid term fv := lazymatch fv with From 25dc8b1377b844a9b7c24776dd7f0cdf5217de7f Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 17:56:42 +0530 Subject: [PATCH 23/74] Use Constr.Unsafe.replace_by_pattern in adjust_pattern_type_variables'
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m03.02s | 1386108 ko | Total Time / Peak Mem | 4m02.70s | 1375876 ko || +0m00.31s || 10232 ko | +0.13% | +0.74% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.52s | 1118200 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.28s | 1119060 ko || +0m00.24s || -860 ko | +0.44% | -0.07% 0m53.76s | 1386108 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m53.64s | 1375876 ko || +0m00.11s || 10232 ko | +0.22% | +0.74% 0m51.66s | 1055776 ko | Rewriter/Rewriter/Examples.vo | 0m51.65s | 1038368 ko || +0m00.00s || 17408 ko | +0.01% | +1.67% 0m27.89s | 908120 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.93s | 909116 ko || -0m00.03s || -996 ko | -0.14% | -0.10% 0m23.66s | 879712 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.67s | 877960 ko || -0m00.01s || 1752 ko | -0.04% | +0.19% 0m15.74s | 732684 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.80s | 732964 ko || -0m00.06s || -280 ko | -0.37% | -0.03% 0m12.07s | 637968 ko | Rewriter/Demo.vo | 0m12.05s | 637940 ko || +0m00.01s || 28 ko | +0.16% | +0.00% 0m00.81s | 471316 ko | Rewriter/Rewriter/Reify.vo | 0m00.85s | 471180 ko || -0m00.03s || 136 ko | -4.70% | +0.02% 0m00.78s | 488484 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.76s | 488216 ko || +0m00.02s || 268 ko | +2.63% | +0.05% 0m00.58s | 482168 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.54s | 481920 ko || +0m00.03s || 248 ko | +7.40% | +0.05% 0m00.53s | 480152 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.55s | 480116 ko || -0m00.02s || 36 ko | -3.63% | +0.00% 0m00.52s | 480188 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.47s | 480188 ko || +0m00.05s || 0 ko | +10.63% | +0.00% 0m00.50s | 478804 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.51s | 478836 ko || -0m00.01s || -32 ko | -1.96% | -0.00% ```

--- src/Rewriter/Rewriter/Reify.v | 11 ++--------- 1 file changed, 2 insertions(+), 9 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 7f7c0915b..83a2ff6f7 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -27,6 +27,7 @@ Require Import Rewriter.Util.CPSNotations. Require Import Rewriter.Util.Notations. Require Import Rewriter.Util.Tactics2.Head. Require Import Rewriter.Util.Tactics2.Constr.Unsafe.MakeAbbreviations. +Require Import Rewriter.Util.Tactics2.ReplaceByPattern. Require Import Rewriter.Util.Tactics2.FixNotationsForPerformance. Require Import Rewriter.Util.Tactics2.InFreshContext. Require Import Rewriter.Util.Tactics2.Notations. @@ -343,15 +344,7 @@ Module Compilers. match t_base_p_evm' with | Some t_base_p_evm' => let (t, base, p, evm') := t_base_p_evm' in - let pat := - lazy_match! (eval pattern t in pat) with - | ?pat _ - => match Constr.Unsafe.kind_nocast pat with - | Constr.Unsafe.Lambda _ pat - => debug_Constr_check (fun () => Constr.Unsafe.substnl [mkApp '@pattern.base.type.var [base; p] ] 0 pat) - | _ => Control.throw (Reification_panic (fprintf "adjust_pattern_type_variables': pattern produced a non-Lambda: %t" pat)) - end - end in + let pat := debug_Constr_check (fun () => Constr.Unsafe.replace_by_pattern [t] [mkApp '@pattern.base.type.var [base; p] ] pat) in adjust_pattern_type_variables' pat | None => pat end). From a754d4dabd2e5d795dcfc698db967763c4946dc5 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 10:13:14 +0530 Subject: [PATCH 24/74] Introduce constr-copying in strip_invalid_or_fail for perf comparison
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m02.99s | 1388364 ko | Total Time / Peak Mem | 4m02.89s | 1386132 ko || +0m00.09s || 2232 ko | +0.04% | +0.16% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.36s | 1116496 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.40s | 1118104 ko || -0m00.03s || -1608 ko | -0.07% | -0.14% 0m53.86s | 1388364 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m53.90s | 1386132 ko || -0m00.03s || 2232 ko | -0.07% | +0.16% 0m51.79s | 1059204 ko | Rewriter/Rewriter/Examples.vo | 0m51.74s | 1055980 ko || +0m00.04s || 3224 ko | +0.09% | +0.30% 0m28.03s | 909812 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m28.03s | 908108 ko || +0m00.00s || 1704 ko | +0.00% | +0.18% 0m23.62s | 882124 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.48s | 879548 ko || +0m00.14s || 2576 ko | +0.59% | +0.29% 0m15.69s | 732232 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.69s | 732648 ko || +0m00.00s || -416 ko | +0.00% | -0.05% 0m12.07s | 637984 ko | Rewriter/Demo.vo | 0m12.03s | 637928 ko || +0m00.04s || 56 ko | +0.33% | +0.00% 0m00.79s | 471384 ko | Rewriter/Rewriter/Reify.vo | 0m00.85s | 471224 ko || -0m00.05s || 160 ko | -7.05% | +0.03% 0m00.78s | 488504 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.71s | 488552 ko || +0m00.07s || -48 ko | +9.85% | -0.00% 0m00.52s | 482216 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.56s | 482188 ko || -0m00.04s || 28 ko | -7.14% | +0.00% 0m00.52s | 480120 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.46s | 480212 ko || +0m00.06s || -92 ko | +13.04% | -0.01% 0m00.49s | 478832 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.53s | 478680 ko || -0m00.04s || 152 ko | -7.54% | +0.03% 0m00.47s | 480200 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.51s | 480288 ko || -0m00.04s || -88 ko | -7.84% | -0.01% ```

--- src/Rewriter/Rewriter/Reify.v | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 83a2ff6f7..78a642a5d 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -380,7 +380,7 @@ Module Compilers. | _ => idtac end. - Ltac strip_invalid_or_fail term := + Ltac strip_invalid_or_fail_internal term := lazymatch term with | fun _ => ?f => f | fun invalid : ?T => ?f @@ -393,6 +393,8 @@ Module Compilers. fail 0 "Invalid (unknown subterm):" term) end) end. + Ltac strip_invalid_or_fail term := + constr:(ltac:(let res := strip_invalid_or_fail_internal term in exact res)). Definition pattern_base_subst_default_relax' {base} t evm P := @pattern.base.subst_default_relax base P t evm. From f63ae0c567f10c9f354c7fc34925020cc21810ac Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 13:22:14 +0530 Subject: [PATCH 25/74] Port strip_invalid_or_fail to Ltac2
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m02.77s | 1378372 ko | Total Time / Peak Mem | 4m02.53s | 1388160 ko || +0m00.23s || -9788 ko | +0.09% | -0.70% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.22s | 1092492 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.23s | 1116656 ko || -0m00.00s || -24164 ko | -0.01% | -2.16% 0m53.93s | 1378372 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m53.64s | 1388160 ko || +0m00.28s || -9788 ko | +0.54% | -0.70% 0m51.95s | 1051024 ko | Rewriter/Rewriter/Examples.vo | 0m51.88s | 1058996 ko || +0m00.07s || -7972 ko | +0.13% | -0.75% 0m27.92s | 900356 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.90s | 909668 ko || +0m00.02s || -9312 ko | +0.07% | -1.02% 0m23.52s | 878172 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.49s | 882092 ko || +0m00.03s || -3920 ko | +0.12% | -0.44% 0m15.77s | 729972 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.65s | 732244 ko || +0m00.11s || -2272 ko | +0.76% | -0.31% 0m11.96s | 639176 ko | Rewriter/Demo.vo | 0m12.07s | 637992 ko || -0m00.10s || 1184 ko | -0.91% | +0.18% 0m00.76s | 488580 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.80s | 488540 ko || -0m00.04s || 40 ko | -5.00% | +0.00% 0m00.76s | 471548 ko | Rewriter/Rewriter/Reify.vo | 0m00.81s | 471208 ko || -0m00.05s || 340 ko | -6.17% | +0.07% 0m00.57s | 482024 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.50s | 481988 ko || +0m00.06s || 36 ko | +13.99% | +0.00% 0m00.53s | 478796 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.53s | 478748 ko || +0m00.00s || 48 ko | +0.00% | +0.01% 0m00.44s | 480244 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.51s | 480288 ko || -0m00.07s || -44 ko | -13.72% | -0.00% 0m00.44s | 480396 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.53s | 480392 ko || -0m00.09s || 4 ko | -16.98% | +0.00% ```

--- src/Rewriter/Rewriter/Reify.v | 203 ++++++++++++++++++++++++++++------ 1 file changed, 170 insertions(+), 33 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 78a642a5d..4d2473091 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -358,43 +358,180 @@ Module Compilers. |- Control.refine (fun () => adjust_pattern_type_variables (Ltac1.get_to_constr "pat" pat))) in constr:(ltac:(f pat)). - Ltac walk_term_under_binders_fail_invalid invalid term fv := - lazymatch fv with - | context[invalid _ _ ?x] - => fail 0 "Invalid (in" term "): Invalid:" x - | context[invalid] - => lazymatch fv with - | ?f ?x => walk_term_under_binders_fail_invalid invalid term f; - walk_term_under_binders_fail_invalid invalid term x - | fun (x : ?T) => @?f x - => let __ := - constr:( - fun x : T - => ltac:(let f := (eval cbv beta in (f x)) in - walk_term_under_binders_fail_invalid invalid term f; - exact I)) in - idtac - | context[invalid _ ?x] - => fail 0 "Invalid (second arg) (in" term "): Invalid:" x - end - | _ => idtac - end. + (* this is fancy but probably too complicated to maintain *) + Ltac2 walk_term_under_binders_fail_invalid_fast (term : constr) (free : Fresh.Free.t) (invalid : ident) (fv : constr) : unit := + Reify.debug_wrap + "walk_term_under_binders_fail_invalid_fast" Message.of_constr fv + Reify.should_debug_fine_grained Reify.should_debug_fine_grained None + (fun () + => let res : (int (* len *) * message) list ref := { contents := [] } in + let check_var i args k := + if Ident.equal i invalid + then res.(contents) := match args with + | None => (0, Message.of_string "") + | Some args + => let len := Array.length args in + (len, (fprintf "%t" (Array.get args (Int.sub len 1)))) + end + :: res.(contents) + else k () in + let subst_ns (ns : ident list) := + let ns := List.map mkVar ns in + Constr.Unsafe.substnl ns 0 in + let rec aux (fv : constr) : unit := + Reify.debug_wrap + "walk_term_under_binders_fail_invalid_fast:aux" Message.of_constr fv + Reify.should_debug_fine_grained Reify.should_debug_fine_grained None + (fun () + => let under (bs : binder list) (k : ident list -> unit) := + let __ := Constr.in_fresh_context_avoiding + @UNNAMED_BINDER false (Some free) bs + (fun ns => List.iter (fun (_, t) => aux t) ns; + k (List.map (fun (n, _) => n) ns); + Control.refine (fun () => 'I)) in + () in + match Constr.Unsafe.kind fv with + | Constr.Unsafe.Rel _ => () | Constr.Unsafe.Meta _ => () | Constr.Unsafe.Sort _ => () | Constr.Unsafe.Constant _ _ => () | Constr.Unsafe.Ind _ _ => () + | Constr.Unsafe.Constructor _ _ => () | Constr.Unsafe.Uint63 _ => () | Constr.Unsafe.Float _ => () + | Constr.Unsafe.Var v => check_var v None (fun () => ()) + | Constr.Unsafe.Cast c _ t => aux c; aux t + | Constr.Unsafe.Prod b c + => under [b] (fun ns => aux (subst_ns ns c)) + | Constr.Unsafe.Lambda b c + => under [b] (fun ns => aux (subst_ns ns c)) + | Constr.Unsafe.LetIn b v c + => aux v; + under [b] (fun ns => aux (subst_ns ns c)) + | Constr.Unsafe.App c l + => let default () := aux c; Array.iter aux l in + match Constr.Unsafe.kind c with + | Constr.Unsafe.Var v + => check_var v (Some l) default + | _ => default () + end + | Constr.Unsafe.Case _ x iv y bl + => Array.iter aux bl; + Constr.Unsafe.Case.iter_invert aux iv; + aux x; + aux y + | Constr.Unsafe.Proj _p c => aux c + | Constr.Unsafe.Array _u t def ty => + Array.iter aux t; aux def; aux ty + | Constr.Unsafe.Fix _ _ tl bl => + under (Array.to_list tl) + (fun ns => let subst_ns := subst_ns ns in + Array.iter (fun c => aux (subst_ns c)) bl) + | Constr.Unsafe.CoFix _ tl bl => + under (Array.to_list tl) + (fun ns => let subst_ns := subst_ns ns in + Array.iter (fun c => aux (subst_ns c)) bl) + | Constr.Unsafe.Evar _ l => () (* not possible to iter in Ltac2... *) + end) in + aux fv; + match res.(contents) with + | [] => Control.zero + (Reification_failure + (fprintf + "Invalid (unknown location): %t" term)) + | v :: vs + => Control.zero + (Reification_failure + (fprintf + "Invalid (in %t):%s%a" + term (String.newline ()) + (fun () + => List.fold_right + (fun (argn, msg) rest + => (fprintf "Invalid (arg %i): %a%s%a" + argn + (fun () x => x) msg + (String.newline ()) + (fun () x => x) rest)) + (Message.of_string "")) + (v :: vs))) + end). - Ltac strip_invalid_or_fail_internal term := - lazymatch term with + Ltac2 rec walk_term_under_binders_fail_invalid (term : constr) (free : Fresh.Free.t) (invalid : ident) (fv : constr) : unit := + Reify.debug_wrap + "walk_term_under_binders_fail_invalid" Message.of_constr fv + Reify.should_debug_fine_grained Reify.should_debug_fine_grained None + (fun () + => let recr ns := + walk_term_under_binders_fail_invalid + term + (Fresh.Free.union free (Fresh.Free.of_ids ns)) + invalid in + let under (b : binder) (k : ident -> unit) : unit := + let __ := Constr.in_fresh_context_avoiding + @UNNAMED_BINDER false (Some free) [b] + (fun ns => + let (n, t) := List.nth ns 0 in + recr [] (* [] because we haven't added the name to the context at this point *) t; + k n; + Control.refine (fun () => 'I)) in + () in + let invalid := mkVar invalid in + (* recurse first?, err option *) + let (recurse_first, res) + := match! fv with + | context[?invalid' _ _ ?x] + => if Constr.equal_nounivs invalid' invalid + then (false, Some (Reification_failure (fprintf "Invalid (in %t): Invalid:%s%t" term (String.newline ()) x))) + else Control.zero Match_failure + | context[?invalid' _ ?x] + => if Constr.equal_nounivs invalid' invalid + then (true, Some (Reification_failure (fprintf "Invalid (second arg) (in %t): Invalid:%s%t" term (String.newline ()) x))) + else Control.zero Match_failure + | context[?invalid'] + => if Constr.equal_nounivs invalid' invalid + then (true, None) + else Control.zero Match_failure + | _ => (false, None) + end in + (if recurse_first + then match Constr.Unsafe.kind_nocast fv with + | Constr.Unsafe.App f xs + => recr [] f; + Array.iter (recr []) xs + | Constr.Unsafe.Lambda b f + => under b (fun n => recr [n] (Constr.Unsafe.substnl [mkVar n] 0 f)) + | Constr.Unsafe.Prod b f + => under b (fun n => recr [n] (Constr.Unsafe.substnl [mkVar n] 0 f)) + | Constr.Unsafe.LetIn b v f + => recr [] v; + under b (fun n => recr [n] (Constr.Unsafe.substnl [mkVar n] 0 f)) + | _ => () + end + else ()); + match res with + | Some err => Control.zero err + | None => () + end). + + Ltac2 strip_invalid_or_fail (term : constr) : constr := + lazy_match! term with | fun _ => ?f => f - | fun invalid : ?T => ?f - => let f' := fresh in - constr:(fun invalid : T - => match f return _ with - | f' - => ltac:(let f := (eval cbv [f'] in f') in - walk_term_under_binders_fail_invalid invalid term f; - fail 0 "Invalid (unknown subterm):" term) - end) + | _ + => match Constr.Unsafe.kind_nocast term with + | Constr.Unsafe.Lambda b f + => let free := Fresh.Free.union (Fresh.Free.of_goal ()) (Fresh.Free.of_constr term) in + let invalid := Fresh.fresh free @INVALID in + let free := Fresh.Free.union free (Fresh.Free.of_ids [invalid]) in + let f := Constr.Unsafe.substnl [mkVar invalid] 0 f in + let __ := Constr.in_context + invalid (Constr.Binder.type b) + (fun () => walk_term_under_binders_fail_invalid term free invalid f; Control.refine (fun () => 'I)) in + Control.zero (Reification_failure (fprintf "Invalid (unknown subterm): %t" term)) + | _ + => Control.throw (Reification_panic (fprintf "strip_invalid_or_fail given non-lambda: %t" term)) + end end. + + #[deprecated(since="8.15",note="Use Ltac2 instead.")] Ltac strip_invalid_or_fail term := - constr:(ltac:(let res := strip_invalid_or_fail_internal term in exact res)). + let f := ltac2:(term + |- Control.refine (fun () => strip_invalid_or_fail (Ltac1.get_to_constr "term" term))) in + constr:(ltac:(f term)). Definition pattern_base_subst_default_relax' {base} t evm P := @pattern.base.subst_default_relax base P t evm. From 8a3a7cc498561f2ce4f341a8becc2ced9e6ae119 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 13:31:02 +0530 Subject: [PATCH 26/74] Port change_pattern_base_subst_default_relax to Ltac2
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m03.61s | 1387712 ko | Total Time / Peak Mem | 4m03.40s | 1378456 ko || +0m00.21s || 9256 ko | +0.08% | +0.67% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.36s | 1112116 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.47s | 1092432 ko || -0m00.10s || 19684 ko | -0.20% | +1.80% 0m53.98s | 1387712 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m54.11s | 1378456 ko || -0m00.13s || 9256 ko | -0.24% | +0.67% 0m51.99s | 1061112 ko | Rewriter/Rewriter/Examples.vo | 0m51.84s | 1051068 ko || +0m00.14s || 10044 ko | +0.28% | +0.95% 0m28.20s | 890764 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.86s | 900376 ko || +0m00.33s || -9612 ko | +1.22% | -1.06% 0m23.66s | 878156 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.58s | 878284 ko || +0m00.08s || -128 ko | +0.33% | -0.01% 0m15.76s | 733796 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.73s | 730068 ko || +0m00.02s || 3728 ko | +0.19% | +0.51% 0m12.05s | 639420 ko | Rewriter/Demo.vo | 0m12.11s | 639204 ko || -0m00.05s || 216 ko | -0.49% | +0.03% 0m00.80s | 471512 ko | Rewriter/Rewriter/Reify.vo | 0m00.88s | 471592 ko || -0m00.07s || -80 ko | -9.09% | -0.01% 0m00.73s | 488428 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.77s | 488556 ko || -0m00.04s || -128 ko | -5.19% | -0.02% 0m00.53s | 482100 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.53s | 482132 ko || +0m00.00s || -32 ko | +0.00% | -0.00% 0m00.53s | 478828 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.48s | 478708 ko || +0m00.05s || 120 ko | +10.41% | +0.02% 0m00.51s | 480344 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.52s | 480304 ko || -0m00.01s || 40 ko | -1.92% | +0.00% 0m00.51s | 480156 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.52s | 480196 ko || -0m00.01s || -40 ko | -1.92% | -0.00% ```

--- src/Rewriter/Rewriter/Reify.v | 24 ++++++++++++++---------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 4d2473091..608c1f9c6 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -538,17 +538,21 @@ Module Compilers. Definition pattern_base_unsubst_default_relax' {base} t evm P := @pattern.base.unsubst_default_relax base P t evm. - Ltac change_pattern_base_subst_default_relax_internal term := - lazymatch (eval pattern (@pattern.base.subst_default_relax), (@pattern.base.unsubst_default_relax) in term) with - | ?f _ _ - => let base := fresh "base" in - let P := fresh "P" in - let t := fresh "t" in - let evm := fresh "evm" in - (eval cbv beta in (f (fun base P t evm => @pattern_base_subst_default_relax' base t evm P) (fun base P t evm => @pattern_base_unsubst_default_relax' base t evm P))) - end. + Ltac2 change_pattern_base_subst_default_relax (term : constr) : constr := + Reify.debug_wrap + "change_pattern_base_subst_default_relax" Message.of_constr term + Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) + (fun () + => lazy_match! (eval pattern '@pattern.base.subst_default_relax, '@pattern.base.unsubst_default_relax in '$term) with + | ?f _ _ + => (eval cbv beta in constr:($f (fun base P t evm => @pattern_base_subst_default_relax' base t evm P) (fun base P t evm => @pattern_base_unsubst_default_relax' base t evm P))) + end). + + #[deprecated(since="8.15",note="Use Ltac2 instead.")] Ltac change_pattern_base_subst_default_relax term := - constr:(ltac:(let v := change_pattern_base_subst_default_relax_internal term in refine v)). + let f := ltac2:(term + |- Control.refine (fun () => change_pattern_base_subst_default_relax (Ltac1.get_to_constr "term" term))) in + constr:(ltac:(f term)). Ltac adjust_lookup_default_internal rewr := lazymatch (eval pattern (@pattern.base.lookup_default) in rewr) with From bc7b77ae4e005b19acb7a8e38f02b783e09ab12e Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 13:06:52 +0530 Subject: [PATCH 27/74] Less retyping in change_pattern_base_subst_default_relax
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m03.64s | 1386944 ko | Total Time / Peak Mem | 4m03.74s | 1387668 ko || -0m00.09s || -724 ko | -0.04% | -0.05% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.49s | 1112268 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.45s | 1112108 ko || +0m00.03s || 160 ko | +0.07% | +0.01% 0m54.18s | 1386944 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m54.29s | 1387668 ko || -0m00.10s || -724 ko | -0.20% | -0.05% 0m52.09s | 1061072 ko | Rewriter/Rewriter/Examples.vo | 0m51.94s | 1061064 ko || +0m00.15s || 8 ko | +0.28% | +0.00% 0m28.22s | 891124 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m28.05s | 890924 ko || +0m00.16s || 200 ko | +0.60% | +0.02% 0m23.19s | 878112 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.66s | 878060 ko || -0m00.46s || 52 ko | -1.98% | +0.00% 0m15.87s | 733828 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.75s | 733816 ko || +0m00.11s || 12 ko | +0.76% | +0.00% 0m12.03s | 639520 ko | Rewriter/Demo.vo | 0m12.12s | 639580 ko || -0m00.08s || -60 ko | -0.74% | -0.00% 0m00.85s | 471620 ko | Rewriter/Rewriter/Reify.vo | 0m00.82s | 471596 ko || +0m00.03s || 24 ko | +3.65% | +0.00% 0m00.72s | 488452 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.72s | 488540 ko || +0m00.00s || -88 ko | +0.00% | -0.01% 0m00.52s | 482180 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.49s | 482116 ko || +0m00.03s || 64 ko | +6.12% | +0.01% 0m00.52s | 480184 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.50s | 480220 ko || +0m00.02s || -36 ko | +4.00% | -0.00% 0m00.51s | 478960 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.47s | 478876 ko || +0m00.04s || 84 ko | +8.51% | +0.01% 0m00.45s | 480224 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.48s | 480196 ko || -0m00.02s || 28 ko | -6.24% | +0.00% ```

--- src/Rewriter/Rewriter/Reify.v | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 608c1f9c6..fee5d859c 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -543,7 +543,7 @@ Module Compilers. "change_pattern_base_subst_default_relax" Message.of_constr term Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) (fun () - => lazy_match! (eval pattern '@pattern.base.subst_default_relax, '@pattern.base.unsubst_default_relax in '$term) with + => lazy_match! (eval pattern '@pattern.base.subst_default_relax, '@pattern.base.unsubst_default_relax in term) with | ?f _ _ => (eval cbv beta in constr:($f (fun base P t evm => @pattern_base_subst_default_relax' base t evm P) (fun base P t evm => @pattern_base_unsubst_default_relax' base t evm P))) end). From f2b8b164b5f3d063948c1bf78b5c2622f8aac400 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 13:10:37 +0530 Subject: [PATCH 28/74] Less typing in change_pattern_base_subst_default_relax
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m03.91s | 1379216 ko | Total Time / Peak Mem | 4m03.81s | 1386864 ko || +0m00.09s || -7648 ko | +0.03% | -0.55% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.28s | 1379216 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m54.16s | 1386864 ko || +0m00.12s || -7648 ko | +0.22% | -0.55% 0m54.27s | 1107636 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.34s | 1112344 ko || -0m00.07s || -4708 ko | -0.12% | -0.42% 0m52.19s | 1044796 ko | Rewriter/Rewriter/Examples.vo | 0m52.17s | 1061016 ko || +0m00.01s || -16220 ko | +0.03% | -1.52% 0m28.12s | 897760 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m28.14s | 891180 ko || -0m00.01s || 6580 ko | -0.07% | +0.73% 0m23.70s | 877708 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.62s | 878164 ko || +0m00.07s || -456 ko | +0.33% | -0.05% 0m15.78s | 730048 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.79s | 733744 ko || -0m00.00s || -3696 ko | -0.06% | -0.50% 0m12.06s | 639620 ko | Rewriter/Demo.vo | 0m12.05s | 639540 ko || +0m00.00s || 80 ko | +0.08% | +0.01% 0m00.82s | 471740 ko | Rewriter/Rewriter/Reify.vo | 0m00.81s | 471548 ko || +0m00.00s || 192 ko | +1.23% | +0.04% 0m00.73s | 488512 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.75s | 488528 ko || -0m00.02s || -16 ko | -2.66% | -0.00% 0m00.53s | 482176 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.55s | 482224 ko || -0m00.02s || -48 ko | -3.63% | -0.00% 0m00.51s | 480352 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.47s | 480236 ko || +0m00.04s || 116 ko | +8.51% | +0.02% 0m00.47s | 478876 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.48s | 478868 ko || -0m00.01s || 8 ko | -2.08% | +0.00% 0m00.45s | 480084 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.49s | 480204 ko || -0m00.03s || -120 ko | -8.16% | -0.02% ```

--- src/Rewriter/Rewriter/Reify.v | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index fee5d859c..19eb6dbcd 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -537,15 +537,21 @@ Module Compilers. := @pattern.base.subst_default_relax base P t evm. Definition pattern_base_unsubst_default_relax' {base} t evm P := @pattern.base.unsubst_default_relax base P t evm. + Definition pattern_base_subst_default_relax'_reordered {base} P t evm + := @pattern_base_subst_default_relax' base t evm P. + Definition pattern_base_unsubst_default_relax'_reordered {base} P t evm + := @pattern_base_unsubst_default_relax' base t evm P. Ltac2 change_pattern_base_subst_default_relax (term : constr) : constr := Reify.debug_wrap "change_pattern_base_subst_default_relax" Message.of_constr term Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) (fun () - => lazy_match! (eval pattern '@pattern.base.subst_default_relax, '@pattern.base.unsubst_default_relax in term) with + => let debug_Constr_check := Reify.Constr.debug_check_strict "change_pattern_base_subst_default_relax" in + lazy_match! (eval pattern '@pattern.base.subst_default_relax, '@pattern.base.unsubst_default_relax in term) with | ?f _ _ - => (eval cbv beta in constr:($f (fun base P t evm => @pattern_base_subst_default_relax' base t evm P) (fun base P t evm => @pattern_base_unsubst_default_relax' base t evm P))) + => (eval cbv beta delta [pattern_base_subst_default_relax'_reordered pattern_base_unsubst_default_relax'_reordered] in + (debug_Constr_check (fun () => mkApp f ['@pattern_base_subst_default_relax'_reordered; '@pattern_base_unsubst_default_relax'_reordered]))) end). #[deprecated(since="8.15",note="Use Ltac2 instead.")] From 1ebd06d0350c8f3d95926142edfa7d153d8ce8f9 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 13:35:22 +0530 Subject: [PATCH 29/74] Port adjust_lookup_default to Ltac2
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m03.96s | 1391020 ko | Total Time / Peak Mem | 4m03.68s | 1378960 ko || +0m00.27s || 12060 ko | +0.11% | +0.87% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.24s | 1096304 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.36s | 1107692 ko || -0m00.11s || -11388 ko | -0.22% | -1.02% 0m54.14s | 1391020 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m54.20s | 1378960 ko || -0m00.06s || 12060 ko | -0.11% | +0.87% 0m52.26s | 1041724 ko | Rewriter/Rewriter/Examples.vo | 0m52.19s | 1044924 ko || +0m00.07s || -3200 ko | +0.13% | -0.30% 0m28.23s | 895956 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m28.07s | 897604 ko || +0m00.16s || -1648 ko | +0.57% | -0.18% 0m23.64s | 884944 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.50s | 877840 ko || +0m00.14s || 7104 ko | +0.59% | +0.80% 0m15.82s | 726984 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.69s | 730120 ko || +0m00.13s || -3136 ko | +0.82% | -0.42% 0m12.12s | 639308 ko | Rewriter/Demo.vo | 0m12.10s | 639716 ko || +0m00.01s || -408 ko | +0.16% | -0.06% 0m00.85s | 471608 ko | Rewriter/Rewriter/Reify.vo | 0m00.83s | 471728 ko || +0m00.02s || -120 ko | +2.40% | -0.02% 0m00.75s | 488488 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.80s | 488612 ko || -0m00.05s || -124 ko | -6.25% | -0.02% 0m00.50s | 482196 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.51s | 482156 ko || -0m00.01s || 40 ko | -1.96% | +0.00% 0m00.48s | 480344 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.42s | 480328 ko || +0m00.06s || 16 ko | +14.28% | +0.00% 0m00.47s | 480128 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.48s | 480212 ko || -0m00.01s || -84 ko | -2.08% | -0.01% 0m00.46s | 478872 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.54s | 478896 ko || -0m00.08s || -24 ko | -14.81% | -0.00% ```

--- src/Rewriter/Rewriter/Reify.v | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 19eb6dbcd..37938aa57 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -560,16 +560,20 @@ Module Compilers. |- Control.refine (fun () => change_pattern_base_subst_default_relax (Ltac1.get_to_constr "term" term))) in constr:(ltac:(f term)). - Ltac adjust_lookup_default_internal rewr := - lazymatch (eval pattern (@pattern.base.lookup_default) in rewr) with - | ?rewr _ - => let base := fresh "base" in - let p := fresh "p" in - let evm := fresh "evm" in - (eval cbv beta in (rewr (fun base p evm => @pattern.base.subst_default base (pattern.base.type.var p) evm))) - end. + Ltac2 adjust_lookup_default (rewr : constr) : constr := + Reify.debug_wrap + "adjust_lookup_default" Message.of_constr rewr + Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) + (fun () + => lazy_match! (eval pattern '@pattern.base.lookup_default in '$rewr) with + | ?rewr _ + => (eval cbv beta in constr:($rewr (fun base p evm => @pattern.base.subst_default base (pattern.base.type.var p) evm))) + end). + #[deprecated(since="8.15",note="Use Ltac2 instead.")] Ltac adjust_lookup_default rewr := - constr:(ltac:(let v := adjust_lookup_default_internal rewr in refine v)). + let f := ltac2:(rewr + |- Control.refine (fun () => adjust_lookup_default (Ltac1.get_to_constr "rewr" rewr))) in + constr:(ltac:(f rewr)). Ltac replace_evar_map_internal evm rewr := let evm' := match rewr with From 448630a94bbbf81a8f8bcc5e03338de7c365363e Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 13:39:02 +0530 Subject: [PATCH 30/74] Less retyping in adjust_lookup_default
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m03.99s | 1391080 ko | Total Time / Peak Mem | 4m03.90s | 1391052 ko || +0m00.08s || 28 ko | +0.03% | +0.00% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.26s | 1391080 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m54.29s | 1391052 ko || -0m00.03s || 28 ko | -0.05% | +0.00% 0m53.98s | 1096404 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.57s | 1096384 ko || -0m00.59s || 20 ko | -1.08% | +0.00% 0m52.23s | 1041844 ko | Rewriter/Rewriter/Examples.vo | 0m52.27s | 1041752 ko || -0m00.04s || 92 ko | -0.07% | +0.00% 0m28.33s | 897132 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m28.26s | 897144 ko || +0m00.06s || -12 ko | +0.24% | -0.00% 0m23.67s | 885108 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.20s | 885072 ko || +0m00.47s || 36 ko | +2.02% | +0.00% 0m15.82s | 727192 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.86s | 727124 ko || -0m00.03s || 68 ko | -0.25% | +0.00% 0m12.07s | 639184 ko | Rewriter/Demo.vo | 0m11.94s | 639220 ko || +0m00.13s || -36 ko | +1.08% | -0.00% 0m00.83s | 488364 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.74s | 488640 ko || +0m00.08s || -276 ko | +12.16% | -0.05% 0m00.81s | 471556 ko | Rewriter/Rewriter/Reify.vo | 0m00.85s | 471548 ko || -0m00.03s || 8 ko | -4.70% | +0.00% 0m00.54s | 478848 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.55s | 478880 ko || -0m00.01s || -32 ko | -1.81% | -0.00% 0m00.49s | 482248 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.50s | 482080 ko || -0m00.01s || 168 ko | -2.00% | +0.03% 0m00.49s | 480344 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.44s | 480296 ko || +0m00.04s || 48 ko | +11.36% | +0.00% 0m00.48s | 480256 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.44s | 480328 ko || +0m00.03s || -72 ko | +9.09% | -0.01% ```

--- src/Rewriter/Rewriter/Reify.v | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 37938aa57..f90ff7248 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -565,7 +565,7 @@ Module Compilers. "adjust_lookup_default" Message.of_constr rewr Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) (fun () - => lazy_match! (eval pattern '@pattern.base.lookup_default in '$rewr) with + => lazy_match! (eval pattern '@pattern.base.lookup_default in rewr) with | ?rewr _ => (eval cbv beta in constr:($rewr (fun base p evm => @pattern.base.subst_default base (pattern.base.type.var p) evm))) end). From cae6b4df075e41376422e917df615bd0ee4c7d13 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 13:41:46 +0530 Subject: [PATCH 31/74] Less typing in adjust_lookup_default
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m04.49s | 1382596 ko | Total Time / Peak Mem | 4m04.05s | 1390972 ko || +0m00.44s || -8376 ko | +0.18% | -0.60% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.60s | 1094880 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.59s | 1096524 ko || +0m00.00s || -1644 ko | +0.01% | -0.14% 0m54.23s | 1382596 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m54.31s | 1390972 ko || -0m00.08s || -8376 ko | -0.14% | -0.60% 0m52.15s | 1059088 ko | Rewriter/Rewriter/Examples.vo | 0m52.13s | 1041672 ko || +0m00.01s || 17416 ko | +0.03% | +1.67% 0m28.36s | 892320 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m28.19s | 897076 ko || +0m00.16s || -4756 ko | +0.60% | -0.53% 0m23.64s | 884020 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.52s | 884956 ko || +0m00.12s || -936 ko | +0.51% | -0.10% 0m15.93s | 727148 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.81s | 727028 ko || +0m00.11s || 120 ko | +0.75% | +0.01% 0m12.02s | 639860 ko | Rewriter/Demo.vo | 0m12.09s | 639308 ko || -0m00.07s || 552 ko | -0.57% | +0.08% 0m00.79s | 471560 ko | Rewriter/Rewriter/Reify.vo | 0m00.76s | 471540 ko || +0m00.03s || 20 ko | +3.94% | +0.00% 0m00.77s | 488436 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.72s | 488556 ko || +0m00.05s || -120 ko | +6.94% | -0.02% 0m00.53s | 482172 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.51s | 482120 ko || +0m00.02s || 52 ko | +3.92% | +0.01% 0m00.51s | 478968 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.50s | 478928 ko || +0m00.01s || 40 ko | +2.00% | +0.00% 0m00.50s | 480228 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.45s | 480416 ko || +0m00.04s || -188 ko | +11.11% | -0.03% 0m00.47s | 480280 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.47s | 480280 ko || +0m00.00s || 0 ko | +0.00% | +0.00% ```

--- src/Rewriter/Rewriter/Reify.v | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index f90ff7248..e070a6b1a 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -560,14 +560,18 @@ Module Compilers. |- Control.refine (fun () => change_pattern_base_subst_default_relax (Ltac1.get_to_constr "term" term))) in constr:(ltac:(f term)). + Definition pattern_base_subst_default_reordered base p evm + := @pattern.base.subst_default base (pattern.base.type.var p) evm. Ltac2 adjust_lookup_default (rewr : constr) : constr := Reify.debug_wrap "adjust_lookup_default" Message.of_constr rewr Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) (fun () - => lazy_match! (eval pattern '@pattern.base.lookup_default in rewr) with + => let debug_Constr_check := Reify.Constr.debug_check_strict "adjust_lookup_default" in + lazy_match! (eval pattern '@pattern.base.lookup_default in rewr) with | ?rewr _ - => (eval cbv beta in constr:($rewr (fun base p evm => @pattern.base.subst_default base (pattern.base.type.var p) evm))) + => (eval cbv beta delta [pattern_base_subst_default_reordered] in + (debug_Constr_check (fun () => mkApp rewr ['@pattern_base_subst_default_reordered]))) end). #[deprecated(since="8.15",note="Use Ltac2 instead.")] Ltac adjust_lookup_default rewr := From 5a2acf7d379e73862f95c3f1841acb31fbe56338 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 13:43:57 +0530 Subject: [PATCH 32/74] Port replace_evar_map to Ltac2
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m04.76s | 1386124 ko | Total Time / Peak Mem | 4m04.05s | 1382720 ko || +0m00.71s || 3404 ko | +0.29% | +0.24% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.49s | 1386124 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m54.19s | 1382720 ko || +0m00.30s || 3404 ko | +0.55% | +0.24% 0m54.32s | 1114336 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.46s | 1095004 ko || -0m00.14s || 19332 ko | -0.25% | +1.76% 0m52.41s | 1067488 ko | Rewriter/Rewriter/Examples.vo | 0m52.04s | 1059276 ko || +0m00.36s || 8212 ko | +0.71% | +0.77% 0m28.24s | 900552 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m28.23s | 892412 ko || +0m00.00s || 8140 ko | +0.03% | +0.91% 0m23.67s | 885224 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.77s | 883820 ko || -0m00.09s || 1404 ko | -0.42% | +0.15% 0m15.83s | 727672 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.79s | 727236 ko || +0m00.04s || 436 ko | +0.25% | +0.05% 0m12.15s | 639576 ko | Rewriter/Demo.vo | 0m12.08s | 639732 ko || +0m00.07s || -156 ko | +0.57% | -0.02% 0m00.84s | 471752 ko | Rewriter/Rewriter/Reify.vo | 0m00.81s | 471660 ko || +0m00.02s || 92 ko | +3.70% | +0.01% 0m00.77s | 488604 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.71s | 488636 ko || +0m00.06s || -32 ko | +8.45% | -0.00% 0m00.54s | 480244 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.44s | 480292 ko || +0m00.10s || -48 ko | +22.72% | -0.00% 0m00.52s | 478852 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.50s | 478796 ko || +0m00.02s || 56 ko | +4.00% | +0.01% 0m00.50s | 482164 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.54s | 482208 ko || -0m00.04s || -44 ko | -7.40% | -0.00% 0m00.49s | 480284 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.49s | 480348 ko || +0m00.00s || -64 ko | +0.00% | -0.01% ```

--- src/Rewriter/Rewriter/Reify.v | 48 +++++++++++++++++++++-------------- 1 file changed, 29 insertions(+), 19 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index e070a6b1a..af3e0f8b7 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -579,26 +579,36 @@ Module Compilers. |- Control.refine (fun () => adjust_lookup_default (Ltac1.get_to_constr "rewr" rewr))) in constr:(ltac:(f rewr)). - Ltac replace_evar_map_internal evm rewr := - let evm' := match rewr with - | context[pattern.base.lookup_default _ ?evm'] - => let __ := match goal with _ => tryif constr_eq evm evm' then fail else idtac end in - evm' - | context[pattern.base.subst_default _ ?evm'] - => let __ := match goal with _ => tryif constr_eq evm evm' then fail else idtac end in - evm' - | _ => tt - end in - lazymatch evm' with - | tt => rewr - | _ - => let rewr := lazymatch (eval pattern evm' in rewr) with - | ?rewr _ => (eval cbv beta in (rewr evm)) - end in - replace_evar_map_internal evm rewr - end. + Ltac2 rec replace_evar_map (evm : constr) (rewr : constr) : constr := + Reify.debug_wrap + "replace_evar_map" (fun (evm, rewr) => fprintf "(%t) in %t" evm rewr) (evm, rewr) + Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) + (fun () + => let evm' := match! rewr with + | context[@pattern.base.lookup_default ?_base ?_p ?evm'] + => if Constr.equal evm evm' + then Control.zero Match_failure + else Some evm' + | context[@pattern.base.subst_default ?_base ?_p ?evm'] + => if Constr.equal evm evm' + then Control.zero Match_failure + else Some evm' + | _ => None + end in + match evm' with + | None => rewr + | Some evm' + => Reify.debug_fine_grained "replace_evar_map" (fun () => fprintf "(%t) → (%t)" evm' evm); + let rewr := lazy_match! (eval pattern '$evm' in '$rewr) with + | ?rewr _ => (eval cbv beta in '($rewr $evm)) + end in + replace_evar_map evm rewr + end). + #[deprecated(since="8.15",note="Use Ltac2 instead.")] Ltac replace_evar_map evm rewr := - constr:(ltac:(let v := replace_evar_map_internal evm rewr in refine v)). + let f := ltac2:(evm rewr + |- Control.refine (fun () => replace_evar_map (Ltac1.get_to_constr "evm" evm) (Ltac1.get_to_constr "rewr" rewr))) in + constr:(ltac:(f constr:(evm) rewr)). Ltac adjust_type_variables_internal rewr := lazymatch rewr with From 183f62b306d8698929f70a0b553534e3bc2ab2b8 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 13:42:51 +0530 Subject: [PATCH 33/74] Less retyping in replace_evar_map
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m04.59s | 1386172 ko | Total Time / Peak Mem | 4m03.66s | 1386056 ko || +0m00.92s || 116 ko | +0.37% | +0.00% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.45s | 1386172 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m54.23s | 1386056 ko || +0m00.22s || 116 ko | +0.40% | +0.00% 0m54.44s | 1114236 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.35s | 1114392 ko || +0m00.08s || -156 ko | +0.16% | -0.01% 0m52.27s | 1065664 ko | Rewriter/Rewriter/Examples.vo | 0m52.51s | 1067444 ko || -0m00.23s || -1780 ko | -0.45% | -0.16% 0m28.11s | 900092 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m27.32s | 900472 ko || +0m00.78s || -380 ko | +2.89% | -0.04% 0m23.68s | 885276 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.72s | 884912 ko || -0m00.03s || 364 ko | -0.16% | +0.04% 0m15.84s | 727620 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.74s | 727620 ko || +0m00.09s || 0 ko | +0.63% | +0.00% 0m12.10s | 639460 ko | Rewriter/Demo.vo | 0m12.12s | 639348 ko || -0m00.01s || 112 ko | -0.16% | +0.01% 0m00.81s | 471744 ko | Rewriter/Rewriter/Reify.vo | 0m00.82s | 471692 ko || -0m00.00s || 52 ko | -1.21% | +0.01% 0m00.76s | 488604 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.74s | 488516 ko || +0m00.02s || 88 ko | +2.70% | +0.01% 0m00.57s | 478860 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.51s | 478768 ko || +0m00.05s || 92 ko | +11.76% | +0.01% 0m00.53s | 480396 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.54s | 480060 ko || -0m00.01s || 336 ko | -1.85% | +0.06% 0m00.52s | 482272 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.52s | 482152 ko || +0m00.00s || 120 ko | +0.00% | +0.02% 0m00.51s | 480144 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.55s | 480396 ko || -0m00.04s || -252 ko | -7.27% | -0.05% ```

--- src/Rewriter/Rewriter/Reify.v | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index af3e0f8b7..8bce469e4 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -599,7 +599,7 @@ Module Compilers. | None => rewr | Some evm' => Reify.debug_fine_grained "replace_evar_map" (fun () => fprintf "(%t) → (%t)" evm' evm); - let rewr := lazy_match! (eval pattern '$evm' in '$rewr) with + let rewr := lazy_match! (eval pattern evm' in rewr) with | ?rewr _ => (eval cbv beta in '($rewr $evm)) end in replace_evar_map evm rewr From c943237747fcf213eb9cb52ce9d18256e628b640 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 13:44:14 +0530 Subject: [PATCH 34/74] Less typing in replace_evar_map
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m04.26s | 1382852 ko | Total Time / Peak Mem | 4m03.81s | 1386004 ko || +0m00.44s || -3152 ko | +0.18% | -0.22% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.41s | 1382852 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m54.33s | 1386004 ko || +0m00.07s || -3152 ko | +0.14% | -0.22% 0m54.32s | 1114392 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.07s | 1114132 ko || +0m00.25s || 260 ko | +0.46% | +0.02% 0m52.24s | 1067380 ko | Rewriter/Rewriter/Examples.vo | 0m52.07s | 1065552 ko || +0m00.17s || 1828 ko | +0.32% | +0.17% 0m28.19s | 900512 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m28.24s | 900216 ko || -0m00.04s || 296 ko | -0.17% | +0.03% 0m23.62s | 884896 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.61s | 885064 ko || +0m00.01s || -168 ko | +0.04% | -0.01% 0m15.80s | 727380 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.83s | 727732 ko || -0m00.02s || -352 ko | -0.18% | -0.04% 0m12.07s | 639496 ko | Rewriter/Demo.vo | 0m12.05s | 639480 ko || +0m00.01s || 16 ko | +0.16% | +0.00% 0m00.83s | 471620 ko | Rewriter/Rewriter/Reify.vo | 0m00.79s | 471736 ko || +0m00.03s || -116 ko | +5.06% | -0.02% 0m00.74s | 488656 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.80s | 488532 ko || -0m00.06s || 124 ko | -7.50% | +0.02% 0m00.54s | 482152 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.50s | 482296 ko || +0m00.04s || -144 ko | +8.00% | -0.02% 0m00.54s | 480376 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.52s | 480332 ko || +0m00.02s || 44 ko | +3.84% | +0.00% 0m00.50s | 478916 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.46s | 478860 ko || +0m00.03s || 56 ko | +8.69% | +0.01% 0m00.47s | 480360 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.55s | 480360 ko || -0m00.08s || 0 ko | -14.54% | +0.00% ```

--- src/Rewriter/Rewriter/Reify.v | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 8bce469e4..d1dcda10d 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -584,7 +584,8 @@ Module Compilers. "replace_evar_map" (fun (evm, rewr) => fprintf "(%t) in %t" evm rewr) (evm, rewr) Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) (fun () - => let evm' := match! rewr with + => let debug_Constr_check := Reify.Constr.debug_check_strict "replace_evar_map" in + let evm' := match! rewr with | context[@pattern.base.lookup_default ?_base ?_p ?evm'] => if Constr.equal evm evm' then Control.zero Match_failure @@ -600,7 +601,7 @@ Module Compilers. | Some evm' => Reify.debug_fine_grained "replace_evar_map" (fun () => fprintf "(%t) → (%t)" evm' evm); let rewr := lazy_match! (eval pattern evm' in rewr) with - | ?rewr _ => (eval cbv beta in '($rewr $evm)) + | ?rewr _ => (eval cbv beta in (debug_Constr_check (fun () => mkApp rewr [evm]))) end in replace_evar_map evm rewr end). From 33984670cf46ff41aa88b47e3d7f64c485910eb7 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 17:58:44 +0530 Subject: [PATCH 35/74] Use Constr.Unsafe.replace_by_pattern in replace_evar_map
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m04.26s | 1385680 ko | Total Time / Peak Mem | 4m04.18s | 1382700 ko || +0m00.07s || 2980 ko | +0.03% | +0.21% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.36s | 1113944 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.29s | 1114408 ko || +0m00.07s || -464 ko | +0.12% | -0.04% 0m54.23s | 1385680 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m54.36s | 1382700 ko || -0m00.13s || 2980 ko | -0.23% | +0.21% 0m52.29s | 1066676 ko | Rewriter/Rewriter/Examples.vo | 0m52.12s | 1067440 ko || +0m00.17s || -764 ko | +0.32% | -0.07% 0m28.19s | 894588 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m28.21s | 900476 ko || -0m00.01s || -5888 ko | -0.07% | -0.65% 0m23.63s | 884924 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.72s | 885008 ko || -0m00.08s || -84 ko | -0.37% | -0.00% 0m15.94s | 728008 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.86s | 727520 ko || +0m00.08s || 488 ko | +0.50% | +0.06% 0m12.07s | 639416 ko | Rewriter/Demo.vo | 0m12.09s | 639520 ko || -0m00.01s || -104 ko | -0.16% | -0.01% 0m00.80s | 488528 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.71s | 488520 ko || +0m00.09s || 8 ko | +12.67% | +0.00% 0m00.75s | 471708 ko | Rewriter/Rewriter/Reify.vo | 0m00.88s | 471808 ko || -0m00.13s || -100 ko | -14.77% | -0.02% 0m00.54s | 478812 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.55s | 478932 ko || -0m00.01s || -120 ko | -1.81% | -0.02% 0m00.51s | 482268 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.50s | 482052 ko || +0m00.01s || 216 ko | +2.00% | +0.04% 0m00.50s | 480168 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.44s | 480288 ko || +0m00.06s || -120 ko | +13.63% | -0.02% 0m00.46s | 480356 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.46s | 480256 ko || +0m00.00s || 100 ko | +0.00% | +0.02% ```

--- src/Rewriter/Rewriter/Reify.v | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index d1dcda10d..113718311 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -600,9 +600,7 @@ Module Compilers. | None => rewr | Some evm' => Reify.debug_fine_grained "replace_evar_map" (fun () => fprintf "(%t) → (%t)" evm' evm); - let rewr := lazy_match! (eval pattern evm' in rewr) with - | ?rewr _ => (eval cbv beta in (debug_Constr_check (fun () => mkApp rewr [evm]))) - end in + let rewr := debug_Constr_check (fun () => Constr.Unsafe.replace_by_pattern [evm'] [evm] rewr) in replace_evar_map evm rewr end). #[deprecated(since="8.15",note="Use Ltac2 instead.")] From 4a0abf398626380db03f77df184ad53b6abad916 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 13:50:19 +0530 Subject: [PATCH 36/74] Port adjust_type_variables to Ltac2
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m04.56s | 1379536 ko | Total Time / Peak Mem | 4m04.03s | 1385824 ko || +0m00.53s || -6288 ko | +0.21% | -0.45% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.30s | 1379536 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m54.52s | 1385824 ko || -0m00.22s || -6288 ko | -0.40% | -0.45% 0m54.26s | 1107500 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.32s | 1114204 ko || -0m00.06s || -6704 ko | -0.11% | -0.60% 0m52.39s | 1059184 ko | Rewriter/Rewriter/Examples.vo | 0m52.04s | 1066664 ko || +0m00.35s || -7480 ko | +0.67% | -0.70% 0m28.37s | 893168 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m28.17s | 894684 ko || +0m00.19s || -1516 ko | +0.70% | -0.16% 0m23.57s | 883056 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.63s | 884888 ko || -0m00.05s || -1832 ko | -0.25% | -0.20% 0m15.94s | 738452 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.75s | 727976 ko || +0m00.18s || 10476 ko | +1.20% | +1.43% 0m12.11s | 639648 ko | Rewriter/Demo.vo | 0m12.11s | 639476 ko || +0m00.00s || 172 ko | +0.00% | +0.02% 0m00.85s | 471796 ko | Rewriter/Rewriter/Reify.vo | 0m00.83s | 471556 ko || +0m00.02s || 240 ko | +2.40% | +0.05% 0m00.80s | 488548 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.72s | 488388 ko || +0m00.08s || 160 ko | +11.11% | +0.03% 0m00.56s | 478760 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.46s | 478880 ko || +0m00.10s || -120 ko | +21.73% | -0.02% 0m00.50s | 480208 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.48s | 480380 ko || +0m00.02s || -172 ko | +4.16% | -0.03% 0m00.49s | 482160 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.51s | 482164 ko || -0m00.02s || -4 ko | -3.92% | -0.00% 0m00.42s | 480220 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.49s | 480332 ko || -0m00.07s || -112 ko | -14.28% | -0.02% ```

--- src/Rewriter/Rewriter/Reify.v | 44 +++++++++++++++++++++-------------- 1 file changed, 26 insertions(+), 18 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 113718311..85badf00b 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -609,25 +609,33 @@ Module Compilers. |- Control.refine (fun () => replace_evar_map (Ltac1.get_to_constr "evm" evm) (Ltac1.get_to_constr "rewr" rewr))) in constr:(ltac:(f constr:(evm) rewr)). - Ltac adjust_type_variables_internal rewr := - lazymatch rewr with - | context[@pattern.base.subst_default ?base (pattern.base.relax ?t) ?evm''] - => let t' := constr:(@pattern.base.subst_default base (pattern.base.relax t) evm'') in - let rewr := - lazymatch (eval pattern - t', - (@pattern_base_subst_default_relax' base t evm''), - (@pattern_base_unsubst_default_relax' base t evm'') - in rewr) - with - | ?rewr _ _ _ - => (eval cbv beta in (rewr t (fun P x => x) (fun P x => x))) - end in - adjust_type_variables_internal rewr - | _ => rewr - end. + Ltac2 rec adjust_type_variables (rewr : constr) : constr := + Reify.debug_wrap + "adjust_type_variables" Message.of_constr rewr + Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) + (fun () + => let debug_Constr_check := Reify.Constr.debug_check_strict "adjust_type_variables" in + lazy_match! rewr with + | context[@pattern.base.subst_default ?base (@pattern.base.relax ?base ?t) ?evm''] + => let t' := debug_Constr_check (fun () => mkApp '@pattern.base.subst_default [base; mkApp '@pattern.base.relax [base; t]; evm'']) in + let rewr := + lazy_match! (eval pattern + $t', + (@pattern_base_subst_default_relax' $base $t $evm''), + (@pattern_base_unsubst_default_relax' $base $t $evm'') + in $rewr) + with + | ?rewr _ _ _ + => (eval cbv beta in constr:($rewr $t (fun P x => x) (fun P x => x))) + end in + adjust_type_variables rewr + | _ => rewr + end). + #[deprecated(since="8.15",note="Use Ltac2 instead.")] Ltac adjust_type_variables rewr := - constr:(ltac:(let v := adjust_type_variables_internal rewr in refine v)). + let f := ltac2:(rewr + |- Control.refine (fun () => adjust_type_variables (Ltac1.get_to_constr "rewr" rewr))) in + constr:(ltac:(f rewr)). Ltac replace_type_try_transport_internal term := lazymatch term with From fdaef4fb2634aa276524662aee2a7dd5da892d72 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 13:54:24 +0530 Subject: [PATCH 37/74] Less retyping in adjust_type_variables
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m04.84s | 1372048 ko | Total Time / Peak Mem | 4m03.44s | 1379472 ko || +0m01.39s || -7424 ko | +0.57% | -0.53% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.42s | 1372048 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m52.97s | 1379472 ko || +0m01.45s || -7424 ko | +2.73% | -0.53% 0m54.55s | 1107632 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.38s | 1107504 ko || +0m00.16s || 128 ko | +0.31% | +0.01% 0m52.36s | 1059280 ko | Rewriter/Rewriter/Examples.vo | 0m52.32s | 1059104 ko || +0m00.03s || 176 ko | +0.07% | +0.01% 0m28.37s | 893032 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m28.56s | 893128 ko || -0m00.18s || -96 ko | -0.66% | -0.01% 0m23.55s | 883056 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.80s | 883020 ko || -0m00.25s || 36 ko | -1.05% | +0.00% 0m15.84s | 738592 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.82s | 738320 ko || +0m00.01s || 272 ko | +0.12% | +0.03% 0m12.11s | 639652 ko | Rewriter/Demo.vo | 0m12.03s | 639648 ko || +0m00.08s || 4 ko | +0.66% | +0.00% 0m00.84s | 471660 ko | Rewriter/Rewriter/Reify.vo | 0m00.82s | 471628 ko || +0m00.02s || 32 ko | +2.43% | +0.00% 0m00.81s | 488592 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.73s | 488496 ko || +0m00.08s || 96 ko | +10.95% | +0.01% 0m00.53s | 478936 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.49s | 478840 ko || +0m00.04s || 96 ko | +8.16% | +0.02% 0m00.51s | 482212 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.53s | 482032 ko || -0m00.02s || 180 ko | -3.77% | +0.03% 0m00.51s | 480364 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.47s | 480360 ko || +0m00.04s || 4 ko | +8.51% | +0.00% 0m00.44s | 480392 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.53s | 480248 ko || -0m00.09s || 144 ko | -16.98% | +0.02% ```

--- src/Rewriter/Rewriter/Reify.v | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 85badf00b..07b288d76 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -620,10 +620,10 @@ Module Compilers. => let t' := debug_Constr_check (fun () => mkApp '@pattern.base.subst_default [base; mkApp '@pattern.base.relax [base; t]; evm'']) in let rewr := lazy_match! (eval pattern - $t', - (@pattern_base_subst_default_relax' $base $t $evm''), - (@pattern_base_unsubst_default_relax' $base $t $evm'') - in $rewr) + t', + '(@pattern_base_subst_default_relax' $base $t $evm''), + '(@pattern_base_unsubst_default_relax' $base $t $evm'') + in rewr) with | ?rewr _ _ _ => (eval cbv beta in constr:($rewr $t (fun P x => x) (fun P x => x))) From f88ff7d89af4550208fc475a3fb584e59885eff9 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 14:04:23 +0530 Subject: [PATCH 38/74] Less typing in adjust_type_variables
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m09.37s | 1378780 ko | Total Time / Peak Mem | 4m04.29s | 1372180 ko || +0m05.08s || 6600 ko | +2.08% | +0.48% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m56.11s | 1378780 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m54.20s | 1372180 ko || +0m01.90s || 6600 ko | +3.52% | +0.48% 0m53.61s | 1056116 ko | Rewriter/Rewriter/Examples.vo | 0m52.35s | 1059176 ko || +0m01.25s || -3060 ko | +2.40% | -0.28% 0m55.05s | 1105820 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.36s | 1107724 ko || +0m00.68s || -1904 ko | +1.26% | -0.17% 0m28.84s | 899024 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m28.40s | 894772 ko || +0m00.44s || 4252 ko | +1.54% | +0.47% 0m23.95s | 882432 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.52s | 883112 ko || +0m00.42s || -680 ko | +1.82% | -0.07% 0m16.14s | 739800 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.83s | 738548 ko || +0m00.31s || 1252 ko | +1.95% | +0.16% 0m12.14s | 640528 ko | Rewriter/Demo.vo | 0m12.11s | 639732 ko || +0m00.03s || 796 ko | +0.24% | +0.12% 0m00.79s | 488328 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.87s | 488532 ko || -0m00.07s || -204 ko | -9.19% | -0.04% 0m00.79s | 471660 ko | Rewriter/Rewriter/Reify.vo | 0m00.81s | 471672 ko || -0m00.02s || -12 ko | -2.46% | -0.00% 0m00.52s | 482252 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.49s | 482304 ko || +0m00.03s || -52 ko | +6.12% | -0.01% 0m00.51s | 480268 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.47s | 480144 ko || +0m00.04s || 124 ko | +8.51% | +0.02% 0m00.49s | 478800 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.42s | 478780 ko || +0m00.07s || 20 ko | +16.66% | +0.00% 0m00.44s | 480436 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.46s | 480328 ko || -0m00.02s || 108 ko | -4.34% | +0.02% ```

--- src/Rewriter/Rewriter/Reify.v | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 07b288d76..27a0d47f9 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -609,6 +609,7 @@ Module Compilers. |- Control.refine (fun () => replace_evar_map (Ltac1.get_to_constr "evm" evm) (Ltac1.get_to_constr "rewr" rewr))) in constr:(ltac:(f constr:(evm) rewr)). + Definition adjust_type_variables_id base t (P : base.type base -> Type) (x : P t) := x. Ltac2 rec adjust_type_variables (rewr : constr) : constr := Reify.debug_wrap "adjust_type_variables" Message.of_constr rewr @@ -621,12 +622,14 @@ Module Compilers. let rewr := lazy_match! (eval pattern t', - '(@pattern_base_subst_default_relax' $base $t $evm''), - '(@pattern_base_unsubst_default_relax' $base $t $evm'') + (mkApp '@pattern_base_subst_default_relax' [base; t; evm'']), + (mkApp '@pattern_base_unsubst_default_relax' [base; t; evm'']) in rewr) with | ?rewr _ _ _ - => (eval cbv beta in constr:($rewr $t (fun P x => x) (fun P x => x))) + => let id := debug_Constr_check (fun () => mkApp '@adjust_type_variables_id [base; t]) in + (eval cbv beta delta [adjust_type_variables_id] in + (debug_Constr_check (fun () => mkApp rewr [t; id; id]))) end in adjust_type_variables rewr | _ => rewr From 7bfac6f0050a2cf1a1e12c389c3407e8a3de01fb Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 13:56:36 +0530 Subject: [PATCH 39/74] Port replace_type_try_transport to Ltac2
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m17.43s | 1410296 ko | Total Time / Peak Mem | 4m10.95s | 1378872 ko || +0m06.47s || 31424 ko | +2.57% | +2.27% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m31.18s | 927816 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m29.18s | 898864 ko || +0m02.00s || 28952 ko | +6.85% | +3.22% 0m57.69s | 1410296 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m56.20s | 1378872 ko || +0m01.48s || 31424 ko | +2.65% | +2.27% 0m55.52s | 1090608 ko | Rewriter/Rewriter/Examples.vo | 0m53.85s | 1056116 ko || +0m01.67s || 34492 ko | +3.10% | +3.26% 0m56.03s | 1118304 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.19s | 1105892 ko || +0m00.84s || 12412 ko | +1.52% | +1.12% 0m24.54s | 891052 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m24.32s | 882480 ko || +0m00.21s || 8572 ko | +0.90% | +0.97% 0m16.38s | 739108 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.06s | 739604 ko || +0m00.32s || -496 ko | +1.99% | -0.06% 0m12.38s | 640172 ko | Rewriter/Demo.vo | 0m12.46s | 640432 ko || -0m00.08s || -260 ko | -0.64% | -0.04% 0m00.88s | 471736 ko | Rewriter/Rewriter/Reify.vo | 0m00.90s | 471812 ko || -0m00.02s || -76 ko | -2.22% | -0.01% 0m00.77s | 488644 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.82s | 488384 ko || -0m00.04s || 260 ko | -6.09% | +0.05% 0m00.57s | 482220 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.46s | 482256 ko || +0m00.10s || -36 ko | +23.91% | -0.00% 0m00.54s | 478764 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.53s | 478836 ko || +0m00.01s || -72 ko | +1.88% | -0.01% 0m00.48s | 480404 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.50s | 480428 ko || -0m00.02s || -24 ko | -4.00% | -0.00% 0m00.47s | 480252 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.49s | 480312 ko || -0m00.02s || -60 ko | -4.08% | -0.01% ```

--- src/Rewriter/Rewriter/Reify.v | 34 ++++++++++++++++++++++++---------- 1 file changed, 24 insertions(+), 10 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 27a0d47f9..cc92ff038 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -640,18 +640,32 @@ Module Compilers. |- Control.refine (fun () => adjust_type_variables (Ltac1.get_to_constr "rewr" rewr))) in constr:(ltac:(f rewr)). - Ltac replace_type_try_transport_internal term := - lazymatch term with - | context[@type.try_transport ?base_type ?try_make_transport_base_type_cps ?P ?t ?t] - => let v := constr:(@type.try_transport base_type try_make_transport_base_type_cps P t t) in - let term := lazymatch (eval pattern v in term) with - | ?term _ => (eval cbv beta in (term (@Some _))) + Ltac2 rec replace_type_try_transport (term : constr) : constr := + Reify.debug_wrap + "replace_type_try_transport" Message.of_constr term + Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) + (fun () + => let res := match! term with + | context[?v] + => lazy_match! v with + | @type.try_transport ?base_type ?try_make_transport_base_type_cps ?p ?t ?t + => Some v + end + | _ => None end in - replace_type_try_transport_internal term - | _ => term - end. + match res with + | Some v + => let term := lazy_match! (eval pattern $v in $term) with + | ?term _ => (eval cbv beta in '($term (@Some _))) + end in + replace_type_try_transport term + | None => term + end). + #[deprecated(since="8.15",note="Use Ltac2 instead.")] Ltac replace_type_try_transport term := - constr:(ltac:(let v := replace_type_try_transport_internal term in refine v)). + let f := ltac2:(term + |- Control.refine (fun () => replace_type_try_transport (Ltac1.get_to_constr "term" term))) in + constr:(ltac:(f term)). Ltac under_binders payload term cont ctx := lazymatch term with From 6b315f9c42789f15ad4577cadf6f8a773c1ac792 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 14:05:09 +0530 Subject: [PATCH 40/74] Less retyping in replace_type_try_transport
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m15.07s | 1410012 ko | Total Time / Peak Mem | 4m15.70s | 1410168 ko || -0m00.62s || -156 ko | -0.24% | -0.01% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m56.62s | 1410012 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m56.88s | 1410168 ko || -0m00.26s || -156 ko | -0.45% | -0.01% 0m55.58s | 1118240 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.80s | 1118292 ko || -0m00.21s || -52 ko | -0.39% | -0.00% 0m55.05s | 1090408 ko | Rewriter/Rewriter/Examples.vo | 0m55.09s | 1090448 ko || -0m00.04s || -40 ko | -0.07% | -0.00% 0m31.04s | 927668 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m31.03s | 927920 ko || +0m00.00s || -252 ko | +0.03% | -0.02% 0m24.70s | 891092 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m24.56s | 891188 ko || +0m00.14s || -96 ko | +0.57% | -0.01% 0m16.12s | 739324 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.06s | 739300 ko || +0m00.06s || 24 ko | +0.37% | +0.00% 0m12.44s | 640232 ko | Rewriter/Demo.vo | 0m12.46s | 640216 ko || -0m00.02s || 16 ko | -0.16% | +0.00% 0m00.84s | 471828 ko | Rewriter/Rewriter/Reify.vo | 0m00.89s | 471880 ko || -0m00.05s || -52 ko | -5.61% | -0.01% 0m00.78s | 488576 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.78s | 488612 ko || +0m00.00s || -36 ko | +0.00% | -0.00% 0m00.50s | 480312 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.55s | 480320 ko || -0m00.05s || -8 ko | -9.09% | -0.00% 0m00.49s | 482228 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.56s | 482288 ko || -0m00.07s || -60 ko | -12.50% | -0.01% 0m00.47s | 478864 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.52s | 478792 ko || -0m00.05s || 72 ko | -9.61% | +0.01% 0m00.45s | 480388 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.53s | 480284 ko || -0m00.08s || 104 ko | -15.09% | +0.02% ```

--- src/Rewriter/Rewriter/Reify.v | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index cc92ff038..3cec2d30b 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -655,7 +655,7 @@ Module Compilers. end in match res with | Some v - => let term := lazy_match! (eval pattern $v in $term) with + => let term := lazy_match! (eval pattern v in term) with | ?term _ => (eval cbv beta in '($term (@Some _))) end in replace_type_try_transport term From 217438f80a8b78e2def145061e989504c9616e21 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 14:07:54 +0530 Subject: [PATCH 41/74] Less typing in replace_type_try_transport
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m10.13s | 1411372 ko | Total Time / Peak Mem | 4m12.82s | 1410104 ko || -0m02.68s || 1268 ko | -1.06% | +0.08% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m29.45s | 930232 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.69s | 927644 ko || -0m01.24s || 2588 ko | -4.04% | +0.27% 0m55.55s | 1411372 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m55.86s | 1410104 ko || -0m00.31s || 1268 ko | -0.55% | +0.08% 0m55.11s | 1118480 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.32s | 1118284 ko || -0m00.21s || 196 ko | -0.37% | +0.01% 0m54.18s | 1102612 ko | Rewriter/Rewriter/Examples.vo | 0m54.43s | 1090432 ko || -0m00.25s || 12180 ko | -0.45% | +1.11% 0m24.08s | 891872 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m24.54s | 890936 ko || -0m00.46s || 936 ko | -1.87% | +0.10% 0m16.04s | 738912 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.10s | 739152 ko || -0m00.06s || -240 ko | -0.37% | -0.03% 0m12.13s | 640572 ko | Rewriter/Demo.vo | 0m12.34s | 640148 ko || -0m00.20s || 424 ko | -1.70% | +0.06% 0m00.87s | 471852 ko | Rewriter/Rewriter/Reify.vo | 0m00.74s | 471848 ko || +0m00.13s || 4 ko | +17.56% | +0.00% 0m00.79s | 488572 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.76s | 488640 ko || +0m00.03s || -68 ko | +3.94% | -0.01% 0m00.57s | 482188 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.56s | 482108 ko || +0m00.00s || 80 ko | +1.78% | +0.01% 0m00.49s | 480248 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.52s | 480196 ko || -0m00.03s || 52 ko | -5.76% | +0.01% 0m00.48s | 478996 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.46s | 478880 ko || +0m00.01s || 116 ko | +4.34% | +0.02% 0m00.40s | 480228 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.51s | 480196 ko || -0m00.10s || 32 ko | -21.56% | +0.00% ```

--- src/Rewriter/Rewriter/Reify.v | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 3cec2d30b..b150b8467 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -645,18 +645,21 @@ Module Compilers. "replace_type_try_transport" Message.of_constr term Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) (fun () - => let res := match! term with + => let debug_Constr_check := Reify.Constr.debug_check_strict "replace_type_try_transport" in + let res := match! term with | context[?v] => lazy_match! v with | @type.try_transport ?base_type ?try_make_transport_base_type_cps ?p ?t ?t - => Some v + => Some (v, debug_Constr_check (fun () => mkApp p [t])) end | _ => None end in match res with | Some v - => let term := lazy_match! (eval pattern v in term) with - | ?term _ => (eval cbv beta in '($term (@Some _))) + => let (v, pt) := v in + let term := lazy_match! (eval pattern v in term) with + | ?term _ => (eval cbv beta in + (debug_Constr_check (fun () => mkApp term [mkApp '@Some [pt] ]))) end in replace_type_try_transport term | None => term From db31d80aef458d144884aa3c5e212199390b1ca3 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 14:12:22 +0530 Subject: [PATCH 42/74] Less cbv beta in replace_type_try_transport
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m17.28s | 1409192 ko | Total Time / Peak Mem | 4m17.27s | 1411384 ko || +0m00.00s || -2192 ko | +0.00% | -0.15% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m57.45s | 1409192 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m57.60s | 1411384 ko || -0m00.14s || -2192 ko | -0.26% | -0.15% 0m56.02s | 1121092 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.85s | 1118504 ko || +0m00.17s || 2588 ko | +0.30% | +0.23% 0m55.65s | 1109692 ko | Rewriter/Rewriter/Examples.vo | 0m55.48s | 1102440 ko || +0m00.17s || 7252 ko | +0.30% | +0.65% 0m30.92s | 927456 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m31.33s | 930276 ko || -0m00.40s || -2820 ko | -1.30% | -0.30% 0m24.52s | 882076 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m24.63s | 891980 ko || -0m00.10s || -9904 ko | -0.44% | -1.11% 0m16.54s | 735096 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.44s | 738960 ko || +0m00.09s || -3864 ko | +0.60% | -0.52% 0m12.44s | 640080 ko | Rewriter/Demo.vo | 0m12.32s | 640484 ko || +0m00.11s || -404 ko | +0.97% | -0.06% 0m00.90s | 471904 ko | Rewriter/Rewriter/Reify.vo | 0m00.85s | 471740 ko || +0m00.05s || 164 ko | +5.88% | +0.03% 0m00.80s | 488520 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.78s | 488644 ko || +0m00.02s || -124 ko | +2.56% | -0.02% 0m00.56s | 478812 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.48s | 478796 ko || +0m00.08s || 16 ko | +16.66% | +0.00% 0m00.53s | 480156 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.51s | 480364 ko || +0m00.02s || -208 ko | +3.92% | -0.04% 0m00.50s | 480456 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.48s | 480436 ko || +0m00.02s || 20 ko | +4.16% | +0.00% 0m00.45s | 482196 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.53s | 482104 ko || -0m00.08s || 92 ko | -15.09% | +0.01% ```

--- src/Rewriter/Rewriter/Reify.v | 45 +++++++++++++++++++++-------------- 1 file changed, 27 insertions(+), 18 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index b150b8467..dc5ab1383 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -640,29 +640,38 @@ Module Compilers. |- Control.refine (fun () => adjust_type_variables (Ltac1.get_to_constr "rewr" rewr))) in constr:(ltac:(f rewr)). - Ltac2 rec replace_type_try_transport (term : constr) : constr := + Ltac2 replace_type_try_transport (term : constr) : constr := Reify.debug_wrap "replace_type_try_transport" Message.of_constr term Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) (fun () => let debug_Constr_check := Reify.Constr.debug_check_strict "replace_type_try_transport" in - let res := match! term with - | context[?v] - => lazy_match! v with - | @type.try_transport ?base_type ?try_make_transport_base_type_cps ?p ?t ?t - => Some (v, debug_Constr_check (fun () => mkApp p [t])) - end - | _ => None - end in - match res with - | Some v - => let (v, pt) := v in - let term := lazy_match! (eval pattern v in term) with - | ?term _ => (eval cbv beta in - (debug_Constr_check (fun () => mkApp term [mkApp '@Some [pt] ]))) - end in - replace_type_try_transport term - | None => term + let some := '@Some in + let rec aux (term : constr) (acc : constr list) : constr * constr list := + let res := match! term with + | context[?v] + => lazy_match! v with + | @type.try_transport ?base_type ?try_make_transport_base_type_cps ?p ?t ?t + => Some (v, p, t) + end + | _ => None + end in + match res with + | Some v + => let (v, p, t) := v in + let some_pt := debug_Constr_check (fun () => mkApp some [ mkApp p [t] ]) in + let term := lazy_match! (eval pattern v in term) with + | ?term _ => term + end in + aux term (some_pt :: acc) + | None => (term, acc) + end in + let (term, args) := aux term [] in + match args with + | [] => term + | _ :: _ + => (eval cbv beta in + (debug_Constr_check (fun () => mkApp term args))) end). #[deprecated(since="8.15",note="Use Ltac2 instead.")] Ltac replace_type_try_transport term := From 4bb70ce24df63f94370c819fa4fc827d2e246550 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 16:13:20 +0530 Subject: [PATCH 43/74] Introduce constr-copying in substitute_beq_with for perf comparison
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m17.07s | 1407672 ko | Total Time / Peak Mem | 4m17.11s | 1408984 ko || -0m00.03s || -1312 ko | -0.01% | -0.09% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m57.33s | 1407672 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m57.32s | 1408984 ko || +0m00.00s || -1312 ko | +0.01% | -0.09% 0m56.08s | 1105756 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.96s | 1120916 ko || +0m00.11s || -15160 ko | +0.21% | -1.35% 0m55.42s | 1106144 ko | Rewriter/Rewriter/Examples.vo | 0m55.47s | 1109620 ko || -0m00.04s || -3476 ko | -0.09% | -0.31% 0m31.10s | 923940 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m31.24s | 927496 ko || -0m00.13s || -3556 ko | -0.44% | -0.38% 0m24.68s | 884948 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m24.62s | 882140 ko || +0m00.05s || 2808 ko | +0.24% | +0.31% 0m16.47s | 737240 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.42s | 735060 ko || +0m00.04s || 2180 ko | +0.30% | +0.29% 0m12.37s | 639840 ko | Rewriter/Demo.vo | 0m12.39s | 640180 ko || -0m00.02s || -340 ko | -0.16% | -0.05% 0m00.81s | 471788 ko | Rewriter/Rewriter/Reify.vo | 0m00.85s | 471712 ko || -0m00.03s || 76 ko | -4.70% | +0.01% 0m00.77s | 488452 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.76s | 488452 ko || +0m00.01s || 0 ko | +1.31% | +0.00% 0m00.55s | 480208 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.55s | 480296 ko || +0m00.00s || -88 ko | +0.00% | -0.01% 0m00.52s | 480388 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.50s | 480372 ko || +0m00.02s || 16 ko | +4.00% | +0.00% 0m00.51s | 478948 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.48s | 478784 ko || +0m00.03s || 164 ko | +6.25% | +0.03% 0m00.47s | 482076 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.55s | 482296 ko || -0m00.08s || -220 ko | -14.54% | -0.04% ```

--- src/Rewriter/Rewriter/Reify.v | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index dc5ab1383..c2b9732d9 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -704,7 +704,7 @@ Module Compilers. lazymatch (eval pattern y in term) with | (fun z => ?term) _ => constr:(match x return _ with z => term end) end. - Ltac substitute_beq_with base_interp_beq only_eliminate_in_ctx full_ctx term beq x := + Ltac substitute_beq_with_internal base_interp_beq only_eliminate_in_ctx full_ctx term beq x := let is_good y := lazymatch full_ctx with | context[dyncons y _] => fail @@ -737,6 +737,8 @@ Module Compilers. end | None => term end. + Ltac substitute_beq_with base_interp_beq only_eliminate_in_ctx full_ctx term beq x := + constr:(ltac:(let res := substitute_beq_with_internal base_interp_beq only_eliminate_in_ctx full_ctx term beq x in exact res)). Ltac remove_andb_true term := let term := lazymatch (eval pattern andb, (andb true) in term) with | ?f _ _ => (eval cbn [andb] in (f (fun x y => andb y x) (fun b => b))) From 330d2d6f1b90d5692dc7b5a6d91e0bfbc162062b Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 16:47:40 +0530 Subject: [PATCH 44/74] Port substitute_beq_with to Ltac2
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m15.43s | 1407948 ko | Total Time / Peak Mem | 4m14.24s | 1407764 ko || +0m01.19s || 184 ko | +0.47% | +0.01% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m57.57s | 1407948 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m56.18s | 1407764 ko || +0m01.39s || 184 ko | +2.47% | +0.01% 0m55.27s | 1104432 ko | Rewriter/Rewriter/Examples.vo | 0m53.58s | 1106240 ko || +0m01.69s || -1808 ko | +3.15% | -0.16% 0m29.95s | 932676 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m31.26s | 923968 ko || -0m01.31s || 8708 ko | -4.19% | +0.94% 0m55.93s | 1125036 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.97s | 1105692 ko || -0m00.03s || 19344 ko | -0.07% | +1.74% 0m24.40s | 896540 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m24.70s | 884992 ko || -0m00.30s || 11548 ko | -1.21% | +1.30% 0m16.54s | 736548 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.21s | 737396 ko || +0m00.32s || -848 ko | +2.03% | -0.11% 0m12.18s | 639748 ko | Rewriter/Demo.vo | 0m12.52s | 639892 ko || -0m00.33s || -144 ko | -2.71% | -0.02% 0m00.89s | 471928 ko | Rewriter/Rewriter/Reify.vo | 0m00.83s | 471912 ko || +0m00.06s || 16 ko | +7.22% | +0.00% 0m00.80s | 488700 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.82s | 488416 ko || -0m00.01s || 284 ko | -2.43% | +0.05% 0m00.51s | 482232 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.54s | 482184 ko || -0m00.03s || 48 ko | -5.55% | +0.00% 0m00.49s | 478796 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.54s | 478920 ko || -0m00.05s || -124 ko | -9.25% | -0.02% 0m00.46s | 480080 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.56s | 480352 ko || -0m00.10s || -272 ko | -17.85% | -0.05% 0m00.45s | 480372 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.53s | 480300 ko || -0m00.08s || 72 ko | -15.09% | +0.01% ```

--- src/Rewriter/Rewriter/Reify.v | 109 +++++++++++++++++++++++----------- 1 file changed, 73 insertions(+), 36 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index c2b9732d9..44adb43d0 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -700,45 +700,82 @@ Module Compilers. end) | ?term => cont payload ctx term end. - Ltac substitute_with term x y := - lazymatch (eval pattern y in term) with - | (fun z => ?term) _ => constr:(match x return _ with z => term end) - end. - Ltac substitute_beq_with_internal base_interp_beq only_eliminate_in_ctx full_ctx term beq x := - let is_good y := - lazymatch full_ctx with - | context[dyncons y _] => fail - | _ => is_var y; - lazymatch only_eliminate_in_ctx with - | context[y] => idtac - end - end in - let y := match term with - | context term' [beq x ?y] - => let __ := is_good y in - constr:(Some (beq x y)) - | context term' [@base.interp_beq ?base ?base_interp ?base_interp_beq ?t x ?y] - => let __ := is_good y in - constr:(Some (@base.interp_beq base base_interp base_interp_beq t x y)) - | context term' [base_interp_beq ?t x ?y] - => let __ := is_good y in - constr:(Some (base_interp_beq t x y)) - | context term' [base_interp_beq ?t1 ?t2 x ?y] (* heterogenous form *) - => let __ := is_good y in - constr:(Some (base_interp_beq t1 t2 x y)) - | _ => constr:(@None unit) - end in - lazymatch y with - | Some (?beq x ?y) - => lazymatch term with - | context term'[beq x y] - => let term := context term'[true] in - substitute_with term x y + Ltac2 substitute_with (term : constr) (x : constr) (y : constr) : constr := + Reify.debug_wrap + "substitute_with" (fun () => fprintf "(%t) → (%t) in %t" y x term) () + Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) + (fun () + => Reify.Constr.debug_check_strict "substitute_with" (fun () => Constr.Unsafe.replace_by_pattern [y] [x] term)). + + Ltac2 substitute_beq_with (base_interp_beq : constr) (only_eliminate_in_ctx : (ident * constr (* ty *) * constr (* var *)) list) (full_ctx : ident list) (term : constr) (beq : constr) (x : constr) : constr := + Reify.debug_wrap + "substitute_beq_with" (fun () => fprintf "(%t) =? _ in %t" x term) () + Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) + (fun () + => let only_eliminate_in_ctx := List.map (fun (n, _ty, _v) => n) only_eliminate_in_ctx in + let is_good (y : constr) := + match Constr.Unsafe.kind_nocast y with + | Constr.Unsafe.Var y + => neg (List.mem Ident.equal y full_ctx) && List.mem Ident.equal y only_eliminate_in_ctx + | _ => false + end in + let term'_y := match! term with + | context term'[?beq' ?x' ?y] + => if Constr.equal_nounivs x x' + && is_good y + && (Constr.equal_nounivs beq' beq + || match! beq' with + | @base.interp_beq ?base ?base_interp ?base_interp_beq ?t + => true + | ?base_interp_beq' ?t + => if Constr.equal_nounivs base_interp_beq' base_interp_beq + then true + else Control.zero Match_failure + | ?base_interp_beq' ?t1 ?t2 + => if Constr.equal_nounivs base_interp_beq' base_interp_beq + then true + else Control.zero Match_failure + end) + then Some (term', y) + else Control.zero Match_failure + | _ => None + end in + match term'_y with + | Some term'_y + => let (term', y) := term'_y in + let term := Pattern.instantiate term' 'true in + substitute_with term x y + | None => term + end). + + #[deprecated(since="8.15",note="Use Ltac2 direct instead.")] + Ltac2 rec var_dynlist_to_list (full_ctx : constr) : ident list := + lazy_match! full_ctx with + | dyncons ?x ?xs + => match Constr.Unsafe.kind_nocast x with + | Constr.Unsafe.Var x + => x :: var_dynlist_to_list xs + | _ + => Control.throw (Reification_panic (fprintf "Non-var in dynlist: %t" x)) end - | None => term + | dynnil => [] + | _ => Control.throw (Reification_panic (fprintf "Non-dynlist passed to var_dynlist_to_dynlist: %t" full_ctx)) end. + + #[deprecated(since="8.15",note="Use Ltac2 instead.")] Ltac substitute_beq_with base_interp_beq only_eliminate_in_ctx full_ctx term beq x := - constr:(ltac:(let res := substitute_beq_with_internal base_interp_beq only_eliminate_in_ctx full_ctx term beq x in exact res)). + let f := ltac2:(base_interp_beq only_eliminate_in_ctx full_ctx term beq x + |- let base_interp_beq := Ltac1.get_to_constr "base_interp_beq" base_interp_beq in + let only_eliminate_in_ctx := Ltac1.get_to_constr "only_eliminate_in_ctx" only_eliminate_in_ctx in + let only_eliminate_in_ctx := expr.value_ctx_to_list only_eliminate_in_ctx in + let full_ctx := Ltac1.get_to_constr "full_ctx" full_ctx in + let full_ctx := var_dynlist_to_list full_ctx in + let term := Ltac1.get_to_constr "term" term in + let beq := Ltac1.get_to_constr "beq" beq in + let x := Ltac1.get_to_constr "x" x in + Control.refine (fun () => substitute_beq_with base_interp_beq only_eliminate_in_ctx full_ctx term beq x)) in + constr:(ltac:(f base_interp_beq only_eliminate_in_ctx full_ctx term beq x)). + Ltac remove_andb_true term := let term := lazymatch (eval pattern andb, (andb true) in term) with | ?f _ _ => (eval cbn [andb] in (f (fun x y => andb y x) (fun b => b))) From fc32aaaca966aa6f206d0b229409d98acb69633e Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 16:52:52 +0530 Subject: [PATCH 45/74] Add constr-copying for remove_andb_true adjust_if_negb substitute_bool_eqb substitute_beq deep_substitute_beq for Ltac2 perf comparison
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m12.03s | 1435904 ko | Total Time / Peak Mem | 4m12.83s | 1407792 ko || -0m00.79s || 28112 ko | -0.31% | +1.99% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m55.72s | 1435904 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m56.96s | 1407792 ko || -0m01.24s || 28112 ko | -2.17% | +1.99% 0m55.35s | 1125432 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.55s | 1125176 ko || -0m00.19s || 256 ko | -0.36% | +0.02% 0m54.44s | 1106312 ko | Rewriter/Rewriter/Examples.vo | 0m54.43s | 1104436 ko || +0m00.00s || 1876 ko | +0.01% | +0.16% 0m30.62s | 926300 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m29.77s | 932644 ko || +0m00.85s || -6344 ko | +2.85% | -0.68% 0m24.10s | 895220 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m24.11s | 896316 ko || -0m00.00s || -1096 ko | -0.04% | -0.12% 0m16.23s | 737504 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.16s | 736472 ko || +0m00.07s || 1032 ko | +0.43% | +0.14% 0m12.14s | 639088 ko | Rewriter/Demo.vo | 0m12.13s | 639844 ko || +0m00.00s || -756 ko | +0.08% | -0.11% 0m00.83s | 472112 ko | Rewriter/Rewriter/Reify.vo | 0m00.85s | 471872 ko || -0m00.02s || 240 ko | -2.35% | +0.05% 0m00.74s | 488532 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.74s | 488676 ko || +0m00.00s || -144 ko | +0.00% | -0.02% 0m00.49s | 480400 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.48s | 480284 ko || +0m00.01s || 116 ko | +2.08% | +0.02% 0m00.49s | 478920 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.60s | 478844 ko || -0m00.10s || 76 ko | -18.33% | +0.01% 0m00.46s | 482184 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.51s | 482236 ko || -0m00.04s || -52 ko | -9.80% | -0.01% 0m00.43s | 480376 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.54s | 480236 ko || -0m00.11s || 140 ko | -20.37% | +0.02% ```

--- src/Rewriter/Rewriter/Reify.v | 32 +++++++++++++++++++++----------- 1 file changed, 21 insertions(+), 11 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 44adb43d0..8b1c7ee5c 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -776,7 +776,7 @@ Module Compilers. Control.refine (fun () => substitute_beq_with base_interp_beq only_eliminate_in_ctx full_ctx term beq x)) in constr:(ltac:(f base_interp_beq only_eliminate_in_ctx full_ctx term beq x)). - Ltac remove_andb_true term := + Ltac remove_andb_true_internal term := let term := lazymatch (eval pattern andb, (andb true) in term) with | ?f _ _ => (eval cbn [andb] in (f (fun x y => andb y x) (fun b => b))) end in @@ -784,31 +784,37 @@ Module Compilers. | ?f _ _ => (eval cbn [andb] in (f (fun x y => andb y x) (fun b => b))) end in term. - Ltac adjust_if_negb term := + Ltac remove_andb_true term := + constr:(ltac:(let res := remove_andb_true_internal term in exact res)). + Ltac adjust_if_negb_internal term := lazymatch term with | context term'[if negb ?x then ?a else ?b] => let term := context term'[if x then b else a] in - adjust_if_negb term + adjust_if_negb_internal term | _ => term end. - Ltac substitute_bool_eqb term := + Ltac adjust_if_negb term := + constr:(ltac:(let res := adjust_if_negb_internal term in exact res)). + Ltac substitute_bool_eqb_internal term := lazymatch term with | context term'[Bool.eqb ?x true] => let term := context term'[x] in - substitute_bool_eqb term + substitute_bool_eqb_internal term | context term'[Bool.eqb ?x false] => let term := context term'[negb x] in - substitute_bool_eqb term + substitute_bool_eqb_internal term | context term'[Bool.eqb true ?x] => let term := context term'[x] in - substitute_bool_eqb term + substitute_bool_eqb_internal term | context term'[Bool.eqb false ?x] => let term := context term'[negb x] in - substitute_bool_eqb term + substitute_bool_eqb_internal term | _ => term end. + Ltac substitute_bool_eqb term := + constr:(ltac:(let res := substitute_bool_eqb_internal term in exact res)). - Ltac substitute_beq base_interp_beq only_eliminate_in_ctx full_ctx ctx term := + Ltac substitute_beq_internal base_interp_beq only_eliminate_in_ctx full_ctx ctx term := let base_interp_beq_head := head base_interp_beq in lazymatch ctx with | dynnil @@ -825,16 +831,20 @@ Module Compilers. substitute_beq_with base_interp_beq only_eliminate_in_ctx full_ctx term beq v | _ => term end in - substitute_beq base_interp_beq only_eliminate_in_ctx full_ctx ctx term + substitute_beq_internal base_interp_beq only_eliminate_in_ctx full_ctx ctx term end. + Ltac substitute_beq base_interp_beq only_eliminate_in_ctx full_ctx ctx term := + constr:(ltac:(let res := substitute_beq_internal base_interp_beq only_eliminate_in_ctx full_ctx ctx term in exact res)). - Ltac deep_substitute_beq base_interp_beq only_eliminate_in_ctx term := + Ltac deep_substitute_beq_internal base_interp_beq only_eliminate_in_ctx term := lazymatch term with | context term'[@Build_rewrite_rule_data ?base ?ident ?var ?pident ?pident_arg_types ?t ?p ?sda ?wo ?ul ?subterm] => let subterm := under_binders only_eliminate_in_ctx subterm ltac:(fun only_eliminate_in_ctx ctx term => substitute_beq base_interp_beq only_eliminate_in_ctx ctx ctx term) dynnil in let term := context term'[@Build_rewrite_rule_data base ident var pident pident_arg_types t p sda wo ul subterm] in term end. + Ltac deep_substitute_beq base_interp_beq only_eliminate_in_ctx term := + constr:(ltac:(let res := deep_substitute_beq_internal base_interp_beq only_eliminate_in_ctx term in exact res)). Ltac clean_beq_internal base_interp_beq only_eliminate_in_ctx term := let base_interp_beq_head := head base_interp_beq in From a1b6f114f8f6f49380f480edc4d72ff27a828b2a Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 16:54:50 +0530 Subject: [PATCH 46/74] Port remove_andb_true to Ltac2
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m12.90s | 1430548 ko | Total Time / Peak Mem | 4m11.00s | 1435872 ko || +0m01.89s || -5324 ko | +0.75% | -0.37% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m55.49s | 1127112 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.09s | 1125364 ko || +0m01.39s || 1748 ko | +2.58% | +0.15% 0m55.97s | 1430548 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m56.08s | 1435872 ko || -0m00.10s || -5324 ko | -0.19% | -0.37% 0m54.63s | 1087940 ko | Rewriter/Rewriter/Examples.vo | 0m54.25s | 1106188 ko || +0m00.38s || -18248 ko | +0.70% | -1.64% 0m30.74s | 925344 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.56s | 926288 ko || +0m00.17s || -944 ko | +0.58% | -0.10% 0m24.24s | 890944 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m24.02s | 895076 ko || +0m00.21s || -4132 ko | +0.91% | -0.46% 0m16.09s | 741272 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.17s | 737652 ko || -0m00.08s || 3620 ko | -0.49% | +0.49% 0m12.11s | 639364 ko | Rewriter/Demo.vo | 0m12.16s | 639112 ko || -0m00.05s || 252 ko | -0.41% | +0.03% 0m00.81s | 472132 ko | Rewriter/Rewriter/Reify.vo | 0m00.86s | 472216 ko || -0m00.04s || -84 ko | -5.81% | -0.01% 0m00.75s | 488560 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.79s | 488648 ko || -0m00.04s || -88 ko | -5.06% | -0.01% 0m00.55s | 482292 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.55s | 482076 ko || +0m00.00s || 216 ko | +0.00% | +0.04% 0m00.54s | 480444 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.50s | 480364 ko || +0m00.04s || 80 ko | +8.00% | +0.01% 0m00.53s | 478844 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.49s | 478964 ko || +0m00.04s || -120 ko | +8.16% | -0.02% 0m00.45s | 480324 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.49s | 480212 ko || -0m00.03s || 112 ko | -8.16% | +0.02% ```

--- src/Rewriter/Rewriter/Reify.v | 25 ++++++++++++++++--------- 1 file changed, 16 insertions(+), 9 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 8b1c7ee5c..a057ef532 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -776,16 +776,23 @@ Module Compilers. Control.refine (fun () => substitute_beq_with base_interp_beq only_eliminate_in_ctx full_ctx term beq x)) in constr:(ltac:(f base_interp_beq only_eliminate_in_ctx full_ctx term beq x)). - Ltac remove_andb_true_internal term := - let term := lazymatch (eval pattern andb, (andb true) in term) with - | ?f _ _ => (eval cbn [andb] in (f (fun x y => andb y x) (fun b => b))) - end in - let term := lazymatch (eval pattern andb, (andb true) in term) with - | ?f _ _ => (eval cbn [andb] in (f (fun x y => andb y x) (fun b => b))) - end in - term. + Ltac2 remove_andb_true (term : constr) : constr := + Reify.debug_wrap + "remove_andb_true" Message.of_constr term + Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) + (fun () + => let term := lazy_match! (eval pattern 'andb, '(andb true) in '$term) with + | ?f _ _ => (eval cbn [andb] in constr:($f (fun x y => andb y x) (fun b => b))) + end in + let term := lazy_match! (eval pattern 'andb, '(andb true) in '$term) with + | ?f _ _ => (eval cbn [andb] in constr:($f (fun x y => andb y x) (fun b => b))) + end in + term). + #[deprecated(since="8.15",note="Use Ltac2 instead.")] Ltac remove_andb_true term := - constr:(ltac:(let res := remove_andb_true_internal term in exact res)). + let f := ltac2:(term + |- Control.refine (fun () => remove_andb_true (Ltac1.get_to_constr "term" term))) in + constr:(ltac:(f term)). Ltac adjust_if_negb_internal term := lazymatch term with | context term'[if negb ?x then ?a else ?b] From 2c1926214a0b12903d83f140ee5fa98f79810190 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 14:16:17 +0530 Subject: [PATCH 47/74] Less retyping in remove_andb_true
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m12.70s | 1430984 ko | Total Time / Peak Mem | 4m12.58s | 1430736 ko || +0m00.12s || 248 ko | +0.04% | +0.01% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m56.22s | 1430984 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m55.93s | 1430736 ko || +0m00.28s || 248 ko | +0.51% | +0.01% 0m55.45s | 1127156 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.48s | 1127032 ko || -0m00.02s || 124 ko | -0.05% | +0.01% 0m54.50s | 1088072 ko | Rewriter/Rewriter/Examples.vo | 0m54.55s | 1088040 ko || -0m00.04s || 32 ko | -0.09% | +0.00% 0m30.54s | 928644 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.75s | 925368 ko || -0m00.21s || 3276 ko | -0.68% | +0.35% 0m24.13s | 890060 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.92s | 890940 ko || +0m00.20s || -880 ko | +0.87% | -0.09% 0m16.22s | 741588 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.21s | 741416 ko || +0m00.00s || 172 ko | +0.06% | +0.02% 0m12.10s | 639456 ko | Rewriter/Demo.vo | 0m12.09s | 639352 ko || +0m00.00s || 104 ko | +0.08% | +0.01% 0m00.79s | 472148 ko | Rewriter/Rewriter/Reify.vo | 0m00.87s | 472220 ko || -0m00.07s || -72 ko | -9.19% | -0.01% 0m00.74s | 488460 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.79s | 488720 ko || -0m00.05s || -260 ko | -6.32% | -0.05% 0m00.51s | 480344 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.47s | 480292 ko || +0m00.04s || 52 ko | +8.51% | +0.01% 0m00.50s | 482240 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.54s | 482184 ko || -0m00.04s || 56 ko | -7.40% | +0.01% 0m00.50s | 480320 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.48s | 480220 ko || +0m00.02s || 100 ko | +4.16% | +0.02% 0m00.50s | 478884 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.50s | 478780 ko || +0m00.00s || 104 ko | +0.00% | +0.02% ```

--- src/Rewriter/Rewriter/Reify.v | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index a057ef532..a5ef443ee 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -781,10 +781,10 @@ Module Compilers. "remove_andb_true" Message.of_constr term Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) (fun () - => let term := lazy_match! (eval pattern 'andb, '(andb true) in '$term) with + => let term := lazy_match! (eval pattern 'andb, '(andb true) in term) with | ?f _ _ => (eval cbn [andb] in constr:($f (fun x y => andb y x) (fun b => b))) end in - let term := lazy_match! (eval pattern 'andb, '(andb true) in '$term) with + let term := lazy_match! (eval pattern 'andb, '(andb true) in term) with | ?f _ _ => (eval cbn [andb] in constr:($f (fun x y => andb y x) (fun b => b))) end in term). From f84336f3bd4fe9752cec1cc882fed103d9115269 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 16:55:59 +0530 Subject: [PATCH 48/74] Port adjust_if_negb to Ltac2
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m12.54s | 1436048 ko | Total Time / Peak Mem | 4m12.67s | 1430840 ko || -0m00.12s || 5208 ko | -0.05% | +0.36% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m56.04s | 1436048 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m55.98s | 1430840 ko || +0m00.06s || 5208 ko | +0.10% | +0.36% 0m55.43s | 1112652 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.26s | 1127180 ko || +0m00.17s || -14528 ko | +0.30% | -1.28% 0m54.59s | 1089636 ko | Rewriter/Rewriter/Examples.vo | 0m54.58s | 1087932 ko || +0m00.01s || 1704 ko | +0.01% | +0.15% 0m30.61s | 927616 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.81s | 928656 ko || -0m00.19s || -1040 ko | -0.64% | -0.11% 0m24.02s | 892796 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m24.10s | 890164 ko || -0m00.08s || 2632 ko | -0.33% | +0.29% 0m16.16s | 743932 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.25s | 741440 ko || -0m00.08s || 2492 ko | -0.55% | +0.33% 0m12.11s | 639184 ko | Rewriter/Demo.vo | 0m12.09s | 639508 ko || +0m00.01s || -324 ko | +0.16% | -0.05% 0m00.85s | 472228 ko | Rewriter/Rewriter/Reify.vo | 0m00.82s | 472224 ko || +0m00.03s || 4 ko | +3.65% | +0.00% 0m00.73s | 488656 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.81s | 488728 ko || -0m00.08s || -72 ko | -9.87% | -0.01% 0m00.54s | 478916 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.52s | 478960 ko || +0m00.02s || -44 ko | +3.84% | -0.00% 0m00.51s | 482212 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.49s | 482072 ko || +0m00.02s || 140 ko | +4.08% | +0.02% 0m00.49s | 480380 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.47s | 480412 ko || +0m00.02s || -32 ko | +4.25% | -0.00% 0m00.47s | 480176 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.50s | 480368 ko || -0m00.03s || -192 ko | -6.00% | -0.03% ```

--- src/Rewriter/Rewriter/Reify.v | 23 +++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index a5ef443ee..39d242ec8 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -793,15 +793,22 @@ Module Compilers. let f := ltac2:(term |- Control.refine (fun () => remove_andb_true (Ltac1.get_to_constr "term" term))) in constr:(ltac:(f term)). - Ltac adjust_if_negb_internal term := - lazymatch term with - | context term'[if negb ?x then ?a else ?b] - => let term := context term'[if x then b else a] in - adjust_if_negb_internal term - | _ => term - end. + Ltac2 rec adjust_if_negb (term : constr) : constr := + Reify.debug_wrap + "adjust_if_negb" Message.of_constr term + Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) + (fun () + => lazy_match! term with + | context term'[if negb ?x then ?a else ?b] + => let term := Pattern.instantiate term' '(if $x then $b else $a) in + adjust_if_negb term + | _ => term + end). + #[deprecated(since="8.15",note="Use Ltac2 instead.")] Ltac adjust_if_negb term := - constr:(ltac:(let res := adjust_if_negb_internal term in exact res)). + let f := ltac2:(term + |- Control.refine (fun () => adjust_if_negb (Ltac1.get_to_constr "term" term))) in + constr:(ltac:(f term)). Ltac substitute_bool_eqb_internal term := lazymatch term with | context term'[Bool.eqb ?x true] From 7aeea771e83a60145cd78fc8a478e0b6bc2fbb71 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 16:59:42 +0530 Subject: [PATCH 49/74] Port substitute_bool_eqb to Ltac2
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m12.19s | 1435912 ko | Total Time / Peak Mem | 4m12.22s | 1436176 ko || -0m00.03s || -264 ko | -0.01% | -0.01% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m55.76s | 1435912 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m56.26s | 1436176 ko || -0m00.50s || -264 ko | -0.88% | -0.01% 0m55.22s | 1122952 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.21s | 1112600 ko || +0m00.00s || 10352 ko | +0.01% | +0.93% 0m54.65s | 1090660 ko | Rewriter/Rewriter/Examples.vo | 0m54.55s | 1089544 ko || +0m00.10s || 1116 ko | +0.18% | +0.10% 0m30.64s | 927284 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.79s | 927680 ko || -0m00.14s || -396 ko | -0.48% | -0.04% 0m24.08s | 894252 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m24.01s | 892976 ko || +0m00.06s || 1276 ko | +0.29% | +0.14% 0m16.23s | 748356 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.90s | 744020 ko || +0m00.33s || 4336 ko | +2.07% | +0.58% 0m12.02s | 639572 ko | Rewriter/Demo.vo | 0m11.82s | 639132 ko || +0m00.19s || 440 ko | +1.69% | +0.06% 0m00.84s | 472112 ko | Rewriter/Rewriter/Reify.vo | 0m00.84s | 472200 ko || +0m00.00s || -88 ko | +0.00% | -0.01% 0m00.74s | 488604 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.81s | 488540 ko || -0m00.07s || 64 ko | -8.64% | +0.01% 0m00.53s | 480252 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.55s | 480332 ko || -0m00.02s || -80 ko | -3.63% | -0.01% 0m00.51s | 482276 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.57s | 482248 ko || -0m00.05s || 28 ko | -10.52% | +0.00% 0m00.50s | 478904 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.43s | 478968 ko || +0m00.07s || -64 ko | +16.27% | -0.01% 0m00.48s | 480480 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.49s | 480468 ko || -0m00.01s || 12 ko | -2.04% | +0.00% ```

--- src/Rewriter/Rewriter/Reify.v | 45 ++++++++++++++++++++++------------- 1 file changed, 28 insertions(+), 17 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 39d242ec8..8be2f7120 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -809,24 +809,35 @@ Module Compilers. let f := ltac2:(term |- Control.refine (fun () => adjust_if_negb (Ltac1.get_to_constr "term" term))) in constr:(ltac:(f term)). - Ltac substitute_bool_eqb_internal term := - lazymatch term with - | context term'[Bool.eqb ?x true] - => let term := context term'[x] in - substitute_bool_eqb_internal term - | context term'[Bool.eqb ?x false] - => let term := context term'[negb x] in - substitute_bool_eqb_internal term - | context term'[Bool.eqb true ?x] - => let term := context term'[x] in - substitute_bool_eqb_internal term - | context term'[Bool.eqb false ?x] - => let term := context term'[negb x] in - substitute_bool_eqb_internal term - | _ => term - end. + Ltac2 rec substitute_bool_eqb (term : constr) : constr := + Reify.debug_wrap + "substitute_bool_eqb" Message.of_constr term + Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) + (fun () + => lazy_match! term with + | context term'[Bool.eqb ?x true] + => Reify.debug_fine_grained "substitute_bool_eqb" (fun () => fprintf "found %t =? true" x); + let term := Pattern.instantiate term' x in + substitute_bool_eqb term + | context term'[Bool.eqb ?x false] + => Reify.debug_fine_grained "substitute_bool_eqb" (fun () => fprintf "found %t =? false" x); + let term := Pattern.instantiate term' (mkApp 'negb [x]) in + substitute_bool_eqb term + | context term'[Bool.eqb true ?x] + => Reify.debug_fine_grained "substitute_bool_eqb" (fun () => fprintf "found true =? %t" x); + let term := Pattern.instantiate term' x in + substitute_bool_eqb term + | context term'[Bool.eqb false ?x] + => Reify.debug_fine_grained "substitute_bool_eqb" (fun () => fprintf "found false =? %t" x); + let term := Pattern.instantiate term' (mkApp 'negb [x]) in + substitute_bool_eqb term + | _ => term + end). + #[deprecated(since="8.15",note="Use Ltac2 instead.")] Ltac substitute_bool_eqb term := - constr:(ltac:(let res := substitute_bool_eqb_internal term in exact res)). + let f := ltac2:(term + |- Control.refine (fun () => substitute_bool_eqb (Ltac1.get_to_constr "term" term))) in + constr:(ltac:(f term)). Ltac substitute_beq_internal base_interp_beq only_eliminate_in_ctx full_ctx ctx term := let base_interp_beq_head := head base_interp_beq in From 6e2f9dfac873de50d2739cb74f1cbd92c59d92dd Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 17:17:55 +0530 Subject: [PATCH 50/74] Port substitute_beq to Ltac2
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m12.94s | 1435228 ko | Total Time / Peak Mem | 4m12.43s | 1436056 ko || +0m00.50s || -828 ko | +0.20% | -0.05% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m56.20s | 1435228 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m56.19s | 1436056 ko || +0m00.01s || -828 ko | +0.01% | -0.05% 0m55.64s | 1112716 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.31s | 1122928 ko || +0m00.32s || -10212 ko | +0.59% | -0.90% 0m54.53s | 1089588 ko | Rewriter/Rewriter/Examples.vo | 0m54.52s | 1090576 ko || +0m00.00s || -988 ko | +0.01% | -0.09% 0m30.75s | 929164 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.69s | 927288 ko || +0m00.05s || 1876 ko | +0.19% | +0.20% 0m24.01s | 891624 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.77s | 894272 ko || +0m00.24s || -2648 ko | +1.00% | -0.29% 0m16.15s | 742012 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.15s | 748412 ko || +0m00.00s || -6400 ko | +0.00% | -0.85% 0m12.09s | 639108 ko | Rewriter/Demo.vo | 0m12.09s | 639668 ko || +0m00.00s || -560 ko | +0.00% | -0.08% 0m00.85s | 472448 ko | Rewriter/Rewriter/Reify.vo | 0m00.86s | 472236 ko || -0m00.01s || 212 ko | -1.16% | +0.04% 0m00.78s | 488740 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.78s | 488624 ko || +0m00.00s || 116 ko | +0.00% | +0.02% 0m00.50s | 480460 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.49s | 480352 ko || +0m00.01s || 108 ko | +2.04% | +0.02% 0m00.50s | 480412 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.50s | 480504 ko || +0m00.00s || -92 ko | +0.00% | -0.01% 0m00.49s | 478872 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.53s | 478992 ko || -0m00.04s || -120 ko | -7.54% | -0.02% 0m00.46s | 482212 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.56s | 482164 ko || -0m00.10s || 48 ko | -17.85% | +0.00% ```

--- src/Rewriter/Rewriter/Reify.v | 62 ++++++++++++++++++++++++----------- 1 file changed, 42 insertions(+), 20 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 8be2f7120..569f33a79 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -26,6 +26,7 @@ Require Import Rewriter.Util.Tactics.DebugPrint. Require Import Rewriter.Util.CPSNotations. Require Import Rewriter.Util.Notations. Require Import Rewriter.Util.Tactics2.Head. +Require Import Rewriter.Util.Tactics2.HeadReference. Require Import Rewriter.Util.Tactics2.Constr.Unsafe.MakeAbbreviations. Require Import Rewriter.Util.Tactics2.ReplaceByPattern. Require Import Rewriter.Util.Tactics2.FixNotationsForPerformance. @@ -839,27 +840,48 @@ Module Compilers. |- Control.refine (fun () => substitute_bool_eqb (Ltac1.get_to_constr "term" term))) in constr:(ltac:(f term)). - Ltac substitute_beq_internal base_interp_beq only_eliminate_in_ctx full_ctx ctx term := - let base_interp_beq_head := head base_interp_beq in - lazymatch ctx with - | dynnil - => let term := (eval cbv [base.interp_beq base_interp_beq_head] in term) in - let term := substitute_bool_eqb term in - let term := remove_andb_true term in - let term := adjust_if_negb term in - term - | dyncons ?v ?ctx - => let term := substitute_beq_with base_interp_beq only_eliminate_in_ctx full_ctx term Z.eqb v in - let term := match constr:(Set) with - | _ => let T := type of v in - let beq := (eval cbv beta delta [Reflect.decb_rel] in (Reflect.decb_rel (@eq T))) in - substitute_beq_with base_interp_beq only_eliminate_in_ctx full_ctx term beq v - | _ => term - end in - substitute_beq_internal base_interp_beq only_eliminate_in_ctx full_ctx ctx term - end. + Ltac2 rec substitute_beq (base_interp_beq : constr) (only_eliminate_in_ctx : (ident * constr (* ty *) * constr (* var *)) list) (full_ctx : ident list) (ctx : ident list) (term : constr) : constr := + Reify.debug_wrap + "substitute_beq" Message.of_constr term + Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) + (fun () + => let base_interp_beq_head := head_reference base_interp_beq in + match ctx with + | [] + => let term := (eval cbv [base.interp_beq $base_interp_beq_head] in term) in + let term := '(ltac2:(Control.refine (fun () => substitute_bool_eqb term))) in + let term := '(ltac2:(Control.refine (fun () => remove_andb_true term))) in + let term := '(ltac2:(Control.refine (fun () => adjust_if_negb term))) in + term + | v :: ctx + => let v := mkVar v in + let term := '(ltac2:(Control.refine (fun () => substitute_beq_with base_interp_beq only_eliminate_in_ctx full_ctx term 'Z.eqb v))) in + let term + := match Control.case + (fun () + => let t := Constr.type v in + (* IMPORTANT: Typeclass resolution happens here, so this must be constr, not open_constr (N.B. ' is open_constr) *) + let beq := (eval cbv beta delta [Reflect.decb_rel] in constr:(Reflect.decb_rel (@eq $t))) in + '(ltac2:(Control.refine (fun () => substitute_beq_with base_interp_beq only_eliminate_in_ctx full_ctx term beq v)))) + with + | Val term => let (term, _) := term in term + | Err _ => term + end in + substitute_beq base_interp_beq only_eliminate_in_ctx full_ctx ctx term + end). + #[deprecated(since="8.15",note="Use Ltac2 instead.")] Ltac substitute_beq base_interp_beq only_eliminate_in_ctx full_ctx ctx term := - constr:(ltac:(let res := substitute_beq_internal base_interp_beq only_eliminate_in_ctx full_ctx ctx term in exact res)). + let f := ltac2:(base_interp_beq only_eliminate_in_ctx full_ctx ctx term + |- let base_interp_beq := Ltac1.get_to_constr "base_interp_beq" base_interp_beq in + let only_eliminate_in_ctx := Ltac1.get_to_constr "only_eliminate_in_ctx" only_eliminate_in_ctx in + let only_eliminate_in_ctx := expr.value_ctx_to_list only_eliminate_in_ctx in + let full_ctx := Ltac1.get_to_constr "full_ctx" full_ctx in + let full_ctx := var_dynlist_to_list full_ctx in + let ctx := Ltac1.get_to_constr "ctx" ctx in + let ctx := var_dynlist_to_list ctx in + let term := Ltac1.get_to_constr "term" term in + Control.refine (fun () => substitute_beq base_interp_beq only_eliminate_in_ctx full_ctx ctx term)) in + constr:(ltac:(f base_interp_beq only_eliminate_in_ctx full_ctx ctx term)). Ltac deep_substitute_beq_internal base_interp_beq only_eliminate_in_ctx term := lazymatch term with From d4a0377970503ce4680b4a31b12ac79b5bddf220 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 17:24:01 +0530 Subject: [PATCH 51/74] Remove constr-copying in substitute_beq and remove dead Ltac wrappers
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m12.62s | 1400248 ko | Total Time / Peak Mem | 4m12.86s | 1435208 ko || -0m00.24s || -34960 ko | -0.09% | -2.43% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m56.14s | 1400248 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m56.21s | 1435208 ko || -0m00.07s || -34960 ko | -0.12% | -2.43% 0m55.57s | 1125028 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.40s | 1112624 ko || +0m00.17s || 12404 ko | +0.30% | +1.11% 0m54.43s | 1103080 ko | Rewriter/Rewriter/Examples.vo | 0m54.54s | 1089672 ko || -0m00.10s || 13408 ko | -0.20% | +1.23% 0m30.65s | 923864 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.66s | 929260 ko || -0m00.01s || -5396 ko | -0.03% | -0.58% 0m24.02s | 897132 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m24.18s | 891676 ko || -0m00.16s || 5456 ko | -0.66% | +0.61% 0m16.19s | 739616 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.19s | 741852 ko || +0m00.00s || -2236 ko | +0.00% | -0.30% 0m12.06s | 639760 ko | Rewriter/Demo.vo | 0m12.07s | 639192 ko || -0m00.00s || 568 ko | -0.08% | +0.08% 0m00.80s | 472412 ko | Rewriter/Rewriter/Reify.vo | 0m00.81s | 472424 ko || -0m00.01s || -12 ko | -1.23% | -0.00% 0m00.77s | 488548 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.79s | 488560 ko || -0m00.02s || -12 ko | -2.53% | -0.00% 0m00.52s | 482380 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.52s | 482336 ko || +0m00.00s || 44 ko | +0.00% | +0.00% 0m00.50s | 478976 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.56s | 478956 ko || -0m00.06s || 20 ko | -10.71% | +0.00% 0m00.49s | 480088 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.43s | 480456 ko || +0m00.06s || -368 ko | +13.95% | -0.07% 0m00.48s | 480472 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.50s | 480184 ko || -0m00.02s || 288 ko | -4.00% | +0.05% ```

--- src/Rewriter/Rewriter/Reify.v | 34 +++++----------------------------- 1 file changed, 5 insertions(+), 29 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 569f33a79..d89b85736 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -763,20 +763,6 @@ Module Compilers. | _ => Control.throw (Reification_panic (fprintf "Non-dynlist passed to var_dynlist_to_dynlist: %t" full_ctx)) end. - #[deprecated(since="8.15",note="Use Ltac2 instead.")] - Ltac substitute_beq_with base_interp_beq only_eliminate_in_ctx full_ctx term beq x := - let f := ltac2:(base_interp_beq only_eliminate_in_ctx full_ctx term beq x - |- let base_interp_beq := Ltac1.get_to_constr "base_interp_beq" base_interp_beq in - let only_eliminate_in_ctx := Ltac1.get_to_constr "only_eliminate_in_ctx" only_eliminate_in_ctx in - let only_eliminate_in_ctx := expr.value_ctx_to_list only_eliminate_in_ctx in - let full_ctx := Ltac1.get_to_constr "full_ctx" full_ctx in - let full_ctx := var_dynlist_to_list full_ctx in - let term := Ltac1.get_to_constr "term" term in - let beq := Ltac1.get_to_constr "beq" beq in - let x := Ltac1.get_to_constr "x" x in - Control.refine (fun () => substitute_beq_with base_interp_beq only_eliminate_in_ctx full_ctx term beq x)) in - constr:(ltac:(f base_interp_beq only_eliminate_in_ctx full_ctx term beq x)). - Ltac2 remove_andb_true (term : constr) : constr := Reify.debug_wrap "remove_andb_true" Message.of_constr term @@ -805,11 +791,6 @@ Module Compilers. adjust_if_negb term | _ => term end). - #[deprecated(since="8.15",note="Use Ltac2 instead.")] - Ltac adjust_if_negb term := - let f := ltac2:(term - |- Control.refine (fun () => adjust_if_negb (Ltac1.get_to_constr "term" term))) in - constr:(ltac:(f term)). Ltac2 rec substitute_bool_eqb (term : constr) : constr := Reify.debug_wrap "substitute_bool_eqb" Message.of_constr term @@ -834,11 +815,6 @@ Module Compilers. substitute_bool_eqb term | _ => term end). - #[deprecated(since="8.15",note="Use Ltac2 instead.")] - Ltac substitute_bool_eqb term := - let f := ltac2:(term - |- Control.refine (fun () => substitute_bool_eqb (Ltac1.get_to_constr "term" term))) in - constr:(ltac:(f term)). Ltac2 rec substitute_beq (base_interp_beq : constr) (only_eliminate_in_ctx : (ident * constr (* ty *) * constr (* var *)) list) (full_ctx : ident list) (ctx : ident list) (term : constr) : constr := Reify.debug_wrap @@ -849,20 +825,20 @@ Module Compilers. match ctx with | [] => let term := (eval cbv [base.interp_beq $base_interp_beq_head] in term) in - let term := '(ltac2:(Control.refine (fun () => substitute_bool_eqb term))) in - let term := '(ltac2:(Control.refine (fun () => remove_andb_true term))) in - let term := '(ltac2:(Control.refine (fun () => adjust_if_negb term))) in + let term := substitute_bool_eqb term in + let term := remove_andb_true term in + let term := adjust_if_negb term in term | v :: ctx => let v := mkVar v in - let term := '(ltac2:(Control.refine (fun () => substitute_beq_with base_interp_beq only_eliminate_in_ctx full_ctx term 'Z.eqb v))) in + let term := substitute_beq_with base_interp_beq only_eliminate_in_ctx full_ctx term 'Z.eqb v in let term := match Control.case (fun () => let t := Constr.type v in (* IMPORTANT: Typeclass resolution happens here, so this must be constr, not open_constr (N.B. ' is open_constr) *) let beq := (eval cbv beta delta [Reflect.decb_rel] in constr:(Reflect.decb_rel (@eq $t))) in - '(ltac2:(Control.refine (fun () => substitute_beq_with base_interp_beq only_eliminate_in_ctx full_ctx term beq v)))) + substitute_beq_with base_interp_beq only_eliminate_in_ctx full_ctx term beq v) with | Val term => let (term, _) := term in term | Err _ => term From b25aa91eded2523430353fa3ed4814e62babca11 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 17:35:32 +0530 Subject: [PATCH 52/74] Port deep_substitute_beq to Ltac2
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m11.25s | 1391944 ko | Total Time / Peak Mem | 4m12.32s | 1400248 ko || -0m01.07s || -8304 ko | -0.42% | -0.59% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m55.77s | 1391944 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m56.00s | 1400248 ko || -0m00.22s || -8304 ko | -0.41% | -0.59% 0m55.29s | 1123708 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.38s | 1124924 ko || -0m00.09s || -1216 ko | -0.16% | -0.10% 0m54.12s | 1095668 ko | Rewriter/Rewriter/Examples.vo | 0m54.35s | 1102920 ko || -0m00.23s || -7252 ko | -0.42% | -0.65% 0m30.36s | 926152 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.53s | 923868 ko || -0m00.17s || 2284 ko | -0.55% | +0.24% 0m24.08s | 893184 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m24.12s | 897200 ko || -0m00.04s || -4016 ko | -0.16% | -0.44% 0m16.05s | 737480 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.14s | 739608 ko || -0m00.08s || -2128 ko | -0.55% | -0.28% 0m12.10s | 639996 ko | Rewriter/Demo.vo | 0m12.11s | 639732 ko || -0m00.00s || 264 ko | -0.08% | +0.04% 0m00.83s | 472160 ko | Rewriter/Rewriter/Reify.vo | 0m00.84s | 472300 ko || -0m00.01s || -140 ko | -1.19% | -0.02% 0m00.76s | 488552 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.77s | 488704 ko || -0m00.01s || -152 ko | -1.29% | -0.03% 0m00.52s | 482248 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.52s | 482312 ko || +0m00.00s || -64 ko | +0.00% | -0.01% 0m00.48s | 478884 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.59s | 478932 ko || -0m00.10s || -48 ko | -18.64% | -0.01% 0m00.47s | 480200 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.53s | 480328 ko || -0m00.06s || -128 ko | -11.32% | -0.02% 0m00.42s | 480180 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.45s | 480072 ko || -0m00.03s || 108 ko | -6.66% | +0.02% ```

--- src/Rewriter/Rewriter/Reify.v | 87 +++++++++++++---------------------- 1 file changed, 33 insertions(+), 54 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index d89b85736..88382b634 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -57,8 +57,6 @@ Module Compilers. Local Notation EvarMap := pattern.EvarMap. Local Notation EvarMap_at base := (pattern.EvarMap_at base). - Inductive dynlist := dynnil | dyncons {T} (x : T) (xs : dynlist). - Section with_var. Local Notation type_of_list := (fold_right (fun a b => prod a b) unit). @@ -680,26 +678,17 @@ Module Compilers. |- Control.refine (fun () => replace_type_try_transport (Ltac1.get_to_constr "term" term))) in constr:(ltac:(f term)). - Ltac under_binders payload term cont ctx := - lazymatch term with - | (fun x : ?T => ?f) - => let ctx' := fresh in - let f' := fresh in - let payload' := fresh in (* COQBUG(https://github.com/coq/coq/issues/7210#issuecomment-470009463) *) - constr:(match payload return _ with - | payload' - => fun x : T - => match f, dyncons x ctx return _ with - | f', ctx' - => ltac:(let ctx := (eval cbv delta [ctx'] in ctx') in - let f := (eval cbv delta [f'] in f') in - let payload := (eval cbv delta [payload'] in payload') in - clear f' ctx' payload'; - let res := under_binders payload f cont ctx in - exact res) - end - end) - | ?term => cont payload ctx term + Ltac2 rec under_binders (avoid : Fresh.Free.t) (term : constr) (cont : ident list -> constr -> constr) (ctx : ident list) : constr := + match Constr.Unsafe.kind_nocast term with + | Constr.Unsafe.Lambda xb term + => Constr.in_fresh_context_avoiding + @UNNAMED_BINDER false (Some avoid) [xb] + (fun ns + => let ns := List.map (fun (n, _t) => n) ns in + let term := Constr.Unsafe.substnl (List.map mkVar ns) 0 term in + let ctx := List.append ns ctx in + Control.refine (fun () => under_binders (Fresh.Free.union avoid (Fresh.Free.of_ids ns)) term cont ctx)) + | _ => cont ctx term end. Ltac2 substitute_with (term : constr) (x : constr) (y : constr) : constr := Reify.debug_wrap @@ -749,20 +738,6 @@ Module Compilers. | None => term end). - #[deprecated(since="8.15",note="Use Ltac2 direct instead.")] - Ltac2 rec var_dynlist_to_list (full_ctx : constr) : ident list := - lazy_match! full_ctx with - | dyncons ?x ?xs - => match Constr.Unsafe.kind_nocast x with - | Constr.Unsafe.Var x - => x :: var_dynlist_to_list xs - | _ - => Control.throw (Reification_panic (fprintf "Non-var in dynlist: %t" x)) - end - | dynnil => [] - | _ => Control.throw (Reification_panic (fprintf "Non-dynlist passed to var_dynlist_to_dynlist: %t" full_ctx)) - end. - Ltac2 remove_andb_true (term : constr) : constr := Reify.debug_wrap "remove_andb_true" Message.of_constr term @@ -845,29 +820,33 @@ Module Compilers. end in substitute_beq base_interp_beq only_eliminate_in_ctx full_ctx ctx term end). + + Ltac2 deep_substitute_beq (base_interp_beq : constr) (only_eliminate_in_ctx : (ident * constr (* ty *) * constr (* var *)) list) (term : constr) : constr := + Reify.debug_wrap + "deep_substitute_beq" Message.of_constr term + Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) + (fun () + => let debug_Constr_check := Reify.Constr.debug_check_strict "deep_substitute_beq" in + lazy_match! term with + | context term'[@Build_rewrite_rule_data ?base ?ident ?var ?pident ?pident_arg_types ?t ?p ?sda ?wo ?ul ?subterm] + => let avoid := Fresh.Free.union + (Fresh.Free.of_goal ()) + (Fresh.Free.union + (Fresh.Free.of_ids (List.map (fun (n, _ty, _var) => n) only_eliminate_in_ctx)) + (Fresh.Free.of_constr term)) in + let subterm := under_binders avoid subterm (fun ctx term => substitute_beq base_interp_beq only_eliminate_in_ctx ctx ctx term) [] in + let term := Pattern.instantiate term' (debug_Constr_check (fun () => mkApp '@Build_rewrite_rule_data [base; ident; var; pident; pident_arg_types; t; p; sda; wo; ul; subterm])) in + term + end). #[deprecated(since="8.15",note="Use Ltac2 instead.")] - Ltac substitute_beq base_interp_beq only_eliminate_in_ctx full_ctx ctx term := - let f := ltac2:(base_interp_beq only_eliminate_in_ctx full_ctx ctx term + Ltac deep_substitute_beq base_interp_beq only_eliminate_in_ctx term := + let f := ltac2:(base_interp_beq only_eliminate_in_ctx term |- let base_interp_beq := Ltac1.get_to_constr "base_interp_beq" base_interp_beq in let only_eliminate_in_ctx := Ltac1.get_to_constr "only_eliminate_in_ctx" only_eliminate_in_ctx in let only_eliminate_in_ctx := expr.value_ctx_to_list only_eliminate_in_ctx in - let full_ctx := Ltac1.get_to_constr "full_ctx" full_ctx in - let full_ctx := var_dynlist_to_list full_ctx in - let ctx := Ltac1.get_to_constr "ctx" ctx in - let ctx := var_dynlist_to_list ctx in let term := Ltac1.get_to_constr "term" term in - Control.refine (fun () => substitute_beq base_interp_beq only_eliminate_in_ctx full_ctx ctx term)) in - constr:(ltac:(f base_interp_beq only_eliminate_in_ctx full_ctx ctx term)). - - Ltac deep_substitute_beq_internal base_interp_beq only_eliminate_in_ctx term := - lazymatch term with - | context term'[@Build_rewrite_rule_data ?base ?ident ?var ?pident ?pident_arg_types ?t ?p ?sda ?wo ?ul ?subterm] - => let subterm := under_binders only_eliminate_in_ctx subterm ltac:(fun only_eliminate_in_ctx ctx term => substitute_beq base_interp_beq only_eliminate_in_ctx ctx ctx term) dynnil in - let term := context term'[@Build_rewrite_rule_data base ident var pident pident_arg_types t p sda wo ul subterm] in - term - end. - Ltac deep_substitute_beq base_interp_beq only_eliminate_in_ctx term := - constr:(ltac:(let res := deep_substitute_beq_internal base_interp_beq only_eliminate_in_ctx term in exact res)). + Control.refine (fun () => deep_substitute_beq base_interp_beq only_eliminate_in_ctx term)) in + constr:(ltac:(f base_interp_beq only_eliminate_in_ctx term)). Ltac clean_beq_internal base_interp_beq only_eliminate_in_ctx term := let base_interp_beq_head := head base_interp_beq in From a27178f8d47ae94fc82ded9ceab0e046f764e824 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 14:22:29 +0530 Subject: [PATCH 53/74] Faster fresh in deep_substitute_beq
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m10.93s | 1393532 ko | Total Time / Peak Mem | 4m11.35s | 1392056 ko || -0m00.41s || 1476 ko | -0.16% | +0.10% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m55.95s | 1393532 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m55.69s | 1392056 ko || +0m00.26s || 1476 ko | +0.46% | +0.10% 0m55.44s | 1123880 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.85s | 1123848 ko || +0m00.58s || 32 ko | +1.07% | +0.00% 0m54.22s | 1095652 ko | Rewriter/Rewriter/Examples.vo | 0m54.43s | 1095692 ko || -0m00.21s || -40 ko | -0.38% | -0.00% 0m29.50s | 924692 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.44s | 926256 ko || -0m00.94s || -1564 ko | -3.08% | -0.16% 0m24.01s | 893384 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m24.10s | 893400 ko || -0m00.08s || -16 ko | -0.37% | -0.00% 0m16.11s | 737204 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.16s | 737544 ko || -0m00.05s || -340 ko | -0.30% | -0.04% 0m12.08s | 640128 ko | Rewriter/Demo.vo | 0m12.14s | 640068 ko || -0m00.06s || 60 ko | -0.49% | +0.00% 0m00.88s | 471928 ko | Rewriter/Rewriter/Reify.vo | 0m00.78s | 472120 ko || +0m00.09s || -192 ko | +12.82% | -0.04% 0m00.75s | 488636 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.79s | 488640 ko || -0m00.04s || -4 ko | -5.06% | -0.00% 0m00.54s | 480412 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.47s | 480028 ko || +0m00.07s || 384 ko | +14.89% | +0.07% 0m00.51s | 478872 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.46s | 478924 ko || +0m00.04s || -52 ko | +10.86% | -0.01% 0m00.48s | 480372 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.54s | 480400 ko || -0m00.06s || -28 ko | -11.11% | -0.00% 0m00.47s | 482232 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.51s | 482256 ko || -0m00.04s || -24 ko | -7.84% | -0.00% ```

--- src/Rewriter/Rewriter/Reify.v | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 88382b634..61c1a365c 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -821,7 +821,7 @@ Module Compilers. substitute_beq base_interp_beq only_eliminate_in_ctx full_ctx ctx term end). - Ltac2 deep_substitute_beq (base_interp_beq : constr) (only_eliminate_in_ctx : (ident * constr (* ty *) * constr (* var *)) list) (term : constr) : constr := + Ltac2 deep_substitute_beq (base_interp_beq : constr) (avoid : Fresh.Free.t) (only_eliminate_in_ctx : (ident * constr (* ty *) * constr (* var *)) list) (term : constr) : constr := Reify.debug_wrap "deep_substitute_beq" Message.of_constr term Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) @@ -829,12 +829,7 @@ Module Compilers. => let debug_Constr_check := Reify.Constr.debug_check_strict "deep_substitute_beq" in lazy_match! term with | context term'[@Build_rewrite_rule_data ?base ?ident ?var ?pident ?pident_arg_types ?t ?p ?sda ?wo ?ul ?subterm] - => let avoid := Fresh.Free.union - (Fresh.Free.of_goal ()) - (Fresh.Free.union - (Fresh.Free.of_ids (List.map (fun (n, _ty, _var) => n) only_eliminate_in_ctx)) - (Fresh.Free.of_constr term)) in - let subterm := under_binders avoid subterm (fun ctx term => substitute_beq base_interp_beq only_eliminate_in_ctx ctx ctx term) [] in + => let subterm := under_binders avoid subterm (fun ctx term => substitute_beq base_interp_beq only_eliminate_in_ctx ctx ctx term) [] in let term := Pattern.instantiate term' (debug_Constr_check (fun () => mkApp '@Build_rewrite_rule_data [base; ident; var; pident; pident_arg_types; t; p; sda; wo; ul; subterm])) in term end). @@ -845,7 +840,7 @@ Module Compilers. let only_eliminate_in_ctx := Ltac1.get_to_constr "only_eliminate_in_ctx" only_eliminate_in_ctx in let only_eliminate_in_ctx := expr.value_ctx_to_list only_eliminate_in_ctx in let term := Ltac1.get_to_constr "term" term in - Control.refine (fun () => deep_substitute_beq base_interp_beq only_eliminate_in_ctx term)) in + Control.refine (fun () => deep_substitute_beq base_interp_beq (Fresh.Free.of_goal ()) only_eliminate_in_ctx term)) in constr:(ltac:(f base_interp_beq only_eliminate_in_ctx term)). Ltac clean_beq_internal base_interp_beq only_eliminate_in_ctx term := From f9c6f8a3427a34dfeabf83d403988bd889ee9bbd Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 17:40:14 +0530 Subject: [PATCH 54/74] Port clean_beq to Ltac2
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m11.69s | 1418900 ko | Total Time / Peak Mem | 4m11.32s | 1393488 ko || +0m00.37s || 25412 ko | +0.14% | +1.82% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m55.61s | 1418900 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m55.65s | 1393488 ko || -0m00.03s || 25412 ko | -0.07% | +1.82% 0m55.44s | 1125624 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.29s | 1123888 ko || +0m00.14s || 1736 ko | +0.27% | +0.15% 0m54.18s | 1102304 ko | Rewriter/Rewriter/Examples.vo | 0m54.16s | 1095620 ko || +0m00.02s || 6684 ko | +0.03% | +0.61% 0m30.52s | 928392 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.48s | 924812 ko || +0m00.03s || 3580 ko | +0.13% | +0.38% 0m24.15s | 894704 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m24.06s | 893448 ko || +0m00.08s || 1256 ko | +0.37% | +0.14% 0m16.21s | 735364 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.13s | 737152 ko || +0m00.08s || -1788 ko | +0.49% | -0.24% 0m12.15s | 639732 ko | Rewriter/Demo.vo | 0m12.09s | 639960 ko || +0m00.06s || -228 ko | +0.49% | -0.03% 0m00.82s | 472108 ko | Rewriter/Rewriter/Reify.vo | 0m00.81s | 472140 ko || +0m00.00s || -32 ko | +1.23% | -0.00% 0m00.70s | 488668 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.70s | 488632 ko || +0m00.00s || 36 ko | +0.00% | +0.00% 0m00.50s | 478912 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.51s | 479024 ko || -0m00.01s || -112 ko | -1.96% | -0.02% 0m00.49s | 482196 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.52s | 482240 ko || -0m00.03s || -44 ko | -5.76% | -0.00% 0m00.48s | 480408 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.45s | 480332 ko || +0m00.02s || 76 ko | +6.66% | +0.01% 0m00.45s | 480260 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.48s | 480156 ko || -0m00.02s || 104 ko | -6.24% | +0.02% ```

--- src/Rewriter/Rewriter/Reify.v | 29 ++++++++++++++++++++--------- 1 file changed, 20 insertions(+), 9 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 61c1a365c..10f540aea 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -843,16 +843,27 @@ Module Compilers. Control.refine (fun () => deep_substitute_beq base_interp_beq (Fresh.Free.of_goal ()) only_eliminate_in_ctx term)) in constr:(ltac:(f base_interp_beq only_eliminate_in_ctx term)). - Ltac clean_beq_internal base_interp_beq only_eliminate_in_ctx term := - let base_interp_beq_head := head base_interp_beq in - let term := (eval cbn [Prod.prod_beq] in term) in - let term := (eval cbv [ident.literal] in term) in - let term := deep_substitute_beq base_interp_beq only_eliminate_in_ctx term in - let term := (eval cbv [base.interp_beq base_interp_beq_head] in term) in - let term := remove_andb_true term in - term. + Ltac2 clean_beq (base_interp_beq : constr) (only_eliminate_in_ctx : (ident * constr (* ty *) * constr (* var *)) list) (term : constr) : constr := + Reify.debug_wrap + "clean_beq" Message.of_constr term + Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) + (fun () + => let base_interp_beq_head := head_reference base_interp_beq in + let term := (eval cbn [Prod.prod_beq] in term) in + let term := (eval cbv [ident.literal] in term) in + let term := '(ltac2:(Control.refine (fun () => deep_substitute_beq base_interp_beq (Fresh.Free.of_goal ()) only_eliminate_in_ctx term))) in + let term := (eval cbv [base.interp_beq $base_interp_beq_head] in term) in + let term := '(ltac2:(Control.refine (fun () => remove_andb_true term))) in + term). + #[deprecated(since="8.15",note="Use Ltac2 instead.")] Ltac clean_beq base_interp_beq only_eliminate_in_ctx term := - constr:(ltac:(let v := clean_beq_internal base_interp_beq only_eliminate_in_ctx term in refine v)). + let f := ltac2:(base_interp_beq only_eliminate_in_ctx term + |- let base_interp_beq := Ltac1.get_to_constr "base_interp_beq" base_interp_beq in + let only_eliminate_in_ctx := Ltac1.get_to_constr "only_eliminate_in_ctx" only_eliminate_in_ctx in + let only_eliminate_in_ctx := expr.value_ctx_to_list only_eliminate_in_ctx in + let term := Ltac1.get_to_constr "term" term in + Control.refine (fun () => clean_beq base_interp_beq only_eliminate_in_ctx term)) in + constr:(ltac:(f base_interp_beq only_eliminate_in_ctx term)). Ltac adjust_side_conditions_for_gets_inlined' value_ctx side_conditions lookup_gets_inlined := lazymatch side_conditions with From 936acdd782985a6bc92e329f36ad7a6625ab6a39 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 14:24:06 +0530 Subject: [PATCH 55/74] Faster fresh in clean_beq
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m11.52s | 1418872 ko | Total Time / Peak Mem | 4m11.80s | 1418932 ko || -0m00.27s || -60 ko | -0.10% | -0.00% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m55.80s | 1418872 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m55.71s | 1418932 ko || +0m00.08s || -60 ko | +0.16% | -0.00% 0m55.32s | 1125320 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.62s | 1125448 ko || -0m00.29s || -128 ko | -0.53% | -0.01% 0m54.07s | 1102448 ko | Rewriter/Rewriter/Examples.vo | 0m54.18s | 1102360 ko || -0m00.10s || 88 ko | -0.20% | +0.00% 0m30.59s | 928604 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.37s | 928292 ko || +0m00.21s || 312 ko | +0.72% | +0.03% 0m23.99s | 894608 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.99s | 894648 ko || +0m00.00s || -40 ko | +0.00% | -0.00% 0m16.12s | 735420 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.19s | 735324 ko || -0m00.07s || 96 ko | -0.43% | +0.01% 0m12.18s | 639760 ko | Rewriter/Demo.vo | 0m12.23s | 639640 ko || -0m00.05s || 120 ko | -0.40% | +0.01% 0m00.83s | 471972 ko | Rewriter/Rewriter/Reify.vo | 0m00.77s | 471992 ko || +0m00.05s || -20 ko | +7.79% | -0.00% 0m00.74s | 488684 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.77s | 488628 ko || -0m00.03s || 56 ko | -3.89% | +0.01% 0m00.50s | 482240 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.45s | 482160 ko || +0m00.04s || 80 ko | +11.11% | +0.01% 0m00.47s | 478928 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.50s | 478872 ko || -0m00.03s || 56 ko | -6.00% | +0.01% 0m00.46s | 480212 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.49s | 480252 ko || -0m00.02s || -40 ko | -6.12% | -0.00% 0m00.46s | 479988 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.53s | 480400 ko || -0m00.07s || -412 ko | -13.20% | -0.08% ```

--- src/Rewriter/Rewriter/Reify.v | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 10f540aea..f3b3f7fbd 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -843,7 +843,7 @@ Module Compilers. Control.refine (fun () => deep_substitute_beq base_interp_beq (Fresh.Free.of_goal ()) only_eliminate_in_ctx term)) in constr:(ltac:(f base_interp_beq only_eliminate_in_ctx term)). - Ltac2 clean_beq (base_interp_beq : constr) (only_eliminate_in_ctx : (ident * constr (* ty *) * constr (* var *)) list) (term : constr) : constr := + Ltac2 clean_beq (base_interp_beq : constr) (avoid : Fresh.Free.t) (only_eliminate_in_ctx : (ident * constr (* ty *) * constr (* var *)) list) (term : constr) : constr := Reify.debug_wrap "clean_beq" Message.of_constr term Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) @@ -851,7 +851,7 @@ Module Compilers. => let base_interp_beq_head := head_reference base_interp_beq in let term := (eval cbn [Prod.prod_beq] in term) in let term := (eval cbv [ident.literal] in term) in - let term := '(ltac2:(Control.refine (fun () => deep_substitute_beq base_interp_beq (Fresh.Free.of_goal ()) only_eliminate_in_ctx term))) in + let term := '(ltac2:(Control.refine (fun () => deep_substitute_beq base_interp_beq avoid only_eliminate_in_ctx term))) in let term := (eval cbv [base.interp_beq $base_interp_beq_head] in term) in let term := '(ltac2:(Control.refine (fun () => remove_andb_true term))) in term). @@ -862,7 +862,7 @@ Module Compilers. let only_eliminate_in_ctx := Ltac1.get_to_constr "only_eliminate_in_ctx" only_eliminate_in_ctx in let only_eliminate_in_ctx := expr.value_ctx_to_list only_eliminate_in_ctx in let term := Ltac1.get_to_constr "term" term in - Control.refine (fun () => clean_beq base_interp_beq only_eliminate_in_ctx term)) in + Control.refine (fun () => clean_beq base_interp_beq (Fresh.Free.of_goal ()) only_eliminate_in_ctx term)) in constr:(ltac:(f base_interp_beq only_eliminate_in_ctx term)). Ltac adjust_side_conditions_for_gets_inlined' value_ctx side_conditions lookup_gets_inlined := From 2176b7f36511960a9f8a5d9716b1738f0dce61dd Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 17:40:54 +0530 Subject: [PATCH 56/74] Remove constr-copying in clean_beq
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m11.54s | 1405208 ko | Total Time / Peak Mem | 4m11.93s | 1418660 ko || -0m00.38s || -13452 ko | -0.15% | -0.94% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m55.75s | 1405208 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m55.92s | 1418660 ko || -0m00.17s || -13452 ko | -0.30% | -0.94% 0m55.45s | 1104020 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.50s | 1125336 ko || -0m00.04s || -21316 ko | -0.09% | -1.89% 0m54.25s | 1107236 ko | Rewriter/Rewriter/Examples.vo | 0m54.17s | 1102588 ko || +0m00.07s || 4648 ko | +0.14% | +0.42% 0m30.51s | 923468 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.40s | 928588 ko || +0m00.11s || -5120 ko | +0.36% | -0.55% 0m24.11s | 897084 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m24.12s | 894708 ko || -0m00.01s || 2376 ko | -0.04% | +0.26% 0m16.01s | 742076 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.06s | 735372 ko || -0m00.04s || 6704 ko | -0.31% | +0.91% 0m12.06s | 639488 ko | Rewriter/Demo.vo | 0m12.12s | 639612 ko || -0m00.05s || -124 ko | -0.49% | -0.01% 0m00.78s | 472016 ko | Rewriter/Rewriter/Reify.vo | 0m00.86s | 472220 ko || -0m00.07s || -204 ko | -9.30% | -0.04% 0m00.70s | 488748 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.77s | 488636 ko || -0m00.07s || 112 ko | -9.09% | +0.02% 0m00.54s | 478876 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.53s | 478912 ko || +0m00.01s || -36 ko | +1.88% | -0.00% 0m00.48s | 482196 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.47s | 482376 ko || +0m00.01s || -180 ko | +2.12% | -0.03% 0m00.48s | 480332 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.52s | 480232 ko || -0m00.04s || 100 ko | -7.69% | +0.02% 0m00.42s | 480164 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.49s | 480208 ko || -0m00.07s || -44 ko | -14.28% | -0.00% ```

--- src/Rewriter/Rewriter/Reify.v | 13 ++----------- 1 file changed, 2 insertions(+), 11 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index f3b3f7fbd..98b7ed633 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -833,15 +833,6 @@ Module Compilers. let term := Pattern.instantiate term' (debug_Constr_check (fun () => mkApp '@Build_rewrite_rule_data [base; ident; var; pident; pident_arg_types; t; p; sda; wo; ul; subterm])) in term end). - #[deprecated(since="8.15",note="Use Ltac2 instead.")] - Ltac deep_substitute_beq base_interp_beq only_eliminate_in_ctx term := - let f := ltac2:(base_interp_beq only_eliminate_in_ctx term - |- let base_interp_beq := Ltac1.get_to_constr "base_interp_beq" base_interp_beq in - let only_eliminate_in_ctx := Ltac1.get_to_constr "only_eliminate_in_ctx" only_eliminate_in_ctx in - let only_eliminate_in_ctx := expr.value_ctx_to_list only_eliminate_in_ctx in - let term := Ltac1.get_to_constr "term" term in - Control.refine (fun () => deep_substitute_beq base_interp_beq (Fresh.Free.of_goal ()) only_eliminate_in_ctx term)) in - constr:(ltac:(f base_interp_beq only_eliminate_in_ctx term)). Ltac2 clean_beq (base_interp_beq : constr) (avoid : Fresh.Free.t) (only_eliminate_in_ctx : (ident * constr (* ty *) * constr (* var *)) list) (term : constr) : constr := Reify.debug_wrap @@ -851,9 +842,9 @@ Module Compilers. => let base_interp_beq_head := head_reference base_interp_beq in let term := (eval cbn [Prod.prod_beq] in term) in let term := (eval cbv [ident.literal] in term) in - let term := '(ltac2:(Control.refine (fun () => deep_substitute_beq base_interp_beq avoid only_eliminate_in_ctx term))) in + let term := deep_substitute_beq base_interp_beq avoid only_eliminate_in_ctx term in let term := (eval cbv [base.interp_beq $base_interp_beq_head] in term) in - let term := '(ltac2:(Control.refine (fun () => remove_andb_true term))) in + let term := remove_andb_true term in term). #[deprecated(since="8.15",note="Use Ltac2 instead.")] Ltac clean_beq base_interp_beq only_eliminate_in_ctx term := From 791167adb11360172b22a99b865523f74bc7e093 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 18:00:10 +0530 Subject: [PATCH 57/74] Port adjust_side_conditions_for_gets_inlined to Ltac2
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m11.33s | 1401256 ko | Total Time / Peak Mem | 4m11.36s | 1405108 ko || -0m00.02s || -3852 ko | -0.00% | -0.27% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m55.64s | 1401256 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m55.66s | 1405108 ko || -0m00.01s || -3852 ko | -0.03% | -0.27% 0m55.08s | 1104404 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.28s | 1104012 ko || -0m00.20s || 392 ko | -0.36% | +0.03% 0m54.35s | 1107312 ko | Rewriter/Rewriter/Examples.vo | 0m54.27s | 1107348 ko || +0m00.07s || -36 ko | +0.14% | -0.00% 0m30.49s | 923612 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.40s | 923624 ko || +0m00.08s || -12 ko | +0.29% | -0.00% 0m23.95s | 897228 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m24.02s | 897048 ko || -0m00.07s || 180 ko | -0.29% | +0.02% 0m16.14s | 743748 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.06s | 741996 ko || +0m00.08s || 1752 ko | +0.49% | +0.23% 0m12.13s | 639508 ko | Rewriter/Demo.vo | 0m12.11s | 639608 ko || +0m00.02s || -100 ko | +0.16% | -0.01% 0m00.79s | 472208 ko | Rewriter/Rewriter/Reify.vo | 0m00.82s | 472048 ko || -0m00.02s || 160 ko | -3.65% | +0.03% 0m00.76s | 488672 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.77s | 488616 ko || -0m00.01s || 56 ko | -1.29% | +0.01% 0m00.55s | 482256 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.50s | 482296 ko || +0m00.05s || -40 ko | +10.00% | -0.00% 0m00.50s | 478764 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.52s | 478868 ko || -0m00.02s || -104 ko | -3.84% | -0.02% 0m00.49s | 480440 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.48s | 480132 ko || +0m00.01s || 308 ko | +2.08% | +0.06% 0m00.47s | 480380 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.47s | 480376 ko || +0m00.00s || 4 ko | +0.00% | +0.00% ```

--- src/Rewriter/Rewriter/Reify.v | 63 +++++++++++++++++++++++++---------- 1 file changed, 46 insertions(+), 17 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 98b7ed633..c9af80295 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -856,24 +856,53 @@ Module Compilers. Control.refine (fun () => clean_beq base_interp_beq (Fresh.Free.of_goal ()) only_eliminate_in_ctx term)) in constr:(ltac:(f base_interp_beq only_eliminate_in_ctx term)). - Ltac adjust_side_conditions_for_gets_inlined' value_ctx side_conditions lookup_gets_inlined := - lazymatch side_conditions with - | context sc[ident.gets_inlined _ ?x] - => lazymatch value_ctx with - | context[expr.var_context.cons x ?p _] - => let rep := constr:(lookup_gets_inlined p) in - let side_conditions := context sc[rep] in - adjust_side_conditions_for_gets_inlined' value_ctx side_conditions lookup_gets_inlined - | _ => constr_fail_with ltac:(fun _ => fail 1 "Could not find an expression corresponding to" x "in context" value_ctx) - end - | _ => side_conditions - end. - + Ltac2 rec adjust_side_conditions_for_gets_inlined' (value_ctx : (ident * constr (* ty *) * constr (* var *)) list) (side_conditions : constr) (lookup_gets_inlined : constr) : constr := + Reify.debug_wrap + "adjust_side_conditions_for_gets_inlined'" Message.of_constr side_conditions + Reify.should_debug_fine_grained Reify.should_debug_fine_grained (Some Message.of_constr) + (fun () + => let debug_Constr_check := Reify.Constr.debug_check_strict "adjust_side_conditions_for_gets_inlined'" in + lazy_match! side_conditions with + | context sc[ident.gets_inlined _ ?x] + => match Constr.Unsafe.kind_nocast x with + | Constr.Unsafe.Var x + => match List.find_opt (fun (n, ty, rv) => Ident.equal n x) value_ctx with + | Some v + => let (_x, ty, p) := v in + let rep := debug_Constr_check (fun () => mkApp lookup_gets_inlined [p]) in + let side_conditions := Pattern.instantiate sc rep in + adjust_side_conditions_for_gets_inlined' value_ctx side_conditions lookup_gets_inlined + | None + => Control.zero + (Reification_failure + (fprintf + "Could not find an expression corresponding to %I in context %a" + x + (fun () => Message.of_list (fun (id, t, v) => fprintf "(%I, %t, %t)" id t v)) value_ctx)) + end + | _ => Control.zero (Reification_failure (fprintf "adjust_side_conditions_for_gets_inlined': In side-condition:%s%t%sFound ident.gets_inlined _ x with x not a Var: %t" (String.newline ()) side_conditions (String.newline ()) x)) + end + | _ => side_conditions + end). + Ltac2 adjust_side_conditions_for_gets_inlined (value_ctx : (ident * constr (* ty *) * constr (* var *)) list) (side_conditions : constr) : constr := + let lookup_gets_inlined := Fresh.fresh (Fresh.Free.union + (Fresh.Free.of_goal ()) + (Fresh.Free.union + (Fresh.Free.of_constr side_conditions) + (Fresh.Free.of_ids (List.map (fun (n, _, _) => n) value_ctx)))) + @lookup_gets_inlined in + Constr.in_context + lookup_gets_inlined '(positive -> bool) + (fun () => Control.refine + (fun () => adjust_side_conditions_for_gets_inlined' value_ctx side_conditions (mkVar lookup_gets_inlined))). + #[deprecated(since="8.15",note="Use Ltac2 instead.")] Ltac adjust_side_conditions_for_gets_inlined value_ctx side_conditions := - let lookup_gets_inlined := fresh in - constr:(fun lookup_gets_inlined : positive -> bool - => ltac:(let v := adjust_side_conditions_for_gets_inlined' value_ctx side_conditions lookup_gets_inlined in - exact v)). + let f := ltac2:(value_ctx side_conditions + |- let value_ctx := Ltac1.get_to_constr "value_ctx" value_ctx in + let value_ctx := expr.value_ctx_to_list value_ctx in + let side_conditions := Ltac1.get_to_constr "side_conditions" side_conditions in + Control.refine (fun () => adjust_side_conditions_for_gets_inlined value_ctx side_conditions)) in + constr:(ltac:(f value_ctx side_conditions)). Ltac reify_to_pattern_and_replacement_in_context base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota type_ctx var gets_inlined should_do_again cur_i term value_ctx := let base_type := constr:(base.type base) in From e51ece78731f3de2935b93b1b96957f1a252fb3c Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 14:26:45 +0530 Subject: [PATCH 58/74] Faster fresh in adjust_side_conditions_for_gets_inlined
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m11.24s | 1400236 ko | Total Time / Peak Mem | 4m11.12s | 1401332 ko || +0m00.12s || -1096 ko | +0.04% | -0.07% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m55.68s | 1400236 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m55.84s | 1401332 ko || -0m00.16s || -1096 ko | -0.28% | -0.07% 0m55.19s | 1104048 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.56s | 1104352 ko || +0m00.62s || -304 ko | +1.15% | -0.02% 0m54.30s | 1106008 ko | Rewriter/Rewriter/Examples.vo | 0m54.13s | 1107272 ko || +0m00.16s || -1264 ko | +0.31% | -0.11% 0m30.46s | 927164 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.48s | 923592 ko || -0m00.01s || 3572 ko | -0.06% | +0.38% 0m23.99s | 897192 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m24.06s | 897064 ko || -0m00.07s || 128 ko | -0.29% | +0.01% 0m16.07s | 743908 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.20s | 743752 ko || -0m00.12s || 156 ko | -0.80% | +0.02% 0m12.09s | 639528 ko | Rewriter/Demo.vo | 0m12.18s | 639420 ko || -0m00.08s || 108 ko | -0.73% | +0.01% 0m00.80s | 472172 ko | Rewriter/Rewriter/Reify.vo | 0m00.86s | 472032 ko || -0m00.05s || 140 ko | -6.97% | +0.02% 0m00.73s | 488632 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.81s | 488668 ko || -0m00.08s || -36 ko | -9.87% | -0.00% 0m00.50s | 479028 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.56s | 479000 ko || -0m00.06s || 28 ko | -10.71% | +0.00% 0m00.49s | 482132 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.48s | 482212 ko || +0m00.01s || -80 ko | +2.08% | -0.01% 0m00.48s | 480248 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.47s | 480256 ko || +0m00.01s || -8 ko | +2.12% | -0.00% 0m00.46s | 480448 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.49s | 480276 ko || -0m00.02s || 172 ko | -6.12% | +0.03% ```

--- src/Rewriter/Rewriter/Reify.v | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index c9af80295..89b40cb4e 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -884,13 +884,8 @@ Module Compilers. end | _ => side_conditions end). - Ltac2 adjust_side_conditions_for_gets_inlined (value_ctx : (ident * constr (* ty *) * constr (* var *)) list) (side_conditions : constr) : constr := - let lookup_gets_inlined := Fresh.fresh (Fresh.Free.union - (Fresh.Free.of_goal ()) - (Fresh.Free.union - (Fresh.Free.of_constr side_conditions) - (Fresh.Free.of_ids (List.map (fun (n, _, _) => n) value_ctx)))) - @lookup_gets_inlined in + Ltac2 adjust_side_conditions_for_gets_inlined (avoid : Fresh.Free.t) (value_ctx : (ident * constr (* ty *) * constr (* var *)) list) (side_conditions : constr) : constr := + let lookup_gets_inlined := Fresh.fresh avoid @lookup_gets_inlined in Constr.in_context lookup_gets_inlined '(positive -> bool) (fun () => Control.refine @@ -901,7 +896,7 @@ Module Compilers. |- let value_ctx := Ltac1.get_to_constr "value_ctx" value_ctx in let value_ctx := expr.value_ctx_to_list value_ctx in let side_conditions := Ltac1.get_to_constr "side_conditions" side_conditions in - Control.refine (fun () => adjust_side_conditions_for_gets_inlined value_ctx side_conditions)) in + Control.refine (fun () => adjust_side_conditions_for_gets_inlined (Fresh.Free.of_goal ()) value_ctx side_conditions)) in constr:(ltac:(f value_ctx side_conditions)). Ltac reify_to_pattern_and_replacement_in_context base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota type_ctx var gets_inlined should_do_again cur_i term value_ctx := From f4368fe1a592a04f65501a582023489b06637a21 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 19:00:59 +0530 Subject: [PATCH 59/74] Port reify_to_pattern_and_replacement_in_context to Ltac2
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m14.85s | 1426584 ko | Total Time / Peak Mem | 4m11.93s | 1400320 ko || +0m02.91s || 26264 ko | +1.15% | +1.87% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m55.26s | 1084212 ko | Rewriter/Rewriter/Examples.vo | 0m54.02s | 1106020 ko || +0m01.23s || -21808 ko | +2.29% | -1.97% 0m56.39s | 1426584 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m56.26s | 1400320 ko || +0m00.13s || 26264 ko | +0.23% | +1.87% 0m55.95s | 1116988 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.22s | 1104052 ko || +0m00.73s || 12936 ko | +1.32% | +1.17% 0m31.29s | 931604 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.38s | 927252 ko || +0m00.91s || 4352 ko | +2.99% | +0.46% 0m24.05s | 876176 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.99s | 897036 ko || +0m00.06s || -20860 ko | +0.25% | -2.32% 0m16.33s | 731324 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.22s | 743784 ko || +0m00.10s || -12460 ko | +0.67% | -1.67% 0m12.10s | 639000 ko | Rewriter/Demo.vo | 0m12.20s | 639420 ko || -0m00.09s || -420 ko | -0.81% | -0.06% 0m00.86s | 472736 ko | Rewriter/Rewriter/Reify.vo | 0m00.81s | 472188 ko || +0m00.04s || 548 ko | +6.17% | +0.11% 0m00.75s | 488592 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.80s | 488600 ko || -0m00.05s || -8 ko | -6.25% | -0.00% 0m00.52s | 482308 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.55s | 482240 ko || -0m00.03s || 68 ko | -5.45% | +0.01% 0m00.47s | 480428 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.51s | 480272 ko || -0m00.04s || 156 ko | -7.84% | +0.03% 0m00.45s | 478788 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.48s | 478844 ko || -0m00.02s || -56 ko | -6.24% | -0.01% 0m00.44s | 480280 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.50s | 480356 ko || -0m00.06s || -76 ko | -12.00% | -0.01% ```

--- src/Rewriter/Rewriter/Reify.v | 237 +++++++++++++++++++++------------- 1 file changed, 146 insertions(+), 91 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 89b40cb4e..c59be066b 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -899,93 +899,148 @@ Module Compilers. Control.refine (fun () => adjust_side_conditions_for_gets_inlined (Fresh.Free.of_goal ()) value_ctx side_conditions)) in constr:(ltac:(f value_ctx side_conditions)). - Ltac reify_to_pattern_and_replacement_in_context base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota type_ctx var gets_inlined should_do_again cur_i term value_ctx := - let base_type := constr:(base.type base) in - let reify_base_type := ltac:(Compilers.base.reify base reify_base) in - let base_interp_head := head base_interp in - let t := fresh "t" in - let p := fresh "p" in - let reify_rec_gen type_ctx := reify_to_pattern_and_replacement_in_context base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota type_ctx var gets_inlined should_do_again in - let var_pos := constr:(fun _ : type base_type => positive) in - let value := constr:(@value base_type ident var) in - let cexpr_to_pattern_and_replacement_unfolded := constr:(@expr_to_pattern_and_replacement_unfolded base try_make_transport_base_cps ident var pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident (reflect_ident_iota var) gets_inlined should_do_again type_ctx) in - let cpartial_lam_unif_rewrite_ruleTP_gen := constr:(@partial_lam_unif_rewrite_ruleTP_gen_unfolded base ident var pident pident_arg_types should_do_again) in - let cwith_unif_rewrite_ruleTP_gen := constr:(fun t p => @with_unif_rewrite_ruleTP_gen base ident var pident pident_arg_types value t p should_do_again true true) in - lazymatch term with - | (fun x : ?T => ?f) - => let rT := Compilers.type.reify reify_base_type base_type T in - let not_x1 := fresh in - let not_x2 := fresh in - let next_i := (eval vm_compute in (Pos.succ cur_i)) in - let type_ctx' := fresh in (* COQBUG(https://github.com/coq/coq/issues/7210#issuecomment-470009463) *) - let rf0 := - constr:( - match type_ctx return _ with - | type_ctx' - => fun (x : T) - => match f, @expr.var_context.cons base_type var_pos T rT x cur_i value_ctx return _ with (* c.f. COQBUG(https://github.com/coq/coq/issues/6252#issuecomment-347041995) for [return _] *) - | not_x1, not_x2 - => ltac:( - let f := (eval cbv delta [not_x1] in not_x1) in - let value_ctx := (eval cbv delta [not_x2] in not_x2) in - let type_ctx := (eval cbv delta [type_ctx'] in type_ctx') in - clear not_x1 not_x2 type_ctx'; - let rf := reify_rec_gen type_ctx next_i f value_ctx in - exact rf) - end - end) in - lazymatch rf0 with - | (fun _ => ?f) => f - | _ - => constr_fail_with ltac:(fun _ => fail 1 "Failure to eliminate functional dependencies of" rf0) - end - | (@eq ?T ?A ?B, ?side_conditions) - => let rA := expr.reify_in_context base_type ident reify_base_type reify_ident var_pos A value_ctx tt in - let rB := expr.reify_in_context base_type ident reify_base_type reify_ident var_pos B value_ctx tt in - let side_conditions := adjust_side_conditions_for_gets_inlined value_ctx side_conditions in - let invalid := fresh "invalid" in - let res := constr:(fun invalid => cexpr_to_pattern_and_replacement_unfolded invalid _ rA rB side_conditions) in - let res := (eval cbv [expr_to_pattern_and_replacement_unfolded pident_arg_types pident_of_typed_ident pident_type_of_list_arg_types_beq pident_arg_types_of_typed_ident (*reflect_ident_iota*)] in res) in - let res := (eval cbn [fst snd andb pattern.base.relax pattern.base.subst_default pattern.base.subst_default_relax] in res) in - let res := change_pattern_base_subst_default_relax res in - let p := (eval cbv [projT1] in (fun invalid => projT1 (res invalid))) in - let p := strip_invalid_or_fail p in - let p := adjust_pattern_type_variables p in - let res := (eval cbv [projT2] in (fun invalid => projT2 (res invalid))) in - let evm' := fresh "evm" in - let res' := fresh in - let res := - constr:( - fun invalid (evm' : EvarMap_at base) - => match res invalid return _ with - | res' - => ltac:(let res := (eval cbv beta delta [res'] in res') in - clear res'; - let res := adjust_lookup_default res in - let res := adjust_type_variables res in - let res := replace_evar_map evm' res in - let res := replace_type_try_transport res in - exact res) - end) in - let res := (eval cbv [UnderLets.map UnderLets.flat_map reify_expr_beta_iota reflect_expr_beta_iota reify_to_UnderLets] in res) in - let res := (eval cbn [reify reflect UnderLets.of_expr UnderLets.to_expr UnderLets.splice value' Base_value invert_Literal invert_ident_Literal splice_under_lets_with_value] in res) in - let res := strip_invalid_or_fail res in - (* cbv here not strictly needed *) - let res := (eval cbv [partial_lam_unif_rewrite_ruleTP_gen_unfolded] in - (existT - (cwith_unif_rewrite_ruleTP_gen _) - p - (cpartial_lam_unif_rewrite_ruleTP_gen _ p res))) in - (* not strictly needed *) - let res := (eval cbn [pattern.base.subst_default pattern.base.lookup_default PositiveMap.find type.interp base.interp base_interp_head] in res) in - let res := (eval cbv [projT1 projT2] in - (existT - (@rewrite_ruleTP base ident var pident pident_arg_types) - {| pattern.pattern_of_anypattern := projT1 res |} - {| rew_replacement := projT2 res |})) in - let res := clean_beq base_interp_beq value_ctx res in - res - end. + Ltac2 rec reify_to_pattern_and_replacement_in_context (base : constr) (reify_base : constr -> constr) (base_interp : constr) (base_interp_beq : constr) (try_make_transport_base_cps : constr) (ident : constr) (reify_ident_opt : binder list -> constr -> constr option) (pident : constr) (pident_arg_types : constr) (pident_type_of_list_arg_types_beq : constr) (pident_of_typed_ident : constr) (pident_arg_types_of_typed_ident : constr) (reflect_ident_iota : constr) (type_ctx : constr) (var : constr) (gets_inlined : constr) (should_do_again : constr) (cur_i : constr) (term : constr) (value_ctx : (ident * constr (* ty *) * constr (* var *)) list) : constr := + let wrap_constr_for_perf c := '(ltac2:(Control.refine (fun () => c))) in + Reify.debug_wrap + "reify_to_pattern_and_replacement_in_context" Message.of_constr term + Reify.should_debug_enter_reify Reify.should_debug_leave_reify_success (Some Message.of_constr) + (fun () + => let debug_Constr_check := Reify.Constr.debug_check_strict "reify_to_pattern_and_replacement_in_context" in + let base_type := debug_Constr_check (fun () => mkApp 'base.type [base]) in + let reify_base_type := Compilers.base.reify base reify_base in + let base_interp_head := head_reference base_interp in + let reify_rec_gen := reify_to_pattern_and_replacement_in_context base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota type_ctx var gets_inlined should_do_again in + let var_pos := '(fun _ : type $base_type => positive) in + let value := debug_Constr_check (fun () => mkApp '@value [base_type; ident; var]) in + let cexpr_to_pattern_and_replacement_unfolded := debug_Constr_check (fun () => mkApp '@expr_to_pattern_and_replacement_unfolded [base; try_make_transport_base_cps; ident; var; pident; pident_arg_types; pident_type_of_list_arg_types_beq; pident_of_typed_ident; pident_arg_types_of_typed_ident; mkApp reflect_ident_iota [var]; gets_inlined; should_do_again; type_ctx]) in + let cpartial_lam_unif_rewrite_ruleTP_gen := debug_Constr_check (fun () => mkApp '@partial_lam_unif_rewrite_ruleTP_gen_unfolded [base; ident; var; pident; pident_arg_types; should_do_again]) in + let check name c + := let c := debug_Constr_check c in + match Constr.Unsafe.check c with + | Val c => c + | Err err => Control.throw (Reification_panic (fprintf "reify_to_pattern_and_replacement_in_context: Could not make %s from %t: %a" name c (fun () => Message.of_exn) err)) + end in + let cwith_unif_rewrite_ruleTP_gen + := let tb := Constr.Binder.make (Some @t) (debug_Constr_check (fun () => mkApp '@type.type [mkApp '@pattern.base.type.type [base] ])) in + (* can't check this one, it's not under binders *) + let pb := Constr.Binder.make (Some @p) (mkApp '@pattern.pattern [base; pident; mkRel 1]) in + let t := mkRel 2 in + let p := mkRel 1 in + debug_Constr_check (fun () => mkLambda tb (mkLambda pb (mkApp '@with_unif_rewrite_ruleTP_gen [base; ident; var; pident; pident_arg_types; value; t; p; should_do_again; 'true; 'true]))) in + match Constr.Unsafe.kind_nocast term with + | Constr.Unsafe.Lambda xb f + => let t := Constr.Binder.type xb in + let rT := Compilers.type.reify reify_base_type base_type t in + let next_i := (eval vm_compute in (debug_Constr_check (fun () => mkApp 'Pos.succ [cur_i]))) in + strip_functional_dependency + (Constr.in_fresh_context + @UNNAMED_VARIABLE [xb] + (fun ns + => let (x, _) := List.nth ns 0 in + let f := debug_Constr_check (fun () => Constr.Unsafe.substnl [mkVar x] 0 f) in + let value_ctx := (x, rT, cur_i) :: value_ctx in + let rf := reify_rec_gen next_i f value_ctx in + Control.refine (fun () => rf))) + | _ + => lazy_match! term with + | (@eq ?t ?a ?b, ?side_conditions) + => let rA := wrap_constr_for_perf (expr.reify_in_context base_type ident reify_base_type reify_ident_opt var_pos a [] [] value_ctx [] None) in + let rB := wrap_constr_for_perf (expr.reify_in_context base_type ident reify_base_type reify_ident_opt var_pos b [] [] value_ctx [] None) in + let side_conditions := wrap_constr_for_perf (adjust_side_conditions_for_gets_inlined (Fresh.Free.of_goal ()) value_ctx side_conditions) in + let res := check "res" + (fun () => mkLambda + (* Hack around COQBUG(https://github.com/coq/coq/issues/16419) *) + (Constr.Binder.make (Some @invalid) '(match _ return Type with ev => ev end)) + (mkApp cexpr_to_pattern_and_replacement_unfolded [mkRel 1; '_; rA; rB; side_conditions])) in + let res := let pident_arg_types := head_reference pident_arg_types in + let pident_of_typed_ident := head_reference pident_of_typed_ident in + let pident_type_of_list_arg_types_beq := head_reference pident_type_of_list_arg_types_beq in + let pident_arg_types_of_typed_ident := head_reference pident_arg_types_of_typed_ident in + (eval cbv [expr_to_pattern_and_replacement_unfolded $pident_arg_types $pident_of_typed_ident $pident_type_of_list_arg_types_beq $pident_arg_types_of_typed_ident (*reflect_ident_iota*)] in res) in + let res := (eval cbn [fst snd andb pattern.base.relax pattern.base.subst_default pattern.base.subst_default_relax] in res) in + let res := wrap_constr_for_perf (change_pattern_base_subst_default_relax res) in + let p := (eval cbv [projT1] in + (check "projT1_res" + (fun () => mkLambda (Constr.Binder.make (Some @invalid) '(match _ return Type with ev => ev end)) + (mkApp '@projT1 ['_; '_; mkApp res [mkRel 1] ])))) + (*(fun invalid => projT1 (res invalid))*) in + let p := wrap_constr_for_perf (strip_invalid_or_fail p) in + let p := wrap_constr_for_perf (adjust_pattern_type_variables p) in + (* avoid capturing invalid *) + let res := (eval cbv [projT2] in + (check "projT2_res" + (fun () => mkLambda (Constr.Binder.make (Some @invalid) '(match _ return Type with ev => ev end)) + (mkApp '@projT2 ['_; '_; mkApp res [mkRel 1] ])))) + (*(fun invalid => projT2 (res invalid))*) in + let avoid := Fresh.Free.union (Fresh.Free.of_goal ()) (Fresh.Free.of_constr res) in + let invalid := Fresh.fresh avoid @invalid in + let evm' := Fresh.fresh avoid @evm' in + let res () + := Constr.in_context + invalid '_ + (fun () + => Control.refine + (fun () + => Constr.in_context + evm' '(EvarMap_at $base) + (fun () + => Control.refine + (fun () + => (* we must check here to unify the evar in the type of invalid, lest we run into COQBUG(https://github.com/coq/coq/issues/16540) *) + let res := (eval cbv beta in (check "res invalid" (fun () => mkApp res [mkVar invalid]))) in + let res := wrap_constr_for_perf (adjust_lookup_default res) in + let res := wrap_constr_for_perf (adjust_type_variables res) in + let res := wrap_constr_for_perf (replace_evar_map (mkVar evm') res) in + let res := wrap_constr_for_perf (replace_type_try_transport res) in + res)))) in + let res := debug_Constr_check res in + let res := (eval cbv [UnderLets.map UnderLets.flat_map reify_expr_beta_iota reflect_expr_beta_iota reify_to_UnderLets] in res) in + let res := (eval cbn [reify reflect UnderLets.of_expr UnderLets.to_expr UnderLets.splice value' Base_value invert_Literal invert_ident_Literal splice_under_lets_with_value] in res) in + let res := wrap_constr_for_perf (strip_invalid_or_fail res) in + (* cbv here not strictly needed *) + let res := (eval cbv [partial_lam_unif_rewrite_ruleTP_gen_unfolded] + in constr:(existT + ($cwith_unif_rewrite_ruleTP_gen _) + $p + ($cpartial_lam_unif_rewrite_ruleTP_gen _ $p $res))) in + (* not strictly needed *) + let res := (eval cbn [pattern.base.subst_default pattern.base.lookup_default PositiveMap.find type.interp base.interp $base_interp_head] in res) in + let res := (eval cbv [projT1 projT2] + in constr:(existT + (@rewrite_ruleTP $base $ident $var $pident $pident_arg_types) + {| pattern.pattern_of_anypattern := projT1 $res |} + {| rew_replacement := projT2 $res |})) in + let res := wrap_constr_for_perf (clean_beq base_interp_beq (Fresh.Free.of_goal ()) value_ctx res) in + res + end + end). + + #[deprecated(since="8.15",note="Use Ltac2 instead.")] + Ltac reify_to_pattern_and_replacement_in_context base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota type_ctx var gets_inlined should_do_again cur_i term value_ctx := + let f := ltac2:(base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota type_ctx var gets_inlined should_do_again cur_i term value_ctx + |- let base := Ltac1.get_to_constr "base" base in + let reify_base := fun ty => Ltac1.apply_c reify_base [ty] in + let base_interp := Ltac1.get_to_constr "base_interp" base_interp in + let base_interp_beq := Ltac1.get_to_constr "base_interp_beq" base_interp_beq in + let try_make_transport_base_cps := Ltac1.get_to_constr "try_make_transport_base_cps" try_make_transport_base_cps in + let ident := Ltac1.get_to_constr "ident" ident in + let reify_ident_opt := expr.reify_ident_opt_of_cps reify_ident in + let pident := Ltac1.get_to_constr "pident" pident in + let pident_arg_types := Ltac1.get_to_constr "pident_arg_types" pident_arg_types in + let pident_type_of_list_arg_types_beq := Ltac1.get_to_constr "pident_type_of_list_arg_types_beq" pident_type_of_list_arg_types_beq in + let pident_of_typed_ident := Ltac1.get_to_constr "pident_of_typed_ident" pident_of_typed_ident in + let pident_arg_types_of_typed_ident := Ltac1.get_to_constr "pident_arg_types_of_typed_ident" pident_arg_types_of_typed_ident in + let reflect_ident_iota := Ltac1.get_to_constr "reflect_ident_iota" reflect_ident_iota in + let type_ctx := Ltac1.get_to_constr "type_ctx" type_ctx in + let var := Ltac1.get_to_constr "var" var in + let gets_inlined := Ltac1.get_to_constr "gets_inlined" gets_inlined in + let should_do_again := Ltac1.get_to_constr "should_do_again" should_do_again in + let cur_i := Ltac1.get_to_constr "cur_i" cur_i in + let term := Ltac1.get_to_constr "term" term in + let value_ctx := Ltac1.get_to_constr "value_ctx" value_ctx in + let value_ctx := expr.value_ctx_to_list value_ctx in + Control.refine (fun () => reify_to_pattern_and_replacement_in_context base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota type_ctx var gets_inlined should_do_again cur_i term value_ctx)) in + constr:(ltac:(f base reify_base base_interp base_interp_beq try_make_transport_base_cps ident ltac:(expr.wrap_reify_ident_cps reify_ident) pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota type_ctx constr:(var) gets_inlined should_do_again cur_i term value_ctx)). Ltac reify base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota var gets_inlined should_do_again lem := let base_type := constr:(Compilers.base.type base) in @@ -995,10 +1050,10 @@ Module Compilers. base_type_interp lem ltac:( - fun ty_ctx cur_i lem - => let lem := equation_to_parts lem in - let res := reify_to_pattern_and_replacement_in_context base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota ty_ctx var gets_inlined should_do_again constr:(1%positive) lem (@expr.var_context.nil (base.type base) (fun _ => positive)) in - res). + fun ty_ctx cur_i lem + => let lem := equation_to_parts lem in + let res := reify_to_pattern_and_replacement_in_context base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota ty_ctx var gets_inlined should_do_again constr:(1%positive) lem (@expr.var_context.nil (base.type base) (fun _ => positive)) in + res). Ltac Reify base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota gets_inlined should_do_again lem := let var := fresh "var" in From 89b692a2f0fd189de69b758a93ca56375acfd969 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 19:06:56 +0530 Subject: [PATCH 60/74] Remove constr-copying in reify_to_pattern_and_replacement_in_context and remove dead code
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m12.15s | 1410288 ko | Total Time / Peak Mem | 4m15.29s | 1426712 ko || -0m03.13s || -16424 ko | -1.22% | -1.15% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m54.23s | 1084372 ko | Rewriter/Rewriter/Examples.vo | 0m55.30s | 1084268 ko || -0m01.07s || 104 ko | -1.93% | +0.00% 0m56.24s | 1410288 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m56.67s | 1426712 ko || -0m00.42s || -16424 ko | -0.75% | -1.15% 0m55.22s | 1105024 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.95s | 1116872 ko || -0m00.73s || -11848 ko | -1.30% | -1.06% 0m30.58s | 921632 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m31.28s | 931640 ko || -0m00.70s || -10008 ko | -2.23% | -1.07% 0m23.97s | 881180 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.92s | 876052 ko || +0m00.04s || 5128 ko | +0.20% | +0.58% 0m16.19s | 736148 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.36s | 731352 ko || -0m00.16s || 4796 ko | -1.03% | +0.65% 0m12.14s | 638928 ko | Rewriter/Demo.vo | 0m12.14s | 638892 ko || +0m00.00s || 36 ko | +0.00% | +0.00% 0m00.88s | 472436 ko | Rewriter/Rewriter/Reify.vo | 0m00.84s | 472676 ko || +0m00.04s || -240 ko | +4.76% | -0.05% 0m00.71s | 488628 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.78s | 488716 ko || -0m00.07s || -88 ko | -8.97% | -0.01% 0m00.52s | 482292 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.50s | 482300 ko || +0m00.02s || -8 ko | +4.00% | -0.00% 0m00.50s | 480292 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.52s | 480464 ko || -0m00.02s || -172 ko | -3.84% | -0.03% 0m00.50s | 480516 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.51s | 480400 ko || -0m00.01s || 116 ko | -1.96% | +0.02% 0m00.48s | 478852 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.52s | 478940 ko || -0m00.04s || -88 ko | -7.69% | -0.01% ```

--- src/Rewriter/Rewriter/Reify.v | 62 +++++++---------------------------- 1 file changed, 12 insertions(+), 50 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index c59be066b..b240f2cee 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -602,11 +602,6 @@ Module Compilers. let rewr := debug_Constr_check (fun () => Constr.Unsafe.replace_by_pattern [evm'] [evm] rewr) in replace_evar_map evm rewr end). - #[deprecated(since="8.15",note="Use Ltac2 instead.")] - Ltac replace_evar_map evm rewr := - let f := ltac2:(evm rewr - |- Control.refine (fun () => replace_evar_map (Ltac1.get_to_constr "evm" evm) (Ltac1.get_to_constr "rewr" rewr))) in - constr:(ltac:(f constr:(evm) rewr)). Definition adjust_type_variables_id base t (P : base.type base -> Type) (x : P t) := x. Ltac2 rec adjust_type_variables (rewr : constr) : constr := @@ -633,11 +628,6 @@ Module Compilers. adjust_type_variables rewr | _ => rewr end). - #[deprecated(since="8.15",note="Use Ltac2 instead.")] - Ltac adjust_type_variables rewr := - let f := ltac2:(rewr - |- Control.refine (fun () => adjust_type_variables (Ltac1.get_to_constr "rewr" rewr))) in - constr:(ltac:(f rewr)). Ltac2 replace_type_try_transport (term : constr) : constr := Reify.debug_wrap @@ -672,11 +662,6 @@ Module Compilers. => (eval cbv beta in (debug_Constr_check (fun () => mkApp term args))) end). - #[deprecated(since="8.15",note="Use Ltac2 instead.")] - Ltac replace_type_try_transport term := - let f := ltac2:(term - |- Control.refine (fun () => replace_type_try_transport (Ltac1.get_to_constr "term" term))) in - constr:(ltac:(f term)). Ltac2 rec under_binders (avoid : Fresh.Free.t) (term : constr) (cont : ident list -> constr -> constr) (ctx : ident list) : constr := match Constr.Unsafe.kind_nocast term with @@ -750,11 +735,6 @@ Module Compilers. | ?f _ _ => (eval cbn [andb] in constr:($f (fun x y => andb y x) (fun b => b))) end in term). - #[deprecated(since="8.15",note="Use Ltac2 instead.")] - Ltac remove_andb_true term := - let f := ltac2:(term - |- Control.refine (fun () => remove_andb_true (Ltac1.get_to_constr "term" term))) in - constr:(ltac:(f term)). Ltac2 rec adjust_if_negb (term : constr) : constr := Reify.debug_wrap "adjust_if_negb" Message.of_constr term @@ -846,15 +826,6 @@ Module Compilers. let term := (eval cbv [base.interp_beq $base_interp_beq_head] in term) in let term := remove_andb_true term in term). - #[deprecated(since="8.15",note="Use Ltac2 instead.")] - Ltac clean_beq base_interp_beq only_eliminate_in_ctx term := - let f := ltac2:(base_interp_beq only_eliminate_in_ctx term - |- let base_interp_beq := Ltac1.get_to_constr "base_interp_beq" base_interp_beq in - let only_eliminate_in_ctx := Ltac1.get_to_constr "only_eliminate_in_ctx" only_eliminate_in_ctx in - let only_eliminate_in_ctx := expr.value_ctx_to_list only_eliminate_in_ctx in - let term := Ltac1.get_to_constr "term" term in - Control.refine (fun () => clean_beq base_interp_beq (Fresh.Free.of_goal ()) only_eliminate_in_ctx term)) in - constr:(ltac:(f base_interp_beq only_eliminate_in_ctx term)). Ltac2 rec adjust_side_conditions_for_gets_inlined' (value_ctx : (ident * constr (* ty *) * constr (* var *)) list) (side_conditions : constr) (lookup_gets_inlined : constr) : constr := Reify.debug_wrap @@ -890,17 +861,8 @@ Module Compilers. lookup_gets_inlined '(positive -> bool) (fun () => Control.refine (fun () => adjust_side_conditions_for_gets_inlined' value_ctx side_conditions (mkVar lookup_gets_inlined))). - #[deprecated(since="8.15",note="Use Ltac2 instead.")] - Ltac adjust_side_conditions_for_gets_inlined value_ctx side_conditions := - let f := ltac2:(value_ctx side_conditions - |- let value_ctx := Ltac1.get_to_constr "value_ctx" value_ctx in - let value_ctx := expr.value_ctx_to_list value_ctx in - let side_conditions := Ltac1.get_to_constr "side_conditions" side_conditions in - Control.refine (fun () => adjust_side_conditions_for_gets_inlined (Fresh.Free.of_goal ()) value_ctx side_conditions)) in - constr:(ltac:(f value_ctx side_conditions)). Ltac2 rec reify_to_pattern_and_replacement_in_context (base : constr) (reify_base : constr -> constr) (base_interp : constr) (base_interp_beq : constr) (try_make_transport_base_cps : constr) (ident : constr) (reify_ident_opt : binder list -> constr -> constr option) (pident : constr) (pident_arg_types : constr) (pident_type_of_list_arg_types_beq : constr) (pident_of_typed_ident : constr) (pident_arg_types_of_typed_ident : constr) (reflect_ident_iota : constr) (type_ctx : constr) (var : constr) (gets_inlined : constr) (should_do_again : constr) (cur_i : constr) (term : constr) (value_ctx : (ident * constr (* ty *) * constr (* var *)) list) : constr := - let wrap_constr_for_perf c := '(ltac2:(Control.refine (fun () => c))) in Reify.debug_wrap "reify_to_pattern_and_replacement_in_context" Message.of_constr term Reify.should_debug_enter_reify Reify.should_debug_leave_reify_success (Some Message.of_constr) @@ -944,9 +906,9 @@ Module Compilers. | _ => lazy_match! term with | (@eq ?t ?a ?b, ?side_conditions) - => let rA := wrap_constr_for_perf (expr.reify_in_context base_type ident reify_base_type reify_ident_opt var_pos a [] [] value_ctx [] None) in - let rB := wrap_constr_for_perf (expr.reify_in_context base_type ident reify_base_type reify_ident_opt var_pos b [] [] value_ctx [] None) in - let side_conditions := wrap_constr_for_perf (adjust_side_conditions_for_gets_inlined (Fresh.Free.of_goal ()) value_ctx side_conditions) in + => let rA := expr.reify_in_context base_type ident reify_base_type reify_ident_opt var_pos a [] [] value_ctx [] None in + let rB := expr.reify_in_context base_type ident reify_base_type reify_ident_opt var_pos b [] [] value_ctx [] None in + let side_conditions := adjust_side_conditions_for_gets_inlined (Fresh.Free.of_goal ()) value_ctx side_conditions in let res := check "res" (fun () => mkLambda (* Hack around COQBUG(https://github.com/coq/coq/issues/16419) *) @@ -958,14 +920,14 @@ Module Compilers. let pident_arg_types_of_typed_ident := head_reference pident_arg_types_of_typed_ident in (eval cbv [expr_to_pattern_and_replacement_unfolded $pident_arg_types $pident_of_typed_ident $pident_type_of_list_arg_types_beq $pident_arg_types_of_typed_ident (*reflect_ident_iota*)] in res) in let res := (eval cbn [fst snd andb pattern.base.relax pattern.base.subst_default pattern.base.subst_default_relax] in res) in - let res := wrap_constr_for_perf (change_pattern_base_subst_default_relax res) in + let res := change_pattern_base_subst_default_relax res in let p := (eval cbv [projT1] in (check "projT1_res" (fun () => mkLambda (Constr.Binder.make (Some @invalid) '(match _ return Type with ev => ev end)) (mkApp '@projT1 ['_; '_; mkApp res [mkRel 1] ])))) (*(fun invalid => projT1 (res invalid))*) in - let p := wrap_constr_for_perf (strip_invalid_or_fail p) in - let p := wrap_constr_for_perf (adjust_pattern_type_variables p) in + let p := strip_invalid_or_fail p in + let p := adjust_pattern_type_variables p in (* avoid capturing invalid *) let res := (eval cbv [projT2] in (check "projT2_res" @@ -988,15 +950,15 @@ Module Compilers. (fun () => (* we must check here to unify the evar in the type of invalid, lest we run into COQBUG(https://github.com/coq/coq/issues/16540) *) let res := (eval cbv beta in (check "res invalid" (fun () => mkApp res [mkVar invalid]))) in - let res := wrap_constr_for_perf (adjust_lookup_default res) in - let res := wrap_constr_for_perf (adjust_type_variables res) in - let res := wrap_constr_for_perf (replace_evar_map (mkVar evm') res) in - let res := wrap_constr_for_perf (replace_type_try_transport res) in + let res := adjust_lookup_default res in + let res := adjust_type_variables res in + let res := replace_evar_map (mkVar evm') res in + let res := replace_type_try_transport res in res)))) in let res := debug_Constr_check res in let res := (eval cbv [UnderLets.map UnderLets.flat_map reify_expr_beta_iota reflect_expr_beta_iota reify_to_UnderLets] in res) in let res := (eval cbn [reify reflect UnderLets.of_expr UnderLets.to_expr UnderLets.splice value' Base_value invert_Literal invert_ident_Literal splice_under_lets_with_value] in res) in - let res := wrap_constr_for_perf (strip_invalid_or_fail res) in + let res := strip_invalid_or_fail res in (* cbv here not strictly needed *) let res := (eval cbv [partial_lam_unif_rewrite_ruleTP_gen_unfolded] in constr:(existT @@ -1010,7 +972,7 @@ Module Compilers. (@rewrite_ruleTP $base $ident $var $pident $pident_arg_types) {| pattern.pattern_of_anypattern := projT1 $res |} {| rew_replacement := projT2 $res |})) in - let res := wrap_constr_for_perf (clean_beq base_interp_beq (Fresh.Free.of_goal ()) value_ctx res) in + let res := clean_beq base_interp_beq (Fresh.Free.of_goal ()) value_ctx res in res end end). From 99e2fcabd4b811f68490c6e8dd888c5cb0415ad0 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 14:38:08 +0530 Subject: [PATCH 61/74] Faster fresh in reify_to_pattern_and_replacement_in_context
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m11.53s | 1386440 ko | Total Time / Peak Mem | 4m12.11s | 1410164 ko || -0m00.58s || -23724 ko | -0.23% | -1.68% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m55.85s | 1386440 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m55.94s | 1410164 ko || -0m00.08s || -23724 ko | -0.16% | -1.68% 0m54.87s | 1107028 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.10s | 1104948 ko || -0m00.23s || 2080 ko | -0.41% | +0.18% 0m54.47s | 1087132 ko | Rewriter/Rewriter/Examples.vo | 0m54.51s | 1084304 ko || -0m00.03s || 2828 ko | -0.07% | +0.26% 0m30.56s | 925064 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.52s | 921784 ko || +0m00.03s || 3280 ko | +0.13% | +0.35% 0m23.99s | 881352 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m24.09s | 881164 ko || -0m00.10s || 188 ko | -0.41% | +0.02% 0m16.20s | 736484 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.07s | 736212 ko || +0m00.12s || 272 ko | +0.80% | +0.03% 0m12.10s | 638996 ko | Rewriter/Demo.vo | 0m12.13s | 638996 ko || -0m00.03s || 0 ko | -0.24% | +0.00% 0m00.77s | 488724 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.80s | 488732 ko || -0m00.03s || -8 ko | -3.75% | -0.00% 0m00.77s | 472400 ko | Rewriter/Rewriter/Reify.vo | 0m00.83s | 472452 ko || -0m00.05s || -52 ko | -7.22% | -0.01% 0m00.52s | 482352 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.57s | 482320 ko || -0m00.04s || 32 ko | -8.77% | +0.00% 0m00.49s | 480328 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.51s | 480532 ko || -0m00.02s || -204 ko | -3.92% | -0.04% 0m00.47s | 480324 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.55s | 480280 ko || -0m00.08s || 44 ko | -14.54% | +0.00% 0m00.47s | 479044 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.50s | 478968 ko || -0m00.03s || 76 ko | -6.00% | +0.01% ```

--- src/Rewriter/Rewriter/Reify.v | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index b240f2cee..12d77c364 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -862,7 +862,7 @@ Module Compilers. (fun () => Control.refine (fun () => adjust_side_conditions_for_gets_inlined' value_ctx side_conditions (mkVar lookup_gets_inlined))). - Ltac2 rec reify_to_pattern_and_replacement_in_context (base : constr) (reify_base : constr -> constr) (base_interp : constr) (base_interp_beq : constr) (try_make_transport_base_cps : constr) (ident : constr) (reify_ident_opt : binder list -> constr -> constr option) (pident : constr) (pident_arg_types : constr) (pident_type_of_list_arg_types_beq : constr) (pident_of_typed_ident : constr) (pident_arg_types_of_typed_ident : constr) (reflect_ident_iota : constr) (type_ctx : constr) (var : constr) (gets_inlined : constr) (should_do_again : constr) (cur_i : constr) (term : constr) (value_ctx : (ident * constr (* ty *) * constr (* var *)) list) : constr := + Ltac2 rec reify_to_pattern_and_replacement_in_context (base : constr) (reify_base : constr -> constr) (base_interp : constr) (base_interp_beq : constr) (try_make_transport_base_cps : constr) (ident : constr) (reify_ident_opt : binder list -> constr -> constr option) (pident : constr) (pident_arg_types : constr) (pident_type_of_list_arg_types_beq : constr) (pident_of_typed_ident : constr) (pident_arg_types_of_typed_ident : constr) (reflect_ident_iota : constr) (avoid : Fresh.Free.t) (type_ctx : constr) (var : constr) (gets_inlined : constr) (should_do_again : constr) (cur_i : constr) (term : constr) (value_ctx : (ident * constr (* ty *) * constr (* var *)) list) : constr := Reify.debug_wrap "reify_to_pattern_and_replacement_in_context" Message.of_constr term Reify.should_debug_enter_reify Reify.should_debug_leave_reify_success (Some Message.of_constr) @@ -871,7 +871,7 @@ Module Compilers. let base_type := debug_Constr_check (fun () => mkApp 'base.type [base]) in let reify_base_type := Compilers.base.reify base reify_base in let base_interp_head := head_reference base_interp in - let reify_rec_gen := reify_to_pattern_and_replacement_in_context base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota type_ctx var gets_inlined should_do_again in + let reify_rec_gen avoid := reify_to_pattern_and_replacement_in_context base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota avoid type_ctx var gets_inlined should_do_again in let var_pos := '(fun _ : type $base_type => positive) in let value := debug_Constr_check (fun () => mkApp '@value [base_type; ident; var]) in let cexpr_to_pattern_and_replacement_unfolded := debug_Constr_check (fun () => mkApp '@expr_to_pattern_and_replacement_unfolded [base; try_make_transport_base_cps; ident; var; pident; pident_arg_types; pident_type_of_list_arg_types_beq; pident_of_typed_ident; pident_arg_types_of_typed_ident; mkApp reflect_ident_iota [var]; gets_inlined; should_do_again; type_ctx]) in @@ -895,20 +895,22 @@ Module Compilers. let rT := Compilers.type.reify reify_base_type base_type t in let next_i := (eval vm_compute in (debug_Constr_check (fun () => mkApp 'Pos.succ [cur_i]))) in strip_functional_dependency - (Constr.in_fresh_context - @UNNAMED_VARIABLE [xb] + (Constr.in_fresh_context_avoiding + @UNNAMED_VARIABLE false (Some avoid) [xb] (fun ns - => let (x, _) := List.nth ns 0 in + => let ns := List.map (fun (n, _) => n) ns in + let avoid := Fresh.Free.union avoid (Fresh.Free.of_ids ns) in + let x := List.nth ns 0 in let f := debug_Constr_check (fun () => Constr.Unsafe.substnl [mkVar x] 0 f) in let value_ctx := (x, rT, cur_i) :: value_ctx in - let rf := reify_rec_gen next_i f value_ctx in + let rf := reify_rec_gen avoid next_i f value_ctx in Control.refine (fun () => rf))) | _ => lazy_match! term with | (@eq ?t ?a ?b, ?side_conditions) => let rA := expr.reify_in_context base_type ident reify_base_type reify_ident_opt var_pos a [] [] value_ctx [] None in let rB := expr.reify_in_context base_type ident reify_base_type reify_ident_opt var_pos b [] [] value_ctx [] None in - let side_conditions := adjust_side_conditions_for_gets_inlined (Fresh.Free.of_goal ()) value_ctx side_conditions in + let side_conditions := adjust_side_conditions_for_gets_inlined avoid value_ctx side_conditions in let res := check "res" (fun () => mkLambda (* Hack around COQBUG(https://github.com/coq/coq/issues/16419) *) @@ -934,7 +936,6 @@ Module Compilers. (fun () => mkLambda (Constr.Binder.make (Some @invalid) '(match _ return Type with ev => ev end)) (mkApp '@projT2 ['_; '_; mkApp res [mkRel 1] ])))) (*(fun invalid => projT2 (res invalid))*) in - let avoid := Fresh.Free.union (Fresh.Free.of_goal ()) (Fresh.Free.of_constr res) in let invalid := Fresh.fresh avoid @invalid in let evm' := Fresh.fresh avoid @evm' in let res () @@ -972,7 +973,7 @@ Module Compilers. (@rewrite_ruleTP $base $ident $var $pident $pident_arg_types) {| pattern.pattern_of_anypattern := projT1 $res |} {| rew_replacement := projT2 $res |})) in - let res := clean_beq base_interp_beq (Fresh.Free.of_goal ()) value_ctx res in + let res := clean_beq base_interp_beq avoid value_ctx res in res end end). @@ -1001,7 +1002,7 @@ Module Compilers. let term := Ltac1.get_to_constr "term" term in let value_ctx := Ltac1.get_to_constr "value_ctx" value_ctx in let value_ctx := expr.value_ctx_to_list value_ctx in - Control.refine (fun () => reify_to_pattern_and_replacement_in_context base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota type_ctx var gets_inlined should_do_again cur_i term value_ctx)) in + Control.refine (fun () => reify_to_pattern_and_replacement_in_context base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota (Fresh.Free.of_goal ()) type_ctx var gets_inlined should_do_again cur_i term value_ctx)) in constr:(ltac:(f base reify_base base_interp base_interp_beq try_make_transport_base_cps ident ltac:(expr.wrap_reify_ident_cps reify_ident) pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota type_ctx constr:(var) gets_inlined should_do_again cur_i term value_ctx)). Ltac reify base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota var gets_inlined should_do_again lem := From c490704086de11a079b41f0a46bbd7c32e7dad66 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 19:23:14 +0530 Subject: [PATCH 62/74] Port reify and Reify to Ltac2
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m12.53s | 1400276 ko | Total Time / Peak Mem | 4m12.46s | 1386444 ko || +0m00.07s || 13832 ko | +0.02% | +0.99% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m56.14s | 1400276 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m56.04s | 1386444 ko || +0m00.10s || 13832 ko | +0.17% | +0.99% 0m55.54s | 1115212 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.18s | 1106900 ko || +0m00.35s || 8312 ko | +0.65% | +0.75% 0m54.45s | 1086048 ko | Rewriter/Rewriter/Examples.vo | 0m54.50s | 1087104 ko || -0m00.04s || -1056 ko | -0.09% | -0.09% 0m30.79s | 923304 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.73s | 920428 ko || +0m00.05s || 2876 ko | +0.19% | +0.31% 0m23.96s | 877148 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m24.07s | 881200 ko || -0m00.10s || -4052 ko | -0.45% | -0.45% 0m16.13s | 729944 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.17s | 736500 ko || -0m00.04s || -6556 ko | -0.24% | -0.89% 0m12.09s | 638976 ko | Rewriter/Demo.vo | 0m12.18s | 638960 ko || -0m00.08s || 16 ko | -0.73% | +0.00% 0m00.81s | 488676 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.76s | 488500 ko || +0m00.05s || 176 ko | +6.57% | +0.03% 0m00.81s | 472740 ko | Rewriter/Rewriter/Reify.vo | 0m00.84s | 472464 ko || -0m00.02s || 276 ko | -3.57% | +0.05% 0m00.48s | 482212 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.52s | 482264 ko || -0m00.04s || -52 ko | -7.69% | -0.01% 0m00.45s | 480436 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.52s | 480428 ko || -0m00.07s || 8 ko | -13.46% | +0.00% 0m00.45s | 478996 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.45s | 478960 ko || +0m00.00s || 36 ko | +0.00% | +0.00% 0m00.43s | 480436 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.50s | 480352 ko || -0m00.07s || 84 ko | -14.00% | +0.01% ```

--- src/Rewriter/Rewriter/Reify.v | 78 +++++++++++++++++++++++++++++------ 1 file changed, 65 insertions(+), 13 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 12d77c364..ccbe7cd6f 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -1005,24 +1005,76 @@ Module Compilers. Control.refine (fun () => reify_to_pattern_and_replacement_in_context base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota (Fresh.Free.of_goal ()) type_ctx var gets_inlined should_do_again cur_i term value_ctx)) in constr:(ltac:(f base reify_base base_interp base_interp_beq try_make_transport_base_cps ident ltac:(expr.wrap_reify_ident_cps reify_ident) pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota type_ctx constr:(var) gets_inlined should_do_again cur_i term value_ctx)). - Ltac reify base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota var gets_inlined should_do_again lem := - let base_type := constr:(Compilers.base.type base) in - let base_type_interp := constr:(@Compilers.base.interp base base_interp) in + Ltac2 reify (base : constr) (reify_base : constr -> constr) (base_interp : constr) (base_interp_beq : constr) (try_make_transport_base_cps : constr) (ident : constr) (reify_ident_opt : binder list -> constr -> constr option) (pident : constr) (pident_arg_types : constr) (pident_type_of_list_arg_types_beq : constr) (pident_of_typed_ident : constr) (pident_arg_types_of_typed_ident : constr) (reflect_ident_iota : constr) (var : constr) (gets_inlined : constr) (should_do_again : constr) (lem : constr) : constr := + let debug_Constr_check := Reify.Constr.debug_check_strict "RewriteRules.Reify.reify" in + let base_type := debug_Constr_check (fun () => mkApp '@Compilers.base.type [base]) in + let base_type_interp := debug_Constr_check (fun () => mkApp '@Compilers.base.interp [base; base_interp]) in + let wrap_constr_for_perf c := '(ltac2:(Control.refine (fun () => c))) in + let avoid := Fresh.Free.of_goal () in reify_under_forall_types base_type base_type_interp + avoid lem - ltac:( - fun ty_ctx cur_i lem - => let lem := equation_to_parts lem in - let res := reify_to_pattern_and_replacement_in_context base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota ty_ctx var gets_inlined should_do_again constr:(1%positive) lem (@expr.var_context.nil (base.type base) (fun _ => positive)) in - res). + (fun avoid ty_ctx cur_i lem + => let avoid := Fresh.Free.of_goal () in + let lem := wrap_constr_for_perf (equation_to_parts avoid lem) in + let res := wrap_constr_for_perf (reify_to_pattern_and_replacement_in_context base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota avoid ty_ctx var gets_inlined should_do_again '(1%positive) lem []) in + res). + #[deprecated(since="8.15",note="Use Ltac2 instead.")] + Ltac reify base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota var gets_inlined should_do_again lem := + let f := ltac2:(base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota var gets_inlined should_do_again lem + |- let base := Ltac1.get_to_constr "base" base in + let reify_base := fun ty => Ltac1.apply_c reify_base [ty] in + let base_interp := Ltac1.get_to_constr "base_interp" base_interp in + let base_interp_beq := Ltac1.get_to_constr "base_interp_beq" base_interp_beq in + let try_make_transport_base_cps := Ltac1.get_to_constr "try_make_transport_base_cps" try_make_transport_base_cps in + let ident := Ltac1.get_to_constr "ident" ident in + let reify_ident_opt := expr.reify_ident_opt_of_cps reify_ident in + let pident := Ltac1.get_to_constr "pident" pident in + let pident_arg_types := Ltac1.get_to_constr "pident_arg_types" pident_arg_types in + let pident_type_of_list_arg_types_beq := Ltac1.get_to_constr "pident_type_of_list_arg_types_beq" pident_type_of_list_arg_types_beq in + let pident_of_typed_ident := Ltac1.get_to_constr "pident_of_typed_ident" pident_of_typed_ident in + let pident_arg_types_of_typed_ident := Ltac1.get_to_constr "pident_arg_types_of_typed_ident" pident_arg_types_of_typed_ident in + let reflect_ident_iota := Ltac1.get_to_constr "reflect_ident_iota" reflect_ident_iota in + let var := Ltac1.get_to_constr "var" var in + let gets_inlined := Ltac1.get_to_constr "gets_inlined" gets_inlined in + let should_do_again := Ltac1.get_to_constr "should_do_again" should_do_again in + let lem := Ltac1.get_to_constr "lem" lem in + Control.refine (fun () => reify base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota var gets_inlined should_do_again lem)) in + constr:(ltac:(f base reify_base base_interp base_interp_beq try_make_transport_base_cps ident ltac:(expr.wrap_reify_ident_cps reify_ident) pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota constr:(var) gets_inlined should_do_again lem)). + + Ltac2 _Reify (base : constr) (reify_base : constr -> constr) (base_interp : constr) (base_interp_beq : constr) (try_make_transport_base_cps : constr) (ident : constr) (reify_ident_opt : binder list -> constr -> constr option) (pident : constr) (pident_arg_types : constr) (pident_type_of_list_arg_types_beq : constr) (pident_of_typed_ident : constr) (pident_arg_types_of_typed_ident : constr) (reflect_ident_iota : constr) (gets_inlined : constr) (should_do_again : constr) (lem : constr) : constr := + let debug_Constr_check := Reify.Constr.debug_check_strict "RewriteRules.Reify._Reify" in + Constr.in_fresh_context_avoiding + @var true (Some (Fresh.Free.of_constr lem)) [Constr.Binder.make None '(Compilers.type.type (Compilers.base.type $base) -> Type)] + (fun ns + => let (var, _) := List.nth ns 0 in + let var := mkVar var in + let res := reify base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota var (debug_Constr_check (fun () => mkApp gets_inlined [var])) should_do_again lem in + Control.refine (fun () => res)). - Ltac Reify base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota gets_inlined should_do_again lem := - let var := fresh "var" in - constr:(fun var : Compilers.type.type (Compilers.base.type base) -> Type - => ltac:(let res := reify base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota var (gets_inlined var) should_do_again lem in - exact res)). + #[deprecated(since="8.15",note="Use Ltac2 instead.")] + Ltac Reify base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota gets_inlined should_do_again lem := + let f := ltac2:(base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota gets_inlined should_do_again lem + |- let base := Ltac1.get_to_constr "base" base in + let reify_base := fun ty => Ltac1.apply_c reify_base [ty] in + let base_interp := Ltac1.get_to_constr "base_interp" base_interp in + let base_interp_beq := Ltac1.get_to_constr "base_interp_beq" base_interp_beq in + let try_make_transport_base_cps := Ltac1.get_to_constr "try_make_transport_base_cps" try_make_transport_base_cps in + let ident := Ltac1.get_to_constr "ident" ident in + let reify_ident_opt := expr.reify_ident_opt_of_cps reify_ident in + let pident := Ltac1.get_to_constr "pident" pident in + let pident_arg_types := Ltac1.get_to_constr "pident_arg_types" pident_arg_types in + let pident_type_of_list_arg_types_beq := Ltac1.get_to_constr "pident_type_of_list_arg_types_beq" pident_type_of_list_arg_types_beq in + let pident_of_typed_ident := Ltac1.get_to_constr "pident_of_typed_ident" pident_of_typed_ident in + let pident_arg_types_of_typed_ident := Ltac1.get_to_constr "pident_arg_types_of_typed_ident" pident_arg_types_of_typed_ident in + let reflect_ident_iota := Ltac1.get_to_constr "reflect_ident_iota" reflect_ident_iota in + let gets_inlined := Ltac1.get_to_constr "gets_inlined" gets_inlined in + let should_do_again := Ltac1.get_to_constr "should_do_again" should_do_again in + let lem := Ltac1.get_to_constr "lem" lem in + Control.refine (fun () => _Reify base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota gets_inlined should_do_again lem)) in + constr:(ltac:(f base reify_base base_interp base_interp_beq try_make_transport_base_cps ident ltac:(expr.wrap_reify_ident_cps reify_ident) pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota gets_inlined should_do_again lem)). (* lems is either a list of [Prop]s, or a list of [bool (* should_do_again *) * Prop] *) Ltac reify_list base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota var gets_inlined lems := From 73507e3e982f96bb007713a9b9363ed58452d506 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sat, 1 Oct 2022 14:59:07 +0530 Subject: [PATCH 63/74] Faster fresh in reify and _Reify
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m12.99s | 1406936 ko | Total Time / Peak Mem | 4m12.75s | 1400036 ko || +0m00.24s || 6900 ko | +0.09% | +0.49% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m56.21s | 1406936 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m56.03s | 1400036 ko || +0m00.17s || 6900 ko | +0.32% | +0.49% 0m55.43s | 1115988 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.57s | 1115304 ko || -0m00.14s || 684 ko | -0.25% | +0.06% 0m54.66s | 1086040 ko | Rewriter/Rewriter/Examples.vo | 0m54.49s | 1086196 ko || +0m00.16s || -156 ko | +0.31% | -0.01% 0m30.61s | 922644 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.64s | 923284 ko || -0m00.03s || -640 ko | -0.09% | -0.06% 0m23.96s | 877436 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m24.01s | 877192 ko || -0m00.05s || 244 ko | -0.20% | +0.02% 0m16.39s | 729864 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.26s | 730172 ko || +0m00.12s || -308 ko | +0.79% | -0.04% 0m12.15s | 639028 ko | Rewriter/Demo.vo | 0m12.23s | 639032 ko || -0m00.08s || -4 ko | -0.65% | -0.00% 0m00.85s | 472860 ko | Rewriter/Rewriter/Reify.vo | 0m00.81s | 472864 ko || +0m00.03s || -4 ko | +4.93% | -0.00% 0m00.79s | 488676 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.78s | 488588 ko || +0m00.01s || 88 ko | +1.28% | +0.01% 0m00.51s | 478920 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.50s | 478932 ko || +0m00.01s || -12 ko | +2.00% | -0.00% 0m00.49s | 482320 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.51s | 482180 ko || -0m00.02s || 140 ko | -3.92% | +0.02% 0m00.48s | 480524 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.44s | 480384 ko || +0m00.03s || 140 ko | +9.09% | +0.02% 0m00.46s | 480344 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.48s | 480472 ko || -0m00.01s || -128 ko | -4.16% | -0.02% ```

--- src/Rewriter/Rewriter/Reify.v | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index ccbe7cd6f..9b190989d 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -1005,20 +1005,18 @@ Module Compilers. Control.refine (fun () => reify_to_pattern_and_replacement_in_context base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota (Fresh.Free.of_goal ()) type_ctx var gets_inlined should_do_again cur_i term value_ctx)) in constr:(ltac:(f base reify_base base_interp base_interp_beq try_make_transport_base_cps ident ltac:(expr.wrap_reify_ident_cps reify_ident) pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota type_ctx constr:(var) gets_inlined should_do_again cur_i term value_ctx)). - Ltac2 reify (base : constr) (reify_base : constr -> constr) (base_interp : constr) (base_interp_beq : constr) (try_make_transport_base_cps : constr) (ident : constr) (reify_ident_opt : binder list -> constr -> constr option) (pident : constr) (pident_arg_types : constr) (pident_type_of_list_arg_types_beq : constr) (pident_of_typed_ident : constr) (pident_arg_types_of_typed_ident : constr) (reflect_ident_iota : constr) (var : constr) (gets_inlined : constr) (should_do_again : constr) (lem : constr) : constr := + Ltac2 reify (base : constr) (reify_base : constr -> constr) (base_interp : constr) (base_interp_beq : constr) (try_make_transport_base_cps : constr) (ident : constr) (reify_ident_opt : binder list -> constr -> constr option) (pident : constr) (pident_arg_types : constr) (pident_type_of_list_arg_types_beq : constr) (pident_of_typed_ident : constr) (pident_arg_types_of_typed_ident : constr) (reflect_ident_iota : constr) (avoid : Fresh.Free.t) (var : constr) (gets_inlined : constr) (should_do_again : constr) (lem : constr) : constr := let debug_Constr_check := Reify.Constr.debug_check_strict "RewriteRules.Reify.reify" in let base_type := debug_Constr_check (fun () => mkApp '@Compilers.base.type [base]) in let base_type_interp := debug_Constr_check (fun () => mkApp '@Compilers.base.interp [base; base_interp]) in let wrap_constr_for_perf c := '(ltac2:(Control.refine (fun () => c))) in - let avoid := Fresh.Free.of_goal () in reify_under_forall_types base_type base_type_interp avoid lem (fun avoid ty_ctx cur_i lem - => let avoid := Fresh.Free.of_goal () in - let lem := wrap_constr_for_perf (equation_to_parts avoid lem) in + => let lem := wrap_constr_for_perf (equation_to_parts avoid lem) in let res := wrap_constr_for_perf (reify_to_pattern_and_replacement_in_context base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota avoid ty_ctx var gets_inlined should_do_again '(1%positive) lem []) in res). #[deprecated(since="8.15",note="Use Ltac2 instead.")] @@ -1041,17 +1039,18 @@ Module Compilers. let gets_inlined := Ltac1.get_to_constr "gets_inlined" gets_inlined in let should_do_again := Ltac1.get_to_constr "should_do_again" should_do_again in let lem := Ltac1.get_to_constr "lem" lem in - Control.refine (fun () => reify base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota var gets_inlined should_do_again lem)) in + Control.refine (fun () => reify base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota (Fresh.Free.of_goal ()) var gets_inlined should_do_again lem)) in constr:(ltac:(f base reify_base base_interp base_interp_beq try_make_transport_base_cps ident ltac:(expr.wrap_reify_ident_cps reify_ident) pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota constr:(var) gets_inlined should_do_again lem)). - Ltac2 _Reify (base : constr) (reify_base : constr -> constr) (base_interp : constr) (base_interp_beq : constr) (try_make_transport_base_cps : constr) (ident : constr) (reify_ident_opt : binder list -> constr -> constr option) (pident : constr) (pident_arg_types : constr) (pident_type_of_list_arg_types_beq : constr) (pident_of_typed_ident : constr) (pident_arg_types_of_typed_ident : constr) (reflect_ident_iota : constr) (gets_inlined : constr) (should_do_again : constr) (lem : constr) : constr := + Ltac2 _Reify (base : constr) (reify_base : constr -> constr) (base_interp : constr) (base_interp_beq : constr) (try_make_transport_base_cps : constr) (ident : constr) (reify_ident_opt : binder list -> constr -> constr option) (pident : constr) (pident_arg_types : constr) (pident_type_of_list_arg_types_beq : constr) (pident_of_typed_ident : constr) (pident_arg_types_of_typed_ident : constr) (reflect_ident_iota : constr) (avoid : Fresh.Free.t) (gets_inlined : constr) (should_do_again : constr) (lem : constr) : constr := let debug_Constr_check := Reify.Constr.debug_check_strict "RewriteRules.Reify._Reify" in Constr.in_fresh_context_avoiding - @var true (Some (Fresh.Free.of_constr lem)) [Constr.Binder.make None '(Compilers.type.type (Compilers.base.type $base) -> Type)] + @var false (Some avoid) [Constr.Binder.make None '(Compilers.type.type (Compilers.base.type $base) -> Type)] (fun ns - => let (var, _) := List.nth ns 0 in - let var := mkVar var in - let res := reify base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota var (debug_Constr_check (fun () => mkApp gets_inlined [var])) should_do_again lem in + => let ns := List.map (fun (n, _) => n) ns in + let avoid := Fresh.Free.union avoid (Fresh.Free.of_ids ns) in + let var := mkVar (List.nth ns 0) in + let res := reify base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota avoid var (debug_Constr_check (fun () => mkApp gets_inlined [var])) should_do_again lem in Control.refine (fun () => res)). #[deprecated(since="8.15",note="Use Ltac2 instead.")] @@ -1073,7 +1072,7 @@ Module Compilers. let gets_inlined := Ltac1.get_to_constr "gets_inlined" gets_inlined in let should_do_again := Ltac1.get_to_constr "should_do_again" should_do_again in let lem := Ltac1.get_to_constr "lem" lem in - Control.refine (fun () => _Reify base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota gets_inlined should_do_again lem)) in + Control.refine (fun () => _Reify base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota (Fresh.Free.of_goal ()) gets_inlined should_do_again lem)) in constr:(ltac:(f base reify_base base_interp base_interp_beq try_make_transport_base_cps ident ltac:(expr.wrap_reify_ident_cps reify_ident) pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota gets_inlined should_do_again lem)). (* lems is either a list of [Prop]s, or a list of [bool (* should_do_again *) * Prop] *) From d12b1839b84dfa5399e78d0f6e0b4bf1f4ae1cdb Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 19:24:28 +0530 Subject: [PATCH 64/74] Remove constr-wrapping in reify and delete some dead code
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m12.59s | 1417696 ko | Total Time / Peak Mem | 4m11.84s | 1406724 ko || +0m00.75s || 10972 ko | +0.30% | +0.77% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m55.54s | 1100912 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.30s | 1116032 ko || +0m01.24s || -15120 ko | +2.28% | -1.35% 0m56.02s | 1417696 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m56.17s | 1406724 ko || -0m00.14s || 10972 ko | -0.26% | +0.77% 0m54.46s | 1084008 ko | Rewriter/Rewriter/Examples.vo | 0m54.49s | 1086012 ko || -0m00.03s || -2004 ko | -0.05% | -0.18% 0m30.53s | 921064 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.77s | 922548 ko || -0m00.23s || -1484 ko | -0.77% | -0.16% 0m24.13s | 878736 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m24.00s | 877408 ko || +0m00.12s || 1328 ko | +0.54% | +0.15% 0m16.19s | 733020 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.33s | 729988 ko || -0m00.13s || 3032 ko | -0.85% | +0.41% 0m12.16s | 639052 ko | Rewriter/Demo.vo | 0m12.10s | 639008 ko || +0m00.06s || 44 ko | +0.49% | +0.00% 0m00.79s | 488752 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.73s | 488636 ko || +0m00.06s || 116 ko | +8.21% | +0.02% 0m00.79s | 472732 ko | Rewriter/Rewriter/Reify.vo | 0m00.92s | 472856 ko || -0m00.13s || -124 ko | -14.13% | -0.02% 0m00.55s | 482236 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.55s | 482436 ko || +0m00.00s || -200 ko | +0.00% | -0.04% 0m00.51s | 480416 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.48s | 480448 ko || +0m00.03s || -32 ko | +6.25% | -0.00% 0m00.47s | 478992 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.52s | 478928 ko || -0m00.05s || 64 ko | -9.61% | +0.01% 0m00.46s | 480416 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.48s | 480328 ko || -0m00.01s || 88 ko | -4.16% | +0.01% ```

--- src/Rewriter/Rewriter/Reify.v | 37 ++--------------------------------- 1 file changed, 2 insertions(+), 35 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 9b190989d..e988fa927 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -310,11 +310,6 @@ Module Compilers. end). Ltac2 equation_to_parts (avoid : Fresh.Free.t) (lem : constr) : constr := equation_to_parts' avoid lem '(@nil bool). - #[deprecated(since="8.15",note="Use Ltac2 instead.")] - Ltac equation_to_parts lem := - let f := ltac2:(lem - |- Control.refine (fun () => equation_to_parts (Fresh.Free.of_goal ()) (Ltac1.get_to_constr "lem" lem))) in - constr:(ltac:(f lem)). Ltac2 preadjust_pattern_type_variables (pat : constr) : constr := Reify.debug_wrap @@ -978,46 +973,18 @@ Module Compilers. end end). - #[deprecated(since="8.15",note="Use Ltac2 instead.")] - Ltac reify_to_pattern_and_replacement_in_context base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota type_ctx var gets_inlined should_do_again cur_i term value_ctx := - let f := ltac2:(base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota type_ctx var gets_inlined should_do_again cur_i term value_ctx - |- let base := Ltac1.get_to_constr "base" base in - let reify_base := fun ty => Ltac1.apply_c reify_base [ty] in - let base_interp := Ltac1.get_to_constr "base_interp" base_interp in - let base_interp_beq := Ltac1.get_to_constr "base_interp_beq" base_interp_beq in - let try_make_transport_base_cps := Ltac1.get_to_constr "try_make_transport_base_cps" try_make_transport_base_cps in - let ident := Ltac1.get_to_constr "ident" ident in - let reify_ident_opt := expr.reify_ident_opt_of_cps reify_ident in - let pident := Ltac1.get_to_constr "pident" pident in - let pident_arg_types := Ltac1.get_to_constr "pident_arg_types" pident_arg_types in - let pident_type_of_list_arg_types_beq := Ltac1.get_to_constr "pident_type_of_list_arg_types_beq" pident_type_of_list_arg_types_beq in - let pident_of_typed_ident := Ltac1.get_to_constr "pident_of_typed_ident" pident_of_typed_ident in - let pident_arg_types_of_typed_ident := Ltac1.get_to_constr "pident_arg_types_of_typed_ident" pident_arg_types_of_typed_ident in - let reflect_ident_iota := Ltac1.get_to_constr "reflect_ident_iota" reflect_ident_iota in - let type_ctx := Ltac1.get_to_constr "type_ctx" type_ctx in - let var := Ltac1.get_to_constr "var" var in - let gets_inlined := Ltac1.get_to_constr "gets_inlined" gets_inlined in - let should_do_again := Ltac1.get_to_constr "should_do_again" should_do_again in - let cur_i := Ltac1.get_to_constr "cur_i" cur_i in - let term := Ltac1.get_to_constr "term" term in - let value_ctx := Ltac1.get_to_constr "value_ctx" value_ctx in - let value_ctx := expr.value_ctx_to_list value_ctx in - Control.refine (fun () => reify_to_pattern_and_replacement_in_context base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota (Fresh.Free.of_goal ()) type_ctx var gets_inlined should_do_again cur_i term value_ctx)) in - constr:(ltac:(f base reify_base base_interp base_interp_beq try_make_transport_base_cps ident ltac:(expr.wrap_reify_ident_cps reify_ident) pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota type_ctx constr:(var) gets_inlined should_do_again cur_i term value_ctx)). - Ltac2 reify (base : constr) (reify_base : constr -> constr) (base_interp : constr) (base_interp_beq : constr) (try_make_transport_base_cps : constr) (ident : constr) (reify_ident_opt : binder list -> constr -> constr option) (pident : constr) (pident_arg_types : constr) (pident_type_of_list_arg_types_beq : constr) (pident_of_typed_ident : constr) (pident_arg_types_of_typed_ident : constr) (reflect_ident_iota : constr) (avoid : Fresh.Free.t) (var : constr) (gets_inlined : constr) (should_do_again : constr) (lem : constr) : constr := let debug_Constr_check := Reify.Constr.debug_check_strict "RewriteRules.Reify.reify" in let base_type := debug_Constr_check (fun () => mkApp '@Compilers.base.type [base]) in let base_type_interp := debug_Constr_check (fun () => mkApp '@Compilers.base.interp [base; base_interp]) in - let wrap_constr_for_perf c := '(ltac2:(Control.refine (fun () => c))) in reify_under_forall_types base_type base_type_interp avoid lem (fun avoid ty_ctx cur_i lem - => let lem := wrap_constr_for_perf (equation_to_parts avoid lem) in - let res := wrap_constr_for_perf (reify_to_pattern_and_replacement_in_context base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota avoid ty_ctx var gets_inlined should_do_again '(1%positive) lem []) in + => let lem := equation_to_parts avoid lem in + let res := reify_to_pattern_and_replacement_in_context base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota avoid ty_ctx var gets_inlined should_do_again '(1%positive) lem [] in res). #[deprecated(since="8.15",note="Use Ltac2 instead.")] Ltac reify base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota var gets_inlined should_do_again lem := From c6e6883276bbc65b301d577eaba9ff3ecbaccda7 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 19:28:28 +0530 Subject: [PATCH 65/74] Port reify_list and Reify_list to Ltac2
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m09.88s | 1411716 ko | Total Time / Peak Mem | 4m11.54s | 1417588 ko || -0m01.66s || -5872 ko | -0.66% | -0.41% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m53.79s | 1117316 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.35s | 1101004 ko || -0m01.56s || 16312 ko | -2.81% | +1.48% 0m55.77s | 1411716 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m56.16s | 1417588 ko || -0m00.38s || -5872 ko | -0.69% | -0.41% 0m54.43s | 1087008 ko | Rewriter/Rewriter/Examples.vo | 0m54.55s | 1084116 ko || -0m00.11s || 2892 ko | -0.21% | +0.26% 0m30.00s | 926684 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m29.61s | 921072 ko || +0m00.39s || 5612 ko | +1.31% | +0.60% 0m24.02s | 878908 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m24.02s | 878760 ko || +0m00.00s || 148 ko | +0.00% | +0.01% 0m16.17s | 730940 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.21s | 733188 ko || -0m00.03s || -2248 ko | -0.24% | -0.30% 0m12.13s | 638640 ko | Rewriter/Demo.vo | 0m12.13s | 639028 ko || +0m00.00s || -388 ko | +0.00% | -0.06% 0m00.82s | 472932 ko | Rewriter/Rewriter/Reify.vo | 0m00.81s | 472504 ko || +0m00.00s || 428 ko | +1.23% | +0.09% 0m00.78s | 488744 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.72s | 488532 ko || +0m00.06s || 212 ko | +8.33% | +0.04% 0m00.50s | 482280 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.51s | 482376 ko || -0m00.01s || -96 ko | -1.96% | -0.01% 0m00.50s | 480200 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.46s | 480140 ko || +0m00.03s || 60 ko | +8.69% | +0.01% 0m00.49s | 478964 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.47s | 478924 ko || +0m00.02s || 40 ko | +4.25% | +0.00% 0m00.48s | 480404 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.55s | 480428 ko || -0m00.07s || -24 ko | -12.72% | -0.00% ```

--- src/Rewriter/Rewriter/Reify.v | 88 +++++++++++++++++++++++++++-------- 1 file changed, 69 insertions(+), 19 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index e988fa927..a1e9bf5b5 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -1043,27 +1043,77 @@ Module Compilers. constr:(ltac:(f base reify_base base_interp base_interp_beq try_make_transport_base_cps ident ltac:(expr.wrap_reify_ident_cps reify_ident) pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota gets_inlined should_do_again lem)). (* lems is either a list of [Prop]s, or a list of [bool (* should_do_again *) * Prop] *) + Ltac2 reify_list (base : constr) (reify_base : constr -> constr) (base_interp : constr) (base_interp_beq : constr) (try_make_transport_base_cps : constr) (ident : constr) (reify_ident_opt : binder list -> constr -> constr option) (pident : constr) (pident_arg_types : constr) (pident_type_of_list_arg_types_beq : constr) (pident_of_typed_ident : constr) (pident_arg_types_of_typed_ident : constr) (reflect_ident_iota : constr) (var : constr) (gets_inlined : constr) (lems : constr) : constr := + let debug_Constr_check := Reify.Constr.debug_check_strict "RewriteRules.Reify.reify_list" in + let avoid := Fresh.Free.of_goal () in + let reify' := reify base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota avoid var gets_inlined in + let listT := debug_Constr_check (fun () => mkApp '@rewrite_ruleT [base; ident; var; pident; pident_arg_types]) in + let rec aux (lems : constr) : constr + := lazy_match! Std.eval_hnf lems with + | (?b, ?lem) :: ?lems + => let rlem := reify' b lem in + let rlems := aux lems in + debug_Constr_check (fun () => mkApp '@cons [listT; rlem; rlems]) + | nil => debug_Constr_check (fun () => mkApp '@nil [listT]) + | _ + => let list_map := (eval cbv delta [List.map] in '(@List.map)) in + let lems := (eval cbv beta iota in + constr:($list_map _ _ (fun p : Prop => (false, p)) $lems)) in + aux lems + end in + aux lems. + #[deprecated(since="8.15",note="Use Ltac2 instead.")] Ltac reify_list base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota var gets_inlined lems := - let reify' := reify base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota var gets_inlined in - let reify_list_rec := reify_list base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota var gets_inlined in - lazymatch (eval hnf in lems) with - | (?b, ?lem) :: ?lems - => let rlem := reify' b lem in - let rlems := reify_list_rec lems in - constr:(rlem :: rlems) - | nil => constr:(@nil (@rewrite_ruleT base ident var pident pident_arg_types)) - | _ - => let List_map := (eval cbv delta [List.map] in (@List.map)) in - let lems := (eval cbv beta iota in - (List_map _ _ (fun p : Prop => (false, p)) lems)) in - reify_list_rec lems - end. + let f := ltac2:(base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota var gets_inlined lems + |- let base := Ltac1.get_to_constr "base" base in + let reify_base := fun ty => Ltac1.apply_c reify_base [ty] in + let base_interp := Ltac1.get_to_constr "base_interp" base_interp in + let base_interp_beq := Ltac1.get_to_constr "base_interp_beq" base_interp_beq in + let try_make_transport_base_cps := Ltac1.get_to_constr "try_make_transport_base_cps" try_make_transport_base_cps in + let ident := Ltac1.get_to_constr "ident" ident in + let reify_ident_opt := expr.reify_ident_opt_of_cps reify_ident in + let pident := Ltac1.get_to_constr "pident" pident in + let pident_arg_types := Ltac1.get_to_constr "pident_arg_types" pident_arg_types in + let pident_type_of_list_arg_types_beq := Ltac1.get_to_constr "pident_type_of_list_arg_types_beq" pident_type_of_list_arg_types_beq in + let pident_of_typed_ident := Ltac1.get_to_constr "pident_of_typed_ident" pident_of_typed_ident in + let pident_arg_types_of_typed_ident := Ltac1.get_to_constr "pident_arg_types_of_typed_ident" pident_arg_types_of_typed_ident in + let reflect_ident_iota := Ltac1.get_to_constr "reflect_ident_iota" reflect_ident_iota in + let var := Ltac1.get_to_constr "var" var in + let gets_inlined := Ltac1.get_to_constr "gets_inlined" gets_inlined in + let lems := Ltac1.get_to_constr "lems" lems in + Control.refine (fun () => reify_list base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota var gets_inlined lems)) in + constr:(ltac:(f base reify_base base_interp base_interp_beq try_make_transport_base_cps ident ltac:(expr.wrap_reify_ident_cps reify_ident) pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota constr:(var) gets_inlined lems)). - Ltac Reify_list base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota gets_inlined lems := - let var := fresh "var" in - constr:(fun var : Compilers.type.type (Compilers.base.type base) -> Type - => ltac:(let res := reify_list base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota var (gets_inlined var) lems in - exact res)). + Ltac2 _Reify_list (base : constr) (reify_base : constr -> constr) (base_interp : constr) (base_interp_beq : constr) (try_make_transport_base_cps : constr) (ident : constr) (reify_ident_opt : binder list -> constr -> constr option) (pident : constr) (pident_arg_types : constr) (pident_type_of_list_arg_types_beq : constr) (pident_of_typed_ident : constr) (pident_arg_types_of_typed_ident : constr) (reflect_ident_iota : constr) (gets_inlined : constr) (lems : constr) : constr := + let debug_Constr_check := Reify.Constr.debug_check_strict "RewriteRules.Reify._Reify_list" in + Constr.in_fresh_context_avoiding + @var true None [Constr.Binder.make None '(Compilers.type.type (Compilers.base.type $base) -> Type)] + (fun ns + => let (var, _) := List.nth ns 0 in + let var := mkVar var in + let res := reify_list base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota var (debug_Constr_check (fun () => mkApp gets_inlined [var])) lems in + Control.refine (fun () => res)). + + #[deprecated(since="8.15",note="Use Ltac2 instead.")] + Ltac Reify_list base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota gets_inlined lems := + let f := ltac2:(base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota gets_inlined lems + |- let base := Ltac1.get_to_constr "base" base in + let reify_base := fun ty => Ltac1.apply_c reify_base [ty] in + let base_interp := Ltac1.get_to_constr "base_interp" base_interp in + let base_interp_beq := Ltac1.get_to_constr "base_interp_beq" base_interp_beq in + let try_make_transport_base_cps := Ltac1.get_to_constr "try_make_transport_base_cps" try_make_transport_base_cps in + let ident := Ltac1.get_to_constr "ident" ident in + let reify_ident_opt := expr.reify_ident_opt_of_cps reify_ident in + let pident := Ltac1.get_to_constr "pident" pident in + let pident_arg_types := Ltac1.get_to_constr "pident_arg_types" pident_arg_types in + let pident_type_of_list_arg_types_beq := Ltac1.get_to_constr "pident_type_of_list_arg_types_beq" pident_type_of_list_arg_types_beq in + let pident_of_typed_ident := Ltac1.get_to_constr "pident_of_typed_ident" pident_of_typed_ident in + let pident_arg_types_of_typed_ident := Ltac1.get_to_constr "pident_arg_types_of_typed_ident" pident_arg_types_of_typed_ident in + let reflect_ident_iota := Ltac1.get_to_constr "reflect_ident_iota" reflect_ident_iota in + let gets_inlined := Ltac1.get_to_constr "gets_inlined" gets_inlined in + let lems := Ltac1.get_to_constr "lems" lems in + Control.refine (fun () => _Reify_list base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota gets_inlined lems)) in + constr:(ltac:(f base reify_base base_interp base_interp_beq try_make_transport_base_cps ident ltac:(expr.wrap_reify_ident_cps reify_ident) pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota gets_inlined lems)). End Reify. Module Make. From ead2b9bfa1f7d277800bed5a5eb6bf624a254083 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 19:29:17 +0530 Subject: [PATCH 66/74] Remove dead code
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m12.25s | 1411728 ko | Total Time / Peak Mem | 4m11.12s | 1411528 ko || +0m01.12s || 200 ko | +0.44% | +0.01% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m55.94s | 1411728 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m55.99s | 1411528 ko || -0m00.05s || 200 ko | -0.08% | +0.01% 0m55.39s | 1117372 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.19s | 1117284 ko || +0m00.20s || 88 ko | +0.36% | +0.00% 0m54.36s | 1086812 ko | Rewriter/Rewriter/Examples.vo | 0m54.54s | 1086920 ko || -0m00.17s || -108 ko | -0.33% | -0.00% 0m30.72s | 926740 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m29.87s | 926724 ko || +0m00.84s || 16 ko | +2.84% | +0.00% 0m23.98s | 878848 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.90s | 879060 ko || +0m00.08s || -212 ko | +0.33% | -0.02% 0m16.18s | 730992 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.11s | 730812 ko || +0m00.07s || 180 ko | +0.43% | +0.02% 0m12.15s | 638696 ko | Rewriter/Demo.vo | 0m12.10s | 638660 ko || +0m00.05s || 36 ko | +0.41% | +0.00% 0m00.76s | 472832 ko | Rewriter/Rewriter/Reify.vo | 0m00.78s | 472760 ko || -0m00.02s || 72 ko | -2.56% | +0.01% 0m00.74s | 488664 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.78s | 488752 ko || -0m00.04s || -88 ko | -5.12% | -0.01% 0m00.54s | 482156 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.50s | 482304 ko || +0m00.04s || -148 ko | +8.00% | -0.03% 0m00.53s | 478960 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.47s | 478860 ko || +0m00.06s || 100 ko | +12.76% | +0.02% 0m00.48s | 480460 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.45s | 480404 ko || +0m00.02s || 56 ko | +6.66% | +0.01% 0m00.48s | 480556 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.45s | 480168 ko || +0m00.02s || 388 ko | +6.66% | +0.08% ```

--- src/Rewriter/Rewriter/Reify.v | 30 ------------------------------ 1 file changed, 30 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index a1e9bf5b5..33f0e61ab 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -258,14 +258,6 @@ Module Compilers. Ltac2 reify_under_forall_types (base_type : constr) (base_type_interp : constr) (avoid : Fresh.Free.t) (lem : constr) (cont : Fresh.Free.t -> constr (* ty_ctx *) -> constr (* cur_i *) -> constr (* lem *) -> constr) : constr := '(ltac2:(refine_reify_under_forall_types base_type base_type_interp avoid lem (fun avoid ty_ctx cur_i lem => Control.refine (fun () => cont avoid ty_ctx cur_i lem)))). - #[deprecated(since="8.15",note="Use Ltac2 instead.")] - Ltac reify_under_forall_types base_type base_type_interp lem cont := - let f := ltac2:(base_type base_type_interp lem cont - |- let cont avoid ty_ctx cur_i lem - := Ltac1.apply cont [Ltac1.of_constr ty_ctx; Ltac1.of_constr cur_i; Ltac1.of_constr lem] Ltac1.run in - refine_reify_under_forall_types (Ltac1.get_to_constr "base_type" base_type) (Ltac1.get_to_constr "base_type_interp" base_type_interp) (Fresh.Free.of_goal ()) (Ltac1.get_to_constr "lem" lem) cont) in - constr:(ltac:(f base_type base_type_interp lem ltac:(fun ty_ctx cur_i lem => let v := cont ty_ctx cur_i lem in refine v))). - (* uses typeclass resolution *) Ltac2 prop_to_bool (h : constr) : constr := eval cbv [decb] in constr:(decb $h). @@ -346,11 +338,6 @@ Module Compilers. Ltac2 adjust_pattern_type_variables (pat : constr) : constr := let pat := preadjust_pattern_type_variables pat in adjust_pattern_type_variables' pat. - #[deprecated(since="8.15",note="Use Ltac2 instead.")] - Ltac adjust_pattern_type_variables pat := - let f := ltac2:(pat - |- Control.refine (fun () => adjust_pattern_type_variables (Ltac1.get_to_constr "pat" pat))) in - constr:(ltac:(f pat)). (* this is fancy but probably too complicated to maintain *) Ltac2 walk_term_under_binders_fail_invalid_fast (term : constr) (free : Fresh.Free.t) (invalid : ident) (fv : constr) : unit := @@ -521,12 +508,6 @@ Module Compilers. end end. - #[deprecated(since="8.15",note="Use Ltac2 instead.")] - Ltac strip_invalid_or_fail term := - let f := ltac2:(term - |- Control.refine (fun () => strip_invalid_or_fail (Ltac1.get_to_constr "term" term))) in - constr:(ltac:(f term)). - Definition pattern_base_subst_default_relax' {base} t evm P := @pattern.base.subst_default_relax base P t evm. Definition pattern_base_unsubst_default_relax' {base} t evm P @@ -548,12 +529,6 @@ Module Compilers. (debug_Constr_check (fun () => mkApp f ['@pattern_base_subst_default_relax'_reordered; '@pattern_base_unsubst_default_relax'_reordered]))) end). - #[deprecated(since="8.15",note="Use Ltac2 instead.")] - Ltac change_pattern_base_subst_default_relax term := - let f := ltac2:(term - |- Control.refine (fun () => change_pattern_base_subst_default_relax (Ltac1.get_to_constr "term" term))) in - constr:(ltac:(f term)). - Definition pattern_base_subst_default_reordered base p evm := @pattern.base.subst_default base (pattern.base.type.var p) evm. Ltac2 adjust_lookup_default (rewr : constr) : constr := @@ -567,11 +542,6 @@ Module Compilers. => (eval cbv beta delta [pattern_base_subst_default_reordered] in (debug_Constr_check (fun () => mkApp rewr ['@pattern_base_subst_default_reordered]))) end). - #[deprecated(since="8.15",note="Use Ltac2 instead.")] - Ltac adjust_lookup_default rewr := - let f := ltac2:(rewr - |- Control.refine (fun () => adjust_lookup_default (Ltac1.get_to_constr "rewr" rewr))) in - constr:(ltac:(f rewr)). Ltac2 rec replace_evar_map (evm : constr) (rewr : constr) : constr := Reify.debug_wrap From 57402185952c3c1f82e3a88465bf4cf2d83a1502 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 19:33:25 +0530 Subject: [PATCH 67/74] Refactor reify_package usage to make porting to Ltac2 easier
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m12.29s | 1411708 ko | Total Time / Peak Mem | 4m12.70s | 1411656 ko || -0m00.40s || 52 ko | -0.15% | +0.00% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m55.90s | 1411708 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m56.16s | 1411656 ko || -0m00.25s || 52 ko | -0.46% | +0.00% 0m55.39s | 1117492 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.21s | 1117464 ko || +0m00.17s || 28 ko | +0.32% | +0.00% 0m54.37s | 1086928 ko | Rewriter/Rewriter/Examples.vo | 0m54.56s | 1086896 ko || -0m00.19s || 32 ko | -0.34% | +0.00% 0m30.66s | 926596 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.82s | 926720 ko || -0m00.16s || -124 ko | -0.51% | -0.01% 0m24.04s | 878928 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.99s | 878980 ko || +0m00.05s || -52 ko | +0.20% | -0.00% 0m16.19s | 730772 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.26s | 730912 ko || -0m00.07s || -140 ko | -0.43% | -0.01% 0m12.14s | 638880 ko | Rewriter/Demo.vo | 0m12.08s | 638800 ko || +0m00.06s || 80 ko | +0.49% | +0.01% 0m00.80s | 472764 ko | Rewriter/Rewriter/Reify.vo | 0m00.85s | 472736 ko || -0m00.04s || 28 ko | -5.88% | +0.00% 0m00.78s | 488664 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.78s | 488640 ko || +0m00.00s || 24 ko | +0.00% | +0.00% 0m00.55s | 482404 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.52s | 482160 ko || +0m00.03s || 244 ko | +5.76% | +0.05% 0m00.52s | 480364 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.48s | 480300 ko || +0m00.04s || 64 ko | +8.33% | +0.01% 0m00.50s | 478968 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.50s | 478960 ko || +0m00.00s || 8 ko | +0.00% | +0.00% 0m00.46s | 480432 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.49s | 480432 ko || -0m00.02s || 0 ko | -6.12% | +0.00% ```

--- src/Rewriter/Rewriter/Reify.v | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 33f0e61ab..be6c4380f 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -1416,7 +1416,9 @@ Module Compilers. all_rewrite_rules. End AdjustRewriteRulesForReduction. - Ltac Reify reify_base reify_ident exprInfo exprExtraInfo pkg ident_is_var_like include_interp specs := + Ltac Reify reify_package exprInfo exprExtraInfo pkg ident_is_var_like include_interp specs := + let reify_base := Basic.Tactic.reify_base_via_reify_package reify_package in + let reify_ident := Basic.Tactic.reify_ident_via_reify_package reify_package in let exprInfo := (eval hnf in exprInfo) in let exprExtraInfo := (eval hnf in exprExtraInfo) in let pkg := (eval hnf in pkg) in @@ -1576,11 +1578,7 @@ Module Compilers. let invert_bind_args_unknown := lazymatch (eval hnf in pkg) with {| invert_bind_args_unknown := ?v |} => v end in let pident_unify_unknown := lazymatch (eval hnf in pkg) with {| unify_unknown := ?v |} => v end in let __ := debug1 ltac:(fun _ => idtac "Reifying...") in - let specs_lems := - let reify_base := Basic.Tactic.reify_base_via_reify_package reify_package in - let reify_ident := Basic.Tactic.reify_ident_via_reify_package reify_package in - - Reify reify_base reify_ident exprInfo exprExtraInfo pkg ident_is_var_like include_interp specs in + let specs_lems := Reify reify_package exprInfo exprExtraInfo pkg ident_is_var_like include_interp specs in let dummy_count := lazymatch specs_lems with (?n, ?specs, ?lems) => n end in let specs := lazymatch specs_lems with (?n, ?specs, ?lems) => specs end in let rewrite_rules := lazymatch specs_lems with (?n, ?specs, ?lems) => lems end in From 212e695d927f581c50c1a03156b30af3e2b69f0b Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Mon, 26 Sep 2022 19:51:34 +0530 Subject: [PATCH 68/74] Finish porting pattern / rewrite reification to Ltac2
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m12.43s | 1403492 ko | Total Time / Peak Mem | 4m12.36s | 1411680 ko || +0m00.06s || -8188 ko | +0.02% | -0.58% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m56.05s | 1403492 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m56.00s | 1411680 ko || +0m00.04s || -8188 ko | +0.08% | -0.58% 0m55.10s | 1109680 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.43s | 1117320 ko || -0m00.32s || -7640 ko | -0.59% | -0.68% 0m54.31s | 1071436 ko | Rewriter/Rewriter/Examples.vo | 0m54.40s | 1086872 ko || -0m00.08s || -15436 ko | -0.16% | -1.42% 0m30.93s | 924452 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.72s | 926624 ko || +0m00.21s || -2172 ko | +0.68% | -0.23% 0m24.07s | 892220 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.97s | 879020 ko || +0m00.10s || 13200 ko | +0.41% | +1.50% 0m16.16s | 739700 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.20s | 730816 ko || -0m00.03s || 8884 ko | -0.24% | +1.21% 0m12.18s | 639248 ko | Rewriter/Demo.vo | 0m12.06s | 638600 ko || +0m00.11s || 648 ko | +0.99% | +0.10% 0m00.83s | 472988 ko | Rewriter/Rewriter/Reify.vo | 0m00.84s | 472936 ko || -0m00.01s || 52 ko | -1.19% | +0.01% 0m00.80s | 488748 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.77s | 488716 ko || +0m00.03s || 32 ko | +3.89% | +0.00% 0m00.55s | 482412 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.52s | 482280 ko || +0m00.03s || 132 ko | +5.76% | +0.02% 0m00.50s | 480096 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.46s | 480432 ko || +0m00.03s || -336 ko | +8.69% | -0.06% 0m00.48s | 478972 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.52s | 478852 ko || -0m00.04s || 120 ko | -7.69% | +0.02% 0m00.47s | 480392 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.47s | 480252 ko || +0m00.00s || 140 ko | +0.00% | +0.02% ```

--- src/Rewriter/Rewriter/Reify.v | 78 +++++++++++++++++++---------------- 1 file changed, 43 insertions(+), 35 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index be6c4380f..938f6a27e 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -1090,10 +1090,10 @@ Module Compilers. Export Rewriter.Compilers.RewriteRules.Make. Import pattern.ident.GoalType. - Ltac build_pident_pair exprExtraInfo pkg := + Ltac2 build_pident_pair (exprExtraInfo : constr) (pkg : constr) : constr := let v := (eval vm_compute in - (fun A B => @of_typed_ident_of pkg _ (@ident.ident_pair _ _ _ (@Classes.buildIdent _ exprExtraInfo) A B))) in - let h := lazymatch v with fun A B => ?f _ _ => f end in + constr:(match $pkg, $exprExtraInfo return _ with pkg, exprExtraInfo => fun A B => @of_typed_ident_of pkg _ (@ident.ident_pair _ _ _ (@Classes.buildIdent _ exprExtraInfo) A B) end)) in + let h := lazy_match! v with fun A B => ?f _ _ => f end in h. Section make_rewrite_rules. Import Compile. @@ -1347,20 +1347,20 @@ Module Compilers. End bundled. End make_rewrite_rules. - Ltac build_interp_rewrite_rules exprInfo exprExtraInfo pkg := - let exprInfo := (eval hnf in exprInfo) in - let exprExtraInfo := (eval hnf in exprExtraInfo) in + Ltac2 build_interp_rewrite_rules (exprInfo : constr) (exprExtraInfo : constr) (pkg : constr) : constr := + let exprInfo := Std.eval_hnf exprInfo in + let exprExtraInfo := Std.eval_hnf exprExtraInfo in let pident_pair := build_pident_pair exprExtraInfo pkg in - let ident_interp := (eval cbv [Classes.ident_interp] in (@Classes.ident_interp exprInfo)) in - let ident_interp_head := head ident_interp in - let base_interp_beq := (eval cbv [Classes.base_interp_beq] in (@Classes.base_interp_beq exprInfo exprExtraInfo)) in - let base_interp_beq_head := head base_interp_beq in - let x := fresh "x" in - let v := (eval cbv -[ident_interp_head ident.smart_Literal base_interp_beq_head] in - (fun var - => @interp_rewrite_rules_folded - exprInfo exprExtraInfo pkg var pident_pair (fun evm t x => Datatypes.fst x))) in - let v := (eval cbv [ident_interp_head ident.smart_Literal ident.ident_Literal ident.ident_tt ident.ident_pair] in v) in + let ident_interp := (eval cbv [Classes.ident_interp] in '(@Classes.ident_interp $exprInfo)) in + let ident_interp_head := head_reference ident_interp in + let base_interp_beq := (eval cbv [Classes.base_interp_beq] in '(@Classes.base_interp_beq $exprInfo $exprExtraInfo)) in + let base_interp_beq_head := head_reference base_interp_beq in + let v := (eval cbv -[$ident_interp_head ident.smart_Literal $base_interp_beq_head] in + constr:(match @interp_rewrite_rules_folded $exprInfo $exprExtraInfo $pkg, $pident_pair return _ with + | h, pident_pair + => fun var => h var pident_pair (fun evm t x => Datatypes.fst x) + end)) in + let v := (eval cbv [$ident_interp_head ident.smart_Literal ident.ident_Literal ident.ident_tt ident.ident_pair] in $v) in v. Module Import AdjustRewriteRulesForReduction. @@ -1416,13 +1416,13 @@ Module Compilers. all_rewrite_rules. End AdjustRewriteRulesForReduction. - Ltac Reify reify_package exprInfo exprExtraInfo pkg ident_is_var_like include_interp specs := + Ltac2 _Reify (reify_package : constr) (exprInfo : constr) (exprExtraInfo : constr) (pkg : constr) (ident_is_var_like : constr) (include_interp : constr) (specs : constr) : constr := let reify_base := Basic.Tactic.reify_base_via_reify_package reify_package in - let reify_ident := Basic.Tactic.reify_ident_via_reify_package reify_package in - let exprInfo := (eval hnf in exprInfo) in - let exprExtraInfo := (eval hnf in exprExtraInfo) in - let pkg := (eval hnf in pkg) in - lazymatch constr:((exprInfo, exprExtraInfo, pkg)) with + let reify_ident := Basic.Tactic.reify_ident_via_reify_package_opt reify_package in + let exprInfo := Std.eval_hnf exprInfo in + let exprExtraInfo := Std.eval_hnf exprExtraInfo in + let pkg := Std.eval_hnf pkg in + lazy_match! constr:(($exprInfo, $exprExtraInfo, $pkg)) with | ({| Classes.base := ?base ; Classes.ident := ?ident ; Classes.base_interp := ?base_interp @@ -1443,24 +1443,32 @@ Module Compilers. ; of_typed_ident_unfolded := ?of_typed_ident_unfolded ; arg_types_of_typed_ident_unfolded := ?arg_types_of_typed_ident_unfolded |}) - => let base_type := constr:(Compilers.base.type base) in - let reflect_ident_iota := constr:(@Compile.reflect_ident_iota base ident base_interp baseTypeHasNat buildIdent buildEagerIdent toRestrictedIdent toFromRestrictedIdent invertIdent baseHasNatCorrect try_make_transport_base_cps) in - let lems := Reify.Reify_list base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pattern_ident arg_types_unfolded type_of_list_arg_types_beq_unfolded of_typed_ident_unfolded arg_types_of_typed_ident_unfolded reflect_ident_iota (fun var t => @SubstVarLike.is_recursively_var_or_ident base_type ident var ident_is_var_like (type.base t)) specs in - lazymatch include_interp with + => let base_type := constr:(@Compilers.base.type $base) in + let reflect_ident_iota := constr:(@Compile.reflect_ident_iota $base $ident $base_interp $baseTypeHasNat $buildIdent $buildEagerIdent $toRestrictedIdent $toFromRestrictedIdent $invertIdent $baseHasNatCorrect $try_make_transport_base_cps) in + let lems := Reify._Reify_list base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident pattern_ident arg_types_unfolded type_of_list_arg_types_beq_unfolded of_typed_ident_unfolded arg_types_of_typed_ident_unfolded reflect_ident_iota (constr:(match $base_type, $ident, $ident_is_var_like return _ with base_type', ident', ident_is_var_like' => fun var t => @SubstVarLike.is_recursively_var_or_ident base_type' ident' var ident_is_var_like' (type.base t) end)) specs in + lazy_match! include_interp with | true - => let myapp := (eval cbv [List.app] in (@List.app)) in + => let myapp := (eval cbv [Datatypes.app] in '(@Datatypes.app)) in let interp_rewrite_rules := build_interp_rewrite_rules exprInfo exprExtraInfo pkg in let res := (eval cbv beta iota in - (fun var => myapp _ (@interp_rewrite_rules var) (lems var))) in - let len := lazymatch (eval compute in (fun var => List.length (@interp_rewrite_rules var))) with (fun _ => ?n) => n end in - let adjusted_specs := (eval cbv [List.app List.repeat] in - (List.app - (List.repeat (false, forall A (x : A), x = x) len))) in - constr:((len, adjusted_specs specs, res)) - | false => constr:((O, specs, lems)) - | _ => constr_fail_with ltac:(fun _ => fail 1 "Invalid value for include_interp (must be either true or false):" include_interp) + constr:(match $myapp, $interp_rewrite_rules, $lems return _ with + | myapp', interp_rewrite_rules', lems' + => fun var => myapp' _ (@interp_rewrite_rules' var) (lems' var) + end)) in + let len := lazy_match! (eval cbv in constr:(match $interp_rewrite_rules return _ with interp_rewrite_rules' => fun var => List.length (interp_rewrite_rules' var) end)) with (fun _ => ?n) => n end in + let adjusted_specs := (eval cbv [Datatypes.app List.repeat] in + constr:(List.app + (List.repeat (false, forall A (x : A), x = x) $len))) in + constr:(($len, $adjusted_specs $specs, $res)) + | false => constr:((O, $specs, $lems)) + | _ => Control.throw (Reification_panic (fprintf "Invalid value for include_interp (must be either true or false): %t" include_interp)) end end. + (* Note that this one doesn't need to be deprecated, because it doesn't incur much overhead *) + Ltac Reify reify_package exprInfo exprExtraInfo pkg ident_is_var_like include_interp specs := + let f := ltac2:(reify_package exprInfo exprExtraInfo pkg ident_is_var_like include_interp specs + |- Control.refine (fun () => _Reify (Ltac1.get_to_constr "reify_package" reify_package) (Ltac1.get_to_constr "exprInfo" exprInfo) (Ltac1.get_to_constr "exprExtraInfo" exprExtraInfo) (Ltac1.get_to_constr "pkg" pkg) (Ltac1.get_to_constr "ident_is_var_like" ident_is_var_like) (Ltac1.get_to_constr "include_interp" include_interp) (Ltac1.get_to_constr "specs" specs))) in + constr:(ltac:(f reify_package exprInfo exprExtraInfo pkg ident_is_var_like include_interp specs)). Ltac make_rewrite_head1 base_interp try_make_transport_base_cps base_beq pident_unify_unknown invert_bind_args_unknown rewrite_head0 pr2_rewrite_rules := time_tac_in_constr_if_debug1 From 0e454c22fb54787537694e8bdc4066668fc7a912 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sun, 2 Oct 2022 11:02:49 +0530 Subject: [PATCH 69/74] Localize checking and making of constrs in reify_to_pattern_and_replacement_in_context
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m12.58s | 1391156 ko | Total Time / Peak Mem | 4m12.87s | 1403688 ko || -0m00.29s || -12532 ko | -0.11% | -0.89% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m56.27s | 1391156 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m56.44s | 1403688 ko || -0m00.16s || -12532 ko | -0.30% | -0.89% 0m55.45s | 1114708 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.48s | 1109836 ko || -0m00.02s || 4872 ko | -0.05% | +0.43% 0m54.40s | 1060832 ko | Rewriter/Rewriter/Examples.vo | 0m54.33s | 1071412 ko || +0m00.07s || -10580 ko | +0.12% | -0.98% 0m30.64s | 923080 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.81s | 924400 ko || -0m00.16s || -1320 ko | -0.55% | -0.14% 0m23.98s | 885256 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.93s | 892216 ko || +0m00.05s || -6960 ko | +0.20% | -0.78% 0m16.16s | 738648 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.18s | 739700 ko || -0m00.01s || -1052 ko | -0.12% | -0.14% 0m12.08s | 638780 ko | Rewriter/Demo.vo | 0m12.12s | 639276 ko || -0m00.03s || -496 ko | -0.33% | -0.07% 0m00.84s | 472928 ko | Rewriter/Rewriter/Reify.vo | 0m00.82s | 472892 ko || +0m00.02s || 36 ko | +2.43% | +0.00% 0m00.72s | 488656 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.74s | 488800 ko || -0m00.02s || -144 ko | -2.70% | -0.02% 0m00.52s | 482248 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.52s | 482260 ko || +0m00.00s || -12 ko | +0.00% | -0.00% 0m00.52s | 480288 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.55s | 480344 ko || -0m00.03s || -56 ko | -5.45% | -0.01% 0m00.50s | 480540 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.44s | 480488 ko || +0m00.06s || 52 ko | +13.63% | +0.01% 0m00.50s | 479036 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.52s | 478848 ko || -0m00.02s || 188 ko | -3.84% | +0.03% ```

--- src/Rewriter/Rewriter/Reify.v | 38 +++++++++++++++++------------------ 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 938f6a27e..4e0970483 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -835,25 +835,7 @@ Module Compilers. => let debug_Constr_check := Reify.Constr.debug_check_strict "reify_to_pattern_and_replacement_in_context" in let base_type := debug_Constr_check (fun () => mkApp 'base.type [base]) in let reify_base_type := Compilers.base.reify base reify_base in - let base_interp_head := head_reference base_interp in let reify_rec_gen avoid := reify_to_pattern_and_replacement_in_context base reify_base base_interp base_interp_beq try_make_transport_base_cps ident reify_ident_opt pident pident_arg_types pident_type_of_list_arg_types_beq pident_of_typed_ident pident_arg_types_of_typed_ident reflect_ident_iota avoid type_ctx var gets_inlined should_do_again in - let var_pos := '(fun _ : type $base_type => positive) in - let value := debug_Constr_check (fun () => mkApp '@value [base_type; ident; var]) in - let cexpr_to_pattern_and_replacement_unfolded := debug_Constr_check (fun () => mkApp '@expr_to_pattern_and_replacement_unfolded [base; try_make_transport_base_cps; ident; var; pident; pident_arg_types; pident_type_of_list_arg_types_beq; pident_of_typed_ident; pident_arg_types_of_typed_ident; mkApp reflect_ident_iota [var]; gets_inlined; should_do_again; type_ctx]) in - let cpartial_lam_unif_rewrite_ruleTP_gen := debug_Constr_check (fun () => mkApp '@partial_lam_unif_rewrite_ruleTP_gen_unfolded [base; ident; var; pident; pident_arg_types; should_do_again]) in - let check name c - := let c := debug_Constr_check c in - match Constr.Unsafe.check c with - | Val c => c - | Err err => Control.throw (Reification_panic (fprintf "reify_to_pattern_and_replacement_in_context: Could not make %s from %t: %a" name c (fun () => Message.of_exn) err)) - end in - let cwith_unif_rewrite_ruleTP_gen - := let tb := Constr.Binder.make (Some @t) (debug_Constr_check (fun () => mkApp '@type.type [mkApp '@pattern.base.type.type [base] ])) in - (* can't check this one, it's not under binders *) - let pb := Constr.Binder.make (Some @p) (mkApp '@pattern.pattern [base; pident; mkRel 1]) in - let t := mkRel 2 in - let p := mkRel 1 in - debug_Constr_check (fun () => mkLambda tb (mkLambda pb (mkApp '@with_unif_rewrite_ruleTP_gen [base; ident; var; pident; pident_arg_types; value; t; p; should_do_again; 'true; 'true]))) in match Constr.Unsafe.kind_nocast term with | Constr.Unsafe.Lambda xb f => let t := Constr.Binder.type xb in @@ -873,7 +855,25 @@ Module Compilers. | _ => lazy_match! term with | (@eq ?t ?a ?b, ?side_conditions) - => let rA := expr.reify_in_context base_type ident reify_base_type reify_ident_opt var_pos a [] [] value_ctx [] None in + => let base_interp_head := head_reference base_interp in + let var_pos := '(fun _ : type $base_type => positive) in + let cexpr_to_pattern_and_replacement_unfolded := debug_Constr_check (fun () => mkApp '@expr_to_pattern_and_replacement_unfolded [base; try_make_transport_base_cps; ident; var; pident; pident_arg_types; pident_type_of_list_arg_types_beq; pident_of_typed_ident; pident_arg_types_of_typed_ident; mkApp reflect_ident_iota [var]; gets_inlined; should_do_again; type_ctx]) in + let cpartial_lam_unif_rewrite_ruleTP_gen := debug_Constr_check (fun () => mkApp '@partial_lam_unif_rewrite_ruleTP_gen_unfolded [base; ident; var; pident; pident_arg_types; should_do_again]) in + let value := debug_Constr_check (fun () => mkApp '@value [base_type; ident; var]) in + let check name c + := let c := debug_Constr_check c in + match Constr.Unsafe.check c with + | Val c => c + | Err err => Control.throw (Reification_panic (fprintf "reify_to_pattern_and_replacement_in_context: Could not make %s from %t: %a" name c (fun () => Message.of_exn) err)) + end in + let cwith_unif_rewrite_ruleTP_gen + := let tb := Constr.Binder.make (Some @t) (debug_Constr_check (fun () => mkApp '@type.type [mkApp '@pattern.base.type.type [base] ])) in + (* can't check this one, it's not under binders *) + let pb := Constr.Binder.make (Some @p) (mkApp '@pattern.pattern [base; pident; mkRel 1]) in + let t := mkRel 2 in + let p := mkRel 1 in + debug_Constr_check (fun () => mkLambda tb (mkLambda pb (mkApp '@with_unif_rewrite_ruleTP_gen [base; ident; var; pident; pident_arg_types; value; t; p; should_do_again; 'true; 'true]))) in + let rA := expr.reify_in_context base_type ident reify_base_type reify_ident_opt var_pos a [] [] value_ctx [] None in let rB := expr.reify_in_context base_type ident reify_base_type reify_ident_opt var_pos b [] [] value_ctx [] None in let side_conditions := adjust_side_conditions_for_gets_inlined avoid value_ctx side_conditions in let res := check "res" From e81fa8d13cb8549d860d39262829601a8bc08eb0 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sun, 2 Oct 2022 11:14:08 +0530 Subject: [PATCH 70/74] Fewer evars in reify_to_pattern_and_replacement_in_context
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m11.99s | 1401964 ko | Total Time / Peak Mem | 4m12.33s | 1391168 ko || -0m00.34s || 10796 ko | -0.13% | +0.77% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m56.37s | 1401964 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m56.21s | 1391168 ko || +0m00.15s || 10796 ko | +0.28% | +0.77% 0m55.34s | 1117532 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.24s | 1114764 ko || +0m00.10s || 2768 ko | +0.18% | +0.24% 0m54.34s | 1066088 ko | Rewriter/Rewriter/Examples.vo | 0m54.39s | 1060772 ko || -0m00.04s || 5316 ko | -0.09% | +0.50% 0m30.56s | 927828 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.77s | 923048 ko || -0m00.21s || 4780 ko | -0.68% | +0.51% 0m23.45s | 885896 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.89s | 885432 ko || -0m00.44s || 464 ko | -1.84% | +0.05% 0m16.24s | 738724 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.17s | 738444 ko || +0m00.06s || 280 ko | +0.43% | +0.03% 0m12.06s | 638560 ko | Rewriter/Demo.vo | 0m12.12s | 638600 ko || -0m00.05s || -40 ko | -0.49% | -0.00% 0m00.84s | 472960 ko | Rewriter/Rewriter/Reify.vo | 0m00.80s | 472812 ko || +0m00.03s || 148 ko | +4.99% | +0.03% 0m00.76s | 488672 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.78s | 488728 ko || -0m00.02s || -56 ko | -2.56% | -0.01% 0m00.53s | 480420 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.54s | 480488 ko || -0m00.01s || -68 ko | -1.85% | -0.01% 0m00.51s | 480520 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.44s | 480308 ko || +0m00.07s || 212 ko | +15.90% | +0.04% 0m00.50s | 478976 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.47s | 478980 ko || +0m00.03s || -4 ko | +6.38% | -0.00% 0m00.49s | 482408 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.51s | 482376 ko || -0m00.02s || 32 ko | -3.92% | +0.00% ```

--- src/Rewriter/Rewriter/Reify.v | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 4e0970483..db27be158 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -873,6 +873,7 @@ Module Compilers. let t := mkRel 2 in let p := mkRel 1 in debug_Constr_check (fun () => mkLambda tb (mkLambda pb (mkApp '@with_unif_rewrite_ruleTP_gen [base; ident; var; pident; pident_arg_types; value; t; p; should_do_again; 'true; 'true]))) in + let rT := Compilers.type.reify reify_base_type base_type t in let rA := expr.reify_in_context base_type ident reify_base_type reify_ident_opt var_pos a [] [] value_ctx [] None in let rB := expr.reify_in_context base_type ident reify_base_type reify_ident_opt var_pos b [] [] value_ctx [] None in let side_conditions := adjust_side_conditions_for_gets_inlined avoid value_ctx side_conditions in @@ -880,7 +881,7 @@ Module Compilers. (fun () => mkLambda (* Hack around COQBUG(https://github.com/coq/coq/issues/16419) *) (Constr.Binder.make (Some @invalid) '(match _ return Type with ev => ev end)) - (mkApp cexpr_to_pattern_and_replacement_unfolded [mkRel 1; '_; rA; rB; side_conditions])) in + (mkApp cexpr_to_pattern_and_replacement_unfolded [mkRel 1; rT; rA; rB; side_conditions])) in let res := let pident_arg_types := head_reference pident_arg_types in let pident_of_typed_ident := head_reference pident_of_typed_ident in let pident_type_of_list_arg_types_beq := head_reference pident_type_of_list_arg_types_beq in From 71205a583fa159e6f317d8a8e57a10fe780d04ba Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sun, 2 Oct 2022 12:17:02 +0530 Subject: [PATCH 71/74] reify_to_pattern_and_replacement_in_context: Move existT lifting to a definition
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m09.42s | 1385680 ko | Total Time / Peak Mem | 4m12.82s | 1402076 ko || -0m03.40s || -16396 ko | -1.34% | -1.16% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m29.34s | 927564 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.72s | 927828 ko || -0m01.37s || -264 ko | -4.49% | -0.02% 0m55.80s | 1385680 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m56.29s | 1402076 ko || -0m00.49s || -16396 ko | -0.87% | -1.16% 0m54.91s | 1139380 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.52s | 1117564 ko || -0m00.61s || 21816 ko | -1.09% | +1.95% 0m53.62s | 1101604 ko | Rewriter/Rewriter/Examples.vo | 0m54.47s | 1066148 ko || -0m00.85s || 35456 ko | -1.56% | +3.32% 0m23.84s | 876424 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m24.04s | 885908 ko || -0m00.19s || -9484 ko | -0.83% | -1.07% 0m16.11s | 729936 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.19s | 738828 ko || -0m00.08s || -8892 ko | -0.49% | -1.20% 0m12.08s | 639460 ko | Rewriter/Demo.vo | 0m12.06s | 638640 ko || +0m00.01s || 820 ko | +0.16% | +0.12% 0m00.86s | 472888 ko | Rewriter/Rewriter/Reify.vo | 0m00.83s | 472996 ko || +0m00.03s || -108 ko | +3.61% | -0.02% 0m00.82s | 488784 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.74s | 488688 ko || +0m00.07s || 96 ko | +10.81% | +0.01% 0m00.57s | 482280 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.55s | 482284 ko || +0m00.01s || -4 ko | +3.63% | -0.00% 0m00.54s | 478956 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.49s | 478804 ko || +0m00.05s || 152 ko | +10.20% | +0.03% 0m00.50s | 480408 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.47s | 480572 ko || +0m00.03s || -164 ko | +6.38% | -0.03% 0m00.43s | 480376 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.46s | 480408 ko || -0m00.03s || -32 ko | -6.52% | -0.00% ```

--- src/Rewriter/Rewriter/Reify.v | 16 +++++----------- 1 file changed, 5 insertions(+), 11 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index db27be158..1e50d3e83 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -827,6 +827,8 @@ Module Compilers. (fun () => Control.refine (fun () => adjust_side_conditions_for_gets_inlined' value_ctx side_conditions (mkVar lookup_gets_inlined))). + Definition lift_existT {X A B} (v : forall x : X, @sigT (A x) (B x)) + := Eval cbv [projT1 projT2] in existT _ (fun x => projT1 (v x)) (fun x => projT2 (v x)). Ltac2 rec reify_to_pattern_and_replacement_in_context (base : constr) (reify_base : constr -> constr) (base_interp : constr) (base_interp_beq : constr) (try_make_transport_base_cps : constr) (ident : constr) (reify_ident_opt : binder list -> constr -> constr option) (pident : constr) (pident_arg_types : constr) (pident_type_of_list_arg_types_beq : constr) (pident_of_typed_ident : constr) (pident_arg_types_of_typed_ident : constr) (reflect_ident_iota : constr) (avoid : Fresh.Free.t) (type_ctx : constr) (var : constr) (gets_inlined : constr) (should_do_again : constr) (cur_i : constr) (term : constr) (value_ctx : (ident * constr (* ty *) * constr (* var *)) list) : constr := Reify.debug_wrap "reify_to_pattern_and_replacement_in_context" Message.of_constr term @@ -889,19 +891,11 @@ Module Compilers. (eval cbv [expr_to_pattern_and_replacement_unfolded $pident_arg_types $pident_of_typed_ident $pident_type_of_list_arg_types_beq $pident_arg_types_of_typed_ident (*reflect_ident_iota*)] in res) in let res := (eval cbn [fst snd andb pattern.base.relax pattern.base.subst_default pattern.base.subst_default_relax] in res) in let res := change_pattern_base_subst_default_relax res in - let p := (eval cbv [projT1] in - (check "projT1_res" - (fun () => mkLambda (Constr.Binder.make (Some @invalid) '(match _ return Type with ev => ev end)) - (mkApp '@projT1 ['_; '_; mkApp res [mkRel 1] ])))) - (*(fun invalid => projT1 (res invalid))*) in + let (p, res) := lazy_match! (eval cbv [lift_existT] in constr:(@lift_existT _ _ _ $res)) with + | existT _ ?p ?res => (p, res) + end in let p := strip_invalid_or_fail p in let p := adjust_pattern_type_variables p in - (* avoid capturing invalid *) - let res := (eval cbv [projT2] in - (check "projT2_res" - (fun () => mkLambda (Constr.Binder.make (Some @invalid) '(match _ return Type with ev => ev end)) - (mkApp '@projT2 ['_; '_; mkApp res [mkRel 1] ])))) - (*(fun invalid => projT2 (res invalid))*) in let invalid := Fresh.fresh avoid @invalid in let evm' := Fresh.fresh avoid @evm' in let res () From 56b8dd5f718bfeae685a0ca2eeeb976a13c49d48 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sun, 2 Oct 2022 12:44:40 +0530 Subject: [PATCH 72/74] Fewer evars and checks in reify_to_pattern_and_replacement_in_context
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m09.62s | 1410476 ko | Total Time / Peak Mem | 4m08.49s | 1385696 ko || +0m01.13s || 24780 ko | +0.45% | +1.78% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m55.61s | 1410476 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m55.38s | 1385696 ko || +0m00.22s || 24780 ko | +0.41% | +1.78% 0m55.06s | 1106808 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m54.63s | 1139360 ko || +0m00.42s || -32552 ko | +0.78% | -2.85% 0m53.48s | 1075856 ko | Rewriter/Rewriter/Examples.vo | 0m52.55s | 1101708 ko || +0m00.92s || -25852 ko | +1.76% | -2.34% 0m30.10s | 924288 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.35s | 927632 ko || -0m00.25s || -3344 ko | -0.82% | -0.36% 0m23.77s | 884884 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.81s | 876512 ko || -0m00.03s || 8372 ko | -0.16% | +0.95% 0m15.97s | 733680 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m16.06s | 729976 ko || -0m00.08s || 3704 ko | -0.56% | +0.50% 0m12.19s | 639416 ko | Rewriter/Demo.vo | 0m12.16s | 639496 ko || +0m00.02s || -80 ko | +0.24% | -0.01% 0m00.82s | 472900 ko | Rewriter/Rewriter/Reify.vo | 0m00.85s | 472940 ko || -0m00.03s || -40 ko | -3.52% | -0.00% 0m00.76s | 488712 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.79s | 488752 ko || -0m00.03s || -40 ko | -3.79% | -0.00% 0m00.50s | 479044 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.51s | 479060 ko || -0m00.01s || -16 ko | -1.96% | -0.00% 0m00.46s | 482248 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.46s | 482256 ko || +0m00.00s || -8 ko | +0.00% | -0.00% 0m00.46s | 480464 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.46s | 480380 ko || +0m00.00s || 84 ko | +0.00% | +0.01% 0m00.45s | 480352 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.48s | 480420 ko || -0m00.02s || -68 ko | -6.24% | -0.01% ```

--- src/Rewriter/Rewriter/Reify.v | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index 1e50d3e83..f712175c3 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -862,6 +862,7 @@ Module Compilers. let cexpr_to_pattern_and_replacement_unfolded := debug_Constr_check (fun () => mkApp '@expr_to_pattern_and_replacement_unfolded [base; try_make_transport_base_cps; ident; var; pident; pident_arg_types; pident_type_of_list_arg_types_beq; pident_of_typed_ident; pident_arg_types_of_typed_ident; mkApp reflect_ident_iota [var]; gets_inlined; should_do_again; type_ctx]) in let cpartial_lam_unif_rewrite_ruleTP_gen := debug_Constr_check (fun () => mkApp '@partial_lam_unif_rewrite_ruleTP_gen_unfolded [base; ident; var; pident; pident_arg_types; should_do_again]) in let value := debug_Constr_check (fun () => mkApp '@value [base_type; ident; var]) in + let cinvalidT := '(forall A B : Type, A -> B) in let check name c := let c := debug_Constr_check c in match Constr.Unsafe.check c with @@ -879,10 +880,10 @@ Module Compilers. let rA := expr.reify_in_context base_type ident reify_base_type reify_ident_opt var_pos a [] [] value_ctx [] None in let rB := expr.reify_in_context base_type ident reify_base_type reify_ident_opt var_pos b [] [] value_ctx [] None in let side_conditions := adjust_side_conditions_for_gets_inlined avoid value_ctx side_conditions in + (* N.B. We need both check and η-expansion here to ... relax universe constraints? *) let res := check "res" (fun () => mkLambda - (* Hack around COQBUG(https://github.com/coq/coq/issues/16419) *) - (Constr.Binder.make (Some @invalid) '(match _ return Type with ev => ev end)) + (Constr.Binder.make (Some @invalid) cinvalidT) (mkApp cexpr_to_pattern_and_replacement_unfolded [mkRel 1; rT; rA; rB; side_conditions])) in let res := let pident_arg_types := head_reference pident_arg_types in let pident_of_typed_ident := head_reference pident_of_typed_ident in @@ -900,7 +901,7 @@ Module Compilers. let evm' := Fresh.fresh avoid @evm' in let res () := Constr.in_context - invalid '_ + invalid cinvalidT (fun () => Control.refine (fun () @@ -909,13 +910,13 @@ Module Compilers. (fun () => Control.refine (fun () - => (* we must check here to unify the evar in the type of invalid, lest we run into COQBUG(https://github.com/coq/coq/issues/16540) *) - let res := (eval cbv beta in (check "res invalid" (fun () => mkApp res [mkVar invalid]))) in - let res := adjust_lookup_default res in - let res := adjust_type_variables res in - let res := replace_evar_map (mkVar evm') res in - let res := replace_type_try_transport res in - res)))) in + => let res := (eval cbv beta in + (debug_Constr_check (fun () => mkApp res [mkVar invalid]))) in + let res := adjust_lookup_default res in + let res := adjust_type_variables res in + let res := replace_evar_map (mkVar evm') res in + let res := replace_type_try_transport res in + res)))) in let res := debug_Constr_check res in let res := (eval cbv [UnderLets.map UnderLets.flat_map reify_expr_beta_iota reflect_expr_beta_iota reify_to_UnderLets] in res) in let res := (eval cbn [reify reflect UnderLets.of_expr UnderLets.to_expr UnderLets.splice value' Base_value invert_Literal invert_ident_Literal splice_under_lets_with_value] in res) in From 86dc030755216e713bb37f5ba9d9902d04c77028 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sun, 2 Oct 2022 13:20:10 +0530 Subject: [PATCH 73/74] Factor out eta expansion and universes in reify_to_pattern_and_replacement_in_context
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m09.90s | 1419232 ko | Total Time / Peak Mem | 4m10.12s | 1410292 ko || -0m00.21s || 8940 ko | -0.08% | +0.63% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m55.53s | 1419232 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m55.72s | 1410292 ko || -0m00.18s || 8940 ko | -0.34% | +0.63% 0m55.05s | 1109808 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.21s | 1106772 ko || -0m00.16s || 3036 ko | -0.28% | +0.27% 0m53.62s | 1070304 ko | Rewriter/Rewriter/Examples.vo | 0m53.67s | 1075808 ko || -0m00.05s || -5504 ko | -0.09% | -0.51% 0m30.06s | 922932 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.05s | 924364 ko || +0m00.00s || -1432 ko | +0.03% | -0.15% 0m23.82s | 884980 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.90s | 884944 ko || -0m00.07s || 36 ko | -0.33% | +0.00% 0m16.06s | 735236 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.93s | 733712 ko || +0m00.12s || 1524 ko | +0.81% | +0.20% 0m12.08s | 640860 ko | Rewriter/Demo.vo | 0m12.01s | 639564 ko || +0m00.07s || 1296 ko | +0.58% | +0.20% 0m00.82s | 488740 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.73s | 488836 ko || +0m00.08s || -96 ko | +12.32% | -0.01% 0m00.79s | 472940 ko | Rewriter/Rewriter/Reify.vo | 0m00.85s | 472888 ko || -0m00.05s || 52 ko | -7.05% | +0.01% 0m00.59s | 482440 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.55s | 482292 ko || +0m00.03s || 148 ko | +7.27% | +0.03% 0m00.52s | 480480 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.51s | 480436 ko || +0m00.01s || 44 ko | +1.96% | +0.00% 0m00.48s | 480492 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.45s | 480428 ko || +0m00.02s || 64 ko | +6.66% | +0.01% 0m00.48s | 478948 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.54s | 478968 ko || -0m00.06s || -20 ko | -11.11% | -0.00% ```

--- src/Rewriter/Rewriter/Reify.v | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index f712175c3..fbf089a88 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -201,8 +201,8 @@ Module Compilers. then Some replacement else None))). - - Definition expr_to_pattern_and_replacement_unfolded gets_inlined should_do_again evm invalid {t} lhs rhs side_conditions + (** N.B. We must annotate the type of [invalid] to relax universe constraints *) + Definition expr_to_pattern_and_replacement_unfolded gets_inlined should_do_again evm {t} lhs rhs side_conditions (invalid : forall A B : Type, A -> B) := Eval cbv beta iota delta [expr_to_pattern_and_replacement lookup_expr_gets_inlined pattern_of_expr lam_unification_resultT' Pos.succ pair'_unification_resultT' PositiveMap.empty PositiveMap.fold Pos.max expr_pos_to_expr_value (* expr_value_to_rewrite_rule_replacement*) fold_left List.rev List.app value PositiveMap.add PositiveMap.xfoldi Pos.compare Pos.compare_cont FMapPositive.append projT1 projT2 PositiveMap.find Base_value (*UnderLets.map reify_expr_beta_iota reflect_expr_beta_iota*) lam_type_of_list fold_right list_rect pattern.type.relax pattern.type.subst_default pattern.type.subst_default_relax pattern.type.unsubst_default_relax option_map unification_resultT' with_unification_resultT' with_unif_rewrite_ruleTP_gen'] in @expr_to_pattern_and_replacement gets_inlined should_do_again evm invalid t lhs rhs side_conditions. @@ -863,12 +863,6 @@ Module Compilers. let cpartial_lam_unif_rewrite_ruleTP_gen := debug_Constr_check (fun () => mkApp '@partial_lam_unif_rewrite_ruleTP_gen_unfolded [base; ident; var; pident; pident_arg_types; should_do_again]) in let value := debug_Constr_check (fun () => mkApp '@value [base_type; ident; var]) in let cinvalidT := '(forall A B : Type, A -> B) in - let check name c - := let c := debug_Constr_check c in - match Constr.Unsafe.check c with - | Val c => c - | Err err => Control.throw (Reification_panic (fprintf "reify_to_pattern_and_replacement_in_context: Could not make %s from %t: %a" name c (fun () => Message.of_exn) err)) - end in let cwith_unif_rewrite_ruleTP_gen := let tb := Constr.Binder.make (Some @t) (debug_Constr_check (fun () => mkApp '@type.type [mkApp '@pattern.base.type.type [base] ])) in (* can't check this one, it's not under binders *) @@ -876,15 +870,19 @@ Module Compilers. let t := mkRel 2 in let p := mkRel 1 in debug_Constr_check (fun () => mkLambda tb (mkLambda pb (mkApp '@with_unif_rewrite_ruleTP_gen [base; ident; var; pident; pident_arg_types; value; t; p; should_do_again; 'true; 'true]))) in + let check name c + := let c := debug_Constr_check c in + match Constr.Unsafe.check c with + | Val c => c + | Err err => Control.throw (Reification_panic (fprintf "reify_to_pattern_and_replacement_in_context: Could not make %s from %t: %a" name c (fun () => Message.of_exn) err)) + end in let rT := Compilers.type.reify reify_base_type base_type t in let rA := expr.reify_in_context base_type ident reify_base_type reify_ident_opt var_pos a [] [] value_ctx [] None in let rB := expr.reify_in_context base_type ident reify_base_type reify_ident_opt var_pos b [] [] value_ctx [] None in let side_conditions := adjust_side_conditions_for_gets_inlined avoid value_ctx side_conditions in (* N.B. We need both check and η-expansion here to ... relax universe constraints? *) let res := check "res" - (fun () => mkLambda - (Constr.Binder.make (Some @invalid) cinvalidT) - (mkApp cexpr_to_pattern_and_replacement_unfolded [mkRel 1; rT; rA; rB; side_conditions])) in + (fun () => mkApp cexpr_to_pattern_and_replacement_unfolded [rT; rA; rB; side_conditions]) in let res := let pident_arg_types := head_reference pident_arg_types in let pident_of_typed_ident := head_reference pident_of_typed_ident in let pident_type_of_list_arg_types_beq := head_reference pident_type_of_list_arg_types_beq in From 499ea11a30f18a515e01f5603906f2b35b156be9 Mon Sep 17 00:00:00 2001 From: Jason Gross Date: Sun, 2 Oct 2022 13:22:48 +0530 Subject: [PATCH 74/74] Factor lift_existT into expr_to_pattern_and_replacement_unfolded{,_split} in reify_to_pattern_and_replacement_in_context
Timing Diff

``` After | Peak Mem | File Name | Before | Peak Mem || Change || Change (mem) | % Change | % Change (mem) ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 4m10.43s | 1406768 ko | Total Time / Peak Mem | 4m10.13s | 1419076 ko || +0m00.30s || -12308 ko | +0.11% | -0.86% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- 0m55.77s | 1406768 ko | Rewriter/Rewriter/Examples/PerfTesting/SieveOfEratosthenes.vo | 0m55.70s | 1419076 ko || +0m00.07s || -12308 ko | +0.12% | -0.86% 0m55.15s | 1119396 ko | Rewriter/Rewriter/Examples/PerfTesting/LiftLetsMap.vo | 0m55.30s | 1109780 ko || -0m00.14s || 9616 ko | -0.27% | +0.86% 0m53.75s | 1072204 ko | Rewriter/Rewriter/Examples.vo | 0m53.46s | 1070164 ko || +0m00.28s || 2040 ko | +0.54% | +0.19% 0m30.00s | 927484 ko | Rewriter/Rewriter/Examples/PrefixSums.vo | 0m30.08s | 923084 ko || -0m00.07s || 4400 ko | -0.26% | +0.47% 0m23.91s | 882200 ko | Rewriter/Rewriter/Examples/PerfTesting/Plus0Tree.vo | 0m23.96s | 885260 ko || -0m00.05s || -3060 ko | -0.20% | -0.34% 0m16.06s | 734968 ko | Rewriter/Rewriter/Examples/PerfTesting/UnderLetsPlus0.vo | 0m15.91s | 735200 ko || +0m00.14s || -232 ko | +0.94% | -0.03% 0m12.07s | 636716 ko | Rewriter/Demo.vo | 0m12.08s | 640800 ko || -0m00.00s || -4084 ko | -0.08% | -0.63% 0m00.85s | 475472 ko | Rewriter/Rewriter/Reify.vo | 0m00.82s | 473124 ko || +0m00.03s || 2348 ko | +3.65% | +0.49% 0m00.82s | 488764 ko | Rewriter/Rewriter/AllTactics.vo | 0m00.75s | 488668 ko || +0m00.06s || 96 ko | +9.33% | +0.01% 0m00.57s | 482324 ko | Rewriter/Rewriter/Examples/PerfTesting/Settings.vo | 0m00.48s | 482352 ko || +0m00.08s || -28 ko | +18.74% | -0.00% 0m00.56s | 480404 ko | Rewriter/Util/plugins/RewriterBuild.vo | 0m00.56s | 480516 ko || +0m00.00s || -112 ko | +0.00% | -0.02% 0m00.47s | 480232 ko | Rewriter/Util/plugins/RewriterBuildRegistry.vo | 0m00.50s | 480216 ko || -0m00.03s || 16 ko | -6.00% | +0.00% 0m00.46s | 478952 ko | Rewriter/Util/plugins/RewriterBuildRegistryImports.vo | 0m00.54s | 479076 ko || -0m00.08s || -124 ko | -14.81% | -0.02% ```

--- src/Rewriter/Rewriter/Reify.v | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/src/Rewriter/Rewriter/Reify.v b/src/Rewriter/Rewriter/Reify.v index fbf089a88..d20a8f683 100644 --- a/src/Rewriter/Rewriter/Reify.v +++ b/src/Rewriter/Rewriter/Reify.v @@ -202,9 +202,10 @@ Module Compilers. else None))). (** N.B. We must annotate the type of [invalid] to relax universe constraints *) - Definition expr_to_pattern_and_replacement_unfolded gets_inlined should_do_again evm {t} lhs rhs side_conditions (invalid : forall A B : Type, A -> B) + Definition expr_to_pattern_and_replacement_unfolded_split gets_inlined should_do_again evm {t} lhs rhs side_conditions := Eval cbv beta iota delta [expr_to_pattern_and_replacement lookup_expr_gets_inlined pattern_of_expr lam_unification_resultT' Pos.succ pair'_unification_resultT' PositiveMap.empty PositiveMap.fold Pos.max expr_pos_to_expr_value (* expr_value_to_rewrite_rule_replacement*) fold_left List.rev List.app value PositiveMap.add PositiveMap.xfoldi Pos.compare Pos.compare_cont FMapPositive.append projT1 projT2 PositiveMap.find Base_value (*UnderLets.map reify_expr_beta_iota reflect_expr_beta_iota*) lam_type_of_list fold_right list_rect pattern.type.relax pattern.type.subst_default pattern.type.subst_default_relax pattern.type.unsubst_default_relax option_map unification_resultT' with_unification_resultT' with_unif_rewrite_ruleTP_gen'] - in @expr_to_pattern_and_replacement gets_inlined should_do_again evm invalid t lhs rhs side_conditions. + in let f := fun (invalid : forall A B : Type, A -> B) => @expr_to_pattern_and_replacement gets_inlined should_do_again evm invalid t lhs rhs side_conditions in + existT _ (fun invalid => projT1 (f invalid)) (fun invalid => projT2 (f invalid)). Definition partial_lam_unif_rewrite_ruleTP_gen_unfolded should_do_again {t} p := Eval cbv beta iota delta [partial_lam_unif_rewrite_ruleTP_gen pattern.collect_vars pattern.type.lam_forall_vars partial_lam_unification_resultT pattern.type.collect_vars pattern.base.collect_vars PositiveSet.union PositiveSet.add PositiveSet.empty pattern.type.lam_forall_vars_gen List.rev PositiveSet.elements PositiveSet.xelements PositiveSet.rev PositiveSet.rev_append List.app orb fold_right PositiveMap.add PositiveMap.empty] @@ -827,8 +828,6 @@ Module Compilers. (fun () => Control.refine (fun () => adjust_side_conditions_for_gets_inlined' value_ctx side_conditions (mkVar lookup_gets_inlined))). - Definition lift_existT {X A B} (v : forall x : X, @sigT (A x) (B x)) - := Eval cbv [projT1 projT2] in existT _ (fun x => projT1 (v x)) (fun x => projT2 (v x)). Ltac2 rec reify_to_pattern_and_replacement_in_context (base : constr) (reify_base : constr -> constr) (base_interp : constr) (base_interp_beq : constr) (try_make_transport_base_cps : constr) (ident : constr) (reify_ident_opt : binder list -> constr -> constr option) (pident : constr) (pident_arg_types : constr) (pident_type_of_list_arg_types_beq : constr) (pident_of_typed_ident : constr) (pident_arg_types_of_typed_ident : constr) (reflect_ident_iota : constr) (avoid : Fresh.Free.t) (type_ctx : constr) (var : constr) (gets_inlined : constr) (should_do_again : constr) (cur_i : constr) (term : constr) (value_ctx : (ident * constr (* ty *) * constr (* var *)) list) : constr := Reify.debug_wrap "reify_to_pattern_and_replacement_in_context" Message.of_constr term @@ -859,7 +858,7 @@ Module Compilers. | (@eq ?t ?a ?b, ?side_conditions) => let base_interp_head := head_reference base_interp in let var_pos := '(fun _ : type $base_type => positive) in - let cexpr_to_pattern_and_replacement_unfolded := debug_Constr_check (fun () => mkApp '@expr_to_pattern_and_replacement_unfolded [base; try_make_transport_base_cps; ident; var; pident; pident_arg_types; pident_type_of_list_arg_types_beq; pident_of_typed_ident; pident_arg_types_of_typed_ident; mkApp reflect_ident_iota [var]; gets_inlined; should_do_again; type_ctx]) in + let cexpr_to_pattern_and_replacement_unfolded_split := debug_Constr_check (fun () => mkApp '@expr_to_pattern_and_replacement_unfolded_split [base; try_make_transport_base_cps; ident; var; pident; pident_arg_types; pident_type_of_list_arg_types_beq; pident_of_typed_ident; pident_arg_types_of_typed_ident; mkApp reflect_ident_iota [var]; gets_inlined; should_do_again; type_ctx]) in let cpartial_lam_unif_rewrite_ruleTP_gen := debug_Constr_check (fun () => mkApp '@partial_lam_unif_rewrite_ruleTP_gen_unfolded [base; ident; var; pident; pident_arg_types; should_do_again]) in let value := debug_Constr_check (fun () => mkApp '@value [base_type; ident; var]) in let cinvalidT := '(forall A B : Type, A -> B) in @@ -880,17 +879,17 @@ Module Compilers. let rA := expr.reify_in_context base_type ident reify_base_type reify_ident_opt var_pos a [] [] value_ctx [] None in let rB := expr.reify_in_context base_type ident reify_base_type reify_ident_opt var_pos b [] [] value_ctx [] None in let side_conditions := adjust_side_conditions_for_gets_inlined avoid value_ctx side_conditions in - (* N.B. We need both check and η-expansion here to ... relax universe constraints? *) + (* N.B. We need check here to ... relax universe constraints? *) let res := check "res" - (fun () => mkApp cexpr_to_pattern_and_replacement_unfolded [rT; rA; rB; side_conditions]) in + (fun () => mkApp cexpr_to_pattern_and_replacement_unfolded_split [rT; rA; rB; side_conditions]) in let res := let pident_arg_types := head_reference pident_arg_types in let pident_of_typed_ident := head_reference pident_of_typed_ident in let pident_type_of_list_arg_types_beq := head_reference pident_type_of_list_arg_types_beq in let pident_arg_types_of_typed_ident := head_reference pident_arg_types_of_typed_ident in - (eval cbv [expr_to_pattern_and_replacement_unfolded $pident_arg_types $pident_of_typed_ident $pident_type_of_list_arg_types_beq $pident_arg_types_of_typed_ident (*reflect_ident_iota*)] in res) in + (eval cbv [expr_to_pattern_and_replacement_unfolded_split $pident_arg_types $pident_of_typed_ident $pident_type_of_list_arg_types_beq $pident_arg_types_of_typed_ident (*reflect_ident_iota*)] in res) in let res := (eval cbn [fst snd andb pattern.base.relax pattern.base.subst_default pattern.base.subst_default_relax] in res) in let res := change_pattern_base_subst_default_relax res in - let (p, res) := lazy_match! (eval cbv [lift_existT] in constr:(@lift_existT _ _ _ $res)) with + let (p, res) := lazy_match! res with | existT _ ?p ?res => (p, res) end in let p := strip_invalid_or_fail p in