diff --git a/.completion/fish/fstar.exe.fish b/.completion/fish/fstar.exe.fish index 7218d1ada12..eb9f58d5ee2 100644 --- a/.completion/fish/fstar.exe.fish +++ b/.completion/fish/fstar.exe.fish @@ -12,8 +12,7 @@ complete -c fstar.exe -l print_cache_version --description "Print the version fo complete -c fstar.exe -l cmi --description "Inline across module interfaces during extraction (aka. cross-module inlining)" complete -c fstar.exe -l codegen -r --description "Generate code for further compilation to executable code, or build a compiler plugin" complete -c fstar.exe -l codegen-lib --description "namespace External runtime library (i.e. M.N.x extracts to M.N.X instead of M_N.x)" -complete -c fstar.exe -l debug --description "module_name Print lots of debugging information while checking module" -complete -c fstar.exe -l debug_level -r --description "Control the verbosity of debugging info" +complete -c fstar.exe -l debug -r --description "Control the verbosity of debugging info" complete -c fstar.exe -l defensive -r --description "Enable several internal sanity checks, useful to track bugs and report issues." complete -c fstar.exe -l dep -r --description "Output the transitive closure of the full dependency graph in three formats:" complete -c fstar.exe -l detail_errors --description "Emit a detailed error report by asking the SMT solver many queries; will take longer" diff --git a/.docker/base.Dockerfile b/.docker/base.Dockerfile index cad708d6404..1f8c7dea910 100644 --- a/.docker/base.Dockerfile +++ b/.docker/base.Dockerfile @@ -9,7 +9,8 @@ # will NOT use this file. # We always try to build against the most current ubuntu image. -FROM ubuntu:latest +# FIXME: Broken with 24.04, fixing it to 23.10 so we can keep working +FROM ubuntu:23.10 RUN apt-get update @@ -22,7 +23,6 @@ RUN apt-get -y --no-install-recommends install vim emacs # Base dependencies: opam # CI dependencies: jq (to identify F* branch) # python3 (for interactive tests) -# libicu (for .NET, cf. https://aka.ms/dotnet-missing-libicu ) RUN apt-get install -y --no-install-recommends \ jq \ bc \ @@ -34,7 +34,6 @@ RUN apt-get install -y --no-install-recommends \ sudo \ python3 \ python-is-python3 \ - libicu70 \ opam \ && apt-get clean -y diff --git a/Makefile b/Makefile index fbd4f9206f8..1e820f2973b 100644 --- a/Makefile +++ b/Makefile @@ -57,6 +57,11 @@ bootstrap: +$(Q)$(MAKE) dune-snapshot +$(Q)$(MAKE) fstar +# This is a faster version of bootstrap, since it does not use dune +# to install the binary and libraries, and instead just copies the binary +# mannualy. HOWEVER, note that this means plugins will not work well, +# since they are compiled against the objects in bin/, which will become +# stale if this rule is used. Using bootstrap is usually safer. .PHONY: boot boot: +$(Q)$(MAKE) dune-snapshot @@ -127,10 +132,22 @@ bench: # Regenerate and accept expected output tests. Should be manually # reviewed before checking in. .PHONY: output -output: +output: output-error-messages output-ide-emacs output-ide-lsp output-bug-reports + +.PHONY: output-error-messages +output-error-messages: +$(Q)$(MAKE) -C tests/error-messages accept + +.PHONY: output-ide-emacs +output-ide-emacs: +$(Q)$(MAKE) -C tests/ide/emacs accept + +.PHONY: output-ide-lsp +output-ide-lsp: +$(Q)$(MAKE) -C tests/ide/lsp accept + +.PHONY: output-bug-reports +output-bug-reports: +$(Q)$(MAKE) -C tests/bug-reports output-accept # This rule is meant to mimic what the docker based CI does, but it diff --git a/examples/dm4free/README.md b/examples/dm4free/README.md index 66706fd0cee..4b677a3bcd9 100644 --- a/examples/dm4free/README.md +++ b/examples/dm4free/README.md @@ -23,7 +23,7 @@ To see more debug output related to the DMFF elaboration and star transformations: ``` -fstar.exe --trace_error --debug_level ED --debug FStar.DM4F.IntST FStar.DM4F.IntST.fst --prn --print_implicits --print_universes --print_bound_var_types +fstar.exe --trace_error --debug ED FStar.DM4F.IntST.fst --prn --print_implicits --print_universes --print_bound_var_types ``` Current status: diff --git a/examples/dm4free/old/StExn.Handle.fst b/examples/dm4free/old/StExn.Handle.fst index b3eb0a87601..872206639cc 100644 --- a/examples/dm4free/old/StExn.Handle.fst +++ b/examples/dm4free/old/StExn.Handle.fst @@ -197,7 +197,6 @@ val handle: #a:Type0 -> #wp:wp a -> $f:(unit -> StateExn a wp) (* match x with *) (* | None -> False *) (* | Some z -> (ens h0 None h1 /\ z=def) \/ ens h0 x h1) *) -(* #set-options "--debug StExn.Handle --debug_level HACK!" *) (* let handle2 #a #req #ens f def = *) (* StateExn.reflect (fun h0 -> *) (* match reify (f ()) h0 with *) diff --git a/examples/dm4free/old/intST.fst b/examples/dm4free/old/intST.fst index be6ffef9888..75ac0fd1d8f 100644 --- a/examples/dm4free/old/intST.fst +++ b/examples/dm4free/old/intST.fst @@ -105,7 +105,7 @@ let put_unfolded (n: int): (n0: int -> PURE (unit * int) (fun post -> post ((), let put_cps_type = n:int -> Tot (repr unit (fun n0 post -> post ((), n))) let put_cps_type_unfolded = n:int -> Tot (n0: int -> PURE (unit * int) (fun post -> post ((), n))) -(* #reset-options "--debug NatST --debug_level SMTEncoding" *) +(* #reset-options "--debug SMTEncoding" *) reifiable reflectable new_effect { STATE : a:Type -> wp:wp a -> Effect diff --git a/examples/dsls/bool_refinement/BoolRefinement.fst b/examples/dsls/bool_refinement/BoolRefinement.fst index 770f7f7bd4f..d384e2bda74 100755 --- a/examples/dsls/bool_refinement/BoolRefinement.fst +++ b/examples/dsls/bool_refinement/BoolRefinement.fst @@ -516,7 +516,7 @@ let weaken (f:RT.fstar_top_env) (sg:src_env) (hyp:var { None? (lookup sg hyp) } let exp (sg:src_env) = e:src_exp { ln e /\ (forall x. x `Set.mem` freevars e ==> Some? (lookup sg x)) } -#push-options "--fuel 2 --ifuel 2 --z3rlimit_factor 6 --query_stats" +#push-options "--fuel 2 --ifuel 2 --z3rlimit_factor 6" let rec check (f:RT.fstar_top_env) (sg:src_env) (e:exp sg) @@ -650,7 +650,7 @@ let src_refinements_are_closed (e:src_exp {ln e && closed e}) src_refinements_are_closed_core 0 e elt -#push-options "--query_stats --fuel 8 --ifuel 2 --z3rlimit_factor 2" +#push-options "--fuel 8 --ifuel 2 --z3rlimit_factor 2" let rec elab_open_commute' (n:nat) (e:src_exp { ln' e n }) (x:var) : Lemma (ensures RT.subst_term (elab_exp e) (RT.open_with_var x n) == @@ -949,7 +949,7 @@ let rec as_bindings_rename_env_append (sg sg':src_env) (x y:var) let rt_rename (x y:var) : RT.subst_elt = RT.NT x (RT.var_as_term y) -#push-options "--query_stats --fuel 8 --ifuel 4 --z3rlimit_factor 10" +#push-options "--fuel 8 --ifuel 4 --z3rlimit_factor 10" let rec rename_elab_commute_core (m:int) (e:src_exp { ln' e m } ) (x y:var) (n:nat) : Lemma (ensures RT.subst_term (elab_exp e) (RT.shift_subst_n n [rt_rename x y]) == @@ -1123,7 +1123,7 @@ let sub_typing_renaming (#f:RT.fstar_top_env) | S_ELab g _ _ d -> S_ELab _ _ _ (core_subtyping_renaming sg sg' x y b t0 t1 d) -#push-options "--query_stats --fuel 2 --ifuel 2 --z3rlimit_factor 2" +#push-options "--fuel 2 --ifuel 2 --z3rlimit_factor 2" let freevars_included_in (e:src_exp) (sg:src_env) = forall x. x `Set.mem` freevars e ==> Some? (lookup sg x) @@ -1685,12 +1685,15 @@ let soundness_lemma (f:RT.fstar_top_env) (fun dd -> FStar.Squash.return_squash (soundness dd)) let main (nm:string) (src:src_exp) : RT.dsl_tac_t = - fun f -> + fun (f, expected_t) -> if ln src && closed src - then - let (| src_ty, _ |) = check f [] src in - soundness_lemma f [] src src_ty; - [RT.mk_checked_let f nm (elab_exp src) (elab_ty src_ty)] + then if None? expected_t + then let (| src_ty, _ |) = check f [] src in + soundness_lemma f [] src src_ty; + [], + RT.mk_checked_let f (T.cur_module ()) nm (elab_exp src) (elab_ty src_ty), + [] + else T.fail "Bool refinement DSL: no support for expected type yet" else T.fail "Not locally nameless" (***** Examples *****) diff --git a/examples/dsls/dependent_bool_refinement/DependentBoolRefinement.fst b/examples/dsls/dependent_bool_refinement/DependentBoolRefinement.fst index 8c3c0cf1b20..5fc26b2f452 100755 --- a/examples/dsls/dependent_bool_refinement/DependentBoolRefinement.fst +++ b/examples/dsls/dependent_bool_refinement/DependentBoolRefinement.fst @@ -105,7 +105,7 @@ let open_ty t v = open_ty' t (EVar v) 0 let close_ty t v = close_ty' t v 0 let open_ty_with t e = open_ty' t e 0 -#push-options "--query_stats --fuel 4 --ifuel 2 --z3rlimit_factor 8" +#push-options "--fuel 4 --ifuel 2 --z3rlimit_factor 8" let rec open_exp_freevars (e:src_exp) (v:src_exp) (n:nat) : Lemma (ensures (freevars e `Set.subset` freevars (open_exp' e v n)) /\ @@ -472,7 +472,7 @@ and check_ok (e:src_exp) (sg:src_env) | EApp e1 e2 -> check_ok e1 sg && check_ok e2 sg -#push-options "--fuel 2 --ifuel 2 --z3rlimit_factor 6 --query_stats" +#push-options "--fuel 2 --ifuel 2 --z3rlimit_factor 6" let rec check (f:fstar_top_env) (sg:src_env) @@ -578,7 +578,7 @@ let rec extend_env_l_lookup_bvar (g:R.env) (sg:src_env) (x:var) | [] -> () | hd :: tl -> extend_env_l_lookup_bvar g tl x -#push-options "--query_stats --fuel 8 --ifuel 2 --z3rlimit_factor 2" +#push-options "--fuel 8 --ifuel 2 --z3rlimit_factor 2" let rec elab_open_commute' (n:nat) (e:src_exp) (x:src_exp) : Lemma (ensures RT.subst_term (elab_exp e) [ RT.DT n (elab_exp x) ] == @@ -638,7 +638,7 @@ let rec extend_env_l_lookup_fvar (g:R.env) (sg:src_env) (fv:R.fv) | [] -> () | hd::tl -> extend_env_l_lookup_fvar g tl fv -#push-options "--query_stats --fuel 2 --ifuel 2 --z3rlimit_factor 2" +#push-options "--fuel 2 --ifuel 2 --z3rlimit_factor 2" let subtyping_soundness #f (#sg:src_env) (#t0 #t1:src_ty) (ds:sub_typing f sg t0 t1) : GTot (RT.sub_typing (extend_env_l f sg) (elab_ty t0) (elab_ty t1)) @@ -646,7 +646,7 @@ let subtyping_soundness #f (#sg:src_env) (#t0 #t1:src_ty) (ds:sub_typing f sg t0 | S_Refl _ _ -> RT.Rel_equiv _ _ _ _ (RT.Rel_refl _ _ _) | S_ELab _ _ _ d -> d -#push-options "--query_stats --fuel 8 --ifuel 2 --z3rlimit_factor 4" +#push-options "--fuel 8 --ifuel 2 --z3rlimit_factor 4" let rec elab_close_commute' (n:nat) (e:src_exp) (x:var) : Lemma (ensures RT.subst_term (elab_exp e) [ RT.ND x n ] == @@ -878,10 +878,13 @@ and closed_ty (t:src_ty) let main (nm:string) (src:src_exp) : RT.dsl_tac_t - = fun f -> + = fun (f, expected_t) -> if closed src - then - let (| src_ty, _ |) = check f [] src in - soundness_lemma f [] src src_ty; - [RT.mk_checked_let f nm (elab_exp src) (elab_ty src_ty)] + then if None? expected_t + then let (| src_ty, _ |) = check f [] src in + soundness_lemma f [] src src_ty; + [], + RT.mk_checked_let f (T.cur_module ()) nm (elab_exp src) (elab_ty src_ty), + [] + else T.fail "Dependent bool refinement DSL: no support for expected type yet" else T.fail "Not locally nameless" diff --git a/examples/dsls/stlc/STLC.Core.fst b/examples/dsls/stlc/STLC.Core.fst index c8007d7c6c2..918f3087e00 100755 --- a/examples/dsls/stlc/STLC.Core.fst +++ b/examples/dsls/stlc/STLC.Core.fst @@ -1,3 +1,19 @@ +(* + Copyright 2023 Microsoft Research + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + module STLC.Core module T = FStar.Tactics.V2 module R = FStar.Reflection.V2 @@ -537,12 +553,15 @@ let soundness_lemma (sg:stlc_env) (fun dd -> FStar.Squash.return_squash (soundness dd g)) let main (nm:string) (src:stlc_exp) : RT.dsl_tac_t = - fun g -> + fun (g, expected_t) -> if ln src && closed src - then - let (| src_ty, d |) = check g [] src in - soundness_lemma [] src src_ty g; - [RT.mk_checked_let g nm (elab_exp src) (elab_ty src_ty)] + then if None? expected_t + then let (| src_ty, d |) = check g [] src in + soundness_lemma [] src src_ty g; + [], + RT.mk_checked_let g (T.cur_module ()) nm (elab_exp src) (elab_ty src_ty), + [] + else T.fail "STLC Core DSL: no support for expected type yet" else T.fail "Not locally nameless" (***** Tests *****) diff --git a/examples/dsls/stlc/STLC.Infer.fst b/examples/dsls/stlc/STLC.Infer.fst index 4bc09510746..ba347619a1a 100755 --- a/examples/dsls/stlc/STLC.Infer.fst +++ b/examples/dsls/stlc/STLC.Infer.fst @@ -1,3 +1,19 @@ +(* + Copyright 2024 Microsoft Research + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + module STLC.Infer module T = FStar.Tactics.V2 module R = FStar.Reflection.V2 @@ -123,10 +139,10 @@ let rec elab_core g (e:stlc_exp R.term) let main (nm:string) (e:stlc_exp unit) : RT.dsl_tac_t - = fun g -> + = fun (g, expected_t) -> let (| e, _ |) = infer g [] e in let e = elab_core g e in - Core.main nm e g + Core.main nm e (g, expected_t) (***** Tests *****) diff --git a/examples/layeredeffects/everparse/tls/Negotiation.Writers.NoHoare.fst b/examples/layeredeffects/everparse/tls/Negotiation.Writers.NoHoare.fst index dc08de21681..8698385a864 100644 --- a/examples/layeredeffects/everparse/tls/Negotiation.Writers.NoHoare.fst +++ b/examples/layeredeffects/everparse/tls/Negotiation.Writers.NoHoare.fst @@ -14,7 +14,7 @@ open Negotiation module U32 = FStar.UInt32 module B = LowStar.Buffer -#push-options "--z3rlimit 16 --query_stats" +#push-options "--z3rlimit 16" inline_for_extraction noextract diff --git a/examples/miniparse/MiniParse.fst.config.json b/examples/miniparse/MiniParse.fst.config.json new file mode 100644 index 00000000000..6d6e73162ba --- /dev/null +++ b/examples/miniparse/MiniParse.fst.config.json @@ -0,0 +1,7 @@ +{ + "fstar_exe": "fstar.exe", + "options": [ + ], + "include_dirs": [ + ] +} diff --git a/examples/native_tactics/Imp.Fun.Driver.fst b/examples/native_tactics/Imp.Fun.Driver.fst index 08a3181b755..b8082cafbe2 100644 --- a/examples/native_tactics/Imp.Fun.Driver.fst +++ b/examples/native_tactics/Imp.Fun.Driver.fst @@ -47,6 +47,6 @@ let normal #a (e:a) = let norm_assert (p:Type) : Lemma (requires (normal p)) (ensures True) = () -#set-options "--debug Imp.Fun.Driver --debug_level print_normalized_terms --admit_smt_queries true" +#set-options "--debug print_normalized_terms --admit_smt_queries true" // let _ = norm_assert (forall (x:int) rm. R.sel (eval' (Seq [Const x (reg 0)]) rm) 0 == x) // eval' (Seq [Const x (reg 0)]) rm == rm) let _ = norm_assert (forall x y. equiv_norm (long_zero x) (long_zero y)) diff --git a/examples/native_tactics/Imp.Fun.DriverNBE.fst b/examples/native_tactics/Imp.Fun.DriverNBE.fst index 59a713b788e..269eda04b67 100644 --- a/examples/native_tactics/Imp.Fun.DriverNBE.fst +++ b/examples/native_tactics/Imp.Fun.DriverNBE.fst @@ -48,6 +48,6 @@ let normal #a (e:a) = let norm_assert (p:Type) : Lemma (requires (normal p)) (ensures True) = () -#set-options "--debug Imp.Fun.DriverNBE --debug_level print_normalized_terms --admit_smt_queries true" +#set-options "--debug print_normalized_terms --admit_smt_queries true" // let _ = norm_assert (forall (x:int) rm. R.sel (eval' (Seq [Const x (reg 0)]) rm) 0 == x) // eval' (Seq [Const x (reg 0)]) rm == rm) let _ = norm_assert (forall x y. equiv_norm (long_zero x) (long_zero y)) diff --git a/examples/native_tactics/Imp.Fun.fst b/examples/native_tactics/Imp.Fun.fst index 8ac62622947..7fa34d9683d 100644 --- a/examples/native_tactics/Imp.Fun.fst +++ b/examples/native_tactics/Imp.Fun.fst @@ -14,7 +14,7 @@ limitations under the License. *) module Imp.Fun -//#set-options "--debug Imp --debug_level SMTQuery" +//#set-options "--debug SMTQuery" open FStar.Mul module R = Registers.Fun @@ -167,7 +167,7 @@ let normal #a (e:a) = let norm_assert (p:Type) : Lemma (requires (normal p)) (ensures True) = () -#set-options "--debug Registers.Imp --debug_level print_normalized_terms --admit_smt_queries true" +#set-options "--debug print_normalized_terms --admit_smt_queries true" // let _ = norm_assert (forall (x:int) rm. R.sel (eval' (Seq [Const x (reg 0)]) rm) 0 == x) // eval' (Seq [Const x (reg 0)]) rm == rm) let _ = norm_assert (forall x y. equiv_norm (long_zero x) (long_zero y)) // let _ = norm_assert (forall x y. equiv_norm (long_zero x) (long_zero y)) diff --git a/examples/native_tactics/Imp.List.Driver.fst b/examples/native_tactics/Imp.List.Driver.fst index e62325b5648..278322e153e 100644 --- a/examples/native_tactics/Imp.List.Driver.fst +++ b/examples/native_tactics/Imp.List.Driver.fst @@ -47,6 +47,6 @@ let normal #a (e:a) = let norm_assert (p:Type) : Lemma (requires (normal p)) (ensures True) = () -#set-options "--debug Imp.List.Driver --debug_level print_normalized_terms --admit_smt_queries true" +#set-options "--debug print_normalized_terms --admit_smt_queries true" // let _ = norm_assert (forall (x:int) rm. R.sel (eval' (Seq [Const x (reg 0)]) rm) 0 == x) // eval' (Seq [Const x (reg 0)]) rm == rm) let _ = norm_assert (forall x y. equiv_norm (long_zero x) (long_zero y)) diff --git a/examples/native_tactics/Imp.List.DriverNBE.fst b/examples/native_tactics/Imp.List.DriverNBE.fst index f1cff409fcc..23cce7a26a1 100644 --- a/examples/native_tactics/Imp.List.DriverNBE.fst +++ b/examples/native_tactics/Imp.List.DriverNBE.fst @@ -48,5 +48,5 @@ let normal #a (e:a) = let norm_assert (p:Type) : Lemma (requires (normal p)) (ensures True) = () -#set-options "--debug Imp.List.DriverNBE --debug_level print_normalized_terms --admit_smt_queries true" +#set-options "--debug print_normalized_terms --admit_smt_queries true" let _ = norm_assert (forall x y. equiv_norm (long_zero x) (long_zero y)) diff --git a/examples/native_tactics/Imp.List.fst b/examples/native_tactics/Imp.List.fst index 894ea266e3e..b348ac35fed 100644 --- a/examples/native_tactics/Imp.List.fst +++ b/examples/native_tactics/Imp.List.fst @@ -14,7 +14,7 @@ limitations under the License. *) module Imp.List -//#set-options "--debug Imp --debug_level SMTQuery" +//#set-options "--debug SMTQuery" open FStar.Mul module R = Registers.List diff --git a/examples/native_tactics/Makefile b/examples/native_tactics/Makefile index d88329ad727..1d3735ed423 100644 --- a/examples/native_tactics/Makefile +++ b/examples/native_tactics/Makefile @@ -54,7 +54,7 @@ all: $(addsuffix .sep.test, $(TAC_MODULES)) $(addsuffix .test, $(ALL)) touch $@ %.sep.test: %.fst %.ml - $(FSTAR) $*.Test.fst --load $* --debug $* --debug_level tactics + $(FSTAR) $*.Test.fst --load $* touch $@ %.ml: %.fst diff --git a/examples/native_tactics/Registers.Imp.fst b/examples/native_tactics/Registers.Imp.fst index 64ff3bfe2d8..eab1b267b7a 100644 --- a/examples/native_tactics/Registers.Imp.fst +++ b/examples/native_tactics/Registers.Imp.fst @@ -14,7 +14,7 @@ limitations under the License. *) module Registers.Imp -//#set-options "--debug Imp --debug_level SMTQuery" +//#set-options "--debug SMTQuery" open FStar.Mul module R = Registers.List @@ -167,7 +167,7 @@ let normal #a (e:a) = let norm_assert (p:Type) : Lemma (requires (normal p)) (ensures True) = () -#set-options "--debug Registers.Imp --debug_level print_normalized_terms --admit_smt_queries true" +#set-options "--debug print_normalized_terms --admit_smt_queries true" // let _ = norm_assert (forall (x:int) rm. R.sel (eval' (Seq [Const x (reg 0)]) rm) 0 == x) // eval' (Seq [Const x (reg 0)]) rm == rm) let _ = norm_assert (forall x y. equiv_norm (long_zero x) (long_zero y)) // let _ = norm_assert (forall x y. equiv_norm (long_zero x) (long_zero y)) diff --git a/examples/native_tactics/Simple.Test.fst b/examples/native_tactics/Simple.Test.fst index 566866fd193..a50465e818d 100644 --- a/examples/native_tactics/Simple.Test.fst +++ b/examples/native_tactics/Simple.Test.fst @@ -20,6 +20,6 @@ type t = | This | That let test0 = assert_norm (id 1000000 = 1000000) let test1 = assert_norm (poly_id 1000000 This = This) let test2 = assert_norm (mk_n_list 10 This = [This;This;This;This;This;This;This;This;This;This]) -let test3 = assert_norm (poly_list_id (mk_n_list 100000 This) = mk_n_list 100000 This) +let test3 = assert_norm (poly_list_id (mk_n_list 40000 This) = mk_n_list 40000 This) let test4 = assert_norm (eq_int_list (poly_list_id (mk_n_list 100000 0)) (mk_n_list 100000 0)) diff --git a/examples/tactics/Imp.fst b/examples/tactics/Imp.fst index b9f8075987e..8cd73ea198e 100644 --- a/examples/tactics/Imp.fst +++ b/examples/tactics/Imp.fst @@ -15,7 +15,7 @@ *) module Imp -//#set-options "--debug Imp --debug_level SMTQuery" +//#set-options "--debug SMTQuery" open FStar.Mul open FStar.Tactics.V2 diff --git a/examples/tactics/micro-benchmarks/rewriteEqualityImplications.fst b/examples/tactics/micro-benchmarks/rewriteEqualityImplications.fst index 0ad83b55821..2ff62b68687 100644 --- a/examples/tactics/micro-benchmarks/rewriteEqualityImplications.fst +++ b/examples/tactics/micro-benchmarks/rewriteEqualityImplications.fst @@ -14,7 +14,7 @@ limitations under the License. *) (* Here's the incantation I use to check this file: *) -(* $ fstar rewriteEqualityImplications.fst --debug RewriteEqualityImplications --debug_level Low | grep "\(Got goal\)\|Checking top-level decl let" *) +(* $ fstar rewriteEqualityImplications.fst --debug Low | grep "\(Got goal\)\|Checking top-level decl let" *) (* Notice the "Got goal" output, in particular---that's the result of preprocessing the VC for each top-level term. *) (* Each term results in 0 or more queries that get sent to Z3 *) module RewriteEqualityImplications diff --git a/ocaml/fstar-lib/FStar_Compiler_Util.ml b/ocaml/fstar-lib/FStar_Compiler_Util.ml index a34adb61afe..5b496565d88 100644 --- a/ocaml/fstar-lib/FStar_Compiler_Util.ml +++ b/ocaml/fstar-lib/FStar_Compiler_Util.ml @@ -545,7 +545,7 @@ type printer = { let default_printer = { printer_prinfo = (fun s -> pr "%s" s; flush stdout); - printer_prwarning = (fun s -> fpr stderr "%s" (colorize_cyan s); flush stdout; flush stderr); + printer_prwarning = (fun s -> fpr stderr "%s" (colorize_yellow s); flush stdout; flush stderr); printer_prerror = (fun s -> fpr stderr "%s" (colorize_red s); flush stdout; flush stderr); printer_prgeneric = fun label get_string get_json -> pr "%s: %s" label (get_string ())} diff --git a/ocaml/fstar-lib/FStar_Parser_ParseIt.ml b/ocaml/fstar-lib/FStar_Parser_ParseIt.ml index b6c970def2e..f3ec9aad461 100644 --- a/ocaml/fstar-lib/FStar_Parser_ParseIt.ml +++ b/ocaml/fstar-lib/FStar_Parser_ParseIt.ml @@ -65,7 +65,7 @@ let read_physical_file (filename: string) = raise_err (Fatal_UnableToReadFile, U.format1 "Unable to read file %s\n" filename) let read_file (filename:string) = - let debug = FStar_Options.debug_any () in + let debug = FStar_Compiler_Debug.any () in match read_vfs_entry filename with | Some (_mtime, contents) -> if debug then U.print1 "Reading in-memory file %s\n" filename; @@ -268,7 +268,7 @@ let parse fn = current_pos lexbuf in let raw_contents = contents_at d.drange in - if FStar_Options.debug_any() + if FStar_Compiler_Debug.any() then FStar_Compiler_Util.print2 "At range %s, got code\n%s\n" (FStar_Compiler_Range.string_of_range raw_contents.range) diff --git a/ocaml/fstar-lib/FStar_Range.ml b/ocaml/fstar-lib/FStar_Range.ml index cbd5b447224..0451f197f82 100644 --- a/ocaml/fstar-lib/FStar_Range.ml +++ b/ocaml/fstar-lib/FStar_Range.ml @@ -3,5 +3,6 @@ type range = __range let mk_range f a b c d = FStar_Compiler_Range_Type.mk_range f {line=a;col=b} {line=c;col=d} let range_0 : range = let z = Prims.parse_int "0" in mk_range "dummy" z z z z +let join_range r1 r2 = FStar_Compiler_Range_Ops.union_ranges r1 r2 -type ('Ar,'Amsg,'Ab) labeled = 'Ab \ No newline at end of file +type ('Ar,'Amsg,'Ab) labeled = 'Ab diff --git a/ocaml/fstar-lib/FStar_Tactics_Load.ml b/ocaml/fstar-lib/FStar_Tactics_Load.ml index ed563d54aa9..4bee7e0044e 100644 --- a/ocaml/fstar-lib/FStar_Tactics_Load.ml +++ b/ocaml/fstar-lib/FStar_Tactics_Load.ml @@ -6,8 +6,8 @@ module EC = FStar_Errors_Codes module EM = FStar_Errors_Msg module O = FStar_Options -let perr s = if O.debug_any () then U.print_error s -let perr1 s x = if O.debug_any () then U.print1_error s x +let perr s = if FStar_Compiler_Debug.any () then U.print_error s +let perr1 s x = if FStar_Compiler_Debug.any () then U.print1_error s x let dynlink (fname:string) : unit = try diff --git a/ocaml/fstar-lib/FStar_Tactics_Native.ml b/ocaml/fstar-lib/FStar_Tactics_Native.ml index f1e3d8148c6..df1cc6729e1 100644 --- a/ocaml/fstar-lib/FStar_Tactics_Native.ml +++ b/ocaml/fstar-lib/FStar_Tactics_Native.ml @@ -30,8 +30,8 @@ type native_primitive_step = strong_reduction_ok: bool; tactic: itac} -let perr s = if O.debug_any () then BU.print_error s -let perr1 s x = if O.debug_any () then BU.print1_error s x +let perr s = if FStar_Compiler_Debug.any () then BU.print_error s +let perr1 s x = if FStar_Compiler_Debug.any () then BU.print1_error s x let compiled_tactics: native_primitive_step list ref = ref [] diff --git a/ocaml/fstar-lib/FStar_Tactics_V2_Builtins.ml b/ocaml/fstar-lib/FStar_Tactics_V2_Builtins.ml index 37aeddfed30..fb1f5260e39 100644 --- a/ocaml/fstar-lib/FStar_Tactics_V2_Builtins.ml +++ b/ocaml/fstar-lib/FStar_Tactics_V2_Builtins.ml @@ -34,35 +34,31 @@ let to_tac_1 (t: 'b -> 'a __tac): 'b -> 'a TM.tac = fun x -> (fun (ps: proofstate) -> uninterpret_tac (t x) ps) |> TM.mk_tac -let from_tac_1 s (t: 'a -> 'b TM.tac): 'a -> 'b __tac = - fun (x: 'a) -> - fun (ps: proofstate) -> - let m = t x in - interpret_tac s m ps - -let from_tac_2 s (t: 'a -> 'b -> 'c TM.tac): 'a -> 'b -> 'c __tac = - fun (x: 'a) -> - fun (y: 'b) -> - fun (ps: proofstate) -> - let m = t x y in - interpret_tac s m ps - -let from_tac_3 s (t: 'a -> 'b -> 'c -> 'd TM.tac): 'a -> 'b -> 'c -> 'd __tac = - fun (x: 'a) -> - fun (y: 'b) -> - fun (z: 'c) -> - fun (ps: proofstate) -> - let m = t x y z in - interpret_tac s m ps - -let from_tac_4 s (t: 'a -> 'b -> 'c -> 'd -> 'e TM.tac): 'a -> 'b -> 'c -> 'd -> 'e __tac = - fun (x: 'a) -> - fun (y: 'b) -> - fun (z: 'c) -> - fun (w: 'd) -> - fun (ps: proofstate) -> - let m = t x y z w in - interpret_tac s m ps +let from_tac_1 s (t: 'a -> 'r TM.tac): 'a -> 'r __tac = + fun (xa: 'a) (ps : proofstate) -> + let m = t xa in + interpret_tac s m ps + +let from_tac_2 s (t: 'a -> 'b -> 'r TM.tac): 'a -> 'b -> 'r __tac = + fun (xa: 'a) (xb: 'b) (ps : proofstate) -> + let m = t xa xb in + interpret_tac s m ps + +let from_tac_3 s (t: 'a -> 'b -> 'c -> 'r TM.tac): 'a -> 'b -> 'c -> 'r __tac = + fun (xa: 'a) (xb: 'b) (xc: 'c) (ps : proofstate) -> + let m = t xa xb xc in + interpret_tac s m ps + +let from_tac_4 s (t: 'a -> 'b -> 'c -> 'd -> 'r TM.tac): 'a -> 'b -> 'c -> 'd -> 'r __tac = + fun (xa: 'a) (xb: 'b) (xc: 'c) (xd: 'd) (ps : proofstate) -> + let m = t xa xb xc xd in + interpret_tac s m ps + +let from_tac_5 s (t: 'a -> 'b -> 'c -> 'd -> 'e -> 'r TM.tac): 'a -> 'b -> 'c -> 'd -> 'e -> 'r __tac = + fun (xa: 'a) (xb: 'b) (xc: 'c) (xd: 'd) (xe: 'e) (ps : proofstate) -> + let m = t xa xb xc xd xe in + interpret_tac s m ps + (* Pointing to the internal primitives *) let compress = from_tac_1 "B.compress" B.compress @@ -115,6 +111,7 @@ let tadmit_t = from_tac_1 "B.tadmit_t" B.tadmit_t let join = from_tac_1 "B.join" B.join let curms = from_tac_1 "B.curms" B.curms let set_urgency = from_tac_1 "B.set_urgency" B.set_urgency +let set_dump_on_failure = from_tac_1 "B.set_dump_on_failure" B.set_dump_on_failure let t_commute_applied_match = from_tac_1 "B.t_commute_applied_match" B.t_commute_applied_match let gather_or_solve_explicit_guards_for_resolved_goals = from_tac_1 "B.gather_explicit_guards_for_resolved_goals" B.gather_explicit_guards_for_resolved_goals let string_to_term = from_tac_2 "B.string_to_term" B.string_to_term @@ -146,7 +143,7 @@ type ('env, 'sc, 't, 'pats, 'bnds) match_complete_token = unit let is_non_informative = from_tac_2 "B.refl_is_non_informative" B.refl_is_non_informative let check_subtyping = from_tac_3 "B.refl_check_subtyping" B.refl_check_subtyping -let check_equiv = from_tac_3 "B.refl_check_equiv" B.refl_check_equiv +let t_check_equiv = from_tac_5 "B.t_refl_check_equiv" B.t_refl_check_equiv let core_compute_term_type = from_tac_2 "B.refl_core_compute_term_type" B.refl_core_compute_term_type let core_check_term = from_tac_4 "B.refl_core_check_term" B.refl_core_check_term let core_check_term_at_type = from_tac_3 "B.refl_core_check_term_at_type" B.refl_core_check_term_at_type @@ -158,6 +155,8 @@ let instantiate_implicits = from_tac_2 "B.refl_instantiate_implicits" B.r let try_unify = from_tac_4 "B.refl_try_unify" B.refl_try_unify let maybe_relate_after_unfolding = from_tac_3 "B.refl_maybe_relate_after_unfolding" B.refl_maybe_relate_after_unfolding let maybe_unfold_head = from_tac_2 "B.refl_maybe_unfold_head" B.refl_maybe_unfold_head +let norm_well_typed_term = from_tac_3 "B.norm_well_typed_term" B.refl_norm_well_typed_term + let push_open_namespace = from_tac_2 "B.push_open_namespace" B.push_open_namespace let push_module_abbrev = from_tac_3 "B.push_module_abbrev" B.push_module_abbrev let resolve_name = from_tac_2 "B.resolve_name" B.resolve_name diff --git a/ocaml/fstar-lib/generated/FStar_CheckedFiles.ml b/ocaml/fstar-lib/generated/FStar_CheckedFiles.ml index b650fd7cbe9..d2c3052e64f 100644 --- a/ocaml/fstar-lib/generated/FStar_CheckedFiles.ml +++ b/ocaml/fstar-lib/generated/FStar_CheckedFiles.ml @@ -1,5 +1,7 @@ open Prims -let (cache_version_number : Prims.int) = (Prims.of_int (65)) +let (dbg : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "CheckedFiles" +let (cache_version_number : Prims.int) = (Prims.of_int (67)) type tc_result = { checked_module: FStar_Syntax_Syntax.modul ; @@ -162,9 +164,7 @@ let (hash_dependences : FStar_Compiler_Util.format1 "hash_dependences::the interface checked file %s does not exist\n" iface in - ((let uu___2 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "CheckedFiles") in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg in if uu___2 then FStar_Compiler_Util.print1 "%s\n" msg else ()); @@ -193,9 +193,7 @@ let (hash_dependences : FStar_Compiler_Util.format2 "For dependency %s, cache file %s is not loaded" fn2 cache_fn in - ((let uu___3 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "CheckedFiles") in + ((let uu___3 = FStar_Compiler_Effect.op_Bang dbg in if uu___3 then FStar_Compiler_Util.print1 "%s\n" msg else ()); @@ -223,9 +221,7 @@ let (hash_dependences : let (load_checked_file : Prims.string -> Prims.string -> cache_t) = fun fn -> fun checked_fn -> - (let uu___1 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "CheckedFiles") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg in if uu___1 then FStar_Compiler_Util.print1 "Trying to load checked file result %s\n" @@ -263,9 +259,7 @@ let (load_checked_file : Prims.string -> Prims.string -> cache_t) = FStar_Compiler_Util.digest_of_file fn in if x.digest <> current_digest then - ((let uu___5 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "CheckedFiles") in + ((let uu___5 = FStar_Compiler_Effect.op_Bang dbg in if uu___5 then FStar_Compiler_Util.print4 @@ -289,9 +283,7 @@ let (load_checked_file_with_tc_result : fun deps -> fun fn -> fun checked_fn -> - (let uu___1 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "CheckedFiles") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg in if uu___1 then FStar_Compiler_Util.print1 @@ -369,9 +361,7 @@ let (load_checked_file_with_tc_result : validate_iface_cache (); FStar_Pervasives.Inr tc_result1)) else - ((let uu___5 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "CheckedFiles") in + ((let uu___5 = FStar_Compiler_Effect.op_Bang dbg in if uu___5 then ((let uu___7 = @@ -490,9 +480,7 @@ let (load_module_from_cache : | FStar_Pervasives.Inl msg -> (fail msg cache_file; FStar_Pervasives_Native.None) | FStar_Pervasives.Inr tc_result1 -> - ((let uu___4 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "CheckedFiles") in + ((let uu___4 = FStar_Compiler_Effect.op_Bang dbg in if uu___4 then FStar_Compiler_Util.print1 diff --git a/ocaml/fstar-lib/generated/FStar_Class_Binders.ml b/ocaml/fstar-lib/generated/FStar_Class_Binders.ml index 794f05147b7..4b59d1215d7 100644 --- a/ocaml/fstar-lib/generated/FStar_Class_Binders.ml +++ b/ocaml/fstar-lib/generated/FStar_Class_Binders.ml @@ -1,22 +1,32 @@ open Prims type 'a hasNames = { - freeNames: 'a -> FStar_Syntax_Syntax.bv FStar_Compiler_Set.set } + freeNames: 'a -> FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.flat_set } let __proj__MkhasNames__item__freeNames : - 'a . 'a hasNames -> 'a -> FStar_Syntax_Syntax.bv FStar_Compiler_Set.set = - fun projectee -> match projectee with | { freeNames;_} -> freeNames + 'a . + 'a hasNames -> + 'a -> FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.flat_set + = fun projectee -> match projectee with | { freeNames;_} -> freeNames let freeNames : - 'a . 'a hasNames -> 'a -> FStar_Syntax_Syntax.bv FStar_Compiler_Set.set = + 'a . + 'a hasNames -> + 'a -> FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.flat_set + = fun projectee -> match projectee with | { freeNames = freeNames1;_} -> freeNames1 type 'a hasBinders = { - boundNames: 'a -> FStar_Syntax_Syntax.bv FStar_Compiler_Set.set } + boundNames: 'a -> FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.flat_set } let __proj__MkhasBinders__item__boundNames : - 'a . 'a hasBinders -> 'a -> FStar_Syntax_Syntax.bv FStar_Compiler_Set.set = - fun projectee -> match projectee with | { boundNames;_} -> boundNames + 'a . + 'a hasBinders -> + 'a -> FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.flat_set + = fun projectee -> match projectee with | { boundNames;_} -> boundNames let boundNames : - 'a . 'a hasBinders -> 'a -> FStar_Syntax_Syntax.bv FStar_Compiler_Set.set = + 'a . + 'a hasBinders -> + 'a -> FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.flat_set + = fun projectee -> match projectee with | { boundNames = boundNames1;_} -> boundNames1 let (hasNames_term : FStar_Syntax_Syntax.term hasNames) = @@ -30,7 +40,11 @@ let (hasNames_comp : FStar_Syntax_Syntax.comp hasNames) = | FStar_Syntax_Syntax.GTotal t -> FStar_Syntax_Free.names t | FStar_Syntax_Syntax.Comp ct -> let uu___ = - FStar_Compiler_Set.empty FStar_Syntax_Syntax.ord_bv () in + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) ()) in let uu___1 = let uu___2 = FStar_Syntax_Free.names ct.FStar_Syntax_Syntax.result_typ in @@ -42,11 +56,25 @@ let (hasNames_comp : FStar_Syntax_Syntax.comp hasNames) = ct.FStar_Syntax_Syntax.effect_args in uu___2 :: uu___3 in FStar_Compiler_List.fold_left - (FStar_Compiler_Set.union FStar_Syntax_Syntax.ord_bv) uu___ - uu___1) + (fun uu___3 -> + fun uu___2 -> + (Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)))) uu___3 uu___2) + uu___ uu___1) } let (hasBinders_list_bv : FStar_Syntax_Syntax.bv Prims.list hasBinders) = - { boundNames = (FStar_Compiler_Set.from_list FStar_Syntax_Syntax.ord_bv) } + { + boundNames = + (fun uu___ -> + (Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)))) uu___) + } let (hasBinders_set_bv : - FStar_Syntax_Syntax.bv FStar_Compiler_Set.set hasBinders) = + FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.flat_set hasBinders) = { boundNames = (fun x -> x) } \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Class_Setlike.ml b/ocaml/fstar-lib/generated/FStar_Class_Setlike.ml new file mode 100644 index 00000000000..c9d1be35da4 --- /dev/null +++ b/ocaml/fstar-lib/generated/FStar_Class_Setlike.ml @@ -0,0 +1,298 @@ +open Prims +type ('e, 's) setlike = + { + empty: unit -> 's ; + singleton: 'e -> 's ; + is_empty: 's -> Prims.bool ; + add: 'e -> 's -> 's ; + remove: 'e -> 's -> 's ; + mem: 'e -> 's -> Prims.bool ; + equal: 's -> 's -> Prims.bool ; + subset: 's -> 's -> Prims.bool ; + union: 's -> 's -> 's ; + inter: 's -> 's -> 's ; + diff: 's -> 's -> 's ; + for_all: ('e -> Prims.bool) -> 's -> Prims.bool ; + for_any: ('e -> Prims.bool) -> 's -> Prims.bool ; + elems: 's -> 'e Prims.list ; + collect: ('e -> 's) -> 'e Prims.list -> 's ; + from_list: 'e Prims.list -> 's ; + addn: 'e Prims.list -> 's -> 's } +let __proj__Mksetlike__item__empty : 'e 's . ('e, 's) setlike -> unit -> 's = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> empty +let __proj__Mksetlike__item__singleton : 'e 's . ('e, 's) setlike -> 'e -> 's + = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> singleton +let __proj__Mksetlike__item__is_empty : + 'e 's . ('e, 's) setlike -> 's -> Prims.bool = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> is_empty +let __proj__Mksetlike__item__add : 'e 's . ('e, 's) setlike -> 'e -> 's -> 's + = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> add +let __proj__Mksetlike__item__remove : + 'e 's . ('e, 's) setlike -> 'e -> 's -> 's = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> remove +let __proj__Mksetlike__item__mem : + 'e 's . ('e, 's) setlike -> 'e -> 's -> Prims.bool = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> mem +let __proj__Mksetlike__item__equal : + 'e 's . ('e, 's) setlike -> 's -> 's -> Prims.bool = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> equal +let __proj__Mksetlike__item__subset : + 'e 's . ('e, 's) setlike -> 's -> 's -> Prims.bool = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> subset +let __proj__Mksetlike__item__union : + 'e 's . ('e, 's) setlike -> 's -> 's -> 's = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> union +let __proj__Mksetlike__item__inter : + 'e 's . ('e, 's) setlike -> 's -> 's -> 's = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> inter +let __proj__Mksetlike__item__diff : + 'e 's . ('e, 's) setlike -> 's -> 's -> 's = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> diff +let __proj__Mksetlike__item__for_all : + 'e 's . ('e, 's) setlike -> ('e -> Prims.bool) -> 's -> Prims.bool = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> for_all +let __proj__Mksetlike__item__for_any : + 'e 's . ('e, 's) setlike -> ('e -> Prims.bool) -> 's -> Prims.bool = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> for_any +let __proj__Mksetlike__item__elems : + 'e 's . ('e, 's) setlike -> 's -> 'e Prims.list = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> elems +let __proj__Mksetlike__item__collect : + 'e 's . ('e, 's) setlike -> ('e -> 's) -> 'e Prims.list -> 's = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> collect +let __proj__Mksetlike__item__from_list : + 'e 's . ('e, 's) setlike -> 'e Prims.list -> 's = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> from_list +let __proj__Mksetlike__item__addn : + 'e 's . ('e, 's) setlike -> 'e Prims.list -> 's -> 's = + fun projectee -> + match projectee with + | { empty; singleton; is_empty; add; remove; mem; equal; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> addn +let empty : 'e . unit -> ('e, Obj.t) setlike -> unit -> Obj.t = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton; is_empty; add; remove; mem; equal; + subset; union; inter; diff; for_all; for_any; elems; collect; + from_list; addn;_} -> empty1 +let singleton : 'e . unit -> ('e, Obj.t) setlike -> 'e -> Obj.t = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty; add; remove; + mem; equal; subset; union; inter; diff; for_all; for_any; elems; + collect; from_list; addn;_} -> singleton1 +let is_empty : 'e . unit -> ('e, Obj.t) setlike -> Obj.t -> Prims.bool = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add; remove; mem; equal; subset; union; inter; diff; for_all; + for_any; elems; collect; from_list; addn;_} -> is_empty1 +let add : 'e . unit -> ('e, Obj.t) setlike -> 'e -> Obj.t -> Obj.t = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove; mem; equal; subset; union; inter; diff; + for_all; for_any; elems; collect; from_list; addn;_} -> add1 +let remove : 'e . unit -> ('e, Obj.t) setlike -> 'e -> Obj.t -> Obj.t = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem; equal; subset; union; inter; + diff; for_all; for_any; elems; collect; from_list; addn;_} -> + remove1 +let mem : 'e . unit -> ('e, Obj.t) setlike -> 'e -> Obj.t -> Prims.bool = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem = mem1; equal; subset; union; + inter; diff; for_all; for_any; elems; collect; from_list; addn;_} + -> mem1 +let equal : 'e . unit -> ('e, Obj.t) setlike -> Obj.t -> Obj.t -> Prims.bool + = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem = mem1; equal = equal1; subset; + union; inter; diff; for_all; for_any; elems; collect; from_list; + addn;_} -> equal1 +let subset : 'e . unit -> ('e, Obj.t) setlike -> Obj.t -> Obj.t -> Prims.bool + = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem = mem1; equal = equal1; + subset = subset1; union; inter; diff; for_all; for_any; elems; + collect; from_list; addn;_} -> subset1 +let union : 'e . unit -> ('e, Obj.t) setlike -> Obj.t -> Obj.t -> Obj.t = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem = mem1; equal = equal1; + subset = subset1; union = union1; inter; diff; for_all; for_any; + elems; collect; from_list; addn;_} -> union1 +let inter : 'e . unit -> ('e, Obj.t) setlike -> Obj.t -> Obj.t -> Obj.t = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem = mem1; equal = equal1; + subset = subset1; union = union1; inter = inter1; diff; for_all; + for_any; elems; collect; from_list; addn;_} -> inter1 +let diff : 'e . unit -> ('e, Obj.t) setlike -> Obj.t -> Obj.t -> Obj.t = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem = mem1; equal = equal1; + subset = subset1; union = union1; inter = inter1; diff = diff1; + for_all; for_any; elems; collect; from_list; addn;_} -> diff1 +let for_all : + 'e . + unit -> ('e, Obj.t) setlike -> ('e -> Prims.bool) -> Obj.t -> Prims.bool + = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem = mem1; equal = equal1; + subset = subset1; union = union1; inter = inter1; diff = diff1; + for_all = for_all1; for_any; elems; collect; from_list; addn;_} -> + for_all1 +let for_any : + 'e . + unit -> ('e, Obj.t) setlike -> ('e -> Prims.bool) -> Obj.t -> Prims.bool + = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem = mem1; equal = equal1; + subset = subset1; union = union1; inter = inter1; diff = diff1; + for_all = for_all1; for_any = for_any1; elems; collect; from_list; + addn;_} -> for_any1 +let elems : 'e . unit -> ('e, Obj.t) setlike -> Obj.t -> 'e Prims.list = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem = mem1; equal = equal1; + subset = subset1; union = union1; inter = inter1; diff = diff1; + for_all = for_all1; for_any = for_any1; elems = elems1; collect; + from_list; addn;_} -> elems1 +let collect : + 'e . unit -> ('e, Obj.t) setlike -> ('e -> Obj.t) -> 'e Prims.list -> Obj.t + = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem = mem1; equal = equal1; + subset = subset1; union = union1; inter = inter1; diff = diff1; + for_all = for_all1; for_any = for_any1; elems = elems1; + collect = collect1; from_list; addn;_} -> collect1 +let from_list : 'e . unit -> ('e, Obj.t) setlike -> 'e Prims.list -> Obj.t = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem = mem1; equal = equal1; + subset = subset1; union = union1; inter = inter1; diff = diff1; + for_all = for_all1; for_any = for_any1; elems = elems1; + collect = collect1; from_list = from_list1; addn;_} -> from_list1 +let addn : + 'e . unit -> ('e, Obj.t) setlike -> 'e Prims.list -> Obj.t -> Obj.t = + fun s -> + fun projectee -> + match projectee with + | { empty = empty1; singleton = singleton1; is_empty = is_empty1; + add = add1; remove = remove1; mem = mem1; equal = equal1; + subset = subset1; union = union1; inter = inter1; diff = diff1; + for_all = for_all1; for_any = for_any1; elems = elems1; + collect = collect1; from_list = from_list1; addn = addn1;_} -> + addn1 +let symdiff : 'e 's . ('e, 's) setlike -> 's -> 's -> 's = + fun uu___2 -> + fun uu___1 -> + fun uu___ -> + (fun uu___ -> + fun s1 -> + fun s2 -> + Obj.magic + (diff () (Obj.magic uu___) (Obj.magic s1) (Obj.magic s2))) + uu___2 uu___1 uu___ \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Compiler_Debug.ml b/ocaml/fstar-lib/generated/FStar_Compiler_Debug.ml new file mode 100644 index 00000000000..2315a9fdfe6 --- /dev/null +++ b/ocaml/fstar-lib/generated/FStar_Compiler_Debug.ml @@ -0,0 +1,143 @@ +open Prims +let (anyref : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Util.mk_ref false +let (_debug_all : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Util.mk_ref false +let (toggle_list : + (Prims.string * Prims.bool FStar_Compiler_Effect.ref) Prims.list + FStar_Compiler_Effect.ref) + = FStar_Compiler_Util.mk_ref [] +type saved_state = + { + toggles: (Prims.string * Prims.bool) Prims.list ; + any: Prims.bool ; + all: Prims.bool } +let (__proj__Mksaved_state__item__toggles : + saved_state -> (Prims.string * Prims.bool) Prims.list) = + fun projectee -> match projectee with | { toggles; any; all;_} -> toggles +let (__proj__Mksaved_state__item__any : saved_state -> Prims.bool) = + fun projectee -> match projectee with | { toggles; any; all;_} -> any +let (__proj__Mksaved_state__item__all : saved_state -> Prims.bool) = + fun projectee -> match projectee with | { toggles; any; all;_} -> all +let (snapshot : unit -> saved_state) = + fun uu___ -> + let uu___1 = + let uu___2 = FStar_Compiler_Effect.op_Bang toggle_list in + FStar_Compiler_List.map + (fun uu___3 -> + match uu___3 with + | (k, r) -> + let uu___4 = FStar_Compiler_Effect.op_Bang r in (k, uu___4)) + uu___2 in + let uu___2 = FStar_Compiler_Effect.op_Bang anyref in + let uu___3 = FStar_Compiler_Effect.op_Bang _debug_all in + { toggles = uu___1; any = uu___2; all = uu___3 } +let (register_toggle : Prims.string -> Prims.bool FStar_Compiler_Effect.ref) + = + fun k -> + let r = FStar_Compiler_Util.mk_ref false in + (let uu___1 = FStar_Compiler_Effect.op_Bang _debug_all in + if uu___1 then FStar_Compiler_Effect.op_Colon_Equals r true else ()); + (let uu___2 = + let uu___3 = FStar_Compiler_Effect.op_Bang toggle_list in (k, r) :: + uu___3 in + FStar_Compiler_Effect.op_Colon_Equals toggle_list uu___2); + r +let (get_toggle : Prims.string -> Prims.bool FStar_Compiler_Effect.ref) = + fun k -> + let uu___ = + let uu___1 = FStar_Compiler_Effect.op_Bang toggle_list in + FStar_Compiler_List.tryFind + (fun uu___2 -> match uu___2 with | (k', uu___3) -> k = k') uu___1 in + match uu___ with + | FStar_Pervasives_Native.Some (uu___1, r) -> r + | FStar_Pervasives_Native.None -> register_toggle k +let (restore : saved_state -> unit) = + fun snapshot1 -> + (let uu___1 = FStar_Compiler_Effect.op_Bang toggle_list in + FStar_Compiler_List.iter + (fun uu___2 -> + match uu___2 with + | (uu___3, r) -> FStar_Compiler_Effect.op_Colon_Equals r false) + uu___1); + FStar_Compiler_List.iter + (fun uu___2 -> + match uu___2 with + | (k, b) -> + let r = get_toggle k in + FStar_Compiler_Effect.op_Colon_Equals r b) snapshot1.toggles; + FStar_Compiler_Effect.op_Colon_Equals anyref snapshot1.any; + FStar_Compiler_Effect.op_Colon_Equals _debug_all snapshot1.all +let (list_all_toggles : unit -> Prims.string Prims.list) = + fun uu___ -> + let uu___1 = FStar_Compiler_Effect.op_Bang toggle_list in + FStar_Compiler_List.map FStar_Pervasives_Native.fst uu___1 +let (any : unit -> Prims.bool) = + fun uu___ -> + (FStar_Compiler_Effect.op_Bang anyref) || + (FStar_Compiler_Effect.op_Bang _debug_all) +let (enable : unit -> unit) = + fun uu___ -> FStar_Compiler_Effect.op_Colon_Equals anyref true +let (dbg_level : Prims.int FStar_Compiler_Effect.ref) = + FStar_Compiler_Util.mk_ref Prims.int_zero +let (low : unit -> Prims.bool) = + fun uu___ -> + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_level in + uu___1 >= Prims.int_one) || (FStar_Compiler_Effect.op_Bang _debug_all) +let (medium : unit -> Prims.bool) = + fun uu___ -> + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_level in + uu___1 >= (Prims.of_int (2))) || + (FStar_Compiler_Effect.op_Bang _debug_all) +let (high : unit -> Prims.bool) = + fun uu___ -> + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_level in + uu___1 >= (Prims.of_int (3))) || + (FStar_Compiler_Effect.op_Bang _debug_all) +let (extreme : unit -> Prims.bool) = + fun uu___ -> + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_level in + uu___1 >= (Prims.of_int (4))) || + (FStar_Compiler_Effect.op_Bang _debug_all) +let (set_level_low : unit -> unit) = + fun uu___ -> FStar_Compiler_Effect.op_Colon_Equals dbg_level Prims.int_one +let (set_level_medium : unit -> unit) = + fun uu___ -> + FStar_Compiler_Effect.op_Colon_Equals dbg_level (Prims.of_int (2)) +let (set_level_high : unit -> unit) = + fun uu___ -> + FStar_Compiler_Effect.op_Colon_Equals dbg_level (Prims.of_int (3)) +let (set_level_extreme : unit -> unit) = + fun uu___ -> + FStar_Compiler_Effect.op_Colon_Equals dbg_level (Prims.of_int (4)) +let (enable_toggles : Prims.string Prims.list -> unit) = + fun keys -> + if Prims.uu___is_Cons keys then enable () else (); + FStar_Compiler_List.iter + (fun k -> + if k = "Low" + then set_level_low () + else + if k = "Medium" + then set_level_medium () + else + if k = "High" + then set_level_high () + else + if k = "Extreme" + then set_level_extreme () + else + (let t = get_toggle k in + FStar_Compiler_Effect.op_Colon_Equals t true)) keys +let (disable_all : unit -> unit) = + fun uu___ -> + FStar_Compiler_Effect.op_Colon_Equals anyref false; + FStar_Compiler_Effect.op_Colon_Equals dbg_level Prims.int_zero; + (let uu___3 = FStar_Compiler_Effect.op_Bang toggle_list in + FStar_Compiler_List.iter + (fun uu___4 -> + match uu___4 with + | (uu___5, r) -> FStar_Compiler_Effect.op_Colon_Equals r false) + uu___3) +let (set_debug_all : unit -> unit) = + fun uu___ -> FStar_Compiler_Effect.op_Colon_Equals _debug_all true \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Compiler_FlatSet.ml b/ocaml/fstar-lib/generated/FStar_Compiler_FlatSet.ml new file mode 100644 index 00000000000..0a701e59788 --- /dev/null +++ b/ocaml/fstar-lib/generated/FStar_Compiler_FlatSet.ml @@ -0,0 +1,138 @@ +open Prims +type 't flat_set = 't Prims.list +type 'a t = 'a flat_set +let rec add : 'a . 'a FStar_Class_Ord.ord -> 'a -> 'a flat_set -> 'a flat_set + = + fun uu___ -> + fun x -> + fun s -> + match s with + | [] -> [x] + | y::yy -> + let uu___1 = + FStar_Class_Deq.op_Equals_Question + (FStar_Class_Ord.ord_eq uu___) x y in + if uu___1 + then s + else (let uu___3 = add uu___ x yy in y :: uu___3) +let empty : 'a . unit -> 'a flat_set = fun uu___ -> [] +let from_list : 'a . 'a FStar_Class_Ord.ord -> 'a Prims.list -> 'a flat_set = + fun uu___ -> fun xs -> FStar_Class_Ord.dedup uu___ xs +let mem : 'a . 'a FStar_Class_Ord.ord -> 'a -> 'a flat_set -> Prims.bool = + fun uu___ -> + fun x -> + fun s -> + FStar_Compiler_List.existsb + (fun y -> + FStar_Class_Deq.op_Equals_Question + (FStar_Class_Ord.ord_eq uu___) x y) s +let singleton : 'a . 'a FStar_Class_Ord.ord -> 'a -> 'a flat_set = + fun uu___ -> fun x -> [x] +let is_empty : 'a . 'a flat_set -> Prims.bool = fun s -> Prims.uu___is_Nil s +let addn : + 'a . 'a FStar_Class_Ord.ord -> 'a Prims.list -> 'a flat_set -> 'a flat_set + = + fun uu___ -> + fun xs -> fun ys -> FStar_Compiler_List.fold_right (add uu___) xs ys +let rec remove : + 'a . 'a FStar_Class_Ord.ord -> 'a -> 'a flat_set -> 'a flat_set = + fun uu___ -> + fun x -> + fun s -> + match s with + | [] -> [] + | y::yy -> + let uu___1 = + FStar_Class_Deq.op_Equals_Question + (FStar_Class_Ord.ord_eq uu___) x y in + if uu___1 + then yy + else (let uu___3 = remove uu___ x yy in y :: uu___3) +let elems : 'a . 'a flat_set -> 'a Prims.list = fun s -> s +let for_all : 'a . ('a -> Prims.bool) -> 'a flat_set -> Prims.bool = + fun p -> + fun s -> let uu___ = elems s in FStar_Compiler_List.for_all p uu___ +let for_any : 'a . ('a -> Prims.bool) -> 'a flat_set -> Prims.bool = + fun p -> + fun s -> let uu___ = elems s in FStar_Compiler_List.existsb p uu___ +let subset : + 'a . 'a FStar_Class_Ord.ord -> 'a flat_set -> 'a flat_set -> Prims.bool = + fun uu___ -> fun s1 -> fun s2 -> for_all (fun y -> mem uu___ y s2) s1 +let equal : + 'a . 'a FStar_Class_Ord.ord -> 'a flat_set -> 'a flat_set -> Prims.bool = + fun uu___ -> + fun s1 -> + fun s2 -> + let uu___1 = FStar_Class_Ord.sort uu___ s1 in + let uu___2 = FStar_Class_Ord.sort uu___ s2 in + FStar_Class_Deq.op_Equals_Question + (FStar_Class_Ord.ord_eq (FStar_Class_Ord.ord_list uu___)) uu___1 + uu___2 +let union : + 'a . 'a FStar_Class_Ord.ord -> 'a flat_set -> 'a flat_set -> 'a flat_set = + fun uu___ -> + fun s1 -> + fun s2 -> + FStar_Compiler_List.fold_left (fun s -> fun x -> add uu___ x s) s1 s2 +let inter : + 'a . 'a FStar_Class_Ord.ord -> 'a flat_set -> 'a flat_set -> 'a flat_set = + fun uu___ -> + fun s1 -> + fun s2 -> FStar_Compiler_List.filter (fun y -> mem uu___ y s2) s1 +let diff : + 'a . 'a FStar_Class_Ord.ord -> 'a flat_set -> 'a flat_set -> 'a flat_set = + fun uu___ -> + fun s1 -> + fun s2 -> + FStar_Compiler_List.filter + (fun y -> let uu___1 = mem uu___ y s2 in Prims.op_Negation uu___1) + s1 +let collect : + 'a 'b . + 'b FStar_Class_Ord.ord -> + ('a -> 'b flat_set) -> 'a Prims.list -> 'b flat_set + = + fun uu___ -> + fun f -> + fun l -> + let uu___1 = empty () in + FStar_Compiler_List.fold_right + (fun x -> fun acc -> let uu___2 = f x in union uu___ uu___2 acc) l + uu___1 +let showable_set : + 'a . + 'a FStar_Class_Ord.ord -> + 'a FStar_Class_Show.showable -> 'a flat_set FStar_Class_Show.showable + = + fun uu___ -> + fun uu___1 -> + { + FStar_Class_Show.show = + (fun s -> + let uu___2 = elems s in + FStar_Class_Show.show (FStar_Class_Show.show_list uu___1) uu___2) + } +let setlike_flat_set : + 'a . + 'a FStar_Class_Ord.ord -> ('a, 'a flat_set) FStar_Class_Setlike.setlike + = + fun uu___ -> + { + FStar_Class_Setlike.empty = empty; + FStar_Class_Setlike.singleton = (singleton uu___); + FStar_Class_Setlike.is_empty = is_empty; + FStar_Class_Setlike.add = (add uu___); + FStar_Class_Setlike.remove = (remove uu___); + FStar_Class_Setlike.mem = (mem uu___); + FStar_Class_Setlike.equal = (equal uu___); + FStar_Class_Setlike.subset = (subset uu___); + FStar_Class_Setlike.union = (union uu___); + FStar_Class_Setlike.inter = (inter uu___); + FStar_Class_Setlike.diff = (diff uu___); + FStar_Class_Setlike.for_all = for_all; + FStar_Class_Setlike.for_any = for_any; + FStar_Class_Setlike.elems = elems; + FStar_Class_Setlike.collect = (collect uu___); + FStar_Class_Setlike.from_list = (from_list uu___); + FStar_Class_Setlike.addn = (addn uu___) + } \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Compiler_RBSet.ml b/ocaml/fstar-lib/generated/FStar_Compiler_RBSet.ml new file mode 100644 index 00000000000..7d93f137aaf --- /dev/null +++ b/ocaml/fstar-lib/generated/FStar_Compiler_RBSet.ml @@ -0,0 +1,228 @@ +open Prims +type color = + | R + | B +let (uu___is_R : color -> Prims.bool) = + fun projectee -> match projectee with | R -> true | uu___ -> false +let (uu___is_B : color -> Prims.bool) = + fun projectee -> match projectee with | B -> true | uu___ -> false +type 'a rbset = + | L + | N of (color * 'a rbset * 'a * 'a rbset) +let uu___is_L : 'a . 'a rbset -> Prims.bool = + fun projectee -> match projectee with | L -> true | uu___ -> false +let uu___is_N : 'a . 'a rbset -> Prims.bool = + fun projectee -> match projectee with | N _0 -> true | uu___ -> false +let __proj__N__item___0 : 'a . 'a rbset -> (color * 'a rbset * 'a * 'a rbset) + = fun projectee -> match projectee with | N _0 -> _0 +type 'a t = 'a rbset +let empty : 'uuuuu . unit -> 'uuuuu rbset = fun uu___ -> L +let singleton : 'a . 'a -> 'a rbset = fun x -> N (R, L, x, L) +let is_empty : 'uuuuu . unit -> 'uuuuu rbset -> Prims.bool = + fun uu___ -> uu___is_L +let balance : + 'uuuuu . color -> 'uuuuu rbset -> 'uuuuu -> 'uuuuu rbset -> 'uuuuu rbset = + fun c -> + fun l -> + fun x -> + fun r -> + match (c, l, x, r) with + | (B, N (R, N (R, a, x1, b), y, c1), z, d) -> + N (R, (N (B, a, x1, b)), y, (N (B, c1, z, d))) + | (B, a, x1, N (R, N (R, b, y, c1), z, d)) -> + N (R, (N (B, a, x1, b)), y, (N (B, c1, z, d))) + | (B, N (R, a, x1, N (R, b, y, c1)), z, d) -> + N (R, (N (B, a, x1, b)), y, (N (B, c1, z, d))) + | (B, a, x1, N (R, b, y, N (R, c1, z, d))) -> + N (R, (N (B, a, x1, b)), y, (N (B, c1, z, d))) + | (c1, l1, x1, r1) -> N (c1, l1, x1, r1) +let blackroot : 'a . 'a rbset -> 'a rbset = + fun t1 -> match t1 with | N (uu___, l, x, r) -> N (B, l, x, r) +let add : 'a . 'a FStar_Class_Ord.ord -> 'a -> 'a rbset -> 'a rbset = + fun uu___ -> + fun x -> + fun s -> + let rec add' s1 = + match s1 with + | L -> N (R, L, x, L) + | N (c, a1, y, b) -> + let uu___1 = FStar_Class_Ord.op_Less_Question uu___ x y in + if uu___1 + then let uu___2 = add' a1 in balance c uu___2 y b + else + (let uu___3 = FStar_Class_Ord.op_Greater_Question uu___ x y in + if uu___3 + then let uu___4 = add' b in balance c a1 y uu___4 + else s1) in + let uu___1 = add' s in blackroot uu___1 +let rec extract_min : + 'a . 'a FStar_Class_Ord.ord -> 'a rbset -> ('a rbset * 'a) = + fun uu___ -> + fun t1 -> + match t1 with + | N (uu___1, L, x, r) -> (r, x) + | N (c, a1, x, b) -> + let uu___1 = extract_min uu___ a1 in + (match uu___1 with | (a', y) -> ((balance c a' x b), y)) +let rec remove : 'a . 'a FStar_Class_Ord.ord -> 'a -> 'a rbset -> 'a rbset = + fun uu___ -> + fun x -> + fun t1 -> + match t1 with + | L -> L + | N (c, l, y, r) -> + let uu___1 = FStar_Class_Ord.op_Less_Question uu___ x y in + if uu___1 + then let uu___2 = remove uu___ x l in balance c uu___2 y r + else + (let uu___3 = FStar_Class_Ord.op_Greater_Question uu___ x y in + if uu___3 + then let uu___4 = remove uu___ x r in balance c l y uu___4 + else + if uu___is_L r + then l + else + (let uu___6 = extract_min uu___ r in + match uu___6 with | (r', y') -> balance c l y' r')) +let rec mem : 'a . 'a FStar_Class_Ord.ord -> 'a -> 'a rbset -> Prims.bool = + fun uu___ -> + fun x -> + fun s -> + match s with + | L -> false + | N (uu___1, a1, y, b) -> + let uu___2 = FStar_Class_Ord.op_Less_Question uu___ x y in + if uu___2 + then mem uu___ x a1 + else + (let uu___4 = FStar_Class_Ord.op_Greater_Question uu___ x y in + if uu___4 then mem uu___ x b else true) +let rec elems : 'a . 'a rbset -> 'a Prims.list = + fun s -> + match s with + | L -> [] + | N (uu___, a1, x, b) -> + let uu___1 = elems a1 in + let uu___2 = + let uu___3 = elems b in FStar_List_Tot_Base.append [x] uu___3 in + FStar_List_Tot_Base.append uu___1 uu___2 +let equal : 'a . 'a FStar_Class_Ord.ord -> 'a rbset -> 'a rbset -> Prims.bool + = + fun uu___ -> + fun s1 -> + fun s2 -> + let uu___1 = elems s1 in + let uu___2 = elems s2 in + FStar_Class_Deq.op_Equals_Question + (FStar_Class_Ord.ord_eq (FStar_Class_Ord.ord_list uu___)) uu___1 + uu___2 +let rec union : + 'a . 'a FStar_Class_Ord.ord -> 'a rbset -> 'a rbset -> 'a rbset = + fun uu___ -> + fun s1 -> + fun s2 -> + match s1 with + | L -> s2 + | N (c, a1, x, b) -> + let uu___1 = let uu___2 = add uu___ x s2 in union uu___ b uu___2 in + union uu___ a1 uu___1 +let inter : 'a . 'a FStar_Class_Ord.ord -> 'a rbset -> 'a rbset -> 'a rbset = + fun uu___ -> + fun s1 -> + fun s2 -> + let rec aux s11 acc = + match s11 with + | L -> acc + | N (uu___1, a1, x, b) -> + let uu___2 = mem uu___ x s2 in + if uu___2 + then + let uu___3 = let uu___4 = aux b acc in aux a1 uu___4 in + add uu___ x uu___3 + else (let uu___4 = aux b acc in aux a1 uu___4) in + aux s1 L +let rec diff : + 'a . 'a FStar_Class_Ord.ord -> 'a rbset -> 'a rbset -> 'a rbset = + fun uu___ -> + fun s1 -> + fun s2 -> + match s2 with + | L -> s1 + | N (uu___1, a1, x, b) -> + let uu___2 = + let uu___3 = remove uu___ x s1 in diff uu___ uu___3 a1 in + diff uu___ uu___2 b +let rec subset : + 'a . 'a FStar_Class_Ord.ord -> 'a rbset -> 'a rbset -> Prims.bool = + fun uu___ -> + fun s1 -> + fun s2 -> + match s1 with + | L -> true + | N (uu___1, a1, x, b) -> + ((mem uu___ x s2) && (subset uu___ a1 s2)) && (subset uu___ b s2) +let rec for_all : 'a . ('a -> Prims.bool) -> 'a rbset -> Prims.bool = + fun p -> + fun s -> + match s with + | L -> true + | N (uu___, a1, x, b) -> ((p x) && (for_all p a1)) && (for_all p b) +let rec for_any : 'a . ('a -> Prims.bool) -> 'a rbset -> Prims.bool = + fun p -> + fun s -> + match s with + | L -> false + | N (uu___, a1, x, b) -> ((p x) || (for_any p a1)) || (for_any p b) +let from_list : 'a . 'a FStar_Class_Ord.ord -> 'a Prims.list -> 'a rbset = + fun uu___ -> + fun xs -> + FStar_Compiler_List.fold_left (fun s -> fun e -> add uu___ e s) L xs +let addn : + 'a . 'a FStar_Class_Ord.ord -> 'a Prims.list -> 'a rbset -> 'a rbset = + fun uu___ -> + fun xs -> + fun s -> + FStar_Compiler_List.fold_left (fun s1 -> fun e -> add uu___ e s1) s + xs +let collect : + 'a . + 'a FStar_Class_Ord.ord -> ('a -> 'a rbset) -> 'a Prims.list -> 'a rbset + = + fun uu___ -> + fun f -> + fun l -> + FStar_Compiler_List.fold_left + (fun s -> fun e -> let uu___1 = f e in union uu___ uu___1 s) L l +let setlike_rbset : + 'a . 'a FStar_Class_Ord.ord -> ('a, 'a t) FStar_Class_Setlike.setlike = + fun uu___ -> + { + FStar_Class_Setlike.empty = empty; + FStar_Class_Setlike.singleton = singleton; + FStar_Class_Setlike.is_empty = (is_empty ()); + FStar_Class_Setlike.add = (add uu___); + FStar_Class_Setlike.remove = (remove uu___); + FStar_Class_Setlike.mem = (mem uu___); + FStar_Class_Setlike.equal = (equal uu___); + FStar_Class_Setlike.subset = (subset uu___); + FStar_Class_Setlike.union = (union uu___); + FStar_Class_Setlike.inter = (inter uu___); + FStar_Class_Setlike.diff = (diff uu___); + FStar_Class_Setlike.for_all = for_all; + FStar_Class_Setlike.for_any = for_any; + FStar_Class_Setlike.elems = elems; + FStar_Class_Setlike.collect = (collect uu___); + FStar_Class_Setlike.from_list = (from_list uu___); + FStar_Class_Setlike.addn = (addn uu___) + } +let showable_rbset : + 'a . 'a FStar_Class_Show.showable -> 'a t FStar_Class_Show.showable = + fun uu___ -> + { + FStar_Class_Show.show = + (fun s -> + let uu___1 = + let uu___2 = elems s in + FStar_Class_Show.show (FStar_Class_Show.show_list uu___) uu___2 in + Prims.strcat "RBSet " uu___1) + } \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Compiler_Range_Ops.ml b/ocaml/fstar-lib/generated/FStar_Compiler_Range_Ops.ml index a0c0ef1c24a..16520664139 100644 --- a/ocaml/fstar-lib/generated/FStar_Compiler_Range_Ops.ml +++ b/ocaml/fstar-lib/generated/FStar_Compiler_Range_Ops.ml @@ -255,5 +255,12 @@ let (json_of_def_range : FStar_Compiler_Range_Type.range -> FStar_Json.json) let uu___ = file_of_range r in let uu___1 = start_of_range r in let uu___2 = end_of_range r in json_of_range_fields uu___ uu___1 uu___2 -let (show_range : FStar_Compiler_Range_Type.range FStar_Class_Show.showable) - = { FStar_Class_Show.show = string_of_range } \ No newline at end of file +let (showable_range : + FStar_Compiler_Range_Type.range FStar_Class_Show.showable) = + { FStar_Class_Show.show = string_of_range } +let (pretty_range : FStar_Compiler_Range_Type.range FStar_Class_PP.pretty) = + { + FStar_Class_PP.pp = + (fun r -> + let uu___ = string_of_range r in FStar_Pprint.doc_of_string uu___) + } \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Compiler_Set.ml b/ocaml/fstar-lib/generated/FStar_Compiler_Set.ml deleted file mode 100644 index 224379a4f80..00000000000 --- a/ocaml/fstar-lib/generated/FStar_Compiler_Set.ml +++ /dev/null @@ -1,112 +0,0 @@ -open Prims -type 't set = 't Prims.list -type 'a t = 'a set -let rec add : 'a . 'a FStar_Class_Ord.ord -> 'a -> 'a set -> 'a set = - fun uu___ -> - fun x -> - fun s -> - match s with - | [] -> [x] - | y::yy -> - let uu___1 = - FStar_Class_Deq.op_Equals_Question - (FStar_Class_Ord.ord_eq uu___) x y in - if uu___1 - then s - else (let uu___3 = add uu___ x yy in y :: uu___3) -let empty : 'a . 'a FStar_Class_Ord.ord -> unit -> 'a set = - fun uu___ -> fun uu___1 -> [] -let from_list : 'a . 'a FStar_Class_Ord.ord -> 'a Prims.list -> 'a set = - fun uu___ -> fun xs -> FStar_Class_Ord.dedup uu___ xs -let mem : 'a . 'a FStar_Class_Ord.ord -> 'a -> 'a set -> Prims.bool = - fun uu___ -> - fun x -> - fun s -> - FStar_Compiler_List.existsb - (fun y -> - FStar_Class_Deq.op_Equals_Question - (FStar_Class_Ord.ord_eq uu___) x y) s -let singleton : 'a . 'a FStar_Class_Ord.ord -> 'a -> 'a set = - fun uu___ -> fun x -> [x] -let is_empty : 'a . 'a FStar_Class_Ord.ord -> 'a set -> Prims.bool = - fun uu___ -> fun s -> Prims.uu___is_Nil s -let addn : 'a . 'a FStar_Class_Ord.ord -> 'a Prims.list -> 'a set -> 'a set = - fun uu___ -> - fun xs -> fun ys -> FStar_Compiler_List.fold_right (add uu___) xs ys -let rec remove : 'a . 'a FStar_Class_Ord.ord -> 'a -> 'a set -> 'a set = - fun uu___ -> - fun x -> - fun s -> - match s with - | [] -> [] - | y::yy -> - let uu___1 = - FStar_Class_Deq.op_Equals_Question - (FStar_Class_Ord.ord_eq uu___) x y in - if uu___1 - then yy - else (let uu___3 = remove uu___ x yy in y :: uu___3) -let elems : 'a . 'a FStar_Class_Ord.ord -> 'a set -> 'a Prims.list = - fun uu___ -> fun s -> s -let for_all : - 'a . 'a FStar_Class_Ord.ord -> ('a -> Prims.bool) -> 'a set -> Prims.bool = - fun uu___ -> - fun p -> - fun s -> - let uu___1 = elems uu___ s in FStar_Compiler_List.for_all p uu___1 -let for_any : - 'a . 'a FStar_Class_Ord.ord -> ('a -> Prims.bool) -> 'a set -> Prims.bool = - fun uu___ -> - fun p -> - fun s -> - let uu___1 = elems uu___ s in FStar_Compiler_List.existsb p uu___1 -let subset : 'a . 'a FStar_Class_Ord.ord -> 'a set -> 'a set -> Prims.bool = - fun uu___ -> fun s1 -> fun s2 -> for_all uu___ (fun y -> mem uu___ y s2) s1 -let equal : 'a . 'a FStar_Class_Ord.ord -> 'a set -> 'a set -> Prims.bool = - fun uu___ -> - fun s1 -> - fun s2 -> - let uu___1 = FStar_Class_Ord.sort uu___ s1 in - let uu___2 = FStar_Class_Ord.sort uu___ s2 in - FStar_Class_Deq.op_Equals_Question - (FStar_Class_Ord.ord_eq (FStar_Class_Ord.ord_list uu___)) uu___1 - uu___2 -let union : 'a . 'a FStar_Class_Ord.ord -> 'a set -> 'a set -> 'a set = - fun uu___ -> - fun s1 -> - fun s2 -> - FStar_Compiler_List.fold_left (fun s -> fun x -> add uu___ x s) s1 s2 -let inter : 'a . 'a FStar_Class_Ord.ord -> 'a set -> 'a set -> 'a set = - fun uu___ -> - fun s1 -> - fun s2 -> FStar_Compiler_List.filter (fun y -> mem uu___ y s2) s1 -let diff : 'a . 'a FStar_Class_Ord.ord -> 'a set -> 'a set -> 'a set = - fun uu___ -> - fun s1 -> - fun s2 -> - FStar_Compiler_List.filter - (fun y -> let uu___1 = mem uu___ y s2 in Prims.op_Negation uu___1) - s1 -let collect : - 'a 'b . 'b FStar_Class_Ord.ord -> ('a -> 'b set) -> 'a Prims.list -> 'b set - = - fun uu___ -> - fun f -> - fun l -> - let uu___1 = empty uu___ () in - FStar_Compiler_List.fold_right - (fun x -> fun acc -> let uu___2 = f x in union uu___ uu___2 acc) l - uu___1 -let showable_set : - 'a . - 'a FStar_Class_Ord.ord -> - 'a FStar_Class_Show.showable -> 'a set FStar_Class_Show.showable - = - fun uu___ -> - fun uu___1 -> - { - FStar_Class_Show.show = - (fun s -> - let uu___2 = elems uu___ s in - FStar_Class_Show.show (FStar_Class_Show.show_list uu___1) uu___2) - } \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Defensive.ml b/ocaml/fstar-lib/generated/FStar_Defensive.ml index 2f456ecca1d..87160bf072b 100644 --- a/ocaml/fstar-lib/generated/FStar_Defensive.ml +++ b/ocaml/fstar-lib/generated/FStar_Defensive.ml @@ -10,7 +10,7 @@ let pp_set : 'a . 'a FStar_Class_Ord.ord -> 'a FStar_Class_PP.pretty -> - 'a FStar_Compiler_Set.set FStar_Class_PP.pretty + 'a FStar_Compiler_FlatSet.t FStar_Class_PP.pretty = fun uu___ -> fun uu___1 -> @@ -26,7 +26,10 @@ let pp_set : Prims.int_zero uu___2 FStar_Pprint.lbracket uu___3 FStar_Pprint.rbracket ds in let uu___2 = - let uu___3 = FStar_Compiler_Set.elems uu___ s in + let uu___3 = + FStar_Class_Setlike.elems () + (Obj.magic (FStar_Compiler_FlatSet.setlike_flat_set uu___)) + (Obj.magic s) in FStar_Compiler_List.map (FStar_Class_PP.pp uu___1) uu___3 in doclist uu___2) } @@ -49,8 +52,11 @@ let __def_check_scoped : let scope = FStar_Class_Binders.boundNames uu___ env in let uu___3 = let uu___4 = - FStar_Compiler_Set.subset FStar_Syntax_Syntax.ord_bv free - scope in + FStar_Class_Setlike.subset () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) (Obj.magic free) + (Obj.magic scope) in Prims.op_Negation uu___4 in if uu___3 then @@ -90,8 +96,12 @@ let __def_check_scoped : let uu___15 = FStar_Errors_Msg.text "Diff =" in let uu___16 = let uu___17 = - FStar_Compiler_Set.diff - FStar_Syntax_Syntax.ord_bv free scope in + Obj.magic + (FStar_Class_Setlike.diff () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic free) (Obj.magic scope)) in FStar_Class_PP.pp (pp_set FStar_Syntax_Syntax.ord_bv pp_bv) uu___17 in diff --git a/ocaml/fstar-lib/generated/FStar_Errors.ml b/ocaml/fstar-lib/generated/FStar_Errors.ml index 5357dc35905..cbe4cb4e8c4 100644 --- a/ocaml/fstar-lib/generated/FStar_Errors.ml +++ b/ocaml/fstar-lib/generated/FStar_Errors.ml @@ -389,19 +389,18 @@ let (format_issue' : Prims.bool -> issue -> Prims.string) = FStar_Pprint.op_Hat_Hat FStar_Pprint.hardline uu___2 in FStar_Pprint.op_Hat_Hat l uu___1) uu___ t | uu___ -> FStar_Pprint.empty in + let subdoc = FStar_Errors_Msg.subdoc' print_hdr in let mainmsg = let uu___ = FStar_Compiler_List.map - (fun d -> - let uu___1 = FStar_Pprint.group d in - FStar_Errors_Msg.subdoc uu___1) issue1.issue_msg in + (fun d -> let uu___1 = FStar_Pprint.group d in subdoc uu___1) + issue1.issue_msg in FStar_Pprint.concat uu___ in let doc = let uu___ = let uu___1 = - let uu___2 = FStar_Errors_Msg.subdoc seealso in - let uu___3 = FStar_Errors_Msg.subdoc ctx in - FStar_Pprint.op_Hat_Hat uu___2 uu___3 in + let uu___2 = subdoc seealso in + let uu___3 = subdoc ctx in FStar_Pprint.op_Hat_Hat uu___2 uu___3 in FStar_Pprint.op_Hat_Hat mainmsg uu___1 in FStar_Pprint.op_Hat_Hat hdr uu___ in FStar_Errors_Msg.renderdoc doc @@ -413,7 +412,7 @@ let (print_issue : issue -> unit) = match issue1.issue_level with | EInfo -> (fun s -> - let uu___ = FStar_Compiler_Util.colorize_magenta s in + let uu___ = FStar_Compiler_Util.colorize_cyan s in FStar_Compiler_Util.print_string uu___) | EWarning -> FStar_Compiler_Util.print_warning | EError -> FStar_Compiler_Util.print_error @@ -483,7 +482,7 @@ let (mk_default_handler : Prims.bool -> error_handler) = else (); (match e.issue_level with | EInfo -> print_issue e - | uu___2 when print && (FStar_Options.debug_any ()) -> print_issue e + | uu___2 when print && (FStar_Compiler_Debug.any ()) -> print_issue e | uu___2 -> let uu___3 = let uu___4 = FStar_Compiler_Effect.op_Bang issues in e :: uu___4 in @@ -649,7 +648,7 @@ let (diag_doc : = fun r -> fun msg -> - let uu___ = FStar_Options.debug_any () in + let uu___ = FStar_Compiler_Debug.any () in if uu___ then let msg1 = maybe_add_backtrace msg in @@ -663,7 +662,7 @@ let (diag : FStar_Compiler_Range_Type.range -> Prims.string -> unit) = fun msg -> let uu___ = FStar_Errors_Msg.mkmsg msg in diag_doc r uu___ let (diag0 : Prims.string -> unit) = fun msg -> - let uu___ = FStar_Options.debug_any () in + let uu___ = FStar_Compiler_Debug.any () in if uu___ then let uu___1 = @@ -740,7 +739,7 @@ let (set_option_warning_callback_range : FStar_Compiler_Range_Type.range FStar_Pervasives_Native.option -> unit) = fun ropt -> FStar_Options.set_option_warning_callback (warn_unsafe_options ropt) -let (uu___385 : +let (uu___386 : (((Prims.string -> FStar_Errors_Codes.error_setting Prims.list) -> unit) * (unit -> FStar_Errors_Codes.error_setting Prims.list))) = @@ -786,10 +785,10 @@ let (uu___385 : (set_callbacks, get_error_flags) let (t_set_parse_warn_error : (Prims.string -> FStar_Errors_Codes.error_setting Prims.list) -> unit) = - match uu___385 with + match uu___386 with | (t_set_parse_warn_error1, error_flags) -> t_set_parse_warn_error1 let (error_flags : unit -> FStar_Errors_Codes.error_setting Prims.list) = - match uu___385 with + match uu___386 with | (t_set_parse_warn_error1, error_flags1) -> error_flags1 let (set_parse_warn_error : (Prims.string -> FStar_Errors_Codes.error_setting Prims.list) -> unit) = diff --git a/ocaml/fstar-lib/generated/FStar_Errors_Msg.ml b/ocaml/fstar-lib/generated/FStar_Errors_Msg.ml index f1459a8ec5f..82b51469080 100644 --- a/ocaml/fstar-lib/generated/FStar_Errors_Msg.ml +++ b/ocaml/fstar-lib/generated/FStar_Errors_Msg.ml @@ -45,22 +45,29 @@ let (backtrace_doc : unit -> FStar_Pprint.document) = let uu___2 = FStar_Pprint.arbitrary_string (FStar_Compiler_Util.trim_string s) in FStar_Pprint.op_Hat_Slash_Hat uu___1 uu___2 +let (subdoc' : Prims.bool -> FStar_Pprint.document -> FStar_Pprint.document) + = + fun indent -> + fun d -> + if d = FStar_Pprint.empty + then FStar_Pprint.empty + else + (let uu___1 = + if indent + then FStar_Pprint.blank (Prims.of_int (2)) + else FStar_Pprint.empty in + let uu___2 = + let uu___3 = FStar_Pprint.doc_of_string "-" in + let uu___4 = + let uu___5 = FStar_Pprint.blank Prims.int_one in + let uu___6 = + let uu___7 = FStar_Pprint.align d in + FStar_Pprint.op_Hat_Hat uu___7 FStar_Pprint.hardline in + FStar_Pprint.op_Hat_Hat uu___5 uu___6 in + FStar_Pprint.op_Hat_Hat uu___3 uu___4 in + FStar_Pprint.op_Hat_Hat uu___1 uu___2) let (subdoc : FStar_Pprint.document -> FStar_Pprint.document) = - fun d -> - if d = FStar_Pprint.empty - then FStar_Pprint.empty - else - (let uu___1 = FStar_Pprint.blank (Prims.of_int (2)) in - let uu___2 = - let uu___3 = FStar_Pprint.doc_of_string "-" in - let uu___4 = - let uu___5 = FStar_Pprint.blank Prims.int_one in - let uu___6 = - let uu___7 = FStar_Pprint.align d in - FStar_Pprint.op_Hat_Hat uu___7 FStar_Pprint.hardline in - FStar_Pprint.op_Hat_Hat uu___5 uu___6 in - FStar_Pprint.op_Hat_Hat uu___3 uu___4 in - FStar_Pprint.op_Hat_Hat uu___1 uu___2) + fun d -> subdoc' true d let (rendermsg : error_message -> Prims.string) = fun ds -> let uu___ = diff --git a/ocaml/fstar-lib/generated/FStar_Extraction_ML_Modul.ml b/ocaml/fstar-lib/generated/FStar_Extraction_ML_Modul.ml index 58dcb7cf5c0..7736e0f1b26 100644 --- a/ocaml/fstar-lib/generated/FStar_Extraction_ML_Modul.ml +++ b/ocaml/fstar-lib/generated/FStar_Extraction_ML_Modul.ml @@ -1,4 +1,6 @@ open Prims +let (dbg_ExtractionReify : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "ExtractionReify" type tydef_declaration = (FStar_Extraction_ML_Syntax.mlsymbol * FStar_Extraction_ML_Syntax.metadata * Prims.int) @@ -450,13 +452,14 @@ let (bundle_as_inductive_families : FStar_Syntax_Syntax.num_uniform_params = uu___1; FStar_Syntax_Syntax.t = t; FStar_Syntax_Syntax.mutuals = uu___2; - FStar_Syntax_Syntax.ds = datas;_} + FStar_Syntax_Syntax.ds = datas; + FStar_Syntax_Syntax.injective_type_params = uu___3;_} -> - let uu___3 = FStar_Syntax_Subst.open_univ_vars us t in - (match uu___3 with + let uu___4 = FStar_Syntax_Subst.open_univ_vars us t in + (match uu___4 with | (_us, t1) -> - let uu___4 = FStar_Syntax_Subst.open_term bs t1 in - (match uu___4 with + let uu___5 = FStar_Syntax_Subst.open_term bs t1 in + (match uu___5 with | (bs1, t2) -> let datas1 = FStar_Compiler_List.collect @@ -471,93 +474,95 @@ let (bundle_as_inductive_families : FStar_Syntax_Syntax.num_ty_params = nparams; FStar_Syntax_Syntax.mutuals1 = - uu___5;_} + uu___6; + FStar_Syntax_Syntax.injective_type_params1 + = uu___7;_} when FStar_Ident.lid_equals l l' -> - let uu___6 = + let uu___8 = FStar_Syntax_Subst.open_univ_vars us1 t3 in - (match uu___6 with + (match uu___8 with | (_us1, t4) -> - let uu___7 = + let uu___9 = FStar_Syntax_Util.arrow_formals t4 in - (match uu___7 with + (match uu___9 with | (bs', body) -> - let uu___8 = + let uu___10 = FStar_Compiler_Util.first_N (FStar_Compiler_List.length bs1) bs' in - (match uu___8 with + (match uu___10 with | (bs_params, rest) -> let subst = FStar_Compiler_List.map2 - (fun uu___9 -> - fun uu___10 + (fun uu___11 -> + fun uu___12 -> match - (uu___9, - uu___10) + (uu___11, + uu___12) with | ({ FStar_Syntax_Syntax.binder_bv = b'; FStar_Syntax_Syntax.binder_qual - = uu___11; + = uu___13; FStar_Syntax_Syntax.binder_positivity - = uu___12; + = uu___14; FStar_Syntax_Syntax.binder_attrs - = uu___13;_}, + = uu___15;_}, { FStar_Syntax_Syntax.binder_bv = b; FStar_Syntax_Syntax.binder_qual - = uu___14; + = uu___16; FStar_Syntax_Syntax.binder_positivity - = uu___15; + = uu___17; FStar_Syntax_Syntax.binder_attrs - = uu___16;_}) + = uu___18;_}) -> - let uu___17 + let uu___19 = - let uu___18 + let uu___20 = FStar_Syntax_Syntax.bv_to_name b in (b', - uu___18) in + uu___20) in FStar_Syntax_Syntax.NT - uu___17) + uu___19) bs_params bs1 in let t5 = - let uu___9 = - let uu___10 = + let uu___11 = + let uu___12 = FStar_Syntax_Syntax.mk_Total body in FStar_Syntax_Util.arrow - rest uu___10 in + rest uu___12 in FStar_Syntax_Subst.subst - subst uu___9 in + subst uu___11 in [{ dname = d; dtyp = t5 }]))) - | uu___5 -> []) ses in + | uu___6 -> []) ses in let metadata = - let uu___5 = + let uu___6 = extract_metadata se.FStar_Syntax_Syntax.sigattrs in - let uu___6 = + let uu___7 = FStar_Compiler_List.choose flag_of_qual quals in - FStar_Compiler_List.op_At uu___5 uu___6 in + FStar_Compiler_List.op_At uu___6 uu___7 in let fv = FStar_Syntax_Syntax.lid_as_fv l FStar_Pervasives_Native.None in - let uu___5 = + let uu___6 = FStar_Extraction_ML_UEnv.extend_type_name env1 fv in - (match uu___5 with - | (uu___6, env2) -> + (match uu___6 with + | (uu___7, env2) -> (env2, [{ ifv = fv; @@ -1029,17 +1034,18 @@ let (extract_bundle_iface : FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___1; FStar_Syntax_Syntax.num_ty_params = uu___2; - FStar_Syntax_Syntax.mutuals1 = uu___3;_}; - FStar_Syntax_Syntax.sigrng = uu___4; - FStar_Syntax_Syntax.sigquals = uu___5; - FStar_Syntax_Syntax.sigmeta = uu___6; - FStar_Syntax_Syntax.sigattrs = uu___7; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___8; - FStar_Syntax_Syntax.sigopts = uu___9;_}::[]; - FStar_Syntax_Syntax.lids = uu___10;_}, + FStar_Syntax_Syntax.mutuals1 = uu___3; + FStar_Syntax_Syntax.injective_type_params1 = uu___4;_}; + FStar_Syntax_Syntax.sigrng = uu___5; + FStar_Syntax_Syntax.sigquals = uu___6; + FStar_Syntax_Syntax.sigmeta = uu___7; + FStar_Syntax_Syntax.sigattrs = uu___8; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___9; + FStar_Syntax_Syntax.sigopts = uu___10;_}::[]; + FStar_Syntax_Syntax.lids = uu___11;_}, (FStar_Syntax_Syntax.ExceptionConstructor)::[]) -> - let uu___11 = extract_ctor env [] env { dname = l; dtyp = t } in - (match uu___11 with + let uu___12 = extract_ctor env [] env { dname = l; dtyp = t } in + (match uu___12 with | (env1, ctor) -> (env1, (iface_of_bindings [ctor]))) | (FStar_Syntax_Syntax.Sig_bundle { FStar_Syntax_Syntax.ses = ses; FStar_Syntax_Syntax.lids = uu___;_}, @@ -1181,10 +1187,7 @@ let (extract_reifiable_effect : (FStar_Extraction_ML_Syntax.MLM_Let (FStar_Extraction_ML_Syntax.NonRec, [lb])))) in let rec extract_fv tm = - (let uu___1 = - let uu___2 = FStar_Extraction_ML_UEnv.tcenv_of_uenv g in - FStar_TypeChecker_Env.debug uu___2 - (FStar_Options.Other "ExtractionReify") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_ExtractionReify in if uu___1 then let uu___2 = FStar_Syntax_Print.term_to_string tm in @@ -1218,10 +1221,7 @@ let (extract_reifiable_effect : FStar_Compiler_Util.format2 "(%s) Not an fv: %s" uu___4 uu___5 in FStar_Compiler_Effect.failwith uu___3) in let extract_action g1 a = - (let uu___1 = - let uu___2 = FStar_Extraction_ML_UEnv.tcenv_of_uenv g1 in - FStar_TypeChecker_Env.debug uu___2 - (FStar_Options.Other "ExtractionReify") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_ExtractionReify in if uu___1 then let uu___2 = @@ -1278,10 +1278,7 @@ let (extract_reifiable_effect : (match uu___4 with | (a_nm, a_lid, exp_b, g2) -> ((let uu___6 = - let uu___7 = - FStar_Extraction_ML_UEnv.tcenv_of_uenv g2 in - FStar_TypeChecker_Env.debug uu___7 - (FStar_Options.Other "ExtractionReify") in + FStar_Compiler_Effect.op_Bang dbg_ExtractionReify in if uu___6 then let uu___7 = @@ -1291,10 +1288,7 @@ let (extract_reifiable_effect : "Extracted action term: %s\n" uu___7 else ()); (let uu___7 = - let uu___8 = - FStar_Extraction_ML_UEnv.tcenv_of_uenv g2 in - FStar_TypeChecker_Env.debug uu___8 - (FStar_Options.Other "ExtractionReify") in + FStar_Compiler_Effect.op_Bang dbg_ExtractionReify in if uu___7 then ((let uu___9 = @@ -1854,7 +1848,7 @@ let (extract_iface : let uu___ = FStar_Syntax_Unionfind.with_uf_enabled (fun uu___1 -> - let uu___2 = FStar_Options.debug_any () in + let uu___2 = FStar_Compiler_Debug.any () in if uu___2 then let uu___3 = @@ -2070,17 +2064,18 @@ let (extract_bundle : FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___1; FStar_Syntax_Syntax.num_ty_params = uu___2; - FStar_Syntax_Syntax.mutuals1 = uu___3;_}; - FStar_Syntax_Syntax.sigrng = uu___4; - FStar_Syntax_Syntax.sigquals = uu___5; - FStar_Syntax_Syntax.sigmeta = uu___6; - FStar_Syntax_Syntax.sigattrs = uu___7; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___8; - FStar_Syntax_Syntax.sigopts = uu___9;_}::[]; - FStar_Syntax_Syntax.lids = uu___10;_}, + FStar_Syntax_Syntax.mutuals1 = uu___3; + FStar_Syntax_Syntax.injective_type_params1 = uu___4;_}; + FStar_Syntax_Syntax.sigrng = uu___5; + FStar_Syntax_Syntax.sigquals = uu___6; + FStar_Syntax_Syntax.sigmeta = uu___7; + FStar_Syntax_Syntax.sigattrs = uu___8; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___9; + FStar_Syntax_Syntax.sigopts = uu___10;_}::[]; + FStar_Syntax_Syntax.lids = uu___11;_}, (FStar_Syntax_Syntax.ExceptionConstructor)::[]) -> - let uu___11 = extract_ctor env [] env { dname = l; dtyp = t } in - (match uu___11 with + let uu___12 = extract_ctor env [] env { dname = l; dtyp = t } in + (match uu___12 with | (env1, ctor) -> (env1, [FStar_Extraction_ML_Syntax.mk_mlmodule1_with_attrs @@ -2943,10 +2938,7 @@ let (extract' : FStar_Compiler_Util.fold_map (fun g4 -> fun se -> - let uu___3 = - let uu___4 = - FStar_Ident.string_of_lid m.FStar_Syntax_Syntax.name in - FStar_Options.debug_module uu___4 in + let uu___3 = FStar_Compiler_Debug.any () in if uu___3 then let nm = diff --git a/ocaml/fstar-lib/generated/FStar_Extraction_ML_RegEmb.ml b/ocaml/fstar-lib/generated/FStar_Extraction_ML_RegEmb.ml index aac544dad71..ae8a8762449 100644 --- a/ocaml/fstar-lib/generated/FStar_Extraction_ML_RegEmb.ml +++ b/ocaml/fstar-lib/generated/FStar_Extraction_ML_RegEmb.ml @@ -168,15 +168,30 @@ let (not_implemented_warning : let uu___2 = let uu___3 = let uu___4 = - FStar_Errors.lookup - FStar_Errors_Codes.Warning_PluginNotImplemented in - FStar_Errors.error_number uu___4 in - Prims.string_of_int uu___3 in - FStar_Compiler_Util.format3 - "Plugin `%s' can not run natively because %s (use --warn_error -%s to carry on)." - t msg uu___2 in + FStar_Compiler_Util.format1 + "Plugin `%s' can not run natively because:" t in + FStar_Errors_Msg.text uu___4 in + let uu___4 = FStar_Errors_Msg.text msg in + FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one uu___3 + uu___4 in + let uu___3 = + let uu___4 = + let uu___5 = FStar_Errors_Msg.text "Use --warn_error -" in + let uu___6 = + let uu___7 = + let uu___8 = + let uu___9 = + FStar_Errors.lookup + FStar_Errors_Codes.Warning_PluginNotImplemented in + FStar_Errors.error_number uu___9 in + FStar_Class_PP.pp FStar_Class_PP.pp_int uu___8 in + let uu___8 = FStar_Errors_Msg.text "to carry on." in + FStar_Pprint.op_Hat_Slash_Hat uu___7 uu___8 in + FStar_Pprint.op_Hat_Hat uu___5 uu___6 in + [uu___4] in + uu___2 :: uu___3 in (FStar_Errors_Codes.Warning_PluginNotImplemented, uu___1) in - FStar_Errors.log_issue r uu___ + FStar_Errors.log_issue_doc r uu___ type embedding_data = { arity: Prims.int ; @@ -1039,15 +1054,15 @@ let (builtin_embeddings : (FStar_Ident.lident * embedding_data) Prims.list) = uu___4 :: uu___5 in uu___2 :: uu___3 in uu___ :: uu___1 +let (dbg_plugin : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Plugins" let (local_fv_embeddings : (FStar_Ident.lident * embedding_data) Prims.list FStar_Compiler_Effect.ref) = FStar_Compiler_Util.mk_ref [] let (register_embedding : FStar_Ident.lident -> embedding_data -> unit) = fun l -> fun d -> - (let uu___1 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "Plugins") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_plugin in if uu___1 then let uu___2 = FStar_Ident.string_of_lid l in @@ -1688,72 +1703,73 @@ let (mk_unembed : FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = ty_lid; FStar_Syntax_Syntax.num_ty_params = num_ty_params; - FStar_Syntax_Syntax.mutuals1 = uu___1;_} + FStar_Syntax_Syntax.mutuals1 = uu___1; + FStar_Syntax_Syntax.injective_type_params1 = uu___2;_} -> let fv = fresh "fv" in - let uu___2 = FStar_Syntax_Util.arrow_formals t in - (match uu___2 with + let uu___3 = FStar_Syntax_Util.arrow_formals t in + (match uu___3 with | (bs, c) -> let vs = FStar_Compiler_List.map (fun b -> - let uu___3 = - let uu___4 = + let uu___4 = + let uu___5 = FStar_Ident.string_of_id (b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.ppname in - fresh uu___4 in - (uu___3, + fresh uu___5 in + (uu___4, ((b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort))) bs in let pat_s = - let uu___3 = - let uu___4 = FStar_Ident.string_of_lid lid in - FStar_Extraction_ML_Syntax.MLC_String uu___4 in - FStar_Extraction_ML_Syntax.MLP_Const uu___3 in + let uu___4 = + let uu___5 = FStar_Ident.string_of_lid lid in + FStar_Extraction_ML_Syntax.MLC_String uu___5 in + FStar_Extraction_ML_Syntax.MLP_Const uu___4 in let pat_args = - let uu___3 = + let uu___4 = FStar_Compiler_List.map - (fun uu___4 -> - match uu___4 with - | (v, uu___5) -> + (fun uu___5 -> + match uu___5 with + | (v, uu___6) -> FStar_Extraction_ML_Syntax.MLP_Var v) vs in - pats_to_list_pat uu___3 in + pats_to_list_pat uu___4 in let pat_both = FStar_Extraction_ML_Syntax.MLP_Tuple [pat_s; pat_args] in let ret = match record_fields with | FStar_Pervasives_Native.Some fields -> - let uu___3 = + let uu___4 = FStar_Compiler_List.map2 - (fun uu___4 -> + (fun uu___5 -> fun fld -> - match uu___4 with - | (v, uu___5) -> + match uu___5 with + | (v, uu___6) -> ((FStar_Pervasives_Native.snd fld), (mk (FStar_Extraction_ML_Syntax.MLE_Var v)))) vs fields in - ml_record lid uu___3 + ml_record lid uu___4 | FStar_Pervasives_Native.None -> - let uu___3 = + let uu___4 = FStar_Compiler_List.map - (fun uu___4 -> - match uu___4 with - | (v, uu___5) -> + (fun uu___5 -> + match uu___5 with + | (v, uu___6) -> mk (FStar_Extraction_ML_Syntax.MLE_Var v)) vs in - ml_ctor lid uu___3 in + ml_ctor lid uu___4 in let ret1 = mk (FStar_Extraction_ML_Syntax.MLE_App (ml_some, [ret])) in let body = FStar_Compiler_List.fold_right - (fun uu___3 -> + (fun uu___4 -> fun body1 -> - match uu___3 with + match uu___4 with | (v, ty) -> let body2 = mk @@ -1761,41 +1777,41 @@ let (mk_unembed : ([mk_binder v FStar_Extraction_ML_Syntax.MLTY_Top], body1)) in - let uu___4 = - let uu___5 = - let uu___6 = ml_name bind_opt_lid in - let uu___7 = - let uu___8 = - let uu___9 = - let uu___10 = - let uu___11 = - ml_name unembed_lid in + let uu___5 = + let uu___6 = + let uu___7 = ml_name bind_opt_lid in + let uu___8 = + let uu___9 = + let uu___10 = + let uu___11 = let uu___12 = - let uu___13 = + ml_name unembed_lid in + let uu___13 = + let uu___14 = embedding_for tcenv mutuals SyntaxTerm [] ty in - [uu___13; + [uu___14; mk (FStar_Extraction_ML_Syntax.MLE_Var v)] in - (uu___11, uu___12) in + (uu___12, uu___13) in FStar_Extraction_ML_Syntax.MLE_App - uu___10 in - mk uu___9 in - [uu___8; body2] in - (uu___6, uu___7) in + uu___11 in + mk uu___10 in + [uu___9; body2] in + (uu___7, uu___8) in FStar_Extraction_ML_Syntax.MLE_App - uu___5 in - mk uu___4) vs ret1 in + uu___6 in + mk uu___5) vs ret1 in let br = (pat_both, FStar_Pervasives_Native.None, body) in - let uu___3 = - let uu___4 = + let uu___4 = + let uu___5 = FStar_Compiler_Effect.op_Bang e_branches in - br :: uu___4 in + br :: uu___5 in FStar_Compiler_Effect.op_Colon_Equals e_branches - uu___3) + uu___4) | uu___1 -> FStar_Compiler_Effect.failwith "impossible, filter above") ctors; @@ -1838,28 +1854,29 @@ let (mk_embed : FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = ty_lid; FStar_Syntax_Syntax.num_ty_params = num_ty_params; - FStar_Syntax_Syntax.mutuals1 = uu___1;_} + FStar_Syntax_Syntax.mutuals1 = uu___1; + FStar_Syntax_Syntax.injective_type_params1 = uu___2;_} -> let fv = fresh "fv" in - let uu___2 = FStar_Syntax_Util.arrow_formals t in - (match uu___2 with + let uu___3 = FStar_Syntax_Util.arrow_formals t in + (match uu___3 with | (bs, c) -> let vs = FStar_Compiler_List.map (fun b -> - let uu___3 = - let uu___4 = + let uu___4 = + let uu___5 = FStar_Ident.string_of_id (b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.ppname in - fresh uu___4 in - (uu___3, + fresh uu___5 in + (uu___4, ((b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort))) bs in let pat = match record_fields with | FStar_Pervasives_Native.Some fields -> - let uu___3 = - let uu___4 = + let uu___4 = + let uu___5 = FStar_Compiler_List.map2 (fun v -> fun fld -> @@ -1867,48 +1884,48 @@ let (mk_embed : (FStar_Extraction_ML_Syntax.MLP_Var (FStar_Pervasives_Native.fst v)))) vs fields in - ([], uu___4) in - FStar_Extraction_ML_Syntax.MLP_Record uu___3 + ([], uu___5) in + FStar_Extraction_ML_Syntax.MLP_Record uu___4 | FStar_Pervasives_Native.None -> - let uu___3 = - let uu___4 = - let uu___5 = FStar_Ident.path_of_lid lid in - splitlast uu___5 in + let uu___4 = let uu___5 = + let uu___6 = FStar_Ident.path_of_lid lid in + splitlast uu___6 in + let uu___6 = FStar_Compiler_List.map (fun v -> FStar_Extraction_ML_Syntax.MLP_Var (FStar_Pervasives_Native.fst v)) vs in - (uu___4, uu___5) in - FStar_Extraction_ML_Syntax.MLP_CTor uu___3 in + (uu___5, uu___6) in + FStar_Extraction_ML_Syntax.MLP_CTor uu___4 in let fvar = ml_name s_tdataconstr_lid in let lid_of_str = ml_name lid_of_str_lid in let head = - let uu___3 = - let uu___4 = - let uu___5 = - let uu___6 = - let uu___7 = - let uu___8 = - let uu___9 = - let uu___10 = - let uu___11 = - let uu___12 = - let uu___13 = + let uu___4 = + let uu___5 = + let uu___6 = + let uu___7 = + let uu___8 = + let uu___9 = + let uu___10 = + let uu___11 = + let uu___12 = + let uu___13 = + let uu___14 = FStar_Ident.string_of_lid lid in FStar_Extraction_ML_Syntax.MLC_String - uu___13 in + uu___14 in FStar_Extraction_ML_Syntax.MLE_Const - uu___12 in - mk uu___11 in - [uu___10] in - (lid_of_str, uu___9) in - FStar_Extraction_ML_Syntax.MLE_App uu___8 in - mk uu___7 in - [uu___6] in - (fvar, uu___5) in - FStar_Extraction_ML_Syntax.MLE_App uu___4 in - mk uu___3 in + uu___13 in + mk uu___12 in + [uu___11] in + (lid_of_str, uu___10) in + FStar_Extraction_ML_Syntax.MLE_App uu___9 in + mk uu___8 in + [uu___7] in + (fvar, uu___6) in + FStar_Extraction_ML_Syntax.MLE_App uu___5 in + mk uu___4 in let mk_mk_app t1 ts = let ts1 = FStar_Compiler_List.map @@ -1916,44 +1933,44 @@ let (mk_embed : mk (FStar_Extraction_ML_Syntax.MLE_Tuple [t2; ml_none])) ts in - let uu___3 = - let uu___4 = - let uu___5 = ml_name mk_app_lid in - let uu___6 = - let uu___7 = - let uu___8 = as_ml_list ts1 in [uu___8] in - t1 :: uu___7 in - (uu___5, uu___6) in - FStar_Extraction_ML_Syntax.MLE_App uu___4 in - mk uu___3 in + let uu___4 = + let uu___5 = + let uu___6 = ml_name mk_app_lid in + let uu___7 = + let uu___8 = + let uu___9 = as_ml_list ts1 in [uu___9] in + t1 :: uu___8 in + (uu___6, uu___7) in + FStar_Extraction_ML_Syntax.MLE_App uu___5 in + mk uu___4 in let args = FStar_Compiler_List.map - (fun uu___3 -> - match uu___3 with + (fun uu___4 -> + match uu___4 with | (v, ty) -> let vt = mk (FStar_Extraction_ML_Syntax.MLE_Var v) in - let uu___4 = - let uu___5 = - let uu___6 = ml_name embed_lid in - let uu___7 = - let uu___8 = + let uu___5 = + let uu___6 = + let uu___7 = ml_name embed_lid in + let uu___8 = + let uu___9 = embedding_for tcenv mutuals SyntaxTerm [] ty in - [uu___8; vt] in - (uu___6, uu___7) in + [uu___9; vt] in + (uu___7, uu___8) in FStar_Extraction_ML_Syntax.MLE_App - uu___5 in - mk uu___4) vs in + uu___6 in + mk uu___5) vs in let ret = mk_mk_app head args in let br = (pat, FStar_Pervasives_Native.None, ret) in - let uu___3 = - let uu___4 = + let uu___4 = + let uu___5 = FStar_Compiler_Effect.op_Bang e_branches in - br :: uu___4 in + br :: uu___5 in FStar_Compiler_Effect.op_Colon_Equals e_branches - uu___3) + uu___4) | uu___1 -> FStar_Compiler_Effect.failwith "impossible, filter above") ctors; @@ -2051,7 +2068,8 @@ let (__do_handle_plugin : FStar_Syntax_Syntax.num_uniform_params = uu___3; FStar_Syntax_Syntax.t = uu___4; FStar_Syntax_Syntax.mutuals = uu___5; - FStar_Syntax_Syntax.ds = uu___6;_} + FStar_Syntax_Syntax.ds = uu___6; + FStar_Syntax_Syntax.injective_type_params = uu___7;_} -> lid) mutual_sigelts in let proc_one typ_sigelt = let uu___1 = typ_sigelt.FStar_Syntax_Syntax.sigel in @@ -2063,7 +2081,8 @@ let (__do_handle_plugin : FStar_Syntax_Syntax.num_uniform_params = uu___3; FStar_Syntax_Syntax.t = uu___4; FStar_Syntax_Syntax.mutuals = uu___5; - FStar_Syntax_Syntax.ds = uu___6;_} + FStar_Syntax_Syntax.ds = uu___6; + FStar_Syntax_Syntax.injective_type_params = uu___7;_} -> (if (FStar_Compiler_List.length ps) > Prims.int_zero then @@ -2072,48 +2091,50 @@ let (__do_handle_plugin : else (); (let ns = FStar_Ident.ns_of_lid tlid in let name = - let uu___8 = - let uu___9 = FStar_Ident.ids_of_lid tlid in - FStar_Compiler_List.last uu___9 in - FStar_Ident.string_of_id uu___8 in + let uu___9 = + let uu___10 = FStar_Ident.ids_of_lid tlid in + FStar_Compiler_List.last uu___10 in + FStar_Ident.string_of_id uu___9 in let ctors = FStar_Compiler_List.filter (fun se1 -> match se1.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_datacon - { FStar_Syntax_Syntax.lid1 = uu___8; - FStar_Syntax_Syntax.us1 = uu___9; - FStar_Syntax_Syntax.t1 = uu___10; + { FStar_Syntax_Syntax.lid1 = uu___9; + FStar_Syntax_Syntax.us1 = uu___10; + FStar_Syntax_Syntax.t1 = uu___11; FStar_Syntax_Syntax.ty_lid = ty_lid; - FStar_Syntax_Syntax.num_ty_params = uu___11; - FStar_Syntax_Syntax.mutuals1 = uu___12;_} + FStar_Syntax_Syntax.num_ty_params = uu___12; + FStar_Syntax_Syntax.mutuals1 = uu___13; + FStar_Syntax_Syntax.injective_type_params1 = + uu___14;_} -> FStar_Ident.lid_equals ty_lid tlid - | uu___8 -> false) ses in + | uu___9 -> false) ses in let ml_name1 = - let uu___8 = - let uu___9 = - let uu___10 = FStar_Ident.string_of_lid tlid in - FStar_Extraction_ML_Syntax.MLC_String uu___10 in - FStar_Extraction_ML_Syntax.MLE_Const uu___9 in - mk uu___8 in + let uu___9 = + let uu___10 = + let uu___11 = FStar_Ident.string_of_lid tlid in + FStar_Extraction_ML_Syntax.MLC_String uu___11 in + FStar_Extraction_ML_Syntax.MLE_Const uu___10 in + mk uu___9 in let record_fields = - let uu___8 = + let uu___9 = FStar_Compiler_List.find - (fun uu___9 -> - match uu___9 with - | FStar_Syntax_Syntax.RecordType uu___10 -> true - | uu___10 -> false) + (fun uu___10 -> + match uu___10 with + | FStar_Syntax_Syntax.RecordType uu___11 -> true + | uu___11 -> false) typ_sigelt.FStar_Syntax_Syntax.sigquals in - match uu___8 with + match uu___9 with | FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.RecordType (uu___9, b)) -> - let uu___10 = + (FStar_Syntax_Syntax.RecordType (uu___10, b)) -> + let uu___11 = FStar_Compiler_List.map (fun f -> FStar_Extraction_ML_UEnv.lookup_record_field_name g (tlid, f)) b in - FStar_Pervasives_Native.Some uu___10 - | uu___9 -> FStar_Pervasives_Native.None in + FStar_Pervasives_Native.Some uu___11 + | uu___10 -> FStar_Pervasives_Native.None in let tcenv = FStar_Extraction_ML_UEnv.tcenv_of_uenv g in let ml_unembed = mk_unembed tcenv mutual_lids record_fields ctors in @@ -2144,19 +2165,19 @@ let (__do_handle_plugin : FStar_Extraction_ML_Syntax.mllb_meta = []; FStar_Extraction_ML_Syntax.print_typ = false } in - (let uu___9 = - let uu___10 = - let uu___11 = + (let uu___10 = + let uu___11 = + let uu___12 = FStar_Ident.mk_ident ((Prims.strcat "e_" name), FStar_Compiler_Range_Type.dummyRange) in - FStar_Ident.lid_of_ns_and_id ns uu___11 in + FStar_Ident.lid_of_ns_and_id ns uu___12 in { arity = Prims.int_zero; - syn_emb = uu___10; + syn_emb = uu___11; nbe_emb = FStar_Pervasives_Native.None } in - register_embedding tlid uu___9); + register_embedding tlid uu___10); [lb])) in let lbs = FStar_Compiler_List.concatMap proc_one mutual_sigelts in let unthunking = @@ -2171,7 +2192,8 @@ let (__do_handle_plugin : FStar_Syntax_Syntax.num_uniform_params = uu___3; FStar_Syntax_Syntax.t = uu___4; FStar_Syntax_Syntax.mutuals = uu___5; - FStar_Syntax_Syntax.ds = uu___6;_} + FStar_Syntax_Syntax.ds = uu___6; + FStar_Syntax_Syntax.injective_type_params = uu___7;_} -> tlid1 in let name = let uu___1 = diff --git a/ocaml/fstar-lib/generated/FStar_Extraction_ML_RemoveUnusedParameters.ml b/ocaml/fstar-lib/generated/FStar_Extraction_ML_RemoveUnusedParameters.ml index 543896ed1d2..39ad27ac71f 100644 --- a/ocaml/fstar-lib/generated/FStar_Extraction_ML_RemoveUnusedParameters.ml +++ b/ocaml/fstar-lib/generated/FStar_Extraction_ML_RemoveUnusedParameters.ml @@ -45,24 +45,40 @@ let (lookup_tyname : fun name -> let uu___ = FStar_Extraction_ML_Syntax.string_of_mlpath name in FStar_Compiler_Util.psmap_try_find env.tydef_map uu___ -type var_set = FStar_Extraction_ML_Syntax.mlident FStar_Compiler_Set.set -let (empty_var_set : Prims.string FStar_Compiler_Set.set) = - FStar_Compiler_Set.empty FStar_Class_Ord.ord_string () +type var_set = FStar_Extraction_ML_Syntax.mlident FStar_Compiler_RBSet.t +let (empty_var_set : Prims.string FStar_Compiler_RBSet.t) = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset FStar_Class_Ord.ord_string)) ()) let rec (freevars_of_mlty' : var_set -> FStar_Extraction_ML_Syntax.mlty -> var_set) = - fun vars -> - fun t -> - match t with - | FStar_Extraction_ML_Syntax.MLTY_Var i -> - FStar_Compiler_Set.add FStar_Class_Ord.ord_string i vars - | FStar_Extraction_ML_Syntax.MLTY_Fun (t0, uu___, t1) -> - let uu___1 = freevars_of_mlty' vars t0 in - freevars_of_mlty' uu___1 t1 - | FStar_Extraction_ML_Syntax.MLTY_Named (tys, uu___) -> - FStar_Compiler_List.fold_left freevars_of_mlty' vars tys - | FStar_Extraction_ML_Syntax.MLTY_Tuple tys -> - FStar_Compiler_List.fold_left freevars_of_mlty' vars tys - | uu___ -> vars + fun uu___1 -> + fun uu___ -> + (fun vars -> + fun t -> + match t with + | FStar_Extraction_ML_Syntax.MLTY_Var i -> + Obj.magic + (Obj.repr + (FStar_Class_Setlike.add () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_string)) i (Obj.magic vars))) + | FStar_Extraction_ML_Syntax.MLTY_Fun (t0, uu___, t1) -> + Obj.magic + (Obj.repr + (let uu___1 = freevars_of_mlty' vars t0 in + freevars_of_mlty' uu___1 t1)) + | FStar_Extraction_ML_Syntax.MLTY_Named (tys, uu___) -> + Obj.magic + (Obj.repr + (FStar_Compiler_List.fold_left freevars_of_mlty' vars tys)) + | FStar_Extraction_ML_Syntax.MLTY_Tuple tys -> + Obj.magic + (Obj.repr + (FStar_Compiler_List.fold_left freevars_of_mlty' vars tys)) + | uu___ -> Obj.magic (Obj.repr vars)) uu___1 uu___ let (freevars_of_mlty : FStar_Extraction_ML_Syntax.mlty -> var_set) = freevars_of_mlty' empty_var_set let rec (elim_mlty : @@ -327,8 +343,11 @@ let (elim_tydef : let p = param.FStar_Extraction_ML_Syntax.ty_param_name in let uu___2 = - FStar_Compiler_Set.mem FStar_Class_Ord.ord_string - p freevars in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_string)) p + (Obj.magic freevars) in if uu___2 then (if must_eliminate i diff --git a/ocaml/fstar-lib/generated/FStar_Extraction_ML_Term.ml b/ocaml/fstar-lib/generated/FStar_Extraction_ML_Term.ml index 674c7498edc..a955c69dd6f 100644 --- a/ocaml/fstar-lib/generated/FStar_Extraction_ML_Term.ml +++ b/ocaml/fstar-lib/generated/FStar_Extraction_ML_Term.ml @@ -1,4 +1,8 @@ open Prims +let (dbg_Extraction : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Extraction" +let (dbg_ExtractionNorm : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "ExtractionNorm" exception Un_extractable let (uu___is_Un_extractable : Prims.exn -> Prims.bool) = fun projectee -> @@ -108,12 +112,12 @@ let err_value_restriction : uu___2 uu___3 in (FStar_Errors_Codes.Fatal_ValueRestriction, uu___1) in fail t.FStar_Syntax_Syntax.pos uu___ -let err_unexpected_eff : - 'uuuuu . - FStar_Extraction_ML_UEnv.uenv -> - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> - FStar_Extraction_ML_Syntax.mlty -> - FStar_Extraction_ML_Syntax.e_tag -> 'uuuuu -> unit +let (err_unexpected_eff : + FStar_Extraction_ML_UEnv.uenv -> + FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> + FStar_Extraction_ML_Syntax.mlty -> + FStar_Extraction_ML_Syntax.e_tag -> + FStar_Extraction_ML_Syntax.e_tag -> unit) = fun env -> fun t -> @@ -153,7 +157,7 @@ let err_unexpected_eff : let uu___7 = FStar_Errors_Msg.text "got effect" in let uu___8 = let uu___9 = - FStar_Extraction_ML_Util.eff_to_string f0 in + FStar_Extraction_ML_Util.eff_to_string f1 in FStar_Pprint.arbitrary_string uu___9 in FStar_Pprint.prefix (Prims.of_int (4)) Prims.int_one uu___7 uu___8 in @@ -549,15 +553,13 @@ let (is_constructor : FStar_Syntax_Syntax.term -> Prims.bool) = match uu___ with | FStar_Syntax_Syntax.Tm_fvar { FStar_Syntax_Syntax.fv_name = uu___1; - FStar_Syntax_Syntax.fv_delta = uu___2; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Data_ctor);_} -> true | FStar_Syntax_Syntax.Tm_fvar { FStar_Syntax_Syntax.fv_name = uu___1; - FStar_Syntax_Syntax.fv_delta = uu___2; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Record_ctor uu___3);_} + (FStar_Syntax_Syntax.Record_ctor uu___2);_} -> true | uu___1 -> false let rec (is_fstar_value : FStar_Syntax_Syntax.term -> Prims.bool) = @@ -3947,11 +3949,10 @@ and (term_as_mlexpr' : lb.FStar_Syntax_Syntax.lbdef) uu___3 "FStar.Extraction.ML.Term.normalize_lb_def" in let uu___2 = - (FStar_TypeChecker_Env.debug tcenv - (FStar_Options.Other "Extraction")) + (FStar_Compiler_Effect.op_Bang dbg_Extraction) || - (FStar_TypeChecker_Env.debug tcenv - (FStar_Options.Other "ExtractNorm")) in + (FStar_Compiler_Effect.op_Bang + dbg_ExtractionNorm) in if uu___2 then ((let uu___4 = diff --git a/ocaml/fstar-lib/generated/FStar_Extraction_ML_UEnv.ml b/ocaml/fstar-lib/generated/FStar_Extraction_ML_UEnv.ml index 050ee12368e..104e8cd1a88 100644 --- a/ocaml/fstar-lib/generated/FStar_Extraction_ML_UEnv.ml +++ b/ocaml/fstar-lib/generated/FStar_Extraction_ML_UEnv.ml @@ -251,12 +251,13 @@ let with_typars_env : currentModule = (u.currentModule) }, x) let (bindings_of_uenv : uenv -> binding Prims.list) = fun u -> u.env_bindings +let (dbg : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Extraction" let (debug : uenv -> (unit -> unit) -> unit) = fun g -> fun f -> let c = FStar_Extraction_ML_Syntax.string_of_mlpath g.currentModule in - let uu___ = - FStar_Options.debug_at_level c (FStar_Options.Other "Extraction") in + let uu___ = FStar_Compiler_Effect.op_Bang dbg in if uu___ then f () else () let (print_mlpath_map : uenv -> Prims.string) = fun g -> diff --git a/ocaml/fstar-lib/generated/FStar_Interactive_Ide.ml b/ocaml/fstar-lib/generated/FStar_Interactive_Ide.ml index 96c7b622e87..817b5eabee5 100644 --- a/ocaml/fstar-lib/generated/FStar_Interactive_Ide.ml +++ b/ocaml/fstar-lib/generated/FStar_Interactive_Ide.ml @@ -1,4 +1,6 @@ open Prims +let (dbg : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "IDE" let with_captured_errors' : 'uuuuu . FStar_TypeChecker_Env.env -> @@ -150,9 +152,7 @@ let (run_repl_ld_transactions : fun tasks -> fun progress_callback -> let debug verb task = - let uu___ = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "IDE") in + let uu___ = FStar_Compiler_Effect.op_Bang dbg in if uu___ then let uu___1 = FStar_Interactive_Ide_Types.string_of_repl_task task in @@ -1836,8 +1836,7 @@ let (run_push_with_deps : = fun st -> fun query -> - (let uu___1 = - FStar_Options.debug_at_level_no_module (FStar_Options.Other "IDE") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg in if uu___1 then FStar_Compiler_Util.print_string "Reloading dependencies" else ()); @@ -2444,7 +2443,7 @@ type search_candidate = FStar_Compiler_Effect.ref ; sc_fvars: - FStar_Ident.lid FStar_Compiler_Set.t FStar_Pervasives_Native.option + FStar_Ident.lid FStar_Compiler_RBSet.t FStar_Pervasives_Native.option FStar_Compiler_Effect.ref } let (__proj__Mksearch_candidate__item__sc_lid : @@ -2460,7 +2459,7 @@ let (__proj__Mksearch_candidate__item__sc_typ : match projectee with | { sc_lid; sc_typ; sc_fvars;_} -> sc_typ let (__proj__Mksearch_candidate__item__sc_fvars : search_candidate -> - FStar_Ident.lid FStar_Compiler_Set.t FStar_Pervasives_Native.option + FStar_Ident.lid FStar_Compiler_RBSet.t FStar_Pervasives_Native.option FStar_Compiler_Effect.ref) = fun projectee -> @@ -2490,7 +2489,7 @@ let (sc_typ : typ) let (sc_fvars : FStar_TypeChecker_Env.env -> - search_candidate -> FStar_Ident.lident FStar_Compiler_Set.set) + search_candidate -> FStar_Ident.lident FStar_Compiler_RBSet.t) = fun tcenv -> fun sc -> @@ -2539,7 +2538,6 @@ let run_search : fun st -> fun search_str -> let tcenv = st.FStar_Interactive_Ide_Types.repl_env in - let empty_fv_set = FStar_Syntax_Syntax.new_fv_set () in let st_matches candidate term = let found = match term.st_term with @@ -2548,7 +2546,10 @@ let run_search : FStar_Compiler_Util.contains uu___ str | TypeContainsLid lid -> let uu___ = sc_fvars tcenv candidate in - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_fv lid uu___ in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_fv)) lid (Obj.magic uu___) in found <> term.st_negate in let parse search_str1 = let parse_one term = @@ -2700,8 +2701,7 @@ let (maybe_cancel_queries : fun st -> fun l -> let log_cancellation l1 = - let uu___ = - FStar_Options.debug_at_level_no_module (FStar_Options.Other "IDE") in + let uu___ = FStar_Compiler_Effect.op_Bang dbg in if uu___ then FStar_Compiler_List.iter @@ -2897,8 +2897,7 @@ and (validate_and_run_query : FStar_Compiler_Effect.op_Colon_Equals repl_current_qid (FStar_Pervasives_Native.Some (query1.FStar_Interactive_Ide_Types.qid)); - (let uu___2 = - FStar_Options.debug_at_level_no_module (FStar_Options.Other "IDE") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg in if uu___2 then let uu___3 = FStar_Interactive_Ide_Types.query_to_string query1 in diff --git a/ocaml/fstar-lib/generated/FStar_Interactive_Incremental.ml b/ocaml/fstar-lib/generated/FStar_Interactive_Incremental.ml index 6c6473678e9..05f08f5e064 100644 --- a/ocaml/fstar-lib/generated/FStar_Interactive_Incremental.ml +++ b/ocaml/fstar-lib/generated/FStar_Interactive_Incremental.ml @@ -490,7 +490,7 @@ let (run_full_buffer : FStar_Interactive_Ide_Types.Cache then log_syntax_issues err_opt else (); - (let uu___6 = FStar_Options.debug_any () in + (let uu___6 = FStar_Compiler_Debug.any () in if uu___6 then let uu___7 = diff --git a/ocaml/fstar-lib/generated/FStar_Interactive_Legacy.ml b/ocaml/fstar-lib/generated/FStar_Interactive_Legacy.ml index e0d22a8cae1..25707cc8c05 100644 --- a/ocaml/fstar-lib/generated/FStar_Interactive_Legacy.ml +++ b/ocaml/fstar-lib/generated/FStar_Interactive_Legacy.ml @@ -275,7 +275,7 @@ let rec (read_chunk : unit -> input_chunks) = fun uu___ -> let s = the_interactive_state in let log = - let uu___1 = FStar_Options.debug_any () in + let uu___1 = FStar_Compiler_Debug.any () in if uu___1 then let transcript = diff --git a/ocaml/fstar-lib/generated/FStar_Main.ml b/ocaml/fstar-lib/generated/FStar_Main.ml index 19182a15478..9cb15806899 100644 --- a/ocaml/fstar-lib/generated/FStar_Main.ml +++ b/ocaml/fstar-lib/generated/FStar_Main.ml @@ -115,7 +115,7 @@ let (load_native_tactics : unit -> unit) = let cmxs_files = FStar_Compiler_List.map cmxs_file (FStar_Compiler_List.op_At modules_to_load cmxs_to_load) in - (let uu___2 = FStar_Options.debug_any () in + (let uu___2 = FStar_Compiler_Debug.any () in if uu___2 then FStar_Compiler_Util.print1 "Will try to load cmxs files: [%s]\n" diff --git a/ocaml/fstar-lib/generated/FStar_Options.ml b/ocaml/fstar-lib/generated/FStar_Options.ml index 2b56c00ddb2..893a4080ab5 100644 --- a/ocaml/fstar-lib/generated/FStar_Options.ml +++ b/ocaml/fstar-lib/generated/FStar_Options.ml @@ -1,22 +1,4 @@ open Prims -type debug_level_t = - | Low - | Medium - | High - | Extreme - | Other of Prims.string -let (uu___is_Low : debug_level_t -> Prims.bool) = - fun projectee -> match projectee with | Low -> true | uu___ -> false -let (uu___is_Medium : debug_level_t -> Prims.bool) = - fun projectee -> match projectee with | Medium -> true | uu___ -> false -let (uu___is_High : debug_level_t -> Prims.bool) = - fun projectee -> match projectee with | High -> true | uu___ -> false -let (uu___is_Extreme : debug_level_t -> Prims.bool) = - fun projectee -> match projectee with | Extreme -> true | uu___ -> false -let (uu___is_Other : debug_level_t -> Prims.bool) = - fun projectee -> match projectee with | Other _0 -> true | uu___ -> false -let (__proj__Other__item___0 : debug_level_t -> Prims.string) = - fun projectee -> match projectee with | Other _0 -> _0 type split_queries_t = | No | OnFailure @@ -183,14 +165,17 @@ let copy_optionstate : 'uuuuu . 'uuuuu FStar_Compiler_Util.smap -> 'uuuuu FStar_Compiler_Util.smap = fun m -> FStar_Compiler_Util.smap_copy m let (fstar_options : - optionstate Prims.list Prims.list FStar_Compiler_Effect.ref) = - FStar_Compiler_Util.mk_ref [] + (FStar_Compiler_Debug.saved_state * optionstate) Prims.list Prims.list + FStar_Compiler_Effect.ref) + = FStar_Compiler_Util.mk_ref [] let (internal_peek : unit -> optionstate) = fun uu___ -> let uu___1 = - let uu___2 = FStar_Compiler_Effect.op_Bang fstar_options in + let uu___2 = + let uu___3 = FStar_Compiler_Effect.op_Bang fstar_options in + FStar_Compiler_List.hd uu___3 in FStar_Compiler_List.hd uu___2 in - FStar_Compiler_List.hd uu___1 + FStar_Pervasives_Native.snd uu___1 let (peek : unit -> optionstate) = fun uu___ -> let uu___1 = internal_peek () in copy_optionstate uu___1 let (pop : unit -> unit) = @@ -202,14 +187,18 @@ let (pop : unit -> unit) = | uu___2::tl -> FStar_Compiler_Effect.op_Colon_Equals fstar_options tl let (push : unit -> unit) = fun uu___ -> + let new_st = + let uu___1 = + let uu___2 = FStar_Compiler_Effect.op_Bang fstar_options in + FStar_Compiler_List.hd uu___2 in + FStar_Compiler_List.map + (fun uu___2 -> + match uu___2 with + | (dbg, opts) -> + let uu___3 = copy_optionstate opts in (dbg, uu___3)) uu___1 in let uu___1 = - let uu___2 = - let uu___3 = - let uu___4 = FStar_Compiler_Effect.op_Bang fstar_options in - FStar_Compiler_List.hd uu___4 in - FStar_Compiler_List.map copy_optionstate uu___3 in - let uu___3 = FStar_Compiler_Effect.op_Bang fstar_options in uu___2 :: - uu___3 in + let uu___2 = FStar_Compiler_Effect.op_Bang fstar_options in new_st :: + uu___2 in FStar_Compiler_Effect.op_Colon_Equals fstar_options uu___1 let (internal_pop : unit -> Prims.bool) = fun uu___ -> @@ -228,6 +217,10 @@ let (internal_pop : unit -> Prims.bool) = FStar_Compiler_List.tl uu___5 in tl :: uu___4 in FStar_Compiler_Effect.op_Colon_Equals fstar_options uu___3); + (let uu___4 = + let uu___5 = FStar_Compiler_List.hd tl in + FStar_Pervasives_Native.fst uu___5 in + FStar_Compiler_Debug.restore uu___4); true) let (internal_push : unit -> unit) = fun uu___ -> @@ -236,8 +229,13 @@ let (internal_push : unit -> unit) = FStar_Compiler_List.hd uu___1 in let stack' = let uu___1 = - let uu___2 = FStar_Compiler_List.hd curstack in - copy_optionstate uu___2 in + let uu___2 = FStar_Compiler_Debug.snapshot () in + let uu___3 = + let uu___4 = + let uu___5 = FStar_Compiler_List.hd curstack in + FStar_Pervasives_Native.snd uu___5 in + copy_optionstate uu___4 in + (uu___2, uu___3) in uu___1 :: curstack in let uu___1 = let uu___2 = @@ -252,8 +250,9 @@ let (set : optionstate -> unit) = | [] -> FStar_Compiler_Effect.failwith "set on empty option stack" | []::uu___1 -> FStar_Compiler_Effect.failwith "set on empty current option stack" - | (uu___1::tl)::os -> - FStar_Compiler_Effect.op_Colon_Equals fstar_options ((o :: tl) :: os) + | ((dbg, uu___1)::tl)::os -> + FStar_Compiler_Effect.op_Colon_Equals fstar_options (((dbg, o) :: tl) + :: os) let (snapshot : unit -> (Prims.int * unit)) = fun uu___ -> FStar_Common.snapshot push fstar_options () let (rollback : Prims.int FStar_Pervasives_Native.option -> unit) = @@ -288,9 +287,10 @@ let (defaults : (Prims.string * option_val) Prims.list) = ("cmi", (Bool false)); ("codegen", Unset); ("codegen-lib", (List [])); - ("debug", (List [])); - ("debug_level", (List [])); ("defensive", (String "no")); + ("debug", (List [])); + ("debug_all", (Bool false)); + ("debug_all_modules", (Bool false)); ("dep", Unset); ("detail_errors", (Bool false)); ("detail_hint_replay", (Bool false)); @@ -412,7 +412,14 @@ let (init : unit -> unit) = let (clear : unit -> unit) = fun uu___ -> let o = FStar_Compiler_Util.smap_create (Prims.of_int (50)) in - FStar_Compiler_Effect.op_Colon_Equals fstar_options [[o]]; init () + (let uu___2 = + let uu___3 = + let uu___4 = + let uu___5 = FStar_Compiler_Debug.snapshot () in (uu___5, o) in + [uu___4] in + [uu___3] in + FStar_Compiler_Effect.op_Colon_Equals fstar_options uu___2); + init () let (_run : unit) = clear () let (get_option : Prims.string -> option_val) = fun s -> @@ -490,10 +497,6 @@ let (get_codegen : unit -> Prims.string FStar_Pervasives_Native.option) = fun uu___ -> lookup_opt "codegen" (as_option as_string) let (get_codegen_lib : unit -> Prims.string Prims.list) = fun uu___ -> lookup_opt "codegen-lib" (as_list as_string) -let (get_debug : unit -> Prims.string Prims.list) = - fun uu___ -> lookup_opt "debug" as_comma_string_list -let (get_debug_level : unit -> Prims.string Prims.list) = - fun uu___ -> lookup_opt "debug_level" as_comma_string_list let (get_defensive : unit -> Prims.string) = fun uu___ -> lookup_opt "defensive" as_string let (get_dep : unit -> Prims.string FStar_Pervasives_Native.option) = @@ -713,29 +716,6 @@ let (get_profile_group_by_decl : unit -> Prims.bool) = let (get_profile_component : unit -> Prims.string Prims.list FStar_Pervasives_Native.option) = fun uu___ -> lookup_opt "profile_component" (as_option (as_list as_string)) -let (dlevel : Prims.string -> debug_level_t) = - fun uu___ -> - match uu___ with - | "Low" -> Low - | "Medium" -> Medium - | "High" -> High - | "Extreme" -> Extreme - | s -> Other s -let (one_debug_level_geq : debug_level_t -> debug_level_t -> Prims.bool) = - fun l1 -> - fun l2 -> - match l1 with - | Other uu___ -> l1 = l2 - | Low -> l1 = l2 - | Medium -> (l2 = Low) || (l2 = Medium) - | High -> ((l2 = Low) || (l2 = Medium)) || (l2 = High) - | Extreme -> - (((l2 = Low) || (l2 = Medium)) || (l2 = High)) || (l2 = Extreme) -let (debug_level_geq : debug_level_t -> Prims.bool) = - fun l2 -> - let uu___ = get_debug_level () in - FStar_Compiler_Util.for_some - (fun l1 -> one_debug_level_geq (dlevel l1) l2) uu___ let (universe_include_path_base_dirs : Prims.string Prims.list) = let sub_dirs = ["legacy"; "experimental"; ".cache"] in FStar_Compiler_List.collect @@ -768,6 +748,15 @@ let (display_version : unit -> unit) = "F* %s\nplatform=%s\ncompiler=%s\ndate=%s\ncommit=%s\n" uu___2 uu___3 uu___4 uu___5 uu___6 in FStar_Compiler_Util.print_string uu___1 +let (display_debug_keys : unit -> unit) = + fun uu___ -> + let keys = FStar_Compiler_Debug.list_all_toggles () in + let uu___1 = + FStar_Compiler_List.sortWith FStar_Compiler_String.compare keys in + FStar_Compiler_List.iter + (fun s -> + let uu___2 = FStar_Compiler_String.op_Hat s "\n" in + FStar_Compiler_Util.print_string uu___2) uu___1 let display_usage_aux : 'uuuuu 'uuuuu1 . (('uuuuu * Prims.string * 'uuuuu1 FStar_Getopt.opt_variant) * @@ -1016,7 +1005,7 @@ let (interp_quake_arg : Prims.string -> (Prims.int * Prims.int * Prims.bool)) let uu___ = ios f1 in let uu___1 = ios f2 in (uu___, uu___1, true) else FStar_Compiler_Effect.failwith "unexpected value for --quake" | uu___ -> FStar_Compiler_Effect.failwith "unexpected value for --quake" -let (uu___461 : (((Prims.string -> unit) -> unit) * (Prims.string -> unit))) +let (uu___450 : (((Prims.string -> unit) -> unit) * (Prims.string -> unit))) = let cb = FStar_Compiler_Util.mk_ref FStar_Pervasives_Native.None in let set1 f = @@ -1028,11 +1017,11 @@ let (uu___461 : (((Prims.string -> unit) -> unit) * (Prims.string -> unit))) | FStar_Pervasives_Native.Some f -> f msg in (set1, call) let (set_option_warning_callback_aux : (Prims.string -> unit) -> unit) = - match uu___461 with + match uu___450 with | (set_option_warning_callback_aux1, option_warning_callback) -> set_option_warning_callback_aux1 let (option_warning_callback : Prims.string -> unit) = - match uu___461 with + match uu___450 with | (set_option_warning_callback_aux1, option_warning_callback1) -> option_warning_callback1 let (set_option_warning_callback : (Prims.string -> unit) -> unit) = @@ -1167,198 +1156,213 @@ let rec (specs_with_types : let uu___28 = let uu___29 = text - "Print lots of debugging information while checking module" in - (FStar_Getopt.noshort, "debug", - (Accumulated (SimpleStr "module_name")), + "Debug toggles (comma-separated list of debug keys)" in + (100, "debug", + (PostProcessed + ((fun o -> + let keys = as_comma_string_list o in + FStar_Compiler_Debug.enable_toggles + keys; + o), + (Accumulated + (SimpleStr "debug toggles")))), uu___29) in let uu___29 = let uu___30 = let uu___31 = text - "Control the verbosity of debugging info" in - (FStar_Getopt.noshort, "debug_level", - (Accumulated - (OpenEnumStr - (["Low"; - "Medium"; - "High"; - "Extreme"], "..."))), uu___31) in + "Enable all debug toggles. WARNING: this will cause a lot of output!" in + (FStar_Getopt.noshort, "debug_all", + (PostProcessed + ((fun o -> + match o with + | Bool (true) -> + (FStar_Compiler_Debug.set_debug_all + (); + o) + | uu___32 -> + FStar_Compiler_Effect.failwith + "?"), (Const (Bool true)))), + uu___31) in let uu___31 = let uu___32 = let uu___33 = - let uu___34 = - text - "Enable several internal sanity checks, useful to track bugs and report issues." in + text + "Enable to make the effect of --debug apply to every module processed by the compiler, including dependencies." in + (FStar_Getopt.noshort, + "debug_all_modules", + (Const (Bool true)), uu___33) in + let uu___33 = + let uu___34 = let uu___35 = let uu___36 = - let uu___37 = - let uu___38 = - text - "if 'no', no checks are performed" in + text + "Enable several internal sanity checks, useful to track bugs and report issues." in + let uu___37 = + let uu___38 = let uu___39 = let uu___40 = text - "if 'warn', checks are performed and raise a warning when they fail" in + "if 'no', no checks are performed" in let uu___41 = let uu___42 = text - "if 'error, like 'warn', but the compiler raises a hard error instead" in + "if 'warn', checks are performed and raise a warning when they fail" in let uu___43 = let uu___44 = text - "if 'abort, like 'warn', but the compiler immediately aborts on an error" in - [uu___44] in + "if 'error, like 'warn', but the compiler raises a hard error instead" in + let uu___45 = + let uu___46 = + text + "if 'abort, like 'warn', but the compiler immediately aborts on an error" in + [uu___46] in + uu___44 :: uu___45 in uu___42 :: uu___43 in uu___40 :: uu___41 in - uu___38 :: uu___39 in - FStar_Errors_Msg.bulleted uu___37 in - let uu___37 = text "(default 'no')" in - FStar_Pprint.op_Hat_Slash_Hat - uu___36 uu___37 in - FStar_Pprint.op_Hat_Hat uu___34 - uu___35 in - (FStar_Getopt.noshort, "defensive", - (EnumStr - ["no"; "warn"; "error"; "abort"]), - uu___33) in - let uu___33 = - let uu___34 = - let uu___35 = - let uu___36 = - text - "Output the transitive closure of the full dependency graph in three formats:" in + FStar_Errors_Msg.bulleted + uu___39 in + let uu___39 = + text "(default 'no')" in + FStar_Pprint.op_Hat_Slash_Hat + uu___38 uu___39 in + FStar_Pprint.op_Hat_Hat uu___36 + uu___37 in + (FStar_Getopt.noshort, "defensive", + (EnumStr + ["no"; "warn"; "error"; "abort"]), + uu___35) in + let uu___35 = + let uu___36 = let uu___37 = let uu___38 = - let uu___39 = - text - "'graph': a format suitable the 'dot' tool from 'GraphViz'" in + text + "Output the transitive closure of the full dependency graph in three formats:" in + let uu___39 = let uu___40 = let uu___41 = text - "'full': a format suitable for 'make', including dependences for producing .ml and .krml files" in + "'graph': a format suitable the 'dot' tool from 'GraphViz'" in let uu___42 = let uu___43 = text - "'make': (deprecated) a format suitable for 'make', including only dependences among source files" in - [uu___43] in + "'full': a format suitable for 'make', including dependences for producing .ml and .krml files" in + let uu___44 = + let uu___45 = + text + "'make': (deprecated) a format suitable for 'make', including only dependences among source files" in + [uu___45] in + uu___43 :: uu___44 in uu___41 :: uu___42 in - uu___39 :: uu___40 in - FStar_Errors_Msg.bulleted uu___38 in - FStar_Pprint.op_Hat_Hat uu___36 - uu___37 in - (FStar_Getopt.noshort, "dep", - (EnumStr - ["make"; "graph"; "full"; "raw"]), - uu___35) in - let uu___35 = - let uu___36 = - let uu___37 = - text - "Emit a detailed error report by asking the SMT solver many queries; will take longer" in - (FStar_Getopt.noshort, - "detail_errors", - (Const (Bool true)), uu___37) in + FStar_Errors_Msg.bulleted + uu___40 in + FStar_Pprint.op_Hat_Hat uu___38 + uu___39 in + (FStar_Getopt.noshort, "dep", + (EnumStr + ["make"; + "graph"; + "full"; + "raw"]), uu___37) in let uu___37 = let uu___38 = let uu___39 = text - "Emit a detailed report for proof whose unsat core fails to replay" in + "Emit a detailed error report by asking the SMT solver many queries; will take longer" in (FStar_Getopt.noshort, - "detail_hint_replay", + "detail_errors", (Const (Bool true)), uu___39) in let uu___39 = let uu___40 = let uu___41 = text - "Print out this module as it passes through the compiler pipeline" in + "Emit a detailed report for proof whose unsat core fails to replay" in (FStar_Getopt.noshort, - "dump_module", - (Accumulated - (SimpleStr "module_name")), - uu___41) in + "detail_hint_replay", + (Const (Bool true)), uu___41) in let uu___41 = let uu___42 = let uu___43 = text - "Try to solve subtyping constraints at each binder (loses precision but may be slightly more efficient)" in + "Print out this module as it passes through the compiler pipeline" in (FStar_Getopt.noshort, - "eager_subtyping", - (Const (Bool true)), + "dump_module", + (Accumulated + (SimpleStr "module_name")), uu___43) in let uu___43 = let uu___44 = let uu___45 = text - "Print context information for each error or warning raised (default false)" in + "Try to solve subtyping constraints at each binder (loses precision but may be slightly more efficient)" in (FStar_Getopt.noshort, - "error_contexts", - BoolStr, uu___45) in + "eager_subtyping", + (Const (Bool true)), + uu___45) in let uu___45 = let uu___46 = let uu___47 = text - "These options are set in extensions option map. Keys are usually namespaces separated by \":\". E.g., 'pulse:verbose=1;my:extension:option=xyz;foo:bar=baz'. These options are typically interpreted by extensions. Any later use of --ext over the same key overrides the old value. An entry 'e' that is not of the form 'a=b' is treated as 'e=1', i.e., 'e' associated with string \"1\"." in + "Print context information for each error or warning raised (default false)" in (FStar_Getopt.noshort, - "ext", - (ReverseAccumulated - (SimpleStr - "One or more semicolon separated occurrences of key-value pairs")), - uu___47) in + "error_contexts", + BoolStr, uu___47) in let uu___47 = let uu___48 = let uu___49 = text - "Extract only those modules whose names or namespaces match the provided options. 'TargetName' ranges over {OCaml, krml, FSharp, Plugin, Extension}. A 'ModuleSelector' is a space or comma-separated list of '[+|-]( * | namespace | module)'. For example --extract 'OCaml:A -A.B' --extract 'krml:A -A.C' --extract '*' means for OCaml, extract everything in the A namespace only except A.B; for krml, extract everything in the A namespace only except A.C; for everything else, extract everything. Note, the '+' is optional: --extract '+A' and --extract 'A' mean the same thing. Note also that '--extract A' applies both to a module named 'A' and to any module in the 'A' namespace Multiple uses of this option accumulate, e.g., --extract A --extract B is interpreted as --extract 'A B'." in + "These options are set in extensions option map. Keys are usually namespaces separated by \":\". E.g., 'pulse:verbose=1;my:extension:option=xyz;foo:bar=baz'. These options are typically interpreted by extensions. Any later use of --ext over the same key overrides the old value. An entry 'e' that is not of the form 'a=b' is treated as 'e=1', i.e., 'e' associated with string \"1\"." in (FStar_Getopt.noshort, - "extract", - (Accumulated + "ext", + (ReverseAccumulated (SimpleStr - "One or more semicolon separated occurrences of '[TargetName:]ModuleSelector'")), + "One or more semicolon separated occurrences of key-value pairs")), uu___49) in let uu___49 = let uu___50 = let uu___51 = text - "Deprecated: use --extract instead; Only extract the specified modules (instead of the possibly-partial dependency graph)" in + "Extract only those modules whose names or namespaces match the provided options. 'TargetName' ranges over {OCaml, krml, FSharp, Plugin, Extension}. A 'ModuleSelector' is a space or comma-separated list of '[+|-]( * | namespace | module)'. For example --extract 'OCaml:A -A.B' --extract 'krml:A -A.C' --extract '*' means for OCaml, extract everything in the A namespace only except A.B; for krml, extract everything in the A namespace only except A.C; for everything else, extract everything. Note, the '+' is optional: --extract '+A' and --extract 'A' mean the same thing. Note also that '--extract A' applies both to a module named 'A' and to any module in the 'A' namespace Multiple uses of this option accumulate, e.g., --extract A --extract B is interpreted as --extract 'A B'." in (FStar_Getopt.noshort, - "extract_module", + "extract", (Accumulated - (PostProcessed - (pp_lowercase, - (SimpleStr - "module_name")))), + (SimpleStr + "One or more semicolon separated occurrences of '[TargetName:]ModuleSelector'")), uu___51) in let uu___51 = let uu___52 = let uu___53 = text - "Deprecated: use --extract instead; Only extract modules in the specified namespace" in + "Deprecated: use --extract instead; Only extract the specified modules (instead of the possibly-partial dependency graph)" in (FStar_Getopt.noshort, - "extract_namespace", + "extract_module", (Accumulated (PostProcessed (pp_lowercase, ( SimpleStr - "namespace name")))), + "module_name")))), uu___53) in let uu___53 = let uu___54 = let uu___55 = text - "Explicitly break the abstraction imposed by the interface of any implementation file that appears on the command line (use with care!)" in + "Deprecated: use --extract instead; Only extract modules in the specified namespace" in (FStar_Getopt.noshort, - "expose_interfaces", - (Const - (Bool true)), + "extract_namespace", + (Accumulated + (PostProcessed + (pp_lowercase, + (SimpleStr + "namespace name")))), uu___55) in let uu___55 = let uu___56 = let uu___57 = text - "Don't print unification variable numbers" in + "Explicitly break the abstraction imposed by the interface of any implementation file that appears on the command line (use with care!)" in (FStar_Getopt.noshort, - "hide_uvar_nums", + "expose_interfaces", (Const (Bool true)), uu___57) in @@ -1366,25 +1370,26 @@ let rec (specs_with_types : let uu___58 = let uu___59 = text - "Read/write hints to dir/module_name.hints (instead of placing hint-file alongside source file)" in + "Don't print unification variable numbers" in (FStar_Getopt.noshort, - "hint_dir", - (PostProcessed - (pp_validate_dir, - (PathStr - "dir"))), + "hide_uvar_nums", + (Const + (Bool + true)), uu___59) in let uu___59 = let uu___60 = let uu___61 = text - "Read/write hints to path (instead of module-specific hints files; overrides hint_dir)" in + "Read/write hints to dir/module_name.hints (instead of placing hint-file alongside source file)" in (FStar_Getopt.noshort, - "hint_file", + "hint_dir", ( - PathStr - "path"), + PostProcessed + (pp_validate_dir, + (PathStr + "dir"))), uu___61) in let uu___61 = let uu___62 @@ -1392,11 +1397,11 @@ let rec (specs_with_types : let uu___63 = text - "Use to generate hints for definitions which do not have them. The command will receive a JSON representation of the query, the type of the top-level definition involved, and the full SMT theory, and must output a comma separated list of facts to be used." in + "Read/write hints to path (instead of module-specific hints files; overrides hint_dir)" in (FStar_Getopt.noshort, - "hint_hook", - (SimpleStr - "command"), + "hint_file", + (PathStr + "path"), uu___63) in let uu___63 = @@ -1405,12 +1410,11 @@ let rec (specs_with_types : let uu___65 = text - "Print information regarding hints (deprecated; use --query_stats instead)" in + "Use to generate hints for definitions which do not have them. The command will receive a JSON representation of the query, the type of the top-level definition involved, and the full SMT theory, and must output a comma separated list of facts to be used." in (FStar_Getopt.noshort, - "hint_info", - (Const - (Bool - true)), + "hint_hook", + (SimpleStr + "command"), uu___65) in let uu___65 = @@ -1419,9 +1423,9 @@ let rec (specs_with_types : let uu___67 = text - "Legacy interactive mode; reads input from stdin" in + "Print information regarding hints (deprecated; use --query_stats instead)" in (FStar_Getopt.noshort, - "in", + "hint_info", (Const (Bool true)), @@ -1433,9 +1437,9 @@ let rec (specs_with_types : let uu___69 = text - "JSON-based interactive mode for IDEs" in + "Legacy interactive mode; reads input from stdin" in (FStar_Getopt.noshort, - "ide", + "in", (Const (Bool true)), @@ -1447,9 +1451,9 @@ let rec (specs_with_types : let uu___71 = text - "Disable identifier tables in IDE mode (temporary workaround useful in Steel)" in + "JSON-based interactive mode for IDEs" in (FStar_Getopt.noshort, - "ide_id_info_off", + "ide", (Const (Bool true)), @@ -1461,9 +1465,9 @@ let rec (specs_with_types : let uu___73 = text - "Language Server Protocol-based interactive mode for IDEs" in + "Disable identifier tables in IDE mode (temporary workaround useful in Steel)" in (FStar_Getopt.noshort, - "lsp", + "ide_id_info_off", (Const (Bool true)), @@ -1475,12 +1479,12 @@ let rec (specs_with_types : let uu___75 = text - "A directory in which to search for files included on the command line" in + "Language Server Protocol-based interactive mode for IDEs" in (FStar_Getopt.noshort, - "include", - (ReverseAccumulated - (PathStr - "path")), + "lsp", + (Const + (Bool + true)), uu___75) in let uu___75 = @@ -1489,12 +1493,12 @@ let rec (specs_with_types : let uu___77 = text - "Parses and prettyprints the files included on the command line" in + "A directory in which to search for files included on the command line" in (FStar_Getopt.noshort, - "print", - (Const - (Bool - true)), + "include", + (ReverseAccumulated + (PathStr + "path")), uu___77) in let uu___77 = @@ -1503,9 +1507,9 @@ let rec (specs_with_types : let uu___79 = text - "Parses and prettyprints in place the files included on the command line" in + "Parses and prettyprints the files included on the command line" in (FStar_Getopt.noshort, - "print_in_place", + "print", (Const (Bool true)), @@ -1517,9 +1521,9 @@ let rec (specs_with_types : let uu___81 = text - "Force checking the files given as arguments even if they have valid checked files" in - (102, - "force", + "Parses and prettyprints in place the files included on the command line" in + (FStar_Getopt.noshort, + "print_in_place", (Const (Bool true)), @@ -1531,26 +1535,40 @@ let rec (specs_with_types : let uu___83 = text + "Force checking the files given as arguments even if they have valid checked files" in + (102, + "force", + (Const + (Bool + true)), + uu___83) in + let uu___83 + = + let uu___84 + = + let uu___85 + = + text "Set initial_fuel and max_fuel at once" in (FStar_Getopt.noshort, "fuel", (PostProcessed ((fun - uu___84 + uu___86 -> - match uu___84 + match uu___86 with | String s -> let p f = - let uu___85 + let uu___87 = FStar_Compiler_Util.int_of_string f in Int - uu___85 in - let uu___85 + uu___87 in + let uu___87 = match FStar_Compiler_Util.split @@ -1564,40 +1582,40 @@ let rec (specs_with_types : -> (f1, f2) | - uu___86 + uu___88 -> FStar_Compiler_Effect.failwith "unexpected value for --fuel" in - (match uu___85 + (match uu___87 with | (min, max) -> (( - let uu___87 + let uu___89 = p min in set_option "initial_fuel" - uu___87); - (let uu___88 + uu___89); + (let uu___90 = p max in set_option "max_fuel" - uu___88); + uu___90); String s)) | - uu___85 + uu___87 -> FStar_Compiler_Effect.failwith "impos"), (SimpleStr "non-negative integer or pair of non-negative integers"))), - uu___83) in - let uu___83 + uu___85) in + let uu___85 = - let uu___84 + let uu___86 = - let uu___85 + let uu___87 = text "Set initial_ifuel and max_ifuel at once" in @@ -1605,21 +1623,21 @@ let rec (specs_with_types : "ifuel", (PostProcessed ((fun - uu___86 + uu___88 -> - match uu___86 + match uu___88 with | String s -> let p f = - let uu___87 + let uu___89 = FStar_Compiler_Util.int_of_string f in Int - uu___87 in - let uu___87 + uu___89 in + let uu___89 = match FStar_Compiler_Util.split @@ -1633,40 +1651,40 @@ let rec (specs_with_types : -> (f1, f2) | - uu___88 + uu___90 -> FStar_Compiler_Effect.failwith "unexpected value for --ifuel" in - (match uu___87 + (match uu___89 with | (min, max) -> (( - let uu___89 + let uu___91 = p min in set_option "initial_ifuel" - uu___89); - (let uu___90 + uu___91); + (let uu___92 = p max in set_option "max_ifuel" - uu___90); + uu___92); String s)) | - uu___87 + uu___89 -> FStar_Compiler_Effect.failwith "impos"), (SimpleStr "non-negative integer or pair of non-negative integers"))), - uu___85) in - let uu___85 + uu___87) in + let uu___87 = - let uu___86 + let uu___88 = - let uu___87 + let uu___89 = text "Number of unrolling of recursive functions to try initially (default 2)" in @@ -1674,12 +1692,12 @@ let rec (specs_with_types : "initial_fuel", (IntStr "non-negative integer"), - uu___87) in - let uu___87 + uu___89) in + let uu___89 = - let uu___88 + let uu___90 = - let uu___89 + let uu___91 = text "Number of unrolling of inductive datatypes to try at first (default 1)" in @@ -1687,24 +1705,24 @@ let rec (specs_with_types : "initial_ifuel", (IntStr "non-negative integer"), - uu___89) in - let uu___89 + uu___91) in + let uu___91 = - let uu___90 + let uu___92 = - let uu___91 + let uu___93 = text "Retain comments in the logged SMT queries (requires --log_queries or --log_failing_queries; default true)" in (FStar_Getopt.noshort, "keep_query_captions", BoolStr, - uu___91) in - let uu___91 + uu___93) in + let uu___93 = - let uu___92 + let uu___94 = - let uu___93 + let uu___95 = text "Run the lax-type checker only (admit all verification conditions)" in @@ -1712,7 +1730,7 @@ let rec (specs_with_types : "lax", (WithSideEffect ((fun - uu___94 + uu___96 -> if warn_unsafe @@ -1723,12 +1741,12 @@ let rec (specs_with_types : (Const (Bool true)))), - uu___93) in - let uu___93 + uu___95) in + let uu___95 = - let uu___94 + let uu___96 = - let uu___95 + let uu___97 = text "Load OCaml module, compiling it if necessary" in @@ -1737,12 +1755,12 @@ let rec (specs_with_types : (ReverseAccumulated (PathStr "module")), - uu___95) in - let uu___95 + uu___97) in + let uu___97 = - let uu___96 + let uu___98 = - let uu___97 + let uu___99 = text "Load compiled module, fails hard if the module is not already compiled" in @@ -1751,12 +1769,12 @@ let rec (specs_with_types : (ReverseAccumulated (PathStr "module")), - uu___97) in - let uu___97 + uu___99) in + let uu___99 = - let uu___98 + let uu___100 = - let uu___99 + let uu___101 = text "Print types computed for data/val/let-bindings" in @@ -1765,21 +1783,7 @@ let rec (specs_with_types : (Const (Bool true)), - uu___99) in - let uu___99 - = - let uu___100 - = - let uu___101 - = - text - "Log the Z3 queries in several queries-*.smt2 files, as we go" in - (FStar_Getopt.noshort, - "log_queries", - (Const - (Bool - true)), - uu___101) in + uu___101) in let uu___101 = let uu___102 @@ -1787,9 +1791,9 @@ let rec (specs_with_types : let uu___103 = text - "As --log_queries, but only save the failing queries. Each query is\n saved in its own file regardless of whether they were checked during the\n same invocation. The SMT2 file names begin with \"failedQueries\"" in + "Log the Z3 queries in several queries-*.smt2 files, as we go" in (FStar_Getopt.noshort, - "log_failing_queries", + "log_queries", (Const (Bool true)), @@ -1801,11 +1805,12 @@ let rec (specs_with_types : let uu___105 = text - "Number of unrolling of recursive functions to try at most (default 8)" in + "As --log_queries, but only save the failing queries. Each query is\n saved in its own file regardless of whether they were checked during the\n same invocation. The SMT2 file names begin with \"failedQueries\"" in (FStar_Getopt.noshort, - "max_fuel", - (IntStr - "non-negative integer"), + "log_failing_queries", + (Const + (Bool + true)), uu___105) in let uu___105 = @@ -1814,9 +1819,9 @@ let rec (specs_with_types : let uu___107 = text - "Number of unrolling of inductive datatypes to try at most (default 2)" in + "Number of unrolling of recursive functions to try at most (default 8)" in (FStar_Getopt.noshort, - "max_ifuel", + "max_fuel", (IntStr "non-negative integer"), uu___107) in @@ -1827,12 +1832,11 @@ let rec (specs_with_types : let uu___109 = text - "Trigger various specializations for compiling the F* compiler itself (not meant for user code)" in + "Number of unrolling of inductive datatypes to try at most (default 2)" in (FStar_Getopt.noshort, - "MLish", - (Const - (Bool - true)), + "max_ifuel", + (IntStr + "non-negative integer"), uu___109) in let uu___109 = @@ -1841,9 +1845,9 @@ let rec (specs_with_types : let uu___111 = text - "Ignore the default module search paths" in + "Trigger various specializations for compiling the F* compiler itself (not meant for user code)" in (FStar_Getopt.noshort, - "no_default_includes", + "MLish", (Const (Bool true)), @@ -1855,12 +1859,12 @@ let rec (specs_with_types : let uu___113 = text - "Deprecated: use --extract instead; Do not extract code from this module" in + "Ignore the default module search paths" in (FStar_Getopt.noshort, - "no_extract", - (Accumulated - (PathStr - "module name")), + "no_default_includes", + (Const + (Bool + true)), uu___113) in let uu___113 = @@ -1869,12 +1873,12 @@ let rec (specs_with_types : let uu___115 = text - "Suppress location information in the generated OCaml output (only relevant with --codegen OCaml)" in + "Deprecated: use --extract instead; Do not extract code from this module" in (FStar_Getopt.noshort, - "no_location_info", - (Const - (Bool - true)), + "no_extract", + (Accumulated + (PathStr + "module name")), uu___115) in let uu___115 = @@ -1883,9 +1887,9 @@ let rec (specs_with_types : let uu___117 = text - "Do not send any queries to the SMT solver, and fail on them instead" in + "Suppress location information in the generated OCaml output (only relevant with --codegen OCaml)" in (FStar_Getopt.noshort, - "no_smt", + "no_location_info", (Const (Bool true)), @@ -1897,9 +1901,9 @@ let rec (specs_with_types : let uu___119 = text - "Extract top-level pure terms after normalizing them. This can lead to very large code, but can result in more partial evaluation and compile-time specialization." in + "Do not send any queries to the SMT solver, and fail on them instead" in (FStar_Getopt.noshort, - "normalize_pure_terms_for_extraction", + "no_smt", (Const (Bool true)), @@ -1911,13 +1915,12 @@ let rec (specs_with_types : let uu___121 = text - "Place output in directory dir" in + "Extract top-level pure terms after normalizing them. This can lead to very large code, but can result in more partial evaluation and compile-time specialization." in (FStar_Getopt.noshort, - "odir", - (PostProcessed - (pp_validate_dir, - (PathStr - "dir"))), + "normalize_pure_terms_for_extraction", + (Const + (Bool + true)), uu___121) in let uu___121 = @@ -1926,11 +1929,13 @@ let rec (specs_with_types : let uu___123 = text - "Output the result of --dep into this file instead of to standard output." in + "Place output in directory dir" in (FStar_Getopt.noshort, - "output_deps_to", + "odir", + (PostProcessed + (pp_validate_dir, (PathStr - "file"), + "dir"))), uu___123) in let uu___123 = @@ -1939,9 +1944,9 @@ let rec (specs_with_types : let uu___125 = text - "Use a custom prims.fst file. Do not use if you do not know exactly what you're doing." in + "Output the result of --dep into this file instead of to standard output." in (FStar_Getopt.noshort, - "prims", + "output_deps_to", (PathStr "file"), uu___125) in @@ -1952,12 +1957,11 @@ let rec (specs_with_types : let uu___127 = text - "Print the types of bound variables" in + "Use a custom prims.fst file. Do not use if you do not know exactly what you're doing." in (FStar_Getopt.noshort, - "print_bound_var_types", - (Const - (Bool - true)), + "prims", + (PathStr + "file"), uu___127) in let uu___127 = @@ -1966,9 +1970,9 @@ let rec (specs_with_types : let uu___129 = text - "Print inferred predicate transformers for all computation types" in + "Print the types of bound variables" in (FStar_Getopt.noshort, - "print_effect_args", + "print_bound_var_types", (Const (Bool true)), @@ -1980,9 +1984,9 @@ let rec (specs_with_types : let uu___131 = text - "Print the errors generated by declarations marked with expect_failure, useful for debugging error locations" in + "Print inferred predicate transformers for all computation types" in (FStar_Getopt.noshort, - "print_expected_failures", + "print_effect_args", (Const (Bool true)), @@ -1994,9 +1998,9 @@ let rec (specs_with_types : let uu___133 = text - "Print full names of variables" in + "Print the errors generated by declarations marked with expect_failure, useful for debugging error locations" in (FStar_Getopt.noshort, - "print_full_names", + "print_expected_failures", (Const (Bool true)), @@ -2008,9 +2012,9 @@ let rec (specs_with_types : let uu___135 = text - "Print implicit arguments" in + "Print full names of variables" in (FStar_Getopt.noshort, - "print_implicits", + "print_full_names", (Const (Bool true)), @@ -2022,9 +2026,9 @@ let rec (specs_with_types : let uu___137 = text - "Print universes" in + "Print implicit arguments" in (FStar_Getopt.noshort, - "print_universes", + "print_implicits", (Const (Bool true)), @@ -2036,9 +2040,9 @@ let rec (specs_with_types : let uu___139 = text - "Print Z3 statistics for each SMT query (details such as relevant modules, facts, etc. for each proof)" in + "Print universes" in (FStar_Getopt.noshort, - "print_z3_statistics", + "print_universes", (Const (Bool true)), @@ -2050,9 +2054,9 @@ let rec (specs_with_types : let uu___141 = text - "Print full names (deprecated; use --print_full_names instead)" in + "Print Z3 statistics for each SMT query (details such as relevant modules, facts, etc. for each proof)" in (FStar_Getopt.noshort, - "prn", + "print_z3_statistics", (Const (Bool true)), @@ -2064,9 +2068,9 @@ let rec (specs_with_types : let uu___143 = text - "Proof recovery mode: before failing an SMT query, retry 3 times, increasing rlimits. If the query goes through after retrying, verification will succeed, but a warning will be emitted. This feature is useful to restore a project after some change to its libraries or F* upgrade. Importantly, then, this option cannot be used in a pragma (#set-options, etc)." in + "Print full names (deprecated; use --print_full_names instead)" in (FStar_Getopt.noshort, - "proof_recovery", + "prn", (Const (Bool true)), @@ -2077,76 +2081,90 @@ let rec (specs_with_types : = let uu___145 = + text + "Proof recovery mode: before failing an SMT query, retry 3 times, increasing rlimits. If the query goes through after retrying, verification will succeed, but a warning will be emitted. This feature is useful to restore a project after some change to its libraries or F* upgrade. Importantly, then, this option cannot be used in a pragma (#set-options, etc)." in + (FStar_Getopt.noshort, + "proof_recovery", + (Const + (Bool + true)), + uu___145) in + let uu___145 + = let uu___146 = - text - "Repeats SMT queries to check for robustness" in let uu___147 = let uu___148 = + text + "Repeats SMT queries to check for robustness" in let uu___149 = let uu___150 = - text - "--quake N/M repeats each query checks that it succeeds at least N out of M times, aborting early if possible" in let uu___151 = let uu___152 = text - "--quake N/M/k works as above, except it will unconditionally run M times" in + "--quake N/M repeats each query checks that it succeeds at least N out of M times, aborting early if possible" in let uu___153 = let uu___154 = text - "--quake N is an alias for --quake N/N" in + "--quake N/M/k works as above, except it will unconditionally run M times" in let uu___155 = let uu___156 = text + "--quake N is an alias for --quake N/N" in + let uu___157 + = + let uu___158 + = + text "--quake N/k is an alias for --quake N/N/k" in - [uu___156] in + [uu___158] in + uu___156 + :: + uu___157 in uu___154 :: uu___155 in uu___152 :: uu___153 in - uu___150 - :: - uu___151 in FStar_Errors_Msg.bulleted - uu___149 in - let uu___149 + uu___151 in + let uu___151 = text "Using --quake disables --retry. When quake testing, queries are not splitted for error reporting unless '--split_queries always' is given. Queries from the smt_sync tactic are not quake-tested." in FStar_Pprint.op_Hat_Hat + uu___150 + uu___151 in + FStar_Pprint.op_Hat_Hat uu___148 uu___149 in - FStar_Pprint.op_Hat_Hat - uu___146 - uu___147 in (FStar_Getopt.noshort, "quake", (PostProcessed ((fun - uu___146 + uu___148 -> - match uu___146 + match uu___148 with | String s -> - let uu___147 + let uu___149 = interp_quake_arg s in - (match uu___147 + (match uu___149 with | (min, @@ -2167,18 +2185,18 @@ let rec (specs_with_types : false); String s)) | - uu___147 + uu___149 -> FStar_Compiler_Effect.failwith "impos"), (SimpleStr "positive integer or pair of positive integers"))), - uu___145) in - let uu___145 + uu___147) in + let uu___147 = - let uu___146 + let uu___148 = - let uu___147 + let uu___149 = text "Print SMT query statistics" in @@ -2187,12 +2205,12 @@ let rec (specs_with_types : (Const (Bool true)), - uu___147) in - let uu___147 + uu___149) in + let uu___149 = - let uu___148 + let uu___150 = - let uu___149 + let uu___151 = text "Record a database of hints for efficient proof replay" in @@ -2201,12 +2219,12 @@ let rec (specs_with_types : (Const (Bool true)), - uu___149) in - let uu___149 + uu___151) in + let uu___151 = - let uu___150 + let uu___152 = - let uu___151 + let uu___153 = text "Record the state of options used to check each sigelt, useful for the `check_with` attribute and metaprogramming. Note that this implies a performance hit and increases the size of checked files." in @@ -2215,12 +2233,12 @@ let rec (specs_with_types : (Const (Bool true)), - uu___151) in - let uu___151 + uu___153) in + let uu___153 = - let uu___152 + let uu___154 = - let uu___153 + let uu___155 = text "Retry each SMT query N times and succeed on the first try. Using --retry disables --quake." in @@ -2228,9 +2246,9 @@ let rec (specs_with_types : "retry", (PostProcessed ((fun - uu___154 + uu___156 -> - match uu___154 + match uu___156 with | Int i -> @@ -2251,18 +2269,18 @@ let rec (specs_with_types : true); Bool true) | - uu___155 + uu___157 -> FStar_Compiler_Effect.failwith "impos"), (IntStr "positive integer"))), - uu___153) in - let uu___153 + uu___155) in + let uu___155 = - let uu___154 + let uu___156 = - let uu___155 + let uu___157 = text "Optimistically, attempt using the recorded hint for toplevel_name (a top-level name in the current module) when trying to verify some other term 'g'" in @@ -2270,12 +2288,12 @@ let rec (specs_with_types : "reuse_hint_for", (SimpleStr "toplevel_name"), - uu___155) in - let uu___155 + uu___157) in + let uu___157 = - let uu___156 + let uu___158 = - let uu___157 + let uu___159 = text "Report every use of an escape hatch, include assume, admit, etc." in @@ -2284,12 +2302,12 @@ let rec (specs_with_types : (EnumStr ["warn"; "error"]), - uu___157) in - let uu___157 + uu___159) in + let uu___159 = - let uu___158 + let uu___160 = - let uu___159 + let uu___161 = text "Disable all non-critical output" in @@ -2298,12 +2316,12 @@ let rec (specs_with_types : (Const (Bool true)), - uu___159) in - let uu___159 + uu___161) in + let uu___161 = - let uu___160 + let uu___162 = - let uu___161 + let uu___163 = text "Path to the Z3 SMT solver (we could eventually support other solvers)" in @@ -2311,211 +2329,197 @@ let rec (specs_with_types : "smt", (PathStr "path"), - uu___161) in - let uu___161 + uu___163) in + let uu___163 = - let uu___162 + let uu___164 = - let uu___163 + let uu___165 = text "Toggle a peephole optimization that eliminates redundant uses of boxing/unboxing in the SMT encoding (default 'false')" in (FStar_Getopt.noshort, "smtencoding.elim_box", BoolStr, - uu___163) in - let uu___163 - = - let uu___164 - = + uu___165) in let uu___165 = let uu___166 = - text - "Control the representation of non-linear arithmetic functions in the SMT encoding:" in let uu___167 = let uu___168 = + text + "Control the representation of non-linear arithmetic functions in the SMT encoding:" in let uu___169 = let uu___170 = - text - "if 'boxwrap' use 'Prims.op_Multiply, Prims.op_Division, Prims.op_Modulus'" in let uu___171 = let uu___172 = text - "if 'native' use '*, div, mod'" in + "if 'boxwrap' use 'Prims.op_Multiply, Prims.op_Division, Prims.op_Modulus'" in let uu___173 = let uu___174 = text + "if 'native' use '*, div, mod'" in + let uu___175 + = + let uu___176 + = + text "if 'wrapped' use '_mul, _div, _mod : Int*Int -> Int'" in - [uu___174] in + [uu___176] in + uu___174 + :: + uu___175 in uu___172 :: uu___173 in - uu___170 - :: - uu___171 in FStar_Errors_Msg.bulleted - uu___169 in - let uu___169 + uu___171 in + let uu___171 = text "(default 'boxwrap')" in FStar_Pprint.op_Hat_Hat + uu___170 + uu___171 in + FStar_Pprint.op_Hat_Hat uu___168 uu___169 in - FStar_Pprint.op_Hat_Hat - uu___166 - uu___167 in (FStar_Getopt.noshort, "smtencoding.nl_arith_repr", (EnumStr ["native"; "wrapped"; "boxwrap"]), - uu___165) in - let uu___165 - = - let uu___166 - = + uu___167) in let uu___167 = let uu___168 = - text - "Toggle the representation of linear arithmetic functions in the SMT encoding:" in let uu___169 = let uu___170 = + text + "Toggle the representation of linear arithmetic functions in the SMT encoding:" in let uu___171 = let uu___172 = - text - "if 'boxwrap', use 'Prims.op_Addition, Prims.op_Subtraction, Prims.op_Minus'" in let uu___173 = let uu___174 = text + "if 'boxwrap', use 'Prims.op_Addition, Prims.op_Subtraction, Prims.op_Minus'" in + let uu___175 + = + let uu___176 + = + text "if 'native', use '+, -, -'" in - [uu___174] in - uu___172 + [uu___176] in + uu___174 :: - uu___173 in + uu___175 in FStar_Errors_Msg.bulleted - uu___171 in - let uu___171 + uu___173 in + let uu___173 = text "(default 'boxwrap')" in FStar_Pprint.op_Hat_Hat + uu___172 + uu___173 in + FStar_Pprint.op_Hat_Hat uu___170 uu___171 in - FStar_Pprint.op_Hat_Hat - uu___168 - uu___169 in (FStar_Getopt.noshort, "smtencoding.l_arith_repr", (EnumStr ["native"; "boxwrap"]), - uu___167) in - let uu___167 + uu___169) in + let uu___169 = - let uu___168 + let uu___170 = - let uu___169 + let uu___171 = text "Include an axiom in the SMT encoding to introduce proof-irrelevance from a constructive proof" in (FStar_Getopt.noshort, "smtencoding.valid_intro", BoolStr, - uu___169) in - let uu___169 + uu___171) in + let uu___171 = - let uu___170 + let uu___172 = - let uu___171 + let uu___173 = text "Include an axiom in the SMT encoding to eliminate proof-irrelevance into the existence of a proof witness" in (FStar_Getopt.noshort, "smtencoding.valid_elim", BoolStr, - uu___171) in - let uu___171 - = - let uu___172 - = + uu___173) in let uu___173 = let uu___174 = - text - "Split SMT verification conditions into several separate queries, one per goal. Helps with localizing errors." in let uu___175 = let uu___176 = + text + "Split SMT verification conditions into several separate queries, one per goal. Helps with localizing errors." in let uu___177 = - text - "Use 'no' to disable (this may reduce the quality of error messages)." in let uu___178 = let uu___179 = text - "Use 'on_failure' to split queries and retry when discharging fails (the default)" in + "Use 'no' to disable (this may reduce the quality of error messages)." in let uu___180 = let uu___181 = text + "Use 'on_failure' to split queries and retry when discharging fails (the default)" in + let uu___182 + = + let uu___183 + = + text "Use 'yes' to always split." in - [uu___181] in + [uu___183] in + uu___181 + :: + uu___182 in uu___179 :: uu___180 in - uu___177 - :: - uu___178 in FStar_Errors_Msg.bulleted - uu___176 in + uu___178 in FStar_Pprint.op_Hat_Hat - uu___174 - uu___175 in + uu___176 + uu___177 in (FStar_Getopt.noshort, "split_queries", (EnumStr ["no"; "on_failure"; "always"]), - uu___173) in - let uu___173 - = - let uu___174 - = - let uu___175 - = - text - "Do not use the lexical scope of tactics to improve binder names" in - (FStar_Getopt.noshort, - "tactic_raw_binders", - (Const - (Bool - true)), uu___175) in let uu___175 = @@ -2524,9 +2528,9 @@ let rec (specs_with_types : let uu___177 = text - "Do not recover from metaprogramming errors, and abort if one occurs" in + "Do not use the lexical scope of tactics to improve binder names" in (FStar_Getopt.noshort, - "tactics_failhard", + "tactic_raw_binders", (Const (Bool true)), @@ -2538,9 +2542,9 @@ let rec (specs_with_types : let uu___179 = text - "Print some rough information on tactics, such as the time they take to run" in + "Do not recover from metaprogramming errors, and abort if one occurs" in (FStar_Getopt.noshort, - "tactics_info", + "tactics_failhard", (Const (Bool true)), @@ -2552,9 +2556,9 @@ let rec (specs_with_types : let uu___181 = text - "Print a depth-indexed trace of tactic execution (Warning: very verbose)" in + "Print some rough information on tactics, such as the time they take to run" in (FStar_Getopt.noshort, - "tactic_trace", + "tactics_info", (Const (Bool true)), @@ -2566,11 +2570,12 @@ let rec (specs_with_types : let uu___183 = text - "Trace tactics up to a certain binding depth" in + "Print a depth-indexed trace of tactic execution (Warning: very verbose)" in (FStar_Getopt.noshort, - "tactic_trace_d", - (IntStr - "positive_integer"), + "tactic_trace", + (Const + (Bool + true)), uu___183) in let uu___183 = @@ -2579,12 +2584,11 @@ let rec (specs_with_types : let uu___185 = text - "Use NBE to evaluate metaprograms (experimental)" in + "Trace tactics up to a certain binding depth" in (FStar_Getopt.noshort, - "__tactics_nbe", - (Const - (Bool - true)), + "tactic_trace_d", + (IntStr + "positive_integer"), uu___185) in let uu___185 = @@ -2593,10 +2597,12 @@ let rec (specs_with_types : let uu___187 = text - "Attempt to normalize definitions marked as tcnorm (default 'true')" in + "Use NBE to evaluate metaprograms (experimental)" in (FStar_Getopt.noshort, - "tcnorm", - BoolStr, + "__tactics_nbe", + (Const + (Bool + true)), uu___187) in let uu___187 = @@ -2605,12 +2611,10 @@ let rec (specs_with_types : let uu___189 = text - "Print the time it takes to verify each top-level definition. This is just an alias for an invocation of the profiler, so it may not work well if combined with --profile. In particular, it implies --profile_group_by_decls." in + "Attempt to normalize definitions marked as tcnorm (default 'true')" in (FStar_Getopt.noshort, - "timing", - (Const - (Bool - true)), + "tcnorm", + BoolStr, uu___189) in let uu___189 = @@ -2619,9 +2623,9 @@ let rec (specs_with_types : let uu___191 = text - "Attach stack traces on errors" in + "Print the time it takes to verify each top-level definition. This is just an alias for an invocation of the profiler, so it may not work well if combined with --profile. In particular, it implies --profile_group_by_decl." in (FStar_Getopt.noshort, - "trace_error", + "timing", (Const (Bool true)), @@ -2633,9 +2637,9 @@ let rec (specs_with_types : let uu___193 = text - "Emit output formatted for debugging" in + "Attach stack traces on errors" in (FStar_Getopt.noshort, - "ugly", + "trace_error", (Const (Bool true)), @@ -2647,9 +2651,9 @@ let rec (specs_with_types : let uu___195 = text - "Let the SMT solver unfold inductive types to arbitrary depths (may affect verifier performance)" in + "Emit output formatted for debugging" in (FStar_Getopt.noshort, - "unthrottle_inductives", + "ugly", (Const (Bool true)), @@ -2661,9 +2665,9 @@ let rec (specs_with_types : let uu___197 = text - "Allow tactics to run external processes. WARNING: checking an untrusted F* file while using this option can have disastrous effects." in + "Let the SMT solver unfold inductive types to arbitrary depths (may affect verifier performance)" in (FStar_Getopt.noshort, - "unsafe_tactic_exec", + "unthrottle_inductives", (Const (Bool true)), @@ -2675,9 +2679,9 @@ let rec (specs_with_types : let uu___199 = text - "Use equality constraints when comparing higher-order types (Temporary)" in + "Allow tactics to run external processes. WARNING: checking an untrusted F* file while using this option can have disastrous effects." in (FStar_Getopt.noshort, - "use_eq_at_higher_order", + "unsafe_tactic_exec", (Const (Bool true)), @@ -2689,18 +2693,32 @@ let rec (specs_with_types : let uu___201 = text - "Use a previously recorded hints database for proof replay" in + "Use equality constraints when comparing higher-order types (Temporary)" in (FStar_Getopt.noshort, - "use_hints", + "use_eq_at_higher_order", (Const (Bool true)), uu___201) in let uu___201 = - let uu___202 + let uu___202 + = + let uu___203 + = + text + "Use a previously recorded hints database for proof replay" in + (FStar_Getopt.noshort, + "use_hints", + (Const + (Bool + true)), + uu___203) in + let uu___203 + = + let uu___204 = - let uu___203 + let uu___205 = text "Admit queries if their hash matches the hash recorded in the hints database" in @@ -2709,12 +2727,12 @@ let rec (specs_with_types : (Const (Bool true)), - uu___203) in - let uu___203 + uu___205) in + let uu___205 = - let uu___204 + let uu___206 = - let uu___205 + let uu___207 = text "Use compiled tactics from path" in @@ -2722,12 +2740,12 @@ let rec (specs_with_types : "use_native_tactics", (PathStr "path"), - uu___205) in - let uu___205 + uu___207) in + let uu___207 = - let uu___206 + let uu___208 = - let uu___207 + let uu___209 = text "Do not run plugins natively and interpret them as usual instead" in @@ -2736,12 +2754,12 @@ let rec (specs_with_types : (Const (Bool true)), - uu___207) in - let uu___207 + uu___209) in + let uu___209 = - let uu___208 + let uu___210 = - let uu___209 + let uu___211 = text "Do not run the tactic engine before discharging a VC" in @@ -2750,12 +2768,12 @@ let rec (specs_with_types : (Const (Bool true)), - uu___209) in - let uu___209 + uu___211) in + let uu___211 = - let uu___210 + let uu___212 = - let uu___211 + let uu___213 = text "Prunes the context to include only the facts from the given namespace or fact id. Facts can be include or excluded using the [+|-] qualifier. For example --using_facts_from '* -FStar.Reflection +FStar.Compiler.List -FStar.Compiler.List.Tot' will remove all facts from FStar.Compiler.List.Tot.*, retain all remaining facts from FStar.Compiler.List.*, remove all facts from FStar.Reflection.*, and retain all the rest. Note, the '+' is optional: --using_facts_from 'FStar.Compiler.List' is equivalent to --using_facts_from '+FStar.Compiler.List'. Multiple uses of this option accumulate, e.g., --using_facts_from A --using_facts_from B is interpreted as --using_facts_from A^B." in @@ -2764,12 +2782,12 @@ let rec (specs_with_types : (ReverseAccumulated (SimpleStr "One or more space-separated occurrences of '[+|-]( * | namespace | fact id)'")), - uu___211) in - let uu___211 + uu___213) in + let uu___213 = - let uu___212 + let uu___214 = - let uu___213 + let uu___215 = text "This does nothing and will be removed" in @@ -2778,12 +2796,12 @@ let rec (specs_with_types : (Const (Bool true)), - uu___213) in - let uu___213 + uu___215) in + let uu___215 = - let uu___214 + let uu___216 = - let uu___215 + let uu___217 = text "Display version number" in @@ -2791,7 +2809,7 @@ let rec (specs_with_types : "version", (WithSideEffect ((fun - uu___216 + uu___218 -> display_version (); @@ -2800,12 +2818,12 @@ let rec (specs_with_types : (Const (Bool true)))), - uu___215) in - let uu___215 + uu___217) in + let uu___217 = - let uu___216 + let uu___218 = - let uu___217 + let uu___219 = text "Warn when (a -> b) is desugared to (a -> Tot b)" in @@ -2814,12 +2832,12 @@ let rec (specs_with_types : (Const (Bool true)), - uu___217) in - let uu___217 + uu___219) in + let uu___219 = - let uu___218 + let uu___220 = - let uu___219 + let uu___221 = text "Z3 command line options" in @@ -2828,12 +2846,12 @@ let rec (specs_with_types : (ReverseAccumulated (SimpleStr "option")), - uu___219) in - let uu___219 + uu___221) in + let uu___221 = - let uu___220 + let uu___222 = - let uu___221 + let uu___223 = text "Z3 options in smt2 format" in @@ -2842,12 +2860,12 @@ let rec (specs_with_types : (ReverseAccumulated (SimpleStr "option")), - uu___221) in - let uu___221 + uu___223) in + let uu___223 = - let uu___222 + let uu___224 = - let uu___223 + let uu___225 = text "Restart Z3 after each query; useful for ensuring proof robustness" in @@ -2856,12 +2874,12 @@ let rec (specs_with_types : (Const (Bool true)), - uu___223) in - let uu___223 + uu___225) in + let uu___225 = - let uu___224 + let uu___226 = - let uu___225 + let uu___227 = text "Set the Z3 per-query resource limit (default 5 units, taking roughtly 5s)" in @@ -2869,12 +2887,12 @@ let rec (specs_with_types : "z3rlimit", (IntStr "positive_integer"), - uu___225) in - let uu___225 + uu___227) in + let uu___227 = - let uu___226 + let uu___228 = - let uu___227 + let uu___229 = text "Set the Z3 per-query resource limit multiplier. This is useful when, say, regenerating hints and you want to be more lax. (default 1)" in @@ -2882,12 +2900,12 @@ let rec (specs_with_types : "z3rlimit_factor", (IntStr "positive_integer"), - uu___227) in - let uu___227 + uu___229) in + let uu___229 = - let uu___228 + let uu___230 = - let uu___229 + let uu___231 = text "Set the Z3 random seed (default 0)" in @@ -2895,12 +2913,12 @@ let rec (specs_with_types : "z3seed", (IntStr "positive_integer"), - uu___229) in - let uu___229 + uu___231) in + let uu___231 = - let uu___230 + let uu___232 = - let uu___231 + let uu___233 = text "Set the version of Z3 that is to be used. Default: 4.8.5" in @@ -2908,12 +2926,12 @@ let rec (specs_with_types : "z3version", (SimpleStr "version"), - uu___231) in - let uu___231 + uu___233) in + let uu___233 = - let uu___232 + let uu___234 = - let uu___233 + let uu___235 = text "Don't check positivity of inductive types" in @@ -2921,7 +2939,7 @@ let rec (specs_with_types : "__no_positivity", (WithSideEffect ((fun - uu___234 + uu___236 -> if warn_unsafe @@ -2932,75 +2950,63 @@ let rec (specs_with_types : (Const (Bool true)))), - uu___233) in - let uu___233 - = - let uu___234 - = + uu___235) in let uu___235 = let uu___236 = - text - "The [-warn_error] option follows the OCaml syntax, namely:" in let uu___237 = let uu___238 = + text + "The [-warn_error] option follows the OCaml syntax, namely:" in let uu___239 = - text - "[r] is a range of warnings (either a number [n], or a range [n..n])" in let uu___240 = let uu___241 = text - "[-r] silences range [r]" in + "[r] is a range of warnings (either a number [n], or a range [n..n])" in let uu___242 = let uu___243 = text - "[+r] enables range [r] as warnings (NOTE: \"enabling\" an error will downgrade it to a warning)" in + "[-r] silences range [r]" in let uu___244 = let uu___245 = text + "[+r] enables range [r] as warnings (NOTE: \"enabling\" an error will downgrade it to a warning)" in + let uu___246 + = + let uu___247 + = + text "[@r] makes range [r] fatal." in - [uu___245] in + [uu___247] in + uu___245 + :: + uu___246 in uu___243 :: uu___244 in uu___241 :: uu___242 in - uu___239 - :: - uu___240 in FStar_Errors_Msg.bulleted - uu___238 in + uu___240 in FStar_Pprint.op_Hat_Hat - uu___236 - uu___237 in + uu___238 + uu___239 in (FStar_Getopt.noshort, "warn_error", (ReverseAccumulated (SimpleStr "")), - uu___235) in - let uu___235 - = - let uu___236 - = - let uu___237 - = - text - "Use normalization by evaluation as the default normalization strategy (default 'false')" in - (FStar_Getopt.noshort, - "use_nbe", - BoolStr, uu___237) in let uu___237 = @@ -3009,9 +3015,9 @@ let rec (specs_with_types : let uu___239 = text - "Use normalization by evaluation for normalizing terms before extraction (default 'false')" in + "Use normalization by evaluation as the default normalization strategy (default 'false')" in (FStar_Getopt.noshort, - "use_nbe_for_extraction", + "use_nbe", BoolStr, uu___239) in let uu___239 @@ -3021,9 +3027,9 @@ let rec (specs_with_types : let uu___241 = text - "Enforce trivial preconditions for unannotated effectful functions (default 'true')" in + "Use normalization by evaluation for normalizing terms before extraction (default 'false')" in (FStar_Getopt.noshort, - "trivial_pre_for_unannotated_effectful_fns", + "use_nbe_for_extraction", BoolStr, uu___241) in let uu___241 @@ -3033,12 +3039,24 @@ let rec (specs_with_types : let uu___243 = text + "Enforce trivial preconditions for unannotated effectful functions (default 'true')" in + (FStar_Getopt.noshort, + "trivial_pre_for_unannotated_effectful_fns", + BoolStr, + uu___243) in + let uu___243 + = + let uu___244 + = + let uu___245 + = + text "Debug messages for embeddings/unembeddings of natively compiled terms" in (FStar_Getopt.noshort, "__debug_embedding", (WithSideEffect ((fun - uu___244 + uu___246 -> FStar_Compiler_Effect.op_Colon_Equals debug_embedding @@ -3046,12 +3064,12 @@ let rec (specs_with_types : (Const (Bool true)))), - uu___243) in - let uu___243 + uu___245) in + let uu___245 = - let uu___244 + let uu___246 = - let uu___245 + let uu___247 = text "Eagerly embed and unembed terms to primitive operations and plugins: not recommended except for benchmarking" in @@ -3059,7 +3077,7 @@ let rec (specs_with_types : "eager_embedding", (WithSideEffect ((fun - uu___246 + uu___248 -> FStar_Compiler_Effect.op_Colon_Equals eager_embedding @@ -3067,12 +3085,12 @@ let rec (specs_with_types : (Const (Bool true)))), - uu___245) in - let uu___245 + uu___247) in + let uu___247 = - let uu___246 + let uu___248 = - let uu___247 + let uu___249 = text "Emit profiles grouped by declaration rather than by module" in @@ -3081,12 +3099,12 @@ let rec (specs_with_types : (Const (Bool true)), - uu___247) in - let uu___247 + uu___249) in + let uu___249 = - let uu___248 + let uu___250 = - let uu___249 + let uu___251 = text "Specific source locations in the compiler are instrumented with profiling counters. Pass `--profile_component FStar.TypeChecker` to enable all counters in the FStar.TypeChecker namespace. This option is a module or namespace selector, like many other options (e.g., `--extract`)" in @@ -3095,12 +3113,12 @@ let rec (specs_with_types : (Accumulated (SimpleStr "One or more space-separated occurrences of '[+|-]( * | namespace | module | identifier)'")), - uu___249) in - let uu___249 + uu___251) in + let uu___251 = - let uu___250 + let uu___252 = - let uu___251 + let uu___253 = text "Profiling can be enabled when the compiler is processing a given set of source modules. Pass `--profile FStar.Pervasives` to enable profiling when the compiler is processing any module in FStar.Pervasives. This option is a module or namespace selector, like many other options (e.g., `--extract`)" in @@ -3109,12 +3127,12 @@ let rec (specs_with_types : (Accumulated (SimpleStr "One or more space-separated occurrences of '[+|-]( * | namespace | module)'")), - uu___251) in - let uu___251 + uu___253) in + let uu___253 = - let uu___252 + let uu___254 = - let uu___253 + let uu___255 = text "Display this information" in @@ -3122,22 +3140,50 @@ let rec (specs_with_types : "help", (WithSideEffect ((fun - uu___254 + uu___256 -> ( - let uu___256 + let uu___258 = specs warn_unsafe in display_usage_aux - uu___256); + uu___258); FStar_Compiler_Effect.exit Prims.int_zero), (Const (Bool true)))), - uu___253) in - [uu___252] in + uu___255) in + let uu___255 + = + let uu___256 + = + let uu___257 + = + text + "List all debug keys and exit" in + (FStar_Getopt.noshort, + "list_debug_keys", + (WithSideEffect + ((fun + uu___258 + -> + display_debug_keys + (); + FStar_Compiler_Effect.exit + Prims.int_zero), + (Const + (Bool + true)))), + uu___257) in + [uu___256] in + uu___254 + :: + uu___255 in + uu___252 + :: + uu___253 in uu___250 :: uu___251 in @@ -3481,7 +3527,8 @@ let (settable : Prims.string -> Prims.bool) = | "compat_pre_typed_indexed_effects" -> true | "disallow_unification_guards" -> true | "debug" -> true - | "debug_level" -> true + | "debug_all" -> true + | "debug_all_modules" -> true | "defensive" -> true | "detail_errors" -> true | "detail_hint_replay" -> true @@ -3958,18 +4005,7 @@ let (codegen_libs : unit -> Prims.string Prims.list Prims.list) = fun uu___ -> let uu___1 = get_codegen_lib () in FStar_Compiler_List.map (fun x -> FStar_Compiler_Util.split x ".") uu___1 -let (debug_any : unit -> Prims.bool) = - fun uu___ -> let uu___1 = get_debug () in uu___1 <> [] -let (debug_module : Prims.string -> Prims.bool) = - fun modul -> - let uu___ = get_debug () in - FStar_Compiler_List.existsb (module_name_eq modul) uu___ -let (debug_at_level_no_module : debug_level_t -> Prims.bool) = - fun level -> debug_level_geq level -let (debug_at_level : Prims.string -> debug_level_t -> Prims.bool) = - fun modul -> - fun level -> (debug_module modul) && (debug_at_level_no_module level) -let (profile_group_by_decls : unit -> Prims.bool) = +let (profile_group_by_decl : unit -> Prims.bool) = fun uu___ -> get_profile_group_by_decl () let (defensive : unit -> Prims.bool) = fun uu___ -> let uu___1 = get_defensive () in uu___1 <> "no" @@ -4187,6 +4223,12 @@ let (use_nbe_for_extraction : unit -> Prims.bool) = fun uu___ -> get_use_nbe_for_extraction () let (trivial_pre_for_unannotated_effectful_fns : unit -> Prims.bool) = fun uu___ -> get_trivial_pre_for_unannotated_effectful_fns () +let (debug_keys : unit -> Prims.string Prims.list) = + fun uu___ -> lookup_opt "debug" as_comma_string_list +let (debug_all : unit -> Prims.bool) = + fun uu___ -> lookup_opt "debug_all" as_bool +let (debug_all_modules : unit -> Prims.bool) = + fun uu___ -> lookup_opt "debug_all_modules" as_bool let with_saved_options : 'a . (unit -> 'a) -> 'a = fun f -> let uu___ = let uu___1 = trace_error () in Prims.op_Negation uu___1 in diff --git a/ocaml/fstar-lib/generated/FStar_Parser_AST.ml b/ocaml/fstar-lib/generated/FStar_Parser_AST.ml index e9f0e558134..738743f4754 100644 --- a/ocaml/fstar-lib/generated/FStar_Parser_AST.ml +++ b/ocaml/fstar-lib/generated/FStar_Parser_AST.ml @@ -1665,7 +1665,8 @@ let (string_to_op : | "At" -> FStar_Pervasives_Native.Some ("@", FStar_Pervasives_Native.None) | "Plus" -> - FStar_Pervasives_Native.Some ("+", FStar_Pervasives_Native.None) + FStar_Pervasives_Native.Some + ("+", (FStar_Pervasives_Native.Some (Prims.of_int (2)))) | "Minus" -> FStar_Pervasives_Native.Some ("-", FStar_Pervasives_Native.None) | "Subtraction" -> @@ -1674,15 +1675,18 @@ let (string_to_op : | "Tilde" -> FStar_Pervasives_Native.Some ("~", FStar_Pervasives_Native.None) | "Slash" -> - FStar_Pervasives_Native.Some ("/", FStar_Pervasives_Native.None) + FStar_Pervasives_Native.Some + ("/", (FStar_Pervasives_Native.Some (Prims.of_int (2)))) | "Backslash" -> FStar_Pervasives_Native.Some ("\\", FStar_Pervasives_Native.None) | "Less" -> - FStar_Pervasives_Native.Some ("<", FStar_Pervasives_Native.None) + FStar_Pervasives_Native.Some + ("<", (FStar_Pervasives_Native.Some (Prims.of_int (2)))) | "Equals" -> FStar_Pervasives_Native.Some ("=", FStar_Pervasives_Native.None) | "Greater" -> - FStar_Pervasives_Native.Some (">", FStar_Pervasives_Native.None) + FStar_Pervasives_Native.Some + (">", (FStar_Pervasives_Native.Some (Prims.of_int (2)))) | "Underscore" -> FStar_Pervasives_Native.Some ("_", FStar_Pervasives_Native.None) | "Bar" -> diff --git a/ocaml/fstar-lib/generated/FStar_Parser_AST_Util.ml b/ocaml/fstar-lib/generated/FStar_Parser_AST_Util.ml index c210332f98b..c3aac1c6178 100644 --- a/ocaml/fstar-lib/generated/FStar_Parser_AST_Util.ml +++ b/ocaml/fstar-lib/generated/FStar_Parser_AST_Util.ml @@ -1071,10 +1071,36 @@ let (__proj__Mkerror_message__item__range : error_message -> FStar_Compiler_Range_Type.range) = fun projectee -> match projectee with | { message; range;_} -> range type extension_parser = - open_namespaces_and_abbreviations -> + { + parse_decl_name: Prims.string -> FStar_Compiler_Range_Type.range -> - (error_message, FStar_Parser_AST.decl) FStar_Pervasives.either + (error_message, FStar_Ident.ident) FStar_Pervasives.either + ; + parse_decl: + open_namespaces_and_abbreviations -> + Prims.string -> + FStar_Compiler_Range_Type.range -> + (error_message, FStar_Parser_AST.decl) FStar_Pervasives.either + } +let (__proj__Mkextension_parser__item__parse_decl_name : + extension_parser -> + Prims.string -> + FStar_Compiler_Range_Type.range -> + (error_message, FStar_Ident.ident) FStar_Pervasives.either) + = + fun projectee -> + match projectee with + | { parse_decl_name; parse_decl;_} -> parse_decl_name +let (__proj__Mkextension_parser__item__parse_decl : + extension_parser -> + open_namespaces_and_abbreviations -> + Prims.string -> + FStar_Compiler_Range_Type.range -> + (error_message, FStar_Parser_AST.decl) FStar_Pervasives.either) + = + fun projectee -> + match projectee with | { parse_decl_name; parse_decl;_} -> parse_decl let (extension_parser_table : extension_parser FStar_Compiler_Util.smap) = FStar_Compiler_Util.smap_create (Prims.of_int (20)) let (register_extension_parser : Prims.string -> extension_parser -> unit) = diff --git a/ocaml/fstar-lib/generated/FStar_Parser_Const.ml b/ocaml/fstar-lib/generated/FStar_Parser_Const.ml index ba1d30ce48a..89ca42413db 100644 --- a/ocaml/fstar-lib/generated/FStar_Parser_Const.ml +++ b/ocaml/fstar-lib/generated/FStar_Parser_Const.ml @@ -259,6 +259,8 @@ let (__range_lid : FStar_Ident.lident) = p2l ["FStar"; "Range"; "__range"] let (range_lid : FStar_Ident.lident) = p2l ["FStar"; "Range"; "range"] let (range_0 : FStar_Ident.lident) = p2l ["FStar"; "Range"; "range_0"] let (mk_range_lid : FStar_Ident.lident) = p2l ["FStar"; "Range"; "mk_range"] +let (join_range_lid : FStar_Ident.lident) = + p2l ["FStar"; "Range"; "join_range"] let (guard_free : FStar_Ident.lident) = pconst "guard_free" let (inversion_lid : FStar_Ident.lident) = p2l ["FStar"; "Pervasives"; "inversion"] diff --git a/ocaml/fstar-lib/generated/FStar_Parser_Dep.ml b/ocaml/fstar-lib/generated/FStar_Parser_Dep.ml index 3d30b1fd6f3..537ba47d770 100644 --- a/ocaml/fstar-lib/generated/FStar_Parser_Dep.ml +++ b/ocaml/fstar-lib/generated/FStar_Parser_Dep.ml @@ -9,6 +9,8 @@ let (uu___is_Open_namespace : open_kind -> Prims.bool) = fun projectee -> match projectee with | Open_namespace -> true | uu___ -> false type module_name = Prims.string +let (dbg : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Dep" let profile : 'uuuuu . (unit -> 'uuuuu) -> Prims.string -> 'uuuuu = fun f -> fun c -> FStar_Profiling.profile f FStar_Pervasives_Native.None c let with_file_outchannel : @@ -933,10 +935,10 @@ let (enter_namespace : = fun original_map -> fun working_map -> - fun prefix -> + fun sprefix -> fun implicit_open -> let found = FStar_Compiler_Util.mk_ref false in - let prefix1 = Prims.strcat prefix "." in + let sprefix1 = Prims.strcat sprefix "." in let suffix_exists mopt = match mopt with | FStar_Pervasives_Native.None -> false @@ -946,13 +948,13 @@ let (enter_namespace : FStar_Compiler_Util.smap_iter original_map (fun k -> fun uu___1 -> - if FStar_Compiler_Util.starts_with k prefix1 + if FStar_Compiler_Util.starts_with k sprefix1 then let suffix = FStar_Compiler_String.substring k - (FStar_Compiler_String.length prefix1) + (FStar_Compiler_String.length sprefix1) ((FStar_Compiler_String.length k) - - (FStar_Compiler_String.length prefix1)) in + (FStar_Compiler_String.length sprefix1)) in ((let suffix_filename = FStar_Compiler_Util.smap_try_find original_map suffix in if implicit_open && (suffix_exists suffix_filename) @@ -964,12 +966,58 @@ let (enter_namespace : let uu___3 = let uu___4 = let uu___5 = - let uu___6 = - FStar_Compiler_Util.format4 - "Implicitly opening %s namespace shadows (%s -> %s), rename %s to avoid conflicts" - prefix1 suffix str str in - FStar_Errors_Msg.text uu___6 in - [uu___5] in + let uu___6 = FStar_Pprint.break_ Prims.int_one in + let uu___7 = + let uu___8 = + FStar_Errors_Msg.text + "Implicitly opening namespace" in + let uu___9 = + let uu___10 = + let uu___11 = + FStar_Pprint.doc_of_string sprefix1 in + FStar_Pprint.squotes uu___11 in + let uu___11 = + let uu___12 = + FStar_Errors_Msg.text "shadows module" in + let uu___13 = + let uu___14 = + let uu___15 = + FStar_Pprint.doc_of_string suffix in + FStar_Pprint.squotes uu___15 in + let uu___15 = + let uu___16 = + FStar_Errors_Msg.text "in file" in + let uu___17 = + let uu___18 = + let uu___19 = + let uu___20 = + FStar_Pprint.doc_of_string str in + FStar_Pprint.dquotes uu___20 in + FStar_Pprint.op_Hat_Hat uu___19 + FStar_Pprint.dot in + [uu___18] in + uu___16 :: uu___17 in + uu___14 :: uu___15 in + uu___12 :: uu___13 in + uu___10 :: uu___11 in + uu___8 :: uu___9 in + FStar_Pprint.flow uu___6 uu___7 in + let uu___6 = + let uu___7 = + let uu___8 = FStar_Errors_Msg.text "Rename" in + let uu___9 = + let uu___10 = + let uu___11 = + FStar_Pprint.doc_of_string str in + FStar_Pprint.dquotes uu___11 in + let uu___11 = + FStar_Errors_Msg.text + "to avoid conflicts." in + FStar_Pprint.op_Hat_Slash_Hat uu___10 + uu___11 in + FStar_Pprint.op_Hat_Slash_Hat uu___8 uu___9 in + [uu___7] in + uu___5 :: uu___6 in (FStar_Errors_Codes.Warning_UnexpectedFile, uu___4) in FStar_Errors.log_issue_doc FStar_Compiler_Range_Type.dummyRange uu___3 @@ -1124,9 +1172,7 @@ let (collect_one : if uu___ then () else - (let uu___2 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "Dep") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg in if uu___2 then let uu___3 = FStar_Ident.range_of_lid module_name1 in @@ -1186,9 +1232,7 @@ let (collect_one : from_parsing_data uu___1 original_map filename in match uu___ with | (deps1, has_inline_for_extraction, mo_roots) -> - ((let uu___2 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "Dep") in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg in if uu___2 then let uu___3 = @@ -1884,9 +1928,7 @@ let (topological_dependences_of' : "Impossible: cycle detected after cycle detection has passed" | Black -> (all_friends, all_files) | White -> - ((let uu___2 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "Dep") in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg in if uu___2 then let uu___3 = @@ -1909,9 +1951,7 @@ let (topological_dependences_of' : | (all_friends1, all_files1) -> (deps_add_dep dep_graph1 filename { edges = (dep_node1.edges); color = Black }; - (let uu___6 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "Dep") in + (let uu___6 = FStar_Compiler_Effect.op_Bang dbg in if uu___6 then FStar_Compiler_Util.print1 "Adding %s\n" @@ -1936,9 +1976,7 @@ let (topological_dependences_of' : let uu___ = all_friend_deps dep_graph [] ([], []) root_files in match uu___ with | (friends1, all_files_0) -> - ((let uu___2 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "Dep") in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg in if uu___2 then let uu___3 = @@ -1957,9 +1995,7 @@ let (topological_dependences_of' : match uu___2 with | (widened1, dep_graph1) -> let uu___3 = - (let uu___5 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "Dep") in + (let uu___5 = FStar_Compiler_Effect.op_Bang dbg in if uu___5 then FStar_Compiler_Util.print_string @@ -1968,9 +2004,7 @@ let (topological_dependences_of' : all_friend_deps dep_graph1 [] ([], []) root_files in (match uu___3 with | (uu___4, all_files) -> - ((let uu___6 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "Dep") in + ((let uu___6 = FStar_Compiler_Effect.op_Bang dbg in if uu___6 then FStar_Compiler_Util.print1 @@ -1987,9 +2021,7 @@ let (phase1 : fun dep_graph -> fun interfaces_needing_inlining -> fun for_extraction -> - (let uu___1 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "Dep") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg in if uu___1 then FStar_Compiler_Util.print_string @@ -2226,9 +2258,7 @@ let (collect : "FStar.Parser.Dep.topological_dependences_of" in match uu___3 with | (all_files, uu___4) -> - ((let uu___6 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "Dep") in + ((let uu___6 = FStar_Compiler_Effect.op_Bang dbg in if uu___6 then FStar_Compiler_Util.print1 diff --git a/ocaml/fstar-lib/generated/FStar_PtrdiffT.ml b/ocaml/fstar-lib/generated/FStar_PtrdiffT.ml index 922174eee30..45945e4417f 100644 --- a/ocaml/fstar-lib/generated/FStar_PtrdiffT.ml +++ b/ocaml/fstar-lib/generated/FStar_PtrdiffT.ml @@ -4,7 +4,7 @@ type 'x fits = unit let (v : t -> Prims.int) = fun x -> FStar_Int64.v x let (int_to_t : Prims.int -> t) = fun x -> FStar_Int64.int_to_t x let (ptrdifft_to_sizet : t -> FStar_SizeT.t) = - fun x -> FStar_Int_Cast.int64_to_uint64 x + fun x -> FStar_SizeT.Sz (FStar_Int_Cast.int64_to_uint64 x) let (add : t -> t -> t) = fun x -> fun y -> FStar_Int64.add x y let (div : t -> t -> t) = fun x -> fun y -> FStar_Int64.div x y let (rem : t -> t -> t) = fun x -> fun y -> FStar_Int64.rem x y diff --git a/ocaml/fstar-lib/generated/FStar_Queue.ml b/ocaml/fstar-lib/generated/FStar_Queue.ml new file mode 100644 index 00000000000..7d6a4cad0d3 --- /dev/null +++ b/ocaml/fstar-lib/generated/FStar_Queue.ml @@ -0,0 +1,37 @@ +open Prims +type 'a queue = ('a Prims.list * 'a Prims.list) +let empty : 'a . unit -> 'a queue = fun uu___ -> ([], []) +let queue_to_list : 'a . 'a queue -> 'a Prims.list = + fun q -> + match FStar_Pervasives_Native.fst q with + | [] -> [] + | uu___ -> + FStar_List_Tot_Base.op_At (FStar_Pervasives_Native.fst q) + (FStar_List_Tot_Base.rev (FStar_Pervasives_Native.snd q)) +let queue_of_list : 'a . 'a Prims.list -> 'a queue = + fun l -> match l with | [] -> empty () | uu___ -> (l, []) +let queue_to_seq : 'a . 'a queue -> 'a FStar_Seq_Base.seq = + fun q -> FStar_Seq_Base.seq_of_list (queue_to_list q) +let queue_of_seq : 'a . 'a FStar_Seq_Base.seq -> 'a queue = + fun s -> queue_of_list (FStar_Seq_Base.seq_to_list s) +type ('a, 'q1, 'q2) equal = unit +type ('a, 'q) not_empty = unit +let enqueue : 'a . 'a -> 'a queue -> 'a queue = + fun x -> + fun q -> + match FStar_Pervasives_Native.fst q with + | [] -> ([x], []) + | l -> (l, (x :: (FStar_Pervasives_Native.snd q))) +let dequeue : 'a . 'a queue -> ('a * 'a queue) = + fun q -> + let uu___ = FStar_Pervasives_Native.fst q in + match uu___ with + | hd::tl -> + (match tl with + | [] -> + (hd, + ((FStar_List_Tot_Base.rev (FStar_Pervasives_Native.snd q)), + [])) + | uu___1 -> (hd, (tl, (FStar_Pervasives_Native.snd q)))) +let peek : 'a . 'a queue -> 'a = + fun q -> FStar_List_Tot_Base.hd (FStar_Pervasives_Native.fst q) \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_RefinementExtensionality.ml b/ocaml/fstar-lib/generated/FStar_RefinementExtensionality.ml new file mode 100644 index 00000000000..868c3b1fd91 --- /dev/null +++ b/ocaml/fstar-lib/generated/FStar_RefinementExtensionality.ml @@ -0,0 +1,5 @@ +open Prims +type 'x ref1 = unit +type 'x ref2 = unit +type ty1 = Prims.int +type ty2 = Prims.int \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Reflection_Typing.ml b/ocaml/fstar-lib/generated/FStar_Reflection_Typing.ml index 5e74410f138..7d5787a8e72 100644 --- a/ocaml/fstar-lib/generated/FStar_Reflection_Typing.ml +++ b/ocaml/fstar-lib/generated/FStar_Reflection_Typing.ml @@ -1652,13 +1652,16 @@ let (__proj__ST_Let_Opaque__item__ty : fun projectee -> match projectee with | ST_Let_Opaque (g, fv, ty, _3) -> ty type blob = (Prims.string * FStar_Reflection_Types.term) -type 'g sigelt_for = +type ('s, 't) sigelt_has_type = Obj.t +type ('g, 't) sigelt_for = (Prims.bool * FStar_Reflection_Types.sigelt * blob FStar_Pervasives_Native.option) -type 'g dsl_tac_result_t = unit sigelt_for Prims.list +type ('g, 't) dsl_tac_result_t = + ((unit, unit) sigelt_for Prims.list * (unit, unit) sigelt_for * (unit, + unit) sigelt_for Prims.list) type dsl_tac_t = - fstar_top_env -> - (unit dsl_tac_result_t, unit) FStar_Tactics_Effect.tac_repr + (fstar_top_env * FStar_Reflection_Types.typ FStar_Pervasives_Native.option) + -> ((unit, unit) dsl_tac_result_t, unit) FStar_Tactics_Effect.tac_repr let (if_complete_match : FStar_Reflection_Types.env -> FStar_Reflection_Types.term -> @@ -1734,146 +1737,61 @@ let (mkif : (brty ())) let (mk_checked_let : FStar_Reflection_Types.env -> - Prims.string -> - FStar_Reflection_Types.term -> - FStar_Reflection_Types.typ -> - (unit sigelt_for, unit) FStar_Tactics_Effect.tac_repr) + FStar_Reflection_Types.name -> + Prims.string -> + FStar_Reflection_Types.term -> + FStar_Reflection_Types.typ -> (unit, unit) sigelt_for) = fun g -> - fun nm -> - fun tm -> - fun ty -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Reflection.Typing.fsti" - (Prims.of_int (1833)) (Prims.of_int (11)) - (Prims.of_int (1833)) (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Reflection.Typing.fsti" - (Prims.of_int (1833)) (Prims.of_int (46)) - (Prims.of_int (1839)) (Prims.of_int (20))))) - (Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Reflection.Typing.fsti" - (Prims.of_int (1833)) (Prims.of_int (19)) - (Prims.of_int (1833)) (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Reflection.Typing.fsti" - (Prims.of_int (1833)) (Prims.of_int (11)) - (Prims.of_int (1833)) (Prims.of_int (43))))) - (Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Reflection.Typing.fsti" - (Prims.of_int (1833)) (Prims.of_int (20)) - (Prims.of_int (1833)) (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Reflection.Typing.fsti" - (Prims.of_int (1833)) (Prims.of_int (19)) - (Prims.of_int (1833)) (Prims.of_int (43))))) - (Obj.magic (FStar_Tactics_V2_Derived.cur_module ())) - (fun uu___ -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - FStar_List_Tot_Base.op_At uu___ [nm])))) - (fun uu___ -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - FStar_Reflection_V2_Builtins.pack_fv uu___)))) - (fun fv -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> - (true, - (FStar_Reflection_V2_Builtins.pack_sigelt - (FStar_Reflection_V2_Data.Sg_Let - (false, - [FStar_Reflection_V2_Builtins.pack_lb - { - FStar_Reflection_V2_Data.lb_fv = fv; - FStar_Reflection_V2_Data.lb_us = []; - FStar_Reflection_V2_Data.lb_typ = ty; - FStar_Reflection_V2_Data.lb_def = tm - }]))), FStar_Pervasives_Native.None))) + fun cur_module -> + fun nm -> + fun tm -> + fun ty -> + let fv = + FStar_Reflection_V2_Builtins.pack_fv + (FStar_List_Tot_Base.op_At cur_module [nm]) in + let lb = + FStar_Reflection_V2_Builtins.pack_lb + { + FStar_Reflection_V2_Data.lb_fv = fv; + FStar_Reflection_V2_Data.lb_us = []; + FStar_Reflection_V2_Data.lb_typ = ty; + FStar_Reflection_V2_Data.lb_def = tm + } in + let se = + FStar_Reflection_V2_Builtins.pack_sigelt + (FStar_Reflection_V2_Data.Sg_Let (false, [lb])) in + let pf = ST_Let (g, fv, ty, tm, ()) in + (true, se, FStar_Pervasives_Native.None) let (mk_unchecked_let : FStar_Reflection_Types.env -> - Prims.string -> - FStar_Reflection_Types.term -> - FStar_Reflection_Types.typ -> - (unit sigelt_for, unit) FStar_Tactics_Effect.tac_repr) + FStar_Reflection_Types.name -> + Prims.string -> + FStar_Reflection_Types.term -> + FStar_Reflection_Types.typ -> + (Prims.bool * FStar_Reflection_Types.sigelt * blob + FStar_Pervasives_Native.option)) = fun g -> - fun nm -> - fun tm -> - fun ty -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Reflection.Typing.fsti" - (Prims.of_int (1842)) (Prims.of_int (11)) - (Prims.of_int (1842)) (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Reflection.Typing.fsti" - (Prims.of_int (1842)) (Prims.of_int (46)) - (Prims.of_int (1845)) (Prims.of_int (21))))) - (Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Reflection.Typing.fsti" - (Prims.of_int (1842)) (Prims.of_int (19)) - (Prims.of_int (1842)) (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Reflection.Typing.fsti" - (Prims.of_int (1842)) (Prims.of_int (11)) - (Prims.of_int (1842)) (Prims.of_int (43))))) - (Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Reflection.Typing.fsti" - (Prims.of_int (1842)) (Prims.of_int (20)) - (Prims.of_int (1842)) (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Reflection.Typing.fsti" - (Prims.of_int (1842)) (Prims.of_int (19)) - (Prims.of_int (1842)) (Prims.of_int (43))))) - (Obj.magic (FStar_Tactics_V2_Derived.cur_module ())) - (fun uu___ -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - FStar_List_Tot_Base.op_At uu___ [nm])))) - (fun uu___ -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - FStar_Reflection_V2_Builtins.pack_fv uu___)))) - (fun fv -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> - (false, - (FStar_Reflection_V2_Builtins.pack_sigelt - (FStar_Reflection_V2_Data.Sg_Let - (false, - [FStar_Reflection_V2_Builtins.pack_lb - { - FStar_Reflection_V2_Data.lb_fv = fv; - FStar_Reflection_V2_Data.lb_us = []; - FStar_Reflection_V2_Data.lb_typ = ty; - FStar_Reflection_V2_Data.lb_def = tm - }]))), FStar_Pervasives_Native.None))) + fun cur_module -> + fun nm -> + fun tm -> + fun ty -> + let fv = + FStar_Reflection_V2_Builtins.pack_fv + (FStar_List_Tot_Base.op_At cur_module [nm]) in + let lb = + FStar_Reflection_V2_Builtins.pack_lb + { + FStar_Reflection_V2_Data.lb_fv = fv; + FStar_Reflection_V2_Data.lb_us = []; + FStar_Reflection_V2_Data.lb_typ = ty; + FStar_Reflection_V2_Data.lb_def = tm + } in + let se = + FStar_Reflection_V2_Builtins.pack_sigelt + (FStar_Reflection_V2_Data.Sg_Let (false, [lb])) in + (false, se, FStar_Pervasives_Native.None) let (typing_to_token : FStar_Reflection_Types.env -> FStar_Reflection_Types.term -> diff --git a/ocaml/fstar-lib/generated/FStar_Reflection_V1_Builtins.ml b/ocaml/fstar-lib/generated/FStar_Reflection_V1_Builtins.ml index 8679a07295b..1d431cf3cd4 100644 --- a/ocaml/fstar-lib/generated/FStar_Reflection_V1_Builtins.ml +++ b/ocaml/fstar-lib/generated/FStar_Reflection_V1_Builtins.ml @@ -882,22 +882,23 @@ let (inspect_sigelt : FStar_Syntax_Syntax.params = param_bs; FStar_Syntax_Syntax.num_uniform_params = uu___; FStar_Syntax_Syntax.t = ty; FStar_Syntax_Syntax.mutuals = uu___1; - FStar_Syntax_Syntax.ds = c_lids;_} + FStar_Syntax_Syntax.ds = c_lids; + FStar_Syntax_Syntax.injective_type_params = uu___2;_} -> let nm = FStar_Ident.path_of_lid lid in - let uu___2 = FStar_Syntax_Subst.univ_var_opening us in - (match uu___2 with + let uu___3 = FStar_Syntax_Subst.univ_var_opening us in + (match uu___3 with | (s, us1) -> let param_bs1 = FStar_Syntax_Subst.subst_binders s param_bs in let ty1 = FStar_Syntax_Subst.subst s ty in - let uu___3 = FStar_Syntax_Subst.open_term param_bs1 ty1 in - (match uu___3 with + let uu___4 = FStar_Syntax_Subst.open_term param_bs1 ty1 in + (match uu___4 with | (param_bs2, ty2) -> let inspect_ctor c_lid = - let uu___4 = - let uu___5 = get_env () in - FStar_TypeChecker_Env.lookup_sigelt uu___5 c_lid in - match uu___4 with + let uu___5 = + let uu___6 = get_env () in + FStar_TypeChecker_Env.lookup_sigelt uu___6 c_lid in + match uu___5 with | FStar_Pervasives_Native.Some { FStar_Syntax_Syntax.sigel = @@ -905,22 +906,24 @@ let (inspect_sigelt : { FStar_Syntax_Syntax.lid1 = lid1; FStar_Syntax_Syntax.us1 = us2; FStar_Syntax_Syntax.t1 = cty; - FStar_Syntax_Syntax.ty_lid = uu___5; + FStar_Syntax_Syntax.ty_lid = uu___6; FStar_Syntax_Syntax.num_ty_params = nparam; - FStar_Syntax_Syntax.mutuals1 = uu___6;_}; - FStar_Syntax_Syntax.sigrng = uu___7; - FStar_Syntax_Syntax.sigquals = uu___8; - FStar_Syntax_Syntax.sigmeta = uu___9; - FStar_Syntax_Syntax.sigattrs = uu___10; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___11; - FStar_Syntax_Syntax.sigopts = uu___12;_} + FStar_Syntax_Syntax.mutuals1 = uu___7; + FStar_Syntax_Syntax.injective_type_params1 = + uu___8;_}; + FStar_Syntax_Syntax.sigrng = uu___9; + FStar_Syntax_Syntax.sigquals = uu___10; + FStar_Syntax_Syntax.sigmeta = uu___11; + FStar_Syntax_Syntax.sigattrs = uu___12; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___13; + FStar_Syntax_Syntax.sigopts = uu___14;_} -> let cty1 = FStar_Syntax_Subst.subst s cty in - let uu___13 = - let uu___14 = get_env () in - FStar_TypeChecker_Normalize.get_n_binders uu___14 + let uu___15 = + let uu___16 = get_env () in + FStar_TypeChecker_Normalize.get_n_binders uu___16 nparam cty1 in - (match uu___13 with + (match uu___15 with | (param_ctor_bs, c) -> (if (FStar_Compiler_List.length param_ctor_bs) <> @@ -929,11 +932,11 @@ let (inspect_sigelt : FStar_Compiler_Effect.failwith "impossible: inspect_sigelt: could not obtain sufficient ctor param binders" else (); - (let uu___16 = - let uu___17 = + (let uu___18 = + let uu___19 = FStar_Syntax_Util.is_total_comp c in - Prims.op_Negation uu___17 in - if uu___16 + Prims.op_Negation uu___19 in + if uu___18 then FStar_Compiler_Effect.failwith "impossible: inspect_sigelt: removed parameters and got an effectful comp" @@ -943,26 +946,26 @@ let (inspect_sigelt : FStar_Compiler_List.map2 (fun b1 -> fun b2 -> - let uu___16 = - let uu___17 = + let uu___18 = + let uu___19 = FStar_Syntax_Syntax.bv_to_name b2.FStar_Syntax_Syntax.binder_bv in ((b1.FStar_Syntax_Syntax.binder_bv), - uu___17) in - FStar_Syntax_Syntax.NT uu___16) + uu___19) in + FStar_Syntax_Syntax.NT uu___18) param_ctor_bs param_bs2 in let cty3 = FStar_Syntax_Subst.subst s' cty2 in let cty4 = FStar_Syntax_Util.remove_inacc cty3 in - let uu___16 = FStar_Ident.path_of_lid lid1 in - (uu___16, cty4)))) - | uu___5 -> + let uu___18 = FStar_Ident.path_of_lid lid1 in + (uu___18, cty4)))) + | uu___6 -> FStar_Compiler_Effect.failwith "impossible: inspect_sigelt: did not find ctor" in - let uu___4 = - let uu___5 = FStar_Compiler_List.map inspect_ident us1 in - let uu___6 = FStar_Compiler_List.map inspect_ctor c_lids in - (nm, uu___5, param_bs2, ty2, uu___6) in - FStar_Reflection_V1_Data.Sg_Inductive uu___4)) + let uu___5 = + let uu___6 = FStar_Compiler_List.map inspect_ident us1 in + let uu___7 = FStar_Compiler_List.map inspect_ctor c_lids in + (nm, uu___6, param_bs2, ty2, uu___7) in + FStar_Reflection_V1_Data.Sg_Inductive uu___5)) | FStar_Syntax_Syntax.Sig_declare_typ { FStar_Syntax_Syntax.lid2 = lid; FStar_Syntax_Syntax.us2 = us; FStar_Syntax_Syntax.t2 = ty;_} @@ -1037,6 +1040,7 @@ let (pack_sigelt : (check_lid ind_lid; (let s = FStar_Syntax_Subst.univ_var_closing us_names1 in let nparam = FStar_Compiler_List.length param_bs in + let injective_type_params = false in let pack_ctor c = let uu___1 = c in match uu___1 with @@ -1056,7 +1060,9 @@ let (pack_sigelt : FStar_Syntax_Syntax.t1 = ty3; FStar_Syntax_Syntax.ty_lid = ind_lid; FStar_Syntax_Syntax.num_ty_params = nparam; - FStar_Syntax_Syntax.mutuals1 = [] + FStar_Syntax_Syntax.mutuals1 = []; + FStar_Syntax_Syntax.injective_type_params1 = + injective_type_params }) in let ctor_ses = FStar_Compiler_List.map pack_ctor ctors in let c_lids = @@ -1079,7 +1085,9 @@ let (pack_sigelt : FStar_Pervasives_Native.None; FStar_Syntax_Syntax.t = ty2; FStar_Syntax_Syntax.mutuals = []; - FStar_Syntax_Syntax.ds = c_lids + FStar_Syntax_Syntax.ds = c_lids; + FStar_Syntax_Syntax.injective_type_params = + injective_type_params }) in let se = FStar_Syntax_Syntax.mk_sigelt diff --git a/ocaml/fstar-lib/generated/FStar_Reflection_V2_Builtins.ml b/ocaml/fstar-lib/generated/FStar_Reflection_V2_Builtins.ml index f9d5a21a5de..245ff6c1fe4 100644 --- a/ocaml/fstar-lib/generated/FStar_Reflection_V2_Builtins.ml +++ b/ocaml/fstar-lib/generated/FStar_Reflection_V2_Builtins.ml @@ -604,9 +604,9 @@ let (compare_namedv : if n < Prims.int_zero then FStar_Order.Lt else if n = Prims.int_zero then FStar_Order.Eq else FStar_Order.Gt -let (lookup_attr : +let (lookup_attr_ses : FStar_Syntax_Syntax.term -> - FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.fv Prims.list) + FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.sigelt Prims.list) = fun attr -> fun env -> @@ -615,22 +615,27 @@ let (lookup_attr : uu___1.FStar_Syntax_Syntax.n in match uu___ with | FStar_Syntax_Syntax.Tm_fvar fv -> - let ses = - let uu___1 = - let uu___2 = FStar_Syntax_Syntax.lid_of_fv fv in - FStar_Ident.string_of_lid uu___2 in - FStar_TypeChecker_Env.lookup_attr env uu___1 in - FStar_Compiler_List.concatMap - (fun se -> - let uu___1 = FStar_Syntax_Util.lid_of_sigelt se in - match uu___1 with - | FStar_Pervasives_Native.None -> [] - | FStar_Pervasives_Native.Some l -> - let uu___2 = - FStar_Syntax_Syntax.lid_as_fv l - FStar_Pervasives_Native.None in - [uu___2]) ses + let uu___1 = + let uu___2 = FStar_Syntax_Syntax.lid_of_fv fv in + FStar_Ident.string_of_lid uu___2 in + FStar_TypeChecker_Env.lookup_attr env uu___1 | uu___1 -> [] +let (lookup_attr : + FStar_Syntax_Syntax.term -> + FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.fv Prims.list) + = + fun attr -> + fun env -> + let ses = lookup_attr_ses attr env in + FStar_Compiler_List.concatMap + (fun se -> + let uu___ = FStar_Syntax_Util.lid_of_sigelt se in + match uu___ with + | FStar_Pervasives_Native.None -> [] + | FStar_Pervasives_Native.Some l -> + let uu___1 = + FStar_Syntax_Syntax.lid_as_fv l FStar_Pervasives_Native.None in + [uu___1]) ses let (all_defs_in_env : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.fv Prims.list) = fun env -> @@ -829,37 +834,39 @@ let (inspect_sigelt : FStar_Syntax_Syntax.params = param_bs; FStar_Syntax_Syntax.num_uniform_params = uu___; FStar_Syntax_Syntax.t = ty; FStar_Syntax_Syntax.mutuals = uu___1; - FStar_Syntax_Syntax.ds = c_lids;_} + FStar_Syntax_Syntax.ds = c_lids; + FStar_Syntax_Syntax.injective_type_params = uu___2;_} -> let nm = FStar_Ident.path_of_lid lid in let inspect_ctor c_lid = - let uu___2 = - let uu___3 = get_env () in - FStar_TypeChecker_Env.lookup_sigelt uu___3 c_lid in - match uu___2 with + let uu___3 = + let uu___4 = get_env () in + FStar_TypeChecker_Env.lookup_sigelt uu___4 c_lid in + match uu___3 with | FStar_Pervasives_Native.Some { FStar_Syntax_Syntax.sigel = FStar_Syntax_Syntax.Sig_datacon { FStar_Syntax_Syntax.lid1 = lid1; FStar_Syntax_Syntax.us1 = us1; FStar_Syntax_Syntax.t1 = cty; - FStar_Syntax_Syntax.ty_lid = uu___3; + FStar_Syntax_Syntax.ty_lid = uu___4; FStar_Syntax_Syntax.num_ty_params = nparam; - FStar_Syntax_Syntax.mutuals1 = uu___4;_}; - FStar_Syntax_Syntax.sigrng = uu___5; - FStar_Syntax_Syntax.sigquals = uu___6; - FStar_Syntax_Syntax.sigmeta = uu___7; - FStar_Syntax_Syntax.sigattrs = uu___8; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___9; - FStar_Syntax_Syntax.sigopts = uu___10;_} - -> let uu___11 = FStar_Ident.path_of_lid lid1 in (uu___11, cty) - | uu___3 -> + FStar_Syntax_Syntax.mutuals1 = uu___5; + FStar_Syntax_Syntax.injective_type_params1 = uu___6;_}; + FStar_Syntax_Syntax.sigrng = uu___7; + FStar_Syntax_Syntax.sigquals = uu___8; + FStar_Syntax_Syntax.sigmeta = uu___9; + FStar_Syntax_Syntax.sigattrs = uu___10; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___11; + FStar_Syntax_Syntax.sigopts = uu___12;_} + -> let uu___13 = FStar_Ident.path_of_lid lid1 in (uu___13, cty) + | uu___4 -> FStar_Compiler_Effect.failwith "impossible: inspect_sigelt: did not find ctor" in - let uu___2 = - let uu___3 = FStar_Compiler_List.map inspect_ctor c_lids in - (nm, us, param_bs, ty, uu___3) in - FStar_Reflection_V2_Data.Sg_Inductive uu___2 + let uu___3 = + let uu___4 = FStar_Compiler_List.map inspect_ctor c_lids in + (nm, us, param_bs, ty, uu___4) in + FStar_Reflection_V2_Data.Sg_Inductive uu___3 | FStar_Syntax_Syntax.Sig_declare_typ { FStar_Syntax_Syntax.lid2 = lid; FStar_Syntax_Syntax.us2 = us; FStar_Syntax_Syntax.t2 = ty;_} @@ -919,6 +926,7 @@ let (pack_sigelt : FStar_Ident.lid_of_path nm FStar_Compiler_Range_Type.dummyRange in (check_lid ind_lid; (let nparam = FStar_Compiler_List.length param_bs in + let injective_type_params = false in let pack_ctor c = let uu___1 = c in match uu___1 with @@ -934,7 +942,9 @@ let (pack_sigelt : FStar_Syntax_Syntax.t1 = ty1; FStar_Syntax_Syntax.ty_lid = ind_lid; FStar_Syntax_Syntax.num_ty_params = nparam; - FStar_Syntax_Syntax.mutuals1 = [] + FStar_Syntax_Syntax.mutuals1 = []; + FStar_Syntax_Syntax.injective_type_params1 = + injective_type_params }) in let ctor_ses = FStar_Compiler_List.map pack_ctor ctors in let c_lids = @@ -953,7 +963,9 @@ let (pack_sigelt : FStar_Pervasives_Native.None; FStar_Syntax_Syntax.t = ty; FStar_Syntax_Syntax.mutuals = []; - FStar_Syntax_Syntax.ds = c_lids + FStar_Syntax_Syntax.ds = c_lids; + FStar_Syntax_Syntax.injective_type_params = + injective_type_params }) in let se = FStar_Syntax_Syntax.mk_sigelt diff --git a/ocaml/fstar-lib/generated/FStar_Reflection_V2_Interpreter.ml b/ocaml/fstar-lib/generated/FStar_Reflection_V2_Interpreter.ml index 01e6f8d4a05..dd0fc671008 100644 --- a/ocaml/fstar-lib/generated/FStar_Reflection_V2_Interpreter.ml +++ b/ocaml/fstar-lib/generated/FStar_Reflection_V2_Interpreter.ml @@ -337,43 +337,60 @@ let (reflection_primops : FStar_Reflection_V2_Builtins.compare_namedv in let uu___55 = let uu___56 = - mk2 "lookup_attr" + mk2 + "lookup_attr_ses" FStar_Reflection_V2_Embeddings.e_term FStar_Reflection_V2_Embeddings.e_env (FStar_Syntax_Embeddings.e_list - FStar_Reflection_V2_Embeddings.e_fv) + FStar_Reflection_V2_Embeddings.e_sigelt) FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_Reflection_V2_NBEEmbeddings.e_env (FStar_TypeChecker_NBETerm.e_list - FStar_Reflection_V2_NBEEmbeddings.e_fv) - FStar_Reflection_V2_Builtins.lookup_attr in + FStar_Reflection_V2_NBEEmbeddings.e_sigelt) + FStar_Reflection_V2_Builtins.lookup_attr_ses in let uu___57 = let uu___58 = - mk1 - "all_defs_in_env" + mk2 + "lookup_attr" + FStar_Reflection_V2_Embeddings.e_term FStar_Reflection_V2_Embeddings.e_env (FStar_Syntax_Embeddings.e_list FStar_Reflection_V2_Embeddings.e_fv) + FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_Reflection_V2_NBEEmbeddings.e_env (FStar_TypeChecker_NBETerm.e_list FStar_Reflection_V2_NBEEmbeddings.e_fv) - FStar_Reflection_V2_Builtins.all_defs_in_env in + FStar_Reflection_V2_Builtins.lookup_attr in let uu___59 = let uu___60 = - mk2 - "defs_in_module" + mk1 + "all_defs_in_env" FStar_Reflection_V2_Embeddings.e_env - FStar_Syntax_Embeddings.e_string_list (FStar_Syntax_Embeddings.e_list FStar_Reflection_V2_Embeddings.e_fv) FStar_Reflection_V2_NBEEmbeddings.e_env - FStar_TypeChecker_NBETerm.e_string_list (FStar_TypeChecker_NBETerm.e_list FStar_Reflection_V2_NBEEmbeddings.e_fv) - FStar_Reflection_V2_Builtins.defs_in_module in + FStar_Reflection_V2_Builtins.all_defs_in_env in let uu___61 = let uu___62 = mk2 + "defs_in_module" + FStar_Reflection_V2_Embeddings.e_env + FStar_Syntax_Embeddings.e_string_list + ( + FStar_Syntax_Embeddings.e_list + FStar_Reflection_V2_Embeddings.e_fv) + FStar_Reflection_V2_NBEEmbeddings.e_env + FStar_TypeChecker_NBETerm.e_string_list + ( + FStar_TypeChecker_NBETerm.e_list + FStar_Reflection_V2_NBEEmbeddings.e_fv) + FStar_Reflection_V2_Builtins.defs_in_module in + let uu___63 = + let uu___64 + = + mk2 "term_eq" FStar_Reflection_V2_Embeddings.e_term FStar_Reflection_V2_Embeddings.e_term @@ -382,8 +399,9 @@ let (reflection_primops : FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_TypeChecker_NBETerm.e_bool FStar_Reflection_V2_Builtins.term_eq in - let uu___63 = - let uu___64 + let uu___65 + = + let uu___66 = mk1 "moduleof" @@ -392,9 +410,9 @@ let (reflection_primops : FStar_Reflection_V2_NBEEmbeddings.e_env FStar_TypeChecker_NBETerm.e_string_list FStar_Reflection_V2_Builtins.moduleof in - let uu___65 + let uu___67 = - let uu___66 + let uu___68 = mk1 "vars_of_env" @@ -405,9 +423,9 @@ let (reflection_primops : (FStar_TypeChecker_NBETerm.e_list FStar_Reflection_V2_NBEEmbeddings.e_binding) FStar_Reflection_V2_Builtins.vars_of_env in - let uu___67 + let uu___69 = - let uu___68 + let uu___70 = mk2 "lookup_typ" @@ -420,9 +438,9 @@ let (reflection_primops : (FStar_TypeChecker_NBETerm.e_option FStar_Reflection_V2_NBEEmbeddings.e_sigelt) FStar_Reflection_V2_Builtins.lookup_typ in - let uu___69 + let uu___71 = - let uu___70 + let uu___72 = mk1 "env_open_modules" @@ -433,9 +451,9 @@ let (reflection_primops : (FStar_TypeChecker_NBETerm.e_list FStar_TypeChecker_NBETerm.e_string_list) FStar_Reflection_V2_Builtins.env_open_modules in - let uu___71 + let uu___73 = - let uu___72 + let uu___74 = mk1 "implode_qn" @@ -444,9 +462,9 @@ let (reflection_primops : FStar_TypeChecker_NBETerm.e_string_list FStar_TypeChecker_NBETerm.e_string FStar_Reflection_V2_Builtins.implode_qn in - let uu___73 + let uu___75 = - let uu___74 + let uu___76 = mk1 "explode_qn" @@ -455,9 +473,9 @@ let (reflection_primops : FStar_TypeChecker_NBETerm.e_string FStar_TypeChecker_NBETerm.e_string_list FStar_Reflection_V2_Builtins.explode_qn in - let uu___75 + let uu___77 = - let uu___76 + let uu___78 = mk2 "compare_string" @@ -468,9 +486,9 @@ let (reflection_primops : FStar_TypeChecker_NBETerm.e_string FStar_TypeChecker_NBETerm.e_int FStar_Reflection_V2_Builtins.compare_string in - let uu___77 + let uu___79 = - let uu___78 + let uu___80 = mk2 "push_namedv" @@ -481,9 +499,9 @@ let (reflection_primops : FStar_Reflection_V2_NBEEmbeddings.e_namedv FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Reflection_V2_Builtins.push_namedv in - let uu___79 + let uu___81 = - let uu___80 + let uu___82 = mk1 "range_of_term" @@ -492,9 +510,9 @@ let (reflection_primops : FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_TypeChecker_NBETerm.e_range FStar_Reflection_V2_Builtins.range_of_term in - let uu___81 + let uu___83 = - let uu___82 + let uu___84 = mk1 "range_of_sigelt" @@ -503,9 +521,9 @@ let (reflection_primops : FStar_Reflection_V2_NBEEmbeddings.e_sigelt FStar_TypeChecker_NBETerm.e_range FStar_Reflection_V2_Builtins.range_of_sigelt in - let uu___83 + let uu___85 = - let uu___84 + let uu___86 = mk1 "inspect_ident" @@ -518,9 +536,9 @@ let (reflection_primops : FStar_TypeChecker_NBETerm.e_string FStar_TypeChecker_NBETerm.e_range) FStar_Reflection_V2_Builtins.inspect_ident in - let uu___85 + let uu___87 = - let uu___86 + let uu___88 = mk1 "pack_ident" @@ -533,7 +551,10 @@ let (reflection_primops : FStar_TypeChecker_NBETerm.e_range) FStar_Reflection_V2_NBEEmbeddings.e_univ_name FStar_Reflection_V2_Builtins.pack_ident in - [uu___86] in + [uu___88] in + uu___86 + :: + uu___87 in uu___84 :: uu___85 in diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml index f861a5aed0b..80272ec4cdb 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Encode.ml @@ -1,4 +1,10 @@ open Prims +let (dbg_SMTEncoding : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "SMTEncoding" +let (dbg_SMTQuery : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "SMTQuery" +let (dbg_Time : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Time" let (norm_before_encoding : FStar_SMTEncoding_Env.env_t -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term) @@ -701,70 +707,90 @@ let (prims : prims_t) = | (l', uu___4) -> FStar_Ident.lid_equals l l') prims1 in { mk; is })) let (pretype_axiom : - FStar_Compiler_Range_Type.range -> - FStar_SMTEncoding_Env.env_t -> - FStar_SMTEncoding_Term.term -> - FStar_SMTEncoding_Term.fv Prims.list -> FStar_SMTEncoding_Term.decl) + Prims.bool -> + FStar_Compiler_Range_Type.range -> + FStar_SMTEncoding_Env.env_t -> + FStar_SMTEncoding_Term.term -> + FStar_SMTEncoding_Term.fv Prims.list -> FStar_SMTEncoding_Term.decl) = - fun rng -> - fun env -> - fun tapp -> - fun vars -> - let uu___ = - FStar_SMTEncoding_Env.fresh_fvar - env.FStar_SMTEncoding_Env.current_module_name "x" - FStar_SMTEncoding_Term.Term_sort in - match uu___ with - | (xxsym, xx) -> - let uu___1 = - FStar_SMTEncoding_Env.fresh_fvar - env.FStar_SMTEncoding_Env.current_module_name "f" - FStar_SMTEncoding_Term.Fuel_sort in - (match uu___1 with - | (ffsym, ff) -> - let xx_has_type = - FStar_SMTEncoding_Term.mk_HasTypeFuel ff xx tapp in - let tapp_hash = FStar_SMTEncoding_Term.hash_of_term tapp in - let module_name = - env.FStar_SMTEncoding_Env.current_module_name in - let uu___2 = - let uu___3 = + fun term_constr_eq -> + fun rng -> + fun env -> + fun tapp -> + fun vars -> + let uu___ = + FStar_SMTEncoding_Env.fresh_fvar + env.FStar_SMTEncoding_Env.current_module_name "x" + FStar_SMTEncoding_Term.Term_sort in + match uu___ with + | (xxsym, xx) -> + let uu___1 = + FStar_SMTEncoding_Env.fresh_fvar + env.FStar_SMTEncoding_Env.current_module_name "f" + FStar_SMTEncoding_Term.Fuel_sort in + (match uu___1 with + | (ffsym, ff) -> + let xx_has_type = + FStar_SMTEncoding_Term.mk_HasTypeFuel ff xx tapp in + let tapp_hash = FStar_SMTEncoding_Term.hash_of_term tapp in + let module_name = + env.FStar_SMTEncoding_Env.current_module_name in + let uu___2 = + let uu___3 = + let uu___4 = + let uu___5 = + let uu___6 = + FStar_SMTEncoding_Term.mk_fv + (xxsym, FStar_SMTEncoding_Term.Term_sort) in + let uu___7 = + let uu___8 = + FStar_SMTEncoding_Term.mk_fv + (ffsym, FStar_SMTEncoding_Term.Fuel_sort) in + uu___8 :: vars in + uu___6 :: uu___7 in + let uu___6 = + let uu___7 = + let uu___8 = + if term_constr_eq + then + let uu___9 = + let uu___10 = + FStar_SMTEncoding_Util.mkApp + ("Term_constr_id", [tapp]) in + let uu___11 = + let uu___12 = + let uu___13 = + let uu___14 = + FStar_SMTEncoding_Util.mkApp + ("PreType", [xx]) in + [uu___14] in + ("Term_constr_id", uu___13) in + FStar_SMTEncoding_Util.mkApp uu___12 in + (uu___10, uu___11) in + FStar_SMTEncoding_Util.mkEq uu___9 + else + (let uu___10 = + let uu___11 = + FStar_SMTEncoding_Util.mkApp + ("PreType", [xx]) in + (tapp, uu___11) in + FStar_SMTEncoding_Util.mkEq uu___10) in + (xx_has_type, uu___8) in + FStar_SMTEncoding_Util.mkImp uu___7 in + ([[xx_has_type]], uu___5, uu___6) in + FStar_SMTEncoding_Term.mkForall rng uu___4 in let uu___4 = let uu___5 = let uu___6 = - FStar_SMTEncoding_Term.mk_fv - (xxsym, FStar_SMTEncoding_Term.Term_sort) in - let uu___7 = - let uu___8 = - FStar_SMTEncoding_Term.mk_fv - (ffsym, FStar_SMTEncoding_Term.Fuel_sort) in - uu___8 :: vars in - uu___6 :: uu___7 in - let uu___6 = - let uu___7 = - let uu___8 = - let uu___9 = - let uu___10 = - FStar_SMTEncoding_Util.mkApp - ("PreType", [xx]) in - (tapp, uu___10) in - FStar_SMTEncoding_Util.mkEq uu___9 in - (xx_has_type, uu___8) in - FStar_SMTEncoding_Util.mkImp uu___7 in - ([[xx_has_type]], uu___5, uu___6) in - FStar_SMTEncoding_Term.mkForall rng uu___4 in - let uu___4 = - let uu___5 = - let uu___6 = - let uu___7 = - FStar_Compiler_Util.digest_of_string tapp_hash in - Prims.strcat "_pretyping_" uu___7 in - Prims.strcat module_name uu___6 in - FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.mk_unique - uu___5 in - (uu___3, (FStar_Pervasives_Native.Some "pretyping"), - uu___4) in - FStar_SMTEncoding_Util.mkAssume uu___2) + let uu___7 = + FStar_Compiler_Util.digest_of_string tapp_hash in + Prims.strcat "_pretyping_" uu___7 in + Prims.strcat module_name uu___6 in + FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.mk_unique + uu___5 in + (uu___3, (FStar_Pervasives_Native.Some "pretyping"), + uu___4) in + FStar_SMTEncoding_Util.mkAssume uu___2) let (primitive_type_axioms : FStar_TypeChecker_Env.env -> FStar_Ident.lident -> @@ -2100,8 +2126,9 @@ let (encode_free_var : FStar_Syntax_Syntax.range_of_fv fv in pretype_axiom - uu___15 env2 - vapp vars1 in + false uu___15 + env2 vapp + vars1 in [uu___14] in uu___12 :: uu___13 else [] in @@ -2680,10 +2707,8 @@ let (encode_top_level_let : FStar_Syntax_Util.comp_result t_body_comp in ((let uu___12 = - FStar_TypeChecker_Env.debug - env2.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other - "SMTEncoding") in + FStar_Compiler_Effect.op_Bang + dbg_SMTEncoding in if uu___12 then let uu___13 = @@ -3030,10 +3055,8 @@ let (encode_top_level_let : (match uu___12 with | (env', e1, t_norm1) -> ((let uu___14 = - FStar_TypeChecker_Env.debug - env01.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other - "SMTEncoding") in + FStar_Compiler_Effect.op_Bang + dbg_SMTEncoding in if uu___14 then let uu___15 = @@ -3067,10 +3090,8 @@ let (encode_top_level_let : (match uu___15 with | (pre_opt, tres) -> ((let uu___17 = - FStar_TypeChecker_Env.debug - env01.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other - "SMTEncoding") in + FStar_Compiler_Effect.op_Bang + dbg_SMTEncoding in if uu___17 then let uu___18 = @@ -3761,1589 +3782,671 @@ let (encode_top_level_let : (Prims.strcat "let rec unencodeable: Skipping: " msg) in let uu___2 = FStar_SMTEncoding_Term.mk_decls_trivial [decl] in (uu___2, env)) -let rec (encode_sigelt : +let (encode_sig_inductive : FStar_SMTEncoding_Env.env_t -> FStar_Syntax_Syntax.sigelt -> (FStar_SMTEncoding_Term.decls_t * FStar_SMTEncoding_Env.env_t)) = fun env -> fun se -> - let nm = FStar_Syntax_Print.sigelt_to_string_short se in - let uu___ = - let uu___1 = - let uu___2 = FStar_Syntax_Print.sigelt_to_string_short se in - FStar_Compiler_Util.format1 - "While encoding top-level declaration `%s`" uu___2 in - FStar_Errors.with_ctx uu___1 (fun uu___2 -> encode_sigelt' env se) in + let uu___ = se.FStar_Syntax_Syntax.sigel in match uu___ with - | (g, env1) -> - let g1 = - match g with - | [] -> - ((let uu___2 = - FStar_TypeChecker_Env.debug - env1.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in - if uu___2 - then - FStar_Compiler_Util.print1 "Skipped encoding of %s\n" nm - else ()); - (let uu___2 = - let uu___3 = - let uu___4 = - FStar_Compiler_Util.format1 "" nm in - FStar_SMTEncoding_Term.Caption uu___4 in - [uu___3] in - FStar_SMTEncoding_Term.mk_decls_trivial uu___2)) - | uu___1 -> - let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = - FStar_Compiler_Util.format1 "" nm in - FStar_SMTEncoding_Term.Caption uu___5 in - [uu___4] in - FStar_SMTEncoding_Term.mk_decls_trivial uu___3 in - let uu___3 = - let uu___4 = - let uu___5 = - let uu___6 = + | FStar_Syntax_Syntax.Sig_inductive_typ + { FStar_Syntax_Syntax.lid = t; + FStar_Syntax_Syntax.us = universe_names; + FStar_Syntax_Syntax.params = tps; + FStar_Syntax_Syntax.num_uniform_params = uu___1; + FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = uu___2; + FStar_Syntax_Syntax.ds = datas; + FStar_Syntax_Syntax.injective_type_params = injective_type_params;_} + -> + let t_lid = t in + let tcenv = env.FStar_SMTEncoding_Env.tcenv in + let quals = se.FStar_Syntax_Syntax.sigquals in + let is_logical = + FStar_Compiler_Util.for_some + (fun uu___3 -> + match uu___3 with + | FStar_Syntax_Syntax.Logic -> true + | FStar_Syntax_Syntax.Assumption -> true + | uu___4 -> false) quals in + let constructor_or_logic_type_decl c = + if is_logical + then + let uu___3 = + let uu___4 = + let uu___5 = + FStar_Compiler_List.map + (fun f -> f.FStar_SMTEncoding_Term.field_sort) + c.FStar_SMTEncoding_Term.constr_fields in + ((c.FStar_SMTEncoding_Term.constr_name), uu___5, + FStar_SMTEncoding_Term.Term_sort, + FStar_Pervasives_Native.None) in + FStar_SMTEncoding_Term.DeclFun uu___4 in + [uu___3] + else + (let uu___4 = FStar_Ident.range_of_lid t in + FStar_SMTEncoding_Term.constructor_to_decl uu___4 c) in + let inversion_axioms env1 tapp vars = + let uu___3 = + FStar_Compiler_Util.for_some + (fun l -> + let uu___4 = + FStar_TypeChecker_Env.try_lookup_lid + env1.FStar_SMTEncoding_Env.tcenv l in + FStar_Compiler_Option.isNone uu___4) datas in + if uu___3 + then [] + else + (let uu___5 = + FStar_SMTEncoding_Env.fresh_fvar + env1.FStar_SMTEncoding_Env.current_module_name "x" + FStar_SMTEncoding_Term.Term_sort in + match uu___5 with + | (xxsym, xx) -> + let uu___6 = + FStar_Compiler_List.fold_left + (fun uu___7 -> + fun l -> + match uu___7 with + | (out, decls) -> + let is_l = + FStar_SMTEncoding_Env.mk_data_tester env1 l + xx in + let uu___8 = + let uu___9 = + injective_type_params || + (let uu___10 = + FStar_Options.ext_getv + "compat:injectivity" in + uu___10 <> "") in + if uu___9 + then + let uu___10 = + FStar_TypeChecker_Env.lookup_datacon + env1.FStar_SMTEncoding_Env.tcenv l in + match uu___10 with + | (uu___11, data_t) -> + let uu___12 = + FStar_Syntax_Util.arrow_formals + data_t in + (match uu___12 with + | (args, res) -> + let indices = + let uu___13 = + FStar_Syntax_Util.head_and_args_full + res in + FStar_Pervasives_Native.snd + uu___13 in + let env2 = + FStar_Compiler_List.fold_left + (fun env3 -> + fun uu___13 -> + match uu___13 with + | { + FStar_Syntax_Syntax.binder_bv + = x; + FStar_Syntax_Syntax.binder_qual + = uu___14; + FStar_Syntax_Syntax.binder_positivity + = uu___15; + FStar_Syntax_Syntax.binder_attrs + = uu___16;_} + -> + let uu___17 = + let uu___18 = + let uu___19 = + FStar_SMTEncoding_Env.mk_term_projector_name + l x in + (uu___19, [xx]) in + FStar_SMTEncoding_Util.mkApp + uu___18 in + FStar_SMTEncoding_Env.push_term_var + env3 x uu___17) + env1 args in + let uu___13 = + FStar_SMTEncoding_EncodeTerm.encode_args + indices env2 in + (match uu___13 with + | (indices1, decls') -> + (if + (FStar_Compiler_List.length + indices1) + <> + (FStar_Compiler_List.length + vars) + then + FStar_Compiler_Effect.failwith + "Impossible" + else (); + (let eqs = + FStar_Compiler_List.map2 + (fun v -> + fun a -> + let uu___15 = + let uu___16 = + FStar_SMTEncoding_Util.mkFreeV + v in + (uu___16, a) in + FStar_SMTEncoding_Util.mkEq + uu___15) vars + indices1 in + let uu___15 = + let uu___16 = + let uu___17 = + FStar_SMTEncoding_Util.mk_and_l + eqs in + (is_l, uu___17) in + FStar_SMTEncoding_Util.mkAnd + uu___16 in + (uu___15, decls'))))) + else (is_l, []) in + (match uu___8 with + | (inversion_case, decls') -> + let uu___9 = + FStar_SMTEncoding_Util.mkOr + (out, inversion_case) in + (uu___9, + (FStar_Compiler_List.op_At decls + decls')))) + (FStar_SMTEncoding_Util.mkFalse, []) datas in + (match uu___6 with + | (data_ax, decls) -> let uu___7 = - FStar_Compiler_Util.format1 "" nm in - FStar_SMTEncoding_Term.Caption uu___7 in - [uu___6] in - FStar_SMTEncoding_Term.mk_decls_trivial uu___5 in - FStar_Compiler_List.op_At g uu___4 in - FStar_Compiler_List.op_At uu___2 uu___3 in - (g1, env1) -and (encode_sigelt' : + FStar_SMTEncoding_Env.fresh_fvar + env1.FStar_SMTEncoding_Env.current_module_name + "f" FStar_SMTEncoding_Term.Fuel_sort in + (match uu___7 with + | (ffsym, ff) -> + let fuel_guarded_inversion = + let xx_has_type_sfuel = + if + (FStar_Compiler_List.length datas) > + Prims.int_one + then + let uu___8 = + FStar_SMTEncoding_Util.mkApp + ("SFuel", [ff]) in + FStar_SMTEncoding_Term.mk_HasTypeFuel + uu___8 xx tapp + else + FStar_SMTEncoding_Term.mk_HasTypeFuel ff + xx tapp in + let uu___8 = + let uu___9 = + let uu___10 = FStar_Ident.range_of_lid t in + let uu___11 = + let uu___12 = + let uu___13 = + FStar_SMTEncoding_Term.mk_fv + (ffsym, + FStar_SMTEncoding_Term.Fuel_sort) in + let uu___14 = + let uu___15 = + FStar_SMTEncoding_Term.mk_fv + (xxsym, + FStar_SMTEncoding_Term.Term_sort) in + uu___15 :: vars in + FStar_SMTEncoding_Env.add_fuel uu___13 + uu___14 in + let uu___13 = + FStar_SMTEncoding_Util.mkImp + (xx_has_type_sfuel, data_ax) in + ([[xx_has_type_sfuel]], uu___12, + uu___13) in + FStar_SMTEncoding_Term.mkForall uu___10 + uu___11 in + let uu___10 = + let uu___11 = + let uu___12 = + FStar_Ident.string_of_lid t in + Prims.strcat "fuel_guarded_inversion_" + uu___12 in + FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.mk_unique + uu___11 in + (uu___9, + (FStar_Pervasives_Native.Some + "inversion axiom"), uu___10) in + FStar_SMTEncoding_Util.mkAssume uu___8 in + let uu___8 = + FStar_SMTEncoding_Term.mk_decls_trivial + [fuel_guarded_inversion] in + FStar_Compiler_List.op_At decls uu___8))) in + let uu___3 = + let k1 = + match tps with + | [] -> k + | uu___4 -> + let uu___5 = + let uu___6 = + let uu___7 = FStar_Syntax_Syntax.mk_Total k in + { + FStar_Syntax_Syntax.bs1 = tps; + FStar_Syntax_Syntax.comp = uu___7 + } in + FStar_Syntax_Syntax.Tm_arrow uu___6 in + FStar_Syntax_Syntax.mk uu___5 k.FStar_Syntax_Syntax.pos in + let k2 = norm_before_encoding env k1 in + FStar_Syntax_Util.arrow_formals k2 in + (match uu___3 with + | (formals, res) -> + let uu___4 = + FStar_SMTEncoding_EncodeTerm.encode_binders + FStar_Pervasives_Native.None formals env in + (match uu___4 with + | (vars, guards, env', binder_decls, uu___5) -> + let arity = FStar_Compiler_List.length vars in + let uu___6 = + FStar_SMTEncoding_Env.new_term_constant_and_tok_from_lid + env t arity in + (match uu___6 with + | (tname, ttok, env1) -> + let ttok_tm = + FStar_SMTEncoding_Util.mkApp (ttok, []) in + let guard = FStar_SMTEncoding_Util.mk_and_l guards in + let tapp = + let uu___7 = + let uu___8 = + FStar_Compiler_List.map + FStar_SMTEncoding_Util.mkFreeV vars in + (tname, uu___8) in + FStar_SMTEncoding_Util.mkApp uu___7 in + let uu___7 = + let tname_decl = + let uu___8 = + let uu___9 = + FStar_Compiler_List.map + (fun fv -> + let uu___10 = + let uu___11 = + FStar_SMTEncoding_Term.fv_name fv in + Prims.strcat tname uu___11 in + let uu___11 = + FStar_SMTEncoding_Term.fv_sort fv in + { + FStar_SMTEncoding_Term.field_name = + uu___10; + FStar_SMTEncoding_Term.field_sort = + uu___11; + FStar_SMTEncoding_Term.field_projectible + = false + }) vars in + let uu___10 = + let uu___11 = + FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.next_id + () in + FStar_Pervasives_Native.Some uu___11 in + { + FStar_SMTEncoding_Term.constr_name = tname; + FStar_SMTEncoding_Term.constr_fields = + uu___9; + FStar_SMTEncoding_Term.constr_sort = + FStar_SMTEncoding_Term.Term_sort; + FStar_SMTEncoding_Term.constr_id = uu___10; + FStar_SMTEncoding_Term.constr_base = false + } in + constructor_or_logic_type_decl uu___8 in + let uu___8 = + match vars with + | [] -> + let uu___9 = + let uu___10 = + let uu___11 = + FStar_SMTEncoding_Util.mkApp + (tname, []) in + FStar_Pervasives_Native.Some uu___11 in + FStar_SMTEncoding_Env.push_free_var env1 t + arity tname uu___10 in + ([], uu___9) + | uu___9 -> + let ttok_decl = + FStar_SMTEncoding_Term.DeclFun + (ttok, [], + FStar_SMTEncoding_Term.Term_sort, + (FStar_Pervasives_Native.Some "token")) in + let ttok_fresh = + let uu___10 = + FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.next_id + () in + FStar_SMTEncoding_Term.fresh_token + (ttok, FStar_SMTEncoding_Term.Term_sort) + uu___10 in + let ttok_app = + FStar_SMTEncoding_EncodeTerm.mk_Apply + ttok_tm vars in + let pats = [[ttok_app]; [tapp]] in + let name_tok_corr = + let uu___10 = + let uu___11 = + let uu___12 = + FStar_Ident.range_of_lid t in + let uu___13 = + let uu___14 = + FStar_SMTEncoding_Util.mkEq + (ttok_app, tapp) in + (pats, FStar_Pervasives_Native.None, + vars, uu___14) in + FStar_SMTEncoding_Term.mkForall' + uu___12 uu___13 in + (uu___11, + (FStar_Pervasives_Native.Some + "name-token correspondence"), + (Prims.strcat "token_correspondence_" + ttok)) in + FStar_SMTEncoding_Util.mkAssume uu___10 in + ([ttok_decl; ttok_fresh; name_tok_corr], + env1) in + match uu___8 with + | (tok_decls, env2) -> + ((FStar_Compiler_List.op_At tname_decl + tok_decls), env2) in + (match uu___7 with + | (decls, env2) -> + let kindingAx = + let uu___8 = + FStar_SMTEncoding_EncodeTerm.encode_term_pred + FStar_Pervasives_Native.None res env' + tapp in + match uu___8 with + | (k1, decls1) -> + let karr = + if + (FStar_Compiler_List.length formals) + > Prims.int_zero + then + let uu___9 = + let uu___10 = + let uu___11 = + let uu___12 = + FStar_SMTEncoding_Term.mk_PreType + ttok_tm in + FStar_SMTEncoding_Term.mk_tester + "Tm_arrow" uu___12 in + (uu___11, + (FStar_Pervasives_Native.Some + "kinding"), + (Prims.strcat "pre_kinding_" + ttok)) in + FStar_SMTEncoding_Util.mkAssume + uu___10 in + [uu___9] + else [] in + let rng = FStar_Ident.range_of_lid t in + let tot_fun_axioms = + let uu___9 = + FStar_Compiler_List.map + (fun uu___10 -> + FStar_SMTEncoding_Util.mkTrue) + vars in + FStar_SMTEncoding_EncodeTerm.isTotFun_axioms + rng ttok_tm vars uu___9 true in + let uu___9 = + let uu___10 = + let uu___11 = + let uu___12 = + let uu___13 = + let uu___14 = + let uu___15 = + let uu___16 = + let uu___17 = + let uu___18 = + FStar_SMTEncoding_Util.mkImp + (guard, k1) in + ([[tapp]], vars, + uu___18) in + FStar_SMTEncoding_Term.mkForall + rng uu___17 in + (tot_fun_axioms, uu___16) in + FStar_SMTEncoding_Util.mkAnd + uu___15 in + (uu___14, + FStar_Pervasives_Native.None, + (Prims.strcat "kinding_" ttok)) in + FStar_SMTEncoding_Util.mkAssume + uu___13 in + [uu___12] in + FStar_Compiler_List.op_At karr + uu___11 in + FStar_SMTEncoding_Term.mk_decls_trivial + uu___10 in + FStar_Compiler_List.op_At decls1 uu___9 in + let aux = + let uu___8 = + let uu___9 = + inversion_axioms env2 tapp vars in + let uu___10 = + let uu___11 = + let uu___12 = + let uu___13 = + FStar_Ident.range_of_lid t in + pretype_axiom + (Prims.op_Negation + injective_type_params) uu___13 + env2 tapp vars in + [uu___12] in + FStar_SMTEncoding_Term.mk_decls_trivial + uu___11 in + FStar_Compiler_List.op_At uu___9 uu___10 in + FStar_Compiler_List.op_At kindingAx uu___8 in + let uu___8 = + let uu___9 = + FStar_SMTEncoding_Term.mk_decls_trivial + decls in + FStar_Compiler_List.op_At uu___9 + (FStar_Compiler_List.op_At binder_decls aux) in + (uu___8, env2))))) +let (encode_datacon : FStar_SMTEncoding_Env.env_t -> FStar_Syntax_Syntax.sigelt -> (FStar_SMTEncoding_Term.decls_t * FStar_SMTEncoding_Env.env_t)) = fun env -> fun se -> - (let uu___1 = - FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in - if uu___1 - then - let uu___2 = FStar_Syntax_Print.sigelt_to_string se in - FStar_Compiler_Util.print1 "@@@Encoding sigelt %s\n" uu___2 - else ()); - (let is_opaque_to_smt t = - let uu___1 = - let uu___2 = FStar_Syntax_Subst.compress t in - uu___2.FStar_Syntax_Syntax.n in - match uu___1 with - | FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_string - (s, uu___2)) -> s = "opaque_to_smt" - | uu___2 -> false in - let is_uninterpreted_by_smt t = - let uu___1 = - let uu___2 = FStar_Syntax_Subst.compress t in - uu___2.FStar_Syntax_Syntax.n in - match uu___1 with - | FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_string - (s, uu___2)) -> s = "uninterpreted_by_smt" - | uu___2 -> false in - match se.FStar_Syntax_Syntax.sigel with - | FStar_Syntax_Syntax.Sig_splice uu___1 -> - FStar_Compiler_Effect.failwith - "impossible -- splice should have been removed by Tc.fs" - | FStar_Syntax_Syntax.Sig_fail uu___1 -> - FStar_Compiler_Effect.failwith - "impossible -- Sig_fail should have been removed by Tc.fs" - | FStar_Syntax_Syntax.Sig_pragma uu___1 -> ([], env) - | FStar_Syntax_Syntax.Sig_effect_abbrev uu___1 -> ([], env) - | FStar_Syntax_Syntax.Sig_sub_effect uu___1 -> ([], env) - | FStar_Syntax_Syntax.Sig_polymonadic_bind uu___1 -> ([], env) - | FStar_Syntax_Syntax.Sig_polymonadic_subcomp uu___1 -> ([], env) - | FStar_Syntax_Syntax.Sig_new_effect ed -> - let uu___1 = - let uu___2 = - FStar_SMTEncoding_Util.is_smt_reifiable_effect - env.FStar_SMTEncoding_Env.tcenv ed.FStar_Syntax_Syntax.mname in - Prims.op_Negation uu___2 in - if uu___1 - then ([], env) - else - (let close_effect_params tm = - match ed.FStar_Syntax_Syntax.binders with - | [] -> tm - | uu___3 -> - FStar_Syntax_Syntax.mk - (FStar_Syntax_Syntax.Tm_abs - { - FStar_Syntax_Syntax.bs = - (ed.FStar_Syntax_Syntax.binders); - FStar_Syntax_Syntax.body = tm; - FStar_Syntax_Syntax.rc_opt = - (FStar_Pervasives_Native.Some - (FStar_Syntax_Util.mk_residual_comp - FStar_Parser_Const.effect_Tot_lid - FStar_Pervasives_Native.None - [FStar_Syntax_Syntax.TOTAL])) - }) tm.FStar_Syntax_Syntax.pos in - let encode_action env1 a = - let action_defn = - let uu___3 = - close_effect_params a.FStar_Syntax_Syntax.action_defn in - norm_before_encoding env1 uu___3 in - let uu___3 = - FStar_Syntax_Util.arrow_formals_comp - a.FStar_Syntax_Syntax.action_typ in - match uu___3 with - | (formals, uu___4) -> - let arity = FStar_Compiler_List.length formals in + let uu___ = se.FStar_Syntax_Syntax.sigel in + match uu___ with + | FStar_Syntax_Syntax.Sig_datacon + { FStar_Syntax_Syntax.lid1 = d; FStar_Syntax_Syntax.us1 = uu___1; + FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___2; + FStar_Syntax_Syntax.num_ty_params = n_tps; + FStar_Syntax_Syntax.mutuals1 = mutuals; + FStar_Syntax_Syntax.injective_type_params1 = + injective_type_params;_} + -> + let quals = se.FStar_Syntax_Syntax.sigquals in + let t1 = norm_before_encoding env t in + let uu___3 = FStar_Syntax_Util.arrow_formals t1 in + (match uu___3 with + | (formals, t_res) -> + let arity = FStar_Compiler_List.length formals in + let uu___4 = + FStar_SMTEncoding_Env.new_term_constant_and_tok_from_lid env + d arity in + (match uu___4 with + | (ddconstrsym, ddtok, env1) -> + let ddtok_tm = FStar_SMTEncoding_Util.mkApp (ddtok, []) in let uu___5 = - FStar_SMTEncoding_Env.new_term_constant_and_tok_from_lid - env1 a.FStar_Syntax_Syntax.action_name arity in + FStar_SMTEncoding_Env.fresh_fvar + env1.FStar_SMTEncoding_Env.current_module_name "f" + FStar_SMTEncoding_Term.Fuel_sort in (match uu___5 with - | (aname, atok, env2) -> + | (fuel_var, fuel_tm) -> + let s_fuel_tm = + FStar_SMTEncoding_Util.mkApp ("SFuel", [fuel_tm]) in let uu___6 = - FStar_SMTEncoding_EncodeTerm.encode_term - action_defn env2 in + FStar_SMTEncoding_EncodeTerm.encode_binders + (FStar_Pervasives_Native.Some fuel_tm) formals + env1 in (match uu___6 with - | (tm, decls) -> - let a_decls = - let uu___7 = - let uu___8 = - let uu___9 = - FStar_Compiler_List.map - (fun uu___10 -> - FStar_SMTEncoding_Term.Term_sort) - formals in - (aname, uu___9, - FStar_SMTEncoding_Term.Term_sort, - (FStar_Pervasives_Native.Some "Action")) in - FStar_SMTEncoding_Term.DeclFun uu___8 in - [uu___7; - FStar_SMTEncoding_Term.DeclFun - (atok, [], - FStar_SMTEncoding_Term.Term_sort, - (FStar_Pervasives_Native.Some - "Action token"))] in + | (vars, guards, env', binder_decls, names) -> + let injective_type_params1 = + injective_type_params || + (let uu___7 = + FStar_Options.ext_getv + "compat:injectivity" in + uu___7 <> "") in + let fields = + FStar_Compiler_List.mapi + (fun n -> + fun x -> + let field_projectible = + (n >= n_tps) || + injective_type_params1 in + let uu___7 = + FStar_SMTEncoding_Env.mk_term_projector_name + d x in + { + FStar_SMTEncoding_Term.field_name = + uu___7; + FStar_SMTEncoding_Term.field_sort = + FStar_SMTEncoding_Term.Term_sort; + FStar_SMTEncoding_Term.field_projectible + = field_projectible + }) names in + let datacons = + let uu___7 = FStar_Ident.range_of_lid d in + let uu___8 = + let uu___9 = + let uu___10 = + FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.next_id + () in + FStar_Pervasives_Native.Some uu___10 in + { + FStar_SMTEncoding_Term.constr_name = + ddconstrsym; + FStar_SMTEncoding_Term.constr_fields = + fields; + FStar_SMTEncoding_Term.constr_sort = + FStar_SMTEncoding_Term.Term_sort; + FStar_SMTEncoding_Term.constr_id = uu___9; + FStar_SMTEncoding_Term.constr_base = + (Prims.op_Negation + injective_type_params1) + } in + FStar_SMTEncoding_Term.constructor_to_decl + uu___7 uu___8 in + let app = + FStar_SMTEncoding_EncodeTerm.mk_Apply + ddtok_tm vars in + let guard = + FStar_SMTEncoding_Util.mk_and_l guards in + let xvars = + FStar_Compiler_List.map + FStar_SMTEncoding_Util.mkFreeV vars in + let dapp = + FStar_SMTEncoding_Util.mkApp + (ddconstrsym, xvars) in let uu___7 = - let aux uu___8 uu___9 = - match (uu___8, uu___9) with - | ({ FStar_Syntax_Syntax.binder_bv = bv; - FStar_Syntax_Syntax.binder_qual = - uu___10; - FStar_Syntax_Syntax.binder_positivity - = uu___11; - FStar_Syntax_Syntax.binder_attrs = - uu___12;_}, - (env3, acc_sorts, acc)) -> - let uu___13 = - FStar_SMTEncoding_Env.gen_term_var - env3 bv in - (match uu___13 with - | (xxsym, xx, env4) -> - let uu___14 = - let uu___15 = + FStar_SMTEncoding_EncodeTerm.encode_term_pred + FStar_Pervasives_Native.None t1 env1 + ddtok_tm in + (match uu___7 with + | (tok_typing, decls3) -> + let tok_typing1 = + match fields with + | uu___8::uu___9 -> + let ff = + FStar_SMTEncoding_Term.mk_fv + ("ty", + FStar_SMTEncoding_Term.Term_sort) in + let f = + FStar_SMTEncoding_Util.mkFreeV ff in + let vtok_app_l = + FStar_SMTEncoding_EncodeTerm.mk_Apply + ddtok_tm [ff] in + let vtok_app_r = + let uu___10 = + let uu___11 = FStar_SMTEncoding_Term.mk_fv - (xxsym, + (ddtok, FStar_SMTEncoding_Term.Term_sort) in - uu___15 :: acc_sorts in - (env4, uu___14, (xx :: acc))) in - FStar_Compiler_List.fold_right aux formals - (env2, [], []) in - (match uu___7 with - | (uu___8, xs_sorts, xs) -> - let app = - FStar_SMTEncoding_Util.mkApp (aname, xs) in - let a_eq = - let uu___9 = - let uu___10 = + [uu___11] in + FStar_SMTEncoding_EncodeTerm.mk_Apply + f uu___10 in + let uu___10 = + FStar_Ident.range_of_lid d in let uu___11 = - FStar_Ident.range_of_lid - a.FStar_Syntax_Syntax.action_name in - let uu___12 = - let uu___13 = - let uu___14 = - let uu___15 = - FStar_SMTEncoding_EncodeTerm.mk_Apply - tm xs_sorts in - (app, uu___15) in - FStar_SMTEncoding_Util.mkEq - uu___14 in - ([[app]], xs_sorts, uu___13) in + let uu___12 = + FStar_SMTEncoding_Term.mk_NoHoist + f tok_typing in + ([[vtok_app_l]; [vtok_app_r]], + [ff], uu___12) in FStar_SMTEncoding_Term.mkForall - uu___11 uu___12 in - (uu___10, - (FStar_Pervasives_Native.Some - "Action equality"), - (Prims.strcat aname "_equality")) in - FStar_SMTEncoding_Util.mkAssume uu___9 in - let tok_correspondence = - let tok_term = - let uu___9 = - FStar_SMTEncoding_Term.mk_fv - (atok, - FStar_SMTEncoding_Term.Term_sort) in - FStar_SMTEncoding_Util.mkFreeV uu___9 in - let tok_app = - FStar_SMTEncoding_EncodeTerm.mk_Apply - tok_term xs_sorts in + uu___10 uu___11 + | uu___8 -> tok_typing in + let uu___8 = let uu___9 = - let uu___10 = - let uu___11 = - FStar_Ident.range_of_lid - a.FStar_Syntax_Syntax.action_name in - let uu___12 = - let uu___13 = - FStar_SMTEncoding_Util.mkEq - (tok_app, app) in - ([[tok_app]], xs_sorts, uu___13) in - FStar_SMTEncoding_Term.mkForall - uu___11 uu___12 in - (uu___10, - (FStar_Pervasives_Native.Some - "Action token correspondence"), - (Prims.strcat aname - "_token_correspondence")) in - FStar_SMTEncoding_Util.mkAssume uu___9 in - let uu___9 = - let uu___10 = - FStar_SMTEncoding_Term.mk_decls_trivial - (FStar_Compiler_List.op_At a_decls - [a_eq; tok_correspondence]) in - FStar_Compiler_List.op_At decls uu___10 in - (env2, uu___9)))) in - let uu___3 = - FStar_Compiler_Util.fold_map encode_action env - ed.FStar_Syntax_Syntax.actions in - match uu___3 with - | (env1, decls2) -> - ((FStar_Compiler_List.flatten decls2), env1)) - | FStar_Syntax_Syntax.Sig_declare_typ - { FStar_Syntax_Syntax.lid2 = lid; - FStar_Syntax_Syntax.us2 = uu___1; - FStar_Syntax_Syntax.t2 = uu___2;_} - when FStar_Ident.lid_equals lid FStar_Parser_Const.precedes_lid -> - let uu___3 = - FStar_SMTEncoding_Env.new_term_constant_and_tok_from_lid env lid - (Prims.of_int (4)) in - (match uu___3 with | (tname, ttok, env1) -> ([], env1)) - | FStar_Syntax_Syntax.Sig_declare_typ - { FStar_Syntax_Syntax.lid2 = lid; - FStar_Syntax_Syntax.us2 = uu___1; FStar_Syntax_Syntax.t2 = t;_} - -> - let quals = se.FStar_Syntax_Syntax.sigquals in - let will_encode_definition = - let uu___2 = - FStar_Compiler_Util.for_some - (fun uu___3 -> - match uu___3 with - | FStar_Syntax_Syntax.Assumption -> true - | FStar_Syntax_Syntax.Projector uu___4 -> true - | FStar_Syntax_Syntax.Discriminator uu___4 -> true - | FStar_Syntax_Syntax.Irreducible -> true - | uu___4 -> false) quals in - Prims.op_Negation uu___2 in - if will_encode_definition - then ([], env) - else - (let fv = - FStar_Syntax_Syntax.lid_as_fv lid - FStar_Pervasives_Native.None in - let uu___3 = - let uu___4 = - FStar_Compiler_Util.for_some is_uninterpreted_by_smt - se.FStar_Syntax_Syntax.sigattrs in - encode_top_level_val uu___4 env fv t quals in - match uu___3 with - | (decls, env1) -> - let tname = FStar_Ident.string_of_lid lid in - let tsym = - let uu___4 = - FStar_SMTEncoding_Env.try_lookup_free_var env1 lid in - FStar_Compiler_Option.get uu___4 in - let uu___4 = - let uu___5 = - let uu___6 = - primitive_type_axioms - env1.FStar_SMTEncoding_Env.tcenv lid tname tsym in - FStar_SMTEncoding_Term.mk_decls_trivial uu___6 in - FStar_Compiler_List.op_At decls uu___5 in - (uu___4, env1)) - | FStar_Syntax_Syntax.Sig_assume - { FStar_Syntax_Syntax.lid3 = l; FStar_Syntax_Syntax.us3 = us; - FStar_Syntax_Syntax.phi1 = f;_} - -> - let uu___1 = FStar_Syntax_Subst.open_univ_vars us f in - (match uu___1 with - | (uvs, f1) -> - let env1 = - let uu___2 = - FStar_TypeChecker_Env.push_univ_vars - env.FStar_SMTEncoding_Env.tcenv uvs in - { - FStar_SMTEncoding_Env.bvar_bindings = - (env.FStar_SMTEncoding_Env.bvar_bindings); - FStar_SMTEncoding_Env.fvar_bindings = - (env.FStar_SMTEncoding_Env.fvar_bindings); - FStar_SMTEncoding_Env.depth = - (env.FStar_SMTEncoding_Env.depth); - FStar_SMTEncoding_Env.tcenv = uu___2; - FStar_SMTEncoding_Env.warn = - (env.FStar_SMTEncoding_Env.warn); - FStar_SMTEncoding_Env.nolabels = - (env.FStar_SMTEncoding_Env.nolabels); - FStar_SMTEncoding_Env.use_zfuel_name = - (env.FStar_SMTEncoding_Env.use_zfuel_name); - FStar_SMTEncoding_Env.encode_non_total_function_typ = - (env.FStar_SMTEncoding_Env.encode_non_total_function_typ); - FStar_SMTEncoding_Env.current_module_name = - (env.FStar_SMTEncoding_Env.current_module_name); - FStar_SMTEncoding_Env.encoding_quantifier = - (env.FStar_SMTEncoding_Env.encoding_quantifier); - FStar_SMTEncoding_Env.global_cache = - (env.FStar_SMTEncoding_Env.global_cache) - } in - let f2 = norm_before_encoding env1 f1 in - let uu___2 = - FStar_SMTEncoding_EncodeTerm.encode_formula f2 env1 in - (match uu___2 with - | (f3, decls) -> - let g = - let uu___3 = - let uu___4 = - let uu___5 = - let uu___6 = - let uu___7 = - let uu___8 = - FStar_Syntax_Print.lid_to_string l in - FStar_Compiler_Util.format1 "Assumption: %s" - uu___8 in - FStar_Pervasives_Native.Some uu___7 in - let uu___7 = - let uu___8 = - let uu___9 = FStar_Ident.string_of_lid l in - Prims.strcat "assumption_" uu___9 in - FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.mk_unique - uu___8 in - (f3, uu___6, uu___7) in - FStar_SMTEncoding_Util.mkAssume uu___5 in - [uu___4] in - FStar_SMTEncoding_Term.mk_decls_trivial uu___3 in - ((FStar_Compiler_List.op_At decls g), env1))) - | FStar_Syntax_Syntax.Sig_let - { FStar_Syntax_Syntax.lbs1 = lbs; - FStar_Syntax_Syntax.lids1 = uu___1;_} - when - (FStar_Compiler_List.contains FStar_Syntax_Syntax.Irreducible - se.FStar_Syntax_Syntax.sigquals) - || - (FStar_Compiler_Util.for_some is_opaque_to_smt - se.FStar_Syntax_Syntax.sigattrs) - -> - let attrs = se.FStar_Syntax_Syntax.sigattrs in - let uu___2 = - FStar_Compiler_Util.fold_map - (fun env1 -> - fun lb -> - let lid = - let uu___3 = - let uu___4 = - FStar_Compiler_Util.right - lb.FStar_Syntax_Syntax.lbname in - uu___4.FStar_Syntax_Syntax.fv_name in - uu___3.FStar_Syntax_Syntax.v in - let uu___3 = - let uu___4 = - FStar_TypeChecker_Env.try_lookup_val_decl - env1.FStar_SMTEncoding_Env.tcenv lid in - FStar_Compiler_Option.isNone uu___4 in - if uu___3 - then - let val_decl = - { - FStar_Syntax_Syntax.sigel = - (FStar_Syntax_Syntax.Sig_declare_typ - { - FStar_Syntax_Syntax.lid2 = lid; - FStar_Syntax_Syntax.us2 = - (lb.FStar_Syntax_Syntax.lbunivs); - FStar_Syntax_Syntax.t2 = - (lb.FStar_Syntax_Syntax.lbtyp) - }); - FStar_Syntax_Syntax.sigrng = - (se.FStar_Syntax_Syntax.sigrng); - FStar_Syntax_Syntax.sigquals = - (FStar_Syntax_Syntax.Irreducible :: - (se.FStar_Syntax_Syntax.sigquals)); - FStar_Syntax_Syntax.sigmeta = - (se.FStar_Syntax_Syntax.sigmeta); - FStar_Syntax_Syntax.sigattrs = - (se.FStar_Syntax_Syntax.sigattrs); - FStar_Syntax_Syntax.sigopens_and_abbrevs = - (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); - FStar_Syntax_Syntax.sigopts = - (se.FStar_Syntax_Syntax.sigopts) - } in - let uu___4 = encode_sigelt' env1 val_decl in - match uu___4 with | (decls, env2) -> (env2, decls) - else (env1, [])) env (FStar_Pervasives_Native.snd lbs) in - (match uu___2 with - | (env1, decls) -> ((FStar_Compiler_List.flatten decls), env1)) - | FStar_Syntax_Syntax.Sig_let - { - FStar_Syntax_Syntax.lbs1 = - (uu___1, - { FStar_Syntax_Syntax.lbname = FStar_Pervasives.Inr b2t; - FStar_Syntax_Syntax.lbunivs = uu___2; - FStar_Syntax_Syntax.lbtyp = uu___3; - FStar_Syntax_Syntax.lbeff = uu___4; - FStar_Syntax_Syntax.lbdef = uu___5; - FStar_Syntax_Syntax.lbattrs = uu___6; - FStar_Syntax_Syntax.lbpos = uu___7;_}::[]); - FStar_Syntax_Syntax.lids1 = uu___8;_} - when FStar_Syntax_Syntax.fv_eq_lid b2t FStar_Parser_Const.b2t_lid - -> - let uu___9 = - FStar_SMTEncoding_Env.new_term_constant_and_tok_from_lid env - (b2t.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v - Prims.int_one in - (match uu___9 with - | (tname, ttok, env1) -> - let xx = - FStar_SMTEncoding_Term.mk_fv - ("x", FStar_SMTEncoding_Term.Term_sort) in - let x = FStar_SMTEncoding_Util.mkFreeV xx in - let b2t_x = FStar_SMTEncoding_Util.mkApp ("Prims.b2t", [x]) in - let valid_b2t_x = - FStar_SMTEncoding_Util.mkApp ("Valid", [b2t_x]) in - let bool_ty = - let uu___10 = - FStar_Syntax_Syntax.withsort FStar_Parser_Const.bool_lid in - FStar_SMTEncoding_Env.lookup_free_var env1 uu___10 in - let decls = - let uu___10 = - let uu___11 = - let uu___12 = - let uu___13 = - let uu___14 = FStar_Syntax_Syntax.range_of_fv b2t in - let uu___15 = - let uu___16 = - let uu___17 = - let uu___18 = - FStar_SMTEncoding_Util.mkApp - ((FStar_Pervasives_Native.snd - FStar_SMTEncoding_Term.boxBoolFun), - [x]) in - (valid_b2t_x, uu___18) in - FStar_SMTEncoding_Util.mkEq uu___17 in - ([[b2t_x]], [xx], uu___16) in - FStar_SMTEncoding_Term.mkForall uu___14 uu___15 in - (uu___13, (FStar_Pervasives_Native.Some "b2t def"), - "b2t_def") in - FStar_SMTEncoding_Util.mkAssume uu___12 in - let uu___12 = - let uu___13 = - let uu___14 = - let uu___15 = - let uu___16 = FStar_Syntax_Syntax.range_of_fv b2t in - let uu___17 = - let uu___18 = - let uu___19 = - let uu___20 = - FStar_SMTEncoding_Term.mk_HasType x - bool_ty in - let uu___21 = - FStar_SMTEncoding_Term.mk_HasType b2t_x - FStar_SMTEncoding_Term.mk_Term_type in - (uu___20, uu___21) in - FStar_SMTEncoding_Util.mkImp uu___19 in - ([[b2t_x]], [xx], uu___18) in - FStar_SMTEncoding_Term.mkForall uu___16 uu___17 in - (uu___15, - (FStar_Pervasives_Native.Some "b2t typing"), - "b2t_typing") in - FStar_SMTEncoding_Util.mkAssume uu___14 in - [uu___13] in - uu___11 :: uu___12 in - (FStar_SMTEncoding_Term.DeclFun - (tname, [FStar_SMTEncoding_Term.Term_sort], - FStar_SMTEncoding_Term.Term_sort, - FStar_Pervasives_Native.None)) - :: uu___10 in - let uu___10 = FStar_SMTEncoding_Term.mk_decls_trivial decls in - (uu___10, env1)) - | FStar_Syntax_Syntax.Sig_let uu___1 when - FStar_Compiler_Util.for_some - (fun uu___2 -> - match uu___2 with - | FStar_Syntax_Syntax.Discriminator uu___3 -> true - | uu___3 -> false) se.FStar_Syntax_Syntax.sigquals - -> - ((let uu___3 = - FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in - if uu___3 - then - let uu___4 = FStar_Syntax_Print.sigelt_to_string_short se in - FStar_Compiler_Util.print1 "Not encoding discriminator '%s'\n" - uu___4 - else ()); - ([], env)) - | FStar_Syntax_Syntax.Sig_let - { FStar_Syntax_Syntax.lbs1 = uu___1; - FStar_Syntax_Syntax.lids1 = lids;_} - when - (FStar_Compiler_Util.for_some - (fun l -> - let uu___2 = - let uu___3 = - let uu___4 = FStar_Ident.ns_of_lid l in - FStar_Compiler_List.hd uu___4 in - FStar_Ident.string_of_id uu___3 in - uu___2 = "Prims") lids) - && - (FStar_Compiler_Util.for_some - (fun uu___2 -> - match uu___2 with - | FStar_Syntax_Syntax.Unfold_for_unification_and_vcgen -> - true - | uu___3 -> false) se.FStar_Syntax_Syntax.sigquals) - -> - ((let uu___3 = - FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in - if uu___3 - then - let uu___4 = FStar_Syntax_Print.sigelt_to_string_short se in - FStar_Compiler_Util.print1 - "Not encoding unfold let from Prims '%s'\n" uu___4 - else ()); - ([], env)) - | FStar_Syntax_Syntax.Sig_let - { FStar_Syntax_Syntax.lbs1 = (false, lb::[]); - FStar_Syntax_Syntax.lids1 = uu___1;_} - when - FStar_Compiler_Util.for_some - (fun uu___2 -> - match uu___2 with - | FStar_Syntax_Syntax.Projector uu___3 -> true - | uu___3 -> false) se.FStar_Syntax_Syntax.sigquals - -> - let fv = FStar_Compiler_Util.right lb.FStar_Syntax_Syntax.lbname in - let l = (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - let uu___2 = FStar_SMTEncoding_Env.try_lookup_free_var env l in - (match uu___2 with - | FStar_Pervasives_Native.Some uu___3 -> ([], env) - | FStar_Pervasives_Native.None -> - let se1 = - let uu___3 = FStar_Ident.range_of_lid l in - { - FStar_Syntax_Syntax.sigel = - (FStar_Syntax_Syntax.Sig_declare_typ - { - FStar_Syntax_Syntax.lid2 = l; - FStar_Syntax_Syntax.us2 = - (lb.FStar_Syntax_Syntax.lbunivs); - FStar_Syntax_Syntax.t2 = - (lb.FStar_Syntax_Syntax.lbtyp) - }); - FStar_Syntax_Syntax.sigrng = uu___3; - FStar_Syntax_Syntax.sigquals = - (se.FStar_Syntax_Syntax.sigquals); - FStar_Syntax_Syntax.sigmeta = - (se.FStar_Syntax_Syntax.sigmeta); - FStar_Syntax_Syntax.sigattrs = - (se.FStar_Syntax_Syntax.sigattrs); - FStar_Syntax_Syntax.sigopens_and_abbrevs = - (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); - FStar_Syntax_Syntax.sigopts = - (se.FStar_Syntax_Syntax.sigopts) - } in - encode_sigelt env se1) - | FStar_Syntax_Syntax.Sig_let - { FStar_Syntax_Syntax.lbs1 = (is_rec, bindings); - FStar_Syntax_Syntax.lids1 = uu___1;_} - -> - let bindings1 = - FStar_Compiler_List.map - (fun lb -> - let def = - norm_before_encoding env lb.FStar_Syntax_Syntax.lbdef in - let typ = - norm_before_encoding env lb.FStar_Syntax_Syntax.lbtyp in - { - FStar_Syntax_Syntax.lbname = - (lb.FStar_Syntax_Syntax.lbname); - FStar_Syntax_Syntax.lbunivs = - (lb.FStar_Syntax_Syntax.lbunivs); - FStar_Syntax_Syntax.lbtyp = typ; - FStar_Syntax_Syntax.lbeff = - (lb.FStar_Syntax_Syntax.lbeff); - FStar_Syntax_Syntax.lbdef = def; - FStar_Syntax_Syntax.lbattrs = - (lb.FStar_Syntax_Syntax.lbattrs); - FStar_Syntax_Syntax.lbpos = - (lb.FStar_Syntax_Syntax.lbpos) - }) bindings in - encode_top_level_let env (is_rec, bindings1) - se.FStar_Syntax_Syntax.sigquals - | FStar_Syntax_Syntax.Sig_bundle - { FStar_Syntax_Syntax.ses = ses; - FStar_Syntax_Syntax.lids = uu___1;_} - -> - let uu___2 = encode_sigelts env ses in - (match uu___2 with - | (g, env1) -> - let uu___3 = - FStar_Compiler_List.fold_left - (fun uu___4 -> - fun elt -> - match uu___4 with - | (g', inversions) -> - let uu___5 = - FStar_Compiler_List.partition - (fun uu___6 -> - match uu___6 with - | FStar_SMTEncoding_Term.Assume - { - FStar_SMTEncoding_Term.assumption_term - = uu___7; - FStar_SMTEncoding_Term.assumption_caption - = FStar_Pervasives_Native.Some - "inversion axiom"; - FStar_SMTEncoding_Term.assumption_name - = uu___8; - FStar_SMTEncoding_Term.assumption_fact_ids - = uu___9;_} - -> false - | uu___7 -> true) - elt.FStar_SMTEncoding_Term.decls in - (match uu___5 with - | (elt_g', elt_inversions) -> - ((FStar_Compiler_List.op_At g' - [{ - FStar_SMTEncoding_Term.sym_name = - (elt.FStar_SMTEncoding_Term.sym_name); - FStar_SMTEncoding_Term.key = - (elt.FStar_SMTEncoding_Term.key); - FStar_SMTEncoding_Term.decls = - elt_g'; - FStar_SMTEncoding_Term.a_names = - (elt.FStar_SMTEncoding_Term.a_names) - }]), - (FStar_Compiler_List.op_At inversions - elt_inversions)))) ([], []) g in - (match uu___3 with - | (g', inversions) -> - let uu___4 = - FStar_Compiler_List.fold_left - (fun uu___5 -> - fun elt -> - match uu___5 with - | (decls, elts, rest) -> - let uu___6 = - (FStar_Compiler_Util.is_some - elt.FStar_SMTEncoding_Term.key) - && - (FStar_Compiler_List.existsb - (fun uu___7 -> - match uu___7 with - | FStar_SMTEncoding_Term.DeclFun - uu___8 -> true - | uu___8 -> false) - elt.FStar_SMTEncoding_Term.decls) in - if uu___6 - then - (decls, - (FStar_Compiler_List.op_At elts [elt]), - rest) - else - (let uu___8 = - FStar_Compiler_List.partition - (fun uu___9 -> - match uu___9 with - | FStar_SMTEncoding_Term.DeclFun - uu___10 -> true - | uu___10 -> false) - elt.FStar_SMTEncoding_Term.decls in - match uu___8 with - | (elt_decls, elt_rest) -> - ((FStar_Compiler_List.op_At decls - elt_decls), elts, - (FStar_Compiler_List.op_At rest - [{ - FStar_SMTEncoding_Term.sym_name - = - (elt.FStar_SMTEncoding_Term.sym_name); - FStar_SMTEncoding_Term.key = - (elt.FStar_SMTEncoding_Term.key); - FStar_SMTEncoding_Term.decls - = elt_rest; - FStar_SMTEncoding_Term.a_names - = - (elt.FStar_SMTEncoding_Term.a_names) - }])))) ([], [], []) g' in - (match uu___4 with - | (decls, elts, rest) -> - let uu___5 = - let uu___6 = - FStar_SMTEncoding_Term.mk_decls_trivial decls in - let uu___7 = - let uu___8 = - let uu___9 = - FStar_SMTEncoding_Term.mk_decls_trivial - inversions in - FStar_Compiler_List.op_At rest uu___9 in - FStar_Compiler_List.op_At elts uu___8 in - FStar_Compiler_List.op_At uu___6 uu___7 in - (uu___5, env1)))) - | FStar_Syntax_Syntax.Sig_inductive_typ - { FStar_Syntax_Syntax.lid = t; - FStar_Syntax_Syntax.us = universe_names; - FStar_Syntax_Syntax.params = tps; - FStar_Syntax_Syntax.num_uniform_params = uu___1; - FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = uu___2; - FStar_Syntax_Syntax.ds = datas;_} - -> - let tcenv = env.FStar_SMTEncoding_Env.tcenv in - let is_injective = - let uu___3 = FStar_Syntax_Subst.univ_var_opening universe_names in - match uu___3 with - | (usubst, uvs) -> - let uu___4 = - let uu___5 = - FStar_TypeChecker_Env.push_univ_vars tcenv uvs in - let uu___6 = FStar_Syntax_Subst.subst_binders usubst tps in - let uu___7 = - let uu___8 = - FStar_Syntax_Subst.shift_subst - (FStar_Compiler_List.length tps) usubst in - FStar_Syntax_Subst.subst uu___8 k in - (uu___5, uu___6, uu___7) in - (match uu___4 with - | (env1, tps1, k1) -> - let uu___5 = FStar_Syntax_Subst.open_term tps1 k1 in - (match uu___5 with - | (tps2, k2) -> - let uu___6 = FStar_Syntax_Util.arrow_formals k2 in - (match uu___6 with - | (uu___7, k3) -> - let uu___8 = - FStar_TypeChecker_TcTerm.tc_binders env1 - tps2 in - (match uu___8 with - | (tps3, env_tps, uu___9, us) -> - let u_k = - let uu___10 = - let uu___11 = - FStar_Syntax_Syntax.fvar t - FStar_Pervasives_Native.None in - let uu___12 = - let uu___13 = - FStar_Syntax_Util.args_of_binders - tps3 in - FStar_Pervasives_Native.snd - uu___13 in - let uu___13 = - FStar_Ident.range_of_lid t in - FStar_Syntax_Syntax.mk_Tm_app - uu___11 uu___12 uu___13 in - FStar_TypeChecker_TcTerm.level_of_type - env_tps uu___10 k3 in - let rec universe_leq u v = - match (u, v) with - | (FStar_Syntax_Syntax.U_zero, - uu___10) -> true - | (FStar_Syntax_Syntax.U_succ u0, - FStar_Syntax_Syntax.U_succ v0) -> - universe_leq u0 v0 - | (FStar_Syntax_Syntax.U_name u0, - FStar_Syntax_Syntax.U_name v0) -> - FStar_Ident.ident_equals u0 v0 - | (FStar_Syntax_Syntax.U_name uu___10, - FStar_Syntax_Syntax.U_succ v0) -> - universe_leq u v0 - | (FStar_Syntax_Syntax.U_max us1, - uu___10) -> - FStar_Compiler_Util.for_all - (fun u1 -> universe_leq u1 v) - us1 - | (uu___10, FStar_Syntax_Syntax.U_max - vs) -> - FStar_Compiler_Util.for_some - (universe_leq u) vs - | (FStar_Syntax_Syntax.U_unknown, - uu___10) -> - let uu___11 = - let uu___12 = - FStar_Ident.string_of_lid t in - let uu___13 = - FStar_Syntax_Print.univ_to_string - u in - let uu___14 = - FStar_Syntax_Print.univ_to_string - v in - FStar_Compiler_Util.format3 - "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" - uu___12 uu___13 uu___14 in - FStar_Compiler_Effect.failwith - uu___11 - | (uu___10, - FStar_Syntax_Syntax.U_unknown) -> - let uu___11 = - let uu___12 = - FStar_Ident.string_of_lid t in - let uu___13 = - FStar_Syntax_Print.univ_to_string - u in - let uu___14 = - FStar_Syntax_Print.univ_to_string - v in - FStar_Compiler_Util.format3 - "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" - uu___12 uu___13 uu___14 in - FStar_Compiler_Effect.failwith - uu___11 - | (FStar_Syntax_Syntax.U_unif uu___10, - uu___11) -> - let uu___12 = - let uu___13 = - FStar_Ident.string_of_lid t in - let uu___14 = - FStar_Syntax_Print.univ_to_string - u in - let uu___15 = - FStar_Syntax_Print.univ_to_string - v in - FStar_Compiler_Util.format3 - "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" - uu___13 uu___14 uu___15 in - FStar_Compiler_Effect.failwith - uu___12 - | (uu___10, FStar_Syntax_Syntax.U_unif - uu___11) -> - let uu___12 = - let uu___13 = - FStar_Ident.string_of_lid t in - let uu___14 = - FStar_Syntax_Print.univ_to_string - u in - let uu___15 = - FStar_Syntax_Print.univ_to_string - v in - FStar_Compiler_Util.format3 - "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" - uu___13 uu___14 uu___15 in - FStar_Compiler_Effect.failwith - uu___12 - | uu___10 -> false in - let u_leq_u_k u = - let uu___10 = - FStar_TypeChecker_Normalize.normalize_universe - env_tps u in - universe_leq uu___10 u_k in - let tp_ok tp u_tp = - let t_tp = - (tp.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in - let uu___10 = u_leq_u_k u_tp in - if uu___10 - then true - else - (let uu___12 = - FStar_Syntax_Util.arrow_formals - t_tp in - match uu___12 with - | (formals, uu___13) -> - let uu___14 = - FStar_TypeChecker_TcTerm.tc_binders - env_tps formals in - (match uu___14 with - | (uu___15, uu___16, uu___17, - u_formals) -> - FStar_Compiler_Util.for_all - (fun u_formal -> - u_leq_u_k u_formal) - u_formals)) in - FStar_Compiler_List.forall2 tp_ok tps3 - us)))) in - ((let uu___4 = - FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in - if uu___4 - then - let uu___5 = FStar_Ident.string_of_lid t in - FStar_Compiler_Util.print2 "%s injectivity for %s\n" - (if is_injective then "YES" else "NO") uu___5 - else ()); - (let quals = se.FStar_Syntax_Syntax.sigquals in - let is_logical = - FStar_Compiler_Util.for_some - (fun uu___4 -> - match uu___4 with - | FStar_Syntax_Syntax.Logic -> true - | FStar_Syntax_Syntax.Assumption -> true - | uu___5 -> false) quals in - let constructor_or_logic_type_decl c = - if is_logical - then - let uu___4 = - let uu___5 = - let uu___6 = - FStar_Compiler_List.map - (fun f -> f.FStar_SMTEncoding_Term.field_sort) - c.FStar_SMTEncoding_Term.constr_fields in - ((c.FStar_SMTEncoding_Term.constr_name), uu___6, - FStar_SMTEncoding_Term.Term_sort, - FStar_Pervasives_Native.None) in - FStar_SMTEncoding_Term.DeclFun uu___5 in - [uu___4] - else - (let uu___5 = FStar_Ident.range_of_lid t in - FStar_SMTEncoding_Term.constructor_to_decl uu___5 c) in - let inversion_axioms env1 tapp vars = - let uu___4 = - FStar_Compiler_Util.for_some - (fun l -> - let uu___5 = - FStar_TypeChecker_Env.try_lookup_lid - env1.FStar_SMTEncoding_Env.tcenv l in - FStar_Compiler_Option.isNone uu___5) datas in - if uu___4 - then [] - else - (let uu___6 = - FStar_SMTEncoding_Env.fresh_fvar - env1.FStar_SMTEncoding_Env.current_module_name "x" - FStar_SMTEncoding_Term.Term_sort in - match uu___6 with - | (xxsym, xx) -> - let uu___7 = - FStar_Compiler_List.fold_left - (fun uu___8 -> - fun l -> - match uu___8 with - | (out, decls) -> - let uu___9 = - FStar_TypeChecker_Env.lookup_datacon - env1.FStar_SMTEncoding_Env.tcenv l in - (match uu___9 with - | (uu___10, data_t) -> - let uu___11 = - FStar_Syntax_Util.arrow_formals - data_t in - (match uu___11 with - | (args, res) -> - let indices = - let uu___12 = - FStar_Syntax_Util.head_and_args_full - res in - FStar_Pervasives_Native.snd - uu___12 in - let env2 = - FStar_Compiler_List.fold_left - (fun env3 -> - fun uu___12 -> - match uu___12 with - | { - FStar_Syntax_Syntax.binder_bv - = x; - FStar_Syntax_Syntax.binder_qual - = uu___13; - FStar_Syntax_Syntax.binder_positivity - = uu___14; - FStar_Syntax_Syntax.binder_attrs - = uu___15;_} - -> - let uu___16 = - let uu___17 = - let uu___18 = - FStar_SMTEncoding_Env.mk_term_projector_name - l x in - (uu___18, [xx]) in - FStar_SMTEncoding_Util.mkApp - uu___17 in - FStar_SMTEncoding_Env.push_term_var - env3 x uu___16) - env1 args in - let uu___12 = - FStar_SMTEncoding_EncodeTerm.encode_args - indices env2 in - (match uu___12 with - | (indices1, decls') -> - (if - (FStar_Compiler_List.length - indices1) - <> - (FStar_Compiler_List.length - vars) - then - FStar_Compiler_Effect.failwith - "Impossible" - else (); - (let eqs = - if is_injective - then - FStar_Compiler_List.map2 - (fun v -> - fun a -> - let uu___14 = - let uu___15 - = - FStar_SMTEncoding_Util.mkFreeV - v in - (uu___15, a) in - FStar_SMTEncoding_Util.mkEq - uu___14) - vars indices1 - else [] in - let uu___14 = - let uu___15 = - let uu___16 = - let uu___17 = - let uu___18 = - FStar_SMTEncoding_Env.mk_data_tester - env2 l xx in - let uu___19 = - FStar_SMTEncoding_Util.mk_and_l - eqs in - (uu___18, - uu___19) in - FStar_SMTEncoding_Util.mkAnd - uu___17 in - (out, uu___16) in - FStar_SMTEncoding_Util.mkOr - uu___15 in - (uu___14, - (FStar_Compiler_List.op_At - decls decls')))))))) - (FStar_SMTEncoding_Util.mkFalse, []) datas in - (match uu___7 with - | (data_ax, decls) -> - let uu___8 = - FStar_SMTEncoding_Env.fresh_fvar - env1.FStar_SMTEncoding_Env.current_module_name - "f" FStar_SMTEncoding_Term.Fuel_sort in - (match uu___8 with - | (ffsym, ff) -> - let fuel_guarded_inversion = - let xx_has_type_sfuel = - if - (FStar_Compiler_List.length datas) > - Prims.int_one - then - let uu___9 = - FStar_SMTEncoding_Util.mkApp - ("SFuel", [ff]) in - FStar_SMTEncoding_Term.mk_HasTypeFuel - uu___9 xx tapp - else - FStar_SMTEncoding_Term.mk_HasTypeFuel - ff xx tapp in - let uu___9 = - let uu___10 = - let uu___11 = - FStar_Ident.range_of_lid t in - let uu___12 = - let uu___13 = - let uu___14 = - FStar_SMTEncoding_Term.mk_fv - (ffsym, - FStar_SMTEncoding_Term.Fuel_sort) in - let uu___15 = - let uu___16 = - FStar_SMTEncoding_Term.mk_fv - (xxsym, - FStar_SMTEncoding_Term.Term_sort) in - uu___16 :: vars in - FStar_SMTEncoding_Env.add_fuel - uu___14 uu___15 in - let uu___14 = - FStar_SMTEncoding_Util.mkImp - (xx_has_type_sfuel, data_ax) in - ([[xx_has_type_sfuel]], uu___13, - uu___14) in - FStar_SMTEncoding_Term.mkForall uu___11 - uu___12 in - let uu___11 = - let uu___12 = - let uu___13 = - FStar_Ident.string_of_lid t in - Prims.strcat - "fuel_guarded_inversion_" uu___13 in - FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.mk_unique - uu___12 in - (uu___10, - (FStar_Pervasives_Native.Some - "inversion axiom"), uu___11) in - FStar_SMTEncoding_Util.mkAssume uu___9 in - let uu___9 = - FStar_SMTEncoding_Term.mk_decls_trivial - [fuel_guarded_inversion] in - FStar_Compiler_List.op_At decls uu___9))) in - let uu___4 = - let k1 = - match tps with - | [] -> k - | uu___5 -> - let uu___6 = - let uu___7 = - let uu___8 = FStar_Syntax_Syntax.mk_Total k in - { - FStar_Syntax_Syntax.bs1 = tps; - FStar_Syntax_Syntax.comp = uu___8 - } in - FStar_Syntax_Syntax.Tm_arrow uu___7 in - FStar_Syntax_Syntax.mk uu___6 k.FStar_Syntax_Syntax.pos in - let k2 = norm_before_encoding env k1 in - FStar_Syntax_Util.arrow_formals k2 in - match uu___4 with - | (formals, res) -> - let uu___5 = - FStar_SMTEncoding_EncodeTerm.encode_binders - FStar_Pervasives_Native.None formals env in - (match uu___5 with - | (vars, guards, env', binder_decls, uu___6) -> - let arity = FStar_Compiler_List.length vars in - let uu___7 = - FStar_SMTEncoding_Env.new_term_constant_and_tok_from_lid - env t arity in - (match uu___7 with - | (tname, ttok, env1) -> - let ttok_tm = - FStar_SMTEncoding_Util.mkApp (ttok, []) in - let guard = FStar_SMTEncoding_Util.mk_and_l guards in - let tapp = - let uu___8 = - let uu___9 = - FStar_Compiler_List.map - FStar_SMTEncoding_Util.mkFreeV vars in - (tname, uu___9) in - FStar_SMTEncoding_Util.mkApp uu___8 in - let uu___8 = - let tname_decl = - let uu___9 = - let uu___10 = - FStar_Compiler_List.map - (fun fv -> - let uu___11 = - let uu___12 = - FStar_SMTEncoding_Term.fv_name fv in - Prims.strcat tname uu___12 in - let uu___12 = - FStar_SMTEncoding_Term.fv_sort fv in - { - FStar_SMTEncoding_Term.field_name = - uu___11; - FStar_SMTEncoding_Term.field_sort = - uu___12; - FStar_SMTEncoding_Term.field_projectible - = false - }) vars in - let uu___11 = - let uu___12 = - FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.next_id - () in - FStar_Pervasives_Native.Some uu___12 in - { - FStar_SMTEncoding_Term.constr_name = tname; - FStar_SMTEncoding_Term.constr_fields = - uu___10; - FStar_SMTEncoding_Term.constr_sort = - FStar_SMTEncoding_Term.Term_sort; - FStar_SMTEncoding_Term.constr_id = uu___11 - } in - constructor_or_logic_type_decl uu___9 in - let uu___9 = - match vars with - | [] -> - let uu___10 = - let uu___11 = - let uu___12 = - FStar_SMTEncoding_Util.mkApp - (tname, []) in - FStar_Pervasives_Native.Some uu___12 in - FStar_SMTEncoding_Env.push_free_var env1 - t arity tname uu___11 in - ([], uu___10) - | uu___10 -> - let ttok_decl = - FStar_SMTEncoding_Term.DeclFun - (ttok, [], - FStar_SMTEncoding_Term.Term_sort, - (FStar_Pervasives_Native.Some - "token")) in - let ttok_fresh = - let uu___11 = - FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.next_id - () in - FStar_SMTEncoding_Term.fresh_token - (ttok, - FStar_SMTEncoding_Term.Term_sort) - uu___11 in - let ttok_app = - FStar_SMTEncoding_EncodeTerm.mk_Apply - ttok_tm vars in - let pats = [[ttok_app]; [tapp]] in - let name_tok_corr = - let uu___11 = - let uu___12 = - let uu___13 = - FStar_Ident.range_of_lid t in - let uu___14 = - let uu___15 = - FStar_SMTEncoding_Util.mkEq - (ttok_app, tapp) in - (pats, - FStar_Pervasives_Native.None, - vars, uu___15) in - FStar_SMTEncoding_Term.mkForall' - uu___13 uu___14 in - (uu___12, - (FStar_Pervasives_Native.Some - "name-token correspondence"), - (Prims.strcat - "token_correspondence_" ttok)) in - FStar_SMTEncoding_Util.mkAssume uu___11 in - ([ttok_decl; ttok_fresh; name_tok_corr], - env1) in - match uu___9 with - | (tok_decls, env2) -> - ((FStar_Compiler_List.op_At tname_decl - tok_decls), env2) in - (match uu___8 with - | (decls, env2) -> - let kindingAx = - let uu___9 = - FStar_SMTEncoding_EncodeTerm.encode_term_pred - FStar_Pervasives_Native.None res env' - tapp in - match uu___9 with - | (k1, decls1) -> - let karr = - if - (FStar_Compiler_List.length formals) - > Prims.int_zero - then - let uu___10 = - let uu___11 = - let uu___12 = - let uu___13 = - FStar_SMTEncoding_Term.mk_PreType - ttok_tm in - FStar_SMTEncoding_Term.mk_tester - "Tm_arrow" uu___13 in - (uu___12, - (FStar_Pervasives_Native.Some - "kinding"), - (Prims.strcat "pre_kinding_" - ttok)) in - FStar_SMTEncoding_Util.mkAssume - uu___11 in - [uu___10] - else [] in - let rng = FStar_Ident.range_of_lid t in - let tot_fun_axioms = - let uu___10 = - FStar_Compiler_List.map - (fun uu___11 -> - FStar_SMTEncoding_Util.mkTrue) - vars in - FStar_SMTEncoding_EncodeTerm.isTotFun_axioms - rng ttok_tm vars uu___10 true in - let uu___10 = - let uu___11 = - let uu___12 = - let uu___13 = - let uu___14 = - let uu___15 = - let uu___16 = - let uu___17 = - let uu___18 = - let uu___19 = - FStar_SMTEncoding_Util.mkImp - (guard, k1) in - ([[tapp]], vars, - uu___19) in - FStar_SMTEncoding_Term.mkForall - rng uu___18 in - (tot_fun_axioms, uu___17) in - FStar_SMTEncoding_Util.mkAnd - uu___16 in - (uu___15, - FStar_Pervasives_Native.None, - (Prims.strcat "kinding_" - ttok)) in - FStar_SMTEncoding_Util.mkAssume - uu___14 in - [uu___13] in - FStar_Compiler_List.op_At karr - uu___12 in - FStar_SMTEncoding_Term.mk_decls_trivial - uu___11 in - FStar_Compiler_List.op_At decls1 - uu___10 in - let aux = - let uu___9 = - let uu___10 = - inversion_axioms env2 tapp vars in - let uu___11 = - let uu___12 = - let uu___13 = - let uu___14 = - FStar_Ident.range_of_lid t in - pretype_axiom uu___14 env2 tapp - vars in - [uu___13] in - FStar_SMTEncoding_Term.mk_decls_trivial - uu___12 in - FStar_Compiler_List.op_At uu___10 uu___11 in - FStar_Compiler_List.op_At kindingAx uu___9 in - let g = - let uu___9 = - FStar_SMTEncoding_Term.mk_decls_trivial - decls in - FStar_Compiler_List.op_At uu___9 - (FStar_Compiler_List.op_At binder_decls - aux) in - (g, env2)))))) - | FStar_Syntax_Syntax.Sig_datacon - { FStar_Syntax_Syntax.lid1 = d; FStar_Syntax_Syntax.us1 = uu___1; - FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___2; - FStar_Syntax_Syntax.num_ty_params = n_tps; - FStar_Syntax_Syntax.mutuals1 = mutuals;_} - -> - let quals = se.FStar_Syntax_Syntax.sigquals in - let t1 = norm_before_encoding env t in - let uu___3 = FStar_Syntax_Util.arrow_formals t1 in - (match uu___3 with - | (formals, t_res) -> - let arity = FStar_Compiler_List.length formals in - let uu___4 = - FStar_SMTEncoding_Env.new_term_constant_and_tok_from_lid - env d arity in - (match uu___4 with - | (ddconstrsym, ddtok, env1) -> - let ddtok_tm = FStar_SMTEncoding_Util.mkApp (ddtok, []) in - let uu___5 = - FStar_SMTEncoding_Env.fresh_fvar - env1.FStar_SMTEncoding_Env.current_module_name "f" - FStar_SMTEncoding_Term.Fuel_sort in - (match uu___5 with - | (fuel_var, fuel_tm) -> - let s_fuel_tm = - FStar_SMTEncoding_Util.mkApp ("SFuel", [fuel_tm]) in - let uu___6 = - FStar_SMTEncoding_EncodeTerm.encode_binders - (FStar_Pervasives_Native.Some fuel_tm) formals - env1 in - (match uu___6 with - | (vars, guards, env', binder_decls, names) -> - let fields = - FStar_Compiler_List.mapi - (fun n -> - fun x -> - let uu___7 = - FStar_SMTEncoding_Env.mk_term_projector_name - d x in - { - FStar_SMTEncoding_Term.field_name = - uu___7; - FStar_SMTEncoding_Term.field_sort = - FStar_SMTEncoding_Term.Term_sort; - FStar_SMTEncoding_Term.field_projectible - = true - }) names in - let datacons = - let uu___7 = FStar_Ident.range_of_lid d in - let uu___8 = - let uu___9 = - let uu___10 = - FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.next_id - () in - FStar_Pervasives_Native.Some uu___10 in - { - FStar_SMTEncoding_Term.constr_name = - ddconstrsym; - FStar_SMTEncoding_Term.constr_fields = - fields; - FStar_SMTEncoding_Term.constr_sort = - FStar_SMTEncoding_Term.Term_sort; - FStar_SMTEncoding_Term.constr_id = - uu___9 - } in - FStar_SMTEncoding_Term.constructor_to_decl - uu___7 uu___8 in - let app = - FStar_SMTEncoding_EncodeTerm.mk_Apply - ddtok_tm vars in - let guard = - FStar_SMTEncoding_Util.mk_and_l guards in - let xvars = - FStar_Compiler_List.map - FStar_SMTEncoding_Util.mkFreeV vars in - let dapp = - FStar_SMTEncoding_Util.mkApp - (ddconstrsym, xvars) in - let uu___7 = - FStar_SMTEncoding_EncodeTerm.encode_term_pred - FStar_Pervasives_Native.None t1 env1 - ddtok_tm in - (match uu___7 with - | (tok_typing, decls3) -> - let tok_typing1 = - match fields with - | uu___8::uu___9 -> - let ff = - FStar_SMTEncoding_Term.mk_fv - ("ty", - FStar_SMTEncoding_Term.Term_sort) in - let f = - FStar_SMTEncoding_Util.mkFreeV ff in - let vtok_app_l = - FStar_SMTEncoding_EncodeTerm.mk_Apply - ddtok_tm [ff] in - let vtok_app_r = - let uu___10 = - let uu___11 = - FStar_SMTEncoding_Term.mk_fv - (ddtok, - FStar_SMTEncoding_Term.Term_sort) in - [uu___11] in - FStar_SMTEncoding_EncodeTerm.mk_Apply - f uu___10 in - let uu___10 = - FStar_Ident.range_of_lid d in - let uu___11 = - let uu___12 = - FStar_SMTEncoding_Term.mk_NoHoist - f tok_typing in - ([[vtok_app_l]; [vtok_app_r]], - [ff], uu___12) in - FStar_SMTEncoding_Term.mkForall - uu___10 uu___11 - | uu___8 -> tok_typing in - let uu___8 = - let uu___9 = - FStar_SMTEncoding_EncodeTerm.encode_term - t_res env' in - match uu___9 with - | (t_res_tm, t_res_decls) -> - let uu___10 = - FStar_SMTEncoding_Term.mk_HasTypeWithFuel - (FStar_Pervasives_Native.Some - fuel_tm) dapp t_res_tm in - (uu___10, t_res_tm, t_res_decls) in - (match uu___8 with - | (ty_pred', t_res_tm, decls_pred) -> - let proxy_fresh = - match formals with - | [] -> [] - | uu___9 -> - let uu___10 = - let uu___11 = - FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.next_id - () in - FStar_SMTEncoding_Term.fresh_token - (ddtok, - FStar_SMTEncoding_Term.Term_sort) - uu___11 in - [uu___10] in - let encode_elim uu___9 = - let uu___10 = - FStar_Syntax_Util.head_and_args - t_res in - match uu___10 with - | (head, args) -> - let uu___11 = - let uu___12 = - FStar_Syntax_Subst.compress - head in - uu___12.FStar_Syntax_Syntax.n in - (match uu___11 with - | FStar_Syntax_Syntax.Tm_uinst - ({ - FStar_Syntax_Syntax.n - = - FStar_Syntax_Syntax.Tm_fvar - fv; - FStar_Syntax_Syntax.pos - = uu___12; - FStar_Syntax_Syntax.vars - = uu___13; - FStar_Syntax_Syntax.hash_code - = uu___14;_}, - uu___15) - -> - let encoded_head_fvb = - FStar_SMTEncoding_Env.lookup_free_var_name - env' - fv.FStar_Syntax_Syntax.fv_name in - let uu___16 = - FStar_SMTEncoding_EncodeTerm.encode_args - args env' in - (match uu___16 with - | (encoded_args, - arg_decls) -> - let guards_for_parameter - orig_arg arg xv = - let fv1 = - match arg.FStar_SMTEncoding_Term.tm - with - | FStar_SMTEncoding_Term.FreeV - fv2 -> fv2 - | uu___17 -> - let uu___18 - = - let uu___19 - = - let uu___20 - = - FStar_Syntax_Print.term_to_string - orig_arg in - FStar_Compiler_Util.format1 - "Inductive type parameter %s must be a variable ; You may want to change it to an index." - uu___20 in - (FStar_Errors_Codes.Fatal_NonVariableInductiveTypeParameter, - uu___19) in - FStar_Errors.raise_error - uu___18 - orig_arg.FStar_Syntax_Syntax.pos in - let guards1 = - FStar_Compiler_List.collect - (fun g -> - let uu___17 - = - let uu___18 - = - FStar_SMTEncoding_Term.free_variables - g in - FStar_Compiler_List.contains - fv1 - uu___18 in - if uu___17 - then - let uu___18 - = - FStar_SMTEncoding_Term.subst - g fv1 xv in - [uu___18] - else []) - guards in - FStar_SMTEncoding_Util.mk_and_l - guards1 in - let uu___17 = - let uu___18 = - FStar_Compiler_List.zip - args - encoded_args in - FStar_Compiler_List.fold_left - (fun uu___19 -> - fun uu___20 - -> - match - (uu___19, + FStar_SMTEncoding_EncodeTerm.encode_term + t_res env' in + match uu___9 with + | (t_res_tm, t_res_decls) -> + let uu___10 = + FStar_SMTEncoding_Term.mk_HasTypeWithFuel + (FStar_Pervasives_Native.Some + fuel_tm) dapp t_res_tm in + (uu___10, t_res_tm, t_res_decls) in + (match uu___8 with + | (ty_pred', t_res_tm, decls_pred) -> + let proxy_fresh = + match formals with + | [] -> [] + | uu___9 -> + let uu___10 = + let uu___11 = + FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.next_id + () in + FStar_SMTEncoding_Term.fresh_token + (ddtok, + FStar_SMTEncoding_Term.Term_sort) + uu___11 in + [uu___10] in + let encode_elim uu___9 = + let uu___10 = + FStar_Syntax_Util.head_and_args + t_res in + match uu___10 with + | (head, args) -> + let uu___11 = + let uu___12 = + FStar_Syntax_Subst.compress + head in + uu___12.FStar_Syntax_Syntax.n in + (match uu___11 with + | FStar_Syntax_Syntax.Tm_uinst + ({ + FStar_Syntax_Syntax.n = + FStar_Syntax_Syntax.Tm_fvar + fv; + FStar_Syntax_Syntax.pos + = uu___12; + FStar_Syntax_Syntax.vars + = uu___13; + FStar_Syntax_Syntax.hash_code + = uu___14;_}, + uu___15) + -> + let encoded_head_fvb = + FStar_SMTEncoding_Env.lookup_free_var_name + env' + fv.FStar_Syntax_Syntax.fv_name in + let uu___16 = + FStar_SMTEncoding_EncodeTerm.encode_args + args env' in + (match uu___16 with + | (encoded_args, + arg_decls) -> + let uu___17 = + let uu___18 = + FStar_Compiler_List.zip + args + encoded_args in + FStar_Compiler_List.fold_left + (fun uu___19 -> + fun uu___20 -> + match + (uu___19, uu___20) - with - | ((env2, + with + | ((env2, arg_vars, eqns_or_guards, i), @@ -5370,14 +4473,6 @@ and (encode_sigelt' : if i < n_tps then - let uu___23 - = - guards_for_parameter - (FStar_Pervasives_Native.fst - orig_arg) - arg xv in - uu___23 - :: eqns_or_guards else (let uu___24 @@ -5393,112 +4488,152 @@ and (encode_sigelt' : eqns, (i + Prims.int_one)))) - (env', [], [], - Prims.int_zero) - uu___18 in - (match uu___17 with - | (uu___18, - arg_vars, - elim_eqns_or_guards, - uu___19) -> - let arg_vars1 = - FStar_Compiler_List.rev - arg_vars in - let ty = - FStar_SMTEncoding_EncodeTerm.maybe_curry_fvb - (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.p - encoded_head_fvb - arg_vars1 in - let xvars1 = - FStar_Compiler_List.map - FStar_SMTEncoding_Util.mkFreeV - vars in - let dapp1 = - FStar_SMTEncoding_Util.mkApp - (ddconstrsym, + (env', [], [], + Prims.int_zero) + uu___18 in + (match uu___17 with + | (uu___18, + arg_vars, + elim_eqns_or_guards, + uu___19) -> + let arg_vars1 = + FStar_Compiler_List.rev + arg_vars in + let uu___20 = + FStar_Compiler_List.splitAt + n_tps + arg_vars1 in + (match uu___20 + with + | (arg_params, + uu___21) -> + let uu___22 + = + FStar_Compiler_List.splitAt + n_tps + vars in + (match uu___22 + with + | + (data_arg_params, + uu___23) + -> + let elim_eqns_and_guards + = + let uu___24 + = + FStar_SMTEncoding_Util.mk_and_l + (FStar_Compiler_List.op_At + elim_eqns_or_guards + guards) in + FStar_Compiler_List.fold_left2 + (fun + elim_eqns_and_guards1 + -> + fun + data_arg_param + -> + fun + arg_param + -> + FStar_SMTEncoding_Term.subst + elim_eqns_and_guards1 + data_arg_param + arg_param) + uu___24 + data_arg_params + arg_params in + let ty = + FStar_SMTEncoding_EncodeTerm.maybe_curry_fvb + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.p + encoded_head_fvb + arg_vars1 in + let xvars1 + = + FStar_Compiler_List.map + FStar_SMTEncoding_Util.mkFreeV + vars in + let dapp1 + = + FStar_SMTEncoding_Util.mkApp + (ddconstrsym, xvars1) in - let ty_pred = - FStar_SMTEncoding_Term.mk_HasTypeWithFuel - (FStar_Pervasives_Native.Some + let ty_pred + = + FStar_SMTEncoding_Term.mk_HasTypeWithFuel + (FStar_Pervasives_Native.Some s_fuel_tm) - dapp1 ty in - let arg_binders - = - FStar_Compiler_List.map - FStar_SMTEncoding_Term.fv_of_term - arg_vars1 in - let typing_inversion - = - let uu___20 = - let uu___21 + dapp1 ty in + let arg_binders = - let uu___22 + FStar_Compiler_List.map + FStar_SMTEncoding_Term.fv_of_term + arg_vars1 in + let typing_inversion + = + let uu___24 + = + let uu___25 + = + let uu___26 = FStar_Ident.range_of_lid d in - let uu___23 + let uu___27 = - let uu___24 + let uu___28 = - let uu___25 + let uu___29 = FStar_SMTEncoding_Term.mk_fv (fuel_var, FStar_SMTEncoding_Term.Fuel_sort) in FStar_SMTEncoding_Env.add_fuel - uu___25 + uu___29 (FStar_Compiler_List.op_At vars arg_binders) in - let uu___25 - = - let uu___26 - = - let uu___27 + let uu___29 = - FStar_SMTEncoding_Util.mk_and_l - (FStar_Compiler_List.op_At - elim_eqns_or_guards - guards) in - (ty_pred, - uu___27) in FStar_SMTEncoding_Util.mkImp - uu___26 in + (ty_pred, + elim_eqns_and_guards) in ([ [ty_pred]], - uu___24, - uu___25) in + uu___28, + uu___29) in FStar_SMTEncoding_Term.mkForall - uu___22 - uu___23 in - (uu___21, - ( - FStar_Pervasives_Native.Some + uu___26 + uu___27 in + (uu___25, + (FStar_Pervasives_Native.Some "data constructor typing elim"), - ( - Prims.strcat + (Prims.strcat "data_elim_" ddconstrsym)) in - FStar_SMTEncoding_Util.mkAssume - uu___20 in - let lex_t = - let uu___20 = - let uu___21 + FStar_SMTEncoding_Util.mkAssume + uu___24 in + let lex_t = - let uu___22 + let uu___24 + = + let uu___25 + = + let uu___26 = FStar_Ident.string_of_lid FStar_Parser_Const.lex_t_lid in - (uu___22, + (uu___26, FStar_SMTEncoding_Term.Term_sort) in - FStar_SMTEncoding_Term.mk_fv - uu___21 in - FStar_SMTEncoding_Util.mkFreeV - uu___20 in - let subterm_ordering - = - let prec = - let uu___20 + FStar_SMTEncoding_Term.mk_fv + uu___25 in + FStar_SMTEncoding_Util.mkFreeV + uu___24 in + let subterm_ordering + = + let prec + = + let uu___24 = FStar_Compiler_List.mapi (fun i -> @@ -5507,90 +4642,92 @@ and (encode_sigelt' : i < n_tps then [] else - (let uu___22 + (let uu___26 = - let uu___23 + let uu___27 = FStar_SMTEncoding_Util.mkFreeV v in FStar_SMTEncoding_Util.mk_Precedes lex_t lex_t - uu___23 + uu___27 dapp1 in - [uu___22])) + [uu___26])) vars in - FStar_Compiler_List.flatten - uu___20 in - let uu___20 = - let uu___21 + FStar_Compiler_List.flatten + uu___24 in + let uu___24 = - let uu___22 + let uu___25 + = + let uu___26 = FStar_Ident.range_of_lid d in - let uu___23 + let uu___27 = - let uu___24 + let uu___28 = - let uu___25 + let uu___29 = FStar_SMTEncoding_Term.mk_fv (fuel_var, FStar_SMTEncoding_Term.Fuel_sort) in FStar_SMTEncoding_Env.add_fuel - uu___25 + uu___29 (FStar_Compiler_List.op_At vars arg_binders) in - let uu___25 + let uu___29 = - let uu___26 + let uu___30 = - let uu___27 + let uu___31 = FStar_SMTEncoding_Util.mk_and_l prec in (ty_pred, - uu___27) in + uu___31) in FStar_SMTEncoding_Util.mkImp - uu___26 in + uu___30 in ([ [ty_pred]], - uu___24, - uu___25) in + uu___28, + uu___29) in FStar_SMTEncoding_Term.mkForall - uu___22 - uu___23 in - (uu___21, - ( - FStar_Pervasives_Native.Some + uu___26 + uu___27 in + (uu___25, + (FStar_Pervasives_Native.Some "subterm ordering"), - ( - Prims.strcat + (Prims.strcat "subterm_ordering_" ddconstrsym)) in - FStar_SMTEncoding_Util.mkAssume - uu___20 in - let uu___20 = - let uu___21 = - FStar_Compiler_Util.first_N + FStar_SMTEncoding_Util.mkAssume + uu___24 in + let uu___24 + = + let uu___25 + = + FStar_Compiler_Util.first_N n_tps formals in - match uu___21 - with - | (uu___22, - formals') + match uu___25 + with + | + (uu___26, + formals') -> - let uu___23 + let uu___27 = FStar_Compiler_Util.first_N n_tps vars in - (match uu___23 + (match uu___27 with | - (uu___24, + (uu___28, vars') -> let norm t2 = @@ -5603,26 +4740,26 @@ and (encode_sigelt' : env'.FStar_SMTEncoding_Env.tcenv t2 in let warn_compat - uu___25 = - let uu___26 + uu___29 = + let uu___30 = FStar_Syntax_Syntax.range_of_fv fv in FStar_Errors.log_issue - uu___26 + uu___30 (FStar_Errors_Codes.Warning_DeprecatedGeneric, "Using 'compat:2954' to use a permissive encoding of the subterm ordering on the codomain of a constructor.\nThis is deprecated and will be removed in a future version of F*.") in - let uu___25 + let uu___29 = FStar_Compiler_List.fold_left2 (fun - uu___26 + uu___30 -> fun formal -> fun var -> - match uu___26 + match uu___30 with | (codomain_prec_l, @@ -5633,28 +4770,28 @@ and (encode_sigelt' : let t3 = FStar_Syntax_Util.unrefine t2 in - let uu___27 + let uu___31 = - let uu___28 + let uu___32 = FStar_Syntax_Subst.compress t3 in - uu___28.FStar_Syntax_Syntax.n in - match uu___27 + uu___32.FStar_Syntax_Syntax.n in + match uu___31 with | FStar_Syntax_Syntax.Tm_arrow - uu___28 + uu___32 -> - let uu___29 + let uu___33 = - let uu___30 + let uu___34 = FStar_Syntax_Util.unrefine t3 in FStar_Syntax_Util.arrow_formals_comp - uu___30 in - (match uu___29 + uu___34 in + (match uu___33 with | (bs, c) @@ -5665,25 +4802,25 @@ and (encode_sigelt' : [] -> FStar_Pervasives_Native.None | - uu___30 + uu___34 when - let uu___31 + let uu___35 = FStar_Syntax_Util.is_tot_or_gtot_comp c in Prims.op_Negation - uu___31 + uu___35 -> FStar_Pervasives_Native.None | - uu___30 + uu___34 -> - let uu___31 + let uu___35 = FStar_Syntax_Util.is_lemma_comp c in if - uu___31 + uu___35 then FStar_Pervasives_Native.None else @@ -5693,61 +4830,61 @@ and (encode_sigelt' : c) in let t5 = norm t4 in - let uu___33 + let uu___37 = (FStar_Syntax_Syntax.is_type t5) || (FStar_Syntax_Util.is_sub_singleton t5) in if - uu___33 + uu___37 then FStar_Pervasives_Native.None else - (let uu___35 + (let uu___39 = FStar_Syntax_Util.head_and_args_full t5 in - match uu___35 + match uu___39 with | (head1, - uu___36) + uu___40) -> - let uu___37 + let uu___41 = - let uu___38 + let uu___42 = FStar_Syntax_Util.un_uinst head1 in - uu___38.FStar_Syntax_Syntax.n in - (match uu___37 + uu___42.FStar_Syntax_Syntax.n in + (match uu___41 with | FStar_Syntax_Syntax.Tm_fvar fv1 -> - let uu___38 + let uu___42 = FStar_Compiler_Util.for_some (FStar_Syntax_Syntax.fv_eq_lid fv1) mutuals in if - uu___38 + uu___42 then FStar_Pervasives_Native.Some (bs, c) else - (let uu___40 + (let uu___44 = - let uu___41 + let uu___45 = FStar_Options.ext_getv "compat:2954" in - uu___41 + uu___45 <> "" in if - uu___40 + uu___44 then (warn_compat (); @@ -5756,18 +4893,18 @@ and (encode_sigelt' : else FStar_Pervasives_Native.None) | - uu___38 + uu___42 -> - let uu___39 + let uu___43 = - let uu___40 + let uu___44 = FStar_Options.ext_getv "compat:2954" in - uu___40 + uu___44 <> "" in if - uu___39 + uu___43 then (warn_compat (); @@ -5776,85 +4913,86 @@ and (encode_sigelt' : else FStar_Pervasives_Native.None))))) | - uu___28 + uu___32 -> - let uu___29 + let uu___33 = FStar_Syntax_Util.head_and_args t3 in - (match uu___29 + (match uu___33 with | (head1, - uu___30) + uu___34) -> let t' = norm t3 in - let uu___31 + let uu___35 = FStar_Syntax_Util.head_and_args t' in - (match uu___31 + (match uu___35 with | (head', - uu___32) + uu___36) -> - let uu___33 + let uu___37 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env1.FStar_SMTEncoding_Env.tcenv head1 head' in - (match uu___33 + (match uu___37 with | - FStar_Syntax_Util.Equal + FStar_TypeChecker_TermEqAndSimplify.Equal -> FStar_Pervasives_Native.None | - FStar_Syntax_Util.NotEqual + FStar_TypeChecker_TermEqAndSimplify.NotEqual -> binder_and_codomain_type t' | - uu___34 + uu___38 -> - let uu___35 + let uu___39 = - let uu___36 + let uu___40 = FStar_Syntax_Subst.compress head1 in - uu___36.FStar_Syntax_Syntax.n in - (match uu___35 + uu___40.FStar_Syntax_Syntax.n in + (match uu___39 with | FStar_Syntax_Syntax.Tm_fvar - uu___36 + uu___40 -> binder_and_codomain_type t' | FStar_Syntax_Syntax.Tm_name - uu___36 + uu___40 -> binder_and_codomain_type t' | FStar_Syntax_Syntax.Tm_uinst - uu___36 + uu___40 -> binder_and_codomain_type t' | - uu___36 + uu___40 -> FStar_Pervasives_Native.None)))) in - let uu___27 + let uu___31 = binder_and_codomain_type (formal.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in - (match uu___27 + (match uu___31 with | FStar_Pervasives_Native.None @@ -5865,90 +5003,90 @@ and (encode_sigelt' : FStar_Pervasives_Native.Some (bs, c) -> - let uu___28 + let uu___32 = FStar_SMTEncoding_EncodeTerm.encode_binders FStar_Pervasives_Native.None bs env' in - (match uu___28 + (match uu___32 with | (bs', guards', _env', bs_decls, - uu___29) + uu___33) -> let fun_app = - let uu___30 + let uu___34 = FStar_SMTEncoding_Util.mkFreeV var in FStar_SMTEncoding_EncodeTerm.mk_Apply - uu___30 + uu___34 bs' in - let uu___30 + let uu___34 = - let uu___31 + let uu___35 = - let uu___32 + let uu___36 = FStar_Ident.range_of_lid d in - let uu___33 + let uu___37 = - let uu___34 + let uu___38 = - let uu___35 + let uu___39 = - let uu___36 + let uu___40 = FStar_SMTEncoding_Util.mk_Precedes lex_t lex_t fun_app dapp1 in - [uu___36] in - [uu___35] in - let uu___35 + [uu___40] in + [uu___39] in + let uu___39 = - let uu___36 + let uu___40 = - let uu___37 + let uu___41 = FStar_SMTEncoding_Util.mk_and_l (ty_pred' :: guards') in - let uu___38 + let uu___42 = FStar_SMTEncoding_Util.mk_Precedes lex_t lex_t fun_app dapp1 in - (uu___37, - uu___38) in + (uu___41, + uu___42) in FStar_SMTEncoding_Util.mkImp - uu___36 in - (uu___34, + uu___40 in + (uu___38, bs', - uu___35) in + uu___39) in FStar_SMTEncoding_Term.mkForall - uu___32 - uu___33 in - uu___31 + uu___36 + uu___37 in + uu___35 :: codomain_prec_l in - (uu___30, + (uu___34, (FStar_Compiler_List.op_At bs_decls cod_decls))))) ([], []) formals' vars' in - (match uu___25 + (match uu___29 with | (codomain_prec_l, @@ -5961,141 +5099,94 @@ and (encode_sigelt' : ([], cod_decls) | - uu___26 + uu___30 -> - let uu___27 + let uu___31 = - let uu___28 + let uu___32 = - let uu___29 + let uu___33 = - let uu___30 + let uu___34 = - let uu___31 + let uu___35 = FStar_Ident.range_of_lid d in - let uu___32 + let uu___36 = - let uu___33 + let uu___37 = - let uu___34 + let uu___38 = FStar_SMTEncoding_Term.mk_fv (fuel_var, FStar_SMTEncoding_Term.Fuel_sort) in FStar_SMTEncoding_Env.add_fuel - uu___34 + uu___38 (FStar_Compiler_List.op_At vars arg_binders) in - let uu___34 + let uu___38 = FStar_SMTEncoding_Util.mk_and_l codomain_prec_l in ([ [ty_pred]], - uu___33, - uu___34) in + uu___37, + uu___38) in FStar_SMTEncoding_Term.mkForall - uu___31 - uu___32 in - (uu___30, + uu___35 + uu___36 in + (uu___34, (FStar_Pervasives_Native.Some "well-founded ordering on codomain"), (Prims.strcat "well_founded_ordering_on_codomain_" ddconstrsym)) in FStar_SMTEncoding_Util.mkAssume - uu___29 in - [uu___28] in - (uu___27, + uu___33 in + [uu___32] in + (uu___31, cod_decls)))) in - (match uu___20 - with - | (codomain_ordering, - codomain_decls) - -> - ((FStar_Compiler_List.op_At + (match uu___24 + with + | + (codomain_ordering, + codomain_decls) + -> + ((FStar_Compiler_List.op_At arg_decls codomain_decls), (FStar_Compiler_List.op_At [typing_inversion; subterm_ordering] - codomain_ordering))))) - | FStar_Syntax_Syntax.Tm_fvar - fv -> - let encoded_head_fvb = - FStar_SMTEncoding_Env.lookup_free_var_name - env' - fv.FStar_Syntax_Syntax.fv_name in - let uu___12 = - FStar_SMTEncoding_EncodeTerm.encode_args - args env' in - (match uu___12 with - | (encoded_args, - arg_decls) -> - let guards_for_parameter - orig_arg arg xv = - let fv1 = - match arg.FStar_SMTEncoding_Term.tm - with - | FStar_SMTEncoding_Term.FreeV - fv2 -> fv2 - | uu___13 -> - let uu___14 - = - let uu___15 - = - let uu___16 - = - FStar_Syntax_Print.term_to_string - orig_arg in - FStar_Compiler_Util.format1 - "Inductive type parameter %s must be a variable ; You may want to change it to an index." - uu___16 in - (FStar_Errors_Codes.Fatal_NonVariableInductiveTypeParameter, - uu___15) in - FStar_Errors.raise_error - uu___14 - orig_arg.FStar_Syntax_Syntax.pos in - let guards1 = - FStar_Compiler_List.collect - (fun g -> - let uu___13 - = - let uu___14 - = - FStar_SMTEncoding_Term.free_variables - g in - FStar_Compiler_List.contains - fv1 - uu___14 in - if uu___13 - then - let uu___14 - = - FStar_SMTEncoding_Term.subst - g fv1 xv in - [uu___14] - else []) - guards in - FStar_SMTEncoding_Util.mk_and_l - guards1 in - let uu___13 = - let uu___14 = - FStar_Compiler_List.zip - args - encoded_args in - FStar_Compiler_List.fold_left - (fun uu___15 -> - fun uu___16 - -> - match - (uu___15, + codomain_ordering))))))) + | FStar_Syntax_Syntax.Tm_fvar + fv -> + let encoded_head_fvb = + FStar_SMTEncoding_Env.lookup_free_var_name + env' + fv.FStar_Syntax_Syntax.fv_name in + let uu___12 = + FStar_SMTEncoding_EncodeTerm.encode_args + args env' in + (match uu___12 with + | (encoded_args, + arg_decls) -> + let uu___13 = + let uu___14 = + FStar_Compiler_List.zip + args + encoded_args in + FStar_Compiler_List.fold_left + (fun uu___15 -> + fun uu___16 -> + match + (uu___15, uu___16) - with - | ((env2, + with + | ((env2, arg_vars, eqns_or_guards, i), @@ -6122,14 +5213,6 @@ and (encode_sigelt' : if i < n_tps then - let uu___19 - = - guards_for_parameter - (FStar_Pervasives_Native.fst - orig_arg) - arg xv in - uu___19 - :: eqns_or_guards else (let uu___20 @@ -6145,112 +5228,152 @@ and (encode_sigelt' : eqns, (i + Prims.int_one)))) - (env', [], [], - Prims.int_zero) - uu___14 in - (match uu___13 with - | (uu___14, - arg_vars, - elim_eqns_or_guards, - uu___15) -> - let arg_vars1 = - FStar_Compiler_List.rev - arg_vars in - let ty = - FStar_SMTEncoding_EncodeTerm.maybe_curry_fvb - (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.p - encoded_head_fvb - arg_vars1 in - let xvars1 = - FStar_Compiler_List.map - FStar_SMTEncoding_Util.mkFreeV - vars in - let dapp1 = - FStar_SMTEncoding_Util.mkApp - (ddconstrsym, + (env', [], [], + Prims.int_zero) + uu___14 in + (match uu___13 with + | (uu___14, + arg_vars, + elim_eqns_or_guards, + uu___15) -> + let arg_vars1 = + FStar_Compiler_List.rev + arg_vars in + let uu___16 = + FStar_Compiler_List.splitAt + n_tps + arg_vars1 in + (match uu___16 + with + | (arg_params, + uu___17) -> + let uu___18 + = + FStar_Compiler_List.splitAt + n_tps + vars in + (match uu___18 + with + | + (data_arg_params, + uu___19) + -> + let elim_eqns_and_guards + = + let uu___20 + = + FStar_SMTEncoding_Util.mk_and_l + (FStar_Compiler_List.op_At + elim_eqns_or_guards + guards) in + FStar_Compiler_List.fold_left2 + (fun + elim_eqns_and_guards1 + -> + fun + data_arg_param + -> + fun + arg_param + -> + FStar_SMTEncoding_Term.subst + elim_eqns_and_guards1 + data_arg_param + arg_param) + uu___20 + data_arg_params + arg_params in + let ty = + FStar_SMTEncoding_EncodeTerm.maybe_curry_fvb + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.p + encoded_head_fvb + arg_vars1 in + let xvars1 + = + FStar_Compiler_List.map + FStar_SMTEncoding_Util.mkFreeV + vars in + let dapp1 + = + FStar_SMTEncoding_Util.mkApp + (ddconstrsym, xvars1) in - let ty_pred = - FStar_SMTEncoding_Term.mk_HasTypeWithFuel - (FStar_Pervasives_Native.Some + let ty_pred + = + FStar_SMTEncoding_Term.mk_HasTypeWithFuel + (FStar_Pervasives_Native.Some s_fuel_tm) - dapp1 ty in - let arg_binders - = - FStar_Compiler_List.map - FStar_SMTEncoding_Term.fv_of_term - arg_vars1 in - let typing_inversion - = - let uu___16 = - let uu___17 + dapp1 ty in + let arg_binders = - let uu___18 + FStar_Compiler_List.map + FStar_SMTEncoding_Term.fv_of_term + arg_vars1 in + let typing_inversion + = + let uu___20 + = + let uu___21 + = + let uu___22 = FStar_Ident.range_of_lid d in - let uu___19 + let uu___23 = - let uu___20 + let uu___24 = - let uu___21 + let uu___25 = FStar_SMTEncoding_Term.mk_fv (fuel_var, FStar_SMTEncoding_Term.Fuel_sort) in FStar_SMTEncoding_Env.add_fuel - uu___21 + uu___25 (FStar_Compiler_List.op_At vars arg_binders) in - let uu___21 - = - let uu___22 - = - let uu___23 + let uu___25 = - FStar_SMTEncoding_Util.mk_and_l - (FStar_Compiler_List.op_At - elim_eqns_or_guards - guards) in - (ty_pred, - uu___23) in FStar_SMTEncoding_Util.mkImp - uu___22 in + (ty_pred, + elim_eqns_and_guards) in ([ [ty_pred]], - uu___20, - uu___21) in + uu___24, + uu___25) in FStar_SMTEncoding_Term.mkForall - uu___18 - uu___19 in - (uu___17, - ( - FStar_Pervasives_Native.Some + uu___22 + uu___23 in + (uu___21, + (FStar_Pervasives_Native.Some "data constructor typing elim"), - ( - Prims.strcat + (Prims.strcat "data_elim_" ddconstrsym)) in - FStar_SMTEncoding_Util.mkAssume - uu___16 in - let lex_t = - let uu___16 = - let uu___17 + FStar_SMTEncoding_Util.mkAssume + uu___20 in + let lex_t = - let uu___18 + let uu___20 + = + let uu___21 + = + let uu___22 = FStar_Ident.string_of_lid FStar_Parser_Const.lex_t_lid in - (uu___18, + (uu___22, FStar_SMTEncoding_Term.Term_sort) in - FStar_SMTEncoding_Term.mk_fv - uu___17 in - FStar_SMTEncoding_Util.mkFreeV - uu___16 in - let subterm_ordering - = - let prec = - let uu___16 + FStar_SMTEncoding_Term.mk_fv + uu___21 in + FStar_SMTEncoding_Util.mkFreeV + uu___20 in + let subterm_ordering + = + let prec + = + let uu___20 = FStar_Compiler_List.mapi (fun i -> @@ -6259,90 +5382,92 @@ and (encode_sigelt' : i < n_tps then [] else - (let uu___18 + (let uu___22 = - let uu___19 + let uu___23 = FStar_SMTEncoding_Util.mkFreeV v in FStar_SMTEncoding_Util.mk_Precedes lex_t lex_t - uu___19 + uu___23 dapp1 in - [uu___18])) + [uu___22])) vars in - FStar_Compiler_List.flatten - uu___16 in - let uu___16 = - let uu___17 + FStar_Compiler_List.flatten + uu___20 in + let uu___20 = - let uu___18 + let uu___21 + = + let uu___22 = FStar_Ident.range_of_lid d in - let uu___19 + let uu___23 = - let uu___20 + let uu___24 = - let uu___21 + let uu___25 = FStar_SMTEncoding_Term.mk_fv (fuel_var, FStar_SMTEncoding_Term.Fuel_sort) in FStar_SMTEncoding_Env.add_fuel - uu___21 + uu___25 (FStar_Compiler_List.op_At vars arg_binders) in - let uu___21 + let uu___25 = - let uu___22 + let uu___26 = - let uu___23 + let uu___27 = FStar_SMTEncoding_Util.mk_and_l prec in (ty_pred, - uu___23) in + uu___27) in FStar_SMTEncoding_Util.mkImp - uu___22 in + uu___26 in ([ [ty_pred]], - uu___20, - uu___21) in + uu___24, + uu___25) in FStar_SMTEncoding_Term.mkForall - uu___18 - uu___19 in - (uu___17, - ( - FStar_Pervasives_Native.Some + uu___22 + uu___23 in + (uu___21, + (FStar_Pervasives_Native.Some "subterm ordering"), - ( - Prims.strcat + (Prims.strcat "subterm_ordering_" ddconstrsym)) in - FStar_SMTEncoding_Util.mkAssume - uu___16 in - let uu___16 = - let uu___17 = - FStar_Compiler_Util.first_N + FStar_SMTEncoding_Util.mkAssume + uu___20 in + let uu___20 + = + let uu___21 + = + FStar_Compiler_Util.first_N n_tps formals in - match uu___17 - with - | (uu___18, - formals') + match uu___21 + with + | + (uu___22, + formals') -> - let uu___19 + let uu___23 = FStar_Compiler_Util.first_N n_tps vars in - (match uu___19 + (match uu___23 with | - (uu___20, + (uu___24, vars') -> let norm t2 = @@ -6355,26 +5480,26 @@ and (encode_sigelt' : env'.FStar_SMTEncoding_Env.tcenv t2 in let warn_compat - uu___21 = - let uu___22 + uu___25 = + let uu___26 = FStar_Syntax_Syntax.range_of_fv fv in FStar_Errors.log_issue - uu___22 + uu___26 (FStar_Errors_Codes.Warning_DeprecatedGeneric, "Using 'compat:2954' to use a permissive encoding of the subterm ordering on the codomain of a constructor.\nThis is deprecated and will be removed in a future version of F*.") in - let uu___21 + let uu___25 = FStar_Compiler_List.fold_left2 (fun - uu___22 + uu___26 -> fun formal -> fun var -> - match uu___22 + match uu___26 with | (codomain_prec_l, @@ -6385,28 +5510,28 @@ and (encode_sigelt' : let t3 = FStar_Syntax_Util.unrefine t2 in - let uu___23 + let uu___27 = - let uu___24 + let uu___28 = FStar_Syntax_Subst.compress t3 in - uu___24.FStar_Syntax_Syntax.n in - match uu___23 + uu___28.FStar_Syntax_Syntax.n in + match uu___27 with | FStar_Syntax_Syntax.Tm_arrow - uu___24 + uu___28 -> - let uu___25 + let uu___29 = - let uu___26 + let uu___30 = FStar_Syntax_Util.unrefine t3 in FStar_Syntax_Util.arrow_formals_comp - uu___26 in - (match uu___25 + uu___30 in + (match uu___29 with | (bs, c) @@ -6417,25 +5542,25 @@ and (encode_sigelt' : [] -> FStar_Pervasives_Native.None | - uu___26 + uu___30 when - let uu___27 + let uu___31 = FStar_Syntax_Util.is_tot_or_gtot_comp c in Prims.op_Negation - uu___27 + uu___31 -> FStar_Pervasives_Native.None | - uu___26 + uu___30 -> - let uu___27 + let uu___31 = FStar_Syntax_Util.is_lemma_comp c in if - uu___27 + uu___31 then FStar_Pervasives_Native.None else @@ -6445,61 +5570,61 @@ and (encode_sigelt' : c) in let t5 = norm t4 in - let uu___29 + let uu___33 = (FStar_Syntax_Syntax.is_type t5) || (FStar_Syntax_Util.is_sub_singleton t5) in if - uu___29 + uu___33 then FStar_Pervasives_Native.None else - (let uu___31 + (let uu___35 = FStar_Syntax_Util.head_and_args_full t5 in - match uu___31 + match uu___35 with | (head1, - uu___32) + uu___36) -> - let uu___33 + let uu___37 = - let uu___34 + let uu___38 = FStar_Syntax_Util.un_uinst head1 in - uu___34.FStar_Syntax_Syntax.n in - (match uu___33 + uu___38.FStar_Syntax_Syntax.n in + (match uu___37 with | FStar_Syntax_Syntax.Tm_fvar fv1 -> - let uu___34 + let uu___38 = FStar_Compiler_Util.for_some (FStar_Syntax_Syntax.fv_eq_lid fv1) mutuals in if - uu___34 + uu___38 then FStar_Pervasives_Native.Some (bs, c) else - (let uu___36 + (let uu___40 = - let uu___37 + let uu___41 = FStar_Options.ext_getv "compat:2954" in - uu___37 + uu___41 <> "" in if - uu___36 + uu___40 then (warn_compat (); @@ -6508,18 +5633,18 @@ and (encode_sigelt' : else FStar_Pervasives_Native.None) | - uu___34 + uu___38 -> - let uu___35 + let uu___39 = - let uu___36 + let uu___40 = FStar_Options.ext_getv "compat:2954" in - uu___36 + uu___40 <> "" in if - uu___35 + uu___39 then (warn_compat (); @@ -6528,85 +5653,86 @@ and (encode_sigelt' : else FStar_Pervasives_Native.None))))) | - uu___24 + uu___28 -> - let uu___25 + let uu___29 = FStar_Syntax_Util.head_and_args t3 in - (match uu___25 + (match uu___29 with | (head1, - uu___26) + uu___30) -> let t' = norm t3 in - let uu___27 + let uu___31 = FStar_Syntax_Util.head_and_args t' in - (match uu___27 + (match uu___31 with | (head', - uu___28) + uu___32) -> - let uu___29 + let uu___33 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env1.FStar_SMTEncoding_Env.tcenv head1 head' in - (match uu___29 + (match uu___33 with | - FStar_Syntax_Util.Equal + FStar_TypeChecker_TermEqAndSimplify.Equal -> FStar_Pervasives_Native.None | - FStar_Syntax_Util.NotEqual + FStar_TypeChecker_TermEqAndSimplify.NotEqual -> binder_and_codomain_type t' | - uu___30 + uu___34 -> - let uu___31 + let uu___35 = - let uu___32 + let uu___36 = FStar_Syntax_Subst.compress head1 in - uu___32.FStar_Syntax_Syntax.n in - (match uu___31 + uu___36.FStar_Syntax_Syntax.n in + (match uu___35 with | FStar_Syntax_Syntax.Tm_fvar - uu___32 + uu___36 -> binder_and_codomain_type t' | FStar_Syntax_Syntax.Tm_name - uu___32 + uu___36 -> binder_and_codomain_type t' | FStar_Syntax_Syntax.Tm_uinst - uu___32 + uu___36 -> binder_and_codomain_type t' | - uu___32 + uu___36 -> FStar_Pervasives_Native.None)))) in - let uu___23 + let uu___27 = binder_and_codomain_type (formal.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in - (match uu___23 + (match uu___27 with | FStar_Pervasives_Native.None @@ -6617,90 +5743,90 @@ and (encode_sigelt' : FStar_Pervasives_Native.Some (bs, c) -> - let uu___24 + let uu___28 = FStar_SMTEncoding_EncodeTerm.encode_binders FStar_Pervasives_Native.None bs env' in - (match uu___24 + (match uu___28 with | (bs', guards', _env', bs_decls, - uu___25) + uu___29) -> let fun_app = - let uu___26 + let uu___30 = FStar_SMTEncoding_Util.mkFreeV var in FStar_SMTEncoding_EncodeTerm.mk_Apply - uu___26 + uu___30 bs' in - let uu___26 + let uu___30 = - let uu___27 + let uu___31 = - let uu___28 + let uu___32 = FStar_Ident.range_of_lid d in - let uu___29 + let uu___33 = - let uu___30 + let uu___34 = - let uu___31 + let uu___35 = - let uu___32 + let uu___36 = FStar_SMTEncoding_Util.mk_Precedes lex_t lex_t fun_app dapp1 in - [uu___32] in - [uu___31] in - let uu___31 + [uu___36] in + [uu___35] in + let uu___35 = - let uu___32 + let uu___36 = - let uu___33 + let uu___37 = FStar_SMTEncoding_Util.mk_and_l (ty_pred' :: guards') in - let uu___34 + let uu___38 = FStar_SMTEncoding_Util.mk_Precedes lex_t lex_t fun_app dapp1 in - (uu___33, - uu___34) in + (uu___37, + uu___38) in FStar_SMTEncoding_Util.mkImp - uu___32 in - (uu___30, + uu___36 in + (uu___34, bs', - uu___31) in + uu___35) in FStar_SMTEncoding_Term.mkForall - uu___28 - uu___29 in - uu___27 + uu___32 + uu___33 in + uu___31 :: codomain_prec_l in - (uu___26, + (uu___30, (FStar_Compiler_List.op_At bs_decls cod_decls))))) ([], []) formals' vars' in - (match uu___21 + (match uu___25 with | (codomain_prec_l, @@ -6713,123 +5839,122 @@ and (encode_sigelt' : ([], cod_decls) | - uu___22 + uu___26 -> - let uu___23 + let uu___27 = - let uu___24 + let uu___28 = - let uu___25 + let uu___29 = - let uu___26 + let uu___30 = - let uu___27 + let uu___31 = FStar_Ident.range_of_lid d in - let uu___28 + let uu___32 = - let uu___29 + let uu___33 = - let uu___30 + let uu___34 = FStar_SMTEncoding_Term.mk_fv (fuel_var, FStar_SMTEncoding_Term.Fuel_sort) in FStar_SMTEncoding_Env.add_fuel - uu___30 + uu___34 (FStar_Compiler_List.op_At vars arg_binders) in - let uu___30 + let uu___34 = FStar_SMTEncoding_Util.mk_and_l codomain_prec_l in ([ [ty_pred]], - uu___29, - uu___30) in + uu___33, + uu___34) in FStar_SMTEncoding_Term.mkForall - uu___27 - uu___28 in - (uu___26, + uu___31 + uu___32 in + (uu___30, (FStar_Pervasives_Native.Some "well-founded ordering on codomain"), (Prims.strcat "well_founded_ordering_on_codomain_" ddconstrsym)) in FStar_SMTEncoding_Util.mkAssume - uu___25 in - [uu___24] in - (uu___23, + uu___29 in + [uu___28] in + (uu___27, cod_decls)))) in - (match uu___16 - with - | (codomain_ordering, - codomain_decls) - -> - ((FStar_Compiler_List.op_At + (match uu___20 + with + | + (codomain_ordering, + codomain_decls) + -> + ((FStar_Compiler_List.op_At arg_decls codomain_decls), (FStar_Compiler_List.op_At [typing_inversion; subterm_ordering] - codomain_ordering))))) - | uu___12 -> - ((let uu___14 = - let uu___15 = - let uu___16 = - FStar_Syntax_Print.lid_to_string - d in - let uu___17 = - FStar_Syntax_Print.term_to_string - head in - FStar_Compiler_Util.format2 - "Constructor %s builds an unexpected type %s\n" - uu___16 uu___17 in - (FStar_Errors_Codes.Warning_ConstructorBuildsUnexpectedType, - uu___15) in - FStar_Errors.log_issue - se.FStar_Syntax_Syntax.sigrng - uu___14); - ([], []))) in - let uu___9 = encode_elim () in - (match uu___9 with - | (decls2, elim) -> - let data_cons_typing_intro_decl - = - let uu___10 = - match t_res_tm.FStar_SMTEncoding_Term.tm - with - | FStar_SMTEncoding_Term.App - (op, args) -> - let uu___11 = - FStar_Compiler_List.splitAt - n_tps args in - (match uu___11 with - | (targs, iargs) -> - let uu___12 = - let uu___13 = - FStar_Compiler_List.map - (fun uu___14 - -> - FStar_SMTEncoding_Env.fresh_fvar + codomain_ordering))))))) + | uu___12 -> + ((let uu___14 = + let uu___15 = + let uu___16 = + FStar_Syntax_Print.lid_to_string + d in + let uu___17 = + FStar_Syntax_Print.term_to_string + head in + FStar_Compiler_Util.format2 + "Constructor %s builds an unexpected type %s\n" + uu___16 uu___17 in + (FStar_Errors_Codes.Warning_ConstructorBuildsUnexpectedType, + uu___15) in + FStar_Errors.log_issue + se.FStar_Syntax_Syntax.sigrng + uu___14); + ([], []))) in + let uu___9 = encode_elim () in + (match uu___9 with + | (decls2, elim) -> + let data_cons_typing_intro_decl + = + let uu___10 = + match t_res_tm.FStar_SMTEncoding_Term.tm + with + | FStar_SMTEncoding_Term.App + (op, args) -> + let uu___11 = + FStar_Compiler_List.splitAt + n_tps args in + (match uu___11 with + | (targs, iargs) -> + let uu___12 = + let uu___13 = + FStar_Compiler_List.map + (fun uu___14 + -> + FStar_SMTEncoding_Env.fresh_fvar env1.FStar_SMTEncoding_Env.current_module_name "i" FStar_SMTEncoding_Term.Term_sort) - iargs in - FStar_Compiler_List.split - uu___13 in - (match uu___12 - with - | (fresh_ivars, - fresh_iargs) - -> - let additional_guards - = - let uu___13 - = - FStar_Compiler_List.map2 + iargs in + FStar_Compiler_List.split + uu___13 in + (match uu___12 with + | (fresh_ivars, + fresh_iargs) -> + let additional_guards + = + let uu___13 + = + FStar_Compiler_List.map2 (fun a -> fun fresh_a @@ -6839,15 +5964,14 @@ and (encode_sigelt' : fresh_a)) iargs fresh_iargs in - FStar_SMTEncoding_Util.mk_and_l - uu___13 in - let uu___13 = - FStar_SMTEncoding_Term.mk_HasTypeWithFuel - ( - FStar_Pervasives_Native.Some + FStar_SMTEncoding_Util.mk_and_l + uu___13 in + let uu___13 = + FStar_SMTEncoding_Term.mk_HasTypeWithFuel + (FStar_Pervasives_Native.Some fuel_tm) - dapp - { + dapp + { FStar_SMTEncoding_Term.tm = (FStar_SMTEncoding_Term.App @@ -6857,115 +5981,113 @@ and (encode_sigelt' : fresh_iargs))); FStar_SMTEncoding_Term.freevars = - (t_res_tm.FStar_SMTEncoding_Term.freevars); - FStar_SMTEncoding_Term.rng - = - (t_res_tm.FStar_SMTEncoding_Term.rng) - } in - let uu___14 = - let uu___15 - = - FStar_Compiler_List.map - (fun s -> - FStar_SMTEncoding_Term.mk_fv - (s, - FStar_SMTEncoding_Term.Term_sort)) - fresh_ivars in - FStar_Compiler_List.op_At - vars - uu___15 in - let uu___15 = - FStar_SMTEncoding_Util.mkAnd - (guard, - additional_guards) in - (uu___13, - uu___14, - uu___15))) - | uu___11 -> - (ty_pred', vars, guard) in - match uu___10 with - | (ty_pred'1, vars1, guard1) - -> - let uu___11 = - let uu___12 = - let uu___13 = - FStar_Ident.range_of_lid - d in - let uu___14 = - let uu___15 = - let uu___16 = - FStar_SMTEncoding_Term.mk_fv - (fuel_var, - FStar_SMTEncoding_Term.Fuel_sort) in - FStar_SMTEncoding_Env.add_fuel - uu___16 vars1 in - let uu___16 = - FStar_SMTEncoding_Util.mkImp - (guard1, - ty_pred'1) in - ([[ty_pred'1]], - uu___15, uu___16) in - FStar_SMTEncoding_Term.mkForall - uu___13 uu___14 in - (uu___12, - (FStar_Pervasives_Native.Some - "data constructor typing intro"), - (Prims.strcat - "data_typing_intro_" - ddtok)) in - FStar_SMTEncoding_Util.mkAssume - uu___11 in - let g = - let uu___10 = - let uu___11 = - let uu___12 = - let uu___13 = - let uu___14 = - let uu___15 = - let uu___16 = - let uu___17 = - let uu___18 = - let uu___19 + (t_res_tm.FStar_SMTEncoding_Term.freevars); + FStar_SMTEncoding_Term.rng = - let uu___20 + (t_res_tm.FStar_SMTEncoding_Term.rng) + } in + let uu___14 = + let uu___15 + = + FStar_Compiler_List.map + (fun s -> + FStar_SMTEncoding_Term.mk_fv + (s, + FStar_SMTEncoding_Term.Term_sort)) + fresh_ivars in + FStar_Compiler_List.op_At + vars + uu___15 in + let uu___15 = + FStar_SMTEncoding_Util.mkAnd + (guard, + additional_guards) in + (uu___13, + uu___14, + uu___15))) + | uu___11 -> + (ty_pred', vars, guard) in + match uu___10 with + | (ty_pred'1, vars1, guard1) + -> + let uu___11 = + let uu___12 = + let uu___13 = + FStar_Ident.range_of_lid + d in + let uu___14 = + let uu___15 = + let uu___16 = + FStar_SMTEncoding_Term.mk_fv + (fuel_var, + FStar_SMTEncoding_Term.Fuel_sort) in + FStar_SMTEncoding_Env.add_fuel + uu___16 vars1 in + let uu___16 = + FStar_SMTEncoding_Util.mkImp + (guard1, + ty_pred'1) in + ([[ty_pred'1]], + uu___15, uu___16) in + FStar_SMTEncoding_Term.mkForall + uu___13 uu___14 in + (uu___12, + (FStar_Pervasives_Native.Some + "data constructor typing intro"), + (Prims.strcat + "data_typing_intro_" + ddtok)) in + FStar_SMTEncoding_Util.mkAssume + uu___11 in + let g = + let uu___10 = + let uu___11 = + let uu___12 = + let uu___13 = + let uu___14 = + let uu___15 = + let uu___16 = + let uu___17 = + let uu___18 = + let uu___19 + = + let uu___20 = FStar_Syntax_Print.lid_to_string d in - FStar_Compiler_Util.format1 + FStar_Compiler_Util.format1 "data constructor proxy: %s" uu___20 in - FStar_Pervasives_Native.Some - uu___19 in - (ddtok, [], - FStar_SMTEncoding_Term.Term_sort, - uu___18) in - FStar_SMTEncoding_Term.DeclFun - uu___17 in - [uu___16] in - FStar_Compiler_List.op_At - uu___15 - proxy_fresh in - FStar_SMTEncoding_Term.mk_decls_trivial - uu___14 in - let uu___14 = - let uu___15 = - let uu___16 = - let uu___17 = - let uu___18 = - FStar_SMTEncoding_Util.mkAssume - (tok_typing1, - ( - FStar_Pervasives_Native.Some + FStar_Pervasives_Native.Some + uu___19 in + (ddtok, [], + FStar_SMTEncoding_Term.Term_sort, + uu___18) in + FStar_SMTEncoding_Term.DeclFun + uu___17 in + [uu___16] in + FStar_Compiler_List.op_At + uu___15 + proxy_fresh in + FStar_SMTEncoding_Term.mk_decls_trivial + uu___14 in + let uu___14 = + let uu___15 = + let uu___16 = + let uu___17 = + let uu___18 = + FStar_SMTEncoding_Util.mkAssume + (tok_typing1, + (FStar_Pervasives_Native.Some "typing for data constructor proxy"), - ( - Prims.strcat + (Prims.strcat "typing_tok_" ddtok)) in - let uu___19 = - let uu___20 = - let uu___21 - = - let uu___22 + let uu___19 = + let uu___20 = + let uu___21 + = + let uu___22 = let uu___23 = @@ -6984,55 +6106,781 @@ and (encode_sigelt' : FStar_SMTEncoding_Term.mkForall uu___23 uu___24 in - (uu___22, + (uu___22, (FStar_Pervasives_Native.Some "equality for proxy"), (Prims.strcat "equality_tok_" ddtok)) in - FStar_SMTEncoding_Util.mkAssume - uu___21 in - [uu___20; - data_cons_typing_intro_decl] in - uu___18 :: - uu___19 in - FStar_Compiler_List.op_At - uu___17 elim in - FStar_SMTEncoding_Term.mk_decls_trivial - uu___16 in - FStar_Compiler_List.op_At - decls_pred uu___15 in - FStar_Compiler_List.op_At - uu___13 uu___14 in - FStar_Compiler_List.op_At - decls3 uu___12 in - FStar_Compiler_List.op_At - decls2 uu___11 in - FStar_Compiler_List.op_At - binder_decls uu___10 in - let uu___10 = - let uu___11 = - FStar_SMTEncoding_Term.mk_decls_trivial - datacons in - FStar_Compiler_List.op_At - uu___11 g in - (uu___10, env1))))))))) -and (encode_sigelts : + FStar_SMTEncoding_Util.mkAssume + uu___21 in + [uu___20; + data_cons_typing_intro_decl] in + uu___18 :: + uu___19 in + FStar_Compiler_List.op_At + uu___17 elim in + FStar_SMTEncoding_Term.mk_decls_trivial + uu___16 in + FStar_Compiler_List.op_At + decls_pred uu___15 in + FStar_Compiler_List.op_At + uu___13 uu___14 in + FStar_Compiler_List.op_At + decls3 uu___12 in + FStar_Compiler_List.op_At + decls2 uu___11 in + FStar_Compiler_List.op_At + binder_decls uu___10 in + let uu___10 = + let uu___11 = + FStar_SMTEncoding_Term.mk_decls_trivial + datacons in + FStar_Compiler_List.op_At + uu___11 g in + (uu___10, env1)))))))) +let rec (encode_sigelt : FStar_SMTEncoding_Env.env_t -> - FStar_Syntax_Syntax.sigelt Prims.list -> + FStar_Syntax_Syntax.sigelt -> (FStar_SMTEncoding_Term.decls_t * FStar_SMTEncoding_Env.env_t)) = fun env -> - fun ses -> - FStar_Compiler_List.fold_left - (fun uu___ -> - fun se -> - match uu___ with - | (g, env1) -> - let uu___1 = encode_sigelt env1 se in - (match uu___1 with - | (g', env2) -> ((FStar_Compiler_List.op_At g g'), env2))) - ([], env) ses + fun se -> + let nm = FStar_Syntax_Print.sigelt_to_string_short se in + let uu___ = + let uu___1 = + let uu___2 = FStar_Syntax_Print.sigelt_to_string_short se in + FStar_Compiler_Util.format1 + "While encoding top-level declaration `%s`" uu___2 in + FStar_Errors.with_ctx uu___1 (fun uu___2 -> encode_sigelt' env se) in + match uu___ with + | (g, env1) -> + let g1 = + match g with + | [] -> + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg_SMTEncoding in + if uu___2 + then + FStar_Compiler_Util.print1 "Skipped encoding of %s\n" nm + else ()); + (let uu___2 = + let uu___3 = + let uu___4 = + FStar_Compiler_Util.format1 "" nm in + FStar_SMTEncoding_Term.Caption uu___4 in + [uu___3] in + FStar_SMTEncoding_Term.mk_decls_trivial uu___2)) + | uu___1 -> + let uu___2 = + let uu___3 = + let uu___4 = + let uu___5 = + FStar_Compiler_Util.format1 "" nm in + FStar_SMTEncoding_Term.Caption uu___5 in + [uu___4] in + FStar_SMTEncoding_Term.mk_decls_trivial uu___3 in + let uu___3 = + let uu___4 = + let uu___5 = + let uu___6 = + let uu___7 = + FStar_Compiler_Util.format1 "" nm in + FStar_SMTEncoding_Term.Caption uu___7 in + [uu___6] in + FStar_SMTEncoding_Term.mk_decls_trivial uu___5 in + FStar_Compiler_List.op_At g uu___4 in + FStar_Compiler_List.op_At uu___2 uu___3 in + (g1, env1) +and (encode_sigelt' : + FStar_SMTEncoding_Env.env_t -> + FStar_Syntax_Syntax.sigelt -> + (FStar_SMTEncoding_Term.decls_t * FStar_SMTEncoding_Env.env_t)) + = + fun env -> + fun se -> + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_SMTEncoding in + if uu___1 + then + let uu___2 = FStar_Syntax_Print.sigelt_to_string se in + FStar_Compiler_Util.print1 "@@@Encoding sigelt %s\n" uu___2 + else ()); + (let is_opaque_to_smt t = + let uu___1 = + let uu___2 = FStar_Syntax_Subst.compress t in + uu___2.FStar_Syntax_Syntax.n in + match uu___1 with + | FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_string + (s, uu___2)) -> s = "opaque_to_smt" + | uu___2 -> false in + let is_uninterpreted_by_smt t = + let uu___1 = + let uu___2 = FStar_Syntax_Subst.compress t in + uu___2.FStar_Syntax_Syntax.n in + match uu___1 with + | FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_string + (s, uu___2)) -> s = "uninterpreted_by_smt" + | uu___2 -> false in + match se.FStar_Syntax_Syntax.sigel with + | FStar_Syntax_Syntax.Sig_splice uu___1 -> + FStar_Compiler_Effect.failwith + "impossible -- splice should have been removed by Tc.fs" + | FStar_Syntax_Syntax.Sig_fail uu___1 -> + FStar_Compiler_Effect.failwith + "impossible -- Sig_fail should have been removed by Tc.fs" + | FStar_Syntax_Syntax.Sig_pragma uu___1 -> ([], env) + | FStar_Syntax_Syntax.Sig_effect_abbrev uu___1 -> ([], env) + | FStar_Syntax_Syntax.Sig_sub_effect uu___1 -> ([], env) + | FStar_Syntax_Syntax.Sig_polymonadic_bind uu___1 -> ([], env) + | FStar_Syntax_Syntax.Sig_polymonadic_subcomp uu___1 -> ([], env) + | FStar_Syntax_Syntax.Sig_new_effect ed -> + let uu___1 = + let uu___2 = + FStar_SMTEncoding_Util.is_smt_reifiable_effect + env.FStar_SMTEncoding_Env.tcenv ed.FStar_Syntax_Syntax.mname in + Prims.op_Negation uu___2 in + if uu___1 + then ([], env) + else + (let close_effect_params tm = + match ed.FStar_Syntax_Syntax.binders with + | [] -> tm + | uu___3 -> + FStar_Syntax_Syntax.mk + (FStar_Syntax_Syntax.Tm_abs + { + FStar_Syntax_Syntax.bs = + (ed.FStar_Syntax_Syntax.binders); + FStar_Syntax_Syntax.body = tm; + FStar_Syntax_Syntax.rc_opt = + (FStar_Pervasives_Native.Some + (FStar_Syntax_Util.mk_residual_comp + FStar_Parser_Const.effect_Tot_lid + FStar_Pervasives_Native.None + [FStar_Syntax_Syntax.TOTAL])) + }) tm.FStar_Syntax_Syntax.pos in + let encode_action env1 a = + let action_defn = + let uu___3 = + close_effect_params a.FStar_Syntax_Syntax.action_defn in + norm_before_encoding env1 uu___3 in + let uu___3 = + FStar_Syntax_Util.arrow_formals_comp + a.FStar_Syntax_Syntax.action_typ in + match uu___3 with + | (formals, uu___4) -> + let arity = FStar_Compiler_List.length formals in + let uu___5 = + FStar_SMTEncoding_Env.new_term_constant_and_tok_from_lid + env1 a.FStar_Syntax_Syntax.action_name arity in + (match uu___5 with + | (aname, atok, env2) -> + let uu___6 = + FStar_SMTEncoding_EncodeTerm.encode_term + action_defn env2 in + (match uu___6 with + | (tm, decls) -> + let a_decls = + let uu___7 = + let uu___8 = + let uu___9 = + FStar_Compiler_List.map + (fun uu___10 -> + FStar_SMTEncoding_Term.Term_sort) + formals in + (aname, uu___9, + FStar_SMTEncoding_Term.Term_sort, + (FStar_Pervasives_Native.Some "Action")) in + FStar_SMTEncoding_Term.DeclFun uu___8 in + [uu___7; + FStar_SMTEncoding_Term.DeclFun + (atok, [], + FStar_SMTEncoding_Term.Term_sort, + (FStar_Pervasives_Native.Some + "Action token"))] in + let uu___7 = + let aux uu___8 uu___9 = + match (uu___8, uu___9) with + | ({ FStar_Syntax_Syntax.binder_bv = bv; + FStar_Syntax_Syntax.binder_qual = + uu___10; + FStar_Syntax_Syntax.binder_positivity + = uu___11; + FStar_Syntax_Syntax.binder_attrs = + uu___12;_}, + (env3, acc_sorts, acc)) -> + let uu___13 = + FStar_SMTEncoding_Env.gen_term_var + env3 bv in + (match uu___13 with + | (xxsym, xx, env4) -> + let uu___14 = + let uu___15 = + FStar_SMTEncoding_Term.mk_fv + (xxsym, + FStar_SMTEncoding_Term.Term_sort) in + uu___15 :: acc_sorts in + (env4, uu___14, (xx :: acc))) in + FStar_Compiler_List.fold_right aux formals + (env2, [], []) in + (match uu___7 with + | (uu___8, xs_sorts, xs) -> + let app = + FStar_SMTEncoding_Util.mkApp (aname, xs) in + let a_eq = + let uu___9 = + let uu___10 = + let uu___11 = + FStar_Ident.range_of_lid + a.FStar_Syntax_Syntax.action_name in + let uu___12 = + let uu___13 = + let uu___14 = + let uu___15 = + FStar_SMTEncoding_EncodeTerm.mk_Apply + tm xs_sorts in + (app, uu___15) in + FStar_SMTEncoding_Util.mkEq + uu___14 in + ([[app]], xs_sorts, uu___13) in + FStar_SMTEncoding_Term.mkForall + uu___11 uu___12 in + (uu___10, + (FStar_Pervasives_Native.Some + "Action equality"), + (Prims.strcat aname "_equality")) in + FStar_SMTEncoding_Util.mkAssume uu___9 in + let tok_correspondence = + let tok_term = + let uu___9 = + FStar_SMTEncoding_Term.mk_fv + (atok, + FStar_SMTEncoding_Term.Term_sort) in + FStar_SMTEncoding_Util.mkFreeV uu___9 in + let tok_app = + FStar_SMTEncoding_EncodeTerm.mk_Apply + tok_term xs_sorts in + let uu___9 = + let uu___10 = + let uu___11 = + FStar_Ident.range_of_lid + a.FStar_Syntax_Syntax.action_name in + let uu___12 = + let uu___13 = + FStar_SMTEncoding_Util.mkEq + (tok_app, app) in + ([[tok_app]], xs_sorts, uu___13) in + FStar_SMTEncoding_Term.mkForall + uu___11 uu___12 in + (uu___10, + (FStar_Pervasives_Native.Some + "Action token correspondence"), + (Prims.strcat aname + "_token_correspondence")) in + FStar_SMTEncoding_Util.mkAssume uu___9 in + let uu___9 = + let uu___10 = + FStar_SMTEncoding_Term.mk_decls_trivial + (FStar_Compiler_List.op_At a_decls + [a_eq; tok_correspondence]) in + FStar_Compiler_List.op_At decls uu___10 in + (env2, uu___9)))) in + let uu___3 = + FStar_Compiler_Util.fold_map encode_action env + ed.FStar_Syntax_Syntax.actions in + match uu___3 with + | (env1, decls2) -> + ((FStar_Compiler_List.flatten decls2), env1)) + | FStar_Syntax_Syntax.Sig_declare_typ + { FStar_Syntax_Syntax.lid2 = lid; + FStar_Syntax_Syntax.us2 = uu___1; + FStar_Syntax_Syntax.t2 = uu___2;_} + when FStar_Ident.lid_equals lid FStar_Parser_Const.precedes_lid -> + let uu___3 = + FStar_SMTEncoding_Env.new_term_constant_and_tok_from_lid env lid + (Prims.of_int (4)) in + (match uu___3 with | (tname, ttok, env1) -> ([], env1)) + | FStar_Syntax_Syntax.Sig_declare_typ + { FStar_Syntax_Syntax.lid2 = lid; + FStar_Syntax_Syntax.us2 = uu___1; FStar_Syntax_Syntax.t2 = t;_} + -> + let quals = se.FStar_Syntax_Syntax.sigquals in + let will_encode_definition = + let uu___2 = + FStar_Compiler_Util.for_some + (fun uu___3 -> + match uu___3 with + | FStar_Syntax_Syntax.Assumption -> true + | FStar_Syntax_Syntax.Projector uu___4 -> true + | FStar_Syntax_Syntax.Discriminator uu___4 -> true + | FStar_Syntax_Syntax.Irreducible -> true + | uu___4 -> false) quals in + Prims.op_Negation uu___2 in + if will_encode_definition + then ([], env) + else + (let fv = + FStar_Syntax_Syntax.lid_as_fv lid + FStar_Pervasives_Native.None in + let uu___3 = + let uu___4 = + FStar_Compiler_Util.for_some is_uninterpreted_by_smt + se.FStar_Syntax_Syntax.sigattrs in + encode_top_level_val uu___4 env fv t quals in + match uu___3 with + | (decls, env1) -> + let tname = FStar_Ident.string_of_lid lid in + let tsym = + let uu___4 = + FStar_SMTEncoding_Env.try_lookup_free_var env1 lid in + FStar_Compiler_Option.get uu___4 in + let uu___4 = + let uu___5 = + let uu___6 = + primitive_type_axioms + env1.FStar_SMTEncoding_Env.tcenv lid tname tsym in + FStar_SMTEncoding_Term.mk_decls_trivial uu___6 in + FStar_Compiler_List.op_At decls uu___5 in + (uu___4, env1)) + | FStar_Syntax_Syntax.Sig_assume + { FStar_Syntax_Syntax.lid3 = l; FStar_Syntax_Syntax.us3 = us; + FStar_Syntax_Syntax.phi1 = f;_} + -> + let uu___1 = FStar_Syntax_Subst.open_univ_vars us f in + (match uu___1 with + | (uvs, f1) -> + let env1 = + let uu___2 = + FStar_TypeChecker_Env.push_univ_vars + env.FStar_SMTEncoding_Env.tcenv uvs in + { + FStar_SMTEncoding_Env.bvar_bindings = + (env.FStar_SMTEncoding_Env.bvar_bindings); + FStar_SMTEncoding_Env.fvar_bindings = + (env.FStar_SMTEncoding_Env.fvar_bindings); + FStar_SMTEncoding_Env.depth = + (env.FStar_SMTEncoding_Env.depth); + FStar_SMTEncoding_Env.tcenv = uu___2; + FStar_SMTEncoding_Env.warn = + (env.FStar_SMTEncoding_Env.warn); + FStar_SMTEncoding_Env.nolabels = + (env.FStar_SMTEncoding_Env.nolabels); + FStar_SMTEncoding_Env.use_zfuel_name = + (env.FStar_SMTEncoding_Env.use_zfuel_name); + FStar_SMTEncoding_Env.encode_non_total_function_typ = + (env.FStar_SMTEncoding_Env.encode_non_total_function_typ); + FStar_SMTEncoding_Env.current_module_name = + (env.FStar_SMTEncoding_Env.current_module_name); + FStar_SMTEncoding_Env.encoding_quantifier = + (env.FStar_SMTEncoding_Env.encoding_quantifier); + FStar_SMTEncoding_Env.global_cache = + (env.FStar_SMTEncoding_Env.global_cache) + } in + let f2 = norm_before_encoding env1 f1 in + let uu___2 = + FStar_SMTEncoding_EncodeTerm.encode_formula f2 env1 in + (match uu___2 with + | (f3, decls) -> + let g = + let uu___3 = + let uu___4 = + let uu___5 = + let uu___6 = + let uu___7 = + let uu___8 = + FStar_Syntax_Print.lid_to_string l in + FStar_Compiler_Util.format1 "Assumption: %s" + uu___8 in + FStar_Pervasives_Native.Some uu___7 in + let uu___7 = + let uu___8 = + let uu___9 = FStar_Ident.string_of_lid l in + Prims.strcat "assumption_" uu___9 in + FStar_SMTEncoding_Env.varops.FStar_SMTEncoding_Env.mk_unique + uu___8 in + (f3, uu___6, uu___7) in + FStar_SMTEncoding_Util.mkAssume uu___5 in + [uu___4] in + FStar_SMTEncoding_Term.mk_decls_trivial uu___3 in + ((FStar_Compiler_List.op_At decls g), env1))) + | FStar_Syntax_Syntax.Sig_let + { FStar_Syntax_Syntax.lbs1 = lbs; + FStar_Syntax_Syntax.lids1 = uu___1;_} + when + (FStar_Compiler_List.contains FStar_Syntax_Syntax.Irreducible + se.FStar_Syntax_Syntax.sigquals) + || + (FStar_Compiler_Util.for_some is_opaque_to_smt + se.FStar_Syntax_Syntax.sigattrs) + -> + let attrs = se.FStar_Syntax_Syntax.sigattrs in + let uu___2 = + FStar_Compiler_Util.fold_map + (fun env1 -> + fun lb -> + let lid = + let uu___3 = + let uu___4 = + FStar_Compiler_Util.right + lb.FStar_Syntax_Syntax.lbname in + uu___4.FStar_Syntax_Syntax.fv_name in + uu___3.FStar_Syntax_Syntax.v in + let uu___3 = + let uu___4 = + FStar_TypeChecker_Env.try_lookup_val_decl + env1.FStar_SMTEncoding_Env.tcenv lid in + FStar_Compiler_Option.isNone uu___4 in + if uu___3 + then + let val_decl = + { + FStar_Syntax_Syntax.sigel = + (FStar_Syntax_Syntax.Sig_declare_typ + { + FStar_Syntax_Syntax.lid2 = lid; + FStar_Syntax_Syntax.us2 = + (lb.FStar_Syntax_Syntax.lbunivs); + FStar_Syntax_Syntax.t2 = + (lb.FStar_Syntax_Syntax.lbtyp) + }); + FStar_Syntax_Syntax.sigrng = + (se.FStar_Syntax_Syntax.sigrng); + FStar_Syntax_Syntax.sigquals = + (FStar_Syntax_Syntax.Irreducible :: + (se.FStar_Syntax_Syntax.sigquals)); + FStar_Syntax_Syntax.sigmeta = + (se.FStar_Syntax_Syntax.sigmeta); + FStar_Syntax_Syntax.sigattrs = + (se.FStar_Syntax_Syntax.sigattrs); + FStar_Syntax_Syntax.sigopens_and_abbrevs = + (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); + FStar_Syntax_Syntax.sigopts = + (se.FStar_Syntax_Syntax.sigopts) + } in + let uu___4 = encode_sigelt' env1 val_decl in + match uu___4 with | (decls, env2) -> (env2, decls) + else (env1, [])) env (FStar_Pervasives_Native.snd lbs) in + (match uu___2 with + | (env1, decls) -> ((FStar_Compiler_List.flatten decls), env1)) + | FStar_Syntax_Syntax.Sig_let + { + FStar_Syntax_Syntax.lbs1 = + (uu___1, + { FStar_Syntax_Syntax.lbname = FStar_Pervasives.Inr b2t; + FStar_Syntax_Syntax.lbunivs = uu___2; + FStar_Syntax_Syntax.lbtyp = uu___3; + FStar_Syntax_Syntax.lbeff = uu___4; + FStar_Syntax_Syntax.lbdef = uu___5; + FStar_Syntax_Syntax.lbattrs = uu___6; + FStar_Syntax_Syntax.lbpos = uu___7;_}::[]); + FStar_Syntax_Syntax.lids1 = uu___8;_} + when FStar_Syntax_Syntax.fv_eq_lid b2t FStar_Parser_Const.b2t_lid + -> + let uu___9 = + FStar_SMTEncoding_Env.new_term_constant_and_tok_from_lid env + (b2t.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v + Prims.int_one in + (match uu___9 with + | (tname, ttok, env1) -> + let xx = + FStar_SMTEncoding_Term.mk_fv + ("x", FStar_SMTEncoding_Term.Term_sort) in + let x = FStar_SMTEncoding_Util.mkFreeV xx in + let b2t_x = FStar_SMTEncoding_Util.mkApp ("Prims.b2t", [x]) in + let valid_b2t_x = + FStar_SMTEncoding_Util.mkApp ("Valid", [b2t_x]) in + let bool_ty = + let uu___10 = + FStar_Syntax_Syntax.withsort FStar_Parser_Const.bool_lid in + FStar_SMTEncoding_Env.lookup_free_var env1 uu___10 in + let decls = + let uu___10 = + let uu___11 = + let uu___12 = + let uu___13 = + let uu___14 = FStar_Syntax_Syntax.range_of_fv b2t in + let uu___15 = + let uu___16 = + let uu___17 = + let uu___18 = + FStar_SMTEncoding_Util.mkApp + ((FStar_Pervasives_Native.snd + FStar_SMTEncoding_Term.boxBoolFun), + [x]) in + (valid_b2t_x, uu___18) in + FStar_SMTEncoding_Util.mkEq uu___17 in + ([[b2t_x]], [xx], uu___16) in + FStar_SMTEncoding_Term.mkForall uu___14 uu___15 in + (uu___13, (FStar_Pervasives_Native.Some "b2t def"), + "b2t_def") in + FStar_SMTEncoding_Util.mkAssume uu___12 in + let uu___12 = + let uu___13 = + let uu___14 = + let uu___15 = + let uu___16 = FStar_Syntax_Syntax.range_of_fv b2t in + let uu___17 = + let uu___18 = + let uu___19 = + let uu___20 = + FStar_SMTEncoding_Term.mk_HasType x + bool_ty in + let uu___21 = + FStar_SMTEncoding_Term.mk_HasType b2t_x + FStar_SMTEncoding_Term.mk_Term_type in + (uu___20, uu___21) in + FStar_SMTEncoding_Util.mkImp uu___19 in + ([[b2t_x]], [xx], uu___18) in + FStar_SMTEncoding_Term.mkForall uu___16 uu___17 in + (uu___15, + (FStar_Pervasives_Native.Some "b2t typing"), + "b2t_typing") in + FStar_SMTEncoding_Util.mkAssume uu___14 in + [uu___13] in + uu___11 :: uu___12 in + (FStar_SMTEncoding_Term.DeclFun + (tname, [FStar_SMTEncoding_Term.Term_sort], + FStar_SMTEncoding_Term.Term_sort, + FStar_Pervasives_Native.None)) + :: uu___10 in + let uu___10 = FStar_SMTEncoding_Term.mk_decls_trivial decls in + (uu___10, env1)) + | FStar_Syntax_Syntax.Sig_let uu___1 when + FStar_Compiler_Util.for_some + (fun uu___2 -> + match uu___2 with + | FStar_Syntax_Syntax.Discriminator uu___3 -> true + | uu___3 -> false) se.FStar_Syntax_Syntax.sigquals + -> + ((let uu___3 = FStar_Compiler_Effect.op_Bang dbg_SMTEncoding in + if uu___3 + then + let uu___4 = FStar_Syntax_Print.sigelt_to_string_short se in + FStar_Compiler_Util.print1 "Not encoding discriminator '%s'\n" + uu___4 + else ()); + ([], env)) + | FStar_Syntax_Syntax.Sig_let + { FStar_Syntax_Syntax.lbs1 = uu___1; + FStar_Syntax_Syntax.lids1 = lids;_} + when + (FStar_Compiler_Util.for_some + (fun l -> + let uu___2 = + let uu___3 = + let uu___4 = FStar_Ident.ns_of_lid l in + FStar_Compiler_List.hd uu___4 in + FStar_Ident.string_of_id uu___3 in + uu___2 = "Prims") lids) + && + (FStar_Compiler_Util.for_some + (fun uu___2 -> + match uu___2 with + | FStar_Syntax_Syntax.Unfold_for_unification_and_vcgen -> + true + | uu___3 -> false) se.FStar_Syntax_Syntax.sigquals) + -> + ((let uu___3 = FStar_Compiler_Effect.op_Bang dbg_SMTEncoding in + if uu___3 + then + let uu___4 = FStar_Syntax_Print.sigelt_to_string_short se in + FStar_Compiler_Util.print1 + "Not encoding unfold let from Prims '%s'\n" uu___4 + else ()); + ([], env)) + | FStar_Syntax_Syntax.Sig_let + { FStar_Syntax_Syntax.lbs1 = (false, lb::[]); + FStar_Syntax_Syntax.lids1 = uu___1;_} + when + FStar_Compiler_Util.for_some + (fun uu___2 -> + match uu___2 with + | FStar_Syntax_Syntax.Projector uu___3 -> true + | uu___3 -> false) se.FStar_Syntax_Syntax.sigquals + -> + let fv = FStar_Compiler_Util.right lb.FStar_Syntax_Syntax.lbname in + let l = (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in + let uu___2 = FStar_SMTEncoding_Env.try_lookup_free_var env l in + (match uu___2 with + | FStar_Pervasives_Native.Some uu___3 -> ([], env) + | FStar_Pervasives_Native.None -> + let se1 = + let uu___3 = FStar_Ident.range_of_lid l in + { + FStar_Syntax_Syntax.sigel = + (FStar_Syntax_Syntax.Sig_declare_typ + { + FStar_Syntax_Syntax.lid2 = l; + FStar_Syntax_Syntax.us2 = + (lb.FStar_Syntax_Syntax.lbunivs); + FStar_Syntax_Syntax.t2 = + (lb.FStar_Syntax_Syntax.lbtyp) + }); + FStar_Syntax_Syntax.sigrng = uu___3; + FStar_Syntax_Syntax.sigquals = + (se.FStar_Syntax_Syntax.sigquals); + FStar_Syntax_Syntax.sigmeta = + (se.FStar_Syntax_Syntax.sigmeta); + FStar_Syntax_Syntax.sigattrs = + (se.FStar_Syntax_Syntax.sigattrs); + FStar_Syntax_Syntax.sigopens_and_abbrevs = + (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); + FStar_Syntax_Syntax.sigopts = + (se.FStar_Syntax_Syntax.sigopts) + } in + encode_sigelt env se1) + | FStar_Syntax_Syntax.Sig_let + { FStar_Syntax_Syntax.lbs1 = (is_rec, bindings); + FStar_Syntax_Syntax.lids1 = uu___1;_} + -> + let bindings1 = + FStar_Compiler_List.map + (fun lb -> + let def = + norm_before_encoding env lb.FStar_Syntax_Syntax.lbdef in + let typ = + norm_before_encoding env lb.FStar_Syntax_Syntax.lbtyp in + { + FStar_Syntax_Syntax.lbname = + (lb.FStar_Syntax_Syntax.lbname); + FStar_Syntax_Syntax.lbunivs = + (lb.FStar_Syntax_Syntax.lbunivs); + FStar_Syntax_Syntax.lbtyp = typ; + FStar_Syntax_Syntax.lbeff = + (lb.FStar_Syntax_Syntax.lbeff); + FStar_Syntax_Syntax.lbdef = def; + FStar_Syntax_Syntax.lbattrs = + (lb.FStar_Syntax_Syntax.lbattrs); + FStar_Syntax_Syntax.lbpos = + (lb.FStar_Syntax_Syntax.lbpos) + }) bindings in + encode_top_level_let env (is_rec, bindings1) + se.FStar_Syntax_Syntax.sigquals + | FStar_Syntax_Syntax.Sig_bundle + { FStar_Syntax_Syntax.ses = ses; + FStar_Syntax_Syntax.lids = uu___1;_} + -> + let uu___2 = + FStar_Compiler_List.fold_left + (fun uu___3 -> + fun se1 -> + match uu___3 with + | (g, env1) -> + let uu___4 = + match se1.FStar_Syntax_Syntax.sigel with + | FStar_Syntax_Syntax.Sig_inductive_typ uu___5 -> + encode_sig_inductive env1 se1 + | FStar_Syntax_Syntax.Sig_datacon uu___5 -> + encode_datacon env1 se1 + | uu___5 -> encode_sigelt env1 se1 in + (match uu___4 with + | (g', env2) -> + ((FStar_Compiler_List.op_At g g'), env2))) + ([], env) ses in + (match uu___2 with + | (g, env1) -> + let uu___3 = + FStar_Compiler_List.fold_left + (fun uu___4 -> + fun elt -> + match uu___4 with + | (g', inversions) -> + let uu___5 = + FStar_Compiler_List.partition + (fun uu___6 -> + match uu___6 with + | FStar_SMTEncoding_Term.Assume + { + FStar_SMTEncoding_Term.assumption_term + = uu___7; + FStar_SMTEncoding_Term.assumption_caption + = FStar_Pervasives_Native.Some + "inversion axiom"; + FStar_SMTEncoding_Term.assumption_name + = uu___8; + FStar_SMTEncoding_Term.assumption_fact_ids + = uu___9;_} + -> false + | uu___7 -> true) + elt.FStar_SMTEncoding_Term.decls in + (match uu___5 with + | (elt_g', elt_inversions) -> + ((FStar_Compiler_List.op_At g' + [{ + FStar_SMTEncoding_Term.sym_name = + (elt.FStar_SMTEncoding_Term.sym_name); + FStar_SMTEncoding_Term.key = + (elt.FStar_SMTEncoding_Term.key); + FStar_SMTEncoding_Term.decls = + elt_g'; + FStar_SMTEncoding_Term.a_names = + (elt.FStar_SMTEncoding_Term.a_names) + }]), + (FStar_Compiler_List.op_At inversions + elt_inversions)))) ([], []) g in + (match uu___3 with + | (g', inversions) -> + let uu___4 = + FStar_Compiler_List.fold_left + (fun uu___5 -> + fun elt -> + match uu___5 with + | (decls, elts, rest) -> + let uu___6 = + (FStar_Compiler_Util.is_some + elt.FStar_SMTEncoding_Term.key) + && + (FStar_Compiler_List.existsb + (fun uu___7 -> + match uu___7 with + | FStar_SMTEncoding_Term.DeclFun + uu___8 -> true + | uu___8 -> false) + elt.FStar_SMTEncoding_Term.decls) in + if uu___6 + then + (decls, + (FStar_Compiler_List.op_At elts [elt]), + rest) + else + (let uu___8 = + FStar_Compiler_List.partition + (fun uu___9 -> + match uu___9 with + | FStar_SMTEncoding_Term.DeclFun + uu___10 -> true + | uu___10 -> false) + elt.FStar_SMTEncoding_Term.decls in + match uu___8 with + | (elt_decls, elt_rest) -> + ((FStar_Compiler_List.op_At decls + elt_decls), elts, + (FStar_Compiler_List.op_At rest + [{ + FStar_SMTEncoding_Term.sym_name + = + (elt.FStar_SMTEncoding_Term.sym_name); + FStar_SMTEncoding_Term.key = + (elt.FStar_SMTEncoding_Term.key); + FStar_SMTEncoding_Term.decls + = elt_rest; + FStar_SMTEncoding_Term.a_names + = + (elt.FStar_SMTEncoding_Term.a_names) + }])))) ([], [], []) g' in + (match uu___4 with + | (decls, elts, rest) -> + let uu___5 = + let uu___6 = + FStar_SMTEncoding_Term.mk_decls_trivial decls in + let uu___7 = + let uu___8 = + let uu___9 = + FStar_SMTEncoding_Term.mk_decls_trivial + inversions in + FStar_Compiler_List.op_At rest uu___9 in + FStar_Compiler_List.op_At elts uu___8 in + FStar_Compiler_List.op_At uu___6 uu___7 in + (uu___5, env1))))) let (encode_env_bindings : FStar_SMTEncoding_Env.env_t -> FStar_Syntax_Syntax.binding Prims.list -> @@ -7049,10 +6897,7 @@ let (encode_env_bindings : | FStar_Syntax_Syntax.Binding_var x -> let t1 = norm_before_encoding env1 x.FStar_Syntax_Syntax.sort in - ((let uu___2 = - FStar_TypeChecker_Env.debug - env1.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg_SMTEncoding in if uu___2 then let uu___3 = FStar_Syntax_Print.bv_to_string x in @@ -7413,7 +7258,7 @@ let (encode_sig : FStar_SMTEncoding_Term.Caption uu___2 in uu___1 :: decls else decls in - (let uu___1 = FStar_TypeChecker_Env.debug tcenv FStar_Options.Medium in + (let uu___1 = FStar_Compiler_Debug.medium () in if uu___1 then let uu___2 = FStar_Syntax_Print.sigelt_to_string se in @@ -7504,8 +7349,7 @@ let (encode_modul : (if modul.FStar_Syntax_Syntax.is_interface then "interface" else "module") uu___4 in - (let uu___5 = - FStar_TypeChecker_Env.debug tcenv1 FStar_Options.Medium in + (let uu___5 = FStar_Compiler_Debug.medium () in if uu___5 then FStar_Compiler_Util.print2 @@ -7557,9 +7401,7 @@ let (encode_modul : match uu___5 with | (decls, env1) -> (give_decls_to_z3_and_set_env env1 name decls; - (let uu___8 = - FStar_TypeChecker_Env.debug tcenv1 - FStar_Options.Medium in + (let uu___8 = FStar_Compiler_Debug.medium () in if uu___8 then FStar_Compiler_Util.print1 @@ -7592,8 +7434,7 @@ let (encode_modul_from_cache : (if tcmod.FStar_Syntax_Syntax.is_interface then "interface" else "module") uu___3 in - (let uu___4 = - FStar_TypeChecker_Env.debug tcenv1 FStar_Options.Medium in + (let uu___4 = FStar_Compiler_Debug.medium () in if uu___4 then FStar_Compiler_Util.print2 @@ -7611,8 +7452,7 @@ let (encode_modul_from_cache : FStar_SMTEncoding_Env.add_fvar_binding_to_env fvb env2) env (FStar_Compiler_List.rev fvbs) in give_decls_to_z3_and_set_env env1 name decls; - (let uu___5 = - FStar_TypeChecker_Env.debug tcenv1 FStar_Options.Medium in + (let uu___5 = FStar_Compiler_Debug.medium () in if uu___5 then FStar_Compiler_Util.print1 @@ -7694,14 +7534,9 @@ let (encode_query : (match uu___3 with | (env_decls, env1) -> ((let uu___5 = - ((FStar_TypeChecker_Env.debug tcenv - FStar_Options.Medium) - || - (FStar_TypeChecker_Env.debug tcenv - (FStar_Options.Other "SMTEncoding"))) - || - (FStar_TypeChecker_Env.debug tcenv - (FStar_Options.Other "SMTQuery")) in + ((FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang dbg_SMTEncoding)) + || (FStar_Compiler_Effect.op_Bang dbg_SMTQuery) in if uu___5 then let uu___6 = FStar_Syntax_Print.term_to_string q1 in @@ -7802,40 +7637,26 @@ let (encode_query : FStar_SMTEncoding_Term.Echo "Done!"]) in ((let uu___9 = - ((FStar_TypeChecker_Env.debug - tcenv FStar_Options.Medium) + ((FStar_Compiler_Debug.medium ()) || - (FStar_TypeChecker_Env.debug - tcenv - (FStar_Options.Other - "SMTEncoding"))) + (FStar_Compiler_Effect.op_Bang + dbg_SMTEncoding)) || - (FStar_TypeChecker_Env.debug - tcenv - (FStar_Options.Other - "SMTQuery")) in + (FStar_Compiler_Effect.op_Bang + dbg_SMTQuery) in if uu___9 then FStar_Compiler_Util.print_string "} Done encoding\n" else ()); (let uu___10 = - (((FStar_TypeChecker_Env.debug - tcenv FStar_Options.Medium) - || - (FStar_TypeChecker_Env.debug - tcenv - (FStar_Options.Other - "SMTEncoding"))) + ((FStar_Compiler_Debug.medium ()) || - (FStar_TypeChecker_Env.debug - tcenv - (FStar_Options.Other - "SMTQuery"))) + (FStar_Compiler_Effect.op_Bang + dbg_SMTEncoding)) || - (FStar_TypeChecker_Env.debug - tcenv - (FStar_Options.Other "Time")) in + (FStar_Compiler_Effect.op_Bang + dbg_Time) in if uu___10 then FStar_Compiler_Util.print1 diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml index ec50ccf9f2f..309139e16a9 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_EncodeTerm.ml @@ -1,4 +1,10 @@ open Prims +let (dbg_PartialApp : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "PartialApp" +let (dbg_SMTEncoding : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "SMTEncoding" +let (dbg_SMTEncodingReify : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "SMTEncodingReify" let mkForall_fuel' : 'uuuuu . Prims.string -> @@ -385,10 +391,17 @@ let check_pattern_vars : let pat_vars = let uu___ = FStar_Syntax_Free.names hd in FStar_Compiler_List.fold_left - (fun out -> - fun x -> - let uu___1 = FStar_Syntax_Free.names x in - FStar_Compiler_Set.union FStar_Syntax_Syntax.ord_bv out + (fun uu___2 -> + fun uu___1 -> + (fun out -> + fun x -> + let uu___1 = FStar_Syntax_Free.names x in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic out) (Obj.magic uu___1))) uu___2 uu___1) uu___ tl in let uu___ = FStar_Compiler_Util.find_opt @@ -399,8 +412,11 @@ let check_pattern_vars : FStar_Syntax_Syntax.binder_positivity = uu___3; FStar_Syntax_Syntax.binder_attrs = uu___4;_} -> let uu___5 = - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_bv b - pat_vars in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) b + (Obj.magic pat_vars) in Prims.op_Negation uu___5) vars in (match uu___ with | FStar_Pervasives_Native.None -> () @@ -718,9 +734,7 @@ and (encode_binders : fun fuel_opt -> fun bs -> fun env -> - (let uu___1 = - FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv - FStar_Options.Medium in + (let uu___1 = FStar_Compiler_Debug.medium () in if uu___1 then let uu___2 = FStar_Syntax_Print.binders_to_string ", " bs in @@ -1264,9 +1278,7 @@ and (encode_term : env.FStar_SMTEncoding_Env.tcenv t; (let t1 = FStar_Syntax_Subst.compress t in let t0 = t1 in - (let uu___2 = - FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_SMTEncoding in if uu___2 then let uu___3 = FStar_Syntax_Print.tag_of_term t1 in @@ -1296,9 +1308,7 @@ and (encode_term : FStar_Compiler_Effect.failwith uu___2 | FStar_Syntax_Syntax.Tm_lazy i -> let e = FStar_Syntax_Util.unfold_lazy i in - ((let uu___3 = - FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in + ((let uu___3 = FStar_Compiler_Effect.op_Bang dbg_SMTEncoding in if uu___3 then let uu___4 = FStar_Syntax_Print.term_to_string t1 in @@ -1333,9 +1343,7 @@ and (encode_term : FStar_Reflection_V2_Embeddings.e_term_view uu___4 in uu___3 t1.FStar_Syntax_Syntax.pos FStar_Pervasives_Native.None FStar_Syntax_Embeddings_Base.id_norm_cb in - ((let uu___4 = - FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in + ((let uu___4 = FStar_Compiler_Effect.op_Bang dbg_SMTEncoding in if uu___4 then let uu___5 = FStar_Syntax_Print.term_to_string t0 in @@ -1854,8 +1862,11 @@ and (encode_term : let uu___5 = let fvs = let uu___6 = FStar_Syntax_Free.names t0 in - FStar_Compiler_Set.elems FStar_Syntax_Syntax.ord_bv - uu___6 in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic uu___6) in let getfreeV t2 = match t2.FStar_SMTEncoding_Term.tm with | FStar_SMTEncoding_Term.FreeV fv -> fv @@ -2051,9 +2062,8 @@ and (encode_term : FStar_SMTEncoding_Term.hash_of_term tkey in ((let uu___9 = - FStar_TypeChecker_Env.debug - env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in + FStar_Compiler_Effect.op_Bang + dbg_SMTEncoding in if uu___9 then let uu___10 = @@ -2359,10 +2369,8 @@ and (encode_term : env.FStar_SMTEncoding_Env.tcenv [] uu___8 in ((let uu___9 = - FStar_TypeChecker_Env.debug - env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other - "SMTEncodingReify") in + FStar_Compiler_Effect.op_Bang + dbg_SMTEncodingReify in if uu___9 then let uu___10 = @@ -2571,10 +2579,8 @@ and (encode_term : (match uu___8 with | (head_type2, formals, c) -> ((let uu___10 = - FStar_TypeChecker_Env.debug - env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other - "PartialApp") in + FStar_Compiler_Effect.op_Bang + dbg_PartialApp in if uu___10 then let uu___11 = @@ -2650,8 +2656,11 @@ and (encode_term : let uu___4 = let fvs = let uu___5 = FStar_Syntax_Free.names t0 in - FStar_Compiler_Set.elems FStar_Syntax_Syntax.ord_bv - uu___5 in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic uu___5) in let tms = FStar_Compiler_List.map (FStar_SMTEncoding_Env.lookup_term_var env) fvs in @@ -2721,13 +2730,24 @@ and (encode_term : | FStar_Pervasives_Native.None -> ((let uu___4 = let uu___5 = - let uu___6 = FStar_Syntax_Print.term_to_string t0 in - FStar_Compiler_Util.format1 - "Losing precision when encoding a function literal: %s\n(Unnannotated abstraction in the compiler ?)" - uu___6 in + let uu___6 = + let uu___7 = + FStar_Errors_Msg.text + "Losing precision when encoding a function literal:" in + let uu___8 = + FStar_Class_PP.pp + FStar_Syntax_Print.pretty_term t0 in + FStar_Pprint.prefix (Prims.of_int (2)) + Prims.int_one uu___7 uu___8 in + let uu___7 = + let uu___8 = + FStar_Errors_Msg.text + "Unannotated abstraction in the compiler?" in + [uu___8] in + uu___6 :: uu___7 in (FStar_Errors_Codes.Warning_FunctionLiteralPrecisionLoss, uu___5) in - FStar_Errors.log_issue t0.FStar_Syntax_Syntax.pos + FStar_Errors.log_issue_doc t0.FStar_Syntax_Syntax.pos uu___4); fallback ()) | FStar_Pervasives_Native.Some rc -> @@ -2824,10 +2844,8 @@ and (encode_term : FStar_SMTEncoding_Term.hash_of_term tkey in ((let uu___11 = - FStar_TypeChecker_Env.debug - env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other - "PartialApp") in + FStar_Compiler_Effect.op_Bang + dbg_PartialApp in if uu___11 then let uu___12 = @@ -3183,9 +3201,7 @@ and (encode_pat : = fun env -> fun pat -> - (let uu___1 = - FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv - FStar_Options.Medium in + (let uu___1 = FStar_Compiler_Debug.medium () in if uu___1 then let uu___2 = FStar_Syntax_Print.pat_to_string pat in @@ -3417,9 +3433,7 @@ and (encode_formula : fun phi -> fun env -> let debug phi1 = - let uu___ = - FStar_TypeChecker_Env.debug env.FStar_SMTEncoding_Env.tcenv - (FStar_Options.Other "SMTEncoding") in + let uu___ = FStar_Compiler_Effect.op_Bang dbg_SMTEncoding in if uu___ then let uu___1 = FStar_Syntax_Print.tag_of_term phi1 in @@ -3679,27 +3693,38 @@ and (encode_formula : | (FStar_Pervasives_Native.Some r1, FStar_Pervasives_Native.Some s) -> let phi3 = - FStar_Syntax_Syntax.mk - (FStar_Syntax_Syntax.Tm_meta - { - FStar_Syntax_Syntax.tm2 = phi2; - FStar_Syntax_Syntax.meta = - (FStar_Syntax_Syntax.Meta_labeled - (s, r1, false)) - }) r1 in + let uu___4 = + let uu___5 = + let uu___6 = + let uu___7 = + let uu___8 = FStar_Errors_Msg.mkmsg s in + (uu___8, r1, false) in + FStar_Syntax_Syntax.Meta_labeled uu___7 in + { + FStar_Syntax_Syntax.tm2 = phi2; + FStar_Syntax_Syntax.meta = uu___6 + } in + FStar_Syntax_Syntax.Tm_meta uu___5 in + FStar_Syntax_Syntax.mk uu___4 r1 in fallback phi3 | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.Some s) -> let phi3 = - FStar_Syntax_Syntax.mk - (FStar_Syntax_Syntax.Tm_meta - { - FStar_Syntax_Syntax.tm2 = phi2; - FStar_Syntax_Syntax.meta = - (FStar_Syntax_Syntax.Meta_labeled - (s, (phi2.FStar_Syntax_Syntax.pos), - false)) - }) phi2.FStar_Syntax_Syntax.pos in + let uu___4 = + let uu___5 = + let uu___6 = + let uu___7 = + let uu___8 = FStar_Errors_Msg.mkmsg s in + (uu___8, (phi2.FStar_Syntax_Syntax.pos), + false) in + FStar_Syntax_Syntax.Meta_labeled uu___7 in + { + FStar_Syntax_Syntax.tm2 = phi2; + FStar_Syntax_Syntax.meta = uu___6 + } in + FStar_Syntax_Syntax.Tm_meta uu___5 in + FStar_Syntax_Syntax.mk uu___4 + phi2.FStar_Syntax_Syntax.pos in fallback phi3 | uu___4 -> fallback phi2) | (FStar_Syntax_Syntax.Tm_fvar fv, (t, uu___)::[]) when diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Env.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Env.ml index 9ec8b772ce6..8be688d87b5 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Env.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Env.ml @@ -1,4 +1,6 @@ open Prims +let (dbg_PartialApp : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "PartialApp" exception Inner_let_rec of (Prims.string * FStar_Compiler_Range_Type.range) Prims.list let (uu___is_Inner_let_rec : Prims.exn -> Prims.bool) = @@ -922,9 +924,7 @@ let (try_lookup_free_var : match uu___ with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some fvb -> - ((let uu___2 = - FStar_TypeChecker_Env.debug env.tcenv - (FStar_Options.Other "PartialApp") in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg_PartialApp in if uu___2 then let uu___3 = FStar_Ident.string_of_lid l in diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_ErrorReporting.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_ErrorReporting.ml index 9d52f5c3985..232b6a12447 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_ErrorReporting.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_ErrorReporting.ml @@ -11,7 +11,7 @@ let (__proj__Not_a_wp_implication__item__uu___ : Prims.exn -> Prims.string) = fun projectee -> match projectee with | Not_a_wp_implication uu___ -> uu___ let (sort_labels : (FStar_SMTEncoding_Term.error_label * Prims.bool) Prims.list -> - ((FStar_SMTEncoding_Term.fv * Prims.string * + ((FStar_SMTEncoding_Term.fv * FStar_Errors_Msg.error_message * FStar_Compiler_Range_Type.range) * Prims.bool) Prims.list) = fun l -> @@ -23,7 +23,7 @@ let (sort_labels : -> FStar_Compiler_Range_Ops.compare r1 r2) l let (remove_dups : labels -> - (FStar_SMTEncoding_Term.fv * Prims.string * + (FStar_SMTEncoding_Term.fv * FStar_Errors_Msg.error_message * FStar_Compiler_Range_Type.range) Prims.list) = fun l -> @@ -40,7 +40,7 @@ type ranges = let (__ctr : Prims.int FStar_Compiler_Effect.ref) = FStar_Compiler_Util.mk_ref Prims.int_zero let (fresh_label : - Prims.string -> + FStar_Errors_Msg.error_message -> FStar_Compiler_Range_Type.range -> FStar_SMTEncoding_Term.term -> (label * FStar_SMTEncoding_Term.term)) = @@ -104,17 +104,23 @@ let (label_goals : FStar_Compiler_Util.for_some is_guard_free (conjuncts lhs) in let uu___ = match use_env_msg with - | FStar_Pervasives_Native.None -> (false, "") + | FStar_Pervasives_Native.None -> (false, FStar_Pprint.empty) | FStar_Pervasives_Native.Some f -> - let uu___1 = f () in (true, uu___1) in + let uu___1 = + let uu___2 = f () in FStar_Pprint.doc_of_string uu___2 in + (true, uu___1) in match uu___ with | (flag, msg_prefix) -> let fresh_label1 msg1 ropt rng t = let msg2 = if flag then - Prims.strcat "Failed to verify implicit argument: " - (Prims.strcat msg_prefix (Prims.strcat " :: " msg1)) + let uu___1 = + let uu___2 = + FStar_Errors_Msg.text + "Failed to verify implicit argument: " in + FStar_Pprint.op_Hat_Hat uu___2 msg_prefix in + uu___1 :: msg1 else msg1 in let rng1 = match ropt with @@ -138,8 +144,9 @@ let (label_goals : | FStar_SMTEncoding_Term.Real uu___1 -> (labels1, q1) | FStar_SMTEncoding_Term.LblPos uu___1 -> FStar_Compiler_Effect.failwith "Impossible" - | FStar_SMTEncoding_Term.Labeled - (arg, "Could not prove post-condition", label_range) -> + | FStar_SMTEncoding_Term.Labeled (arg, d::[], label_range) when + let uu___1 = FStar_Errors_Msg.renderdoc d in + uu___1 = "Could not prove post-condition" -> let fallback debug_msg = aux default_msg (FStar_Pervasives_Native.Some label_range) @@ -233,8 +240,10 @@ let (label_goals : if uu___7 then let uu___8 = - aux - "Could not prove post-condition" + let uu___9 = + FStar_Errors_Msg.mkmsg + "Could not prove post-condition" in + aux uu___9 FStar_Pervasives_Native.None (FStar_Pervasives_Native.Some post_name) @@ -744,8 +753,9 @@ let (label_goals : q1.FStar_SMTEncoding_Term.rng in (labels2, uu___2)) in (FStar_Compiler_Effect.op_Colon_Equals __ctr Prims.int_zero; - aux "Assertion failed" FStar_Pervasives_Native.None - FStar_Pervasives_Native.None [] q) + (let uu___2 = FStar_Errors_Msg.mkmsg "Assertion failed" in + aux uu___2 FStar_Pervasives_Native.None + FStar_Pervasives_Native.None [] q)) let (detail_errors : Prims.bool -> FStar_TypeChecker_Env.env -> @@ -785,21 +795,32 @@ let (detail_errors : else if hint_replay then - FStar_Errors.log_issue r - (FStar_Errors_Codes.Warning_HintFailedToReplayProof, - (Prims.strcat - "Hint failed to replay this sub-proof: " msg1)) + (let uu___3 = + let uu___4 = + let uu___5 = + FStar_Errors_Msg.text + "Hint failed to replay this sub-proof" in + uu___5 :: msg1 in + (FStar_Errors_Codes.Warning_HintFailedToReplayProof, + uu___4) in + FStar_Errors.log_issue_doc r uu___3) else (let uu___4 = let uu___5 = let uu___6 = - FStar_Compiler_Range_Ops.string_of_range r in - FStar_Compiler_Util.format2 - "XX: proof obligation at %s failed\n\t%s\n" uu___6 - msg1 in + let uu___7 = + let uu___8 = + let uu___9 = + FStar_Class_Show.show + FStar_Compiler_Range_Ops.showable_range r in + FStar_Compiler_Util.format1 + "XX: proof obligation at %s failed." uu___9 in + FStar_Errors_Msg.text uu___8 in + [uu___7] in + FStar_Compiler_List.op_At uu___6 msg1 in (FStar_Errors_Codes.Error_ProofObligationFailed, uu___5) in - FStar_Errors.log_issue r uu___4) in + FStar_Errors.log_issue_doc r uu___4) in let elim labs = FStar_Compiler_List.map (fun uu___ -> diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Solver.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Solver.ml index 3c94ee482b1..42de7061bc1 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Solver.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Solver.ml @@ -3,6 +3,8 @@ exception SplitQueryAndRetry let (uu___is_SplitQueryAndRetry : Prims.exn -> Prims.bool) = fun projectee -> match projectee with | SplitQueryAndRetry -> true | uu___ -> false +let (dbg_SMTFail : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "SMTFail" let (z3_replay_result : (unit * unit)) = ((), ()) let z3_result_as_replay_result : 'uuuuu 'uuuuu1 'uuuuu2 . @@ -631,10 +633,9 @@ let (query_errors : (fun uu___3 -> match uu___3 with | (uu___4, x, y) -> - let uu___5 = FStar_Errors_Msg.mkmsg x in - let uu___6 = FStar_Errors.get_ctx () in - (FStar_Errors_Codes.Error_Z3SolverError, uu___5, - y, uu___6)) error_labels in + let uu___5 = FStar_Errors.get_ctx () in + (FStar_Errors_Codes.Error_Z3SolverError, x, y, + uu___5)) error_labels in { error_reason = msg; error_fuel = (settings.query_fuel); @@ -821,9 +822,8 @@ let (errors_to_report : | (FStar_Pervasives_Native.None, (uu___1, msg, rng)::[]) -> let uu___2 = let uu___3 = - let uu___4 = FStar_Errors_Msg.mkmsg msg in - let uu___5 = FStar_Errors.get_ctx () in - (FStar_Errors_Codes.Error_Z3SolverError, uu___4, rng, uu___5) in + let uu___4 = FStar_Errors.get_ctx () in + (FStar_Errors_Codes.Error_Z3SolverError, msg, rng, uu___4) in [uu___3] in FStar_TypeChecker_Err.errors_smt_detail settings.query_env uu___2 recovery_failed_msg @@ -840,10 +840,14 @@ let (errors_to_report : ("", FStar_SMTEncoding_Term.dummy_sort) in let msg = let uu___3 = - FStar_Syntax_Print.term_to_string settings.query_term in - FStar_Compiler_Util.format1 - "Failed to prove the following goal, although it appears to be trivial: %s" - uu___3 in + let uu___4 = + FStar_Errors_Msg.text + "Failed to prove the following goal, although it appears to be trivial:" in + let uu___5 = + FStar_Class_PP.pp FStar_Syntax_Print.pretty_term + settings.query_term in + FStar_Pprint.op_Hat_Slash_Hat uu___4 uu___5 in + [uu___3] in let range = FStar_TypeChecker_Env.get_range settings.query_env in [(dummy_fv, msg, range)] @@ -870,10 +874,9 @@ let (errors_to_report : | (uu___4, msg, rng) -> let uu___5 = let uu___6 = - let uu___7 = FStar_Errors_Msg.mkmsg msg in - let uu___8 = FStar_Errors.get_ctx () in - (FStar_Errors_Codes.Error_Z3SolverError, uu___7, - rng, uu___8) in + let uu___7 = FStar_Errors.get_ctx () in + (FStar_Errors_Codes.Error_Z3SolverError, msg, + rng, uu___7) in [uu___6] in FStar_TypeChecker_Err.errors_smt_detail settings.query_env uu___5 recovery_failed_msg) @@ -1065,7 +1068,7 @@ let (query_info : query_settings -> FStar_SMTEncoding_Z3.z3result -> unit) = let uu___3 = let uu___4 = FStar_Class_Show.show - FStar_Compiler_Range_Ops.show_range + FStar_Compiler_Range_Ops.showable_range settings.query_range in Prims.strcat uu___4 (Prims.strcat at_log_file ")") in Prims.strcat "(" uu___3 in @@ -1140,13 +1143,17 @@ let (query_info : query_settings -> FStar_SMTEncoding_Z3.z3result -> unit) = (fun uu___5 -> match uu___5 with | (uu___6, msg, range1) -> - let tag1 = + let msg1 = if used_hint settings - then "(Hint-replay failed): " - else "" in - FStar_Errors.log_issue range1 + then + let uu___7 = + FStar_Pprint.doc_of_string + "Hint-replay failed" in + uu___7 :: msg + else msg in + FStar_Errors.log_issue_doc range1 (FStar_Errors_Codes.Warning_HitReplayFailed, - (Prims.strcat tag1 msg))) errs)) + msg1)) errs)) else () let (store_hint : FStar_Compiler_Hints.hint -> unit) = fun hint -> @@ -1661,7 +1668,7 @@ let (ask_solver_quake : query_settings Prims.list -> answer) = ((let uu___5 = (quaking_or_retrying && ((FStar_Options.interactive ()) || - (FStar_Options.debug_any ()))) + (FStar_Compiler_Debug.any ()))) && (n > Prims.int_zero) in if uu___5 then @@ -1877,36 +1884,49 @@ let (maybe_save_failing_query : fun env -> fun prefix -> fun qs -> - let uu___ = FStar_Options.log_failing_queries () in - if uu___ - then - let mod1 = - let uu___1 = FStar_TypeChecker_Env.current_module env in - FStar_Class_Show.show FStar_Ident.showable_lident uu___1 in - let n = - (let uu___2 = - let uu___3 = FStar_Compiler_Effect.op_Bang failing_query_ctr in - uu___3 + Prims.int_one in - FStar_Compiler_Effect.op_Colon_Equals failing_query_ctr uu___2); - FStar_Compiler_Effect.op_Bang failing_query_ctr in - let file_name = - let uu___1 = - FStar_Class_Show.show - (FStar_Class_Show.printableshow - FStar_Class_Printable.printable_int) n in - FStar_Compiler_Util.format2 "failedQueries-%s-%s.smt2" mod1 - uu___1 in - let query_str = - let uu___1 = with_fuel_and_diagnostics qs [] in - let uu___2 = - let uu___3 = FStar_Compiler_Util.string_of_int qs.query_index in - FStar_Compiler_Util.format2 "(%s, %s)" qs.query_name uu___3 in - FStar_SMTEncoding_Z3.ask_text qs.query_range - (filter_assertions qs.query_env FStar_Pervasives_Native.None - qs.query_hint) qs.query_hash qs.query_all_labels uu___1 - uu___2 in - FStar_Compiler_Util.write_file file_name query_str - else () + (let uu___1 = FStar_Options.log_failing_queries () in + if uu___1 + then + let mod1 = + let uu___2 = FStar_TypeChecker_Env.current_module env in + FStar_Class_Show.show FStar_Ident.showable_lident uu___2 in + let n = + (let uu___3 = + let uu___4 = FStar_Compiler_Effect.op_Bang failing_query_ctr in + uu___4 + Prims.int_one in + FStar_Compiler_Effect.op_Colon_Equals failing_query_ctr uu___3); + FStar_Compiler_Effect.op_Bang failing_query_ctr in + let file_name = + let uu___2 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) n in + FStar_Compiler_Util.format2 "failedQueries-%s-%s.smt2" mod1 + uu___2 in + let query_str = + let uu___2 = with_fuel_and_diagnostics qs [] in + let uu___3 = + let uu___4 = FStar_Compiler_Util.string_of_int qs.query_index in + FStar_Compiler_Util.format2 "(%s, %s)" qs.query_name uu___4 in + FStar_SMTEncoding_Z3.ask_text qs.query_range + (filter_assertions qs.query_env FStar_Pervasives_Native.None + qs.query_hint) qs.query_hash qs.query_all_labels uu___2 + uu___3 in + FStar_Compiler_Util.write_file file_name query_str + else ()); + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_SMTFail in + if uu___2 + then + let uu___3 = + let uu___4 = FStar_Errors_Msg.text "This query failed:" in + let uu___5 = + let uu___6 = + FStar_Class_PP.pp FStar_Syntax_Print.pretty_term + qs.query_term in + [uu___6] in + uu___4 :: uu___5 in + FStar_Errors.diag_doc qs.query_range uu___3 + else ()) let (ask_solver : Prims.bool -> Prims.bool -> @@ -2228,7 +2248,7 @@ let (encode_and_ask : (let uu___7 = FStar_Options.split_queries () in uu___7 = FStar_Options.Always)) - && (FStar_Options.debug_any ()) in + && (FStar_Compiler_Debug.any ()) in if uu___6 then let n = FStar_Compiler_List.length labels in diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Term.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Term.ml index 99e85a2c75b..89925a4e440 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Term.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Term.ml @@ -166,7 +166,8 @@ type term' = | Quant of (qop * term Prims.list Prims.list * Prims.int FStar_Pervasives_Native.option * sort Prims.list * term) | Let of (term Prims.list * term) - | Labeled of (term * Prims.string * FStar_Compiler_Range_Type.range) + | Labeled of (term * FStar_Errors_Msg.error_message * + FStar_Compiler_Range_Type.range) | LblPos of (term * Prims.string) and term = { @@ -213,8 +214,9 @@ let (__proj__Let__item___0 : term' -> (term Prims.list * term)) = let (uu___is_Labeled : term' -> Prims.bool) = fun projectee -> match projectee with | Labeled _0 -> true | uu___ -> false let (__proj__Labeled__item___0 : - term' -> (term * Prims.string * FStar_Compiler_Range_Type.range)) = - fun projectee -> match projectee with | Labeled _0 -> _0 + term' -> + (term * FStar_Errors_Msg.error_message * FStar_Compiler_Range_Type.range)) + = fun projectee -> match projectee with | Labeled _0 -> _0 let (uu___is_LblPos : term' -> Prims.bool) = fun projectee -> match projectee with | LblPos _0 -> true | uu___ -> false let (__proj__LblPos__item___0 : term' -> (term * Prims.string)) = @@ -258,27 +260,37 @@ type constructor_t = constr_name: Prims.string ; constr_fields: constructor_field Prims.list ; constr_sort: sort ; - constr_id: Prims.int FStar_Pervasives_Native.option } + constr_id: Prims.int FStar_Pervasives_Native.option ; + constr_base: Prims.bool } let (__proj__Mkconstructor_t__item__constr_name : constructor_t -> Prims.string) = fun projectee -> match projectee with - | { constr_name; constr_fields; constr_sort; constr_id;_} -> constr_name + | { constr_name; constr_fields; constr_sort; constr_id; constr_base;_} -> + constr_name let (__proj__Mkconstructor_t__item__constr_fields : constructor_t -> constructor_field Prims.list) = fun projectee -> match projectee with - | { constr_name; constr_fields; constr_sort; constr_id;_} -> + | { constr_name; constr_fields; constr_sort; constr_id; constr_base;_} -> constr_fields let (__proj__Mkconstructor_t__item__constr_sort : constructor_t -> sort) = fun projectee -> match projectee with - | { constr_name; constr_fields; constr_sort; constr_id;_} -> constr_sort + | { constr_name; constr_fields; constr_sort; constr_id; constr_base;_} -> + constr_sort let (__proj__Mkconstructor_t__item__constr_id : constructor_t -> Prims.int FStar_Pervasives_Native.option) = fun projectee -> match projectee with - | { constr_name; constr_fields; constr_sort; constr_id;_} -> constr_id + | { constr_name; constr_fields; constr_sort; constr_id; constr_base;_} -> + constr_id +let (__proj__Mkconstructor_t__item__constr_base : + constructor_t -> Prims.bool) = + fun projectee -> + match projectee with + | { constr_name; constr_fields; constr_sort; constr_id; constr_base;_} -> + constr_base type constructors = constructor_t Prims.list type fact_db_id = | Name of FStar_Ident.lid @@ -523,7 +535,8 @@ let (fv_sort : fv -> sort) = let (fv_force : fv -> Prims.bool) = fun x -> let uu___ = x in match uu___ with | FV (uu___1, uu___2, force) -> force -type error_label = (fv * Prims.string * FStar_Compiler_Range_Type.range) +type error_label = + (fv * FStar_Errors_Msg.error_message * FStar_Compiler_Range_Type.range) type error_labels = error_label Prims.list let (fv_eq : fv -> fv -> Prims.bool) = fun x -> @@ -532,12 +545,17 @@ let (fv_eq : fv -> fv -> Prims.bool) = let (fvs_subset_of : fvs -> fvs -> Prims.bool) = fun x -> fun y -> - let cmp_fv x1 y1 = - let uu___ = fv_name x1 in - let uu___1 = fv_name y1 in FStar_Compiler_Util.compare uu___ uu___1 in - let uu___ = FStar_Compiler_Set.from_list ord_fv x in - let uu___1 = FStar_Compiler_Set.from_list ord_fv y in - FStar_Compiler_Set.subset ord_fv uu___ uu___1 + let uu___ = + Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic (FStar_Compiler_RBSet.setlike_rbset ord_fv)) x) in + let uu___1 = + Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic (FStar_Compiler_RBSet.setlike_rbset ord_fv)) y) in + FStar_Class_Setlike.subset () + (Obj.magic (FStar_Compiler_RBSet.setlike_rbset ord_fv)) + (Obj.magic uu___) (Obj.magic uu___1) let (freevar_eq : term -> term -> Prims.bool) = fun x -> fun y -> @@ -660,8 +678,9 @@ let rec (hash_of_term' : term' -> Prims.string) = | Labeled (t1, r1, r2) -> let uu___ = hash_of_term t1 in let uu___1 = - let uu___2 = FStar_Compiler_Range_Ops.string_of_range r2 in - Prims.strcat r1 uu___2 in + let uu___2 = FStar_Errors_Msg.rendermsg r1 in + let uu___3 = FStar_Compiler_Range_Ops.string_of_range r2 in + Prims.strcat uu___2 uu___3 in Prims.strcat uu___ uu___1 | LblPos (t1, r) -> let uu___ = @@ -1084,8 +1103,9 @@ let rec (print_smt_term : term -> Prims.string) = let uu___1 = print_smt_term_list l in FStar_Compiler_Util.format2 "(%s %s)" uu___ uu___1 | Labeled (t1, r1, r2) -> - let uu___ = print_smt_term t1 in - FStar_Compiler_Util.format2 "(Labeled '%s' %s)" r1 uu___ + let uu___ = FStar_Errors_Msg.rendermsg r1 in + let uu___1 = print_smt_term t1 in + FStar_Compiler_Util.format2 "(Labeled '%s' %s)" uu___ uu___1 | LblPos (t1, s) -> let uu___ = print_smt_term t1 in FStar_Compiler_Util.format2 "(LblPos %s %s)" s uu___ @@ -1480,13 +1500,13 @@ let (injective_constructor : match uu___2 with | { field_name = name1; field_sort = s; field_projectible = projectible;_} -> - let cproj_app = mkApp (name1, [capp]) norng in - let proj_name = - DeclFun - (name1, [sort1], s, - (FStar_Pervasives_Native.Some "Projector")) in if projectible then + let cproj_app = mkApp (name1, [capp]) norng in + let proj_name = + DeclFun + (name1, [sort1], s, + (FStar_Pervasives_Native.Some "Projector")) in let a = let uu___3 = let uu___4 = @@ -1510,7 +1530,7 @@ let (injective_constructor : assumption_fact_ids = [] } in [proj_name; Assume a] - else [proj_name]) fields in + else []) fields in FStar_Compiler_List.flatten uu___1 let (discriminator_name : constructor_t -> Prims.string) = fun constr -> Prims.strcat "is-" constr.constr_name @@ -1518,7 +1538,6 @@ let (constructor_to_decl : FStar_Compiler_Range_Type.range -> constructor_t -> decl Prims.list) = fun rng -> fun constr -> - let injective = true in let sort1 = constr.constr_sort in let field_sorts = FStar_Compiler_List.map (fun f -> f.field_sort) constr.constr_fields in @@ -1599,6 +1618,70 @@ let (constructor_to_decl : let projs = injective_constructor rng ((constr.constr_name), (constr.constr_fields), sort1) in + let base = + if Prims.op_Negation constr.constr_base + then [] + else + (let arg_sorts = + let uu___1 = + FStar_Compiler_List.filter (fun f -> f.field_projectible) + constr.constr_fields in + FStar_Compiler_List.map (fun uu___2 -> Term_sort) uu___1 in + let base_name = Prims.strcat constr.constr_name "@base" in + let decl1 = + DeclFun + (base_name, arg_sorts, Term_sort, + (FStar_Pervasives_Native.Some "Constructor base")) in + let formals = + FStar_Compiler_List.mapi + (fun i -> + fun uu___1 -> + let uu___2 = + let uu___3 = + let uu___4 = FStar_Compiler_Util.string_of_int i in + Prims.strcat "x" uu___4 in + (uu___3, Term_sort) in + mk_fv uu___2) constr.constr_fields in + let constructed_term = + let uu___1 = + let uu___2 = + FStar_Compiler_List.map (fun fv1 -> mkFreeV fv1 norng) + formals in + ((constr.constr_name), uu___2) in + mkApp uu___1 norng in + let inj_formals = + let uu___1 = + FStar_Compiler_List.map2 + (fun f -> + fun fld -> if fld.field_projectible then [f] else []) + formals constr.constr_fields in + FStar_Compiler_List.flatten uu___1 in + let base_term = + let uu___1 = + let uu___2 = + FStar_Compiler_List.map (fun fv1 -> mkFreeV fv1 norng) + inj_formals in + (base_name, uu___2) in + mkApp uu___1 norng in + let eq = mkEq (constructed_term, base_term) norng in + let guard = + mkApp ((discriminator_name constr), [constructed_term]) norng in + let q = + let uu___1 = + let uu___2 = mkImp (guard, eq) norng in + ([[constructed_term]], formals, uu___2) in + mkForall rng uu___1 in + let a = + let uu___1 = + escape (Prims.strcat "constructor_base_" constr.constr_name) in + { + assumption_term = q; + assumption_caption = + (FStar_Pervasives_Native.Some "Constructor base"); + assumption_name = uu___1; + assumption_fact_ids = [] + } in + [decl1; Assume a]) in let uu___ = let uu___1 = let uu___2 = @@ -1612,10 +1695,12 @@ let (constructor_to_decl : let uu___4 = let uu___5 = let uu___6 = - FStar_Compiler_Util.format1 "" - constr.constr_name in - Caption uu___6 in - [uu___5] in + let uu___7 = + FStar_Compiler_Util.format1 "" + constr.constr_name in + Caption uu___7 in + [uu___6] in + FStar_Compiler_List.op_At base uu___5 in FStar_Compiler_List.op_At [disc] uu___4 in FStar_Compiler_List.op_At projs uu___3 in FStar_Compiler_List.op_At cid uu___2 in @@ -1939,7 +2024,8 @@ and (mkPrelude : Prims.string -> Prims.string) = constr_name = name; constr_fields = uu___1; constr_sort = sort1; - constr_id = (FStar_Pervasives_Native.Some id) + constr_id = (FStar_Pervasives_Native.Some id); + constr_base = false } in let constrs = FStar_Compiler_List.map as_constr @@ -2018,7 +2104,8 @@ let (mkBvConstructor : constr_name = uu___; constr_fields = uu___1; constr_sort = Term_sort; - constr_id = FStar_Pervasives_Native.None + constr_id = FStar_Pervasives_Native.None; + constr_base = false } in let uu___ = constructor_to_decl norng constr in (uu___, (constr.constr_name), (discriminator_name constr)) diff --git a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Z3.ml b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Z3.ml index 0c3f9809670..95021b2ab14 100644 --- a/ocaml/fstar-lib/generated/FStar_SMTEncoding_Z3.ml +++ b/ocaml/fstar-lib/generated/FStar_SMTEncoding_Z3.ml @@ -145,7 +145,7 @@ let (z3_exe : unit -> Prims.string) = else (let uu___3 = inpath z3_v in if uu___3 then z3_v else FStar_Platform.exe "z3") in - (let uu___3 = FStar_Options.debug_any () in + (let uu___3 = FStar_Compiler_Debug.any () in if uu___3 then FStar_Compiler_Util.print1 "Chosen Z3 executable: %s\n" path else ()); @@ -817,7 +817,7 @@ let (doZ3Exe : res else ru) in let status = - (let uu___1 = FStar_Options.debug_any () in + (let uu___1 = FStar_Compiler_Debug.any () in if uu___1 then let uu___2 = diff --git a/ocaml/fstar-lib/generated/FStar_SizeT.ml b/ocaml/fstar-lib/generated/FStar_SizeT.ml index 4ff294e6f2b..5c70c2fe7ce 100644 --- a/ocaml/fstar-lib/generated/FStar_SizeT.ml +++ b/ocaml/fstar-lib/generated/FStar_SizeT.ml @@ -1,8 +1,12 @@ open Prims -type t = FStar_UInt64.t +type t = + | Sz of FStar_UInt64.t +let (uu___is_Sz : t -> Prims.bool) = fun projectee -> true +let (__proj__Sz__item__x : t -> FStar_UInt64.t) = + fun projectee -> match projectee with | Sz x -> x type 'x fits = unit -let (v : t -> Prims.nat) = fun x -> FStar_UInt64.v x -let (uint_to_t : Prims.nat -> t) = fun x -> FStar_UInt64.uint_to_t x +let (v : t -> Prims.nat) = fun x -> FStar_UInt64.v (__proj__Sz__item__x x) +let (uint_to_t : Prims.nat -> t) = fun x -> Sz (FStar_UInt64.uint_to_t x) type fits_u32 = unit type fits_u64 = unit let (uint16_to_sizet : FStar_UInt16.t -> t) = @@ -12,17 +16,41 @@ let (uint32_to_sizet : FStar_UInt32.t -> t) = let (uint64_to_sizet : FStar_UInt64.t -> t) = fun x -> uint_to_t (FStar_UInt64.v x) let (sizet_to_uint32 : t -> FStar_UInt32.t) = - fun x -> FStar_Int_Cast.uint64_to_uint32 x -let (add : t -> t -> t) = fun x -> fun y -> FStar_UInt64.add x y -let (sub : t -> t -> t) = fun x -> fun y -> FStar_UInt64.sub x y -let (mul : t -> t -> t) = fun x -> fun y -> FStar_UInt64.mul x y + fun x -> FStar_Int_Cast.uint64_to_uint32 (__proj__Sz__item__x x) +let (add : t -> t -> t) = + fun x -> + fun y -> + Sz (FStar_UInt64.add (__proj__Sz__item__x x) (__proj__Sz__item__x y)) +let (sub : t -> t -> t) = + fun x -> + fun y -> + Sz (FStar_UInt64.sub (__proj__Sz__item__x x) (__proj__Sz__item__x y)) +let (mul : t -> t -> t) = + fun x -> + fun y -> + Sz (FStar_UInt64.mul (__proj__Sz__item__x x) (__proj__Sz__item__x y)) let (div : t -> t -> t) = - fun x -> fun y -> let res = FStar_UInt64.div x y in res -let (rem : t -> t -> t) = fun x -> fun y -> FStar_UInt64.rem x y -let (gt : t -> t -> Prims.bool) = fun x -> fun y -> FStar_UInt64.gt x y -let (gte : t -> t -> Prims.bool) = fun x -> fun y -> FStar_UInt64.gte x y -let (lt : t -> t -> Prims.bool) = fun x -> fun y -> FStar_UInt64.lt x y -let (lte : t -> t -> Prims.bool) = fun x -> fun y -> FStar_UInt64.lte x y + fun x -> + fun y -> + let res = + Sz (FStar_UInt64.div (__proj__Sz__item__x x) (__proj__Sz__item__x y)) in + res +let (rem : t -> t -> t) = + fun x -> + fun y -> + Sz (FStar_UInt64.rem (__proj__Sz__item__x x) (__proj__Sz__item__x y)) +let (gt : t -> t -> Prims.bool) = + fun x -> + fun y -> FStar_UInt64.gt (__proj__Sz__item__x x) (__proj__Sz__item__x y) +let (gte : t -> t -> Prims.bool) = + fun x -> + fun y -> FStar_UInt64.gte (__proj__Sz__item__x x) (__proj__Sz__item__x y) +let (lt : t -> t -> Prims.bool) = + fun x -> + fun y -> FStar_UInt64.lt (__proj__Sz__item__x x) (__proj__Sz__item__x y) +let (lte : t -> t -> Prims.bool) = + fun x -> + fun y -> FStar_UInt64.lte (__proj__Sz__item__x x) (__proj__Sz__item__x y) let (op_Plus_Hat : t -> t -> t) = add let (op_Subtraction_Hat : t -> t -> t) = sub let (op_Star_Hat : t -> t -> t) = mul diff --git a/ocaml/fstar-lib/generated/FStar_SquashProperties.ml b/ocaml/fstar-lib/generated/FStar_SquashProperties.ml index 3675bae54de..141fc597d5b 100644 --- a/ocaml/fstar-lib/generated/FStar_SquashProperties.ml +++ b/ocaml/fstar-lib/generated/FStar_SquashProperties.ml @@ -11,6 +11,6 @@ type ('a, 'b) retract_cond = | MkC of unit * unit * unit let uu___is_MkC : 'a 'b . ('a, 'b) retract_cond -> Prims.bool = fun projectee -> true -let false_elim : 'a . Prims.l_False -> 'a = +let false_elim : 'a . unit -> 'a = fun uu___ -> (fun f -> Obj.magic (failwith "unreachable")) uu___ type u = unit \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Compress.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Compress.ml index d62012594e9..a27ec96e9b5 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Compress.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Compress.ml @@ -21,7 +21,7 @@ let (compress1_t : FStar_Errors.raise_err uu___ | FStar_Syntax_Syntax.Tm_name bv when Prims.op_Negation allow_names -> - ((let uu___1 = FStar_Options.debug_any () in + ((let uu___1 = FStar_Compiler_Debug.any () in if uu___1 then let uu___2 = @@ -80,7 +80,7 @@ let (compress1_u : fun u -> match u with | FStar_Syntax_Syntax.U_name bv when Prims.op_Negation allow_names -> - ((let uu___1 = FStar_Options.debug_any () in + ((let uu___1 = FStar_Compiler_Debug.any () in if uu___1 then let uu___2 = diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_DsEnv.ml b/ocaml/fstar-lib/generated/FStar_Syntax_DsEnv.ml index 821d2993eee..4ac38fc8917 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_DsEnv.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_DsEnv.ml @@ -51,9 +51,7 @@ let (ugly_sigelt_to_string : FStar_Syntax_Syntax.sigelt -> Prims.string) = uu___ se type local_binding = (FStar_Ident.ident * FStar_Syntax_Syntax.bv * used_marker) -type rec_binding = - (FStar_Ident.ident * FStar_Ident.lid * FStar_Syntax_Syntax.delta_depth * - used_marker) +type rec_binding = (FStar_Ident.ident * FStar_Ident.lid * used_marker) type scope_mod = | Local_binding of local_binding | Rec_binding of rec_binding @@ -96,7 +94,7 @@ let (uu___is_Record_or_dc : scope_mod -> Prims.bool) = match projectee with | Record_or_dc _0 -> true | uu___ -> false let (__proj__Record_or_dc__item___0 : scope_mod -> record_or_dc) = fun projectee -> match projectee with | Record_or_dc _0 -> _0 -type string_set = Prims.string FStar_Compiler_Set.t +type string_set = Prims.string FStar_Compiler_RBSet.t type exported_id_kind = | Exported_id_term_type | Exported_id_field @@ -400,7 +398,10 @@ let (transitive_exported_ids : let uu___1 = let uu___2 = exported_id_set1 Exported_id_term_type in FStar_Compiler_Effect.op_Bang uu___2 in - FStar_Compiler_Set.elems FStar_Class_Ord.ord_string uu___1 + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset FStar_Class_Ord.ord_string)) + (Obj.magic uu___1) let (opens_and_abbrevs : env -> (FStar_Syntax_Syntax.open_module_or_namespace, @@ -639,13 +640,12 @@ let (bv_to_name : fun r -> let uu___ = set_bv_range bv r in FStar_Syntax_Syntax.bv_to_name uu___ let (unmangleMap : - (Prims.string * Prims.string * FStar_Syntax_Syntax.delta_depth * - FStar_Syntax_Syntax.fv_qual FStar_Pervasives_Native.option) Prims.list) + (Prims.string * Prims.string * FStar_Syntax_Syntax.fv_qual + FStar_Pervasives_Native.option) Prims.list) = - [("op_ColonColon", "Cons", FStar_Syntax_Syntax.delta_constant, + [("op_ColonColon", "Cons", (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor)); - ("not", "op_Negation", FStar_Syntax_Syntax.delta_equational, - FStar_Pervasives_Native.None)] + ("not", "op_Negation", FStar_Pervasives_Native.None)] let (unmangleOpName : FStar_Ident.ident -> FStar_Syntax_Syntax.term FStar_Pervasives_Native.option) @@ -654,7 +654,7 @@ let (unmangleOpName : FStar_Compiler_Util.find_map unmangleMap (fun uu___ -> match uu___ with - | (x, y, dd, dq) -> + | (x, y, dq) -> let uu___1 = let uu___2 = FStar_Ident.string_of_id id in uu___2 = x in if uu___1 @@ -663,7 +663,7 @@ let (unmangleOpName : let uu___3 = let uu___4 = FStar_Ident.range_of_id id in FStar_Ident.lid_of_path ["Prims"; y] uu___4 in - FStar_Syntax_Syntax.fvar_with_dd uu___3 dd dq in + FStar_Syntax_Syntax.fvar_with_dd uu___3 dq in FStar_Pervasives_Native.Some uu___2 else FStar_Pervasives_Native.None) type 'a cont_t = @@ -784,8 +784,11 @@ let find_in_module_with_includes : let mexports = let uu___2 = mex eikind in FStar_Compiler_Effect.op_Bang uu___2 in - FStar_Compiler_Set.mem FStar_Class_Ord.ord_string - idstr mexports in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_string)) idstr + (Obj.magic mexports) in let mincludes = let uu___1 = FStar_Compiler_Util.smap_try_find env1.includes mname in @@ -831,10 +834,10 @@ let try_lookup_id'' : uu___3 = uu___4 in let check_rec_binding_id uu___ = match uu___ with - | (id', uu___1, uu___2, uu___3) -> - let uu___4 = FStar_Ident.string_of_id id' in - let uu___5 = FStar_Ident.string_of_id id in - uu___4 = uu___5 in + | (id', uu___1, uu___2) -> + let uu___3 = FStar_Ident.string_of_id id' in + let uu___4 = FStar_Ident.string_of_id id in + uu___3 = uu___4 in let curmod_ns = let uu___ = current_module env1 in FStar_Ident.ids_of_lid uu___ in @@ -850,7 +853,7 @@ let try_lookup_id'' : | Rec_binding r when check_rec_binding_id r -> let uu___1 = r in (match uu___1 with - | (uu___2, uu___3, uu___4, used_marker1) -> + | (uu___2, uu___3, used_marker1) -> (FStar_Compiler_Effect.op_Colon_Equals used_marker1 true; k_rec_binding r)) @@ -1173,16 +1176,17 @@ let (fv_qual_of_se : { FStar_Syntax_Syntax.lid1 = uu___; FStar_Syntax_Syntax.us1 = uu___1; FStar_Syntax_Syntax.t1 = uu___2; FStar_Syntax_Syntax.ty_lid = l; FStar_Syntax_Syntax.num_ty_params = uu___3; - FStar_Syntax_Syntax.mutuals1 = uu___4;_} + FStar_Syntax_Syntax.mutuals1 = uu___4; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_} -> let qopt = FStar_Compiler_Util.find_map se.FStar_Syntax_Syntax.sigquals - (fun uu___5 -> - match uu___5 with - | FStar_Syntax_Syntax.RecordConstructor (uu___6, fs) -> + (fun uu___6 -> + match uu___6 with + | FStar_Syntax_Syntax.RecordConstructor (uu___7, fs) -> FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Record_ctor (l, fs)) - | uu___6 -> FStar_Pervasives_Native.None) in + | uu___7 -> FStar_Pervasives_Native.None) in (match qopt with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor @@ -1220,40 +1224,6 @@ let (ns_of_lid_equals : let uu___1 = FStar_Ident.ns_of_lid lid in FStar_Ident.lid_of_ids uu___1 in FStar_Ident.lid_equals uu___ ns) -let (delta_depth_of_declaration : - FStar_Ident.lident -> - FStar_Syntax_Syntax.qualifier Prims.list -> - FStar_Syntax_Syntax.delta_depth) - = - fun lid -> - fun quals -> - let dd = - let uu___ = - (FStar_Syntax_Util.is_primop_lid lid) || - (FStar_Compiler_Util.for_some - (fun uu___1 -> - match uu___1 with - | FStar_Syntax_Syntax.Projector uu___2 -> true - | FStar_Syntax_Syntax.Discriminator uu___2 -> true - | uu___2 -> false) quals) in - if uu___ - then FStar_Syntax_Syntax.delta_equational - else FStar_Syntax_Syntax.delta_constant in - let uu___ = - (FStar_Compiler_Util.for_some - (fun uu___1 -> - match uu___1 with - | FStar_Syntax_Syntax.Assumption -> true - | uu___2 -> false) quals) - && - (let uu___1 = - FStar_Compiler_Util.for_some - (fun uu___2 -> - match uu___2 with - | FStar_Syntax_Syntax.New -> true - | uu___3 -> false) quals in - Prims.op_Negation uu___1) in - if uu___ then FStar_Syntax_Syntax.Delta_abstract dd else dd let (try_lookup_name : Prims.bool -> Prims.bool -> @@ -1275,7 +1245,6 @@ let (try_lookup_name : let uu___4 = let uu___5 = FStar_Syntax_Syntax.fvar_with_dd source_lid - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in (uu___5, (se.FStar_Syntax_Syntax.sigattrs)) in Term_name uu___4 in @@ -1285,8 +1254,7 @@ let (try_lookup_name : let uu___4 = let uu___5 = let uu___6 = fv_qual_of_se se in - FStar_Syntax_Syntax.fvar_with_dd source_lid - FStar_Syntax_Syntax.delta_constant uu___6 in + FStar_Syntax_Syntax.fvar_with_dd source_lid uu___6 in (uu___5, (se.FStar_Syntax_Syntax.sigattrs)) in Term_name uu___4 in FStar_Pervasives_Native.Some uu___3 @@ -1298,10 +1266,7 @@ let (try_lookup_name : let uu___4 = let uu___5 = let uu___6 = - let uu___7 = - FStar_Compiler_Util.must - fv.FStar_Syntax_Syntax.fv_delta in - FStar_Syntax_Syntax.fvar_with_dd source_lid uu___7 + FStar_Syntax_Syntax.fvar_with_dd source_lid fv.FStar_Syntax_Syntax.fv_qual in (uu___6, (se.FStar_Syntax_Syntax.sigattrs)) in Term_name uu___5 in @@ -1324,7 +1289,6 @@ let (try_lookup_name : let lid2 = let uu___5 = FStar_Ident.range_of_lid source_lid in FStar_Ident.set_lid_range lid1 uu___5 in - let dd = delta_depth_of_declaration lid2 quals in let uu___5 = FStar_Compiler_Util.find_map quals (fun uu___6 -> @@ -1348,7 +1312,7 @@ let (try_lookup_name : let uu___8 = let uu___9 = let uu___10 = fv_qual_of_se se in - FStar_Syntax_Syntax.fvar_with_dd lid2 dd + FStar_Syntax_Syntax.fvar_with_dd lid2 uu___10 in (uu___9, (se.FStar_Syntax_Syntax.sigattrs)) in Term_name uu___8 in @@ -1375,8 +1339,7 @@ let (try_lookup_name : let uu___4 = let uu___5 = FStar_Syntax_Syntax.fvar_with_dd source_lid - (FStar_Syntax_Syntax.Delta_constant_at_level - Prims.int_one) FStar_Pervasives_Native.None in + FStar_Pervasives_Native.None in (uu___5, []) in Term_name uu___4 in FStar_Pervasives_Native.Some uu___3 @@ -1388,7 +1351,7 @@ let (try_lookup_name : FStar_Pervasives_Native.Some (Term_name (t, [])) in let k_rec_binding uu___ = match uu___ with - | (id, l, dd, used_marker1) -> + | (id, l, used_marker1) -> (FStar_Compiler_Effect.op_Colon_Equals used_marker1 true; (let uu___2 = let uu___3 = @@ -1396,7 +1359,7 @@ let (try_lookup_name : let uu___5 = let uu___6 = FStar_Ident.range_of_lid lid in FStar_Ident.set_lid_range l uu___6 in - FStar_Syntax_Syntax.fvar_with_dd uu___5 dd + FStar_Syntax_Syntax.fvar_with_dd uu___5 FStar_Pervasives_Native.None in (uu___4, []) in Term_name uu___3 in @@ -1640,9 +1603,7 @@ let (try_lookup_let : uu___9) -> let fv = lb_fv lbs lid1 in let uu___10 = - let uu___11 = - FStar_Compiler_Util.must fv.FStar_Syntax_Syntax.fv_delta in - FStar_Syntax_Syntax.fvar_with_dd lid1 uu___11 + FStar_Syntax_Syntax.fvar_with_dd lid1 fv.FStar_Syntax_Syntax.fv_qual in FStar_Pervasives_Native.Some uu___10 | uu___1 -> FStar_Pervasives_Native.None in @@ -1888,7 +1849,6 @@ let (try_lookup_datacon : then let uu___8 = FStar_Syntax_Syntax.lid_and_dd_as_fv lid1 - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in FStar_Pervasives_Native.Some uu___8 else FStar_Pervasives_Native.None @@ -1902,9 +1862,7 @@ let (try_lookup_datacon : FStar_Syntax_Syntax.sigopts = uu___6;_}, uu___7) -> let qual1 = fv_qual_of_se (FStar_Pervasives_Native.fst se) in - let uu___8 = - FStar_Syntax_Syntax.lid_and_dd_as_fv lid1 - FStar_Syntax_Syntax.delta_constant qual1 in + let uu___8 = FStar_Syntax_Syntax.lid_and_dd_as_fv lid1 qual1 in FStar_Pervasives_Native.Some uu___8 | ({ FStar_Syntax_Syntax.sigel = FStar_Syntax_Syntax.Sig_datacon @@ -1917,9 +1875,7 @@ let (try_lookup_datacon : FStar_Syntax_Syntax.sigopts = uu___6;_}, uu___7) -> let qual1 = fv_qual_of_se (FStar_Pervasives_Native.fst se) in - let uu___8 = - FStar_Syntax_Syntax.lid_and_dd_as_fv lid1 - FStar_Syntax_Syntax.delta_constant qual1 in + let uu___8 = FStar_Syntax_Syntax.lid_and_dd_as_fv lid1 qual1 in FStar_Pervasives_Native.Some uu___8 | uu___ -> FStar_Pervasives_Native.None in resolve_in_open_namespaces' env1 lid @@ -1943,14 +1899,15 @@ let (find_all_datacons : FStar_Syntax_Syntax.num_uniform_params = uu___4; FStar_Syntax_Syntax.t = uu___5; FStar_Syntax_Syntax.mutuals = datas; - FStar_Syntax_Syntax.ds = uu___6;_}; - FStar_Syntax_Syntax.sigrng = uu___7; - FStar_Syntax_Syntax.sigquals = uu___8; - FStar_Syntax_Syntax.sigmeta = uu___9; - FStar_Syntax_Syntax.sigattrs = uu___10; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___11; - FStar_Syntax_Syntax.sigopts = uu___12;_}, - uu___13) -> FStar_Pervasives_Native.Some datas + FStar_Syntax_Syntax.ds = uu___6; + FStar_Syntax_Syntax.injective_type_params = uu___7;_}; + FStar_Syntax_Syntax.sigrng = uu___8; + FStar_Syntax_Syntax.sigquals = uu___9; + FStar_Syntax_Syntax.sigmeta = uu___10; + FStar_Syntax_Syntax.sigattrs = uu___11; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___12; + FStar_Syntax_Syntax.sigopts = uu___13;_}, + uu___14) -> FStar_Pervasives_Native.Some datas | uu___1 -> FStar_Pervasives_Native.None in resolve_in_open_namespaces' env1 lid (fun uu___ -> FStar_Pervasives_Native.None) @@ -2060,13 +2017,15 @@ let (extract_record : FStar_Syntax_Syntax.t1 = uu___3; FStar_Syntax_Syntax.ty_lid = uu___4; FStar_Syntax_Syntax.num_ty_params = uu___5; - FStar_Syntax_Syntax.mutuals1 = uu___6;_}; - FStar_Syntax_Syntax.sigrng = uu___7; - FStar_Syntax_Syntax.sigquals = uu___8; - FStar_Syntax_Syntax.sigmeta = uu___9; - FStar_Syntax_Syntax.sigattrs = uu___10; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___11; - FStar_Syntax_Syntax.sigopts = uu___12;_} -> + FStar_Syntax_Syntax.mutuals1 = uu___6; + FStar_Syntax_Syntax.injective_type_params1 = + uu___7;_}; + FStar_Syntax_Syntax.sigrng = uu___8; + FStar_Syntax_Syntax.sigquals = uu___9; + FStar_Syntax_Syntax.sigmeta = uu___10; + FStar_Syntax_Syntax.sigattrs = uu___11; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___12; + FStar_Syntax_Syntax.sigopts = uu___13;_} -> FStar_Ident.lid_equals dc lid | uu___2 -> false) sigs in FStar_Compiler_List.iter @@ -2081,51 +2040,54 @@ let (extract_record : FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = uu___3; FStar_Syntax_Syntax.mutuals = uu___4; - FStar_Syntax_Syntax.ds = dc::[];_}; - FStar_Syntax_Syntax.sigrng = uu___5; + FStar_Syntax_Syntax.ds = dc::[]; + FStar_Syntax_Syntax.injective_type_params = uu___5;_}; + FStar_Syntax_Syntax.sigrng = uu___6; FStar_Syntax_Syntax.sigquals = typename_quals; - FStar_Syntax_Syntax.sigmeta = uu___6; - FStar_Syntax_Syntax.sigattrs = uu___7; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___8; - FStar_Syntax_Syntax.sigopts = uu___9;_} -> - let uu___10 = - let uu___11 = find_dc dc in - FStar_Compiler_Util.must uu___11 in - (match uu___10 with + FStar_Syntax_Syntax.sigmeta = uu___7; + FStar_Syntax_Syntax.sigattrs = uu___8; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___9; + FStar_Syntax_Syntax.sigopts = uu___10;_} -> + let uu___11 = + let uu___12 = find_dc dc in + FStar_Compiler_Util.must uu___12 in + (match uu___11 with | { FStar_Syntax_Syntax.sigel = FStar_Syntax_Syntax.Sig_datacon { FStar_Syntax_Syntax.lid1 = constrname; - FStar_Syntax_Syntax.us1 = uu___11; + FStar_Syntax_Syntax.us1 = uu___12; FStar_Syntax_Syntax.t1 = t; - FStar_Syntax_Syntax.ty_lid = uu___12; + FStar_Syntax_Syntax.ty_lid = uu___13; FStar_Syntax_Syntax.num_ty_params = n; - FStar_Syntax_Syntax.mutuals1 = uu___13;_}; - FStar_Syntax_Syntax.sigrng = uu___14; - FStar_Syntax_Syntax.sigquals = uu___15; - FStar_Syntax_Syntax.sigmeta = uu___16; - FStar_Syntax_Syntax.sigattrs = uu___17; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___18; - FStar_Syntax_Syntax.sigopts = uu___19;_} -> - let uu___20 = FStar_Syntax_Util.arrow_formals t in - (match uu___20 with - | (all_formals, uu___21) -> - let uu___22 = + FStar_Syntax_Syntax.mutuals1 = uu___14; + FStar_Syntax_Syntax.injective_type_params1 = + uu___15;_}; + FStar_Syntax_Syntax.sigrng = uu___16; + FStar_Syntax_Syntax.sigquals = uu___17; + FStar_Syntax_Syntax.sigmeta = uu___18; + FStar_Syntax_Syntax.sigattrs = uu___19; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___20; + FStar_Syntax_Syntax.sigopts = uu___21;_} -> + let uu___22 = FStar_Syntax_Util.arrow_formals t in + (match uu___22 with + | (all_formals, uu___23) -> + let uu___24 = FStar_Compiler_Util.first_N n all_formals in - (match uu___22 with + (match uu___24 with | (_params, formals) -> let is_rec = is_record typename_quals in let formals' = FStar_Compiler_List.collect (fun f -> - let uu___23 = + let uu___25 = (FStar_Syntax_Syntax.is_null_bv f.FStar_Syntax_Syntax.binder_bv) || (is_rec && (FStar_Syntax_Syntax.is_bqual_implicit f.FStar_Syntax_Syntax.binder_qual)) in - if uu___23 then [] else [f]) + if uu___25 then [] else [f]) formals in let fields' = FStar_Compiler_List.map @@ -2135,11 +2097,11 @@ let (extract_record : formals' in let fields = fields' in let record = - let uu___23 = + let uu___25 = FStar_Ident.ident_of_lid constrname in { typename; - constrname = uu___23; + constrname = uu___25; parms; fields; is_private = @@ -2148,73 +2110,86 @@ let (extract_record : typename_quals); is_record = is_rec } in - ((let uu___24 = - let uu___25 = + ((let uu___26 = + let uu___27 = FStar_Compiler_Effect.op_Bang new_globs in - (Record_or_dc record) :: uu___25 in + (Record_or_dc record) :: uu___27 in FStar_Compiler_Effect.op_Colon_Equals - new_globs uu___24); + new_globs uu___26); (match () with | () -> - ((let add_field uu___25 = - match uu___25 with - | (id, uu___26) -> + ((let add_field uu___27 = + match uu___27 with + | (id, uu___28) -> let modul = - let uu___27 = - let uu___28 = + let uu___29 = + let uu___30 = FStar_Ident.ns_of_lid constrname in FStar_Ident.lid_of_ids - uu___28 in + uu___30 in FStar_Ident.string_of_lid - uu___27 in - let uu___27 = + uu___29 in + let uu___29 = get_exported_id_set e modul in - (match uu___27 with + (match uu___29 with | FStar_Pervasives_Native.Some my_ex -> let my_exported_ids = my_ex Exported_id_field in - ((let uu___29 = - let uu___30 = + ((let uu___31 = + let uu___32 = FStar_Ident.string_of_id id in - let uu___31 = + let uu___33 = FStar_Compiler_Effect.op_Bang my_exported_ids in - FStar_Compiler_Set.add - FStar_Class_Ord.ord_string - uu___30 uu___31 in + Obj.magic + (FStar_Class_Setlike.add + () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_string)) + uu___32 + (Obj.magic + uu___33)) in FStar_Compiler_Effect.op_Colon_Equals my_exported_ids - uu___29); + uu___31); (match () with | () -> let projname = - let uu___29 = - let uu___30 + let uu___31 = + let uu___32 = FStar_Syntax_Util.mk_field_projector_name_from_ident constrname id in FStar_Ident.ident_of_lid - uu___30 in + uu___32 in FStar_Ident.string_of_id - uu___29 in - let uu___30 = - let uu___31 = + uu___31 in + let uu___32 = + let uu___33 = FStar_Compiler_Effect.op_Bang my_exported_ids in - FStar_Compiler_Set.add - FStar_Class_Ord.ord_string - projname - uu___31 in + Obj.magic + (FStar_Class_Setlike.add + () + ( + Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_string)) + projname + ( + Obj.magic + uu___33)) in FStar_Compiler_Effect.op_Colon_Equals my_exported_ids - uu___30)) + uu___32)) | FStar_Pervasives_Native.None -> ()) in FStar_Compiler_List.iter @@ -2222,7 +2197,7 @@ let (extract_record : (match () with | () -> insert_record_cache record)))))) - | uu___11 -> ()) + | uu___12 -> ()) | uu___2 -> ()) sigs | uu___ -> () let (try_lookup_record_or_dc_by_field_name : @@ -2322,16 +2297,17 @@ let (try_lookup_dc_by_field_name : (uu___2, (r.is_record)) in FStar_Pervasives_Native.Some uu___1 | uu___1 -> FStar_Pervasives_Native.None -let (string_set_ref_new : - unit -> Prims.string FStar_Compiler_Set.t FStar_Compiler_Effect.ref) = +let (string_set_ref_new : unit -> string_set FStar_Compiler_Effect.ref) = fun uu___ -> - let uu___1 = FStar_Compiler_Set.empty FStar_Class_Ord.ord_string () in + let uu___1 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset FStar_Class_Ord.ord_string)) + ()) in FStar_Compiler_Util.mk_ref uu___1 let (exported_id_set_new : - unit -> - exported_id_kind -> - Prims.string FStar_Compiler_Set.t FStar_Compiler_Effect.ref) - = + unit -> exported_id_kind -> string_set FStar_Compiler_Effect.ref) = fun uu___ -> let term_type_set = string_set_ref_new () in let field_set = string_set_ref_new () in @@ -2419,30 +2395,25 @@ let (push_bv : env -> FStar_Ident.ident -> (env * FStar_Syntax_Syntax.bv)) = let uu___ = push_bv' env1 x in match uu___ with | (env2, bv, uu___1) -> (env2, bv) let (push_top_level_rec_binding : - env -> - FStar_Ident.ident -> - FStar_Syntax_Syntax.delta_depth -> - (env * Prims.bool FStar_Compiler_Effect.ref)) - = + env -> FStar_Ident.ident -> (env * Prims.bool FStar_Compiler_Effect.ref)) = fun env0 -> fun x -> - fun dd -> - let l = qualify env0 x in - let uu___ = - (unique false true env0 l) || (FStar_Options.interactive ()) in - if uu___ - then - let used_marker1 = FStar_Compiler_Util.mk_ref false in - ((push_scope_mod env0 (Rec_binding (x, l, dd, used_marker1))), - used_marker1) - else - (let uu___2 = - let uu___3 = - let uu___4 = FStar_Ident.string_of_lid l in - Prims.strcat "Duplicate top-level names " uu___4 in - (FStar_Errors_Codes.Fatal_DuplicateTopLevelNames, uu___3) in - let uu___3 = FStar_Ident.range_of_lid l in - FStar_Errors.raise_error uu___2 uu___3) + let l = qualify env0 x in + let uu___ = + (unique false true env0 l) || (FStar_Options.interactive ()) in + if uu___ + then + let used_marker1 = FStar_Compiler_Util.mk_ref false in + ((push_scope_mod env0 (Rec_binding (x, l, used_marker1))), + used_marker1) + else + (let uu___2 = + let uu___3 = + let uu___4 = FStar_Ident.string_of_lid l in + Prims.strcat "Duplicate top-level names " uu___4 in + (FStar_Errors_Codes.Fatal_DuplicateTopLevelNames, uu___3) in + let uu___3 = FStar_Ident.range_of_lid l in + FStar_Errors.raise_error uu___2 uu___3) let (push_sigelt' : Prims.bool -> env -> FStar_Syntax_Syntax.sigelt -> env) = fun fail_on_dup -> fun env1 -> @@ -2590,9 +2561,12 @@ let (push_sigelt' : Prims.bool -> env -> FStar_Syntax_Syntax.sigelt -> env) = let uu___8 = FStar_Compiler_Effect.op_Bang my_exported_ids in - FStar_Compiler_Set.add - FStar_Class_Ord.ord_string uu___7 - uu___8 in + Obj.magic + (FStar_Class_Setlike.add () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_string)) + uu___7 (Obj.magic uu___8)) in FStar_Compiler_Effect.op_Colon_Equals my_exported_ids uu___6 | FStar_Pervasives_Native.None -> ()); @@ -2724,8 +2698,12 @@ let (push_include : env -> FStar_Ident.lident -> env) = (let uu___7 = let uu___8 = FStar_Compiler_Effect.op_Bang ex in - FStar_Compiler_Set.diff - FStar_Class_Ord.ord_string uu___8 ns_ex in + Obj.magic + (FStar_Class_Setlike.diff () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_string)) + (Obj.magic uu___8) (Obj.magic ns_ex)) in FStar_Compiler_Effect.op_Colon_Equals ex uu___7); (match () with @@ -2734,9 +2712,13 @@ let (push_include : env -> FStar_Ident.lident -> env) = let uu___8 = let uu___9 = FStar_Compiler_Effect.op_Bang trans_ex in - FStar_Compiler_Set.union - FStar_Class_Ord.ord_string uu___9 - ns_ex in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_string)) + (Obj.magic uu___9) + (Obj.magic ns_ex)) in FStar_Compiler_Effect.op_Colon_Equals trans_ex uu___8) in FStar_Compiler_List.iter update_exports @@ -2916,11 +2898,13 @@ let (finish : env -> FStar_Syntax_Syntax.modul -> env) = FStar_Syntax_Syntax.t1 = uu___3; FStar_Syntax_Syntax.ty_lid = uu___4; FStar_Syntax_Syntax.num_ty_params = uu___5; - FStar_Syntax_Syntax.mutuals1 = uu___6;_} + FStar_Syntax_Syntax.mutuals1 = uu___6; + FStar_Syntax_Syntax.injective_type_params1 = + uu___7;_} -> - let uu___7 = FStar_Ident.string_of_lid lid in + let uu___8 = FStar_Ident.string_of_lid lid in FStar_Compiler_Util.smap_remove (sigmap env1) - uu___7 + uu___8 | FStar_Syntax_Syntax.Sig_inductive_typ { FStar_Syntax_Syntax.lid = lid; FStar_Syntax_Syntax.us = univ_names; @@ -2928,36 +2912,39 @@ let (finish : env -> FStar_Syntax_Syntax.modul -> env) = FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = typ; FStar_Syntax_Syntax.mutuals = uu___3; - FStar_Syntax_Syntax.ds = uu___4;_} + FStar_Syntax_Syntax.ds = uu___4; + FStar_Syntax_Syntax.injective_type_params = + uu___5;_} -> - ((let uu___6 = FStar_Ident.string_of_lid lid in + ((let uu___7 = FStar_Ident.string_of_lid lid in FStar_Compiler_Util.smap_remove (sigmap env1) - uu___6); + uu___7); if Prims.op_Negation (FStar_Compiler_List.contains FStar_Syntax_Syntax.Private quals) then (let sigel = - let uu___6 = - let uu___7 = - let uu___8 = - let uu___9 = - let uu___10 = + let uu___7 = + let uu___8 = + let uu___9 = + let uu___10 = + let uu___11 = FStar_Syntax_Syntax.mk_Total typ in { FStar_Syntax_Syntax.bs1 = binders; - FStar_Syntax_Syntax.comp = uu___10 + FStar_Syntax_Syntax.comp = uu___11 } in - FStar_Syntax_Syntax.Tm_arrow uu___9 in - let uu___9 = FStar_Ident.range_of_lid lid in - FStar_Syntax_Syntax.mk uu___8 uu___9 in + FStar_Syntax_Syntax.Tm_arrow uu___10 in + let uu___10 = + FStar_Ident.range_of_lid lid in + FStar_Syntax_Syntax.mk uu___9 uu___10 in { FStar_Syntax_Syntax.lid2 = lid; FStar_Syntax_Syntax.us2 = univ_names; - FStar_Syntax_Syntax.t2 = uu___7 + FStar_Syntax_Syntax.t2 = uu___8 } in - FStar_Syntax_Syntax.Sig_declare_typ uu___6 in + FStar_Syntax_Syntax.Sig_declare_typ uu___7 in let se2 = { FStar_Syntax_Syntax.sigel = sigel; @@ -2974,9 +2961,9 @@ let (finish : env -> FStar_Syntax_Syntax.modul -> env) = FStar_Syntax_Syntax.sigopts = (se1.FStar_Syntax_Syntax.sigopts) } in - let uu___6 = FStar_Ident.string_of_lid lid in + let uu___7 = FStar_Ident.string_of_lid lid in FStar_Compiler_Util.smap_add (sigmap env1) - uu___6 (se2, false)) + uu___7 (se2, false)) else ()) | uu___2 -> ()) ses else () @@ -3032,8 +3019,12 @@ let (finish : env -> FStar_Syntax_Syntax.modul -> env) = let uu___3 = let uu___4 = FStar_Compiler_Effect.op_Bang cur_trans_ex_set_ref in - FStar_Compiler_Set.union FStar_Class_Ord.ord_string - cur_ex_set uu___4 in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_string)) + (Obj.magic cur_ex_set) (Obj.magic uu___4)) in FStar_Compiler_Effect.op_Colon_Equals cur_trans_ex_set_ref uu___3 in FStar_Compiler_List.iter update_exports all_exported_id_kinds @@ -3169,50 +3160,36 @@ let (finish_module_or_interface : let uu___ = finish env1 modul1 in (uu___, modul1) type exported_ids = { - exported_id_terms: Prims.string Prims.list ; - exported_id_fields: Prims.string Prims.list } + exported_id_terms: string_set ; + exported_id_fields: string_set } let (__proj__Mkexported_ids__item__exported_id_terms : - exported_ids -> Prims.string Prims.list) = + exported_ids -> string_set) = fun projectee -> match projectee with | { exported_id_terms; exported_id_fields;_} -> exported_id_terms let (__proj__Mkexported_ids__item__exported_id_fields : - exported_ids -> Prims.string Prims.list) = + exported_ids -> string_set) = fun projectee -> match projectee with | { exported_id_terms; exported_id_fields;_} -> exported_id_fields let (as_exported_ids : exported_id_set -> exported_ids) = fun e -> let terms = - let uu___ = - let uu___1 = e Exported_id_term_type in - FStar_Compiler_Effect.op_Bang uu___1 in - FStar_Compiler_Set.elems FStar_Class_Ord.ord_string uu___ in + let uu___ = e Exported_id_term_type in + FStar_Compiler_Effect.op_Bang uu___ in let fields = - let uu___ = - let uu___1 = e Exported_id_field in - FStar_Compiler_Effect.op_Bang uu___1 in - FStar_Compiler_Set.elems FStar_Class_Ord.ord_string uu___ in + let uu___ = e Exported_id_field in FStar_Compiler_Effect.op_Bang uu___ in { exported_id_terms = terms; exported_id_fields = fields } let (as_exported_id_set : exported_ids FStar_Pervasives_Native.option -> - exported_id_kind -> - Prims.string FStar_Compiler_Set.t FStar_Compiler_Effect.ref) + exported_id_kind -> string_set FStar_Compiler_Effect.ref) = fun e -> match e with | FStar_Pervasives_Native.None -> exported_id_set_new () | FStar_Pervasives_Native.Some e1 -> - let terms = - let uu___ = - FStar_Compiler_Set.from_list FStar_Class_Ord.ord_string - e1.exported_id_terms in - FStar_Compiler_Util.mk_ref uu___ in - let fields = - let uu___ = - FStar_Compiler_Set.from_list FStar_Class_Ord.ord_string - e1.exported_id_fields in - FStar_Compiler_Util.mk_ref uu___ in + let terms = FStar_Compiler_Util.mk_ref e1.exported_id_terms in + let fields = FStar_Compiler_Util.mk_ref e1.exported_id_fields in (fun uu___ -> match uu___ with | Exported_id_term_type -> terms @@ -3584,11 +3561,9 @@ let (resolve_name : FStar_Pervasives_Native.Some (FStar_Pervasives.Inr fv) | uu___2 -> FStar_Pervasives_Native.None) | FStar_Pervasives_Native.Some (Eff_name (se, l)) -> - let uu___1 = delta_depth_of_declaration in - let uu___2 = - let uu___3 = + let uu___1 = + let uu___2 = FStar_Syntax_Syntax.lid_and_dd_as_fv l - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in - FStar_Pervasives.Inr uu___3 in - FStar_Pervasives_Native.Some uu___2 \ No newline at end of file + FStar_Pervasives.Inr uu___2 in + FStar_Pervasives_Native.Some uu___1 \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Free.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Free.ml index 29953fecb10..f0c44fa3cd7 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Free.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Free.ml @@ -85,7 +85,7 @@ let (uu___is_NoCache : use_cache_t -> Prims.bool) = let (uu___is_Full : use_cache_t -> Prims.bool) = fun projectee -> match projectee with | Full -> true | uu___ -> false type free_vars_and_fvars = - (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident FStar_Compiler_Set.set) + (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident FStar_Compiler_RBSet.t) let rec snoc : 'a . 'a FStar_Class_Deq.deq -> 'a Prims.list -> 'a -> 'a Prims.list = fun uu___ -> @@ -107,112 +107,200 @@ let op_At_At : fun ys -> FStar_Compiler_List.fold_left (fun xs1 -> fun y -> snoc uu___ xs1 y) xs ys -let (no_free_vars : - (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident FStar_Compiler_Set.t)) - = - let uu___ = FStar_Syntax_Syntax.new_fv_set () in - ({ - FStar_Syntax_Syntax.free_names = []; - FStar_Syntax_Syntax.free_uvars = []; - FStar_Syntax_Syntax.free_univs = []; - FStar_Syntax_Syntax.free_univ_names = [] - }, uu___) -let (singleton_fvar : - FStar_Syntax_Syntax.fv -> - (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident - FStar_Compiler_Set.set)) - = +let (no_free_vars : free_vars_and_fvars) = + let uu___ = + let uu___1 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) ()) in + let uu___2 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic (FStar_Compiler_FlatSet.setlike_flat_set ord_ctx_uvar)) + ()) in + let uu___3 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic (FStar_Compiler_FlatSet.setlike_flat_set ord_univ_uvar)) + ()) in + let uu___4 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) ()) in + { + FStar_Syntax_Syntax.free_names = uu___1; + FStar_Syntax_Syntax.free_uvars = uu___2; + FStar_Syntax_Syntax.free_univs = uu___3; + FStar_Syntax_Syntax.free_univ_names = uu___4 + } in + let uu___1 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset FStar_Syntax_Syntax.ord_fv)) + ()) in + (uu___, uu___1) +let (singleton_fvar : FStar_Syntax_Syntax.fv -> free_vars_and_fvars) = fun fv -> let uu___ = - let uu___1 = FStar_Syntax_Syntax.new_fv_set () in - FStar_Compiler_Set.add FStar_Syntax_Syntax.ord_fv - (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v uu___1 in + let uu___1 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_fv)) ()) in + Obj.magic + (FStar_Class_Setlike.add () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset FStar_Syntax_Syntax.ord_fv)) + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v + (Obj.magic uu___1)) in ((FStar_Pervasives_Native.fst no_free_vars), uu___) let (singleton_bv : FStar_Syntax_Syntax.bv -> - (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident FStar_Compiler_Set.t)) + (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident + FStar_Compiler_RBSet.t)) = fun x -> - ((let uu___ = FStar_Pervasives_Native.fst no_free_vars in + let uu___ = + let uu___1 = FStar_Pervasives_Native.fst no_free_vars in + let uu___2 = + Obj.magic + (FStar_Class_Setlike.singleton () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) x) in { - FStar_Syntax_Syntax.free_names = [x]; + FStar_Syntax_Syntax.free_names = uu___2; FStar_Syntax_Syntax.free_uvars = - (uu___.FStar_Syntax_Syntax.free_uvars); + (uu___1.FStar_Syntax_Syntax.free_uvars); FStar_Syntax_Syntax.free_univs = - (uu___.FStar_Syntax_Syntax.free_univs); + (uu___1.FStar_Syntax_Syntax.free_univs); FStar_Syntax_Syntax.free_univ_names = - (uu___.FStar_Syntax_Syntax.free_univ_names) - }), (FStar_Pervasives_Native.snd no_free_vars)) + (uu___1.FStar_Syntax_Syntax.free_univ_names) + } in + (uu___, (FStar_Pervasives_Native.snd no_free_vars)) let (singleton_uv : FStar_Syntax_Syntax.ctx_uvar -> - (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident FStar_Compiler_Set.t)) + (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident + FStar_Compiler_RBSet.t)) = fun x -> - ((let uu___ = FStar_Pervasives_Native.fst no_free_vars in + let uu___ = + let uu___1 = FStar_Pervasives_Native.fst no_free_vars in + let uu___2 = + Obj.magic + (FStar_Class_Setlike.singleton () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set ord_ctx_uvar)) x) in { FStar_Syntax_Syntax.free_names = - (uu___.FStar_Syntax_Syntax.free_names); - FStar_Syntax_Syntax.free_uvars = [x]; + (uu___1.FStar_Syntax_Syntax.free_names); + FStar_Syntax_Syntax.free_uvars = uu___2; FStar_Syntax_Syntax.free_univs = - (uu___.FStar_Syntax_Syntax.free_univs); + (uu___1.FStar_Syntax_Syntax.free_univs); FStar_Syntax_Syntax.free_univ_names = - (uu___.FStar_Syntax_Syntax.free_univ_names) - }), (FStar_Pervasives_Native.snd no_free_vars)) + (uu___1.FStar_Syntax_Syntax.free_univ_names) + } in + (uu___, (FStar_Pervasives_Native.snd no_free_vars)) let (singleton_univ : FStar_Syntax_Syntax.universe_uvar -> - (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident FStar_Compiler_Set.t)) + (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident + FStar_Compiler_RBSet.t)) = fun x -> - ((let uu___ = FStar_Pervasives_Native.fst no_free_vars in + let uu___ = + let uu___1 = FStar_Pervasives_Native.fst no_free_vars in + let uu___2 = + Obj.magic + (FStar_Class_Setlike.singleton () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set ord_univ_uvar)) x) in { FStar_Syntax_Syntax.free_names = - (uu___.FStar_Syntax_Syntax.free_names); + (uu___1.FStar_Syntax_Syntax.free_names); FStar_Syntax_Syntax.free_uvars = - (uu___.FStar_Syntax_Syntax.free_uvars); - FStar_Syntax_Syntax.free_univs = [x]; + (uu___1.FStar_Syntax_Syntax.free_uvars); + FStar_Syntax_Syntax.free_univs = uu___2; FStar_Syntax_Syntax.free_univ_names = - (uu___.FStar_Syntax_Syntax.free_univ_names) - }), (FStar_Pervasives_Native.snd no_free_vars)) + (uu___1.FStar_Syntax_Syntax.free_univ_names) + } in + (uu___, (FStar_Pervasives_Native.snd no_free_vars)) let (singleton_univ_name : FStar_Syntax_Syntax.univ_name -> - (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident FStar_Compiler_Set.t)) + (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident + FStar_Compiler_RBSet.t)) = fun x -> - ((let uu___ = FStar_Pervasives_Native.fst no_free_vars in + let uu___ = + let uu___1 = FStar_Pervasives_Native.fst no_free_vars in + let uu___2 = + Obj.magic + (FStar_Class_Setlike.singleton () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) x) in { FStar_Syntax_Syntax.free_names = - (uu___.FStar_Syntax_Syntax.free_names); + (uu___1.FStar_Syntax_Syntax.free_names); FStar_Syntax_Syntax.free_uvars = - (uu___.FStar_Syntax_Syntax.free_uvars); + (uu___1.FStar_Syntax_Syntax.free_uvars); FStar_Syntax_Syntax.free_univs = - (uu___.FStar_Syntax_Syntax.free_univs); - FStar_Syntax_Syntax.free_univ_names = [x] - }), (FStar_Pervasives_Native.snd no_free_vars)) -let (union : + (uu___1.FStar_Syntax_Syntax.free_univs); + FStar_Syntax_Syntax.free_univ_names = uu___2 + } in + (uu___, (FStar_Pervasives_Native.snd no_free_vars)) +let (op_Plus_Plus : free_vars_and_fvars -> free_vars_and_fvars -> (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident - FStar_Compiler_Set.set)) + FStar_Compiler_RBSet.t)) = fun f1 -> fun f2 -> let uu___ = let uu___1 = - op_At_At FStar_Syntax_Syntax.deq_bv - (FStar_Pervasives_Native.fst f1).FStar_Syntax_Syntax.free_names - (FStar_Pervasives_Native.fst f2).FStar_Syntax_Syntax.free_names in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic + (FStar_Pervasives_Native.fst f1).FStar_Syntax_Syntax.free_names) + (Obj.magic + (FStar_Pervasives_Native.fst f2).FStar_Syntax_Syntax.free_names)) in let uu___2 = - op_At_At deq_ctx_uvar - (FStar_Pervasives_Native.fst f1).FStar_Syntax_Syntax.free_uvars - (FStar_Pervasives_Native.fst f2).FStar_Syntax_Syntax.free_uvars in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set ord_ctx_uvar)) + (Obj.magic + (FStar_Pervasives_Native.fst f1).FStar_Syntax_Syntax.free_uvars) + (Obj.magic + (FStar_Pervasives_Native.fst f2).FStar_Syntax_Syntax.free_uvars)) in let uu___3 = - op_At_At deq_univ_uvar - (FStar_Pervasives_Native.fst f1).FStar_Syntax_Syntax.free_univs - (FStar_Pervasives_Native.fst f2).FStar_Syntax_Syntax.free_univs in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set ord_univ_uvar)) + (Obj.magic + (FStar_Pervasives_Native.fst f1).FStar_Syntax_Syntax.free_univs) + (Obj.magic + (FStar_Pervasives_Native.fst f2).FStar_Syntax_Syntax.free_univs)) in let uu___4 = - op_At_At FStar_Syntax_Syntax.deq_univ_name - (FStar_Pervasives_Native.fst f1).FStar_Syntax_Syntax.free_univ_names - (FStar_Pervasives_Native.fst f2).FStar_Syntax_Syntax.free_univ_names in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) + (Obj.magic + (FStar_Pervasives_Native.fst f1).FStar_Syntax_Syntax.free_univ_names) + (Obj.magic + (FStar_Pervasives_Native.fst f2).FStar_Syntax_Syntax.free_univ_names)) in { FStar_Syntax_Syntax.free_names = uu___1; FStar_Syntax_Syntax.free_uvars = uu___2; @@ -220,8 +308,13 @@ let (union : FStar_Syntax_Syntax.free_univ_names = uu___4 } in let uu___1 = - FStar_Compiler_Set.union FStar_Syntax_Syntax.ord_fv - (FStar_Pervasives_Native.snd f1) (FStar_Pervasives_Native.snd f2) in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_fv)) + (Obj.magic (FStar_Pervasives_Native.snd f1)) + (Obj.magic (FStar_Pervasives_Native.snd f2))) in (uu___, uu___1) let rec (free_univs : FStar_Syntax_Syntax.universe -> free_vars_and_fvars) = fun u -> @@ -234,7 +327,8 @@ let rec (free_univs : FStar_Syntax_Syntax.universe -> free_vars_and_fvars) = | FStar_Syntax_Syntax.U_succ u1 -> free_univs u1 | FStar_Syntax_Syntax.U_max us -> FStar_Compiler_List.fold_left - (fun out -> fun x -> let uu___1 = free_univs x in union out uu___1) + (fun out -> + fun x -> let uu___1 = free_univs x in op_Plus_Plus out uu___1) no_free_vars us | FStar_Syntax_Syntax.U_unif u1 -> singleton_univ u1 let rec (free_names_and_uvs' : @@ -243,20 +337,21 @@ let rec (free_names_and_uvs' : fun use_cache -> let aux_binders bs from_body = let from_binders = free_names_and_uvars_binders bs use_cache in - union from_binders from_body in + op_Plus_Plus from_binders from_body in let t = FStar_Syntax_Subst.compress tm in match t.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_delayed uu___ -> FStar_Compiler_Effect.failwith "Impossible" | FStar_Syntax_Syntax.Tm_name x -> singleton_bv x | FStar_Syntax_Syntax.Tm_uvar (uv, (s, uu___)) -> - let uu___1 = + let uu___1 = singleton_uv uv in + let uu___2 = if use_cache = Full then - let uu___2 = ctx_uvar_typ uv in - free_names_and_uvars uu___2 use_cache + let uu___3 = ctx_uvar_typ uv in + free_names_and_uvars uu___3 use_cache else no_free_vars in - union (singleton_uv uv) uu___1 + op_Plus_Plus uu___1 uu___2 | FStar_Syntax_Syntax.Tm_type u -> free_univs u | FStar_Syntax_Syntax.Tm_bvar uu___ -> no_free_vars | FStar_Syntax_Syntax.Tm_fvar fv -> singleton_fvar fv @@ -266,8 +361,9 @@ let rec (free_names_and_uvs' : | FStar_Syntax_Syntax.Tm_uinst (t1, us) -> let f = free_names_and_uvars t1 use_cache in FStar_Compiler_List.fold_left - (fun out -> fun u -> let uu___ = free_univs u in union out uu___) - f us + (fun out -> + fun u -> let uu___ = free_univs u in op_Plus_Plus out uu___) f + us | FStar_Syntax_Syntax.Tm_abs { FStar_Syntax_Syntax.bs = bs; FStar_Syntax_Syntax.body = t1; FStar_Syntax_Syntax.rc_opt = ropt;_} @@ -284,7 +380,7 @@ let rec (free_names_and_uvs' : FStar_Syntax_Syntax.residual_flags = uu___3;_} -> free_names_and_uvars t2 use_cache | uu___2 -> no_free_vars in - union uu___ uu___1 + op_Plus_Plus uu___ uu___1 | FStar_Syntax_Syntax.Tm_arrow { FStar_Syntax_Syntax.bs1 = bs; FStar_Syntax_Syntax.comp = c;_} -> let uu___ = free_names_and_uvars_comp c use_cache in @@ -304,46 +400,59 @@ let rec (free_names_and_uvs' : { FStar_Syntax_Syntax.scrutinee = t1; FStar_Syntax_Syntax.ret_opt = asc_opt; FStar_Syntax_Syntax.brs = pats; - FStar_Syntax_Syntax.rc_opt1 = uu___;_} + FStar_Syntax_Syntax.rc_opt1 = rc_opt;_} -> + let uu___ = + match rc_opt with + | FStar_Pervasives_Native.Some + { FStar_Syntax_Syntax.residual_effect = uu___1; + FStar_Syntax_Syntax.residual_typ = + FStar_Pervasives_Native.Some t2; + FStar_Syntax_Syntax.residual_flags = uu___2;_} + -> free_names_and_uvars t2 use_cache + | uu___1 -> no_free_vars in let uu___1 = - let uu___2 = free_names_and_uvars t1 use_cache in - let uu___3 = - match asc_opt with - | FStar_Pervasives_Native.None -> no_free_vars - | FStar_Pervasives_Native.Some (b, asc) -> - let uu___4 = free_names_and_uvars_binders [b] use_cache in - let uu___5 = free_names_and_uvars_ascription asc use_cache in - union uu___4 uu___5 in - union uu___2 uu___3 in - FStar_Compiler_List.fold_left - (fun n -> - fun uu___2 -> - match uu___2 with - | (p, wopt, t2) -> - let n1 = - match wopt with - | FStar_Pervasives_Native.None -> no_free_vars - | FStar_Pervasives_Native.Some w -> - free_names_and_uvars w use_cache in - let n2 = free_names_and_uvars t2 use_cache in - let n3 = - let uu___3 = FStar_Syntax_Syntax.pat_bvs p in - FStar_Compiler_List.fold_left - (fun n4 -> - fun x -> - let uu___4 = - free_names_and_uvars - x.FStar_Syntax_Syntax.sort use_cache in - union n4 uu___4) n uu___3 in - let uu___3 = union n1 n2 in union n3 uu___3) uu___1 pats + let uu___2 = + let uu___3 = free_names_and_uvars t1 use_cache in + let uu___4 = + match asc_opt with + | FStar_Pervasives_Native.None -> no_free_vars + | FStar_Pervasives_Native.Some (b, asc) -> + let uu___5 = free_names_and_uvars_binders [b] use_cache in + let uu___6 = + free_names_and_uvars_ascription asc use_cache in + op_Plus_Plus uu___5 uu___6 in + op_Plus_Plus uu___3 uu___4 in + FStar_Compiler_List.fold_left + (fun n -> + fun uu___3 -> + match uu___3 with + | (p, wopt, t2) -> + let n1 = + match wopt with + | FStar_Pervasives_Native.None -> no_free_vars + | FStar_Pervasives_Native.Some w -> + free_names_and_uvars w use_cache in + let n2 = free_names_and_uvars t2 use_cache in + let n3 = + let uu___4 = FStar_Syntax_Syntax.pat_bvs p in + FStar_Compiler_List.fold_left + (fun n4 -> + fun x -> + let uu___5 = + free_names_and_uvars + x.FStar_Syntax_Syntax.sort use_cache in + op_Plus_Plus n4 uu___5) n uu___4 in + let uu___4 = op_Plus_Plus n3 n1 in + op_Plus_Plus uu___4 n2) uu___2 pats in + op_Plus_Plus uu___ uu___1 | FStar_Syntax_Syntax.Tm_ascribed { FStar_Syntax_Syntax.tm = t1; FStar_Syntax_Syntax.asc = asc; FStar_Syntax_Syntax.eff_opt = uu___;_} -> let uu___1 = free_names_and_uvars t1 use_cache in let uu___2 = free_names_and_uvars_ascription asc use_cache in - union uu___1 uu___2 + op_Plus_Plus uu___1 uu___2 | FStar_Syntax_Syntax.Tm_let { FStar_Syntax_Syntax.lbs = lbs; FStar_Syntax_Syntax.body1 = t1;_} -> @@ -355,11 +464,12 @@ let rec (free_names_and_uvs' : let uu___2 = free_names_and_uvars lb.FStar_Syntax_Syntax.lbtyp use_cache in - let uu___3 = - free_names_and_uvars lb.FStar_Syntax_Syntax.lbdef - use_cache in - union uu___2 uu___3 in - union n uu___1) uu___ (FStar_Pervasives_Native.snd lbs) + op_Plus_Plus n uu___2 in + let uu___2 = + free_names_and_uvars lb.FStar_Syntax_Syntax.lbdef + use_cache in + op_Plus_Plus uu___1 uu___2) uu___ + (FStar_Pervasives_Native.snd lbs) | FStar_Syntax_Syntax.Tm_quoted (tm1, qi) -> (match qi.FStar_Syntax_Syntax.qkind with | FStar_Syntax_Syntax.Quote_static -> @@ -367,7 +477,7 @@ let rec (free_names_and_uvs' : (fun n -> fun t1 -> let uu___ = free_names_and_uvars t1 use_cache in - union n uu___) no_free_vars + op_Plus_Plus n uu___) no_free_vars (FStar_Pervasives_Native.snd qi.FStar_Syntax_Syntax.antiquotations) | FStar_Syntax_Syntax.Quote_dynamic -> @@ -383,10 +493,10 @@ let rec (free_names_and_uvs' : args u1 | FStar_Syntax_Syntax.Meta_monadic (uu___, t') -> let uu___1 = free_names_and_uvars t' use_cache in - union u1 uu___1 + op_Plus_Plus u1 uu___1 | FStar_Syntax_Syntax.Meta_monadic_lift (uu___, uu___1, t') -> let uu___2 = free_names_and_uvars t' use_cache in - union u1 uu___2 + op_Plus_Plus u1 uu___2 | FStar_Syntax_Syntax.Meta_labeled uu___ -> u1 | FStar_Syntax_Syntax.Meta_desugared uu___ -> u1 | FStar_Syntax_Syntax.Meta_named uu___ -> u1) @@ -401,7 +511,7 @@ and (free_names_and_uvars_binders : free_names_and_uvars (b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort use_cache in - union n uu___) no_free_vars bs + op_Plus_Plus n uu___) no_free_vars bs and (free_names_and_uvars_ascription : ((FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax, FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax) @@ -423,7 +533,7 @@ and (free_names_and_uvars_ascription : | FStar_Pervasives_Native.None -> no_free_vars | FStar_Pervasives_Native.Some tac -> free_names_and_uvars tac use_cache in - union uu___2 uu___3 + op_Plus_Plus uu___2 uu___3 and (free_names_and_uvars : FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> use_cache_t -> free_vars_and_fvars) @@ -436,7 +546,13 @@ and (free_names_and_uvars : | FStar_Pervasives_Native.Some n when let uu___1 = should_invalidate_cache n use_cache in Prims.op_Negation uu___1 -> - let uu___1 = FStar_Syntax_Syntax.new_fv_set () in (n, uu___1) + let uu___1 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_fv)) ()) in + (n, uu___1) | uu___1 -> (FStar_Compiler_Effect.op_Colon_Equals t1.FStar_Syntax_Syntax.vars FStar_Pervasives_Native.None; @@ -451,12 +567,7 @@ and (free_names_and_uvars : and (free_names_and_uvars_args : (FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax * FStar_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option) - Prims.list -> - (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident - FStar_Compiler_Set.set) -> - use_cache_t -> - (FStar_Syntax_Syntax.free_vars * FStar_Ident.lident - FStar_Compiler_Set.set)) + Prims.list -> free_vars_and_fvars -> use_cache_t -> free_vars_and_fvars) = fun args -> fun acc -> @@ -467,7 +578,7 @@ and (free_names_and_uvars_args : match uu___ with | (x, uu___1) -> let uu___2 = free_names_and_uvars x use_cache in - union n uu___2) acc args + op_Plus_Plus n uu___2) acc args and (free_names_and_uvars_comp : FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax -> use_cache_t -> free_vars_and_fvars) @@ -484,7 +595,13 @@ and (free_names_and_uvars_comp : FStar_Pervasives_Native.None; free_names_and_uvars_comp c use_cache) else - (let uu___3 = FStar_Syntax_Syntax.new_fv_set () in (n, uu___3)) + (let uu___3 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_fv)) ()) in + (n, uu___3)) | uu___1 -> let n = match c.FStar_Syntax_Syntax.n with @@ -508,13 +625,14 @@ and (free_names_and_uvars_comp : let uu___2 = free_names_and_uvars ct.FStar_Syntax_Syntax.result_typ use_cache in - union uu___2 decreases_vars in + op_Plus_Plus uu___2 decreases_vars in let us1 = free_names_and_uvars_args ct.FStar_Syntax_Syntax.effect_args us use_cache in FStar_Compiler_List.fold_left (fun us2 -> - fun u -> let uu___2 = free_univs u in union us2 uu___2) + fun u -> + let uu___2 = free_univs u in op_Plus_Plus us2 uu___2) us1 ct.FStar_Syntax_Syntax.comp_univs in (FStar_Compiler_Effect.op_Colon_Equals c.FStar_Syntax_Syntax.vars (FStar_Pervasives_Native.Some (FStar_Pervasives_Native.fst n)); @@ -530,127 +648,108 @@ and (free_names_and_uvars_dec_order : (fun acc -> fun t -> let uu___ = free_names_and_uvars t use_cache in - union acc uu___) no_free_vars l + op_Plus_Plus acc uu___) no_free_vars l | FStar_Syntax_Syntax.Decreases_wf (rel, e) -> let uu___ = free_names_and_uvars rel use_cache in - let uu___1 = free_names_and_uvars e use_cache in union uu___ uu___1 + let uu___1 = free_names_and_uvars e use_cache in + op_Plus_Plus uu___ uu___1 and (should_invalidate_cache : FStar_Syntax_Syntax.free_vars -> use_cache_t -> Prims.bool) = fun n -> fun use_cache -> ((use_cache <> Def) || - (FStar_Compiler_Util.for_some + (FStar_Class_Setlike.for_any () + (Obj.magic (FStar_Compiler_FlatSet.setlike_flat_set ord_ctx_uvar)) (fun u -> let uu___ = FStar_Syntax_Unionfind.find u.FStar_Syntax_Syntax.ctx_uvar_head in match uu___ with | FStar_Pervasives_Native.Some uu___1 -> true - | uu___1 -> false) n.FStar_Syntax_Syntax.free_uvars)) + | uu___1 -> false) + (Obj.magic n.FStar_Syntax_Syntax.free_uvars))) || - (FStar_Compiler_Util.for_some + (FStar_Class_Setlike.for_any () + (Obj.magic (FStar_Compiler_FlatSet.setlike_flat_set ord_univ_uvar)) (fun u -> let uu___ = FStar_Syntax_Unionfind.univ_find u in match uu___ with | FStar_Pervasives_Native.Some uu___1 -> true | FStar_Pervasives_Native.None -> false) - n.FStar_Syntax_Syntax.free_univs) -let (new_uv_set : unit -> FStar_Syntax_Syntax.uvars) = - fun uu___ -> FStar_Compiler_Set.empty ord_ctx_uvar () -let (new_universe_uvar_set : - unit -> FStar_Syntax_Syntax.universe_uvar FStar_Compiler_Set.set) = - fun uu___ -> FStar_Compiler_Set.empty ord_univ_uvar () -let (empty : FStar_Syntax_Syntax.bv FStar_Compiler_Set.set) = - FStar_Compiler_Set.empty FStar_Syntax_Syntax.ord_bv () + (Obj.magic n.FStar_Syntax_Syntax.free_univs)) let (names : - FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.bv FStar_Compiler_Set.set) + FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.t) = fun t -> let uu___ = - let uu___1 = - let uu___2 = free_names_and_uvars t Def in - FStar_Pervasives_Native.fst uu___2 in - uu___1.FStar_Syntax_Syntax.free_names in - FStar_Compiler_Set.from_list FStar_Syntax_Syntax.ord_bv uu___ + let uu___1 = free_names_and_uvars t Def in + FStar_Pervasives_Native.fst uu___1 in + uu___.FStar_Syntax_Syntax.free_names let (uvars : FStar_Syntax_Syntax.term -> - FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_Set.set) + FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_FlatSet.t) = fun t -> let uu___ = - let uu___1 = - let uu___2 = free_names_and_uvars t Def in - FStar_Pervasives_Native.fst uu___2 in - uu___1.FStar_Syntax_Syntax.free_uvars in - FStar_Compiler_Set.from_list ord_ctx_uvar uu___ + let uu___1 = free_names_and_uvars t Def in + FStar_Pervasives_Native.fst uu___1 in + uu___.FStar_Syntax_Syntax.free_uvars let (univs : FStar_Syntax_Syntax.term -> - FStar_Syntax_Syntax.universe_uvar FStar_Compiler_Set.set) + FStar_Syntax_Syntax.universe_uvar FStar_Compiler_FlatSet.t) = fun t -> let uu___ = - let uu___1 = - let uu___2 = free_names_and_uvars t Def in - FStar_Pervasives_Native.fst uu___2 in - uu___1.FStar_Syntax_Syntax.free_univs in - FStar_Compiler_Set.from_list ord_univ_uvar uu___ + let uu___1 = free_names_and_uvars t Def in + FStar_Pervasives_Native.fst uu___1 in + uu___.FStar_Syntax_Syntax.free_univs let (univnames : FStar_Syntax_Syntax.term -> - FStar_Syntax_Syntax.univ_name FStar_Compiler_Set.set) + FStar_Syntax_Syntax.univ_name FStar_Compiler_FlatSet.t) = fun t -> let uu___ = - let uu___1 = - let uu___2 = free_names_and_uvars t Def in - FStar_Pervasives_Native.fst uu___2 in - uu___1.FStar_Syntax_Syntax.free_univ_names in - FStar_Compiler_Set.from_list FStar_Syntax_Syntax.ord_ident uu___ + let uu___1 = free_names_and_uvars t Def in + FStar_Pervasives_Native.fst uu___1 in + uu___.FStar_Syntax_Syntax.free_univ_names let (univnames_comp : FStar_Syntax_Syntax.comp -> - FStar_Syntax_Syntax.univ_name FStar_Compiler_Set.set) + FStar_Syntax_Syntax.univ_name FStar_Compiler_FlatSet.t) = fun c -> let uu___ = - let uu___1 = - let uu___2 = free_names_and_uvars_comp c Def in - FStar_Pervasives_Native.fst uu___2 in - uu___1.FStar_Syntax_Syntax.free_univ_names in - FStar_Compiler_Set.from_list FStar_Syntax_Syntax.ord_ident uu___ + let uu___1 = free_names_and_uvars_comp c Def in + FStar_Pervasives_Native.fst uu___1 in + uu___.FStar_Syntax_Syntax.free_univ_names let (fvars : - FStar_Syntax_Syntax.term -> FStar_Ident.lident FStar_Compiler_Set.set) = + FStar_Syntax_Syntax.term -> FStar_Ident.lident FStar_Compiler_RBSet.t) = fun t -> let uu___ = free_names_and_uvars t NoCache in FStar_Pervasives_Native.snd uu___ let (names_of_binders : FStar_Syntax_Syntax.binders -> - FStar_Syntax_Syntax.bv FStar_Compiler_Set.set) + FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.t) = fun bs -> let uu___ = - let uu___1 = - let uu___2 = free_names_and_uvars_binders bs Def in - FStar_Pervasives_Native.fst uu___2 in - uu___1.FStar_Syntax_Syntax.free_names in - FStar_Compiler_Set.from_list FStar_Syntax_Syntax.ord_bv uu___ + let uu___1 = free_names_and_uvars_binders bs Def in + FStar_Pervasives_Native.fst uu___1 in + uu___.FStar_Syntax_Syntax.free_names let (uvars_uncached : FStar_Syntax_Syntax.term -> - FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_Set.set) + FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_FlatSet.t) = fun t -> let uu___ = - let uu___1 = - let uu___2 = free_names_and_uvars t NoCache in - FStar_Pervasives_Native.fst uu___2 in - uu___1.FStar_Syntax_Syntax.free_uvars in - FStar_Compiler_Set.from_list ord_ctx_uvar uu___ + let uu___1 = free_names_and_uvars t NoCache in + FStar_Pervasives_Native.fst uu___1 in + uu___.FStar_Syntax_Syntax.free_uvars let (uvars_full : FStar_Syntax_Syntax.term -> - FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_Set.set) + FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_FlatSet.t) = fun t -> let uu___ = - let uu___1 = - let uu___2 = free_names_and_uvars t Full in - FStar_Pervasives_Native.fst uu___2 in - uu___1.FStar_Syntax_Syntax.free_uvars in - FStar_Compiler_Set.from_list ord_ctx_uvar uu___ \ No newline at end of file + let uu___1 = free_names_and_uvars t Full in + FStar_Pervasives_Native.fst uu___1 in + uu___.FStar_Syntax_Syntax.free_uvars \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Hash.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Hash.ml index f4ee30207aa..70fca371d54 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Hash.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Hash.ml @@ -83,6 +83,15 @@ let hash_option : let uu___1 = FStar_Hash.of_int (Prims.of_int (1249)) in ret uu___1 in let uu___1 = h o1 in mix uu___ uu___1 +let (hash_doc : FStar_Pprint.document -> FStar_Hash.hash_code mm) = + fun d -> + let uu___ = + FStar_Pprint.pretty_string (FStar_Compiler_Util.float_of_string "1.0") + (Prims.of_int (80)) d in + of_string uu___ +let (hash_doc_list : + FStar_Pprint.document Prims.list -> FStar_Hash.hash_code mm) = + fun ds -> hash_list hash_doc ds let hash_pair : 'a 'b . ('a -> FStar_Hash.hash_code mm) -> @@ -579,7 +588,7 @@ and (hash_meta : FStar_Syntax_Syntax.metadata -> FStar_Hash.hash_code mm) = let uu___1 = let uu___2 = of_int (Prims.of_int (1031)) in let uu___3 = - let uu___4 = of_string s in + let uu___4 = hash_doc_list s in let uu___5 = let uu___6 = let uu___7 = FStar_Compiler_Range_Ops.string_of_range r in diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_MutRecTy.ml b/ocaml/fstar-lib/generated/FStar_Syntax_MutRecTy.ml index 4d998fe1010..5523021bbb0 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_MutRecTy.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_MutRecTy.ml @@ -353,7 +353,9 @@ let (disentangle_abbrevs_from_bundle : FStar_Syntax_Syntax.num_uniform_params = num_uniform; FStar_Syntax_Syntax.t = ty; FStar_Syntax_Syntax.mutuals = mut; - FStar_Syntax_Syntax.ds = dc;_} + FStar_Syntax_Syntax.ds = dc; + FStar_Syntax_Syntax.injective_type_params = + injective_type_params;_} -> let bnd' = FStar_Syntax_InstFV.inst_binders unfold_fv bnd in @@ -370,7 +372,9 @@ let (disentangle_abbrevs_from_bundle : num_uniform; FStar_Syntax_Syntax.t = ty'; FStar_Syntax_Syntax.mutuals = mut'; - FStar_Syntax_Syntax.ds = dc + FStar_Syntax_Syntax.ds = dc; + FStar_Syntax_Syntax.injective_type_params = + injective_type_params }); FStar_Syntax_Syntax.sigrng = (x.FStar_Syntax_Syntax.sigrng); @@ -391,7 +395,9 @@ let (disentangle_abbrevs_from_bundle : FStar_Syntax_Syntax.t1 = ty; FStar_Syntax_Syntax.ty_lid = res; FStar_Syntax_Syntax.num_ty_params = npars; - FStar_Syntax_Syntax.mutuals1 = mut;_} + FStar_Syntax_Syntax.mutuals1 = mut; + FStar_Syntax_Syntax.injective_type_params1 = + injective_type_params;_} -> let ty' = FStar_Syntax_InstFV.inst unfold_fv ty in let mut' = filter_out_type_abbrevs mut in @@ -404,7 +410,9 @@ let (disentangle_abbrevs_from_bundle : FStar_Syntax_Syntax.t1 = ty'; FStar_Syntax_Syntax.ty_lid = res; FStar_Syntax_Syntax.num_ty_params = npars; - FStar_Syntax_Syntax.mutuals1 = mut' + FStar_Syntax_Syntax.mutuals1 = mut'; + FStar_Syntax_Syntax.injective_type_params1 = + injective_type_params }); FStar_Syntax_Syntax.sigrng = (x.FStar_Syntax_Syntax.sigrng); diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Print.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Print.ml index 930a25fe49b..1c969625188 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Print.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Print.ml @@ -417,10 +417,11 @@ and (term_to_string : FStar_Syntax_Syntax.term -> Prims.string) = FStar_Syntax_Syntax.meta = FStar_Syntax_Syntax.Meta_labeled (l, r, b);_} -> - let uu___3 = FStar_Compiler_Range_Ops.string_of_range r in - let uu___4 = term_to_string t in - FStar_Compiler_Util.format3 "Meta_labeled(%s, %s){%s}" l - uu___3 uu___4 + let uu___3 = FStar_Errors_Msg.rendermsg l in + let uu___4 = FStar_Compiler_Range_Ops.string_of_range r in + let uu___5 = term_to_string t in + FStar_Compiler_Util.format3 "Meta_labeled(%s, %s){%s}" uu___3 + uu___4 uu___5 | FStar_Syntax_Syntax.Tm_meta { FStar_Syntax_Syntax.tm2 = t; FStar_Syntax_Syntax.meta = FStar_Syntax_Syntax.Meta_named l;_} @@ -1111,8 +1112,9 @@ and (metadata_to_string : FStar_Syntax_Syntax.metadata -> Prims.string) = let uu___1 = sli lid in FStar_Compiler_Util.format1 "{Meta_named %s}" uu___1 | FStar_Syntax_Syntax.Meta_labeled (l, r, uu___1) -> - let uu___2 = FStar_Compiler_Range_Ops.string_of_range r in - FStar_Compiler_Util.format2 "{Meta_labeled (%s, %s)}" l uu___2 + let uu___2 = FStar_Errors_Msg.rendermsg l in + let uu___3 = FStar_Compiler_Range_Ops.string_of_range r in + FStar_Compiler_Util.format2 "{Meta_labeled (%s, %s)}" uu___2 uu___3 | FStar_Syntax_Syntax.Meta_desugared msi -> "{Meta_desugared}" | FStar_Syntax_Syntax.Meta_monadic (m, t) -> let uu___1 = sli m in @@ -1128,6 +1130,8 @@ let (aqual_to_string : FStar_Syntax_Syntax.aqual -> Prims.string) = fun aq -> aqual_to_string' "" aq let (bqual_to_string : FStar_Syntax_Syntax.bqual -> Prims.string) = fun bq -> bqual_to_string' "" bq +let (lb_to_string : FStar_Syntax_Syntax.letbinding -> Prims.string) = + fun lb -> lbs_to_string [] (false, [lb]) let (comp_to_string' : FStar_Syntax_DsEnv.env -> FStar_Syntax_Syntax.comp -> Prims.string) = fun env -> @@ -1450,41 +1454,43 @@ let rec (sigelt_to_string : FStar_Syntax_Syntax.sigelt -> Prims.string) = FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = uu___3; - FStar_Syntax_Syntax.ds = uu___4;_} + FStar_Syntax_Syntax.ds = uu___4; + FStar_Syntax_Syntax.injective_type_params = uu___5;_} -> let quals_str = quals_to_string' x.FStar_Syntax_Syntax.sigquals in let binders_str = binders_to_string " " tps in let term_str = term_to_string k in - let uu___5 = FStar_Options.print_universes () in - if uu___5 + let uu___6 = FStar_Options.print_universes () in + if uu___6 then - let uu___6 = FStar_Ident.string_of_lid lid in - let uu___7 = univ_names_to_string univs in + let uu___7 = FStar_Ident.string_of_lid lid in + let uu___8 = univ_names_to_string univs in FStar_Compiler_Util.format5 "%stype %s<%s> %s : %s" quals_str - uu___6 uu___7 binders_str term_str + uu___7 uu___8 binders_str term_str else - (let uu___7 = FStar_Ident.string_of_lid lid in + (let uu___8 = FStar_Ident.string_of_lid lid in FStar_Compiler_Util.format4 "%stype %s %s : %s" quals_str - uu___7 binders_str term_str) + uu___8 binders_str term_str) | FStar_Syntax_Syntax.Sig_datacon { FStar_Syntax_Syntax.lid1 = lid; FStar_Syntax_Syntax.us1 = univs; FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___2; FStar_Syntax_Syntax.num_ty_params = uu___3; - FStar_Syntax_Syntax.mutuals1 = uu___4;_} + FStar_Syntax_Syntax.mutuals1 = uu___4; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_} -> - let uu___5 = FStar_Options.print_universes () in - if uu___5 + let uu___6 = FStar_Options.print_universes () in + if uu___6 then - let uu___6 = univ_names_to_string univs in - let uu___7 = FStar_Ident.string_of_lid lid in - let uu___8 = term_to_string t in - FStar_Compiler_Util.format3 "datacon<%s> %s : %s" uu___6 - uu___7 uu___8 + let uu___7 = univ_names_to_string univs in + let uu___8 = FStar_Ident.string_of_lid lid in + let uu___9 = term_to_string t in + FStar_Compiler_Util.format3 "datacon<%s> %s : %s" uu___7 + uu___8 uu___9 else - (let uu___7 = FStar_Ident.string_of_lid lid in - let uu___8 = term_to_string t in - FStar_Compiler_Util.format2 "datacon %s : %s" uu___7 uu___8) + (let uu___8 = FStar_Ident.string_of_lid lid in + let uu___9 = term_to_string t in + FStar_Compiler_Util.format2 "datacon %s : %s" uu___8 uu___9) | FStar_Syntax_Syntax.Sig_declare_typ { FStar_Syntax_Syntax.lid2 = lid; FStar_Syntax_Syntax.us2 = univs; FStar_Syntax_Syntax.t2 = t;_} @@ -1726,20 +1732,22 @@ let rec (sigelt_to_string_short : FStar_Syntax_Syntax.sigelt -> Prims.string) FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = uu___3; FStar_Syntax_Syntax.mutuals = uu___4; - FStar_Syntax_Syntax.ds = uu___5;_} + FStar_Syntax_Syntax.ds = uu___5; + FStar_Syntax_Syntax.injective_type_params = uu___6;_} -> - let uu___6 = FStar_Ident.string_of_lid lid in - FStar_Compiler_Util.format1 "type %s" uu___6 + let uu___7 = FStar_Ident.string_of_lid lid in + FStar_Compiler_Util.format1 "type %s" uu___7 | FStar_Syntax_Syntax.Sig_datacon { FStar_Syntax_Syntax.lid1 = lid; FStar_Syntax_Syntax.us1 = uu___; FStar_Syntax_Syntax.t1 = uu___1; FStar_Syntax_Syntax.ty_lid = t_lid; FStar_Syntax_Syntax.num_ty_params = uu___2; - FStar_Syntax_Syntax.mutuals1 = uu___3;_} + FStar_Syntax_Syntax.mutuals1 = uu___3; + FStar_Syntax_Syntax.injective_type_params1 = uu___4;_} -> - let uu___4 = FStar_Ident.string_of_lid lid in - let uu___5 = FStar_Ident.string_of_lid t_lid in - FStar_Compiler_Util.format2 "datacon %s for type %s" uu___4 uu___5 + let uu___5 = FStar_Ident.string_of_lid lid in + let uu___6 = FStar_Ident.string_of_lid t_lid in + FStar_Compiler_Util.format2 "datacon %s for type %s" uu___5 uu___6 | FStar_Syntax_Syntax.Sig_assume { FStar_Syntax_Syntax.lid3 = lid; FStar_Syntax_Syntax.us3 = uu___; FStar_Syntax_Syntax.phi1 = uu___1;_} @@ -1981,6 +1989,13 @@ let (showable_branch : FStar_Syntax_Syntax.branch FStar_Class_Show.showable) let (showable_qualifier : FStar_Syntax_Syntax.qualifier FStar_Class_Show.showable) = { FStar_Class_Show.show = qual_to_string } +let (showable_pat : FStar_Syntax_Syntax.pat FStar_Class_Show.showable) = + { FStar_Class_Show.show = pat_to_string } +let (showable_const : FStar_Const.sconst FStar_Class_Show.showable) = + { FStar_Class_Show.show = const_to_string } +let (showable_letbinding : + FStar_Syntax_Syntax.letbinding FStar_Class_Show.showable) = + { FStar_Class_Show.show = lb_to_string } let (pretty_term : FStar_Syntax_Syntax.term FStar_Class_PP.pretty) = { FStar_Class_PP.pp = term_to_doc } let (pretty_univ : FStar_Syntax_Syntax.universe FStar_Class_PP.pretty) = @@ -2009,4 +2024,27 @@ let (pretty_binder : FStar_Syntax_Syntax.binder FStar_Class_PP.pretty) = (fun x -> let uu___ = FStar_Class_Show.show showable_binder x in FStar_Pprint.doc_of_string uu___) + } +let (pretty_bv : FStar_Syntax_Syntax.bv FStar_Class_PP.pretty) = + { + FStar_Class_PP.pp = + (fun x -> + let uu___ = FStar_Class_Show.show showable_bv x in + FStar_Pprint.doc_of_string uu___) + } +let (pretty_binding : FStar_Syntax_Syntax.binding FStar_Class_PP.pretty) = + { + FStar_Class_PP.pp = + (fun uu___ -> + match uu___ with + | FStar_Syntax_Syntax.Binding_var bv -> + FStar_Class_PP.pp pretty_bv bv + | FStar_Syntax_Syntax.Binding_lid (l, (us, t)) -> + let uu___1 = FStar_Class_PP.pp FStar_Ident.pretty_lident l in + let uu___2 = + let uu___3 = FStar_Class_PP.pp pretty_term t in + FStar_Pprint.op_Hat_Hat FStar_Pprint.colon uu___3 in + FStar_Pprint.op_Hat_Hat uu___1 uu___2 + | FStar_Syntax_Syntax.Binding_univ u -> + FStar_Class_PP.pp FStar_Ident.pretty_ident u) } \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Print_Pretty.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Print_Pretty.ml index dfce21d4754..5228d9ac5f6 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Print_Pretty.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Print_Pretty.ml @@ -138,7 +138,13 @@ let (pat_to_string : FStar_Syntax_Syntax.pat -> Prims.string) = FStar_GenSym.with_frozen_gensym (fun uu___ -> let e = - FStar_Syntax_Resugar.resugar_pat p FStar_Syntax_Syntax.no_names in + let uu___1 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) ()) in + FStar_Syntax_Resugar.resugar_pat p uu___1 in let d = FStar_Parser_ToDocument.pat_to_document e in pp d) let (binder_to_string' : Prims.bool -> FStar_Syntax_Syntax.binder -> Prims.string) = diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml index 5c4ec567b91..1eb2e13fc41 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Resugar.ml @@ -90,10 +90,11 @@ let rec (universe_to_int : = fun n -> fun u -> - match u with + let uu___ = FStar_Syntax_Subst.compress_univ u in + match uu___ with | FStar_Syntax_Syntax.U_succ u1 -> universe_to_int (n + Prims.int_one) u1 - | uu___ -> (n, u) + | uu___1 -> (n, u) let (universe_to_string : FStar_Ident.ident Prims.list -> Prims.string) = fun univs -> let uu___ = FStar_Options.print_universes () in @@ -110,73 +111,73 @@ let rec (resugar_universe : fun u -> fun r -> let mk a r1 = FStar_Parser_AST.mk_term a r1 FStar_Parser_AST.Un in - let uu___ = FStar_Syntax_Subst.compress_univ u in - match uu___ with + let u1 = FStar_Syntax_Subst.compress_univ u in + match u1 with | FStar_Syntax_Syntax.U_zero -> mk (FStar_Parser_AST.Const (FStar_Const.Const_int ("0", FStar_Pervasives_Native.None))) r - | FStar_Syntax_Syntax.U_succ uu___1 -> - let uu___2 = universe_to_int Prims.int_zero u in - (match uu___2 with - | (n, u1) -> - (match u1 with + | FStar_Syntax_Syntax.U_succ uu___ -> + let uu___1 = universe_to_int Prims.int_zero u1 in + (match uu___1 with + | (n, u2) -> + (match u2 with | FStar_Syntax_Syntax.U_zero -> - let uu___3 = - let uu___4 = - let uu___5 = - let uu___6 = FStar_Compiler_Util.string_of_int n in - (uu___6, FStar_Pervasives_Native.None) in - FStar_Const.Const_int uu___5 in - FStar_Parser_AST.Const uu___4 in - mk uu___3 r - | uu___3 -> + let uu___2 = + let uu___3 = + let uu___4 = + let uu___5 = FStar_Compiler_Util.string_of_int n in + (uu___5, FStar_Pervasives_Native.None) in + FStar_Const.Const_int uu___4 in + FStar_Parser_AST.Const uu___3 in + mk uu___2 r + | uu___2 -> let e1 = + let uu___3 = + let uu___4 = + let uu___5 = + let uu___6 = FStar_Compiler_Util.string_of_int n in + (uu___6, FStar_Pervasives_Native.None) in + FStar_Const.Const_int uu___5 in + FStar_Parser_AST.Const uu___4 in + mk uu___3 r in + let e2 = resugar_universe u2 r in + let uu___3 = let uu___4 = - let uu___5 = - let uu___6 = - let uu___7 = FStar_Compiler_Util.string_of_int n in - (uu___7, FStar_Pervasives_Native.None) in - FStar_Const.Const_int uu___6 in - FStar_Parser_AST.Const uu___5 in - mk uu___4 r in - let e2 = resugar_universe u1 r in - let uu___4 = - let uu___5 = - let uu___6 = FStar_Ident.id_of_text "+" in - (uu___6, [e1; e2]) in - FStar_Parser_AST.Op uu___5 in - mk uu___4 r)) + let uu___5 = FStar_Ident.id_of_text "+" in + (uu___5, [e1; e2]) in + FStar_Parser_AST.Op uu___4 in + mk uu___3 r)) | FStar_Syntax_Syntax.U_max l -> (match l with | [] -> FStar_Compiler_Effect.failwith "Impossible: U_max without arguments" - | uu___1 -> + | uu___ -> let t = - let uu___2 = - let uu___3 = FStar_Ident.lid_of_path ["max"] r in - FStar_Parser_AST.Var uu___3 in - mk uu___2 r in + let uu___1 = + let uu___2 = FStar_Ident.lid_of_path ["max"] r in + FStar_Parser_AST.Var uu___2 in + mk uu___1 r in FStar_Compiler_List.fold_left (fun acc -> fun x -> - let uu___2 = - let uu___3 = - let uu___4 = resugar_universe x r in - (acc, uu___4, FStar_Parser_AST.Nothing) in - FStar_Parser_AST.App uu___3 in - mk uu___2 r) t l) - | FStar_Syntax_Syntax.U_name u1 -> mk (FStar_Parser_AST.Uvar u1) r - | FStar_Syntax_Syntax.U_unif uu___1 -> mk FStar_Parser_AST.Wild r + let uu___1 = + let uu___2 = + let uu___3 = resugar_universe x r in + (acc, uu___3, FStar_Parser_AST.Nothing) in + FStar_Parser_AST.App uu___2 in + mk uu___1 r) t l) + | FStar_Syntax_Syntax.U_name u2 -> mk (FStar_Parser_AST.Uvar u2) r + | FStar_Syntax_Syntax.U_unif uu___ -> mk FStar_Parser_AST.Wild r | FStar_Syntax_Syntax.U_bvar x -> let id = - let uu___1 = - let uu___2 = - let uu___3 = FStar_Compiler_Util.string_of_int x in - FStar_Compiler_Util.strcat "uu__univ_bvar_" uu___3 in - (uu___2, r) in - FStar_Ident.mk_ident uu___1 in + let uu___ = + let uu___1 = + let uu___2 = FStar_Compiler_Util.string_of_int x in + FStar_Compiler_Util.strcat "uu__univ_bvar_" uu___2 in + (uu___1, r) in + FStar_Ident.mk_ident uu___ in mk (FStar_Parser_AST.Uvar id) r | FStar_Syntax_Syntax.U_unknown -> mk FStar_Parser_AST.Wild r let (resugar_universe' : @@ -755,426 +756,541 @@ let rec (resugar_term' : uu___7)::[];_} when can_resugar_machine_integer fv -> resugar_machine_integer fv i t.FStar_Syntax_Syntax.pos - | FStar_Syntax_Syntax.Tm_app - { FStar_Syntax_Syntax.hd = e; FStar_Syntax_Syntax.args = args;_} -> - let rec last uu___1 = - match uu___1 with - | hd::[] -> [hd] - | hd::tl -> last tl - | uu___2 -> - FStar_Compiler_Effect.failwith "last of an empty list" in - let first_two_explicit args1 = - let rec drop_implicits args2 = - match args2 with - | (uu___1, FStar_Pervasives_Native.Some - { FStar_Syntax_Syntax.aqual_implicit = true; - FStar_Syntax_Syntax.aqual_attributes = uu___2;_})::tl - -> drop_implicits tl - | uu___1 -> args2 in - let uu___1 = drop_implicits args1 in - match uu___1 with - | [] -> - FStar_Compiler_Effect.failwith - "not_enough explicit_arguments" - | uu___2::[] -> - FStar_Compiler_Effect.failwith - "not_enough explicit_arguments" - | a1::a2::uu___2 -> [a1; a2] in - let resugar_as_app e1 args1 = - let args2 = - FStar_Compiler_List.map - (fun uu___1 -> - match uu___1 with - | (e2, qual) -> - let uu___2 = resugar_term' env e2 in - let uu___3 = resugar_aqual env qual in - (uu___2, uu___3)) args1 in - let uu___1 = resugar_term' env e1 in - match uu___1 with - | { - FStar_Parser_AST.tm = FStar_Parser_AST.Construct - (hd, previous_args); - FStar_Parser_AST.range = r; FStar_Parser_AST.level = l;_} -> - FStar_Parser_AST.mk_term - (FStar_Parser_AST.Construct - (hd, (FStar_Compiler_List.op_At previous_args args2))) r - l - | e2 -> - FStar_Compiler_List.fold_left - (fun acc -> - fun uu___2 -> - match uu___2 with - | (x, qual) -> - mk (FStar_Parser_AST.App (acc, x, qual))) e2 args2 in - let args1 = - let uu___1 = FStar_Options.print_implicits () in - if uu___1 then args else filter_imp_args args in - let uu___1 = resugar_term_as_op e in - (match uu___1 with - | FStar_Pervasives_Native.None -> resugar_as_app e args1 - | FStar_Pervasives_Native.Some ("calc_finish", uu___2) -> - let uu___3 = resugar_calc env t in - (match uu___3 with - | FStar_Pervasives_Native.Some r -> r - | uu___4 -> resugar_as_app e args1) - | FStar_Pervasives_Native.Some ("tuple", uu___2) -> - let out = - FStar_Compiler_List.fold_left - (fun out1 -> - fun uu___3 -> - match uu___3 with - | (x, uu___4) -> - let x1 = resugar_term' env x in - (match out1 with - | FStar_Pervasives_Native.None -> - FStar_Pervasives_Native.Some x1 - | FStar_Pervasives_Native.Some prefix -> - let uu___5 = - let uu___6 = - let uu___7 = - let uu___8 = - FStar_Ident.id_of_text "*" in - (uu___8, [prefix; x1]) in - FStar_Parser_AST.Op uu___7 in - mk uu___6 in - FStar_Pervasives_Native.Some uu___5)) - FStar_Pervasives_Native.None args1 in - FStar_Compiler_Option.get out - | FStar_Pervasives_Native.Some ("dtuple", uu___2) -> - resugar_as_app e args1 - | FStar_Pervasives_Native.Some (ref_read, uu___2) when - let uu___3 = - FStar_Ident.string_of_lid FStar_Parser_Const.sread_lid in - ref_read = uu___3 -> - let uu___3 = FStar_Compiler_List.hd args1 in - (match uu___3 with - | (t1, uu___4) -> - let uu___5 = - let uu___6 = FStar_Syntax_Subst.compress t1 in - uu___6.FStar_Syntax_Syntax.n in - (match uu___5 with - | FStar_Syntax_Syntax.Tm_fvar fv when - let uu___6 = - FStar_Ident.string_of_lid - (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - FStar_Syntax_Util.field_projector_contains_constructor - uu___6 - -> - let f = - let uu___6 = - let uu___7 = - FStar_Ident.string_of_lid - (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - [uu___7] in - FStar_Ident.lid_of_path uu___6 - t1.FStar_Syntax_Syntax.pos in - let uu___6 = - let uu___7 = - let uu___8 = resugar_term' env t1 in (uu___8, f) in - FStar_Parser_AST.Project uu___7 in - mk uu___6 - | uu___6 -> resugar_term' env t1)) - | FStar_Pervasives_Native.Some ("try_with", uu___2) when - (FStar_Compiler_List.length args1) > Prims.int_one -> - (try - (fun uu___3 -> - match () with - | () -> - let new_args = first_two_explicit args1 in - let uu___4 = - match new_args with - | (a1, uu___5)::(a2, uu___6)::[] -> (a1, a2) - | uu___5 -> - FStar_Compiler_Effect.failwith - "wrong arguments to try_with" in - (match uu___4 with - | (body, handler) -> - let decomp term = - let uu___5 = - let uu___6 = - FStar_Syntax_Subst.compress term in - uu___6.FStar_Syntax_Syntax.n in - match uu___5 with - | FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = x; - FStar_Syntax_Syntax.body = e1; - FStar_Syntax_Syntax.rc_opt = uu___6;_} - -> - let uu___7 = - FStar_Syntax_Subst.open_term x e1 in - (match uu___7 with | (x1, e2) -> e2) - | uu___6 -> - let uu___7 = - let uu___8 = - let uu___9 = resugar_term' env term in - FStar_Parser_AST.term_to_string - uu___9 in - Prims.strcat - "wrong argument format to try_with: " - uu___8 in - FStar_Compiler_Effect.failwith uu___7 in - let body1 = - let uu___5 = decomp body in - resugar_term' env uu___5 in - let handler1 = - let uu___5 = decomp handler in - resugar_term' env uu___5 in - let rec resugar_body t1 = - match t1.FStar_Parser_AST.tm with - | FStar_Parser_AST.Match - (e1, FStar_Pervasives_Native.None, - FStar_Pervasives_Native.None, - (uu___5, uu___6, b)::[]) - -> b - | FStar_Parser_AST.Let (uu___5, uu___6, b) -> - b - | FStar_Parser_AST.Ascribed - (t11, t2, t3, use_eq) -> - let uu___5 = - let uu___6 = - let uu___7 = resugar_body t11 in - (uu___7, t2, t3, use_eq) in - FStar_Parser_AST.Ascribed uu___6 in - mk uu___5 - | uu___5 -> - FStar_Compiler_Effect.failwith - "unexpected body format to try_with" in - let e1 = resugar_body body1 in - let rec resugar_branches t1 = - match t1.FStar_Parser_AST.tm with - | FStar_Parser_AST.Match - (e2, FStar_Pervasives_Native.None, - FStar_Pervasives_Native.None, branches) - -> branches - | FStar_Parser_AST.Ascribed - (t11, t2, t3, uu___5) -> - resugar_branches t11 - | uu___5 -> [] in - let branches = resugar_branches handler1 in - mk (FStar_Parser_AST.TryWith (e1, branches)))) - () - with | uu___3 -> resugar_as_app e args1) - | FStar_Pervasives_Native.Some ("try_with", uu___2) -> - resugar_as_app e args1 - | FStar_Pervasives_Native.Some (op, uu___2) when - (((((((op = "=") || (op = "==")) || (op = "===")) || - (op = "@")) - || (op = ":=")) - || (op = "|>")) - || (op = "<<")) - && (FStar_Options.print_implicits ()) - -> resugar_as_app e args1 - | FStar_Pervasives_Native.Some (op, uu___2) when - (FStar_Compiler_Util.starts_with op "forall") || - (FStar_Compiler_Util.starts_with op "exists") + | FStar_Syntax_Syntax.Tm_app uu___1 -> + let t1 = FStar_Syntax_Util.canon_app t in + let uu___2 = t1.FStar_Syntax_Syntax.n in + (match uu___2 with + | FStar_Syntax_Syntax.Tm_app + { FStar_Syntax_Syntax.hd = e; + FStar_Syntax_Syntax.args = args;_} -> - let rec uncurry xs pats t1 flavor_matches = - match t1.FStar_Parser_AST.tm with - | FStar_Parser_AST.QExists (xs', (uu___3, pats'), body) when - flavor_matches t1 -> - uncurry (FStar_Compiler_List.op_At xs xs') - (FStar_Compiler_List.op_At pats pats') body - flavor_matches - | FStar_Parser_AST.QForall (xs', (uu___3, pats'), body) when - flavor_matches t1 -> - uncurry (FStar_Compiler_List.op_At xs xs') - (FStar_Compiler_List.op_At pats pats') body - flavor_matches - | FStar_Parser_AST.QuantOp - (uu___3, xs', (uu___4, pats'), body) when - flavor_matches t1 -> - uncurry (FStar_Compiler_List.op_At xs xs') - (FStar_Compiler_List.op_At pats pats') body - flavor_matches - | uu___3 -> (xs, pats, t1) in - let resugar_forall_body body = + let rec last uu___3 = + match uu___3 with + | hd::[] -> [hd] + | hd::tl -> last tl + | uu___4 -> + FStar_Compiler_Effect.failwith "last of an empty list" in + let first_two_explicit args1 = + let rec drop_implicits args2 = + match args2 with + | (uu___3, FStar_Pervasives_Native.Some + { FStar_Syntax_Syntax.aqual_implicit = true; + FStar_Syntax_Syntax.aqual_attributes = uu___4;_})::tl + -> drop_implicits tl + | uu___3 -> args2 in + let uu___3 = drop_implicits args1 in + match uu___3 with + | [] -> + FStar_Compiler_Effect.failwith + "not_enough explicit_arguments" + | uu___4::[] -> + FStar_Compiler_Effect.failwith + "not_enough explicit_arguments" + | a1::a2::uu___4 -> [a1; a2] in + let resugar_as_app e1 args1 = + let args2 = + FStar_Compiler_List.map + (fun uu___3 -> + match uu___3 with + | (e2, qual) -> + let uu___4 = resugar_term' env e2 in + let uu___5 = resugar_aqual env qual in + (uu___4, uu___5)) args1 in + let uu___3 = resugar_term' env e1 in + match uu___3 with + | { + FStar_Parser_AST.tm = FStar_Parser_AST.Construct + (hd, previous_args); + FStar_Parser_AST.range = r; + FStar_Parser_AST.level = l;_} -> + FStar_Parser_AST.mk_term + (FStar_Parser_AST.Construct + (hd, + (FStar_Compiler_List.op_At previous_args args2))) + r l + | e2 -> + FStar_Compiler_List.fold_left + (fun acc -> + fun uu___4 -> + match uu___4 with + | (x, qual) -> + mk (FStar_Parser_AST.App (acc, x, qual))) e2 + args2 in + let args1 = + let uu___3 = FStar_Options.print_implicits () in + if uu___3 then args else filter_imp_args args in + let is_projector t2 = let uu___3 = - let uu___4 = FStar_Syntax_Subst.compress body in + let uu___4 = + let uu___5 = FStar_Syntax_Subst.compress t2 in + FStar_Syntax_Util.un_uinst uu___5 in uu___4.FStar_Syntax_Syntax.n in match uu___3 with - | FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = xs; - FStar_Syntax_Syntax.body = body1; - FStar_Syntax_Syntax.rc_opt = uu___4;_} - -> - let uu___5 = FStar_Syntax_Subst.open_term xs body1 in - (match uu___5 with - | (xs1, body2) -> - let xs2 = - let uu___6 = FStar_Options.print_implicits () in - if uu___6 then xs1 else filter_imp_bs xs1 in - let xs3 = - (map_opt ()) - (fun b -> - resugar_binder' env b - t.FStar_Syntax_Syntax.pos) xs2 in - let uu___6 = - let uu___7 = - let uu___8 = FStar_Syntax_Subst.compress body2 in - uu___8.FStar_Syntax_Syntax.n in - match uu___7 with - | FStar_Syntax_Syntax.Tm_meta - { FStar_Syntax_Syntax.tm2 = e1; - FStar_Syntax_Syntax.meta = m;_} + | FStar_Syntax_Syntax.Tm_fvar fv -> + let a = + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in + let length = + let uu___4 = + FStar_Ident.nsstr + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in + FStar_Compiler_String.length uu___4 in + let s = + if length = Prims.int_zero + then FStar_Ident.string_of_lid a + else + (let uu___5 = FStar_Ident.string_of_lid a in + FStar_Compiler_Util.substring_from uu___5 + (length + Prims.int_one)) in + if + FStar_Compiler_Util.starts_with s + FStar_Syntax_Util.field_projector_prefix + then + let rest = + FStar_Compiler_Util.substring_from s + (FStar_Compiler_String.length + FStar_Syntax_Util.field_projector_prefix) in + let r = + FStar_Compiler_Util.split rest + FStar_Syntax_Util.field_projector_sep in + (match r with + | fst::snd::[] -> + let l = + FStar_Ident.lid_of_path [fst] + t2.FStar_Syntax_Syntax.pos in + let r1 = + FStar_Ident.mk_ident + (snd, (t2.FStar_Syntax_Syntax.pos)) in + FStar_Pervasives_Native.Some (l, r1) + | uu___4 -> + FStar_Compiler_Effect.failwith + "wrong projector format") + else FStar_Pervasives_Native.None + | uu___4 -> FStar_Pervasives_Native.None in + let uu___3 = + (let uu___4 = is_projector e in + FStar_Pervasives_Native.uu___is_Some uu___4) && + ((FStar_Compiler_List.length args1) = Prims.int_one) in + if uu___3 + then + let uu___4 = + let uu___5 = is_projector e in + FStar_Pervasives_Native.__proj__Some__item__v uu___5 in + (match uu___4 with + | (uu___5, fi) -> + let arg = + let uu___6 = + let uu___7 = FStar_Compiler_List.hd args1 in + FStar_Pervasives_Native.fst uu___7 in + resugar_term' env uu___6 in + let uu___6 = + let uu___7 = + let uu___8 = FStar_Ident.lid_of_ids [fi] in + (arg, uu___8) in + FStar_Parser_AST.Project uu___7 in + mk uu___6) + else + (let uu___5 = resugar_term_as_op e in + match uu___5 with + | FStar_Pervasives_Native.None -> resugar_as_app e args1 + | FStar_Pervasives_Native.Some ("calc_finish", uu___6) -> + let uu___7 = resugar_calc env t1 in + (match uu___7 with + | FStar_Pervasives_Native.Some r -> r + | uu___8 -> resugar_as_app e args1) + | FStar_Pervasives_Native.Some ("tuple", uu___6) -> + let out = + FStar_Compiler_List.fold_left + (fun out1 -> + fun uu___7 -> + match uu___7 with + | (x, uu___8) -> + let x1 = resugar_term' env x in + (match out1 with + | FStar_Pervasives_Native.None -> + FStar_Pervasives_Native.Some x1 + | FStar_Pervasives_Native.Some prefix -> + let uu___9 = + let uu___10 = + let uu___11 = + let uu___12 = + FStar_Ident.id_of_text "*" in + (uu___12, [prefix; x1]) in + FStar_Parser_AST.Op uu___11 in + mk uu___10 in + FStar_Pervasives_Native.Some uu___9)) + FStar_Pervasives_Native.None args1 in + FStar_Compiler_Option.get out + | FStar_Pervasives_Native.Some ("dtuple", uu___6) -> + resugar_as_app e args1 + | FStar_Pervasives_Native.Some (ref_read, uu___6) when + let uu___7 = + FStar_Ident.string_of_lid + FStar_Parser_Const.sread_lid in + ref_read = uu___7 -> + let uu___7 = FStar_Compiler_List.hd args1 in + (match uu___7 with + | (t2, uu___8) -> + let uu___9 = + let uu___10 = FStar_Syntax_Subst.compress t2 in + uu___10.FStar_Syntax_Syntax.n in + (match uu___9 with + | FStar_Syntax_Syntax.Tm_fvar fv when + let uu___10 = + FStar_Ident.string_of_lid + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in + FStar_Syntax_Util.field_projector_contains_constructor + uu___10 -> - let body3 = resugar_term' env e1 in + let f = + let uu___10 = + let uu___11 = + FStar_Ident.string_of_lid + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in + [uu___11] in + FStar_Ident.lid_of_path uu___10 + t2.FStar_Syntax_Syntax.pos in + let uu___10 = + let uu___11 = + let uu___12 = resugar_term' env t2 in + (uu___12, f) in + FStar_Parser_AST.Project uu___11 in + mk uu___10 + | uu___10 -> resugar_term' env t2)) + | FStar_Pervasives_Native.Some ("try_with", uu___6) when + (FStar_Compiler_List.length args1) > Prims.int_one -> + (try + (fun uu___7 -> + match () with + | () -> + let new_args = first_two_explicit args1 in let uu___8 = - match m with - | FStar_Syntax_Syntax.Meta_pattern - (uu___9, pats) -> - let uu___10 = - FStar_Compiler_List.map - (fun es -> - FStar_Compiler_List.map - (fun uu___11 -> - match uu___11 with - | (e2, uu___12) -> - resugar_term' env e2) - es) pats in - (uu___10, body3) - | FStar_Syntax_Syntax.Meta_labeled - (s, r, p) -> - let uu___9 = - mk - (FStar_Parser_AST.Labeled - (body3, s, p)) in - ([], uu___9) + match new_args with + | (a1, uu___9)::(a2, uu___10)::[] -> + (a1, a2) | uu___9 -> FStar_Compiler_Effect.failwith - "wrong pattern format for QForall/QExists" in + "wrong arguments to try_with" in (match uu___8 with - | (pats, body4) -> (pats, body4)) - | uu___8 -> - let uu___9 = resugar_term' env body2 in - ([], uu___9) in - (match uu___6 with - | (pats, body3) -> - let decompile_op op1 = - let uu___7 = - FStar_Parser_AST.string_to_op op1 in - match uu___7 with - | FStar_Pervasives_Native.None -> op1 - | FStar_Pervasives_Native.Some (op2, uu___8) - -> op2 in - let flavor_matches t1 = - match ((t1.FStar_Parser_AST.tm), op) with - | (FStar_Parser_AST.QExists uu___7, - "exists") -> true - | (FStar_Parser_AST.QForall uu___7, - "forall") -> true - | (FStar_Parser_AST.QuantOp - (id, uu___7, uu___8, uu___9), uu___10) -> - let uu___11 = - FStar_Ident.string_of_id id in - uu___11 = op - | uu___7 -> false in - let uu___7 = - uncurry xs3 pats body3 flavor_matches in - (match uu___7 with - | (xs4, pats1, body4) -> - let binders = - FStar_Parser_AST.idents_of_binders xs4 - t.FStar_Syntax_Syntax.pos in - if op = "forall" - then - mk - (FStar_Parser_AST.QForall - (xs4, (binders, pats1), body4)) - else - if op = "exists" - then - mk - (FStar_Parser_AST.QExists - (xs4, (binders, pats1), body4)) - else - (let uu___10 = + | (body, handler) -> + let decomp term = + let uu___9 = + let uu___10 = + FStar_Syntax_Subst.compress term in + uu___10.FStar_Syntax_Syntax.n in + match uu___9 with + | FStar_Syntax_Syntax.Tm_abs + { FStar_Syntax_Syntax.bs = x; + FStar_Syntax_Syntax.body = e1; + FStar_Syntax_Syntax.rc_opt = + uu___10;_} + -> + let uu___11 = + FStar_Syntax_Subst.open_term x + e1 in + (match uu___11 with + | (x1, e2) -> e2) + | uu___10 -> let uu___11 = let uu___12 = - FStar_Ident.id_of_text op in - (uu___12, xs4, (binders, pats1), - body4) in - FStar_Parser_AST.QuantOp uu___11 in - mk uu___10)))) - | uu___4 -> - if op = "forall" - then - let uu___5 = - let uu___6 = - let uu___7 = resugar_term' env body in - ([], ([], []), uu___7) in - FStar_Parser_AST.QForall uu___6 in - mk uu___5 - else - (let uu___6 = - let uu___7 = - let uu___8 = resugar_term' env body in - ([], ([], []), uu___8) in - FStar_Parser_AST.QExists uu___7 in - mk uu___6) in - if (FStar_Compiler_List.length args1) > Prims.int_zero - then - let args2 = last args1 in - (match args2 with - | (b, uu___3)::[] -> resugar_forall_body b - | uu___3 -> - FStar_Compiler_Effect.failwith - "wrong args format to QForall") - else resugar_as_app e args1 - | FStar_Pervasives_Native.Some ("alloc", uu___2) -> - let uu___3 = FStar_Compiler_List.hd args1 in - (match uu___3 with | (e1, uu___4) -> resugar_term' env e1) - | FStar_Pervasives_Native.Some (op, expected_arity1) -> - let op1 = FStar_Ident.id_of_text op in - let resugar args2 = - FStar_Compiler_List.map - (fun uu___2 -> - match uu___2 with - | (e1, qual) -> - let uu___3 = resugar_term' env e1 in - let uu___4 = resugar_aqual env qual in - (uu___3, uu___4)) args2 in - (match expected_arity1 with - | FStar_Pervasives_Native.None -> - let resugared_args = resugar args1 in - let expect_n = - FStar_Parser_ToDocument.handleable_args_length op1 in - if - (FStar_Compiler_List.length resugared_args) >= expect_n - then - let uu___2 = - FStar_Compiler_Util.first_N expect_n resugared_args in - (match uu___2 with - | (op_args, rest) -> - let head = - let uu___3 = - let uu___4 = - let uu___5 = - FStar_Compiler_List.map - FStar_Pervasives_Native.fst op_args in - (op1, uu___5) in - FStar_Parser_AST.Op uu___4 in - mk uu___3 in - FStar_Compiler_List.fold_left - (fun head1 -> - fun uu___3 -> - match uu___3 with - | (arg, qual) -> - mk - (FStar_Parser_AST.App - (head1, arg, qual))) head rest) - else resugar_as_app e args1 - | FStar_Pervasives_Native.Some n when - (FStar_Compiler_List.length args1) = n -> - let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = resugar args1 in - FStar_Compiler_List.map FStar_Pervasives_Native.fst - uu___5 in - (op1, uu___4) in - FStar_Parser_AST.Op uu___3 in - mk uu___2 - | uu___2 -> resugar_as_app e args1)) + let uu___13 = + resugar_term' env term in + FStar_Parser_AST.term_to_string + uu___13 in + Prims.strcat + "wrong argument format to try_with: " + uu___12 in + FStar_Compiler_Effect.failwith + uu___11 in + let body1 = + let uu___9 = decomp body in + resugar_term' env uu___9 in + let handler1 = + let uu___9 = decomp handler in + resugar_term' env uu___9 in + let rec resugar_body t2 = + match t2.FStar_Parser_AST.tm with + | FStar_Parser_AST.Match + (e1, FStar_Pervasives_Native.None, + FStar_Pervasives_Native.None, + (uu___9, uu___10, b)::[]) + -> b + | FStar_Parser_AST.Let + (uu___9, uu___10, b) -> b + | FStar_Parser_AST.Ascribed + (t11, t21, t3, use_eq) -> + let uu___9 = + let uu___10 = + let uu___11 = resugar_body t11 in + (uu___11, t21, t3, use_eq) in + FStar_Parser_AST.Ascribed + uu___10 in + mk uu___9 + | uu___9 -> + FStar_Compiler_Effect.failwith + "unexpected body format to try_with" in + let e1 = resugar_body body1 in + let rec resugar_branches t2 = + match t2.FStar_Parser_AST.tm with + | FStar_Parser_AST.Match + (e2, FStar_Pervasives_Native.None, + FStar_Pervasives_Native.None, + branches) + -> branches + | FStar_Parser_AST.Ascribed + (t11, t21, t3, uu___9) -> + resugar_branches t11 + | uu___9 -> [] in + let branches = resugar_branches handler1 in + mk + (FStar_Parser_AST.TryWith + (e1, branches)))) () + with | uu___7 -> resugar_as_app e args1) + | FStar_Pervasives_Native.Some ("try_with", uu___6) -> + resugar_as_app e args1 + | FStar_Pervasives_Native.Some (op, uu___6) when + (((((((op = "=") || (op = "==")) || (op = "===")) || + (op = "@")) + || (op = ":=")) + || (op = "|>")) + || (op = "<<")) + && (FStar_Options.print_implicits ()) + -> resugar_as_app e args1 + | FStar_Pervasives_Native.Some (op, uu___6) when + (FStar_Compiler_Util.starts_with op "forall") || + (FStar_Compiler_Util.starts_with op "exists") + -> + let rec uncurry xs pats t2 flavor_matches = + match t2.FStar_Parser_AST.tm with + | FStar_Parser_AST.QExists + (xs', (uu___7, pats'), body) when + flavor_matches t2 -> + uncurry (FStar_Compiler_List.op_At xs xs') + (FStar_Compiler_List.op_At pats pats') body + flavor_matches + | FStar_Parser_AST.QForall + (xs', (uu___7, pats'), body) when + flavor_matches t2 -> + uncurry (FStar_Compiler_List.op_At xs xs') + (FStar_Compiler_List.op_At pats pats') body + flavor_matches + | FStar_Parser_AST.QuantOp + (uu___7, xs', (uu___8, pats'), body) when + flavor_matches t2 -> + uncurry (FStar_Compiler_List.op_At xs xs') + (FStar_Compiler_List.op_At pats pats') body + flavor_matches + | uu___7 -> (xs, pats, t2) in + let resugar_forall_body body = + let uu___7 = + let uu___8 = FStar_Syntax_Subst.compress body in + uu___8.FStar_Syntax_Syntax.n in + match uu___7 with + | FStar_Syntax_Syntax.Tm_abs + { FStar_Syntax_Syntax.bs = xs; + FStar_Syntax_Syntax.body = body1; + FStar_Syntax_Syntax.rc_opt = uu___8;_} + -> + let uu___9 = + FStar_Syntax_Subst.open_term xs body1 in + (match uu___9 with + | (xs1, body2) -> + let xs2 = + let uu___10 = + FStar_Options.print_implicits () in + if uu___10 then xs1 else filter_imp_bs xs1 in + let xs3 = + (map_opt ()) + (fun b -> + resugar_binder' env b + t1.FStar_Syntax_Syntax.pos) xs2 in + let uu___10 = + let uu___11 = + let uu___12 = + FStar_Syntax_Subst.compress body2 in + uu___12.FStar_Syntax_Syntax.n in + match uu___11 with + | FStar_Syntax_Syntax.Tm_meta + { FStar_Syntax_Syntax.tm2 = e1; + FStar_Syntax_Syntax.meta = m;_} + -> + let body3 = resugar_term' env e1 in + let uu___12 = + match m with + | FStar_Syntax_Syntax.Meta_pattern + (uu___13, pats) -> + let uu___14 = + FStar_Compiler_List.map + (fun es -> + FStar_Compiler_List.map + (fun uu___15 -> + match uu___15 with + | (e2, uu___16) -> + resugar_term' + env e2) es) + pats in + (uu___14, body3) + | FStar_Syntax_Syntax.Meta_labeled + (s, r, p) -> + let uu___13 = + let uu___14 = + let uu___15 = + let uu___16 = + FStar_Errors_Msg.rendermsg + s in + (body3, uu___16, p) in + FStar_Parser_AST.Labeled + uu___15 in + mk uu___14 in + ([], uu___13) + | uu___13 -> + FStar_Compiler_Effect.failwith + "wrong pattern format for QForall/QExists" in + (match uu___12 with + | (pats, body4) -> (pats, body4)) + | uu___12 -> + let uu___13 = resugar_term' env body2 in + ([], uu___13) in + (match uu___10 with + | (pats, body3) -> + let decompile_op op1 = + let uu___11 = + FStar_Parser_AST.string_to_op op1 in + match uu___11 with + | FStar_Pervasives_Native.None -> op1 + | FStar_Pervasives_Native.Some + (op2, uu___12) -> op2 in + let flavor_matches t2 = + match ((t2.FStar_Parser_AST.tm), op) + with + | (FStar_Parser_AST.QExists uu___11, + "exists") -> true + | (FStar_Parser_AST.QForall uu___11, + "forall") -> true + | (FStar_Parser_AST.QuantOp + (id, uu___11, uu___12, uu___13), + uu___14) -> + let uu___15 = + FStar_Ident.string_of_id id in + uu___15 = op + | uu___11 -> false in + let uu___11 = + uncurry xs3 pats body3 flavor_matches in + (match uu___11 with + | (xs4, pats1, body4) -> + let binders = + FStar_Parser_AST.idents_of_binders + xs4 t1.FStar_Syntax_Syntax.pos in + if op = "forall" + then + mk + (FStar_Parser_AST.QForall + (xs4, (binders, pats1), + body4)) + else + if op = "exists" + then + mk + (FStar_Parser_AST.QExists + (xs4, (binders, pats1), + body4)) + else + (let uu___14 = + let uu___15 = + let uu___16 = + FStar_Ident.id_of_text + op in + (uu___16, xs4, + (binders, pats1), + body4) in + FStar_Parser_AST.QuantOp + uu___15 in + mk uu___14)))) + | uu___8 -> + if op = "forall" + then + let uu___9 = + let uu___10 = + let uu___11 = resugar_term' env body in + ([], ([], []), uu___11) in + FStar_Parser_AST.QForall uu___10 in + mk uu___9 + else + (let uu___10 = + let uu___11 = + let uu___12 = resugar_term' env body in + ([], ([], []), uu___12) in + FStar_Parser_AST.QExists uu___11 in + mk uu___10) in + if (FStar_Compiler_List.length args1) > Prims.int_zero + then + let args2 = last args1 in + (match args2 with + | (b, uu___7)::[] -> resugar_forall_body b + | uu___7 -> + FStar_Compiler_Effect.failwith + "wrong args format to QForall") + else resugar_as_app e args1 + | FStar_Pervasives_Native.Some ("alloc", uu___6) -> + let uu___7 = FStar_Compiler_List.hd args1 in + (match uu___7 with + | (e1, uu___8) -> resugar_term' env e1) + | FStar_Pervasives_Native.Some (op, expected_arity1) -> + let op1 = FStar_Ident.id_of_text op in + let resugar args2 = + FStar_Compiler_List.map + (fun uu___6 -> + match uu___6 with + | (e1, qual) -> + let uu___7 = resugar_term' env e1 in + let uu___8 = resugar_aqual env qual in + (uu___7, uu___8)) args2 in + (match expected_arity1 with + | FStar_Pervasives_Native.None -> + let resugared_args = resugar args1 in + let expect_n = + FStar_Parser_ToDocument.handleable_args_length + op1 in + if + (FStar_Compiler_List.length resugared_args) >= + expect_n + then + let uu___6 = + FStar_Compiler_Util.first_N expect_n + resugared_args in + (match uu___6 with + | (op_args, rest) -> + let head = + let uu___7 = + let uu___8 = + let uu___9 = + FStar_Compiler_List.map + FStar_Pervasives_Native.fst + op_args in + (op1, uu___9) in + FStar_Parser_AST.Op uu___8 in + mk uu___7 in + FStar_Compiler_List.fold_left + (fun head1 -> + fun uu___7 -> + match uu___7 with + | (arg, qual) -> + mk + (FStar_Parser_AST.App + (head1, arg, qual))) head + rest) + else resugar_as_app e args1 + | FStar_Pervasives_Native.Some n when + (FStar_Compiler_List.length args1) = n -> + let uu___6 = + let uu___7 = + let uu___8 = + let uu___9 = resugar args1 in + FStar_Compiler_List.map + FStar_Pervasives_Native.fst uu___9 in + (op1, uu___8) in + FStar_Parser_AST.Op uu___7 in + mk uu___6 + | uu___6 -> resugar_as_app e args1))) | FStar_Syntax_Syntax.Tm_match { FStar_Syntax_Syntax.scrutinee = e; FStar_Syntax_Syntax.ret_opt = FStar_Pervasives_Native.None; @@ -1999,7 +2115,7 @@ and (resugar_bv_as_pat' : FStar_Syntax_DsEnv.env -> FStar_Syntax_Syntax.bv -> FStar_Parser_AST.arg_qualifier FStar_Pervasives_Native.option -> - FStar_Syntax_Syntax.bv FStar_Compiler_Set.set -> + FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.t -> FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax FStar_Pervasives_Native.option -> FStar_Parser_AST.pattern) = @@ -2012,7 +2128,10 @@ and (resugar_bv_as_pat' : let uu___ = FStar_Syntax_Syntax.range_of_bv v in FStar_Parser_AST.mk_pattern a uu___ in let used = - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_bv v body_bv in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) v (Obj.magic body_bv) in let pat = let uu___ = if used @@ -2047,7 +2166,7 @@ and (resugar_bv_as_pat : FStar_Syntax_DsEnv.env -> FStar_Syntax_Syntax.bv -> FStar_Syntax_Syntax.binder_qualifier FStar_Pervasives_Native.option -> - FStar_Syntax_Syntax.bv FStar_Compiler_Set.set -> + FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.t -> FStar_Parser_AST.pattern FStar_Pervasives_Native.option) = fun env -> @@ -2065,7 +2184,8 @@ and (resugar_bv_as_pat : and (resugar_pat' : FStar_Syntax_DsEnv.env -> FStar_Syntax_Syntax.pat -> - FStar_Syntax_Syntax.bv FStar_Compiler_Set.t -> FStar_Parser_AST.pattern) + FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.t -> + FStar_Parser_AST.pattern) = fun env -> fun p -> @@ -2088,8 +2208,11 @@ and (resugar_pat' : let might_be_used = match pattern.FStar_Syntax_Syntax.v with | FStar_Syntax_Syntax.Pat_var bv -> - FStar_Compiler_Set.mem - FStar_Syntax_Syntax.ord_bv bv branch_bv + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) bv + (Obj.magic branch_bv) | uu___2 -> true in is_implicit && might_be_used) args in Prims.op_Negation uu___) in @@ -2191,41 +2314,40 @@ and (resugar_pat' : mk (FStar_Parser_AST.PatTuple (args1, is_dependent_tuple)) | FStar_Syntax_Syntax.Pat_cons ({ FStar_Syntax_Syntax.fv_name = uu___; - FStar_Syntax_Syntax.fv_delta = uu___1; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Record_ctor (name, fields));_}, - uu___2, args) + uu___1, args) -> let fields1 = - let uu___3 = + let uu___2 = FStar_Compiler_List.map (fun f -> FStar_Ident.lid_of_ids [f]) fields in - FStar_Compiler_List.rev uu___3 in + FStar_Compiler_List.rev uu___2 in let args1 = - let uu___3 = + let uu___2 = FStar_Compiler_List.map - (fun uu___4 -> - match uu___4 with + (fun uu___3 -> + match uu___3 with | (p2, b) -> aux p2 (FStar_Pervasives_Native.Some b)) args in - FStar_Compiler_List.rev uu___3 in + FStar_Compiler_List.rev uu___2 in let rec map2 l1 l2 = match (l1, l2) with | ([], []) -> [] | ([], hd::tl) -> [] | (hd::tl, []) -> - let uu___3 = - let uu___4 = + let uu___2 = + let uu___3 = mk (FStar_Parser_AST.PatWild (FStar_Pervasives_Native.None, [])) in - (hd, uu___4) in - let uu___4 = map2 tl [] in uu___3 :: uu___4 + (hd, uu___3) in + let uu___3 = map2 tl [] in uu___2 :: uu___3 | (hd1::tl1, hd2::tl2) -> - let uu___3 = map2 tl1 tl2 in (hd1, hd2) :: uu___3 in + let uu___2 = map2 tl1 tl2 in (hd1, hd2) :: uu___2 in let args2 = - let uu___3 = map2 fields1 args1 in - FStar_Compiler_List.rev uu___3 in + let uu___2 = map2 fields1 args1 in + FStar_Compiler_List.rev uu___2 in mk (FStar_Parser_AST.PatRecord args2) | FStar_Syntax_Syntax.Pat_cons (fv, uu___, args) -> resugar_plain_pat_cons fv args @@ -2372,96 +2494,100 @@ let (resugar_typ : FStar_Syntax_Syntax.num_uniform_params = uu___; FStar_Syntax_Syntax.t = t; FStar_Syntax_Syntax.mutuals = uu___1; - FStar_Syntax_Syntax.ds = datacons;_} + FStar_Syntax_Syntax.ds = datacons; + FStar_Syntax_Syntax.injective_type_params = uu___2;_} -> - let uu___2 = + let uu___3 = FStar_Compiler_List.partition (fun se1 -> match se1.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_datacon - { FStar_Syntax_Syntax.lid1 = uu___3; - FStar_Syntax_Syntax.us1 = uu___4; - FStar_Syntax_Syntax.t1 = uu___5; + { FStar_Syntax_Syntax.lid1 = uu___4; + FStar_Syntax_Syntax.us1 = uu___5; + FStar_Syntax_Syntax.t1 = uu___6; FStar_Syntax_Syntax.ty_lid = inductive_lid; - FStar_Syntax_Syntax.num_ty_params = uu___6; - FStar_Syntax_Syntax.mutuals1 = uu___7;_} + FStar_Syntax_Syntax.num_ty_params = uu___7; + FStar_Syntax_Syntax.mutuals1 = uu___8; + FStar_Syntax_Syntax.injective_type_params1 = uu___9;_} -> FStar_Ident.lid_equals inductive_lid tylid - | uu___3 -> FStar_Compiler_Effect.failwith "unexpected") + | uu___4 -> FStar_Compiler_Effect.failwith "unexpected") datacon_ses in - (match uu___2 with + (match uu___3 with | (current_datacons, other_datacons) -> let bs1 = - let uu___3 = FStar_Options.print_implicits () in - if uu___3 then bs else filter_imp_bs bs in + let uu___4 = FStar_Options.print_implicits () in + if uu___4 then bs else filter_imp_bs bs in let bs2 = (map_opt ()) (fun b -> resugar_binder' env b t.FStar_Syntax_Syntax.pos) bs1 in let tyc = - let uu___3 = + let uu___4 = FStar_Compiler_Util.for_some - (fun uu___4 -> - match uu___4 with - | FStar_Syntax_Syntax.RecordType uu___5 -> true - | uu___5 -> false) se.FStar_Syntax_Syntax.sigquals in - if uu___3 + (fun uu___5 -> + match uu___5 with + | FStar_Syntax_Syntax.RecordType uu___6 -> true + | uu___6 -> false) se.FStar_Syntax_Syntax.sigquals in + if uu___4 then let resugar_datacon_as_fields fields se1 = match se1.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_datacon - { FStar_Syntax_Syntax.lid1 = uu___4; + { FStar_Syntax_Syntax.lid1 = uu___5; FStar_Syntax_Syntax.us1 = univs; FStar_Syntax_Syntax.t1 = term; - FStar_Syntax_Syntax.ty_lid = uu___5; + FStar_Syntax_Syntax.ty_lid = uu___6; FStar_Syntax_Syntax.num_ty_params = num; - FStar_Syntax_Syntax.mutuals1 = uu___6;_} + FStar_Syntax_Syntax.mutuals1 = uu___7; + FStar_Syntax_Syntax.injective_type_params1 = + uu___8;_} -> - let uu___7 = - let uu___8 = FStar_Syntax_Subst.compress term in - uu___8.FStar_Syntax_Syntax.n in - (match uu___7 with + let uu___9 = + let uu___10 = FStar_Syntax_Subst.compress term in + uu___10.FStar_Syntax_Syntax.n in + (match uu___9 with | FStar_Syntax_Syntax.Tm_arrow { FStar_Syntax_Syntax.bs1 = bs3; - FStar_Syntax_Syntax.comp = uu___8;_} + FStar_Syntax_Syntax.comp = uu___10;_} -> let mfields = FStar_Compiler_List.collect (fun b -> - let uu___9 = + let uu___11 = resugar_bqual env b.FStar_Syntax_Syntax.binder_qual in - match uu___9 with + match uu___11 with | FStar_Pervasives_Native.None -> [] | FStar_Pervasives_Native.Some q -> - let uu___10 = - let uu___11 = + let uu___12 = + let uu___13 = bv_as_unique_ident b.FStar_Syntax_Syntax.binder_bv in - let uu___12 = + let uu___14 = FStar_Compiler_List.map (resugar_term' env) b.FStar_Syntax_Syntax.binder_attrs in - let uu___13 = + let uu___15 = resugar_term' env (b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in - (uu___11, q, uu___12, uu___13) in - [uu___10]) bs3 in + (uu___13, q, uu___14, uu___15) in + [uu___12]) bs3 in FStar_Compiler_List.op_At mfields fields - | uu___8 -> + | uu___10 -> FStar_Compiler_Effect.failwith "unexpected") - | uu___4 -> + | uu___5 -> FStar_Compiler_Effect.failwith "unexpected" in let fields = FStar_Compiler_List.fold_left resugar_datacon_as_fields [] current_datacons in - let uu___4 = - let uu___5 = FStar_Ident.ident_of_lid tylid in - let uu___6 = + let uu___5 = + let uu___6 = FStar_Ident.ident_of_lid tylid in + let uu___7 = FStar_Compiler_List.map (resugar_term' env) se.FStar_Syntax_Syntax.sigattrs in - (uu___5, bs2, FStar_Pervasives_Native.None, uu___6, + (uu___6, bs2, FStar_Pervasives_Native.None, uu___7, fields) in - FStar_Parser_AST.TyconRecord uu___4 + FStar_Parser_AST.TyconRecord uu___5 else (let resugar_datacon constructors se1 = match se1.FStar_Syntax_Syntax.sigel with @@ -2469,32 +2595,34 @@ let (resugar_typ : { FStar_Syntax_Syntax.lid1 = l; FStar_Syntax_Syntax.us1 = univs; FStar_Syntax_Syntax.t1 = term; - FStar_Syntax_Syntax.ty_lid = uu___5; + FStar_Syntax_Syntax.ty_lid = uu___6; FStar_Syntax_Syntax.num_ty_params = num; - FStar_Syntax_Syntax.mutuals1 = uu___6;_} + FStar_Syntax_Syntax.mutuals1 = uu___7; + FStar_Syntax_Syntax.injective_type_params1 = + uu___8;_} -> let c = - let uu___7 = FStar_Ident.ident_of_lid l in - let uu___8 = - let uu___9 = - let uu___10 = resugar_term' env term in - FStar_Parser_AST.VpArbitrary uu___10 in - FStar_Pervasives_Native.Some uu___9 in - let uu___9 = + let uu___9 = FStar_Ident.ident_of_lid l in + let uu___10 = + let uu___11 = + let uu___12 = resugar_term' env term in + FStar_Parser_AST.VpArbitrary uu___12 in + FStar_Pervasives_Native.Some uu___11 in + let uu___11 = FStar_Compiler_List.map (resugar_term' env) se1.FStar_Syntax_Syntax.sigattrs in - (uu___7, uu___8, uu___9) in + (uu___9, uu___10, uu___11) in c :: constructors - | uu___5 -> + | uu___6 -> FStar_Compiler_Effect.failwith "unexpected" in let constructors = FStar_Compiler_List.fold_left resugar_datacon [] current_datacons in - let uu___5 = - let uu___6 = FStar_Ident.ident_of_lid tylid in - (uu___6, bs2, FStar_Pervasives_Native.None, + let uu___6 = + let uu___7 = FStar_Ident.ident_of_lid tylid in + (uu___7, bs2, FStar_Pervasives_Native.None, constructors) in - FStar_Parser_AST.TyconVariant uu___5) in + FStar_Parser_AST.TyconVariant uu___6) in (other_datacons, tyc)) | uu___ -> FStar_Compiler_Effect.failwith @@ -2812,16 +2940,18 @@ let (resugar_sigelt' : FStar_Syntax_Syntax.t1 = uu___4; FStar_Syntax_Syntax.ty_lid = uu___5; FStar_Syntax_Syntax.num_ty_params = uu___6; - FStar_Syntax_Syntax.mutuals1 = uu___7;_} + FStar_Syntax_Syntax.mutuals1 = uu___7; + FStar_Syntax_Syntax.injective_type_params1 = + uu___8;_} -> - let uu___8 = - let uu___9 = - let uu___10 = - let uu___11 = FStar_Ident.ident_of_lid l in - (uu___11, FStar_Pervasives_Native.None) in - FStar_Parser_AST.Exception uu___10 in - decl'_to_decl se1 uu___9 in - FStar_Pervasives_Native.Some uu___8 + let uu___9 = + let uu___10 = + let uu___11 = + let uu___12 = FStar_Ident.ident_of_lid l in + (uu___12, FStar_Pervasives_Native.None) in + FStar_Parser_AST.Exception uu___11 in + decl'_to_decl se1 uu___10 in + FStar_Pervasives_Native.Some uu___9 | uu___3 -> FStar_Compiler_Effect.failwith "wrong format for resguar to Exception") @@ -3088,7 +3218,8 @@ let (resugar_comp : FStar_Syntax_Syntax.comp -> FStar_Parser_AST.term) = fun c -> let uu___ = noenv resugar_comp' in uu___ c let (resugar_pat : FStar_Syntax_Syntax.pat -> - FStar_Syntax_Syntax.bv FStar_Compiler_Set.t -> FStar_Parser_AST.pattern) + FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.t -> + FStar_Parser_AST.pattern) = fun p -> fun branch_bv -> let uu___ = noenv resugar_pat' in uu___ p branch_bv diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Subst.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Subst.ml index 0ade76e6491..2a4e8ae9518 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Subst.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Subst.ml @@ -263,8 +263,6 @@ let tag_with_range : let fv1 = { FStar_Syntax_Syntax.fv_name = v; - FStar_Syntax_Syntax.fv_delta = - (fv.FStar_Syntax_Syntax.fv_delta); FStar_Syntax_Syntax.fv_qual = (fv.FStar_Syntax_Syntax.fv_qual) } in diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml index 7d4ac317960..08a9131e5b2 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Syntax.ml @@ -337,8 +337,8 @@ and metadata = | Meta_pattern of (term' syntax Prims.list * (term' syntax * arg_qualifier FStar_Pervasives_Native.option) Prims.list Prims.list) | Meta_named of FStar_Ident.lident - | Meta_labeled of (Prims.string * FStar_Compiler_Range_Type.range * - Prims.bool) + | Meta_labeled of (FStar_Pprint.document Prims.list * + FStar_Compiler_Range_Type.range * Prims.bool) | Meta_desugared of meta_source_info | Meta_monadic of (monad_name * term' syntax) | Meta_monadic_lift of (monad_name * monad_name * term' syntax) @@ -376,17 +376,15 @@ and bv = { ppname: FStar_Ident.ident ; index: Prims.int ; sort: term' syntax } -and fv = - { +and fv = { fv_name: var ; - fv_delta: delta_depth FStar_Pervasives_Native.option ; fv_qual: fv_qual FStar_Pervasives_Native.option } and free_vars = { - free_names: bv Prims.list ; - free_uvars: ctx_uvar Prims.list ; - free_univs: universe_uvar Prims.list ; - free_univ_names: univ_name Prims.list } + free_names: bv FStar_Compiler_FlatSet.t ; + free_uvars: ctx_uvar FStar_Compiler_FlatSet.t ; + free_univs: universe_uvar FStar_Compiler_FlatSet.t ; + free_univ_names: univ_name FStar_Compiler_FlatSet.t } and residual_comp = { residual_effect: FStar_Ident.lident ; @@ -849,7 +847,9 @@ let (uu___is_Meta_labeled : metadata -> Prims.bool) = fun projectee -> match projectee with | Meta_labeled _0 -> true | uu___ -> false let (__proj__Meta_labeled__item___0 : - metadata -> (Prims.string * FStar_Compiler_Range_Type.range * Prims.bool)) + metadata -> + (FStar_Pprint.document Prims.list * FStar_Compiler_Range_Type.range * + Prims.bool)) = fun projectee -> match projectee with | Meta_labeled _0 -> _0 let (uu___is_Meta_desugared : metadata -> Prims.bool) = fun projectee -> @@ -970,34 +970,28 @@ let (__proj__Mkbv__item__sort : bv -> term' syntax) = fun projectee -> match projectee with | { ppname; index; sort;_} -> sort let (__proj__Mkfv__item__fv_name : fv -> var) = fun projectee -> - match projectee with - | { fv_name; fv_delta; fv_qual = fv_qual1;_} -> fv_name -let (__proj__Mkfv__item__fv_delta : - fv -> delta_depth FStar_Pervasives_Native.option) = - fun projectee -> - match projectee with - | { fv_name; fv_delta; fv_qual = fv_qual1;_} -> fv_delta + match projectee with | { fv_name; fv_qual = fv_qual1;_} -> fv_name let (__proj__Mkfv__item__fv_qual : fv -> fv_qual FStar_Pervasives_Native.option) = fun projectee -> - match projectee with - | { fv_name; fv_delta; fv_qual = fv_qual1;_} -> fv_qual1 -let (__proj__Mkfree_vars__item__free_names : free_vars -> bv Prims.list) = + match projectee with | { fv_name; fv_qual = fv_qual1;_} -> fv_qual1 +let (__proj__Mkfree_vars__item__free_names : + free_vars -> bv FStar_Compiler_FlatSet.t) = fun projectee -> match projectee with | { free_names; free_uvars; free_univs; free_univ_names;_} -> free_names let (__proj__Mkfree_vars__item__free_uvars : - free_vars -> ctx_uvar Prims.list) = + free_vars -> ctx_uvar FStar_Compiler_FlatSet.t) = fun projectee -> match projectee with | { free_names; free_uvars; free_univs; free_univ_names;_} -> free_uvars let (__proj__Mkfree_vars__item__free_univs : - free_vars -> universe_uvar Prims.list) = + free_vars -> universe_uvar FStar_Compiler_FlatSet.t) = fun projectee -> match projectee with | { free_names; free_uvars; free_univs; free_univ_names;_} -> free_univs let (__proj__Mkfree_vars__item__free_univ_names : - free_vars -> univ_name Prims.list) = + free_vars -> univ_name FStar_Compiler_FlatSet.t) = fun projectee -> match projectee with | { free_names; free_uvars; free_univs; free_univ_names;_} -> @@ -1128,7 +1122,7 @@ type term = term' syntax type uvar = ((term' syntax FStar_Pervasives_Native.option * uvar_decoration) FStar_Unionfind.p_uvar * version * FStar_Compiler_Range_Type.range) -type uvars = ctx_uvar FStar_Compiler_Set.t +type uvars = ctx_uvar FStar_Compiler_FlatSet.t type comp = comp' syntax type ascription = ((term' syntax, comp' syntax) FStar_Pervasives.either * term' syntax @@ -1149,7 +1143,7 @@ type args = type binders = binder Prims.list type lbname = (bv, fv) FStar_Pervasives.either type letbindings = (Prims.bool * letbinding Prims.list) -type freenames = bv FStar_Compiler_Set.t +type freenames = bv FStar_Compiler_FlatSet.t type attribute = term' syntax type tscheme = (univ_name Prims.list * term' syntax) type gamma = binding Prims.list @@ -1772,7 +1766,8 @@ type sigelt'__Sig_inductive_typ__payload = num_uniform_params: Prims.int FStar_Pervasives_Native.option ; t: typ ; mutuals: FStar_Ident.lident Prims.list ; - ds: FStar_Ident.lident Prims.list } + ds: FStar_Ident.lident Prims.list ; + injective_type_params: Prims.bool } and sigelt'__Sig_bundle__payload = { ses: sigelt Prims.list ; @@ -1784,7 +1779,8 @@ and sigelt'__Sig_datacon__payload = t1: typ ; ty_lid: FStar_Ident.lident ; num_ty_params: Prims.int ; - mutuals1: FStar_Ident.lident Prims.list } + mutuals1: FStar_Ident.lident Prims.list ; + injective_type_params1: Prims.bool } and sigelt'__Sig_declare_typ__payload = { lid2: FStar_Ident.lident ; @@ -1862,17 +1858,20 @@ let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__lid : sigelt'__Sig_inductive_typ__payload -> FStar_Ident.lident) = fun projectee -> match projectee with - | { lid; us; params; num_uniform_params; t; mutuals; ds;_} -> lid + | { lid; us; params; num_uniform_params; t; mutuals; ds; + injective_type_params;_} -> lid let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__us : sigelt'__Sig_inductive_typ__payload -> univ_names) = fun projectee -> match projectee with - | { lid; us; params; num_uniform_params; t; mutuals; ds;_} -> us + | { lid; us; params; num_uniform_params; t; mutuals; ds; + injective_type_params;_} -> us let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__params : sigelt'__Sig_inductive_typ__payload -> binders) = fun projectee -> match projectee with - | { lid; us; params; num_uniform_params; t; mutuals; ds;_} -> params + | { lid; us; params; num_uniform_params; t; mutuals; ds; + injective_type_params;_} -> params let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__num_uniform_params : sigelt'__Sig_inductive_typ__payload -> @@ -1880,23 +1879,32 @@ let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__num_uniform_params = fun projectee -> match projectee with - | { lid; us; params; num_uniform_params; t; mutuals; ds;_} -> - num_uniform_params + | { lid; us; params; num_uniform_params; t; mutuals; ds; + injective_type_params;_} -> num_uniform_params let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__t : sigelt'__Sig_inductive_typ__payload -> typ) = fun projectee -> match projectee with - | { lid; us; params; num_uniform_params; t; mutuals; ds;_} -> t + | { lid; us; params; num_uniform_params; t; mutuals; ds; + injective_type_params;_} -> t let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__mutuals : sigelt'__Sig_inductive_typ__payload -> FStar_Ident.lident Prims.list) = fun projectee -> match projectee with - | { lid; us; params; num_uniform_params; t; mutuals; ds;_} -> mutuals + | { lid; us; params; num_uniform_params; t; mutuals; ds; + injective_type_params;_} -> mutuals let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__ds : sigelt'__Sig_inductive_typ__payload -> FStar_Ident.lident Prims.list) = fun projectee -> match projectee with - | { lid; us; params; num_uniform_params; t; mutuals; ds;_} -> ds + | { lid; us; params; num_uniform_params; t; mutuals; ds; + injective_type_params;_} -> ds +let (__proj__Mksigelt'__Sig_inductive_typ__payload__item__injective_type_params + : sigelt'__Sig_inductive_typ__payload -> Prims.bool) = + fun projectee -> + match projectee with + | { lid; us; params; num_uniform_params; t; mutuals; ds; + injective_type_params;_} -> injective_type_params let (__proj__Mksigelt'__Sig_bundle__payload__item__ses : sigelt'__Sig_bundle__payload -> sigelt Prims.list) = fun projectee -> match projectee with | { ses; lids;_} -> ses @@ -1908,37 +1916,50 @@ let (__proj__Mksigelt'__Sig_datacon__payload__item__lid : fun projectee -> match projectee with | { lid1 = lid; us1 = us; t1 = t; ty_lid; num_ty_params; - mutuals1 = mutuals;_} -> lid + mutuals1 = mutuals; injective_type_params1 = injective_type_params;_} + -> lid let (__proj__Mksigelt'__Sig_datacon__payload__item__us : sigelt'__Sig_datacon__payload -> univ_names) = fun projectee -> match projectee with | { lid1 = lid; us1 = us; t1 = t; ty_lid; num_ty_params; - mutuals1 = mutuals;_} -> us + mutuals1 = mutuals; injective_type_params1 = injective_type_params;_} + -> us let (__proj__Mksigelt'__Sig_datacon__payload__item__t : sigelt'__Sig_datacon__payload -> typ) = fun projectee -> match projectee with | { lid1 = lid; us1 = us; t1 = t; ty_lid; num_ty_params; - mutuals1 = mutuals;_} -> t + mutuals1 = mutuals; injective_type_params1 = injective_type_params;_} + -> t let (__proj__Mksigelt'__Sig_datacon__payload__item__ty_lid : sigelt'__Sig_datacon__payload -> FStar_Ident.lident) = fun projectee -> match projectee with | { lid1 = lid; us1 = us; t1 = t; ty_lid; num_ty_params; - mutuals1 = mutuals;_} -> ty_lid + mutuals1 = mutuals; injective_type_params1 = injective_type_params;_} + -> ty_lid let (__proj__Mksigelt'__Sig_datacon__payload__item__num_ty_params : sigelt'__Sig_datacon__payload -> Prims.int) = fun projectee -> match projectee with | { lid1 = lid; us1 = us; t1 = t; ty_lid; num_ty_params; - mutuals1 = mutuals;_} -> num_ty_params + mutuals1 = mutuals; injective_type_params1 = injective_type_params;_} + -> num_ty_params let (__proj__Mksigelt'__Sig_datacon__payload__item__mutuals : sigelt'__Sig_datacon__payload -> FStar_Ident.lident Prims.list) = fun projectee -> match projectee with | { lid1 = lid; us1 = us; t1 = t; ty_lid; num_ty_params; - mutuals1 = mutuals;_} -> mutuals + mutuals1 = mutuals; injective_type_params1 = injective_type_params;_} + -> mutuals +let (__proj__Mksigelt'__Sig_datacon__payload__item__injective_type_params : + sigelt'__Sig_datacon__payload -> Prims.bool) = + fun projectee -> + match projectee with + | { lid1 = lid; us1 = us; t1 = t; ty_lid; num_ty_params; + mutuals1 = mutuals; injective_type_params1 = injective_type_params;_} + -> injective_type_params let (__proj__Mksigelt'__Sig_declare_typ__payload__item__lid : sigelt'__Sig_declare_typ__payload -> FStar_Ident.lident) = fun projectee -> @@ -2278,6 +2299,8 @@ let (lookup_aq : bv -> antiquotations -> term) = + (FStar_Pervasives_Native.fst aq))) () with | uu___ -> FStar_Compiler_Effect.failwith "antiquotation out of bounds" +type path = Prims.string Prims.list +type subst_t = subst_elt Prims.list let deq_instance_from_cmp : 'uuuuu . ('uuuuu -> 'uuuuu -> FStar_Compiler_Order.order) -> @@ -2360,24 +2383,11 @@ let mk_uvs : 'uuuuu . unit -> 'uuuuu FStar_Pervasives_Native.option FStar_Compiler_Effect.ref = fun uu___ -> FStar_Compiler_Util.mk_ref FStar_Pervasives_Native.None -let (new_bv_set : unit -> bv FStar_Compiler_Set.t) = - fun uu___ -> FStar_Compiler_Set.empty ord_bv () -let (new_id_set : unit -> FStar_Ident.ident FStar_Compiler_Set.t) = - fun uu___ -> FStar_Compiler_Set.empty ord_ident () -let (new_fv_set : unit -> FStar_Ident.lident FStar_Compiler_Set.t) = - fun uu___ -> FStar_Compiler_Set.empty ord_fv () -let (new_universe_names_set : unit -> univ_name FStar_Compiler_Set.t) = - fun uu___ -> FStar_Compiler_Set.empty ord_ident () -type path = Prims.string Prims.list -type subst_t = subst_elt Prims.list -let (no_names : freenames) = new_bv_set () -let (no_fvars : FStar_Ident.lident FStar_Compiler_Set.t) = new_fv_set () -let (no_universe_names : univ_name FStar_Compiler_Set.t) = - new_universe_names_set () -let (freenames_of_list : bv Prims.list -> freenames) = - fun l -> FStar_Compiler_Set.addn ord_bv l no_names let (list_of_freenames : freenames -> bv Prims.list) = - fun fvs -> FStar_Compiler_Set.elems ord_bv fvs + fun fvs -> + FStar_Class_Setlike.elems () + (Obj.magic (FStar_Compiler_FlatSet.setlike_flat_set ord_bv)) + (Obj.magic fvs) let mk : 'a . 'a -> FStar_Compiler_Range_Type.range -> 'a syntax = fun t -> fun r -> @@ -2582,14 +2592,29 @@ let (is_top_level : letbinding Prims.list -> Prims.bool) = | uu___1 -> false let (freenames_of_binders : binders -> freenames) = fun bs -> + let uu___ = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic (FStar_Compiler_FlatSet.setlike_flat_set ord_bv)) ()) in FStar_Compiler_List.fold_right - (fun b -> fun out -> FStar_Compiler_Set.add ord_bv b.binder_bv out) bs - no_names + (fun uu___2 -> + fun uu___1 -> + (fun b -> + fun out -> + Obj.magic + (FStar_Class_Setlike.add () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set ord_bv)) + b.binder_bv (Obj.magic out))) uu___2 uu___1) bs uu___ let (binders_of_list : bv Prims.list -> binders) = fun fvs -> FStar_Compiler_List.map (fun t -> mk_binder t) fvs let (binders_of_freenames : freenames -> binders) = fun fvs -> - let uu___ = FStar_Compiler_Set.elems ord_bv fvs in binders_of_list uu___ + let uu___ = + FStar_Class_Setlike.elems () + (Obj.magic (FStar_Compiler_FlatSet.setlike_flat_set ord_bv)) + (Obj.magic fvs) in + binders_of_list uu___ let (is_bqual_implicit : bqual -> Prims.bool) = fun uu___ -> match uu___ with @@ -2674,41 +2699,26 @@ let (set_bv_range : bv -> FStar_Compiler_Range_Type.range -> bv) = let uu___ = FStar_Ident.set_id_range r bv1.ppname in { ppname = uu___; index = (bv1.index); sort = (bv1.sort) } let (lid_and_dd_as_fv : - FStar_Ident.lident -> - delta_depth -> fv_qual FStar_Pervasives_Native.option -> fv) - = + FStar_Ident.lident -> fv_qual FStar_Pervasives_Native.option -> fv) = fun l -> - fun dd -> - fun dq -> - let uu___ = - let uu___1 = FStar_Ident.range_of_lid l in withinfo l uu___1 in - { - fv_name = uu___; - fv_delta = (FStar_Pervasives_Native.Some dd); - fv_qual = dq - } + fun dq -> + let uu___ = + let uu___1 = FStar_Ident.range_of_lid l in withinfo l uu___1 in + { fv_name = uu___; fv_qual = dq } let (lid_as_fv : FStar_Ident.lident -> fv_qual FStar_Pervasives_Native.option -> fv) = fun l -> fun dq -> let uu___ = let uu___1 = FStar_Ident.range_of_lid l in withinfo l uu___1 in - { - fv_name = uu___; - fv_delta = FStar_Pervasives_Native.None; - fv_qual = dq - } + { fv_name = uu___; fv_qual = dq } let (fv_to_tm : fv -> term) = fun fv1 -> let uu___ = FStar_Ident.range_of_lid (fv1.fv_name).v in mk (Tm_fvar fv1) uu___ let (fvar_with_dd : - FStar_Ident.lident -> - delta_depth -> fv_qual FStar_Pervasives_Native.option -> term) - = - fun l -> - fun dd -> - fun dq -> let uu___ = lid_and_dd_as_fv l dd dq in fv_to_tm uu___ + FStar_Ident.lident -> fv_qual FStar_Pervasives_Native.option -> term) = + fun l -> fun dq -> let uu___ = lid_and_dd_as_fv l dq in fv_to_tm uu___ let (fvar : FStar_Ident.lident -> fv_qual FStar_Pervasives_Native.option -> term) = fun l -> fun dq -> let uu___ = lid_as_fv l dq in fv_to_tm uu___ @@ -2723,7 +2733,7 @@ let (set_range_of_fv : fv -> FStar_Compiler_Range_Type.range -> fv) = let uu___2 = let uu___3 = lid_of_fv fv1 in FStar_Ident.set_lid_range uu___3 r in { v = uu___2; p = (uu___1.p) } in - { fv_name = uu___; fv_delta = (fv1.fv_delta); fv_qual = (fv1.fv_qual) } + { fv_name = uu___; fv_qual = (fv1.fv_qual) } let (has_simple_attribute : term Prims.list -> Prims.string -> Prims.bool) = fun l -> fun s -> @@ -2769,7 +2779,7 @@ let (delta_constant : delta_depth) = Delta_constant_at_level Prims.int_zero let (delta_equational : delta_depth) = Delta_equational_at_level Prims.int_zero let (fvconst : FStar_Ident.lident -> fv) = - fun l -> lid_and_dd_as_fv l delta_constant FStar_Pervasives_Native.None + fun l -> lid_and_dd_as_fv l FStar_Pervasives_Native.None let (tconst : FStar_Ident.lident -> term) = fun l -> let uu___ = let uu___1 = fvconst l in Tm_fvar uu___1 in @@ -2777,16 +2787,12 @@ let (tconst : FStar_Ident.lident -> term) = let (tabbrev : FStar_Ident.lident -> term) = fun l -> let uu___ = - let uu___1 = - lid_and_dd_as_fv l (Delta_constant_at_level Prims.int_one) - FStar_Pervasives_Native.None in + let uu___1 = lid_and_dd_as_fv l FStar_Pervasives_Native.None in Tm_fvar uu___1 in mk uu___ FStar_Compiler_Range_Type.dummyRange let (tdataconstr : FStar_Ident.lident -> term) = fun l -> - let uu___ = - lid_and_dd_as_fv l delta_constant - (FStar_Pervasives_Native.Some Data_ctor) in + let uu___ = lid_and_dd_as_fv l (FStar_Pervasives_Native.Some Data_ctor) in fv_to_tm uu___ let (t_unit : term) = tconst FStar_Parser_Const.unit_lid let (t_bool : term) = tconst FStar_Parser_Const.bool_lid diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_Util.ml b/ocaml/fstar-lib/generated/FStar_Syntax_Util.ml index 77bbee1429c..2b7ddb8552c 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_Util.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_Util.ml @@ -211,13 +211,6 @@ let (binders_of_tks : (FStar_Pervasives_Native.Some (t.FStar_Syntax_Syntax.pos)) t in FStar_Syntax_Syntax.mk_binder_with_attrs uu___1 imp FStar_Pervasives_Native.None []) tks -let (binders_of_freevars : - FStar_Syntax_Syntax.bv FStar_Compiler_Set.set -> - FStar_Syntax_Syntax.binder Prims.list) - = - fun fvs -> - let uu___ = FStar_Compiler_Set.elems FStar_Syntax_Syntax.ord_bv fvs in - FStar_Compiler_List.map FStar_Syntax_Syntax.mk_binder uu___ let mk_subst : 'uuuuu . 'uuuuu -> 'uuuuu Prims.list = fun s -> [s] let (subst_of_list : FStar_Syntax_Syntax.binders -> @@ -389,6 +382,14 @@ let (eq_univs : = fun u1 -> fun u2 -> let uu___ = compare_univs u1 u2 in uu___ = Prims.int_zero +let (eq_univs_list : + FStar_Syntax_Syntax.universes -> + FStar_Syntax_Syntax.universes -> Prims.bool) + = + fun us -> + fun vs -> + ((FStar_Compiler_List.length us) = (FStar_Compiler_List.length vs)) && + (FStar_Compiler_List.forall2 eq_univs us vs) let (ml_comp : FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> FStar_Compiler_Range_Type.range -> FStar_Syntax_Syntax.comp) @@ -936,418 +937,6 @@ let (canon_app : match uu___ with | (hd, args) -> FStar_Syntax_Syntax.mk_Tm_app hd args t.FStar_Syntax_Syntax.pos -type eq_result = - | Equal - | NotEqual - | Unknown -let (uu___is_Equal : eq_result -> Prims.bool) = - fun projectee -> match projectee with | Equal -> true | uu___ -> false -let (uu___is_NotEqual : eq_result -> Prims.bool) = - fun projectee -> match projectee with | NotEqual -> true | uu___ -> false -let (uu___is_Unknown : eq_result -> Prims.bool) = - fun projectee -> match projectee with | Unknown -> true | uu___ -> false -let (injectives : Prims.string Prims.list) = - ["FStar.Int8.int_to_t"; - "FStar.Int16.int_to_t"; - "FStar.Int32.int_to_t"; - "FStar.Int64.int_to_t"; - "FStar.Int128.int_to_t"; - "FStar.UInt8.uint_to_t"; - "FStar.UInt16.uint_to_t"; - "FStar.UInt32.uint_to_t"; - "FStar.UInt64.uint_to_t"; - "FStar.UInt128.uint_to_t"; - "FStar.SizeT.uint_to_t"; - "FStar.Int8.__int_to_t"; - "FStar.Int16.__int_to_t"; - "FStar.Int32.__int_to_t"; - "FStar.Int64.__int_to_t"; - "FStar.Int128.__int_to_t"; - "FStar.UInt8.__uint_to_t"; - "FStar.UInt16.__uint_to_t"; - "FStar.UInt32.__uint_to_t"; - "FStar.UInt64.__uint_to_t"; - "FStar.UInt128.__uint_to_t"; - "FStar.SizeT.__uint_to_t"] -let (eq_inj : eq_result -> eq_result -> eq_result) = - fun r -> - fun s -> - match (r, s) with - | (Equal, Equal) -> Equal - | (NotEqual, uu___) -> NotEqual - | (uu___, NotEqual) -> NotEqual - | (uu___, uu___1) -> Unknown -let (equal_if : Prims.bool -> eq_result) = - fun uu___ -> if uu___ then Equal else Unknown -let (equal_iff : Prims.bool -> eq_result) = - fun uu___ -> if uu___ then Equal else NotEqual -let (eq_and : eq_result -> (unit -> eq_result) -> eq_result) = - fun r -> - fun s -> - let uu___ = (r = Equal) && (let uu___1 = s () in uu___1 = Equal) in - if uu___ then Equal else Unknown -let rec (eq_tm : - FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term -> eq_result) = - fun t1 -> - fun t2 -> - let t11 = canon_app t1 in - let t21 = canon_app t2 in - let equal_data f1 args1 f2 args2 = - let uu___ = FStar_Syntax_Syntax.fv_eq f1 f2 in - if uu___ - then - let uu___1 = FStar_Compiler_List.zip args1 args2 in - FStar_Compiler_List.fold_left - (fun acc -> - fun uu___2 -> - match uu___2 with - | ((a1, q1), (a2, q2)) -> - let uu___3 = eq_tm a1 a2 in eq_inj acc uu___3) Equal - uu___1 - else NotEqual in - let qual_is_inj uu___ = - match uu___ with - | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Data_ctor) -> - true - | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Record_ctor - uu___1) -> true - | uu___1 -> false in - let heads_and_args_in_case_both_data = - let uu___ = let uu___1 = unmeta t11 in head_and_args uu___1 in - match uu___ with - | (head1, args1) -> - let uu___1 = let uu___2 = unmeta t21 in head_and_args uu___2 in - (match uu___1 with - | (head2, args2) -> - let uu___2 = - let uu___3 = - let uu___4 = un_uinst head1 in - uu___4.FStar_Syntax_Syntax.n in - let uu___4 = - let uu___5 = un_uinst head2 in - uu___5.FStar_Syntax_Syntax.n in - (uu___3, uu___4) in - (match uu___2 with - | (FStar_Syntax_Syntax.Tm_fvar f, - FStar_Syntax_Syntax.Tm_fvar g) when - (qual_is_inj f.FStar_Syntax_Syntax.fv_qual) && - (qual_is_inj g.FStar_Syntax_Syntax.fv_qual) - -> FStar_Pervasives_Native.Some (f, args1, g, args2) - | uu___3 -> FStar_Pervasives_Native.None)) in - let t12 = unmeta t11 in - let t22 = unmeta t21 in - match ((t12.FStar_Syntax_Syntax.n), (t22.FStar_Syntax_Syntax.n)) with - | (FStar_Syntax_Syntax.Tm_bvar bv1, FStar_Syntax_Syntax.Tm_bvar bv2) -> - equal_if - (bv1.FStar_Syntax_Syntax.index = bv2.FStar_Syntax_Syntax.index) - | (FStar_Syntax_Syntax.Tm_lazy uu___, uu___1) -> - let uu___2 = unlazy t12 in eq_tm uu___2 t22 - | (uu___, FStar_Syntax_Syntax.Tm_lazy uu___1) -> - let uu___2 = unlazy t22 in eq_tm t12 uu___2 - | (FStar_Syntax_Syntax.Tm_name a, FStar_Syntax_Syntax.Tm_name b) -> - let uu___ = FStar_Syntax_Syntax.bv_eq a b in equal_if uu___ - | uu___ when - FStar_Compiler_Util.is_some heads_and_args_in_case_both_data -> - let uu___1 = - FStar_Compiler_Util.must heads_and_args_in_case_both_data in - (match uu___1 with - | (f, args1, g, args2) -> equal_data f args1 g args2) - | (FStar_Syntax_Syntax.Tm_fvar f, FStar_Syntax_Syntax.Tm_fvar g) -> - let uu___ = FStar_Syntax_Syntax.fv_eq f g in equal_if uu___ - | (FStar_Syntax_Syntax.Tm_uinst (f, us), FStar_Syntax_Syntax.Tm_uinst - (g, vs)) -> - let uu___ = eq_tm f g in - eq_and uu___ - (fun uu___1 -> - let uu___2 = eq_univs_list us vs in equal_if uu___2) - | (FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_range uu___), - FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_range uu___1)) -> - Unknown - | (FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_real r1), - FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_real r2)) -> - equal_if (r1 = r2) - | (FStar_Syntax_Syntax.Tm_constant c, FStar_Syntax_Syntax.Tm_constant - d) -> let uu___ = FStar_Const.eq_const c d in equal_iff uu___ - | (FStar_Syntax_Syntax.Tm_uvar (u1, ([], uu___)), - FStar_Syntax_Syntax.Tm_uvar (u2, ([], uu___1))) -> - let uu___2 = - FStar_Syntax_Unionfind.equiv u1.FStar_Syntax_Syntax.ctx_uvar_head - u2.FStar_Syntax_Syntax.ctx_uvar_head in - equal_if uu___2 - | (FStar_Syntax_Syntax.Tm_app - { FStar_Syntax_Syntax.hd = h1; FStar_Syntax_Syntax.args = args1;_}, - FStar_Syntax_Syntax.Tm_app - { FStar_Syntax_Syntax.hd = h2; FStar_Syntax_Syntax.args = args2;_}) - -> - let uu___ = - let uu___1 = - let uu___2 = un_uinst h1 in uu___2.FStar_Syntax_Syntax.n in - let uu___2 = - let uu___3 = un_uinst h2 in uu___3.FStar_Syntax_Syntax.n in - (uu___1, uu___2) in - (match uu___ with - | (FStar_Syntax_Syntax.Tm_fvar f1, FStar_Syntax_Syntax.Tm_fvar f2) - when - (FStar_Syntax_Syntax.fv_eq f1 f2) && - (let uu___1 = - let uu___2 = FStar_Syntax_Syntax.lid_of_fv f1 in - FStar_Ident.string_of_lid uu___2 in - FStar_Compiler_List.mem uu___1 injectives) - -> equal_data f1 args1 f2 args2 - | uu___1 -> - let uu___2 = eq_tm h1 h2 in - eq_and uu___2 (fun uu___3 -> eq_args args1 args2)) - | (FStar_Syntax_Syntax.Tm_match - { FStar_Syntax_Syntax.scrutinee = t13; - FStar_Syntax_Syntax.ret_opt = uu___; - FStar_Syntax_Syntax.brs = bs1; - FStar_Syntax_Syntax.rc_opt1 = uu___1;_}, - FStar_Syntax_Syntax.Tm_match - { FStar_Syntax_Syntax.scrutinee = t23; - FStar_Syntax_Syntax.ret_opt = uu___2; - FStar_Syntax_Syntax.brs = bs2; - FStar_Syntax_Syntax.rc_opt1 = uu___3;_}) - -> - if - (FStar_Compiler_List.length bs1) = - (FStar_Compiler_List.length bs2) - then - let uu___4 = FStar_Compiler_List.zip bs1 bs2 in - let uu___5 = eq_tm t13 t23 in - FStar_Compiler_List.fold_right - (fun uu___6 -> - fun a -> - match uu___6 with - | (b1, b2) -> - eq_and a (fun uu___7 -> branch_matches b1 b2)) uu___4 - uu___5 - else Unknown - | (FStar_Syntax_Syntax.Tm_type u, FStar_Syntax_Syntax.Tm_type v) -> - let uu___ = eq_univs u v in equal_if uu___ - | (FStar_Syntax_Syntax.Tm_quoted (t13, q1), - FStar_Syntax_Syntax.Tm_quoted (t23, q2)) -> Unknown - | (FStar_Syntax_Syntax.Tm_refine - { FStar_Syntax_Syntax.b = t13; FStar_Syntax_Syntax.phi = phi1;_}, - FStar_Syntax_Syntax.Tm_refine - { FStar_Syntax_Syntax.b = t23; FStar_Syntax_Syntax.phi = phi2;_}) -> - let uu___ = - eq_tm t13.FStar_Syntax_Syntax.sort t23.FStar_Syntax_Syntax.sort in - eq_and uu___ (fun uu___1 -> eq_tm phi1 phi2) - | (FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = bs1; FStar_Syntax_Syntax.body = body1; - FStar_Syntax_Syntax.rc_opt = uu___;_}, - FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = bs2; FStar_Syntax_Syntax.body = body2; - FStar_Syntax_Syntax.rc_opt = uu___1;_}) - when - (FStar_Compiler_List.length bs1) = (FStar_Compiler_List.length bs2) - -> - let uu___2 = - FStar_Compiler_List.fold_left2 - (fun r -> - fun b1 -> - fun b2 -> - eq_and r - (fun uu___3 -> - eq_tm - (b1.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort - (b2.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort)) - Equal bs1 bs2 in - eq_and uu___2 (fun uu___3 -> eq_tm body1 body2) - | (FStar_Syntax_Syntax.Tm_arrow - { FStar_Syntax_Syntax.bs1 = bs1; FStar_Syntax_Syntax.comp = c1;_}, - FStar_Syntax_Syntax.Tm_arrow - { FStar_Syntax_Syntax.bs1 = bs2; FStar_Syntax_Syntax.comp = c2;_}) - when - (FStar_Compiler_List.length bs1) = (FStar_Compiler_List.length bs2) - -> - let uu___ = - FStar_Compiler_List.fold_left2 - (fun r -> - fun b1 -> - fun b2 -> - eq_and r - (fun uu___1 -> - eq_tm - (b1.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort - (b2.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort)) - Equal bs1 bs2 in - eq_and uu___ (fun uu___1 -> eq_comp c1 c2) - | uu___ -> Unknown -and (eq_antiquotations : - FStar_Syntax_Syntax.term Prims.list -> - FStar_Syntax_Syntax.term Prims.list -> eq_result) - = - fun a1 -> - fun a2 -> - match (a1, a2) with - | ([], []) -> Equal - | ([], uu___) -> NotEqual - | (uu___, []) -> NotEqual - | (t1::a11, t2::a21) -> - let uu___ = eq_tm t1 t2 in - (match uu___ with - | NotEqual -> NotEqual - | Unknown -> - let uu___1 = eq_antiquotations a11 a21 in - (match uu___1 with | NotEqual -> NotEqual | uu___2 -> Unknown) - | Equal -> eq_antiquotations a11 a21) -and (branch_matches : - (FStar_Syntax_Syntax.pat' FStar_Syntax_Syntax.withinfo_t * - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax - FStar_Pervasives_Native.option * FStar_Syntax_Syntax.term' - FStar_Syntax_Syntax.syntax) -> - (FStar_Syntax_Syntax.pat' FStar_Syntax_Syntax.withinfo_t * - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax - FStar_Pervasives_Native.option * FStar_Syntax_Syntax.term' - FStar_Syntax_Syntax.syntax) -> eq_result) - = - fun b1 -> - fun b2 -> - let related_by f o1 o2 = - match (o1, o2) with - | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) -> - true - | (FStar_Pervasives_Native.Some x, FStar_Pervasives_Native.Some y) -> - f x y - | (uu___, uu___1) -> false in - let uu___ = b1 in - match uu___ with - | (p1, w1, t1) -> - let uu___1 = b2 in - (match uu___1 with - | (p2, w2, t2) -> - let uu___2 = FStar_Syntax_Syntax.eq_pat p1 p2 in - if uu___2 - then - let uu___3 = - (let uu___4 = eq_tm t1 t2 in uu___4 = Equal) && - (related_by - (fun t11 -> - fun t21 -> - let uu___4 = eq_tm t11 t21 in uu___4 = Equal) w1 - w2) in - (if uu___3 then Equal else Unknown) - else Unknown) -and (eq_args : - FStar_Syntax_Syntax.args -> FStar_Syntax_Syntax.args -> eq_result) = - fun a1 -> - fun a2 -> - match (a1, a2) with - | ([], []) -> Equal - | ((a, uu___)::a11, (b, uu___1)::b1) -> - let uu___2 = eq_tm a b in - (match uu___2 with | Equal -> eq_args a11 b1 | uu___3 -> Unknown) - | uu___ -> Unknown -and (eq_univs_list : - FStar_Syntax_Syntax.universes -> - FStar_Syntax_Syntax.universes -> Prims.bool) - = - fun us -> - fun vs -> - ((FStar_Compiler_List.length us) = (FStar_Compiler_List.length vs)) && - (FStar_Compiler_List.forall2 eq_univs us vs) -and (eq_comp : - FStar_Syntax_Syntax.comp -> FStar_Syntax_Syntax.comp -> eq_result) = - fun c1 -> - fun c2 -> - match ((c1.FStar_Syntax_Syntax.n), (c2.FStar_Syntax_Syntax.n)) with - | (FStar_Syntax_Syntax.Total t1, FStar_Syntax_Syntax.Total t2) -> - eq_tm t1 t2 - | (FStar_Syntax_Syntax.GTotal t1, FStar_Syntax_Syntax.GTotal t2) -> - eq_tm t1 t2 - | (FStar_Syntax_Syntax.Comp ct1, FStar_Syntax_Syntax.Comp ct2) -> - let uu___ = - let uu___1 = - eq_univs_list ct1.FStar_Syntax_Syntax.comp_univs - ct2.FStar_Syntax_Syntax.comp_univs in - equal_if uu___1 in - eq_and uu___ - (fun uu___1 -> - let uu___2 = - let uu___3 = - FStar_Ident.lid_equals ct1.FStar_Syntax_Syntax.effect_name - ct2.FStar_Syntax_Syntax.effect_name in - equal_if uu___3 in - eq_and uu___2 - (fun uu___3 -> - let uu___4 = - eq_tm ct1.FStar_Syntax_Syntax.result_typ - ct2.FStar_Syntax_Syntax.result_typ in - eq_and uu___4 - (fun uu___5 -> - eq_args ct1.FStar_Syntax_Syntax.effect_args - ct2.FStar_Syntax_Syntax.effect_args))) - | uu___ -> NotEqual -let (eq_quoteinfo : - FStar_Syntax_Syntax.quoteinfo -> FStar_Syntax_Syntax.quoteinfo -> eq_result) - = - fun q1 -> - fun q2 -> - if q1.FStar_Syntax_Syntax.qkind <> q2.FStar_Syntax_Syntax.qkind - then NotEqual - else - eq_antiquotations - (FStar_Pervasives_Native.snd q1.FStar_Syntax_Syntax.antiquotations) - (FStar_Pervasives_Native.snd q2.FStar_Syntax_Syntax.antiquotations) -let (eq_bqual : - FStar_Syntax_Syntax.binder_qualifier FStar_Pervasives_Native.option -> - FStar_Syntax_Syntax.binder_qualifier FStar_Pervasives_Native.option -> - eq_result) - = - fun a1 -> - fun a2 -> - match (a1, a2) with - | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) -> Equal - | (FStar_Pervasives_Native.None, uu___) -> NotEqual - | (uu___, FStar_Pervasives_Native.None) -> NotEqual - | (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit b1), - FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit b2)) when - b1 = b2 -> Equal - | (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Meta t1), - FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Meta t2)) -> - eq_tm t1 t2 - | (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Equality), - FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Equality)) -> - Equal - | uu___ -> NotEqual -let (eq_aqual : - FStar_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option -> - FStar_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option -> - eq_result) - = - fun a1 -> - fun a2 -> - match (a1, a2) with - | (FStar_Pervasives_Native.Some a11, FStar_Pervasives_Native.Some a21) - -> - if - (a11.FStar_Syntax_Syntax.aqual_implicit = - a21.FStar_Syntax_Syntax.aqual_implicit) - && - ((FStar_Compiler_List.length - a11.FStar_Syntax_Syntax.aqual_attributes) - = - (FStar_Compiler_List.length - a21.FStar_Syntax_Syntax.aqual_attributes)) - then - FStar_Compiler_List.fold_left2 - (fun out -> - fun t1 -> - fun t2 -> - match out with - | NotEqual -> out - | Unknown -> - let uu___ = eq_tm t1 t2 in - (match uu___ with - | NotEqual -> NotEqual - | uu___1 -> Unknown) - | Equal -> eq_tm t1 t2) Equal - a11.FStar_Syntax_Syntax.aqual_attributes - a21.FStar_Syntax_Syntax.aqual_attributes - else NotEqual - | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) -> Equal - | uu___ -> NotEqual let rec (unrefine : FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term) = fun t -> let t1 = FStar_Syntax_Subst.compress t in @@ -1476,7 +1065,8 @@ let (lids_of_sigelt : FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = uu___3; FStar_Syntax_Syntax.mutuals = uu___4; - FStar_Syntax_Syntax.ds = uu___5;_} + FStar_Syntax_Syntax.ds = uu___5; + FStar_Syntax_Syntax.injective_type_params = uu___6;_} -> [lid] | FStar_Syntax_Syntax.Sig_effect_abbrev { FStar_Syntax_Syntax.lid4 = lid; FStar_Syntax_Syntax.us4 = uu___; @@ -1489,7 +1079,8 @@ let (lids_of_sigelt : FStar_Syntax_Syntax.t1 = uu___1; FStar_Syntax_Syntax.ty_lid = uu___2; FStar_Syntax_Syntax.num_ty_params = uu___3; - FStar_Syntax_Syntax.mutuals1 = uu___4;_} + FStar_Syntax_Syntax.mutuals1 = uu___4; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_} -> [lid] | FStar_Syntax_Syntax.Sig_declare_typ { FStar_Syntax_Syntax.lid2 = lid; FStar_Syntax_Syntax.us2 = uu___; @@ -2006,26 +1597,47 @@ let (let_rec_arity : let d_bvs = match d with | FStar_Syntax_Syntax.Decreases_lex l -> - let uu___2 = - FStar_Compiler_Set.empty FStar_Syntax_Syntax.ord_bv () in - FStar_Compiler_List.fold_left - (fun s -> - fun t -> - let uu___3 = FStar_Syntax_Free.names t in - FStar_Compiler_Set.union - FStar_Syntax_Syntax.ord_bv s uu___3) uu___2 l + Obj.magic + (Obj.repr + (let uu___2 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) ()) in + FStar_Compiler_List.fold_left + (fun uu___4 -> + fun uu___3 -> + (fun s -> + fun t -> + let uu___3 = FStar_Syntax_Free.names t in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic s) (Obj.magic uu___3))) + uu___4 uu___3) uu___2 l)) | FStar_Syntax_Syntax.Decreases_wf (rel, e) -> - let uu___2 = FStar_Syntax_Free.names rel in - let uu___3 = FStar_Syntax_Free.names e in - FStar_Compiler_Set.union FStar_Syntax_Syntax.ord_bv - uu___2 uu___3 in + Obj.magic + (Obj.repr + (let uu___2 = FStar_Syntax_Free.names rel in + let uu___3 = FStar_Syntax_Free.names e in + FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic uu___2) (Obj.magic uu___3))) in let uu___2 = FStar_Common.tabulate n_univs (fun uu___3 -> false) in let uu___3 = FStar_Compiler_List.map (fun b -> - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_bv - b.FStar_Syntax_Syntax.binder_bv d_bvs) bs in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + b.FStar_Syntax_Syntax.binder_bv (Obj.magic d_bvs)) bs in FStar_Compiler_List.op_At uu___2 uu___3) in ((n_univs + (FStar_Compiler_List.length bs)), uu___1) let (abs_formals_maybe_unascribe_body : @@ -2325,12 +1937,6 @@ let (type_with_u : FStar_Syntax_Syntax.universe -> FStar_Syntax_Syntax.typ) = fun u -> FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_type u) FStar_Compiler_Range_Type.dummyRange -let (attr_eq : - FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term -> Prims.bool) = - fun a -> - fun a' -> - let uu___ = eq_tm a a' in - match uu___ with | Equal -> true | uu___1 -> false let (attr_substitute : FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax) = let uu___ = @@ -2368,18 +1974,14 @@ let (exp_string : Prims.string -> FStar_Syntax_Syntax.term) = (FStar_Const.Const_string (s, FStar_Compiler_Range_Type.dummyRange))) FStar_Compiler_Range_Type.dummyRange let (fvar_const : FStar_Ident.lident -> FStar_Syntax_Syntax.term) = - fun l -> - FStar_Syntax_Syntax.fvar_with_dd l FStar_Syntax_Syntax.delta_constant - FStar_Pervasives_Native.None + fun l -> FStar_Syntax_Syntax.fvar_with_dd l FStar_Pervasives_Native.None let (tand : FStar_Syntax_Syntax.term) = fvar_const FStar_Parser_Const.and_lid let (tor : FStar_Syntax_Syntax.term) = fvar_const FStar_Parser_Const.or_lid let (timp : FStar_Syntax_Syntax.term) = FStar_Syntax_Syntax.fvar_with_dd FStar_Parser_Const.imp_lid - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_one) FStar_Pervasives_Native.None let (tiff : FStar_Syntax_Syntax.term) = FStar_Syntax_Syntax.fvar_with_dd FStar_Parser_Const.iff_lid - (FStar_Syntax_Syntax.Delta_constant_at_level (Prims.of_int (2))) FStar_Pervasives_Native.None let (t_bool : FStar_Syntax_Syntax.term) = fvar_const FStar_Parser_Const.bool_lid @@ -2488,7 +2090,7 @@ let (mk_conj_l : match phi with | [] -> FStar_Syntax_Syntax.fvar_with_dd FStar_Parser_Const.true_lid - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None + FStar_Pervasives_Native.None | hd::tl -> FStar_Compiler_List.fold_right mk_conj tl hd let (mk_disj : FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> @@ -2693,15 +2295,13 @@ let (mk_has_type : FStar_Syntax_Syntax.mk uu___ FStar_Compiler_Range_Type.dummyRange let (tforall : FStar_Syntax_Syntax.term) = FStar_Syntax_Syntax.fvar_with_dd FStar_Parser_Const.forall_lid - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_one) FStar_Pervasives_Native.None let (texists : FStar_Syntax_Syntax.term) = FStar_Syntax_Syntax.fvar_with_dd FStar_Parser_Const.exists_lid - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_one) FStar_Pervasives_Native.None let (t_haseq : FStar_Syntax_Syntax.term) = FStar_Syntax_Syntax.fvar_with_dd FStar_Parser_Const.haseq_lid - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None + FStar_Pervasives_Native.None let (decidable_eq : FStar_Syntax_Syntax.term) = fvar_const FStar_Parser_Const.op_Eq let (mk_decidable_eq : @@ -2982,7 +2582,6 @@ let (mk_squash : fun p -> let sq = FStar_Syntax_Syntax.fvar_with_dd FStar_Parser_Const.squash_lid - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_one) FStar_Pervasives_Native.None in let uu___ = FStar_Syntax_Syntax.mk_Tm_uinst sq [u] in let uu___1 = let uu___2 = FStar_Syntax_Syntax.as_arg p in [uu___2] in @@ -2996,7 +2595,6 @@ let (mk_auto_squash : fun p -> let sq = FStar_Syntax_Syntax.fvar_with_dd FStar_Parser_Const.auto_squash_lid - (FStar_Syntax_Syntax.Delta_constant_at_level (Prims.of_int (2))) FStar_Pervasives_Native.None in let uu___ = FStar_Syntax_Syntax.mk_Tm_uinst sq [u] in let uu___1 = let uu___2 = FStar_Syntax_Syntax.as_arg p in [uu___2] in @@ -3043,8 +2641,12 @@ let (un_squash : FStar_Compiler_Effect.failwith "impossible" in let uu___3 = let uu___4 = FStar_Syntax_Free.names p1 in - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_bv - b1.FStar_Syntax_Syntax.binder_bv uu___4 in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + b1.FStar_Syntax_Syntax.binder_bv + (Obj.magic uu___4) in if uu___3 then FStar_Pervasives_Native.None else FStar_Pervasives_Native.Some p1) @@ -3214,7 +2816,10 @@ let (is_free_in : fun bv -> fun t -> let uu___ = FStar_Syntax_Free.names t in - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_bv bv uu___ + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) bv (Obj.magic uu___) let (action_as_lb : FStar_Ident.lident -> FStar_Syntax_Syntax.action -> @@ -3228,7 +2833,6 @@ let (action_as_lb : let uu___1 = FStar_Syntax_Syntax.lid_and_dd_as_fv a.FStar_Syntax_Syntax.action_name - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Pervasives.Inr uu___1 in let uu___1 = @@ -3300,61 +2904,6 @@ let (mk_reflect : } in FStar_Syntax_Syntax.Tm_app uu___1 in FStar_Syntax_Syntax.mk uu___ t.FStar_Syntax_Syntax.pos -let rec (delta_qualifier : - FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.delta_depth) = - fun t -> - let t1 = FStar_Syntax_Subst.compress t in - match t1.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_delayed uu___ -> - FStar_Compiler_Effect.failwith "Impossible" - | FStar_Syntax_Syntax.Tm_lazy i -> - let uu___ = unfold_lazy i in delta_qualifier uu___ - | FStar_Syntax_Syntax.Tm_fvar fv -> - (match fv.FStar_Syntax_Syntax.fv_delta with - | FStar_Pervasives_Native.Some d -> d - | FStar_Pervasives_Native.None -> FStar_Syntax_Syntax.delta_constant) - | FStar_Syntax_Syntax.Tm_bvar uu___ -> - FStar_Syntax_Syntax.delta_equational - | FStar_Syntax_Syntax.Tm_name uu___ -> - FStar_Syntax_Syntax.delta_equational - | FStar_Syntax_Syntax.Tm_match uu___ -> - FStar_Syntax_Syntax.delta_equational - | FStar_Syntax_Syntax.Tm_uvar uu___ -> - FStar_Syntax_Syntax.delta_equational - | FStar_Syntax_Syntax.Tm_unknown -> FStar_Syntax_Syntax.delta_equational - | FStar_Syntax_Syntax.Tm_type uu___ -> FStar_Syntax_Syntax.delta_constant - | FStar_Syntax_Syntax.Tm_quoted uu___ -> - FStar_Syntax_Syntax.delta_constant - | FStar_Syntax_Syntax.Tm_constant uu___ -> - FStar_Syntax_Syntax.delta_constant - | FStar_Syntax_Syntax.Tm_arrow uu___ -> - FStar_Syntax_Syntax.delta_constant - | FStar_Syntax_Syntax.Tm_uinst (t2, uu___) -> delta_qualifier t2 - | FStar_Syntax_Syntax.Tm_refine - { - FStar_Syntax_Syntax.b = - { FStar_Syntax_Syntax.ppname = uu___; - FStar_Syntax_Syntax.index = uu___1; - FStar_Syntax_Syntax.sort = t2;_}; - FStar_Syntax_Syntax.phi = uu___2;_} - -> delta_qualifier t2 - | FStar_Syntax_Syntax.Tm_meta - { FStar_Syntax_Syntax.tm2 = t2; FStar_Syntax_Syntax.meta = uu___;_} - -> delta_qualifier t2 - | FStar_Syntax_Syntax.Tm_ascribed - { FStar_Syntax_Syntax.tm = t2; FStar_Syntax_Syntax.asc = uu___; - FStar_Syntax_Syntax.eff_opt = uu___1;_} - -> delta_qualifier t2 - | FStar_Syntax_Syntax.Tm_app - { FStar_Syntax_Syntax.hd = t2; FStar_Syntax_Syntax.args = uu___;_} -> - delta_qualifier t2 - | FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = uu___; FStar_Syntax_Syntax.body = t2; - FStar_Syntax_Syntax.rc_opt = uu___1;_} - -> delta_qualifier t2 - | FStar_Syntax_Syntax.Tm_let - { FStar_Syntax_Syntax.lbs = uu___; FStar_Syntax_Syntax.body1 = t2;_} - -> delta_qualifier t2 let rec (incr_delta_depth : FStar_Syntax_Syntax.delta_depth -> FStar_Syntax_Syntax.delta_depth) = fun d -> @@ -3364,9 +2913,6 @@ let rec (incr_delta_depth : | FStar_Syntax_Syntax.Delta_equational_at_level i -> FStar_Syntax_Syntax.Delta_equational_at_level (i + Prims.int_one) | FStar_Syntax_Syntax.Delta_abstract d1 -> incr_delta_depth d1 -let (incr_delta_qualifier : - FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.delta_depth) = - fun t -> let uu___ = delta_qualifier t in incr_delta_depth uu___ let (is_unknown : FStar_Syntax_Syntax.term -> Prims.bool) = fun t -> let uu___ = @@ -3639,7 +3185,7 @@ let rec (term_eq_dbg : u2.FStar_Syntax_Syntax.ctx_uvar_head) | (FStar_Syntax_Syntax.Tm_quoted (qt1, qi1), FStar_Syntax_Syntax.Tm_quoted (qt2, qi2)) -> - (let uu___1 = let uu___2 = eq_quoteinfo qi1 qi2 in uu___2 = Equal in + (let uu___1 = quote_info_eq_dbg dbg qi1 qi2 in check1 "tm_quoted qi" uu___1) && (let uu___1 = term_eq_dbg dbg qt1 qt2 in check1 "tm_quoted payload" uu___1) @@ -3710,7 +3256,7 @@ and (arg_eq_dbg : let uu___ = term_eq_dbg dbg t1 t2 in check dbg "arg tm" uu___) (fun q1 -> fun q2 -> - let uu___ = let uu___1 = eq_aqual q1 q2 in uu___1 = Equal in + let uu___ = aqual_eq_dbg dbg q1 q2 in check dbg "arg qual" uu___) a1 a2 and (binder_eq_dbg : Prims.bool -> @@ -3725,10 +3271,8 @@ and (binder_eq_dbg : (b2.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in check dbg "binder_sort" uu___) && (let uu___ = - let uu___1 = - eq_bqual b1.FStar_Syntax_Syntax.binder_qual - b2.FStar_Syntax_Syntax.binder_qual in - uu___1 = Equal in + bqual_eq_dbg dbg b1.FStar_Syntax_Syntax.binder_qual + b2.FStar_Syntax_Syntax.binder_qual in check dbg "binder qual" uu___)) && (let uu___ = @@ -3804,6 +3348,108 @@ and (letbinding_eq_dbg : term_eq_dbg dbg lb1.FStar_Syntax_Syntax.lbdef lb2.FStar_Syntax_Syntax.lbdef in check dbg "lb def" uu___) +and (quote_info_eq_dbg : + Prims.bool -> + FStar_Syntax_Syntax.quoteinfo -> + FStar_Syntax_Syntax.quoteinfo -> Prims.bool) + = + fun dbg -> + fun q1 -> + fun q2 -> + if q1.FStar_Syntax_Syntax.qkind <> q2.FStar_Syntax_Syntax.qkind + then false + else + antiquotations_eq_dbg dbg + (FStar_Pervasives_Native.snd + q1.FStar_Syntax_Syntax.antiquotations) + (FStar_Pervasives_Native.snd + q2.FStar_Syntax_Syntax.antiquotations) +and (antiquotations_eq_dbg : + Prims.bool -> + FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax Prims.list -> + FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax Prims.list -> + Prims.bool) + = + fun dbg -> + fun a1 -> + fun a2 -> + match (a1, a2) with + | ([], []) -> true + | ([], uu___) -> false + | (uu___, []) -> false + | (t1::a11, t2::a21) -> + let uu___ = + let uu___1 = term_eq_dbg dbg t1 t2 in Prims.op_Negation uu___1 in + if uu___ then false else antiquotations_eq_dbg dbg a11 a21 +and (bqual_eq_dbg : + Prims.bool -> + FStar_Syntax_Syntax.binder_qualifier FStar_Pervasives_Native.option -> + FStar_Syntax_Syntax.binder_qualifier FStar_Pervasives_Native.option -> + Prims.bool) + = + fun dbg -> + fun a1 -> + fun a2 -> + match (a1, a2) with + | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) -> + true + | (FStar_Pervasives_Native.None, uu___) -> false + | (uu___, FStar_Pervasives_Native.None) -> false + | (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit b1), + FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit b2)) + when b1 = b2 -> true + | (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Meta t1), + FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Meta t2)) -> + term_eq_dbg dbg t1 t2 + | (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Equality), + FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Equality)) -> + true + | uu___ -> false +and (aqual_eq_dbg : + Prims.bool -> + FStar_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option -> + FStar_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option -> + Prims.bool) + = + fun dbg -> + fun a1 -> + fun a2 -> + match (a1, a2) with + | (FStar_Pervasives_Native.Some a11, FStar_Pervasives_Native.Some + a21) -> + if + (a11.FStar_Syntax_Syntax.aqual_implicit = + a21.FStar_Syntax_Syntax.aqual_implicit) + && + ((FStar_Compiler_List.length + a11.FStar_Syntax_Syntax.aqual_attributes) + = + (FStar_Compiler_List.length + a21.FStar_Syntax_Syntax.aqual_attributes)) + then + FStar_Compiler_List.fold_left2 + (fun out -> + fun t1 -> + fun t2 -> + if Prims.op_Negation out + then false + else term_eq_dbg dbg t1 t2) true + a11.FStar_Syntax_Syntax.aqual_attributes + a21.FStar_Syntax_Syntax.aqual_attributes + else false + | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) -> + true + | uu___ -> false +let (eq_aqual : + FStar_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option -> + FStar_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option -> + Prims.bool) + = fun a1 -> fun a2 -> aqual_eq_dbg false a1 a2 +let (eq_bqual : + FStar_Syntax_Syntax.binder_qualifier FStar_Pervasives_Native.option -> + FStar_Syntax_Syntax.binder_qualifier FStar_Pervasives_Native.option -> + Prims.bool) + = fun b1 -> fun b2 -> bqual_eq_dbg false b1 b2 let (term_eq : FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term -> Prims.bool) = fun t1 -> @@ -4893,9 +4539,7 @@ let (is_binder_unused : FStar_Syntax_Syntax.binder -> Prims.bool) = let (deduplicate_terms : FStar_Syntax_Syntax.term Prims.list -> FStar_Syntax_Syntax.term Prims.list) = - fun l -> - FStar_Compiler_List.deduplicate - (fun x -> fun y -> let uu___ = eq_tm x y in uu___ = Equal) l + fun l -> FStar_Compiler_List.deduplicate (fun x -> fun y -> term_eq x y) l let (eq_binding : FStar_Syntax_Syntax.binding -> FStar_Syntax_Syntax.binding -> Prims.bool) = fun b1 -> diff --git a/ocaml/fstar-lib/generated/FStar_Syntax_VisitM.ml b/ocaml/fstar-lib/generated/FStar_Syntax_VisitM.ml index a51590443a2..b9e76115bd4 100644 --- a/ocaml/fstar-lib/generated/FStar_Syntax_VisitM.ml +++ b/ocaml/fstar-lib/generated/FStar_Syntax_VisitM.ml @@ -1652,7 +1652,8 @@ let rec on_sub_sigelt' : 'm . 'm lvm -> FStar_Syntax_Syntax.sigelt' -> 'm = FStar_Syntax_Syntax.params = params; FStar_Syntax_Syntax.num_uniform_params = num_uniform_params; FStar_Syntax_Syntax.t = t; FStar_Syntax_Syntax.mutuals = mutuals; - FStar_Syntax_Syntax.ds = ds;_} + FStar_Syntax_Syntax.ds = ds; + FStar_Syntax_Syntax.injective_type_params = injective_type_params;_} -> let uu___ = FStar_Class_Monad.mapM (_lvm_monad d) () () @@ -1683,7 +1684,9 @@ let rec on_sub_sigelt' : 'm . 'm lvm -> FStar_Syntax_Syntax.sigelt' -> 'm = FStar_Syntax_Syntax.t = t1; FStar_Syntax_Syntax.mutuals = mutuals; - FStar_Syntax_Syntax.ds = ds + FStar_Syntax_Syntax.ds = ds; + FStar_Syntax_Syntax.injective_type_params + = injective_type_params })))) uu___2))) uu___1) | FStar_Syntax_Syntax.Sig_bundle { FStar_Syntax_Syntax.ses = ses; FStar_Syntax_Syntax.lids = lids;_} @@ -1708,7 +1711,9 @@ let rec on_sub_sigelt' : 'm . 'm lvm -> FStar_Syntax_Syntax.sigelt' -> 'm = { FStar_Syntax_Syntax.lid1 = lid; FStar_Syntax_Syntax.us1 = us; FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = ty_lid; FStar_Syntax_Syntax.num_ty_params = num_ty_params; - FStar_Syntax_Syntax.mutuals1 = mutuals;_} + FStar_Syntax_Syntax.mutuals1 = mutuals; + FStar_Syntax_Syntax.injective_type_params1 = + injective_type_params;_} -> let uu___ = f_term d t in FStar_Class_Monad.op_let_Bang (_lvm_monad d) () () uu___ @@ -1726,7 +1731,9 @@ let rec on_sub_sigelt' : 'm . 'm lvm -> FStar_Syntax_Syntax.sigelt' -> 'm = FStar_Syntax_Syntax.ty_lid = ty_lid; FStar_Syntax_Syntax.num_ty_params = num_ty_params; - FStar_Syntax_Syntax.mutuals1 = mutuals + FStar_Syntax_Syntax.mutuals1 = mutuals; + FStar_Syntax_Syntax.injective_type_params1 = + injective_type_params })))) uu___1) | FStar_Syntax_Syntax.Sig_declare_typ { FStar_Syntax_Syntax.lid2 = lid; FStar_Syntax_Syntax.us2 = us; diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml index 13327a01148..29feead2a69 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Hooks.ml @@ -1,4 +1,8 @@ open Prims +let (dbg_Tac : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Tac" +let (dbg_SpinoffAll : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "SpinoffAll" let (run_tactic_on_typ : FStar_Compiler_Range_Type.range -> FStar_Compiler_Range_Type.range -> @@ -164,35 +168,29 @@ let (by_tactic_interp : -> (match pol1 with | StrictlyPositive -> - let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = - FStar_Tactics_Types.goal_of_goal_ty e assertion in - FStar_Pervasives_Native.fst uu___5 in - [uu___4] in - (FStar_Syntax_Util.t_true, uu___3) in - Simplified uu___2 + let g = + let uu___2 = + FStar_Tactics_Types.goal_of_goal_ty e assertion in + FStar_Pervasives_Native.fst uu___2 in + let g1 = + FStar_Tactics_Types.set_label "spun-off assertion" g in + Simplified (FStar_Syntax_Util.t_true, [g1]) | Pos -> - let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = - FStar_Tactics_Types.goal_of_goal_ty e assertion in - FStar_Pervasives_Native.fst uu___5 in - [uu___4] in - (FStar_Syntax_Util.t_true, uu___3) in - Simplified uu___2 + let g = + let uu___2 = + FStar_Tactics_Types.goal_of_goal_ty e assertion in + FStar_Pervasives_Native.fst uu___2 in + let g1 = + FStar_Tactics_Types.set_label "spun-off assertion" g in + Simplified (FStar_Syntax_Util.t_true, [g1]) | Both -> - let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = - FStar_Tactics_Types.goal_of_goal_ty e assertion in - FStar_Pervasives_Native.fst uu___5 in - [uu___4] in - (assertion, FStar_Syntax_Util.t_true, uu___3) in - Dual uu___2 + let g = + let uu___2 = + FStar_Tactics_Types.goal_of_goal_ty e assertion in + FStar_Pervasives_Native.fst uu___2 in + let g1 = + FStar_Tactics_Types.set_label "spun-off assertion" g in + Dual (assertion, FStar_Syntax_Util.t_true, [g1]) | Neg -> Simplified (assertion, [])) | (FStar_Syntax_Syntax.Tm_fvar fv, (tactic, FStar_Pervasives_Native.None)::(typ, @@ -554,148 +552,145 @@ let (preprocess : fun goal -> FStar_Errors.with_ctx "While preprocessing VC with a tactic" (fun uu___ -> - (let uu___2 = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "Tac") in - FStar_Compiler_Effect.op_Colon_Equals - FStar_Tactics_Interpreter.tacdbg uu___2); - (let uu___3 = - FStar_Compiler_Effect.op_Bang FStar_Tactics_Interpreter.tacdbg in - if uu___3 + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Tac in + if uu___2 then + let uu___3 = + let uu___4 = FStar_TypeChecker_Env.all_binders env in + FStar_Syntax_Print.binders_to_string "," uu___4 in let uu___4 = - let uu___5 = FStar_TypeChecker_Env.all_binders env in - FStar_Syntax_Print.binders_to_string "," uu___5 in - let uu___5 = FStar_Class_Show.show FStar_Syntax_Print.showable_term goal in FStar_Compiler_Util.print2 "About to preprocess %s |= %s\n" - uu___4 uu___5 + uu___3 uu___4 else ()); (let initial = (Prims.int_one, []) in - let uu___3 = - let uu___4 = traverse by_tactic_interp Pos env goal in - match uu___4 with + let uu___2 = + let uu___3 = traverse by_tactic_interp Pos env goal in + match uu___3 with | Unchanged t' -> (false, (t', [])) | Simplified (t', gs) -> (true, (t', gs)) - | uu___5 -> + | uu___4 -> FStar_Compiler_Effect.failwith "preprocess: impossible, traverse returned a Dual" in - match uu___3 with + match uu___2 with | (did_anything, (t', gs)) -> - ((let uu___5 = - FStar_Compiler_Effect.op_Bang - FStar_Tactics_Interpreter.tacdbg in - if uu___5 + ((let uu___4 = FStar_Compiler_Effect.op_Bang dbg_Tac in + if uu___4 then + let uu___5 = + let uu___6 = FStar_TypeChecker_Env.all_binders env in + FStar_Syntax_Print.binders_to_string ", " uu___6 in let uu___6 = - let uu___7 = FStar_TypeChecker_Env.all_binders env in - FStar_Syntax_Print.binders_to_string ", " uu___7 in - let uu___7 = FStar_Class_Show.show FStar_Syntax_Print.showable_term t' in FStar_Compiler_Util.print2 - "Main goal simplified to: %s |- %s\n" uu___6 uu___7 + "Main goal simplified to: %s |- %s\n" uu___5 uu___6 else ()); (let s = initial in let s1 = FStar_Compiler_List.fold_left - (fun uu___5 -> + (fun uu___4 -> fun g -> - match uu___5 with + match uu___4 with | (n, gs1) -> let phi = - let uu___6 = - let uu___7 = + let uu___5 = + let uu___6 = FStar_Tactics_Types.goal_env g in - let uu___8 = + let uu___7 = FStar_Tactics_Types.goal_type g in - getprop uu___7 uu___8 in - match uu___6 with + getprop uu___6 uu___7 in + match uu___5 with | FStar_Pervasives_Native.None -> - let uu___7 = - let uu___8 = - let uu___9 = - let uu___10 = + let uu___6 = + let uu___7 = + let uu___8 = + let uu___9 = FStar_Tactics_Types.goal_type g in FStar_Class_Show.show FStar_Syntax_Print.showable_term - uu___10 in + uu___9 in FStar_Compiler_Util.format1 "Tactic returned proof-relevant goal: %s" - uu___9 in + uu___8 in (FStar_Errors_Codes.Fatal_TacticProofRelevantGoal, - uu___8) in - FStar_Errors.raise_error uu___7 + uu___7) in + FStar_Errors.raise_error uu___6 env.FStar_TypeChecker_Env.range | FStar_Pervasives_Native.Some phi1 -> phi1 in - ((let uu___7 = - FStar_Compiler_Effect.op_Bang - FStar_Tactics_Interpreter.tacdbg in - if uu___7 + ((let uu___6 = + FStar_Compiler_Effect.op_Bang dbg_Tac in + if uu___6 then - let uu___8 = + let uu___7 = FStar_Class_Show.show (FStar_Class_Show.printableshow FStar_Class_Printable.printable_int) n in - let uu___9 = - let uu___10 = + let uu___8 = + let uu___9 = FStar_Tactics_Types.goal_type g in FStar_Class_Show.show FStar_Syntax_Print.showable_term - uu___10 in + uu___9 in FStar_Compiler_Util.print2 - "Got goal #%s: %s\n" uu___8 uu___9 + "Got goal #%s: %s\n" uu___7 uu___8 else ()); (let label = - let uu___7 = + let uu___6 = + let uu___7 = + FStar_Pprint.doc_of_string + "Could not prove goal #" in let uu___8 = - FStar_Class_Show.show - (FStar_Class_Show.printableshow - FStar_Class_Printable.printable_int) - n in - let uu___9 = + let uu___9 = + FStar_Class_PP.pp + FStar_Class_PP.pp_int n in let uu___10 = let uu___11 = - FStar_Tactics_Types.get_label g in - uu___11 = "" in - if uu___10 - then "" - else - (let uu___12 = - let uu___13 = - FStar_Tactics_Types.get_label g in - Prims.strcat uu___13 ")" in - Prims.strcat " (" uu___12) in - Prims.strcat uu___8 uu___9 in - Prims.strcat "Could not prove goal #" - uu___7 in + let uu___12 = + FStar_Tactics_Types.get_label g in + uu___12 = "" in + if uu___11 + then FStar_Pprint.empty + else + (let uu___13 = + let uu___14 = + FStar_Tactics_Types.get_label + g in + FStar_Pprint.doc_of_string + uu___14 in + FStar_Pprint.parens uu___13) in + FStar_Pprint.op_Hat_Slash_Hat uu___9 + uu___10 in + FStar_Pprint.op_Hat_Hat uu___7 uu___8 in + [uu___6] in let gt' = - let uu___7 = + let uu___6 = FStar_Tactics_Types.goal_range g in - FStar_TypeChecker_Util.label label uu___7 + FStar_TypeChecker_Util.label label uu___6 phi in - let uu___7 = - let uu___8 = - let uu___9 = + let uu___6 = + let uu___7 = + let uu___8 = FStar_Tactics_Types.goal_env g in - let uu___10 = + let uu___9 = FStar_Tactics_Types.goal_opts g in - (uu___9, gt', uu___10) in - uu___8 :: gs1 in - ((n + Prims.int_one), uu___7)))) s gs in - let uu___5 = s1 in - match uu___5 with - | (uu___6, gs1) -> + (uu___8, gt', uu___9) in + uu___7 :: gs1 in + ((n + Prims.int_one), uu___6)))) s gs in + let uu___4 = s1 in + match uu___4 with + | (uu___5, gs1) -> let gs2 = FStar_Compiler_List.rev gs1 in - let uu___7 = - let uu___8 = - let uu___9 = FStar_Options.peek () in - (env, t', uu___9) in - uu___8 :: gs2 in - (did_anything, uu___7))))) + let uu___6 = + let uu___7 = + let uu___8 = FStar_Options.peek () in + (env, t', uu___8) in + uu___7 :: gs2 in + (did_anything, uu___6))))) let rec (traverse_for_spinoff : pol -> - (Prims.string * FStar_Compiler_Range_Type.range) + (FStar_Pprint.document Prims.list * FStar_Compiler_Range_Type.range) FStar_Pervasives_Native.option -> FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> tres) = @@ -703,9 +698,7 @@ let rec (traverse_for_spinoff : fun label_ctx -> fun e -> fun t -> - let debug_any = FStar_Options.debug_any () in - let debug = - FStar_TypeChecker_Env.debug e (FStar_Options.Other "SpinoffAll") in + let debug_any = FStar_Compiler_Debug.any () in let traverse1 pol2 e1 t1 = traverse_for_spinoff pol2 label_ctx e1 t1 in let traverse_ctx pol2 ctx e1 t1 = @@ -716,18 +709,20 @@ let rec (traverse_for_spinoff : FStar_Compiler_Range_Ops.string_of_def_range rng in let uu___2 = FStar_Compiler_Range_Ops.string_of_use_range rng in + let uu___3 = FStar_Errors_Msg.rendermsg msg in FStar_Compiler_Util.format3 "(%s,%s) : %s" uu___1 uu___2 - msg in - if debug - then - (let uu___1 = + uu___3 in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_SpinoffAll in + if uu___1 + then + let uu___2 = match label_ctx with | FStar_Pervasives_Native.None -> "None" | FStar_Pervasives_Native.Some lc -> print_lc lc in - let uu___2 = print_lc ctx in + let uu___3 = print_lc ctx in FStar_Compiler_Util.print2 - "Changing label context from %s to %s" uu___1 uu___2) - else (); + "Changing label context from %s to %s" uu___2 uu___3 + else ()); traverse_for_spinoff pol2 (FStar_Pervasives_Native.Some ctx) e1 t1 in let should_descend t1 = @@ -790,13 +785,14 @@ let rec (traverse_for_spinoff : let spinoff t2 = match pol2 with | StrictlyPositive -> - (if debug - then - (let uu___1 = + ((let uu___1 = FStar_Compiler_Effect.op_Bang dbg_SpinoffAll in + if uu___1 + then + let uu___2 = FStar_Class_Show.show FStar_Syntax_Print.showable_term t2 in - FStar_Compiler_Util.print1 "Spinning off %s\n" uu___1) - else (); + FStar_Compiler_Util.print1 "Spinning off %s\n" uu___2 + else ()); (let uu___1 = let uu___2 = let uu___3 = label_goal (e1, t2) in [uu___3] in @@ -1261,15 +1257,19 @@ let rec (traverse_for_spinoff : FStar_Parser_Const.squash_lid)) && (let uu___8 = - FStar_Syntax_Util.eq_tm t2 - FStar_Syntax_Util.t_true in - uu___8 = FStar_Syntax_Util.Equal) + FStar_TypeChecker_TermEqAndSimplify.eq_tm + e t2 FStar_Syntax_Util.t_true in + uu___8 = + FStar_TypeChecker_TermEqAndSimplify.Equal) -> - (if debug - then - FStar_Compiler_Util.print_string - "Simplified squash True to True" - else (); + ((let uu___9 = + FStar_Compiler_Effect.op_Bang + dbg_SpinoffAll in + if uu___9 + then + FStar_Compiler_Util.print_string + "Simplified squash True to True" + else ()); FStar_Syntax_Util.t_true.FStar_Syntax_Syntax.n) | uu___7 -> let t' = @@ -1391,14 +1391,13 @@ let (spinoff_strictly_positive_goals : = fun env -> fun goal -> - let debug = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "SpinoffAll") in - if debug - then - (let uu___1 = + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_SpinoffAll in + if uu___1 + then + let uu___2 = FStar_Class_Show.show FStar_Syntax_Print.showable_term goal in - FStar_Compiler_Util.print1 "spinoff_all called with %s\n" uu___1) - else (); + FStar_Compiler_Util.print1 "spinoff_all called with %s\n" uu___2 + else ()); FStar_Errors.with_ctx "While spinning off all goals" (fun uu___1 -> let initial = (Prims.int_one, []) in @@ -1424,26 +1423,28 @@ let (spinoff_strictly_positive_goals : match t with | FStar_TypeChecker_Common.Trivial -> [] | FStar_TypeChecker_Common.NonTrivial t1 -> - (if debug - then - (let msg = - let uu___4 = - let uu___5 = - FStar_TypeChecker_Env.all_binders env in - FStar_Syntax_Print.binders_to_string ", " uu___5 in + ((let uu___4 = + FStar_Compiler_Effect.op_Bang dbg_SpinoffAll in + if uu___4 + then + let msg = let uu___5 = + let uu___6 = + FStar_TypeChecker_Env.all_binders env in + FStar_Syntax_Print.binders_to_string ", " uu___6 in + let uu___6 = FStar_Class_Show.show FStar_Syntax_Print.showable_term t1 in FStar_Compiler_Util.format2 - "Main goal simplified to: %s |- %s\n" uu___4 - uu___5 in - let uu___4 = FStar_TypeChecker_Env.get_range env in - let uu___5 = + "Main goal simplified to: %s |- %s\n" uu___5 + uu___6 in + let uu___5 = FStar_TypeChecker_Env.get_range env in + let uu___6 = FStar_Compiler_Util.format1 "Verification condition was to be split into several atomic sub-goals, but this query had some sub-goals that couldn't be split---the error report, if any, may be inaccurate.\n%s\n" msg in - FStar_Errors.diag uu___4 uu___5) - else (); + FStar_Errors.diag uu___5 uu___6 + else ()); [(env, t1)]) in let s = initial in let s1 = @@ -1479,15 +1480,18 @@ let (spinoff_strictly_positive_goals : | FStar_TypeChecker_Common.Trivial -> FStar_Pervasives_Native.None | FStar_TypeChecker_Common.NonTrivial t2 -> - (if debug - then - (let uu___8 = + ((let uu___8 = + FStar_Compiler_Effect.op_Bang + dbg_SpinoffAll in + if uu___8 + then + let uu___9 = FStar_Class_Show.show FStar_Syntax_Print.showable_term t2 in FStar_Compiler_Util.print1 - "Got goal: %s\n" uu___8) - else (); + "Got goal: %s\n" uu___9 + else ()); FStar_Pervasives_Native.Some (env1, t2)))) gs2 in ((let uu___6 = FStar_TypeChecker_Env.get_range env in @@ -1523,56 +1527,49 @@ let (synthesize : FStar_Syntax_Syntax.mk_Tm_app uu___1 uu___2 typ.FStar_Syntax_Syntax.pos else - ((let uu___3 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Tac") in - FStar_Compiler_Effect.op_Colon_Equals - FStar_Tactics_Interpreter.tacdbg uu___3); - (let uu___3 = - run_tactic_on_typ tau.FStar_Syntax_Syntax.pos - typ.FStar_Syntax_Syntax.pos tau env typ in - match uu___3 with - | (gs, w) -> - (FStar_Compiler_List.iter - (fun g -> - let uu___5 = - let uu___6 = FStar_Tactics_Types.goal_env g in - let uu___7 = FStar_Tactics_Types.goal_type g in - getprop uu___6 uu___7 in - match uu___5 with - | FStar_Pervasives_Native.Some vc -> - ((let uu___7 = - FStar_Compiler_Effect.op_Bang - FStar_Tactics_Interpreter.tacdbg in - if uu___7 - then - let uu___8 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term vc in - FStar_Compiler_Util.print1 - "Synthesis left a goal: %s\n" uu___8 - else ()); - (let guard = - { - FStar_TypeChecker_Common.guard_f = - (FStar_TypeChecker_Common.NonTrivial - vc); - FStar_TypeChecker_Common.deferred_to_tac - = []; - FStar_TypeChecker_Common.deferred = []; - FStar_TypeChecker_Common.univ_ineqs = - ([], []); - FStar_TypeChecker_Common.implicits = [] - } in - let uu___7 = FStar_Tactics_Types.goal_env g in - FStar_TypeChecker_Rel.force_trivial_guard - uu___7 guard)) - | FStar_Pervasives_Native.None -> - FStar_Errors.raise_error - (FStar_Errors_Codes.Fatal_OpenGoalsInSynthesis, - "synthesis left open goals") - typ.FStar_Syntax_Syntax.pos) gs; - w)))) + (let uu___2 = + run_tactic_on_typ tau.FStar_Syntax_Syntax.pos + typ.FStar_Syntax_Syntax.pos tau env typ in + match uu___2 with + | (gs, w) -> + (FStar_Compiler_List.iter + (fun g -> + let uu___4 = + let uu___5 = FStar_Tactics_Types.goal_env g in + let uu___6 = FStar_Tactics_Types.goal_type g in + getprop uu___5 uu___6 in + match uu___4 with + | FStar_Pervasives_Native.Some vc -> + ((let uu___6 = + FStar_Compiler_Effect.op_Bang dbg_Tac in + if uu___6 + then + let uu___7 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term vc in + FStar_Compiler_Util.print1 + "Synthesis left a goal: %s\n" uu___7 + else ()); + (let guard = + { + FStar_TypeChecker_Common.guard_f = + (FStar_TypeChecker_Common.NonTrivial vc); + FStar_TypeChecker_Common.deferred_to_tac + = []; + FStar_TypeChecker_Common.deferred = []; + FStar_TypeChecker_Common.univ_ineqs = + ([], []); + FStar_TypeChecker_Common.implicits = [] + } in + let uu___6 = FStar_Tactics_Types.goal_env g in + FStar_TypeChecker_Rel.force_trivial_guard + uu___6 guard)) + | FStar_Pervasives_Native.None -> + FStar_Errors.raise_error + (FStar_Errors_Codes.Fatal_OpenGoalsInSynthesis, + "synthesis left open goals") + typ.FStar_Syntax_Syntax.pos) gs; + w))) let (solve_implicits : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> FStar_TypeChecker_Env.implicits -> unit) @@ -1585,87 +1582,80 @@ let (solve_implicits : if env.FStar_TypeChecker_Env.nosynth then () else - ((let uu___3 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Tac") in - FStar_Compiler_Effect.op_Colon_Equals - FStar_Tactics_Interpreter.tacdbg uu___3); - (let gs = - let uu___3 = FStar_TypeChecker_Env.get_range env in - run_tactic_on_all_implicits tau.FStar_Syntax_Syntax.pos - uu___3 tau env imps in - (let uu___4 = - FStar_Options.profile_enabled - FStar_Pervasives_Native.None "FStar.TypeChecker" in - if uu___4 - then - let uu___5 = - FStar_Class_Show.show - (FStar_Class_Show.printableshow - FStar_Class_Printable.printable_nat) - (FStar_Compiler_List.length gs) in - FStar_Compiler_Util.print1 - "solve_implicits produced %s goals\n" uu___5 - else ()); - FStar_Options.with_saved_options - (fun uu___4 -> - let uu___5 = FStar_Options.set_options "--no_tactics" in - FStar_Compiler_List.iter - (fun g -> - (let uu___7 = FStar_Tactics_Types.goal_opts g in - FStar_Options.set uu___7); - (let uu___7 = - let uu___8 = FStar_Tactics_Types.goal_env g in - let uu___9 = FStar_Tactics_Types.goal_type g in - getprop uu___8 uu___9 in - match uu___7 with - | FStar_Pervasives_Native.Some vc -> - ((let uu___9 = - FStar_Compiler_Effect.op_Bang - FStar_Tactics_Interpreter.tacdbg in - if uu___9 - then - let uu___10 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term vc in - FStar_Compiler_Util.print1 - "Synthesis left a goal: %s\n" uu___10 - else ()); - (let uu___9 = - let uu___10 = - FStar_Options.admit_smt_queries () in - Prims.op_Negation uu___10 in - if uu___9 - then - let guard = - { - FStar_TypeChecker_Common.guard_f = - (FStar_TypeChecker_Common.NonTrivial - vc); - FStar_TypeChecker_Common.deferred_to_tac - = []; - FStar_TypeChecker_Common.deferred = - []; - FStar_TypeChecker_Common.univ_ineqs = - ([], []); - FStar_TypeChecker_Common.implicits = - [] - } in - FStar_Profiling.profile - (fun uu___10 -> - let uu___11 = - FStar_Tactics_Types.goal_env g in - FStar_TypeChecker_Rel.force_trivial_guard - uu___11 guard) - FStar_Pervasives_Native.None - "FStar.TypeChecker.Hooks.force_trivial_guard" - else ())) - | FStar_Pervasives_Native.None -> - let uu___8 = - FStar_TypeChecker_Env.get_range env in - FStar_Errors.raise_error - (FStar_Errors_Codes.Fatal_OpenGoalsInSynthesis, - "synthesis left open goals") uu___8)) gs)))) + (let gs = + let uu___2 = FStar_TypeChecker_Env.get_range env in + run_tactic_on_all_implicits tau.FStar_Syntax_Syntax.pos + uu___2 tau env imps in + (let uu___3 = + FStar_Options.profile_enabled FStar_Pervasives_Native.None + "FStar.TypeChecker" in + if uu___3 + then + let uu___4 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_nat) + (FStar_Compiler_List.length gs) in + FStar_Compiler_Util.print1 + "solve_implicits produced %s goals\n" uu___4 + else ()); + FStar_Options.with_saved_options + (fun uu___3 -> + let uu___4 = FStar_Options.set_options "--no_tactics" in + FStar_Compiler_List.iter + (fun g -> + (let uu___6 = FStar_Tactics_Types.goal_opts g in + FStar_Options.set uu___6); + (let uu___6 = + let uu___7 = FStar_Tactics_Types.goal_env g in + let uu___8 = FStar_Tactics_Types.goal_type g in + getprop uu___7 uu___8 in + match uu___6 with + | FStar_Pervasives_Native.Some vc -> + ((let uu___8 = + FStar_Compiler_Effect.op_Bang dbg_Tac in + if uu___8 + then + let uu___9 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term vc in + FStar_Compiler_Util.print1 + "Synthesis left a goal: %s\n" uu___9 + else ()); + (let uu___8 = + let uu___9 = + FStar_Options.admit_smt_queries () in + Prims.op_Negation uu___9 in + if uu___8 + then + let guard = + { + FStar_TypeChecker_Common.guard_f = + (FStar_TypeChecker_Common.NonTrivial + vc); + FStar_TypeChecker_Common.deferred_to_tac + = []; + FStar_TypeChecker_Common.deferred = []; + FStar_TypeChecker_Common.univ_ineqs = + ([], []); + FStar_TypeChecker_Common.implicits = + [] + } in + FStar_Profiling.profile + (fun uu___9 -> + let uu___10 = + FStar_Tactics_Types.goal_env g in + FStar_TypeChecker_Rel.force_trivial_guard + uu___10 guard) + FStar_Pervasives_Native.None + "FStar.TypeChecker.Hooks.force_trivial_guard" + else ())) + | FStar_Pervasives_Native.None -> + let uu___7 = + FStar_TypeChecker_Env.get_range env in + FStar_Errors.raise_error + (FStar_Errors_Codes.Fatal_OpenGoalsInSynthesis, + "synthesis left open goals") uu___7)) gs))) let (find_user_tac_for_attr : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> @@ -1705,13 +1695,6 @@ let (handle_smt_goal : let fv = FStar_Syntax_Syntax.lid_as_fv lid FStar_Pervasives_Native.None in - let dd = - let uu___3 = - FStar_TypeChecker_Env.delta_depth_of_qninfo fv qn in - match uu___3 with - | FStar_Pervasives_Native.Some dd1 -> dd1 - | FStar_Pervasives_Native.None -> - FStar_Compiler_Effect.failwith "Expected a dd" in let uu___3 = FStar_Syntax_Syntax.lid_as_fv lid FStar_Pervasives_Native.None in @@ -1722,54 +1705,56 @@ let (handle_smt_goal : FStar_Errors.with_ctx "While handling an SMT goal with a tactic" (fun uu___2 -> - (let uu___4 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Tac") in - FStar_Compiler_Effect.op_Colon_Equals - FStar_Tactics_Interpreter.tacdbg uu___4); - (let uu___4 = - let uu___5 = FStar_TypeChecker_Env.get_range env in - let uu___6 = - FStar_Syntax_Util.mk_squash - FStar_Syntax_Syntax.U_zero goal1 in - run_tactic_on_typ tau.FStar_Syntax_Syntax.pos uu___5 - tau env uu___6 in - match uu___4 with - | (gs1, uu___5) -> - FStar_Compiler_List.map - (fun g -> - let uu___6 = - let uu___7 = FStar_Tactics_Types.goal_env g in - let uu___8 = - FStar_Tactics_Types.goal_type g in - getprop uu___7 uu___8 in - match uu___6 with - | FStar_Pervasives_Native.Some vc -> - ((let uu___8 = - FStar_Compiler_Effect.op_Bang - FStar_Tactics_Interpreter.tacdbg in - if uu___8 - then - let uu___9 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term - vc in - FStar_Compiler_Util.print1 - "handle_smt_goals left a goal: %s\n" - uu___9 - else ()); - (let uu___8 = - FStar_Tactics_Types.goal_env g in - (uu___8, vc))) - | FStar_Pervasives_Native.None -> - let uu___7 = - FStar_TypeChecker_Env.get_range env in - FStar_Errors.raise_error - (FStar_Errors_Codes.Fatal_OpenGoalsInSynthesis, - "Handling an SMT goal by tactic left non-prop open goals") - uu___7) gs1)) in + let uu___3 = + let uu___4 = FStar_TypeChecker_Env.get_range env in + let uu___5 = + FStar_Syntax_Util.mk_squash + FStar_Syntax_Syntax.U_zero goal1 in + run_tactic_on_typ tau.FStar_Syntax_Syntax.pos uu___4 + tau env uu___5 in + match uu___3 with + | (gs1, uu___4) -> + FStar_Compiler_List.map + (fun g -> + let uu___5 = + let uu___6 = FStar_Tactics_Types.goal_env g in + let uu___7 = FStar_Tactics_Types.goal_type g in + getprop uu___6 uu___7 in + match uu___5 with + | FStar_Pervasives_Native.Some vc -> + ((let uu___7 = + FStar_Compiler_Effect.op_Bang dbg_Tac in + if uu___7 + then + let uu___8 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term + vc in + FStar_Compiler_Util.print1 + "handle_smt_goals left a goal: %s\n" + uu___8 + else ()); + (let uu___7 = + FStar_Tactics_Types.goal_env g in + (uu___7, vc))) + | FStar_Pervasives_Native.None -> + let uu___6 = + FStar_TypeChecker_Env.get_range env in + FStar_Errors.raise_error + (FStar_Errors_Codes.Fatal_OpenGoalsInSynthesis, + "Handling an SMT goal by tactic left non-prop open goals") + uu___6) gs1) in gs | FStar_Pervasives_Native.None -> [(env, goal1)]) +let (uu___842 : + FStar_Syntax_Syntax.term FStar_Syntax_Embeddings_Base.embedding) = + FStar_Reflection_V2_Embeddings.e_term +type blob_t = + (Prims.string * FStar_Syntax_Syntax.term) FStar_Pervasives_Native.option +type dsl_typed_sigelt_t = (Prims.bool * FStar_Syntax_Syntax.sigelt * blob_t) +type dsl_tac_result_t = + (dsl_typed_sigelt_t Prims.list * dsl_typed_sigelt_t * dsl_typed_sigelt_t + Prims.list) let (splice : FStar_TypeChecker_Env.env -> Prims.bool -> @@ -1788,460 +1773,371 @@ let (splice : if env.FStar_TypeChecker_Env.nosynth then [] else - ((let uu___3 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Tac") in - FStar_Compiler_Effect.op_Colon_Equals - FStar_Tactics_Interpreter.tacdbg uu___3); - (let uu___3 = - if is_typed - then - FStar_TypeChecker_TcTerm.tc_check_tot_or_gtot_term - env tau FStar_Syntax_Util.t_dsl_tac_typ "" - else - FStar_TypeChecker_TcTerm.tc_tactic - FStar_Syntax_Syntax.t_unit - FStar_Syntax_Syntax.t_decls env tau in - match uu___3 with - | (tau1, uu___4, g) -> - (FStar_TypeChecker_Rel.force_trivial_guard env g; - (let ps = - FStar_Tactics_V2_Basic.proofstate_of_goals - tau1.FStar_Syntax_Syntax.pos env [] [] in - let tactic_already_typed = true in - let uu___6 = - if is_typed - then - let e_blob = - FStar_Syntax_Embeddings.e_option - (FStar_Syntax_Embeddings.e_tuple2 - FStar_Syntax_Embeddings.e_string - FStar_Reflection_V2_Embeddings.e_term) in - let uu___7 = - FStar_Tactics_Interpreter.run_tactic_on_ps - tau1.FStar_Syntax_Syntax.pos - tau1.FStar_Syntax_Syntax.pos false - FStar_Reflection_V2_Embeddings.e_env - { - FStar_TypeChecker_Env.solver = - (env.FStar_TypeChecker_Env.solver); - FStar_TypeChecker_Env.range = - (env.FStar_TypeChecker_Env.range); - FStar_TypeChecker_Env.curmodule = - (env.FStar_TypeChecker_Env.curmodule); - FStar_TypeChecker_Env.gamma = []; - FStar_TypeChecker_Env.gamma_sig = - (env.FStar_TypeChecker_Env.gamma_sig); - FStar_TypeChecker_Env.gamma_cache = - (env.FStar_TypeChecker_Env.gamma_cache); - FStar_TypeChecker_Env.modules = - (env.FStar_TypeChecker_Env.modules); - FStar_TypeChecker_Env.expected_typ = - (env.FStar_TypeChecker_Env.expected_typ); - FStar_TypeChecker_Env.sigtab = - (env.FStar_TypeChecker_Env.sigtab); - FStar_TypeChecker_Env.attrtab = - (env.FStar_TypeChecker_Env.attrtab); - FStar_TypeChecker_Env.instantiate_imp = - (env.FStar_TypeChecker_Env.instantiate_imp); - FStar_TypeChecker_Env.effects = - (env.FStar_TypeChecker_Env.effects); - FStar_TypeChecker_Env.generalize = - (env.FStar_TypeChecker_Env.generalize); - FStar_TypeChecker_Env.letrecs = - (env.FStar_TypeChecker_Env.letrecs); - FStar_TypeChecker_Env.top_level = - (env.FStar_TypeChecker_Env.top_level); - FStar_TypeChecker_Env.check_uvars = - (env.FStar_TypeChecker_Env.check_uvars); - FStar_TypeChecker_Env.use_eq_strict = - (env.FStar_TypeChecker_Env.use_eq_strict); - FStar_TypeChecker_Env.is_iface = - (env.FStar_TypeChecker_Env.is_iface); - FStar_TypeChecker_Env.admit = - (env.FStar_TypeChecker_Env.admit); - FStar_TypeChecker_Env.lax = - (env.FStar_TypeChecker_Env.lax); - FStar_TypeChecker_Env.lax_universes = - (env.FStar_TypeChecker_Env.lax_universes); - FStar_TypeChecker_Env.phase1 = - (env.FStar_TypeChecker_Env.phase1); - FStar_TypeChecker_Env.failhard = - (env.FStar_TypeChecker_Env.failhard); - FStar_TypeChecker_Env.nosynth = - (env.FStar_TypeChecker_Env.nosynth); - FStar_TypeChecker_Env.uvar_subtyping = - (env.FStar_TypeChecker_Env.uvar_subtyping); - FStar_TypeChecker_Env.intactics = - (env.FStar_TypeChecker_Env.intactics); - FStar_TypeChecker_Env.nocoerce = - (env.FStar_TypeChecker_Env.nocoerce); - FStar_TypeChecker_Env.tc_term = - (env.FStar_TypeChecker_Env.tc_term); - FStar_TypeChecker_Env.typeof_tot_or_gtot_term - = - (env.FStar_TypeChecker_Env.typeof_tot_or_gtot_term); - FStar_TypeChecker_Env.universe_of = - (env.FStar_TypeChecker_Env.universe_of); - FStar_TypeChecker_Env.typeof_well_typed_tot_or_gtot_term - = - (env.FStar_TypeChecker_Env.typeof_well_typed_tot_or_gtot_term); - FStar_TypeChecker_Env.teq_nosmt_force = - (env.FStar_TypeChecker_Env.teq_nosmt_force); - FStar_TypeChecker_Env.subtype_nosmt_force - = - (env.FStar_TypeChecker_Env.subtype_nosmt_force); - FStar_TypeChecker_Env.qtbl_name_and_index - = - (env.FStar_TypeChecker_Env.qtbl_name_and_index); - FStar_TypeChecker_Env.normalized_eff_names - = - (env.FStar_TypeChecker_Env.normalized_eff_names); - FStar_TypeChecker_Env.fv_delta_depths = - (env.FStar_TypeChecker_Env.fv_delta_depths); - FStar_TypeChecker_Env.proof_ns = - (env.FStar_TypeChecker_Env.proof_ns); - FStar_TypeChecker_Env.synth_hook = - (env.FStar_TypeChecker_Env.synth_hook); - FStar_TypeChecker_Env.try_solve_implicits_hook - = - (env.FStar_TypeChecker_Env.try_solve_implicits_hook); - FStar_TypeChecker_Env.splice = - (env.FStar_TypeChecker_Env.splice); - FStar_TypeChecker_Env.mpreprocess = - (env.FStar_TypeChecker_Env.mpreprocess); - FStar_TypeChecker_Env.postprocess = - (env.FStar_TypeChecker_Env.postprocess); - FStar_TypeChecker_Env.identifier_info = - (env.FStar_TypeChecker_Env.identifier_info); - FStar_TypeChecker_Env.tc_hooks = - (env.FStar_TypeChecker_Env.tc_hooks); - FStar_TypeChecker_Env.dsenv = - (env.FStar_TypeChecker_Env.dsenv); - FStar_TypeChecker_Env.nbe = - (env.FStar_TypeChecker_Env.nbe); - FStar_TypeChecker_Env.strict_args_tab = - (env.FStar_TypeChecker_Env.strict_args_tab); - FStar_TypeChecker_Env.erasable_types_tab - = - (env.FStar_TypeChecker_Env.erasable_types_tab); - FStar_TypeChecker_Env.enable_defer_to_tac - = - (env.FStar_TypeChecker_Env.enable_defer_to_tac); - FStar_TypeChecker_Env.unif_allow_ref_guards - = - (env.FStar_TypeChecker_Env.unif_allow_ref_guards); - FStar_TypeChecker_Env.erase_erasable_args - = - (env.FStar_TypeChecker_Env.erase_erasable_args); - FStar_TypeChecker_Env.core_check = - (env.FStar_TypeChecker_Env.core_check) - } - (FStar_Syntax_Embeddings.e_list - (FStar_Syntax_Embeddings.e_tuple3 - FStar_Syntax_Embeddings.e_bool - FStar_Reflection_V2_Embeddings.e_sigelt - e_blob)) tau1 tactic_already_typed - ps in - match uu___7 with - | (gs, sig_blobs) -> - let sigelts = - FStar_Compiler_List.map - (fun uu___8 -> - match uu___8 with - | (checked, se, blob_opt) -> - let uu___9 = - let uu___10 = - se.FStar_Syntax_Syntax.sigmeta in - let uu___11 = - match blob_opt with - | FStar_Pervasives_Native.Some - (s, blob) -> - let uu___12 = - let uu___13 = - FStar_Compiler_Dyn.mkdyn - blob in - (s, uu___13) in - [uu___12] - | FStar_Pervasives_Native.None - -> [] in - { - FStar_Syntax_Syntax.sigmeta_active - = - (uu___10.FStar_Syntax_Syntax.sigmeta_active); - FStar_Syntax_Syntax.sigmeta_fact_db_ids - = - (uu___10.FStar_Syntax_Syntax.sigmeta_fact_db_ids); - FStar_Syntax_Syntax.sigmeta_admit - = - (uu___10.FStar_Syntax_Syntax.sigmeta_admit); - FStar_Syntax_Syntax.sigmeta_spliced - = - (uu___10.FStar_Syntax_Syntax.sigmeta_spliced); - FStar_Syntax_Syntax.sigmeta_already_checked - = checked; - FStar_Syntax_Syntax.sigmeta_extension_data - = uu___11 - } in - { - FStar_Syntax_Syntax.sigel = - (se.FStar_Syntax_Syntax.sigel); - FStar_Syntax_Syntax.sigrng = - (se.FStar_Syntax_Syntax.sigrng); - FStar_Syntax_Syntax.sigquals - = - (se.FStar_Syntax_Syntax.sigquals); - FStar_Syntax_Syntax.sigmeta = - uu___9; - FStar_Syntax_Syntax.sigattrs - = - (se.FStar_Syntax_Syntax.sigattrs); - FStar_Syntax_Syntax.sigopens_and_abbrevs - = - (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); - FStar_Syntax_Syntax.sigopts = - (se.FStar_Syntax_Syntax.sigopts) - }) sig_blobs in - (gs, sigelts) - else - FStar_Tactics_Interpreter.run_tactic_on_ps - tau1.FStar_Syntax_Syntax.pos - tau1.FStar_Syntax_Syntax.pos false - FStar_Syntax_Embeddings.e_unit () - (FStar_Syntax_Embeddings.e_list - FStar_Reflection_V2_Embeddings.e_sigelt) - tau1 tactic_already_typed ps in - match uu___6 with - | (gs, sigelts) -> - let sigelts1 = - let set_lb_dd lb = - let uu___7 = lb in - match uu___7 with - | { - FStar_Syntax_Syntax.lbname = - FStar_Pervasives.Inr fv; - FStar_Syntax_Syntax.lbunivs = uu___8; - FStar_Syntax_Syntax.lbtyp = uu___9; - FStar_Syntax_Syntax.lbeff = uu___10; - FStar_Syntax_Syntax.lbdef = lbdef; - FStar_Syntax_Syntax.lbattrs = uu___11; - FStar_Syntax_Syntax.lbpos = uu___12;_} - -> - let uu___13 = - let uu___14 = - let uu___15 = - let uu___16 = - FStar_Syntax_Util.incr_delta_qualifier - lbdef in + (let uu___2 = + if is_typed + then + FStar_TypeChecker_TcTerm.tc_check_tot_or_gtot_term + env tau FStar_Syntax_Util.t_dsl_tac_typ "" + else + FStar_TypeChecker_TcTerm.tc_tactic + FStar_Syntax_Syntax.t_unit + FStar_Syntax_Syntax.t_decls env tau in + match uu___2 with + | (tau1, uu___3, g) -> + (FStar_TypeChecker_Rel.force_trivial_guard env g; + (let ps = + FStar_Tactics_V2_Basic.proofstate_of_goals + tau1.FStar_Syntax_Syntax.pos env [] [] in + let tactic_already_typed = true in + let uu___5 = + if is_typed + then + (if + (FStar_Compiler_List.length lids) > + Prims.int_one + then + let uu___6 = + let uu___7 = + let uu___8 = + FStar_Class_Show.show + (FStar_Class_Show.show_list + FStar_Ident.showable_lident) lids in + FStar_Compiler_Util.format1 + "Typed splice: unexpected lids length (> 1) (%s)" + uu___8 in + (FStar_Errors_Codes.Error_BadSplice, + uu___7) in + FStar_Errors.raise_error uu___6 rng + else + (let val_t = + if + (FStar_Compiler_List.length lids) = + Prims.int_zero + then FStar_Pervasives_Native.None + else + (let uu___8 = + let uu___9 = + FStar_Compiler_List.hd lids in + FStar_TypeChecker_Env.try_lookup_val_decl + env uu___9 in + match uu___8 with + | FStar_Pervasives_Native.None -> + FStar_Pervasives_Native.None + | FStar_Pervasives_Native.Some + ((uvs, tval), uu___9) -> + if + (FStar_Compiler_List.length uvs) + <> Prims.int_zero + then + let uu___10 = + let uu___11 = + let uu___12 = + FStar_Compiler_Util.string_of_int + (FStar_Compiler_List.length + uvs) in + FStar_Compiler_Util.format1 + "Typed splice: val declaration for %s is universe polymorphic in %s universes, expected 0" + uu___12 in + (FStar_Errors_Codes.Error_BadSplice, + uu___11) in + FStar_Errors.raise_error uu___10 + rng + else FStar_Pervasives_Native.Some - uu___16 in - { - FStar_Syntax_Syntax.fv_name = - (fv.FStar_Syntax_Syntax.fv_name); - FStar_Syntax_Syntax.fv_delta = - uu___15; - FStar_Syntax_Syntax.fv_qual = - (fv.FStar_Syntax_Syntax.fv_qual) - } in - FStar_Pervasives.Inr uu___14 in - { - FStar_Syntax_Syntax.lbname = uu___13; - FStar_Syntax_Syntax.lbunivs = - (lb.FStar_Syntax_Syntax.lbunivs); - FStar_Syntax_Syntax.lbtyp = - (lb.FStar_Syntax_Syntax.lbtyp); - FStar_Syntax_Syntax.lbeff = - (lb.FStar_Syntax_Syntax.lbeff); - FStar_Syntax_Syntax.lbdef = - (lb.FStar_Syntax_Syntax.lbdef); - FStar_Syntax_Syntax.lbattrs = - (lb.FStar_Syntax_Syntax.lbattrs); - FStar_Syntax_Syntax.lbpos = - (lb.FStar_Syntax_Syntax.lbpos) - } in - FStar_Compiler_List.map - (fun se -> - match se.FStar_Syntax_Syntax.sigel with - | FStar_Syntax_Syntax.Sig_let - { - FStar_Syntax_Syntax.lbs1 = - (is_rec, lbs); - FStar_Syntax_Syntax.lids1 = lids1;_} - -> - let uu___7 = - let uu___8 = - let uu___9 = - let uu___10 = - FStar_Compiler_List.map - set_lb_dd lbs in - (is_rec, uu___10) in - { - FStar_Syntax_Syntax.lbs1 = - uu___9; - FStar_Syntax_Syntax.lids1 = - lids1 - } in - FStar_Syntax_Syntax.Sig_let - uu___8 in - { - FStar_Syntax_Syntax.sigel = - uu___7; - FStar_Syntax_Syntax.sigrng = - (se.FStar_Syntax_Syntax.sigrng); - FStar_Syntax_Syntax.sigquals = - (se.FStar_Syntax_Syntax.sigquals); - FStar_Syntax_Syntax.sigmeta = - (se.FStar_Syntax_Syntax.sigmeta); - FStar_Syntax_Syntax.sigattrs = - (se.FStar_Syntax_Syntax.sigattrs); - FStar_Syntax_Syntax.sigopens_and_abbrevs - = - (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); - FStar_Syntax_Syntax.sigopts = - (se.FStar_Syntax_Syntax.sigopts) - } - | uu___7 -> se) sigelts in - (FStar_Options.with_saved_options - (fun uu___8 -> - FStar_Compiler_List.iter - (fun g1 -> - (let uu___10 = - FStar_Tactics_Types.goal_opts g1 in - FStar_Options.set uu___10); - (let uu___10 = - let uu___11 = - FStar_Tactics_Types.goal_env - g1 in - let uu___12 = - FStar_Tactics_Types.goal_type - g1 in - getprop uu___11 uu___12 in - match uu___10 with - | FStar_Pervasives_Native.Some vc - -> - ((let uu___12 = - FStar_Compiler_Effect.op_Bang - FStar_Tactics_Interpreter.tacdbg in - if uu___12 - then - let uu___13 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term - vc in - FStar_Compiler_Util.print1 - "Splice left a goal: %s\n" - uu___13 - else ()); - (let guard = + tval) in + let uu___7 = + FStar_Tactics_Interpreter.run_tactic_on_ps + tau1.FStar_Syntax_Syntax.pos + tau1.FStar_Syntax_Syntax.pos false + (FStar_Syntax_Embeddings.e_tuple2 + FStar_Reflection_V2_Embeddings.e_env + (FStar_Syntax_Embeddings.e_option + uu___842)) + ({ + FStar_TypeChecker_Env.solver = + (env.FStar_TypeChecker_Env.solver); + FStar_TypeChecker_Env.range = + (env.FStar_TypeChecker_Env.range); + FStar_TypeChecker_Env.curmodule = + (env.FStar_TypeChecker_Env.curmodule); + FStar_TypeChecker_Env.gamma = []; + FStar_TypeChecker_Env.gamma_sig = + (env.FStar_TypeChecker_Env.gamma_sig); + FStar_TypeChecker_Env.gamma_cache = + (env.FStar_TypeChecker_Env.gamma_cache); + FStar_TypeChecker_Env.modules = + (env.FStar_TypeChecker_Env.modules); + FStar_TypeChecker_Env.expected_typ = + (env.FStar_TypeChecker_Env.expected_typ); + FStar_TypeChecker_Env.sigtab = + (env.FStar_TypeChecker_Env.sigtab); + FStar_TypeChecker_Env.attrtab = + (env.FStar_TypeChecker_Env.attrtab); + FStar_TypeChecker_Env.instantiate_imp + = + (env.FStar_TypeChecker_Env.instantiate_imp); + FStar_TypeChecker_Env.effects = + (env.FStar_TypeChecker_Env.effects); + FStar_TypeChecker_Env.generalize = + (env.FStar_TypeChecker_Env.generalize); + FStar_TypeChecker_Env.letrecs = + (env.FStar_TypeChecker_Env.letrecs); + FStar_TypeChecker_Env.top_level = + (env.FStar_TypeChecker_Env.top_level); + FStar_TypeChecker_Env.check_uvars = + (env.FStar_TypeChecker_Env.check_uvars); + FStar_TypeChecker_Env.use_eq_strict + = + (env.FStar_TypeChecker_Env.use_eq_strict); + FStar_TypeChecker_Env.is_iface = + (env.FStar_TypeChecker_Env.is_iface); + FStar_TypeChecker_Env.admit = + (env.FStar_TypeChecker_Env.admit); + FStar_TypeChecker_Env.lax = + (env.FStar_TypeChecker_Env.lax); + FStar_TypeChecker_Env.lax_universes + = + (env.FStar_TypeChecker_Env.lax_universes); + FStar_TypeChecker_Env.phase1 = + (env.FStar_TypeChecker_Env.phase1); + FStar_TypeChecker_Env.failhard = + (env.FStar_TypeChecker_Env.failhard); + FStar_TypeChecker_Env.nosynth = + (env.FStar_TypeChecker_Env.nosynth); + FStar_TypeChecker_Env.uvar_subtyping + = + (env.FStar_TypeChecker_Env.uvar_subtyping); + FStar_TypeChecker_Env.intactics = + (env.FStar_TypeChecker_Env.intactics); + FStar_TypeChecker_Env.nocoerce = + (env.FStar_TypeChecker_Env.nocoerce); + FStar_TypeChecker_Env.tc_term = + (env.FStar_TypeChecker_Env.tc_term); + FStar_TypeChecker_Env.typeof_tot_or_gtot_term + = + (env.FStar_TypeChecker_Env.typeof_tot_or_gtot_term); + FStar_TypeChecker_Env.universe_of = + (env.FStar_TypeChecker_Env.universe_of); + FStar_TypeChecker_Env.typeof_well_typed_tot_or_gtot_term + = + (env.FStar_TypeChecker_Env.typeof_well_typed_tot_or_gtot_term); + FStar_TypeChecker_Env.teq_nosmt_force + = + (env.FStar_TypeChecker_Env.teq_nosmt_force); + FStar_TypeChecker_Env.subtype_nosmt_force + = + (env.FStar_TypeChecker_Env.subtype_nosmt_force); + FStar_TypeChecker_Env.qtbl_name_and_index + = + (env.FStar_TypeChecker_Env.qtbl_name_and_index); + FStar_TypeChecker_Env.normalized_eff_names + = + (env.FStar_TypeChecker_Env.normalized_eff_names); + FStar_TypeChecker_Env.fv_delta_depths + = + (env.FStar_TypeChecker_Env.fv_delta_depths); + FStar_TypeChecker_Env.proof_ns = + (env.FStar_TypeChecker_Env.proof_ns); + FStar_TypeChecker_Env.synth_hook = + (env.FStar_TypeChecker_Env.synth_hook); + FStar_TypeChecker_Env.try_solve_implicits_hook + = + (env.FStar_TypeChecker_Env.try_solve_implicits_hook); + FStar_TypeChecker_Env.splice = + (env.FStar_TypeChecker_Env.splice); + FStar_TypeChecker_Env.mpreprocess = + (env.FStar_TypeChecker_Env.mpreprocess); + FStar_TypeChecker_Env.postprocess = + (env.FStar_TypeChecker_Env.postprocess); + FStar_TypeChecker_Env.identifier_info + = + (env.FStar_TypeChecker_Env.identifier_info); + FStar_TypeChecker_Env.tc_hooks = + (env.FStar_TypeChecker_Env.tc_hooks); + FStar_TypeChecker_Env.dsenv = + (env.FStar_TypeChecker_Env.dsenv); + FStar_TypeChecker_Env.nbe = + (env.FStar_TypeChecker_Env.nbe); + FStar_TypeChecker_Env.strict_args_tab + = + (env.FStar_TypeChecker_Env.strict_args_tab); + FStar_TypeChecker_Env.erasable_types_tab + = + (env.FStar_TypeChecker_Env.erasable_types_tab); + FStar_TypeChecker_Env.enable_defer_to_tac + = + (env.FStar_TypeChecker_Env.enable_defer_to_tac); + FStar_TypeChecker_Env.unif_allow_ref_guards + = + (env.FStar_TypeChecker_Env.unif_allow_ref_guards); + FStar_TypeChecker_Env.erase_erasable_args + = + (env.FStar_TypeChecker_Env.erase_erasable_args); + FStar_TypeChecker_Env.core_check = + (env.FStar_TypeChecker_Env.core_check) + }, val_t) + (FStar_Syntax_Embeddings.e_tuple3 + (FStar_Syntax_Embeddings.e_list + (FStar_Syntax_Embeddings.e_tuple3 + FStar_Syntax_Embeddings.e_bool + FStar_Reflection_V2_Embeddings.e_sigelt + (FStar_Syntax_Embeddings.e_option + (FStar_Syntax_Embeddings.e_tuple2 + FStar_Syntax_Embeddings.e_string + uu___842)))) + (FStar_Syntax_Embeddings.e_tuple3 + FStar_Syntax_Embeddings.e_bool + FStar_Reflection_V2_Embeddings.e_sigelt + (FStar_Syntax_Embeddings.e_option + (FStar_Syntax_Embeddings.e_tuple2 + FStar_Syntax_Embeddings.e_string + uu___842))) + (FStar_Syntax_Embeddings.e_list + (FStar_Syntax_Embeddings.e_tuple3 + FStar_Syntax_Embeddings.e_bool + FStar_Reflection_V2_Embeddings.e_sigelt + (FStar_Syntax_Embeddings.e_option + (FStar_Syntax_Embeddings.e_tuple2 + FStar_Syntax_Embeddings.e_string + uu___842))))) tau1 + tactic_already_typed ps in + match uu___7 with + | (gs, + (sig_blobs_before, sig_blob, + sig_blobs_after)) -> + let uu___8 = uu___7 in + let sig_blobs = + FStar_Compiler_List.op_At + sig_blobs_before (sig_blob :: + sig_blobs_after) in + let sigelts = + FStar_Compiler_List.map + (fun uu___9 -> + match uu___9 with + | (checked, se, blob_opt) -> + let uu___10 = + let uu___11 = + se.FStar_Syntax_Syntax.sigmeta in + let uu___12 = + match blob_opt with + | FStar_Pervasives_Native.Some + (s, blob) -> + let uu___13 = + let uu___14 = + FStar_Compiler_Dyn.mkdyn + blob in + (s, uu___14) in + [uu___13] + | FStar_Pervasives_Native.None + -> [] in { - FStar_TypeChecker_Common.guard_f + FStar_Syntax_Syntax.sigmeta_active + = + (uu___11.FStar_Syntax_Syntax.sigmeta_active); + FStar_Syntax_Syntax.sigmeta_fact_db_ids = - (FStar_TypeChecker_Common.NonTrivial - vc); - FStar_TypeChecker_Common.deferred_to_tac - = []; - FStar_TypeChecker_Common.deferred - = []; - FStar_TypeChecker_Common.univ_ineqs - = ([], []); - FStar_TypeChecker_Common.implicits - = [] + (uu___11.FStar_Syntax_Syntax.sigmeta_fact_db_ids); + FStar_Syntax_Syntax.sigmeta_admit + = + (uu___11.FStar_Syntax_Syntax.sigmeta_admit); + FStar_Syntax_Syntax.sigmeta_spliced + = + (uu___11.FStar_Syntax_Syntax.sigmeta_spliced); + FStar_Syntax_Syntax.sigmeta_already_checked + = checked; + FStar_Syntax_Syntax.sigmeta_extension_data + = uu___12 } in - let uu___12 = - FStar_Tactics_Types.goal_env - g1 in - FStar_TypeChecker_Rel.force_trivial_guard - uu___12 guard)) - | FStar_Pervasives_Native.None -> - FStar_Errors.raise_error - (FStar_Errors_Codes.Fatal_OpenGoalsInSynthesis, - "splice left open goals") - rng)) gs); - (let lids' = - FStar_Compiler_List.collect - FStar_Syntax_Util.lids_of_sigelt - sigelts1 in - FStar_Compiler_List.iter - (fun lid -> - let uu___9 = - FStar_Compiler_List.tryFind - (FStar_Ident.lid_equals lid) lids' in - match uu___9 with - | FStar_Pervasives_Native.None when - Prims.op_Negation - env.FStar_TypeChecker_Env.nosynth - -> - let uu___10 = - let uu___11 = - let uu___12 = - FStar_Class_Show.show - FStar_Ident.showable_lident - lid in - let uu___13 = - FStar_Class_Show.show - (FStar_Class_Show.show_list - FStar_Ident.showable_lident) - lids' in - FStar_Compiler_Util.format2 - "Splice declared the name %s but it was not defined.\nThose defined were: %s" - uu___12 uu___13 in - (FStar_Errors_Codes.Fatal_SplicedUndef, - uu___11) in - FStar_Errors.raise_error uu___10 - rng - | uu___10 -> ()) lids; - (let uu___10 = - FStar_Compiler_Effect.op_Bang - FStar_Tactics_Interpreter.tacdbg in - if uu___10 - then - let uu___11 = - FStar_Class_Show.show - (FStar_Class_Show.show_list - FStar_Syntax_Print.showable_sigelt) - sigelts1 in - FStar_Compiler_Util.print1 - "splice: got decls = {\n\n%s\n\n}\n" - uu___11 - else ()); - (let sigelts2 = - FStar_Compiler_List.map - (fun se -> - (match se.FStar_Syntax_Syntax.sigel - with - | FStar_Syntax_Syntax.Sig_datacon - uu___11 -> - let uu___12 = - let uu___13 = - let uu___14 = - FStar_Syntax_Print.sigelt_to_string_short - se in - FStar_Compiler_Util.format1 - "Tactic returned bad sigelt: %s\nIf you wanted to splice an inductive type, call `pack` providing a `Sg_Inductive` to get a proper sigelt." - uu___14 in - (FStar_Errors_Codes.Error_BadSplice, - uu___13) in - FStar_Errors.raise_error - uu___12 rng - | FStar_Syntax_Syntax.Sig_inductive_typ - uu___11 -> - let uu___12 = - let uu___13 = - let uu___14 = - FStar_Syntax_Print.sigelt_to_string_short - se in - FStar_Compiler_Util.format1 - "Tactic returned bad sigelt: %s\nIf you wanted to splice an inductive type, call `pack` providing a `Sg_Inductive` to get a proper sigelt." - uu___14 in - (FStar_Errors_Codes.Error_BadSplice, - uu___13) in - FStar_Errors.raise_error - uu___12 rng - | uu___11 -> ()); + { + FStar_Syntax_Syntax.sigel + = + (se.FStar_Syntax_Syntax.sigel); + FStar_Syntax_Syntax.sigrng + = + (se.FStar_Syntax_Syntax.sigrng); + FStar_Syntax_Syntax.sigquals + = + (se.FStar_Syntax_Syntax.sigquals); + FStar_Syntax_Syntax.sigmeta + = uu___10; + FStar_Syntax_Syntax.sigattrs + = + (se.FStar_Syntax_Syntax.sigattrs); + FStar_Syntax_Syntax.sigopens_and_abbrevs + = + (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); + FStar_Syntax_Syntax.sigopts + = + (se.FStar_Syntax_Syntax.sigopts) + }) sig_blobs in + (gs, sigelts))) + else + FStar_Tactics_Interpreter.run_tactic_on_ps + tau1.FStar_Syntax_Syntax.pos + tau1.FStar_Syntax_Syntax.pos false + FStar_Syntax_Embeddings.e_unit () + (FStar_Syntax_Embeddings.e_list + FStar_Reflection_V2_Embeddings.e_sigelt) + tau1 tactic_already_typed ps in + match uu___5 with + | (gs, sigelts) -> + let sigelts1 = + let set_lb_dd lb = + let uu___6 = lb in + match uu___6 with + | { + FStar_Syntax_Syntax.lbname = + FStar_Pervasives.Inr fv; + FStar_Syntax_Syntax.lbunivs = uu___7; + FStar_Syntax_Syntax.lbtyp = uu___8; + FStar_Syntax_Syntax.lbeff = uu___9; + FStar_Syntax_Syntax.lbdef = lbdef; + FStar_Syntax_Syntax.lbattrs = uu___10; + FStar_Syntax_Syntax.lbpos = uu___11;_} + -> + { + FStar_Syntax_Syntax.lbname = + (FStar_Pervasives.Inr fv); + FStar_Syntax_Syntax.lbunivs = + (lb.FStar_Syntax_Syntax.lbunivs); + FStar_Syntax_Syntax.lbtyp = + (lb.FStar_Syntax_Syntax.lbtyp); + FStar_Syntax_Syntax.lbeff = + (lb.FStar_Syntax_Syntax.lbeff); + FStar_Syntax_Syntax.lbdef = + (lb.FStar_Syntax_Syntax.lbdef); + FStar_Syntax_Syntax.lbattrs = + (lb.FStar_Syntax_Syntax.lbattrs); + FStar_Syntax_Syntax.lbpos = + (lb.FStar_Syntax_Syntax.lbpos) + } in + FStar_Compiler_List.map + (fun se -> + match se.FStar_Syntax_Syntax.sigel with + | FStar_Syntax_Syntax.Sig_let + { + FStar_Syntax_Syntax.lbs1 = + (is_rec, lbs); + FStar_Syntax_Syntax.lids1 = lids1;_} + -> + let uu___6 = + let uu___7 = + let uu___8 = + let uu___9 = + FStar_Compiler_List.map + set_lb_dd lbs in + (is_rec, uu___9) in + { + FStar_Syntax_Syntax.lbs1 = + uu___8; + FStar_Syntax_Syntax.lids1 = + lids1 + } in + FStar_Syntax_Syntax.Sig_let uu___7 in { - FStar_Syntax_Syntax.sigel = - (se.FStar_Syntax_Syntax.sigel); - FStar_Syntax_Syntax.sigrng = rng; + FStar_Syntax_Syntax.sigel = uu___6; + FStar_Syntax_Syntax.sigrng = + (se.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = (se.FStar_Syntax_Syntax.sigquals); FStar_Syntax_Syntax.sigmeta = @@ -2253,38 +2149,188 @@ let (splice : (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); FStar_Syntax_Syntax.sigopts = (se.FStar_Syntax_Syntax.sigopts) - }) sigelts1 in - if is_typed - then () - else + } + | uu___6 -> se) sigelts in + (FStar_Options.with_saved_options + (fun uu___7 -> FStar_Compiler_List.iter - (fun se -> - FStar_Compiler_List.iter - (fun q -> - let uu___12 = - FStar_Syntax_Syntax.is_internal_qualifier - q in - if uu___12 - then - let uu___13 = - let uu___14 = - let uu___15 = - FStar_Syntax_Print.qual_to_string - q in - let uu___16 = - FStar_Syntax_Print.sigelt_to_string_short - se in - FStar_Compiler_Util.format2 - "The qualifier %s is internal, it cannot be attached to spliced sigelt `%s`." - uu___15 uu___16 in - (FStar_Errors_Codes.Error_InternalQualifier, - uu___14) in - FStar_Errors.raise_error - uu___13 rng - else ()) - se.FStar_Syntax_Syntax.sigquals) - sigelts2; - (match () with | () -> sigelts2))))))))) + (fun g1 -> + (let uu___9 = + FStar_Tactics_Types.goal_opts g1 in + FStar_Options.set uu___9); + (let uu___9 = + let uu___10 = + FStar_Tactics_Types.goal_env g1 in + let uu___11 = + FStar_Tactics_Types.goal_type + g1 in + getprop uu___10 uu___11 in + match uu___9 with + | FStar_Pervasives_Native.Some vc + -> + ((let uu___11 = + FStar_Compiler_Effect.op_Bang + dbg_Tac in + if uu___11 + then + let uu___12 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term + vc in + FStar_Compiler_Util.print1 + "Splice left a goal: %s\n" + uu___12 + else ()); + (let guard = + { + FStar_TypeChecker_Common.guard_f + = + (FStar_TypeChecker_Common.NonTrivial + vc); + FStar_TypeChecker_Common.deferred_to_tac + = []; + FStar_TypeChecker_Common.deferred + = []; + FStar_TypeChecker_Common.univ_ineqs + = ([], []); + FStar_TypeChecker_Common.implicits + = [] + } in + let uu___11 = + FStar_Tactics_Types.goal_env + g1 in + FStar_TypeChecker_Rel.force_trivial_guard + uu___11 guard)) + | FStar_Pervasives_Native.None -> + FStar_Errors.raise_error + (FStar_Errors_Codes.Fatal_OpenGoalsInSynthesis, + "splice left open goals") + rng)) gs); + (let lids' = + FStar_Compiler_List.collect + FStar_Syntax_Util.lids_of_sigelt sigelts1 in + FStar_Compiler_List.iter + (fun lid -> + let uu___8 = + FStar_Compiler_List.tryFind + (FStar_Ident.lid_equals lid) lids' in + match uu___8 with + | FStar_Pervasives_Native.None when + Prims.op_Negation + env.FStar_TypeChecker_Env.nosynth + -> + let uu___9 = + let uu___10 = + let uu___11 = + FStar_Class_Show.show + FStar_Ident.showable_lident + lid in + let uu___12 = + FStar_Class_Show.show + (FStar_Class_Show.show_list + FStar_Ident.showable_lident) + lids' in + FStar_Compiler_Util.format2 + "Splice declared the name %s but it was not defined.\nThose defined were: %s" + uu___11 uu___12 in + (FStar_Errors_Codes.Fatal_SplicedUndef, + uu___10) in + FStar_Errors.raise_error uu___9 rng + | uu___9 -> ()) lids; + (let uu___9 = + FStar_Compiler_Effect.op_Bang dbg_Tac in + if uu___9 + then + let uu___10 = + FStar_Class_Show.show + (FStar_Class_Show.show_list + FStar_Syntax_Print.showable_sigelt) + sigelts1 in + FStar_Compiler_Util.print1 + "splice: got decls = {\n\n%s\n\n}\n" + uu___10 + else ()); + (let sigelts2 = + FStar_Compiler_List.map + (fun se -> + (match se.FStar_Syntax_Syntax.sigel + with + | FStar_Syntax_Syntax.Sig_datacon + uu___10 -> + let uu___11 = + let uu___12 = + let uu___13 = + FStar_Syntax_Print.sigelt_to_string_short + se in + FStar_Compiler_Util.format1 + "Tactic returned bad sigelt: %s\nIf you wanted to splice an inductive type, call `pack` providing a `Sg_Inductive` to get a proper sigelt." + uu___13 in + (FStar_Errors_Codes.Error_BadSplice, + uu___12) in + FStar_Errors.raise_error uu___11 + rng + | FStar_Syntax_Syntax.Sig_inductive_typ + uu___10 -> + let uu___11 = + let uu___12 = + let uu___13 = + FStar_Syntax_Print.sigelt_to_string_short + se in + FStar_Compiler_Util.format1 + "Tactic returned bad sigelt: %s\nIf you wanted to splice an inductive type, call `pack` providing a `Sg_Inductive` to get a proper sigelt." + uu___13 in + (FStar_Errors_Codes.Error_BadSplice, + uu___12) in + FStar_Errors.raise_error uu___11 + rng + | uu___10 -> ()); + { + FStar_Syntax_Syntax.sigel = + (se.FStar_Syntax_Syntax.sigel); + FStar_Syntax_Syntax.sigrng = rng; + FStar_Syntax_Syntax.sigquals = + (se.FStar_Syntax_Syntax.sigquals); + FStar_Syntax_Syntax.sigmeta = + (se.FStar_Syntax_Syntax.sigmeta); + FStar_Syntax_Syntax.sigattrs = + (se.FStar_Syntax_Syntax.sigattrs); + FStar_Syntax_Syntax.sigopens_and_abbrevs + = + (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); + FStar_Syntax_Syntax.sigopts = + (se.FStar_Syntax_Syntax.sigopts) + }) sigelts1 in + if is_typed + then () + else + FStar_Compiler_List.iter + (fun se -> + FStar_Compiler_List.iter + (fun q -> + let uu___11 = + FStar_Syntax_Syntax.is_internal_qualifier + q in + if uu___11 + then + let uu___12 = + let uu___13 = + let uu___14 = + FStar_Syntax_Print.qual_to_string + q in + let uu___15 = + FStar_Syntax_Print.sigelt_to_string_short + se in + FStar_Compiler_Util.format2 + "The qualifier %s is internal, it cannot be attached to spliced sigelt `%s`." + uu___14 uu___15 in + (FStar_Errors_Codes.Error_InternalQualifier, + uu___13) in + FStar_Errors.raise_error + uu___12 rng + else ()) + se.FStar_Syntax_Syntax.sigquals) + sigelts2; + (match () with | () -> sigelts2)))))))) let (mpreprocess : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> @@ -2299,22 +2345,17 @@ let (mpreprocess : if env.FStar_TypeChecker_Env.nosynth then tm else - ((let uu___3 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Tac") in - FStar_Compiler_Effect.op_Colon_Equals - FStar_Tactics_Interpreter.tacdbg uu___3); - (let ps = - FStar_Tactics_V2_Basic.proofstate_of_goals - tm.FStar_Syntax_Syntax.pos env [] [] in - let tactic_already_typed = false in - let uu___3 = - FStar_Tactics_Interpreter.run_tactic_on_ps - tau.FStar_Syntax_Syntax.pos tm.FStar_Syntax_Syntax.pos - false FStar_Reflection_V2_Embeddings.e_term tm - FStar_Reflection_V2_Embeddings.e_term tau - tactic_already_typed ps in - match uu___3 with | (gs, tm1) -> tm1))) + (let ps = + FStar_Tactics_V2_Basic.proofstate_of_goals + tm.FStar_Syntax_Syntax.pos env [] [] in + let tactic_already_typed = false in + let uu___2 = + FStar_Tactics_Interpreter.run_tactic_on_ps + tau.FStar_Syntax_Syntax.pos tm.FStar_Syntax_Syntax.pos + false FStar_Reflection_V2_Embeddings.e_term tm + FStar_Reflection_V2_Embeddings.e_term tau + tactic_already_typed ps in + match uu___2 with | (gs, tm1) -> tm1)) let (postprocess : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> @@ -2331,78 +2372,72 @@ let (postprocess : if env.FStar_TypeChecker_Env.nosynth then tm else - ((let uu___3 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Tac") in - FStar_Compiler_Effect.op_Colon_Equals - FStar_Tactics_Interpreter.tacdbg uu___3); - (let uu___3 = - FStar_TypeChecker_Env.new_implicit_var_aux - "postprocess RHS" tm.FStar_Syntax_Syntax.pos env typ - (FStar_Syntax_Syntax.Allow_untyped "postprocess") - FStar_Pervasives_Native.None in - match uu___3 with - | (uvtm, uu___4, g_imp) -> - let u = env.FStar_TypeChecker_Env.universe_of env typ in - let goal = - let uu___5 = FStar_Syntax_Util.mk_eq2 u typ tm uvtm in - FStar_Syntax_Util.mk_squash - FStar_Syntax_Syntax.U_zero uu___5 in - let uu___5 = - run_tactic_on_typ tau.FStar_Syntax_Syntax.pos - tm.FStar_Syntax_Syntax.pos tau env goal in - (match uu___5 with - | (gs, w) -> - (FStar_Compiler_List.iter - (fun g -> - let uu___7 = - let uu___8 = - FStar_Tactics_Types.goal_env g in - let uu___9 = - FStar_Tactics_Types.goal_type g in - getprop uu___8 uu___9 in - match uu___7 with - | FStar_Pervasives_Native.Some vc -> - ((let uu___9 = - FStar_Compiler_Effect.op_Bang - FStar_Tactics_Interpreter.tacdbg in - if uu___9 - then - let uu___10 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term - vc in - FStar_Compiler_Util.print1 - "Postprocessing left a goal: %s\n" - uu___10 - else ()); - (let guard = - { - FStar_TypeChecker_Common.guard_f - = - (FStar_TypeChecker_Common.NonTrivial - vc); - FStar_TypeChecker_Common.deferred_to_tac - = []; - FStar_TypeChecker_Common.deferred - = []; - FStar_TypeChecker_Common.univ_ineqs - = ([], []); - FStar_TypeChecker_Common.implicits - = [] - } in - let uu___9 = - FStar_Tactics_Types.goal_env g in - FStar_TypeChecker_Rel.force_trivial_guard - uu___9 guard)) - | FStar_Pervasives_Native.None -> - FStar_Errors.raise_error - (FStar_Errors_Codes.Fatal_OpenGoalsInSynthesis, - "postprocessing left open goals") - typ.FStar_Syntax_Syntax.pos) gs; - (let tagged_imps = - FStar_TypeChecker_Rel.resolve_implicits_tac - env g_imp in - FStar_Tactics_Interpreter.report_implicits - tm.FStar_Syntax_Syntax.pos tagged_imps; - uvtm)))))) \ No newline at end of file + (let uu___2 = + FStar_TypeChecker_Env.new_implicit_var_aux + "postprocess RHS" tm.FStar_Syntax_Syntax.pos env typ + (FStar_Syntax_Syntax.Allow_untyped "postprocess") + FStar_Pervasives_Native.None in + match uu___2 with + | (uvtm, uu___3, g_imp) -> + let u = env.FStar_TypeChecker_Env.universe_of env typ in + let goal = + let uu___4 = FStar_Syntax_Util.mk_eq2 u typ tm uvtm in + FStar_Syntax_Util.mk_squash + FStar_Syntax_Syntax.U_zero uu___4 in + let uu___4 = + run_tactic_on_typ tau.FStar_Syntax_Syntax.pos + tm.FStar_Syntax_Syntax.pos tau env goal in + (match uu___4 with + | (gs, w) -> + (FStar_Compiler_List.iter + (fun g -> + let uu___6 = + let uu___7 = + FStar_Tactics_Types.goal_env g in + let uu___8 = + FStar_Tactics_Types.goal_type g in + getprop uu___7 uu___8 in + match uu___6 with + | FStar_Pervasives_Native.Some vc -> + ((let uu___8 = + FStar_Compiler_Effect.op_Bang + dbg_Tac in + if uu___8 + then + let uu___9 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term + vc in + FStar_Compiler_Util.print1 + "Postprocessing left a goal: %s\n" + uu___9 + else ()); + (let guard = + { + FStar_TypeChecker_Common.guard_f = + (FStar_TypeChecker_Common.NonTrivial + vc); + FStar_TypeChecker_Common.deferred_to_tac + = []; + FStar_TypeChecker_Common.deferred + = []; + FStar_TypeChecker_Common.univ_ineqs + = ([], []); + FStar_TypeChecker_Common.implicits + = [] + } in + let uu___8 = + FStar_Tactics_Types.goal_env g in + FStar_TypeChecker_Rel.force_trivial_guard + uu___8 guard)) + | FStar_Pervasives_Native.None -> + FStar_Errors.raise_error + (FStar_Errors_Codes.Fatal_OpenGoalsInSynthesis, + "postprocessing left open goals") + typ.FStar_Syntax_Syntax.pos) gs; + (let tagged_imps = + FStar_TypeChecker_Rel.resolve_implicits_tac + env g_imp in + FStar_Tactics_Interpreter.report_implicits + tm.FStar_Syntax_Syntax.pos tagged_imps; + uvtm))))) \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_InterpFuns.ml b/ocaml/fstar-lib/generated/FStar_Tactics_InterpFuns.ml index c814b0d2302..fa15e66c967 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_InterpFuns.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_InterpFuns.ml @@ -371,6 +371,90 @@ let mk_tac_step_4 : FStar_Pervasives_Native.Some uu___11) in set_auto_reflect (Prims.of_int (4)) uu___10 +let mk_tac_step_5 : + 'nres 'nt1 'nt2 'nt3 'nt4 'nt5 'res 't1 't2 't3 't4 't5 . + Prims.int -> + Prims.string -> + 't1 FStar_Syntax_Embeddings_Base.embedding -> + 't2 FStar_Syntax_Embeddings_Base.embedding -> + 't3 FStar_Syntax_Embeddings_Base.embedding -> + 't4 FStar_Syntax_Embeddings_Base.embedding -> + 't5 FStar_Syntax_Embeddings_Base.embedding -> + 'res FStar_Syntax_Embeddings_Base.embedding -> + 'nt1 FStar_TypeChecker_NBETerm.embedding -> + 'nt2 FStar_TypeChecker_NBETerm.embedding -> + 'nt3 FStar_TypeChecker_NBETerm.embedding -> + 'nt4 FStar_TypeChecker_NBETerm.embedding -> + 'nt5 FStar_TypeChecker_NBETerm.embedding -> + 'nres FStar_TypeChecker_NBETerm.embedding -> + ('t1 -> + 't2 -> + 't3 -> + 't4 -> + 't5 -> 'res FStar_Tactics_Monad.tac) + -> + ('nt1 -> + 'nt2 -> + 'nt3 -> + 'nt4 -> + 'nt5 -> + 'nres FStar_Tactics_Monad.tac) + -> + FStar_TypeChecker_Primops_Base.primitive_step + = + fun univ_arity -> + fun nm -> + fun uu___ -> + fun uu___1 -> + fun uu___2 -> + fun uu___3 -> + fun uu___4 -> + fun uu___5 -> + fun uu___6 -> + fun uu___7 -> + fun uu___8 -> + fun uu___9 -> + fun uu___10 -> + fun uu___11 -> + fun f -> + fun nbe_f -> + let lid = builtin_lid nm in + let uu___12 = + FStar_TypeChecker_Primops_Base.mk6' + univ_arity lid uu___ uu___6 uu___1 + uu___7 uu___2 uu___8 uu___3 uu___9 + uu___4 uu___10 + FStar_Tactics_Embedding.e_proofstate + FStar_Tactics_Embedding.e_proofstate_nbe + (FStar_Tactics_Embedding.e_result + uu___5) + (FStar_Tactics_Embedding.e_result_nbe + uu___11) + (fun a -> + fun b -> + fun c -> + fun d -> + fun e -> + fun ps -> + let uu___13 = + let uu___14 = + f a b c d e in + run_wrap nm uu___14 ps in + FStar_Pervasives_Native.Some + uu___13) + (fun a -> + fun b -> + fun c -> + fun d -> + fun e -> + fun ps -> + let uu___13 = + let uu___14 = + nbe_f a b c d e in + run_wrap nm uu___14 ps in + FStar_Pervasives_Native.Some + uu___13) in + set_auto_reflect (Prims.of_int (5)) uu___12 let (max_tac_arity : Prims.int) = (Prims.of_int (20)) let mk_tactic_interpretation_1 : 'r 't1 . diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Interpreter.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Interpreter.ml index d8475edf75c..0f63e417417 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Interpreter.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Interpreter.ml @@ -1,7 +1,7 @@ open Prims +let (dbg_Tac : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Tac" let solve : 'a . 'a -> 'a = fun ev -> ev -let (tacdbg : Prims.bool FStar_Compiler_Effect.ref) = - FStar_Compiler_Util.mk_ref false let embed : 'a . 'a FStar_Syntax_Embeddings_Base.embedding -> @@ -777,7 +777,9 @@ let run_unembedded_tactic_on_ps : FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (ps.FStar_Tactics_Types.urgency) + (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in let ps2 = { @@ -909,7 +911,9 @@ let run_unembedded_tactic_on_ps : FStar_Tactics_Types.local_state = (ps1.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (ps1.FStar_Tactics_Types.urgency) + (ps1.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps1.FStar_Tactics_Types.dump_on_failure) } in let env = ps2.FStar_Tactics_Types.main_context in let res = @@ -925,11 +929,11 @@ let run_unembedded_tactic_on_ps : let uu___2 = tau arg in FStar_Tactics_Monad.run_safe uu___2 ps2) uu___ "FStar.Tactics.Interpreter.run_safe" in - (let uu___1 = FStar_Compiler_Effect.op_Bang tacdbg in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Tac in if uu___1 then FStar_Compiler_Util.print_string "}\n" else ()); (match res with | FStar_Tactics_Result.Success (ret, ps3) -> - ((let uu___2 = FStar_Compiler_Effect.op_Bang tacdbg in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Tac in if uu___2 then FStar_Tactics_Printing.do_dump_proofstate ps3 @@ -947,7 +951,7 @@ let run_unembedded_tactic_on_ps : if uu___4 then ((let uu___6 = - FStar_Compiler_Effect.op_Bang tacdbg in + FStar_Compiler_Effect.op_Bang dbg_Tac in if uu___6 then let uu___7 = @@ -982,7 +986,7 @@ let run_unembedded_tactic_on_ps : FStar_Errors.with_ctx "While checking implicits left by a tactic" (fun uu___4 -> - (let uu___6 = FStar_Compiler_Effect.op_Bang tacdbg in + (let uu___6 = FStar_Compiler_Effect.op_Bang dbg_Tac in if uu___6 then let uu___7 = @@ -1011,7 +1015,8 @@ let run_unembedded_tactic_on_ps : let g1 = FStar_TypeChecker_Rel.solve_deferred_constraints env g in - (let uu___7 = FStar_Compiler_Effect.op_Bang tacdbg in + (let uu___7 = + FStar_Compiler_Effect.op_Bang dbg_Tac in if uu___7 then let uu___8 = @@ -1033,7 +1038,7 @@ let run_unembedded_tactic_on_ps : FStar_TypeChecker_Rel.resolve_implicits_tac env g1 in (let uu___8 = - FStar_Compiler_Effect.op_Bang tacdbg in + FStar_Compiler_Effect.op_Bang dbg_Tac in if uu___8 then let uu___9 = @@ -1068,8 +1073,11 @@ let run_unembedded_tactic_on_ps : FStar_Compiler_Effect.raise (FStar_Errors.Err (code, msg1, ctx)) | FStar_Tactics_Result.Failed (e, ps3) -> - (FStar_Tactics_Printing.do_dump_proofstate ps3 - "at the time of failure"; + (if ps3.FStar_Tactics_Types.dump_on_failure + then + FStar_Tactics_Printing.do_dump_proofstate ps3 + "at the time of failure" + else (); (let texn_to_doc e1 = match e1 with | FStar_Tactics_Common.TacticFailure msg -> msg @@ -1094,9 +1102,12 @@ let run_unembedded_tactic_on_ps : let uu___2 = let uu___3 = let uu___4 = - let uu___5 = - FStar_Pprint.doc_of_string "Tactic failed" in - [uu___5] in + if ps3.FStar_Tactics_Types.dump_on_failure + then + let uu___5 = + FStar_Pprint.doc_of_string "Tactic failed" in + [uu___5] + else [] in let uu___5 = texn_to_doc e in FStar_Compiler_List.op_At uu___4 uu___5 in (FStar_Errors_Codes.Fatal_UserTacticFailure, uu___3) in @@ -1124,7 +1135,7 @@ let run_tactic_on_ps' : fun tactic_already_typed -> fun ps -> let env = ps.FStar_Tactics_Types.main_context in - (let uu___1 = FStar_Compiler_Effect.op_Bang tacdbg in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Tac in if uu___1 then let uu___2 = @@ -1151,7 +1162,7 @@ let run_tactic_on_ps' : FStar_TypeChecker_TcTerm.tc_tactic uu___3 uu___4 env tactic in match uu___2 with | (uu___3, uu___4, g1) -> g1) in - (let uu___2 = FStar_Compiler_Effect.op_Bang tacdbg in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Tac in if uu___2 then FStar_Compiler_Util.print_string "}\n" else ()); diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_MApply.ml b/ocaml/fstar-lib/generated/FStar_Tactics_MApply.ml index f3c0b78a2aa..155b6a55ce8 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_MApply.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_MApply.ml @@ -1,4 +1,40 @@ open Prims +type 'a termable = + { + to_term: + 'a -> (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr } +let __proj__Mktermable__item__to_term : + 'a . + 'a termable -> + 'a -> + (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr + = fun projectee -> match projectee with | { to_term;_} -> to_term +let to_term : + 'a . + 'a termable -> + 'a -> + (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr + = + fun projectee -> match projectee with | { to_term = to_term1;_} -> to_term1 +let (termable_term : FStar_Tactics_NamedView.term termable) = + { + to_term = + (fun uu___ -> + (fun t -> + Obj.magic (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> t))) + uu___) + } +let (termable_binding : FStar_Tactics_NamedView.binding termable) = + { + to_term = + (fun uu___ -> + (fun b -> + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun uu___ -> + FStar_Tactics_V2_SyntaxCoercions.binding_to_term b))) + uu___) + } let rec (apply_squash_or_lem : Prims.nat -> FStar_Tactics_NamedView.term -> @@ -17,13 +53,13 @@ let rec (apply_squash_or_lem : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (35)) (Prims.of_int (8)) - (Prims.of_int (35)) (Prims.of_int (43))))) + (Prims.of_int (25)) (Prims.of_int (8)) + (Prims.of_int (25)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (35)) (Prims.of_int (45)) - (Prims.of_int (35)) (Prims.of_int (52))))) + (Prims.of_int (25)) (Prims.of_int (45)) + (Prims.of_int (25)) (Prims.of_int (52))))) (Obj.magic (FStar_Tactics_V2_Derived.apply (FStar_Reflection_V2_Builtins.pack_ln @@ -55,17 +91,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (41)) + (Prims.of_int (31)) (Prims.of_int (13)) - (Prims.of_int (41)) + (Prims.of_int (31)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (41)) + (Prims.of_int (31)) (Prims.of_int (33)) - (Prims.of_int (90)) + (Prims.of_int (80)) (Prims.of_int (41))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -73,17 +109,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (41)) + (Prims.of_int (31)) (Prims.of_int (16)) - (Prims.of_int (41)) + (Prims.of_int (31)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (41)) + (Prims.of_int (31)) (Prims.of_int (13)) - (Prims.of_int (41)) + (Prims.of_int (31)) (Prims.of_int (30))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_env @@ -101,17 +137,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (42)) + (Prims.of_int (32)) (Prims.of_int (17)) - (Prims.of_int (42)) + (Prims.of_int (32)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (41)) + (Prims.of_int (31)) (Prims.of_int (33)) - (Prims.of_int (90)) + (Prims.of_int (80)) (Prims.of_int (41))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_arr @@ -135,18 +171,18 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (46)) + (Prims.of_int (36)) (Prims.of_int (18)) - (Prims.of_int (46)) + (Prims.of_int (36)) (Prims.of_int (32))))) ( FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (46)) + (Prims.of_int (36)) (Prims.of_int (35)) - (Prims.of_int (55)) + (Prims.of_int (45)) (Prims.of_int (41))))) ( FStar_Tactics_Effect.lift_div_tac @@ -170,17 +206,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (47)) + (Prims.of_int (37)) (Prims.of_int (18)) - (Prims.of_int (47)) + (Prims.of_int (37)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (49)) + (Prims.of_int (39)) (Prims.of_int (7)) - (Prims.of_int (55)) + (Prims.of_int (45)) (Prims.of_int (41))))) (Obj.magic (FStar_Tactics_V2_Derived.norm_term @@ -195,17 +231,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (49)) + (Prims.of_int (39)) (Prims.of_int (13)) - (Prims.of_int (49)) + (Prims.of_int (39)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (49)) + (Prims.of_int (39)) (Prims.of_int (7)) - (Prims.of_int (55)) + (Prims.of_int (45)) (Prims.of_int (41))))) (Obj.magic (FStar_Reflection_V2_Formula.term_as_formula' @@ -226,17 +262,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (51)) + (Prims.of_int (41)) (Prims.of_int (11)) - (Prims.of_int (51)) + (Prims.of_int (41)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (52)) + (Prims.of_int (42)) (Prims.of_int (11)) - (Prims.of_int (52)) + (Prims.of_int (42)) (Prims.of_int (38))))) (Obj.magic (FStar_Tactics_V2_Derived.apply_lemma @@ -281,17 +317,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (63)) + (Prims.of_int (53)) (Prims.of_int (18)) - (Prims.of_int (63)) + (Prims.of_int (53)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (65)) + (Prims.of_int (55)) (Prims.of_int (9)) - (Prims.of_int (71)) + (Prims.of_int (61)) (Prims.of_int (43))))) (Obj.magic (FStar_Tactics_V2_Derived.norm_term @@ -306,17 +342,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (65)) + (Prims.of_int (55)) (Prims.of_int (15)) - (Prims.of_int (65)) + (Prims.of_int (55)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (65)) + (Prims.of_int (55)) (Prims.of_int (9)) - (Prims.of_int (71)) + (Prims.of_int (61)) (Prims.of_int (43))))) (Obj.magic (FStar_Reflection_V2_Formula.term_as_formula' @@ -337,17 +373,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (67)) + (Prims.of_int (57)) (Prims.of_int (13)) - (Prims.of_int (67)) + (Prims.of_int (57)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (68)) + (Prims.of_int (58)) (Prims.of_int (13)) - (Prims.of_int (68)) + (Prims.of_int (58)) (Prims.of_int (40))))) (Obj.magic (FStar_Tactics_V2_Derived.apply_lemma @@ -383,17 +419,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (78)) + (Prims.of_int (68)) (Prims.of_int (18)) - (Prims.of_int (78)) + (Prims.of_int (68)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (80)) + (Prims.of_int (70)) (Prims.of_int (9)) - (Prims.of_int (87)) + (Prims.of_int (77)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_V2_Derived.norm_term @@ -408,17 +444,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (80)) + (Prims.of_int (70)) (Prims.of_int (15)) - (Prims.of_int (80)) + (Prims.of_int (70)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (80)) + (Prims.of_int (70)) (Prims.of_int (9)) - (Prims.of_int (87)) + (Prims.of_int (77)) (Prims.of_int (20))))) (Obj.magic (FStar_Reflection_V2_Formula.term_as_formula' @@ -438,17 +474,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (82)) + (Prims.of_int (72)) (Prims.of_int (13)) - (Prims.of_int (82)) + (Prims.of_int (72)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (83)) + (Prims.of_int (73)) (Prims.of_int (13)) - (Prims.of_int (83)) + (Prims.of_int (73)) (Prims.of_int (40))))) (Obj.magic (FStar_Tactics_V2_Derived.apply_lemma @@ -477,17 +513,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (86)) + (Prims.of_int (76)) (Prims.of_int (13)) - (Prims.of_int (86)) + (Prims.of_int (76)) (Prims.of_int (48))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (87)) + (Prims.of_int (77)) (Prims.of_int (13)) - (Prims.of_int (87)) + (Prims.of_int (77)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_V2_Derived.apply @@ -513,45 +549,21 @@ let rec (apply_squash_or_lem : (FStar_Tactics_V2_Derived.fail "mapply: can't apply (2)")))) uu___4))) uu___4)))) uu___2))) -type 'a termable = - { - to_term: - 'a -> (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr } -let __proj__Mktermable__item__to_term : - 'a . - 'a termable -> - 'a -> - (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr - = fun projectee -> match projectee with | { to_term;_} -> to_term -let to_term : - 'a . - 'a termable -> - 'a -> - (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr - = - fun projectee -> match projectee with | { to_term = to_term1;_} -> to_term1 -let (termable_term : FStar_Tactics_NamedView.term termable) = - { - to_term = - (fun uu___ -> - (fun t -> - Obj.magic (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> t))) - uu___) - } -let (termable_binding : FStar_Tactics_NamedView.binding termable) = - { - to_term = - (fun uu___ -> - (fun b -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> - FStar_Tactics_V2_SyntaxCoercions.binding_to_term b))) - uu___) - } let (mapply0 : FStar_Tactics_NamedView.term -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun t -> apply_squash_or_lem (Prims.of_int (10)) t +let _ = + FStar_Tactics_Native.register_tactic "FStar.Tactics.MApply.mapply0" + (Prims.of_int (2)) + (fun psc -> + fun ncb -> + fun us -> + fun args -> + FStar_Tactics_InterpFuns.mk_tactic_interpretation_1 + "FStar.Tactics.MApply.mapply0 (plugin)" + (FStar_Tactics_Native.from_tactic_1 mapply0) + FStar_Reflection_V2_Embeddings.e_term + FStar_Syntax_Embeddings.e_unit psc ncb us args) let mapply : 'ty . 'ty termable -> 'ty -> (unit, unit) FStar_Tactics_Effect.tac_repr = fun uu___ -> @@ -559,14 +571,12 @@ let mapply : FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (110)) (Prims.of_int (10)) - (Prims.of_int (110)) (Prims.of_int (19))))) + (FStar_Range.mk_range "FStar.Tactics.MApply.fsti" + (Prims.of_int (35)) (Prims.of_int (10)) (Prims.of_int (35)) + (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.MApply.fst" - (Prims.of_int (111)) (Prims.of_int (2)) (Prims.of_int (111)) - (Prims.of_int (26))))) (Obj.magic (to_term uu___ x)) - (fun uu___1 -> - (fun t -> Obj.magic (apply_squash_or_lem (Prims.of_int (10)) t)) - uu___1) \ No newline at end of file + (FStar_Range.mk_range "FStar.Tactics.MApply.fsti" + (Prims.of_int (36)) (Prims.of_int (2)) (Prims.of_int (36)) + (Prims.of_int (11))))) (Obj.magic (to_term uu___ x)) + (fun uu___1 -> (fun t -> Obj.magic (mapply0 t)) uu___1) \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Monad.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Monad.ml index 53393bbcb57..a6e87dc59d1 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Monad.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Monad.ml @@ -1,4 +1,12 @@ open Prims +let (dbg_Core : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Core" +let (dbg_CoreEq : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "CoreEq" +let (dbg_RegisterGoal : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "RegisterGoal" +let (dbg_TacFail : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "TacFail" let (goal_ctr : Prims.int FStar_Compiler_Effect.ref) = FStar_Compiler_Util.mk_ref Prims.int_zero let (get_goal_ctr : unit -> Prims.int) = @@ -20,8 +28,10 @@ let (is_goal_safe_as_well_typed : FStar_Tactics_Types.goal -> Prims.bool) = match uu___1 with | FStar_Pervasives_Native.Some t -> let uu___2 = FStar_Syntax_Free.uvars t in - FStar_Compiler_Set.is_empty FStar_Syntax_Free.ord_ctx_uvar - uu___2 + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___2) | uu___2 -> false) uu___ in all_deps_resolved let (register_goal : FStar_Tactics_Types.goal -> unit) = @@ -151,9 +161,7 @@ let (register_goal : FStar_Tactics_Types.goal -> unit) = FStar_TypeChecker_Env.core_check = (env.FStar_TypeChecker_Env.core_check) } in - (let uu___6 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "CoreEq") in + (let uu___6 = FStar_Compiler_Effect.op_Bang dbg_CoreEq in if uu___6 then let uu___7 = @@ -166,11 +174,8 @@ let (register_goal : FStar_Tactics_Types.goal -> unit) = if Prims.op_Negation should_register then let uu___7 = - (FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "Core")) - || - (FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "RegisterGoal")) in + (FStar_Compiler_Effect.op_Bang dbg_Core) || + (FStar_Compiler_Effect.op_Bang dbg_RegisterGoal) in (if uu___7 then let uu___8 = @@ -183,11 +188,8 @@ let (register_goal : FStar_Tactics_Types.goal -> unit) = else ()) else ((let uu___8 = - (FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "Core")) - || - (FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "RegisterGoal")) in + (FStar_Compiler_Effect.op_Bang dbg_Core) || + (FStar_Compiler_Effect.op_Bang dbg_RegisterGoal) in if uu___8 then let uu___9 = @@ -289,9 +291,7 @@ let fail_doc : 'a . FStar_Errors_Msg.error_message -> 'a tac = fun msg -> mk_tac (fun ps -> - (let uu___1 = - FStar_TypeChecker_Env.debug ps.FStar_Tactics_Types.main_context - (FStar_Options.Other "TacFail") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_TacFail in if uu___1 then let uu___2 = @@ -343,7 +343,9 @@ let catch : 'a . 'a tac -> (Prims.exn, 'a) FStar_Pervasives.either tac = FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (ps.FStar_Tactics_Types.urgency) + (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in FStar_Tactics_Result.Success ((FStar_Pervasives.Inl m), ps1)))) let recover : 'a . 'a tac -> (Prims.exn, 'a) FStar_Pervasives.either tac = @@ -508,7 +510,9 @@ let (set_goals : FStar_Tactics_Types.goal Prims.list -> unit tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) }) let (set_smt_goals : FStar_Tactics_Types.goal Prims.list -> unit tac) = fun gs -> @@ -535,7 +539,9 @@ let (set_smt_goals : FStar_Tactics_Types.goal Prims.list -> unit tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) }) let (cur_goals : FStar_Tactics_Types.goal Prims.list tac) = bind get (fun ps -> ret ps.FStar_Tactics_Types.goals) @@ -595,7 +601,9 @@ let (dismiss : unit tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in set uu___) let (replace_cur : FStar_Tactics_Types.goal -> unit tac) = @@ -629,7 +637,9 @@ let (replace_cur : FStar_Tactics_Types.goal -> unit tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in set uu___1)) let (getopts : FStar_Options.optionstate tac) = @@ -668,7 +678,9 @@ let (add_goals : FStar_Tactics_Types.goal Prims.list -> unit tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) }) let (add_smt_goals : FStar_Tactics_Types.goal Prims.list -> unit tac) = fun gs -> @@ -697,7 +709,9 @@ let (add_smt_goals : FStar_Tactics_Types.goal Prims.list -> unit tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) }) let (push_goals : FStar_Tactics_Types.goal Prims.list -> unit tac) = fun gs -> @@ -727,7 +741,9 @@ let (push_goals : FStar_Tactics_Types.goal Prims.list -> unit tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) }) let (push_smt_goals : FStar_Tactics_Types.goal Prims.list -> unit tac) = fun gs -> @@ -756,7 +772,9 @@ let (push_smt_goals : FStar_Tactics_Types.goal Prims.list -> unit tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) }) let (add_implicits : FStar_TypeChecker_Env.implicits -> unit tac) = fun i -> @@ -785,7 +803,9 @@ let (add_implicits : FStar_TypeChecker_Env.implicits -> unit tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) }) let (new_uvar : Prims.string -> @@ -1003,7 +1023,9 @@ let (compress_implicits : unit tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in set ps') let (get_phi : @@ -1139,7 +1161,10 @@ let divide : 'a 'b . FStar_BigInt.t -> 'a tac -> 'b tac -> ('a * 'b) tac = = (p.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (p.FStar_Tactics_Types.urgency) + (p.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure + = + (p.FStar_Tactics_Types.dump_on_failure) } in let uu___2 = set lp in Obj.magic @@ -1210,7 +1235,10 @@ let divide : 'a 'b . FStar_BigInt.t -> 'a tac -> 'b tac -> ('a * 'b) tac = (lp'.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (lp'.FStar_Tactics_Types.urgency) + (lp'.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure + = + (lp'.FStar_Tactics_Types.dump_on_failure) } in let uu___4 = set rp in @@ -1299,7 +1327,10 @@ let divide : 'a 'b . FStar_BigInt.t -> 'a tac -> 'b tac -> ('a * 'b) tac = (rp'.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (rp'.FStar_Tactics_Types.urgency) + (rp'.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure + = + (rp'.FStar_Tactics_Types.dump_on_failure) } in let uu___6 = set p' in diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Printing.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Printing.ml index 8f69ca5ba52..433c69f2d5d 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Printing.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Printing.ml @@ -1,4 +1,6 @@ open Prims +let (dbg_Imp : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Imp" let (term_to_string : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> Prims.string) = fun e -> @@ -230,10 +232,7 @@ let (ps_to_string : else "" in let uu___6 = let uu___7 = - let uu___8 = - FStar_TypeChecker_Env.debug - ps.FStar_Tactics_Types.main_context - (FStar_Options.Other "Imp") in + let uu___8 = FStar_Compiler_Effect.op_Bang dbg_Imp in if uu___8 then let uu___9 = diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_TypeRepr.ml b/ocaml/fstar-lib/generated/FStar_Tactics_TypeRepr.ml new file mode 100644 index 00000000000..c8214fd829e --- /dev/null +++ b/ocaml/fstar-lib/generated/FStar_Tactics_TypeRepr.ml @@ -0,0 +1,2369 @@ +open Prims +let (empty_elim : Prims.empty -> unit -> Obj.t) = + fun uu___1 -> + fun uu___ -> + (fun e -> fun a -> Obj.magic (failwith "unreachable")) uu___1 uu___ +let (add_suffix : + Prims.string -> FStar_Reflection_Types.name -> FStar_Reflection_Types.name) + = + fun s -> + fun nm -> + FStar_Reflection_V2_Builtins.explode_qn + (Prims.strcat (FStar_Reflection_V2_Builtins.implode_qn nm) s) +let (unitv_ : FStar_Tactics_NamedView.term) = + FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_Const FStar_Reflection_V2_Data.C_Unit) +let (unitt_ : FStar_Tactics_NamedView.term) = + FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv ["Prims"; "unit"])) +let (empty_ : FStar_Tactics_NamedView.term) = + FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv ["Prims"; "empty"])) +let (either_ : + FStar_Tactics_NamedView.term -> + FStar_Tactics_NamedView.term -> FStar_Tactics_NamedView.term) + = + fun a -> + fun b -> + FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_App + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_App + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + ["FStar"; "Pervasives"; "either"]))), + (a, FStar_Reflection_V2_Data.Q_Explicit)))), + (b, FStar_Reflection_V2_Data.Q_Explicit))) +let (tuple2_ : + FStar_Tactics_NamedView.term -> + FStar_Tactics_NamedView.term -> FStar_Tactics_NamedView.term) + = + fun a -> + fun b -> + FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_App + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_App + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + ["FStar"; "Pervasives"; "Native"; "tuple2"]))), + (a, FStar_Reflection_V2_Data.Q_Explicit)))), + (b, FStar_Reflection_V2_Data.Q_Explicit))) +let (mktuple2_ : + FStar_Tactics_NamedView.term -> + FStar_Tactics_NamedView.term -> FStar_Tactics_NamedView.term) + = + fun a -> + fun b -> + FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_App + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_App + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + ["FStar"; "Pervasives"; "Native"; "Mktuple2"]))), + (a, FStar_Reflection_V2_Data.Q_Explicit)))), + (b, FStar_Reflection_V2_Data.Q_Explicit))) +let (get_inductive_typ : + Prims.string -> + (FStar_Tactics_NamedView.sigelt_view, unit) FStar_Tactics_Effect.tac_repr) + = + fun nm -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (18)) (Prims.of_int (10)) (Prims.of_int (18)) + (Prims.of_int (20))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (18)) (Prims.of_int (23)) (Prims.of_int (27)) + (Prims.of_int (48))))) + (Obj.magic (FStar_Tactics_V2_Builtins.top_env ())) + (fun uu___ -> + (fun e -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (19)) (Prims.of_int (11)) + (Prims.of_int (19)) (Prims.of_int (39))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (20)) (Prims.of_int (2)) + (Prims.of_int (27)) (Prims.of_int (48))))) + (FStar_Tactics_Effect.lift_div_tac + (fun uu___ -> + FStar_Reflection_V2_Builtins.lookup_typ e + (FStar_Reflection_V2_Builtins.explode_qn nm))) + (fun uu___ -> + (fun se -> + match se with + | FStar_Pervasives_Native.None -> + Obj.magic + (Obj.repr + (FStar_Tactics_V2_Derived.fail + "ctors_of_typ: type not found")) + | FStar_Pervasives_Native.Some se1 -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (23)) + (Prims.of_int (14)) + (Prims.of_int (23)) + (Prims.of_int (31))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (24)) + (Prims.of_int (4)) + (Prims.of_int (27)) + (Prims.of_int (48))))) + (Obj.magic + (FStar_Tactics_NamedView.inspect_sigelt + se1)) + (fun sev -> + if + FStar_Tactics_NamedView.uu___is_Sg_Inductive + sev + then + FStar_Tactics_Effect.lift_div_tac + (fun uu___ -> sev) + else + FStar_Tactics_V2_Derived.fail + "ctors_of_typ: not an inductive type")))) + uu___))) uu___) +let (alg_ctor : + FStar_Reflection_Types.typ -> + (FStar_Reflection_Types.typ, unit) FStar_Tactics_Effect.tac_repr) + = + fun ty -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (30)) (Prims.of_int (15)) (Prims.of_int (30)) + (Prims.of_int (29))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (29)) (Prims.of_int (35)) (Prims.of_int (31)) + (Prims.of_int (67))))) + (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_arr ty)) + (fun uu___ -> + (fun uu___ -> + match uu___ with + | (tys, c) -> + Obj.magic + (FStar_Tactics_Util.fold_right + (fun uu___2 -> + fun uu___1 -> + (fun ty1 -> + fun acc -> + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun uu___1 -> tuple2_ ty1 acc))) uu___2 + uu___1) tys unitt_)) uu___) +let (generate_repr_typ : + FStar_Tactics_NamedView.binders -> + FStar_Reflection_V2_Data.ctor Prims.list -> + (FStar_Reflection_Types.typ, unit) FStar_Tactics_Effect.tac_repr) + = + fun params -> + fun ctors -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (35)) (Prims.of_int (18)) (Prims.of_int (35)) + (Prims.of_int (61))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (35)) (Prims.of_int (64)) (Prims.of_int (38)) + (Prims.of_int (17))))) + (Obj.magic + (FStar_Tactics_Util.map + (fun uu___ -> match uu___ with | (uu___1, ty) -> alg_ctor ty) + ctors)) + (fun uu___ -> + (fun ctor_typs -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (37)) (Prims.of_int (4)) + (Prims.of_int (37)) (Prims.of_int (67))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (36)) (Prims.of_int (6)) + (Prims.of_int (36)) (Prims.of_int (21))))) + (Obj.magic + (FStar_Tactics_Util.fold_right + (fun uu___1 -> + fun uu___ -> + (fun ty -> + fun acc -> + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun uu___ -> either_ ty acc))) + uu___1 uu___) ctor_typs empty_)) + (fun alternative_typ -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___ -> alternative_typ)))) uu___) +let _ = + FStar_Tactics_Native.register_tactic + "FStar.Tactics.TypeRepr.generate_repr_typ" (Prims.of_int (3)) + (fun psc -> + fun ncb -> + fun us -> + fun args -> + FStar_Tactics_InterpFuns.mk_tactic_interpretation_2 + "FStar.Tactics.TypeRepr.generate_repr_typ (plugin)" + (FStar_Tactics_Native.from_tactic_2 generate_repr_typ) + (FStar_Syntax_Embeddings.e_list + FStar_Tactics_NamedView.e_binder) + (FStar_Syntax_Embeddings.e_list + (FStar_Syntax_Embeddings.e_tuple2 + (FStar_Syntax_Embeddings.e_list + FStar_Syntax_Embeddings.e_string) + FStar_Reflection_V2_Embeddings.e_term)) + FStar_Reflection_V2_Embeddings.e_term psc ncb us args) +let (generate_down : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = + fun uu___ -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (43)) (Prims.of_int (10)) (Prims.of_int (43)) + (Prims.of_int (18))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (43)) (Prims.of_int (21)) (Prims.of_int (52)) + (Prims.of_int (3))))) + (Obj.magic (FStar_Tactics_V2_Builtins.intro ())) + (fun uu___1 -> + (fun b -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (44)) (Prims.of_int (14)) + (Prims.of_int (44)) (Prims.of_int (26))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (45)) (Prims.of_int (2)) + (Prims.of_int (52)) (Prims.of_int (3))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.t_destruct + (FStar_Tactics_V2_SyntaxCoercions.binding_to_term b))) + (fun uu___1 -> + (fun cases -> + Obj.magic + (FStar_Tactics_Util.iteri + (fun i -> + fun uu___1 -> + match uu___1 with + | (c, n) -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (46)) + (Prims.of_int (13)) + (Prims.of_int (46)) + (Prims.of_int (42))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (46)) + (Prims.of_int (45)) + (Prims.of_int (51)) + (Prims.of_int (13))))) + (Obj.magic + (FStar_Tactics_Util.repeatn n + (fun uu___2 -> + FStar_Tactics_V2_Builtins.intro + ()))) + (fun uu___2 -> + (fun bs -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (47)) + (Prims.of_int (16)) + (Prims.of_int (47)) + (Prims.of_int (24))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (47)) + (Prims.of_int (27)) + (Prims.of_int (51)) + (Prims.of_int (13))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.intro + ())) + (fun uu___2 -> + (fun _b_eq -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (48)) + (Prims.of_int (14)) + (Prims.of_int (48)) + (Prims.of_int (80))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (48)) + (Prims.of_int (83)) + (Prims.of_int (51)) + (Prims.of_int (13))))) + (Obj.magic + (FStar_Tactics_Util.fold_right + (fun + uu___3 -> + fun + uu___2 -> + (fun b1 + -> + fun acc + -> + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun + uu___2 -> + mktuple2_ + (FStar_Tactics_V2_SyntaxCoercions.binding_to_term + b1) acc))) + uu___3 + uu___2) + bs unitv_)) + (fun uu___2 -> + (fun sol -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (49)) + (Prims.of_int (12)) + (Prims.of_int (49)) + (Prims.of_int (45))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (50)) + (Prims.of_int (4)) + (Prims.of_int (51)) + (Prims.of_int (13))))) + (Obj.magic + (FStar_Tactics_Util.repeatn + i + (fun + uu___2 -> + FStar_Tactics_V2_Derived.apply + (FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + ["FStar"; + "Pervasives"; + "Inr"])))))) + (fun + uu___2 -> + (fun + uu___2 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (50)) + (Prims.of_int (4)) + (Prims.of_int (50)) + (Prims.of_int (16))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (51)) + (Prims.of_int (4)) + (Prims.of_int (51)) + (Prims.of_int (13))))) + (Obj.magic + (FStar_Tactics_V2_Derived.apply + (FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + ["FStar"; + "Pervasives"; + "Inl"]))))) + (fun + uu___3 -> + (fun + uu___3 -> + Obj.magic + (FStar_Tactics_V2_Derived.exact + sol)) + uu___3))) + uu___2))) + uu___2))) + uu___2))) uu___2)) + cases)) uu___1))) uu___1) +let _ = + FStar_Tactics_Native.register_tactic "FStar.Tactics.TypeRepr.generate_down" + (Prims.of_int (2)) + (fun psc -> + fun ncb -> + fun us -> + fun args -> + FStar_Tactics_InterpFuns.mk_tactic_interpretation_1 + "FStar.Tactics.TypeRepr.generate_down (plugin)" + (FStar_Tactics_Native.from_tactic_1 generate_down) + FStar_Syntax_Embeddings.e_unit FStar_Syntax_Embeddings.e_unit + psc ncb us args) +let rec (get_apply_tuple : + FStar_Tactics_NamedView.binding -> + (FStar_Tactics_NamedView.binding Prims.list, unit) + FStar_Tactics_Effect.tac_repr) + = + fun b -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (55)) (Prims.of_int (17)) (Prims.of_int (55)) + (Prims.of_int (35))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (54)) (Prims.of_int (58)) (Prims.of_int (74)) + (Prims.of_int (69))))) + (Obj.magic + (FStar_Tactics_V2_SyntaxHelpers.collect_app + b.FStar_Reflection_V2_Data.sort3)) + (fun uu___ -> + (fun uu___ -> + match uu___ with + | (hd, args) -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (56)) (Prims.of_int (8)) + (Prims.of_int (56)) (Prims.of_int (24))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (56)) (Prims.of_int (2)) + (Prims.of_int (74)) (Prims.of_int (69))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (56)) (Prims.of_int (8)) + (Prims.of_int (56)) (Prims.of_int (18))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (56)) (Prims.of_int (8)) + (Prims.of_int (56)) (Prims.of_int (24))))) + (Obj.magic (FStar_Tactics_NamedView.inspect hd)) + (fun uu___1 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___2 -> (uu___1, args))))) + (fun uu___1 -> + (fun uu___1 -> + match uu___1 with + | (FStar_Tactics_NamedView.Tv_UInst (fv, uu___2), + b1::b2::[]) -> + Obj.magic + (Obj.repr + (if + (FStar_Reflection_V2_Builtins.inspect_fv + fv) + = + ["FStar"; + "Pervasives"; + "Native"; + "tuple2"] + then + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (60)) + (Prims.of_int (18)) + (Prims.of_int (60)) + (Prims.of_int (30))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (61)) + (Prims.of_int (6)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.t_destruct + (FStar_Tactics_V2_SyntaxCoercions.binding_to_term + b))) + (fun uu___3 -> + (fun cases -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (61)) + (Prims.of_int (6)) + (Prims.of_int (61)) + (Prims.of_int (136))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (61)) + (Prims.of_int (137)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (Obj.magic + (FStar_Tactics_V2_Derived.guard + ((((FStar_List_Tot_Base.length + cases) + = + Prims.int_one) + && + ((FStar_Reflection_V2_Builtins.inspect_fv + (FStar_Pervasives_Native.fst + (FStar_List_Tot_Base.hd + cases))) + = + ["FStar"; + "Pervasives"; + "Native"; + "Mktuple2"])) + && + ((FStar_Pervasives_Native.snd + (FStar_List_Tot_Base.hd + cases)) + = + (Prims.of_int (2)))))) + (fun uu___3 -> + (fun uu___3 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (62)) + (Prims.of_int (15)) + (Prims.of_int (62)) + (Prims.of_int (23))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (62)) + (Prims.of_int (26)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.intro + ())) + (fun uu___4 -> + (fun b11 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (63)) + (Prims.of_int (15)) + (Prims.of_int (63)) + (Prims.of_int (23))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (63)) + (Prims.of_int (26)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.intro + ())) + (fun + uu___4 -> + (fun b21 + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (64)) + (Prims.of_int (16)) + (Prims.of_int (64)) + (Prims.of_int (24))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (65)) + (Prims.of_int (6)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.intro + ())) + (fun + uu___4 -> + (fun _eq + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (65)) + (Prims.of_int (12)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (65)) + (Prims.of_int (6)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (Obj.magic + (get_apply_tuple + b21)) + (fun + uu___4 -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___5 -> + b11 :: + uu___4)))) + uu___4))) + uu___4))) + uu___4))) + uu___3))) uu___3) + else + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (67)) + (Prims.of_int (11)) + (Prims.of_int (67)) + (Prims.of_int (71))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (67)) + (Prims.of_int (6)) + (Prims.of_int (67)) + (Prims.of_int (71))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (67)) + (Prims.of_int (49)) + (Prims.of_int (67)) + (Prims.of_int (70))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "prims.fst" + (Prims.of_int (590)) + (Prims.of_int (19)) + (Prims.of_int (590)) + (Prims.of_int (31))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.term_to_string + b.FStar_Reflection_V2_Data.sort3)) + (fun uu___4 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___5 -> + Prims.strcat + "unexpected term in apply_tuple: " + uu___4)))) + (fun uu___4 -> + FStar_Tactics_V2_Derived.fail + uu___4))) + | (FStar_Tactics_NamedView.Tv_FVar fv, b1::b2::[]) + -> + Obj.magic + (Obj.repr + (if + (FStar_Reflection_V2_Builtins.inspect_fv + fv) + = + ["FStar"; + "Pervasives"; + "Native"; + "tuple2"] + then + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (60)) + (Prims.of_int (18)) + (Prims.of_int (60)) + (Prims.of_int (30))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (61)) + (Prims.of_int (6)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.t_destruct + (FStar_Tactics_V2_SyntaxCoercions.binding_to_term + b))) + (fun uu___2 -> + (fun cases -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (61)) + (Prims.of_int (6)) + (Prims.of_int (61)) + (Prims.of_int (136))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (61)) + (Prims.of_int (137)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (Obj.magic + (FStar_Tactics_V2_Derived.guard + ((((FStar_List_Tot_Base.length + cases) + = + Prims.int_one) + && + ((FStar_Reflection_V2_Builtins.inspect_fv + (FStar_Pervasives_Native.fst + (FStar_List_Tot_Base.hd + cases))) + = + ["FStar"; + "Pervasives"; + "Native"; + "Mktuple2"])) + && + ((FStar_Pervasives_Native.snd + (FStar_List_Tot_Base.hd + cases)) + = + (Prims.of_int (2)))))) + (fun uu___2 -> + (fun uu___2 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (62)) + (Prims.of_int (15)) + (Prims.of_int (62)) + (Prims.of_int (23))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (62)) + (Prims.of_int (26)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.intro + ())) + (fun uu___3 -> + (fun b11 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (63)) + (Prims.of_int (15)) + (Prims.of_int (63)) + (Prims.of_int (23))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (63)) + (Prims.of_int (26)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.intro + ())) + (fun + uu___3 -> + (fun b21 + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (64)) + (Prims.of_int (16)) + (Prims.of_int (64)) + (Prims.of_int (24))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (65)) + (Prims.of_int (6)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.intro + ())) + (fun + uu___3 -> + (fun _eq + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (65)) + (Prims.of_int (12)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (65)) + (Prims.of_int (6)) + (Prims.of_int (65)) + (Prims.of_int (30))))) + (Obj.magic + (get_apply_tuple + b21)) + (fun + uu___3 -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___4 -> + b11 :: + uu___3)))) + uu___3))) + uu___3))) + uu___3))) + uu___2))) uu___2) + else + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (67)) + (Prims.of_int (11)) + (Prims.of_int (67)) + (Prims.of_int (71))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (67)) + (Prims.of_int (6)) + (Prims.of_int (67)) + (Prims.of_int (71))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (67)) + (Prims.of_int (49)) + (Prims.of_int (67)) + (Prims.of_int (70))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "prims.fst" + (Prims.of_int (590)) + (Prims.of_int (19)) + (Prims.of_int (590)) + (Prims.of_int (31))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.term_to_string + b.FStar_Reflection_V2_Data.sort3)) + (fun uu___3 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___4 -> + Prims.strcat + "unexpected term in apply_tuple: " + uu___3)))) + (fun uu___3 -> + FStar_Tactics_V2_Derived.fail + uu___3))) + | (FStar_Tactics_NamedView.Tv_FVar fv, []) -> + Obj.magic + (Obj.repr + (if + (FStar_Reflection_V2_Builtins.inspect_fv + fv) + = ["Prims"; "unit"] + then + Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___2 -> [])) + else + Obj.repr + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (72)) + (Prims.of_int (11)) + (Prims.of_int (72)) + (Prims.of_int (71))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (72)) + (Prims.of_int (6)) + (Prims.of_int (72)) + (Prims.of_int (71))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (72)) + (Prims.of_int (49)) + (Prims.of_int (72)) + (Prims.of_int (70))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "prims.fst" + (Prims.of_int (590)) + (Prims.of_int (19)) + (Prims.of_int (590)) + (Prims.of_int (31))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.term_to_string + b.FStar_Reflection_V2_Data.sort3)) + (fun uu___3 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___4 -> + Prims.strcat + "unexpected term in apply_tuple: " + uu___3)))) + (fun uu___3 -> + FStar_Tactics_V2_Derived.fail + uu___3)))) + | uu___2 -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (74)) + (Prims.of_int (9)) + (Prims.of_int (74)) + (Prims.of_int (69))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (74)) + (Prims.of_int (4)) + (Prims.of_int (74)) + (Prims.of_int (69))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (74)) + (Prims.of_int (47)) + (Prims.of_int (74)) + (Prims.of_int (68))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "prims.fst" + (Prims.of_int (590)) + (Prims.of_int (19)) + (Prims.of_int (590)) + (Prims.of_int (31))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.term_to_string + b.FStar_Reflection_V2_Data.sort3)) + (fun uu___3 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___4 -> + Prims.strcat + "unexpected term in apply_tuple: " + uu___3)))) + (fun uu___3 -> + FStar_Tactics_V2_Derived.fail + uu___3)))) uu___1))) uu___) +let rec (generate_up_aux : + FStar_Reflection_V2_Data.ctor Prims.list -> + FStar_Tactics_NamedView.binding -> + (unit, unit) FStar_Tactics_Effect.tac_repr) + = + fun ctors -> + fun b -> + match ctors with + | [] -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (82)) (Prims.of_int (4)) + (Prims.of_int (82)) (Prims.of_int (23))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (83)) (Prims.of_int (4)) + (Prims.of_int (83)) (Prims.of_int (11))))) + (Obj.magic + (FStar_Tactics_V2_Derived.apply + (FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + ["FStar"; "Tactics"; "TypeRepr"; "empty_elim"]))))) + (fun uu___ -> + (fun uu___ -> + Obj.magic + (FStar_Tactics_V2_Derived.exact + (FStar_Tactics_V2_SyntaxCoercions.binding_to_term b))) + uu___) + | c::cs -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (85)) (Prims.of_int (16)) + (Prims.of_int (85)) (Prims.of_int (28))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (86)) (Prims.of_int (4)) + (Prims.of_int (99)) (Prims.of_int (24))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.t_destruct + (FStar_Tactics_V2_SyntaxCoercions.binding_to_term b))) + (fun uu___ -> + (fun cases -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (86)) (Prims.of_int (4)) + (Prims.of_int (87)) (Prims.of_int (49))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (88)) (Prims.of_int (4)) + (Prims.of_int (99)) (Prims.of_int (24))))) + (if + (FStar_List_Tot_Base.length cases) <> + (Prims.of_int (2)) + then + FStar_Tactics_V2_Derived.fail + "generate_up_aux: expected Inl/Inr???" + else + FStar_Tactics_Effect.lift_div_tac + (fun uu___1 -> ())) + (fun uu___ -> + (fun uu___ -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (88)) + (Prims.of_int (4)) + (Prims.of_int (96)) + (Prims.of_int (5))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (96)) + (Prims.of_int (6)) + (Prims.of_int (99)) + (Prims.of_int (24))))) + (Obj.magic + (FStar_Tactics_V2_Derived.focus + (fun uu___1 -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (89)) + (Prims.of_int (15)) + (Prims.of_int (89)) + (Prims.of_int (23))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (89)) + (Prims.of_int (26)) + (Prims.of_int (95)) + (Prims.of_int (11))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.intro + ())) + (fun uu___2 -> + (fun b' -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (90)) + (Prims.of_int (16)) + (Prims.of_int (90)) + (Prims.of_int (24))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (90)) + (Prims.of_int (27)) + (Prims.of_int (95)) + (Prims.of_int (11))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.intro + ())) + (fun uu___2 -> + (fun _eq -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (91)) + (Prims.of_int (19)) + (Prims.of_int (91)) + (Prims.of_int (24))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (91)) + (Prims.of_int (27)) + (Prims.of_int (95)) + (Prims.of_int (11))))) + (FStar_Tactics_Effect.lift_div_tac + (fun + uu___2 -> + FStar_Pervasives_Native.fst + c)) + (fun + uu___2 -> + (fun + c_name -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (92)) + (Prims.of_int (17)) + (Prims.of_int (92)) + (Prims.of_int (35))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (93)) + (Prims.of_int (6)) + (Prims.of_int (95)) + (Prims.of_int (11))))) + (Obj.magic + (get_apply_tuple + b')) + (fun + uu___2 -> + (fun args + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (93)) + (Prims.of_int (6)) + (Prims.of_int (93)) + (Prims.of_int (45))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (94)) + (Prims.of_int (6)) + (Prims.of_int (95)) + (Prims.of_int (11))))) + (Obj.magic + (FStar_Tactics_V2_Derived.apply + (FStar_Tactics_NamedView.pack + (FStar_Tactics_NamedView.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + c_name))))) + (fun + uu___2 -> + (fun + uu___2 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (94)) + (Prims.of_int (6)) + (Prims.of_int (94)) + (Prims.of_int (49))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (95)) + (Prims.of_int (6)) + (Prims.of_int (95)) + (Prims.of_int (11))))) + (Obj.magic + (FStar_Tactics_Util.iter + (fun b1 + -> + FStar_Tactics_V2_Derived.exact + (FStar_Tactics_V2_SyntaxCoercions.binding_to_term + b1)) args)) + (fun + uu___3 -> + (fun + uu___3 -> + Obj.magic + (FStar_Tactics_V2_Derived.qed + ())) + uu___3))) + uu___2))) + uu___2))) + uu___2))) + uu___2))) uu___2)))) + (fun uu___1 -> + (fun uu___1 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (97)) + (Prims.of_int (12)) + (Prims.of_int (97)) + (Prims.of_int (20))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (97)) + (Prims.of_int (23)) + (Prims.of_int (99)) + (Prims.of_int (24))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.intro + ())) + (fun uu___2 -> + (fun b1 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (98)) + (Prims.of_int (14)) + (Prims.of_int (98)) + (Prims.of_int (22))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (99)) + (Prims.of_int (4)) + (Prims.of_int (99)) + (Prims.of_int (24))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.intro + ())) + (fun uu___2 -> + (fun _eq -> + Obj.magic + (generate_up_aux + cs b1)) + uu___2))) uu___2))) + uu___1))) uu___))) uu___) +let (generate_up : + Prims.string -> unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = + fun nm -> + fun uu___ -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (104)) (Prims.of_int (29)) + (Prims.of_int (104)) (Prims.of_int (49))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (103)) (Prims.of_int (43)) + (Prims.of_int (106)) (Prims.of_int (25))))) + (Obj.magic (get_inductive_typ nm)) + (fun uu___1 -> + (fun uu___1 -> + match uu___1 with + | FStar_Tactics_NamedView.Sg_Inductive + { FStar_Tactics_NamedView.nm = uu___2; + FStar_Tactics_NamedView.univs1 = uu___3; + FStar_Tactics_NamedView.params = uu___4; + FStar_Tactics_NamedView.typ = uu___5; + FStar_Tactics_NamedView.ctors = ctors;_} + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (105)) (Prims.of_int (10)) + (Prims.of_int (105)) (Prims.of_int (18))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (106)) (Prims.of_int (2)) + (Prims.of_int (106)) (Prims.of_int (25))))) + (Obj.magic (FStar_Tactics_V2_Builtins.intro ())) + (fun uu___6 -> + (fun b -> Obj.magic (generate_up_aux ctors b)) + uu___6))) uu___1) +let _ = + FStar_Tactics_Native.register_tactic "FStar.Tactics.TypeRepr.generate_up" + (Prims.of_int (3)) + (fun psc -> + fun ncb -> + fun us -> + fun args -> + FStar_Tactics_InterpFuns.mk_tactic_interpretation_2 + "FStar.Tactics.TypeRepr.generate_up (plugin)" + (FStar_Tactics_Native.from_tactic_2 generate_up) + FStar_Syntax_Embeddings.e_string + FStar_Syntax_Embeddings.e_unit FStar_Syntax_Embeddings.e_unit + psc ncb us args) +let (make_implicits : + FStar_Tactics_NamedView.binders -> FStar_Tactics_NamedView.binders) = + fun bs -> + FStar_List_Tot_Base.map + (fun b -> + match b.FStar_Tactics_NamedView.qual with + | FStar_Reflection_V2_Data.Q_Explicit -> + { + FStar_Tactics_NamedView.uniq = + (b.FStar_Tactics_NamedView.uniq); + FStar_Tactics_NamedView.ppname = + (b.FStar_Tactics_NamedView.ppname); + FStar_Tactics_NamedView.sort = + (b.FStar_Tactics_NamedView.sort); + FStar_Tactics_NamedView.qual = + FStar_Reflection_V2_Data.Q_Implicit; + FStar_Tactics_NamedView.attrs = + (b.FStar_Tactics_NamedView.attrs) + } + | uu___ -> b) bs +let (binder_to_argv : + FStar_Tactics_NamedView.binder -> FStar_Reflection_V2_Data.argv) = + fun b -> + ((FStar_Tactics_V2_SyntaxCoercions.binder_to_term b), + (b.FStar_Tactics_NamedView.qual)) +let (generate_all : + FStar_Reflection_Types.name -> + FStar_Tactics_NamedView.binders -> + FStar_Reflection_V2_Data.ctor Prims.list -> + (FStar_Reflection_Types.decls, unit) FStar_Tactics_Effect.tac_repr) + = + fun nm -> + fun params -> + fun ctors -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (119)) (Prims.of_int (17)) + (Prims.of_int (119)) (Prims.of_int (38))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (119)) (Prims.of_int (41)) + (Prims.of_int (165)) (Prims.of_int (27))))) + (FStar_Tactics_Effect.lift_div_tac + (fun uu___ -> make_implicits params)) + (fun uu___ -> + (fun params_i -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (120)) (Prims.of_int (15)) + (Prims.of_int (120)) (Prims.of_int (88))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (120)) (Prims.of_int (91)) + (Prims.of_int (165)) (Prims.of_int (27))))) + (FStar_Tactics_Effect.lift_div_tac + (fun uu___ -> + FStar_Reflection_V2_Derived.mk_app + (FStar_Tactics_NamedView.pack + (FStar_Tactics_NamedView.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv nm))) + (FStar_List_Tot_Base.map binder_to_argv params))) + (fun uu___ -> + (fun t -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (121)) + (Prims.of_int (15)) + (Prims.of_int (121)) + (Prims.of_int (45))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (121)) + (Prims.of_int (48)) + (Prims.of_int (165)) + (Prims.of_int (27))))) + (Obj.magic (generate_repr_typ params ctors)) + (fun uu___ -> + (fun t_repr -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (122)) + (Prims.of_int (16)) + (Prims.of_int (130)) + (Prims.of_int (3))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (131)) + (Prims.of_int (4)) + (Prims.of_int (165)) + (Prims.of_int (27))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (122)) + (Prims.of_int (31)) + (Prims.of_int (130)) + (Prims.of_int (3))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (122)) + (Prims.of_int (16)) + (Prims.of_int (130)) + (Prims.of_int (3))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (123)) + (Prims.of_int (4)) + (Prims.of_int (129)) + (Prims.of_int (6))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (122)) + (Prims.of_int (31)) + (Prims.of_int (130)) + (Prims.of_int (3))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (124)) + (Prims.of_int (10)) + (Prims.of_int (129)) + (Prims.of_int (6))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (123)) + (Prims.of_int (4)) + (Prims.of_int (129)) + (Prims.of_int (6))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (125)) + (Prims.of_int (6)) + (Prims.of_int (128)) + (Prims.of_int (36))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (124)) + (Prims.of_int (10)) + (Prims.of_int (129)) + (Prims.of_int (6))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (127)) + (Prims.of_int (15)) + (Prims.of_int (127)) + (Prims.of_int (47))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (125)) + (Prims.of_int (6)) + (Prims.of_int (128)) + (Prims.of_int (36))))) + (Obj.magic + (FStar_Tactics_V2_SyntaxHelpers.mk_arr + params + (FStar_Reflection_V2_Data.C_Total + (FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_Type + (FStar_Reflection_V2_Builtins.pack_universe + FStar_Reflection_V2_Data.Uv_Unk)))))) + (fun + uu___ -> + (fun + uu___ -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (128)) + (Prims.of_int (15)) + (Prims.of_int (128)) + (Prims.of_int (35))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (125)) + (Prims.of_int (6)) + (Prims.of_int (128)) + (Prims.of_int (36))))) + (Obj.magic + (FStar_Tactics_V2_Derived.mk_abs + params + t_repr)) + (fun + uu___1 -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___2 -> + { + FStar_Tactics_NamedView.lb_fv + = + (FStar_Reflection_V2_Builtins.pack_fv + (add_suffix + "_repr" + nm)); + FStar_Tactics_NamedView.lb_us + = []; + FStar_Tactics_NamedView.lb_typ + = uu___; + FStar_Tactics_NamedView.lb_def + = uu___1 + })))) + uu___))) + (fun uu___ + -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___1 -> + [uu___])))) + (fun uu___ -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___1 + -> + { + FStar_Tactics_NamedView.isrec + = false; + FStar_Tactics_NamedView.lbs + = uu___ + })))) + (fun uu___ -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___1 -> + FStar_Tactics_NamedView.Sg_Let + uu___)))) + (fun uu___ -> + (fun uu___ -> + Obj.magic + (FStar_Tactics_NamedView.pack_sigelt + uu___)) uu___))) + (fun uu___ -> + (fun se_repr -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (134)) + (Prims.of_int (4)) + (Prims.of_int (134)) + (Prims.of_int (30))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (135)) + (Prims.of_int (4)) + (Prims.of_int (165)) + (Prims.of_int (27))))) + (FStar_Tactics_Effect.lift_div_tac + (fun uu___ -> + FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_App + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + ["FStar"; + "Tactics"; + "Effect"; + "synth_by_tactic"]))), + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_Abs + ((FStar_Reflection_V2_Builtins.pack_binder + { + FStar_Reflection_V2_Data.sort2 + = + (FStar_Reflection_V2_Builtins.pack_ln + FStar_Reflection_V2_Data.Tv_Unknown); + FStar_Reflection_V2_Data.qual + = + FStar_Reflection_V2_Data.Q_Explicit; + FStar_Reflection_V2_Data.attrs + = []; + FStar_Reflection_V2_Data.ppname2 + = + (FStar_Sealed.seal + "uu___") + }), + (FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_App + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + ["FStar"; + "Tactics"; + "TypeRepr"; + "generate_down"]))), + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_Const + FStar_Reflection_V2_Data.C_Unit)), + FStar_Reflection_V2_Data.Q_Explicit))))))), + FStar_Reflection_V2_Data.Q_Explicit))))) + (fun uu___ -> + (fun down_def -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + ( + Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (136)) + (Prims.of_int (17)) + (Prims.of_int (136)) + (Prims.of_int (41))))) + (FStar_Sealed.seal + ( + Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (136)) + (Prims.of_int (44)) + (Prims.of_int (165)) + (Prims.of_int (27))))) + (Obj.magic + ( + FStar_Tactics_V2_Derived.mk_abs + params_i + down_def)) + (fun uu___ + -> + (fun + down_def1 + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (137)) + (Prims.of_int (15)) + (Prims.of_int (147)) + (Prims.of_int (3))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (148)) + (Prims.of_int (4)) + (Prims.of_int (165)) + (Prims.of_int (27))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (138)) + (Prims.of_int (12)) + (Prims.of_int (138)) + (Prims.of_int (26))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (139)) + (Prims.of_int (4)) + (Prims.of_int (147)) + (Prims.of_int (3))))) + (Obj.magic + (FStar_Tactics_V2_Derived.fresh_binder + t)) + (fun + uu___ -> + (fun b -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (139)) + (Prims.of_int (19)) + (Prims.of_int (147)) + (Prims.of_int (3))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (139)) + (Prims.of_int (4)) + (Prims.of_int (147)) + (Prims.of_int (3))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (140)) + (Prims.of_int (6)) + (Prims.of_int (146)) + (Prims.of_int (8))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (139)) + (Prims.of_int (19)) + (Prims.of_int (147)) + (Prims.of_int (3))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (141)) + (Prims.of_int (12)) + (Prims.of_int (146)) + (Prims.of_int (8))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (140)) + (Prims.of_int (6)) + (Prims.of_int (146)) + (Prims.of_int (8))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (142)) + (Prims.of_int (8)) + (Prims.of_int (145)) + (Prims.of_int (26))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (141)) + (Prims.of_int (12)) + (Prims.of_int (146)) + (Prims.of_int (8))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (144)) + (Prims.of_int (17)) + (Prims.of_int (144)) + (Prims.of_int (67))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (142)) + (Prims.of_int (8)) + (Prims.of_int (145)) + (Prims.of_int (26))))) + (Obj.magic + (FStar_Tactics_V2_SyntaxHelpers.mk_tot_arr + params_i + (FStar_Tactics_NamedView.pack + (FStar_Tactics_NamedView.Tv_Arrow + (b, + (FStar_Reflection_V2_Data.C_Total + t_repr)))))) + (fun + uu___ -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___1 -> + { + FStar_Tactics_NamedView.lb_fv + = + (FStar_Reflection_V2_Builtins.pack_fv + (add_suffix + "_down" + nm)); + FStar_Tactics_NamedView.lb_us + = []; + FStar_Tactics_NamedView.lb_typ + = uu___; + FStar_Tactics_NamedView.lb_def + = + down_def1 + })))) + (fun + uu___ -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___1 -> + [uu___])))) + (fun + uu___ -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___1 -> + { + FStar_Tactics_NamedView.isrec + = false; + FStar_Tactics_NamedView.lbs + = uu___ + })))) + (fun + uu___ -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___1 -> + FStar_Tactics_NamedView.Sg_Let + uu___)))) + (fun + uu___ -> + (fun + uu___ -> + Obj.magic + (FStar_Tactics_NamedView.pack_sigelt + uu___)) + uu___))) + uu___))) + (fun + uu___ -> + (fun + se_down + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (150)) + (Prims.of_int (4)) + (Prims.of_int (150)) + (Prims.of_int (77))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (151)) + (Prims.of_int (4)) + (Prims.of_int (165)) + (Prims.of_int (27))))) + (FStar_Tactics_Effect.lift_div_tac + (fun + uu___ -> + FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_App + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + ["FStar"; + "Tactics"; + "Effect"; + "synth_by_tactic"]))), + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_Abs + ((FStar_Reflection_V2_Builtins.pack_binder + { + FStar_Reflection_V2_Data.sort2 + = + (FStar_Reflection_V2_Builtins.pack_ln + FStar_Reflection_V2_Data.Tv_Unknown); + FStar_Reflection_V2_Data.qual + = + FStar_Reflection_V2_Data.Q_Explicit; + FStar_Reflection_V2_Data.attrs + = []; + FStar_Reflection_V2_Data.ppname2 + = + (FStar_Sealed.seal + "uu___") + }), + (FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_App + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_App + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + ["FStar"; + "Tactics"; + "TypeRepr"; + "generate_up"]))), + ((FStar_Tactics_NamedView.pack + (FStar_Tactics_NamedView.Tv_Const + (FStar_Reflection_V2_Data.C_String + (FStar_Reflection_V2_Builtins.implode_qn + nm)))), + FStar_Reflection_V2_Data.Q_Explicit)))), + ((FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_Const + FStar_Reflection_V2_Data.C_Unit)), + FStar_Reflection_V2_Data.Q_Explicit))))))), + FStar_Reflection_V2_Data.Q_Explicit))))) + (fun + uu___ -> + (fun + up_def -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (152)) + (Prims.of_int (15)) + (Prims.of_int (152)) + (Prims.of_int (37))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (152)) + (Prims.of_int (40)) + (Prims.of_int (165)) + (Prims.of_int (27))))) + (Obj.magic + (FStar_Tactics_V2_Derived.mk_abs + params_i + up_def)) + (fun + uu___ -> + (fun + up_def1 + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (153)) + (Prims.of_int (13)) + (Prims.of_int (163)) + (Prims.of_int (3))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (165)) + (Prims.of_int (2)) + (Prims.of_int (165)) + (Prims.of_int (27))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (154)) + (Prims.of_int (12)) + (Prims.of_int (154)) + (Prims.of_int (31))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (155)) + (Prims.of_int (4)) + (Prims.of_int (163)) + (Prims.of_int (3))))) + (Obj.magic + (FStar_Tactics_V2_Derived.fresh_binder + t_repr)) + (fun + uu___ -> + (fun b -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (155)) + (Prims.of_int (19)) + (Prims.of_int (163)) + (Prims.of_int (3))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (155)) + (Prims.of_int (4)) + (Prims.of_int (163)) + (Prims.of_int (3))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (156)) + (Prims.of_int (6)) + (Prims.of_int (162)) + (Prims.of_int (8))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (155)) + (Prims.of_int (19)) + (Prims.of_int (163)) + (Prims.of_int (3))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (157)) + (Prims.of_int (12)) + (Prims.of_int (162)) + (Prims.of_int (8))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (156)) + (Prims.of_int (6)) + (Prims.of_int (162)) + (Prims.of_int (8))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (158)) + (Prims.of_int (8)) + (Prims.of_int (161)) + (Prims.of_int (24))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (157)) + (Prims.of_int (12)) + (Prims.of_int (162)) + (Prims.of_int (8))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (160)) + (Prims.of_int (17)) + (Prims.of_int (160)) + (Prims.of_int (62))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (158)) + (Prims.of_int (8)) + (Prims.of_int (161)) + (Prims.of_int (24))))) + (Obj.magic + (FStar_Tactics_V2_SyntaxHelpers.mk_tot_arr + params_i + (FStar_Tactics_NamedView.pack + (FStar_Tactics_NamedView.Tv_Arrow + (b, + (FStar_Reflection_V2_Data.C_Total + t)))))) + (fun + uu___ -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___1 -> + { + FStar_Tactics_NamedView.lb_fv + = + (FStar_Reflection_V2_Builtins.pack_fv + (add_suffix + "_up" nm)); + FStar_Tactics_NamedView.lb_us + = []; + FStar_Tactics_NamedView.lb_typ + = uu___; + FStar_Tactics_NamedView.lb_def + = up_def1 + })))) + (fun + uu___ -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___1 -> + [uu___])))) + (fun + uu___ -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___1 -> + { + FStar_Tactics_NamedView.isrec + = false; + FStar_Tactics_NamedView.lbs + = uu___ + })))) + (fun + uu___ -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___1 -> + FStar_Tactics_NamedView.Sg_Let + uu___)))) + (fun + uu___ -> + (fun + uu___ -> + Obj.magic + (FStar_Tactics_NamedView.pack_sigelt + uu___)) + uu___))) + uu___))) + (fun + se_up -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___ -> + [se_repr; + se_down; + se_up])))) + uu___))) + uu___))) + uu___))) + uu___))) + uu___))) uu___))) + uu___))) uu___))) uu___) +let (entry : + Prims.string -> + (FStar_Reflection_Types.decls, unit) FStar_Tactics_Effect.tac_repr) + = + fun nm -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (169)) (Prims.of_int (41)) (Prims.of_int (169)) + (Prims.of_int (61))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (168)) (Prims.of_int (37)) (Prims.of_int (170)) + (Prims.of_int (30))))) (Obj.magic (get_inductive_typ nm)) + (fun uu___ -> + (fun uu___ -> + match uu___ with + | FStar_Tactics_NamedView.Sg_Inductive + { FStar_Tactics_NamedView.nm = nm1; + FStar_Tactics_NamedView.univs1 = uu___1; + FStar_Tactics_NamedView.params = params; + FStar_Tactics_NamedView.typ = uu___2; + FStar_Tactics_NamedView.ctors = ctors;_} + -> Obj.magic (generate_all nm1 params ctors)) uu___) +let _ = + FStar_Tactics_Native.register_tactic "FStar.Tactics.TypeRepr.entry" + (Prims.of_int (2)) + (fun psc -> + fun ncb -> + fun us -> + fun args -> + FStar_Tactics_InterpFuns.mk_tactic_interpretation_1 + "FStar.Tactics.TypeRepr.entry (plugin)" + (FStar_Tactics_Native.from_tactic_1 entry) + FStar_Syntax_Embeddings.e_string + (FStar_Syntax_Embeddings.e_list + FStar_Reflection_V2_Embeddings.e_sigelt) psc ncb us args) \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml index 25c69d85574..c18e1a96e85 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Typeclasses.ml @@ -8,12 +8,12 @@ let (debug : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (29)) (Prims.of_int (5)) (Prims.of_int (29)) + (Prims.of_int (30)) (Prims.of_int (5)) (Prims.of_int (30)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (29)) (Prims.of_int (2)) (Prims.of_int (30)) + (Prims.of_int (30)) (Prims.of_int (2)) (Prims.of_int (31)) (Prims.of_int (16))))) (Obj.magic (FStar_Tactics_V2_Builtins.debugging ())) (fun uu___ -> @@ -27,14 +27,14 @@ let (debug : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (30)) (Prims.of_int (10)) - (Prims.of_int (30)) (Prims.of_int (16))))) + (Prims.of_int (31)) (Prims.of_int (10)) + (Prims.of_int (31)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (30)) (Prims.of_int (4)) - (Prims.of_int (30)) (Prims.of_int (16))))) + (Prims.of_int (31)) (Prims.of_int (4)) + (Prims.of_int (31)) (Prims.of_int (16))))) (Obj.magic (f ())) (fun uu___1 -> (fun uu___1 -> @@ -50,6 +50,51 @@ let op_At : 'uuuuu . unit -> 'uuuuu Prims.list -> 'uuuuu Prims.list -> 'uuuuu Prims.list = fun uu___ -> FStar_List_Tot_Base.op_At +type st_t = + { + seen: FStar_Tactics_NamedView.term Prims.list ; + glb: (FStar_Reflection_Types.sigelt * FStar_Reflection_Types.fv) Prims.list ; + fuel: Prims.int } +let (__proj__Mkst_t__item__seen : + st_t -> FStar_Tactics_NamedView.term Prims.list) = + fun projectee -> match projectee with | { seen; glb; fuel;_} -> seen +let (__proj__Mkst_t__item__glb : + st_t -> + (FStar_Reflection_Types.sigelt * FStar_Reflection_Types.fv) Prims.list) + = fun projectee -> match projectee with | { seen; glb; fuel;_} -> glb +let (__proj__Mkst_t__item__fuel : st_t -> Prims.int) = + fun projectee -> match projectee with | { seen; glb; fuel;_} -> fuel +type tc_goal = + { + g: FStar_Tactics_NamedView.term ; + head_fv: FStar_Reflection_Types.fv ; + c_se: FStar_Reflection_Types.sigelt FStar_Pervasives_Native.option ; + fundeps: Prims.int Prims.list FStar_Pervasives_Native.option ; + args_and_uvars: (FStar_Reflection_V2_Data.argv * Prims.bool) Prims.list } +let (__proj__Mktc_goal__item__g : tc_goal -> FStar_Tactics_NamedView.term) = + fun projectee -> + match projectee with + | { g; head_fv; c_se; fundeps; args_and_uvars;_} -> g +let (__proj__Mktc_goal__item__head_fv : tc_goal -> FStar_Reflection_Types.fv) + = + fun projectee -> + match projectee with + | { g; head_fv; c_se; fundeps; args_and_uvars;_} -> head_fv +let (__proj__Mktc_goal__item__c_se : + tc_goal -> FStar_Reflection_Types.sigelt FStar_Pervasives_Native.option) = + fun projectee -> + match projectee with + | { g; head_fv; c_se; fundeps; args_and_uvars;_} -> c_se +let (__proj__Mktc_goal__item__fundeps : + tc_goal -> Prims.int Prims.list FStar_Pervasives_Native.option) = + fun projectee -> + match projectee with + | { g; head_fv; c_se; fundeps; args_and_uvars;_} -> fundeps +let (__proj__Mktc_goal__item__args_and_uvars : + tc_goal -> (FStar_Reflection_V2_Data.argv * Prims.bool) Prims.list) = + fun projectee -> + match projectee with + | { g; head_fv; c_se; fundeps; args_and_uvars;_} -> args_and_uvars let (fv_eq : FStar_Reflection_Types.fv -> FStar_Reflection_Types.fv -> Prims.bool) = fun fv1 -> @@ -66,12 +111,12 @@ let rec (head_of : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (57)) (Prims.of_int (8)) (Prims.of_int (57)) + (Prims.of_int (86)) (Prims.of_int (8)) (Prims.of_int (86)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (57)) (Prims.of_int (2)) (Prims.of_int (61)) + (Prims.of_int (86)) (Prims.of_int (2)) (Prims.of_int (90)) (Prims.of_int (13))))) (Obj.magic (FStar_Tactics_NamedView.inspect t)) (fun uu___ -> @@ -103,12 +148,12 @@ let rec (res_typ : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (64)) (Prims.of_int (8)) (Prims.of_int (64)) + (Prims.of_int (93)) (Prims.of_int (8)) (Prims.of_int (93)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (64)) (Prims.of_int (2)) (Prims.of_int (70)) + (Prims.of_int (93)) (Prims.of_int (2)) (Prims.of_int (99)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_NamedView.inspect t)) (fun uu___ -> @@ -154,12 +199,12 @@ let rec (maybe_intros : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (85)) (Prims.of_int (10)) (Prims.of_int (85)) + (Prims.of_int (114)) (Prims.of_int (10)) (Prims.of_int (114)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (86)) (Prims.of_int (2)) (Prims.of_int (90)) + (Prims.of_int (115)) (Prims.of_int (2)) (Prims.of_int (119)) (Prims.of_int (11))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_goal ())) (fun uu___1 -> @@ -169,13 +214,13 @@ let rec (maybe_intros : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (86)) (Prims.of_int (8)) - (Prims.of_int (86)) (Prims.of_int (17))))) + (Prims.of_int (115)) (Prims.of_int (8)) + (Prims.of_int (115)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (86)) (Prims.of_int (2)) - (Prims.of_int (90)) (Prims.of_int (11))))) + (Prims.of_int (115)) (Prims.of_int (2)) + (Prims.of_int (119)) (Prims.of_int (11))))) (Obj.magic (FStar_Tactics_NamedView.inspect g)) (fun uu___1 -> (fun uu___1 -> @@ -188,17 +233,17 @@ let rec (maybe_intros : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (88)) + (Prims.of_int (117)) (Prims.of_int (4)) - (Prims.of_int (88)) + (Prims.of_int (117)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (89)) + (Prims.of_int (118)) (Prims.of_int (4)) - (Prims.of_int (89)) + (Prims.of_int (118)) (Prims.of_int (19))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -206,17 +251,17 @@ let rec (maybe_intros : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (88)) + (Prims.of_int (117)) (Prims.of_int (11)) - (Prims.of_int (88)) + (Prims.of_int (117)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (88)) + (Prims.of_int (117)) (Prims.of_int (4)) - (Prims.of_int (88)) + (Prims.of_int (117)) (Prims.of_int (21))))) (Obj.magic (FStar_Tactics_V2_Builtins.intro @@ -232,528 +277,436 @@ let rec (maybe_intros : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.repr (FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> ())))) uu___1))) uu___1) -let rec (tcresolve' : - FStar_Tactics_NamedView.term Prims.list -> - FStar_Reflection_Types.fv Prims.list -> - Prims.int -> (unit, unit) FStar_Tactics_Effect.tac_repr) +let (sigelt_name : + FStar_Reflection_Types.sigelt -> FStar_Reflection_Types.fv Prims.list) = + fun se -> + match FStar_Reflection_V2_Builtins.inspect_sigelt se with + | FStar_Reflection_V2_Data.Sg_Let (uu___, lbs) -> + (match lbs with + | lb::[] -> + [(FStar_Reflection_V2_Builtins.inspect_lb lb).FStar_Reflection_V2_Data.lb_fv] + | uu___1 -> []) + | FStar_Reflection_V2_Data.Sg_Val (nm, uu___, uu___1) -> + [FStar_Reflection_V2_Builtins.pack_fv nm] + | uu___ -> [] +let (unembed_int : + FStar_Tactics_NamedView.term -> + (Prims.int FStar_Pervasives_Native.option, unit) + FStar_Tactics_Effect.tac_repr) = - fun seen -> - fun glb -> - fun fuel -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (105)) (Prims.of_int (4)) - (Prims.of_int (106)) (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (107)) (Prims.of_int (4)) - (Prims.of_int (128)) (Prims.of_int (34))))) - (if fuel <= Prims.int_zero - then FStar_Tactics_Effect.raise NoInst - else FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> ())) - (fun uu___ -> - (fun uu___ -> - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (107)) (Prims.of_int (4)) - (Prims.of_int (107)) (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (109)) (Prims.of_int (4)) - (Prims.of_int (128)) (Prims.of_int (34))))) - (Obj.magic - (debug - (fun uu___1 -> - (fun uu___1 -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - Prims.strcat "fuel = " - (Prims.string_of_int fuel)))) - uu___1))) - (fun uu___1 -> - (fun uu___1 -> - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (109)) - (Prims.of_int (4)) - (Prims.of_int (109)) - (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (109)) - (Prims.of_int (19)) - (Prims.of_int (128)) - (Prims.of_int (34))))) - (Obj.magic (maybe_intros ())) - (fun uu___2 -> - (fun uu___2 -> - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (110)) - (Prims.of_int (12)) - (Prims.of_int (110)) - (Prims.of_int (23))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (113)) - (Prims.of_int (4)) - (Prims.of_int (128)) - (Prims.of_int (34))))) - (Obj.magic - (FStar_Tactics_V2_Derived.cur_goal - ())) - (fun uu___3 -> - (fun g -> - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (113)) - (Prims.of_int (4)) - (Prims.of_int (116)) - (Prims.of_int (5))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (118)) - (Prims.of_int (4)) - (Prims.of_int (128)) - (Prims.of_int (34))))) - (if - FStar_List_Tot_Base.existsb - (FStar_Reflection_V2_TermEq.term_eq - g) seen - then - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (114)) - (Prims.of_int (6)) - (Prims.of_int (114)) - (Prims.of_int (30))))) - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (115)) - (Prims.of_int (6)) - (Prims.of_int (115)) - (Prims.of_int (18))))) - (Obj.magic - ( - debug - (fun - uu___3 -> - (fun - uu___3 -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___4 -> - "loop"))) - uu___3))) - (fun uu___3 - -> - FStar_Tactics_Effect.raise - NoInst))) - else - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 - -> ())))) - (fun uu___3 -> - (fun uu___3 -> - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (118)) - (Prims.of_int (10)) - (Prims.of_int (118)) - (Prims.of_int (19))))) - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (118)) - (Prims.of_int (4)) - (Prims.of_int (128)) - (Prims.of_int (34))))) - (Obj.magic - ( - head_of g)) - (fun uu___4 - -> - (fun - uu___4 -> - match uu___4 - with - | - FStar_Pervasives_Native.None - -> - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (120)) - (Prims.of_int (6)) - (Prims.of_int (120)) - (Prims.of_int (61))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (121)) - (Prims.of_int (6)) - (Prims.of_int (121)) - (Prims.of_int (18))))) - (Obj.magic - (debug - (fun - uu___5 -> - (fun - uu___5 -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___6 -> - "goal does not look like a typeclass"))) - uu___5))) - (fun - uu___5 -> - FStar_Tactics_Effect.raise - NoInst)) - | - FStar_Pervasives_Native.Some - head_fv - -> - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (125)) - (Prims.of_int (17)) - (Prims.of_int (125)) - (Prims.of_int (26))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (126)) - (Prims.of_int (6)) - (Prims.of_int (128)) - (Prims.of_int (34))))) - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___5 -> - g :: seen)) - (fun - uu___5 -> - (fun - seen1 -> - Obj.magic - (FStar_Tactics_V2_Derived.or_else - (local - head_fv - seen1 glb - fuel) - (global - head_fv - seen1 glb - fuel))) - uu___5))) - uu___4))) - uu___3))) uu___3))) - uu___2))) uu___1))) uu___) -and (local : - FStar_Reflection_Types.fv -> - FStar_Tactics_NamedView.term Prims.list -> - FStar_Reflection_Types.fv Prims.list -> - Prims.int -> unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) + fun uu___ -> + (fun t -> + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun uu___ -> + match FStar_Reflection_V2_Builtins.inspect_ln t with + | FStar_Reflection_V2_Data.Tv_Const + (FStar_Reflection_V2_Data.C_Int i) -> + FStar_Pervasives_Native.Some i + | uu___1 -> FStar_Pervasives_Native.None))) uu___ +let rec unembed_list : + 'a . + (FStar_Tactics_NamedView.term -> + ('a FStar_Pervasives_Native.option, unit) + FStar_Tactics_Effect.tac_repr) + -> + FStar_Tactics_NamedView.term -> + ('a Prims.list FStar_Pervasives_Native.option, unit) + FStar_Tactics_Effect.tac_repr + = + fun u -> + fun t -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (138)) (Prims.of_int (8)) (Prims.of_int (138)) + (Prims.of_int (13))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (138)) (Prims.of_int (2)) (Prims.of_int (152)) + (Prims.of_int (8))))) + (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.hua t)) + (fun uu___ -> + (fun uu___ -> + match uu___ with + | FStar_Pervasives_Native.Some + (fv, uu___1, + (ty, FStar_Reflection_V2_Data.Q_Implicit)::(hd, + FStar_Reflection_V2_Data.Q_Explicit):: + (tl, FStar_Reflection_V2_Data.Q_Explicit)::[]) + -> + Obj.magic + (Obj.repr + (if + (FStar_Reflection_V2_Builtins.implode_qn + (FStar_Reflection_V2_Builtins.inspect_fv fv)) + = "Prims.Cons" + then + Obj.repr + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (141)) + (Prims.of_int (12)) + (Prims.of_int (141)) + (Prims.of_int (35))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (141)) + (Prims.of_int (6)) + (Prims.of_int (143)) + (Prims.of_int (17))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (141)) + (Prims.of_int (12)) + (Prims.of_int (141)) + (Prims.of_int (16))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (141)) + (Prims.of_int (12)) + (Prims.of_int (141)) + (Prims.of_int (35))))) + (Obj.magic (u hd)) + (fun uu___2 -> + (fun uu___2 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (141)) + (Prims.of_int (18)) + (Prims.of_int (141)) + (Prims.of_int (35))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (141)) + (Prims.of_int (12)) + (Prims.of_int (141)) + (Prims.of_int (35))))) + (Obj.magic + (unembed_list u tl)) + (fun uu___3 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___4 -> + (uu___2, uu___3))))) + uu___2))) + (fun uu___2 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___3 -> + match uu___2 with + | (FStar_Pervasives_Native.Some hd1, + FStar_Pervasives_Native.Some tl1) + -> + FStar_Pervasives_Native.Some (hd1 + :: tl1) + | uu___4 -> + FStar_Pervasives_Native.None))) + else + Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___3 -> FStar_Pervasives_Native.None)))) + | FStar_Pervasives_Native.Some + (fv, uu___1, (ty, FStar_Reflection_V2_Data.Q_Implicit)::[]) + -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___2 -> + if + (FStar_Reflection_V2_Builtins.implode_qn + (FStar_Reflection_V2_Builtins.inspect_fv fv)) + = "Prims.Nil" + then FStar_Pervasives_Native.Some [] + else FStar_Pervasives_Native.None))) + | uu___1 -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___2 -> FStar_Pervasives_Native.None)))) + uu___) +let (extract_fundeps : + FStar_Reflection_Types.sigelt -> + (Prims.int Prims.list FStar_Pervasives_Native.option, unit) + FStar_Tactics_Effect.tac_repr) + = + fun se -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (155)) (Prims.of_int (14)) (Prims.of_int (155)) + (Prims.of_int (29))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (155)) (Prims.of_int (32)) (Prims.of_int (169)) + (Prims.of_int (13))))) + (FStar_Tactics_Effect.lift_div_tac + (fun uu___ -> FStar_Reflection_V2_Builtins.sigelt_attrs se)) + (fun uu___ -> + (fun attrs -> + let rec aux uu___ = + (fun attrs1 -> + match attrs1 with + | [] -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___ -> FStar_Pervasives_Native.None))) + | attr::attrs' -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (160)) + (Prims.of_int (12)) + (Prims.of_int (160)) + (Prims.of_int (28))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (160)) + (Prims.of_int (12)) + (Prims.of_int (160)) + (Prims.of_int (28))))) + (Obj.magic + (FStar_Tactics_V2_SyntaxHelpers.collect_app + attr)) + (fun uu___ -> + (fun uu___ -> + match uu___ with + | (hd, + (a0, + FStar_Reflection_V2_Data.Q_Explicit)::[]) + -> + if + FStar_Reflection_V2_TermEq.term_eq + hd + (FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + ["FStar"; + "Tactics"; + "Typeclasses"; + "fundeps"]))) + then + Obj.magic + (unembed_list unembed_int a0) + else Obj.magic (aux attrs') + | uu___1 -> Obj.magic (aux attrs')) uu___)))) + uu___ in + Obj.magic (aux attrs)) uu___) +let (trywith : + st_t -> + tc_goal -> + FStar_Tactics_NamedView.term -> + FStar_Tactics_NamedView.term -> + (st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) -> + (unit, unit) FStar_Tactics_Effect.tac_repr) = - fun head_fv -> - fun seen -> - fun glb -> - fun fuel -> - fun uu___ -> + fun st -> + fun g -> + fun t -> + fun typ -> + fun k -> FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (131)) (Prims.of_int (13)) - (Prims.of_int (131)) (Prims.of_int (37))))) + (Prims.of_int (174)) (Prims.of_int (26)) + (Prims.of_int (174)) (Prims.of_int (122))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (132)) (Prims.of_int (4)) - (Prims.of_int (134)) (Prims.of_int (12))))) + (Prims.of_int (177)) (Prims.of_int (4)) + (Prims.of_int (199)) (Prims.of_int (13))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (131)) (Prims.of_int (25)) - (Prims.of_int (131)) (Prims.of_int (37))))) + (Prims.of_int (174)) (Prims.of_int (26)) + (Prims.of_int (174)) (Prims.of_int (102))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (131)) (Prims.of_int (13)) - (Prims.of_int (131)) (Prims.of_int (37))))) - (Obj.magic (FStar_Tactics_V2_Derived.cur_env ())) - (fun uu___1 -> + (Prims.of_int (174)) (Prims.of_int (26)) + (Prims.of_int (174)) (Prims.of_int (122))))) + (Obj.magic + (FStar_Tactics_Util.mapi + (fun uu___1 -> + fun uu___ -> + (fun i -> + fun uu___ -> + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun uu___1 -> + match uu___ with + | (uu___2, b) -> + if b then [i] else []))) + uu___1 uu___) g.args_and_uvars)) + (fun uu___ -> FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - FStar_Reflection_V2_Builtins.vars_of_env uu___1)))) - (fun uu___1 -> - (fun bs -> + (fun uu___1 -> FStar_List_Tot_Base.flatten uu___)))) + (fun uu___ -> + (fun unresolved_args -> Obj.magic - (first - (fun b -> - trywith head_fv seen glb fuel - (FStar_Tactics_NamedView.pack - (FStar_Tactics_NamedView.Tv_Var - (FStar_Tactics_V2_SyntaxCoercions.binding_to_namedv - b))) b.FStar_Reflection_V2_Data.sort3) - bs)) uu___1) -and (global : - FStar_Reflection_Types.fv -> - FStar_Tactics_NamedView.term Prims.list -> - FStar_Reflection_Types.fv Prims.list -> - Prims.int -> unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) - = - fun head_fv -> - fun seen -> - fun glb -> - fun fuel -> - fun uu___ -> - first - (fun fv -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (138)) (Prims.of_int (24)) - (Prims.of_int (138)) (Prims.of_int (58))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (139)) (Prims.of_int (14)) - (Prims.of_int (139)) (Prims.of_int (67))))) - (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (138)) (Prims.of_int (27)) - (Prims.of_int (138)) (Prims.of_int (38))))) + (Prims.of_int (177)) (Prims.of_int (10)) + (Prims.of_int (177)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (138)) (Prims.of_int (24)) - (Prims.of_int (138)) (Prims.of_int (58))))) - (Obj.magic (FStar_Tactics_V2_Derived.cur_env ())) - (fun uu___1 -> - (fun uu___1 -> - Obj.magic - (FStar_Tactics_V2_Builtins.tc uu___1 - (FStar_Tactics_NamedView.pack - (FStar_Tactics_NamedView.Tv_FVar fv)))) - uu___1))) - (fun uu___1 -> - (fun typ -> - Obj.magic - (trywith head_fv seen glb fuel - (FStar_Tactics_NamedView.pack - (FStar_Tactics_NamedView.Tv_FVar fv)) typ)) - uu___1)) glb -and (trywith : - FStar_Reflection_Types.fv -> - FStar_Tactics_NamedView.term Prims.list -> - FStar_Reflection_Types.fv Prims.list -> - Prims.int -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term -> - (unit, unit) FStar_Tactics_Effect.tac_repr) - = - fun head_fv -> - fun seen -> - fun glb -> - fun fuel -> - fun t -> - fun typ -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (144)) (Prims.of_int (10)) - (Prims.of_int (144)) (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (144)) (Prims.of_int (4)) - (Prims.of_int (158)) (Prims.of_int (7))))) - (Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (144)) (Prims.of_int (18)) - (Prims.of_int (144)) (Prims.of_int (31))))) - (FStar_Sealed.seal + (Prims.of_int (177)) (Prims.of_int (4)) + (Prims.of_int (199)) (Prims.of_int (13))))) (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (144)) (Prims.of_int (10)) - (Prims.of_int (144)) (Prims.of_int (31))))) - (Obj.magic (res_typ typ)) - (fun uu___ -> - (fun uu___ -> Obj.magic (head_of uu___)) uu___))) - (fun uu___ -> - (fun uu___ -> - match uu___ with - | FStar_Pervasives_Native.None -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (146)) - (Prims.of_int (6)) - (Prims.of_int (146)) - (Prims.of_int (104))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (147)) - (Prims.of_int (6)) - (Prims.of_int (147)) - (Prims.of_int (18))))) + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal (Obj.magic - (debug - (fun uu___1 -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (146)) - (Prims.of_int (53)) - (Prims.of_int (146)) - (Prims.of_int (103))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "prims.fst" - (Prims.of_int (590)) - (Prims.of_int (19)) - (Prims.of_int (590)) - (Prims.of_int (31))))) - (Obj.magic - (FStar_Tactics_Effect.tac_bind + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (177)) + (Prims.of_int (18)) + (Prims.of_int (177)) + (Prims.of_int (31))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (177)) + (Prims.of_int (10)) + (Prims.of_int (177)) + (Prims.of_int (31))))) + (Obj.magic (res_typ typ)) + (fun uu___ -> + (fun uu___ -> Obj.magic (head_of uu___)) + uu___))) + (fun uu___ -> + (fun uu___ -> + match uu___ with + | FStar_Pervasives_Native.None -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (179)) + (Prims.of_int (6)) + (Prims.of_int (179)) + (Prims.of_int (104))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (180)) + (Prims.of_int (6)) + (Prims.of_int (180)) + (Prims.of_int (18))))) + (Obj.magic + (debug + (fun uu___1 -> + FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (146)) + (Prims.of_int (179)) (Prims.of_int (53)) - (Prims.of_int (146)) - (Prims.of_int (69))))) + (Prims.of_int (179)) + (Prims.of_int (103))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (146)) - (Prims.of_int (53)) - (Prims.of_int (146)) - (Prims.of_int (103))))) + "prims.fst" + (Prims.of_int (590)) + (Prims.of_int (19)) + (Prims.of_int (590)) + (Prims.of_int (31))))) (Obj.magic - (FStar_Tactics_V2_Builtins.term_to_string - t)) - (fun uu___2 -> - (fun uu___2 -> - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (179)) + (Prims.of_int (53)) + (Prims.of_int (179)) + (Prims.of_int (69))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (179)) + (Prims.of_int (53)) + (Prims.of_int (179)) + (Prims.of_int (103))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.term_to_string + t)) + (fun uu___2 -> + (fun uu___2 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind ( - FStar_Range.mk_range + FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (146)) + (Prims.of_int (179)) (Prims.of_int (72)) - (Prims.of_int (146)) + (Prims.of_int (179)) (Prims.of_int (103))))) - (FStar_Sealed.seal - (Obj.magic ( - FStar_Range.mk_range + FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "prims.fst" (Prims.of_int (590)) (Prims.of_int (19)) (Prims.of_int (590)) (Prims.of_int (31))))) - (Obj.magic - (FStar_Tactics_Effect.tac_bind ( - FStar_Sealed.seal + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (146)) + (Prims.of_int (179)) (Prims.of_int (85)) - (Prims.of_int (146)) + (Prims.of_int (179)) (Prims.of_int (103))))) - ( - FStar_Sealed.seal + (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "prims.fst" @@ -761,12 +714,10 @@ and (trywith : (Prims.of_int (19)) (Prims.of_int (590)) (Prims.of_int (31))))) - ( - Obj.magic + (Obj.magic (FStar_Tactics_V2_Builtins.term_to_string typ)) - ( - fun + (fun uu___3 -> FStar_Tactics_Effect.lift_div_tac (fun @@ -774,152 +725,1138 @@ and (trywith : Prims.strcat " typ=" uu___3)))) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun + ( + fun + uu___3 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___4 -> Prims.strcat uu___2 uu___3)))) - uu___2))) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - Prims.strcat - "no head for typ of this? " - uu___2))))) - (fun uu___1 -> - FStar_Tactics_Effect.raise NoInst))) - | FStar_Pervasives_Native.Some fv' -> - Obj.magic - (Obj.repr - (if fv_eq fv' head_fv - then - Obj.repr + uu___2))) + (fun uu___2 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___3 -> + Prims.strcat + "no head for typ of this? " + uu___2))))) + (fun uu___1 -> + FStar_Tactics_Effect.raise NoInst)) + | FStar_Pervasives_Native.Some fv' -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (182)) + (Prims.of_int (6)) + (Prims.of_int (183)) + (Prims.of_int (20))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (184)) + (Prims.of_int (6)) + (Prims.of_int (199)) + (Prims.of_int (13))))) + (if + Prims.op_Negation + (fv_eq fv' g.head_fv) + then + FStar_Tactics_Effect.raise NoInst + else + FStar_Tactics_Effect.lift_div_tac + (fun uu___2 -> ())) + (fun uu___1 -> + (fun uu___1 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (184)) + (Prims.of_int (6)) + (Prims.of_int (184)) + (Prims.of_int (82))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (185)) + (Prims.of_int (6)) + (Prims.of_int (199)) + (Prims.of_int (13))))) + (Obj.magic + (debug + (fun uu___2 -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + ( + FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (184)) + (Prims.of_int (65)) + (Prims.of_int (184)) + (Prims.of_int (81))))) + (FStar_Sealed.seal + (Obj.magic + ( + FStar_Range.mk_range + "prims.fst" + (Prims.of_int (590)) + (Prims.of_int (19)) + (Prims.of_int (590)) + (Prims.of_int (31))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.term_to_string + t)) + (fun uu___3 -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___4 -> + Prims.strcat + "Trying to apply hypothesis/instance: " + uu___3))))) + (fun uu___2 -> + (fun uu___2 -> + Obj.magic + (FStar_Tactics_V2_Derived.seq + (fun uu___3 -> + (fun uu___3 + -> + if + (Prims.uu___is_Cons + unresolved_args) + && + (FStar_Pervasives_Native.uu___is_None + g.fundeps) + then + Obj.magic + (Obj.repr + (FStar_Tactics_V2_Derived.fail + "Will not continue as there are unresolved args (and no fundeps)")) + else + Obj.magic + (Obj.repr + (if + (Prims.uu___is_Cons + unresolved_args) + && + (FStar_Pervasives_Native.uu___is_Some + g.fundeps) + then + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (189)) + (Prims.of_int (29)) + (Prims.of_int (189)) + (Prims.of_int (38))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (188)) + (Prims.of_int (62)) + (Prims.of_int (193)) + (Prims.of_int (9))))) + (FStar_Tactics_Effect.lift_div_tac + (fun + uu___5 -> + g.fundeps)) + (fun + uu___5 -> + (fun + uu___5 -> + match uu___5 + with + | + FStar_Pervasives_Native.Some + fundeps + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (190)) + (Prims.of_int (10)) + (Prims.of_int (190)) + (Prims.of_int (46))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (190)) + (Prims.of_int (47)) + (Prims.of_int (192)) + (Prims.of_int (54))))) + (Obj.magic + (debug + (fun + uu___6 -> + (fun + uu___6 -> + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun + uu___7 -> + "checking fundeps"))) + uu___6))) + (fun + uu___6 -> + (fun + uu___6 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (191)) + (Prims.of_int (25)) + (Prims.of_int (191)) + (Prims.of_int (91))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (192)) + (Prims.of_int (10)) + (Prims.of_int (192)) + (Prims.of_int (54))))) + (FStar_Tactics_Effect.lift_div_tac + (fun + uu___7 -> + FStar_List_Tot_Base.for_all + (fun i -> + FStar_List_Tot_Base.mem + i fundeps) + unresolved_args)) + (fun + uu___7 -> + (fun + all_good + -> + if + all_good + then + Obj.magic + (Obj.repr + (FStar_Tactics_V2_Derived.apply + t)) + else + Obj.magic + (Obj.repr + (FStar_Tactics_V2_Derived.fail + "fundeps"))) + uu___7))) + uu___6))) + uu___5) + else + FStar_Tactics_V2_Derived.apply_noinst + t))) + uu___3) + (fun uu___3 -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (197)) + (Prims.of_int (8)) + (Prims.of_int (197)) + (Prims.of_int (67))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (197)) + (Prims.of_int (68)) + (Prims.of_int (199)) + (Prims.of_int (12))))) + (Obj.magic + (debug + (fun + uu___4 -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (197)) + (Prims.of_int (25)) + (Prims.of_int (197)) + (Prims.of_int (36))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (197)) + (Prims.of_int (38)) + (Prims.of_int (197)) + (Prims.of_int (66))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.dump + "next")) + (fun + uu___5 -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___6 -> + "apply seems to have worked"))))) + (fun + uu___4 -> + (fun + uu___4 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (198)) + (Prims.of_int (19)) + (Prims.of_int (198)) + (Prims.of_int (45))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (199)) + (Prims.of_int (8)) + (Prims.of_int (199)) + (Prims.of_int (12))))) + (FStar_Tactics_Effect.lift_div_tac + (fun + uu___5 -> + { + seen = + (st.seen); + glb = + (st.glb); + fuel = + (st.fuel + - + Prims.int_one) + })) + (fun + uu___5 -> + (fun st1 + -> + Obj.magic + (k st1)) + uu___5))) + uu___4)))) + uu___2))) uu___1))) + uu___))) uu___) +let (local : + st_t -> + tc_goal -> + (st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) -> + unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) + = + fun st -> + fun g -> + fun k -> + fun uu___ -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (202)) (Prims.of_int (4)) + (Prims.of_int (202)) (Prims.of_int (59))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (202)) (Prims.of_int (60)) + (Prims.of_int (206)) (Prims.of_int (12))))) + (Obj.magic + (debug + (fun uu___1 -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (202)) (Prims.of_int (40)) + (Prims.of_int (202)) (Prims.of_int (58))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "prims.fst" + (Prims.of_int (590)) (Prims.of_int (19)) + (Prims.of_int (590)) (Prims.of_int (31))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.term_to_string g.g)) + (fun uu___2 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___3 -> + Prims.strcat "local, goal = " uu___2))))) + (fun uu___1 -> + (fun uu___1 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (203)) (Prims.of_int (13)) + (Prims.of_int (203)) (Prims.of_int (37))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (204)) (Prims.of_int (4)) + (Prims.of_int (206)) (Prims.of_int (12))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (203)) + (Prims.of_int (25)) + (Prims.of_int (203)) + (Prims.of_int (37))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (203)) + (Prims.of_int (13)) + (Prims.of_int (203)) + (Prims.of_int (37))))) + (Obj.magic (FStar_Tactics_V2_Derived.cur_env ())) + (fun uu___2 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___3 -> + FStar_Reflection_V2_Builtins.vars_of_env + uu___2)))) + (fun uu___2 -> + (fun bs -> + Obj.magic + (first + (fun b -> + trywith st g + (FStar_Tactics_NamedView.pack + (FStar_Tactics_NamedView.Tv_Var + (FStar_Tactics_V2_SyntaxCoercions.binding_to_namedv + b))) + b.FStar_Reflection_V2_Data.sort3 k) bs)) + uu___2))) uu___1) +let (global : + st_t -> + tc_goal -> + (st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) -> + unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) + = + fun st -> + fun g -> + fun k -> + fun uu___ -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (209)) (Prims.of_int (4)) + (Prims.of_int (209)) (Prims.of_int (60))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (210)) (Prims.of_int (4)) + (Prims.of_int (213)) (Prims.of_int (16))))) + (Obj.magic + (debug + (fun uu___1 -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (209)) (Prims.of_int (41)) + (Prims.of_int (209)) (Prims.of_int (59))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "prims.fst" + (Prims.of_int (590)) (Prims.of_int (19)) + (Prims.of_int (590)) (Prims.of_int (31))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.term_to_string g.g)) + (fun uu___2 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___3 -> + Prims.strcat "global, goal = " uu___2))))) + (fun uu___1 -> + (fun uu___1 -> + Obj.magic + (first + (fun uu___2 -> + match uu___2 with + | (se, fv) -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (211)) + (Prims.of_int (24)) + (Prims.of_int (211)) + (Prims.of_int (58))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (212)) + (Prims.of_int (14)) + (Prims.of_int (212)) + (Prims.of_int (52))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (211)) + (Prims.of_int (27)) + (Prims.of_int (211)) + (Prims.of_int (38))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (211)) + (Prims.of_int (24)) + (Prims.of_int (211)) + (Prims.of_int (58))))) + (Obj.magic + (FStar_Tactics_V2_Derived.cur_env ())) + (fun uu___3 -> + (fun uu___3 -> + Obj.magic + (FStar_Tactics_V2_Builtins.tc + uu___3 + (FStar_Tactics_NamedView.pack + (FStar_Tactics_NamedView.Tv_FVar + fv)))) uu___3))) + (fun uu___3 -> + (fun typ -> + Obj.magic + (trywith st g + (FStar_Tactics_NamedView.pack + (FStar_Tactics_NamedView.Tv_FVar + fv)) typ k)) uu___3)) + st.glb)) uu___1) +exception Next +let (uu___is_Next : Prims.exn -> Prims.bool) = + fun projectee -> match projectee with | Next -> true | uu___ -> false +let (try_trivial : + st_t -> + tc_goal -> + (st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) -> + unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) + = + fun st -> + fun g -> + fun k -> + fun uu___ -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (217)) (Prims.of_int (8)) + (Prims.of_int (217)) (Prims.of_int (11))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (217)) (Prims.of_int (2)) + (Prims.of_int (222)) (Prims.of_int (19))))) + (Obj.magic (FStar_Tactics_NamedView.inspect g.g)) + (fun uu___1 -> + (fun uu___1 -> + match uu___1 with + | FStar_Tactics_NamedView.Tv_FVar fv -> + Obj.magic + (Obj.repr + (if + (FStar_Reflection_V2_Builtins.implode_qn + (FStar_Reflection_V2_Builtins.inspect_fv fv)) + = "Prims.unit" + then + Obj.repr + (FStar_Tactics_V2_Derived.exact + (FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_Const + FStar_Reflection_V2_Data.C_Unit))) + else Obj.repr (FStar_Tactics_Effect.raise Next))) + | uu___2 -> + Obj.magic (Obj.repr (FStar_Tactics_Effect.raise Next))) + uu___1) +let op_Less_Bar_Greater : + 'a . + (unit -> ('a, unit) FStar_Tactics_Effect.tac_repr) -> + (unit -> ('a, unit) FStar_Tactics_Effect.tac_repr) -> + unit -> ('a, unit) FStar_Tactics_Effect.tac_repr + = + fun t1 -> + fun t2 -> + fun uu___ -> + FStar_Tactics_V2_Derived.try_with + (fun uu___1 -> match () with | () -> t1 ()) (fun uu___1 -> t2 ()) +let rec (tcresolve' : st_t -> (unit, unit) FStar_Tactics_Effect.tac_repr) = + fun st -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (234)) (Prims.of_int (4)) (Prims.of_int (235)) + (Prims.of_int (18))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (236)) (Prims.of_int (4)) (Prims.of_int (265)) + (Prims.of_int (33))))) + (if st.fuel <= Prims.int_zero + then FStar_Tactics_Effect.raise NoInst + else FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> ())) + (fun uu___ -> + (fun uu___ -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (236)) (Prims.of_int (4)) + (Prims.of_int (236)) (Prims.of_int (55))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (238)) (Prims.of_int (4)) + (Prims.of_int (265)) (Prims.of_int (33))))) + (Obj.magic + (debug + (fun uu___1 -> + (fun uu___1 -> + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun uu___2 -> + Prims.strcat "fuel = " + (Prims.string_of_int st.fuel)))) + uu___1))) + (fun uu___1 -> + (fun uu___1 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (238)) (Prims.of_int (4)) + (Prims.of_int (238)) (Prims.of_int (18))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (238)) (Prims.of_int (19)) + (Prims.of_int (265)) (Prims.of_int (33))))) + (Obj.magic (maybe_intros ())) + (fun uu___2 -> + (fun uu___2 -> + Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (151)) - (Prims.of_int (8)) - (Prims.of_int (151)) - (Prims.of_int (84))))) + (Prims.of_int (239)) + (Prims.of_int (12)) + (Prims.of_int (239)) + (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (152)) - (Prims.of_int (8)) - (Prims.of_int (154)) - (Prims.of_int (39))))) + (Prims.of_int (242)) + (Prims.of_int (4)) + (Prims.of_int (265)) + (Prims.of_int (33))))) (Obj.magic - (debug - (fun uu___1 -> - FStar_Tactics_Effect.tac_bind + (FStar_Tactics_V2_Derived.cur_goal + ())) + (fun uu___3 -> + (fun g -> + Obj.magic + (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (151)) - (Prims.of_int (67)) - (Prims.of_int (151)) - (Prims.of_int (83))))) + (Prims.of_int (242)) + (Prims.of_int (4)) + (Prims.of_int (245)) + (Prims.of_int (5))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range - "prims.fst" - (Prims.of_int (590)) - (Prims.of_int (19)) - (Prims.of_int (590)) - (Prims.of_int (31))))) - (Obj.magic - (FStar_Tactics_V2_Builtins.term_to_string - t)) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - Prims.strcat - "Trying to apply hypothesis/instance: " - uu___2))))) - (fun uu___1 -> - (fun uu___1 -> - Obj.magic - (FStar_Tactics_V2_Derived.seq - (fun uu___2 -> - FStar_Tactics_V2_Derived.apply_noinst - t) - (fun uu___2 -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (153)) - (Prims.of_int (10)) - (Prims.of_int (153)) - (Prims.of_int (69))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (154)) - (Prims.of_int (10)) - (Prims.of_int (154)) - (Prims.of_int (38))))) - (Obj.magic - (debug + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (247)) + (Prims.of_int (4)) + (Prims.of_int (265)) + (Prims.of_int (33))))) + (if + FStar_List_Tot_Base.existsb + (FStar_Reflection_V2_TermEq.term_eq + g) st.seen + then + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (243)) + (Prims.of_int (6)) + (Prims.of_int (243)) + (Prims.of_int (30))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (244)) + (Prims.of_int (6)) + (Prims.of_int (244)) + (Prims.of_int (18))))) + (Obj.magic + (debug + (fun + uu___3 -> + (fun + uu___3 -> + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun + uu___4 -> + "loop"))) + uu___3))) (fun uu___3 -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal + FStar_Tactics_Effect.raise + NoInst))) + else + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___4 -> + ())))) + (fun uu___3 -> + (fun uu___3 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (247)) + (Prims.of_int (10)) + (Prims.of_int (247)) + (Prims.of_int (15))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (247)) + (Prims.of_int (4)) + (Prims.of_int (265)) + (Prims.of_int (33))))) + (Obj.magic + (FStar_Tactics_V2_SyntaxHelpers.hua + g)) + (fun uu___4 -> + (fun uu___4 + -> + match uu___4 + with + | + FStar_Pervasives_Native.None + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (249)) + (Prims.of_int (6)) + (Prims.of_int (249)) + (Prims.of_int (61))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (250)) + (Prims.of_int (6)) + (Prims.of_int (250)) + (Prims.of_int (18))))) + (Obj.magic + (debug + (fun + uu___5 -> + (fun + uu___5 -> + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun + uu___6 -> + "Goal does not look like a typeclass"))) + uu___5))) + (fun + uu___5 -> + FStar_Tactics_Effect.raise + NoInst)) + | + FStar_Pervasives_Native.Some + (head_fv, + us, args) + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (153)) - (Prims.of_int (27)) - (Prims.of_int (153)) - (Prims.of_int (38))))) - (FStar_Sealed.seal + (Prims.of_int (254)) + (Prims.of_int (17)) + (Prims.of_int (254)) + (Prims.of_int (61))))) + (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (153)) - (Prims.of_int (40)) - (Prims.of_int (153)) - (Prims.of_int (68))))) - (Obj.magic - (FStar_Tactics_V2_Builtins.dump - "next")) - (fun uu___4 + (Prims.of_int (254)) + (Prims.of_int (64)) + (Prims.of_int (265)) + (Prims.of_int (33))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (254)) + (Prims.of_int (28)) + (Prims.of_int (254)) + (Prims.of_int (40))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (254)) + (Prims.of_int (17)) + (Prims.of_int (254)) + (Prims.of_int (61))))) + (Obj.magic + (FStar_Tactics_V2_Derived.cur_env + ())) + (fun + uu___5 -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___6 -> + FStar_Reflection_V2_Builtins.lookup_typ + uu___5 + (FStar_Reflection_V2_Builtins.inspect_fv + head_fv))))) + (fun + uu___5 -> + (fun c_se + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (255)) + (Prims.of_int (20)) + (Prims.of_int (257)) + (Prims.of_int (39))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (258)) + (Prims.of_int (8)) + (Prims.of_int (265)) + (Prims.of_int (33))))) + (match c_se + with + | + FStar_Pervasives_Native.None + -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun + uu___5 -> + FStar_Pervasives_Native.None))) + | + FStar_Pervasives_Native.Some + se -> + Obj.magic + (Obj.repr + (extract_fundeps + se))) + (fun + uu___5 -> + (fun + fundeps -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (260)) + (Prims.of_int (27)) + (Prims.of_int (260)) + (Prims.of_int (89))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (260)) + (Prims.of_int (92)) + (Prims.of_int (265)) + (Prims.of_int (33))))) + (Obj.magic + (FStar_Tactics_Util.map + (fun + uu___5 -> + match uu___5 + with + | + (a, q) -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (260)) + (Prims.of_int (67)) + (Prims.of_int (260)) + (Prims.of_int (88))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (260)) + (Prims.of_int (59)) + (Prims.of_int (260)) + (Prims.of_int (88))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (260)) + (Prims.of_int (73)) + (Prims.of_int (260)) + (Prims.of_int (88))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (260)) + (Prims.of_int (67)) + (Prims.of_int (260)) + (Prims.of_int (88))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.free_uvars + a)) + (fun + uu___6 -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___7 -> + Prims.uu___is_Cons + uu___6)))) + (fun + uu___6 -> FStar_Tactics_Effect.lift_div_tac (fun + uu___7 -> + ((a, q), + uu___6)))) + args)) + (fun uu___5 -> - "apply seems to have worked"))))) - (fun uu___3 -> - (fun uu___3 -> - Obj.magic - (tcresolve' - seen glb - (fuel - - Prims.int_one))) - uu___3)))) uu___1)) - else - Obj.repr - (FStar_Tactics_Effect.raise NoInst)))) - uu___) + (fun + args_and_uvars + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (261)) + (Prims.of_int (17)) + (Prims.of_int (261)) + (Prims.of_int (44))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (261)) + (Prims.of_int (49)) + (Prims.of_int (265)) + (Prims.of_int (33))))) + (FStar_Tactics_Effect.lift_div_tac + (fun + uu___5 -> + { + seen = (g + :: + (st.seen)); + glb = + (st.glb); + fuel = + (st.fuel) + })) + (fun + uu___5 -> + (fun st1 + -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (262)) + (Prims.of_int (16)) + (Prims.of_int (262)) + (Prims.of_int (57))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (263)) + (Prims.of_int (6)) + (Prims.of_int (265)) + (Prims.of_int (33))))) + (FStar_Tactics_Effect.lift_div_tac + (fun + uu___5 -> + { + g; + head_fv; + c_se; + fundeps; + args_and_uvars + })) + (fun + uu___5 -> + (fun g1 + -> + Obj.magic + (op_Less_Bar_Greater + (op_Less_Bar_Greater + (try_trivial + st1 g1 + tcresolve') + (local + st1 g1 + tcresolve')) + (global + st1 g1 + tcresolve') + ())) + uu___5))) + uu___5))) + uu___5))) + uu___5))) + uu___5))) + uu___4))) + uu___3))) uu___3))) + uu___2))) uu___1))) uu___) +let rec concatMap : + 'a 'b . + ('a -> ('b Prims.list, unit) FStar_Tactics_Effect.tac_repr) -> + 'a Prims.list -> ('b Prims.list, unit) FStar_Tactics_Effect.tac_repr + = + fun uu___1 -> + fun uu___ -> + (fun f -> + fun l -> + match l with + | [] -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> []))) + | x::xs -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (270)) (Prims.of_int (13)) + (Prims.of_int (270)) (Prims.of_int (16))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (270)) (Prims.of_int (13)) + (Prims.of_int (270)) (Prims.of_int (33))))) + (Obj.magic (f x)) + (fun uu___ -> + (fun uu___ -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (270)) + (Prims.of_int (19)) + (Prims.of_int (270)) + (Prims.of_int (33))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (270)) + (Prims.of_int (13)) + (Prims.of_int (270)) + (Prims.of_int (33))))) + (Obj.magic (concatMap f xs)) + (fun uu___1 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___2 -> (op_At ()) uu___ uu___1)))) + uu___)))) uu___1 uu___ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (162)) (Prims.of_int (4)) (Prims.of_int (162)) + (Prims.of_int (275)) (Prims.of_int (4)) (Prims.of_int (275)) (Prims.of_int (54))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (162)) (Prims.of_int (55)) (Prims.of_int (186)) + (Prims.of_int (275)) (Prims.of_int (55)) (Prims.of_int (308)) (Prims.of_int (18))))) (Obj.magic (debug @@ -928,13 +1865,13 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (162)) (Prims.of_int (21)) - (Prims.of_int (162)) (Prims.of_int (28))))) + (Prims.of_int (275)) (Prims.of_int (21)) + (Prims.of_int (275)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (162)) (Prims.of_int (30)) - (Prims.of_int (162)) (Prims.of_int (53))))) + (Prims.of_int (275)) (Prims.of_int (30)) + (Prims.of_int (275)) (Prims.of_int (53))))) (Obj.magic (FStar_Tactics_V2_Builtins.dump "")) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -946,13 +1883,13 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (167)) (Prims.of_int (12)) - (Prims.of_int (167)) (Prims.of_int (26))))) + (Prims.of_int (276)) (Prims.of_int (12)) + (Prims.of_int (276)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (168)) (Prims.of_int (4)) - (Prims.of_int (186)) (Prims.of_int (18))))) + (Prims.of_int (277)) (Prims.of_int (4)) + (Prims.of_int (308)) (Prims.of_int (18))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_witness ())) (fun uu___2 -> (fun w -> @@ -962,15 +1899,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (168)) (Prims.of_int (4)) - (Prims.of_int (168)) (Prims.of_int (19))))) + (Prims.of_int (277)) (Prims.of_int (4)) + (Prims.of_int (277)) (Prims.of_int (29))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (168)) (Prims.of_int (20)) - (Prims.of_int (186)) (Prims.of_int (18))))) - (Obj.magic (maybe_intros ())) + (Prims.of_int (280)) (Prims.of_int (4)) + (Prims.of_int (308)) (Prims.of_int (18))))) + (Obj.magic + (FStar_Tactics_V2_Builtins.set_dump_on_failure + false)) (fun uu___2 -> (fun uu___2 -> Obj.magic @@ -979,93 +1918,187 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (173)) - (Prims.of_int (14)) - (Prims.of_int (173)) - (Prims.of_int (52))))) + (Prims.of_int (280)) + (Prims.of_int (4)) + (Prims.of_int (280)) + (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (174)) - (Prims.of_int (4)) - (Prims.of_int (186)) + (Prims.of_int (280)) + (Prims.of_int (20)) + (Prims.of_int (308)) (Prims.of_int (18))))) - (Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (173)) - (Prims.of_int (40)) - (Prims.of_int (173)) - (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (173)) - (Prims.of_int (14)) - (Prims.of_int (173)) - (Prims.of_int (52))))) - (Obj.magic - (FStar_Tactics_V2_Derived.cur_env - ())) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - FStar_Reflection_V2_Builtins.lookup_attr - (FStar_Reflection_V2_Builtins.pack_ln - (FStar_Reflection_V2_Data.Tv_FVar - (FStar_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Typeclasses"; - "tcinstance"]))) - uu___3)))) + (Obj.magic (maybe_intros ())) (fun uu___3 -> - (fun glb -> + (fun uu___3 -> Obj.magic - (FStar_Tactics_V2_Derived.try_with - (fun uu___3 -> - match () with - | () -> - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (285)) + (Prims.of_int (14)) + (Prims.of_int (285)) + (Prims.of_int (56))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (285)) + (Prims.of_int (59)) + (Prims.of_int (308)) + (Prims.of_int (18))))) + (Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (285)) + (Prims.of_int (44)) + (Prims.of_int (285)) + (Prims.of_int (56))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (285)) + (Prims.of_int (14)) + (Prims.of_int (285)) + (Prims.of_int (56))))) + (Obj.magic + (FStar_Tactics_V2_Derived.cur_env + ())) + (fun uu___4 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___5 -> + FStar_Reflection_V2_Builtins.lookup_attr_ses + (FStar_Reflection_V2_Builtins.pack_ln + (FStar_Reflection_V2_Data.Tv_FVar + (FStar_Reflection_V2_Builtins.pack_fv + ["FStar"; + "Tactics"; + "Typeclasses"; + "tcinstance"]))) + uu___4)))) + (fun uu___4 -> + (fun glb -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (286)) + (Prims.of_int (14)) + (Prims.of_int (288)) + (Prims.of_int (5))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (175)) + (Prims.of_int (289)) (Prims.of_int (6)) - (Prims.of_int (175)) - (Prims.of_int (26))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range + (Prims.of_int (308)) + (Prims.of_int (18))))) + (Obj.magic + (concatMap + (fun se -> + concatMap + (fun + uu___4 -> + (fun fv + -> + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun + uu___4 -> + [ + (se, fv)]))) + uu___4) + (sigelt_name + se)) glb)) + (fun uu___4 -> + (fun glb1 -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (291)) + (Prims.of_int (6)) + (Prims.of_int (293)) + (Prims.of_int (16))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (295)) + (Prims.of_int (4)) + (Prims.of_int (308)) + (Prims.of_int (18))))) + (FStar_Tactics_Effect.lift_div_tac + (fun + uu___4 -> + { + seen = []; + glb = + glb1; + fuel = + (Prims.of_int (16)) + })) + (fun + uu___4 -> + (fun st0 + -> + Obj.magic + (FStar_Tactics_V2_Derived.try_with + (fun + uu___4 -> + match () + with + | + () -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (296)) + (Prims.of_int (6)) + (Prims.of_int (296)) + (Prims.of_int (20))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (176)) + (Prims.of_int (297)) (Prims.of_int (6)) - (Prims.of_int (176)) + (Prims.of_int (297)) (Prims.of_int (59))))) - (Obj.magic - (tcresolve' [] - glb - (Prims.of_int (16)))) - (fun uu___4 -> - (fun uu___4 -> - Obj.magic - (debug + (Obj.magic + (tcresolve' + st0)) + (fun + uu___5 -> (fun uu___5 -> + Obj.magic + (debug + (fun + uu___6 -> FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (176)) + (Prims.of_int (297)) (Prims.of_int (42)) - (Prims.of_int (176)) + (Prims.of_int (297)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic @@ -1079,57 +2112,58 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Tactics_V2_Builtins.term_to_string w)) (fun - uu___6 -> + uu___7 -> FStar_Tactics_Effect.lift_div_tac (fun - uu___7 -> + uu___8 -> Prims.strcat "Solved to:\n\t" - uu___6))))) - uu___4)) - (fun uu___3 -> - (fun uu___3 -> - match uu___3 with - | NoInst -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.tac_bind - ( - FStar_Sealed.seal + uu___7))))) + uu___5)) + (fun + uu___4 -> + (fun + uu___4 -> + match uu___4 + with + | + NoInst -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (180)) + (Prims.of_int (301)) (Prims.of_int (15)) - (Prims.of_int (183)) + (Prims.of_int (305)) (Prims.of_int (7))))) - ( - FStar_Sealed.seal + (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (180)) + (Prims.of_int (301)) (Prims.of_int (6)) - (Prims.of_int (183)) + (Prims.of_int (305)) (Prims.of_int (7))))) - ( - Obj.magic + (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (181)) - (Prims.of_int (8)) - (Prims.of_int (182)) - (Prims.of_int (59))))) + (Prims.of_int (301)) + (Prims.of_int (15)) + (Prims.of_int (305)) + (Prims.of_int (7))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (180)) + (Prims.of_int (301)) (Prims.of_int (15)) - (Prims.of_int (183)) + (Prims.of_int (305)) (Prims.of_int (7))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1137,111 +2171,116 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (182)) - (Prims.of_int (10)) - (Prims.of_int (182)) - (Prims.of_int (59))))) + (Prims.of_int (303)) + (Prims.of_int (8)) + (Prims.of_int (304)) + (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (181)) - (Prims.of_int (8)) - (Prims.of_int (182)) - (Prims.of_int (59))))) + (Prims.of_int (301)) + (Prims.of_int (15)) + (Prims.of_int (305)) + (Prims.of_int (7))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (182)) - (Prims.of_int (28)) - (Prims.of_int (182)) - (Prims.of_int (58))))) + (Prims.of_int (304)) + (Prims.of_int (10)) + (Prims.of_int (304)) + (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (182)) - (Prims.of_int (10)) - (Prims.of_int (182)) - (Prims.of_int (59))))) + (Prims.of_int (303)) + (Prims.of_int (8)) + (Prims.of_int (304)) + (Prims.of_int (37))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (182)) - (Prims.of_int (44)) - (Prims.of_int (182)) - (Prims.of_int (57))))) + (Prims.of_int (304)) + (Prims.of_int (23)) + (Prims.of_int (304)) + (Prims.of_int (36))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (182)) - (Prims.of_int (28)) - (Prims.of_int (182)) - (Prims.of_int (58))))) + (Prims.of_int (304)) + (Prims.of_int (10)) + (Prims.of_int (304)) + (Prims.of_int (37))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_goal ())) (fun - uu___4 -> + uu___5 -> (fun - uu___4 -> + uu___5 -> Obj.magic - (FStar_Tactics_V2_Builtins.term_to_string - uu___4)) - uu___4))) - (fun - uu___4 -> - FStar_Tactics_Effect.lift_div_tac + (FStar_Tactics_V2_Builtins.term_to_doc + uu___5)) + uu___5))) (fun uu___5 -> - FStar_Pprint.arbitrary_string - uu___4)))) - (fun - uu___4 -> FStar_Tactics_Effect.lift_div_tac (fun - uu___5 -> + uu___6 -> FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one (FStar_Pprint.arbitrary_string "Could not solve constraint") - uu___4)))) + uu___5)))) (fun - uu___4 -> + uu___5 -> FStar_Tactics_Effect.lift_div_tac (fun + uu___6 -> + [uu___5])))) + (fun + uu___5 -> + FStar_Tactics_Effect.lift_div_tac + (fun + uu___6 -> + (FStar_Pprint.arbitrary_string + "Typeclass resolution failed.") + :: uu___5)))) + (fun uu___5 -> - [uu___4])))) - ( - fun - uu___4 -> FStar_Tactics_V2_Derived.fail_doc - uu___4))) - | FStar_Tactics_Common.TacticFailure - msg -> - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail_doc - ( - (op_At ()) + uu___5))) + | + FStar_Tactics_Common.TacticFailure + msg -> + Obj.magic + (Obj.repr + (FStar_Tactics_V2_Derived.fail_doc + ((op_At + ()) [ FStar_Pprint.arbitrary_string - "Typeclass resolution failed"] + "Typeclass resolution failed."] msg))) - | e -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.raise + | + e -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.raise e))) - uu___3))) uu___3))) + uu___4))) + uu___4))) + uu___4))) + uu___4))) uu___3))) uu___2))) uu___2))) uu___1) let _ = FStar_Tactics_Native.register_tactic "FStar.Tactics.Typeclasses.tcresolve" @@ -1277,8 +2316,8 @@ let rec (mk_abs : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (195)) (Prims.of_int (20)) - (Prims.of_int (195)) (Prims.of_int (47))))) + (Prims.of_int (317)) (Prims.of_int (20)) + (Prims.of_int (317)) (Prims.of_int (47))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "dummy" Prims.int_zero @@ -1289,17 +2328,17 @@ let rec (mk_abs : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (195)) + (Prims.of_int (317)) (Prims.of_int (30)) - (Prims.of_int (195)) + (Prims.of_int (317)) (Prims.of_int (46))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (195)) + (Prims.of_int (317)) (Prims.of_int (20)) - (Prims.of_int (195)) + (Prims.of_int (317)) (Prims.of_int (47))))) (Obj.magic (mk_abs bs1 body)) (fun uu___ -> @@ -1358,12 +2397,12 @@ let (mk_class : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (219)) (Prims.of_int (13)) (Prims.of_int (219)) + (Prims.of_int (341)) (Prims.of_int (13)) (Prims.of_int (341)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (219)) (Prims.of_int (29)) (Prims.of_int (309)) + (Prims.of_int (341)) (Prims.of_int (29)) (Prims.of_int (431)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> FStar_Reflection_V2_Builtins.explode_qn nm)) @@ -1374,27 +2413,27 @@ let (mk_class : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (220)) (Prims.of_int (12)) - (Prims.of_int (220)) (Prims.of_int (38))))) + (Prims.of_int (342)) (Prims.of_int (12)) + (Prims.of_int (342)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (221)) (Prims.of_int (4)) - (Prims.of_int (309)) (Prims.of_int (5))))) + (Prims.of_int (343)) (Prims.of_int (4)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (220)) (Prims.of_int (23)) - (Prims.of_int (220)) (Prims.of_int (35))))) + (Prims.of_int (342)) (Prims.of_int (23)) + (Prims.of_int (342)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (220)) (Prims.of_int (12)) - (Prims.of_int (220)) (Prims.of_int (38))))) + (Prims.of_int (342)) (Prims.of_int (12)) + (Prims.of_int (342)) (Prims.of_int (38))))) (Obj.magic (FStar_Tactics_V2_Builtins.top_env ())) (fun uu___ -> FStar_Tactics_Effect.lift_div_tac @@ -1409,14 +2448,14 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (221)) (Prims.of_int (4)) - (Prims.of_int (221)) (Prims.of_int (19))))) + (Prims.of_int (343)) (Prims.of_int (4)) + (Prims.of_int (343)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (221)) (Prims.of_int (20)) - (Prims.of_int (309)) (Prims.of_int (5))))) + (Prims.of_int (343)) (Prims.of_int (20)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Derived.guard (FStar_Pervasives_Native.uu___is_Some r))) @@ -1428,17 +2467,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (222)) + (Prims.of_int (344)) (Prims.of_int (18)) - (Prims.of_int (222)) + (Prims.of_int (344)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (221)) + (Prims.of_int (343)) (Prims.of_int (20)) - (Prims.of_int (309)) + (Prims.of_int (431)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> r)) @@ -1453,17 +2492,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (223)) + (Prims.of_int (345)) (Prims.of_int (23)) - (Prims.of_int (223)) + (Prims.of_int (345)) (Prims.of_int (115))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (223)) + (Prims.of_int (345)) (Prims.of_int (118)) - (Prims.of_int (309)) + (Prims.of_int (431)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> @@ -1488,18 +2527,18 @@ let (mk_class : Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (224)) + (Prims.of_int (346)) (Prims.of_int (13)) - (Prims.of_int (224)) + (Prims.of_int (346)) (Prims.of_int (30))))) (FStar_Sealed.seal ( Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (225)) + (Prims.of_int (347)) (Prims.of_int (4)) - (Prims.of_int (309)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic ( @@ -1515,17 +2554,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (225)) + (Prims.of_int (347)) (Prims.of_int (4)) - (Prims.of_int (225)) + (Prims.of_int (347)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (225)) + (Prims.of_int (347)) (Prims.of_int (29)) - (Prims.of_int (309)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Derived.guard @@ -1541,17 +2580,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (226)) + (Prims.of_int (348)) (Prims.of_int (63)) - (Prims.of_int (226)) + (Prims.of_int (348)) (Prims.of_int (65))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (225)) + (Prims.of_int (347)) (Prims.of_int (29)) - (Prims.of_int (309)) + (Prims.of_int (431)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -1583,17 +2622,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (227)) + (Prims.of_int (349)) (Prims.of_int (4)) - (Prims.of_int (227)) + (Prims.of_int (349)) (Prims.of_int (87))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (228)) + (Prims.of_int (350)) (Prims.of_int (4)) - (Prims.of_int (309)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (debug @@ -1604,9 +2643,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (227)) + (Prims.of_int (349)) (Prims.of_int (35)) - (Prims.of_int (227)) + (Prims.of_int (349)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -1638,17 +2677,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (228)) + (Prims.of_int (350)) (Prims.of_int (4)) - (Prims.of_int (228)) + (Prims.of_int (350)) (Prims.of_int (57))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (229)) + (Prims.of_int (351)) (Prims.of_int (4)) - (Prims.of_int (309)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (debug @@ -1675,17 +2714,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (229)) + (Prims.of_int (351)) (Prims.of_int (4)) - (Prims.of_int (229)) + (Prims.of_int (351)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (229)) + (Prims.of_int (351)) (Prims.of_int (60)) - (Prims.of_int (309)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (debug @@ -1696,9 +2735,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (229)) + (Prims.of_int (351)) (Prims.of_int (40)) - (Prims.of_int (229)) + (Prims.of_int (351)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic @@ -1729,17 +2768,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (230)) + (Prims.of_int (352)) (Prims.of_int (20)) - (Prims.of_int (230)) + (Prims.of_int (352)) (Prims.of_int (29))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (232)) + (Prims.of_int (354)) (Prims.of_int (4)) - (Prims.of_int (309)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (last @@ -1755,17 +2794,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (232)) + (Prims.of_int (354)) (Prims.of_int (4)) - (Prims.of_int (232)) + (Prims.of_int (354)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (232)) + (Prims.of_int (354)) (Prims.of_int (31)) - (Prims.of_int (309)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Derived.guard @@ -1782,17 +2821,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (233)) + (Prims.of_int (355)) (Prims.of_int (25)) - (Prims.of_int (233)) + (Prims.of_int (355)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (232)) + (Prims.of_int (354)) (Prims.of_int (31)) - (Prims.of_int (309)) + (Prims.of_int (431)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -1814,17 +2853,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (234)) + (Prims.of_int (356)) (Prims.of_int (4)) - (Prims.of_int (234)) + (Prims.of_int (356)) (Prims.of_int (87))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (234)) + (Prims.of_int (356)) (Prims.of_int (88)) - (Prims.of_int (309)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (debug @@ -1835,9 +2874,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (234)) + (Prims.of_int (356)) (Prims.of_int (35)) - (Prims.of_int (234)) + (Prims.of_int (356)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -1853,9 +2892,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (234)) + (Prims.of_int (356)) (Prims.of_int (55)) - (Prims.of_int (234)) + (Prims.of_int (356)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -1871,9 +2910,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (234)) + (Prims.of_int (356)) (Prims.of_int (69)) - (Prims.of_int (234)) + (Prims.of_int (356)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -1927,17 +2966,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (235)) + (Prims.of_int (357)) (Prims.of_int (18)) - (Prims.of_int (235)) + (Prims.of_int (357)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (234)) + (Prims.of_int (356)) (Prims.of_int (88)) - (Prims.of_int (309)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_arr_bs @@ -1959,17 +2998,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (236)) + (Prims.of_int (358)) (Prims.of_int (12)) - (Prims.of_int (236)) + (Prims.of_int (358)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (237)) + (Prims.of_int (359)) (Prims.of_int (4)) - (Prims.of_int (309)) + (Prims.of_int (431)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -1988,17 +3027,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (237)) + (Prims.of_int (359)) (Prims.of_int (4)) - (Prims.of_int (237)) + (Prims.of_int (359)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (237)) + (Prims.of_int (359)) (Prims.of_int (23)) - (Prims.of_int (309)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Derived.guard @@ -2016,17 +3055,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (238)) + (Prims.of_int (360)) (Prims.of_int (22)) - (Prims.of_int (238)) + (Prims.of_int (360)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (237)) + (Prims.of_int (359)) (Prims.of_int (23)) - (Prims.of_int (309)) + (Prims.of_int (431)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2049,17 +3088,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (240)) + (Prims.of_int (362)) (Prims.of_int (4)) - (Prims.of_int (240)) + (Prims.of_int (362)) (Prims.of_int (87))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (241)) + (Prims.of_int (363)) (Prims.of_int (4)) - (Prims.of_int (309)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2071,9 +3110,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (240)) + (Prims.of_int (362)) (Prims.of_int (35)) - (Prims.of_int (240)) + (Prims.of_int (362)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic @@ -2109,17 +3148,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (241)) + (Prims.of_int (363)) (Prims.of_int (4)) - (Prims.of_int (241)) + (Prims.of_int (363)) (Prims.of_int (81))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (242)) + (Prims.of_int (364)) (Prims.of_int (4)) - (Prims.of_int (309)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2152,17 +3191,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (242)) + (Prims.of_int (364)) (Prims.of_int (4)) - (Prims.of_int (242)) + (Prims.of_int (364)) (Prims.of_int (76))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (243)) + (Prims.of_int (365)) (Prims.of_int (4)) - (Prims.of_int (309)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2195,17 +3234,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (243)) + (Prims.of_int (365)) (Prims.of_int (4)) - (Prims.of_int (243)) + (Prims.of_int (365)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (243)) + (Prims.of_int (365)) (Prims.of_int (52)) - (Prims.of_int (309)) + (Prims.of_int (431)) (Prims.of_int (5))))) (Obj.magic (debug @@ -2217,9 +3256,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (243)) + (Prims.of_int (365)) (Prims.of_int (32)) - (Prims.of_int (243)) + (Prims.of_int (365)) (Prims.of_int (50))))) (FStar_Sealed.seal (Obj.magic @@ -2254,17 +3293,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (247)) + (Prims.of_int (369)) (Prims.of_int (24)) - (Prims.of_int (247)) + (Prims.of_int (369)) (Prims.of_int (61))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (250)) + (Prims.of_int (372)) (Prims.of_int (4)) - (Prims.of_int (309)) + (Prims.of_int (431)) (Prims.of_int (5))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2288,17 +3327,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (252)) + (Prims.of_int (374)) (Prims.of_int (14)) - (Prims.of_int (252)) + (Prims.of_int (374)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (253)) + (Prims.of_int (375)) (Prims.of_int (6)) - (Prims.of_int (308)) + (Prims.of_int (430)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_V2_Derived.name_of_binder @@ -2313,17 +3352,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (253)) + (Prims.of_int (375)) (Prims.of_int (6)) - (Prims.of_int (253)) + (Prims.of_int (375)) (Prims.of_int (48))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (253)) + (Prims.of_int (375)) (Prims.of_int (49)) - (Prims.of_int (308)) + (Prims.of_int (430)) (Prims.of_int (8))))) (Obj.magic (debug @@ -2354,17 +3393,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (254)) + (Prims.of_int (376)) (Prims.of_int (15)) - (Prims.of_int (254)) + (Prims.of_int (376)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (254)) + (Prims.of_int (376)) (Prims.of_int (31)) - (Prims.of_int (308)) + (Prims.of_int (430)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_module @@ -2380,17 +3419,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (255)) + (Prims.of_int (377)) (Prims.of_int (16)) - (Prims.of_int (255)) + (Prims.of_int (377)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (255)) + (Prims.of_int (377)) (Prims.of_int (37)) - (Prims.of_int (308)) + (Prims.of_int (430)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2411,17 +3450,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (256)) + (Prims.of_int (378)) (Prims.of_int (16)) - (Prims.of_int (256)) + (Prims.of_int (378)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (256)) + (Prims.of_int (378)) (Prims.of_int (41)) - (Prims.of_int (308)) + (Prims.of_int (430)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_V2_Derived.fresh_namedv_named @@ -2437,17 +3476,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (257)) + (Prims.of_int (379)) (Prims.of_int (16)) - (Prims.of_int (257)) + (Prims.of_int (379)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (257)) + (Prims.of_int (379)) (Prims.of_int (31)) - (Prims.of_int (308)) + (Prims.of_int (430)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2471,17 +3510,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (259)) + (Prims.of_int (381)) (Prims.of_int (8)) - (Prims.of_int (263)) + (Prims.of_int (385)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (264)) + (Prims.of_int (386)) (Prims.of_int (10)) - (Prims.of_int (308)) + (Prims.of_int (430)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2489,17 +3528,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (261)) + (Prims.of_int (383)) (Prims.of_int (17)) - (Prims.of_int (261)) + (Prims.of_int (383)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (259)) + (Prims.of_int (381)) (Prims.of_int (8)) - (Prims.of_int (263)) + (Prims.of_int (385)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_V2_Builtins.fresh @@ -2538,17 +3577,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (265)) + (Prims.of_int (387)) (Prims.of_int (22)) - (Prims.of_int (265)) + (Prims.of_int (387)) (Prims.of_int (48))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (265)) + (Prims.of_int (387)) (Prims.of_int (51)) - (Prims.of_int (308)) + (Prims.of_int (430)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2556,17 +3595,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (265)) + (Prims.of_int (387)) (Prims.of_int (22)) - (Prims.of_int (265)) + (Prims.of_int (387)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (265)) + (Prims.of_int (387)) (Prims.of_int (22)) - (Prims.of_int (265)) + (Prims.of_int (387)) (Prims.of_int (48))))) (Obj.magic (FStar_Tactics_V2_Derived.cur_module @@ -2595,17 +3634,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (266)) + (Prims.of_int (388)) (Prims.of_int (17)) - (Prims.of_int (266)) + (Prims.of_int (388)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (266)) + (Prims.of_int (388)) (Prims.of_int (54)) - (Prims.of_int (308)) + (Prims.of_int (430)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2626,17 +3665,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (269)) + (Prims.of_int (391)) (Prims.of_int (8)) - (Prims.of_int (274)) + (Prims.of_int (396)) (Prims.of_int (50))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (275)) + (Prims.of_int (397)) (Prims.of_int (8)) - (Prims.of_int (308)) + (Prims.of_int (430)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2644,17 +3683,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (269)) + (Prims.of_int (391)) (Prims.of_int (14)) - (Prims.of_int (269)) + (Prims.of_int (391)) (Prims.of_int (47))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (269)) + (Prims.of_int (391)) (Prims.of_int (8)) - (Prims.of_int (274)) + (Prims.of_int (396)) (Prims.of_int (50))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2662,17 +3701,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (269)) + (Prims.of_int (391)) (Prims.of_int (25)) - (Prims.of_int (269)) + (Prims.of_int (391)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (269)) + (Prims.of_int (391)) (Prims.of_int (14)) - (Prims.of_int (269)) + (Prims.of_int (391)) (Prims.of_int (47))))) (Obj.magic (FStar_Tactics_V2_Builtins.top_env @@ -2712,17 +3751,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (272)) + (Prims.of_int (394)) (Prims.of_int (16)) - (Prims.of_int (272)) + (Prims.of_int (394)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (272)) + (Prims.of_int (394)) (Prims.of_int (10)) - (Prims.of_int (274)) + (Prims.of_int (396)) (Prims.of_int (50))))) (Obj.magic (FStar_Tactics_NamedView.inspect_sigelt @@ -2769,17 +3808,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (278)) + (Prims.of_int (400)) (Prims.of_int (14)) - (Prims.of_int (285)) + (Prims.of_int (407)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (286)) + (Prims.of_int (408)) (Prims.of_int (8)) - (Prims.of_int (308)) + (Prims.of_int (430)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2787,17 +3826,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (279)) + (Prims.of_int (401)) (Prims.of_int (22)) - (Prims.of_int (279)) + (Prims.of_int (401)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (278)) + (Prims.of_int (400)) (Prims.of_int (14)) - (Prims.of_int (285)) + (Prims.of_int (407)) (Prims.of_int (37))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_arr_bs @@ -2819,17 +3858,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (280)) + (Prims.of_int (402)) (Prims.of_int (21)) - (Prims.of_int (280)) + (Prims.of_int (402)) (Prims.of_int (75))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (279)) + (Prims.of_int (401)) (Prims.of_int (54)) - (Prims.of_int (285)) + (Prims.of_int (407)) (Prims.of_int (37))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2868,17 +3907,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (284)) + (Prims.of_int (406)) (Prims.of_int (21)) - (Prims.of_int (284)) + (Prims.of_int (406)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (285)) + (Prims.of_int (407)) (Prims.of_int (12)) - (Prims.of_int (285)) + (Prims.of_int (407)) (Prims.of_int (37))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -2912,17 +3951,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (287)) + (Prims.of_int (409)) (Prims.of_int (15)) - (Prims.of_int (294)) + (Prims.of_int (416)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (296)) + (Prims.of_int (418)) (Prims.of_int (6)) - (Prims.of_int (308)) + (Prims.of_int (430)) (Prims.of_int (8))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2930,17 +3969,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (288)) + (Prims.of_int (410)) (Prims.of_int (23)) - (Prims.of_int (288)) + (Prims.of_int (410)) (Prims.of_int (49))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (287)) + (Prims.of_int (409)) (Prims.of_int (15)) - (Prims.of_int (294)) + (Prims.of_int (416)) (Prims.of_int (38))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_abs @@ -2962,17 +4001,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (289)) + (Prims.of_int (411)) (Prims.of_int (21)) - (Prims.of_int (289)) + (Prims.of_int (411)) (Prims.of_int (75))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (288)) + (Prims.of_int (410)) (Prims.of_int (52)) - (Prims.of_int (294)) + (Prims.of_int (416)) (Prims.of_int (38))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3011,17 +4050,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (293)) + (Prims.of_int (415)) (Prims.of_int (21)) - (Prims.of_int (293)) + (Prims.of_int (415)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (294)) + (Prims.of_int (416)) (Prims.of_int (12)) - (Prims.of_int (294)) + (Prims.of_int (416)) (Prims.of_int (38))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3055,17 +4094,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (296)) + (Prims.of_int (418)) (Prims.of_int (6)) - (Prims.of_int (296)) + (Prims.of_int (418)) (Prims.of_int (53))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (297)) + (Prims.of_int (419)) (Prims.of_int (6)) - (Prims.of_int (308)) + (Prims.of_int (430)) (Prims.of_int (8))))) (Obj.magic (debug @@ -3077,9 +4116,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (296)) + (Prims.of_int (418)) (Prims.of_int (34)) - (Prims.of_int (296)) + (Prims.of_int (418)) (Prims.of_int (52))))) (FStar_Sealed.seal (Obj.magic @@ -3114,17 +4153,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (297)) + (Prims.of_int (419)) (Prims.of_int (6)) - (Prims.of_int (297)) + (Prims.of_int (419)) (Prims.of_int (52))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (297)) + (Prims.of_int (419)) (Prims.of_int (53)) - (Prims.of_int (308)) + (Prims.of_int (430)) (Prims.of_int (8))))) (Obj.magic (debug @@ -3136,9 +4175,9 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (297)) + (Prims.of_int (419)) (Prims.of_int (34)) - (Prims.of_int (297)) + (Prims.of_int (419)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic @@ -3173,17 +4212,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (299)) + (Prims.of_int (421)) (Prims.of_int (22)) - (Prims.of_int (299)) + (Prims.of_int (421)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (299)) + (Prims.of_int (421)) (Prims.of_int (27)) - (Prims.of_int (308)) + (Prims.of_int (430)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3200,17 +4239,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (300)) + (Prims.of_int (422)) (Prims.of_int (23)) - (Prims.of_int (300)) + (Prims.of_int (422)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (300)) + (Prims.of_int (422)) (Prims.of_int (29)) - (Prims.of_int (308)) + (Prims.of_int (430)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3227,17 +4266,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (301)) + (Prims.of_int (423)) (Prims.of_int (21)) - (Prims.of_int (301)) + (Prims.of_int (423)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (301)) + (Prims.of_int (423)) (Prims.of_int (27)) - (Prims.of_int (308)) + (Prims.of_int (430)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3254,17 +4293,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (303)) + (Prims.of_int (425)) (Prims.of_int (17)) - (Prims.of_int (303)) + (Prims.of_int (425)) (Prims.of_int (70))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (303)) + (Prims.of_int (425)) (Prims.of_int (75)) - (Prims.of_int (308)) + (Prims.of_int (430)) (Prims.of_int (8))))) (FStar_Tactics_Effect.lift_div_tac (fun @@ -3292,17 +4331,17 @@ let (mk_class : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (304)) + (Prims.of_int (426)) (Prims.of_int (15)) - (Prims.of_int (304)) + (Prims.of_int (426)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Typeclasses.fst" - (Prims.of_int (306)) + (Prims.of_int (428)) (Prims.of_int (15)) - (Prims.of_int (306)) + (Prims.of_int (428)) (Prims.of_int (42))))) (Obj.magic (FStar_Tactics_NamedView.pack_sigelt diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Types.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Types.ml index ce150fcee94..64867e95d86 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Types.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Types.ml @@ -35,6 +35,7 @@ type guard_policy = | SMT | SMTSync | Force + | ForceSMT | Drop let (uu___is_Goal : guard_policy -> Prims.bool) = fun projectee -> match projectee with | Goal -> true | uu___ -> false @@ -44,6 +45,8 @@ let (uu___is_SMTSync : guard_policy -> Prims.bool) = fun projectee -> match projectee with | SMTSync -> true | uu___ -> false let (uu___is_Force : guard_policy -> Prims.bool) = fun projectee -> match projectee with | Force -> true | uu___ -> false +let (uu___is_ForceSMT : guard_policy -> Prims.bool) = + fun projectee -> match projectee with | ForceSMT -> true | uu___ -> false let (uu___is_Drop : guard_policy -> Prims.bool) = fun projectee -> match projectee with | Drop -> true | uu___ -> false type proofstate = @@ -60,91 +63,104 @@ type proofstate = freshness: Prims.int ; tac_verb_dbg: Prims.bool ; local_state: FStar_Syntax_Syntax.term FStar_Compiler_Util.psmap ; - urgency: Prims.int } + urgency: Prims.int ; + dump_on_failure: Prims.bool } let (__proj__Mkproofstate__item__main_context : proofstate -> FStar_TypeChecker_Env.env) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> main_context + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> + main_context let (__proj__Mkproofstate__item__all_implicits : proofstate -> FStar_TypeChecker_Common.implicits) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> all_implicits + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> + all_implicits let (__proj__Mkproofstate__item__goals : proofstate -> goal Prims.list) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> goals + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> goals let (__proj__Mkproofstate__item__smt_goals : proofstate -> goal Prims.list) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> smt_goals + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> smt_goals let (__proj__Mkproofstate__item__depth : proofstate -> Prims.int) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> depth + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> depth let (__proj__Mkproofstate__item____dump : proofstate -> proofstate -> Prims.string -> unit) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> __dump + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> __dump let (__proj__Mkproofstate__item__psc : proofstate -> FStar_TypeChecker_Primops_Base.psc) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> psc + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> psc let (__proj__Mkproofstate__item__entry_range : proofstate -> FStar_Compiler_Range_Type.range) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> entry_range + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> entry_range let (__proj__Mkproofstate__item__guard_policy : proofstate -> guard_policy) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> guard_policy1 + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> + guard_policy1 let (__proj__Mkproofstate__item__freshness : proofstate -> Prims.int) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> freshness + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> freshness let (__proj__Mkproofstate__item__tac_verb_dbg : proofstate -> Prims.bool) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> tac_verb_dbg + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> + tac_verb_dbg let (__proj__Mkproofstate__item__local_state : proofstate -> FStar_Syntax_Syntax.term FStar_Compiler_Util.psmap) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> local_state + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> local_state let (__proj__Mkproofstate__item__urgency : proofstate -> Prims.int) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; psc; entry_range; guard_policy = guard_policy1; freshness; - tac_verb_dbg; local_state; urgency;_} -> urgency + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> urgency +let (__proj__Mkproofstate__item__dump_on_failure : proofstate -> Prims.bool) + = + fun projectee -> + match projectee with + | { main_context; all_implicits; goals; smt_goals; depth; __dump; + psc; entry_range; guard_policy = guard_policy1; freshness; + tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> + dump_on_failure let (goal_env : goal -> FStar_TypeChecker_Env.env) = fun g -> g.goal_main_env let (goal_range : goal -> FStar_Compiler_Range_Type.range) = fun g -> (g.goal_main_env).FStar_TypeChecker_Env.range @@ -342,7 +358,8 @@ let (decr_depth : proofstate -> proofstate) = freshness = (ps.freshness); tac_verb_dbg = (ps.tac_verb_dbg); local_state = (ps.local_state); - urgency = (ps.urgency) + urgency = (ps.urgency); + dump_on_failure = (ps.dump_on_failure) } let (incr_depth : proofstate -> proofstate) = fun ps -> @@ -359,7 +376,8 @@ let (incr_depth : proofstate -> proofstate) = freshness = (ps.freshness); tac_verb_dbg = (ps.tac_verb_dbg); local_state = (ps.local_state); - urgency = (ps.urgency) + urgency = (ps.urgency); + dump_on_failure = (ps.dump_on_failure) } let (set_ps_psc : FStar_TypeChecker_Primops_Base.psc -> proofstate -> proofstate) = @@ -378,7 +396,8 @@ let (set_ps_psc : freshness = (ps.freshness); tac_verb_dbg = (ps.tac_verb_dbg); local_state = (ps.local_state); - urgency = (ps.urgency) + urgency = (ps.urgency); + dump_on_failure = (ps.dump_on_failure) } let (tracepoint_with_psc : FStar_TypeChecker_Primops_Base.psc -> proofstate -> Prims.bool) = @@ -419,7 +438,8 @@ let (set_proofstate_range : freshness = (ps.freshness); tac_verb_dbg = (ps.tac_verb_dbg); local_state = (ps.local_state); - urgency = (ps.urgency) + urgency = (ps.urgency); + dump_on_failure = (ps.dump_on_failure) } let (goals_of : proofstate -> goal Prims.list) = fun ps -> ps.goals let (smt_goals_of : proofstate -> goal Prims.list) = fun ps -> ps.smt_goals diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_Util.ml b/ocaml/fstar-lib/generated/FStar_Tactics_Util.ml index db4dbfb9319..270b05d0ecc 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_Util.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_Util.ml @@ -709,4 +709,38 @@ let rec string_of_list : FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> Prims.strcat uu___ uu___1)))) uu___)))) + uu___1 uu___ +let string_of_option : + 'a . + ('a -> (Prims.string, unit) FStar_Tactics_Effect.tac_repr) -> + 'a FStar_Pervasives_Native.option -> + (Prims.string, unit) FStar_Tactics_Effect.tac_repr + = + fun uu___1 -> + fun uu___ -> + (fun f -> + fun o -> + match o with + | FStar_Pervasives_Native.Some x -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Util.fst" + (Prims.of_int (126)) (Prims.of_int (24)) + (Prims.of_int (126)) (Prims.of_int (27))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "prims.fst" + (Prims.of_int (590)) (Prims.of_int (19)) + (Prims.of_int (590)) (Prims.of_int (31))))) + (Obj.magic (f x)) + (fun uu___ -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___1 -> Prims.strcat "Some " uu___)))) + | FStar_Pervasives_Native.None -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> "None")))) uu___1 uu___ \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml index de22aaf32af..f3f28e4bb3e 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V1_Basic.ml @@ -1,4 +1,12 @@ open Prims +let (dbg_2635 : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "2635" +let (dbg_ReflTc : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "ReflTc" +let (dbg_Tac : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Tac" +let (dbg_TacUnify : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "TacUnify" let ret : 'a . 'a -> 'a FStar_Tactics_Monad.tac = fun uu___ -> (fun x -> @@ -51,7 +59,7 @@ let (core_check : then FStar_Pervasives.Inl FStar_Pervasives_Native.None else (let debug f = - let uu___2 = FStar_Options.debug_any () in + let uu___2 = FStar_Compiler_Debug.any () in if uu___2 then f () else () in let uu___2 = FStar_TypeChecker_Core.check_term env sol t must_tot in @@ -69,7 +77,7 @@ let (core_check : let uu___5 = let uu___6 = FStar_TypeChecker_Env.get_range env in FStar_Class_Show.show - FStar_Compiler_Range_Ops.show_range uu___6 in + FStar_Compiler_Range_Ops.showable_range uu___6 in let uu___6 = FStar_TypeChecker_Core.print_error_short err in let uu___7 = @@ -190,10 +198,7 @@ let (debugging : unit -> Prims.bool FStar_Tactics_Monad.tac) = let uu___1 = bind () in uu___1 FStar_Tactics_Monad.get (fun ps -> - let uu___2 = - FStar_TypeChecker_Env.debug ps.FStar_Tactics_Types.main_context - (FStar_Options.Other "Tac") in - ret uu___2) + let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Tac in ret uu___2) let (do_dump_ps : Prims.string -> FStar_Tactics_Types.proofstate -> unit) = fun msg -> fun ps -> @@ -244,7 +249,9 @@ let (dump_all : Prims.bool -> Prims.string -> unit FStar_Tactics_Monad.tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in do_dump_ps msg ps'; FStar_Tactics_Result.Success ((), ps)) let (dump_uvars_of : @@ -257,7 +264,10 @@ let (dump_uvars_of : let uu___ = let uu___1 = FStar_Tactics_Types.goal_type g in FStar_Syntax_Free.uvars uu___1 in - FStar_Compiler_Set.elems FStar_Syntax_Free.ord_ctx_uvar uu___ in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___) in let gs = FStar_Compiler_List.map (FStar_Tactics_Types.goal_of_ctx_uvar g) uvs in @@ -287,7 +297,9 @@ let (dump_uvars_of : (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in do_dump_ps msg ps'; FStar_Tactics_Result.Success ((), ps)) let fail1 : @@ -424,7 +436,9 @@ let (set_guard_policy : (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) }) let with_policy : 'a . @@ -931,21 +945,39 @@ let (__do_unify_wflags : let uu___1 = match check_side with | Check_none -> - FStar_Syntax_Free.new_uv_set () + Obj.magic + (Obj.repr + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + ())) | Check_left_only -> - FStar_Syntax_Free.uvars t1 + Obj.magic + (Obj.repr + (FStar_Syntax_Free.uvars t1)) | Check_right_only -> - FStar_Syntax_Free.uvars t2 + Obj.magic + (Obj.repr + (FStar_Syntax_Free.uvars t2)) | Check_both -> - let uu___2 = - FStar_Syntax_Free.uvars t1 in - let uu___3 = - FStar_Syntax_Free.uvars t2 in - FStar_Compiler_Set.union - FStar_Syntax_Free.ord_ctx_uvar - uu___2 uu___3 in - FStar_Compiler_Set.elems - FStar_Syntax_Free.ord_ctx_uvar uu___1 in + Obj.magic + (Obj.repr + (let uu___2 = + FStar_Syntax_Free.uvars t1 in + let uu___3 = + FStar_Syntax_Free.uvars t2 in + FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uu___2) + (Obj.magic uu___3))) in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uu___1) in let uu___1 = let uu___2 = let uu___3 = @@ -1064,7 +1096,7 @@ let (__do_unify_wflags : msg in let uu___10 = FStar_Class_Show.show - FStar_Compiler_Range_Ops.show_range + FStar_Compiler_Range_Ops.showable_range r in FStar_Compiler_Util.print2 ">> do_unify error, (%s) at (%s)\n" @@ -1104,27 +1136,28 @@ let (__do_unify : fun env1 -> fun t1 -> fun t2 -> - let dbg = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "TacUnify") in let uu___ = bind () in uu___ idtac (fun uu___1 -> - if dbg - then - (FStar_Options.push (); - (let uu___4 = - FStar_Options.set_options - "--debug_level Rel --debug_level RelCheck" in - ())) - else (); + (let uu___3 = FStar_Compiler_Effect.op_Bang dbg_TacUnify in + if uu___3 + then + (FStar_Options.push (); + (let uu___5 = + FStar_Options.set_options "--debug Rel,RelCheck" in + ())) + else ()); (let uu___3 = - __do_unify_wflags dbg allow_guards must_tot check_side - env1 t1 t2 in + let uu___4 = FStar_Compiler_Effect.op_Bang dbg_TacUnify in + __do_unify_wflags uu___4 allow_guards must_tot + check_side env1 t1 t2 in let uu___4 = bind () in uu___4 uu___3 (fun r -> - if dbg then FStar_Options.pop () else (); ret r))) + (let uu___6 = + FStar_Compiler_Effect.op_Bang dbg_TacUnify in + if uu___6 then FStar_Options.pop () else ()); + ret r))) let (do_unify_aux : Prims.bool -> check_unifier_solved_implicits_side -> @@ -1205,8 +1238,11 @@ let (do_match : let uvs2 = FStar_Syntax_Free.uvars_uncached t1 in let uu___4 = let uu___5 = - FStar_Compiler_Set.equal - FStar_Syntax_Free.ord_ctx_uvar uvs1 uvs2 in + FStar_Class_Setlike.equal () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uvs1) (Obj.magic uvs2) in Prims.op_Negation uu___5 in (if uu___4 then (FStar_Syntax_Unionfind.rollback tx; ret false) @@ -1246,8 +1282,11 @@ let (do_match_on_lhs : let uvs2 = FStar_Syntax_Free.uvars_uncached lhs in let uu___6 = let uu___7 = - FStar_Compiler_Set.equal - FStar_Syntax_Free.ord_ctx_uvar uvs1 uvs2 in + FStar_Class_Setlike.equal () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uvs1) (Obj.magic uvs2) in Prims.op_Negation uu___7 in (if uu___6 then @@ -1417,7 +1456,9 @@ let (fresh : unit -> FStar_BigInt.t FStar_Tactics_Monad.tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in let uu___2 = FStar_Tactics_Monad.set ps1 in let uu___3 = bind () in @@ -2282,7 +2323,9 @@ let divide : FStar_Tactics_Types.local_state = (p.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (p.FStar_Tactics_Types.urgency) + (p.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (p.FStar_Tactics_Types.dump_on_failure) } in let uu___4 = FStar_Tactics_Monad.set lp in let uu___5 = bind () in @@ -2319,7 +2362,10 @@ let divide : FStar_Tactics_Types.local_state = (lp'.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (lp'.FStar_Tactics_Types.urgency) + (lp'.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure + = + (lp'.FStar_Tactics_Types.dump_on_failure) } in let uu___9 = FStar_Tactics_Monad.set rp in let uu___10 = bind () in @@ -2378,7 +2424,10 @@ let divide : (rp'.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (rp'.FStar_Tactics_Types.urgency) + (rp'.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure + = + (rp'.FStar_Tactics_Types.dump_on_failure) } in let uu___14 = FStar_Tactics_Monad.set @@ -3604,10 +3653,21 @@ let (t_apply : = let uu___11 = - FStar_Syntax_Free.new_uv_set - () in + Obj.magic + (FStar_Class_Setlike.empty + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + ()) in FStar_Compiler_List.fold_right (fun + uu___13 + -> + fun + uu___12 + -> + (fun uu___12 -> fun s -> @@ -3625,16 +3685,30 @@ let (t_apply : uv in FStar_Syntax_Free.uvars uu___16 in - FStar_Compiler_Set.union - FStar_Syntax_Free.ord_ctx_uvar - s uu___15) + Obj.magic + (FStar_Class_Setlike.union + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic + s) + (Obj.magic + uu___15))) + uu___13 + uu___12) uvs uu___11 in let free_in_some_goal uv = - FStar_Compiler_Set.mem - FStar_Syntax_Free.ord_ctx_uvar - uv uvset in + FStar_Class_Setlike.mem + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + uv + (Obj.magic + uvset) in let uu___11 = solve' @@ -3992,10 +4066,10 @@ let (t_apply_lemma : (( let uu___19 = - FStar_TypeChecker_Env.debug - env1 - (FStar_Options.Other - "2635") in + (FStar_Compiler_Debug.medium + ()) || + (FStar_Compiler_Effect.op_Bang + dbg_2635) in if uu___19 then @@ -4189,9 +4263,13 @@ let (t_apply_lemma : = FStar_Syntax_Free.uvars t1 in - FStar_Compiler_Set.elems - FStar_Syntax_Free.ord_ctx_uvar - uu___17 in + FStar_Class_Setlike.elems + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic + uu___17) in FStar_Compiler_List.map (fun x -> x.FStar_Syntax_Syntax.ctx_uvar_head) @@ -5025,7 +5103,10 @@ let (free_in : fun bv -> fun t -> let uu___ = FStar_Syntax_Free.names t in - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_bv bv uu___ + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) bv (Obj.magic uu___) let (clear : FStar_Syntax_Syntax.binder -> unit FStar_Tactics_Monad.tac) = fun b -> let bv = b.FStar_Syntax_Syntax.binder_bv in @@ -5249,7 +5330,10 @@ let (_t_trefl : g.FStar_Tactics_Types.goal_ctx_uvar in let uvars = let uu___2 = FStar_Syntax_Free.uvars t in - FStar_Compiler_Set.elems FStar_Syntax_Free.ord_ctx_uvar uu___2 in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___2) in let uu___2 = FStar_Compiler_Util.for_all is_uvar_untyped_or_already_checked uvars in @@ -5418,7 +5502,7 @@ let (_t_trefl : | FStar_Pervasives.Inl (uu___13, t_ty) -> let uu___14 = FStar_TypeChecker_Core.check_term_subtyping - env1 ty t_ty in + true true env1 ty t_ty in (match uu___14 with | FStar_Pervasives.Inl (FStar_Pervasives_Native.None) -> @@ -6081,7 +6165,9 @@ let (join : unit -> unit FStar_Tactics_Monad.tac) = FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (ps.FStar_Tactics_Types.urgency) + (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in Obj.magic (FStar_Class_Monad.op_let_Bang @@ -7343,7 +7429,9 @@ let (t_destruct : FStar_Syntax_Syntax.mutuals = mut; FStar_Syntax_Syntax.ds - = c_lids;_} + = c_lids; + FStar_Syntax_Syntax.injective_type_params + = uu___11;_} -> Obj.repr (let erasable @@ -7351,36 +7439,36 @@ let (t_destruct : FStar_Syntax_Util.has_attribute se.FStar_Syntax_Syntax.sigattrs FStar_Parser_Const.erasable_attr in - let uu___11 - = let uu___12 = + let uu___13 + = erasable && - (let uu___13 + (let uu___14 = is_irrelevant g in Prims.op_Negation - uu___13) in + uu___14) in failwhen - uu___12 + uu___13 "cannot destruct erasable type to solve proof-relevant goal" in FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___11 - (fun uu___12 + (fun + uu___13 -> (fun - uu___12 + uu___13 -> - let uu___12 + let uu___13 = Obj.magic - uu___12 in - let uu___13 + uu___13 in + let uu___14 = failwhen ((FStar_Compiler_List.length @@ -7392,34 +7480,34 @@ let (t_destruct : (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___13 - (fun uu___14 + (fun + uu___15 -> (fun - uu___14 + uu___15 -> - let uu___14 + let uu___15 = Obj.magic - uu___14 in - let uu___15 + uu___15 in + let uu___16 = FStar_Syntax_Subst.open_term t_ps t_ty in - match uu___15 + match uu___16 with | (t_ps1, t_ty1) -> - let uu___16 + let uu___17 = Obj.magic (FStar_Class_Monad.mapM FStar_Tactics_Monad.monad_tac () () (fun - uu___17 + uu___18 -> (fun c_lid -> @@ -7427,16 +7515,16 @@ let (t_destruct : = Obj.magic c_lid in - let uu___17 - = let uu___18 = + let uu___19 + = FStar_Tactics_Types.goal_env g in FStar_TypeChecker_Env.lookup_sigelt - uu___18 + uu___19 c_lid in - match uu___17 + match uu___18 with | FStar_Pervasives_Native.None @@ -7457,17 +7545,19 @@ let (t_destruct : FStar_Syntax_Syntax.Sig_datacon { FStar_Syntax_Syntax.lid1 - = uu___18; + = uu___19; FStar_Syntax_Syntax.us1 = c_us; FStar_Syntax_Syntax.t1 = c_ty; FStar_Syntax_Syntax.ty_lid - = uu___19; + = uu___20; FStar_Syntax_Syntax.num_ty_params = nparam; FStar_Syntax_Syntax.mutuals1 - = mut1;_} + = mut1; + FStar_Syntax_Syntax.injective_type_params1 + = uu___21;_} -> Obj.repr (let fv1 @@ -7476,7 +7566,7 @@ let (t_destruct : c_lid (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor) in - let uu___20 + let uu___22 = failwhen ((FStar_Compiler_List.length @@ -7487,17 +7577,17 @@ let (t_destruct : FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___20 + uu___22 (fun - uu___21 + uu___23 -> (fun - uu___21 + uu___23 -> - let uu___21 + let uu___23 = Obj.magic - uu___21 in + uu___23 in let s = FStar_TypeChecker_Env.mk_univ_subst c_us a_us in @@ -7505,26 +7595,26 @@ let (t_destruct : = FStar_Syntax_Subst.subst s c_ty in - let uu___22 + let uu___24 = FStar_TypeChecker_Env.inst_tscheme (c_us, c_ty1) in - match uu___22 + match uu___24 with | (c_us1, c_ty2) -> - let uu___23 + let uu___25 = FStar_Syntax_Util.arrow_formals_comp c_ty2 in - (match uu___23 + (match uu___25 with | (bs, comp) -> - let uu___24 + let uu___26 = let rename_bv bv = @@ -7533,26 +7623,26 @@ let (t_destruct : bv.FStar_Syntax_Syntax.ppname in let ppname1 = - let uu___25 + let uu___27 = - let uu___26 + let uu___28 = - let uu___27 + let uu___29 = FStar_Class_Show.show FStar_Ident.showable_ident ppname in Prims.strcat "a" - uu___27 in - let uu___27 + uu___29 in + let uu___29 = FStar_Ident.range_of_id ppname in - (uu___26, - uu___27) in + (uu___28, + uu___29) in FStar_Ident.mk_ident - uu___25 in + uu___27 in FStar_Syntax_Syntax.freshen_bv { FStar_Syntax_Syntax.ppname @@ -7567,13 +7657,13 @@ let (t_destruct : let bs' = FStar_Compiler_List.map (fun b -> - let uu___25 + let uu___27 = rename_bv b.FStar_Syntax_Syntax.binder_bv in { FStar_Syntax_Syntax.binder_bv - = uu___25; + = uu___27; FStar_Syntax_Syntax.binder_qual = (b.FStar_Syntax_Syntax.binder_qual); @@ -7588,100 +7678,100 @@ let (t_destruct : = FStar_Compiler_List.map2 (fun - uu___25 + uu___27 -> fun - uu___26 + uu___28 -> match - (uu___25, - uu___26) + (uu___27, + uu___28) with | ({ FStar_Syntax_Syntax.binder_bv = bv; FStar_Syntax_Syntax.binder_qual - = uu___27; + = uu___29; FStar_Syntax_Syntax.binder_positivity - = uu___28; + = uu___30; FStar_Syntax_Syntax.binder_attrs - = uu___29;_}, + = uu___31;_}, { FStar_Syntax_Syntax.binder_bv = bv'; FStar_Syntax_Syntax.binder_qual - = uu___30; + = uu___32; FStar_Syntax_Syntax.binder_positivity - = uu___31; + = uu___33; FStar_Syntax_Syntax.binder_attrs - = uu___32;_}) + = uu___34;_}) -> - let uu___33 + let uu___35 = - let uu___34 + let uu___36 = FStar_Syntax_Syntax.bv_to_name bv' in (bv, - uu___34) in + uu___36) in FStar_Syntax_Syntax.NT - uu___33) + uu___35) bs bs' in - let uu___25 + let uu___27 = FStar_Syntax_Subst.subst_binders subst bs' in - let uu___26 + let uu___28 = FStar_Syntax_Subst.subst_comp subst comp in - (uu___25, - uu___26) in - (match uu___24 + (uu___27, + uu___28) in + (match uu___26 with | (bs1, comp1) -> - let uu___25 + let uu___27 = FStar_Compiler_List.splitAt nparam bs1 in - (match uu___25 + (match uu___27 with | (d_ps, bs2) -> - let uu___26 + let uu___28 = - let uu___27 + let uu___29 = - let uu___28 + let uu___30 = FStar_Syntax_Util.is_total_comp comp1 in Prims.op_Negation - uu___28 in + uu___30 in failwhen - uu___27 + uu___29 "not total?" in Obj.magic (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___26 + uu___28 (fun - uu___27 + uu___29 -> (fun - uu___27 + uu___29 -> - let uu___27 + let uu___29 = Obj.magic - uu___27 in + uu___29 in let mk_pat p = { @@ -7692,28 +7782,28 @@ let (t_destruct : (s_tm1.FStar_Syntax_Syntax.pos) } in let is_imp - uu___28 = - match uu___28 + uu___30 = + match uu___30 with | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit - uu___29) + uu___31) -> true | - uu___29 + uu___31 -> false in - let uu___28 + let uu___30 = FStar_Compiler_List.splitAt nparam args in - match uu___28 + match uu___30 with | (a_ps, a_is) -> - let uu___29 + let uu___31 = failwhen ((FStar_Compiler_List.length @@ -7725,17 +7815,17 @@ let (t_destruct : (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___29 + uu___31 (fun - uu___30 + uu___32 -> (fun - uu___30 + uu___32 -> - let uu___30 + let uu___32 = Obj.magic - uu___30 in + uu___32 in let d_ps_a_ps = FStar_Compiler_List.zip @@ -7744,22 +7834,22 @@ let (t_destruct : = FStar_Compiler_List.map (fun - uu___31 + uu___33 -> - match uu___31 + match uu___33 with | ({ FStar_Syntax_Syntax.binder_bv = bv; FStar_Syntax_Syntax.binder_qual - = uu___32; + = uu___34; FStar_Syntax_Syntax.binder_positivity - = uu___33; + = uu___35; FStar_Syntax_Syntax.binder_attrs - = uu___34;_}, + = uu___36;_}, (t, - uu___35)) + uu___37)) -> FStar_Syntax_Syntax.NT (bv, t)) @@ -7771,22 +7861,22 @@ let (t_destruct : = FStar_Compiler_List.map (fun - uu___31 + uu___33 -> - match uu___31 + match uu___33 with | ({ FStar_Syntax_Syntax.binder_bv = bv; FStar_Syntax_Syntax.binder_qual - = uu___32; + = uu___34; FStar_Syntax_Syntax.binder_positivity - = uu___33; + = uu___35; FStar_Syntax_Syntax.binder_attrs - = uu___34;_}, + = uu___36;_}, (t, - uu___35)) + uu___37)) -> ((mk_pat (FStar_Syntax_Syntax.Pat_dot_term @@ -7798,9 +7888,9 @@ let (t_destruct : = FStar_Compiler_List.map (fun - uu___31 + uu___33 -> - match uu___31 + match uu___33 with | { @@ -7809,9 +7899,9 @@ let (t_destruct : FStar_Syntax_Syntax.binder_qual = bq; FStar_Syntax_Syntax.binder_positivity - = uu___32; + = uu___34; FStar_Syntax_Syntax.binder_attrs - = uu___33;_} + = uu___35;_} -> ((mk_pat (FStar_Syntax_Syntax.Pat_var @@ -7841,7 +7931,7 @@ let (t_destruct : env1.FStar_TypeChecker_Env.universe_of env1 s_ty1 in - let uu___31 + let uu___33 = FStar_TypeChecker_TcTerm.tc_pat { @@ -8002,23 +8092,23 @@ let (t_destruct : (env1.FStar_TypeChecker_Env.core_check) } s_ty1 pat in - match uu___31 + match uu___33 with | - (uu___32, - uu___33, - uu___34, + (uu___34, uu___35, - pat_t, uu___36, + uu___37, + pat_t, + uu___38, _guard_pat, _erasable) -> let eq_b = - let uu___37 + let uu___39 = - let uu___38 + let uu___40 = FStar_Syntax_Util.mk_eq2 equ s_ty1 @@ -8026,38 +8116,38 @@ let (t_destruct : pat_t in FStar_Syntax_Util.mk_squash FStar_Syntax_Syntax.U_zero - uu___38 in + uu___40 in FStar_Syntax_Syntax.gen_bv "breq" FStar_Pervasives_Native.None - uu___37 in + uu___39 in let cod1 = - let uu___37 + let uu___39 = - let uu___38 + let uu___40 = FStar_Syntax_Syntax.mk_binder eq_b in - [uu___38] in - let uu___38 + [uu___40] in + let uu___40 = FStar_Syntax_Syntax.mk_Total cod in FStar_Syntax_Util.arrow - uu___37 - uu___38 in + uu___39 + uu___40 in let nty = - let uu___37 + let uu___39 = FStar_Syntax_Syntax.mk_Total cod1 in FStar_Syntax_Util.arrow bs3 - uu___37 in - let uu___37 + uu___39 in + let uu___39 = - let uu___38 + let uu___40 = goal_typedness_deps g in @@ -8065,7 +8155,7 @@ let (t_destruct : "destruct branch" env1 nty FStar_Pervasives_Native.None - uu___38 + uu___40 (rangeof g) in Obj.magic @@ -8073,18 +8163,18 @@ let (t_destruct : FStar_Tactics_Monad.monad_tac () () (Obj.magic - uu___37) + uu___39) (fun - uu___38 + uu___40 -> (fun - uu___38 + uu___40 -> - let uu___38 + let uu___40 = Obj.magic - uu___38 in - match uu___38 + uu___40 in + match uu___40 with | (uvt, uv) @@ -8100,48 +8190,48 @@ let (t_destruct : uvt bs3 in let brt1 = - let uu___39 + let uu___41 = - let uu___40 + let uu___42 = FStar_Syntax_Syntax.as_arg FStar_Syntax_Util.exp_unit in - [uu___40] in + [uu___42] in FStar_Syntax_Util.mk_app brt - uu___39 in + uu___41 in let br = FStar_Syntax_Subst.close_branch (pat, FStar_Pervasives_Native.None, brt1) in - let uu___39 + let uu___41 = - let uu___40 + let uu___42 = - let uu___41 + let uu___43 = FStar_BigInt.of_int_fs (FStar_Compiler_List.length bs3) in (fv1, - uu___41) in + uu___43) in (g', br, - uu___40) in + uu___42) in Obj.magic (ret - uu___39)) - uu___38))) - uu___30))) - uu___27)))))) - uu___21)) + uu___41)) + uu___40))) + uu___32))) + uu___29)))))) + uu___23)) | - uu___18 + uu___19 -> Obj.repr (FStar_Tactics_Monad.fail "impossible: not a ctor")))) - uu___17) + uu___18) (Obj.magic c_lids)) in Obj.magic @@ -8149,9 +8239,9 @@ let (t_destruct : FStar_Tactics_Monad.monad_tac () () (Obj.magic - uu___16) + uu___17) (fun - uu___17 + uu___18 -> (fun goal_brs @@ -8160,11 +8250,11 @@ let (t_destruct : = Obj.magic goal_brs in - let uu___17 + let uu___18 = FStar_Compiler_List.unzip3 goal_brs in - match uu___17 + match uu___18 with | (goals, @@ -8186,7 +8276,7 @@ let (t_destruct : FStar_Pervasives_Native.None }) s_tm1.FStar_Syntax_Syntax.pos in - let uu___18 + let uu___19 = solve' g w in @@ -8194,21 +8284,21 @@ let (t_destruct : (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___18 - (fun uu___19 + (fun + uu___20 -> (fun - uu___19 + uu___20 -> - let uu___19 + let uu___20 = Obj.magic - uu___19 in + uu___20 in mark_goal_implicit_already_checked g; ( - let uu___21 + let uu___22 = FStar_Tactics_Monad.add_goals goals in @@ -8216,25 +8306,25 @@ let (t_destruct : (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___21 - (fun uu___22 + (fun + uu___23 -> (fun - uu___22 + uu___23 -> - let uu___22 + let uu___23 = Obj.magic - uu___22 in + uu___23 in Obj.magic (ret infos)) - uu___22)))) - uu___19))) - uu___17))) - uu___14))) - uu___12)) + uu___23)))) + uu___20))) + uu___18))) + uu___15))) + uu___13)) | uu___9 -> Obj.repr @@ -8811,7 +8901,9 @@ let (lset : (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = uu___1; FStar_Tactics_Types.urgency = - (ps.FStar_Tactics_Types.urgency) + (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in Obj.magic (FStar_Tactics_Monad.set ps1)) uu___1) in FStar_Tactics_Monad.wrap_err "lset" uu___ @@ -8845,7 +8937,9 @@ let (set_urgency : FStar_BigInt.t -> unit FStar_Tactics_Monad.tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = uu___ + FStar_Tactics_Types.urgency = uu___; + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in Obj.magic (FStar_Tactics_Monad.set ps1)) uu___) let (t_commute_applied_match : unit -> unit FStar_Tactics_Monad.tac) = @@ -9143,7 +9237,8 @@ let (comp_to_string : let (range_to_string : FStar_Compiler_Range_Type.range -> Prims.string FStar_Tactics_Monad.tac) = fun r -> - let uu___ = FStar_Class_Show.show FStar_Compiler_Range_Ops.show_range r in + let uu___ = + FStar_Class_Show.show FStar_Compiler_Range_Ops.showable_range r in ret uu___ let (term_eq_old : FStar_Syntax_Syntax.term -> @@ -9266,8 +9361,11 @@ let (free_uvars : let uvs = let uu___1 = let uu___2 = FStar_Syntax_Free.uvars_uncached tm in - FStar_Compiler_Set.elems FStar_Syntax_Free.ord_ctx_uvar - uu___2 in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uu___2) in FStar_Compiler_List.map (fun u -> let uu___2 = @@ -9278,8 +9376,7 @@ let (free_uvars : let (dbg_refl : env -> (unit -> Prims.string) -> unit) = fun g -> fun msg -> - let uu___ = - FStar_TypeChecker_Env.debug g (FStar_Options.Other "ReflTc") in + let uu___ = FStar_Compiler_Effect.op_Bang dbg_ReflTc in if uu___ then let uu___1 = msg () in FStar_Compiler_Util.print_string uu___1 else () @@ -9321,9 +9418,16 @@ let refl_typing_builtin_wrapper : let (no_uvars_in_term : FStar_Syntax_Syntax.term -> Prims.bool) = fun t -> (let uu___ = FStar_Syntax_Free.uvars t in - FStar_Compiler_Set.is_empty FStar_Syntax_Free.ord_ctx_uvar uu___) && + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___)) + && (let uu___ = FStar_Syntax_Free.univs t in - FStar_Compiler_Set.is_empty FStar_Syntax_Free.ord_univ_uvar uu___) + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_univ_uvar)) (Obj.magic uu___)) let (no_uvars_in_g : env -> Prims.bool) = fun g -> FStar_Compiler_Util.for_all diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V1_Derived.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V1_Derived.ml index c572860bd14..2229ca26f9d 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V1_Derived.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V1_Derived.ml @@ -458,12 +458,12 @@ let (debug : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (143)) (Prims.of_int (7)) (Prims.of_int (143)) + (Prims.of_int (142)) (Prims.of_int (7)) (Prims.of_int (142)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (143)) (Prims.of_int (4)) (Prims.of_int (143)) + (Prims.of_int (142)) (Prims.of_int (4)) (Prims.of_int (142)) (Prims.of_int (32))))) (Obj.magic (FStar_Tactics_V1_Builtins.debugging ())) (fun uu___ -> @@ -481,25 +481,25 @@ let (smt : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (150)) (Prims.of_int (10)) (Prims.of_int (150)) + (Prims.of_int (149)) (Prims.of_int (10)) (Prims.of_int (149)) (Prims.of_int (32))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (150)) (Prims.of_int (4)) (Prims.of_int (156)) + (Prims.of_int (149)) (Prims.of_int (4)) (Prims.of_int (155)) (Prims.of_int (11))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (150)) (Prims.of_int (10)) - (Prims.of_int (150)) (Prims.of_int (18))))) + (Prims.of_int (149)) (Prims.of_int (10)) + (Prims.of_int (149)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (150)) (Prims.of_int (10)) - (Prims.of_int (150)) (Prims.of_int (32))))) + (Prims.of_int (149)) (Prims.of_int (10)) + (Prims.of_int (149)) (Prims.of_int (32))))) (Obj.magic (goals ())) (fun uu___1 -> (fun uu___1 -> @@ -509,14 +509,14 @@ let (smt : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (150)) (Prims.of_int (20)) - (Prims.of_int (150)) (Prims.of_int (32))))) + (Prims.of_int (149)) (Prims.of_int (20)) + (Prims.of_int (149)) (Prims.of_int (32))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (150)) (Prims.of_int (10)) - (Prims.of_int (150)) (Prims.of_int (32))))) + (Prims.of_int (149)) (Prims.of_int (10)) + (Prims.of_int (149)) (Prims.of_int (32))))) (Obj.magic (smt_goals ())) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -534,14 +534,14 @@ let (smt : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (154)) (Prims.of_int (8)) - (Prims.of_int (154)) (Prims.of_int (20))))) + (Prims.of_int (153)) (Prims.of_int (8)) + (Prims.of_int (153)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (155)) (Prims.of_int (8)) - (Prims.of_int (155)) (Prims.of_int (32))))) + (Prims.of_int (154)) (Prims.of_int (8)) + (Prims.of_int (154)) (Prims.of_int (32))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_goals gs)) (fun uu___2 -> (fun uu___2 -> @@ -559,12 +559,12 @@ let (later : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (162)) (Prims.of_int (10)) (Prims.of_int (162)) + (Prims.of_int (161)) (Prims.of_int (10)) (Prims.of_int (161)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (162)) (Prims.of_int (4)) (Prims.of_int (164)) + (Prims.of_int (161)) (Prims.of_int (4)) (Prims.of_int (163)) (Prims.of_int (33))))) (Obj.magic (goals ())) (fun uu___1 -> (fun uu___1 -> @@ -616,12 +616,12 @@ let (t_pointwise : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (223)) (Prims.of_int (4)) (Prims.of_int (223)) + (Prims.of_int (222)) (Prims.of_int (4)) (Prims.of_int (222)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (224)) (Prims.of_int (4)) (Prims.of_int (228)) + (Prims.of_int (223)) (Prims.of_int (4)) (Prims.of_int (227)) (Prims.of_int (24))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> @@ -639,13 +639,13 @@ let (t_pointwise : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (226)) (Prims.of_int (4)) - (Prims.of_int (226)) (Prims.of_int (10))))) + (Prims.of_int (225)) (Prims.of_int (4)) + (Prims.of_int (225)) (Prims.of_int (10))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (228)) (Prims.of_int (2)) - (Prims.of_int (228)) (Prims.of_int (24))))) + (Prims.of_int (227)) (Prims.of_int (2)) + (Prims.of_int (227)) (Prims.of_int (24))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> fun uu___1 -> tau ())) (fun uu___ -> @@ -666,12 +666,12 @@ let (topdown_rewrite : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (252)) (Prims.of_int (49)) - (Prims.of_int (261)) (Prims.of_int (10))))) + (Prims.of_int (251)) (Prims.of_int (49)) + (Prims.of_int (260)) (Prims.of_int (10))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (263)) (Prims.of_int (4)) (Prims.of_int (263)) + (Prims.of_int (262)) (Prims.of_int (4)) (Prims.of_int (262)) (Prims.of_int (33))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> @@ -680,13 +680,13 @@ let (topdown_rewrite : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (253)) (Prims.of_int (17)) - (Prims.of_int (253)) (Prims.of_int (23))))) + (Prims.of_int (252)) (Prims.of_int (17)) + (Prims.of_int (252)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (252)) (Prims.of_int (49)) - (Prims.of_int (261)) (Prims.of_int (10))))) + (Prims.of_int (251)) (Prims.of_int (49)) + (Prims.of_int (260)) (Prims.of_int (10))))) (Obj.magic (ctrl t)) (fun uu___1 -> (fun uu___1 -> @@ -698,17 +698,17 @@ let (topdown_rewrite : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (255)) + (Prims.of_int (254)) (Prims.of_int (8)) - (Prims.of_int (259)) + (Prims.of_int (258)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (261)) + (Prims.of_int (260)) (Prims.of_int (6)) - (Prims.of_int (261)) + (Prims.of_int (260)) (Prims.of_int (10))))) (match i with | uu___2 when uu___2 = Prims.int_zero -> @@ -751,12 +751,12 @@ let (cur_module : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (269)) (Prims.of_int (13)) (Prims.of_int (269)) + (Prims.of_int (268)) (Prims.of_int (13)) (Prims.of_int (268)) (Prims.of_int (25))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (269)) (Prims.of_int (4)) (Prims.of_int (269)) + (Prims.of_int (268)) (Prims.of_int (4)) (Prims.of_int (268)) (Prims.of_int (25))))) (Obj.magic (FStar_Tactics_V1_Builtins.top_env ())) (fun uu___1 -> @@ -772,12 +772,12 @@ let (open_modules : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (272)) (Prims.of_int (21)) (Prims.of_int (272)) + (Prims.of_int (271)) (Prims.of_int (21)) (Prims.of_int (271)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (272)) (Prims.of_int (4)) (Prims.of_int (272)) + (Prims.of_int (271)) (Prims.of_int (4)) (Prims.of_int (271)) (Prims.of_int (33))))) (Obj.magic (FStar_Tactics_V1_Builtins.top_env ())) (fun uu___1 -> @@ -793,12 +793,12 @@ let (fresh_uvar : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (275)) (Prims.of_int (12)) (Prims.of_int (275)) + (Prims.of_int (274)) (Prims.of_int (12)) (Prims.of_int (274)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (276)) (Prims.of_int (4)) (Prims.of_int (276)) + (Prims.of_int (275)) (Prims.of_int (4)) (Prims.of_int (275)) (Prims.of_int (16))))) (Obj.magic (cur_env ())) (fun uu___ -> (fun e -> Obj.magic (FStar_Tactics_V1_Builtins.uvar_env e o)) uu___) @@ -813,12 +813,12 @@ let (unify : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (279)) (Prims.of_int (12)) - (Prims.of_int (279)) (Prims.of_int (22))))) + (Prims.of_int (278)) (Prims.of_int (12)) + (Prims.of_int (278)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (280)) (Prims.of_int (4)) (Prims.of_int (280)) + (Prims.of_int (279)) (Prims.of_int (4)) (Prims.of_int (279)) (Prims.of_int (21))))) (Obj.magic (cur_env ())) (fun uu___ -> (fun e -> Obj.magic (FStar_Tactics_V1_Builtins.unify_env e t1 t2)) @@ -834,12 +834,12 @@ let (unify_guard : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (283)) (Prims.of_int (12)) - (Prims.of_int (283)) (Prims.of_int (22))))) + (Prims.of_int (282)) (Prims.of_int (12)) + (Prims.of_int (282)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (284)) (Prims.of_int (4)) (Prims.of_int (284)) + (Prims.of_int (283)) (Prims.of_int (4)) (Prims.of_int (283)) (Prims.of_int (27))))) (Obj.magic (cur_env ())) (fun uu___ -> (fun e -> @@ -856,12 +856,12 @@ let (tmatch : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (287)) (Prims.of_int (12)) - (Prims.of_int (287)) (Prims.of_int (22))))) + (Prims.of_int (286)) (Prims.of_int (12)) + (Prims.of_int (286)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (288)) (Prims.of_int (4)) (Prims.of_int (288)) + (Prims.of_int (287)) (Prims.of_int (4)) (Prims.of_int (287)) (Prims.of_int (21))))) (Obj.magic (cur_env ())) (fun uu___ -> (fun e -> Obj.magic (FStar_Tactics_V1_Builtins.match_env e t1 t2)) @@ -880,13 +880,13 @@ let divide : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (294)) (Prims.of_int (4)) - (Prims.of_int (295)) (Prims.of_int (31))))) + (Prims.of_int (293)) (Prims.of_int (4)) + (Prims.of_int (294)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (295)) (Prims.of_int (32)) - (Prims.of_int (308)) (Prims.of_int (10))))) + (Prims.of_int (294)) (Prims.of_int (32)) + (Prims.of_int (307)) (Prims.of_int (10))))) (if n < Prims.int_zero then fail "divide: negative n" else FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> ())) @@ -898,28 +898,28 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (296)) (Prims.of_int (18)) - (Prims.of_int (296)) (Prims.of_int (40))))) + (Prims.of_int (295)) (Prims.of_int (18)) + (Prims.of_int (295)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (295)) (Prims.of_int (32)) - (Prims.of_int (308)) (Prims.of_int (10))))) + (Prims.of_int (294)) (Prims.of_int (32)) + (Prims.of_int (307)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (296)) (Prims.of_int (18)) - (Prims.of_int (296)) (Prims.of_int (26))))) + (Prims.of_int (295)) (Prims.of_int (18)) + (Prims.of_int (295)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (296)) (Prims.of_int (18)) - (Prims.of_int (296)) (Prims.of_int (40))))) + (Prims.of_int (295)) (Prims.of_int (18)) + (Prims.of_int (295)) (Prims.of_int (40))))) (Obj.magic (goals ())) (fun uu___1 -> (fun uu___1 -> @@ -929,17 +929,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (296)) + (Prims.of_int (295)) (Prims.of_int (28)) - (Prims.of_int (296)) + (Prims.of_int (295)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (296)) + (Prims.of_int (295)) (Prims.of_int (18)) - (Prims.of_int (296)) + (Prims.of_int (295)) (Prims.of_int (40))))) (Obj.magic (smt_goals ())) (fun uu___2 -> @@ -956,17 +956,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (297)) + (Prims.of_int (296)) (Prims.of_int (19)) - (Prims.of_int (297)) + (Prims.of_int (296)) (Prims.of_int (45))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (296)) + (Prims.of_int (295)) (Prims.of_int (43)) - (Prims.of_int (308)) + (Prims.of_int (307)) (Prims.of_int (10))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> @@ -981,17 +981,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (299)) + (Prims.of_int (298)) (Prims.of_int (4)) - (Prims.of_int (299)) + (Prims.of_int (298)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (299)) + (Prims.of_int (298)) (Prims.of_int (19)) - (Prims.of_int (308)) + (Prims.of_int (307)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_goals @@ -1005,18 +1005,18 @@ let divide : ( FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (299)) + (Prims.of_int (298)) (Prims.of_int (19)) - (Prims.of_int (299)) + (Prims.of_int (298)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic ( FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (299)) + (Prims.of_int (298)) (Prims.of_int (36)) - (Prims.of_int (308)) + (Prims.of_int (307)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_smt_goals @@ -1030,17 +1030,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (300)) + (Prims.of_int (299)) (Prims.of_int (12)) - (Prims.of_int (300)) + (Prims.of_int (299)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (300)) + (Prims.of_int (299)) (Prims.of_int (19)) - (Prims.of_int (308)) + (Prims.of_int (307)) (Prims.of_int (10))))) (Obj.magic (l ())) @@ -1053,17 +1053,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (301)) + (Prims.of_int (300)) (Prims.of_int (20)) - (Prims.of_int (301)) + (Prims.of_int (300)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (300)) + (Prims.of_int (299)) (Prims.of_int (19)) - (Prims.of_int (308)) + (Prims.of_int (307)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1071,17 +1071,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (301)) + (Prims.of_int (300)) (Prims.of_int (20)) - (Prims.of_int (301)) + (Prims.of_int (300)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (301)) + (Prims.of_int (300)) (Prims.of_int (20)) - (Prims.of_int (301)) + (Prims.of_int (300)) (Prims.of_int (42))))) (Obj.magic (goals ())) @@ -1095,17 +1095,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (301)) + (Prims.of_int (300)) (Prims.of_int (30)) - (Prims.of_int (301)) + (Prims.of_int (300)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (301)) + (Prims.of_int (300)) (Prims.of_int (20)) - (Prims.of_int (301)) + (Prims.of_int (300)) (Prims.of_int (42))))) (Obj.magic (smt_goals @@ -1133,17 +1133,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (303)) + (Prims.of_int (302)) (Prims.of_int (4)) - (Prims.of_int (303)) + (Prims.of_int (302)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (303)) + (Prims.of_int (302)) (Prims.of_int (19)) - (Prims.of_int (308)) + (Prims.of_int (307)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_goals @@ -1158,17 +1158,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (303)) + (Prims.of_int (302)) (Prims.of_int (19)) - (Prims.of_int (303)) + (Prims.of_int (302)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (303)) + (Prims.of_int (302)) (Prims.of_int (36)) - (Prims.of_int (308)) + (Prims.of_int (307)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_smt_goals @@ -1183,17 +1183,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (304)) + (Prims.of_int (303)) (Prims.of_int (12)) - (Prims.of_int (304)) + (Prims.of_int (303)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (304)) + (Prims.of_int (303)) (Prims.of_int (19)) - (Prims.of_int (308)) + (Prims.of_int (307)) (Prims.of_int (10))))) (Obj.magic (r ())) @@ -1206,17 +1206,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (305)) + (Prims.of_int (304)) (Prims.of_int (20)) - (Prims.of_int (305)) + (Prims.of_int (304)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (304)) + (Prims.of_int (303)) (Prims.of_int (19)) - (Prims.of_int (308)) + (Prims.of_int (307)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1224,17 +1224,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (305)) + (Prims.of_int (304)) (Prims.of_int (20)) - (Prims.of_int (305)) + (Prims.of_int (304)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (305)) + (Prims.of_int (304)) (Prims.of_int (20)) - (Prims.of_int (305)) + (Prims.of_int (304)) (Prims.of_int (42))))) (Obj.magic (goals ())) @@ -1248,17 +1248,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (305)) + (Prims.of_int (304)) (Prims.of_int (30)) - (Prims.of_int (305)) + (Prims.of_int (304)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (305)) + (Prims.of_int (304)) (Prims.of_int (20)) - (Prims.of_int (305)) + (Prims.of_int (304)) (Prims.of_int (42))))) (Obj.magic (smt_goals @@ -1287,17 +1287,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (307)) + (Prims.of_int (306)) (Prims.of_int (4)) - (Prims.of_int (307)) + (Prims.of_int (306)) (Prims.of_int (25))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (307)) + (Prims.of_int (306)) (Prims.of_int (27)) - (Prims.of_int (308)) + (Prims.of_int (307)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_goals @@ -1314,17 +1314,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (307)) + (Prims.of_int (306)) (Prims.of_int (27)) - (Prims.of_int (307)) + (Prims.of_int (306)) (Prims.of_int (60))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (308)) + (Prims.of_int (307)) (Prims.of_int (4)) - (Prims.of_int (308)) + (Prims.of_int (307)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_smt_goals @@ -1364,13 +1364,13 @@ let rec (iseq : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (312)) (Prims.of_int (23)) - (Prims.of_int (312)) (Prims.of_int (53))))) + (Prims.of_int (311)) (Prims.of_int (23)) + (Prims.of_int (311)) (Prims.of_int (53))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (312)) (Prims.of_int (57)) - (Prims.of_int (312)) (Prims.of_int (59))))) + (Prims.of_int (311)) (Prims.of_int (57)) + (Prims.of_int (311)) (Prims.of_int (59))))) (Obj.magic (divide Prims.int_one t (fun uu___ -> iseq ts1))) (fun uu___ -> @@ -1389,12 +1389,12 @@ let focus : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (318)) (Prims.of_int (10)) (Prims.of_int (318)) + (Prims.of_int (317)) (Prims.of_int (10)) (Prims.of_int (317)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (318)) (Prims.of_int (4)) (Prims.of_int (325)) + (Prims.of_int (317)) (Prims.of_int (4)) (Prims.of_int (324)) (Prims.of_int (9))))) (Obj.magic (goals ())) (fun uu___ -> (fun uu___ -> @@ -1408,14 +1408,14 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (321)) (Prims.of_int (18)) - (Prims.of_int (321)) (Prims.of_int (30))))) + (Prims.of_int (320)) (Prims.of_int (18)) + (Prims.of_int (320)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (322)) (Prims.of_int (8)) - (Prims.of_int (325)) (Prims.of_int (9))))) + (Prims.of_int (321)) (Prims.of_int (8)) + (Prims.of_int (324)) (Prims.of_int (9))))) (Obj.magic (smt_goals ())) (fun uu___1 -> (fun sgs -> @@ -1425,17 +1425,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (322)) + (Prims.of_int (321)) (Prims.of_int (8)) - (Prims.of_int (322)) + (Prims.of_int (321)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (322)) + (Prims.of_int (321)) (Prims.of_int (23)) - (Prims.of_int (325)) + (Prims.of_int (324)) (Prims.of_int (9))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_goals @@ -1448,17 +1448,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (322)) + (Prims.of_int (321)) (Prims.of_int (23)) - (Prims.of_int (322)) + (Prims.of_int (321)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (322)) + (Prims.of_int (321)) (Prims.of_int (40)) - (Prims.of_int (325)) + (Prims.of_int (324)) (Prims.of_int (9))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_smt_goals @@ -1471,17 +1471,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (323)) + (Prims.of_int (322)) (Prims.of_int (16)) - (Prims.of_int (323)) + (Prims.of_int (322)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (8)) - (Prims.of_int (325)) + (Prims.of_int (324)) (Prims.of_int (9))))) (Obj.magic (t ())) (fun uu___3 -> @@ -1493,18 +1493,18 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (8)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (33))))) ( FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (35)) - (Prims.of_int (325)) + (Prims.of_int (324)) (Prims.of_int (9))))) ( Obj.magic @@ -1513,17 +1513,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (18)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (8)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (33))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1531,17 +1531,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (19)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (18)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (33))))) (Obj.magic (goals ())) @@ -1571,17 +1571,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (35)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (69))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (323)) + (Prims.of_int (322)) (Prims.of_int (12)) - (Prims.of_int (323)) + (Prims.of_int (322)) (Prims.of_int (13))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1589,17 +1589,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (49)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (69))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (35)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (69))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1607,17 +1607,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (50)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (62))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (49)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (69))))) (Obj.magic (smt_goals @@ -1660,12 +1660,12 @@ let rec mapAll : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (331)) (Prims.of_int (10)) (Prims.of_int (331)) + (Prims.of_int (330)) (Prims.of_int (10)) (Prims.of_int (330)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (331)) (Prims.of_int (4)) (Prims.of_int (333)) + (Prims.of_int (330)) (Prims.of_int (4)) (Prims.of_int (332)) (Prims.of_int (66))))) (Obj.magic (goals ())) (fun uu___ -> (fun uu___ -> @@ -1682,14 +1682,14 @@ let rec mapAll : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (333)) (Prims.of_int (27)) - (Prims.of_int (333)) (Prims.of_int (58))))) + (Prims.of_int (332)) (Prims.of_int (27)) + (Prims.of_int (332)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (333)) (Prims.of_int (13)) - (Prims.of_int (333)) (Prims.of_int (66))))) + (Prims.of_int (332)) (Prims.of_int (13)) + (Prims.of_int (332)) (Prims.of_int (66))))) (Obj.magic (divide Prims.int_one t (fun uu___3 -> mapAll t))) (fun uu___3 -> @@ -1706,12 +1706,12 @@ let rec (iterAll : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (337)) (Prims.of_int (10)) (Prims.of_int (337)) + (Prims.of_int (336)) (Prims.of_int (10)) (Prims.of_int (336)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (337)) (Prims.of_int (4)) (Prims.of_int (339)) + (Prims.of_int (336)) (Prims.of_int (4)) (Prims.of_int (338)) (Prims.of_int (60))))) (Obj.magic (goals ())) (fun uu___ -> (fun uu___ -> @@ -1728,14 +1728,14 @@ let rec (iterAll : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (339)) (Prims.of_int (22)) - (Prims.of_int (339)) (Prims.of_int (54))))) + (Prims.of_int (338)) (Prims.of_int (22)) + (Prims.of_int (338)) (Prims.of_int (54))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (339)) (Prims.of_int (58)) - (Prims.of_int (339)) (Prims.of_int (60))))) + (Prims.of_int (338)) (Prims.of_int (58)) + (Prims.of_int (338)) (Prims.of_int (60))))) (Obj.magic (divide Prims.int_one t (fun uu___3 -> iterAll t))) (fun uu___3 -> @@ -1750,25 +1750,25 @@ let (iterAllSMT : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (342)) (Prims.of_int (18)) (Prims.of_int (342)) + (Prims.of_int (341)) (Prims.of_int (18)) (Prims.of_int (341)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (341)) (Prims.of_int (50)) (Prims.of_int (348)) + (Prims.of_int (340)) (Prims.of_int (50)) (Prims.of_int (347)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (342)) (Prims.of_int (18)) - (Prims.of_int (342)) (Prims.of_int (26))))) + (Prims.of_int (341)) (Prims.of_int (18)) + (Prims.of_int (341)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (342)) (Prims.of_int (18)) - (Prims.of_int (342)) (Prims.of_int (40))))) + (Prims.of_int (341)) (Prims.of_int (18)) + (Prims.of_int (341)) (Prims.of_int (40))))) (Obj.magic (goals ())) (fun uu___ -> (fun uu___ -> @@ -1778,14 +1778,14 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (342)) (Prims.of_int (28)) - (Prims.of_int (342)) (Prims.of_int (40))))) + (Prims.of_int (341)) (Prims.of_int (28)) + (Prims.of_int (341)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (342)) (Prims.of_int (18)) - (Prims.of_int (342)) (Prims.of_int (40))))) + (Prims.of_int (341)) (Prims.of_int (18)) + (Prims.of_int (341)) (Prims.of_int (40))))) (Obj.magic (smt_goals ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -1800,14 +1800,14 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (343)) (Prims.of_int (4)) - (Prims.of_int (343)) (Prims.of_int (17))))) + (Prims.of_int (342)) (Prims.of_int (4)) + (Prims.of_int (342)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (344)) (Prims.of_int (4)) - (Prims.of_int (348)) (Prims.of_int (28))))) + (Prims.of_int (343)) (Prims.of_int (4)) + (Prims.of_int (347)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_goals sgs)) (fun uu___1 -> (fun uu___1 -> @@ -1817,17 +1817,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (344)) + (Prims.of_int (343)) (Prims.of_int (4)) - (Prims.of_int (344)) + (Prims.of_int (343)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (345)) + (Prims.of_int (344)) (Prims.of_int (4)) - (Prims.of_int (348)) + (Prims.of_int (347)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_smt_goals @@ -1840,17 +1840,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (345)) + (Prims.of_int (344)) (Prims.of_int (4)) - (Prims.of_int (345)) + (Prims.of_int (344)) (Prims.of_int (13))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (345)) + (Prims.of_int (344)) (Prims.of_int (14)) - (Prims.of_int (348)) + (Prims.of_int (347)) (Prims.of_int (28))))) (Obj.magic (iterAll t)) (fun uu___3 -> @@ -1861,17 +1861,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (346)) + (Prims.of_int (345)) (Prims.of_int (20)) - (Prims.of_int (346)) + (Prims.of_int (345)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (345)) + (Prims.of_int (344)) (Prims.of_int (14)) - (Prims.of_int (348)) + (Prims.of_int (347)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1879,17 +1879,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (346)) + (Prims.of_int (345)) (Prims.of_int (20)) - (Prims.of_int (346)) + (Prims.of_int (345)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (346)) + (Prims.of_int (345)) (Prims.of_int (20)) - (Prims.of_int (346)) + (Prims.of_int (345)) (Prims.of_int (42))))) (Obj.magic (goals ())) @@ -1902,17 +1902,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (346)) + (Prims.of_int (345)) (Prims.of_int (30)) - (Prims.of_int (346)) + (Prims.of_int (345)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (346)) + (Prims.of_int (345)) (Prims.of_int (20)) - (Prims.of_int (346)) + (Prims.of_int (345)) (Prims.of_int (42))))) (Obj.magic (smt_goals @@ -1935,17 +1935,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (347)) + (Prims.of_int (346)) (Prims.of_int (4)) - (Prims.of_int (347)) + (Prims.of_int (346)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (348)) + (Prims.of_int (347)) (Prims.of_int (4)) - (Prims.of_int (348)) + (Prims.of_int (347)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_goals @@ -1975,13 +1975,13 @@ let (seq : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (354)) (Prims.of_int (21)) - (Prims.of_int (354)) (Prims.of_int (25))))) + (Prims.of_int (353)) (Prims.of_int (21)) + (Prims.of_int (353)) (Prims.of_int (25))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (354)) (Prims.of_int (27)) - (Prims.of_int (354)) (Prims.of_int (36))))) + (Prims.of_int (353)) (Prims.of_int (27)) + (Prims.of_int (353)) (Prims.of_int (36))))) (Obj.magic (f ())) (fun uu___1 -> (fun uu___1 -> Obj.magic (iterAll g)) uu___1)) let (exact_args : @@ -1996,13 +1996,13 @@ let (exact_args : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (358)) (Prims.of_int (16)) - (Prims.of_int (358)) (Prims.of_int (39))))) + (Prims.of_int (357)) (Prims.of_int (16)) + (Prims.of_int (357)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (358)) (Prims.of_int (42)) - (Prims.of_int (364)) (Prims.of_int (44))))) + (Prims.of_int (357)) (Prims.of_int (42)) + (Prims.of_int (363)) (Prims.of_int (44))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> FStar_List_Tot_Base.length qs)) (fun uu___1 -> @@ -2013,14 +2013,14 @@ let (exact_args : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (359)) (Prims.of_int (18)) - (Prims.of_int (359)) (Prims.of_int (55))))) + (Prims.of_int (358)) (Prims.of_int (18)) + (Prims.of_int (358)) (Prims.of_int (55))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (359)) (Prims.of_int (58)) - (Prims.of_int (364)) (Prims.of_int (44))))) + (Prims.of_int (358)) (Prims.of_int (58)) + (Prims.of_int (363)) (Prims.of_int (44))))) (Obj.magic (FStar_Tactics_Util.repeatn n (fun uu___1 -> @@ -2033,17 +2033,17 @@ let (exact_args : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (360)) + (Prims.of_int (359)) (Prims.of_int (17)) - (Prims.of_int (360)) + (Prims.of_int (359)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (361)) + (Prims.of_int (360)) (Prims.of_int (8)) - (Prims.of_int (364)) + (Prims.of_int (363)) (Prims.of_int (44))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2051,17 +2051,17 @@ let (exact_args : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (360)) + (Prims.of_int (359)) (Prims.of_int (26)) - (Prims.of_int (360)) + (Prims.of_int (359)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (360)) + (Prims.of_int (359)) (Prims.of_int (17)) - (Prims.of_int (360)) + (Prims.of_int (359)) (Prims.of_int (38))))) (Obj.magic (FStar_Tactics_Util.zip uvs qs)) @@ -2078,17 +2078,17 @@ let (exact_args : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (361)) + (Prims.of_int (360)) (Prims.of_int (8)) - (Prims.of_int (361)) + (Prims.of_int (360)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (362)) + (Prims.of_int (361)) (Prims.of_int (8)) - (Prims.of_int (364)) + (Prims.of_int (363)) (Prims.of_int (44))))) (Obj.magic (exact t')) (fun uu___1 -> @@ -2126,12 +2126,12 @@ let (exact_n : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (368)) (Prims.of_int (15)) - (Prims.of_int (368)) (Prims.of_int (49))))) + (Prims.of_int (367)) (Prims.of_int (15)) + (Prims.of_int (367)) (Prims.of_int (49))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (368)) (Prims.of_int (4)) (Prims.of_int (368)) + (Prims.of_int (367)) (Prims.of_int (4)) (Prims.of_int (367)) (Prims.of_int (51))))) (Obj.magic (FStar_Tactics_Util.repeatn n @@ -2148,12 +2148,12 @@ let (ngoals : unit -> (Prims.int, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (371)) (Prims.of_int (47)) (Prims.of_int (371)) + (Prims.of_int (370)) (Prims.of_int (47)) (Prims.of_int (370)) (Prims.of_int (57))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (371)) (Prims.of_int (26)) (Prims.of_int (371)) + (Prims.of_int (370)) (Prims.of_int (26)) (Prims.of_int (370)) (Prims.of_int (57))))) (Obj.magic (goals ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -2164,12 +2164,12 @@ let (ngoals_smt : unit -> (Prims.int, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (374)) (Prims.of_int (51)) (Prims.of_int (374)) + (Prims.of_int (373)) (Prims.of_int (51)) (Prims.of_int (373)) (Prims.of_int (65))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (374)) (Prims.of_int (30)) (Prims.of_int (374)) + (Prims.of_int (373)) (Prims.of_int (30)) (Prims.of_int (373)) (Prims.of_int (65))))) (Obj.magic (smt_goals ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -2181,12 +2181,12 @@ let (fresh_bv : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (382)) (Prims.of_int (12)) (Prims.of_int (382)) + (Prims.of_int (381)) (Prims.of_int (12)) (Prims.of_int (381)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (383)) (Prims.of_int (4)) (Prims.of_int (383)) + (Prims.of_int (382)) (Prims.of_int (4)) (Prims.of_int (382)) (Prims.of_int (42))))) (Obj.magic (FStar_Tactics_V1_Builtins.fresh ())) (fun uu___1 -> @@ -2205,12 +2205,12 @@ let (fresh_binder_named : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (386)) (Prims.of_int (14)) - (Prims.of_int (386)) (Prims.of_int (33))))) + (Prims.of_int (385)) (Prims.of_int (14)) + (Prims.of_int (385)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (386)) (Prims.of_int (4)) (Prims.of_int (386)) + (Prims.of_int (385)) (Prims.of_int (4)) (Prims.of_int (385)) (Prims.of_int (35))))) (Obj.magic (FStar_Tactics_V1_Builtins.fresh_bv_named nm)) (fun uu___ -> @@ -2225,12 +2225,12 @@ let (fresh_binder : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (390)) (Prims.of_int (12)) (Prims.of_int (390)) + (Prims.of_int (389)) (Prims.of_int (12)) (Prims.of_int (389)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (391)) (Prims.of_int (4)) (Prims.of_int (391)) + (Prims.of_int (390)) (Prims.of_int (4)) (Prims.of_int (390)) (Prims.of_int (48))))) (Obj.magic (FStar_Tactics_V1_Builtins.fresh ())) (fun uu___ -> @@ -2249,12 +2249,12 @@ let (fresh_implicit_binder_named : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (394)) (Prims.of_int (23)) - (Prims.of_int (394)) (Prims.of_int (42))))) + (Prims.of_int (393)) (Prims.of_int (23)) + (Prims.of_int (393)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (394)) (Prims.of_int (4)) (Prims.of_int (394)) + (Prims.of_int (393)) (Prims.of_int (4)) (Prims.of_int (393)) (Prims.of_int (44))))) (Obj.magic (FStar_Tactics_V1_Builtins.fresh_bv_named nm)) (fun uu___ -> @@ -2270,12 +2270,12 @@ let (fresh_implicit_binder : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (398)) (Prims.of_int (12)) (Prims.of_int (398)) + (Prims.of_int (397)) (Prims.of_int (12)) (Prims.of_int (397)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (399)) (Prims.of_int (4)) (Prims.of_int (399)) + (Prims.of_int (398)) (Prims.of_int (4)) (Prims.of_int (398)) (Prims.of_int (57))))) (Obj.magic (FStar_Tactics_V1_Builtins.fresh ())) (fun uu___ -> @@ -2302,12 +2302,12 @@ let try_with : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (412)) (Prims.of_int (10)) - (Prims.of_int (412)) (Prims.of_int (17))))) + (Prims.of_int (411)) (Prims.of_int (10)) + (Prims.of_int (411)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (412)) (Prims.of_int (4)) (Prims.of_int (414)) + (Prims.of_int (411)) (Prims.of_int (4)) (Prims.of_int (413)) (Prims.of_int (16))))) (Obj.magic (FStar_Tactics_V1_Builtins.catch f)) (fun uu___ -> @@ -2333,13 +2333,13 @@ let trytac : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (417)) (Prims.of_int (13)) - (Prims.of_int (417)) (Prims.of_int (19))))) + (Prims.of_int (416)) (Prims.of_int (13)) + (Prims.of_int (416)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (417)) (Prims.of_int (8)) - (Prims.of_int (417)) (Prims.of_int (19))))) + (Prims.of_int (416)) (Prims.of_int (8)) + (Prims.of_int (416)) (Prims.of_int (19))))) (Obj.magic (t ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -2384,12 +2384,12 @@ let rec repeat : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (434)) (Prims.of_int (10)) (Prims.of_int (434)) + (Prims.of_int (433)) (Prims.of_int (10)) (Prims.of_int (433)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (434)) (Prims.of_int (4)) (Prims.of_int (436)) + (Prims.of_int (433)) (Prims.of_int (4)) (Prims.of_int (435)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_V1_Builtins.catch t)) (fun uu___ -> @@ -2407,14 +2407,14 @@ let rec repeat : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (436)) (Prims.of_int (20)) - (Prims.of_int (436)) (Prims.of_int (28))))) + (Prims.of_int (435)) (Prims.of_int (20)) + (Prims.of_int (435)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (436)) (Prims.of_int (15)) - (Prims.of_int (436)) (Prims.of_int (28))))) + (Prims.of_int (435)) (Prims.of_int (15)) + (Prims.of_int (435)) (Prims.of_int (28))))) (Obj.magic (repeat t)) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -2429,12 +2429,12 @@ let repeat1 : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (439)) (Prims.of_int (4)) (Prims.of_int (439)) + (Prims.of_int (438)) (Prims.of_int (4)) (Prims.of_int (438)) (Prims.of_int (8))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (439)) (Prims.of_int (4)) (Prims.of_int (439)) + (Prims.of_int (438)) (Prims.of_int (4)) (Prims.of_int (438)) (Prims.of_int (20))))) (Obj.magic (t ())) (fun uu___ -> (fun uu___ -> @@ -2443,13 +2443,13 @@ let repeat1 : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (439)) (Prims.of_int (12)) - (Prims.of_int (439)) (Prims.of_int (20))))) + (Prims.of_int (438)) (Prims.of_int (12)) + (Prims.of_int (438)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (439)) (Prims.of_int (4)) - (Prims.of_int (439)) (Prims.of_int (20))))) + (Prims.of_int (438)) (Prims.of_int (4)) + (Prims.of_int (438)) (Prims.of_int (20))))) (Obj.magic (repeat t)) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -2464,12 +2464,12 @@ let repeat' : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (442)) (Prims.of_int (12)) (Prims.of_int (442)) + (Prims.of_int (441)) (Prims.of_int (12)) (Prims.of_int (441)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (442)) (Prims.of_int (24)) (Prims.of_int (442)) + (Prims.of_int (441)) (Prims.of_int (24)) (Prims.of_int (441)) (Prims.of_int (26))))) (Obj.magic (repeat f)) (fun uu___ -> FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> ())) let (norm_term : @@ -2483,12 +2483,12 @@ let (norm_term : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (446)) (Prims.of_int (8)) (Prims.of_int (447)) + (Prims.of_int (445)) (Prims.of_int (8)) (Prims.of_int (446)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (449)) (Prims.of_int (4)) (Prims.of_int (449)) + (Prims.of_int (448)) (Prims.of_int (4)) (Prims.of_int (448)) (Prims.of_int (23))))) (Obj.magic (try_with (fun uu___ -> match () with | () -> cur_env ()) @@ -2504,25 +2504,25 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (456)) (Prims.of_int (16)) (Prims.of_int (456)) + (Prims.of_int (455)) (Prims.of_int (16)) (Prims.of_int (455)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (455)) (Prims.of_int (27)) (Prims.of_int (462)) + (Prims.of_int (454)) (Prims.of_int (27)) (Prims.of_int (461)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (456)) (Prims.of_int (16)) - (Prims.of_int (456)) (Prims.of_int (24))))) + (Prims.of_int (455)) (Prims.of_int (16)) + (Prims.of_int (455)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (456)) (Prims.of_int (16)) - (Prims.of_int (456)) (Prims.of_int (38))))) + (Prims.of_int (455)) (Prims.of_int (16)) + (Prims.of_int (455)) (Prims.of_int (38))))) (Obj.magic (goals ())) (fun uu___1 -> (fun uu___1 -> @@ -2532,14 +2532,14 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (456)) (Prims.of_int (26)) - (Prims.of_int (456)) (Prims.of_int (38))))) + (Prims.of_int (455)) (Prims.of_int (26)) + (Prims.of_int (455)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (456)) (Prims.of_int (16)) - (Prims.of_int (456)) (Prims.of_int (38))))) + (Prims.of_int (455)) (Prims.of_int (16)) + (Prims.of_int (455)) (Prims.of_int (38))))) (Obj.magic (smt_goals ())) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -2554,14 +2554,14 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (457)) (Prims.of_int (2)) - (Prims.of_int (457)) (Prims.of_int (18))))) + (Prims.of_int (456)) (Prims.of_int (2)) + (Prims.of_int (456)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (458)) (Prims.of_int (2)) - (Prims.of_int (462)) (Prims.of_int (20))))) + (Prims.of_int (457)) (Prims.of_int (2)) + (Prims.of_int (461)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_smt_goals [])) (fun uu___2 -> (fun uu___2 -> @@ -2571,17 +2571,17 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (458)) + (Prims.of_int (457)) (Prims.of_int (2)) - (Prims.of_int (458)) + (Prims.of_int (457)) (Prims.of_int (15))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (459)) + (Prims.of_int (458)) (Prims.of_int (2)) - (Prims.of_int (462)) + (Prims.of_int (461)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_V1_Builtins.set_goals sgs)) @@ -2593,17 +2593,17 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (459)) + (Prims.of_int (458)) (Prims.of_int (2)) - (Prims.of_int (459)) + (Prims.of_int (458)) (Prims.of_int (14))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (459)) + (Prims.of_int (458)) (Prims.of_int (15)) - (Prims.of_int (462)) + (Prims.of_int (461)) (Prims.of_int (20))))) (Obj.magic (repeat' @@ -2616,17 +2616,17 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (460)) + (Prims.of_int (459)) (Prims.of_int (13)) - (Prims.of_int (460)) + (Prims.of_int (459)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (461)) + (Prims.of_int (460)) (Prims.of_int (2)) - (Prims.of_int (462)) + (Prims.of_int (461)) (Prims.of_int (20))))) (Obj.magic (goals ())) (fun uu___5 -> @@ -2638,18 +2638,18 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (461)) + (Prims.of_int (460)) (Prims.of_int (2)) - (Prims.of_int (461)) + (Prims.of_int (460)) (Prims.of_int (14))))) (FStar_Sealed.seal ( Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (462)) + (Prims.of_int (461)) (Prims.of_int (2)) - (Prims.of_int (462)) + (Prims.of_int (461)) (Prims.of_int (20))))) (Obj.magic ( @@ -2676,13 +2676,13 @@ let discard : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (465)) (Prims.of_int (22)) - (Prims.of_int (465)) (Prims.of_int (28))))) + (Prims.of_int (464)) (Prims.of_int (22)) + (Prims.of_int (464)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (465)) (Prims.of_int (32)) - (Prims.of_int (465)) (Prims.of_int (34))))) + (Prims.of_int (464)) (Prims.of_int (32)) + (Prims.of_int (464)) (Prims.of_int (34))))) (Obj.magic (tau ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ())) let rec repeatseq : @@ -2695,12 +2695,12 @@ let rec repeatseq : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (469)) (Prims.of_int (12)) (Prims.of_int (469)) + (Prims.of_int (468)) (Prims.of_int (12)) (Prims.of_int (468)) (Prims.of_int (82))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (469)) (Prims.of_int (86)) (Prims.of_int (469)) + (Prims.of_int (468)) (Prims.of_int (86)) (Prims.of_int (468)) (Prims.of_int (88))))) (Obj.magic (trytac @@ -2720,12 +2720,12 @@ let (admit_all : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (477)) (Prims.of_int (12)) (Prims.of_int (477)) + (Prims.of_int (476)) (Prims.of_int (12)) (Prims.of_int (476)) (Prims.of_int (25))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (478)) (Prims.of_int (4)) (Prims.of_int (478)) + (Prims.of_int (477)) (Prims.of_int (4)) (Prims.of_int (477)) (Prims.of_int (6))))) (Obj.magic (repeat tadmit)) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ())) let (is_guard : unit -> (Prims.bool, unit) FStar_Tactics_Effect.tac_repr) = @@ -2734,12 +2734,12 @@ let (is_guard : unit -> (Prims.bool, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (482)) (Prims.of_int (33)) (Prims.of_int (482)) + (Prims.of_int (481)) (Prims.of_int (33)) (Prims.of_int (481)) (Prims.of_int (47))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (482)) (Prims.of_int (4)) (Prims.of_int (482)) + (Prims.of_int (481)) (Prims.of_int (4)) (Prims.of_int (481)) (Prims.of_int (47))))) (Obj.magic (_cur_goal ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -2750,12 +2750,12 @@ let (skip_guard : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (485)) (Prims.of_int (7)) (Prims.of_int (485)) + (Prims.of_int (484)) (Prims.of_int (7)) (Prims.of_int (484)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (485)) (Prims.of_int (4)) (Prims.of_int (487)) + (Prims.of_int (484)) (Prims.of_int (4)) (Prims.of_int (486)) (Prims.of_int (16))))) (Obj.magic (is_guard ())) (fun uu___1 -> (fun uu___1 -> @@ -2768,12 +2768,12 @@ let (guards_to_smt : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (490)) (Prims.of_int (12)) (Prims.of_int (490)) + (Prims.of_int (489)) (Prims.of_int (12)) (Prims.of_int (489)) (Prims.of_int (29))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (491)) (Prims.of_int (4)) (Prims.of_int (491)) + (Prims.of_int (490)) (Prims.of_int (4)) (Prims.of_int (490)) (Prims.of_int (6))))) (Obj.magic (repeat skip_guard)) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ())) let (simpl : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = @@ -2805,12 +2805,12 @@ let (intros' : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (499)) (Prims.of_int (36)) (Prims.of_int (499)) + (Prims.of_int (498)) (Prims.of_int (36)) (Prims.of_int (498)) (Prims.of_int (45))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (499)) (Prims.of_int (49)) (Prims.of_int (499)) + (Prims.of_int (498)) (Prims.of_int (49)) (Prims.of_int (498)) (Prims.of_int (51))))) (Obj.magic (intros ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ())) let (destruct : @@ -2821,12 +2821,12 @@ let (destruct : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (500)) (Prims.of_int (37)) (Prims.of_int (500)) + (Prims.of_int (499)) (Prims.of_int (37)) (Prims.of_int (499)) (Prims.of_int (50))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (500)) (Prims.of_int (54)) (Prims.of_int (500)) + (Prims.of_int (499)) (Prims.of_int (54)) (Prims.of_int (499)) (Prims.of_int (56))))) (Obj.magic (FStar_Tactics_V1_Builtins.t_destruct tm)) (fun uu___ -> FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> ())) @@ -2840,13 +2840,13 @@ let (destruct_intros : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (501)) (Prims.of_int (59)) - (Prims.of_int (501)) (Prims.of_int (72))))) + (Prims.of_int (500)) (Prims.of_int (59)) + (Prims.of_int (500)) (Prims.of_int (72))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (501)) (Prims.of_int (76)) - (Prims.of_int (501)) (Prims.of_int (78))))) + (Prims.of_int (500)) (Prims.of_int (76)) + (Prims.of_int (500)) (Prims.of_int (78))))) (Obj.magic (FStar_Tactics_V1_Builtins.t_destruct tm)) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ()))) intros' @@ -2860,12 +2860,12 @@ let (tcut : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (507)) (Prims.of_int (12)) (Prims.of_int (507)) + (Prims.of_int (506)) (Prims.of_int (12)) (Prims.of_int (506)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (507)) (Prims.of_int (26)) (Prims.of_int (510)) + (Prims.of_int (506)) (Prims.of_int (26)) (Prims.of_int (509)) (Prims.of_int (12))))) (Obj.magic (cur_goal ())) (fun uu___ -> (fun g -> @@ -2874,13 +2874,13 @@ let (tcut : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (508)) (Prims.of_int (13)) - (Prims.of_int (508)) (Prims.of_int (37))))) + (Prims.of_int (507)) (Prims.of_int (13)) + (Prims.of_int (507)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (509)) (Prims.of_int (4)) - (Prims.of_int (510)) (Prims.of_int (12))))) + (Prims.of_int (508)) (Prims.of_int (4)) + (Prims.of_int (509)) (Prims.of_int (12))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> FStar_Reflection_V1_Derived.mk_e_app @@ -2900,14 +2900,14 @@ let (tcut : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (509)) (Prims.of_int (4)) - (Prims.of_int (509)) (Prims.of_int (12))))) + (Prims.of_int (508)) (Prims.of_int (4)) + (Prims.of_int (508)) (Prims.of_int (12))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (510)) (Prims.of_int (4)) - (Prims.of_int (510)) (Prims.of_int (12))))) + (Prims.of_int (509)) (Prims.of_int (4)) + (Prims.of_int (509)) (Prims.of_int (12))))) (Obj.magic (apply tt)) (fun uu___ -> (fun uu___ -> @@ -2923,12 +2923,12 @@ let (pose : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (513)) (Prims.of_int (4)) (Prims.of_int (513)) + (Prims.of_int (512)) (Prims.of_int (4)) (Prims.of_int (512)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (514)) (Prims.of_int (4)) (Prims.of_int (516)) + (Prims.of_int (513)) (Prims.of_int (4)) (Prims.of_int (515)) (Prims.of_int (12))))) (Obj.magic (apply @@ -2943,13 +2943,13 @@ let (pose : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (514)) (Prims.of_int (4)) - (Prims.of_int (514)) (Prims.of_int (11))))) + (Prims.of_int (513)) (Prims.of_int (4)) + (Prims.of_int (513)) (Prims.of_int (11))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (515)) (Prims.of_int (4)) - (Prims.of_int (516)) (Prims.of_int (12))))) + (Prims.of_int (514)) (Prims.of_int (4)) + (Prims.of_int (515)) (Prims.of_int (12))))) (Obj.magic (flip ())) (fun uu___1 -> (fun uu___1 -> @@ -2959,14 +2959,14 @@ let (pose : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (515)) (Prims.of_int (4)) - (Prims.of_int (515)) (Prims.of_int (11))))) + (Prims.of_int (514)) (Prims.of_int (4)) + (Prims.of_int (514)) (Prims.of_int (11))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (516)) (Prims.of_int (4)) - (Prims.of_int (516)) (Prims.of_int (12))))) + (Prims.of_int (515)) (Prims.of_int (4)) + (Prims.of_int (515)) (Prims.of_int (12))))) (Obj.magic (exact t)) (fun uu___2 -> (fun uu___2 -> @@ -2982,12 +2982,12 @@ let (intro_as : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (519)) (Prims.of_int (12)) (Prims.of_int (519)) + (Prims.of_int (518)) (Prims.of_int (12)) (Prims.of_int (518)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (520)) (Prims.of_int (4)) (Prims.of_int (520)) + (Prims.of_int (519)) (Prims.of_int (4)) (Prims.of_int (519)) (Prims.of_int (17))))) (Obj.magic (FStar_Tactics_V1_Builtins.intro ())) (fun uu___ -> @@ -3003,12 +3003,12 @@ let (pose_as : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (523)) (Prims.of_int (12)) - (Prims.of_int (523)) (Prims.of_int (18))))) + (Prims.of_int (522)) (Prims.of_int (12)) + (Prims.of_int (522)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (524)) (Prims.of_int (4)) (Prims.of_int (524)) + (Prims.of_int (523)) (Prims.of_int (4)) (Prims.of_int (523)) (Prims.of_int (17))))) (Obj.magic (pose t)) (fun uu___ -> (fun b -> Obj.magic (FStar_Tactics_V1_Builtins.rename_to b s)) @@ -3024,12 +3024,12 @@ let for_each_binder : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (527)) (Prims.of_int (10)) (Prims.of_int (527)) + (Prims.of_int (526)) (Prims.of_int (10)) (Prims.of_int (526)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (527)) (Prims.of_int (4)) (Prims.of_int (527)) + (Prims.of_int (526)) (Prims.of_int (4)) (Prims.of_int (526)) (Prims.of_int (26))))) (Obj.magic (cur_binders ())) (fun uu___ -> (fun uu___ -> Obj.magic (FStar_Tactics_Util.map f uu___)) uu___) @@ -3050,13 +3050,13 @@ let rec (revert_all : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (532)) (Prims.of_int (15)) - (Prims.of_int (532)) (Prims.of_int (24))))) + (Prims.of_int (531)) (Prims.of_int (15)) + (Prims.of_int (531)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (533)) (Prims.of_int (15)) - (Prims.of_int (533)) (Prims.of_int (28))))) + (Prims.of_int (532)) (Prims.of_int (15)) + (Prims.of_int (532)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_V1_Builtins.revert ())) (fun uu___1 -> (fun uu___1 -> Obj.magic (revert_all tl)) uu___1)))) @@ -3076,12 +3076,12 @@ let (binder_to_term : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (540)) (Prims.of_int (14)) (Prims.of_int (540)) + (Prims.of_int (539)) (Prims.of_int (14)) (Prims.of_int (539)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (541)) (Prims.of_int (2)) (Prims.of_int (541)) + (Prims.of_int (540)) (Prims.of_int (2)) (Prims.of_int (540)) (Prims.of_int (28))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> FStar_Reflection_V1_Builtins.inspect_binder b)) @@ -3115,13 +3115,13 @@ let rec (__assumption_aux : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (553)) (Prims.of_int (16)) - (Prims.of_int (553)) (Prims.of_int (32))))) + (Prims.of_int (552)) (Prims.of_int (16)) + (Prims.of_int (552)) (Prims.of_int (32))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (554)) (Prims.of_int (8)) - (Prims.of_int (557)) (Prims.of_int (27))))) + (Prims.of_int (553)) (Prims.of_int (8)) + (Prims.of_int (556)) (Prims.of_int (27))))) (Obj.magic (binder_to_term b)) (fun uu___ -> (fun t -> @@ -3138,17 +3138,17 @@ let rec (__assumption_aux : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (555)) + (Prims.of_int (554)) (Prims.of_int (13)) - (Prims.of_int (555)) + (Prims.of_int (554)) (Prims.of_int (48))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (556)) + (Prims.of_int (555)) (Prims.of_int (13)) - (Prims.of_int (556)) + (Prims.of_int (555)) (Prims.of_int (20))))) (Obj.magic (apply @@ -3169,12 +3169,12 @@ let (assumption : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (560)) (Prims.of_int (21)) (Prims.of_int (560)) + (Prims.of_int (559)) (Prims.of_int (21)) (Prims.of_int (559)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (560)) (Prims.of_int (4)) (Prims.of_int (560)) + (Prims.of_int (559)) (Prims.of_int (4)) (Prims.of_int (559)) (Prims.of_int (37))))) (Obj.magic (cur_binders ())) (fun uu___1 -> (fun uu___1 -> Obj.magic (__assumption_aux uu___1)) uu___1) @@ -3189,12 +3189,12 @@ let (destruct_equality_implication : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (563)) (Prims.of_int (10)) (Prims.of_int (563)) + (Prims.of_int (562)) (Prims.of_int (10)) (Prims.of_int (562)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (563)) (Prims.of_int (4)) (Prims.of_int (570)) + (Prims.of_int (562)) (Prims.of_int (4)) (Prims.of_int (569)) (Prims.of_int (15))))) (Obj.magic (FStar_Reflection_V1_Formula.term_as_formula t)) (fun uu___ -> @@ -3208,14 +3208,14 @@ let (destruct_equality_implication : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (565)) (Prims.of_int (18)) - (Prims.of_int (565)) (Prims.of_int (38))))) + (Prims.of_int (564)) (Prims.of_int (18)) + (Prims.of_int (564)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (566)) (Prims.of_int (14)) - (Prims.of_int (568)) (Prims.of_int (19))))) + (Prims.of_int (565)) (Prims.of_int (14)) + (Prims.of_int (567)) (Prims.of_int (19))))) (Obj.magic (FStar_Reflection_V1_Formula.term_as_formula' lhs)) (fun lhs1 -> @@ -3244,13 +3244,13 @@ let (rewrite' : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (579)) (Prims.of_int (20)) - (Prims.of_int (579)) (Prims.of_int (35))))) + (Prims.of_int (578)) (Prims.of_int (20)) + (Prims.of_int (578)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (580)) (Prims.of_int (20)) - (Prims.of_int (581)) (Prims.of_int (29))))) + (Prims.of_int (579)) (Prims.of_int (20)) + (Prims.of_int (580)) (Prims.of_int (29))))) (Obj.magic (FStar_Tactics_V1_Builtins.binder_retype b)) (fun uu___1 -> (fun uu___1 -> @@ -3260,14 +3260,14 @@ let (rewrite' : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (580)) (Prims.of_int (20)) - (Prims.of_int (580)) (Prims.of_int (43))))) + (Prims.of_int (579)) (Prims.of_int (20)) + (Prims.of_int (579)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (581)) (Prims.of_int (20)) - (Prims.of_int (581)) (Prims.of_int (29))))) + (Prims.of_int (580)) (Prims.of_int (20)) + (Prims.of_int (580)) (Prims.of_int (29))))) (Obj.magic (apply_lemma (FStar_Reflection_V2_Builtins.pack_ln @@ -3307,14 +3307,14 @@ let rec (try_rewrite_equality : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (589)) (Prims.of_int (20)) - (Prims.of_int (589)) (Prims.of_int (56))))) + (Prims.of_int (588)) (Prims.of_int (20)) + (Prims.of_int (588)) (Prims.of_int (56))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (589)) (Prims.of_int (14)) - (Prims.of_int (595)) (Prims.of_int (37))))) + (Prims.of_int (588)) (Prims.of_int (14)) + (Prims.of_int (594)) (Prims.of_int (37))))) (Obj.magic (FStar_Reflection_V1_Formula.term_as_formula (FStar_Reflection_V1_Derived.type_of_binder x_t))) @@ -3350,13 +3350,13 @@ let rec (rewrite_all_context_equalities : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (602)) (Prims.of_int (8)) - (Prims.of_int (602)) (Prims.of_int (40))))) + (Prims.of_int (601)) (Prims.of_int (8)) + (Prims.of_int (601)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (603)) (Prims.of_int (8)) - (Prims.of_int (603)) (Prims.of_int (41))))) + (Prims.of_int (602)) (Prims.of_int (8)) + (Prims.of_int (602)) (Prims.of_int (41))))) (Obj.magic (try_with (fun uu___ -> @@ -3378,12 +3378,12 @@ let (rewrite_eqs_from_context : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (607)) (Prims.of_int (35)) (Prims.of_int (607)) + (Prims.of_int (606)) (Prims.of_int (35)) (Prims.of_int (606)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (607)) (Prims.of_int (4)) (Prims.of_int (607)) + (Prims.of_int (606)) (Prims.of_int (4)) (Prims.of_int (606)) (Prims.of_int (51))))) (Obj.magic (cur_binders ())) (fun uu___1 -> (fun uu___1 -> Obj.magic (rewrite_all_context_equalities uu___1)) @@ -3396,12 +3396,12 @@ let (rewrite_equality : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (610)) (Prims.of_int (27)) (Prims.of_int (610)) + (Prims.of_int (609)) (Prims.of_int (27)) (Prims.of_int (609)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (610)) (Prims.of_int (4)) (Prims.of_int (610)) + (Prims.of_int (609)) (Prims.of_int (4)) (Prims.of_int (609)) (Prims.of_int (43))))) (Obj.magic (cur_binders ())) (fun uu___ -> (fun uu___ -> Obj.magic (try_rewrite_equality t uu___)) uu___) @@ -3413,12 +3413,12 @@ let (unfold_def : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (613)) (Prims.of_int (10)) (Prims.of_int (613)) + (Prims.of_int (612)) (Prims.of_int (10)) (Prims.of_int (612)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (613)) (Prims.of_int (4)) (Prims.of_int (617)) + (Prims.of_int (612)) (Prims.of_int (4)) (Prims.of_int (616)) (Prims.of_int (46))))) (Obj.magic (FStar_Tactics_V1_Builtins.inspect t)) (fun uu___ -> @@ -3432,14 +3432,14 @@ let (unfold_def : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (615)) (Prims.of_int (16)) - (Prims.of_int (615)) (Prims.of_int (42))))) + (Prims.of_int (614)) (Prims.of_int (16)) + (Prims.of_int (614)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (616)) (Prims.of_int (8)) - (Prims.of_int (616)) (Prims.of_int (30))))) + (Prims.of_int (615)) (Prims.of_int (8)) + (Prims.of_int (615)) (Prims.of_int (30))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> FStar_Reflection_V1_Builtins.implode_qn @@ -3462,12 +3462,12 @@ let (l_to_r : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (624)) (Prims.of_int (8)) (Prims.of_int (627)) + (Prims.of_int (623)) (Prims.of_int (8)) (Prims.of_int (626)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (628)) (Prims.of_int (4)) (Prims.of_int (628)) + (Prims.of_int (627)) (Prims.of_int (4)) (Prims.of_int (627)) (Prims.of_int (28))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> @@ -3476,13 +3476,13 @@ let (l_to_r : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (624)) (Prims.of_int (8)) - (Prims.of_int (627)) (Prims.of_int (31))))) + (Prims.of_int (623)) (Prims.of_int (8)) + (Prims.of_int (626)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (624)) (Prims.of_int (8)) - (Prims.of_int (627)) (Prims.of_int (31))))) + (Prims.of_int (623)) (Prims.of_int (8)) + (Prims.of_int (626)) (Prims.of_int (31))))) (Obj.magic (FStar_Tactics_Util.fold_left (fun uu___3 -> @@ -3530,13 +3530,13 @@ let (grewrite : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (641)) (Prims.of_int (12)) - (Prims.of_int (641)) (Prims.of_int (33))))) + (Prims.of_int (640)) (Prims.of_int (12)) + (Prims.of_int (640)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (641)) (Prims.of_int (36)) - (Prims.of_int (655)) (Prims.of_int (44))))) + (Prims.of_int (640)) (Prims.of_int (36)) + (Prims.of_int (654)) (Prims.of_int (44))))) (Obj.magic (tcut (mk_sq_eq t1 t2))) (fun uu___ -> (fun e -> @@ -3545,13 +3545,13 @@ let (grewrite : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (642)) (Prims.of_int (12)) - (Prims.of_int (642)) (Prims.of_int (45))))) + (Prims.of_int (641)) (Prims.of_int (12)) + (Prims.of_int (641)) (Prims.of_int (45))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (643)) (Prims.of_int (4)) - (Prims.of_int (655)) (Prims.of_int (44))))) + (Prims.of_int (642)) (Prims.of_int (4)) + (Prims.of_int (654)) (Prims.of_int (44))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> FStar_Reflection_V1_Builtins.pack_ln @@ -3567,17 +3567,17 @@ let (grewrite : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (646)) + (Prims.of_int (645)) (Prims.of_int (8)) - (Prims.of_int (651)) + (Prims.of_int (650)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (653)) + (Prims.of_int (652)) (Prims.of_int (6)) - (Prims.of_int (655)) + (Prims.of_int (654)) (Prims.of_int (43))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3585,17 +3585,17 @@ let (grewrite : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (646)) + (Prims.of_int (645)) (Prims.of_int (14)) - (Prims.of_int (646)) + (Prims.of_int (645)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (646)) + (Prims.of_int (645)) (Prims.of_int (8)) - (Prims.of_int (651)) + (Prims.of_int (650)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3603,17 +3603,17 @@ let (grewrite : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (646)) + (Prims.of_int (645)) (Prims.of_int (30)) - (Prims.of_int (646)) + (Prims.of_int (645)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (646)) + (Prims.of_int (645)) (Prims.of_int (14)) - (Prims.of_int (646)) + (Prims.of_int (645)) (Prims.of_int (42))))) (Obj.magic (cur_goal ())) (fun uu___1 -> @@ -3657,12 +3657,12 @@ let (grewrite_eq : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (662)) (Prims.of_int (8)) (Prims.of_int (662)) + (Prims.of_int (661)) (Prims.of_int (8)) (Prims.of_int (661)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (662)) (Prims.of_int (2)) (Prims.of_int (674)) + (Prims.of_int (661)) (Prims.of_int (2)) (Prims.of_int (673)) (Prims.of_int (7))))) (Obj.magic (FStar_Reflection_V1_Formula.term_as_formula @@ -3678,14 +3678,14 @@ let (grewrite_eq : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (664)) (Prims.of_int (4)) - (Prims.of_int (664)) (Prims.of_int (16))))) + (Prims.of_int (663)) (Prims.of_int (4)) + (Prims.of_int (663)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (665)) (Prims.of_int (4)) - (Prims.of_int (665)) (Prims.of_int (54))))) + (Prims.of_int (664)) (Prims.of_int (4)) + (Prims.of_int (664)) (Prims.of_int (54))))) (Obj.magic (grewrite l r)) (fun uu___2 -> (fun uu___2 -> @@ -3698,17 +3698,17 @@ let (grewrite_eq : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (665)) + (Prims.of_int (664)) (Prims.of_int (34)) - (Prims.of_int (665)) + (Prims.of_int (664)) (Prims.of_int (52))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (665)) + (Prims.of_int (664)) (Prims.of_int (28)) - (Prims.of_int (665)) + (Prims.of_int (664)) (Prims.of_int (52))))) (Obj.magic (binder_to_term b)) (fun uu___4 -> @@ -3722,14 +3722,14 @@ let (grewrite_eq : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (667)) (Prims.of_int (16)) - (Prims.of_int (667)) (Prims.of_int (51))))) + (Prims.of_int (666)) (Prims.of_int (16)) + (Prims.of_int (666)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (667)) (Prims.of_int (10)) - (Prims.of_int (673)) (Prims.of_int (56))))) + (Prims.of_int (666)) (Prims.of_int (10)) + (Prims.of_int (672)) (Prims.of_int (56))))) (Obj.magic (FStar_Reflection_V1_Formula.term_as_formula' (FStar_Reflection_V1_Derived.type_of_binder b))) @@ -3746,17 +3746,17 @@ let (grewrite_eq : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (669)) + (Prims.of_int (668)) (Prims.of_int (6)) - (Prims.of_int (669)) + (Prims.of_int (668)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (670)) + (Prims.of_int (669)) (Prims.of_int (6)) - (Prims.of_int (671)) + (Prims.of_int (670)) (Prims.of_int (56))))) (Obj.magic (grewrite l r)) (fun uu___4 -> @@ -3770,17 +3770,17 @@ let (grewrite_eq : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (670)) + (Prims.of_int (669)) (Prims.of_int (30)) - (Prims.of_int (670)) + (Prims.of_int (669)) (Prims.of_int (55))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (671)) + (Prims.of_int (670)) (Prims.of_int (30)) - (Prims.of_int (671)) + (Prims.of_int (670)) (Prims.of_int (54))))) (Obj.magic (apply_lemma @@ -3800,17 +3800,17 @@ let (grewrite_eq : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (671)) + (Prims.of_int (670)) (Prims.of_int (36)) - (Prims.of_int (671)) + (Prims.of_int (670)) (Prims.of_int (54))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (671)) + (Prims.of_int (670)) (Prims.of_int (30)) - (Prims.of_int (671)) + (Prims.of_int (670)) (Prims.of_int (54))))) (Obj.magic (binder_to_term @@ -3848,14 +3848,14 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (696)) (Prims.of_int (8)) - (Prims.of_int (696)) (Prims.of_int (43))))) + (Prims.of_int (695)) (Prims.of_int (8)) + (Prims.of_int (695)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (696)) (Prims.of_int (45)) - (Prims.of_int (696)) (Prims.of_int (52))))) + (Prims.of_int (695)) (Prims.of_int (45)) + (Prims.of_int (695)) (Prims.of_int (52))))) (Obj.magic (apply (FStar_Reflection_V2_Builtins.pack_ln @@ -3879,17 +3879,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (702)) + (Prims.of_int (701)) (Prims.of_int (13)) - (Prims.of_int (702)) + (Prims.of_int (701)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (702)) + (Prims.of_int (701)) (Prims.of_int (33)) - (Prims.of_int (751)) + (Prims.of_int (750)) (Prims.of_int (41))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3897,17 +3897,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (702)) + (Prims.of_int (701)) (Prims.of_int (16)) - (Prims.of_int (702)) + (Prims.of_int (701)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (702)) + (Prims.of_int (701)) (Prims.of_int (13)) - (Prims.of_int (702)) + (Prims.of_int (701)) (Prims.of_int (30))))) (Obj.magic (cur_env ())) (fun uu___4 -> @@ -3923,17 +3923,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (703)) + (Prims.of_int (702)) (Prims.of_int (17)) - (Prims.of_int (703)) + (Prims.of_int (702)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (702)) + (Prims.of_int (701)) (Prims.of_int (33)) - (Prims.of_int (751)) + (Prims.of_int (750)) (Prims.of_int (41))))) (Obj.magic (FStar_Tactics_V1_SyntaxHelpers.collect_arr @@ -3957,18 +3957,18 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (707)) + (Prims.of_int (706)) (Prims.of_int (18)) - (Prims.of_int (707)) + (Prims.of_int (706)) (Prims.of_int (32))))) ( FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (707)) + (Prims.of_int (706)) (Prims.of_int (35)) - (Prims.of_int (716)) + (Prims.of_int (715)) (Prims.of_int (41))))) ( FStar_Tactics_Effect.lift_div_tac @@ -3992,17 +3992,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (708)) + (Prims.of_int (707)) (Prims.of_int (18)) - (Prims.of_int (708)) + (Prims.of_int (707)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (710)) + (Prims.of_int (709)) (Prims.of_int (7)) - (Prims.of_int (716)) + (Prims.of_int (715)) (Prims.of_int (41))))) (Obj.magic (norm_term @@ -4017,17 +4017,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (710)) + (Prims.of_int (709)) (Prims.of_int (13)) - (Prims.of_int (710)) + (Prims.of_int (709)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (710)) + (Prims.of_int (709)) (Prims.of_int (7)) - (Prims.of_int (716)) + (Prims.of_int (715)) (Prims.of_int (41))))) (Obj.magic (FStar_Reflection_V1_Formula.term_as_formula' @@ -4048,17 +4048,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (712)) + (Prims.of_int (711)) (Prims.of_int (11)) - (Prims.of_int (712)) + (Prims.of_int (711)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (713)) + (Prims.of_int (712)) (Prims.of_int (11)) - (Prims.of_int (713)) + (Prims.of_int (712)) (Prims.of_int (38))))) (Obj.magic (apply_lemma @@ -4104,17 +4104,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (724)) + (Prims.of_int (723)) (Prims.of_int (18)) - (Prims.of_int (724)) + (Prims.of_int (723)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (726)) + (Prims.of_int (725)) (Prims.of_int (9)) - (Prims.of_int (732)) + (Prims.of_int (731)) (Prims.of_int (43))))) (Obj.magic (norm_term @@ -4129,17 +4129,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (726)) + (Prims.of_int (725)) (Prims.of_int (15)) - (Prims.of_int (726)) + (Prims.of_int (725)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (726)) + (Prims.of_int (725)) (Prims.of_int (9)) - (Prims.of_int (732)) + (Prims.of_int (731)) (Prims.of_int (43))))) (Obj.magic (FStar_Reflection_V1_Formula.term_as_formula' @@ -4160,17 +4160,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (728)) + (Prims.of_int (727)) (Prims.of_int (13)) - (Prims.of_int (728)) + (Prims.of_int (727)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (729)) + (Prims.of_int (728)) (Prims.of_int (13)) - (Prims.of_int (729)) + (Prims.of_int (728)) (Prims.of_int (40))))) (Obj.magic (apply_lemma @@ -4207,17 +4207,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (739)) + (Prims.of_int (738)) (Prims.of_int (18)) - (Prims.of_int (739)) + (Prims.of_int (738)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (741)) + (Prims.of_int (740)) (Prims.of_int (9)) - (Prims.of_int (748)) + (Prims.of_int (747)) (Prims.of_int (20))))) (Obj.magic (norm_term @@ -4232,17 +4232,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (741)) + (Prims.of_int (740)) (Prims.of_int (15)) - (Prims.of_int (741)) + (Prims.of_int (740)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (741)) + (Prims.of_int (740)) (Prims.of_int (9)) - (Prims.of_int (748)) + (Prims.of_int (747)) (Prims.of_int (20))))) (Obj.magic (FStar_Reflection_V1_Formula.term_as_formula' @@ -4262,17 +4262,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (743)) + (Prims.of_int (742)) (Prims.of_int (13)) - (Prims.of_int (743)) + (Prims.of_int (742)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (744)) + (Prims.of_int (743)) (Prims.of_int (13)) - (Prims.of_int (744)) + (Prims.of_int (743)) (Prims.of_int (40))))) (Obj.magic (apply_lemma @@ -4302,17 +4302,17 @@ let rec (apply_squash_or_lem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (747)) + (Prims.of_int (746)) (Prims.of_int (13)) - (Prims.of_int (747)) + (Prims.of_int (746)) (Prims.of_int (48))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (748)) + (Prims.of_int (747)) (Prims.of_int (13)) - (Prims.of_int (748)) + (Prims.of_int (747)) (Prims.of_int (20))))) (Obj.magic (apply @@ -4346,12 +4346,12 @@ let (admit_dump_t : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (761)) (Prims.of_int (2)) (Prims.of_int (761)) + (Prims.of_int (760)) (Prims.of_int (2)) (Prims.of_int (760)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (762)) (Prims.of_int (2)) (Prims.of_int (762)) + (Prims.of_int (761)) (Prims.of_int (2)) (Prims.of_int (761)) (Prims.of_int (16))))) (Obj.magic (FStar_Tactics_V1_Builtins.dump "Admitting")) (fun uu___1 -> @@ -4369,12 +4369,12 @@ let (magic_dump_t : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (769)) (Prims.of_int (2)) (Prims.of_int (769)) + (Prims.of_int (768)) (Prims.of_int (2)) (Prims.of_int (768)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (770)) (Prims.of_int (2)) (Prims.of_int (772)) + (Prims.of_int (769)) (Prims.of_int (2)) (Prims.of_int (771)) (Prims.of_int (4))))) (Obj.magic (FStar_Tactics_V1_Builtins.dump "Admitting")) (fun uu___1 -> @@ -4384,13 +4384,13 @@ let (magic_dump_t : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (770)) (Prims.of_int (2)) - (Prims.of_int (770)) (Prims.of_int (16))))) + (Prims.of_int (769)) (Prims.of_int (2)) + (Prims.of_int (769)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (771)) (Prims.of_int (2)) - (Prims.of_int (772)) (Prims.of_int (4))))) + (Prims.of_int (770)) (Prims.of_int (2)) + (Prims.of_int (771)) (Prims.of_int (4))))) (Obj.magic (apply (FStar_Reflection_V2_Builtins.pack_ln @@ -4405,14 +4405,14 @@ let (magic_dump_t : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (771)) (Prims.of_int (2)) - (Prims.of_int (771)) (Prims.of_int (13))))) + (Prims.of_int (770)) (Prims.of_int (2)) + (Prims.of_int (770)) (Prims.of_int (13))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (772)) (Prims.of_int (2)) - (Prims.of_int (772)) (Prims.of_int (4))))) + (Prims.of_int (771)) (Prims.of_int (2)) + (Prims.of_int (771)) (Prims.of_int (4))))) (Obj.magic (exact (FStar_Reflection_V2_Builtins.pack_ln @@ -4434,13 +4434,13 @@ let (change_with : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (779)) (Prims.of_int (8)) - (Prims.of_int (779)) (Prims.of_int (22))))) + (Prims.of_int (778)) (Prims.of_int (8)) + (Prims.of_int (778)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (780)) (Prims.of_int (8)) - (Prims.of_int (780)) (Prims.of_int (29))))) + (Prims.of_int (779)) (Prims.of_int (8)) + (Prims.of_int (779)) (Prims.of_int (29))))) (Obj.magic (grewrite t1 t2)) (fun uu___1 -> (fun uu___1 -> Obj.magic (iseq [idtac; trivial])) uu___1)) @@ -4464,12 +4464,12 @@ let finish_by : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (787)) (Prims.of_int (12)) (Prims.of_int (787)) + (Prims.of_int (786)) (Prims.of_int (12)) (Prims.of_int (786)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (788)) (Prims.of_int (4)) (Prims.of_int (789)) + (Prims.of_int (787)) (Prims.of_int (4)) (Prims.of_int (788)) (Prims.of_int (5))))) (Obj.magic (t ())) (fun uu___ -> (fun x -> @@ -4478,13 +4478,13 @@ let finish_by : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (788)) (Prims.of_int (4)) - (Prims.of_int (788)) (Prims.of_int (58))))) + (Prims.of_int (787)) (Prims.of_int (4)) + (Prims.of_int (787)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (787)) (Prims.of_int (8)) - (Prims.of_int (787)) (Prims.of_int (9))))) + (Prims.of_int (786)) (Prims.of_int (8)) + (Prims.of_int (786)) (Prims.of_int (9))))) (Obj.magic (or_else qed (fun uu___ -> @@ -4506,13 +4506,13 @@ let solve_then : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (792)) (Prims.of_int (4)) (Prims.of_int (792)) + (Prims.of_int (791)) (Prims.of_int (4)) (Prims.of_int (791)) (Prims.of_int (10))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (792)) (Prims.of_int (11)) - (Prims.of_int (796)) (Prims.of_int (5))))) + (Prims.of_int (791)) (Prims.of_int (11)) + (Prims.of_int (795)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V1_Builtins.dup ())) (fun uu___ -> (fun uu___ -> @@ -4521,13 +4521,13 @@ let solve_then : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (793)) (Prims.of_int (12)) - (Prims.of_int (793)) (Prims.of_int (42))))) + (Prims.of_int (792)) (Prims.of_int (12)) + (Prims.of_int (792)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (793)) (Prims.of_int (45)) - (Prims.of_int (796)) (Prims.of_int (5))))) + (Prims.of_int (792)) (Prims.of_int (45)) + (Prims.of_int (795)) (Prims.of_int (5))))) (Obj.magic (focus (fun uu___1 -> finish_by t1))) (fun uu___1 -> (fun x -> @@ -4537,17 +4537,17 @@ let solve_then : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (794)) + (Prims.of_int (793)) (Prims.of_int (12)) - (Prims.of_int (794)) + (Prims.of_int (793)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (795)) + (Prims.of_int (794)) (Prims.of_int (4)) - (Prims.of_int (796)) + (Prims.of_int (795)) (Prims.of_int (5))))) (Obj.magic (t2 x)) (fun uu___1 -> @@ -4558,17 +4558,17 @@ let solve_then : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (795)) + (Prims.of_int (794)) (Prims.of_int (4)) - (Prims.of_int (795)) + (Prims.of_int (794)) (Prims.of_int (12))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (794)) + (Prims.of_int (793)) (Prims.of_int (8)) - (Prims.of_int (794)) + (Prims.of_int (793)) (Prims.of_int (9))))) (Obj.magic (trefl ())) (fun uu___1 -> @@ -4587,13 +4587,13 @@ let add_elem : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (799)) (Prims.of_int (4)) - (Prims.of_int (799)) (Prims.of_int (17))))) + (Prims.of_int (798)) (Prims.of_int (4)) + (Prims.of_int (798)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (800)) (Prims.of_int (4)) - (Prims.of_int (804)) (Prims.of_int (5))))) + (Prims.of_int (799)) (Prims.of_int (4)) + (Prims.of_int (803)) (Prims.of_int (5))))) (Obj.magic (apply (FStar_Reflection_V2_Builtins.pack_ln @@ -4610,14 +4610,14 @@ let add_elem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (801)) (Prims.of_int (14)) - (Prims.of_int (801)) (Prims.of_int (18))))) + (Prims.of_int (800)) (Prims.of_int (14)) + (Prims.of_int (800)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (802)) (Prims.of_int (6)) - (Prims.of_int (803)) (Prims.of_int (7))))) + (Prims.of_int (801)) (Prims.of_int (6)) + (Prims.of_int (802)) (Prims.of_int (7))))) (Obj.magic (t ())) (fun uu___3 -> (fun x -> @@ -4627,17 +4627,17 @@ let add_elem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (802)) + (Prims.of_int (801)) (Prims.of_int (6)) - (Prims.of_int (802)) + (Prims.of_int (801)) (Prims.of_int (12))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (801)) + (Prims.of_int (800)) (Prims.of_int (10)) - (Prims.of_int (801)) + (Prims.of_int (800)) (Prims.of_int (11))))) (Obj.magic (qed ())) (fun uu___3 -> @@ -4659,13 +4659,13 @@ let specialize : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (823)) (Prims.of_int (42)) - (Prims.of_int (823)) (Prims.of_int (51))))) + (Prims.of_int (822)) (Prims.of_int (42)) + (Prims.of_int (822)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (823)) (Prims.of_int (36)) - (Prims.of_int (823)) (Prims.of_int (51))))) + (Prims.of_int (822)) (Prims.of_int (36)) + (Prims.of_int (822)) (Prims.of_int (51))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> (fun uu___2 -> @@ -4685,12 +4685,12 @@ let (tlabel : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (826)) (Prims.of_int (10)) (Prims.of_int (826)) + (Prims.of_int (825)) (Prims.of_int (10)) (Prims.of_int (825)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (826)) (Prims.of_int (4)) (Prims.of_int (829)) + (Prims.of_int (825)) (Prims.of_int (4)) (Prims.of_int (828)) (Prims.of_int (38))))) (Obj.magic (goals ())) (fun uu___ -> (fun uu___ -> @@ -4707,12 +4707,12 @@ let (tlabel' : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (832)) (Prims.of_int (10)) (Prims.of_int (832)) + (Prims.of_int (831)) (Prims.of_int (10)) (Prims.of_int (831)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (832)) (Prims.of_int (4)) (Prims.of_int (836)) + (Prims.of_int (831)) (Prims.of_int (4)) (Prims.of_int (835)) (Prims.of_int (26))))) (Obj.magic (goals ())) (fun uu___ -> (fun uu___ -> @@ -4726,14 +4726,14 @@ let (tlabel' : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (835)) (Prims.of_int (16)) - (Prims.of_int (835)) (Prims.of_int (45))))) + (Prims.of_int (834)) (Prims.of_int (16)) + (Prims.of_int (834)) (Prims.of_int (45))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (836)) (Prims.of_int (8)) - (Prims.of_int (836)) (Prims.of_int (26))))) + (Prims.of_int (835)) (Prims.of_int (8)) + (Prims.of_int (835)) (Prims.of_int (26))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> FStar_Tactics_Types.set_label @@ -4750,37 +4750,37 @@ let (focus_all : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (839)) (Prims.of_int (4)) (Prims.of_int (839)) + (Prims.of_int (838)) (Prims.of_int (4)) (Prims.of_int (838)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (840)) (Prims.of_int (4)) (Prims.of_int (840)) + (Prims.of_int (839)) (Prims.of_int (4)) (Prims.of_int (839)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (839)) (Prims.of_int (14)) - (Prims.of_int (839)) (Prims.of_int (39))))) + (Prims.of_int (838)) (Prims.of_int (14)) + (Prims.of_int (838)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (839)) (Prims.of_int (4)) - (Prims.of_int (839)) (Prims.of_int (39))))) + (Prims.of_int (838)) (Prims.of_int (4)) + (Prims.of_int (838)) (Prims.of_int (39))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (839)) (Prims.of_int (15)) - (Prims.of_int (839)) (Prims.of_int (23))))) + (Prims.of_int (838)) (Prims.of_int (15)) + (Prims.of_int (838)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (839)) (Prims.of_int (14)) - (Prims.of_int (839)) (Prims.of_int (39))))) + (Prims.of_int (838)) (Prims.of_int (14)) + (Prims.of_int (838)) (Prims.of_int (39))))) (Obj.magic (goals ())) (fun uu___1 -> (fun uu___1 -> @@ -4790,17 +4790,17 @@ let (focus_all : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (839)) + (Prims.of_int (838)) (Prims.of_int (26)) - (Prims.of_int (839)) + (Prims.of_int (838)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (839)) + (Prims.of_int (838)) (Prims.of_int (14)) - (Prims.of_int (839)) + (Prims.of_int (838)) (Prims.of_int (39))))) (Obj.magic (smt_goals ())) (fun uu___2 -> @@ -4836,25 +4836,25 @@ let (bump_nth : Prims.pos -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (855)) (Prims.of_int (8)) (Prims.of_int (855)) + (Prims.of_int (854)) (Prims.of_int (8)) (Prims.of_int (854)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (855)) (Prims.of_int (2)) (Prims.of_int (857)) + (Prims.of_int (854)) (Prims.of_int (2)) (Prims.of_int (856)) (Prims.of_int (37))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (855)) (Prims.of_int (28)) - (Prims.of_int (855)) (Prims.of_int (38))))) + (Prims.of_int (854)) (Prims.of_int (28)) + (Prims.of_int (854)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (855)) (Prims.of_int (8)) - (Prims.of_int (855)) (Prims.of_int (38))))) + (Prims.of_int (854)) (Prims.of_int (8)) + (Prims.of_int (854)) (Prims.of_int (38))))) (Obj.magic (goals ())) (fun uu___ -> FStar_Tactics_Effect.lift_div_tac @@ -4878,12 +4878,12 @@ let rec (destruct_list : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (860)) (Prims.of_int (21)) (Prims.of_int (860)) + (Prims.of_int (859)) (Prims.of_int (21)) (Prims.of_int (859)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (859)) (Prims.of_int (52)) (Prims.of_int (872)) + (Prims.of_int (858)) (Prims.of_int (52)) (Prims.of_int (871)) (Prims.of_int (27))))) (Obj.magic (FStar_Tactics_V1_SyntaxHelpers.collect_app t)) (fun uu___ -> @@ -4908,17 +4908,17 @@ let rec (destruct_list : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (865)) + (Prims.of_int (864)) (Prims.of_int (17)) - (Prims.of_int (865)) + (Prims.of_int (864)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (865)) + (Prims.of_int (864)) (Prims.of_int (11)) - (Prims.of_int (865)) + (Prims.of_int (864)) (Prims.of_int (33))))) (Obj.magic (destruct_list a2)) (fun uu___1 -> @@ -4944,17 +4944,17 @@ let rec (destruct_list : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (865)) + (Prims.of_int (864)) (Prims.of_int (17)) - (Prims.of_int (865)) + (Prims.of_int (864)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (865)) + (Prims.of_int (864)) (Prims.of_int (11)) - (Prims.of_int (865)) + (Prims.of_int (864)) (Prims.of_int (33))))) (Obj.magic (destruct_list a2)) (fun uu___2 -> @@ -4989,25 +4989,25 @@ let (get_match_body : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (875)) (Prims.of_int (8)) (Prims.of_int (875)) + (Prims.of_int (874)) (Prims.of_int (8)) (Prims.of_int (874)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (875)) (Prims.of_int (2)) (Prims.of_int (879)) + (Prims.of_int (874)) (Prims.of_int (2)) (Prims.of_int (878)) (Prims.of_int (46))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (875)) (Prims.of_int (22)) - (Prims.of_int (875)) (Prims.of_int (35))))) + (Prims.of_int (874)) (Prims.of_int (22)) + (Prims.of_int (874)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (875)) (Prims.of_int (8)) - (Prims.of_int (875)) (Prims.of_int (35))))) + (Prims.of_int (874)) (Prims.of_int (8)) + (Prims.of_int (874)) (Prims.of_int (35))))) (Obj.magic (cur_goal ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -5025,14 +5025,14 @@ let (get_match_body : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (877)) (Prims.of_int (20)) - (Prims.of_int (877)) (Prims.of_int (39))))) + (Prims.of_int (876)) (Prims.of_int (20)) + (Prims.of_int (876)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (877)) (Prims.of_int (14)) - (Prims.of_int (879)) (Prims.of_int (46))))) + (Prims.of_int (876)) (Prims.of_int (14)) + (Prims.of_int (878)) (Prims.of_int (46))))) (Obj.magic (FStar_Tactics_V1_SyntaxHelpers.inspect_unascribe t)) @@ -5061,13 +5061,13 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (892)) (Prims.of_int (14)) - (Prims.of_int (892)) (Prims.of_int (31))))) + (Prims.of_int (891)) (Prims.of_int (14)) + (Prims.of_int (891)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (892)) (Prims.of_int (34)) - (Prims.of_int (898)) (Prims.of_int (20))))) + (Prims.of_int (891)) (Prims.of_int (34)) + (Prims.of_int (897)) (Prims.of_int (20))))) (Obj.magic (get_match_body ())) (fun uu___2 -> (fun x -> @@ -5077,14 +5077,14 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (893)) (Prims.of_int (14)) - (Prims.of_int (893)) (Prims.of_int (26))))) + (Prims.of_int (892)) (Prims.of_int (14)) + (Prims.of_int (892)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (894)) (Prims.of_int (6)) - (Prims.of_int (898)) (Prims.of_int (20))))) + (Prims.of_int (893)) (Prims.of_int (6)) + (Prims.of_int (897)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_V1_Builtins.t_destruct x)) (fun uu___2 -> (fun uu___2 -> @@ -5096,17 +5096,17 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (895)) + (Prims.of_int (894)) (Prims.of_int (17)) - (Prims.of_int (895)) + (Prims.of_int (894)) (Prims.of_int (29))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (895)) + (Prims.of_int (894)) (Prims.of_int (32)) - (Prims.of_int (898)) + (Prims.of_int (897)) (Prims.of_int (19))))) (Obj.magic (repeat @@ -5119,17 +5119,17 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (896)) + (Prims.of_int (895)) (Prims.of_int (16)) - (Prims.of_int (896)) + (Prims.of_int (895)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (897)) + (Prims.of_int (896)) (Prims.of_int (8)) - (Prims.of_int (898)) + (Prims.of_int (897)) (Prims.of_int (19))))) (Obj.magic (last bs)) (fun uu___4 -> @@ -5140,17 +5140,17 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (897)) + (Prims.of_int (896)) (Prims.of_int (8)) - (Prims.of_int (897)) + (Prims.of_int (896)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (898)) + (Prims.of_int (897)) (Prims.of_int (8)) - (Prims.of_int (898)) + (Prims.of_int (897)) (Prims.of_int (19))))) (Obj.magic (grewrite_eq b)) @@ -5172,12 +5172,12 @@ let (nth_binder : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (907)) (Prims.of_int (11)) (Prims.of_int (907)) + (Prims.of_int (906)) (Prims.of_int (11)) (Prims.of_int (906)) (Prims.of_int (25))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (907)) (Prims.of_int (28)) (Prims.of_int (912)) + (Prims.of_int (906)) (Prims.of_int (28)) (Prims.of_int (911)) (Prims.of_int (15))))) (Obj.magic (cur_binders ())) (fun uu___ -> (fun bs -> @@ -5186,13 +5186,13 @@ let (nth_binder : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (908)) (Prims.of_int (16)) - (Prims.of_int (908)) (Prims.of_int (65))))) + (Prims.of_int (907)) (Prims.of_int (16)) + (Prims.of_int (907)) (Prims.of_int (65))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (908)) (Prims.of_int (68)) - (Prims.of_int (912)) (Prims.of_int (15))))) + (Prims.of_int (907)) (Prims.of_int (68)) + (Prims.of_int (911)) (Prims.of_int (15))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> if i >= Prims.int_zero @@ -5206,14 +5206,14 @@ let (nth_binder : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (909)) (Prims.of_int (16)) - (Prims.of_int (909)) (Prims.of_int (62))))) + (Prims.of_int (908)) (Prims.of_int (16)) + (Prims.of_int (908)) (Prims.of_int (62))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (910)) (Prims.of_int (2)) - (Prims.of_int (912)) (Prims.of_int (15))))) + (Prims.of_int (909)) (Prims.of_int (2)) + (Prims.of_int (911)) (Prims.of_int (15))))) (if k < Prims.int_zero then fail "not enough binders" else @@ -5240,12 +5240,12 @@ let (name_appears_in : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (920)) (Prims.of_int (4)) (Prims.of_int (925)) + (Prims.of_int (919)) (Prims.of_int (4)) (Prims.of_int (924)) (Prims.of_int (12))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (927)) (Prims.of_int (2)) (Prims.of_int (929)) + (Prims.of_int (926)) (Prims.of_int (2)) (Prims.of_int (928)) (Prims.of_int (16))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> @@ -5261,17 +5261,17 @@ let (name_appears_in : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (922)) + (Prims.of_int (921)) (Prims.of_int (6)) - (Prims.of_int (923)) + (Prims.of_int (922)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (919)) + (Prims.of_int (918)) (Prims.of_int (10)) - (Prims.of_int (919)) + (Prims.of_int (918)) (Prims.of_int (11))))) (if (FStar_Reflection_V1_Builtins.inspect_fv @@ -5301,31 +5301,31 @@ let (name_appears_in : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (927)) (Prims.of_int (6)) - (Prims.of_int (927)) (Prims.of_int (30))))) + (Prims.of_int (926)) (Prims.of_int (6)) + (Prims.of_int (926)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (927)) (Prims.of_int (32)) - (Prims.of_int (927)) (Prims.of_int (37))))) + (Prims.of_int (926)) (Prims.of_int (32)) + (Prims.of_int (926)) (Prims.of_int (37))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (927)) + (Prims.of_int (926)) (Prims.of_int (13)) - (Prims.of_int (927)) + (Prims.of_int (926)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (927)) + (Prims.of_int (926)) (Prims.of_int (6)) - (Prims.of_int (927)) + (Prims.of_int (926)) (Prims.of_int (30))))) (Obj.magic (FStar_Tactics_Visit.visit_tm ff t)) @@ -5366,14 +5366,14 @@ let rec (mk_abs : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (936)) (Prims.of_int (13)) - (Prims.of_int (936)) (Prims.of_int (27))))) + (Prims.of_int (935)) (Prims.of_int (13)) + (Prims.of_int (935)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (937)) (Prims.of_int (4)) - (Prims.of_int (937)) (Prims.of_int (22))))) + (Prims.of_int (936)) (Prims.of_int (4)) + (Prims.of_int (936)) (Prims.of_int (22))))) (Obj.magic (mk_abs args' t)) (fun uu___ -> (fun t' -> @@ -5394,13 +5394,13 @@ let (string_to_term_with_lb : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (945)) (Prims.of_int (14)) - (Prims.of_int (945)) (Prims.of_int (32))))) + (Prims.of_int (944)) (Prims.of_int (14)) + (Prims.of_int (944)) (Prims.of_int (32))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (945)) (Prims.of_int (35)) - (Prims.of_int (951)) (Prims.of_int (75))))) + (Prims.of_int (944)) (Prims.of_int (35)) + (Prims.of_int (950)) (Prims.of_int (75))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> FStar_Reflection_V2_Builtins.pack_ln @@ -5413,14 +5413,14 @@ let (string_to_term_with_lb : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (946)) (Prims.of_int (20)) - (Prims.of_int (949)) (Prims.of_int (27))))) + (Prims.of_int (945)) (Prims.of_int (20)) + (Prims.of_int (948)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (945)) (Prims.of_int (35)) - (Prims.of_int (951)) (Prims.of_int (75))))) + (Prims.of_int (944)) (Prims.of_int (35)) + (Prims.of_int (950)) (Prims.of_int (75))))) (Obj.magic (FStar_Tactics_Util.fold_left (fun uu___ -> @@ -5432,17 +5432,17 @@ let (string_to_term_with_lb : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (947)) + (Prims.of_int (946)) (Prims.of_int (20)) - (Prims.of_int (947)) + (Prims.of_int (946)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (946)) + (Prims.of_int (945)) (Prims.of_int (56)) - (Prims.of_int (948)) + (Prims.of_int (947)) (Prims.of_int (25))))) (Obj.magic (FStar_Tactics_V1_Builtins.push_bv_dsenv @@ -5464,17 +5464,17 @@ let (string_to_term_with_lb : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (950)) + (Prims.of_int (949)) (Prims.of_int (12)) - (Prims.of_int (950)) + (Prims.of_int (949)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V1.Derived.fst" - (Prims.of_int (951)) + (Prims.of_int (950)) (Prims.of_int (4)) - (Prims.of_int (951)) + (Prims.of_int (950)) (Prims.of_int (75))))) (Obj.magic (FStar_Tactics_V1_Builtins.string_to_term diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml index c1d8061b37a..f3f4913f81a 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Basic.ml @@ -1,4 +1,12 @@ open Prims +let (dbg_TacUnify : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "TacUnify" +let (dbg_2635 : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "2635" +let (dbg_ReflTc : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "ReflTc" +let (dbg_TacVerbose : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "TacVerbose" let (compress : FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term FStar_Tactics_Monad.tac) @@ -37,7 +45,7 @@ let (core_check : then FStar_Pervasives.Inl FStar_Pervasives_Native.None else (let debug f = - let uu___2 = FStar_Options.debug_any () in + let uu___2 = FStar_Compiler_Debug.any () in if uu___2 then f () else () in let uu___2 = FStar_TypeChecker_Core.check_term env sol t must_tot in @@ -55,7 +63,7 @@ let (core_check : let uu___5 = let uu___6 = FStar_TypeChecker_Env.get_range env in FStar_Class_Show.show - FStar_Compiler_Range_Ops.show_range uu___6 in + FStar_Compiler_Range_Ops.showable_range uu___6 in let uu___6 = FStar_TypeChecker_Core.print_error_short err in let uu___7 = @@ -128,6 +136,8 @@ let (print : Prims.string -> unit FStar_Tactics_Monad.tac) = let uu___2 = FStar_Options.silent () in Prims.op_Negation uu___2 in if uu___1 then tacprint msg else ()); FStar_Class_Monad.return FStar_Tactics_Monad.monad_tac () (Obj.repr ()) +let (dbg_Tac : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Tac" let (debugging : unit -> Prims.bool FStar_Tactics_Monad.tac) = fun uu___ -> (fun uu___ -> @@ -137,10 +147,7 @@ let (debugging : unit -> Prims.bool FStar_Tactics_Monad.tac) = (fun uu___1 -> (fun ps -> let ps = Obj.magic ps in - let uu___1 = - FStar_TypeChecker_Env.debug - ps.FStar_Tactics_Types.main_context - (FStar_Options.Other "Tac") in + let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Tac in Obj.magic (FStar_Class_Monad.return FStar_Tactics_Monad.monad_tac () (Obj.magic uu___1))) uu___1))) uu___ @@ -194,7 +201,9 @@ let (dump_all : Prims.bool -> Prims.string -> unit FStar_Tactics_Monad.tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in do_dump_ps msg ps'; FStar_Tactics_Result.Success ((), ps)) let (dump_uvars_of : @@ -207,7 +216,10 @@ let (dump_uvars_of : let uu___ = let uu___1 = FStar_Tactics_Types.goal_type g in FStar_Syntax_Free.uvars uu___1 in - FStar_Compiler_Set.elems FStar_Syntax_Free.ord_ctx_uvar uu___ in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___) in let gs = FStar_Compiler_List.map (FStar_Tactics_Types.goal_of_ctx_uvar g) uvs in @@ -237,7 +249,9 @@ let (dump_uvars_of : (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency) + FStar_Tactics_Types.urgency = (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in do_dump_ps msg ps'; FStar_Tactics_Result.Success ((), ps)) let fail1 : @@ -387,7 +401,9 @@ let (set_guard_policy : FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (ps.FStar_Tactics_Types.urgency) + (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) })) uu___) let with_policy : 'a . @@ -588,6 +604,66 @@ let (proc_guard_formula : FStar_Tactics_Monad.monad_tac () (Obj.repr ())) () with + | uu___1 -> + FStar_Tactics_Monad.mlog + (fun uu___2 -> + let uu___3 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term + f in + FStar_Compiler_Util.print1 + "guard = %s\n" uu___3) + (fun uu___2 -> + fail1 + "Forcing the guard failed (%s)" + reason))) + | FStar_Tactics_Types.ForceSMT -> + Obj.magic + (FStar_Tactics_Monad.mlog + (fun uu___ -> + let uu___1 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term f in + FStar_Compiler_Util.print2 + "Forcing guard WITH SMT (%s:%s)\n" reason + uu___1) + (fun uu___ -> + let g = + { + FStar_TypeChecker_Common.guard_f = + (FStar_TypeChecker_Common.NonTrivial f); + FStar_TypeChecker_Common.deferred_to_tac + = + (FStar_TypeChecker_Env.trivial_guard.FStar_TypeChecker_Common.deferred_to_tac); + FStar_TypeChecker_Common.deferred = + (FStar_TypeChecker_Env.trivial_guard.FStar_TypeChecker_Common.deferred); + FStar_TypeChecker_Common.univ_ineqs = + (FStar_TypeChecker_Env.trivial_guard.FStar_TypeChecker_Common.univ_ineqs); + FStar_TypeChecker_Common.implicits = + (FStar_TypeChecker_Env.trivial_guard.FStar_TypeChecker_Common.implicits) + } in + try + (fun uu___1 -> + match () with + | () -> + let uu___2 = + let uu___3 = + let uu___4 = + FStar_TypeChecker_Rel.discharge_guard + e g in + FStar_TypeChecker_Env.is_trivial + uu___4 in + Prims.op_Negation uu___3 in + if uu___2 + then + fail1 + "Forcing the guard failed (%s)" + reason + else + FStar_Class_Monad.return + FStar_Tactics_Monad.monad_tac () + (Obj.repr ())) () + with | uu___1 -> FStar_Tactics_Monad.mlog (fun uu___2 -> @@ -995,21 +1071,39 @@ let (__do_unify_wflags : let uu___1 = match check_side with | Check_none -> - FStar_Syntax_Free.new_uv_set () + Obj.magic + (Obj.repr + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + ())) | Check_left_only -> - FStar_Syntax_Free.uvars t1 + Obj.magic + (Obj.repr + (FStar_Syntax_Free.uvars t1)) | Check_right_only -> - FStar_Syntax_Free.uvars t2 + Obj.magic + (Obj.repr + (FStar_Syntax_Free.uvars t2)) | Check_both -> - let uu___2 = - FStar_Syntax_Free.uvars t1 in - let uu___3 = - FStar_Syntax_Free.uvars t2 in - FStar_Compiler_Set.union - FStar_Syntax_Free.ord_ctx_uvar - uu___2 uu___3 in - FStar_Compiler_Set.elems - FStar_Syntax_Free.ord_ctx_uvar uu___1 in + Obj.magic + (Obj.repr + (let uu___2 = + FStar_Syntax_Free.uvars t1 in + let uu___3 = + FStar_Syntax_Free.uvars t2 in + FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uu___2) + (Obj.magic uu___3))) in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uu___1) in let uu___1 = let uu___2 = let uu___3 = @@ -1153,7 +1247,7 @@ let (__do_unify_wflags : msg in let uu___9 = FStar_Class_Show.show - FStar_Compiler_Range_Ops.show_range + FStar_Compiler_Range_Ops.showable_range r in FStar_Compiler_Util.print2 ">> do_unify error, (%s) at (%s)\n" @@ -1211,9 +1305,6 @@ let (__do_unify : fun env1 -> fun t1 -> fun t2 -> - let dbg = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "TacUnify") in let uu___ = FStar_Class_Monad.return FStar_Tactics_Monad.monad_tac () (Obj.repr ()) in @@ -1223,17 +1314,24 @@ let (__do_unify : (fun uu___1 -> (fun uu___1 -> let uu___1 = Obj.magic uu___1 in - if dbg - then - (FStar_Options.push (); - (let uu___4 = - FStar_Options.set_options - "--debug_level Rel --debug_level RelCheck" in - ())) - else (); (let uu___3 = - __do_unify_wflags dbg allow_guards - must_tot check_side env1 t1 t2 in + FStar_Compiler_Effect.op_Bang + dbg_TacUnify in + if uu___3 + then + (FStar_Options.push (); + (let uu___5 = + FStar_Options.set_options + "--debug Rel,RelCheck" in + ())) + else ()); + (let uu___3 = + let uu___4 = + FStar_Compiler_Effect.op_Bang + dbg_TacUnify in + __do_unify_wflags uu___4 + allow_guards must_tot check_side + env1 t1 t2 in Obj.magic (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () @@ -1241,9 +1339,12 @@ let (__do_unify : (fun uu___4 -> (fun r -> let r = Obj.magic r in - if dbg - then FStar_Options.pop () - else (); + (let uu___5 = + FStar_Compiler_Effect.op_Bang + dbg_TacUnify in + if uu___5 + then FStar_Options.pop () + else ()); Obj.magic (FStar_Class_Monad.return FStar_Tactics_Monad.monad_tac @@ -1377,9 +1478,12 @@ let (do_match : t1 in let uu___2 = let uu___3 = - FStar_Compiler_Set.equal - FStar_Syntax_Free.ord_ctx_uvar - uvs1 uvs2 in + FStar_Class_Setlike.equal () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uvs1) + (Obj.magic uvs2) in Prims.op_Negation uu___3 in (if uu___2 then @@ -1454,9 +1558,13 @@ let (do_match_on_lhs : lhs in let uu___4 = let uu___5 = - FStar_Compiler_Set.equal - FStar_Syntax_Free.ord_ctx_uvar - uvs1 uvs2 in + FStar_Class_Setlike.equal + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uvs1) + (Obj.magic uvs2) in Prims.op_Negation uu___5 in (if uu___4 then @@ -1708,7 +1816,9 @@ let (fresh : unit -> FStar_BigInt.t FStar_Tactics_Monad.tac) = FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (ps.FStar_Tactics_Types.urgency) + (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in let uu___1 = FStar_Tactics_Monad.set ps1 in Obj.magic @@ -3219,84 +3329,119 @@ let (norm : let uu___2 = FStar_Tactics_Monad.goal_with_type goal t in Obj.magic (FStar_Tactics_Monad.replace_cur uu___2)) uu___1))) uu___) +let (__norm_term_env : + Prims.bool -> + env -> + FStar_Pervasives.norm_step Prims.list -> + FStar_Syntax_Syntax.term -> + FStar_Syntax_Syntax.term FStar_Tactics_Monad.tac) + = + fun well_typed -> + fun e -> + fun s -> + fun t -> + let uu___ = + Obj.magic + (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () + () (Obj.magic FStar_Tactics_Monad.get) + (fun uu___1 -> + (fun ps -> + let ps = Obj.magic ps in + let uu___1 = + FStar_Tactics_Monad.if_verbose + (fun uu___2 -> + let uu___3 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t in + FStar_Compiler_Util.print1 + "norm_term_env: t = %s\n" uu___3) in + Obj.magic + (FStar_Class_Monad.op_let_Bang + FStar_Tactics_Monad.monad_tac () () uu___1 + (fun uu___2 -> + (fun uu___2 -> + let uu___2 = Obj.magic uu___2 in + let uu___3 = + if well_typed + then + Obj.magic + (FStar_Class_Monad.return + FStar_Tactics_Monad.monad_tac () + (Obj.magic t)) + else + (let uu___5 = __tc_lax e t in + Obj.magic + (FStar_Class_Monad.op_let_Bang + FStar_Tactics_Monad.monad_tac () + () (Obj.magic uu___5) + (fun uu___6 -> + (fun uu___6 -> + let uu___6 = + Obj.magic uu___6 in + match uu___6 with + | (t1, uu___7, uu___8) -> + Obj.magic + (FStar_Class_Monad.return + FStar_Tactics_Monad.monad_tac + () (Obj.magic t1))) + uu___6))) in + Obj.magic + (FStar_Class_Monad.op_let_Bang + FStar_Tactics_Monad.monad_tac () () + (Obj.magic uu___3) + (fun uu___4 -> + (fun t1 -> + let t1 = Obj.magic t1 in + let steps = + let uu___4 = + FStar_TypeChecker_Cfg.translate_norm_steps + s in + FStar_Compiler_List.op_At + [FStar_TypeChecker_Env.Reify; + FStar_TypeChecker_Env.UnfoldTac] + uu___4 in + let t2 = + normalize steps + ps.FStar_Tactics_Types.main_context + t1 in + let uu___4 = + FStar_Tactics_Monad.if_verbose + (fun uu___5 -> + let uu___6 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term + t2 in + FStar_Compiler_Util.print1 + "norm_term_env: t' = %s\n" + uu___6) in + Obj.magic + (FStar_Class_Monad.op_let_Bang + FStar_Tactics_Monad.monad_tac + () () uu___4 + (fun uu___5 -> + (fun uu___5 -> + let uu___5 = + Obj.magic uu___5 in + Obj.magic + (FStar_Class_Monad.return + FStar_Tactics_Monad.monad_tac + () + (Obj.magic t2))) + uu___5))) uu___4))) + uu___2))) uu___1)) in + FStar_Tactics_Monad.wrap_err "norm_term" uu___ let (norm_term_env : env -> FStar_Pervasives.norm_step Prims.list -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term FStar_Tactics_Monad.tac) - = - fun e -> - fun s -> - fun t -> - let uu___ = - Obj.magic - (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () - () (Obj.magic FStar_Tactics_Monad.get) - (fun uu___1 -> - (fun ps -> - let ps = Obj.magic ps in - let uu___1 = - FStar_Tactics_Monad.if_verbose - (fun uu___2 -> - let uu___3 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term t in - FStar_Compiler_Util.print1 - "norm_term_env: t = %s\n" uu___3) in - Obj.magic - (FStar_Class_Monad.op_let_Bang - FStar_Tactics_Monad.monad_tac () () uu___1 - (fun uu___2 -> - (fun uu___2 -> - let uu___2 = Obj.magic uu___2 in - let uu___3 = __tc_lax e t in - Obj.magic - (FStar_Class_Monad.op_let_Bang - FStar_Tactics_Monad.monad_tac () () - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - let uu___4 = Obj.magic uu___4 in - match uu___4 with - | (t1, uu___5, uu___6) -> - let steps = - let uu___7 = - FStar_TypeChecker_Cfg.translate_norm_steps - s in - FStar_Compiler_List.op_At - [FStar_TypeChecker_Env.Reify; - FStar_TypeChecker_Env.UnfoldTac] - uu___7 in - let t2 = - normalize steps - ps.FStar_Tactics_Types.main_context - t1 in - let uu___7 = - FStar_Tactics_Monad.if_verbose - (fun uu___8 -> - let uu___9 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term - t2 in - FStar_Compiler_Util.print1 - "norm_term_env: t' = %s\n" - uu___9) in - Obj.magic - (FStar_Class_Monad.op_let_Bang - FStar_Tactics_Monad.monad_tac - () () uu___7 - (fun uu___8 -> - (fun uu___8 -> - let uu___8 = - Obj.magic uu___8 in - Obj.magic - (FStar_Class_Monad.return - FStar_Tactics_Monad.monad_tac - () - (Obj.magic t2))) - uu___8))) uu___4))) - uu___2))) uu___1)) in - FStar_Tactics_Monad.wrap_err "norm_term" uu___ + = fun e -> fun s -> fun t -> __norm_term_env false e s t +let (refl_norm_well_typed_term : + env -> + FStar_Pervasives.norm_step Prims.list -> + FStar_Syntax_Syntax.term -> + FStar_Syntax_Syntax.term FStar_Tactics_Monad.tac) + = fun e -> fun s -> fun t -> __norm_term_env true e s t let (refine_intro : unit -> unit FStar_Tactics_Monad.tac) = fun uu___ -> let uu___1 = @@ -4021,9 +4166,13 @@ let (t_apply : = FStar_Syntax_Free.uvars_uncached typ1 in - FStar_Compiler_Set.is_empty - FStar_Syntax_Free.ord_ctx_uvar - uu___11 in + FStar_Class_Setlike.is_empty + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic + uu___11) in Prims.op_Negation uu___10) in if uu___9 @@ -4139,10 +4288,21 @@ let (t_apply : = let uu___13 = - FStar_Syntax_Free.new_uv_set - () in + Obj.magic + (FStar_Class_Setlike.empty + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + ()) in FStar_Compiler_List.fold_right (fun + uu___15 + -> + fun + uu___14 + -> + (fun uu___14 -> fun s -> @@ -4160,16 +4320,30 @@ let (t_apply : uv in FStar_Syntax_Free.uvars uu___18 in - FStar_Compiler_Set.union - FStar_Syntax_Free.ord_ctx_uvar - s uu___17) + Obj.magic + (FStar_Class_Setlike.union + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic + s) + (Obj.magic + uu___17))) + uu___15 + uu___14) uvs uu___13 in let free_in_some_goal uv = - FStar_Compiler_Set.mem - FStar_Syntax_Free.ord_ctx_uvar - uv uvset in + FStar_Class_Setlike.mem + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + uv + (Obj.magic + uvset) in let uu___13 = solve' @@ -4526,10 +4700,8 @@ let (t_apply_lemma : (( let uu___19 = - FStar_TypeChecker_Env.debug - env1 - (FStar_Options.Other - "2635") in + FStar_Compiler_Effect.op_Bang + dbg_2635 in if uu___19 then @@ -4762,13 +4934,17 @@ let (t_apply_lemma : = FStar_Syntax_Free.uvars t1 in - FStar_Compiler_Set.for_any - FStar_Syntax_Free.ord_ctx_uvar + FStar_Class_Setlike.for_any + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (fun u -> FStar_Syntax_Unionfind.equiv u.FStar_Syntax_Syntax.ctx_uvar_head uv) - uu___16 in + (Obj.magic + uu___16) in let appears uv goals = @@ -5610,7 +5786,10 @@ let (free_in : fun bv -> fun t -> let uu___ = FStar_Syntax_Free.names t in - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_bv bv uu___ + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) bv (Obj.magic uu___) let (clear : FStar_Reflection_V2_Data.binding -> unit FStar_Tactics_Monad.tac) = fun b -> @@ -5837,8 +6016,11 @@ let (_t_trefl : g.FStar_Tactics_Types.goal_ctx_uvar in let uvars = FStar_Syntax_Free.uvars t in let uu___2 = - FStar_Compiler_Set.for_all FStar_Syntax_Free.ord_ctx_uvar - is_uvar_untyped_or_already_checked uvars in + FStar_Class_Setlike.for_all () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + is_uvar_untyped_or_already_checked (Obj.magic uvars) in if uu___2 then skip_register else @@ -6004,7 +6186,7 @@ let (_t_trefl : | FStar_Pervasives.Inl (uu___13, t_ty) -> let uu___14 = FStar_TypeChecker_Core.check_term_subtyping - env1 ty t_ty in + true true env1 ty t_ty in (match uu___14 with | FStar_Pervasives.Inl (FStar_Pervasives_Native.None) -> @@ -6627,7 +6809,9 @@ let (join : unit -> unit FStar_Tactics_Monad.tac) = FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); FStar_Tactics_Types.urgency = - (ps.FStar_Tactics_Types.urgency) + (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in Obj.magic (FStar_Class_Monad.op_let_Bang @@ -8000,7 +8184,9 @@ let (t_destruct : FStar_Syntax_Syntax.mutuals = mut; FStar_Syntax_Syntax.ds - = c_lids;_} + = c_lids; + FStar_Syntax_Syntax.injective_type_params + = uu___11;_} -> Obj.repr (let erasable @@ -8008,36 +8194,36 @@ let (t_destruct : FStar_Syntax_Util.has_attribute se.FStar_Syntax_Syntax.sigattrs FStar_Parser_Const.erasable_attr in - let uu___11 - = let uu___12 = + let uu___13 + = erasable && - (let uu___13 + (let uu___14 = FStar_Tactics_Monad.is_irrelevant g in Prims.op_Negation - uu___13) in + uu___14) in failwhen - uu___12 + uu___13 "cannot destruct erasable type to solve proof-relevant goal" in FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___11 - (fun uu___12 + (fun + uu___13 -> (fun - uu___12 + uu___13 -> - let uu___12 + let uu___13 = Obj.magic - uu___12 in - let uu___13 + uu___13 in + let uu___14 = failwhen ((FStar_Compiler_List.length @@ -8049,34 +8235,34 @@ let (t_destruct : (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___13 - (fun uu___14 + (fun + uu___15 -> (fun - uu___14 + uu___15 -> - let uu___14 + let uu___15 = Obj.magic - uu___14 in - let uu___15 + uu___15 in + let uu___16 = FStar_Syntax_Subst.open_term t_ps t_ty in - match uu___15 + match uu___16 with | (t_ps1, t_ty1) -> - let uu___16 + let uu___17 = Obj.magic (FStar_Class_Monad.mapM FStar_Tactics_Monad.monad_tac () () (fun - uu___17 + uu___18 -> (fun c_lid -> @@ -8084,16 +8270,16 @@ let (t_destruct : = Obj.magic c_lid in - let uu___17 - = let uu___18 = + let uu___19 + = FStar_Tactics_Types.goal_env g in FStar_TypeChecker_Env.lookup_sigelt - uu___18 + uu___19 c_lid in - match uu___17 + match uu___18 with | FStar_Pervasives_Native.None @@ -8114,33 +8300,35 @@ let (t_destruct : FStar_Syntax_Syntax.Sig_datacon { FStar_Syntax_Syntax.lid1 - = uu___18; + = uu___19; FStar_Syntax_Syntax.us1 = c_us; FStar_Syntax_Syntax.t1 = c_ty; FStar_Syntax_Syntax.ty_lid - = uu___19; + = uu___20; FStar_Syntax_Syntax.num_ty_params = nparam; FStar_Syntax_Syntax.mutuals1 - = mut1;_} + = mut1; + FStar_Syntax_Syntax.injective_type_params1 + = uu___21;_} -> Obj.repr (let qual = let fallback - uu___20 = + uu___22 = FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor in let qninfo = - let uu___20 + let uu___22 = FStar_Tactics_Types.goal_env g in FStar_TypeChecker_Env.lookup_qname - uu___20 + uu___22 c_lid in match qninfo with @@ -8153,7 +8341,7 @@ let (t_destruct : FStar_Syntax_DsEnv.fv_qual_of_se se2 | - uu___20 + uu___22 -> fallback () in @@ -8161,7 +8349,7 @@ let (t_destruct : FStar_Syntax_Syntax.lid_as_fv c_lid qual in - let uu___20 + let uu___22 = failwhen ((FStar_Compiler_List.length @@ -8172,17 +8360,17 @@ let (t_destruct : FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___20 + uu___22 (fun - uu___21 + uu___23 -> (fun - uu___21 + uu___23 -> - let uu___21 + let uu___23 = Obj.magic - uu___21 in + uu___23 in let s = FStar_TypeChecker_Env.mk_univ_subst c_us a_us in @@ -8190,26 +8378,26 @@ let (t_destruct : = FStar_Syntax_Subst.subst s c_ty in - let uu___22 + let uu___24 = FStar_TypeChecker_Env.inst_tscheme (c_us, c_ty1) in - match uu___22 + match uu___24 with | (c_us1, c_ty2) -> - let uu___23 + let uu___25 = FStar_Syntax_Util.arrow_formals_comp c_ty2 in - (match uu___23 + (match uu___25 with | (bs, comp) -> - let uu___24 + let uu___26 = let rename_bv bv = @@ -8218,26 +8406,26 @@ let (t_destruct : bv.FStar_Syntax_Syntax.ppname in let ppname1 = - let uu___25 + let uu___27 = - let uu___26 + let uu___28 = - let uu___27 + let uu___29 = FStar_Class_Show.show FStar_Ident.showable_ident ppname in Prims.strcat "a" - uu___27 in - let uu___27 + uu___29 in + let uu___29 = FStar_Ident.range_of_id ppname in - (uu___26, - uu___27) in + (uu___28, + uu___29) in FStar_Ident.mk_ident - uu___25 in + uu___27 in FStar_Syntax_Syntax.freshen_bv { FStar_Syntax_Syntax.ppname @@ -8252,13 +8440,13 @@ let (t_destruct : let bs' = FStar_Compiler_List.map (fun b -> - let uu___25 + let uu___27 = rename_bv b.FStar_Syntax_Syntax.binder_bv in { FStar_Syntax_Syntax.binder_bv - = uu___25; + = uu___27; FStar_Syntax_Syntax.binder_qual = (b.FStar_Syntax_Syntax.binder_qual); @@ -8273,100 +8461,100 @@ let (t_destruct : = FStar_Compiler_List.map2 (fun - uu___25 + uu___27 -> fun - uu___26 + uu___28 -> match - (uu___25, - uu___26) + (uu___27, + uu___28) with | ({ FStar_Syntax_Syntax.binder_bv = bv; FStar_Syntax_Syntax.binder_qual - = uu___27; + = uu___29; FStar_Syntax_Syntax.binder_positivity - = uu___28; + = uu___30; FStar_Syntax_Syntax.binder_attrs - = uu___29;_}, + = uu___31;_}, { FStar_Syntax_Syntax.binder_bv = bv'; FStar_Syntax_Syntax.binder_qual - = uu___30; + = uu___32; FStar_Syntax_Syntax.binder_positivity - = uu___31; + = uu___33; FStar_Syntax_Syntax.binder_attrs - = uu___32;_}) + = uu___34;_}) -> - let uu___33 + let uu___35 = - let uu___34 + let uu___36 = FStar_Syntax_Syntax.bv_to_name bv' in (bv, - uu___34) in + uu___36) in FStar_Syntax_Syntax.NT - uu___33) + uu___35) bs bs' in - let uu___25 + let uu___27 = FStar_Syntax_Subst.subst_binders subst bs' in - let uu___26 + let uu___28 = FStar_Syntax_Subst.subst_comp subst comp in - (uu___25, - uu___26) in - (match uu___24 + (uu___27, + uu___28) in + (match uu___26 with | (bs1, comp1) -> - let uu___25 + let uu___27 = FStar_Compiler_List.splitAt nparam bs1 in - (match uu___25 + (match uu___27 with | (d_ps, bs2) -> - let uu___26 + let uu___28 = - let uu___27 + let uu___29 = - let uu___28 + let uu___30 = FStar_Syntax_Util.is_total_comp comp1 in Prims.op_Negation - uu___28 in + uu___30 in failwhen - uu___27 + uu___29 "not total?" in Obj.magic (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___26 + uu___28 (fun - uu___27 + uu___29 -> (fun - uu___27 + uu___29 -> - let uu___27 + let uu___29 = Obj.magic - uu___27 in + uu___29 in let mk_pat p = { @@ -8377,28 +8565,28 @@ let (t_destruct : (s_tm1.FStar_Syntax_Syntax.pos) } in let is_imp - uu___28 = - match uu___28 + uu___30 = + match uu___30 with | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit - uu___29) + uu___31) -> true | - uu___29 + uu___31 -> false in - let uu___28 + let uu___30 = FStar_Compiler_List.splitAt nparam args in - match uu___28 + match uu___30 with | (a_ps, a_is) -> - let uu___29 + let uu___31 = failwhen ((FStar_Compiler_List.length @@ -8410,17 +8598,17 @@ let (t_destruct : (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___29 + uu___31 (fun - uu___30 + uu___32 -> (fun - uu___30 + uu___32 -> - let uu___30 + let uu___32 = Obj.magic - uu___30 in + uu___32 in let d_ps_a_ps = FStar_Compiler_List.zip @@ -8429,22 +8617,22 @@ let (t_destruct : = FStar_Compiler_List.map (fun - uu___31 + uu___33 -> - match uu___31 + match uu___33 with | ({ FStar_Syntax_Syntax.binder_bv = bv; FStar_Syntax_Syntax.binder_qual - = uu___32; + = uu___34; FStar_Syntax_Syntax.binder_positivity - = uu___33; + = uu___35; FStar_Syntax_Syntax.binder_attrs - = uu___34;_}, + = uu___36;_}, (t, - uu___35)) + uu___37)) -> FStar_Syntax_Syntax.NT (bv, t)) @@ -8456,22 +8644,22 @@ let (t_destruct : = FStar_Compiler_List.map (fun - uu___31 + uu___33 -> - match uu___31 + match uu___33 with | ({ FStar_Syntax_Syntax.binder_bv = bv; FStar_Syntax_Syntax.binder_qual - = uu___32; + = uu___34; FStar_Syntax_Syntax.binder_positivity - = uu___33; + = uu___35; FStar_Syntax_Syntax.binder_attrs - = uu___34;_}, + = uu___36;_}, (t, - uu___35)) + uu___37)) -> ((mk_pat (FStar_Syntax_Syntax.Pat_dot_term @@ -8483,9 +8671,9 @@ let (t_destruct : = FStar_Compiler_List.map (fun - uu___31 + uu___33 -> - match uu___31 + match uu___33 with | { @@ -8494,9 +8682,9 @@ let (t_destruct : FStar_Syntax_Syntax.binder_qual = bq; FStar_Syntax_Syntax.binder_positivity - = uu___32; + = uu___34; FStar_Syntax_Syntax.binder_attrs - = uu___33;_} + = uu___35;_} -> ((mk_pat (FStar_Syntax_Syntax.Pat_var @@ -8526,7 +8714,7 @@ let (t_destruct : env1.FStar_TypeChecker_Env.universe_of env1 s_ty1 in - let uu___31 + let uu___33 = FStar_TypeChecker_TcTerm.tc_pat { @@ -8687,23 +8875,23 @@ let (t_destruct : (env1.FStar_TypeChecker_Env.core_check) } s_ty1 pat in - match uu___31 + match uu___33 with | - (uu___32, - uu___33, - uu___34, + (uu___34, uu___35, - pat_t, uu___36, + uu___37, + pat_t, + uu___38, _guard_pat, _erasable) -> let eq_b = - let uu___37 + let uu___39 = - let uu___38 + let uu___40 = FStar_Syntax_Util.mk_eq2 equ s_ty1 @@ -8711,38 +8899,38 @@ let (t_destruct : pat_t in FStar_Syntax_Util.mk_squash FStar_Syntax_Syntax.U_zero - uu___38 in + uu___40 in FStar_Syntax_Syntax.gen_bv "breq" FStar_Pervasives_Native.None - uu___37 in + uu___39 in let cod1 = - let uu___37 + let uu___39 = - let uu___38 + let uu___40 = FStar_Syntax_Syntax.mk_binder eq_b in - [uu___38] in - let uu___38 + [uu___40] in + let uu___40 = FStar_Syntax_Syntax.mk_Total cod in FStar_Syntax_Util.arrow - uu___37 - uu___38 in + uu___39 + uu___40 in let nty = - let uu___37 + let uu___39 = FStar_Syntax_Syntax.mk_Total cod1 in FStar_Syntax_Util.arrow bs3 - uu___37 in - let uu___37 + uu___39 in + let uu___39 = - let uu___38 + let uu___40 = FStar_Tactics_Monad.goal_typedness_deps g in @@ -8750,7 +8938,7 @@ let (t_destruct : "destruct branch" env1 nty FStar_Pervasives_Native.None - uu___38 + uu___40 (rangeof g) in Obj.magic @@ -8758,18 +8946,18 @@ let (t_destruct : FStar_Tactics_Monad.monad_tac () () (Obj.magic - uu___37) + uu___39) (fun - uu___38 + uu___40 -> (fun - uu___38 + uu___40 -> - let uu___38 + let uu___40 = Obj.magic - uu___38 in - match uu___38 + uu___40 in + match uu___40 with | (uvt, uv) @@ -8785,51 +8973,51 @@ let (t_destruct : uvt bs3 in let brt1 = - let uu___39 + let uu___41 = - let uu___40 + let uu___42 = FStar_Syntax_Syntax.as_arg FStar_Syntax_Util.exp_unit in - [uu___40] in + [uu___42] in FStar_Syntax_Util.mk_app brt - uu___39 in + uu___41 in let br = FStar_Syntax_Subst.close_branch (pat, FStar_Pervasives_Native.None, brt1) in - let uu___39 + let uu___41 = - let uu___40 + let uu___42 = - let uu___41 + let uu___43 = FStar_BigInt.of_int_fs (FStar_Compiler_List.length bs3) in (fv1, - uu___41) in + uu___43) in (g', br, - uu___40) in + uu___42) in Obj.magic (FStar_Class_Monad.return FStar_Tactics_Monad.monad_tac () (Obj.magic - uu___39))) - uu___38))) - uu___30))) - uu___27)))))) - uu___21)) + uu___41))) + uu___40))) + uu___32))) + uu___29)))))) + uu___23)) | - uu___18 + uu___19 -> Obj.repr (FStar_Tactics_Monad.fail "impossible: not a ctor")))) - uu___17) + uu___18) (Obj.magic c_lids)) in Obj.magic @@ -8837,9 +9025,9 @@ let (t_destruct : FStar_Tactics_Monad.monad_tac () () (Obj.magic - uu___16) + uu___17) (fun - uu___17 + uu___18 -> (fun goal_brs @@ -8848,11 +9036,11 @@ let (t_destruct : = Obj.magic goal_brs in - let uu___17 + let uu___18 = FStar_Compiler_List.unzip3 goal_brs in - match uu___17 + match uu___18 with | (goals, @@ -8874,7 +9062,7 @@ let (t_destruct : FStar_Pervasives_Native.None }) s_tm1.FStar_Syntax_Syntax.pos in - let uu___18 + let uu___19 = solve' g w in @@ -8882,21 +9070,21 @@ let (t_destruct : (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___18 - (fun uu___19 + (fun + uu___20 -> (fun - uu___19 + uu___20 -> - let uu___19 + let uu___20 = Obj.magic - uu___19 in + uu___20 in FStar_Tactics_Monad.mark_goal_implicit_already_checked g; ( - let uu___21 + let uu___22 = FStar_Tactics_Monad.add_goals goals in @@ -8904,28 +9092,28 @@ let (t_destruct : (FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () - uu___21 - (fun uu___22 + (fun + uu___23 -> (fun - uu___22 + uu___23 -> - let uu___22 + let uu___23 = Obj.magic - uu___22 in + uu___23 in Obj.magic (FStar_Class_Monad.return FStar_Tactics_Monad.monad_tac () (Obj.magic infos))) - uu___22)))) - uu___19))) - uu___17))) - uu___14))) - uu___12)) + uu___23)))) + uu___20))) + uu___18))) + uu___15))) + uu___13)) | uu___9 -> Obj.repr @@ -9013,7 +9201,9 @@ let (lset : (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = uu___1; FStar_Tactics_Types.urgency = - (ps.FStar_Tactics_Types.urgency) + (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) } in Obj.magic (FStar_Tactics_Monad.set ps1)) uu___1) in FStar_Tactics_Monad.wrap_err "lset" uu___ @@ -9047,7 +9237,43 @@ let (set_urgency : FStar_BigInt.t -> unit FStar_Tactics_Monad.tac) = (ps.FStar_Tactics_Types.tac_verb_dbg); FStar_Tactics_Types.local_state = (ps.FStar_Tactics_Types.local_state); - FStar_Tactics_Types.urgency = uu___ + FStar_Tactics_Types.urgency = uu___; + FStar_Tactics_Types.dump_on_failure = + (ps.FStar_Tactics_Types.dump_on_failure) + } in + Obj.magic (FStar_Tactics_Monad.set ps1)) uu___) +let (set_dump_on_failure : Prims.bool -> unit FStar_Tactics_Monad.tac) = + fun b -> + FStar_Class_Monad.op_let_Bang FStar_Tactics_Monad.monad_tac () () + (Obj.magic FStar_Tactics_Monad.get) + (fun uu___ -> + (fun ps -> + let ps = Obj.magic ps in + let ps1 = + { + FStar_Tactics_Types.main_context = + (ps.FStar_Tactics_Types.main_context); + FStar_Tactics_Types.all_implicits = + (ps.FStar_Tactics_Types.all_implicits); + FStar_Tactics_Types.goals = (ps.FStar_Tactics_Types.goals); + FStar_Tactics_Types.smt_goals = + (ps.FStar_Tactics_Types.smt_goals); + FStar_Tactics_Types.depth = (ps.FStar_Tactics_Types.depth); + FStar_Tactics_Types.__dump = (ps.FStar_Tactics_Types.__dump); + FStar_Tactics_Types.psc = (ps.FStar_Tactics_Types.psc); + FStar_Tactics_Types.entry_range = + (ps.FStar_Tactics_Types.entry_range); + FStar_Tactics_Types.guard_policy = + (ps.FStar_Tactics_Types.guard_policy); + FStar_Tactics_Types.freshness = + (ps.FStar_Tactics_Types.freshness); + FStar_Tactics_Types.tac_verb_dbg = + (ps.FStar_Tactics_Types.tac_verb_dbg); + FStar_Tactics_Types.local_state = + (ps.FStar_Tactics_Types.local_state); + FStar_Tactics_Types.urgency = + (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = b } in Obj.magic (FStar_Tactics_Monad.set ps1)) uu___) let (t_commute_applied_match : unit -> unit FStar_Tactics_Monad.tac) = @@ -9426,7 +9652,7 @@ let (range_to_string : fun uu___ -> (fun r -> let uu___ = - FStar_Class_Show.show FStar_Compiler_Range_Ops.show_range r in + FStar_Class_Show.show FStar_Compiler_Range_Ops.showable_range r in Obj.magic (FStar_Class_Monad.return FStar_Tactics_Monad.monad_tac () (Obj.magic uu___))) uu___ @@ -9562,8 +9788,11 @@ let (free_uvars : let uvs = let uu___2 = let uu___3 = FStar_Syntax_Free.uvars_uncached tm in - FStar_Compiler_Set.elems FStar_Syntax_Free.ord_ctx_uvar - uu___3 in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uu___3) in FStar_Compiler_List.map (fun u -> let uu___3 = @@ -9675,8 +9904,7 @@ let write : let (dbg_refl : env -> (unit -> Prims.string) -> unit) = fun g -> fun msg -> - let uu___ = - FStar_TypeChecker_Env.debug g (FStar_Options.Other "ReflTc") in + let uu___ = FStar_Compiler_Effect.op_Bang dbg_ReflTc in if uu___ then let uu___1 = msg () in FStar_Compiler_Util.print_string uu___1 else () @@ -9861,13 +10089,23 @@ let refl_typing_builtin_wrapper : let (no_uvars_in_term : FStar_Syntax_Syntax.term -> Prims.bool) = fun t -> (let uu___ = FStar_Syntax_Free.uvars t in - FStar_Compiler_Set.is_empty FStar_Syntax_Free.ord_ctx_uvar uu___) && + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___)) + && (let uu___ = FStar_Syntax_Free.univs t in - FStar_Compiler_Set.is_empty FStar_Syntax_Free.ord_univ_uvar uu___) + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_univ_uvar)) (Obj.magic uu___)) let (no_univ_uvars_in_term : FStar_Syntax_Syntax.term -> Prims.bool) = fun t -> let uu___ = FStar_Syntax_Free.univs t in - FStar_Compiler_Set.is_empty FStar_Syntax_Free.ord_univ_uvar uu___ + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_univ_uvar)) (Obj.magic uu___) let (no_uvars_in_g : env -> Prims.bool) = fun g -> FStar_Compiler_Util.for_all @@ -9957,117 +10195,136 @@ let (refl_is_non_informative : FStar_Class_Monad.return FStar_Tactics_Monad.monad_tac () (Obj.magic uu___2)))) uu___1 uu___ let (refl_check_relation : - env -> - FStar_Syntax_Syntax.typ -> - FStar_Syntax_Syntax.typ -> - relation -> - (unit FStar_Pervasives_Native.option * issues) - FStar_Tactics_Monad.tac) + relation -> + Prims.bool -> + Prims.bool -> + env -> + FStar_Syntax_Syntax.typ -> + FStar_Syntax_Syntax.typ -> + (unit FStar_Pervasives_Native.option * issues) + FStar_Tactics_Monad.tac) = - fun uu___3 -> - fun uu___2 -> - fun uu___1 -> - fun uu___ -> - (fun g -> - fun t0 -> - fun t1 -> - fun rel -> - let uu___ = - ((no_uvars_in_g g) && (no_uvars_in_term t0)) && - (no_uvars_in_term t1) in - if uu___ - then - Obj.magic - (Obj.repr - (refl_typing_builtin_wrapper "refl_check_relation" - (fun uu___1 -> - let g1 = - FStar_TypeChecker_Env.set_range g - t0.FStar_Syntax_Syntax.pos in - dbg_refl g1 - (fun uu___3 -> - let uu___4 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term t0 in - let uu___5 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term t1 in - FStar_Compiler_Util.format3 - "refl_check_relation: %s %s %s\n" - uu___4 - (if rel = Subtyping - then "<:?" - else "=?=") uu___5); - (let f = - if rel = Subtyping - then - FStar_TypeChecker_Core.check_term_subtyping - else - FStar_TypeChecker_Core.check_term_equality in - let uu___3 = f g1 t0 t1 in - match uu___3 with - | FStar_Pervasives.Inl - (FStar_Pervasives_Native.None) -> - (dbg_refl g1 - (fun uu___5 -> - "refl_check_relation: succeeded (no guard)"); - ((), [])) - | FStar_Pervasives.Inl - (FStar_Pervasives_Native.Some guard_f) - -> - (dbg_refl g1 - (fun uu___5 -> - "refl_check_relation: succeeded"); - ((), [(g1, guard_f)])) - | FStar_Pervasives.Inr err -> - (dbg_refl g1 - (fun uu___5 -> - let uu___6 = - FStar_TypeChecker_Core.print_error - err in - FStar_Compiler_Util.format1 - "refl_check_relation failed: %s\n" - uu___6); - (let uu___5 = - let uu___6 = - let uu___7 = - FStar_TypeChecker_Core.print_error - err in - Prims.strcat - "check_relation failed: " uu___7 in - (FStar_Errors_Codes.Fatal_IllTyped, - uu___6) in - let uu___6 = - FStar_TypeChecker_Env.get_range g1 in - FStar_Errors.raise_error uu___5 uu___6)))))) - else - Obj.magic - (Obj.repr - (let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = - FStar_TypeChecker_Env.get_range g in - unexpected_uvars_issue uu___5 in - [uu___4] in - (FStar_Pervasives_Native.None, uu___3) in - FStar_Class_Monad.return - FStar_Tactics_Monad.monad_tac () - (Obj.magic uu___2)))) uu___3 uu___2 uu___1 uu___ + fun uu___5 -> + fun uu___4 -> + fun uu___3 -> + fun uu___2 -> + fun uu___1 -> + fun uu___ -> + (fun rel -> + fun smt_ok -> + fun unfolding_ok -> + fun g -> + fun t0 -> + fun t1 -> + let uu___ = + ((no_uvars_in_g g) && (no_uvars_in_term t0)) && + (no_uvars_in_term t1) in + if uu___ + then + Obj.magic + (Obj.repr + (refl_typing_builtin_wrapper + "refl_check_relation" + (fun uu___1 -> + let g1 = + FStar_TypeChecker_Env.set_range g + t0.FStar_Syntax_Syntax.pos in + dbg_refl g1 + (fun uu___3 -> + let uu___4 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term + t0 in + let uu___5 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term + t1 in + FStar_Compiler_Util.format3 + "refl_check_relation: %s %s %s\n" + uu___4 + (if rel = Subtyping + then "<:?" + else "=?=") uu___5); + (let f = + if rel = Subtyping + then + FStar_TypeChecker_Core.check_term_subtyping + else + FStar_TypeChecker_Core.check_term_equality in + let uu___3 = + f smt_ok unfolding_ok g1 t0 t1 in + match uu___3 with + | FStar_Pervasives.Inl + (FStar_Pervasives_Native.None) + -> + (dbg_refl g1 + (fun uu___5 -> + "refl_check_relation: succeeded (no guard)\n"); + ((), [])) + | FStar_Pervasives.Inl + (FStar_Pervasives_Native.Some + guard_f) -> + (dbg_refl g1 + (fun uu___5 -> + "refl_check_relation: succeeded\n"); + ((), [(g1, guard_f)])) + | FStar_Pervasives.Inr err -> + (dbg_refl g1 + (fun uu___5 -> + let uu___6 = + FStar_TypeChecker_Core.print_error + err in + FStar_Compiler_Util.format1 + "refl_check_relation failed: %s\n" + uu___6); + (let uu___5 = + let uu___6 = + let uu___7 = + FStar_TypeChecker_Core.print_error + err in + Prims.strcat + "check_relation failed: " + uu___7 in + (FStar_Errors_Codes.Fatal_IllTyped, + uu___6) in + let uu___6 = + FStar_TypeChecker_Env.get_range + g1 in + FStar_Errors.raise_error + uu___5 uu___6)))))) + else + Obj.magic + (Obj.repr + (let uu___2 = + let uu___3 = + let uu___4 = + let uu___5 = + FStar_TypeChecker_Env.get_range g in + unexpected_uvars_issue uu___5 in + [uu___4] in + (FStar_Pervasives_Native.None, uu___3) in + FStar_Class_Monad.return + FStar_Tactics_Monad.monad_tac () + (Obj.magic uu___2)))) uu___5 uu___4 + uu___3 uu___2 uu___1 uu___ let (refl_check_subtyping : env -> FStar_Syntax_Syntax.typ -> FStar_Syntax_Syntax.typ -> (unit FStar_Pervasives_Native.option * issues) FStar_Tactics_Monad.tac) - = fun g -> fun t0 -> fun t1 -> refl_check_relation g t0 t1 Subtyping -let (refl_check_equiv : - env -> - FStar_Syntax_Syntax.typ -> - FStar_Syntax_Syntax.typ -> - (unit FStar_Pervasives_Native.option * issues) - FStar_Tactics_Monad.tac) - = fun g -> fun t0 -> fun t1 -> refl_check_relation g t0 t1 Equality + = + fun g -> + fun t0 -> fun t1 -> refl_check_relation Subtyping true true g t0 t1 +let (t_refl_check_equiv : + Prims.bool -> + Prims.bool -> + env -> + FStar_Syntax_Syntax.typ -> + FStar_Syntax_Syntax.typ -> + (unit FStar_Pervasives_Native.option * issues) + FStar_Tactics_Monad.tac) + = refl_check_relation Equality let (to_must_tot : FStar_TypeChecker_Core.tot_or_ghost -> Prims.bool) = fun eff -> match eff with @@ -10381,7 +10638,7 @@ let (refl_tc_term : (fun uu___3 -> let uu___4 = FStar_Class_Show.show - FStar_Compiler_Range_Ops.show_range + FStar_Compiler_Range_Ops.showable_range e.FStar_Syntax_Syntax.pos in let uu___5 = FStar_Class_Show.show @@ -10662,7 +10919,7 @@ let (refl_tc_term : FStar_TypeChecker_Env.get_range g3 in FStar_Class_Show.show - FStar_Compiler_Range_Ops.show_range + FStar_Compiler_Range_Ops.showable_range uu___11 in let uu___11 = FStar_Class_Show.show @@ -10670,7 +10927,7 @@ let (refl_tc_term : guard in let uu___12 = FStar_Class_Show.show - FStar_Compiler_Range_Ops.show_range + FStar_Compiler_Range_Ops.showable_range guard.FStar_Syntax_Syntax.pos in FStar_Compiler_Util.format3 "Got guard in Env@%s |- %s@%s\n" @@ -10693,7 +10950,7 @@ let (refl_tc_term : (fun uu___10 -> let uu___11 = FStar_Class_Show.show - FStar_Compiler_Range_Ops.show_range + FStar_Compiler_Range_Ops.showable_range e2.FStar_Syntax_Syntax.pos in let uu___12 = FStar_Class_Show.show @@ -11737,9 +11994,13 @@ let (refl_try_unify : = FStar_Syntax_Free.uvars_full t2 in - FStar_Compiler_Set.is_empty - FStar_Syntax_Free.ord_ctx_uvar - uu___9 in + FStar_Class_Setlike.is_empty + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic + uu___9) in if uu___8 then (bv, t2) @@ -12168,20 +12429,25 @@ let (log_issues : (fun ps -> let ps = Obj.magic ps in let is1 = - FStar_Compiler_List.map - (fun i -> - let uu___ = - let uu___1 = - FStar_Errors_Msg.text "Tactic logged issue:" in - uu___1 :: (i.FStar_Errors.issue_msg) in - { - FStar_Errors.issue_msg = uu___; - FStar_Errors.issue_level = (i.FStar_Errors.issue_level); - FStar_Errors.issue_range = (i.FStar_Errors.issue_range); - FStar_Errors.issue_number = - (i.FStar_Errors.issue_number); - FStar_Errors.issue_ctx = (i.FStar_Errors.issue_ctx) - }) is in + if ps.FStar_Tactics_Types.dump_on_failure + then + FStar_Compiler_List.map + (fun i -> + let uu___ = + let uu___1 = + FStar_Errors_Msg.text "Tactic logged issue:" in + uu___1 :: (i.FStar_Errors.issue_msg) in + { + FStar_Errors.issue_msg = uu___; + FStar_Errors.issue_level = + (i.FStar_Errors.issue_level); + FStar_Errors.issue_range = + (i.FStar_Errors.issue_range); + FStar_Errors.issue_number = + (i.FStar_Errors.issue_number); + FStar_Errors.issue_ctx = (i.FStar_Errors.issue_ctx) + }) is + else is in FStar_Errors.add_issues is1; Obj.magic (FStar_Class_Monad.return FStar_Tactics_Monad.monad_tac () @@ -12505,9 +12771,7 @@ let (proofstate_of_goals : fun imps -> let env2 = tac_env env1 in let ps = - let uu___ = - FStar_TypeChecker_Env.debug env2 - (FStar_Options.Other "TacVerbose") in + let uu___ = FStar_Compiler_Effect.op_Bang dbg_TacVerbose in let uu___1 = FStar_Compiler_Util.psmap_empty () in { FStar_Tactics_Types.main_context = env2; @@ -12524,7 +12788,8 @@ let (proofstate_of_goals : FStar_Tactics_Types.freshness = Prims.int_zero; FStar_Tactics_Types.tac_verb_dbg = uu___; FStar_Tactics_Types.local_state = uu___1; - FStar_Tactics_Types.urgency = Prims.int_one + FStar_Tactics_Types.urgency = Prims.int_one; + FStar_Tactics_Types.dump_on_failure = true } in ps let (proofstate_of_goal_ty : @@ -12662,9 +12927,7 @@ let (proofstate_of_all_implicits : let uu___ = FStar_Compiler_List.hd goals in FStar_Tactics_Types.goal_witness uu___ in let ps = - let uu___ = - FStar_TypeChecker_Env.debug env2 - (FStar_Options.Other "TacVerbose") in + let uu___ = FStar_Compiler_Effect.op_Bang dbg_TacVerbose in let uu___1 = FStar_Compiler_Util.psmap_empty () in { FStar_Tactics_Types.main_context = env2; @@ -12680,7 +12943,8 @@ let (proofstate_of_all_implicits : FStar_Tactics_Types.freshness = Prims.int_zero; FStar_Tactics_Types.tac_verb_dbg = uu___; FStar_Tactics_Types.local_state = uu___1; - FStar_Tactics_Types.urgency = Prims.int_one + FStar_Tactics_Types.urgency = Prims.int_one; + FStar_Tactics_Types.dump_on_failure = true } in (ps, w) let (getprop : @@ -12774,12 +13038,43 @@ let (call_subtac : proofstate_of_goal_ty rng g goal_ty in match uu___2 with | (ps, w) -> + let ps1 = + { + FStar_Tactics_Types.main_context = + (ps.FStar_Tactics_Types.main_context); + FStar_Tactics_Types.all_implicits = + (ps.FStar_Tactics_Types.all_implicits); + FStar_Tactics_Types.goals = + (ps.FStar_Tactics_Types.goals); + FStar_Tactics_Types.smt_goals = + (ps.FStar_Tactics_Types.smt_goals); + FStar_Tactics_Types.depth = + (ps.FStar_Tactics_Types.depth); + FStar_Tactics_Types.__dump = + (ps.FStar_Tactics_Types.__dump); + FStar_Tactics_Types.psc = + (ps.FStar_Tactics_Types.psc); + FStar_Tactics_Types.entry_range = + (ps.FStar_Tactics_Types.entry_range); + FStar_Tactics_Types.guard_policy = + (ps.FStar_Tactics_Types.guard_policy); + FStar_Tactics_Types.freshness = + (ps.FStar_Tactics_Types.freshness); + FStar_Tactics_Types.tac_verb_dbg = + (ps.FStar_Tactics_Types.tac_verb_dbg); + FStar_Tactics_Types.local_state = + (ps.FStar_Tactics_Types.local_state); + FStar_Tactics_Types.urgency = + (ps.FStar_Tactics_Types.urgency); + FStar_Tactics_Types.dump_on_failure = + false + } in let uu___3 = FStar_Errors.catch_errors_and_ignore_rest (fun uu___4 -> run_unembedded_tactic_on_ps_and_solve_remaining rng rng false () (fun uu___5 -> f) - ps) in + ps1) in (match uu___3 with | ([], FStar_Pervasives_Native.Some ()) -> Obj.magic diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Derived.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Derived.ml index 2e2a41e9b6f..ce75f790f77 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Derived.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Derived.ml @@ -597,12 +597,12 @@ let (debug : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (162)) (Prims.of_int (7)) (Prims.of_int (162)) + (Prims.of_int (161)) (Prims.of_int (7)) (Prims.of_int (161)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (162)) (Prims.of_int (4)) (Prims.of_int (162)) + (Prims.of_int (161)) (Prims.of_int (4)) (Prims.of_int (161)) (Prims.of_int (32))))) (Obj.magic (FStar_Tactics_V2_Builtins.debugging ())) (fun uu___ -> @@ -620,25 +620,25 @@ let (smt : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (169)) (Prims.of_int (10)) (Prims.of_int (169)) + (Prims.of_int (168)) (Prims.of_int (10)) (Prims.of_int (168)) (Prims.of_int (32))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (169)) (Prims.of_int (4)) (Prims.of_int (175)) + (Prims.of_int (168)) (Prims.of_int (4)) (Prims.of_int (174)) (Prims.of_int (11))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (169)) (Prims.of_int (10)) - (Prims.of_int (169)) (Prims.of_int (18))))) + (Prims.of_int (168)) (Prims.of_int (10)) + (Prims.of_int (168)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (169)) (Prims.of_int (10)) - (Prims.of_int (169)) (Prims.of_int (32))))) + (Prims.of_int (168)) (Prims.of_int (10)) + (Prims.of_int (168)) (Prims.of_int (32))))) (Obj.magic (goals ())) (fun uu___1 -> (fun uu___1 -> @@ -648,14 +648,14 @@ let (smt : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (169)) (Prims.of_int (20)) - (Prims.of_int (169)) (Prims.of_int (32))))) + (Prims.of_int (168)) (Prims.of_int (20)) + (Prims.of_int (168)) (Prims.of_int (32))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (169)) (Prims.of_int (10)) - (Prims.of_int (169)) (Prims.of_int (32))))) + (Prims.of_int (168)) (Prims.of_int (10)) + (Prims.of_int (168)) (Prims.of_int (32))))) (Obj.magic (smt_goals ())) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -673,14 +673,14 @@ let (smt : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (173)) (Prims.of_int (8)) - (Prims.of_int (173)) (Prims.of_int (20))))) + (Prims.of_int (172)) (Prims.of_int (8)) + (Prims.of_int (172)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (174)) (Prims.of_int (8)) - (Prims.of_int (174)) (Prims.of_int (32))))) + (Prims.of_int (173)) (Prims.of_int (8)) + (Prims.of_int (173)) (Prims.of_int (32))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_goals gs)) (fun uu___2 -> (fun uu___2 -> @@ -698,12 +698,12 @@ let (later : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (181)) (Prims.of_int (10)) (Prims.of_int (181)) + (Prims.of_int (180)) (Prims.of_int (10)) (Prims.of_int (180)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (181)) (Prims.of_int (4)) (Prims.of_int (183)) + (Prims.of_int (180)) (Prims.of_int (4)) (Prims.of_int (182)) (Prims.of_int (33))))) (Obj.magic (goals ())) (fun uu___1 -> (fun uu___1 -> @@ -755,12 +755,12 @@ let (t_pointwise : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (242)) (Prims.of_int (4)) (Prims.of_int (242)) + (Prims.of_int (241)) (Prims.of_int (4)) (Prims.of_int (241)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (243)) (Prims.of_int (4)) (Prims.of_int (247)) + (Prims.of_int (242)) (Prims.of_int (4)) (Prims.of_int (246)) (Prims.of_int (24))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> @@ -778,13 +778,13 @@ let (t_pointwise : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (245)) (Prims.of_int (4)) - (Prims.of_int (245)) (Prims.of_int (10))))) + (Prims.of_int (244)) (Prims.of_int (4)) + (Prims.of_int (244)) (Prims.of_int (10))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (247)) (Prims.of_int (2)) - (Prims.of_int (247)) (Prims.of_int (24))))) + (Prims.of_int (246)) (Prims.of_int (2)) + (Prims.of_int (246)) (Prims.of_int (24))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> fun uu___1 -> tau ())) (fun uu___ -> @@ -805,12 +805,12 @@ let (topdown_rewrite : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (271)) (Prims.of_int (49)) - (Prims.of_int (280)) (Prims.of_int (10))))) + (Prims.of_int (270)) (Prims.of_int (49)) + (Prims.of_int (279)) (Prims.of_int (10))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (282)) (Prims.of_int (4)) (Prims.of_int (282)) + (Prims.of_int (281)) (Prims.of_int (4)) (Prims.of_int (281)) (Prims.of_int (33))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> @@ -819,13 +819,13 @@ let (topdown_rewrite : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (272)) (Prims.of_int (17)) - (Prims.of_int (272)) (Prims.of_int (23))))) + (Prims.of_int (271)) (Prims.of_int (17)) + (Prims.of_int (271)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (271)) (Prims.of_int (49)) - (Prims.of_int (280)) (Prims.of_int (10))))) + (Prims.of_int (270)) (Prims.of_int (49)) + (Prims.of_int (279)) (Prims.of_int (10))))) (Obj.magic (ctrl t)) (fun uu___1 -> (fun uu___1 -> @@ -837,17 +837,17 @@ let (topdown_rewrite : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (274)) + (Prims.of_int (273)) (Prims.of_int (8)) - (Prims.of_int (278)) + (Prims.of_int (277)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (280)) + (Prims.of_int (279)) (Prims.of_int (6)) - (Prims.of_int (280)) + (Prims.of_int (279)) (Prims.of_int (10))))) (match i with | uu___2 when uu___2 = Prims.int_zero -> @@ -890,12 +890,12 @@ let (cur_module : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (288)) (Prims.of_int (13)) (Prims.of_int (288)) + (Prims.of_int (287)) (Prims.of_int (13)) (Prims.of_int (287)) (Prims.of_int (25))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (288)) (Prims.of_int (4)) (Prims.of_int (288)) + (Prims.of_int (287)) (Prims.of_int (4)) (Prims.of_int (287)) (Prims.of_int (25))))) (Obj.magic (FStar_Tactics_V2_Builtins.top_env ())) (fun uu___1 -> @@ -911,12 +911,12 @@ let (open_modules : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (291)) (Prims.of_int (21)) (Prims.of_int (291)) + (Prims.of_int (290)) (Prims.of_int (21)) (Prims.of_int (290)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (291)) (Prims.of_int (4)) (Prims.of_int (291)) + (Prims.of_int (290)) (Prims.of_int (4)) (Prims.of_int (290)) (Prims.of_int (33))))) (Obj.magic (FStar_Tactics_V2_Builtins.top_env ())) (fun uu___1 -> @@ -932,12 +932,12 @@ let (fresh_uvar : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (294)) (Prims.of_int (12)) (Prims.of_int (294)) + (Prims.of_int (293)) (Prims.of_int (12)) (Prims.of_int (293)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (295)) (Prims.of_int (4)) (Prims.of_int (295)) + (Prims.of_int (294)) (Prims.of_int (4)) (Prims.of_int (294)) (Prims.of_int (16))))) (Obj.magic (cur_env ())) (fun uu___ -> (fun e -> Obj.magic (FStar_Tactics_V2_Builtins.uvar_env e o)) uu___) @@ -952,12 +952,12 @@ let (unify : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (298)) (Prims.of_int (12)) - (Prims.of_int (298)) (Prims.of_int (22))))) + (Prims.of_int (297)) (Prims.of_int (12)) + (Prims.of_int (297)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (299)) (Prims.of_int (4)) (Prims.of_int (299)) + (Prims.of_int (298)) (Prims.of_int (4)) (Prims.of_int (298)) (Prims.of_int (21))))) (Obj.magic (cur_env ())) (fun uu___ -> (fun e -> Obj.magic (FStar_Tactics_V2_Builtins.unify_env e t1 t2)) @@ -973,12 +973,12 @@ let (unify_guard : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (302)) (Prims.of_int (12)) - (Prims.of_int (302)) (Prims.of_int (22))))) + (Prims.of_int (301)) (Prims.of_int (12)) + (Prims.of_int (301)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (303)) (Prims.of_int (4)) (Prims.of_int (303)) + (Prims.of_int (302)) (Prims.of_int (4)) (Prims.of_int (302)) (Prims.of_int (27))))) (Obj.magic (cur_env ())) (fun uu___ -> (fun e -> @@ -995,12 +995,12 @@ let (tmatch : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (306)) (Prims.of_int (12)) - (Prims.of_int (306)) (Prims.of_int (22))))) + (Prims.of_int (305)) (Prims.of_int (12)) + (Prims.of_int (305)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (307)) (Prims.of_int (4)) (Prims.of_int (307)) + (Prims.of_int (306)) (Prims.of_int (4)) (Prims.of_int (306)) (Prims.of_int (21))))) (Obj.magic (cur_env ())) (fun uu___ -> (fun e -> Obj.magic (FStar_Tactics_V2_Builtins.match_env e t1 t2)) @@ -1019,13 +1019,13 @@ let divide : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (313)) (Prims.of_int (4)) - (Prims.of_int (314)) (Prims.of_int (31))))) + (Prims.of_int (312)) (Prims.of_int (4)) + (Prims.of_int (313)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (314)) (Prims.of_int (32)) - (Prims.of_int (327)) (Prims.of_int (10))))) + (Prims.of_int (313)) (Prims.of_int (32)) + (Prims.of_int (326)) (Prims.of_int (10))))) (if n < Prims.int_zero then fail "divide: negative n" else FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> ())) @@ -1037,28 +1037,28 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (315)) (Prims.of_int (18)) - (Prims.of_int (315)) (Prims.of_int (40))))) + (Prims.of_int (314)) (Prims.of_int (18)) + (Prims.of_int (314)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (314)) (Prims.of_int (32)) - (Prims.of_int (327)) (Prims.of_int (10))))) + (Prims.of_int (313)) (Prims.of_int (32)) + (Prims.of_int (326)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (315)) (Prims.of_int (18)) - (Prims.of_int (315)) (Prims.of_int (26))))) + (Prims.of_int (314)) (Prims.of_int (18)) + (Prims.of_int (314)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (315)) (Prims.of_int (18)) - (Prims.of_int (315)) (Prims.of_int (40))))) + (Prims.of_int (314)) (Prims.of_int (18)) + (Prims.of_int (314)) (Prims.of_int (40))))) (Obj.magic (goals ())) (fun uu___1 -> (fun uu___1 -> @@ -1068,17 +1068,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (315)) + (Prims.of_int (314)) (Prims.of_int (28)) - (Prims.of_int (315)) + (Prims.of_int (314)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (315)) + (Prims.of_int (314)) (Prims.of_int (18)) - (Prims.of_int (315)) + (Prims.of_int (314)) (Prims.of_int (40))))) (Obj.magic (smt_goals ())) (fun uu___2 -> @@ -1095,17 +1095,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (316)) + (Prims.of_int (315)) (Prims.of_int (19)) - (Prims.of_int (316)) + (Prims.of_int (315)) (Prims.of_int (45))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (315)) + (Prims.of_int (314)) (Prims.of_int (43)) - (Prims.of_int (327)) + (Prims.of_int (326)) (Prims.of_int (10))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> @@ -1120,17 +1120,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (318)) + (Prims.of_int (317)) (Prims.of_int (4)) - (Prims.of_int (318)) + (Prims.of_int (317)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (318)) + (Prims.of_int (317)) (Prims.of_int (19)) - (Prims.of_int (327)) + (Prims.of_int (326)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_goals @@ -1144,18 +1144,18 @@ let divide : ( FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (318)) + (Prims.of_int (317)) (Prims.of_int (19)) - (Prims.of_int (318)) + (Prims.of_int (317)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic ( FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (318)) + (Prims.of_int (317)) (Prims.of_int (36)) - (Prims.of_int (327)) + (Prims.of_int (326)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_smt_goals @@ -1169,17 +1169,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (319)) + (Prims.of_int (318)) (Prims.of_int (12)) - (Prims.of_int (319)) + (Prims.of_int (318)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (319)) + (Prims.of_int (318)) (Prims.of_int (19)) - (Prims.of_int (327)) + (Prims.of_int (326)) (Prims.of_int (10))))) (Obj.magic (l ())) @@ -1192,17 +1192,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (320)) + (Prims.of_int (319)) (Prims.of_int (20)) - (Prims.of_int (320)) + (Prims.of_int (319)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (319)) + (Prims.of_int (318)) (Prims.of_int (19)) - (Prims.of_int (327)) + (Prims.of_int (326)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1210,17 +1210,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (320)) + (Prims.of_int (319)) (Prims.of_int (20)) - (Prims.of_int (320)) + (Prims.of_int (319)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (320)) + (Prims.of_int (319)) (Prims.of_int (20)) - (Prims.of_int (320)) + (Prims.of_int (319)) (Prims.of_int (42))))) (Obj.magic (goals ())) @@ -1234,17 +1234,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (320)) + (Prims.of_int (319)) (Prims.of_int (30)) - (Prims.of_int (320)) + (Prims.of_int (319)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (320)) + (Prims.of_int (319)) (Prims.of_int (20)) - (Prims.of_int (320)) + (Prims.of_int (319)) (Prims.of_int (42))))) (Obj.magic (smt_goals @@ -1272,17 +1272,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (322)) + (Prims.of_int (321)) (Prims.of_int (4)) - (Prims.of_int (322)) + (Prims.of_int (321)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (322)) + (Prims.of_int (321)) (Prims.of_int (19)) - (Prims.of_int (327)) + (Prims.of_int (326)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_goals @@ -1297,17 +1297,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (322)) + (Prims.of_int (321)) (Prims.of_int (19)) - (Prims.of_int (322)) + (Prims.of_int (321)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (322)) + (Prims.of_int (321)) (Prims.of_int (36)) - (Prims.of_int (327)) + (Prims.of_int (326)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_smt_goals @@ -1322,17 +1322,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (323)) + (Prims.of_int (322)) (Prims.of_int (12)) - (Prims.of_int (323)) + (Prims.of_int (322)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (323)) + (Prims.of_int (322)) (Prims.of_int (19)) - (Prims.of_int (327)) + (Prims.of_int (326)) (Prims.of_int (10))))) (Obj.magic (r ())) @@ -1345,17 +1345,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (20)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (323)) + (Prims.of_int (322)) (Prims.of_int (19)) - (Prims.of_int (327)) + (Prims.of_int (326)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1363,17 +1363,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (20)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (20)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (42))))) (Obj.magic (goals ())) @@ -1387,17 +1387,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (30)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (20)) - (Prims.of_int (324)) + (Prims.of_int (323)) (Prims.of_int (42))))) (Obj.magic (smt_goals @@ -1426,17 +1426,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (326)) + (Prims.of_int (325)) (Prims.of_int (4)) - (Prims.of_int (326)) + (Prims.of_int (325)) (Prims.of_int (25))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (326)) + (Prims.of_int (325)) (Prims.of_int (27)) - (Prims.of_int (327)) + (Prims.of_int (326)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_goals @@ -1453,17 +1453,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (326)) + (Prims.of_int (325)) (Prims.of_int (27)) - (Prims.of_int (326)) + (Prims.of_int (325)) (Prims.of_int (60))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (327)) + (Prims.of_int (326)) (Prims.of_int (4)) - (Prims.of_int (327)) + (Prims.of_int (326)) (Prims.of_int (10))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_smt_goals @@ -1503,13 +1503,13 @@ let rec (iseq : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (331)) (Prims.of_int (23)) - (Prims.of_int (331)) (Prims.of_int (53))))) + (Prims.of_int (330)) (Prims.of_int (23)) + (Prims.of_int (330)) (Prims.of_int (53))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (331)) (Prims.of_int (57)) - (Prims.of_int (331)) (Prims.of_int (59))))) + (Prims.of_int (330)) (Prims.of_int (57)) + (Prims.of_int (330)) (Prims.of_int (59))))) (Obj.magic (divide Prims.int_one t (fun uu___ -> iseq ts1))) (fun uu___ -> @@ -1528,12 +1528,12 @@ let focus : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (337)) (Prims.of_int (10)) (Prims.of_int (337)) + (Prims.of_int (336)) (Prims.of_int (10)) (Prims.of_int (336)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (337)) (Prims.of_int (4)) (Prims.of_int (344)) + (Prims.of_int (336)) (Prims.of_int (4)) (Prims.of_int (343)) (Prims.of_int (9))))) (Obj.magic (goals ())) (fun uu___ -> (fun uu___ -> @@ -1547,14 +1547,14 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (340)) (Prims.of_int (18)) - (Prims.of_int (340)) (Prims.of_int (30))))) + (Prims.of_int (339)) (Prims.of_int (18)) + (Prims.of_int (339)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (341)) (Prims.of_int (8)) - (Prims.of_int (344)) (Prims.of_int (9))))) + (Prims.of_int (340)) (Prims.of_int (8)) + (Prims.of_int (343)) (Prims.of_int (9))))) (Obj.magic (smt_goals ())) (fun uu___1 -> (fun sgs -> @@ -1564,17 +1564,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (341)) + (Prims.of_int (340)) (Prims.of_int (8)) - (Prims.of_int (341)) + (Prims.of_int (340)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (341)) + (Prims.of_int (340)) (Prims.of_int (23)) - (Prims.of_int (344)) + (Prims.of_int (343)) (Prims.of_int (9))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_goals @@ -1587,17 +1587,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (341)) + (Prims.of_int (340)) (Prims.of_int (23)) - (Prims.of_int (341)) + (Prims.of_int (340)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (341)) + (Prims.of_int (340)) (Prims.of_int (40)) - (Prims.of_int (344)) + (Prims.of_int (343)) (Prims.of_int (9))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_smt_goals @@ -1610,17 +1610,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (342)) + (Prims.of_int (341)) (Prims.of_int (16)) - (Prims.of_int (342)) + (Prims.of_int (341)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (8)) - (Prims.of_int (344)) + (Prims.of_int (343)) (Prims.of_int (9))))) (Obj.magic (t ())) (fun uu___3 -> @@ -1632,18 +1632,18 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (8)) - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (33))))) ( FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (35)) - (Prims.of_int (344)) + (Prims.of_int (343)) (Prims.of_int (9))))) ( Obj.magic @@ -1652,17 +1652,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (18)) - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (8)) - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (33))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1670,17 +1670,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (19)) - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (18)) - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (33))))) (Obj.magic (goals ())) @@ -1710,17 +1710,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (35)) - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (69))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (342)) + (Prims.of_int (341)) (Prims.of_int (12)) - (Prims.of_int (342)) + (Prims.of_int (341)) (Prims.of_int (13))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1728,17 +1728,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (49)) - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (69))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (35)) - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (69))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -1746,17 +1746,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (50)) - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (62))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (49)) - (Prims.of_int (343)) + (Prims.of_int (342)) (Prims.of_int (69))))) (Obj.magic (smt_goals @@ -1799,12 +1799,12 @@ let rec mapAll : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (350)) (Prims.of_int (10)) (Prims.of_int (350)) + (Prims.of_int (349)) (Prims.of_int (10)) (Prims.of_int (349)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (350)) (Prims.of_int (4)) (Prims.of_int (352)) + (Prims.of_int (349)) (Prims.of_int (4)) (Prims.of_int (351)) (Prims.of_int (66))))) (Obj.magic (goals ())) (fun uu___ -> (fun uu___ -> @@ -1821,14 +1821,14 @@ let rec mapAll : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (352)) (Prims.of_int (27)) - (Prims.of_int (352)) (Prims.of_int (58))))) + (Prims.of_int (351)) (Prims.of_int (27)) + (Prims.of_int (351)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (352)) (Prims.of_int (13)) - (Prims.of_int (352)) (Prims.of_int (66))))) + (Prims.of_int (351)) (Prims.of_int (13)) + (Prims.of_int (351)) (Prims.of_int (66))))) (Obj.magic (divide Prims.int_one t (fun uu___3 -> mapAll t))) (fun uu___3 -> @@ -1845,12 +1845,12 @@ let rec (iterAll : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (356)) (Prims.of_int (10)) (Prims.of_int (356)) + (Prims.of_int (355)) (Prims.of_int (10)) (Prims.of_int (355)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (356)) (Prims.of_int (4)) (Prims.of_int (358)) + (Prims.of_int (355)) (Prims.of_int (4)) (Prims.of_int (357)) (Prims.of_int (60))))) (Obj.magic (goals ())) (fun uu___ -> (fun uu___ -> @@ -1867,14 +1867,14 @@ let rec (iterAll : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (358)) (Prims.of_int (22)) - (Prims.of_int (358)) (Prims.of_int (54))))) + (Prims.of_int (357)) (Prims.of_int (22)) + (Prims.of_int (357)) (Prims.of_int (54))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (358)) (Prims.of_int (58)) - (Prims.of_int (358)) (Prims.of_int (60))))) + (Prims.of_int (357)) (Prims.of_int (58)) + (Prims.of_int (357)) (Prims.of_int (60))))) (Obj.magic (divide Prims.int_one t (fun uu___3 -> iterAll t))) (fun uu___3 -> @@ -1889,25 +1889,25 @@ let (iterAllSMT : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (361)) (Prims.of_int (18)) (Prims.of_int (361)) + (Prims.of_int (360)) (Prims.of_int (18)) (Prims.of_int (360)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (360)) (Prims.of_int (50)) (Prims.of_int (367)) + (Prims.of_int (359)) (Prims.of_int (50)) (Prims.of_int (366)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (361)) (Prims.of_int (18)) - (Prims.of_int (361)) (Prims.of_int (26))))) + (Prims.of_int (360)) (Prims.of_int (18)) + (Prims.of_int (360)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (361)) (Prims.of_int (18)) - (Prims.of_int (361)) (Prims.of_int (40))))) + (Prims.of_int (360)) (Prims.of_int (18)) + (Prims.of_int (360)) (Prims.of_int (40))))) (Obj.magic (goals ())) (fun uu___ -> (fun uu___ -> @@ -1917,14 +1917,14 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (361)) (Prims.of_int (28)) - (Prims.of_int (361)) (Prims.of_int (40))))) + (Prims.of_int (360)) (Prims.of_int (28)) + (Prims.of_int (360)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (361)) (Prims.of_int (18)) - (Prims.of_int (361)) (Prims.of_int (40))))) + (Prims.of_int (360)) (Prims.of_int (18)) + (Prims.of_int (360)) (Prims.of_int (40))))) (Obj.magic (smt_goals ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -1939,14 +1939,14 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (362)) (Prims.of_int (4)) - (Prims.of_int (362)) (Prims.of_int (17))))) + (Prims.of_int (361)) (Prims.of_int (4)) + (Prims.of_int (361)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (363)) (Prims.of_int (4)) - (Prims.of_int (367)) (Prims.of_int (28))))) + (Prims.of_int (362)) (Prims.of_int (4)) + (Prims.of_int (366)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_goals sgs)) (fun uu___1 -> (fun uu___1 -> @@ -1956,17 +1956,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (363)) + (Prims.of_int (362)) (Prims.of_int (4)) - (Prims.of_int (363)) + (Prims.of_int (362)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (364)) + (Prims.of_int (363)) (Prims.of_int (4)) - (Prims.of_int (367)) + (Prims.of_int (366)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_smt_goals @@ -1979,17 +1979,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (364)) + (Prims.of_int (363)) (Prims.of_int (4)) - (Prims.of_int (364)) + (Prims.of_int (363)) (Prims.of_int (13))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (364)) + (Prims.of_int (363)) (Prims.of_int (14)) - (Prims.of_int (367)) + (Prims.of_int (366)) (Prims.of_int (28))))) (Obj.magic (iterAll t)) (fun uu___3 -> @@ -2000,17 +2000,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (365)) + (Prims.of_int (364)) (Prims.of_int (20)) - (Prims.of_int (365)) + (Prims.of_int (364)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (364)) + (Prims.of_int (363)) (Prims.of_int (14)) - (Prims.of_int (367)) + (Prims.of_int (366)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2018,17 +2018,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (365)) + (Prims.of_int (364)) (Prims.of_int (20)) - (Prims.of_int (365)) + (Prims.of_int (364)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (365)) + (Prims.of_int (364)) (Prims.of_int (20)) - (Prims.of_int (365)) + (Prims.of_int (364)) (Prims.of_int (42))))) (Obj.magic (goals ())) @@ -2041,17 +2041,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (365)) + (Prims.of_int (364)) (Prims.of_int (30)) - (Prims.of_int (365)) + (Prims.of_int (364)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (365)) + (Prims.of_int (364)) (Prims.of_int (20)) - (Prims.of_int (365)) + (Prims.of_int (364)) (Prims.of_int (42))))) (Obj.magic (smt_goals @@ -2074,17 +2074,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (366)) + (Prims.of_int (365)) (Prims.of_int (4)) - (Prims.of_int (366)) + (Prims.of_int (365)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (367)) + (Prims.of_int (366)) (Prims.of_int (4)) - (Prims.of_int (367)) + (Prims.of_int (366)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_goals @@ -2114,13 +2114,13 @@ let (seq : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (373)) (Prims.of_int (21)) - (Prims.of_int (373)) (Prims.of_int (25))))) + (Prims.of_int (372)) (Prims.of_int (21)) + (Prims.of_int (372)) (Prims.of_int (25))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (373)) (Prims.of_int (27)) - (Prims.of_int (373)) (Prims.of_int (36))))) + (Prims.of_int (372)) (Prims.of_int (27)) + (Prims.of_int (372)) (Prims.of_int (36))))) (Obj.magic (f ())) (fun uu___1 -> (fun uu___1 -> Obj.magic (iterAll g)) uu___1)) let (exact_args : @@ -2136,13 +2136,13 @@ let (exact_args : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (377)) (Prims.of_int (16)) - (Prims.of_int (377)) (Prims.of_int (39))))) + (Prims.of_int (376)) (Prims.of_int (16)) + (Prims.of_int (376)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (377)) (Prims.of_int (42)) - (Prims.of_int (383)) (Prims.of_int (44))))) + (Prims.of_int (376)) (Prims.of_int (42)) + (Prims.of_int (382)) (Prims.of_int (44))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> FStar_List_Tot_Base.length qs)) (fun uu___1 -> @@ -2153,14 +2153,14 @@ let (exact_args : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (378)) (Prims.of_int (18)) - (Prims.of_int (378)) (Prims.of_int (55))))) + (Prims.of_int (377)) (Prims.of_int (18)) + (Prims.of_int (377)) (Prims.of_int (55))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (378)) (Prims.of_int (58)) - (Prims.of_int (383)) (Prims.of_int (44))))) + (Prims.of_int (377)) (Prims.of_int (58)) + (Prims.of_int (382)) (Prims.of_int (44))))) (Obj.magic (FStar_Tactics_Util.repeatn n (fun uu___1 -> @@ -2173,17 +2173,17 @@ let (exact_args : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (379)) + (Prims.of_int (378)) (Prims.of_int (17)) - (Prims.of_int (379)) + (Prims.of_int (378)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (380)) + (Prims.of_int (379)) (Prims.of_int (8)) - (Prims.of_int (383)) + (Prims.of_int (382)) (Prims.of_int (44))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -2191,17 +2191,17 @@ let (exact_args : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (379)) + (Prims.of_int (378)) (Prims.of_int (26)) - (Prims.of_int (379)) + (Prims.of_int (378)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (379)) + (Prims.of_int (378)) (Prims.of_int (17)) - (Prims.of_int (379)) + (Prims.of_int (378)) (Prims.of_int (38))))) (Obj.magic (FStar_Tactics_Util.zip uvs qs)) @@ -2218,17 +2218,17 @@ let (exact_args : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (380)) + (Prims.of_int (379)) (Prims.of_int (8)) - (Prims.of_int (380)) + (Prims.of_int (379)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (381)) + (Prims.of_int (380)) (Prims.of_int (8)) - (Prims.of_int (383)) + (Prims.of_int (382)) (Prims.of_int (44))))) (Obj.magic (exact t')) (fun uu___1 -> @@ -2267,12 +2267,12 @@ let (exact_n : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (387)) (Prims.of_int (15)) - (Prims.of_int (387)) (Prims.of_int (49))))) + (Prims.of_int (386)) (Prims.of_int (15)) + (Prims.of_int (386)) (Prims.of_int (49))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (387)) (Prims.of_int (4)) (Prims.of_int (387)) + (Prims.of_int (386)) (Prims.of_int (4)) (Prims.of_int (386)) (Prims.of_int (51))))) (Obj.magic (FStar_Tactics_Util.repeatn n @@ -2289,12 +2289,12 @@ let (ngoals : unit -> (Prims.int, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (390)) (Prims.of_int (47)) (Prims.of_int (390)) + (Prims.of_int (389)) (Prims.of_int (47)) (Prims.of_int (389)) (Prims.of_int (57))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (390)) (Prims.of_int (26)) (Prims.of_int (390)) + (Prims.of_int (389)) (Prims.of_int (26)) (Prims.of_int (389)) (Prims.of_int (57))))) (Obj.magic (goals ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -2305,12 +2305,12 @@ let (ngoals_smt : unit -> (Prims.int, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (393)) (Prims.of_int (51)) (Prims.of_int (393)) + (Prims.of_int (392)) (Prims.of_int (51)) (Prims.of_int (392)) (Prims.of_int (65))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (393)) (Prims.of_int (30)) (Prims.of_int (393)) + (Prims.of_int (392)) (Prims.of_int (30)) (Prims.of_int (392)) (Prims.of_int (65))))) (Obj.magic (smt_goals ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -2324,12 +2324,12 @@ let (fresh_namedv_named : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (397)) (Prims.of_int (10)) (Prims.of_int (397)) + (Prims.of_int (396)) (Prims.of_int (10)) (Prims.of_int (396)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (398)) (Prims.of_int (2)) (Prims.of_int (402)) + (Prims.of_int (397)) (Prims.of_int (2)) (Prims.of_int (401)) (Prims.of_int (4))))) (Obj.magic (FStar_Tactics_V2_Builtins.fresh ())) (fun n -> @@ -2353,12 +2353,12 @@ let (fresh_namedv : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (407)) (Prims.of_int (10)) (Prims.of_int (407)) + (Prims.of_int (406)) (Prims.of_int (10)) (Prims.of_int (406)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (408)) (Prims.of_int (2)) (Prims.of_int (412)) + (Prims.of_int (407)) (Prims.of_int (2)) (Prims.of_int (411)) (Prims.of_int (4))))) (Obj.magic (FStar_Tactics_V2_Builtins.fresh ())) (fun n -> @@ -2387,12 +2387,12 @@ let (fresh_binder_named : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (415)) (Prims.of_int (10)) - (Prims.of_int (415)) (Prims.of_int (18))))) + (Prims.of_int (414)) (Prims.of_int (10)) + (Prims.of_int (414)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (417)) (Prims.of_int (4)) (Prims.of_int (421)) + (Prims.of_int (416)) (Prims.of_int (4)) (Prims.of_int (420)) (Prims.of_int (17))))) (Obj.magic (FStar_Tactics_V2_Builtins.fresh ())) (fun n -> @@ -2416,12 +2416,12 @@ let (fresh_binder : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (425)) (Prims.of_int (10)) (Prims.of_int (425)) + (Prims.of_int (424)) (Prims.of_int (10)) (Prims.of_int (424)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (427)) (Prims.of_int (4)) (Prims.of_int (431)) + (Prims.of_int (426)) (Prims.of_int (4)) (Prims.of_int (430)) (Prims.of_int (17))))) (Obj.magic (FStar_Tactics_V2_Builtins.fresh ())) (fun n -> @@ -2446,12 +2446,12 @@ let (fresh_implicit_binder : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (435)) (Prims.of_int (10)) (Prims.of_int (435)) + (Prims.of_int (434)) (Prims.of_int (10)) (Prims.of_int (434)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (437)) (Prims.of_int (4)) (Prims.of_int (441)) + (Prims.of_int (436)) (Prims.of_int (4)) (Prims.of_int (440)) (Prims.of_int (17))))) (Obj.magic (FStar_Tactics_V2_Builtins.fresh ())) (fun n -> @@ -2486,12 +2486,12 @@ let try_with : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (455)) (Prims.of_int (10)) - (Prims.of_int (455)) (Prims.of_int (17))))) + (Prims.of_int (454)) (Prims.of_int (10)) + (Prims.of_int (454)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (455)) (Prims.of_int (4)) (Prims.of_int (457)) + (Prims.of_int (454)) (Prims.of_int (4)) (Prims.of_int (456)) (Prims.of_int (16))))) (Obj.magic (FStar_Tactics_V2_Builtins.catch f)) (fun uu___ -> @@ -2517,13 +2517,13 @@ let trytac : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (460)) (Prims.of_int (13)) - (Prims.of_int (460)) (Prims.of_int (19))))) + (Prims.of_int (459)) (Prims.of_int (13)) + (Prims.of_int (459)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (460)) (Prims.of_int (8)) - (Prims.of_int (460)) (Prims.of_int (19))))) + (Prims.of_int (459)) (Prims.of_int (8)) + (Prims.of_int (459)) (Prims.of_int (19))))) (Obj.magic (t ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -2568,12 +2568,12 @@ let rec repeat : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (477)) (Prims.of_int (10)) (Prims.of_int (477)) + (Prims.of_int (476)) (Prims.of_int (10)) (Prims.of_int (476)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (477)) (Prims.of_int (4)) (Prims.of_int (479)) + (Prims.of_int (476)) (Prims.of_int (4)) (Prims.of_int (478)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_V2_Builtins.catch t)) (fun uu___ -> @@ -2591,14 +2591,14 @@ let rec repeat : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (479)) (Prims.of_int (20)) - (Prims.of_int (479)) (Prims.of_int (28))))) + (Prims.of_int (478)) (Prims.of_int (20)) + (Prims.of_int (478)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (479)) (Prims.of_int (15)) - (Prims.of_int (479)) (Prims.of_int (28))))) + (Prims.of_int (478)) (Prims.of_int (15)) + (Prims.of_int (478)) (Prims.of_int (28))))) (Obj.magic (repeat t)) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -2613,12 +2613,12 @@ let repeat1 : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (482)) (Prims.of_int (4)) (Prims.of_int (482)) + (Prims.of_int (481)) (Prims.of_int (4)) (Prims.of_int (481)) (Prims.of_int (8))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (482)) (Prims.of_int (4)) (Prims.of_int (482)) + (Prims.of_int (481)) (Prims.of_int (4)) (Prims.of_int (481)) (Prims.of_int (20))))) (Obj.magic (t ())) (fun uu___ -> (fun uu___ -> @@ -2627,13 +2627,13 @@ let repeat1 : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (482)) (Prims.of_int (12)) - (Prims.of_int (482)) (Prims.of_int (20))))) + (Prims.of_int (481)) (Prims.of_int (12)) + (Prims.of_int (481)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (482)) (Prims.of_int (4)) - (Prims.of_int (482)) (Prims.of_int (20))))) + (Prims.of_int (481)) (Prims.of_int (4)) + (Prims.of_int (481)) (Prims.of_int (20))))) (Obj.magic (repeat t)) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -2648,12 +2648,12 @@ let repeat' : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (485)) (Prims.of_int (12)) (Prims.of_int (485)) + (Prims.of_int (484)) (Prims.of_int (12)) (Prims.of_int (484)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (485)) (Prims.of_int (24)) (Prims.of_int (485)) + (Prims.of_int (484)) (Prims.of_int (24)) (Prims.of_int (484)) (Prims.of_int (26))))) (Obj.magic (repeat f)) (fun uu___ -> FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> ())) let (norm_term : @@ -2667,12 +2667,12 @@ let (norm_term : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (489)) (Prims.of_int (8)) (Prims.of_int (490)) + (Prims.of_int (488)) (Prims.of_int (8)) (Prims.of_int (489)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (492)) (Prims.of_int (4)) (Prims.of_int (492)) + (Prims.of_int (491)) (Prims.of_int (4)) (Prims.of_int (491)) (Prims.of_int (23))))) (Obj.magic (try_with (fun uu___ -> match () with | () -> cur_env ()) @@ -2688,25 +2688,25 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (499)) (Prims.of_int (16)) (Prims.of_int (499)) + (Prims.of_int (498)) (Prims.of_int (16)) (Prims.of_int (498)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (498)) (Prims.of_int (27)) (Prims.of_int (505)) + (Prims.of_int (497)) (Prims.of_int (27)) (Prims.of_int (504)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (499)) (Prims.of_int (16)) - (Prims.of_int (499)) (Prims.of_int (24))))) + (Prims.of_int (498)) (Prims.of_int (16)) + (Prims.of_int (498)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (499)) (Prims.of_int (16)) - (Prims.of_int (499)) (Prims.of_int (38))))) + (Prims.of_int (498)) (Prims.of_int (16)) + (Prims.of_int (498)) (Prims.of_int (38))))) (Obj.magic (goals ())) (fun uu___1 -> (fun uu___1 -> @@ -2716,14 +2716,14 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (499)) (Prims.of_int (26)) - (Prims.of_int (499)) (Prims.of_int (38))))) + (Prims.of_int (498)) (Prims.of_int (26)) + (Prims.of_int (498)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (499)) (Prims.of_int (16)) - (Prims.of_int (499)) (Prims.of_int (38))))) + (Prims.of_int (498)) (Prims.of_int (16)) + (Prims.of_int (498)) (Prims.of_int (38))))) (Obj.magic (smt_goals ())) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -2738,14 +2738,14 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (500)) (Prims.of_int (2)) - (Prims.of_int (500)) (Prims.of_int (18))))) + (Prims.of_int (499)) (Prims.of_int (2)) + (Prims.of_int (499)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (501)) (Prims.of_int (2)) - (Prims.of_int (505)) (Prims.of_int (20))))) + (Prims.of_int (500)) (Prims.of_int (2)) + (Prims.of_int (504)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_smt_goals [])) (fun uu___2 -> (fun uu___2 -> @@ -2755,17 +2755,17 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (501)) + (Prims.of_int (500)) (Prims.of_int (2)) - (Prims.of_int (501)) + (Prims.of_int (500)) (Prims.of_int (15))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (502)) + (Prims.of_int (501)) (Prims.of_int (2)) - (Prims.of_int (505)) + (Prims.of_int (504)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_V2_Builtins.set_goals sgs)) @@ -2777,17 +2777,17 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (502)) + (Prims.of_int (501)) (Prims.of_int (2)) - (Prims.of_int (502)) + (Prims.of_int (501)) (Prims.of_int (14))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (502)) + (Prims.of_int (501)) (Prims.of_int (15)) - (Prims.of_int (505)) + (Prims.of_int (504)) (Prims.of_int (20))))) (Obj.magic (repeat' @@ -2800,17 +2800,17 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (503)) + (Prims.of_int (502)) (Prims.of_int (13)) - (Prims.of_int (503)) + (Prims.of_int (502)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (504)) + (Prims.of_int (503)) (Prims.of_int (2)) - (Prims.of_int (505)) + (Prims.of_int (504)) (Prims.of_int (20))))) (Obj.magic (goals ())) (fun uu___5 -> @@ -2822,18 +2822,18 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (504)) + (Prims.of_int (503)) (Prims.of_int (2)) - (Prims.of_int (504)) + (Prims.of_int (503)) (Prims.of_int (14))))) (FStar_Sealed.seal ( Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (505)) + (Prims.of_int (504)) (Prims.of_int (2)) - (Prims.of_int (505)) + (Prims.of_int (504)) (Prims.of_int (20))))) (Obj.magic ( @@ -2860,13 +2860,13 @@ let discard : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (508)) (Prims.of_int (22)) - (Prims.of_int (508)) (Prims.of_int (28))))) + (Prims.of_int (507)) (Prims.of_int (22)) + (Prims.of_int (507)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (508)) (Prims.of_int (32)) - (Prims.of_int (508)) (Prims.of_int (34))))) + (Prims.of_int (507)) (Prims.of_int (32)) + (Prims.of_int (507)) (Prims.of_int (34))))) (Obj.magic (tau ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ())) let rec repeatseq : @@ -2879,12 +2879,12 @@ let rec repeatseq : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (512)) (Prims.of_int (12)) (Prims.of_int (512)) + (Prims.of_int (511)) (Prims.of_int (12)) (Prims.of_int (511)) (Prims.of_int (82))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (512)) (Prims.of_int (86)) (Prims.of_int (512)) + (Prims.of_int (511)) (Prims.of_int (86)) (Prims.of_int (511)) (Prims.of_int (88))))) (Obj.magic (trytac @@ -2904,12 +2904,12 @@ let (admit_all : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (520)) (Prims.of_int (12)) (Prims.of_int (520)) + (Prims.of_int (519)) (Prims.of_int (12)) (Prims.of_int (519)) (Prims.of_int (25))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (521)) (Prims.of_int (4)) (Prims.of_int (521)) + (Prims.of_int (520)) (Prims.of_int (4)) (Prims.of_int (520)) (Prims.of_int (6))))) (Obj.magic (repeat tadmit)) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ())) let (is_guard : unit -> (Prims.bool, unit) FStar_Tactics_Effect.tac_repr) = @@ -2918,12 +2918,12 @@ let (is_guard : unit -> (Prims.bool, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (525)) (Prims.of_int (33)) (Prims.of_int (525)) + (Prims.of_int (524)) (Prims.of_int (33)) (Prims.of_int (524)) (Prims.of_int (47))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (525)) (Prims.of_int (4)) (Prims.of_int (525)) + (Prims.of_int (524)) (Prims.of_int (4)) (Prims.of_int (524)) (Prims.of_int (47))))) (Obj.magic (_cur_goal ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -2934,12 +2934,12 @@ let (skip_guard : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (528)) (Prims.of_int (7)) (Prims.of_int (528)) + (Prims.of_int (527)) (Prims.of_int (7)) (Prims.of_int (527)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (528)) (Prims.of_int (4)) (Prims.of_int (530)) + (Prims.of_int (527)) (Prims.of_int (4)) (Prims.of_int (529)) (Prims.of_int (16))))) (Obj.magic (is_guard ())) (fun uu___1 -> (fun uu___1 -> @@ -2952,12 +2952,12 @@ let (guards_to_smt : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (533)) (Prims.of_int (12)) (Prims.of_int (533)) + (Prims.of_int (532)) (Prims.of_int (12)) (Prims.of_int (532)) (Prims.of_int (29))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (534)) (Prims.of_int (4)) (Prims.of_int (534)) + (Prims.of_int (533)) (Prims.of_int (4)) (Prims.of_int (533)) (Prims.of_int (6))))) (Obj.magic (repeat skip_guard)) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ())) let (simpl : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = @@ -2989,12 +2989,12 @@ let (intros' : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (542)) (Prims.of_int (36)) (Prims.of_int (542)) + (Prims.of_int (541)) (Prims.of_int (36)) (Prims.of_int (541)) (Prims.of_int (45))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (542)) (Prims.of_int (49)) (Prims.of_int (542)) + (Prims.of_int (541)) (Prims.of_int (49)) (Prims.of_int (541)) (Prims.of_int (51))))) (Obj.magic (intros ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ())) let (destruct : @@ -3005,12 +3005,12 @@ let (destruct : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (543)) (Prims.of_int (37)) (Prims.of_int (543)) + (Prims.of_int (542)) (Prims.of_int (37)) (Prims.of_int (542)) (Prims.of_int (50))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (543)) (Prims.of_int (54)) (Prims.of_int (543)) + (Prims.of_int (542)) (Prims.of_int (54)) (Prims.of_int (542)) (Prims.of_int (56))))) (Obj.magic (FStar_Tactics_V2_Builtins.t_destruct tm)) (fun uu___ -> FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> ())) @@ -3024,13 +3024,13 @@ let (destruct_intros : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (544)) (Prims.of_int (59)) - (Prims.of_int (544)) (Prims.of_int (72))))) + (Prims.of_int (543)) (Prims.of_int (59)) + (Prims.of_int (543)) (Prims.of_int (72))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (544)) (Prims.of_int (76)) - (Prims.of_int (544)) (Prims.of_int (78))))) + (Prims.of_int (543)) (Prims.of_int (76)) + (Prims.of_int (543)) (Prims.of_int (78))))) (Obj.magic (FStar_Tactics_V2_Builtins.t_destruct tm)) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ()))) intros' @@ -3044,12 +3044,12 @@ let (tcut : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (550)) (Prims.of_int (12)) (Prims.of_int (550)) + (Prims.of_int (549)) (Prims.of_int (12)) (Prims.of_int (549)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (550)) (Prims.of_int (26)) (Prims.of_int (553)) + (Prims.of_int (549)) (Prims.of_int (26)) (Prims.of_int (552)) (Prims.of_int (12))))) (Obj.magic (cur_goal ())) (fun uu___ -> (fun g -> @@ -3058,13 +3058,13 @@ let (tcut : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (551)) (Prims.of_int (13)) - (Prims.of_int (551)) (Prims.of_int (37))))) + (Prims.of_int (550)) (Prims.of_int (13)) + (Prims.of_int (550)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (552)) (Prims.of_int (4)) - (Prims.of_int (553)) (Prims.of_int (12))))) + (Prims.of_int (551)) (Prims.of_int (4)) + (Prims.of_int (552)) (Prims.of_int (12))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> FStar_Reflection_V2_Derived.mk_e_app @@ -3084,14 +3084,14 @@ let (tcut : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (552)) (Prims.of_int (4)) - (Prims.of_int (552)) (Prims.of_int (12))))) + (Prims.of_int (551)) (Prims.of_int (4)) + (Prims.of_int (551)) (Prims.of_int (12))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (553)) (Prims.of_int (4)) - (Prims.of_int (553)) (Prims.of_int (12))))) + (Prims.of_int (552)) (Prims.of_int (4)) + (Prims.of_int (552)) (Prims.of_int (12))))) (Obj.magic (apply tt)) (fun uu___ -> (fun uu___ -> @@ -3107,12 +3107,12 @@ let (pose : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (556)) (Prims.of_int (4)) (Prims.of_int (556)) + (Prims.of_int (555)) (Prims.of_int (4)) (Prims.of_int (555)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (557)) (Prims.of_int (4)) (Prims.of_int (559)) + (Prims.of_int (556)) (Prims.of_int (4)) (Prims.of_int (558)) (Prims.of_int (12))))) (Obj.magic (apply @@ -3127,13 +3127,13 @@ let (pose : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (557)) (Prims.of_int (4)) - (Prims.of_int (557)) (Prims.of_int (11))))) + (Prims.of_int (556)) (Prims.of_int (4)) + (Prims.of_int (556)) (Prims.of_int (11))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (558)) (Prims.of_int (4)) - (Prims.of_int (559)) (Prims.of_int (12))))) + (Prims.of_int (557)) (Prims.of_int (4)) + (Prims.of_int (558)) (Prims.of_int (12))))) (Obj.magic (flip ())) (fun uu___1 -> (fun uu___1 -> @@ -3143,14 +3143,14 @@ let (pose : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (558)) (Prims.of_int (4)) - (Prims.of_int (558)) (Prims.of_int (11))))) + (Prims.of_int (557)) (Prims.of_int (4)) + (Prims.of_int (557)) (Prims.of_int (11))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (559)) (Prims.of_int (4)) - (Prims.of_int (559)) (Prims.of_int (12))))) + (Prims.of_int (558)) (Prims.of_int (4)) + (Prims.of_int (558)) (Prims.of_int (12))))) (Obj.magic (exact t)) (fun uu___2 -> (fun uu___2 -> @@ -3166,12 +3166,12 @@ let (intro_as : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (562)) (Prims.of_int (12)) (Prims.of_int (562)) + (Prims.of_int (561)) (Prims.of_int (12)) (Prims.of_int (561)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (563)) (Prims.of_int (4)) (Prims.of_int (563)) + (Prims.of_int (562)) (Prims.of_int (4)) (Prims.of_int (562)) (Prims.of_int (17))))) (Obj.magic (FStar_Tactics_V2_Builtins.intro ())) (fun uu___ -> @@ -3187,12 +3187,12 @@ let (pose_as : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (566)) (Prims.of_int (12)) - (Prims.of_int (566)) (Prims.of_int (18))))) + (Prims.of_int (565)) (Prims.of_int (12)) + (Prims.of_int (565)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (567)) (Prims.of_int (4)) (Prims.of_int (567)) + (Prims.of_int (566)) (Prims.of_int (4)) (Prims.of_int (566)) (Prims.of_int (17))))) (Obj.magic (pose t)) (fun uu___ -> (fun b -> Obj.magic (FStar_Tactics_V2_Builtins.rename_to b s)) @@ -3208,12 +3208,12 @@ let for_each_binding : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (570)) (Prims.of_int (10)) (Prims.of_int (570)) + (Prims.of_int (569)) (Prims.of_int (10)) (Prims.of_int (569)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (570)) (Prims.of_int (4)) (Prims.of_int (570)) + (Prims.of_int (569)) (Prims.of_int (4)) (Prims.of_int (569)) (Prims.of_int (23))))) (Obj.magic (cur_vars ())) (fun uu___ -> (fun uu___ -> Obj.magic (FStar_Tactics_Util.map f uu___)) uu___) @@ -3234,13 +3234,13 @@ let rec (revert_all : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (575)) (Prims.of_int (15)) - (Prims.of_int (575)) (Prims.of_int (24))))) + (Prims.of_int (574)) (Prims.of_int (15)) + (Prims.of_int (574)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (576)) (Prims.of_int (13)) - (Prims.of_int (576)) (Prims.of_int (26))))) + (Prims.of_int (575)) (Prims.of_int (13)) + (Prims.of_int (575)) (Prims.of_int (26))))) (Obj.magic (FStar_Tactics_V2_Builtins.revert ())) (fun uu___1 -> (fun uu___1 -> Obj.magic (revert_all tl)) uu___1)))) @@ -3276,17 +3276,17 @@ let rec (__assumption_aux : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (588)) + (Prims.of_int (587)) (Prims.of_int (13)) - (Prims.of_int (588)) + (Prims.of_int (587)) (Prims.of_int (48))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (589)) + (Prims.of_int (588)) (Prims.of_int (13)) - (Prims.of_int (589)) + (Prims.of_int (588)) (Prims.of_int (20))))) (Obj.magic (apply @@ -3309,12 +3309,12 @@ let (assumption : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (593)) (Prims.of_int (21)) (Prims.of_int (593)) + (Prims.of_int (592)) (Prims.of_int (21)) (Prims.of_int (592)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (593)) (Prims.of_int (4)) (Prims.of_int (593)) + (Prims.of_int (592)) (Prims.of_int (4)) (Prims.of_int (592)) (Prims.of_int (34))))) (Obj.magic (cur_vars ())) (fun uu___1 -> (fun uu___1 -> Obj.magic (__assumption_aux uu___1)) uu___1) @@ -3329,12 +3329,12 @@ let (destruct_equality_implication : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (596)) (Prims.of_int (10)) (Prims.of_int (596)) + (Prims.of_int (595)) (Prims.of_int (10)) (Prims.of_int (595)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (596)) (Prims.of_int (4)) (Prims.of_int (603)) + (Prims.of_int (595)) (Prims.of_int (4)) (Prims.of_int (602)) (Prims.of_int (15))))) (Obj.magic (FStar_Reflection_V2_Formula.term_as_formula t)) (fun uu___ -> @@ -3348,14 +3348,14 @@ let (destruct_equality_implication : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (598)) (Prims.of_int (18)) - (Prims.of_int (598)) (Prims.of_int (38))))) + (Prims.of_int (597)) (Prims.of_int (18)) + (Prims.of_int (597)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (599)) (Prims.of_int (14)) - (Prims.of_int (601)) (Prims.of_int (19))))) + (Prims.of_int (598)) (Prims.of_int (14)) + (Prims.of_int (600)) (Prims.of_int (19))))) (Obj.magic (FStar_Reflection_V2_Formula.term_as_formula' lhs)) (fun lhs1 -> @@ -3385,13 +3385,13 @@ let (rewrite' : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (612)) (Prims.of_int (20)) - (Prims.of_int (612)) (Prims.of_int (32))))) + (Prims.of_int (611)) (Prims.of_int (20)) + (Prims.of_int (611)) (Prims.of_int (32))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (613)) (Prims.of_int (20)) - (Prims.of_int (614)) (Prims.of_int (29))))) + (Prims.of_int (612)) (Prims.of_int (20)) + (Prims.of_int (613)) (Prims.of_int (29))))) (Obj.magic (FStar_Tactics_V2_Builtins.var_retype x)) (fun uu___1 -> (fun uu___1 -> @@ -3401,14 +3401,14 @@ let (rewrite' : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (613)) (Prims.of_int (20)) - (Prims.of_int (613)) (Prims.of_int (43))))) + (Prims.of_int (612)) (Prims.of_int (20)) + (Prims.of_int (612)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (614)) (Prims.of_int (20)) - (Prims.of_int (614)) (Prims.of_int (29))))) + (Prims.of_int (613)) (Prims.of_int (20)) + (Prims.of_int (613)) (Prims.of_int (29))))) (Obj.magic (apply_lemma (FStar_Reflection_V2_Builtins.pack_ln @@ -3448,14 +3448,14 @@ let rec (try_rewrite_equality : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (622)) (Prims.of_int (20)) - (Prims.of_int (622)) (Prims.of_int (57))))) + (Prims.of_int (621)) (Prims.of_int (20)) + (Prims.of_int (621)) (Prims.of_int (57))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (622)) (Prims.of_int (14)) - (Prims.of_int (628)) (Prims.of_int (37))))) + (Prims.of_int (621)) (Prims.of_int (14)) + (Prims.of_int (627)) (Prims.of_int (37))))) (Obj.magic (FStar_Reflection_V2_Formula.term_as_formula (type_of_binding x_t))) @@ -3491,13 +3491,13 @@ let rec (rewrite_all_context_equalities : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (635)) (Prims.of_int (8)) - (Prims.of_int (635)) (Prims.of_int (40))))) + (Prims.of_int (634)) (Prims.of_int (8)) + (Prims.of_int (634)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (636)) (Prims.of_int (8)) - (Prims.of_int (636)) (Prims.of_int (41))))) + (Prims.of_int (635)) (Prims.of_int (8)) + (Prims.of_int (635)) (Prims.of_int (41))))) (Obj.magic (try_with (fun uu___ -> @@ -3519,12 +3519,12 @@ let (rewrite_eqs_from_context : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (640)) (Prims.of_int (35)) (Prims.of_int (640)) + (Prims.of_int (639)) (Prims.of_int (35)) (Prims.of_int (639)) (Prims.of_int (48))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (640)) (Prims.of_int (4)) (Prims.of_int (640)) + (Prims.of_int (639)) (Prims.of_int (4)) (Prims.of_int (639)) (Prims.of_int (48))))) (Obj.magic (cur_vars ())) (fun uu___1 -> (fun uu___1 -> Obj.magic (rewrite_all_context_equalities uu___1)) @@ -3537,12 +3537,12 @@ let (rewrite_equality : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (643)) (Prims.of_int (27)) (Prims.of_int (643)) + (Prims.of_int (642)) (Prims.of_int (27)) (Prims.of_int (642)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (643)) (Prims.of_int (4)) (Prims.of_int (643)) + (Prims.of_int (642)) (Prims.of_int (4)) (Prims.of_int (642)) (Prims.of_int (40))))) (Obj.magic (cur_vars ())) (fun uu___ -> (fun uu___ -> Obj.magic (try_rewrite_equality t uu___)) uu___) @@ -3554,12 +3554,12 @@ let (unfold_def : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (646)) (Prims.of_int (10)) (Prims.of_int (646)) + (Prims.of_int (645)) (Prims.of_int (10)) (Prims.of_int (645)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (646)) (Prims.of_int (4)) (Prims.of_int (650)) + (Prims.of_int (645)) (Prims.of_int (4)) (Prims.of_int (649)) (Prims.of_int (46))))) (Obj.magic (FStar_Tactics_NamedView.inspect t)) (fun uu___ -> @@ -3573,14 +3573,14 @@ let (unfold_def : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (648)) (Prims.of_int (16)) - (Prims.of_int (648)) (Prims.of_int (42))))) + (Prims.of_int (647)) (Prims.of_int (16)) + (Prims.of_int (647)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (649)) (Prims.of_int (8)) - (Prims.of_int (649)) (Prims.of_int (30))))) + (Prims.of_int (648)) (Prims.of_int (8)) + (Prims.of_int (648)) (Prims.of_int (30))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> FStar_Reflection_V2_Builtins.implode_qn @@ -3603,12 +3603,12 @@ let (l_to_r : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (657)) (Prims.of_int (8)) (Prims.of_int (660)) + (Prims.of_int (656)) (Prims.of_int (8)) (Prims.of_int (659)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (661)) (Prims.of_int (4)) (Prims.of_int (661)) + (Prims.of_int (660)) (Prims.of_int (4)) (Prims.of_int (660)) (Prims.of_int (28))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> @@ -3617,13 +3617,13 @@ let (l_to_r : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (657)) (Prims.of_int (8)) - (Prims.of_int (660)) (Prims.of_int (31))))) + (Prims.of_int (656)) (Prims.of_int (8)) + (Prims.of_int (659)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (657)) (Prims.of_int (8)) - (Prims.of_int (660)) (Prims.of_int (31))))) + (Prims.of_int (656)) (Prims.of_int (8)) + (Prims.of_int (659)) (Prims.of_int (31))))) (Obj.magic (FStar_Tactics_Util.fold_left (fun uu___3 -> @@ -3672,13 +3672,13 @@ let (grewrite : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (674)) (Prims.of_int (12)) - (Prims.of_int (674)) (Prims.of_int (33))))) + (Prims.of_int (673)) (Prims.of_int (12)) + (Prims.of_int (673)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (674)) (Prims.of_int (36)) - (Prims.of_int (688)) (Prims.of_int (44))))) + (Prims.of_int (673)) (Prims.of_int (36)) + (Prims.of_int (687)) (Prims.of_int (44))))) (Obj.magic (tcut (mk_sq_eq t1 t2))) (fun uu___ -> (fun e -> @@ -3687,13 +3687,13 @@ let (grewrite : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (675)) (Prims.of_int (12)) - (Prims.of_int (675)) (Prims.of_int (27))))) + (Prims.of_int (674)) (Prims.of_int (12)) + (Prims.of_int (674)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (676)) (Prims.of_int (4)) - (Prims.of_int (688)) (Prims.of_int (44))))) + (Prims.of_int (675)) (Prims.of_int (4)) + (Prims.of_int (687)) (Prims.of_int (44))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> FStar_Tactics_NamedView.pack @@ -3710,17 +3710,17 @@ let (grewrite : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (679)) + (Prims.of_int (678)) (Prims.of_int (8)) - (Prims.of_int (684)) + (Prims.of_int (683)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (686)) + (Prims.of_int (685)) (Prims.of_int (6)) - (Prims.of_int (688)) + (Prims.of_int (687)) (Prims.of_int (43))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3728,17 +3728,17 @@ let (grewrite : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (679)) + (Prims.of_int (678)) (Prims.of_int (14)) - (Prims.of_int (679)) + (Prims.of_int (678)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (679)) + (Prims.of_int (678)) (Prims.of_int (8)) - (Prims.of_int (684)) + (Prims.of_int (683)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_Effect.tac_bind @@ -3746,17 +3746,17 @@ let (grewrite : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (679)) + (Prims.of_int (678)) (Prims.of_int (30)) - (Prims.of_int (679)) + (Prims.of_int (678)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (679)) + (Prims.of_int (678)) (Prims.of_int (14)) - (Prims.of_int (679)) + (Prims.of_int (678)) (Prims.of_int (42))))) (Obj.magic (cur_goal ())) (fun uu___1 -> @@ -3778,17 +3778,17 @@ let (grewrite : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (681)) + (Prims.of_int (680)) (Prims.of_int (17)) - (Prims.of_int (681)) + (Prims.of_int (680)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (681)) + (Prims.of_int (680)) (Prims.of_int (10)) - (Prims.of_int (683)) + (Prims.of_int (682)) (Prims.of_int (24))))) (Obj.magic (FStar_Tactics_NamedView.inspect @@ -3835,12 +3835,12 @@ let (grewrite_eq : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (695)) (Prims.of_int (8)) (Prims.of_int (695)) + (Prims.of_int (694)) (Prims.of_int (8)) (Prims.of_int (694)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (695)) (Prims.of_int (2)) (Prims.of_int (707)) + (Prims.of_int (694)) (Prims.of_int (2)) (Prims.of_int (706)) (Prims.of_int (7))))) (Obj.magic (FStar_Reflection_V2_Formula.term_as_formula (type_of_binding b))) @@ -3855,14 +3855,14 @@ let (grewrite_eq : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (697)) (Prims.of_int (4)) - (Prims.of_int (697)) (Prims.of_int (16))))) + (Prims.of_int (696)) (Prims.of_int (4)) + (Prims.of_int (696)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (698)) (Prims.of_int (4)) - (Prims.of_int (698)) (Prims.of_int (37))))) + (Prims.of_int (697)) (Prims.of_int (4)) + (Prims.of_int (697)) (Prims.of_int (37))))) (Obj.magic (grewrite l r)) (fun uu___2 -> (fun uu___2 -> @@ -3880,14 +3880,14 @@ let (grewrite_eq : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (700)) (Prims.of_int (16)) - (Prims.of_int (700)) (Prims.of_int (52))))) + (Prims.of_int (699)) (Prims.of_int (16)) + (Prims.of_int (699)) (Prims.of_int (52))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (700)) (Prims.of_int (10)) - (Prims.of_int (706)) (Prims.of_int (56))))) + (Prims.of_int (699)) (Prims.of_int (10)) + (Prims.of_int (705)) (Prims.of_int (56))))) (Obj.magic (FStar_Reflection_V2_Formula.term_as_formula' (type_of_binding b))) @@ -3904,17 +3904,17 @@ let (grewrite_eq : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (702)) + (Prims.of_int (701)) (Prims.of_int (6)) - (Prims.of_int (702)) + (Prims.of_int (701)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (703)) + (Prims.of_int (702)) (Prims.of_int (6)) - (Prims.of_int (704)) + (Prims.of_int (703)) (Prims.of_int (39))))) (Obj.magic (grewrite l r)) (fun uu___4 -> @@ -3928,17 +3928,17 @@ let (grewrite_eq : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (703)) + (Prims.of_int (702)) (Prims.of_int (30)) - (Prims.of_int (703)) + (Prims.of_int (702)) (Prims.of_int (55))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (704)) + (Prims.of_int (703)) (Prims.of_int (30)) - (Prims.of_int (704)) + (Prims.of_int (703)) (Prims.of_int (37))))) (Obj.magic (apply_lemma @@ -3970,12 +3970,12 @@ let (admit_dump_t : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (711)) (Prims.of_int (2)) (Prims.of_int (711)) + (Prims.of_int (710)) (Prims.of_int (2)) (Prims.of_int (710)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (712)) (Prims.of_int (2)) (Prims.of_int (712)) + (Prims.of_int (711)) (Prims.of_int (2)) (Prims.of_int (711)) (Prims.of_int (16))))) (Obj.magic (FStar_Tactics_V2_Builtins.dump "Admitting")) (fun uu___1 -> @@ -3993,12 +3993,12 @@ let (magic_dump_t : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (719)) (Prims.of_int (2)) (Prims.of_int (719)) + (Prims.of_int (718)) (Prims.of_int (2)) (Prims.of_int (718)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (720)) (Prims.of_int (2)) (Prims.of_int (722)) + (Prims.of_int (719)) (Prims.of_int (2)) (Prims.of_int (721)) (Prims.of_int (4))))) (Obj.magic (FStar_Tactics_V2_Builtins.dump "Admitting")) (fun uu___1 -> @@ -4008,13 +4008,13 @@ let (magic_dump_t : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (720)) (Prims.of_int (2)) - (Prims.of_int (720)) (Prims.of_int (16))))) + (Prims.of_int (719)) (Prims.of_int (2)) + (Prims.of_int (719)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (721)) (Prims.of_int (2)) - (Prims.of_int (722)) (Prims.of_int (4))))) + (Prims.of_int (720)) (Prims.of_int (2)) + (Prims.of_int (721)) (Prims.of_int (4))))) (Obj.magic (apply (FStar_Reflection_V2_Builtins.pack_ln @@ -4029,14 +4029,14 @@ let (magic_dump_t : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (721)) (Prims.of_int (2)) - (Prims.of_int (721)) (Prims.of_int (13))))) + (Prims.of_int (720)) (Prims.of_int (2)) + (Prims.of_int (720)) (Prims.of_int (13))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (722)) (Prims.of_int (2)) - (Prims.of_int (722)) (Prims.of_int (4))))) + (Prims.of_int (721)) (Prims.of_int (2)) + (Prims.of_int (721)) (Prims.of_int (4))))) (Obj.magic (exact (FStar_Reflection_V2_Builtins.pack_ln @@ -4059,13 +4059,13 @@ let (change_with : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (729)) (Prims.of_int (8)) - (Prims.of_int (729)) (Prims.of_int (22))))) + (Prims.of_int (728)) (Prims.of_int (8)) + (Prims.of_int (728)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (730)) (Prims.of_int (8)) - (Prims.of_int (730)) (Prims.of_int (29))))) + (Prims.of_int (729)) (Prims.of_int (8)) + (Prims.of_int (729)) (Prims.of_int (29))))) (Obj.magic (grewrite t1 t2)) (fun uu___1 -> (fun uu___1 -> Obj.magic (iseq [idtac; trivial])) uu___1)) @@ -4089,12 +4089,12 @@ let finish_by : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (737)) (Prims.of_int (12)) (Prims.of_int (737)) + (Prims.of_int (736)) (Prims.of_int (12)) (Prims.of_int (736)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (738)) (Prims.of_int (4)) (Prims.of_int (739)) + (Prims.of_int (737)) (Prims.of_int (4)) (Prims.of_int (738)) (Prims.of_int (5))))) (Obj.magic (t ())) (fun uu___ -> (fun x -> @@ -4103,13 +4103,13 @@ let finish_by : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (738)) (Prims.of_int (4)) - (Prims.of_int (738)) (Prims.of_int (58))))) + (Prims.of_int (737)) (Prims.of_int (4)) + (Prims.of_int (737)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (737)) (Prims.of_int (8)) - (Prims.of_int (737)) (Prims.of_int (9))))) + (Prims.of_int (736)) (Prims.of_int (8)) + (Prims.of_int (736)) (Prims.of_int (9))))) (Obj.magic (or_else qed (fun uu___ -> @@ -4131,13 +4131,13 @@ let solve_then : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (742)) (Prims.of_int (4)) (Prims.of_int (742)) + (Prims.of_int (741)) (Prims.of_int (4)) (Prims.of_int (741)) (Prims.of_int (10))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (742)) (Prims.of_int (11)) - (Prims.of_int (746)) (Prims.of_int (5))))) + (Prims.of_int (741)) (Prims.of_int (11)) + (Prims.of_int (745)) (Prims.of_int (5))))) (Obj.magic (FStar_Tactics_V2_Builtins.dup ())) (fun uu___ -> (fun uu___ -> @@ -4146,13 +4146,13 @@ let solve_then : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (743)) (Prims.of_int (12)) - (Prims.of_int (743)) (Prims.of_int (42))))) + (Prims.of_int (742)) (Prims.of_int (12)) + (Prims.of_int (742)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (743)) (Prims.of_int (45)) - (Prims.of_int (746)) (Prims.of_int (5))))) + (Prims.of_int (742)) (Prims.of_int (45)) + (Prims.of_int (745)) (Prims.of_int (5))))) (Obj.magic (focus (fun uu___1 -> finish_by t1))) (fun uu___1 -> (fun x -> @@ -4162,17 +4162,17 @@ let solve_then : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (744)) + (Prims.of_int (743)) (Prims.of_int (12)) - (Prims.of_int (744)) + (Prims.of_int (743)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (745)) + (Prims.of_int (744)) (Prims.of_int (4)) - (Prims.of_int (746)) + (Prims.of_int (745)) (Prims.of_int (5))))) (Obj.magic (t2 x)) (fun uu___1 -> @@ -4183,17 +4183,17 @@ let solve_then : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (745)) + (Prims.of_int (744)) (Prims.of_int (4)) - (Prims.of_int (745)) + (Prims.of_int (744)) (Prims.of_int (12))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (744)) + (Prims.of_int (743)) (Prims.of_int (8)) - (Prims.of_int (744)) + (Prims.of_int (743)) (Prims.of_int (9))))) (Obj.magic (trefl ())) (fun uu___1 -> @@ -4212,13 +4212,13 @@ let add_elem : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (749)) (Prims.of_int (4)) - (Prims.of_int (749)) (Prims.of_int (17))))) + (Prims.of_int (748)) (Prims.of_int (4)) + (Prims.of_int (748)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (750)) (Prims.of_int (4)) - (Prims.of_int (754)) (Prims.of_int (5))))) + (Prims.of_int (749)) (Prims.of_int (4)) + (Prims.of_int (753)) (Prims.of_int (5))))) (Obj.magic (apply (FStar_Reflection_V2_Builtins.pack_ln @@ -4235,14 +4235,14 @@ let add_elem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (751)) (Prims.of_int (14)) - (Prims.of_int (751)) (Prims.of_int (18))))) + (Prims.of_int (750)) (Prims.of_int (14)) + (Prims.of_int (750)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (752)) (Prims.of_int (6)) - (Prims.of_int (753)) (Prims.of_int (7))))) + (Prims.of_int (751)) (Prims.of_int (6)) + (Prims.of_int (752)) (Prims.of_int (7))))) (Obj.magic (t ())) (fun uu___3 -> (fun x -> @@ -4252,17 +4252,17 @@ let add_elem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (752)) + (Prims.of_int (751)) (Prims.of_int (6)) - (Prims.of_int (752)) + (Prims.of_int (751)) (Prims.of_int (12))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (751)) + (Prims.of_int (750)) (Prims.of_int (10)) - (Prims.of_int (751)) + (Prims.of_int (750)) (Prims.of_int (11))))) (Obj.magic (qed ())) (fun uu___3 -> @@ -4284,13 +4284,13 @@ let specialize : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (773)) (Prims.of_int (42)) - (Prims.of_int (773)) (Prims.of_int (51))))) + (Prims.of_int (772)) (Prims.of_int (42)) + (Prims.of_int (772)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (773)) (Prims.of_int (36)) - (Prims.of_int (773)) (Prims.of_int (51))))) + (Prims.of_int (772)) (Prims.of_int (36)) + (Prims.of_int (772)) (Prims.of_int (51))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> (fun uu___2 -> @@ -4310,12 +4310,12 @@ let (tlabel : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (776)) (Prims.of_int (10)) (Prims.of_int (776)) + (Prims.of_int (775)) (Prims.of_int (10)) (Prims.of_int (775)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (776)) (Prims.of_int (4)) (Prims.of_int (779)) + (Prims.of_int (775)) (Prims.of_int (4)) (Prims.of_int (778)) (Prims.of_int (38))))) (Obj.magic (goals ())) (fun uu___ -> (fun uu___ -> @@ -4332,12 +4332,12 @@ let (tlabel' : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (782)) (Prims.of_int (10)) (Prims.of_int (782)) + (Prims.of_int (781)) (Prims.of_int (10)) (Prims.of_int (781)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (782)) (Prims.of_int (4)) (Prims.of_int (786)) + (Prims.of_int (781)) (Prims.of_int (4)) (Prims.of_int (785)) (Prims.of_int (26))))) (Obj.magic (goals ())) (fun uu___ -> (fun uu___ -> @@ -4351,14 +4351,14 @@ let (tlabel' : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (785)) (Prims.of_int (16)) - (Prims.of_int (785)) (Prims.of_int (45))))) + (Prims.of_int (784)) (Prims.of_int (16)) + (Prims.of_int (784)) (Prims.of_int (45))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (786)) (Prims.of_int (8)) - (Prims.of_int (786)) (Prims.of_int (26))))) + (Prims.of_int (785)) (Prims.of_int (8)) + (Prims.of_int (785)) (Prims.of_int (26))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> FStar_Tactics_Types.set_label @@ -4375,37 +4375,37 @@ let (focus_all : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (789)) (Prims.of_int (4)) (Prims.of_int (789)) + (Prims.of_int (788)) (Prims.of_int (4)) (Prims.of_int (788)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (790)) (Prims.of_int (4)) (Prims.of_int (790)) + (Prims.of_int (789)) (Prims.of_int (4)) (Prims.of_int (789)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (789)) (Prims.of_int (14)) - (Prims.of_int (789)) (Prims.of_int (39))))) + (Prims.of_int (788)) (Prims.of_int (14)) + (Prims.of_int (788)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (789)) (Prims.of_int (4)) - (Prims.of_int (789)) (Prims.of_int (39))))) + (Prims.of_int (788)) (Prims.of_int (4)) + (Prims.of_int (788)) (Prims.of_int (39))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (789)) (Prims.of_int (15)) - (Prims.of_int (789)) (Prims.of_int (23))))) + (Prims.of_int (788)) (Prims.of_int (15)) + (Prims.of_int (788)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (789)) (Prims.of_int (14)) - (Prims.of_int (789)) (Prims.of_int (39))))) + (Prims.of_int (788)) (Prims.of_int (14)) + (Prims.of_int (788)) (Prims.of_int (39))))) (Obj.magic (goals ())) (fun uu___1 -> (fun uu___1 -> @@ -4415,17 +4415,17 @@ let (focus_all : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (789)) + (Prims.of_int (788)) (Prims.of_int (26)) - (Prims.of_int (789)) + (Prims.of_int (788)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (789)) + (Prims.of_int (788)) (Prims.of_int (14)) - (Prims.of_int (789)) + (Prims.of_int (788)) (Prims.of_int (39))))) (Obj.magic (smt_goals ())) (fun uu___2 -> @@ -4461,25 +4461,25 @@ let (bump_nth : Prims.pos -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (805)) (Prims.of_int (8)) (Prims.of_int (805)) + (Prims.of_int (804)) (Prims.of_int (8)) (Prims.of_int (804)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (805)) (Prims.of_int (2)) (Prims.of_int (807)) + (Prims.of_int (804)) (Prims.of_int (2)) (Prims.of_int (806)) (Prims.of_int (37))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (805)) (Prims.of_int (28)) - (Prims.of_int (805)) (Prims.of_int (38))))) + (Prims.of_int (804)) (Prims.of_int (28)) + (Prims.of_int (804)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (805)) (Prims.of_int (8)) - (Prims.of_int (805)) (Prims.of_int (38))))) + (Prims.of_int (804)) (Prims.of_int (8)) + (Prims.of_int (804)) (Prims.of_int (38))))) (Obj.magic (goals ())) (fun uu___ -> FStar_Tactics_Effect.lift_div_tac @@ -4503,12 +4503,12 @@ let rec (destruct_list : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (810)) (Prims.of_int (21)) (Prims.of_int (810)) + (Prims.of_int (809)) (Prims.of_int (21)) (Prims.of_int (809)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (809)) (Prims.of_int (52)) (Prims.of_int (822)) + (Prims.of_int (808)) (Prims.of_int (52)) (Prims.of_int (821)) (Prims.of_int (27))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.collect_app t)) (fun uu___ -> @@ -4521,28 +4521,28 @@ let rec (destruct_list : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (811)) (Prims.of_int (10)) - (Prims.of_int (811)) (Prims.of_int (28))))) + (Prims.of_int (810)) (Prims.of_int (10)) + (Prims.of_int (810)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (811)) (Prims.of_int (4)) - (Prims.of_int (822)) (Prims.of_int (27))))) + (Prims.of_int (810)) (Prims.of_int (4)) + (Prims.of_int (821)) (Prims.of_int (27))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (811)) (Prims.of_int (10)) - (Prims.of_int (811)) (Prims.of_int (22))))) + (Prims.of_int (810)) (Prims.of_int (10)) + (Prims.of_int (810)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (811)) (Prims.of_int (10)) - (Prims.of_int (811)) (Prims.of_int (28))))) + (Prims.of_int (810)) (Prims.of_int (10)) + (Prims.of_int (810)) (Prims.of_int (28))))) (Obj.magic (FStar_Tactics_NamedView.inspect head)) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -4567,17 +4567,17 @@ let rec (destruct_list : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (815)) + (Prims.of_int (814)) (Prims.of_int (17)) - (Prims.of_int (815)) + (Prims.of_int (814)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (815)) + (Prims.of_int (814)) (Prims.of_int (11)) - (Prims.of_int (815)) + (Prims.of_int (814)) (Prims.of_int (33))))) (Obj.magic (destruct_list a2)) (fun uu___2 -> @@ -4605,17 +4605,17 @@ let rec (destruct_list : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (815)) + (Prims.of_int (814)) (Prims.of_int (17)) - (Prims.of_int (815)) + (Prims.of_int (814)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (815)) + (Prims.of_int (814)) (Prims.of_int (11)) - (Prims.of_int (815)) + (Prims.of_int (814)) (Prims.of_int (33))))) (Obj.magic (destruct_list a2)) (fun uu___3 -> @@ -4652,25 +4652,25 @@ let (get_match_body : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (825)) (Prims.of_int (8)) (Prims.of_int (825)) + (Prims.of_int (824)) (Prims.of_int (8)) (Prims.of_int (824)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (825)) (Prims.of_int (2)) (Prims.of_int (829)) + (Prims.of_int (824)) (Prims.of_int (2)) (Prims.of_int (828)) (Prims.of_int (46))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (825)) (Prims.of_int (22)) - (Prims.of_int (825)) (Prims.of_int (35))))) + (Prims.of_int (824)) (Prims.of_int (22)) + (Prims.of_int (824)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (825)) (Prims.of_int (8)) - (Prims.of_int (825)) (Prims.of_int (35))))) + (Prims.of_int (824)) (Prims.of_int (8)) + (Prims.of_int (824)) (Prims.of_int (35))))) (Obj.magic (cur_goal ())) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -4688,14 +4688,14 @@ let (get_match_body : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (827)) (Prims.of_int (20)) - (Prims.of_int (827)) (Prims.of_int (39))))) + (Prims.of_int (826)) (Prims.of_int (20)) + (Prims.of_int (826)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (827)) (Prims.of_int (14)) - (Prims.of_int (829)) (Prims.of_int (46))))) + (Prims.of_int (826)) (Prims.of_int (14)) + (Prims.of_int (828)) (Prims.of_int (46))))) (Obj.magic (FStar_Tactics_V2_SyntaxHelpers.inspect_unascribe t)) @@ -4724,13 +4724,13 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (842)) (Prims.of_int (14)) - (Prims.of_int (842)) (Prims.of_int (31))))) + (Prims.of_int (841)) (Prims.of_int (14)) + (Prims.of_int (841)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (842)) (Prims.of_int (34)) - (Prims.of_int (848)) (Prims.of_int (20))))) + (Prims.of_int (841)) (Prims.of_int (34)) + (Prims.of_int (847)) (Prims.of_int (20))))) (Obj.magic (get_match_body ())) (fun uu___2 -> (fun x -> @@ -4740,14 +4740,14 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (843)) (Prims.of_int (14)) - (Prims.of_int (843)) (Prims.of_int (26))))) + (Prims.of_int (842)) (Prims.of_int (14)) + (Prims.of_int (842)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (844)) (Prims.of_int (6)) - (Prims.of_int (848)) (Prims.of_int (20))))) + (Prims.of_int (843)) (Prims.of_int (6)) + (Prims.of_int (847)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_V2_Builtins.t_destruct x)) (fun uu___2 -> (fun uu___2 -> @@ -4759,17 +4759,17 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (845)) + (Prims.of_int (844)) (Prims.of_int (17)) - (Prims.of_int (845)) + (Prims.of_int (844)) (Prims.of_int (29))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (845)) + (Prims.of_int (844)) (Prims.of_int (32)) - (Prims.of_int (848)) + (Prims.of_int (847)) (Prims.of_int (19))))) (Obj.magic (repeat @@ -4782,17 +4782,17 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (846)) + (Prims.of_int (845)) (Prims.of_int (16)) - (Prims.of_int (846)) + (Prims.of_int (845)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (847)) + (Prims.of_int (846)) (Prims.of_int (8)) - (Prims.of_int (848)) + (Prims.of_int (847)) (Prims.of_int (19))))) (Obj.magic (last bs)) (fun uu___4 -> @@ -4803,17 +4803,17 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (847)) + (Prims.of_int (846)) (Prims.of_int (8)) - (Prims.of_int (847)) + (Prims.of_int (846)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (848)) + (Prims.of_int (847)) (Prims.of_int (8)) - (Prims.of_int (848)) + (Prims.of_int (847)) (Prims.of_int (19))))) (Obj.magic (grewrite_eq b)) @@ -4835,12 +4835,12 @@ let (nth_var : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (857)) (Prims.of_int (11)) (Prims.of_int (857)) + (Prims.of_int (856)) (Prims.of_int (11)) (Prims.of_int (856)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (857)) (Prims.of_int (25)) (Prims.of_int (862)) + (Prims.of_int (856)) (Prims.of_int (25)) (Prims.of_int (861)) (Prims.of_int (15))))) (Obj.magic (cur_vars ())) (fun uu___ -> (fun bs -> @@ -4849,13 +4849,13 @@ let (nth_var : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (858)) (Prims.of_int (16)) - (Prims.of_int (858)) (Prims.of_int (65))))) + (Prims.of_int (857)) (Prims.of_int (16)) + (Prims.of_int (857)) (Prims.of_int (65))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (858)) (Prims.of_int (68)) - (Prims.of_int (862)) (Prims.of_int (15))))) + (Prims.of_int (857)) (Prims.of_int (68)) + (Prims.of_int (861)) (Prims.of_int (15))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> if i >= Prims.int_zero @@ -4869,14 +4869,14 @@ let (nth_var : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (859)) (Prims.of_int (16)) - (Prims.of_int (859)) (Prims.of_int (62))))) + (Prims.of_int (858)) (Prims.of_int (16)) + (Prims.of_int (858)) (Prims.of_int (62))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (860)) (Prims.of_int (2)) - (Prims.of_int (862)) (Prims.of_int (15))))) + (Prims.of_int (859)) (Prims.of_int (2)) + (Prims.of_int (861)) (Prims.of_int (15))))) (if k < Prims.int_zero then fail "not enough binders" else @@ -4903,12 +4903,12 @@ let (name_appears_in : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (870)) (Prims.of_int (4)) (Prims.of_int (875)) + (Prims.of_int (869)) (Prims.of_int (4)) (Prims.of_int (874)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (877)) (Prims.of_int (2)) (Prims.of_int (879)) + (Prims.of_int (876)) (Prims.of_int (2)) (Prims.of_int (878)) (Prims.of_int (16))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> @@ -4917,13 +4917,13 @@ let (name_appears_in : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (870)) (Prims.of_int (10)) - (Prims.of_int (870)) (Prims.of_int (19))))) + (Prims.of_int (869)) (Prims.of_int (10)) + (Prims.of_int (869)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (870)) (Prims.of_int (4)) - (Prims.of_int (875)) (Prims.of_int (19))))) + (Prims.of_int (869)) (Prims.of_int (4)) + (Prims.of_int (874)) (Prims.of_int (19))))) (Obj.magic (FStar_Tactics_NamedView.inspect t1)) (fun uu___1 -> (fun uu___1 -> @@ -4936,17 +4936,17 @@ let (name_appears_in : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (872)) + (Prims.of_int (871)) (Prims.of_int (6)) - (Prims.of_int (873)) + (Prims.of_int (872)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (869)) + (Prims.of_int (868)) (Prims.of_int (10)) - (Prims.of_int (869)) + (Prims.of_int (868)) (Prims.of_int (11))))) (if (FStar_Reflection_V2_Builtins.inspect_fv @@ -4978,31 +4978,31 @@ let (name_appears_in : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (877)) (Prims.of_int (6)) - (Prims.of_int (877)) (Prims.of_int (30))))) + (Prims.of_int (876)) (Prims.of_int (6)) + (Prims.of_int (876)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (877)) (Prims.of_int (32)) - (Prims.of_int (877)) (Prims.of_int (37))))) + (Prims.of_int (876)) (Prims.of_int (32)) + (Prims.of_int (876)) (Prims.of_int (37))))) (Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (877)) + (Prims.of_int (876)) (Prims.of_int (13)) - (Prims.of_int (877)) + (Prims.of_int (876)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (877)) + (Prims.of_int (876)) (Prims.of_int (6)) - (Prims.of_int (877)) + (Prims.of_int (876)) (Prims.of_int (30))))) (Obj.magic (FStar_Tactics_Visit.visit_tm ff t)) @@ -5043,8 +5043,8 @@ let rec (mk_abs : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (886)) (Prims.of_int (13)) - (Prims.of_int (886)) (Prims.of_int (27))))) + (Prims.of_int (885)) (Prims.of_int (13)) + (Prims.of_int (885)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "dummy" Prims.int_zero @@ -5066,12 +5066,12 @@ let (namedv_to_simple_binder : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (891)) (Prims.of_int (11)) (Prims.of_int (891)) + (Prims.of_int (890)) (Prims.of_int (11)) (Prims.of_int (890)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (893)) (Prims.of_int (4)) (Prims.of_int (897)) + (Prims.of_int (892)) (Prims.of_int (4)) (Prims.of_int (896)) (Prims.of_int (16))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> FStar_Tactics_NamedView.inspect_namedv n)) @@ -5082,13 +5082,13 @@ let (namedv_to_simple_binder : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (895)) (Prims.of_int (13)) - (Prims.of_int (895)) (Prims.of_int (27))))) + (Prims.of_int (894)) (Prims.of_int (13)) + (Prims.of_int (894)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (893)) (Prims.of_int (4)) - (Prims.of_int (897)) (Prims.of_int (16))))) + (Prims.of_int (892)) (Prims.of_int (4)) + (Prims.of_int (896)) (Prims.of_int (16))))) (Obj.magic (FStar_Tactics_Unseal.unseal nv.FStar_Reflection_V2_Data.sort)) @@ -5128,13 +5128,13 @@ let (string_to_term_with_lb : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (917)) (Prims.of_int (6)) - (Prims.of_int (920)) (Prims.of_int (27))))) + (Prims.of_int (916)) (Prims.of_int (6)) + (Prims.of_int (919)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (916)) (Prims.of_int (3)) - (Prims.of_int (924)) (Prims.of_int (21))))) + (Prims.of_int (915)) (Prims.of_int (3)) + (Prims.of_int (923)) (Prims.of_int (21))))) (Obj.magic (FStar_Tactics_Util.fold_left (fun uu___ -> @@ -5146,14 +5146,14 @@ let (string_to_term_with_lb : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (918)) (Prims.of_int (19)) - (Prims.of_int (918)) (Prims.of_int (36))))) + (Prims.of_int (917)) (Prims.of_int (19)) + (Prims.of_int (917)) (Prims.of_int (36))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (917)) (Prims.of_int (42)) - (Prims.of_int (919)) (Prims.of_int (25))))) + (Prims.of_int (916)) (Prims.of_int (42)) + (Prims.of_int (918)) (Prims.of_int (25))))) (Obj.magic (FStar_Tactics_V2_Builtins.push_bv_dsenv e1 i)) (fun uu___2 -> @@ -5172,14 +5172,14 @@ let (string_to_term_with_lb : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (920)) (Prims.of_int (30)) - (Prims.of_int (924)) (Prims.of_int (21))))) + (Prims.of_int (919)) (Prims.of_int (30)) + (Prims.of_int (923)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (920)) (Prims.of_int (30)) - (Prims.of_int (924)) (Prims.of_int (21))))) + (Prims.of_int (919)) (Prims.of_int (30)) + (Prims.of_int (923)) (Prims.of_int (21))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> uu___)) (fun uu___1 -> @@ -5190,17 +5190,17 @@ let (string_to_term_with_lb : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (921)) + (Prims.of_int (920)) (Prims.of_int (12)) - (Prims.of_int (921)) + (Prims.of_int (920)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (922)) + (Prims.of_int (921)) (Prims.of_int (4)) - (Prims.of_int (924)) + (Prims.of_int (923)) (Prims.of_int (21))))) (Obj.magic (FStar_Tactics_V2_Builtins.string_to_term @@ -5242,12 +5242,12 @@ let (smt_sync : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (936)) (Prims.of_int (40)) (Prims.of_int (936)) + (Prims.of_int (935)) (Prims.of_int (40)) (Prims.of_int (935)) (Prims.of_int (56))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (936)) (Prims.of_int (29)) (Prims.of_int (936)) + (Prims.of_int (935)) (Prims.of_int (29)) (Prims.of_int (935)) (Prims.of_int (56))))) (Obj.magic (FStar_Tactics_V2_Builtins.get_vconfig ())) (fun uu___1 -> @@ -5261,13 +5261,13 @@ let (smt_sync' : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (940)) (Prims.of_int (15)) - (Prims.of_int (940)) (Prims.of_int (29))))) + (Prims.of_int (939)) (Prims.of_int (15)) + (Prims.of_int (939)) (Prims.of_int (29))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (940)) (Prims.of_int (32)) - (Prims.of_int (944)) (Prims.of_int (20))))) + (Prims.of_int (939)) (Prims.of_int (32)) + (Prims.of_int (943)) (Prims.of_int (20))))) (Obj.magic (FStar_Tactics_V2_Builtins.get_vconfig ())) (fun uu___ -> (fun vcfg -> @@ -5276,13 +5276,13 @@ let (smt_sync' : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (941)) (Prims.of_int (18)) - (Prims.of_int (942)) (Prims.of_int (68))))) + (Prims.of_int (940)) (Prims.of_int (18)) + (Prims.of_int (941)) (Prims.of_int (68))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (944)) (Prims.of_int (4)) - (Prims.of_int (944)) (Prims.of_int (20))))) + (Prims.of_int (943)) (Prims.of_int (4)) + (Prims.of_int (943)) (Prims.of_int (20))))) (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> { @@ -5340,4 +5340,26 @@ let (smt_sync' : (fun vcfg' -> Obj.magic (FStar_Tactics_V2_Builtins.t_smt_sync vcfg')) - uu___))) uu___) \ No newline at end of file + uu___))) uu___) +let (check_equiv : + FStar_Reflection_Types.env -> + FStar_Reflection_Types.typ -> + FStar_Reflection_Types.typ -> + (((unit, unit, unit) FStar_Tactics_Types.equiv_token + FStar_Pervasives_Native.option * FStar_Issue.issue Prims.list), + unit) FStar_Tactics_Effect.tac_repr) + = + fun g -> + fun t0 -> + fun t1 -> FStar_Tactics_V2_Builtins.t_check_equiv true true g t0 t1 +let (check_equiv_nosmt : + FStar_Reflection_Types.env -> + FStar_Reflection_Types.typ -> + FStar_Reflection_Types.typ -> + (((unit, unit, unit) FStar_Tactics_Types.equiv_token + FStar_Pervasives_Native.option * FStar_Issue.issue Prims.list), + unit) FStar_Tactics_Effect.tac_repr) + = + fun g -> + fun t0 -> + fun t1 -> FStar_Tactics_V2_Builtins.t_check_equiv false false g t0 t1 \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Primops.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Primops.ml index 56661c063a0..330dbfd8364 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V2_Primops.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V2_Primops.ml @@ -127,8 +127,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = let uu___14 = let uu___15 = FStar_Tactics_InterpFuns.mk_tot_step_1 Prims.int_zero - "goal_type" FStar_Tactics_Embedding.e_goal - FStar_Reflection_V2_Embeddings.e_term + "goal_type" FStar_Tactics_Embedding.e_goal uu___2 FStar_Tactics_Embedding.e_goal_nbe FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_Tactics_Types.goal_type @@ -136,8 +135,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = let uu___16 = let uu___17 = FStar_Tactics_InterpFuns.mk_tot_step_1 Prims.int_zero - "goal_witness" FStar_Tactics_Embedding.e_goal - FStar_Reflection_V2_Embeddings.e_term + "goal_witness" FStar_Tactics_Embedding.e_goal uu___2 FStar_Tactics_Embedding.e_goal_nbe FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_Tactics_Types.goal_witness @@ -176,9 +174,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = let uu___25 = let uu___26 = FStar_Tactics_InterpFuns.mk_tac_step_1 - Prims.int_zero "compress" - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + Prims.int_zero "compress" uu___2 uu___2 FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_Tactics_V2_Basic.compress @@ -296,8 +292,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Reflection_V2_Embeddings.e_env (FStar_Syntax_Embeddings.e_list FStar_Syntax_Embeddings.e_norm_step) - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + uu___2 uu___2 FStar_Reflection_V2_NBEEmbeddings.e_env (FStar_TypeChecker_NBETerm.e_list FStar_TypeChecker_NBETerm.e_norm_step) @@ -406,7 +401,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = "t_exact" FStar_Syntax_Embeddings.e_bool FStar_Syntax_Embeddings.e_bool - FStar_Reflection_V2_Embeddings.e_term + uu___2 FStar_Syntax_Embeddings.e_unit FStar_TypeChecker_NBETerm.e_bool FStar_TypeChecker_NBETerm.e_bool @@ -422,7 +417,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Syntax_Embeddings.e_bool FStar_Syntax_Embeddings.e_bool FStar_Syntax_Embeddings.e_bool - FStar_Reflection_V2_Embeddings.e_term + uu___2 FStar_Syntax_Embeddings.e_unit FStar_TypeChecker_NBETerm.e_bool FStar_TypeChecker_NBETerm.e_bool @@ -439,7 +434,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = "t_apply_lemma" FStar_Syntax_Embeddings.e_bool FStar_Syntax_Embeddings.e_bool - FStar_Reflection_V2_Embeddings.e_term + uu___2 FStar_Syntax_Embeddings.e_unit FStar_TypeChecker_NBETerm.e_bool FStar_TypeChecker_NBETerm.e_bool @@ -468,7 +463,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "tcc" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term + uu___2 FStar_Reflection_V2_Embeddings.e_comp FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Reflection_V2_NBEEmbeddings.e_attribute @@ -483,8 +478,8 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "tc" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + uu___2 + uu___2 FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_Reflection_V2_NBEEmbeddings.e_attribute @@ -497,7 +492,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero "unshelve" - FStar_Reflection_V2_Embeddings.e_term + uu___2 FStar_Syntax_Embeddings.e_unit FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_TypeChecker_NBETerm.e_unit @@ -692,7 +687,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero "tadmit_t" - FStar_Reflection_V2_Embeddings.e_term + uu___2 FStar_Syntax_Embeddings.e_unit FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_TypeChecker_NBETerm.e_unit @@ -718,7 +713,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero "t_destruct" - FStar_Reflection_V2_Embeddings.e_term + uu___2 (FStar_Syntax_Embeddings.e_list (FStar_Syntax_Embeddings.e_tuple2 FStar_Reflection_V2_Embeddings.e_fv @@ -778,8 +773,8 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = "uvar_env" FStar_Reflection_V2_Embeddings.e_env (FStar_Syntax_Embeddings.e_option - FStar_Reflection_V2_Embeddings.e_term) - FStar_Reflection_V2_Embeddings.e_term + uu___2) + uu___2 FStar_Reflection_V2_NBEEmbeddings.e_env (FStar_TypeChecker_NBETerm.e_option FStar_Reflection_V2_NBEEmbeddings.e_attribute) @@ -794,8 +789,8 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "ghost_uvar_env" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + uu___2 + uu___2 FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_Reflection_V2_NBEEmbeddings.e_attribute @@ -809,7 +804,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "fresh_universe_uvar" FStar_Syntax_Embeddings.e_unit - FStar_Reflection_V2_Embeddings.e_term + uu___2 FStar_TypeChecker_NBETerm.e_unit FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_Tactics_V2_Basic.fresh_universe_uvar @@ -822,8 +817,8 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "unify_env" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + uu___2 + uu___2 FStar_Syntax_Embeddings.e_bool FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Reflection_V2_NBEEmbeddings.e_attribute @@ -839,8 +834,8 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "unify_guard_env" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + uu___2 + uu___2 FStar_Syntax_Embeddings.e_bool FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Reflection_V2_NBEEmbeddings.e_attribute @@ -856,8 +851,8 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "match_env" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + uu___2 + uu___2 FStar_Syntax_Embeddings.e_bool FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Reflection_V2_NBEEmbeddings.e_attribute @@ -889,7 +884,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero "change" - FStar_Reflection_V2_Embeddings.e_term + uu___2 FStar_Syntax_Embeddings.e_unit FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_TypeChecker_NBETerm.e_unit @@ -1002,6 +997,19 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_one + "set_dump_on_failure" + FStar_Syntax_Embeddings.e_bool + FStar_Syntax_Embeddings.e_unit + FStar_TypeChecker_NBETerm.e_bool + FStar_TypeChecker_NBETerm.e_unit + FStar_Tactics_V2_Basic.set_dump_on_failure + FStar_Tactics_V2_Basic.set_dump_on_failure in + let uu___137 + = + let uu___138 + = + FStar_Tactics_InterpFuns.mk_tac_step_1 + Prims.int_one "t_commute_applied_match" FStar_Syntax_Embeddings.e_unit FStar_Syntax_Embeddings.e_unit @@ -1009,9 +1017,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_unit FStar_Tactics_V2_Basic.t_commute_applied_match FStar_Tactics_V2_Basic.t_commute_applied_match in - let uu___137 + let uu___139 = - let uu___138 + let uu___140 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1022,24 +1030,24 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_unit FStar_Tactics_V2_Basic.gather_explicit_guards_for_resolved_goals FStar_Tactics_V2_Basic.gather_explicit_guards_for_resolved_goals in - let uu___139 + let uu___141 = - let uu___140 + let uu___142 = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero "string_to_term" FStar_Reflection_V2_Embeddings.e_env FStar_Syntax_Embeddings.e_string - FStar_Reflection_V2_Embeddings.e_term + uu___2 FStar_Reflection_V2_NBEEmbeddings.e_env FStar_TypeChecker_NBETerm.e_string FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_Tactics_V2_Basic.string_to_term FStar_Tactics_V2_Basic.string_to_term in - let uu___141 + let uu___143 = - let uu___142 + let uu___144 = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1056,22 +1064,22 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Reflection_V2_NBEEmbeddings.e_binding) FStar_Tactics_V2_Basic.push_bv_dsenv FStar_Tactics_V2_Basic.push_bv_dsenv in - let uu___143 + let uu___145 = - let uu___144 + let uu___146 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero "term_to_string" - FStar_Reflection_V2_Embeddings.e_term + uu___2 FStar_Syntax_Embeddings.e_string FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_TypeChecker_NBETerm.e_string FStar_Tactics_V2_Basic.term_to_string FStar_Tactics_V2_Basic.term_to_string in - let uu___145 + let uu___147 = - let uu___146 + let uu___148 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1082,22 +1090,22 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_string FStar_Tactics_V2_Basic.comp_to_string FStar_Tactics_V2_Basic.comp_to_string in - let uu___147 + let uu___149 = - let uu___148 + let uu___150 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero "term_to_doc" - FStar_Reflection_V2_Embeddings.e_term + uu___2 FStar_Syntax_Embeddings.e_document FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_TypeChecker_NBETerm.e_document FStar_Tactics_V2_Basic.term_to_doc FStar_Tactics_V2_Basic.term_to_doc in - let uu___149 + let uu___151 = - let uu___150 + let uu___152 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1108,9 +1116,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_document FStar_Tactics_V2_Basic.comp_to_doc FStar_Tactics_V2_Basic.comp_to_doc in - let uu___151 + let uu___153 = - let uu___152 + let uu___154 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1121,30 +1129,30 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_string FStar_Tactics_V2_Basic.range_to_string FStar_Tactics_V2_Basic.range_to_string in - let uu___153 + let uu___155 = - let uu___154 + let uu___156 = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero "term_eq_old" - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + uu___2 + uu___2 FStar_Syntax_Embeddings.e_bool FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_TypeChecker_NBETerm.e_bool FStar_Tactics_V2_Basic.term_eq_old FStar_Tactics_V2_Basic.term_eq_old in - let uu___155 + let uu___157 = - let uu___156 + let uu___158 = - let uu___157 + let uu___159 = FStar_Tactics_Interpreter.e_tactic_thunk FStar_Syntax_Embeddings.e_any in - let uu___158 + let uu___160 = FStar_Tactics_Interpreter.e_tactic_nbe_thunk FStar_TypeChecker_NBETerm.e_any in @@ -1153,23 +1161,23 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = "with_compat_pre_core" FStar_Syntax_Embeddings.e_any FStar_Syntax_Embeddings.e_int - uu___157 + uu___159 FStar_Syntax_Embeddings.e_any FStar_TypeChecker_NBETerm.e_any FStar_TypeChecker_NBETerm.e_int - uu___158 + uu___160 FStar_TypeChecker_NBETerm.e_any (fun - uu___159 + uu___161 -> FStar_Tactics_V2_Basic.with_compat_pre_core) (fun - uu___159 + uu___161 -> FStar_Tactics_V2_Basic.with_compat_pre_core) in - let uu___157 + let uu___159 = - let uu___158 + let uu___160 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1180,9 +1188,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_vconfig FStar_Tactics_V2_Basic.get_vconfig FStar_Tactics_V2_Basic.get_vconfig in - let uu___159 + let uu___161 = - let uu___160 + let uu___162 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1193,9 +1201,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_unit FStar_Tactics_V2_Basic.set_vconfig FStar_Tactics_V2_Basic.set_vconfig in - let uu___161 + let uu___163 = - let uu___162 + let uu___164 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1206,14 +1214,14 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_unit FStar_Tactics_V2_Basic.t_smt_sync FStar_Tactics_V2_Basic.t_smt_sync in - let uu___163 + let uu___165 = - let uu___164 + let uu___166 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero "free_uvars" - FStar_Reflection_V2_Embeddings.e_term + uu___2 (FStar_Syntax_Embeddings.e_list FStar_Syntax_Embeddings.e_int) FStar_Reflection_V2_NBEEmbeddings.e_attribute @@ -1221,9 +1229,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_int) FStar_Tactics_V2_Basic.free_uvars FStar_Tactics_V2_Basic.free_uvars in - let uu___165 + let uu___167 = - let uu___166 + let uu___168 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1240,9 +1248,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_string)) FStar_Tactics_V2_Basic.all_ext_options FStar_Tactics_V2_Basic.all_ext_options in - let uu___167 + let uu___169 = - let uu___168 + let uu___170 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1253,9 +1261,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_string FStar_Tactics_V2_Basic.ext_getv FStar_Tactics_V2_Basic.ext_getv in - let uu___169 + let uu___171 = - let uu___170 + let uu___172 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1272,9 +1280,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_string)) FStar_Tactics_V2_Basic.ext_getns FStar_Tactics_V2_Basic.ext_getns in - let uu___171 + let uu___173 = - let uu___172 + let uu___174 = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_one @@ -1288,16 +1296,16 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = (FStar_Tactics_Embedding.e_tref_nbe ()) (fun - uu___173 + uu___175 -> FStar_Tactics_V2_Basic.alloc) (fun - uu___173 + uu___175 -> FStar_Tactics_V2_Basic.alloc) in - let uu___173 + let uu___175 = - let uu___174 + let uu___176 = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_one @@ -1311,16 +1319,16 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = ()) FStar_TypeChecker_NBETerm.e_any (fun - uu___175 + uu___177 -> FStar_Tactics_V2_Basic.read) (fun - uu___175 + uu___177 -> FStar_Tactics_V2_Basic.read) in - let uu___175 + let uu___177 = - let uu___176 + let uu___178 = FStar_Tactics_InterpFuns.mk_tac_step_3 Prims.int_one @@ -1336,22 +1344,22 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_any FStar_TypeChecker_NBETerm.e_unit (fun - uu___177 + uu___179 -> FStar_Tactics_V2_Basic.write) (fun - uu___177 + uu___179 -> FStar_Tactics_V2_Basic.write) in - let uu___177 + let uu___179 = - let uu___178 + let uu___180 = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero "is_non_informative" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term + uu___2 (FStar_Syntax_Embeddings.e_tuple2 (FStar_Syntax_Embeddings.e_option FStar_Syntax_Embeddings.e_unit) @@ -1366,16 +1374,16 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_issue)) FStar_Tactics_V2_Basic.refl_is_non_informative FStar_Tactics_V2_Basic.refl_is_non_informative in - let uu___179 + let uu___181 = - let uu___180 + let uu___182 = FStar_Tactics_InterpFuns.mk_tac_step_3 Prims.int_zero "check_subtyping" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + uu___2 + uu___2 (FStar_Syntax_Embeddings.e_tuple2 (FStar_Syntax_Embeddings.e_option FStar_Syntax_Embeddings.e_unit) @@ -1391,21 +1399,25 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_issue)) FStar_Tactics_V2_Basic.refl_check_subtyping FStar_Tactics_V2_Basic.refl_check_subtyping in - let uu___181 + let uu___183 = - let uu___182 + let uu___184 = - FStar_Tactics_InterpFuns.mk_tac_step_3 + FStar_Tactics_InterpFuns.mk_tac_step_5 Prims.int_zero - "check_equiv" + "t_check_equiv" + FStar_Syntax_Embeddings.e_bool + FStar_Syntax_Embeddings.e_bool FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + uu___2 + uu___2 (FStar_Syntax_Embeddings.e_tuple2 (FStar_Syntax_Embeddings.e_option FStar_Syntax_Embeddings.e_unit) (FStar_Syntax_Embeddings.e_list FStar_Syntax_Embeddings.e_issue)) + FStar_TypeChecker_NBETerm.e_bool + FStar_TypeChecker_NBETerm.e_bool FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Reflection_V2_NBEEmbeddings.e_attribute FStar_Reflection_V2_NBEEmbeddings.e_attribute @@ -1414,25 +1426,24 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_unit) (FStar_TypeChecker_NBETerm.e_list FStar_TypeChecker_NBETerm.e_issue)) - FStar_Tactics_V2_Basic.refl_check_equiv - FStar_Tactics_V2_Basic.refl_check_equiv in - let uu___183 - = - let uu___184 - = + FStar_Tactics_V2_Basic.t_refl_check_equiv + FStar_Tactics_V2_Basic.t_refl_check_equiv in let uu___185 = - e_ret_t - (FStar_Syntax_Embeddings.e_tuple2 - (solve - FStar_Tactics_Embedding.e_tot_or_ghost) - FStar_Reflection_V2_Embeddings.e_term) in + let uu___186 + = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero "core_compute_term_type" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term - uu___185 + uu___2 + (FStar_Syntax_Embeddings.e_tuple2 + (FStar_Syntax_Embeddings.e_option + (FStar_Syntax_Embeddings.e_tuple2 + FStar_Tactics_Embedding.e_tot_or_ghost + uu___2)) + (FStar_Syntax_Embeddings.e_list + FStar_Syntax_Embeddings.e_issue)) FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Reflection_V2_NBEEmbeddings.e_attribute (FStar_TypeChecker_NBETerm.e_tuple2 @@ -1444,16 +1455,16 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_issue)) FStar_Tactics_V2_Basic.refl_core_compute_term_type FStar_Tactics_V2_Basic.refl_core_compute_term_type in - let uu___185 + let uu___187 = - let uu___186 + let uu___188 = FStar_Tactics_InterpFuns.mk_tac_step_4 Prims.int_zero "core_check_term" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + uu___2 + uu___2 FStar_Tactics_Embedding.e_tot_or_ghost (FStar_Syntax_Embeddings.e_tuple2 (FStar_Syntax_Embeddings.e_option @@ -1471,16 +1482,16 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_issue)) FStar_Tactics_V2_Basic.refl_core_check_term FStar_Tactics_V2_Basic.refl_core_check_term in - let uu___187 + let uu___189 = - let uu___188 + let uu___190 = FStar_Tactics_InterpFuns.mk_tac_step_3 Prims.int_zero "core_check_term_at_type" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + uu___2 + uu___2 (FStar_Syntax_Embeddings.e_tuple2 (FStar_Syntax_Embeddings.e_option FStar_Tactics_Embedding.e_tot_or_ghost) @@ -1496,25 +1507,24 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_issue)) FStar_Tactics_V2_Basic.refl_core_check_term_at_type FStar_Tactics_V2_Basic.refl_core_check_term_at_type in - let uu___189 - = - let uu___190 - = let uu___191 = - e_ret_t - (FStar_Syntax_Embeddings.e_tuple2 - FStar_Reflection_V2_Embeddings.e_term - (FStar_Syntax_Embeddings.e_tuple2 - (solve - FStar_Tactics_Embedding.e_tot_or_ghost) - FStar_Reflection_V2_Embeddings.e_term)) in + let uu___192 + = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero "tc_term" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term - uu___191 + uu___2 + (FStar_Syntax_Embeddings.e_tuple2 + (FStar_Syntax_Embeddings.e_option + (FStar_Syntax_Embeddings.e_tuple2 + uu___2 + (FStar_Syntax_Embeddings.e_tuple2 + FStar_Tactics_Embedding.e_tot_or_ghost + uu___2))) + (FStar_Syntax_Embeddings.e_list + FStar_Syntax_Embeddings.e_issue)) FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Reflection_V2_NBEEmbeddings.e_attribute (FStar_TypeChecker_NBETerm.e_tuple2 @@ -1528,15 +1538,15 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_issue)) FStar_Tactics_V2_Basic.refl_tc_term FStar_Tactics_V2_Basic.refl_tc_term in - let uu___191 + let uu___193 = - let uu___192 + let uu___194 = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero "universe_of" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term + uu___2 (FStar_Syntax_Embeddings.e_tuple2 (FStar_Syntax_Embeddings.e_option FStar_Reflection_V2_Embeddings.e_universe) @@ -1551,15 +1561,15 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_issue)) FStar_Tactics_V2_Basic.refl_universe_of FStar_Tactics_V2_Basic.refl_universe_of in - let uu___193 + let uu___195 = - let uu___194 + let uu___196 = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero "check_prop_validity" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term + uu___2 (FStar_Syntax_Embeddings.e_tuple2 (FStar_Syntax_Embeddings.e_option FStar_Syntax_Embeddings.e_unit) @@ -1574,16 +1584,16 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_issue)) FStar_Tactics_V2_Basic.refl_check_prop_validity FStar_Tactics_V2_Basic.refl_check_prop_validity in - let uu___195 + let uu___197 = - let uu___196 + let uu___198 = FStar_Tactics_InterpFuns.mk_tac_step_4 Prims.int_zero "check_match_complete" FStar_Reflection_V2_Embeddings.e_env - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term + uu___2 + uu___2 (FStar_Syntax_Embeddings.e_list FStar_Reflection_V2_Embeddings.e_pattern) (FStar_Syntax_Embeddings.e_option @@ -1607,11 +1617,11 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Reflection_V2_NBEEmbeddings.e_binding)))) FStar_Tactics_V2_Basic.refl_check_match_complete FStar_Tactics_V2_Basic.refl_check_match_complete in - let uu___197 + let uu___199 = - let uu___198 + let uu___200 = - let uu___199 + let uu___201 = e_ret_t (FStar_Syntax_Embeddings.e_tuple3 @@ -1624,7 +1634,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = uu___2) (solve uu___2)) in - let uu___200 + let uu___202 = nbe_e_ret_t (FStar_TypeChecker_NBETerm.e_tuple3 @@ -1642,24 +1652,24 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = "instantiate_implicits" FStar_Reflection_V2_Embeddings.e_env uu___2 - uu___199 + uu___201 FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Reflection_V2_NBEEmbeddings.e_attribute - uu___200 + uu___202 FStar_Tactics_V2_Basic.refl_instantiate_implicits FStar_Tactics_V2_Basic.refl_instantiate_implicits in - let uu___199 + let uu___201 = - let uu___200 + let uu___202 = - let uu___201 + let uu___203 = e_ret_t (FStar_Syntax_Embeddings.e_list (FStar_Syntax_Embeddings.e_tuple2 FStar_Reflection_V2_Embeddings.e_namedv FStar_Reflection_V2_Embeddings.e_term)) in - let uu___202 + let uu___204 = nbe_e_ret_t (FStar_TypeChecker_NBETerm.e_list @@ -1674,22 +1684,22 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = (FStar_Syntax_Embeddings.e_tuple2 FStar_Reflection_V2_Embeddings.e_namedv FStar_Reflection_V2_Embeddings.e_term)) - FStar_Reflection_V2_Embeddings.e_term - FStar_Reflection_V2_Embeddings.e_term - uu___201 + uu___2 + uu___2 + uu___203 FStar_Reflection_V2_NBEEmbeddings.e_env (FStar_TypeChecker_NBETerm.e_list (FStar_TypeChecker_NBETerm.e_tuple2 FStar_Reflection_V2_NBEEmbeddings.e_namedv FStar_Reflection_V2_NBEEmbeddings.e_term)) - FStar_Reflection_V2_NBEEmbeddings.e_term - FStar_Reflection_V2_NBEEmbeddings.e_term - uu___202 + FStar_Reflection_V2_NBEEmbeddings.e_attribute + FStar_Reflection_V2_NBEEmbeddings.e_attribute + uu___204 FStar_Tactics_V2_Basic.refl_try_unify FStar_Tactics_V2_Basic.refl_try_unify in - let uu___201 + let uu___203 = - let uu___202 + let uu___204 = FStar_Tactics_InterpFuns.mk_tac_step_3 Prims.int_zero @@ -1712,9 +1722,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_issue)) FStar_Tactics_V2_Basic.refl_maybe_relate_after_unfolding FStar_Tactics_V2_Basic.refl_maybe_relate_after_unfolding in - let uu___203 + let uu___205 = - let uu___204 + let uu___206 = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1735,9 +1745,28 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_issue)) FStar_Tactics_V2_Basic.refl_maybe_unfold_head FStar_Tactics_V2_Basic.refl_maybe_unfold_head in - let uu___205 + let uu___207 = - let uu___206 + let uu___208 + = + FStar_Tactics_InterpFuns.mk_tac_step_3 + Prims.int_zero + "norm_well_typed_term" + FStar_Reflection_V2_Embeddings.e_env + (FStar_Syntax_Embeddings.e_list + FStar_Syntax_Embeddings.e_norm_step) + uu___2 + uu___2 + FStar_Reflection_V2_NBEEmbeddings.e_env + (FStar_TypeChecker_NBETerm.e_list + FStar_TypeChecker_NBETerm.e_norm_step) + FStar_Reflection_V2_NBEEmbeddings.e_attribute + FStar_Reflection_V2_NBEEmbeddings.e_attribute + FStar_Tactics_V2_Basic.refl_norm_well_typed_term + FStar_Tactics_V2_Basic.refl_norm_well_typed_term in + let uu___209 + = + let uu___210 = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1750,9 +1779,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Tactics_V2_Basic.push_open_namespace FStar_Tactics_V2_Basic.push_open_namespace in - let uu___207 + let uu___211 = - let uu___208 + let uu___212 = FStar_Tactics_InterpFuns.mk_tac_step_3 Prims.int_zero @@ -1767,9 +1796,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Reflection_V2_NBEEmbeddings.e_env FStar_Tactics_V2_Basic.push_module_abbrev FStar_Tactics_V2_Basic.push_module_abbrev in - let uu___209 + let uu___213 = - let uu___210 + let uu___214 = FStar_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1790,9 +1819,9 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Reflection_V2_NBEEmbeddings.e_fv))) FStar_Tactics_V2_Basic.resolve_name FStar_Tactics_V2_Basic.resolve_name in - let uu___211 + let uu___215 = - let uu___212 + let uu___216 = FStar_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1805,15 +1834,15 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_unit FStar_Tactics_V2_Basic.log_issues FStar_Tactics_V2_Basic.log_issues in - let uu___213 + let uu___217 = - let uu___214 + let uu___218 = - let uu___215 + let uu___219 = FStar_Tactics_Interpreter.e_tactic_thunk FStar_Syntax_Embeddings.e_unit in - let uu___216 + let uu___220 = FStar_Tactics_Interpreter.e_tactic_nbe_thunk FStar_TypeChecker_NBETerm.e_unit in @@ -1821,7 +1850,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "call_subtac" FStar_Reflection_V2_Embeddings.e_env - uu___215 + uu___219 FStar_Reflection_V2_Embeddings.e_universe uu___2 (FStar_Syntax_Embeddings.e_tuple2 @@ -1830,7 +1859,7 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = (FStar_Syntax_Embeddings.e_list FStar_Syntax_Embeddings.e_issue)) FStar_Reflection_V2_NBEEmbeddings.e_env - uu___216 + uu___220 FStar_Reflection_V2_NBEEmbeddings.e_universe FStar_Reflection_V2_NBEEmbeddings.e_attribute (FStar_TypeChecker_NBETerm.e_tuple2 @@ -1840,7 +1869,13 @@ let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_TypeChecker_NBETerm.e_issue)) FStar_Tactics_V2_Basic.call_subtac FStar_Tactics_V2_Basic.call_subtac in - [uu___214] in + [uu___218] in + uu___216 + :: + uu___217 in + uu___214 + :: + uu___215 in uu___212 :: uu___213 in diff --git a/ocaml/fstar-lib/generated/FStar_Tactics_V2_SyntaxHelpers.ml b/ocaml/fstar-lib/generated/FStar_Tactics_V2_SyntaxHelpers.ml index 133edc8b66c..9718ddb2c6f 100644 --- a/ocaml/fstar-lib/generated/FStar_Tactics_V2_SyntaxHelpers.ml +++ b/ocaml/fstar-lib/generated/FStar_Tactics_V2_SyntaxHelpers.ml @@ -412,4 +412,52 @@ let (collect_app : ((FStar_Tactics_NamedView.term * FStar_Reflection_V2_Data.argv Prims.list), unit) FStar_Tactics_Effect.tac_repr) - = collect_app' [] \ No newline at end of file + = collect_app' [] +let (hua : + FStar_Tactics_NamedView.term -> + ((FStar_Reflection_Types.fv * FStar_Reflection_V2_Data.universes * + FStar_Reflection_V2_Data.argv Prims.list) + FStar_Pervasives_Native.option, + unit) FStar_Tactics_Effect.tac_repr) + = + fun t -> + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.V2.SyntaxHelpers.fst" + (Prims.of_int (92)) (Prims.of_int (17)) (Prims.of_int (92)) + (Prims.of_int (30))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.V2.SyntaxHelpers.fst" + (Prims.of_int (91)) (Prims.of_int (62)) (Prims.of_int (96)) + (Prims.of_int (13))))) (Obj.magic (collect_app t)) + (fun uu___ -> + (fun uu___ -> + match uu___ with + | (hd, args) -> + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.SyntaxHelpers.fst" + (Prims.of_int (93)) (Prims.of_int (8)) + (Prims.of_int (93)) (Prims.of_int (18))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.SyntaxHelpers.fst" + (Prims.of_int (93)) (Prims.of_int (2)) + (Prims.of_int (96)) (Prims.of_int (13))))) + (Obj.magic (FStar_Tactics_NamedView.inspect hd)) + (fun uu___1 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___2 -> + match uu___1 with + | FStar_Tactics_NamedView.Tv_FVar fv -> + FStar_Pervasives_Native.Some (fv, [], args) + | FStar_Tactics_NamedView.Tv_UInst (fv, us) -> + FStar_Pervasives_Native.Some (fv, us, args) + | uu___3 -> FStar_Pervasives_Native.None)))) + uu___) \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_ToSyntax_Interleave.ml b/ocaml/fstar-lib/generated/FStar_ToSyntax_Interleave.ml index 9778a34b2fb..fdfd1522443 100644 --- a/ocaml/fstar-lib/generated/FStar_ToSyntax_Interleave.ml +++ b/ocaml/fstar-lib/generated/FStar_ToSyntax_Interleave.ml @@ -46,6 +46,29 @@ let (definition_lids : | uu___3 -> []) tys | FStar_Parser_AST.Splice (uu___, ids, uu___1) -> FStar_Compiler_List.map (fun id -> FStar_Ident.lid_of_ids [id]) ids + | FStar_Parser_AST.DeclSyntaxExtension + (extension_name, code, uu___, range) -> + let ext_parser = + FStar_Parser_AST_Util.lookup_extension_parser extension_name in + (match ext_parser with + | FStar_Pervasives_Native.None -> + let uu___1 = + let uu___2 = + FStar_Compiler_Util.format1 "Unknown syntax extension %s" + extension_name in + (FStar_Errors_Codes.Fatal_SyntaxError, uu___2) in + FStar_Errors.raise_error uu___1 d.FStar_Parser_AST.drange + | FStar_Pervasives_Native.Some parser -> + let uu___1 = + parser.FStar_Parser_AST_Util.parse_decl_name code range in + (match uu___1 with + | FStar_Pervasives.Inl error -> + FStar_Errors.raise_error + (FStar_Errors_Codes.Fatal_SyntaxError, + (error.FStar_Parser_AST_Util.message)) + error.FStar_Parser_AST_Util.range + | FStar_Pervasives.Inr id -> + let uu___2 = FStar_Ident.lid_of_ids [id] in [uu___2])) | uu___ -> [] let (is_definition_of : FStar_Ident.ident -> FStar_Parser_AST.decl -> Prims.bool) = diff --git a/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml b/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml index ee9b4b36c5e..566f087337f 100644 --- a/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml +++ b/ocaml/fstar-lib/generated/FStar_ToSyntax_ToSyntax.ml @@ -1,4 +1,6 @@ open Prims +let (dbg_attrs : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "attrs" type antiquotations_temp = (FStar_Syntax_Syntax.bv * FStar_Syntax_Syntax.term) Prims.list let (tun_r : FStar_Compiler_Range_Type.range -> FStar_Syntax_Syntax.term) = @@ -327,51 +329,31 @@ let (op_as_term : fun env -> fun arity -> fun op -> - let r l dd = + let r l = let uu___ = let uu___1 = let uu___2 = let uu___3 = FStar_Ident.range_of_id op in FStar_Ident.set_lid_range l uu___3 in - FStar_Syntax_Syntax.lid_and_dd_as_fv uu___2 dd + FStar_Syntax_Syntax.lid_and_dd_as_fv uu___2 FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___1 in FStar_Pervasives_Native.Some uu___ in let fallback uu___ = let uu___1 = FStar_Ident.string_of_id op in match uu___1 with - | "=" -> - r FStar_Parser_Const.op_Eq FStar_Syntax_Syntax.delta_equational - | "<" -> - r FStar_Parser_Const.op_LT FStar_Syntax_Syntax.delta_equational - | "<=" -> - r FStar_Parser_Const.op_LTE - FStar_Syntax_Syntax.delta_equational - | ">" -> - r FStar_Parser_Const.op_GT FStar_Syntax_Syntax.delta_equational - | ">=" -> - r FStar_Parser_Const.op_GTE - FStar_Syntax_Syntax.delta_equational - | "&&" -> - r FStar_Parser_Const.op_And - FStar_Syntax_Syntax.delta_equational - | "||" -> - r FStar_Parser_Const.op_Or FStar_Syntax_Syntax.delta_equational - | "+" -> - r FStar_Parser_Const.op_Addition - FStar_Syntax_Syntax.delta_equational - | "-" when arity = Prims.int_one -> - r FStar_Parser_Const.op_Minus - FStar_Syntax_Syntax.delta_equational - | "-" -> - r FStar_Parser_Const.op_Subtraction - FStar_Syntax_Syntax.delta_equational - | "/" -> - r FStar_Parser_Const.op_Division - FStar_Syntax_Syntax.delta_equational - | "%" -> - r FStar_Parser_Const.op_Modulus - FStar_Syntax_Syntax.delta_equational + | "=" -> r FStar_Parser_Const.op_Eq + | "<" -> r FStar_Parser_Const.op_LT + | "<=" -> r FStar_Parser_Const.op_LTE + | ">" -> r FStar_Parser_Const.op_GT + | ">=" -> r FStar_Parser_Const.op_GTE + | "&&" -> r FStar_Parser_Const.op_And + | "||" -> r FStar_Parser_Const.op_Or + | "+" -> r FStar_Parser_Const.op_Addition + | "-" when arity = Prims.int_one -> r FStar_Parser_Const.op_Minus + | "-" -> r FStar_Parser_Const.op_Subtraction + | "/" -> r FStar_Parser_Const.op_Division + | "%" -> r FStar_Parser_Const.op_Modulus | "@" -> ((let uu___3 = FStar_Ident.range_of_id op in let uu___4 = @@ -382,36 +364,15 @@ let (op_as_term : [uu___6] in (FStar_Errors_Codes.Warning_DeprecatedGeneric, uu___5) in FStar_Errors.log_issue_doc uu___3 uu___4); - r FStar_Parser_Const.list_tot_append_lid - (FStar_Syntax_Syntax.Delta_equational_at_level - (Prims.of_int (2)))) - | "<>" -> - r FStar_Parser_Const.op_notEq - FStar_Syntax_Syntax.delta_equational - | "~" -> - r FStar_Parser_Const.not_lid - (FStar_Syntax_Syntax.Delta_constant_at_level - (Prims.of_int (2))) - | "==" -> - r FStar_Parser_Const.eq2_lid - (FStar_Syntax_Syntax.Delta_constant_at_level - (Prims.of_int (2))) - | "<<" -> - r FStar_Parser_Const.precedes_lid - FStar_Syntax_Syntax.delta_constant - | "/\\" -> - r FStar_Parser_Const.and_lid - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_one) - | "\\/" -> - r FStar_Parser_Const.or_lid - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_one) - | "==>" -> - r FStar_Parser_Const.imp_lid - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_one) - | "<==>" -> - r FStar_Parser_Const.iff_lid - (FStar_Syntax_Syntax.Delta_constant_at_level - (Prims.of_int (2))) + r FStar_Parser_Const.list_tot_append_lid) + | "<>" -> r FStar_Parser_Const.op_notEq + | "~" -> r FStar_Parser_Const.not_lid + | "==" -> r FStar_Parser_Const.eq2_lid + | "<<" -> r FStar_Parser_Const.precedes_lid + | "/\\" -> r FStar_Parser_Const.and_lid + | "\\/" -> r FStar_Parser_Const.or_lid + | "==>" -> r FStar_Parser_Const.imp_lid + | "<==>" -> r FStar_Parser_Const.iff_lid | uu___2 -> FStar_Pervasives_Native.None in let uu___ = let uu___1 = @@ -892,40 +853,70 @@ let rec (destruct_app_pattern : ((FStar_Pervasives.Inl id), args, FStar_Pervasives_Native.None) | uu___ -> FStar_Compiler_Effect.failwith "Not an app pattern" let rec (gather_pattern_bound_vars_maybe_top : - FStar_Ident.ident FStar_Compiler_Set.set -> - FStar_Parser_AST.pattern -> FStar_Ident.ident FStar_Compiler_Set.set) + FStar_Ident.ident FStar_Compiler_FlatSet.t -> + FStar_Parser_AST.pattern -> FStar_Ident.ident FStar_Compiler_FlatSet.t) = - fun acc -> - fun p -> - let gather_pattern_bound_vars_from_list = - FStar_Compiler_List.fold_left gather_pattern_bound_vars_maybe_top acc in - match p.FStar_Parser_AST.pat with - | FStar_Parser_AST.PatWild uu___ -> acc - | FStar_Parser_AST.PatConst uu___ -> acc - | FStar_Parser_AST.PatVQuote uu___ -> acc - | FStar_Parser_AST.PatName uu___ -> acc - | FStar_Parser_AST.PatOp uu___ -> acc - | FStar_Parser_AST.PatApp (phead, pats) -> - gather_pattern_bound_vars_from_list (phead :: pats) - | FStar_Parser_AST.PatTvar (x, uu___, uu___1) -> - FStar_Compiler_Set.add FStar_Syntax_Syntax.ord_ident x acc - | FStar_Parser_AST.PatVar (x, uu___, uu___1) -> - FStar_Compiler_Set.add FStar_Syntax_Syntax.ord_ident x acc - | FStar_Parser_AST.PatList pats -> - gather_pattern_bound_vars_from_list pats - | FStar_Parser_AST.PatTuple (pats, uu___) -> - gather_pattern_bound_vars_from_list pats - | FStar_Parser_AST.PatOr pats -> - gather_pattern_bound_vars_from_list pats - | FStar_Parser_AST.PatRecord guarded_pats -> - let uu___ = - FStar_Compiler_List.map FStar_Pervasives_Native.snd guarded_pats in - gather_pattern_bound_vars_from_list uu___ - | FStar_Parser_AST.PatAscribed (pat, uu___) -> - gather_pattern_bound_vars_maybe_top acc pat + fun uu___1 -> + fun uu___ -> + (fun acc -> + fun p -> + let gather_pattern_bound_vars_from_list = + FStar_Compiler_List.fold_left + gather_pattern_bound_vars_maybe_top acc in + match p.FStar_Parser_AST.pat with + | FStar_Parser_AST.PatWild uu___ -> Obj.magic (Obj.repr acc) + | FStar_Parser_AST.PatConst uu___ -> Obj.magic (Obj.repr acc) + | FStar_Parser_AST.PatVQuote uu___ -> Obj.magic (Obj.repr acc) + | FStar_Parser_AST.PatName uu___ -> Obj.magic (Obj.repr acc) + | FStar_Parser_AST.PatOp uu___ -> Obj.magic (Obj.repr acc) + | FStar_Parser_AST.PatApp (phead, pats) -> + Obj.magic + (Obj.repr + (gather_pattern_bound_vars_from_list (phead :: pats))) + | FStar_Parser_AST.PatTvar (x, uu___, uu___1) -> + Obj.magic + (Obj.repr + (FStar_Class_Setlike.add () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) x + (Obj.magic acc))) + | FStar_Parser_AST.PatVar (x, uu___, uu___1) -> + Obj.magic + (Obj.repr + (FStar_Class_Setlike.add () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) x + (Obj.magic acc))) + | FStar_Parser_AST.PatList pats -> + Obj.magic + (Obj.repr (gather_pattern_bound_vars_from_list pats)) + | FStar_Parser_AST.PatTuple (pats, uu___) -> + Obj.magic + (Obj.repr (gather_pattern_bound_vars_from_list pats)) + | FStar_Parser_AST.PatOr pats -> + Obj.magic + (Obj.repr (gather_pattern_bound_vars_from_list pats)) + | FStar_Parser_AST.PatRecord guarded_pats -> + Obj.magic + (Obj.repr + (let uu___ = + FStar_Compiler_List.map FStar_Pervasives_Native.snd + guarded_pats in + gather_pattern_bound_vars_from_list uu___)) + | FStar_Parser_AST.PatAscribed (pat, uu___) -> + Obj.magic + (Obj.repr (gather_pattern_bound_vars_maybe_top acc pat))) + uu___1 uu___ let (gather_pattern_bound_vars : - FStar_Parser_AST.pattern -> FStar_Ident.ident FStar_Compiler_Set.set) = - let acc = FStar_Compiler_Set.empty FStar_Syntax_Syntax.ord_ident () in + FStar_Parser_AST.pattern -> FStar_Ident.ident FStar_Compiler_FlatSet.t) = + let acc = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) ()) in fun p -> gather_pattern_bound_vars_maybe_top acc p type bnd = | LocalBinder of (FStar_Syntax_Syntax.bv * FStar_Syntax_Syntax.bqual * @@ -991,101 +982,36 @@ let (no_annot_abs : FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax) = fun bs -> fun t -> FStar_Syntax_Util.abs bs t FStar_Pervasives_Native.None -let (mk_ref_read : - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax) - = - fun tm -> - let tm' = - let uu___ = - let uu___1 = - let uu___2 = - FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.sread_lid - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in - FStar_Syntax_Syntax.fv_to_tm uu___2 in - let uu___2 = - let uu___3 = - let uu___4 = FStar_Syntax_Syntax.as_aqual_implicit false in - (tm, uu___4) in - [uu___3] in - { FStar_Syntax_Syntax.hd = uu___1; FStar_Syntax_Syntax.args = uu___2 - } in - FStar_Syntax_Syntax.Tm_app uu___ in - FStar_Syntax_Syntax.mk tm' tm.FStar_Syntax_Syntax.pos -let (mk_ref_alloc : - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax) - = - fun tm -> - let tm' = - let uu___ = - let uu___1 = - let uu___2 = - FStar_Syntax_Syntax.lid_and_dd_as_fv - FStar_Parser_Const.salloc_lid - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in - FStar_Syntax_Syntax.fv_to_tm uu___2 in - let uu___2 = - let uu___3 = - let uu___4 = FStar_Syntax_Syntax.as_aqual_implicit false in - (tm, uu___4) in - [uu___3] in - { FStar_Syntax_Syntax.hd = uu___1; FStar_Syntax_Syntax.args = uu___2 - } in - FStar_Syntax_Syntax.Tm_app uu___ in - FStar_Syntax_Syntax.mk tm' tm.FStar_Syntax_Syntax.pos -let (mk_ref_assign : - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> - FStar_Compiler_Range_Type.range -> - FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax) - = - fun t1 -> - fun t2 -> - fun pos -> - let tm = - let uu___ = - let uu___1 = - let uu___2 = - FStar_Syntax_Syntax.lid_and_dd_as_fv - FStar_Parser_Const.swrite_lid - FStar_Syntax_Syntax.delta_constant - FStar_Pervasives_Native.None in - FStar_Syntax_Syntax.fv_to_tm uu___2 in - let uu___2 = - let uu___3 = - let uu___4 = FStar_Syntax_Syntax.as_aqual_implicit false in - (t1, uu___4) in - let uu___4 = - let uu___5 = - let uu___6 = FStar_Syntax_Syntax.as_aqual_implicit false in - (t2, uu___6) in - [uu___5] in - uu___3 :: uu___4 in - { - FStar_Syntax_Syntax.hd = uu___1; - FStar_Syntax_Syntax.args = uu___2 - } in - FStar_Syntax_Syntax.Tm_app uu___ in - FStar_Syntax_Syntax.mk tm pos let rec (generalize_annotated_univs : FStar_Syntax_Syntax.sigelt -> FStar_Syntax_Syntax.sigelt) = fun s -> let vars = FStar_Compiler_Util.mk_ref [] in let seen = - let uu___ = FStar_Compiler_Set.empty FStar_Syntax_Syntax.ord_ident () in + let uu___ = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_ident)) ()) in FStar_Compiler_Util.mk_ref uu___ in let reg u = let uu___ = let uu___1 = let uu___2 = FStar_Compiler_Effect.op_Bang seen in - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_ident u uu___2 in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_ident)) u (Obj.magic uu___2) in Prims.op_Negation uu___1 in if uu___ then ((let uu___2 = let uu___3 = FStar_Compiler_Effect.op_Bang seen in - FStar_Compiler_Set.add FStar_Syntax_Syntax.ord_ident u uu___3 in + Obj.magic + (FStar_Class_Setlike.add () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_ident)) u (Obj.magic uu___3)) in FStar_Compiler_Effect.op_Colon_Equals seen uu___2); (let uu___2 = let uu___3 = FStar_Compiler_Effect.op_Bang vars in u :: uu___3 in @@ -1128,30 +1054,33 @@ let rec (generalize_annotated_univs : FStar_Syntax_Syntax.num_uniform_params = num_uniform; FStar_Syntax_Syntax.t = t; FStar_Syntax_Syntax.mutuals = lids1; - FStar_Syntax_Syntax.ds = lids2;_} + FStar_Syntax_Syntax.ds = lids2; + FStar_Syntax_Syntax.injective_type_params = uu___5;_} -> - let uu___5 = - let uu___6 = - let uu___7 = - FStar_Syntax_Subst.subst_binders usubst bs in + let uu___6 = + let uu___7 = let uu___8 = - let uu___9 = + FStar_Syntax_Subst.subst_binders usubst bs in + let uu___9 = + let uu___10 = FStar_Syntax_Subst.shift_subst (FStar_Compiler_List.length bs) usubst in - FStar_Syntax_Subst.subst uu___9 t in + FStar_Syntax_Subst.subst uu___10 t in { FStar_Syntax_Syntax.lid = lid; FStar_Syntax_Syntax.us = unames; - FStar_Syntax_Syntax.params = uu___7; + FStar_Syntax_Syntax.params = uu___8; FStar_Syntax_Syntax.num_uniform_params = num_uniform; - FStar_Syntax_Syntax.t = uu___8; + FStar_Syntax_Syntax.t = uu___9; FStar_Syntax_Syntax.mutuals = lids1; - FStar_Syntax_Syntax.ds = lids2 + FStar_Syntax_Syntax.ds = lids2; + FStar_Syntax_Syntax.injective_type_params = + false } in - FStar_Syntax_Syntax.Sig_inductive_typ uu___6 in + FStar_Syntax_Syntax.Sig_inductive_typ uu___7 in { - FStar_Syntax_Syntax.sigel = uu___5; + FStar_Syntax_Syntax.sigel = uu___6; FStar_Syntax_Syntax.sigrng = (se.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = @@ -1171,22 +1100,25 @@ let rec (generalize_annotated_univs : FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = tlid; FStar_Syntax_Syntax.num_ty_params = n; - FStar_Syntax_Syntax.mutuals1 = lids1;_} + FStar_Syntax_Syntax.mutuals1 = lids1; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_} -> - let uu___5 = - let uu___6 = - let uu___7 = FStar_Syntax_Subst.subst usubst t in + let uu___6 = + let uu___7 = + let uu___8 = FStar_Syntax_Subst.subst usubst t in { FStar_Syntax_Syntax.lid1 = lid; FStar_Syntax_Syntax.us1 = unames; - FStar_Syntax_Syntax.t1 = uu___7; + FStar_Syntax_Syntax.t1 = uu___8; FStar_Syntax_Syntax.ty_lid = tlid; FStar_Syntax_Syntax.num_ty_params = n; - FStar_Syntax_Syntax.mutuals1 = lids1 + FStar_Syntax_Syntax.mutuals1 = lids1; + FStar_Syntax_Syntax.injective_type_params1 = + false } in - FStar_Syntax_Syntax.Sig_datacon uu___6 in + FStar_Syntax_Syntax.Sig_datacon uu___7 in { - FStar_Syntax_Syntax.sigel = uu___5; + FStar_Syntax_Syntax.sigel = uu___6; FStar_Syntax_Syntax.sigrng = (se.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = @@ -1370,7 +1302,10 @@ let rec (generalize_annotated_univs : | FStar_Syntax_Syntax.Layered_eff_sig (n, (uu___1, t)) -> let uvs = let uu___2 = FStar_Syntax_Free.univnames t in - FStar_Compiler_Set.elems FStar_Syntax_Syntax.ord_ident uu___2 in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) (Obj.magic uu___2) in let usubst = FStar_Syntax_Subst.univ_var_closing uvs in let uu___2 = let uu___3 = @@ -1381,7 +1316,10 @@ let rec (generalize_annotated_univs : | FStar_Syntax_Syntax.WP_eff_sig (uu___1, t) -> let uvs = let uu___2 = FStar_Syntax_Free.univnames t in - FStar_Compiler_Set.elems FStar_Syntax_Syntax.ord_ident uu___2 in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) (Obj.magic uu___2) in let usubst = FStar_Syntax_Subst.univ_var_closing uvs in let uu___2 = let uu___3 = FStar_Syntax_Subst.subst usubst t in @@ -1603,56 +1541,103 @@ let (check_linear_pattern_variables : = fun pats -> fun r -> - let rec pat_vars p = - match p.FStar_Syntax_Syntax.v with - | FStar_Syntax_Syntax.Pat_dot_term uu___ -> - FStar_Syntax_Syntax.no_names - | FStar_Syntax_Syntax.Pat_constant uu___ -> - FStar_Syntax_Syntax.no_names - | FStar_Syntax_Syntax.Pat_var x -> - let uu___ = - let uu___1 = - FStar_Ident.string_of_id x.FStar_Syntax_Syntax.ppname in - uu___1 = FStar_Ident.reserved_prefix in - if uu___ - then FStar_Syntax_Syntax.no_names - else - FStar_Compiler_Set.add FStar_Syntax_Syntax.ord_bv x - FStar_Syntax_Syntax.no_names - | FStar_Syntax_Syntax.Pat_cons (uu___, uu___1, pats1) -> - let aux out uu___2 = - match uu___2 with - | (p1, uu___3) -> - let p_vars = pat_vars p1 in - let intersection = - FStar_Compiler_Set.inter FStar_Syntax_Syntax.ord_bv - p_vars out in - let uu___4 = - FStar_Compiler_Set.is_empty FStar_Syntax_Syntax.ord_bv - intersection in - if uu___4 - then - FStar_Compiler_Set.union FStar_Syntax_Syntax.ord_bv out - p_vars - else - (let duplicate_bv = - let uu___6 = - FStar_Compiler_Set.elems FStar_Syntax_Syntax.ord_bv - intersection in - FStar_Compiler_List.hd uu___6 in - let uu___6 = - let uu___7 = - let uu___8 = - FStar_Ident.string_of_id - duplicate_bv.FStar_Syntax_Syntax.ppname in - FStar_Compiler_Util.format1 - "Non-linear patterns are not permitted: `%s` appears more than once in this pattern." - uu___8 in - (FStar_Errors_Codes.Fatal_NonLinearPatternNotPermitted, - uu___7) in - FStar_Errors.raise_error uu___6 r) in - FStar_Compiler_List.fold_left aux FStar_Syntax_Syntax.no_names - pats1 in + let rec pat_vars uu___ = + (fun p -> + match p.FStar_Syntax_Syntax.v with + | FStar_Syntax_Syntax.Pat_dot_term uu___ -> + Obj.magic + (Obj.repr + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) ())) + | FStar_Syntax_Syntax.Pat_constant uu___ -> + Obj.magic + (Obj.repr + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) ())) + | FStar_Syntax_Syntax.Pat_var x -> + Obj.magic + (Obj.repr + (let uu___ = + let uu___1 = + FStar_Ident.string_of_id + x.FStar_Syntax_Syntax.ppname in + uu___1 = FStar_Ident.reserved_prefix in + if uu___ + then + FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) () + else + FStar_Class_Setlike.singleton () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) x)) + | FStar_Syntax_Syntax.Pat_cons (uu___, uu___1, pats1) -> + Obj.magic + (Obj.repr + (let aux uu___3 uu___2 = + (fun out -> + fun uu___2 -> + match uu___2 with + | (p1, uu___3) -> + let p_vars = pat_vars p1 in + let intersection = + Obj.magic + (FStar_Class_Setlike.inter () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic p_vars) (Obj.magic out)) in + let uu___4 = + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic intersection) in + if uu___4 + then + Obj.magic + (Obj.repr + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic out) (Obj.magic p_vars))) + else + Obj.magic + (Obj.repr + (let duplicate_bv = + let uu___6 = + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic intersection) in + FStar_Compiler_List.hd uu___6 in + let uu___6 = + let uu___7 = + let uu___8 = + FStar_Ident.string_of_id + duplicate_bv.FStar_Syntax_Syntax.ppname in + FStar_Compiler_Util.format1 + "Non-linear patterns are not permitted: `%s` appears more than once in this pattern." + uu___8 in + (FStar_Errors_Codes.Fatal_NonLinearPatternNotPermitted, + uu___7) in + FStar_Errors.raise_error uu___6 r))) + uu___3 uu___2 in + let uu___2 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) ()) in + FStar_Compiler_List.fold_left aux uu___2 pats1))) uu___ in match pats with | [] -> () | p::[] -> let uu___ = pat_vars p in () @@ -1661,24 +1646,47 @@ let (check_linear_pattern_variables : let aux p1 = let uu___ = let uu___1 = pat_vars p1 in - FStar_Compiler_Set.equal FStar_Syntax_Syntax.ord_bv pvars - uu___1 in + FStar_Class_Setlike.equal () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) (Obj.magic pvars) + (Obj.magic uu___1) in if uu___ then () else - (let symdiff s1 s2 = - let uu___2 = - FStar_Compiler_Set.diff FStar_Syntax_Syntax.ord_bv s1 s2 in - let uu___3 = - FStar_Compiler_Set.diff FStar_Syntax_Syntax.ord_bv s2 s1 in - FStar_Compiler_Set.union FStar_Syntax_Syntax.ord_bv uu___2 - uu___3 in + (let symdiff uu___3 uu___2 = + (fun s1 -> + fun s2 -> + let uu___2 = + Obj.magic + (FStar_Class_Setlike.diff () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic s1) (Obj.magic s2)) in + let uu___3 = + Obj.magic + (FStar_Class_Setlike.diff () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic s2) (Obj.magic s1)) in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic uu___2) (Obj.magic uu___3))) uu___3 + uu___2 in let nonlinear_vars = let uu___2 = pat_vars p1 in symdiff pvars uu___2 in let first_nonlinear_var = let uu___2 = - FStar_Compiler_Set.elems FStar_Syntax_Syntax.ord_bv - nonlinear_vars in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic nonlinear_vars) in FStar_Compiler_List.hd uu___2 in let uu___2 = let uu___3 = @@ -1998,7 +2006,6 @@ let rec (desugar_data_pat : let uu___5 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.nil_lid - FStar_Syntax_Syntax.delta_constant (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor) in (uu___5, FStar_Pervasives_Native.None, []) in @@ -2016,7 +2023,6 @@ let rec (desugar_data_pat : let uu___4 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.cons_lid - FStar_Syntax_Syntax.delta_constant (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor) in (uu___4, FStar_Pervasives_Native.None, @@ -2108,7 +2114,6 @@ let rec (desugar_data_pat : FStar_Ident.lid_of_path ["__dummy__"] p1.FStar_Parser_AST.prange in FStar_Syntax_Syntax.lid_and_dd_as_fv lid - FStar_Syntax_Syntax.delta_constant (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Unresolved_constructor { @@ -2393,12 +2398,8 @@ and (desugar_machine_integer : FStar_Ident.path_of_text private_intro_nm in FStar_Ident.lid_of_path uu___3 range in let private_fv = - let uu___3 = - FStar_Syntax_Util.incr_delta_depth - (FStar_Pervasives_Native.__proj__Some__item__v - fv.FStar_Syntax_Syntax.fv_delta) in FStar_Syntax_Syntax.lid_and_dd_as_fv private_lid - uu___3 fv.FStar_Syntax_Syntax.fv_qual in + fv.FStar_Syntax_Syntax.fv_qual in { FStar_Syntax_Syntax.n = (FStar_Syntax_Syntax.Tm_fvar private_fv); @@ -2606,7 +2607,8 @@ and (desugar_term_maybe_top : Prims.strcat "Unexpected or unbound operator: " uu___4 in (FStar_Errors_Codes.Fatal_UnepxectedOrUnboundOperator, uu___3) in - FStar_Errors.raise_error uu___2 top.FStar_Parser_AST.range + let uu___3 = FStar_Ident.range_of_id s in + FStar_Errors.raise_error uu___2 uu___3 | FStar_Pervasives_Native.Some op -> if (FStar_Compiler_List.length args) > Prims.int_zero then @@ -2733,7 +2735,6 @@ and (desugar_term_maybe_top : FStar_Ident.set_lid_range FStar_Parser_Const.true_lid top.FStar_Parser_AST.range in FStar_Syntax_Syntax.fvar_with_dd uu___2 - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in (uu___1, noaqs) | FStar_Parser_AST.Name lid when @@ -2743,7 +2744,6 @@ and (desugar_term_maybe_top : FStar_Ident.set_lid_range FStar_Parser_Const.false_lid top.FStar_Parser_AST.range in FStar_Syntax_Syntax.fvar_with_dd uu___2 - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in (uu___1, noaqs) | FStar_Parser_AST.Projector (eff_name, id) when @@ -2759,8 +2759,7 @@ and (desugar_term_maybe_top : let lid = FStar_Syntax_Util.dm4f_lid ed txt in let uu___2 = FStar_Syntax_Syntax.fvar_with_dd lid - (FStar_Syntax_Syntax.Delta_constant_at_level - Prims.int_one) FStar_Pervasives_Native.None in + FStar_Pervasives_Native.None in (uu___2, noaqs) | FStar_Pervasives_Native.None -> let uu___2 = @@ -3072,25 +3071,43 @@ and (desugar_term_maybe_top : | [] -> FStar_Pervasives_Native.None | set::sets2 -> let i = - FStar_Compiler_Set.inter FStar_Syntax_Syntax.ord_ident - acc set in + Obj.magic + (FStar_Class_Setlike.inter () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) + (Obj.magic acc) (Obj.magic set)) in let uu___1 = - FStar_Compiler_Set.is_empty - FStar_Syntax_Syntax.ord_ident i in + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) (Obj.magic i) in if uu___1 then let uu___2 = - FStar_Compiler_Set.union - FStar_Syntax_Syntax.ord_ident acc set in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) + (Obj.magic acc) (Obj.magic set)) in aux uu___2 sets2 else (let uu___3 = let uu___4 = - FStar_Compiler_Set.elems - FStar_Syntax_Syntax.ord_ident i in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) + (Obj.magic i) in FStar_Compiler_List.hd uu___4 in FStar_Pervasives_Native.Some uu___3) in - let uu___1 = FStar_Syntax_Syntax.new_id_set () in + let uu___1 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) ()) in aux uu___1 sets in ((let uu___2 = check_disjoint bvss in match uu___2 with @@ -3098,14 +3115,28 @@ and (desugar_term_maybe_top : | FStar_Pervasives_Native.Some id -> let uu___3 = let uu___4 = - let uu___5 = FStar_Ident.string_of_id id in - FStar_Compiler_Util.format1 - "Non-linear patterns are not permitted: `%s` appears more than once in this function definition." - uu___5 in + let uu___5 = + FStar_Errors_Msg.text + "Non-linear patterns are not permitted." in + let uu___6 = + let uu___7 = + let uu___8 = FStar_Errors_Msg.text "The variable " in + let uu___9 = + let uu___10 = + let uu___11 = + FStar_Class_PP.pp FStar_Ident.pretty_ident id in + FStar_Pprint.squotes uu___11 in + let uu___11 = + FStar_Errors_Msg.text + " appears more than once in this function definition." in + FStar_Pprint.op_Hat_Slash_Hat uu___10 uu___11 in + FStar_Pprint.op_Hat_Slash_Hat uu___8 uu___9 in + [uu___7] in + uu___5 :: uu___6 in (FStar_Errors_Codes.Fatal_NonLinearPatternNotPermitted, uu___4) in let uu___4 = FStar_Ident.range_of_id id in - FStar_Errors.raise_error uu___3 uu___4); + FStar_Errors.raise_error_doc uu___3 uu___4); (let binders1 = FStar_Compiler_List.map replace_unit_pattern binders in let uu___2 = @@ -3230,7 +3261,6 @@ and (desugar_term_maybe_top : top.FStar_Parser_AST.range in FStar_Syntax_Syntax.lid_and_dd_as_fv uu___8 - FStar_Syntax_Syntax.delta_constant (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor) in let sc1 = @@ -3293,7 +3323,6 @@ and (desugar_term_maybe_top : top.FStar_Parser_AST.range in FStar_Syntax_Syntax.lid_and_dd_as_fv uu___9 - FStar_Syntax_Syntax.delta_constant (FStar_Pervasives_Native.Some FStar_Syntax_Syntax.Data_ctor) in let sc1 = @@ -3657,8 +3686,7 @@ and (desugar_term_maybe_top : let uu___9 = let uu___10 = FStar_Ident.ident_of_lid l in FStar_Syntax_DsEnv.push_top_level_rec_binding - env1 uu___10 - FStar_Syntax_Syntax.delta_equational in + env1 uu___10 in (match uu___9 with | (env2, used_marker) -> (env2, (FStar_Pervasives.Inr l), @@ -3740,11 +3768,8 @@ and (desugar_term_maybe_top : FStar_Pervasives.Inl x | FStar_Pervasives.Inr l -> let uu___6 = - let uu___7 = - FStar_Syntax_Util.incr_delta_qualifier - body1 in FStar_Syntax_Syntax.lid_and_dd_as_fv l - uu___7 FStar_Pervasives_Native.None in + FStar_Pervasives_Native.None in FStar_Pervasives.Inr uu___6 in let body2 = if is_rec @@ -3884,11 +3909,8 @@ and (desugar_term_maybe_top : match uu___6 with | (body1, aq) -> let fv = - let uu___7 = - FStar_Syntax_Util.incr_delta_qualifier - t11 in FStar_Syntax_Syntax.lid_and_dd_as_fv l - uu___7 FStar_Pervasives_Native.None in + FStar_Pervasives_Native.None in let uu___7 = let uu___8 = let uu___9 = @@ -4021,9 +4043,7 @@ and (desugar_term_maybe_top : let uu___1 = let uu___2 = FStar_Syntax_Syntax.lid_and_dd_as_fv - FStar_Parser_Const.bool_lid - FStar_Syntax_Syntax.delta_constant - FStar_Pervasives_Native.None in + FStar_Parser_Const.bool_lid FStar_Pervasives_Native.None in FStar_Syntax_Syntax.Tm_fvar uu___2 in mk uu___1 in let uu___1 = desugar_term_aq env t1 in @@ -4253,7 +4273,6 @@ and (desugar_term_maybe_top : FStar_Ident.lid_of_path ["__dummy__"] top.FStar_Parser_AST.range in FStar_Syntax_Syntax.fvar_with_dd lid - FStar_Syntax_Syntax.delta_constant (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Unresolved_constructor uc)) in let mk_result args1 = @@ -4329,8 +4348,6 @@ and (desugar_term_maybe_top : match uu___2 with | FStar_Pervasives_Native.None -> FStar_Syntax_Syntax.fvar_with_dd f - (FStar_Syntax_Syntax.Delta_equational_at_level - Prims.int_one) (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Unresolved_projector FStar_Pervasives_Native.None)) @@ -4353,9 +4370,7 @@ and (desugar_term_maybe_top : let uu___3 = FStar_Ident.set_lid_range projname top.FStar_Parser_AST.range in - FStar_Syntax_Syntax.lid_and_dd_as_fv uu___3 - (FStar_Syntax_Syntax.Delta_equational_at_level - Prims.int_one) qual in + FStar_Syntax_Syntax.lid_and_dd_as_fv uu___3 qual in let qual1 = FStar_Syntax_Syntax.Unresolved_projector (FStar_Pervasives_Native.Some candidate_projector) in @@ -4363,8 +4378,6 @@ and (desugar_term_maybe_top : let uu___3 = qualify_field_names constrname [f] in FStar_Compiler_List.hd uu___3 in FStar_Syntax_Syntax.fvar_with_dd f1 - (FStar_Syntax_Syntax.Delta_equational_at_level - Prims.int_one) (FStar_Pervasives_Native.Some qual1) in let uu___2 = let uu___3 = @@ -4415,8 +4428,10 @@ and (desugar_term_maybe_top : ((let fvs = FStar_Syntax_Free.names tm1 in let uu___3 = let uu___4 = - FStar_Compiler_Set.is_empty FStar_Syntax_Syntax.ord_bv - fvs in + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) (Obj.magic fvs) in Prims.op_Negation uu___4 in if uu___3 then @@ -4424,7 +4439,7 @@ and (desugar_term_maybe_top : let uu___5 = let uu___6 = FStar_Class_Show.show - (FStar_Compiler_Set.showable_set + (FStar_Compiler_FlatSet.showable_set FStar_Syntax_Syntax.ord_bv FStar_Syntax_Print.showable_bv) fvs in FStar_Compiler_Util.format1 @@ -4655,7 +4670,6 @@ and (desugar_term_maybe_top : let uu___2 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.forall_intro_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___2 in let args = @@ -4699,7 +4713,6 @@ and (desugar_term_maybe_top : let uu___2 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.exists_intro_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___2 in let args = @@ -4754,7 +4767,6 @@ and (desugar_term_maybe_top : let uu___2 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.implies_intro_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___2 in let args = @@ -4786,7 +4798,6 @@ and (desugar_term_maybe_top : let head = let uu___1 = FStar_Syntax_Syntax.lid_and_dd_as_fv lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___1 in let args = @@ -4814,7 +4825,6 @@ and (desugar_term_maybe_top : let uu___1 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.and_intro_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___1 in let args = @@ -4849,7 +4859,6 @@ and (desugar_term_maybe_top : let uu___2 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.forall_elim_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___2 in let args = @@ -4934,7 +4943,6 @@ and (desugar_term_maybe_top : let uu___3 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.exists_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___3 in let args = @@ -4962,7 +4970,6 @@ and (desugar_term_maybe_top : let uu___3 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.exists_elim_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___3 in let args = @@ -5061,7 +5068,6 @@ and (desugar_term_maybe_top : let uu___1 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.implies_elim_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___1 in let args = @@ -5111,7 +5117,6 @@ and (desugar_term_maybe_top : let uu___3 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.or_elim_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___3 in let extra_binder = @@ -5178,7 +5183,6 @@ and (desugar_term_maybe_top : let uu___2 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.and_elim_lid - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___2 in let args = @@ -5845,7 +5849,6 @@ and (desugar_comp : pat.FStar_Syntax_Syntax.pos in FStar_Syntax_Syntax.fvar_with_dd uu___10 - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in let uu___10 = let uu___11 = @@ -6011,14 +6014,19 @@ and (desugar_formula : match uu___ with | FStar_Parser_AST.Labeled (f1, l, p) -> let f2 = desugar_formula env f1 in - mk - (FStar_Syntax_Syntax.Tm_meta - { - FStar_Syntax_Syntax.tm2 = f2; - FStar_Syntax_Syntax.meta = - (FStar_Syntax_Syntax.Meta_labeled - (l, (f2.FStar_Syntax_Syntax.pos), p)) - }) + let uu___1 = + let uu___2 = + let uu___3 = + let uu___4 = + let uu___5 = FStar_Errors_Msg.mkmsg l in + (uu___5, (f2.FStar_Syntax_Syntax.pos), p) in + FStar_Syntax_Syntax.Meta_labeled uu___4 in + { + FStar_Syntax_Syntax.tm2 = f2; + FStar_Syntax_Syntax.meta = uu___3 + } in + FStar_Syntax_Syntax.Tm_meta uu___2 in + mk uu___1 | FStar_Parser_AST.QForall ([], uu___1, uu___2) -> FStar_Compiler_Effect.failwith "Impossible: Quantifier without binders" @@ -6055,7 +6063,6 @@ and (desugar_formula : let uu___1 = FStar_Ident.set_lid_range q b.FStar_Parser_AST.brange in FStar_Syntax_Syntax.fvar_with_dd uu___1 - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_one) FStar_Pervasives_Native.None in desugar_quant q_head b pats true body | FStar_Parser_AST.QExists (b::[], pats, body) -> @@ -6064,7 +6071,6 @@ and (desugar_formula : let uu___1 = FStar_Ident.set_lid_range q b.FStar_Parser_AST.brange in FStar_Syntax_Syntax.fvar_with_dd uu___1 - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_one) FStar_Pervasives_Native.None in desugar_quant q_head b pats true body | FStar_Parser_AST.QuantOp (i, b::[], pats, body) -> @@ -6433,14 +6439,11 @@ let (mk_indexed_projector_names : if only_decl then [decl] else - (let dd = - FStar_Syntax_Syntax.Delta_equational_at_level - Prims.int_one in - let lb = + (let lb = let uu___2 = let uu___3 = FStar_Syntax_Syntax.lid_and_dd_as_fv - field_name dd FStar_Pervasives_Native.None in + field_name FStar_Pervasives_Native.None in FStar_Pervasives.Inr uu___3 in { FStar_Syntax_Syntax.lbname = uu___2; @@ -6508,32 +6511,33 @@ let (mk_data_projector_names : FStar_Syntax_Syntax.us1 = uu___; FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___1; FStar_Syntax_Syntax.num_ty_params = n; - FStar_Syntax_Syntax.mutuals1 = uu___2;_} + FStar_Syntax_Syntax.mutuals1 = uu___2; + FStar_Syntax_Syntax.injective_type_params1 = uu___3;_} -> - let uu___3 = FStar_Syntax_Util.arrow_formals t in - (match uu___3 with - | (formals, uu___4) -> + let uu___4 = FStar_Syntax_Util.arrow_formals t in + (match uu___4 with + | (formals, uu___5) -> (match formals with | [] -> [] - | uu___5 -> - let filter_records uu___6 = - match uu___6 with + | uu___6 -> + let filter_records uu___7 = + match uu___7 with | FStar_Syntax_Syntax.RecordConstructor - (uu___7, fns) -> + (uu___8, fns) -> FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Record_ctor (lid, fns)) - | uu___7 -> FStar_Pervasives_Native.None in + | uu___8 -> FStar_Pervasives_Native.None in let fv_qual = - let uu___6 = + let uu___7 = FStar_Compiler_Util.find_map se.FStar_Syntax_Syntax.sigquals filter_records in - match uu___6 with + match uu___7 with | FStar_Pervasives_Native.None -> FStar_Syntax_Syntax.Data_ctor | FStar_Pervasives_Native.Some q -> q in - let uu___6 = FStar_Compiler_Util.first_N n formals in - (match uu___6 with - | (uu___7, rest) -> + let uu___7 = FStar_Compiler_Util.first_N n formals in + (match uu___7 with + | (uu___8, rest) -> mk_indexed_projector_names iquals fv_qual se.FStar_Syntax_Syntax.sigattrs env lid rest))) | uu___ -> []) @@ -6570,11 +6574,10 @@ let (mk_typ_abbrev : FStar_Syntax_DsEnv.lookup_letbinding_quals_and_attrs env lid in FStar_Pervasives_Native.snd uu___ in - let dd = FStar_Syntax_Util.incr_delta_qualifier t in let lb = let uu___ = let uu___1 = - FStar_Syntax_Syntax.lid_and_dd_as_fv lid dd + FStar_Syntax_Syntax.lid_and_dd_as_fv lid FStar_Pervasives_Native.None in FStar_Pervasives.Inr uu___1 in let uu___1 = @@ -6920,7 +6923,9 @@ let rec (desugar_tycon : FStar_Pervasives_Native.None; FStar_Syntax_Syntax.t = k1; FStar_Syntax_Syntax.mutuals = mutuals; - FStar_Syntax_Syntax.ds = [] + FStar_Syntax_Syntax.ds = []; + FStar_Syntax_Syntax.injective_type_params = + false }); FStar_Syntax_Syntax.sigrng = uu___2; FStar_Syntax_Syntax.sigquals = quals1; @@ -6933,12 +6938,12 @@ let rec (desugar_tycon : } in let uu___2 = FStar_Syntax_DsEnv.push_top_level_rec_binding _env - id FStar_Syntax_Syntax.delta_constant in + id in (match uu___2 with | (_env1, uu___3) -> let uu___4 = FStar_Syntax_DsEnv.push_top_level_rec_binding - _env' id FStar_Syntax_Syntax.delta_constant in + _env' id in (match uu___4 with | (_env2, uu___5) -> (_env1, _env2, se, tconstr)))) | uu___1 -> FStar_Compiler_Effect.failwith "Unexpected tycon" in @@ -6986,7 +6991,9 @@ let rec (desugar_tycon : FStar_Syntax_Syntax.num_uniform_params = uu___5; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = []; - FStar_Syntax_Syntax.ds = [];_} + FStar_Syntax_Syntax.ds = []; + FStar_Syntax_Syntax.injective_type_params = + uu___6;_} -> let quals1 = se.FStar_Syntax_Syntax.sigquals in let quals2 = @@ -6995,22 +7002,22 @@ let rec (desugar_tycon : FStar_Syntax_Syntax.Assumption quals1 then quals1 else - ((let uu___8 = - let uu___9 = FStar_Options.ml_ish () in - Prims.op_Negation uu___9 in - if uu___8 + ((let uu___9 = + let uu___10 = FStar_Options.ml_ish () in + Prims.op_Negation uu___10 in + if uu___9 then - let uu___9 = - let uu___10 = - let uu___11 = + let uu___10 = + let uu___11 = + let uu___12 = FStar_Syntax_Print.lid_to_string l in FStar_Compiler_Util.format1 "Adding an implicit 'assume new' qualifier on %s" - uu___11 in + uu___12 in (FStar_Errors_Codes.Warning_AddImplicitAssumeNewQualifier, - uu___10) in + uu___11) in FStar_Errors.log_issue - se.FStar_Syntax_Syntax.sigrng uu___9 + se.FStar_Syntax_Syntax.sigrng uu___10 else ()); FStar_Syntax_Syntax.Assumption :: @@ -7020,17 +7027,17 @@ let rec (desugar_tycon : let t = match typars with | [] -> k - | uu___6 -> - let uu___7 = - let uu___8 = - let uu___9 = + | uu___7 -> + let uu___8 = + let uu___9 = + let uu___10 = FStar_Syntax_Syntax.mk_Total k in { FStar_Syntax_Syntax.bs1 = typars; - FStar_Syntax_Syntax.comp = uu___9 + FStar_Syntax_Syntax.comp = uu___10 } in - FStar_Syntax_Syntax.Tm_arrow uu___8 in - FStar_Syntax_Syntax.mk uu___7 + FStar_Syntax_Syntax.Tm_arrow uu___9 in + FStar_Syntax_Syntax.mk uu___8 se.FStar_Syntax_Syntax.sigrng in { FStar_Syntax_Syntax.sigel = @@ -7269,37 +7276,39 @@ let rec (desugar_tycon : = uu___4; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = uu___5; - FStar_Syntax_Syntax.ds = uu___6;_}; - FStar_Syntax_Syntax.sigrng = uu___7; - FStar_Syntax_Syntax.sigquals = uu___8; - FStar_Syntax_Syntax.sigmeta = uu___9; - FStar_Syntax_Syntax.sigattrs = uu___10; + FStar_Syntax_Syntax.ds = uu___6; + FStar_Syntax_Syntax.injective_type_params + = uu___7;_}; + FStar_Syntax_Syntax.sigrng = uu___8; + FStar_Syntax_Syntax.sigquals = uu___9; + FStar_Syntax_Syntax.sigmeta = uu___10; + FStar_Syntax_Syntax.sigattrs = uu___11; FStar_Syntax_Syntax.sigopens_and_abbrevs = - uu___11; - FStar_Syntax_Syntax.sigopts = uu___12;_}, + uu___12; + FStar_Syntax_Syntax.sigopts = uu___13;_}, binders, t, quals1) -> let t1 = - let uu___13 = + let uu___14 = typars_of_binders env1 binders in - match uu___13 with + match uu___14 with | (env2, tpars1) -> - let uu___14 = push_tparams env2 tpars1 in - (match uu___14 with + let uu___15 = push_tparams env2 tpars1 in + (match uu___15 with | (env_tps, tpars2) -> let t2 = desugar_typ env_tps t in let tpars3 = FStar_Syntax_Subst.close_binders tpars2 in FStar_Syntax_Subst.close tpars3 t2) in - let uu___13 = - let uu___14 = - let uu___15 = FStar_Ident.range_of_lid id in + let uu___14 = + let uu___15 = + let uu___16 = FStar_Ident.range_of_lid id in mk_typ_abbrev env1 d id uvs tpars (FStar_Pervasives_Native.Some k) t1 - [id] quals1 uu___15 in - ([], uu___14) in - [uu___13] + [id] quals1 uu___16 in + ([], uu___15) in + [uu___14] | FStar_Pervasives.Inl ({ FStar_Syntax_Syntax.sigel = @@ -7311,7 +7320,9 @@ let rec (desugar_tycon : = num_uniform; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = mutuals1; - FStar_Syntax_Syntax.ds = uu___4;_}; + FStar_Syntax_Syntax.ds = uu___4; + FStar_Syntax_Syntax.injective_type_params + = injective_type_params;_}; FStar_Syntax_Syntax.sigrng = uu___5; FStar_Syntax_Syntax.sigquals = tname_quals; FStar_Syntax_Syntax.sigmeta = uu___6; @@ -7461,7 +7472,10 @@ let rec (desugar_tycon : FStar_Syntax_Syntax.num_ty_params = ntps; FStar_Syntax_Syntax.mutuals1 - = mutuals1 + = mutuals1; + FStar_Syntax_Syntax.injective_type_params1 + = + injective_type_params } in FStar_Syntax_Syntax.Sig_datacon uu___17 in @@ -7509,8 +7523,8 @@ let rec (desugar_tycon : (match uu___11 with | (constrNames, constrs1) -> ((let uu___13 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "attrs") in + FStar_Compiler_Effect.op_Bang + dbg_attrs in if uu___13 then let uu___14 = @@ -7563,7 +7577,10 @@ let rec (desugar_tycon : FStar_Syntax_Syntax.mutuals = mutuals1; FStar_Syntax_Syntax.ds - = constrNames + = constrNames; + FStar_Syntax_Syntax.injective_type_params + = + injective_type_params }); FStar_Syntax_Syntax.sigrng = uu___15; @@ -7599,8 +7616,7 @@ let rec (desugar_tycon : (match uu___3 with | (bundle, abbrevs) -> ((let uu___5 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "attrs") in + FStar_Compiler_Effect.op_Bang dbg_attrs in if uu___5 then let uu___6 = @@ -7632,16 +7648,18 @@ let rec (desugar_tycon : = uu___6; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = uu___7; - FStar_Syntax_Syntax.ds = constrs;_} + FStar_Syntax_Syntax.ds = constrs; + FStar_Syntax_Syntax.injective_type_params + = uu___8;_} -> let quals1 = se.FStar_Syntax_Syntax.sigquals in - let uu___8 = + let uu___9 = FStar_Compiler_List.filter (fun data_lid -> let data_quals = let data_se = - let uu___9 = + let uu___10 = FStar_Compiler_List.find (fun se1 -> match se1.FStar_Syntax_Syntax.sigel @@ -7651,35 +7669,37 @@ let rec (desugar_tycon : FStar_Syntax_Syntax.lid1 = name; FStar_Syntax_Syntax.us1 - = uu___10; - FStar_Syntax_Syntax.t1 = uu___11; - FStar_Syntax_Syntax.ty_lid + FStar_Syntax_Syntax.t1 = uu___12; - FStar_Syntax_Syntax.num_ty_params + FStar_Syntax_Syntax.ty_lid = uu___13; + FStar_Syntax_Syntax.num_ty_params + = uu___14; FStar_Syntax_Syntax.mutuals1 - = uu___14;_} + = uu___15; + FStar_Syntax_Syntax.injective_type_params1 + = uu___16;_} -> FStar_Ident.lid_equals name data_lid - | uu___10 -> false) + | uu___11 -> false) sigelts in FStar_Compiler_Util.must - uu___9 in + uu___10 in data_se.FStar_Syntax_Syntax.sigquals in - let uu___9 = + let uu___10 = FStar_Compiler_List.existsb - (fun uu___10 -> - match uu___10 with + (fun uu___11 -> + match uu___11 with | FStar_Syntax_Syntax.RecordConstructor - uu___11 -> true - | uu___11 -> false) + uu___12 -> true + | uu___12 -> false) data_quals in - Prims.op_Negation uu___9) + Prims.op_Negation uu___10) constrs in mk_data_discriminators quals1 env3 - uu___8 + uu___9 se.FStar_Syntax_Syntax.sigattrs | uu___5 -> []) sigelts in let ops = @@ -8860,41 +8880,50 @@ and (desugar_decl_maybe_fail_attr : (fun i -> FStar_Common.list_of_option i.FStar_Errors.issue_number) errs1 in - if expected_errs = [] - then (env0, []) - else - (let uu___4 = - FStar_Errors.find_multiset_discrepancy - expected_errs errnos in - match uu___4 with - | FStar_Pervasives_Native.None -> (env0, []) - | FStar_Pervasives_Native.Some (e, n1, n2) -> - (FStar_Compiler_List.iter - FStar_Errors.print_issue errs1; - (let uu___7 = - let uu___8 = - let uu___9 = - (FStar_Common.string_of_list ()) - FStar_Compiler_Util.string_of_int - expected_errs in - let uu___10 = - (FStar_Common.string_of_list ()) - FStar_Compiler_Util.string_of_int - errnos in - let uu___11 = - FStar_Compiler_Util.string_of_int e in - let uu___12 = - FStar_Compiler_Util.string_of_int n2 in - let uu___13 = - FStar_Compiler_Util.string_of_int n1 in - FStar_Compiler_Util.format5 - "This top-level definition was expected to raise error codes %s, but it raised %s (at desugaring time). Error #%s was raised %s times, instead of %s." - uu___9 uu___10 uu___11 uu___12 uu___13 in - (FStar_Errors_Codes.Error_DidNotFail, - uu___8) in - FStar_Errors.log_issue - d1.FStar_Parser_AST.drange uu___7); - (env0, []))))) + ((let uu___4 = FStar_Options.print_expected_failures () in + if uu___4 + then + (FStar_Compiler_Util.print_string + ">> Got issues: [\n"; + FStar_Compiler_List.iter FStar_Errors.print_issue + errs1; + FStar_Compiler_Util.print_string ">>]\n") + else ()); + if expected_errs = [] + then (env0, []) + else + (let uu___5 = + FStar_Errors.find_multiset_discrepancy + expected_errs errnos in + match uu___5 with + | FStar_Pervasives_Native.None -> (env0, []) + | FStar_Pervasives_Native.Some (e, n1, n2) -> + (FStar_Compiler_List.iter + FStar_Errors.print_issue errs1; + (let uu___8 = + let uu___9 = + let uu___10 = + (FStar_Common.string_of_list ()) + FStar_Compiler_Util.string_of_int + expected_errs in + let uu___11 = + (FStar_Common.string_of_list ()) + FStar_Compiler_Util.string_of_int + errnos in + let uu___12 = + FStar_Compiler_Util.string_of_int e in + let uu___13 = + FStar_Compiler_Util.string_of_int n2 in + let uu___14 = + FStar_Compiler_Util.string_of_int n1 in + FStar_Compiler_Util.format5 + "This top-level definition was expected to raise error codes %s, but it raised %s (at desugaring time). Error #%s was raised %s times, instead of %s." + uu___10 uu___11 uu___12 uu___13 uu___14 in + (FStar_Errors_Codes.Error_DidNotFail, + uu___9) in + FStar_Errors.log_issue + d1.FStar_Parser_AST.drange uu___8); + (env0, [])))))) | FStar_Pervasives_Native.None -> desugar_decl_core env attrs d in match uu___ with | (env1, sigelts) -> (env1, sigelts) and (desugar_decl : @@ -9013,9 +9042,7 @@ and (desugar_decl_core : desugar_tycon env d d_attrs uu___1 tcs in (match uu___ with | (env1, ses) -> - ((let uu___2 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "attrs") in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg_attrs in if uu___2 then let uu___3 = FStar_Parser_AST.decl_to_string d in @@ -9123,12 +9150,14 @@ and (desugar_decl_core : FStar_Syntax_Syntax.num_ty_params = uu___6; FStar_Syntax_Syntax.mutuals1 = - uu___7;_} + uu___7; + FStar_Syntax_Syntax.injective_type_params1 + = uu___8;_} -> - let uu___8 = + let uu___9 = FStar_Syntax_Util.arrow_formals t in - (match uu___8 with - | (formals1, uu___9) -> + (match uu___9 with + | (formals1, uu___10) -> FStar_Pervasives_Native.Some formals1) | uu___3 -> FStar_Pervasives_Native.None) @@ -9148,7 +9177,8 @@ and (desugar_decl_core : FStar_Syntax_Syntax.num_uniform_params = uu___4; FStar_Syntax_Syntax.t = ty; FStar_Syntax_Syntax.mutuals = uu___5; - FStar_Syntax_Syntax.ds = uu___6;_} + FStar_Syntax_Syntax.ds = uu___6; + FStar_Syntax_Syntax.injective_type_params = uu___7;_} -> let formals1 = match formals with @@ -9159,44 +9189,44 @@ and (desugar_decl_core : let i = FStar_Ident.ident_of_lid meth in FStar_Compiler_Util.for_some (fun formal -> - let uu___7 = + let uu___8 = FStar_Ident.ident_equals i (formal.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.ppname in - if uu___7 + if uu___8 then FStar_Compiler_Util.for_some (fun attr -> - let uu___8 = - let uu___9 = + let uu___9 = + let uu___10 = FStar_Syntax_Subst.compress attr in - uu___9.FStar_Syntax_Syntax.n in - match uu___8 with + uu___10.FStar_Syntax_Syntax.n in + match uu___9 with | FStar_Syntax_Syntax.Tm_fvar fv -> FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.no_method_lid - | uu___9 -> false) + | uu___10 -> false) formal.FStar_Syntax_Syntax.binder_attrs else false) formals1 in let meths1 = FStar_Compiler_List.filter (fun x -> - let uu___7 = has_no_method_attr x in - Prims.op_Negation uu___7) meths in + let uu___8 = has_no_method_attr x in + Prims.op_Negation uu___8) meths in let is_typed = false in - let uu___7 = - let uu___8 = - let uu___9 = - let uu___10 = mkclass lid in + let uu___8 = + let uu___9 = + let uu___10 = + let uu___11 = mkclass lid in { FStar_Syntax_Syntax.is_typed = is_typed; FStar_Syntax_Syntax.lids2 = meths1; - FStar_Syntax_Syntax.tac = uu___10 + FStar_Syntax_Syntax.tac = uu___11 } in - FStar_Syntax_Syntax.Sig_splice uu___9 in - let uu___9 = + FStar_Syntax_Syntax.Sig_splice uu___10 in + let uu___10 = FStar_Syntax_DsEnv.opens_and_abbrevs env1 in { - FStar_Syntax_Syntax.sigel = uu___8; + FStar_Syntax_Syntax.sigel = uu___9; FStar_Syntax_Syntax.sigrng = (d.FStar_Parser_AST.drange); FStar_Syntax_Syntax.sigquals = []; @@ -9204,11 +9234,11 @@ and (desugar_decl_core : FStar_Syntax_Syntax.default_sigmeta; FStar_Syntax_Syntax.sigattrs = []; FStar_Syntax_Syntax.sigopens_and_abbrevs = - uu___9; + uu___10; FStar_Syntax_Syntax.sigopts = FStar_Pervasives_Native.None } in - [uu___7] + [uu___8] | uu___2 -> [] in let uu___2 = if typeclass @@ -9228,7 +9258,6 @@ and (desugar_decl_core : let uu___5 = FStar_Syntax_Syntax.fvar_with_dd FStar_Parser_Const.tcclass_lid - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in uu___5 :: (se.FStar_Syntax_Syntax.sigattrs) in FStar_Syntax_Util.deduplicate_terms uu___4 in @@ -9257,7 +9286,6 @@ and (desugar_decl_core : let uu___6 = FStar_Syntax_Syntax.fvar_with_dd FStar_Parser_Const.tcclass_lid - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in uu___6 :: (se.FStar_Syntax_Syntax.sigattrs) in FStar_Syntax_Util.deduplicate_terms uu___5 in @@ -9608,8 +9636,11 @@ and (desugar_decl_core : FStar_Pervasives_Native.None in let bvs = let uu___2 = gather_pattern_bound_vars pat in - FStar_Compiler_Set.elems FStar_Syntax_Syntax.ord_ident - uu___2 in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) + (Obj.magic uu___2) in let uu___2 = (FStar_Compiler_List.isEmpty bvs) && (let uu___3 = is_var_pattern pat in @@ -9710,7 +9741,8 @@ and (desugar_decl_core : FStar_Parser_Const.exn_lid; FStar_Syntax_Syntax.num_ty_params = Prims.int_zero; FStar_Syntax_Syntax.mutuals1 = - [FStar_Parser_Const.exn_lid] + [FStar_Parser_Const.exn_lid]; + FStar_Syntax_Syntax.injective_type_params1 = false }); FStar_Syntax_Syntax.sigrng = (d.FStar_Parser_AST.drange); FStar_Syntax_Syntax.sigquals = qual; @@ -9995,7 +10027,8 @@ and (desugar_decl_core : FStar_Parser_AST_Util.open_namespaces = uu___1; FStar_Parser_AST_Util.module_abbreviations = uu___2 } in - let uu___1 = parser opens code range in + let uu___1 = + parser.FStar_Parser_AST_Util.parse_decl opens code range in (match uu___1 with | FStar_Pervasives.Inl error -> FStar_Errors.raise_error diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Cfg.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Cfg.ml index 1a16c3208d4..7871021efcd 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Cfg.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Cfg.ml @@ -2190,9 +2190,17 @@ let (prim_from_list : let (built_in_primitive_steps : FStar_TypeChecker_Primops_Base.primitive_step FStar_Compiler_Util.psmap) = prim_from_list FStar_TypeChecker_Primops.built_in_primitive_steps_list +let (env_dependent_ops : FStar_TypeChecker_Env.env_t -> prim_step_set) = + fun env -> + let uu___ = FStar_TypeChecker_Primops.env_dependent_ops env in + prim_from_list uu___ let (equality_ops : - FStar_TypeChecker_Primops_Base.primitive_step FStar_Compiler_Util.psmap) = - prim_from_list FStar_TypeChecker_Primops.equality_ops_list + FStar_TypeChecker_Env.env_t -> + FStar_TypeChecker_Primops_Base.primitive_step FStar_Compiler_Util.psmap) + = + fun env -> + let uu___ = FStar_TypeChecker_Primops.equality_ops_list env in + prim_from_list uu___ let (showable_cfg : cfg FStar_Class_Show.showable) = { FStar_Class_Show.show = @@ -2245,8 +2253,13 @@ let (log_cfg : cfg -> (unit -> unit) -> unit) = fun cfg1 -> fun f -> if (cfg1.debug).cfg then f () else () let (log_primops : cfg -> (unit -> unit) -> unit) = fun cfg1 -> fun f -> if (cfg1.debug).primop then f () else () +let (dbg_unfolding : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Unfolding" let (log_unfolding : cfg -> (unit -> unit) -> unit) = - fun cfg1 -> fun f -> if (cfg1.debug).unfolding then f () else () + fun cfg1 -> + fun f -> + let uu___ = FStar_Compiler_Effect.op_Bang dbg_unfolding in + if uu___ then f () else () let (log_nbe : cfg -> (unit -> unit) -> unit) = fun cfg1 -> fun f -> if (cfg1.debug).debug_nbe then f () else () let (primop_time_map : Prims.int FStar_Compiler_Util.smap) = @@ -2385,6 +2398,28 @@ let (add_nbe : fsteps -> fsteps) = default_univs_to_zero = (s.default_univs_to_zero) } else s +let (dbg_Norm : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Norm" +let (dbg_NormTop : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "NormTop" +let (dbg_NormCfg : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "NormCfg" +let (dbg_Primops : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Primops" +let (dbg_Unfolding : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Unfolding" +let (dbg_380 : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "380" +let (dbg_WPE : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "WPE" +let (dbg_NormDelayed : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "NormDelayed" +let (dbg_print_normalized : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "print_normalized_terms" +let (dbg_NBE : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "NBE" +let (dbg_UNSOUND_EraseErasableArgs : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "UNSOUND_EraseErasableArgs" let (config' : FStar_TypeChecker_Primops_Base.primitive_step Prims.list -> FStar_TypeChecker_Env.step Prims.list -> FStar_TypeChecker_Env.env -> cfg) @@ -2414,63 +2449,49 @@ let (config' : let d1 = match d with | [] -> [FStar_TypeChecker_Env.NoDelta] | uu___ -> d in let steps = let uu___ = to_fsteps s in add_nbe uu___ in - let psteps1 = let uu___ = cached_steps () in add_steps uu___ psteps in + let psteps1 = + let uu___ = + let uu___1 = env_dependent_ops e in + let uu___2 = cached_steps () in merge_steps uu___1 uu___2 in + add_steps uu___ psteps in let dbg_flag = FStar_Compiler_List.contains FStar_TypeChecker_Env.NormDebug s in let uu___ = - let uu___1 = dbg_flag || (FStar_Options.debug_any ()) in - if uu___1 - then - let uu___2 = - (FStar_TypeChecker_Env.debug e (FStar_Options.Other "Norm")) || - dbg_flag in - let uu___3 = - (FStar_TypeChecker_Env.debug e (FStar_Options.Other "NormTop")) - || dbg_flag in - let uu___4 = - FStar_TypeChecker_Env.debug e (FStar_Options.Other "NormCfg") in - let uu___5 = - FStar_TypeChecker_Env.debug e (FStar_Options.Other "Primops") in - let uu___6 = - FStar_TypeChecker_Env.debug e (FStar_Options.Other "Unfolding") in - let uu___7 = - FStar_TypeChecker_Env.debug e (FStar_Options.Other "380") in - let uu___8 = - FStar_TypeChecker_Env.debug e (FStar_Options.Other "WPE") in - let uu___9 = - FStar_TypeChecker_Env.debug e - (FStar_Options.Other "NormDelayed") in - let uu___10 = - FStar_TypeChecker_Env.debug e - (FStar_Options.Other "print_normalized_terms") in - let uu___11 = - FStar_TypeChecker_Env.debug e (FStar_Options.Other "NBE") in - let uu___12 = - let b = - FStar_TypeChecker_Env.debug e - (FStar_Options.Other "UNSOUND_EraseErasableArgs") in - if b - then - (let uu___14 = FStar_TypeChecker_Env.get_range e in - FStar_Errors.log_issue uu___14 - (FStar_Errors_Codes.Warning_WarnOnUse, - "The 'UNSOUND_EraseErasableArgs' setting is for debugging only; it is not sound")) - else (); - b in - { - gen = uu___2; - top = uu___3; - cfg = uu___4; - primop = uu___5; - unfolding = uu___6; - b380 = uu___7; - wpe = uu___8; - norm_delayed = uu___9; - print_normalized = uu___10; - debug_nbe = uu___11; - erase_erasable_args = uu___12 - } - else no_debug_switches in + let uu___1 = (FStar_Compiler_Effect.op_Bang dbg_Norm) || dbg_flag in + let uu___2 = + (FStar_Compiler_Effect.op_Bang dbg_NormTop) || dbg_flag in + let uu___3 = FStar_Compiler_Effect.op_Bang dbg_NormCfg in + let uu___4 = FStar_Compiler_Effect.op_Bang dbg_Primops in + let uu___5 = FStar_Compiler_Effect.op_Bang dbg_Unfolding in + let uu___6 = FStar_Compiler_Effect.op_Bang dbg_380 in + let uu___7 = FStar_Compiler_Effect.op_Bang dbg_WPE in + let uu___8 = FStar_Compiler_Effect.op_Bang dbg_NormDelayed in + let uu___9 = FStar_Compiler_Effect.op_Bang dbg_print_normalized in + let uu___10 = FStar_Compiler_Effect.op_Bang dbg_NBE in + let uu___11 = + (let uu___13 = + FStar_Compiler_Effect.op_Bang dbg_UNSOUND_EraseErasableArgs in + if uu___13 + then + let uu___14 = FStar_TypeChecker_Env.get_range e in + FStar_Errors.log_issue uu___14 + (FStar_Errors_Codes.Warning_WarnOnUse, + "The 'UNSOUND_EraseErasableArgs' setting is for debugging only; it is not sound") + else ()); + FStar_Compiler_Effect.op_Bang dbg_UNSOUND_EraseErasableArgs in + { + gen = uu___1; + top = uu___2; + cfg = uu___3; + primop = uu___4; + unfolding = uu___5; + b380 = uu___6; + wpe = uu___7; + norm_delayed = uu___8; + print_normalized = uu___9; + debug_nbe = uu___10; + erase_erasable_args = uu___11 + } in let uu___1 = (Prims.op_Negation steps.pure_subterms_within_computations) || (FStar_Options.normalize_pure_terms_for_extraction ()) in diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Common.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Common.ml index 456504c264b..3f6c69c7071 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Common.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Common.ml @@ -42,63 +42,69 @@ type 'a problem = logical_guard_uvar: FStar_Syntax_Syntax.ctx_uvar ; reason: Prims.string Prims.list ; loc: FStar_Compiler_Range_Type.range ; - rank: rank_t FStar_Pervasives_Native.option } + rank: rank_t FStar_Pervasives_Native.option ; + logical: Prims.bool } let __proj__Mkproblem__item__pid : 'a . 'a problem -> Prims.int = fun projectee -> match projectee with | { pid; lhs; relation; rhs; element; logical_guard; logical_guard_uvar; - reason; loc; rank;_} -> pid + reason; loc; rank; logical;_} -> pid let __proj__Mkproblem__item__lhs : 'a . 'a problem -> 'a = fun projectee -> match projectee with | { pid; lhs; relation; rhs; element; logical_guard; logical_guard_uvar; - reason; loc; rank;_} -> lhs + reason; loc; rank; logical;_} -> lhs let __proj__Mkproblem__item__relation : 'a . 'a problem -> rel = fun projectee -> match projectee with | { pid; lhs; relation; rhs; element; logical_guard; logical_guard_uvar; - reason; loc; rank;_} -> relation + reason; loc; rank; logical;_} -> relation let __proj__Mkproblem__item__rhs : 'a . 'a problem -> 'a = fun projectee -> match projectee with | { pid; lhs; relation; rhs; element; logical_guard; logical_guard_uvar; - reason; loc; rank;_} -> rhs + reason; loc; rank; logical;_} -> rhs let __proj__Mkproblem__item__element : 'a . 'a problem -> FStar_Syntax_Syntax.bv FStar_Pervasives_Native.option = fun projectee -> match projectee with | { pid; lhs; relation; rhs; element; logical_guard; logical_guard_uvar; - reason; loc; rank;_} -> element + reason; loc; rank; logical;_} -> element let __proj__Mkproblem__item__logical_guard : 'a . 'a problem -> FStar_Syntax_Syntax.term = fun projectee -> match projectee with | { pid; lhs; relation; rhs; element; logical_guard; logical_guard_uvar; - reason; loc; rank;_} -> logical_guard + reason; loc; rank; logical;_} -> logical_guard let __proj__Mkproblem__item__logical_guard_uvar : 'a . 'a problem -> FStar_Syntax_Syntax.ctx_uvar = fun projectee -> match projectee with | { pid; lhs; relation; rhs; element; logical_guard; logical_guard_uvar; - reason; loc; rank;_} -> logical_guard_uvar + reason; loc; rank; logical;_} -> logical_guard_uvar let __proj__Mkproblem__item__reason : 'a . 'a problem -> Prims.string Prims.list = fun projectee -> match projectee with | { pid; lhs; relation; rhs; element; logical_guard; logical_guard_uvar; - reason; loc; rank;_} -> reason + reason; loc; rank; logical;_} -> reason let __proj__Mkproblem__item__loc : 'a . 'a problem -> FStar_Compiler_Range_Type.range = fun projectee -> match projectee with | { pid; lhs; relation; rhs; element; logical_guard; logical_guard_uvar; - reason; loc; rank;_} -> loc + reason; loc; rank; logical;_} -> loc let __proj__Mkproblem__item__rank : 'a . 'a problem -> rank_t FStar_Pervasives_Native.option = fun projectee -> match projectee with | { pid; lhs; relation; rhs; element; logical_guard; logical_guard_uvar; - reason; loc; rank;_} -> rank + reason; loc; rank; logical;_} -> rank +let __proj__Mkproblem__item__logical : 'a . 'a problem -> Prims.bool = + fun projectee -> + match projectee with + | { pid; lhs; relation; rhs; element; logical_guard; logical_guard_uvar; + reason; loc; rank; logical;_} -> logical type prob = | TProb of FStar_Syntax_Syntax.typ problem | CProb of FStar_Syntax_Syntax.comp problem @@ -914,893 +920,6 @@ let (lcomp_of_comp_guard : FStar_Syntax_Syntax.comp -> guard_t -> lcomp) = (fun uu___1 -> (c0, g)) let (lcomp_of_comp : FStar_Syntax_Syntax.comp -> lcomp) = fun c0 -> lcomp_of_comp_guard c0 trivial_guard -let (simplify : - Prims.bool -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term) = - fun debug -> - fun tm -> - let w t = - { - FStar_Syntax_Syntax.n = (t.FStar_Syntax_Syntax.n); - FStar_Syntax_Syntax.pos = (tm.FStar_Syntax_Syntax.pos); - FStar_Syntax_Syntax.vars = (t.FStar_Syntax_Syntax.vars); - FStar_Syntax_Syntax.hash_code = (t.FStar_Syntax_Syntax.hash_code) - } in - let simp_t t = - let uu___ = - let uu___1 = FStar_Syntax_Util.unmeta t in - uu___1.FStar_Syntax_Syntax.n in - match uu___ with - | FStar_Syntax_Syntax.Tm_fvar fv when - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.true_lid -> - FStar_Pervasives_Native.Some true - | FStar_Syntax_Syntax.Tm_fvar fv when - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.false_lid -> - FStar_Pervasives_Native.Some false - | uu___1 -> FStar_Pervasives_Native.None in - let rec args_are_binders args bs = - match (args, bs) with - | ((t, uu___)::args1, b::bs1) -> - let uu___1 = - let uu___2 = FStar_Syntax_Subst.compress t in - uu___2.FStar_Syntax_Syntax.n in - (match uu___1 with - | FStar_Syntax_Syntax.Tm_name bv' -> - (FStar_Syntax_Syntax.bv_eq b.FStar_Syntax_Syntax.binder_bv - bv') - && (args_are_binders args1 bs1) - | uu___2 -> false) - | ([], []) -> true - | (uu___, uu___1) -> false in - let is_applied bs t = - if debug - then - (let uu___1 = FStar_Syntax_Print.term_to_string t in - let uu___2 = FStar_Syntax_Print.tag_of_term t in - FStar_Compiler_Util.print2 "WPE> is_applied %s -- %s\n" uu___1 - uu___2) - else (); - (let uu___1 = FStar_Syntax_Util.head_and_args_full t in - match uu___1 with - | (hd, args) -> - let uu___2 = - let uu___3 = FStar_Syntax_Subst.compress hd in - uu___3.FStar_Syntax_Syntax.n in - (match uu___2 with - | FStar_Syntax_Syntax.Tm_name bv when args_are_binders args bs - -> - (if debug - then - (let uu___4 = FStar_Syntax_Print.term_to_string t in - let uu___5 = FStar_Syntax_Print.bv_to_string bv in - let uu___6 = FStar_Syntax_Print.term_to_string hd in - FStar_Compiler_Util.print3 - "WPE> got it\n>>>>top = %s\n>>>>b = %s\n>>>>hd = %s\n" - uu___4 uu___5 uu___6) - else (); - FStar_Pervasives_Native.Some bv) - | uu___3 -> FStar_Pervasives_Native.None)) in - let is_applied_maybe_squashed bs t = - if debug - then - (let uu___1 = FStar_Syntax_Print.term_to_string t in - let uu___2 = FStar_Syntax_Print.tag_of_term t in - FStar_Compiler_Util.print2 - "WPE> is_applied_maybe_squashed %s -- %s\n" uu___1 uu___2) - else (); - (let uu___1 = FStar_Syntax_Util.is_squash t in - match uu___1 with - | FStar_Pervasives_Native.Some (uu___2, t') -> is_applied bs t' - | uu___2 -> - let uu___3 = FStar_Syntax_Util.is_auto_squash t in - (match uu___3 with - | FStar_Pervasives_Native.Some (uu___4, t') -> is_applied bs t' - | uu___4 -> is_applied bs t)) in - let is_const_match phi = - let uu___ = - let uu___1 = FStar_Syntax_Subst.compress phi in - uu___1.FStar_Syntax_Syntax.n in - match uu___ with - | FStar_Syntax_Syntax.Tm_match - { FStar_Syntax_Syntax.scrutinee = uu___1; - FStar_Syntax_Syntax.ret_opt = uu___2; - FStar_Syntax_Syntax.brs = br::brs; - FStar_Syntax_Syntax.rc_opt1 = uu___3;_} - -> - let uu___4 = br in - (match uu___4 with - | (uu___5, uu___6, e) -> - let r = - let uu___7 = simp_t e in - match uu___7 with - | FStar_Pervasives_Native.None -> - FStar_Pervasives_Native.None - | FStar_Pervasives_Native.Some b -> - let uu___8 = - FStar_Compiler_List.for_all - (fun uu___9 -> - match uu___9 with - | (uu___10, uu___11, e') -> - let uu___12 = simp_t e' in - uu___12 = (FStar_Pervasives_Native.Some b)) - brs in - if uu___8 - then FStar_Pervasives_Native.Some b - else FStar_Pervasives_Native.None in - r) - | uu___1 -> FStar_Pervasives_Native.None in - let maybe_auto_squash t = - let uu___ = FStar_Syntax_Util.is_sub_singleton t in - if uu___ - then t - else FStar_Syntax_Util.mk_auto_squash FStar_Syntax_Syntax.U_zero t in - let squashed_head_un_auto_squash_args t = - let maybe_un_auto_squash_arg uu___ = - match uu___ with - | (t1, q) -> - let uu___1 = FStar_Syntax_Util.is_auto_squash t1 in - (match uu___1 with - | FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.U_zero, t2) -> (t2, q) - | uu___2 -> (t1, q)) in - let uu___ = FStar_Syntax_Util.head_and_args t in - match uu___ with - | (head, args) -> - let args1 = FStar_Compiler_List.map maybe_un_auto_squash_arg args in - FStar_Syntax_Syntax.mk_Tm_app head args1 - t.FStar_Syntax_Syntax.pos in - let rec clearly_inhabited ty = - let uu___ = - let uu___1 = FStar_Syntax_Util.unmeta ty in - uu___1.FStar_Syntax_Syntax.n in - match uu___ with - | FStar_Syntax_Syntax.Tm_uinst (t, uu___1) -> clearly_inhabited t - | FStar_Syntax_Syntax.Tm_arrow - { FStar_Syntax_Syntax.bs1 = uu___1; - FStar_Syntax_Syntax.comp = c;_} - -> clearly_inhabited (FStar_Syntax_Util.comp_result c) - | FStar_Syntax_Syntax.Tm_fvar fv -> - let l = FStar_Syntax_Syntax.lid_of_fv fv in - (((FStar_Ident.lid_equals l FStar_Parser_Const.int_lid) || - (FStar_Ident.lid_equals l FStar_Parser_Const.bool_lid)) - || (FStar_Ident.lid_equals l FStar_Parser_Const.string_lid)) - || (FStar_Ident.lid_equals l FStar_Parser_Const.exn_lid) - | uu___1 -> false in - let simplify1 arg = - let uu___ = simp_t (FStar_Pervasives_Native.fst arg) in (uu___, arg) in - let uu___ = - let uu___1 = FStar_Syntax_Subst.compress tm in - uu___1.FStar_Syntax_Syntax.n in - match uu___ with - | FStar_Syntax_Syntax.Tm_app - { - FStar_Syntax_Syntax.hd = - { - FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_uinst - ({ FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar fv; - FStar_Syntax_Syntax.pos = uu___1; - FStar_Syntax_Syntax.vars = uu___2; - FStar_Syntax_Syntax.hash_code = uu___3;_}, - uu___4); - FStar_Syntax_Syntax.pos = uu___5; - FStar_Syntax_Syntax.vars = uu___6; - FStar_Syntax_Syntax.hash_code = uu___7;_}; - FStar_Syntax_Syntax.args = args;_} - -> - let uu___8 = - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.and_lid in - if uu___8 - then - let uu___9 = FStar_Compiler_List.map simplify1 args in - (match uu___9 with - | (FStar_Pervasives_Native.Some (true), uu___10)::(uu___11, - (arg, - uu___12))::[] - -> maybe_auto_squash arg - | (uu___10, (arg, uu___11))::(FStar_Pervasives_Native.Some - (true), uu___12)::[] - -> maybe_auto_squash arg - | (FStar_Pervasives_Native.Some (false), uu___10)::uu___11::[] - -> w FStar_Syntax_Util.t_false - | uu___10::(FStar_Pervasives_Native.Some (false), uu___11)::[] - -> w FStar_Syntax_Util.t_false - | uu___10 -> squashed_head_un_auto_squash_args tm) - else - (let uu___10 = - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.or_lid in - if uu___10 - then - let uu___11 = FStar_Compiler_List.map simplify1 args in - match uu___11 with - | (FStar_Pervasives_Native.Some (true), uu___12)::uu___13::[] - -> w FStar_Syntax_Util.t_true - | uu___12::(FStar_Pervasives_Native.Some (true), uu___13)::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (false), uu___12)::(uu___13, - (arg, - uu___14))::[] - -> maybe_auto_squash arg - | (uu___12, (arg, uu___13))::(FStar_Pervasives_Native.Some - (false), uu___14)::[] - -> maybe_auto_squash arg - | uu___12 -> squashed_head_un_auto_squash_args tm - else - (let uu___12 = - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.imp_lid in - if uu___12 - then - let uu___13 = FStar_Compiler_List.map simplify1 args in - match uu___13 with - | uu___14::(FStar_Pervasives_Native.Some (true), uu___15)::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (false), uu___14)::uu___15::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (true), uu___14)::(uu___15, - (arg, - uu___16))::[] - -> maybe_auto_squash arg - | (uu___14, (p, uu___15))::(uu___16, (q, uu___17))::[] -> - let uu___18 = FStar_Syntax_Util.term_eq p q in - (if uu___18 - then w FStar_Syntax_Util.t_true - else squashed_head_un_auto_squash_args tm) - | uu___14 -> squashed_head_un_auto_squash_args tm - else - (let uu___14 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.iff_lid in - if uu___14 - then - let uu___15 = FStar_Compiler_List.map simplify1 args in - match uu___15 with - | (FStar_Pervasives_Native.Some (true), uu___16):: - (FStar_Pervasives_Native.Some (true), uu___17)::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (false), uu___16):: - (FStar_Pervasives_Native.Some (false), uu___17)::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (true), uu___16):: - (FStar_Pervasives_Native.Some (false), uu___17)::[] - -> w FStar_Syntax_Util.t_false - | (FStar_Pervasives_Native.Some (false), uu___16):: - (FStar_Pervasives_Native.Some (true), uu___17)::[] - -> w FStar_Syntax_Util.t_false - | (uu___16, (arg, uu___17))::(FStar_Pervasives_Native.Some - (true), uu___18)::[] - -> maybe_auto_squash arg - | (FStar_Pervasives_Native.Some (true), uu___16):: - (uu___17, (arg, uu___18))::[] -> - maybe_auto_squash arg - | (uu___16, (arg, uu___17))::(FStar_Pervasives_Native.Some - (false), uu___18)::[] - -> - let uu___19 = FStar_Syntax_Util.mk_neg arg in - maybe_auto_squash uu___19 - | (FStar_Pervasives_Native.Some (false), uu___16):: - (uu___17, (arg, uu___18))::[] -> - let uu___19 = FStar_Syntax_Util.mk_neg arg in - maybe_auto_squash uu___19 - | (uu___16, (p, uu___17))::(uu___18, (q, uu___19))::[] - -> - let uu___20 = FStar_Syntax_Util.term_eq p q in - (if uu___20 - then w FStar_Syntax_Util.t_true - else squashed_head_un_auto_squash_args tm) - | uu___16 -> squashed_head_un_auto_squash_args tm - else - (let uu___16 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.not_lid in - if uu___16 - then - let uu___17 = FStar_Compiler_List.map simplify1 args in - match uu___17 with - | (FStar_Pervasives_Native.Some (true), uu___18)::[] - -> w FStar_Syntax_Util.t_false - | (FStar_Pervasives_Native.Some (false), uu___18)::[] - -> w FStar_Syntax_Util.t_true - | uu___18 -> squashed_head_un_auto_squash_args tm - else - (let uu___18 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.forall_lid in - if uu___18 - then - match args with - | (t, uu___19)::[] -> - let uu___20 = - let uu___21 = FStar_Syntax_Subst.compress t in - uu___21.FStar_Syntax_Syntax.n in - (match uu___20 with - | FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = uu___21::[]; - FStar_Syntax_Syntax.body = body; - FStar_Syntax_Syntax.rc_opt = uu___22;_} - -> - let uu___23 = simp_t body in - (match uu___23 with - | FStar_Pervasives_Native.Some (true) -> - w FStar_Syntax_Util.t_true - | uu___24 -> tm) - | uu___21 -> tm) - | (ty, FStar_Pervasives_Native.Some - { FStar_Syntax_Syntax.aqual_implicit = true; - FStar_Syntax_Syntax.aqual_attributes = - uu___19;_})::(t, uu___20)::[] - -> - let uu___21 = - let uu___22 = FStar_Syntax_Subst.compress t in - uu___22.FStar_Syntax_Syntax.n in - (match uu___21 with - | FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = uu___22::[]; - FStar_Syntax_Syntax.body = body; - FStar_Syntax_Syntax.rc_opt = uu___23;_} - -> - let uu___24 = simp_t body in - (match uu___24 with - | FStar_Pervasives_Native.Some (true) -> - w FStar_Syntax_Util.t_true - | FStar_Pervasives_Native.Some (false) - when clearly_inhabited ty -> - w FStar_Syntax_Util.t_false - | uu___25 -> tm) - | uu___22 -> tm) - | uu___19 -> tm - else - (let uu___20 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.exists_lid in - if uu___20 - then - match args with - | (t, uu___21)::[] -> - let uu___22 = - let uu___23 = - FStar_Syntax_Subst.compress t in - uu___23.FStar_Syntax_Syntax.n in - (match uu___22 with - | FStar_Syntax_Syntax.Tm_abs - { - FStar_Syntax_Syntax.bs = uu___23::[]; - FStar_Syntax_Syntax.body = body; - FStar_Syntax_Syntax.rc_opt = uu___24;_} - -> - let uu___25 = simp_t body in - (match uu___25 with - | FStar_Pervasives_Native.Some - (false) -> - w FStar_Syntax_Util.t_false - | uu___26 -> tm) - | uu___23 -> tm) - | (ty, FStar_Pervasives_Native.Some - { FStar_Syntax_Syntax.aqual_implicit = true; - FStar_Syntax_Syntax.aqual_attributes = - uu___21;_})::(t, uu___22)::[] - -> - let uu___23 = - let uu___24 = - FStar_Syntax_Subst.compress t in - uu___24.FStar_Syntax_Syntax.n in - (match uu___23 with - | FStar_Syntax_Syntax.Tm_abs - { - FStar_Syntax_Syntax.bs = uu___24::[]; - FStar_Syntax_Syntax.body = body; - FStar_Syntax_Syntax.rc_opt = uu___25;_} - -> - let uu___26 = simp_t body in - (match uu___26 with - | FStar_Pervasives_Native.Some - (false) -> - w FStar_Syntax_Util.t_false - | FStar_Pervasives_Native.Some (true) - when clearly_inhabited ty -> - w FStar_Syntax_Util.t_true - | uu___27 -> tm) - | uu___24 -> tm) - | uu___21 -> tm - else - (let uu___22 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.b2t_lid in - if uu___22 - then - match args with - | ({ - FStar_Syntax_Syntax.n = - FStar_Syntax_Syntax.Tm_constant - (FStar_Const.Const_bool (true)); - FStar_Syntax_Syntax.pos = uu___23; - FStar_Syntax_Syntax.vars = uu___24; - FStar_Syntax_Syntax.hash_code = uu___25;_}, - uu___26)::[] -> - w FStar_Syntax_Util.t_true - | ({ - FStar_Syntax_Syntax.n = - FStar_Syntax_Syntax.Tm_constant - (FStar_Const.Const_bool (false)); - FStar_Syntax_Syntax.pos = uu___23; - FStar_Syntax_Syntax.vars = uu___24; - FStar_Syntax_Syntax.hash_code = uu___25;_}, - uu___26)::[] -> - w FStar_Syntax_Util.t_false - | uu___23 -> tm - else - (let uu___24 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.haseq_lid in - if uu___24 - then - let t_has_eq_for_sure t = - let haseq_lids = - [FStar_Parser_Const.int_lid; - FStar_Parser_Const.bool_lid; - FStar_Parser_Const.unit_lid; - FStar_Parser_Const.string_lid] in - let uu___25 = - let uu___26 = - FStar_Syntax_Subst.compress t in - uu___26.FStar_Syntax_Syntax.n in - match uu___25 with - | FStar_Syntax_Syntax.Tm_fvar fv1 when - FStar_Compiler_List.existsb - (fun l -> - FStar_Syntax_Syntax.fv_eq_lid - fv1 l) haseq_lids - -> true - | uu___26 -> false in - (if - (FStar_Compiler_List.length args) = - Prims.int_one - then - let t = - let uu___25 = - FStar_Compiler_List.hd args in - FStar_Pervasives_Native.fst uu___25 in - let uu___25 = t_has_eq_for_sure t in - (if uu___25 - then w FStar_Syntax_Util.t_true - else - (let uu___27 = - let uu___28 = - FStar_Syntax_Subst.compress t in - uu___28.FStar_Syntax_Syntax.n in - match uu___27 with - | FStar_Syntax_Syntax.Tm_refine - uu___28 -> - let t1 = - FStar_Syntax_Util.unrefine t in - let uu___29 = - t_has_eq_for_sure t1 in - if uu___29 - then - w FStar_Syntax_Util.t_true - else - (let haseq_tm = - let uu___31 = - let uu___32 = - FStar_Syntax_Subst.compress - tm in - uu___32.FStar_Syntax_Syntax.n in - match uu___31 with - | FStar_Syntax_Syntax.Tm_app - { - FStar_Syntax_Syntax.hd - = hd; - FStar_Syntax_Syntax.args - = uu___32;_} - -> hd - | uu___32 -> - FStar_Compiler_Effect.failwith - "Impossible! We have already checked that this is a Tm_app" in - let uu___31 = - let uu___32 = - FStar_Syntax_Syntax.as_arg - t1 in - [uu___32] in - FStar_Syntax_Util.mk_app - haseq_tm uu___31) - | uu___28 -> tm)) - else tm) - else - (let uu___26 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.eq2_lid in - if uu___26 - then - match args with - | (_typ, uu___27)::(a1, uu___28):: - (a2, uu___29)::[] -> - let uu___30 = - FStar_Syntax_Util.eq_tm a1 a2 in - (match uu___30 with - | FStar_Syntax_Util.Equal -> - w FStar_Syntax_Util.t_true - | FStar_Syntax_Util.NotEqual -> - w FStar_Syntax_Util.t_false - | uu___31 -> tm) - | uu___27 -> tm - else - (let uu___28 = - FStar_Syntax_Util.is_auto_squash tm in - match uu___28 with - | FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.U_zero, t) - when - FStar_Syntax_Util.is_sub_singleton - t - -> t - | uu___29 -> tm)))))))))) - | FStar_Syntax_Syntax.Tm_app - { - FStar_Syntax_Syntax.hd = - { FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar fv; - FStar_Syntax_Syntax.pos = uu___1; - FStar_Syntax_Syntax.vars = uu___2; - FStar_Syntax_Syntax.hash_code = uu___3;_}; - FStar_Syntax_Syntax.args = args;_} - -> - let uu___4 = - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.and_lid in - if uu___4 - then - let uu___5 = FStar_Compiler_List.map simplify1 args in - (match uu___5 with - | (FStar_Pervasives_Native.Some (true), uu___6)::(uu___7, - (arg, uu___8))::[] - -> maybe_auto_squash arg - | (uu___6, (arg, uu___7))::(FStar_Pervasives_Native.Some (true), - uu___8)::[] - -> maybe_auto_squash arg - | (FStar_Pervasives_Native.Some (false), uu___6)::uu___7::[] -> - w FStar_Syntax_Util.t_false - | uu___6::(FStar_Pervasives_Native.Some (false), uu___7)::[] -> - w FStar_Syntax_Util.t_false - | uu___6 -> squashed_head_un_auto_squash_args tm) - else - (let uu___6 = - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.or_lid in - if uu___6 - then - let uu___7 = FStar_Compiler_List.map simplify1 args in - match uu___7 with - | (FStar_Pervasives_Native.Some (true), uu___8)::uu___9::[] -> - w FStar_Syntax_Util.t_true - | uu___8::(FStar_Pervasives_Native.Some (true), uu___9)::[] -> - w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (false), uu___8)::(uu___9, - (arg, - uu___10))::[] - -> maybe_auto_squash arg - | (uu___8, (arg, uu___9))::(FStar_Pervasives_Native.Some - (false), uu___10)::[] - -> maybe_auto_squash arg - | uu___8 -> squashed_head_un_auto_squash_args tm - else - (let uu___8 = - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.imp_lid in - if uu___8 - then - let uu___9 = FStar_Compiler_List.map simplify1 args in - match uu___9 with - | uu___10::(FStar_Pervasives_Native.Some (true), uu___11)::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (false), uu___10)::uu___11::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (true), uu___10)::(uu___11, - (arg, - uu___12))::[] - -> maybe_auto_squash arg - | (uu___10, (p, uu___11))::(uu___12, (q, uu___13))::[] -> - let uu___14 = FStar_Syntax_Util.term_eq p q in - (if uu___14 - then w FStar_Syntax_Util.t_true - else squashed_head_un_auto_squash_args tm) - | uu___10 -> squashed_head_un_auto_squash_args tm - else - (let uu___10 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.iff_lid in - if uu___10 - then - let uu___11 = FStar_Compiler_List.map simplify1 args in - match uu___11 with - | (FStar_Pervasives_Native.Some (true), uu___12):: - (FStar_Pervasives_Native.Some (true), uu___13)::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (false), uu___12):: - (FStar_Pervasives_Native.Some (false), uu___13)::[] - -> w FStar_Syntax_Util.t_true - | (FStar_Pervasives_Native.Some (true), uu___12):: - (FStar_Pervasives_Native.Some (false), uu___13)::[] - -> w FStar_Syntax_Util.t_false - | (FStar_Pervasives_Native.Some (false), uu___12):: - (FStar_Pervasives_Native.Some (true), uu___13)::[] - -> w FStar_Syntax_Util.t_false - | (uu___12, (arg, uu___13))::(FStar_Pervasives_Native.Some - (true), uu___14)::[] - -> maybe_auto_squash arg - | (FStar_Pervasives_Native.Some (true), uu___12):: - (uu___13, (arg, uu___14))::[] -> - maybe_auto_squash arg - | (uu___12, (arg, uu___13))::(FStar_Pervasives_Native.Some - (false), uu___14)::[] - -> - let uu___15 = FStar_Syntax_Util.mk_neg arg in - maybe_auto_squash uu___15 - | (FStar_Pervasives_Native.Some (false), uu___12):: - (uu___13, (arg, uu___14))::[] -> - let uu___15 = FStar_Syntax_Util.mk_neg arg in - maybe_auto_squash uu___15 - | (uu___12, (p, uu___13))::(uu___14, (q, uu___15))::[] - -> - let uu___16 = FStar_Syntax_Util.term_eq p q in - (if uu___16 - then w FStar_Syntax_Util.t_true - else squashed_head_un_auto_squash_args tm) - | uu___12 -> squashed_head_un_auto_squash_args tm - else - (let uu___12 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.not_lid in - if uu___12 - then - let uu___13 = FStar_Compiler_List.map simplify1 args in - match uu___13 with - | (FStar_Pervasives_Native.Some (true), uu___14)::[] - -> w FStar_Syntax_Util.t_false - | (FStar_Pervasives_Native.Some (false), uu___14)::[] - -> w FStar_Syntax_Util.t_true - | uu___14 -> squashed_head_un_auto_squash_args tm - else - (let uu___14 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.forall_lid in - if uu___14 - then - match args with - | (t, uu___15)::[] -> - let uu___16 = - let uu___17 = FStar_Syntax_Subst.compress t in - uu___17.FStar_Syntax_Syntax.n in - (match uu___16 with - | FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = uu___17::[]; - FStar_Syntax_Syntax.body = body; - FStar_Syntax_Syntax.rc_opt = uu___18;_} - -> - let uu___19 = simp_t body in - (match uu___19 with - | FStar_Pervasives_Native.Some (true) -> - w FStar_Syntax_Util.t_true - | uu___20 -> tm) - | uu___17 -> tm) - | (ty, FStar_Pervasives_Native.Some - { FStar_Syntax_Syntax.aqual_implicit = true; - FStar_Syntax_Syntax.aqual_attributes = - uu___15;_})::(t, uu___16)::[] - -> - let uu___17 = - let uu___18 = FStar_Syntax_Subst.compress t in - uu___18.FStar_Syntax_Syntax.n in - (match uu___17 with - | FStar_Syntax_Syntax.Tm_abs - { FStar_Syntax_Syntax.bs = uu___18::[]; - FStar_Syntax_Syntax.body = body; - FStar_Syntax_Syntax.rc_opt = uu___19;_} - -> - let uu___20 = simp_t body in - (match uu___20 with - | FStar_Pervasives_Native.Some (true) -> - w FStar_Syntax_Util.t_true - | FStar_Pervasives_Native.Some (false) - when clearly_inhabited ty -> - w FStar_Syntax_Util.t_false - | uu___21 -> tm) - | uu___18 -> tm) - | uu___15 -> tm - else - (let uu___16 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.exists_lid in - if uu___16 - then - match args with - | (t, uu___17)::[] -> - let uu___18 = - let uu___19 = - FStar_Syntax_Subst.compress t in - uu___19.FStar_Syntax_Syntax.n in - (match uu___18 with - | FStar_Syntax_Syntax.Tm_abs - { - FStar_Syntax_Syntax.bs = uu___19::[]; - FStar_Syntax_Syntax.body = body; - FStar_Syntax_Syntax.rc_opt = uu___20;_} - -> - let uu___21 = simp_t body in - (match uu___21 with - | FStar_Pervasives_Native.Some - (false) -> - w FStar_Syntax_Util.t_false - | uu___22 -> tm) - | uu___19 -> tm) - | (ty, FStar_Pervasives_Native.Some - { FStar_Syntax_Syntax.aqual_implicit = true; - FStar_Syntax_Syntax.aqual_attributes = - uu___17;_})::(t, uu___18)::[] - -> - let uu___19 = - let uu___20 = - FStar_Syntax_Subst.compress t in - uu___20.FStar_Syntax_Syntax.n in - (match uu___19 with - | FStar_Syntax_Syntax.Tm_abs - { - FStar_Syntax_Syntax.bs = uu___20::[]; - FStar_Syntax_Syntax.body = body; - FStar_Syntax_Syntax.rc_opt = uu___21;_} - -> - let uu___22 = simp_t body in - (match uu___22 with - | FStar_Pervasives_Native.Some - (false) -> - w FStar_Syntax_Util.t_false - | FStar_Pervasives_Native.Some (true) - when clearly_inhabited ty -> - w FStar_Syntax_Util.t_true - | uu___23 -> tm) - | uu___20 -> tm) - | uu___17 -> tm - else - (let uu___18 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.b2t_lid in - if uu___18 - then - match args with - | ({ - FStar_Syntax_Syntax.n = - FStar_Syntax_Syntax.Tm_constant - (FStar_Const.Const_bool (true)); - FStar_Syntax_Syntax.pos = uu___19; - FStar_Syntax_Syntax.vars = uu___20; - FStar_Syntax_Syntax.hash_code = uu___21;_}, - uu___22)::[] -> - w FStar_Syntax_Util.t_true - | ({ - FStar_Syntax_Syntax.n = - FStar_Syntax_Syntax.Tm_constant - (FStar_Const.Const_bool (false)); - FStar_Syntax_Syntax.pos = uu___19; - FStar_Syntax_Syntax.vars = uu___20; - FStar_Syntax_Syntax.hash_code = uu___21;_}, - uu___22)::[] -> - w FStar_Syntax_Util.t_false - | uu___19 -> tm - else - (let uu___20 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.haseq_lid in - if uu___20 - then - let t_has_eq_for_sure t = - let haseq_lids = - [FStar_Parser_Const.int_lid; - FStar_Parser_Const.bool_lid; - FStar_Parser_Const.unit_lid; - FStar_Parser_Const.string_lid] in - let uu___21 = - let uu___22 = - FStar_Syntax_Subst.compress t in - uu___22.FStar_Syntax_Syntax.n in - match uu___21 with - | FStar_Syntax_Syntax.Tm_fvar fv1 when - FStar_Compiler_List.existsb - (fun l -> - FStar_Syntax_Syntax.fv_eq_lid - fv1 l) haseq_lids - -> true - | uu___22 -> false in - (if - (FStar_Compiler_List.length args) = - Prims.int_one - then - let t = - let uu___21 = - FStar_Compiler_List.hd args in - FStar_Pervasives_Native.fst uu___21 in - let uu___21 = t_has_eq_for_sure t in - (if uu___21 - then w FStar_Syntax_Util.t_true - else - (let uu___23 = - let uu___24 = - FStar_Syntax_Subst.compress t in - uu___24.FStar_Syntax_Syntax.n in - match uu___23 with - | FStar_Syntax_Syntax.Tm_refine - uu___24 -> - let t1 = - FStar_Syntax_Util.unrefine t in - let uu___25 = - t_has_eq_for_sure t1 in - if uu___25 - then - w FStar_Syntax_Util.t_true - else - (let haseq_tm = - let uu___27 = - let uu___28 = - FStar_Syntax_Subst.compress - tm in - uu___28.FStar_Syntax_Syntax.n in - match uu___27 with - | FStar_Syntax_Syntax.Tm_app - { - FStar_Syntax_Syntax.hd - = hd; - FStar_Syntax_Syntax.args - = uu___28;_} - -> hd - | uu___28 -> - FStar_Compiler_Effect.failwith - "Impossible! We have already checked that this is a Tm_app" in - let uu___27 = - let uu___28 = - FStar_Syntax_Syntax.as_arg - t1 in - [uu___28] in - FStar_Syntax_Util.mk_app - haseq_tm uu___27) - | uu___24 -> tm)) - else tm) - else - (let uu___22 = - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.eq2_lid in - if uu___22 - then - match args with - | (_typ, uu___23)::(a1, uu___24):: - (a2, uu___25)::[] -> - let uu___26 = - FStar_Syntax_Util.eq_tm a1 a2 in - (match uu___26 with - | FStar_Syntax_Util.Equal -> - w FStar_Syntax_Util.t_true - | FStar_Syntax_Util.NotEqual -> - w FStar_Syntax_Util.t_false - | uu___27 -> tm) - | uu___23 -> tm - else - (let uu___24 = - FStar_Syntax_Util.is_auto_squash tm in - match uu___24 with - | FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.U_zero, t) - when - FStar_Syntax_Util.is_sub_singleton - t - -> t - | uu___25 -> tm)))))))))) - | FStar_Syntax_Syntax.Tm_refine - { FStar_Syntax_Syntax.b = bv; FStar_Syntax_Syntax.phi = t;_} -> - let uu___1 = simp_t t in - (match uu___1 with - | FStar_Pervasives_Native.Some (true) -> - bv.FStar_Syntax_Syntax.sort - | FStar_Pervasives_Native.Some (false) -> tm - | FStar_Pervasives_Native.None -> tm) - | FStar_Syntax_Syntax.Tm_match uu___1 -> - let uu___2 = is_const_match tm in - (match uu___2 with - | FStar_Pervasives_Native.Some (true) -> - w FStar_Syntax_Util.t_true - | FStar_Pervasives_Native.Some (false) -> - w FStar_Syntax_Util.t_false - | FStar_Pervasives_Native.None -> tm) - | uu___1 -> tm let (check_positivity_qual : Prims.bool -> FStar_Syntax_Syntax.positivity_qualifier FStar_Pervasives_Native.option diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml index bfeaa3b68b4..07dd360e1a8 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Core.ml @@ -6,6 +6,14 @@ let (uu___is_E_Total : tot_or_ghost -> Prims.bool) = fun projectee -> match projectee with | E_Total -> true | uu___ -> false let (uu___is_E_Ghost : tot_or_ghost -> Prims.bool) = fun projectee -> match projectee with | E_Ghost -> true | uu___ -> false +let (dbg : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Core" +let (dbg_Eq : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "CoreEq" +let (dbg_Top : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "CoreTop" +let (dbg_Exit : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "CoreExit" let (goal_ctr : Prims.int FStar_Compiler_Effect.ref) = FStar_Compiler_Util.mk_ref Prims.int_zero let (get_goal_ctr : unit -> Prims.int) = @@ -390,17 +398,24 @@ let (context_term_to_string : context_term -> Prims.string) = type context = { no_guard: Prims.bool ; + unfolding_ok: Prims.bool ; error_context: (Prims.string * context_term FStar_Pervasives_Native.option) Prims.list } let (__proj__Mkcontext__item__no_guard : context -> Prims.bool) = fun projectee -> - match projectee with | { no_guard; error_context;_} -> no_guard + match projectee with + | { no_guard; unfolding_ok; error_context;_} -> no_guard +let (__proj__Mkcontext__item__unfolding_ok : context -> Prims.bool) = + fun projectee -> + match projectee with + | { no_guard; unfolding_ok; error_context;_} -> unfolding_ok let (__proj__Mkcontext__item__error_context : context -> (Prims.string * context_term FStar_Pervasives_Native.option) Prims.list) = fun projectee -> - match projectee with | { no_guard; error_context;_} -> error_context + match projectee with + | { no_guard; unfolding_ok; error_context;_} -> error_context let (showable_context : context FStar_Class_Show.showable) = { FStar_Class_Show.show = @@ -410,15 +425,20 @@ let (showable_context : context FStar_Class_Show.showable) = (FStar_Class_Show.printableshow FStar_Class_Printable.printable_bool) context1.no_guard in let uu___1 = - let uu___2 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) context1.unfolding_ok in + let uu___2 = + let uu___3 = FStar_Compiler_List.map FStar_Pervasives_Native.fst context1.error_context in FStar_Class_Show.show (FStar_Class_Show.show_list (FStar_Class_Show.printableshow - FStar_Class_Printable.printable_string)) uu___2 in - FStar_Compiler_Util.format2 "{no_guard=%s, error_context=%s}" uu___ - uu___1) + FStar_Class_Printable.printable_string)) uu___3 in + FStar_Compiler_Util.format3 + "{no_guard=%s; unfolding_ok=%s; error_context=%s}" uu___ uu___1 + uu___2) } let (print_context : context -> Prims.string) = fun ctx -> @@ -668,6 +688,7 @@ let with_context : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = ((msg, t) :: (ctx.error_context)) } in let uu___ = x () in uu___ ctx1 @@ -698,6 +719,7 @@ let (is_type : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("is_type", (FStar_Pervasives_Native.Some (CtxTerm t))) :: (ctx.error_context)) @@ -865,6 +887,7 @@ let rec (is_arrow : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("is_arrow", FStar_Pervasives_Native.None) :: (ctx.error_context)) } in @@ -1146,7 +1169,13 @@ let strengthen : let no_guard : 'a . 'a result -> 'a result = fun g -> fun ctx -> - let uu___ = g { no_guard = true; error_context = (ctx.error_context) } in + let uu___ = + g + { + no_guard = true; + unfolding_ok = (ctx.unfolding_ok); + error_context = (ctx.error_context) + } in match uu___ with | Success (x, FStar_Pervasives_Native.None) -> Success (x, FStar_Pervasives_Native.None) @@ -1317,8 +1346,11 @@ let (check_no_escape : FStar_Compiler_Util.for_all (fun b -> let uu___1 = - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_bv - b.FStar_Syntax_Syntax.binder_bv xs in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + b.FStar_Syntax_Syntax.binder_bv (Obj.magic xs) in Prims.op_Negation uu___1) bs in if uu___ then fun uu___1 -> Success ((), FStar_Pervasives_Native.None) @@ -1571,11 +1603,12 @@ let (join_eff_l : tot_or_ghost Prims.list -> tot_or_ghost) = fun es -> FStar_List_Tot_Base.fold_right join_eff es E_Total let (guard_not_allowed : Prims.bool result) = fun ctx -> Success ((ctx.no_guard), FStar_Pervasives_Native.None) -let (debug : env -> (unit -> unit) -> unit) = +let (unfolding_ok : Prims.bool result) = + fun ctx -> Success ((ctx.unfolding_ok), FStar_Pervasives_Native.None) +let debug : 'uuuuu . 'uuuuu -> (unit -> unit) -> unit = fun g -> fun f -> - let uu___ = - FStar_TypeChecker_Env.debug g.tcenv (FStar_Options.Other "Core") in + let uu___ = FStar_Compiler_Effect.op_Bang dbg in if uu___ then f () else () let (showable_side : side FStar_Class_Show.showable) = { @@ -1640,39 +1673,14 @@ let (maybe_relate_after_unfolding : fun g -> fun t0 -> fun t1 -> - let rec delta_depth_of_head t = - let head = FStar_Syntax_Util.leftmost_head t in - let uu___ = - let uu___1 = FStar_Syntax_Util.un_uinst head in - uu___1.FStar_Syntax_Syntax.n in - match uu___ with - | FStar_Syntax_Syntax.Tm_fvar fv -> - let uu___1 = FStar_TypeChecker_Env.delta_depth_of_fv g fv in - FStar_Pervasives_Native.Some uu___1 - | FStar_Syntax_Syntax.Tm_match - { FStar_Syntax_Syntax.scrutinee = t2; - FStar_Syntax_Syntax.ret_opt = uu___1; - FStar_Syntax_Syntax.brs = uu___2; - FStar_Syntax_Syntax.rc_opt1 = uu___3;_} - -> delta_depth_of_head t2 - | uu___1 -> FStar_Pervasives_Native.None in - let dd0 = delta_depth_of_head t0 in - let dd1 = delta_depth_of_head t1 in - match (dd0, dd1) with - | (FStar_Pervasives_Native.Some uu___, FStar_Pervasives_Native.None) - -> Left - | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.Some uu___) - -> Right - | (FStar_Pervasives_Native.Some dd01, FStar_Pervasives_Native.Some - dd11) -> - if dd01 = dd11 - then Both - else - (let uu___1 = - FStar_TypeChecker_Common.delta_depth_greater_than dd01 dd11 in - if uu___1 then Left else Right) - | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) -> - Neither + let dd0 = FStar_TypeChecker_Env.delta_depth_of_term g t0 in + let dd1 = FStar_TypeChecker_Env.delta_depth_of_term g t1 in + if dd0 = dd1 + then Both + else + (let uu___1 = + FStar_TypeChecker_Common.delta_depth_greater_than dd0 dd1 in + if uu___1 then Left else Right) let rec (check_relation : env -> relation -> @@ -1700,8 +1708,7 @@ let rec (check_relation : fail uu___2 in let rel_to_string rel1 = match rel1 with | EQUALITY -> "=?=" | SUBTYPING uu___ -> "<:?" in - (let uu___1 = - FStar_TypeChecker_Env.debug g.tcenv (FStar_Options.Other "Core") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg in if uu___1 then let uu___2 = FStar_Syntax_Print.tag_of_term t0 in @@ -1793,11 +1800,45 @@ let rec (check_relation : | uu___6 -> FStar_Pervasives_Native.None)) FStar_Pervasives_Native.None "FStar.TypeChecker.Core.maybe_unfold_side" in - let maybe_unfold t01 t11 = - let uu___4 = which_side_to_unfold t01 t11 in - maybe_unfold_side uu___4 t01 t11 in + let maybe_unfold t01 t11 ctx01 = + let uu___4 = unfolding_ok ctx01 in + match uu___4 with + | Success (x1, g11) -> + let uu___5 = + let uu___6 = + if x1 + then + let uu___7 = + let uu___8 = which_side_to_unfold t01 t11 in + maybe_unfold_side uu___8 t01 t11 in + fun uu___8 -> + Success + (uu___7, FStar_Pervasives_Native.None) + else + (fun uu___8 -> + Success + (FStar_Pervasives_Native.None, + FStar_Pervasives_Native.None)) in + uu___6 ctx01 in + (match uu___5 with + | Success (y, g2) -> + let uu___6 = + let uu___7 = and_pre g11 g2 in (y, uu___7) in + Success uu___6 + | err1 -> err1) + | Error err1 -> Error err1 in let emit_guard t01 t11 = - let uu___4 = do_check g t01 in + let uu___4 ctx = + let ctx1 = + { + no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); + error_context = + (("checking lhs while emitting guard", + FStar_Pervasives_Native.None) :: + (ctx.error_context)) + } in + let uu___5 = do_check g t01 in uu___5 ctx1 in fun ctx01 -> let uu___5 = uu___4 ctx01 in match uu___5 with @@ -1842,43 +1883,45 @@ let rec (check_relation : let uu___4 = (equatable g t01) || (equatable g t11) in (if uu___4 then emit_guard t01 t11 else err ()) else err () in - let maybe_unfold_side_and_retry side1 t01 t11 = - let uu___4 = maybe_unfold_side side1 t01 t11 in + let maybe_unfold_side_and_retry side1 t01 t11 ctx01 = + let uu___4 = unfolding_ok ctx01 in match uu___4 with - | FStar_Pervasives_Native.None -> fallback t01 t11 - | FStar_Pervasives_Native.Some (t02, t12) -> - check_relation g rel t02 t12 in + | Success (x1, g11) -> + let uu___5 = + let uu___6 = + if x1 + then + let uu___7 = maybe_unfold_side side1 t01 t11 in + match uu___7 with + | FStar_Pervasives_Native.None -> + fallback t01 t11 + | FStar_Pervasives_Native.Some (t02, t12) -> + check_relation g rel t02 t12 + else fallback t01 t11 in + uu___6 ctx01 in + (match uu___5 with + | Success (y, g2) -> + let uu___6 = + let uu___7 = and_pre g11 g2 in ((), uu___7) in + Success uu___6 + | err1 -> err1) + | Error err1 -> Error err1 in let maybe_unfold_and_retry t01 t11 = let uu___4 = which_side_to_unfold t01 t11 in maybe_unfold_side_and_retry uu___4 t01 t11 in let beta_iota_reduce t = let t2 = FStar_Syntax_Subst.compress t in - match t2.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_app uu___4 -> - let head = FStar_Syntax_Util.leftmost_head t2 in - let uu___5 = - let uu___6 = FStar_Syntax_Subst.compress head in - uu___6.FStar_Syntax_Syntax.n in - (match uu___5 with - | FStar_Syntax_Syntax.Tm_abs uu___6 -> - FStar_TypeChecker_Normalize.normalize - [FStar_TypeChecker_Env.Beta; - FStar_TypeChecker_Env.Iota; - FStar_TypeChecker_Env.Primops] g.tcenv t2 - | uu___6 -> t2) - | FStar_Syntax_Syntax.Tm_let uu___4 -> - FStar_TypeChecker_Normalize.normalize - [FStar_TypeChecker_Env.Beta; - FStar_TypeChecker_Env.Iota; - FStar_TypeChecker_Env.Primops] g.tcenv t2 - | FStar_Syntax_Syntax.Tm_match uu___4 -> - FStar_TypeChecker_Normalize.normalize - [FStar_TypeChecker_Env.Beta; - FStar_TypeChecker_Env.Iota; - FStar_TypeChecker_Env.Primops] g.tcenv t2 + let t3 = + FStar_TypeChecker_Normalize.normalize + [FStar_TypeChecker_Env.HNF; + FStar_TypeChecker_Env.Weak; + FStar_TypeChecker_Env.Beta; + FStar_TypeChecker_Env.Iota; + FStar_TypeChecker_Env.Primops] g.tcenv t2 in + match t3.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_refine uu___4 -> - FStar_Syntax_Util.flatten_refinement t2 - | uu___4 -> t2 in + FStar_Syntax_Util.flatten_refinement t3 + | uu___4 -> t3 in let beta_iota_reduce1 t = FStar_Profiling.profile (fun uu___4 -> beta_iota_reduce t) @@ -1898,6 +1941,7 @@ let rec (check_relation : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("check_relation", (FStar_Pervasives_Native.Some @@ -2177,45 +2221,89 @@ let rec (check_relation : (let uu___8 = maybe_unfold x0.FStar_Syntax_Syntax.sort x1.FStar_Syntax_Syntax.sort in - match uu___8 with - | FStar_Pervasives_Native.None -> - fallback t01 t11 - | FStar_Pervasives_Native.Some (t02, t12) -> - let lhs = - FStar_Syntax_Syntax.mk - (FStar_Syntax_Syntax.Tm_refine - { - FStar_Syntax_Syntax.b = - { - FStar_Syntax_Syntax.ppname = - (x0.FStar_Syntax_Syntax.ppname); - FStar_Syntax_Syntax.index = - (x0.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = - t02 - }; - FStar_Syntax_Syntax.phi = f0 - }) t02.FStar_Syntax_Syntax.pos in - let rhs = - FStar_Syntax_Syntax.mk - (FStar_Syntax_Syntax.Tm_refine - { - FStar_Syntax_Syntax.b = - { - FStar_Syntax_Syntax.ppname = - (x1.FStar_Syntax_Syntax.ppname); - FStar_Syntax_Syntax.index = - (x1.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = - t12 - }; - FStar_Syntax_Syntax.phi = f1 - }) t12.FStar_Syntax_Syntax.pos in - let uu___9 = - FStar_Syntax_Util.flatten_refinement lhs in - let uu___10 = - FStar_Syntax_Util.flatten_refinement rhs in - check_relation1 g rel uu___9 uu___10) + fun ctx01 -> + let uu___9 = uu___8 ctx01 in + match uu___9 with + | Success (x2, g11) -> + let uu___10 = + let uu___11 = + match x2 with + | FStar_Pervasives_Native.None -> + ((let uu___13 = + FStar_Compiler_Effect.op_Bang + dbg in + if uu___13 + then + let uu___14 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term + x0.FStar_Syntax_Syntax.sort in + let uu___15 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term + x1.FStar_Syntax_Syntax.sort in + FStar_Compiler_Util.print2 + "Cannot match ref heads %s and %s\n" + uu___14 uu___15 + else ()); + fallback t01 t11) + | FStar_Pervasives_Native.Some + (t02, t12) -> + let lhs = + FStar_Syntax_Syntax.mk + (FStar_Syntax_Syntax.Tm_refine + { + FStar_Syntax_Syntax.b = + { + FStar_Syntax_Syntax.ppname + = + (x0.FStar_Syntax_Syntax.ppname); + FStar_Syntax_Syntax.index + = + (x0.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort + = t02 + }; + FStar_Syntax_Syntax.phi + = f0 + }) + t02.FStar_Syntax_Syntax.pos in + let rhs = + FStar_Syntax_Syntax.mk + (FStar_Syntax_Syntax.Tm_refine + { + FStar_Syntax_Syntax.b = + { + FStar_Syntax_Syntax.ppname + = + (x1.FStar_Syntax_Syntax.ppname); + FStar_Syntax_Syntax.index + = + (x1.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort + = t12 + }; + FStar_Syntax_Syntax.phi + = f1 + }) + t12.FStar_Syntax_Syntax.pos in + let uu___12 = + FStar_Syntax_Util.flatten_refinement + lhs in + let uu___13 = + FStar_Syntax_Util.flatten_refinement + rhs in + check_relation1 g rel uu___12 + uu___13 in + uu___11 ctx01 in + (match uu___10 with + | Success (y, g2) -> + let uu___11 = + let uu___12 = and_pre g11 g2 in + ((), uu___12) in + Success uu___11 + | err1 -> err1) + | Error err1 -> Error err1) | (FStar_Syntax_Syntax.Tm_refine { FStar_Syntax_Syntax.b = x0; FStar_Syntax_Syntax.phi = f0;_}, @@ -2229,28 +2317,50 @@ let rec (check_relation : else (let uu___9 = maybe_unfold x0.FStar_Syntax_Syntax.sort t11 in - match uu___9 with - | FStar_Pervasives_Native.None -> - fallback t01 t11 - | FStar_Pervasives_Native.Some (t02, t12) -> - let lhs = - FStar_Syntax_Syntax.mk - (FStar_Syntax_Syntax.Tm_refine - { - FStar_Syntax_Syntax.b = - { - FStar_Syntax_Syntax.ppname = - (x0.FStar_Syntax_Syntax.ppname); - FStar_Syntax_Syntax.index = - (x0.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = - t02 - }; - FStar_Syntax_Syntax.phi = f0 - }) t02.FStar_Syntax_Syntax.pos in - let uu___10 = - FStar_Syntax_Util.flatten_refinement lhs in - check_relation1 g rel uu___10 t12) + fun ctx01 -> + let uu___10 = uu___9 ctx01 in + match uu___10 with + | Success (x1, g11) -> + let uu___11 = + let uu___12 = + match x1 with + | FStar_Pervasives_Native.None -> + fallback t01 t11 + | FStar_Pervasives_Native.Some + (t02, t12) -> + let lhs = + FStar_Syntax_Syntax.mk + (FStar_Syntax_Syntax.Tm_refine + { + FStar_Syntax_Syntax.b = + { + FStar_Syntax_Syntax.ppname + = + (x0.FStar_Syntax_Syntax.ppname); + FStar_Syntax_Syntax.index + = + (x0.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort + = t02 + }; + FStar_Syntax_Syntax.phi + = f0 + }) + t02.FStar_Syntax_Syntax.pos in + let uu___13 = + FStar_Syntax_Util.flatten_refinement + lhs in + check_relation1 g rel uu___13 + t12 in + uu___12 ctx01 in + (match uu___11 with + | Success (y, g2) -> + let uu___12 = + let uu___13 = and_pre g11 g2 in + ((), uu___13) in + Success uu___12 + | err1 -> err1) + | Error err1 -> Error err1) | (uu___6, FStar_Syntax_Syntax.Tm_refine { FStar_Syntax_Syntax.b = x1; FStar_Syntax_Syntax.phi = f1;_}) @@ -2411,28 +2521,50 @@ let rec (check_relation : else (let uu___9 = maybe_unfold t01 x1.FStar_Syntax_Syntax.sort in - match uu___9 with - | FStar_Pervasives_Native.None -> - fallback t01 t11 - | FStar_Pervasives_Native.Some (t02, t12) -> - let rhs = - FStar_Syntax_Syntax.mk - (FStar_Syntax_Syntax.Tm_refine - { - FStar_Syntax_Syntax.b = - { - FStar_Syntax_Syntax.ppname = - (x1.FStar_Syntax_Syntax.ppname); - FStar_Syntax_Syntax.index = - (x1.FStar_Syntax_Syntax.index); - FStar_Syntax_Syntax.sort = - t12 - }; - FStar_Syntax_Syntax.phi = f1 - }) t12.FStar_Syntax_Syntax.pos in - let uu___10 = - FStar_Syntax_Util.flatten_refinement rhs in - check_relation1 g rel t02 uu___10) + fun ctx01 -> + let uu___10 = uu___9 ctx01 in + match uu___10 with + | Success (x2, g11) -> + let uu___11 = + let uu___12 = + match x2 with + | FStar_Pervasives_Native.None -> + fallback t01 t11 + | FStar_Pervasives_Native.Some + (t02, t12) -> + let rhs = + FStar_Syntax_Syntax.mk + (FStar_Syntax_Syntax.Tm_refine + { + FStar_Syntax_Syntax.b = + { + FStar_Syntax_Syntax.ppname + = + (x1.FStar_Syntax_Syntax.ppname); + FStar_Syntax_Syntax.index + = + (x1.FStar_Syntax_Syntax.index); + FStar_Syntax_Syntax.sort + = t12 + }; + FStar_Syntax_Syntax.phi + = f1 + }) + t12.FStar_Syntax_Syntax.pos in + let uu___13 = + FStar_Syntax_Util.flatten_refinement + rhs in + check_relation1 g rel t02 + uu___13 in + uu___12 ctx01 in + (match uu___11 with + | Success (y, g2) -> + let uu___12 = + let uu___13 = and_pre g11 g2 in + ((), uu___13) in + Success uu___12 + | err1 -> err1) + | Error err1 -> Error err1) | (FStar_Syntax_Syntax.Tm_uinst uu___6, uu___7) -> let head_matches1 = head_matches t01 t11 in let uu___8 = @@ -3038,6 +3170,7 @@ let rec (check_relation : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("subtype arrow", FStar_Pervasives_Native.None) :: @@ -3183,6 +3316,9 @@ let rec (check_relation : no_guard = (ctx2.no_guard); + unfolding_ok + = + (ctx2.unfolding_ok); error_context = (("check_subcomp", @@ -3314,13 +3450,27 @@ let rec (check_relation : match uu___19 with | Success (x1, g11) -> let uu___20 = - let uu___21 = + let uu___21 ctx = + let ctx1 = + { + no_guard = + (ctx.no_guard); + unfolding_ok = + (ctx.unfolding_ok); + error_context = + (("relate_branch", + FStar_Pervasives_Native.None) + :: + (ctx.error_context)) + } in let uu___22 = - check_relation1 g' - rel body01 - body11 in - with_binders bs0 x1 - uu___22 in + let uu___23 = + check_relation1 + g' rel body01 + body11 in + with_binders bs0 + x1 uu___23 in + uu___22 ctx1 in uu___21 ctx01 in (match uu___20 with | Success (y, g2) -> @@ -3433,8 +3583,9 @@ and (check_relation_comp : match uu___ with | (FStar_Pervasives_Native.None, uu___1) -> let uu___2 = - let uu___3 = FStar_Syntax_Util.eq_comp c0 c1 in - uu___3 = FStar_Syntax_Util.Equal in + let uu___3 = + FStar_TypeChecker_TermEqAndSimplify.eq_comp g.tcenv c0 c1 in + uu___3 = FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___2 then (fun uu___3 -> Success ((), FStar_Pervasives_Native.None)) else @@ -3496,8 +3647,9 @@ and (check_relation_comp : fail uu___10)))) | (uu___1, FStar_Pervasives_Native.None) -> let uu___2 = - let uu___3 = FStar_Syntax_Util.eq_comp c0 c1 in - uu___3 = FStar_Syntax_Util.Equal in + let uu___3 = + FStar_TypeChecker_TermEqAndSimplify.eq_comp g.tcenv c0 c1 in + uu___3 = FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___2 then (fun uu___3 -> Success ((), FStar_Pervasives_Native.None)) else @@ -3587,6 +3739,7 @@ and (check_subtype : let ctx2 = { no_guard = (ctx1.no_guard); + unfolding_ok = (ctx1.unfolding_ok); error_context = (((if ctx.no_guard then "check_subtype(no_guard)" @@ -3660,6 +3813,7 @@ and (check : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = ((msg, (FStar_Pervasives_Native.Some (CtxTerm e))) :: (ctx.error_context)) @@ -3895,6 +4049,7 @@ and (do_check : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("abs binders", FStar_Pervasives_Native.None) :: (ctx.error_context)) @@ -3950,6 +4105,7 @@ and (do_check : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("arrow binders", FStar_Pervasives_Native.None) :: (ctx.error_context)) @@ -3966,6 +4122,7 @@ and (do_check : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("arrow comp", FStar_Pervasives_Native.None) :: @@ -4032,6 +4189,8 @@ and (do_check : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = + (ctx.unfolding_ok); error_context = (("app subtyping", FStar_Pervasives_Native.None) @@ -4054,6 +4213,8 @@ and (do_check : { no_guard = (ctx.no_guard); + unfolding_ok = + (ctx.unfolding_ok); error_context = (("app arg qual", @@ -4204,6 +4365,9 @@ and (do_check : no_guard = (ctx.no_guard); + unfolding_ok + = + (ctx.unfolding_ok); error_context = (("operator arg1", @@ -4325,6 +4489,9 @@ and (do_check : no_guard = (ctx.no_guard); + unfolding_ok + = + (ctx.unfolding_ok); error_context = (("operator arg2", @@ -4544,6 +4711,8 @@ and (do_check : { no_guard = (ctx.no_guard); + unfolding_ok = + (ctx.unfolding_ok); error_context = (("ascription subtyping", FStar_Pervasives_Native.None) @@ -4625,6 +4794,7 @@ and (do_check : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("ascription comp", FStar_Pervasives_Native.None) :: @@ -4638,11 +4808,22 @@ and (do_check : let uu___10 = let uu___11 = let c_e = as_comp g (eff, te) in - let uu___12 = - check_relation_comp g - (SUBTYPING - (FStar_Pervasives_Native.Some e2)) - c_e c in + let uu___12 ctx = + let ctx1 = + { + no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); + error_context = + (("ascription subtyping (comp)", + FStar_Pervasives_Native.None) + :: (ctx.error_context)) + } in + let uu___13 = + check_relation_comp g + (SUBTYPING + (FStar_Pervasives_Native.Some + e2)) c_e c in + uu___13 ctx1 in fun ctx02 -> let uu___13 = uu___12 ctx02 in match uu___13 with @@ -4705,8 +4886,8 @@ and (do_check : (match uu___1 with | (g', x1, body1) -> let uu___2 = - FStar_Ident.lid_equals lb.FStar_Syntax_Syntax.lbeff - FStar_Parser_Const.effect_Tot_lid in + FStar_Syntax_Util.is_pure_or_ghost_effect + lb.FStar_Syntax_Syntax.lbeff in if uu___2 then let uu___3 = @@ -4746,6 +4927,9 @@ and (do_check : no_guard = (ctx.no_guard); + unfolding_ok + = + (ctx.unfolding_ok); error_context = (("let subtyping", @@ -4759,7 +4943,8 @@ and (do_check : g (FStar_Pervasives_Native.Some (lb.FStar_Syntax_Syntax.lbdef)) - tdef ttyp in + tdef + lb.FStar_Syntax_Syntax.lbtyp in uu___17 ctx1 in fun ctx03 -> let uu___17 @@ -4962,6 +5147,7 @@ and (do_check : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("universe_of", (FStar_Pervasives_Native.Some @@ -5044,6 +5230,8 @@ and (do_check : { no_guard = (ctx.no_guard); + unfolding_ok = + (ctx.unfolding_ok); error_context = (("check_pat", FStar_Pervasives_Native.None) @@ -5130,6 +5318,9 @@ and (do_check : no_guard = (ctx.no_guard); + unfolding_ok + = + (ctx.unfolding_ok); error_context = (("branch", @@ -5233,6 +5424,9 @@ and (do_check : no_guard = (ctx.no_guard); + unfolding_ok + = + (ctx.unfolding_ok); error_context = (("check_branch_subtype", @@ -5462,6 +5656,8 @@ and (do_check : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = + (ctx.unfolding_ok); error_context = (("residual type", (FStar_Pervasives_Native.Some @@ -5516,6 +5712,8 @@ and (do_check : { no_guard = (ctx1.no_guard); + unfolding_ok = + (ctx1.unfolding_ok); error_context = (("check_branches", ctx) :: @@ -5598,6 +5796,7 @@ and (do_check : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("universe_of", (FStar_Pervasives_Native.Some @@ -5764,6 +5963,9 @@ and (do_check : no_guard = (ctx.no_guard); + unfolding_ok + = + (ctx.unfolding_ok); error_context = (("check_pat", @@ -5905,11 +6107,31 @@ and (do_check : (FStar_Pervasives_Native.Some b1) in let uu___36 + ctx = + let ctx1 + = + { + no_guard + = + (ctx.no_guard); + unfolding_ok + = + (ctx.unfolding_ok); + error_context + = + (("branch check relation", + FStar_Pervasives_Native.None) + :: + (ctx.error_context)) + } in + let uu___37 = check_relation g'1 rel tbr expect_tbr in + uu___37 + ctx1 in (fun ctx07 -> let uu___37 @@ -6367,6 +6589,7 @@ and (check_comp : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("comp fully applied", FStar_Pervasives_Native.None) :: @@ -6501,10 +6724,22 @@ and (check_pat : let uu___3 = match x with | (uu___4, t_const) -> - let uu___5 = - let uu___6 = unrefine_tsc t_sc in - check_subtype g (FStar_Pervasives_Native.Some e) - t_const uu___6 in + let uu___5 ctx = + let ctx1 = + { + no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); + error_context = + (("check_pat constant", + FStar_Pervasives_Native.None) :: + (ctx.error_context)) + } in + let uu___6 = + let uu___7 = unrefine_tsc t_sc in + check_subtype g + (FStar_Pervasives_Native.Some e) t_const + uu___7 in + uu___6 ctx1 in (fun ctx01 -> let uu___6 = uu___5 ctx01 in match uu___6 with @@ -6544,6 +6779,7 @@ and (check_pat : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("check_pat_binder", FStar_Pervasives_Native.None) :: (ctx.error_context)) @@ -6654,26 +6890,49 @@ and (check_pat : match x1 with | (uu___16, p_t) -> - (fun ctx02 - -> - let uu___17 + let uu___17 + ctx = + let ctx1 + = + { + no_guard + = + (ctx.no_guard); + unfolding_ok + = + (ctx.unfolding_ok); + error_context + = + (("check_pat cons", + FStar_Pervasives_Native.None) + :: + (ctx.error_context)) + } in + let uu___18 = check_subtype g (FStar_Pervasives_Native.Some x) p_t - expected_t + expected_t in + uu___18 + ctx1 in + (fun ctx02 + -> + let uu___18 + = + uu___17 ctx02 in - match uu___17 + match uu___18 with | Success (x2, g12) -> - let uu___18 - = let uu___19 - uu___20 = + = + let uu___20 + uu___21 = Success ((FStar_List_Tot_Base.op_At ss @@ -6681,24 +6940,24 @@ and (check_pat : FStar_Syntax_Syntax.NT (f, x)]), FStar_Pervasives_Native.None) in - uu___19 + uu___20 ctx02 in - (match uu___18 + (match uu___19 with | Success (y, g2) -> - let uu___19 - = let uu___20 = + let uu___21 + = and_pre g12 g2 in (y, - uu___20) in + uu___21) in Success - uu___19 + uu___20 | err -> err) @@ -7429,6 +7688,7 @@ let (check_term_top : let ctx1 = { no_guard = (ctx.no_guard); + unfolding_ok = (ctx.unfolding_ok); error_context = (("top-level subtyping", FStar_Pervasives_Native.None) :: @@ -7500,8 +7760,7 @@ let (check_term_top_gh : fun topt -> fun must_tot -> fun gh -> - (let uu___1 = - FStar_TypeChecker_Env.debug g (FStar_Options.Other "CoreEq") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Eq in if uu___1 then let uu___2 = @@ -7510,10 +7769,8 @@ let (check_term_top_gh : FStar_Compiler_Util.print1 "(%s) Entering core ... \n" uu___2 else ()); (let uu___2 = - (FStar_TypeChecker_Env.debug g (FStar_Options.Other "Core")) - || - (FStar_TypeChecker_Env.debug g - (FStar_Options.Other "CoreTop")) in + (FStar_Compiler_Effect.op_Bang dbg) || + (FStar_Compiler_Effect.op_Bang dbg_Top) in if uu___2 then let uu___3 = @@ -7533,6 +7790,7 @@ let (check_term_top_gh : (let ctx = { no_guard = false; + unfolding_ok = true; error_context = [("Top", FStar_Pervasives_Native.None)] } in let res = @@ -7552,14 +7810,9 @@ let (check_term_top_gh : FStar_TypeChecker_Normalize.normalize simplify_steps g guard0 in ((let uu___5 = - ((FStar_TypeChecker_Env.debug g - (FStar_Options.Other "CoreExit")) - || - (FStar_TypeChecker_Env.debug g - (FStar_Options.Other "Core"))) - || - (FStar_TypeChecker_Env.debug g - (FStar_Options.Other "CoreTop")) in + ((FStar_Compiler_Effect.op_Bang dbg) || + (FStar_Compiler_Effect.op_Bang dbg_Top)) + || (FStar_Compiler_Effect.op_Bang dbg_Exit) in if uu___5 then ((let uu___7 = @@ -7574,8 +7827,11 @@ let (check_term_top_gh : uu___7 uu___8 uu___9); (let guard_names = let uu___7 = FStar_Syntax_Free.names guard1 in - FStar_Compiler_Set.elems - FStar_Syntax_Syntax.ord_bv uu___7 in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic uu___7) in let uu___7 = FStar_Compiler_List.tryFind (fun bv -> @@ -7603,11 +7859,8 @@ let (check_term_top_gh : Success (et, (FStar_Pervasives_Native.Some guard1))) | Success uu___4 -> ((let uu___6 = - (FStar_TypeChecker_Env.debug g - (FStar_Options.Other "Core")) - || - (FStar_TypeChecker_Env.debug g - (FStar_Options.Other "CoreTop")) in + (FStar_Compiler_Effect.op_Bang dbg) || + (FStar_Compiler_Effect.op_Bang dbg_Top) in if uu___6 then let uu___7 = @@ -7619,11 +7872,8 @@ let (check_term_top_gh : res) | Error uu___4 -> ((let uu___6 = - (FStar_TypeChecker_Env.debug g - (FStar_Options.Other "Core")) - || - (FStar_TypeChecker_Env.debug g - (FStar_Options.Other "CoreTop")) in + (FStar_Compiler_Effect.op_Bang dbg) || + (FStar_Compiler_Effect.op_Bang dbg_Top) in if uu___6 then let uu___7 = @@ -7633,8 +7883,7 @@ let (check_term_top_gh : "(%s) Exiting core (failed)\n" uu___7 else ()); res) in - (let uu___5 = - FStar_TypeChecker_Env.debug g (FStar_Options.Other "CoreEq") in + (let uu___5 = FStar_Compiler_Effect.op_Bang dbg_Eq in if uu___5 then (FStar_Syntax_TermHashTable.print_stats table; @@ -7729,80 +7978,97 @@ let (open_binders_in_comp : let uu___ = open_comp_binders g bs c in match uu___ with | (g', bs1, c1) -> ((g'.tcenv), bs1, c1) let (check_term_equality : - FStar_TypeChecker_Env.env -> - FStar_Syntax_Syntax.typ -> - FStar_Syntax_Syntax.typ -> - (FStar_Syntax_Syntax.typ FStar_Pervasives_Native.option, error) - FStar_Pervasives.either) + Prims.bool -> + Prims.bool -> + FStar_TypeChecker_Env.env -> + FStar_Syntax_Syntax.typ -> + FStar_Syntax_Syntax.typ -> + (FStar_Syntax_Syntax.typ FStar_Pervasives_Native.option, + error) FStar_Pervasives.either) = - fun g -> - fun t0 -> - fun t1 -> - let g1 = initial_env g FStar_Pervasives_Native.None in - (let uu___1 = - FStar_TypeChecker_Env.debug g1.tcenv - (FStar_Options.Other "CoreTop") in - if uu___1 - then - let uu___2 = - FStar_Class_Show.show FStar_Syntax_Print.showable_term t0 in - let uu___3 = - FStar_Class_Show.show FStar_Syntax_Print.showable_term t1 in - FStar_Compiler_Util.print2 - "Entering check_term_equality with %s and %s {\n" uu___2 uu___3 - else ()); - (let ctx = - { - no_guard = false; - error_context = [("Eq", FStar_Pervasives_Native.None)] - } in - let r = let uu___1 = check_relation g1 EQUALITY t0 t1 in uu___1 ctx in - (let uu___2 = - FStar_TypeChecker_Env.debug g1.tcenv - (FStar_Options.Other "CoreTop") in - if uu___2 - then - let uu___3 = - FStar_Class_Show.show FStar_Syntax_Print.showable_term t0 in - let uu___4 = - FStar_Class_Show.show FStar_Syntax_Print.showable_term t1 in - let uu___5 = - FStar_Class_Show.show - (showable_result - (FStar_Class_Show.show_tuple2 - (FStar_Class_Show.printableshow - FStar_Class_Printable.printable_unit) - (FStar_Class_Show.show_option - FStar_Syntax_Print.showable_term))) r in - FStar_Compiler_Util.print3 - "} Exiting check_term_equality (%s, %s). Result = %s.\n" uu___3 - uu___4 uu___5 - else ()); - (let r1 = - match r with - | Success (uu___2, g2) -> FStar_Pervasives.Inl g2 - | Error err -> FStar_Pervasives.Inr err in - r1)) + fun guard_ok -> + fun unfolding_ok1 -> + fun g -> + fun t0 -> + fun t1 -> + let g1 = initial_env g FStar_Pervasives_Native.None in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Top in + if uu___1 + then + let uu___2 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term t0 in + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term t1 in + let uu___4 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) guard_ok in + let uu___5 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) unfolding_ok1 in + FStar_Compiler_Util.print4 + "Entering check_term_equality with %s and %s (guard_ok=%s; unfolding_ok=%s) {\n" + uu___2 uu___3 uu___4 uu___5 + else ()); + (let ctx = + { + no_guard = (Prims.op_Negation guard_ok); + unfolding_ok = unfolding_ok1; + error_context = [("Eq", FStar_Pervasives_Native.None)] + } in + let r = + let uu___1 = check_relation g1 EQUALITY t0 t1 in uu___1 ctx in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Top in + if uu___2 + then + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term t0 in + let uu___4 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term t1 in + let uu___5 = + FStar_Class_Show.show + (showable_result + (FStar_Class_Show.show_tuple2 + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_unit) + (FStar_Class_Show.show_option + FStar_Syntax_Print.showable_term))) r in + FStar_Compiler_Util.print3 + "} Exiting check_term_equality (%s, %s). Result = %s.\n" + uu___3 uu___4 uu___5 + else ()); + (let r1 = + match r with + | Success (uu___2, g2) -> FStar_Pervasives.Inl g2 + | Error err -> FStar_Pervasives.Inr err in + r1)) let (check_term_subtyping : - FStar_TypeChecker_Env.env -> - FStar_Syntax_Syntax.typ -> - FStar_Syntax_Syntax.typ -> - (FStar_Syntax_Syntax.typ FStar_Pervasives_Native.option, error) - FStar_Pervasives.either) + Prims.bool -> + Prims.bool -> + FStar_TypeChecker_Env.env -> + FStar_Syntax_Syntax.typ -> + FStar_Syntax_Syntax.typ -> + (FStar_Syntax_Syntax.typ FStar_Pervasives_Native.option, + error) FStar_Pervasives.either) = - fun g -> - fun t0 -> - fun t1 -> - let g1 = initial_env g FStar_Pervasives_Native.None in - let ctx = - { - no_guard = false; - error_context = [("Subtyping", FStar_Pervasives_Native.None)] - } in - let uu___ = - let uu___1 = - check_relation g1 (SUBTYPING FStar_Pervasives_Native.None) t0 t1 in - uu___1 ctx in - match uu___ with - | Success (uu___1, g2) -> FStar_Pervasives.Inl g2 - | Error err -> FStar_Pervasives.Inr err \ No newline at end of file + fun guard_ok -> + fun unfolding_ok1 -> + fun g -> + fun t0 -> + fun t1 -> + let g1 = initial_env g FStar_Pervasives_Native.None in + let ctx = + { + no_guard = (Prims.op_Negation guard_ok); + unfolding_ok = unfolding_ok1; + error_context = [("Subtyping", FStar_Pervasives_Native.None)] + } in + let uu___ = + let uu___1 = + check_relation g1 (SUBTYPING FStar_Pervasives_Native.None) t0 + t1 in + uu___1 ctx in + match uu___ with + | Success (uu___1, g2) -> FStar_Pervasives.Inl g2 + | Error err -> FStar_Pervasives.Inr err \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_DMFF.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_DMFF.ml index b2bd4a6406a..6185862c8ee 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_DMFF.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_DMFF.ml @@ -15,6 +15,8 @@ let (__proj__Mkenv__item__tc_const : env -> FStar_Const.sconst -> FStar_Syntax_Syntax.typ) = fun projectee -> match projectee with | { tcenv; subst; tc_const;_} -> tc_const +let (dbg : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "ED" let (d : Prims.string -> unit) = fun s -> FStar_Compiler_Util.print1 "\027[01;36m%s\027[00m\n" s let (mk_toplevel_definition : @@ -26,8 +28,7 @@ let (mk_toplevel_definition : fun env1 -> fun lident -> fun def -> - (let uu___1 = - FStar_TypeChecker_Env.debug env1 (FStar_Options.Other "ED") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg in if uu___1 then ((let uu___3 = FStar_Ident.string_of_lid lident in d uu___3); @@ -37,8 +38,7 @@ let (mk_toplevel_definition : "Registering top-level definition: %s\n%s\n" uu___3 uu___4)) else ()); (let fv = - let uu___1 = FStar_Syntax_Util.incr_delta_qualifier def in - FStar_Syntax_Syntax.lid_and_dd_as_fv lident uu___1 + FStar_Syntax_Syntax.lid_and_dd_as_fv lident FStar_Pervasives_Native.None in let lbname = FStar_Pervasives.Inr fv in let lb = @@ -102,8 +102,7 @@ let (gen_wps_for_free : FStar_Syntax_Syntax.sort = uu___ } in let d1 s = FStar_Compiler_Util.print1 "\027[01;36m%s\027[00m\n" s in - (let uu___1 = - FStar_TypeChecker_Env.debug env1 (FStar_Options.Other "ED") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg in if uu___1 then (d1 "Elaborating extra WP combinators"; @@ -149,8 +148,7 @@ let (gen_wps_for_free : let gamma = let uu___1 = collect_binders wp_a1 in FStar_Syntax_Util.name_binders uu___1 in - (let uu___2 = - FStar_TypeChecker_Env.debug env1 (FStar_Options.Other "ED") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg in if uu___2 then let uu___3 = @@ -667,8 +665,7 @@ let (gen_wps_for_free : let l_ite = FStar_Syntax_Syntax.fvar_with_dd FStar_Parser_Const.ite_lid - (FStar_Syntax_Syntax.Delta_constant_at_level - (Prims.of_int (2))) FStar_Pervasives_Native.None in + FStar_Pervasives_Native.None in let uu___5 = let uu___6 = let uu___7 = @@ -825,6 +822,7 @@ let (gen_wps_for_free : FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; + FStar_TypeChecker_Env.UnfoldTac; FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant] env2 t in let uu___3 = @@ -1021,6 +1019,7 @@ let (gen_wps_for_free : FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; + FStar_TypeChecker_Env.UnfoldTac; FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant] env2 t in let uu___3 = @@ -1045,8 +1044,6 @@ let (gen_wps_for_free : FStar_TypeChecker_Env.lookup_projector env2 uu___5 i in FStar_Syntax_Syntax.fvar_with_dd uu___4 - (FStar_Syntax_Syntax.Delta_constant_at_level - Prims.int_one) FStar_Pervasives_Native.None in FStar_Syntax_Util.mk_app projector [(tuple, FStar_Pervasives_Native.None)] in @@ -1207,7 +1204,6 @@ let (gen_wps_for_free : let uu___5 = FStar_Syntax_Syntax.lid_and_dd_as_fv FStar_Parser_Const.guard_free - FStar_Syntax_Syntax.delta_constant FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___5 in let pat = @@ -1339,9 +1335,7 @@ let (gen_wps_for_free : let uu___3 = mk_lid "wp_trivial" in register env2 uu___3 wp_trivial in let wp_trivial2 = mk_generic_app wp_trivial1 in - ((let uu___4 = - FStar_TypeChecker_Env.debug env2 - (FStar_Options.Other "ED") in + ((let uu___4 = FStar_Compiler_Effect.op_Bang dbg in if uu___4 then d1 "End Dijkstra monads for free" else ()); (let c = FStar_Syntax_Subst.close binders in let ed_combs = @@ -1616,7 +1610,10 @@ and (star_type' : let debug t2 s = let string_of_set f s1 = let elts = - FStar_Compiler_Set.elems FStar_Syntax_Syntax.ord_bv s1 in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) (Obj.magic s1) in match elts with | [] -> "{}" | x::xs -> @@ -1662,12 +1659,19 @@ and (star_type' : let non_dependent_or_raise s ty1 = let sinter = let uu___4 = FStar_Syntax_Free.names ty1 in - FStar_Compiler_Set.inter - FStar_Syntax_Syntax.ord_bv uu___4 s in + Obj.magic + (FStar_Class_Setlike.inter () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic uu___4) (Obj.magic s)) in let uu___4 = let uu___5 = - FStar_Compiler_Set.is_empty - FStar_Syntax_Syntax.ord_bv sinter in + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic sinter) in Prims.op_Negation uu___5 in if uu___4 then @@ -1679,26 +1683,39 @@ and (star_type' : (match uu___4 with | (binders1, c1) -> let s = + let uu___5 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + ()) in FStar_Compiler_List.fold_left - (fun s1 -> - fun uu___5 -> - match uu___5 with - | { - FStar_Syntax_Syntax.binder_bv = - bv; - FStar_Syntax_Syntax.binder_qual - = uu___6; - FStar_Syntax_Syntax.binder_positivity - = uu___7; - FStar_Syntax_Syntax.binder_attrs - = uu___8;_} - -> - (non_dependent_or_raise s1 - bv.FStar_Syntax_Syntax.sort; - FStar_Compiler_Set.add - FStar_Syntax_Syntax.ord_bv - bv s1)) - FStar_Syntax_Syntax.no_names binders1 in + (fun uu___7 -> + fun uu___6 -> + (fun s1 -> + fun uu___6 -> + match uu___6 with + | { + FStar_Syntax_Syntax.binder_bv + = bv; + FStar_Syntax_Syntax.binder_qual + = uu___7; + FStar_Syntax_Syntax.binder_positivity + = uu___8; + FStar_Syntax_Syntax.binder_attrs + = uu___9;_} + -> + (non_dependent_or_raise s1 + bv.FStar_Syntax_Syntax.sort; + Obj.magic + (FStar_Class_Setlike.add + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + bv (Obj.magic s1)))) + uu___7 uu___6) uu___5 binders1 in let ct = FStar_Syntax_Util.comp_result c1 in (non_dependent_or_raise s ct; (let k = @@ -1750,6 +1767,7 @@ and (star_type' : FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Env.EraseUniverses; FStar_TypeChecker_Env.Inlining; + FStar_TypeChecker_Env.UnfoldTac; FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant] env1.tcenv t1 in @@ -2273,6 +2291,7 @@ and (infer : FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; + FStar_TypeChecker_Env.UnfoldTac; FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; FStar_TypeChecker_Env.EraseUniverses] env1.tcenv in @@ -2477,6 +2496,7 @@ and (infer : FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; + FStar_TypeChecker_Env.UnfoldTac; FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; FStar_TypeChecker_Env.EraseUniverses] @@ -2581,16 +2601,15 @@ and (infer : FStar_Syntax_Syntax.fv_name = { FStar_Syntax_Syntax.v = lid; FStar_Syntax_Syntax.p = uu___1;_}; - FStar_Syntax_Syntax.fv_delta = uu___2; - FStar_Syntax_Syntax.fv_qual = uu___3;_} + FStar_Syntax_Syntax.fv_qual = uu___2;_} -> - let uu___4 = - let uu___5 = FStar_TypeChecker_Env.lookup_lid env1.tcenv lid in - FStar_Pervasives_Native.fst uu___5 in - (match uu___4 with - | (uu___5, t) -> - let uu___6 = let uu___7 = normalize t in N uu___7 in - (uu___6, e, e)) + let uu___3 = + let uu___4 = FStar_TypeChecker_Env.lookup_lid env1.tcenv lid in + FStar_Pervasives_Native.fst uu___4 in + (match uu___3 with + | (uu___4, t) -> + let uu___5 = let uu___6 = normalize t in N uu___6 in + (uu___5, e, e)) | FStar_Syntax_Syntax.Tm_app { FStar_Syntax_Syntax.hd = @@ -3651,7 +3670,7 @@ and (trans_F_ : ((let uu___10 = let uu___11 = FStar_Syntax_Util.eq_aqual q q' in - uu___11 <> FStar_Syntax_Util.Equal in + Prims.op_Negation uu___11 in if uu___10 then let uu___11 = @@ -3833,7 +3852,8 @@ let (n : FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term) = FStar_TypeChecker_Normalize.normalize - [FStar_TypeChecker_Env.Beta; + [FStar_TypeChecker_Env.UnfoldTac; + FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; FStar_TypeChecker_Env.DoNotUnfoldPureLets; FStar_TypeChecker_Env.Eager_unfolding; @@ -3864,8 +3884,7 @@ let (recheck_debug : fun s -> fun env1 -> fun t -> - (let uu___1 = - FStar_TypeChecker_Env.debug env1 (FStar_Options.Other "ED") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg in if uu___1 then let uu___2 = FStar_Syntax_Print.term_to_string t in @@ -3875,8 +3894,7 @@ let (recheck_debug : (let uu___1 = FStar_TypeChecker_TcTerm.tc_term env1 t in match uu___1 with | (t', uu___2, uu___3) -> - ((let uu___5 = - FStar_TypeChecker_Env.debug env1 (FStar_Options.Other "ED") in + ((let uu___5 = FStar_Compiler_Effect.op_Bang dbg in if uu___5 then let uu___6 = FStar_Syntax_Print.term_to_string t' in @@ -3992,8 +4010,7 @@ let (cps_and_elaborate : (match uu___6 with | (repr, _comp) -> ((let uu___8 = - FStar_TypeChecker_Env.debug env2 - (FStar_Options.Other "ED") in + FStar_Compiler_Effect.op_Bang dbg in if uu___8 then let uu___9 = @@ -4433,7 +4450,8 @@ let (cps_and_elaborate : | FStar_Pervasives_Native.Some (_us, _t) -> ((let uu___16 = - FStar_Options.debug_any () in + FStar_Compiler_Debug.any + () in if uu___16 then let uu___17 = @@ -4446,7 +4464,6 @@ let (cps_and_elaborate : (let uu___16 = FStar_Syntax_Syntax.lid_and_dd_as_fv l' - FStar_Syntax_Syntax.delta_equational FStar_Pervasives_Native.None in FStar_Syntax_Syntax.fv_to_tm uu___16)) @@ -4673,10 +4690,8 @@ let (cps_and_elaborate : uu___20 in ((let uu___20 = - FStar_TypeChecker_Env.debug - env2 - (FStar_Options.Other - "ED") in + FStar_Compiler_Effect.op_Bang + dbg in if uu___20 then let uu___21 @@ -4896,10 +4911,14 @@ let (cps_and_elaborate : = FStar_Syntax_Free.names bv.FStar_Syntax_Syntax.sort in - FStar_Compiler_Set.mem - FStar_Syntax_Syntax.ord_bv + FStar_Class_Setlike.mem + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) type_param1.FStar_Syntax_Syntax.binder_bv - uu___28 in + (Obj.magic + uu___28) in Prims.op_Negation uu___27) wp_binders1 in @@ -5120,10 +5139,8 @@ let (cps_and_elaborate : match uu___20 with | (sigelts', ed2) -> ((let uu___22 = - FStar_TypeChecker_Env.debug - env2 - (FStar_Options.Other - "ED") in + FStar_Compiler_Effect.op_Bang + dbg in if uu___22 then let uu___23 = diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_DeferredImplicits.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_DeferredImplicits.ml index 9492a87af31..9f43b534223 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_DeferredImplicits.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_DeferredImplicits.ml @@ -53,89 +53,8 @@ let (uu___is_Imp : goal_type -> Prims.bool) = fun projectee -> match projectee with | Imp _0 -> true | uu___ -> false let (__proj__Imp__item___0 : goal_type -> FStar_Syntax_Syntax.ctx_uvar) = fun projectee -> match projectee with | Imp _0 -> _0 -type goal_dep = - { - goal_dep_id: Prims.int ; - goal_type: goal_type ; - goal_imp: FStar_TypeChecker_Common.implicit ; - assignees: FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_Set.t ; - goal_dep_uvars: FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_Set.t ; - dependences: goal_dep Prims.list FStar_Compiler_Effect.ref ; - visited: Prims.int FStar_Compiler_Effect.ref } -let (__proj__Mkgoal_dep__item__goal_dep_id : goal_dep -> Prims.int) = - fun projectee -> - match projectee with - | { goal_dep_id; goal_type = goal_type1; goal_imp; assignees; - goal_dep_uvars; dependences; visited;_} -> goal_dep_id -let (__proj__Mkgoal_dep__item__goal_type : goal_dep -> goal_type) = - fun projectee -> - match projectee with - | { goal_dep_id; goal_type = goal_type1; goal_imp; assignees; - goal_dep_uvars; dependences; visited;_} -> goal_type1 -let (__proj__Mkgoal_dep__item__goal_imp : - goal_dep -> FStar_TypeChecker_Common.implicit) = - fun projectee -> - match projectee with - | { goal_dep_id; goal_type = goal_type1; goal_imp; assignees; - goal_dep_uvars; dependences; visited;_} -> goal_imp -let (__proj__Mkgoal_dep__item__assignees : - goal_dep -> FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_Set.t) = - fun projectee -> - match projectee with - | { goal_dep_id; goal_type = goal_type1; goal_imp; assignees; - goal_dep_uvars; dependences; visited;_} -> assignees -let (__proj__Mkgoal_dep__item__goal_dep_uvars : - goal_dep -> FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_Set.t) = - fun projectee -> - match projectee with - | { goal_dep_id; goal_type = goal_type1; goal_imp; assignees; - goal_dep_uvars; dependences; visited;_} -> goal_dep_uvars -let (__proj__Mkgoal_dep__item__dependences : - goal_dep -> goal_dep Prims.list FStar_Compiler_Effect.ref) = - fun projectee -> - match projectee with - | { goal_dep_id; goal_type = goal_type1; goal_imp; assignees; - goal_dep_uvars; dependences; visited;_} -> dependences -let (__proj__Mkgoal_dep__item__visited : - goal_dep -> Prims.int FStar_Compiler_Effect.ref) = - fun projectee -> - match projectee with - | { goal_dep_id; goal_type = goal_type1; goal_imp; assignees; - goal_dep_uvars; dependences; visited;_} -> visited -type goal_deps = goal_dep Prims.list -let (print_uvar_set : - FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_Set.t -> Prims.string) = - fun s -> - let uu___ = - let uu___1 = FStar_Compiler_Set.elems FStar_Syntax_Free.ord_ctx_uvar s in - FStar_Compiler_List.map - (fun u -> - let uu___2 = - let uu___3 = - FStar_Syntax_Unionfind.uvar_id - u.FStar_Syntax_Syntax.ctx_uvar_head in - FStar_Compiler_Util.string_of_int uu___3 in - Prims.strcat "?" uu___2) uu___1 in - FStar_Compiler_String.concat "; " uu___ -let (print_goal_dep : goal_dep -> Prims.string) = - fun gd -> - let uu___ = FStar_Compiler_Util.string_of_int gd.goal_dep_id in - let uu___1 = print_uvar_set gd.assignees in - let uu___2 = - let uu___3 = - let uu___4 = FStar_Compiler_Effect.op_Bang gd.dependences in - FStar_Compiler_List.map - (fun gd1 -> FStar_Compiler_Util.string_of_int gd1.goal_dep_id) - uu___4 in - FStar_Compiler_String.concat "; " uu___3 in - let uu___3 = - FStar_Syntax_Print.ctx_uvar_to_string - (gd.goal_imp).FStar_TypeChecker_Common.imp_uvar in - FStar_Compiler_Util.format4 - "%s:{assignees=[%s], dependences=[%s]}\n\t%s\n" uu___ uu___1 uu___2 - uu___3 let (find_user_tac_for_uvar : - FStar_TypeChecker_Env.env -> + FStar_TypeChecker_Env.env_t -> FStar_Syntax_Syntax.ctx_uvar -> FStar_Syntax_Syntax.sigelt FStar_Pervasives_Native.option) = @@ -201,7 +120,8 @@ let (find_user_tac_for_uvar : let candidates = FStar_Compiler_List.filter (fun hook -> - FStar_Compiler_Util.for_some (FStar_Syntax_Util.attr_eq a) + FStar_Compiler_Util.for_some + (FStar_TypeChecker_TermEqAndSimplify.eq_tm_bool env a) hook.FStar_Syntax_Syntax.sigattrs) hooks in let candidates1 = FStar_Compiler_Util.remove_dups @@ -237,7 +157,9 @@ let (find_user_tac_for_uvar : when (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.override_resolve_implicits_handler_lid) - && (FStar_Syntax_Util.attr_eq a a') + && + (FStar_TypeChecker_TermEqAndSimplify.eq_tm_bool + env a a') -> let uu___5 = attr_list_elements overrides in (match uu___5 with @@ -255,7 +177,9 @@ let (find_user_tac_for_uvar : (a', uu___2)::(overrides, uu___3)::[]) when (FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.override_resolve_implicits_handler_lid) - && (FStar_Syntax_Util.attr_eq a a') + && + (FStar_TypeChecker_TermEqAndSimplify.eq_tm_bool + env a a') -> let uu___4 = attr_list_elements overrides in (match uu___4 with @@ -330,13 +254,6 @@ let solve_goals_with_tac : let fv = FStar_Syntax_Syntax.lid_as_fv lid FStar_Pervasives_Native.None in - let dd = - let uu___3 = - FStar_TypeChecker_Env.delta_depth_of_qninfo fv qn in - match uu___3 with - | FStar_Pervasives_Native.Some dd1 -> dd1 - | FStar_Pervasives_Native.None -> - FStar_Compiler_Effect.failwith "Expected a dd" in let term = let uu___3 = FStar_Syntax_Syntax.lid_as_fv lid diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml index 628eeeee569..2030c19eb1e 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Env.ml @@ -131,6 +131,10 @@ let (uu___is_DefaultUnivsToZero : step -> Prims.bool) = fun projectee -> match projectee with | DefaultUnivsToZero -> true | uu___ -> false type steps = step Prims.list +let (dbg_ImplicitTrace : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "ImplicitTrace" +let (dbg_LayeredEffectsEqns : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "LayeredEffectsEqns" let rec (eq_step : step -> step -> Prims.bool) = fun s1 -> fun s2 -> @@ -2406,11 +2410,6 @@ let (incr_query_index : env -> env) = erase_erasable_args = (env1.erase_erasable_args); core_check = (env1.core_check) })) -let (debug : env -> FStar_Options.debug_level_t -> Prims.bool) = - fun env1 -> - fun l -> - let uu___ = FStar_Ident.string_of_lid env1.curmodule in - FStar_Options.debug_at_level uu___ l let (set_range : env -> FStar_Compiler_Range_Type.range -> env) = fun e -> fun r -> @@ -2877,16 +2876,19 @@ let (add_se_to_attrtab : env -> FStar_Syntax_Syntax.sigelt -> unit) = FStar_Compiler_Util.smap_add (attrtab env2) attr uu___ in FStar_Compiler_List.iter (fun attr -> - let uu___ = - let uu___1 = FStar_Syntax_Subst.compress attr in - uu___1.FStar_Syntax_Syntax.n in + let uu___ = FStar_Syntax_Util.head_and_args attr in match uu___ with - | FStar_Syntax_Syntax.Tm_fvar fv -> - let uu___1 = - let uu___2 = FStar_Syntax_Syntax.lid_of_fv fv in - FStar_Ident.string_of_lid uu___2 in - add_one env1 se uu___1 - | uu___1 -> ()) se.FStar_Syntax_Syntax.sigattrs + | (hd, uu___1) -> + let uu___2 = + let uu___3 = FStar_Syntax_Subst.compress hd in + uu___3.FStar_Syntax_Syntax.n in + (match uu___2 with + | FStar_Syntax_Syntax.Tm_fvar fv -> + let uu___3 = + let uu___4 = FStar_Syntax_Syntax.lid_of_fv fv in + FStar_Ident.string_of_lid uu___4 in + add_one env1 se uu___3 + | uu___3 -> ())) se.FStar_Syntax_Syntax.sigattrs let (try_add_sigelt : Prims.bool -> env -> FStar_Syntax_Syntax.sigelt -> FStar_Ident.lident -> unit) @@ -3138,18 +3140,19 @@ let (try_lookup_lid_aux : FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___2; FStar_Syntax_Syntax.num_ty_params = uu___3; - FStar_Syntax_Syntax.mutuals1 = uu___4;_}; - FStar_Syntax_Syntax.sigrng = uu___5; - FStar_Syntax_Syntax.sigquals = uu___6; - FStar_Syntax_Syntax.sigmeta = uu___7; - FStar_Syntax_Syntax.sigattrs = uu___8; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___9; - FStar_Syntax_Syntax.sigopts = uu___10;_}, + FStar_Syntax_Syntax.mutuals1 = uu___4; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_}; + FStar_Syntax_Syntax.sigrng = uu___6; + FStar_Syntax_Syntax.sigquals = uu___7; + FStar_Syntax_Syntax.sigmeta = uu___8; + FStar_Syntax_Syntax.sigattrs = uu___9; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___10; + FStar_Syntax_Syntax.sigopts = uu___11;_}, FStar_Pervasives_Native.None) -> - let uu___11 = - let uu___12 = inst_tscheme1 (uvs, t) in (uu___12, rng) in - FStar_Pervasives_Native.Some uu___11 + let uu___12 = + let uu___13 = inst_tscheme1 (uvs, t) in (uu___13, rng) in + FStar_Pervasives_Native.Some uu___12 | FStar_Pervasives.Inr ({ FStar_Syntax_Syntax.sigel = @@ -3193,32 +3196,33 @@ let (try_lookup_lid_aux : FStar_Syntax_Syntax.num_uniform_params = uu___1; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = uu___2; - FStar_Syntax_Syntax.ds = uu___3;_}; - FStar_Syntax_Syntax.sigrng = uu___4; - FStar_Syntax_Syntax.sigquals = uu___5; - FStar_Syntax_Syntax.sigmeta = uu___6; - FStar_Syntax_Syntax.sigattrs = uu___7; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___8; - FStar_Syntax_Syntax.sigopts = uu___9;_}, + FStar_Syntax_Syntax.ds = uu___3; + FStar_Syntax_Syntax.injective_type_params = uu___4;_}; + FStar_Syntax_Syntax.sigrng = uu___5; + FStar_Syntax_Syntax.sigquals = uu___6; + FStar_Syntax_Syntax.sigmeta = uu___7; + FStar_Syntax_Syntax.sigattrs = uu___8; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___9; + FStar_Syntax_Syntax.sigopts = uu___10;_}, FStar_Pervasives_Native.None) -> (match tps with | [] -> - let uu___10 = - let uu___11 = inst_tscheme1 (uvs, k) in - (uu___11, rng) in - FStar_Pervasives_Native.Some uu___10 - | uu___10 -> let uu___11 = - let uu___12 = - let uu___13 = - let uu___14 = - let uu___15 = FStar_Syntax_Syntax.mk_Total k in - FStar_Syntax_Util.flat_arrow tps uu___15 in - (uvs, uu___14) in - inst_tscheme1 uu___13 in + let uu___12 = inst_tscheme1 (uvs, k) in (uu___12, rng) in - FStar_Pervasives_Native.Some uu___11) + FStar_Pervasives_Native.Some uu___11 + | uu___11 -> + let uu___12 = + let uu___13 = + let uu___14 = + let uu___15 = + let uu___16 = FStar_Syntax_Syntax.mk_Total k in + FStar_Syntax_Util.flat_arrow tps uu___16 in + (uvs, uu___15) in + inst_tscheme1 uu___14 in + (uu___13, rng) in + FStar_Pervasives_Native.Some uu___12) | FStar_Pervasives.Inr ({ FStar_Syntax_Syntax.sigel = @@ -3229,32 +3233,33 @@ let (try_lookup_lid_aux : FStar_Syntax_Syntax.num_uniform_params = uu___1; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = uu___2; - FStar_Syntax_Syntax.ds = uu___3;_}; - FStar_Syntax_Syntax.sigrng = uu___4; - FStar_Syntax_Syntax.sigquals = uu___5; - FStar_Syntax_Syntax.sigmeta = uu___6; - FStar_Syntax_Syntax.sigattrs = uu___7; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___8; - FStar_Syntax_Syntax.sigopts = uu___9;_}, + FStar_Syntax_Syntax.ds = uu___3; + FStar_Syntax_Syntax.injective_type_params = uu___4;_}; + FStar_Syntax_Syntax.sigrng = uu___5; + FStar_Syntax_Syntax.sigquals = uu___6; + FStar_Syntax_Syntax.sigmeta = uu___7; + FStar_Syntax_Syntax.sigattrs = uu___8; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___9; + FStar_Syntax_Syntax.sigopts = uu___10;_}, FStar_Pervasives_Native.Some us) -> (match tps with | [] -> - let uu___10 = - let uu___11 = inst_tscheme_with (uvs, k) us in - (uu___11, rng) in - FStar_Pervasives_Native.Some uu___10 - | uu___10 -> let uu___11 = - let uu___12 = - let uu___13 = - let uu___14 = - let uu___15 = FStar_Syntax_Syntax.mk_Total k in - FStar_Syntax_Util.flat_arrow tps uu___15 in - (uvs, uu___14) in - inst_tscheme_with uu___13 us in + let uu___12 = inst_tscheme_with (uvs, k) us in (uu___12, rng) in - FStar_Pervasives_Native.Some uu___11) + FStar_Pervasives_Native.Some uu___11 + | uu___11 -> + let uu___12 = + let uu___13 = + let uu___14 = + let uu___15 = + let uu___16 = FStar_Syntax_Syntax.mk_Total k in + FStar_Syntax_Util.flat_arrow tps uu___16 in + (uvs, uu___15) in + inst_tscheme_with uu___14 us in + (uu___13, rng) in + FStar_Pervasives_Native.Some uu___12) | FStar_Pervasives.Inr se -> let uu___1 = match se with @@ -3478,18 +3483,19 @@ let (lookup_datacon : FStar_Syntax_Syntax.us1 = uvs; FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___2; FStar_Syntax_Syntax.num_ty_params = uu___3; - FStar_Syntax_Syntax.mutuals1 = uu___4;_}; - FStar_Syntax_Syntax.sigrng = uu___5; - FStar_Syntax_Syntax.sigquals = uu___6; - FStar_Syntax_Syntax.sigmeta = uu___7; - FStar_Syntax_Syntax.sigattrs = uu___8; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___9; - FStar_Syntax_Syntax.sigopts = uu___10;_}, + FStar_Syntax_Syntax.mutuals1 = uu___4; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_}; + FStar_Syntax_Syntax.sigrng = uu___6; + FStar_Syntax_Syntax.sigquals = uu___7; + FStar_Syntax_Syntax.sigmeta = uu___8; + FStar_Syntax_Syntax.sigattrs = uu___9; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___10; + FStar_Syntax_Syntax.sigopts = uu___11;_}, FStar_Pervasives_Native.None), - uu___11) + uu___12) -> - let uu___12 = FStar_Ident.range_of_lid lid in - inst_tscheme_with_range uu___12 (uvs, t) + let uu___13 = FStar_Ident.range_of_lid lid in + inst_tscheme_with_range uu___13 (uvs, t) | uu___1 -> let uu___2 = name_not_found lid in let uu___3 = FStar_Ident.range_of_lid lid in @@ -3513,18 +3519,19 @@ let (lookup_and_inst_datacon : FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___2; FStar_Syntax_Syntax.num_ty_params = uu___3; - FStar_Syntax_Syntax.mutuals1 = uu___4;_}; - FStar_Syntax_Syntax.sigrng = uu___5; - FStar_Syntax_Syntax.sigquals = uu___6; - FStar_Syntax_Syntax.sigmeta = uu___7; - FStar_Syntax_Syntax.sigattrs = uu___8; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___9; - FStar_Syntax_Syntax.sigopts = uu___10;_}, + FStar_Syntax_Syntax.mutuals1 = uu___4; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_}; + FStar_Syntax_Syntax.sigrng = uu___6; + FStar_Syntax_Syntax.sigquals = uu___7; + FStar_Syntax_Syntax.sigmeta = uu___8; + FStar_Syntax_Syntax.sigattrs = uu___9; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___10; + FStar_Syntax_Syntax.sigopts = uu___11;_}, FStar_Pervasives_Native.None), - uu___11) + uu___12) -> - let uu___12 = inst_tscheme_with (uvs, t) us in - FStar_Pervasives_Native.snd uu___12 + let uu___13 = inst_tscheme_with (uvs, t) us in + FStar_Pervasives_Native.snd uu___13 | uu___1 -> let uu___2 = name_not_found lid in let uu___3 = FStar_Ident.range_of_lid lid in @@ -3547,7 +3554,34 @@ let (datacons_of_typ : FStar_Syntax_Syntax.num_uniform_params = uu___4; FStar_Syntax_Syntax.t = uu___5; FStar_Syntax_Syntax.mutuals = uu___6; - FStar_Syntax_Syntax.ds = dcs;_}; + FStar_Syntax_Syntax.ds = dcs; + FStar_Syntax_Syntax.injective_type_params = uu___7;_}; + FStar_Syntax_Syntax.sigrng = uu___8; + FStar_Syntax_Syntax.sigquals = uu___9; + FStar_Syntax_Syntax.sigmeta = uu___10; + FStar_Syntax_Syntax.sigattrs = uu___11; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___12; + FStar_Syntax_Syntax.sigopts = uu___13;_}, + uu___14), + uu___15) + -> (true, dcs) + | uu___1 -> (false, []) +let (typ_of_datacon : env -> FStar_Ident.lident -> FStar_Ident.lident) = + fun env1 -> + fun lid -> + let uu___ = lookup_qname env1 lid in + match uu___ with + | FStar_Pervasives_Native.Some + (FStar_Pervasives.Inr + ({ + FStar_Syntax_Syntax.sigel = FStar_Syntax_Syntax.Sig_datacon + { FStar_Syntax_Syntax.lid1 = uu___1; + FStar_Syntax_Syntax.us1 = uu___2; + FStar_Syntax_Syntax.t1 = uu___3; + FStar_Syntax_Syntax.ty_lid = l; + FStar_Syntax_Syntax.num_ty_params = uu___4; + FStar_Syntax_Syntax.mutuals1 = uu___5; + FStar_Syntax_Syntax.injective_type_params1 = uu___6;_}; FStar_Syntax_Syntax.sigrng = uu___7; FStar_Syntax_Syntax.sigquals = uu___8; FStar_Syntax_Syntax.sigmeta = uu___9; @@ -3556,9 +3590,14 @@ let (datacons_of_typ : FStar_Syntax_Syntax.sigopts = uu___12;_}, uu___13), uu___14) - -> (true, dcs) - | uu___1 -> (false, []) -let (typ_of_datacon : env -> FStar_Ident.lident -> FStar_Ident.lident) = + -> l + | uu___1 -> + let uu___2 = + let uu___3 = FStar_Syntax_Print.lid_to_string lid in + FStar_Compiler_Util.format1 "Not a datacon: %s" uu___3 in + FStar_Compiler_Effect.failwith uu___2 +let (num_datacon_non_injective_ty_params : + env -> FStar_Ident.lident -> Prims.int FStar_Pervasives_Native.option) = fun env1 -> fun lid -> let uu___ = lookup_qname env1 lid in @@ -3570,9 +3609,11 @@ let (typ_of_datacon : env -> FStar_Ident.lident -> FStar_Ident.lident) = { FStar_Syntax_Syntax.lid1 = uu___1; FStar_Syntax_Syntax.us1 = uu___2; FStar_Syntax_Syntax.t1 = uu___3; - FStar_Syntax_Syntax.ty_lid = l; - FStar_Syntax_Syntax.num_ty_params = uu___4; - FStar_Syntax_Syntax.mutuals1 = uu___5;_}; + FStar_Syntax_Syntax.ty_lid = uu___4; + FStar_Syntax_Syntax.num_ty_params = num_ty_params; + FStar_Syntax_Syntax.mutuals1 = uu___5; + FStar_Syntax_Syntax.injective_type_params1 = + injective_type_params;_}; FStar_Syntax_Syntax.sigrng = uu___6; FStar_Syntax_Syntax.sigquals = uu___7; FStar_Syntax_Syntax.sigmeta = uu___8; @@ -3581,12 +3622,11 @@ let (typ_of_datacon : env -> FStar_Ident.lident -> FStar_Ident.lident) = FStar_Syntax_Syntax.sigopts = uu___11;_}, uu___12), uu___13) - -> l - | uu___1 -> - let uu___2 = - let uu___3 = FStar_Syntax_Print.lid_to_string lid in - FStar_Compiler_Util.format1 "Not a datacon: %s" uu___3 in - FStar_Compiler_Effect.failwith uu___2 + -> + if injective_type_params + then FStar_Pervasives_Native.Some Prims.int_zero + else FStar_Pervasives_Native.Some num_ty_params + | uu___1 -> FStar_Pervasives_Native.None let (lookup_definition_qninfo_aux : Prims.bool -> delta_level Prims.list -> @@ -3666,165 +3706,187 @@ let (lookup_nonrec_definition : fun lid -> let uu___ = lookup_qname env1 lid in lookup_definition_qninfo_aux false delta_levels lid uu___ -let (delta_depth_of_qninfo_lid : - FStar_Ident.lident -> - qninfo -> FStar_Syntax_Syntax.delta_depth FStar_Pervasives_Native.option) - = - fun lid -> - fun qn -> - match qn with - | FStar_Pervasives_Native.None -> - FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_zero) - | FStar_Pervasives_Native.Some (FStar_Pervasives.Inl uu___, uu___1) -> - FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_zero) - | FStar_Pervasives_Native.Some - (FStar_Pervasives.Inr (se, uu___), uu___1) -> - (match se.FStar_Syntax_Syntax.sigel with - | FStar_Syntax_Syntax.Sig_inductive_typ uu___2 -> - FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_zero) - | FStar_Syntax_Syntax.Sig_bundle uu___2 -> - FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_zero) - | FStar_Syntax_Syntax.Sig_datacon uu___2 -> - FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Delta_constant_at_level Prims.int_zero) - | FStar_Syntax_Syntax.Sig_declare_typ uu___2 -> - let uu___3 = - FStar_Syntax_DsEnv.delta_depth_of_declaration lid - se.FStar_Syntax_Syntax.sigquals in - FStar_Pervasives_Native.Some uu___3 - | FStar_Syntax_Syntax.Sig_let - { FStar_Syntax_Syntax.lbs1 = (uu___2, lbs); - FStar_Syntax_Syntax.lids1 = uu___3;_} - -> - FStar_Compiler_Util.find_map lbs - (fun lb -> - let fv = - FStar_Compiler_Util.right lb.FStar_Syntax_Syntax.lbname in - let uu___4 = FStar_Syntax_Syntax.fv_eq_lid fv lid in - if uu___4 - then fv.FStar_Syntax_Syntax.fv_delta - else FStar_Pervasives_Native.None) - | FStar_Syntax_Syntax.Sig_fail uu___2 -> - FStar_Compiler_Effect.failwith - "impossible: delta_depth_of_qninfo" - | FStar_Syntax_Syntax.Sig_splice uu___2 -> - FStar_Compiler_Effect.failwith - "impossible: delta_depth_of_qninfo" - | FStar_Syntax_Syntax.Sig_assume uu___2 -> - FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Sig_new_effect uu___2 -> - FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Sig_sub_effect uu___2 -> - FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Sig_effect_abbrev uu___2 -> - FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Sig_pragma uu___2 -> - FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Sig_polymonadic_bind uu___2 -> - FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Sig_polymonadic_subcomp uu___2 -> - FStar_Pervasives_Native.None) -let (prims_dd_lids : FStar_Ident.lident Prims.list) = - [FStar_Parser_Const.and_lid; - FStar_Parser_Const.or_lid; - FStar_Parser_Const.imp_lid; - FStar_Parser_Const.iff_lid; - FStar_Parser_Const.true_lid; - FStar_Parser_Const.false_lid; - FStar_Parser_Const.not_lid; - FStar_Parser_Const.b2t_lid; - FStar_Parser_Const.eq2_lid; - FStar_Parser_Const.eq3_lid; - FStar_Parser_Const.op_Eq; - FStar_Parser_Const.op_LT; - FStar_Parser_Const.op_LTE; - FStar_Parser_Const.op_GT; - FStar_Parser_Const.op_GTE; - FStar_Parser_Const.forall_lid; - FStar_Parser_Const.exists_lid; - FStar_Parser_Const.haseq_lid; - FStar_Parser_Const.op_And; - FStar_Parser_Const.op_Or; - FStar_Parser_Const.op_Negation] -let (is_prims_dd_lid : FStar_Ident.lident -> Prims.bool) = - fun l -> - FStar_Compiler_List.existsb (fun l0 -> FStar_Ident.lid_equals l l0) - prims_dd_lids -let (delta_depth_of_qninfo : - FStar_Syntax_Syntax.fv -> - qninfo -> FStar_Syntax_Syntax.delta_depth FStar_Pervasives_Native.option) +let rec (delta_depth_of_qninfo_lid : + env -> FStar_Ident.lident -> qninfo -> FStar_Syntax_Syntax.delta_depth) = + fun env1 -> + fun lid -> + fun qn -> + match qn with + | FStar_Pervasives_Native.None -> FStar_Syntax_Syntax.delta_constant + | FStar_Pervasives_Native.Some (FStar_Pervasives.Inl uu___, uu___1) + -> FStar_Syntax_Syntax.delta_constant + | FStar_Pervasives_Native.Some + (FStar_Pervasives.Inr (se, uu___), uu___1) -> + (match se.FStar_Syntax_Syntax.sigel with + | FStar_Syntax_Syntax.Sig_inductive_typ uu___2 -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Sig_bundle uu___2 -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Sig_datacon uu___2 -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Sig_declare_typ uu___2 -> + let d0 = + let uu___3 = FStar_Syntax_Util.is_primop_lid lid in + if uu___3 + then FStar_Syntax_Syntax.delta_equational + else FStar_Syntax_Syntax.delta_constant in + let uu___3 = + (FStar_Compiler_Util.for_some + FStar_Syntax_Syntax.uu___is_Assumption + se.FStar_Syntax_Syntax.sigquals) + && + (let uu___4 = + FStar_Compiler_Util.for_some + FStar_Syntax_Syntax.uu___is_New + se.FStar_Syntax_Syntax.sigquals in + Prims.op_Negation uu___4) in + if uu___3 then FStar_Syntax_Syntax.Delta_abstract d0 else d0 + | FStar_Syntax_Syntax.Sig_let + { FStar_Syntax_Syntax.lbs1 = (uu___2, lbs); + FStar_Syntax_Syntax.lids1 = uu___3;_} + -> + let uu___4 = + FStar_Compiler_Util.find_map lbs + (fun lb -> + let fv = + FStar_Compiler_Util.right + lb.FStar_Syntax_Syntax.lbname in + let uu___5 = FStar_Syntax_Syntax.fv_eq_lid fv lid in + if uu___5 + then + let uu___6 = + let uu___7 = + delta_depth_of_term env1 + lb.FStar_Syntax_Syntax.lbdef in + FStar_Syntax_Util.incr_delta_depth uu___7 in + FStar_Pervasives_Native.Some uu___6 + else FStar_Pervasives_Native.None) in + FStar_Compiler_Util.must uu___4 + | FStar_Syntax_Syntax.Sig_fail uu___2 -> + FStar_Compiler_Effect.failwith + "impossible: delta_depth_of_qninfo" + | FStar_Syntax_Syntax.Sig_splice uu___2 -> + FStar_Compiler_Effect.failwith + "impossible: delta_depth_of_qninfo" + | FStar_Syntax_Syntax.Sig_assume uu___2 -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Sig_new_effect uu___2 -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Sig_sub_effect uu___2 -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Sig_effect_abbrev uu___2 -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Sig_pragma uu___2 -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Sig_polymonadic_bind uu___2 -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Sig_polymonadic_subcomp uu___2 -> + FStar_Syntax_Syntax.delta_constant) +and (delta_depth_of_qninfo : + env -> FStar_Syntax_Syntax.fv -> qninfo -> FStar_Syntax_Syntax.delta_depth) = - fun fv -> - fun qn -> - let lid = (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - let uu___ = - (is_prims_dd_lid lid) && - (FStar_Pervasives_Native.uu___is_Some - fv.FStar_Syntax_Syntax.fv_delta) in - if uu___ - then fv.FStar_Syntax_Syntax.fv_delta - else delta_depth_of_qninfo_lid lid qn -let (delta_depth_of_fv : + fun env1 -> + fun fv -> + fun qn -> + delta_depth_of_qninfo_lid env1 + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v qn +and (delta_depth_of_fv : env -> FStar_Syntax_Syntax.fv -> FStar_Syntax_Syntax.delta_depth) = fun env1 -> fun fv -> let lid = (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in let uu___ = - (is_prims_dd_lid lid) && - (FStar_Pervasives_Native.uu___is_Some - fv.FStar_Syntax_Syntax.fv_delta) in - if uu___ - then FStar_Compiler_Util.must fv.FStar_Syntax_Syntax.fv_delta - else - (let uu___2 = - let uu___3 = FStar_Ident.string_of_lid lid in - FStar_Compiler_Util.smap_try_find env1.fv_delta_depths uu___3 in - if FStar_Compiler_Util.is_some uu___2 - then FStar_Compiler_Util.must uu___2 - else - (let uu___4 = - let uu___5 = + let uu___1 = FStar_Ident.string_of_lid lid in + FStar_Compiler_Util.smap_try_find env1.fv_delta_depths uu___1 in + match uu___ with + | FStar_Pervasives_Native.Some dd -> dd + | FStar_Pervasives_Native.None -> + ((let uu___2 = FStar_Ident.string_of_lid lid in + FStar_Compiler_Util.smap_add env1.fv_delta_depths uu___2 + FStar_Syntax_Syntax.delta_equational); + (let d = + let uu___2 = lookup_qname env1 (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - delta_depth_of_qninfo fv uu___5 in - match uu___4 with - | FStar_Pervasives_Native.None -> - let uu___5 = - let uu___6 = FStar_Syntax_Print.fv_to_string fv in - FStar_Compiler_Util.format1 "Delta depth not found for %s" - uu___6 in - FStar_Compiler_Effect.failwith uu___5 - | FStar_Pervasives_Native.Some d -> - ((let uu___6 = - ((FStar_Pervasives_Native.uu___is_Some - fv.FStar_Syntax_Syntax.fv_delta) - && - (d <> - (FStar_Pervasives_Native.__proj__Some__item__v - fv.FStar_Syntax_Syntax.fv_delta))) - && (FStar_Options.debug_any ()) in - if uu___6 - then - let uu___7 = FStar_Syntax_Print.fv_to_string fv in - let uu___8 = - FStar_Class_Show.show - FStar_Syntax_Syntax.showable_delta_depth - (FStar_Pervasives_Native.__proj__Some__item__v - fv.FStar_Syntax_Syntax.fv_delta) in - let uu___9 = - FStar_Class_Show.show - FStar_Syntax_Syntax.showable_delta_depth d in - FStar_Compiler_Util.print3 - "WARNING WARNING WARNING fv=%s, delta_depth=%s, env.delta_depth=%s\n" - uu___7 uu___8 uu___9 - else ()); - (let uu___7 = FStar_Ident.string_of_lid lid in - FStar_Compiler_Util.smap_add env1.fv_delta_depths uu___7 d); - d))) + delta_depth_of_qninfo env1 fv uu___2 in + (let uu___3 = FStar_Ident.string_of_lid lid in + FStar_Compiler_Util.smap_add env1.fv_delta_depths uu___3 d); + d)) +and (fv_delta_depth : + env -> FStar_Syntax_Syntax.fv -> FStar_Syntax_Syntax.delta_depth) = + fun env1 -> + fun fv -> + let d = delta_depth_of_fv env1 fv in + match d with + | FStar_Syntax_Syntax.Delta_abstract + (FStar_Syntax_Syntax.Delta_constant_at_level l) -> + let uu___ = + (let uu___1 = FStar_Ident.string_of_lid env1.curmodule in + let uu___2 = + FStar_Ident.nsstr + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in + uu___1 = uu___2) && (Prims.op_Negation env1.is_iface) in + if uu___ + then FStar_Syntax_Syntax.Delta_constant_at_level l + else FStar_Syntax_Syntax.delta_constant + | d1 -> d1 +and (delta_depth_of_term : + env -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.delta_depth) = + fun env1 -> + fun t -> + let t1 = FStar_Syntax_Util.unmeta t in + match t1.FStar_Syntax_Syntax.n with + | FStar_Syntax_Syntax.Tm_meta uu___ -> + FStar_Compiler_Effect.failwith "Impossible (delta depth of term)" + | FStar_Syntax_Syntax.Tm_delayed uu___ -> + FStar_Compiler_Effect.failwith "Impossible (delta depth of term)" + | FStar_Syntax_Syntax.Tm_lazy i -> + let uu___ = FStar_Syntax_Util.unfold_lazy i in + delta_depth_of_term env1 uu___ + | FStar_Syntax_Syntax.Tm_fvar fv -> fv_delta_depth env1 fv + | FStar_Syntax_Syntax.Tm_bvar uu___ -> + FStar_Syntax_Syntax.delta_equational + | FStar_Syntax_Syntax.Tm_name uu___ -> + FStar_Syntax_Syntax.delta_equational + | FStar_Syntax_Syntax.Tm_match uu___ -> + FStar_Syntax_Syntax.delta_equational + | FStar_Syntax_Syntax.Tm_uvar uu___ -> + FStar_Syntax_Syntax.delta_equational + | FStar_Syntax_Syntax.Tm_unknown -> + FStar_Syntax_Syntax.delta_equational + | FStar_Syntax_Syntax.Tm_type uu___ -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Tm_quoted uu___ -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Tm_constant uu___ -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Tm_arrow uu___ -> + FStar_Syntax_Syntax.delta_constant + | FStar_Syntax_Syntax.Tm_uinst (t2, uu___) -> + delta_depth_of_term env1 t2 + | FStar_Syntax_Syntax.Tm_refine + { + FStar_Syntax_Syntax.b = + { FStar_Syntax_Syntax.ppname = uu___; + FStar_Syntax_Syntax.index = uu___1; + FStar_Syntax_Syntax.sort = t2;_}; + FStar_Syntax_Syntax.phi = uu___2;_} + -> delta_depth_of_term env1 t2 + | FStar_Syntax_Syntax.Tm_ascribed + { FStar_Syntax_Syntax.tm = t2; FStar_Syntax_Syntax.asc = uu___; + FStar_Syntax_Syntax.eff_opt = uu___1;_} + -> delta_depth_of_term env1 t2 + | FStar_Syntax_Syntax.Tm_app + { FStar_Syntax_Syntax.hd = t2; FStar_Syntax_Syntax.args = uu___;_} + -> delta_depth_of_term env1 t2 + | FStar_Syntax_Syntax.Tm_abs + { FStar_Syntax_Syntax.bs = uu___; FStar_Syntax_Syntax.body = t2; + FStar_Syntax_Syntax.rc_opt = uu___1;_} + -> delta_depth_of_term env1 t2 + | FStar_Syntax_Syntax.Tm_let + { FStar_Syntax_Syntax.lbs = uu___; + FStar_Syntax_Syntax.body1 = t2;_} + -> delta_depth_of_term env1 t2 let (quals_of_qninfo : qninfo -> FStar_Syntax_Syntax.qualifier Prims.list FStar_Pervasives_Native.option) @@ -4402,15 +4464,16 @@ let (num_inductive_ty_params : FStar_Syntax_Syntax.num_uniform_params = uu___3; FStar_Syntax_Syntax.t = uu___4; FStar_Syntax_Syntax.mutuals = uu___5; - FStar_Syntax_Syntax.ds = uu___6;_}; - FStar_Syntax_Syntax.sigrng = uu___7; - FStar_Syntax_Syntax.sigquals = uu___8; - FStar_Syntax_Syntax.sigmeta = uu___9; - FStar_Syntax_Syntax.sigattrs = uu___10; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___11; - FStar_Syntax_Syntax.sigopts = uu___12;_}, - uu___13), - uu___14) + FStar_Syntax_Syntax.ds = uu___6; + FStar_Syntax_Syntax.injective_type_params = uu___7;_}; + FStar_Syntax_Syntax.sigrng = uu___8; + FStar_Syntax_Syntax.sigquals = uu___9; + FStar_Syntax_Syntax.sigmeta = uu___10; + FStar_Syntax_Syntax.sigattrs = uu___11; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___12; + FStar_Syntax_Syntax.sigopts = uu___13;_}, + uu___14), + uu___15) -> FStar_Pervasives_Native.Some (FStar_Compiler_List.length tps) | uu___1 -> FStar_Pervasives_Native.None let (num_inductive_uniform_ty_params : @@ -4430,27 +4493,28 @@ let (num_inductive_uniform_ty_params : FStar_Syntax_Syntax.num_uniform_params = num_uniform; FStar_Syntax_Syntax.t = uu___4; FStar_Syntax_Syntax.mutuals = uu___5; - FStar_Syntax_Syntax.ds = uu___6;_}; - FStar_Syntax_Syntax.sigrng = uu___7; - FStar_Syntax_Syntax.sigquals = uu___8; - FStar_Syntax_Syntax.sigmeta = uu___9; - FStar_Syntax_Syntax.sigattrs = uu___10; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___11; - FStar_Syntax_Syntax.sigopts = uu___12;_}, - uu___13), - uu___14) + FStar_Syntax_Syntax.ds = uu___6; + FStar_Syntax_Syntax.injective_type_params = uu___7;_}; + FStar_Syntax_Syntax.sigrng = uu___8; + FStar_Syntax_Syntax.sigquals = uu___9; + FStar_Syntax_Syntax.sigmeta = uu___10; + FStar_Syntax_Syntax.sigattrs = uu___11; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___12; + FStar_Syntax_Syntax.sigopts = uu___13;_}, + uu___14), + uu___15) -> (match num_uniform with | FStar_Pervasives_Native.None -> - let uu___15 = - let uu___16 = - let uu___17 = FStar_Ident.string_of_lid lid in + let uu___16 = + let uu___17 = + let uu___18 = FStar_Ident.string_of_lid lid in FStar_Compiler_Util.format1 "Internal error: Inductive %s is not decorated with its uniform type parameters" - uu___17 in - (FStar_Errors_Codes.Fatal_UnexpectedInductivetype, uu___16) in - let uu___16 = FStar_Ident.range_of_lid lid in - FStar_Errors.raise_error uu___15 uu___16 + uu___18 in + (FStar_Errors_Codes.Fatal_UnexpectedInductivetype, uu___17) in + let uu___17 = FStar_Ident.range_of_lid lid in + FStar_Errors.raise_error uu___16 uu___17 | FStar_Pervasives_Native.Some n -> FStar_Pervasives_Native.Some n) | uu___1 -> FStar_Pervasives_Native.None let (effect_decl_opt : @@ -4712,9 +4776,14 @@ let (bound_vars : env -> FStar_Syntax_Syntax.bv Prims.list) = let (hasBinders_env : env FStar_Class_Binders.hasBinders) = { FStar_Class_Binders.boundNames = - (fun e -> - let uu___ = bound_vars e in - FStar_Compiler_Set.from_list FStar_Syntax_Syntax.ord_bv uu___) + (fun uu___ -> + (fun e -> + let uu___ = bound_vars e in + Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) uu___)) uu___) } let (hasNames_lcomp : FStar_TypeChecker_Common.lcomp FStar_Class_Binders.hasNames) = @@ -4732,13 +4801,21 @@ let (pretty_lcomp : FStar_TypeChecker_Common.lcomp FStar_Class_PP.pretty) = let (hasNames_guard : guard_t FStar_Class_Binders.hasNames) = { FStar_Class_Binders.freeNames = - (fun g -> - match g.FStar_TypeChecker_Common.guard_f with - | FStar_TypeChecker_Common.Trivial -> - FStar_Compiler_Set.empty FStar_Syntax_Syntax.ord_bv () - | FStar_TypeChecker_Common.NonTrivial f -> - FStar_Class_Binders.freeNames FStar_Class_Binders.hasNames_term - f) + (fun uu___ -> + (fun g -> + match g.FStar_TypeChecker_Common.guard_f with + | FStar_TypeChecker_Common.Trivial -> + Obj.magic + (Obj.repr + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) ())) + | FStar_TypeChecker_Common.NonTrivial f -> + Obj.magic + (Obj.repr + (FStar_Class_Binders.freeNames + FStar_Class_Binders.hasNames_term f))) uu___) } let (pretty_guard : guard_t FStar_Class_PP.pretty) = { @@ -6204,16 +6281,25 @@ let (finish_module : env -> FStar_Syntax_Syntax.modul -> env) = } let (uvars_in_env : env -> FStar_Syntax_Syntax.uvars) = fun env1 -> - let no_uvs = FStar_Syntax_Free.new_uv_set () in - let ext out uvs = - FStar_Compiler_Set.union FStar_Syntax_Free.ord_ctx_uvar out uvs in + let no_uvs = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) ()) in let rec aux out g = match g with | [] -> out | (FStar_Syntax_Syntax.Binding_univ uu___)::tl -> aux out tl | (FStar_Syntax_Syntax.Binding_lid (uu___, (uu___1, t)))::tl -> let uu___2 = - let uu___3 = FStar_Syntax_Free.uvars t in ext out uu___3 in + let uu___3 = FStar_Syntax_Free.uvars t in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic out) + (Obj.magic uu___3)) in aux uu___2 tl | (FStar_Syntax_Syntax.Binding_var { FStar_Syntax_Syntax.ppname = uu___; @@ -6221,22 +6307,37 @@ let (uvars_in_env : env -> FStar_Syntax_Syntax.uvars) = FStar_Syntax_Syntax.sort = t;_})::tl -> let uu___2 = - let uu___3 = FStar_Syntax_Free.uvars t in ext out uu___3 in + let uu___3 = FStar_Syntax_Free.uvars t in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic out) + (Obj.magic uu___3)) in aux uu___2 tl in aux no_uvs env1.gamma let (univ_vars : - env -> FStar_Syntax_Syntax.universe_uvar FStar_Compiler_Set.set) = + env -> FStar_Syntax_Syntax.universe_uvar FStar_Compiler_FlatSet.t) = fun env1 -> - let no_univs = FStar_Syntax_Free.new_universe_uvar_set () in - let ext out uvs = - FStar_Compiler_Set.union FStar_Syntax_Free.ord_univ_uvar out uvs in + let no_univs = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_univ_uvar)) ()) in let rec aux out g = match g with | [] -> out | (FStar_Syntax_Syntax.Binding_univ uu___)::tl -> aux out tl | (FStar_Syntax_Syntax.Binding_lid (uu___, (uu___1, t)))::tl -> let uu___2 = - let uu___3 = FStar_Syntax_Free.univs t in ext out uu___3 in + let uu___3 = FStar_Syntax_Free.univs t in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_univ_uvar)) (Obj.magic out) + (Obj.magic uu___3)) in aux uu___2 tl | (FStar_Syntax_Syntax.Binding_var { FStar_Syntax_Syntax.ppname = uu___; @@ -6244,25 +6345,44 @@ let (univ_vars : FStar_Syntax_Syntax.sort = t;_})::tl -> let uu___2 = - let uu___3 = FStar_Syntax_Free.univs t in ext out uu___3 in + let uu___3 = FStar_Syntax_Free.univs t in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_univ_uvar)) (Obj.magic out) + (Obj.magic uu___3)) in aux uu___2 tl in aux no_univs env1.gamma -let (univnames : env -> FStar_Syntax_Syntax.univ_name FStar_Compiler_Set.set) - = +let (univnames : + env -> FStar_Syntax_Syntax.univ_name FStar_Compiler_FlatSet.t) = fun env1 -> - let no_univ_names = FStar_Syntax_Syntax.no_universe_names in - let ext out uvs = - FStar_Compiler_Set.union FStar_Syntax_Syntax.ord_ident out uvs in + let no_univ_names = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) ()) in let rec aux out g = match g with | [] -> out | (FStar_Syntax_Syntax.Binding_univ uname)::tl -> let uu___ = - FStar_Compiler_Set.add FStar_Syntax_Syntax.ord_ident uname out in + Obj.magic + (FStar_Class_Setlike.add () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) uname (Obj.magic out)) in aux uu___ tl | (FStar_Syntax_Syntax.Binding_lid (uu___, (uu___1, t)))::tl -> let uu___2 = - let uu___3 = FStar_Syntax_Free.univnames t in ext out uu___3 in + let uu___3 = FStar_Syntax_Free.univnames t in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) (Obj.magic out) + (Obj.magic uu___3)) in aux uu___2 tl | (FStar_Syntax_Syntax.Binding_var { FStar_Syntax_Syntax.ppname = uu___; @@ -6270,7 +6390,13 @@ let (univnames : env -> FStar_Syntax_Syntax.univ_name FStar_Compiler_Set.set) FStar_Syntax_Syntax.sort = t;_})::tl -> let uu___2 = - let uu___3 = FStar_Syntax_Free.univnames t in ext out uu___3 in + let uu___3 = FStar_Syntax_Free.univnames t in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) (Obj.magic out) + (Obj.magic uu___3)) in aux uu___2 tl in aux no_univ_names env1.gamma let (lidents : env -> FStar_Ident.lident Prims.list) = @@ -6430,26 +6556,39 @@ let (set_proof_ns : proof_namespace -> env -> env) = } let (unbound_vars : env -> - FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.bv FStar_Compiler_Set.set) + FStar_Syntax_Syntax.term -> + FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.t) = fun e -> fun t -> let uu___ = FStar_Syntax_Free.names t in let uu___1 = bound_vars e in FStar_Compiler_List.fold_left - (fun s -> - fun bv -> - FStar_Compiler_Set.remove FStar_Syntax_Syntax.ord_bv bv s) uu___ - uu___1 + (fun uu___3 -> + fun uu___2 -> + (fun s -> + fun bv -> + Obj.magic + (FStar_Class_Setlike.remove () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) bv (Obj.magic s))) + uu___3 uu___2) uu___ uu___1 let (closed : env -> FStar_Syntax_Syntax.term -> Prims.bool) = fun e -> fun t -> let uu___ = unbound_vars e t in - FStar_Compiler_Set.is_empty FStar_Syntax_Syntax.ord_bv uu___ + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) (Obj.magic uu___) let (closed' : FStar_Syntax_Syntax.term -> Prims.bool) = fun t -> let uu___ = FStar_Syntax_Free.names t in - FStar_Compiler_Set.is_empty FStar_Syntax_Syntax.ord_bv uu___ + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set FStar_Syntax_Syntax.ord_bv)) + (Obj.magic uu___) let (string_of_proof_ns : env -> Prims.string) = fun env1 -> let aux uu___ = @@ -6796,7 +6935,7 @@ let (new_tac_implicit_var : FStar_TypeChecker_Common.imp_range = r } in (let uu___2 = - debug env1 (FStar_Options.Other "ImplicitTrace") in + FStar_Compiler_Effect.op_Bang dbg_ImplicitTrace in if uu___2 then let uu___3 = @@ -6886,8 +7025,8 @@ let (uvars_for_binders : (match uu___2 with | (t, l_ctx_uvars, g_t) -> ((let uu___4 = - debug env1 - (FStar_Options.Other "LayeredEffectsEqns") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsEqns in if uu___4 then FStar_Compiler_List.iter @@ -6963,12 +7102,6 @@ let (fvar_of_nonqual_lid : fun env1 -> fun lid -> let qn = lookup_qname env1 lid in - let dd = - let uu___ = delta_depth_of_qninfo_lid lid qn in - match uu___ with - | FStar_Pervasives_Native.None -> - FStar_Compiler_Effect.failwith "Unexpected no delta_depth" - | FStar_Pervasives_Native.Some dd1 -> dd1 in FStar_Syntax_Syntax.fvar lid FStar_Pervasives_Native.None let (split_smt_query : env -> diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Err.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Err.ml index b287d9b06ff..e0958e4a532 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Err.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Err.ml @@ -219,23 +219,36 @@ let (err_msg_comp_strings : fun c2 -> print_discrepancy (FStar_TypeChecker_Normalize.comp_to_string env) c1 c2 -let (exhaustiveness_check : Prims.string) = "Patterns are incomplete" +let (exhaustiveness_check : FStar_Pprint.document Prims.list) = + let uu___ = FStar_Errors_Msg.text "Patterns are incomplete" in [uu___] let (subtyping_failed : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.typ -> - FStar_Syntax_Syntax.typ -> unit -> Prims.string) + FStar_Syntax_Syntax.typ -> unit -> FStar_Errors_Msg.error_message) = fun env -> fun t1 -> fun t2 -> fun uu___ -> - let uu___1 = err_msg_type_strings env t1 t2 in - match uu___1 with - | (s1, s2) -> - FStar_Compiler_Util.format2 - "Subtyping check failed; expected type %s; got type %s" s2 s1 -let (ill_kinded_type : Prims.string) = "Ill-kinded type" -let (totality_check : Prims.string) = "This term may not terminate" + let ppt = FStar_TypeChecker_Normalize.term_to_doc env in + let uu___1 = FStar_Errors_Msg.text "Subtyping check failed" in + let uu___2 = + let uu___3 = + let uu___4 = + let uu___5 = FStar_Errors_Msg.text "Expected type" in + let uu___6 = ppt t2 in + FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one uu___5 + uu___6 in + let uu___5 = + let uu___6 = FStar_Errors_Msg.text "got type" in + let uu___7 = ppt t1 in + FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one uu___6 + uu___7 in + FStar_Pprint.op_Hat_Slash_Hat uu___4 uu___5 in + [uu___3] in + uu___1 :: uu___2 +let (ill_kinded_type : FStar_Errors_Msg.error_message) = + FStar_Errors_Msg.mkmsg "Ill-kinded type" let (unexpected_signature_for_monad : FStar_TypeChecker_Env.env -> FStar_Ident.lident -> @@ -333,7 +346,7 @@ let (basic_type_error : FStar_Syntax_Syntax.term FStar_Pervasives_Native.option -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term -> - (FStar_Errors_Codes.raw_error * Prims.string)) + (FStar_Errors_Codes.raw_error * FStar_Pprint.document Prims.list)) = fun env -> fun eopt -> @@ -345,14 +358,45 @@ let (basic_type_error : let msg = match eopt with | FStar_Pervasives_Native.None -> - FStar_Compiler_Util.format2 - "Expected type \"%s\"; got type \"%s\"" s1 s2 + let uu___1 = + let uu___2 = + let uu___3 = FStar_Errors_Msg.text "Expected type" in + let uu___4 = + FStar_TypeChecker_Normalize.term_to_doc env t1 in + FStar_Pprint.prefix (Prims.of_int (4)) Prims.int_one + uu___3 uu___4 in + let uu___3 = + let uu___4 = FStar_Errors_Msg.text "got type" in + let uu___5 = + FStar_TypeChecker_Normalize.term_to_doc env t2 in + FStar_Pprint.prefix (Prims.of_int (4)) Prims.int_one + uu___4 uu___5 in + FStar_Pprint.op_Hat_Slash_Hat uu___2 uu___3 in + [uu___1] | FStar_Pervasives_Native.Some e -> let uu___1 = - FStar_TypeChecker_Normalize.term_to_string env e in - FStar_Compiler_Util.format3 - "Expected type \"%s\"; but \"%s\" has type \"%s\"" s1 - uu___1 s2 in + let uu___2 = + let uu___3 = FStar_Errors_Msg.text "Expected type" in + let uu___4 = + FStar_TypeChecker_Normalize.term_to_doc env t1 in + FStar_Pprint.prefix (Prims.of_int (4)) Prims.int_one + uu___3 uu___4 in + let uu___3 = + let uu___4 = + let uu___5 = FStar_Errors_Msg.text "but" in + let uu___6 = + FStar_TypeChecker_Normalize.term_to_doc env e in + FStar_Pprint.prefix (Prims.of_int (4)) + Prims.int_one uu___5 uu___6 in + let uu___5 = + let uu___6 = FStar_Errors_Msg.text "has type" in + let uu___7 = + FStar_TypeChecker_Normalize.term_to_doc env t2 in + FStar_Pprint.prefix (Prims.of_int (4)) + Prims.int_one uu___6 uu___7 in + FStar_Pprint.op_Hat_Slash_Hat uu___4 uu___5 in + FStar_Pprint.op_Hat_Slash_Hat uu___2 uu___3 in + [uu___1] in (FStar_Errors_Codes.Error_TypeError, msg) let (occurs_check : (FStar_Errors_Codes.raw_error * Prims.string)) = (FStar_Errors_Codes.Fatal_PossibleInfiniteTyp, @@ -462,48 +506,84 @@ let computed_computation_type_does_not_match_annotation : 'uuuuu -> FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax -> FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax -> - (FStar_Errors_Codes.raw_error * Prims.string) + (FStar_Errors_Codes.raw_error * FStar_Pprint.document Prims.list) = fun env -> fun e -> fun c -> fun c' -> + let ppt = FStar_TypeChecker_Normalize.term_to_doc env in let uu___ = name_and_result c in match uu___ with | (f1, r1) -> let uu___1 = name_and_result c' in (match uu___1 with | (f2, r2) -> - let uu___2 = err_msg_type_strings env r1 r2 in - (match uu___2 with - | (s1, s2) -> - let uu___3 = - FStar_Compiler_Util.format4 - "Computed type \"%s\" and effect \"%s\" is not compatible with the annotated type \"%s\" effect \"%s\"" - s1 f1 s2 f2 in - (FStar_Errors_Codes.Fatal_ComputedTypeNotMatchAnnotation, - uu___3))) + let uu___2 = + let uu___3 = + let uu___4 = + let uu___5 = FStar_Errors_Msg.text "Computed type" in + let uu___6 = ppt r1 in + FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one + uu___5 uu___6 in + let uu___5 = + let uu___6 = + let uu___7 = FStar_Errors_Msg.text "and effect" in + let uu___8 = FStar_Errors_Msg.text f1 in + FStar_Pprint.prefix (Prims.of_int (2)) + Prims.int_one uu___7 uu___8 in + let uu___7 = + let uu___8 = + let uu___9 = + FStar_Errors_Msg.text + "is not compatible with the annotated type" in + let uu___10 = ppt r2 in + FStar_Pprint.prefix (Prims.of_int (2)) + Prims.int_one uu___9 uu___10 in + let uu___9 = + let uu___10 = FStar_Errors_Msg.text "and effect" in + let uu___11 = FStar_Errors_Msg.text f2 in + FStar_Pprint.prefix (Prims.of_int (2)) + Prims.int_one uu___10 uu___11 in + FStar_Pprint.op_Hat_Slash_Hat uu___8 uu___9 in + FStar_Pprint.op_Hat_Slash_Hat uu___6 uu___7 in + FStar_Pprint.op_Hat_Slash_Hat uu___4 uu___5 in + [uu___3] in + (FStar_Errors_Codes.Fatal_ComputedTypeNotMatchAnnotation, + uu___2)) let computed_computation_type_does_not_match_annotation_eq : 'uuuuu . FStar_TypeChecker_Env.env -> 'uuuuu -> FStar_Syntax_Syntax.comp -> FStar_Syntax_Syntax.comp -> - (FStar_Errors_Codes.raw_error * Prims.string) + (FStar_Errors_Codes.raw_error * FStar_Pprint.document Prims.list) = fun env -> fun e -> fun c -> fun c' -> - let uu___ = err_msg_comp_strings env c c' in - match uu___ with - | (s1, s2) -> - let uu___1 = - FStar_Compiler_Util.format2 - "Computed type \"%s\" does not match annotated type \"%s\", and no subtyping was allowed" - s1 s2 in - (FStar_Errors_Codes.Fatal_ComputedTypeNotMatchAnnotation, - uu___1) + let ppc = FStar_TypeChecker_Normalize.comp_to_doc env in + let uu___ = + let uu___1 = + let uu___2 = + let uu___3 = FStar_Errors_Msg.text "Computed type" in + let uu___4 = ppc c in + FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one uu___3 + uu___4 in + let uu___3 = + let uu___4 = + let uu___5 = + FStar_Errors_Msg.text "does not match annotated type" in + let uu___6 = ppc c' in + FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one uu___5 + uu___6 in + let uu___5 = + FStar_Errors_Msg.text "and no subtyping was allowed" in + FStar_Pprint.op_Hat_Slash_Hat uu___4 uu___5 in + FStar_Pprint.op_Hat_Slash_Hat uu___2 uu___3 in + [uu___1] in + (FStar_Errors_Codes.Fatal_ComputedTypeNotMatchAnnotation, uu___) let (unexpected_non_trivial_precondition_on_term : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> (FStar_Errors_Codes.raw_error * Prims.string)) @@ -515,50 +595,75 @@ let (unexpected_non_trivial_precondition_on_term : FStar_Compiler_Util.format1 "Term has an unexpected non-trivial pre-condition: %s" uu___1 in (FStar_Errors_Codes.Fatal_UnExpectedPreCondition, uu___) +let (__expected_eff_expression : + Prims.string -> + FStar_Syntax_Syntax.term -> + FStar_Syntax_Syntax.comp -> + Prims.string -> + (FStar_Errors_Codes.raw_error * FStar_Pprint.document Prims.list)) + = + fun effname -> + fun e -> + fun c -> + fun reason -> + let uu___ = + let uu___1 = + FStar_Errors_Msg.text + (Prims.strcat "Expected a " + (Prims.strcat effname " expression.")) in + let uu___2 = + let uu___3 = + if reason = "" + then FStar_Pprint.empty + else + (let uu___5 = FStar_Pprint.break_ Prims.int_one in + let uu___6 = + let uu___7 = FStar_Pprint.doc_of_string "Because:" in + let uu___8 = + FStar_Pprint.words (Prims.strcat reason ".") in + uu___7 :: uu___8 in + FStar_Pprint.flow uu___5 uu___6) in + let uu___4 = + let uu___5 = + let uu___6 = + let uu___7 = FStar_Errors_Msg.text "Got an expression" in + let uu___8 = + FStar_Class_PP.pp FStar_Syntax_Print.pretty_term e in + FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one + uu___7 uu___8 in + let uu___7 = + let uu___8 = + let uu___9 = FStar_Errors_Msg.text "with effect" in + let uu___10 = + let uu___11 = + let uu___12 = + let uu___13 = name_and_result c in + FStar_Pervasives_Native.fst uu___13 in + FStar_Pprint.doc_of_string uu___12 in + FStar_Pprint.squotes uu___11 in + FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one + uu___9 uu___10 in + FStar_Pprint.op_Hat_Hat uu___8 FStar_Pprint.dot in + FStar_Pprint.op_Hat_Slash_Hat uu___6 uu___7 in + [uu___5] in + uu___3 :: uu___4 in + uu___1 :: uu___2 in + (FStar_Errors_Codes.Fatal_ExpectedGhostExpression, uu___) let (expected_pure_expression : FStar_Syntax_Syntax.term -> - FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax -> - Prims.string -> (FStar_Errors_Codes.raw_error * Prims.string)) + FStar_Syntax_Syntax.comp -> + Prims.string -> + (FStar_Errors_Codes.raw_error * FStar_Pprint.document Prims.list)) = - fun e -> - fun c -> - fun reason -> - let msg = "Expected a pure expression" in - let msg1 = - if reason = "" - then msg - else FStar_Compiler_Util.format1 (Prims.strcat msg " (%s)") reason in - let uu___ = - let uu___1 = FStar_Syntax_Print.term_to_string e in - let uu___2 = - let uu___3 = name_and_result c in - FStar_Pervasives_Native.fst uu___3 in - FStar_Compiler_Util.format2 - (Prims.strcat msg1 - "; got an expression \"%s\" with effect \"%s\"") uu___1 uu___2 in - (FStar_Errors_Codes.Fatal_ExpectedPureExpression, uu___) + fun e -> fun c -> fun reason -> __expected_eff_expression "pure" e c reason let (expected_ghost_expression : FStar_Syntax_Syntax.term -> - FStar_Syntax_Syntax.comp' FStar_Syntax_Syntax.syntax -> - Prims.string -> (FStar_Errors_Codes.raw_error * Prims.string)) + FStar_Syntax_Syntax.comp -> + Prims.string -> + (FStar_Errors_Codes.raw_error * FStar_Pprint.document Prims.list)) = fun e -> - fun c -> - fun reason -> - let msg = "Expected a ghost expression" in - let msg1 = - if reason = "" - then msg - else FStar_Compiler_Util.format1 (Prims.strcat msg " (%s)") reason in - let uu___ = - let uu___1 = FStar_Syntax_Print.term_to_string e in - let uu___2 = - let uu___3 = name_and_result c in - FStar_Pervasives_Native.fst uu___3 in - FStar_Compiler_Util.format2 - (Prims.strcat msg1 - "; got an expression \"%s\" with effect \"%s\"") uu___1 uu___2 in - (FStar_Errors_Codes.Fatal_ExpectedGhostExpression, uu___) + fun c -> fun reason -> __expected_eff_expression "ghost" e c reason let (expected_effect_1_got_effect_2 : FStar_Ident.lident -> FStar_Ident.lident -> (FStar_Errors_Codes.raw_error * Prims.string)) diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Generalize.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Generalize.ml index fdf1d88d65a..784acaef778 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Generalize.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Generalize.ml @@ -1,4 +1,6 @@ open Prims +let (dbg_Gen : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Gen" let (showable_univ_var : FStar_Syntax_Syntax.universe_uvar FStar_Class_Show.showable) = { @@ -9,29 +11,39 @@ let (showable_univ_var : } let (gen_univs : FStar_TypeChecker_Env.env -> - FStar_Syntax_Syntax.universe_uvar FStar_Compiler_Set.t -> + FStar_Syntax_Syntax.universe_uvar FStar_Compiler_FlatSet.t -> FStar_Syntax_Syntax.univ_name Prims.list) = fun env -> fun x -> let uu___ = - FStar_Compiler_Set.is_empty FStar_Syntax_Free.ord_univ_uvar x in + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_univ_uvar)) (Obj.magic x) in if uu___ then [] else (let s = let uu___2 = let uu___3 = FStar_TypeChecker_Env.univ_vars env in - FStar_Compiler_Set.diff FStar_Syntax_Free.ord_univ_uvar x uu___3 in - FStar_Compiler_Set.elems FStar_Syntax_Free.ord_univ_uvar uu___2 in - (let uu___3 = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "Gen") in + Obj.magic + (FStar_Class_Setlike.diff () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_univ_uvar)) (Obj.magic x) + (Obj.magic uu___3)) in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_univ_uvar)) (Obj.magic uu___2) in + (let uu___3 = FStar_Compiler_Effect.op_Bang dbg_Gen in if uu___3 then let uu___4 = let uu___5 = FStar_TypeChecker_Env.univ_vars env in FStar_Class_Show.show - (FStar_Compiler_Set.showable_set + (FStar_Compiler_FlatSet.showable_set FStar_Syntax_Free.ord_univ_uvar showable_univ_var) uu___5 in FStar_Compiler_Util.print1 "univ_vars in env: %s\n" uu___4 else ()); @@ -42,9 +54,7 @@ let (gen_univs : FStar_Compiler_List.map (fun u -> let u_name = FStar_Syntax_Syntax.new_univ_name r in - (let uu___4 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Gen") in + (let uu___4 = FStar_Compiler_Effect.op_Bang dbg_Gen in if uu___4 then let uu___5 = @@ -66,15 +76,19 @@ let (gen_univs : let (gather_free_univnames : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> - FStar_Syntax_Syntax.univ_name FStar_Compiler_Set.t) + FStar_Syntax_Syntax.univ_name FStar_Compiler_FlatSet.t) = fun env -> fun t -> let ctx_univnames = FStar_TypeChecker_Env.univnames env in let tm_univnames = FStar_Syntax_Free.univnames t in let univnames = - FStar_Compiler_Set.diff FStar_Syntax_Syntax.ord_ident tm_univnames - ctx_univnames in + Obj.magic + (FStar_Class_Setlike.diff () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) (Obj.magic tm_univnames) + (Obj.magic ctx_univnames)) in univnames let (check_universe_generalization : FStar_Syntax_Syntax.univ_name Prims.list -> @@ -113,9 +127,11 @@ let (generalize_universes : FStar_TypeChecker_Env.DoNotUnfoldPureLets] env t0 in let univnames = let uu___1 = gather_free_univnames env t in - FStar_Compiler_Set.elems FStar_Syntax_Syntax.ord_ident uu___1 in - (let uu___2 = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "Gen") in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) (Obj.magic uu___1) in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Gen in if uu___2 then let uu___3 = @@ -129,20 +145,18 @@ let (generalize_universes : uu___3 uu___4 else ()); (let univs = FStar_Syntax_Free.univs t in - (let uu___3 = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "Gen") in + (let uu___3 = FStar_Compiler_Effect.op_Bang dbg_Gen in if uu___3 then let uu___4 = FStar_Class_Show.show - (FStar_Compiler_Set.showable_set + (FStar_Compiler_FlatSet.showable_set FStar_Syntax_Free.ord_univ_uvar showable_univ_var) univs in FStar_Compiler_Util.print1 "univs to gen : %s\n" uu___4 else ()); (let gen = gen_univs env univs in - (let uu___4 = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "Gen") in + (let uu___4 = FStar_Compiler_Effect.op_Bang dbg_Gen in if uu___4 then let uu___5 = @@ -184,8 +198,7 @@ let (gen : then FStar_Pervasives_Native.None else (let norm c = - (let uu___3 = - FStar_TypeChecker_Env.debug env FStar_Options.Medium in + (let uu___3 = FStar_Compiler_Debug.medium () in if uu___3 then let uu___4 = @@ -199,8 +212,7 @@ let (gen : FStar_TypeChecker_Env.Exclude FStar_TypeChecker_Env.Zeta; FStar_TypeChecker_Env.NoFullNorm; FStar_TypeChecker_Env.DoNotUnfoldPureLets] env c in - (let uu___4 = - FStar_TypeChecker_Env.debug env FStar_Options.Medium in + (let uu___4 = FStar_Compiler_Debug.medium () in if uu___4 then let uu___5 = @@ -211,9 +223,16 @@ let (gen : let env_uvars = FStar_TypeChecker_Env.uvars_in_env env in let gen_uvars uvs = let uu___2 = - FStar_Compiler_Set.diff FStar_Syntax_Free.ord_ctx_uvar uvs - env_uvars in - FStar_Compiler_Set.elems FStar_Syntax_Free.ord_ctx_uvar uu___2 in + Obj.magic + (FStar_Class_Setlike.diff () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uvs) + (Obj.magic env_uvars)) in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___2) in let univs_and_uvars_of_lec uu___2 = match uu___2 with | (lbname, e, c) -> @@ -221,19 +240,17 @@ let (gen : let t = FStar_Syntax_Util.comp_result c1 in let univs = FStar_Syntax_Free.univs t in let uvt = FStar_Syntax_Free.uvars t in - ((let uu___4 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Gen") in + ((let uu___4 = FStar_Compiler_Effect.op_Bang dbg_Gen in if uu___4 then let uu___5 = FStar_Class_Show.show - (FStar_Compiler_Set.showable_set + (FStar_Compiler_FlatSet.showable_set FStar_Syntax_Free.ord_univ_uvar showable_univ_var) univs in let uu___6 = FStar_Class_Show.show - (FStar_Compiler_Set.showable_set + (FStar_Compiler_FlatSet.showable_set FStar_Syntax_Free.ord_ctx_uvar FStar_Syntax_Print.showable_ctxu) uvt in FStar_Compiler_Util.print2 @@ -242,26 +259,34 @@ let (gen : else ()); (let univs1 = let uu___4 = - FStar_Compiler_Set.elems - FStar_Syntax_Free.ord_ctx_uvar uvt in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uvt) in FStar_Compiler_List.fold_left - (fun univs2 -> - fun uv -> - let uu___5 = - let uu___6 = FStar_Syntax_Util.ctx_uvar_typ uv in - FStar_Syntax_Free.univs uu___6 in - FStar_Compiler_Set.union - FStar_Syntax_Free.ord_univ_uvar univs2 uu___5) - univs uu___4 in + (fun uu___6 -> + fun uu___5 -> + (fun univs2 -> + fun uv -> + let uu___5 = + let uu___6 = + FStar_Syntax_Util.ctx_uvar_typ uv in + FStar_Syntax_Free.univs uu___6 in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_univ_uvar)) + (Obj.magic univs2) (Obj.magic uu___5))) + uu___6 uu___5) univs uu___4 in let uvs = gen_uvars uvt in - (let uu___5 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Gen") in + (let uu___5 = FStar_Compiler_Effect.op_Bang dbg_Gen in if uu___5 then let uu___6 = FStar_Class_Show.show - (FStar_Compiler_Set.showable_set + (FStar_Compiler_FlatSet.showable_set FStar_Syntax_Free.ord_univ_uvar showable_univ_var) univs1 in let uu___7 = @@ -280,8 +305,11 @@ let (gen : | (univs, uvs, lec_hd) -> let force_univs_eq lec2 u1 u2 = let uu___3 = - FStar_Compiler_Set.equal FStar_Syntax_Free.ord_univ_uvar - u1 u2 in + FStar_Class_Setlike.equal () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_univ_uvar)) (Obj.magic u1) + (Obj.magic u2) in if uu___3 then () else @@ -389,8 +417,11 @@ let (gen : FStar_Syntax_Free.names kres in let uu___9 = let uu___10 = - FStar_Compiler_Set.is_empty - FStar_Syntax_Syntax.ord_bv free in + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic free) in Prims.op_Negation uu___10 in if uu___9 then [] @@ -542,7 +573,7 @@ let (generalize' : fun env -> fun is_rec -> fun lecs -> - (let uu___2 = FStar_TypeChecker_Env.debug env FStar_Options.Low in + (let uu___2 = FStar_Compiler_Debug.low () in if uu___2 then let uu___3 = @@ -560,18 +591,31 @@ let (generalize' : else ()); (let univnames_lecs = let empty = - FStar_Compiler_Set.from_list FStar_Syntax_Syntax.ord_ident [] in + Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) []) in FStar_Compiler_List.fold_left - (fun out -> + (fun uu___3 -> fun uu___2 -> - match uu___2 with - | (l, t, c) -> - let uu___3 = gather_free_univnames env t in - FStar_Compiler_Set.union FStar_Syntax_Syntax.ord_ident - out uu___3) empty lecs in + (fun out -> + fun uu___2 -> + match uu___2 with + | (l, t, c) -> + let uu___3 = gather_free_univnames env t in + Obj.magic + (FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) + (Obj.magic out) (Obj.magic uu___3))) uu___3 + uu___2) empty lecs in let univnames_lecs1 = - FStar_Compiler_Set.elems FStar_Syntax_Syntax.ord_ident - univnames_lecs in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_ident)) (Obj.magic univnames_lecs) in let generalized_lecs = let uu___2 = gen env is_rec lecs in match uu___2 with @@ -580,8 +624,7 @@ let (generalize' : (fun uu___3 -> match uu___3 with | (l, t, c) -> (l, [], t, c, [])) lecs | FStar_Pervasives_Native.Some luecs -> - ((let uu___4 = - FStar_TypeChecker_Env.debug env FStar_Options.Medium in + ((let uu___4 = FStar_Compiler_Debug.medium () in if uu___4 then FStar_Compiler_List.iter @@ -590,7 +633,7 @@ let (generalize' : | (l, us, e, c, gvs) -> let uu___6 = FStar_Class_Show.show - FStar_Compiler_Range_Ops.show_range + FStar_Compiler_Range_Ops.showable_range e.FStar_Syntax_Syntax.pos in let uu___7 = FStar_Syntax_Print.lbname_to_string l in diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_NBE.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_NBE.ml index 809a89458e4..956d49a01b5 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_NBE.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_NBE.ml @@ -1,4 +1,8 @@ open Prims +let (dbg_NBE : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "NBE" +let (dbg_NBETop : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "NBETop" let (max : Prims.int -> Prims.int -> Prims.int) = fun a -> fun b -> if a > b then a else b let map_rev : 'a 'b . ('a -> 'b) -> 'a Prims.list -> 'b Prims.list = @@ -2333,7 +2337,8 @@ and (translate_monadic : let maybe_range_arg = let uu___2 = FStar_Compiler_Util.for_some - (FStar_Syntax_Util.attr_eq + (FStar_TypeChecker_TermEqAndSimplify.eq_tm_bool + (cfg.core_cfg).FStar_TypeChecker_Cfg.tcenv FStar_Syntax_Util.dm4f_bind_range_attr) ed.FStar_Syntax_Syntax.eff_attrs in if uu___2 @@ -2889,9 +2894,9 @@ and (readback : if ((cfg.core_cfg).FStar_TypeChecker_Cfg.steps).FStar_TypeChecker_Cfg.simplify then - FStar_TypeChecker_Common.simplify + FStar_TypeChecker_TermEqAndSimplify.simplify ((cfg.core_cfg).FStar_TypeChecker_Cfg.debug).FStar_TypeChecker_Cfg.wpe - refinement + (cfg.core_cfg).FStar_TypeChecker_Cfg.tcenv refinement else refinement in with_range uu___2) | FStar_TypeChecker_NBETerm.Reflect t -> @@ -2958,9 +2963,9 @@ and (readback : if ((cfg.core_cfg).FStar_TypeChecker_Cfg.steps).FStar_TypeChecker_Cfg.simplify then - FStar_TypeChecker_Common.simplify + FStar_TypeChecker_TermEqAndSimplify.simplify ((cfg.core_cfg).FStar_TypeChecker_Cfg.debug).FStar_TypeChecker_Cfg.wpe - app + (cfg.core_cfg).FStar_TypeChecker_Cfg.tcenv app else app in with_range uu___1 | FStar_TypeChecker_NBETerm.Accu @@ -2977,9 +2982,9 @@ and (readback : if ((cfg.core_cfg).FStar_TypeChecker_Cfg.steps).FStar_TypeChecker_Cfg.simplify then - FStar_TypeChecker_Common.simplify + FStar_TypeChecker_TermEqAndSimplify.simplify ((cfg.core_cfg).FStar_TypeChecker_Cfg.debug).FStar_TypeChecker_Cfg.wpe - app + (cfg.core_cfg).FStar_TypeChecker_Cfg.tcenv app else app in with_range uu___1 | FStar_TypeChecker_NBETerm.Accu @@ -3005,9 +3010,9 @@ and (readback : if ((cfg.core_cfg).FStar_TypeChecker_Cfg.steps).FStar_TypeChecker_Cfg.simplify then - FStar_TypeChecker_Common.simplify + FStar_TypeChecker_TermEqAndSimplify.simplify ((cfg.core_cfg).FStar_TypeChecker_Cfg.debug).FStar_TypeChecker_Cfg.wpe - app + (cfg.core_cfg).FStar_TypeChecker_Cfg.tcenv app else app in with_range uu___1 | FStar_TypeChecker_NBETerm.Accu @@ -3357,9 +3362,8 @@ let (normalize : (cfg.FStar_TypeChecker_Cfg.compat_memo_ignore_cfg) } in (let uu___1 = - (FStar_TypeChecker_Env.debug env (FStar_Options.Other "NBETop")) - || - (FStar_TypeChecker_Env.debug env (FStar_Options.Other "NBE")) in + (FStar_Compiler_Effect.op_Bang dbg_NBETop) || + (FStar_Compiler_Effect.op_Bang dbg_NBE) in if uu___1 then let uu___2 = FStar_Syntax_Print.term_to_string e in @@ -3368,9 +3372,8 @@ let (normalize : (let cfg2 = new_config cfg1 in let r = let uu___1 = translate cfg2 [] e in readback cfg2 uu___1 in (let uu___2 = - (FStar_TypeChecker_Env.debug env (FStar_Options.Other "NBETop")) - || - (FStar_TypeChecker_Env.debug env (FStar_Options.Other "NBE")) in + (FStar_Compiler_Effect.op_Bang dbg_NBETop) || + (FStar_Compiler_Effect.op_Bang dbg_NBE) in if uu___2 then let uu___3 = FStar_Syntax_Print.term_to_string r in diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_NBETerm.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_NBETerm.ml index 1ab8f46c7b0..2894ce29619 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_NBETerm.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_NBETerm.ml @@ -418,124 +418,172 @@ let (mkAccuMatch : = fun s -> fun ret -> fun bs -> fun rc -> mk_t (Accu ((Match (s, ret, bs, rc)), [])) -let (equal_if : Prims.bool -> FStar_Syntax_Util.eq_result) = +let (equal_if : Prims.bool -> FStar_TypeChecker_TermEqAndSimplify.eq_result) + = fun uu___ -> - if uu___ then FStar_Syntax_Util.Equal else FStar_Syntax_Util.Unknown -let (equal_iff : Prims.bool -> FStar_Syntax_Util.eq_result) = + if uu___ + then FStar_TypeChecker_TermEqAndSimplify.Equal + else FStar_TypeChecker_TermEqAndSimplify.Unknown +let (equal_iff : Prims.bool -> FStar_TypeChecker_TermEqAndSimplify.eq_result) + = fun uu___ -> - if uu___ then FStar_Syntax_Util.Equal else FStar_Syntax_Util.NotEqual + if uu___ + then FStar_TypeChecker_TermEqAndSimplify.Equal + else FStar_TypeChecker_TermEqAndSimplify.NotEqual let (eq_inj : - FStar_Syntax_Util.eq_result -> - FStar_Syntax_Util.eq_result -> FStar_Syntax_Util.eq_result) + FStar_TypeChecker_TermEqAndSimplify.eq_result -> + FStar_TypeChecker_TermEqAndSimplify.eq_result -> + FStar_TypeChecker_TermEqAndSimplify.eq_result) = fun r1 -> fun r2 -> match (r1, r2) with - | (FStar_Syntax_Util.Equal, FStar_Syntax_Util.Equal) -> - FStar_Syntax_Util.Equal - | (FStar_Syntax_Util.NotEqual, uu___) -> FStar_Syntax_Util.NotEqual - | (uu___, FStar_Syntax_Util.NotEqual) -> FStar_Syntax_Util.NotEqual - | (FStar_Syntax_Util.Unknown, uu___) -> FStar_Syntax_Util.Unknown - | (uu___, FStar_Syntax_Util.Unknown) -> FStar_Syntax_Util.Unknown + | (FStar_TypeChecker_TermEqAndSimplify.Equal, + FStar_TypeChecker_TermEqAndSimplify.Equal) -> + FStar_TypeChecker_TermEqAndSimplify.Equal + | (FStar_TypeChecker_TermEqAndSimplify.NotEqual, uu___) -> + FStar_TypeChecker_TermEqAndSimplify.NotEqual + | (uu___, FStar_TypeChecker_TermEqAndSimplify.NotEqual) -> + FStar_TypeChecker_TermEqAndSimplify.NotEqual + | (FStar_TypeChecker_TermEqAndSimplify.Unknown, uu___) -> + FStar_TypeChecker_TermEqAndSimplify.Unknown + | (uu___, FStar_TypeChecker_TermEqAndSimplify.Unknown) -> + FStar_TypeChecker_TermEqAndSimplify.Unknown let (eq_and : - FStar_Syntax_Util.eq_result -> - (unit -> FStar_Syntax_Util.eq_result) -> FStar_Syntax_Util.eq_result) + FStar_TypeChecker_TermEqAndSimplify.eq_result -> + (unit -> FStar_TypeChecker_TermEqAndSimplify.eq_result) -> + FStar_TypeChecker_TermEqAndSimplify.eq_result) = fun f -> fun g -> match f with - | FStar_Syntax_Util.Equal -> g () - | uu___ -> FStar_Syntax_Util.Unknown -let (eq_constant : constant -> constant -> FStar_Syntax_Util.eq_result) = + | FStar_TypeChecker_TermEqAndSimplify.Equal -> g () + | uu___ -> FStar_TypeChecker_TermEqAndSimplify.Unknown +let (eq_constant : + constant -> constant -> FStar_TypeChecker_TermEqAndSimplify.eq_result) = fun c1 -> fun c2 -> match (c1, c2) with - | (Unit, Unit) -> FStar_Syntax_Util.Equal + | (Unit, Unit) -> FStar_TypeChecker_TermEqAndSimplify.Equal | (Bool b1, Bool b2) -> equal_iff (b1 = b2) | (Int i1, Int i2) -> equal_iff (i1 = i2) | (String (s1, uu___), String (s2, uu___1)) -> equal_iff (s1 = s2) | (Char c11, Char c21) -> equal_iff (c11 = c21) - | (Range r1, Range r2) -> FStar_Syntax_Util.Unknown - | (uu___, uu___1) -> FStar_Syntax_Util.NotEqual -let rec (eq_t : t -> t -> FStar_Syntax_Util.eq_result) = - fun t1 -> - fun t2 -> - match ((t1.nbe_t), (t2.nbe_t)) with - | (Lam uu___, Lam uu___1) -> FStar_Syntax_Util.Unknown - | (Accu (a1, as1), Accu (a2, as2)) -> - let uu___ = eq_atom a1 a2 in - eq_and uu___ (fun uu___1 -> eq_args as1 as2) - | (Construct (v1, us1, args1), Construct (v2, us2, args2)) -> - let uu___ = FStar_Syntax_Syntax.fv_eq v1 v2 in - if uu___ - then - (if - (FStar_Compiler_List.length args1) <> - (FStar_Compiler_List.length args2) - then - FStar_Compiler_Effect.failwith - "eq_t, different number of args on Construct" - else (); - (let uu___2 = FStar_Compiler_List.zip args1 args2 in - FStar_Compiler_List.fold_left - (fun acc -> - fun uu___3 -> - match uu___3 with - | ((a1, uu___4), (a2, uu___5)) -> - let uu___6 = eq_t a1 a2 in eq_inj acc uu___6) - FStar_Syntax_Util.Equal uu___2)) - else FStar_Syntax_Util.NotEqual - | (FV (v1, us1, args1), FV (v2, us2, args2)) -> - let uu___ = FStar_Syntax_Syntax.fv_eq v1 v2 in - if uu___ - then - let uu___1 = - let uu___2 = FStar_Syntax_Util.eq_univs_list us1 us2 in - equal_iff uu___2 in - eq_and uu___1 (fun uu___2 -> eq_args args1 args2) - else FStar_Syntax_Util.Unknown - | (Constant c1, Constant c2) -> eq_constant c1 c2 - | (Type_t u1, Type_t u2) -> - let uu___ = FStar_Syntax_Util.eq_univs u1 u2 in equal_iff uu___ - | (Univ u1, Univ u2) -> - let uu___ = FStar_Syntax_Util.eq_univs u1 u2 in equal_iff uu___ - | (Refinement (r1, t11), Refinement (r2, t21)) -> - let x = - FStar_Syntax_Syntax.new_bv FStar_Pervasives_Native.None - FStar_Syntax_Syntax.t_unit in - let uu___ = - let uu___1 = - let uu___2 = t11 () in FStar_Pervasives_Native.fst uu___2 in - let uu___2 = - let uu___3 = t21 () in FStar_Pervasives_Native.fst uu___3 in - eq_t uu___1 uu___2 in - eq_and uu___ - (fun uu___1 -> - let uu___2 = let uu___3 = mkAccuVar x in r1 uu___3 in - let uu___3 = let uu___4 = mkAccuVar x in r2 uu___4 in - eq_t uu___2 uu___3) - | (Unknown, Unknown) -> FStar_Syntax_Util.Equal - | (uu___, uu___1) -> FStar_Syntax_Util.Unknown -and (eq_atom : atom -> atom -> FStar_Syntax_Util.eq_result) = + | (Range r1, Range r2) -> FStar_TypeChecker_TermEqAndSimplify.Unknown + | (uu___, uu___1) -> FStar_TypeChecker_TermEqAndSimplify.NotEqual +let rec (eq_t : + FStar_TypeChecker_Env.env_t -> + t -> t -> FStar_TypeChecker_TermEqAndSimplify.eq_result) + = + fun env -> + fun t1 -> + fun t2 -> + match ((t1.nbe_t), (t2.nbe_t)) with + | (Lam uu___, Lam uu___1) -> + FStar_TypeChecker_TermEqAndSimplify.Unknown + | (Accu (a1, as1), Accu (a2, as2)) -> + let uu___ = eq_atom a1 a2 in + eq_and uu___ (fun uu___1 -> eq_args env as1 as2) + | (Construct (v1, us1, args1), Construct (v2, us2, args2)) -> + let uu___ = FStar_Syntax_Syntax.fv_eq v1 v2 in + if uu___ + then + (if + (FStar_Compiler_List.length args1) <> + (FStar_Compiler_List.length args2) + then + FStar_Compiler_Effect.failwith + "eq_t, different number of args on Construct" + else (); + (let uu___2 = + let uu___3 = FStar_Syntax_Syntax.lid_of_fv v1 in + FStar_TypeChecker_Env.num_datacon_non_injective_ty_params + env uu___3 in + match uu___2 with + | FStar_Pervasives_Native.None -> + FStar_TypeChecker_TermEqAndSimplify.Unknown + | FStar_Pervasives_Native.Some n -> + if n <= (FStar_Compiler_List.length args1) + then + let eq_args1 as1 as2 = + FStar_Compiler_List.fold_left2 + (fun acc -> + fun uu___3 -> + fun uu___4 -> + match (uu___3, uu___4) with + | ((a1, uu___5), (a2, uu___6)) -> + let uu___7 = eq_t env a1 a2 in + eq_inj acc uu___7) + FStar_TypeChecker_TermEqAndSimplify.Equal as1 as2 in + let uu___3 = FStar_Compiler_List.splitAt n args1 in + (match uu___3 with + | (parms1, args11) -> + let uu___4 = FStar_Compiler_List.splitAt n args2 in + (match uu___4 with + | (parms2, args21) -> eq_args1 args11 args21)) + else FStar_TypeChecker_TermEqAndSimplify.Unknown)) + else FStar_TypeChecker_TermEqAndSimplify.NotEqual + | (FV (v1, us1, args1), FV (v2, us2, args2)) -> + let uu___ = FStar_Syntax_Syntax.fv_eq v1 v2 in + if uu___ + then + let uu___1 = + let uu___2 = FStar_Syntax_Util.eq_univs_list us1 us2 in + equal_iff uu___2 in + eq_and uu___1 (fun uu___2 -> eq_args env args1 args2) + else FStar_TypeChecker_TermEqAndSimplify.Unknown + | (Constant c1, Constant c2) -> eq_constant c1 c2 + | (Type_t u1, Type_t u2) -> + let uu___ = FStar_Syntax_Util.eq_univs u1 u2 in equal_iff uu___ + | (Univ u1, Univ u2) -> + let uu___ = FStar_Syntax_Util.eq_univs u1 u2 in equal_iff uu___ + | (Refinement (r1, t11), Refinement (r2, t21)) -> + let x = + FStar_Syntax_Syntax.new_bv FStar_Pervasives_Native.None + FStar_Syntax_Syntax.t_unit in + let uu___ = + let uu___1 = + let uu___2 = t11 () in FStar_Pervasives_Native.fst uu___2 in + let uu___2 = + let uu___3 = t21 () in FStar_Pervasives_Native.fst uu___3 in + eq_t env uu___1 uu___2 in + eq_and uu___ + (fun uu___1 -> + let uu___2 = let uu___3 = mkAccuVar x in r1 uu___3 in + let uu___3 = let uu___4 = mkAccuVar x in r2 uu___4 in + eq_t env uu___2 uu___3) + | (Unknown, Unknown) -> FStar_TypeChecker_TermEqAndSimplify.Equal + | (uu___, uu___1) -> FStar_TypeChecker_TermEqAndSimplify.Unknown +and (eq_atom : atom -> atom -> FStar_TypeChecker_TermEqAndSimplify.eq_result) + = fun a1 -> fun a2 -> match (a1, a2) with | (Var bv1, Var bv2) -> let uu___ = FStar_Syntax_Syntax.bv_eq bv1 bv2 in equal_if uu___ - | (uu___, uu___1) -> FStar_Syntax_Util.Unknown -and (eq_arg : arg -> arg -> FStar_Syntax_Util.eq_result) = - fun a1 -> - fun a2 -> - eq_t (FStar_Pervasives_Native.fst a1) (FStar_Pervasives_Native.fst a2) -and (eq_args : args -> args -> FStar_Syntax_Util.eq_result) = - fun as1 -> - fun as2 -> - match (as1, as2) with - | ([], []) -> FStar_Syntax_Util.Equal - | (x::xs, y::ys) -> - let uu___ = eq_arg x y in - eq_and uu___ (fun uu___1 -> eq_args xs ys) - | (uu___, uu___1) -> FStar_Syntax_Util.Unknown + | (uu___, uu___1) -> FStar_TypeChecker_TermEqAndSimplify.Unknown +and (eq_arg : + FStar_TypeChecker_Env.env_t -> + arg -> arg -> FStar_TypeChecker_TermEqAndSimplify.eq_result) + = + fun env -> + fun a1 -> + fun a2 -> + eq_t env (FStar_Pervasives_Native.fst a1) + (FStar_Pervasives_Native.fst a2) +and (eq_args : + FStar_TypeChecker_Env.env_t -> + args -> args -> FStar_TypeChecker_TermEqAndSimplify.eq_result) + = + fun env -> + fun as1 -> + fun as2 -> + match (as1, as2) with + | ([], []) -> FStar_TypeChecker_TermEqAndSimplify.Equal + | (x::xs, y::ys) -> + let uu___ = eq_arg env x y in + eq_and uu___ (fun uu___1 -> eq_args env xs ys) + | (uu___, uu___1) -> FStar_TypeChecker_TermEqAndSimplify.Unknown let (constant_to_string : constant -> Prims.string) = fun c -> match c with diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml index 5b16b2d2068..2a513661f11 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize.ml @@ -1,4 +1,8 @@ open Prims +let (dbg_univ_norm : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "univ_norm" +let (dbg_NormRebuild : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "NormRebuild" let (maybe_debug : FStar_TypeChecker_Cfg.cfg -> FStar_Syntax_Syntax.term -> @@ -357,9 +361,7 @@ let (norm_universe : (match uu___1 with | Univ u3 -> ((let uu___3 = - FStar_TypeChecker_Env.debug - cfg.FStar_TypeChecker_Cfg.tcenv - (FStar_Options.Other "univ_norm") in + FStar_Compiler_Effect.op_Bang dbg_univ_norm in if uu___3 then let uu___4 = @@ -1582,7 +1584,10 @@ let (reduce_equality : fun norm_cb -> fun cfg -> fun tm -> - reduce_primops norm_cb + let uu___ = + let uu___1 = + FStar_TypeChecker_Cfg.equality_ops + cfg.FStar_TypeChecker_Cfg.tcenv in { FStar_TypeChecker_Cfg.steps = { @@ -1652,8 +1657,7 @@ let (reduce_equality : FStar_TypeChecker_Cfg.debug = (cfg.FStar_TypeChecker_Cfg.debug); FStar_TypeChecker_Cfg.delta_level = (cfg.FStar_TypeChecker_Cfg.delta_level); - FStar_TypeChecker_Cfg.primitive_steps = - FStar_TypeChecker_Cfg.equality_ops; + FStar_TypeChecker_Cfg.primitive_steps = uu___1; FStar_TypeChecker_Cfg.strong = (cfg.FStar_TypeChecker_Cfg.strong); FStar_TypeChecker_Cfg.memoize_lazy = (cfg.FStar_TypeChecker_Cfg.memoize_lazy); @@ -1663,7 +1667,8 @@ let (reduce_equality : (cfg.FStar_TypeChecker_Cfg.reifying); FStar_TypeChecker_Cfg.compat_memo_ignore_cfg = (cfg.FStar_TypeChecker_Cfg.compat_memo_ignore_cfg) - } tm + } in + reduce_primops norm_cb uu___ tm type norm_request_t = | Norm_request_none | Norm_request_ready @@ -2803,27 +2808,25 @@ let rec (norm : rebuild cfg empty_env stack2 t1 | FStar_Syntax_Syntax.Tm_fvar { FStar_Syntax_Syntax.fv_name = uu___2; - FStar_Syntax_Syntax.fv_delta = uu___3; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Data_ctor);_} -> (FStar_TypeChecker_Cfg.log_unfolding cfg - (fun uu___5 -> - let uu___6 = FStar_Syntax_Print.term_to_string t1 in + (fun uu___4 -> + let uu___5 = FStar_Syntax_Print.term_to_string t1 in FStar_Compiler_Util.print1 - " >> This is a constructor: %s\n" uu___6); + " >> This is a constructor: %s\n" uu___5); rebuild cfg empty_env stack2 t1) | FStar_Syntax_Syntax.Tm_fvar { FStar_Syntax_Syntax.fv_name = uu___2; - FStar_Syntax_Syntax.fv_delta = uu___3; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Record_ctor uu___4);_} + (FStar_Syntax_Syntax.Record_ctor uu___3);_} -> (FStar_TypeChecker_Cfg.log_unfolding cfg - (fun uu___6 -> - let uu___7 = FStar_Syntax_Print.term_to_string t1 in + (fun uu___5 -> + let uu___6 = FStar_Syntax_Print.term_to_string t1 in FStar_Compiler_Util.print1 - " >> This is a constructor: %s\n" uu___7); + " >> This is a constructor: %s\n" uu___6); rebuild cfg empty_env stack2 t1) | FStar_Syntax_Syntax.Tm_fvar fv -> let lid = FStar_Syntax_Syntax.lid_of_fv fv in @@ -2831,10 +2834,10 @@ let rec (norm : FStar_TypeChecker_Env.lookup_qname cfg.FStar_TypeChecker_Cfg.tcenv lid in let uu___2 = - FStar_TypeChecker_Env.delta_depth_of_qninfo fv qninfo in + FStar_TypeChecker_Env.delta_depth_of_qninfo + cfg.FStar_TypeChecker_Cfg.tcenv fv qninfo in (match uu___2 with - | FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Delta_constant_at_level uu___3) when + | FStar_Syntax_Syntax.Delta_constant_at_level uu___3 when uu___3 = Prims.int_zero -> (FStar_TypeChecker_Cfg.log_unfolding cfg (fun uu___5 -> @@ -3651,9 +3654,15 @@ let rec (norm : (fun env2 -> fun uu___5 -> dummy :: env2) env1 bs1 in norm_comp cfg uu___4 c1 in - let t2 = - let uu___4 = norm_binders cfg env1 bs1 in - FStar_Syntax_Util.arrow uu___4 c2 in + let bs2 = + if + (cfg.FStar_TypeChecker_Cfg.steps).FStar_TypeChecker_Cfg.hnf + then + let uu___4 = close_binders cfg env1 bs1 in + FStar_Pervasives_Native.__proj__Mktuple2__item___1 + uu___4 + else norm_binders cfg env1 bs1 in + let t2 = FStar_Syntax_Util.arrow bs2 c2 in rebuild cfg env1 stack2 t2) | FStar_Syntax_Syntax.Tm_ascribed { FStar_Syntax_Syntax.tm = t11; @@ -4505,9 +4514,7 @@ and (do_unfold_fv : match stack1 with | (UnivArgs (us', uu___2))::stack2 -> ((let uu___4 = - FStar_TypeChecker_Env.debug - cfg.FStar_TypeChecker_Cfg.tcenv - (FStar_Options.Other "univ_norm") in + FStar_Compiler_Effect.op_Bang dbg_univ_norm in if uu___4 then FStar_Compiler_List.iter @@ -4966,7 +4973,8 @@ and (do_reify_monadic : (let maybe_range_arg = let uu___12 = FStar_Compiler_Util.for_some - (FStar_Syntax_Util.attr_eq + (FStar_TypeChecker_TermEqAndSimplify.eq_tm_bool + cfg.FStar_TypeChecker_Cfg.tcenv FStar_Syntax_Util.dm4f_bind_range_attr) ed.FStar_Syntax_Syntax.eff_attrs in if uu___12 @@ -6414,10 +6422,12 @@ and (maybe_simplify_aux : -> (t, false) | uu___32 -> let uu___33 = - norm_cb cfg in - reduce_equality - uu___33 cfg - env1 tm1)))))))))) + let uu___34 = + norm_cb cfg in + reduce_equality + uu___34 cfg + env1 in + uu___33 tm1)))))))))) | FStar_Syntax_Syntax.Tm_app { FStar_Syntax_Syntax.hd = @@ -6959,10 +6969,12 @@ and (maybe_simplify_aux : -> (t, false) | uu___28 -> let uu___29 = - norm_cb cfg in - reduce_equality - uu___29 cfg - env1 tm1)))))))))) + let uu___30 = + norm_cb cfg in + reduce_equality + uu___30 cfg + env1 in + uu___29 tm1)))))))))) | FStar_Syntax_Syntax.Tm_refine { FStar_Syntax_Syntax.b = bv; FStar_Syntax_Syntax.phi = t;_} @@ -7010,9 +7022,7 @@ and (rebuild : FStar_Compiler_Util.print4 ">>> %s\nRebuild %s with %s env elements and top of the stack %s\n" uu___3 uu___4 uu___5 uu___6); - (let uu___3 = - FStar_TypeChecker_Env.debug cfg.FStar_TypeChecker_Cfg.tcenv - (FStar_Options.Other "NormRebuild") in + (let uu___3 = FStar_Compiler_Effect.op_Bang dbg_NormRebuild in if uu___3 then let uu___4 = FStar_Syntax_Util.unbound_variables t in @@ -7805,17 +7815,15 @@ and (do_rebuild : | FStar_Syntax_Syntax.Tm_constant uu___2 -> true | FStar_Syntax_Syntax.Tm_fvar { FStar_Syntax_Syntax.fv_name = uu___2; - FStar_Syntax_Syntax.fv_delta = uu___3; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Data_ctor);_} -> true | FStar_Syntax_Syntax.Tm_fvar { FStar_Syntax_Syntax.fv_name = uu___2; - FStar_Syntax_Syntax.fv_delta = uu___3; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Record_ctor uu___4);_} + (FStar_Syntax_Syntax.Record_ctor uu___3);_} -> true | uu___2 -> false in let guard_when_clause wopt b rest = @@ -8439,7 +8447,7 @@ let (term_to_doc : FStar_Syntax_DsEnv.set_current_module env1.FStar_TypeChecker_Env.dsenv env1.FStar_TypeChecker_Env.curmodule in - FStar_Syntax_Print_Pretty.term_to_doc' uu___ t1 + FStar_Syntax_Print.term_to_doc' uu___ t1 let (term_to_string : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> Prims.string) = fun env1 -> @@ -8500,6 +8508,39 @@ let (comp_to_string : env1.FStar_TypeChecker_Env.dsenv env1.FStar_TypeChecker_Env.curmodule in FStar_Syntax_Print.comp_to_string' uu___1 c1) +let (comp_to_doc : + FStar_TypeChecker_Env.env -> + FStar_Syntax_Syntax.comp -> FStar_Pprint.document) + = + fun env1 -> + fun c -> + FStar_GenSym.with_frozen_gensym + (fun uu___ -> + let c1 = + try + (fun uu___1 -> + match () with + | () -> + let uu___2 = + FStar_TypeChecker_Cfg.config + [FStar_TypeChecker_Env.AllowUnboundUniverses] env1 in + norm_comp uu___2 [] c) () + with + | uu___1 -> + ((let uu___3 = + let uu___4 = + let uu___5 = FStar_Compiler_Util.message_of_exn uu___1 in + FStar_Compiler_Util.format1 + "Normalization failed with error %s\n" uu___5 in + (FStar_Errors_Codes.Warning_NormalizationFailure, + uu___4) in + FStar_Errors.log_issue c.FStar_Syntax_Syntax.pos uu___3); + c) in + let uu___1 = + FStar_Syntax_DsEnv.set_current_module + env1.FStar_TypeChecker_Env.dsenv + env1.FStar_TypeChecker_Env.curmodule in + FStar_Syntax_Print.comp_to_doc' uu___1 c1) let (normalize_refinement : FStar_TypeChecker_Env.steps -> FStar_TypeChecker_Env.env -> @@ -8991,7 +9032,8 @@ let rec (elim_uvars : FStar_Syntax_Syntax.params = binders; FStar_Syntax_Syntax.num_uniform_params = num_uniform; FStar_Syntax_Syntax.t = typ; FStar_Syntax_Syntax.mutuals = lids; - FStar_Syntax_Syntax.ds = lids';_} + FStar_Syntax_Syntax.ds = lids'; + FStar_Syntax_Syntax.injective_type_params = injective_type_params;_} -> let uu___ = elim_uvars_aux_t env1 univ_names binders typ in (match uu___ with @@ -9006,7 +9048,9 @@ let rec (elim_uvars : FStar_Syntax_Syntax.num_uniform_params = num_uniform; FStar_Syntax_Syntax.t = typ1; FStar_Syntax_Syntax.mutuals = lids; - FStar_Syntax_Syntax.ds = lids' + FStar_Syntax_Syntax.ds = lids'; + FStar_Syntax_Syntax.injective_type_params = + injective_type_params }); FStar_Syntax_Syntax.sigrng = (s1.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = @@ -9048,7 +9092,9 @@ let rec (elim_uvars : FStar_Syntax_Syntax.t1 = typ; FStar_Syntax_Syntax.ty_lid = lident; FStar_Syntax_Syntax.num_ty_params = i; - FStar_Syntax_Syntax.mutuals1 = lids;_} + FStar_Syntax_Syntax.mutuals1 = lids; + FStar_Syntax_Syntax.injective_type_params1 = + injective_type_params;_} -> let uu___ = elim_uvars_aux_t env1 univ_names [] typ in (match uu___ with @@ -9062,7 +9108,9 @@ let rec (elim_uvars : FStar_Syntax_Syntax.t1 = typ1; FStar_Syntax_Syntax.ty_lid = lident; FStar_Syntax_Syntax.num_ty_params = i; - FStar_Syntax_Syntax.mutuals1 = lids + FStar_Syntax_Syntax.mutuals1 = lids; + FStar_Syntax_Syntax.injective_type_params1 = + injective_type_params }); FStar_Syntax_Syntax.sigrng = (s1.FStar_Syntax_Syntax.sigrng); FStar_Syntax_Syntax.sigquals = @@ -9627,7 +9675,7 @@ let (get_n_binders : FStar_Syntax_Syntax.term -> (FStar_Syntax_Syntax.binder Prims.list * FStar_Syntax_Syntax.comp)) = fun env1 -> fun n -> fun t -> get_n_binders' env1 [] n t -let (uu___3790 : unit) = +let (uu___3806 : unit) = FStar_Compiler_Effect.op_Colon_Equals __get_n_binders get_n_binders' let (maybe_unfold_head_fv : FStar_TypeChecker_Env.env -> diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize_Unfolding.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize_Unfolding.ml index 76069b83a47..897e84643e9 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize_Unfolding.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Normalize_Unfolding.ml @@ -694,7 +694,8 @@ let (should_unfold : (cfg.FStar_TypeChecker_Cfg.steps).FStar_TypeChecker_Cfg.unfold_tac && (FStar_Compiler_Util.for_some - (FStar_Syntax_Util.attr_eq + (FStar_TypeChecker_TermEqAndSimplify.eq_tm_bool + cfg.FStar_TypeChecker_Cfg.tcenv FStar_Syntax_Util.tac_opaque_attr) attrs) -> (FStar_TypeChecker_Cfg.log_unfolding cfg @@ -709,8 +710,8 @@ let (should_unfold : FStar_Class_Show.show FStar_Syntax_Print.showable_fv fv in let uu___3 = let uu___4 = FStar_Syntax_Syntax.range_of_fv fv in - FStar_Class_Show.show FStar_Compiler_Range_Ops.show_range - uu___4 in + FStar_Class_Show.show + FStar_Compiler_Range_Ops.showable_range uu___4 in let uu___4 = FStar_Class_Show.show (FStar_Class_Show.show_tuple3 diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_PatternUtils.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_PatternUtils.ml index 59d2cb75bff..6121f349b6e 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_PatternUtils.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_PatternUtils.ml @@ -2,6 +2,8 @@ open Prims type lcomp_with_binder = (FStar_Syntax_Syntax.bv FStar_Pervasives_Native.option * FStar_TypeChecker_Common.lcomp) +let (dbg_Patterns : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Patterns" let rec (elaborate_pat : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.pat -> FStar_Syntax_Syntax.pat) @@ -17,10 +19,9 @@ let rec (elaborate_pat : match p.FStar_Syntax_Syntax.v with | FStar_Syntax_Syntax.Pat_cons ({ FStar_Syntax_Syntax.fv_name = uu___; - FStar_Syntax_Syntax.fv_delta = uu___1; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Unresolved_constructor uu___2);_}, - uu___3, uu___4) + (FStar_Syntax_Syntax.Unresolved_constructor uu___1);_}, + uu___2, uu___3) -> p | FStar_Syntax_Syntax.Pat_cons (fv, us_opt, pats) -> let pats1 = @@ -302,8 +303,7 @@ let (pat_as_exp : (match eopt with | FStar_Pervasives_Native.None -> ((let uu___1 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "Patterns") in + FStar_Compiler_Effect.op_Bang dbg_Patterns in if uu___1 then (if diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Positivity.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Positivity.ml index b1a4971caeb..881f4d8dd28 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Positivity.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Positivity.ml @@ -1,14 +1,11 @@ open Prims -let (string_of_lids : FStar_Ident.lident Prims.list -> Prims.string) = - fun lids -> - let uu___ = FStar_Compiler_List.map FStar_Ident.string_of_lid lids in - FStar_Compiler_String.concat ", " uu___ +let (dbg_Positivity : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Positivity" let (debug_positivity : FStar_TypeChecker_Env.env_t -> (unit -> Prims.string) -> unit) = fun env -> fun msg -> - let uu___ = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "Positivity") in + let uu___ = FStar_Compiler_Effect.op_Bang dbg_Positivity in if uu___ then let uu___1 = @@ -16,6 +13,10 @@ let (debug_positivity : Prims.strcat "Positivity::" uu___2 in FStar_Compiler_Util.print_string uu___1 else () +let (string_of_lids : FStar_Ident.lident Prims.list -> Prims.string) = + fun lids -> + let uu___ = FStar_Compiler_List.map FStar_Ident.string_of_lid lids in + FStar_Compiler_String.concat ", " uu___ let (normalize : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term) @@ -88,7 +89,10 @@ let (ty_occurs_in : fun ty_lid -> fun t -> let uu___ = FStar_Syntax_Free.fvars t in - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_fv ty_lid uu___ + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset FStar_Syntax_Syntax.ord_fv)) + ty_lid (Obj.magic uu___) let rec (term_as_fv_or_name : FStar_Syntax_Syntax.term -> ((FStar_Syntax_Syntax.fv * FStar_Syntax_Syntax.universes), @@ -135,10 +139,11 @@ let (open_sig_inductive_typ : FStar_Syntax_Syntax.num_uniform_params = uu___; FStar_Syntax_Syntax.t = uu___1; FStar_Syntax_Syntax.mutuals = uu___2; - FStar_Syntax_Syntax.ds = uu___3;_} + FStar_Syntax_Syntax.ds = uu___3; + FStar_Syntax_Syntax.injective_type_params = uu___4;_} -> - let uu___4 = FStar_Syntax_Subst.univ_var_opening ty_us in - (match uu___4 with + let uu___5 = FStar_Syntax_Subst.univ_var_opening ty_us in + (match uu___5 with | (ty_usubst, ty_us1) -> let env1 = FStar_TypeChecker_Env.push_univ_vars env ty_us1 in let ty_params1 = @@ -369,7 +374,9 @@ let (mark_uniform_type_parameters : FStar_Syntax_Syntax.num_uniform_params = uu___1; FStar_Syntax_Syntax.t = t; FStar_Syntax_Syntax.mutuals = mutuals; - FStar_Syntax_Syntax.ds = data_lids;_} + FStar_Syntax_Syntax.ds = data_lids; + FStar_Syntax_Syntax.injective_type_params = + injective_type_params;_} -> let uu___2 = open_sig_inductive_typ env tc in (match uu___2 with @@ -387,31 +394,33 @@ let (mark_uniform_type_parameters : FStar_Syntax_Syntax.t1 = dt; FStar_Syntax_Syntax.ty_lid = tc_lid'; FStar_Syntax_Syntax.num_ty_params = uu___5; - FStar_Syntax_Syntax.mutuals1 = uu___6;_} + FStar_Syntax_Syntax.mutuals1 = uu___6; + FStar_Syntax_Syntax.injective_type_params1 + = uu___7;_} -> - let uu___7 = + let uu___8 = FStar_Ident.lid_equals tc_lid1 tc_lid' in - if uu___7 + if uu___8 then let dt1 = - let uu___8 = - let uu___9 = + let uu___9 = + let uu___10 = FStar_Compiler_List.map - (fun uu___10 -> + (fun uu___11 -> FStar_Syntax_Syntax.U_name - uu___10) us1 in + uu___11) us1 in FStar_TypeChecker_Env.mk_univ_subst - d_us uu___9 in - FStar_Syntax_Subst.subst uu___8 dt in - let uu___8 = - let uu___9 = - let uu___10 = + d_us uu___10 in + FStar_Syntax_Subst.subst uu___9 dt in + let uu___9 = + let uu___10 = + let uu___11 = apply_constr_arrow d_lid dt1 ty_param_args in FStar_Syntax_Util.arrow_formals - uu___10 in - FStar_Pervasives_Native.fst uu___9 in - FStar_Pervasives_Native.Some uu___8 + uu___11 in + FStar_Pervasives_Native.fst uu___10 in + FStar_Pervasives_Native.Some uu___9 else FStar_Pervasives_Native.None | uu___5 -> FStar_Pervasives_Native.None) datas in let ty_param_bvs = @@ -470,7 +479,9 @@ let (mark_uniform_type_parameters : max_uniform_prefix); FStar_Syntax_Syntax.t = t; FStar_Syntax_Syntax.mutuals = mutuals; - FStar_Syntax_Syntax.ds = data_lids + FStar_Syntax_Syntax.ds = data_lids; + FStar_Syntax_Syntax.injective_type_params = + injective_type_params } in { FStar_Syntax_Syntax.sigel = sigel; diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops.ml index cc07f707b7a..24b4d5315cb 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops.ml @@ -1,18 +1,4 @@ open Prims -let (arg_as_int : - FStar_Syntax_Syntax.arg -> FStar_BigInt.t FStar_Pervasives_Native.option) = - fun a -> - FStar_TypeChecker_Primops_Base.try_unembed_simple - FStar_Syntax_Embeddings.e_int (FStar_Pervasives_Native.fst a) -let arg_as_list : - 'a . - 'a FStar_Syntax_Embeddings_Base.embedding -> - FStar_Syntax_Syntax.arg -> 'a Prims.list FStar_Pervasives_Native.option - = - fun e -> - fun a1 -> - FStar_TypeChecker_Primops_Base.try_unembed_simple - (FStar_Syntax_Embeddings.e_list e) (FStar_Pervasives_Native.fst a1) let (as_primitive_step : Prims.bool -> (FStar_Ident.lident * Prims.int * Prims.int * @@ -29,100 +15,6 @@ let (as_primitive_step : FStar_TypeChecker_Primops_Base.as_primitive_step_nbecbs is_strong (l, arity, u_arity, f, (fun cb -> fun univs -> fun args -> f_nbe univs args)) -let mixed_binary_op : - 'a 'b 'c . - (FStar_Syntax_Syntax.arg -> 'a FStar_Pervasives_Native.option) -> - (FStar_Syntax_Syntax.arg -> 'b FStar_Pervasives_Native.option) -> - (FStar_Compiler_Range_Type.range -> 'c -> FStar_Syntax_Syntax.term) - -> - (FStar_Compiler_Range_Type.range -> - FStar_Syntax_Syntax.universes -> - 'a -> 'b -> 'c FStar_Pervasives_Native.option) - -> - FStar_TypeChecker_Primops_Base.psc -> - FStar_Syntax_Embeddings_Base.norm_cb -> - FStar_Syntax_Syntax.universes -> - FStar_Syntax_Syntax.args -> - FStar_Syntax_Syntax.term FStar_Pervasives_Native.option - = - fun as_a -> - fun as_b -> - fun embed_c -> - fun f -> - fun psc -> - fun norm_cb -> - fun univs -> - fun args -> - match args with - | a1::b1::[] -> - let uu___ = - let uu___1 = as_a a1 in - let uu___2 = as_b b1 in (uu___1, uu___2) in - (match uu___ with - | (FStar_Pervasives_Native.Some a2, - FStar_Pervasives_Native.Some b2) -> - let uu___1 = - f psc.FStar_TypeChecker_Primops_Base.psc_range - univs a2 b2 in - (match uu___1 with - | FStar_Pervasives_Native.Some c1 -> - let uu___2 = - embed_c - psc.FStar_TypeChecker_Primops_Base.psc_range - c1 in - FStar_Pervasives_Native.Some uu___2 - | uu___2 -> FStar_Pervasives_Native.None) - | uu___1 -> FStar_Pervasives_Native.None) - | uu___ -> FStar_Pervasives_Native.None -let mixed_ternary_op : - 'a 'b 'c 'd . - (FStar_Syntax_Syntax.arg -> 'a FStar_Pervasives_Native.option) -> - (FStar_Syntax_Syntax.arg -> 'b FStar_Pervasives_Native.option) -> - (FStar_Syntax_Syntax.arg -> 'c FStar_Pervasives_Native.option) -> - (FStar_Compiler_Range_Type.range -> 'd -> FStar_Syntax_Syntax.term) - -> - (FStar_Compiler_Range_Type.range -> - FStar_Syntax_Syntax.universes -> - 'a -> 'b -> 'c -> 'd FStar_Pervasives_Native.option) - -> - FStar_TypeChecker_Primops_Base.psc -> - FStar_Syntax_Embeddings_Base.norm_cb -> - FStar_Syntax_Syntax.universes -> - FStar_Syntax_Syntax.args -> - FStar_Syntax_Syntax.term FStar_Pervasives_Native.option - = - fun as_a -> - fun as_b -> - fun as_c -> - fun embed_d -> - fun f -> - fun psc -> - fun norm_cb -> - fun univs -> - fun args -> - match args with - | a1::b1::c1::[] -> - let uu___ = - let uu___1 = as_a a1 in - let uu___2 = as_b b1 in - let uu___3 = as_c c1 in (uu___1, uu___2, uu___3) in - (match uu___ with - | (FStar_Pervasives_Native.Some a2, - FStar_Pervasives_Native.Some b2, - FStar_Pervasives_Native.Some c2) -> - let uu___1 = - f psc.FStar_TypeChecker_Primops_Base.psc_range - univs a2 b2 c2 in - (match uu___1 with - | FStar_Pervasives_Native.Some d1 -> - let uu___2 = - embed_d - psc.FStar_TypeChecker_Primops_Base.psc_range - d1 in - FStar_Pervasives_Native.Some uu___2 - | uu___2 -> FStar_Pervasives_Native.None) - | uu___1 -> FStar_Pervasives_Native.None) - | uu___ -> FStar_Pervasives_Native.None let (and_op : FStar_TypeChecker_Primops_Base.psc -> FStar_Syntax_Embeddings_Base.norm_cb -> @@ -516,63 +408,7 @@ let (simple_ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Compiler_String.substring s uu___53 uu___54) in - let uu___53 = - let uu___54 = - FStar_TypeChecker_Primops_Base.mk5 - Prims.int_zero - FStar_Parser_Const.mk_range_lid - FStar_Syntax_Embeddings.e_string - FStar_TypeChecker_NBETerm.e_string - FStar_Syntax_Embeddings.e_int - FStar_TypeChecker_NBETerm.e_int - FStar_Syntax_Embeddings.e_int - FStar_TypeChecker_NBETerm.e_int - FStar_Syntax_Embeddings.e_int - FStar_TypeChecker_NBETerm.e_int - FStar_Syntax_Embeddings.e_int - FStar_TypeChecker_NBETerm.e_int - FStar_Syntax_Embeddings.e_range - FStar_TypeChecker_NBETerm.e_range - (fun fn -> - fun from_l -> - fun from_c - -> - fun to_l - -> - fun to_c - -> - let uu___55 - = - let uu___56 - = - FStar_BigInt.to_int_fs - from_l in - let uu___57 - = - FStar_BigInt.to_int_fs - from_c in - FStar_Compiler_Range_Type.mk_pos - uu___56 - uu___57 in - let uu___56 - = - let uu___57 - = - FStar_BigInt.to_int_fs - to_l in - let uu___58 - = - FStar_BigInt.to_int_fs - to_c in - FStar_Compiler_Range_Type.mk_pos - uu___57 - uu___58 in - FStar_Compiler_Range_Type.mk_range - fn - uu___55 - uu___56) in - [uu___54] in - uu___52 :: uu___53 in + [uu___52] in uu___50 :: uu___51 in uu___48 :: uu___49 in uu___46 :: uu___47 in @@ -599,533 +435,6 @@ let (simple_ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = uu___4 :: uu___5 in uu___2 :: uu___3 in uu___ :: uu___1 -let (bogus_cbs : FStar_TypeChecker_NBETerm.nbe_cbs) = - { - FStar_TypeChecker_NBETerm.iapp = (fun h -> fun _args -> h); - FStar_TypeChecker_NBETerm.translate = - (fun uu___ -> FStar_Compiler_Effect.failwith "bogus_cbs translate") - } -let (issue_ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = - let mk_lid l = FStar_Parser_Const.p2l ["FStar"; "Issue"; l] in - let uu___ = - let uu___1 = mk_lid "message_of_issue" in - FStar_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___1 - FStar_Syntax_Embeddings.e_issue FStar_TypeChecker_NBETerm.e_issue - (FStar_Syntax_Embeddings.e_list FStar_Syntax_Embeddings.e_document) - (FStar_TypeChecker_NBETerm.e_list FStar_TypeChecker_NBETerm.e_document) - FStar_Errors.__proj__Mkissue__item__issue_msg in - let uu___1 = - let uu___2 = - let uu___3 = mk_lid "level_of_issue" in - FStar_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___3 - FStar_Syntax_Embeddings.e_issue FStar_TypeChecker_NBETerm.e_issue - FStar_Syntax_Embeddings.e_string FStar_TypeChecker_NBETerm.e_string - (fun i -> - FStar_Errors.string_of_issue_level i.FStar_Errors.issue_level) in - let uu___3 = - let uu___4 = - let uu___5 = mk_lid "number_of_issue" in - FStar_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___5 - FStar_Syntax_Embeddings.e_issue FStar_TypeChecker_NBETerm.e_issue - (FStar_Syntax_Embeddings.e_option FStar_Syntax_Embeddings.e_int) - (FStar_TypeChecker_NBETerm.e_option FStar_TypeChecker_NBETerm.e_int) - (fun uu___6 -> - (fun i -> - Obj.magic - (FStar_Class_Monad.fmap FStar_Class_Monad.monad_option () - () - (fun uu___6 -> (Obj.magic FStar_BigInt.of_int_fs) uu___6) - (Obj.magic i.FStar_Errors.issue_number))) uu___6) in - let uu___5 = - let uu___6 = - let uu___7 = mk_lid "range_of_issue" in - FStar_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___7 - FStar_Syntax_Embeddings.e_issue FStar_TypeChecker_NBETerm.e_issue - (FStar_Syntax_Embeddings.e_option FStar_Syntax_Embeddings.e_range) - (FStar_TypeChecker_NBETerm.e_option - FStar_TypeChecker_NBETerm.e_range) - FStar_Errors.__proj__Mkissue__item__issue_range in - let uu___7 = - let uu___8 = - let uu___9 = mk_lid "context_of_issue" in - FStar_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___9 - FStar_Syntax_Embeddings.e_issue - FStar_TypeChecker_NBETerm.e_issue - FStar_Syntax_Embeddings.e_string_list - FStar_TypeChecker_NBETerm.e_string_list - FStar_Errors.__proj__Mkissue__item__issue_ctx in - let uu___9 = - let uu___10 = - let uu___11 = mk_lid "render_issue" in - FStar_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___11 - FStar_Syntax_Embeddings.e_issue - FStar_TypeChecker_NBETerm.e_issue - FStar_Syntax_Embeddings.e_string - FStar_TypeChecker_NBETerm.e_string FStar_Errors.format_issue in - let uu___11 = - let uu___12 = - let uu___13 = mk_lid "mk_issue_doc" in - FStar_TypeChecker_Primops_Base.mk5 Prims.int_zero uu___13 - FStar_Syntax_Embeddings.e_string - FStar_TypeChecker_NBETerm.e_string - (FStar_Syntax_Embeddings.e_list - FStar_Syntax_Embeddings.e_document) - (FStar_TypeChecker_NBETerm.e_list - FStar_TypeChecker_NBETerm.e_document) - (FStar_Syntax_Embeddings.e_option - FStar_Syntax_Embeddings.e_range) - (FStar_TypeChecker_NBETerm.e_option - FStar_TypeChecker_NBETerm.e_range) - (FStar_Syntax_Embeddings.e_option - FStar_Syntax_Embeddings.e_int) - (FStar_TypeChecker_NBETerm.e_option - FStar_TypeChecker_NBETerm.e_int) - FStar_Syntax_Embeddings.e_string_list - FStar_TypeChecker_NBETerm.e_string_list - FStar_Syntax_Embeddings.e_issue - FStar_TypeChecker_NBETerm.e_issue - (fun level -> - fun msg -> - fun range -> - fun number -> - fun context -> - let uu___14 = - FStar_Errors.issue_level_of_string level in - let uu___15 = - Obj.magic - (FStar_Class_Monad.fmap - FStar_Class_Monad.monad_option () () - (fun uu___16 -> - (Obj.magic FStar_BigInt.to_int_fs) - uu___16) (Obj.magic number)) in - { - FStar_Errors.issue_msg = msg; - FStar_Errors.issue_level = uu___14; - FStar_Errors.issue_range = range; - FStar_Errors.issue_number = uu___15; - FStar_Errors.issue_ctx = context - }) in - [uu___12] in - uu___10 :: uu___11 in - uu___8 :: uu___9 in - uu___6 :: uu___7 in - uu___4 :: uu___5 in - uu___2 :: uu___3 in - uu___ :: uu___1 -let (seal_steps : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = - FStar_Compiler_List.map - (fun p -> - let uu___ = - FStar_TypeChecker_Primops_Base.as_primitive_step_nbecbs true p in - { - FStar_TypeChecker_Primops_Base.name = - (uu___.FStar_TypeChecker_Primops_Base.name); - FStar_TypeChecker_Primops_Base.arity = - (uu___.FStar_TypeChecker_Primops_Base.arity); - FStar_TypeChecker_Primops_Base.univ_arity = - (uu___.FStar_TypeChecker_Primops_Base.univ_arity); - FStar_TypeChecker_Primops_Base.auto_reflect = - (uu___.FStar_TypeChecker_Primops_Base.auto_reflect); - FStar_TypeChecker_Primops_Base.strong_reduction_ok = - (uu___.FStar_TypeChecker_Primops_Base.strong_reduction_ok); - FStar_TypeChecker_Primops_Base.requires_binder_substitution = - (uu___.FStar_TypeChecker_Primops_Base.requires_binder_substitution); - FStar_TypeChecker_Primops_Base.renorm_after = true; - FStar_TypeChecker_Primops_Base.interpretation = - (uu___.FStar_TypeChecker_Primops_Base.interpretation); - FStar_TypeChecker_Primops_Base.interpretation_nbe = - (uu___.FStar_TypeChecker_Primops_Base.interpretation_nbe) - }) - [(FStar_Parser_Const.map_seal_lid, (Prims.of_int (4)), - (Prims.of_int (2)), - ((fun psc -> - fun univs -> - fun cbs -> - fun args -> - match args with - | (ta, uu___)::(tb, uu___1)::(s, uu___2)::(f, uu___3)::[] -> - let try_unembed e x = - FStar_Syntax_Embeddings_Base.try_unembed e x - FStar_Syntax_Embeddings_Base.id_norm_cb in - let uu___4 = - let uu___5 = - try_unembed FStar_Syntax_Embeddings.e_any ta in - let uu___6 = - try_unembed FStar_Syntax_Embeddings.e_any tb in - let uu___7 = - try_unembed - (FStar_Syntax_Embeddings.e_sealed - FStar_Syntax_Embeddings.e_any) s in - let uu___8 = - try_unembed FStar_Syntax_Embeddings.e_any f in - (uu___5, uu___6, uu___7, uu___8) in - (match uu___4 with - | (FStar_Pervasives_Native.Some ta1, - FStar_Pervasives_Native.Some tb1, - FStar_Pervasives_Native.Some s1, - FStar_Pervasives_Native.Some f1) -> - let r = - let uu___5 = - let uu___6 = - FStar_Syntax_Syntax.as_arg - (FStar_Compiler_Sealed.unseal s1) in - [uu___6] in - FStar_Syntax_Util.mk_app f1 uu___5 in - let emb = - FStar_Syntax_Embeddings_Base.set_type ta1 - FStar_Syntax_Embeddings.e_any in - let uu___5 = - FStar_TypeChecker_Primops_Base.embed_simple - (FStar_Syntax_Embeddings.e_sealed emb) - psc.FStar_TypeChecker_Primops_Base.psc_range - (FStar_Compiler_Sealed.seal r) in - FStar_Pervasives_Native.Some uu___5 - | uu___5 -> FStar_Pervasives_Native.None) - | uu___ -> FStar_Pervasives_Native.None)), - ((fun cb -> - fun univs -> - fun args -> - match args with - | (ta, uu___)::(tb, uu___1)::(s, uu___2)::(f, uu___3)::[] -> - let try_unembed e x = - FStar_TypeChecker_NBETerm.unembed e bogus_cbs x in - let uu___4 = - let uu___5 = - try_unembed FStar_TypeChecker_NBETerm.e_any ta in - let uu___6 = - try_unembed FStar_TypeChecker_NBETerm.e_any tb in - let uu___7 = - try_unembed - (FStar_TypeChecker_NBETerm.e_sealed - FStar_TypeChecker_NBETerm.e_any) s in - let uu___8 = - try_unembed FStar_TypeChecker_NBETerm.e_any f in - (uu___5, uu___6, uu___7, uu___8) in - (match uu___4 with - | (FStar_Pervasives_Native.Some ta1, - FStar_Pervasives_Native.Some tb1, - FStar_Pervasives_Native.Some s1, - FStar_Pervasives_Native.Some f1) -> - let r = - let uu___5 = - let uu___6 = - FStar_TypeChecker_NBETerm.as_arg - (FStar_Compiler_Sealed.unseal s1) in - [uu___6] in - cb.FStar_TypeChecker_NBETerm.iapp f1 uu___5 in - let emb = - FStar_TypeChecker_NBETerm.set_type ta1 - FStar_TypeChecker_NBETerm.e_any in - let uu___5 = - FStar_TypeChecker_NBETerm.embed - (FStar_TypeChecker_NBETerm.e_sealed emb) cb - (FStar_Compiler_Sealed.seal r) in - FStar_Pervasives_Native.Some uu___5 - | uu___5 -> FStar_Pervasives_Native.None) - | uu___ -> FStar_Pervasives_Native.None))); - (FStar_Parser_Const.bind_seal_lid, (Prims.of_int (4)), - (Prims.of_int (2)), - ((fun psc -> - fun univs -> - fun cbs -> - fun args -> - match args with - | (ta, uu___)::(tb, uu___1)::(s, uu___2)::(f, uu___3)::[] -> - let try_unembed e x = - FStar_Syntax_Embeddings_Base.try_unembed e x - FStar_Syntax_Embeddings_Base.id_norm_cb in - let uu___4 = - let uu___5 = - try_unembed FStar_Syntax_Embeddings.e_any ta in - let uu___6 = - try_unembed FStar_Syntax_Embeddings.e_any tb in - let uu___7 = - try_unembed - (FStar_Syntax_Embeddings.e_sealed - FStar_Syntax_Embeddings.e_any) s in - let uu___8 = - try_unembed FStar_Syntax_Embeddings.e_any f in - (uu___5, uu___6, uu___7, uu___8) in - (match uu___4 with - | (FStar_Pervasives_Native.Some ta1, - FStar_Pervasives_Native.Some tb1, - FStar_Pervasives_Native.Some s1, - FStar_Pervasives_Native.Some f1) -> - let r = - let uu___5 = - let uu___6 = - FStar_Syntax_Syntax.as_arg - (FStar_Compiler_Sealed.unseal s1) in - [uu___6] in - FStar_Syntax_Util.mk_app f1 uu___5 in - let uu___5 = - FStar_TypeChecker_Primops_Base.embed_simple - FStar_Syntax_Embeddings.e_any - psc.FStar_TypeChecker_Primops_Base.psc_range r in - FStar_Pervasives_Native.Some uu___5 - | uu___5 -> FStar_Pervasives_Native.None) - | uu___ -> FStar_Pervasives_Native.None)), - ((fun cb -> - fun univs -> - fun args -> - match args with - | (ta, uu___)::(tb, uu___1)::(s, uu___2)::(f, uu___3)::[] -> - let try_unembed e x = - FStar_TypeChecker_NBETerm.unembed e bogus_cbs x in - let uu___4 = - let uu___5 = - try_unembed FStar_TypeChecker_NBETerm.e_any ta in - let uu___6 = - try_unembed FStar_TypeChecker_NBETerm.e_any tb in - let uu___7 = - try_unembed - (FStar_TypeChecker_NBETerm.e_sealed - FStar_TypeChecker_NBETerm.e_any) s in - let uu___8 = - try_unembed FStar_TypeChecker_NBETerm.e_any f in - (uu___5, uu___6, uu___7, uu___8) in - (match uu___4 with - | (FStar_Pervasives_Native.Some ta1, - FStar_Pervasives_Native.Some tb1, - FStar_Pervasives_Native.Some s1, - FStar_Pervasives_Native.Some f1) -> - let r = - let uu___5 = - let uu___6 = - FStar_TypeChecker_NBETerm.as_arg - (FStar_Compiler_Sealed.unseal s1) in - [uu___6] in - cb.FStar_TypeChecker_NBETerm.iapp f1 uu___5 in - let emb = - FStar_TypeChecker_NBETerm.set_type ta1 - FStar_TypeChecker_NBETerm.e_any in - let uu___5 = FStar_TypeChecker_NBETerm.embed emb cb r in - FStar_Pervasives_Native.Some uu___5 - | uu___5 -> FStar_Pervasives_Native.None) - | uu___ -> FStar_Pervasives_Native.None)))] -let (array_ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = - let of_list_op = - let emb_typ t = - let uu___ = - let uu___1 = - FStar_Ident.string_of_lid FStar_Parser_Const.immutable_array_t_lid in - (uu___1, [t]) in - FStar_Syntax_Syntax.ET_app uu___ in - let un_lazy universes t l r = - let uu___ = - let uu___1 = - FStar_Syntax_Util.fvar_const - FStar_Parser_Const.immutable_array_of_list_lid in - FStar_Syntax_Syntax.mk_Tm_uinst uu___1 universes in - let uu___1 = - let uu___2 = FStar_Syntax_Syntax.iarg t in - let uu___3 = let uu___4 = FStar_Syntax_Syntax.as_arg l in [uu___4] in - uu___2 :: uu___3 in - FStar_Syntax_Syntax.mk_Tm_app uu___ uu___1 r in - (FStar_Parser_Const.immutable_array_of_list_lid, (Prims.of_int (2)), - Prims.int_one, - (mixed_binary_op - (fun uu___ -> - match uu___ with - | (elt_t, uu___1) -> FStar_Pervasives_Native.Some elt_t) - (fun uu___ -> - match uu___ with - | (l, q) -> - let uu___1 = arg_as_list FStar_Syntax_Embeddings.e_any (l, q) in - (match uu___1 with - | FStar_Pervasives_Native.Some lst -> - FStar_Pervasives_Native.Some (l, lst) - | uu___2 -> FStar_Pervasives_Native.None)) - (fun r -> - fun uu___ -> - match uu___ with - | (universes, elt_t, (l, blob)) -> - let uu___1 = - let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = - let uu___6 = - FStar_Syntax_Embeddings_Base.emb_typ_of - FStar_Syntax_Embeddings.e_any () in - emb_typ uu___6 in - let uu___6 = - FStar_Thunk.mk - (fun uu___7 -> un_lazy universes elt_t l r) in - (uu___5, uu___6) in - FStar_Syntax_Syntax.Lazy_embedding uu___4 in - let uu___4 = - let uu___5 = - let uu___6 = - FStar_Syntax_Util.fvar_const - FStar_Parser_Const.immutable_array_t_lid in - FStar_Syntax_Syntax.mk_Tm_uinst uu___6 universes in - let uu___6 = - let uu___7 = FStar_Syntax_Syntax.as_arg elt_t in - [uu___7] in - FStar_Syntax_Syntax.mk_Tm_app uu___5 uu___6 r in - { - FStar_Syntax_Syntax.blob = blob; - FStar_Syntax_Syntax.lkind = uu___3; - FStar_Syntax_Syntax.ltyp = uu___4; - FStar_Syntax_Syntax.rng = r - } in - FStar_Syntax_Syntax.Tm_lazy uu___2 in - FStar_Syntax_Syntax.mk uu___1 r) - (fun r -> - fun universes -> - fun elt_t -> - fun uu___ -> - match uu___ with - | (l, lst) -> - let blob = FStar_ImmutableArray_Base.of_list lst in - let uu___1 = - let uu___2 = - let uu___3 = FStar_Compiler_Dyn.mkdyn blob in - (l, uu___3) in - (universes, elt_t, uu___2) in - FStar_Pervasives_Native.Some uu___1)), - (FStar_TypeChecker_NBETerm.mixed_binary_op - (fun uu___ -> - match uu___ with - | (elt_t, uu___1) -> FStar_Pervasives_Native.Some elt_t) - (fun uu___ -> - match uu___ with - | (l, q) -> - let uu___1 = - FStar_TypeChecker_NBETerm.arg_as_list - FStar_TypeChecker_NBETerm.e_any (l, q) in - (match uu___1 with - | FStar_Pervasives_Native.None -> - FStar_Pervasives_Native.None - | FStar_Pervasives_Native.Some lst -> - FStar_Pervasives_Native.Some (l, lst))) - (fun uu___ -> - match uu___ with - | (universes, elt_t, (l, blob)) -> - let uu___1 = - let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = - let uu___6 = - FStar_Syntax_Embeddings_Base.emb_typ_of - FStar_Syntax_Embeddings.e_any () in - emb_typ uu___6 in - (blob, uu___5) in - FStar_Pervasives.Inr uu___4 in - let uu___4 = - FStar_Thunk.mk - (fun uu___5 -> - let uu___6 = - let uu___7 = - let uu___8 = - FStar_Syntax_Syntax.lid_as_fv - FStar_Parser_Const.immutable_array_of_list_lid - FStar_Pervasives_Native.None in - let uu___9 = - let uu___10 = - FStar_TypeChecker_NBETerm.as_arg l in - [uu___10] in - (uu___8, universes, uu___9) in - FStar_TypeChecker_NBETerm.FV uu___7 in - FStar_TypeChecker_NBETerm.mk_t uu___6) in - (uu___3, uu___4) in - FStar_TypeChecker_NBETerm.Lazy uu___2 in - FStar_TypeChecker_NBETerm.mk_t uu___1) - (fun universes -> - fun elt_t -> - fun uu___ -> - match uu___ with - | (l, lst) -> - let blob = FStar_ImmutableArray_Base.of_list lst in - let uu___1 = - let uu___2 = - let uu___3 = FStar_Compiler_Dyn.mkdyn blob in - (l, uu___3) in - (universes, elt_t, uu___2) in - FStar_Pervasives_Native.Some uu___1))) in - let arg1_as_elt_t x = - FStar_Pervasives_Native.Some (FStar_Pervasives_Native.fst x) in - let arg2_as_blob x = - let uu___ = - let uu___1 = - FStar_Syntax_Subst.compress (FStar_Pervasives_Native.fst x) in - uu___1.FStar_Syntax_Syntax.n in - match uu___ with - | FStar_Syntax_Syntax.Tm_lazy - { FStar_Syntax_Syntax.blob = blob; - FStar_Syntax_Syntax.lkind = FStar_Syntax_Syntax.Lazy_embedding - (FStar_Syntax_Syntax.ET_app (head, uu___1), uu___2); - FStar_Syntax_Syntax.ltyp = uu___3; - FStar_Syntax_Syntax.rng = uu___4;_} - when - let uu___5 = - FStar_Ident.string_of_lid FStar_Parser_Const.immutable_array_t_lid in - head = uu___5 -> FStar_Pervasives_Native.Some blob - | uu___1 -> FStar_Pervasives_Native.None in - let arg2_as_blob_nbe x = - match (FStar_Pervasives_Native.fst x).FStar_TypeChecker_NBETerm.nbe_t - with - | FStar_TypeChecker_NBETerm.Lazy - (FStar_Pervasives.Inr - (blob, FStar_Syntax_Syntax.ET_app (head, uu___)), uu___1) - when - let uu___2 = - FStar_Ident.string_of_lid FStar_Parser_Const.immutable_array_t_lid in - head = uu___2 -> FStar_Pervasives_Native.Some blob - | uu___ -> FStar_Pervasives_Native.None in - let length_op = - let embed_int r i = - FStar_TypeChecker_Primops_Base.embed_simple - FStar_Syntax_Embeddings.e_int r i in - let run_op blob = - let uu___ = - let uu___1 = FStar_Compiler_Dyn.undyn blob in - FStar_Compiler_Util.array_length uu___1 in - FStar_Pervasives_Native.Some uu___ in - (FStar_Parser_Const.immutable_array_length_lid, (Prims.of_int (2)), - Prims.int_one, - (mixed_binary_op arg1_as_elt_t arg2_as_blob embed_int - (fun _r -> fun _universes -> fun uu___ -> fun blob -> run_op blob)), - (FStar_TypeChecker_NBETerm.mixed_binary_op - (fun uu___ -> - match uu___ with - | (elt_t, uu___1) -> FStar_Pervasives_Native.Some elt_t) - arg2_as_blob_nbe - (fun i -> - FStar_TypeChecker_NBETerm.embed FStar_TypeChecker_NBETerm.e_int - bogus_cbs i) - (fun _universes -> fun uu___ -> fun blob -> run_op blob))) in - let index_op = - (FStar_Parser_Const.immutable_array_index_lid, (Prims.of_int (3)), - Prims.int_one, - (mixed_ternary_op arg1_as_elt_t arg2_as_blob arg_as_int - (fun r -> fun tm -> tm) - (fun r -> - fun _universes -> - fun _t -> - fun blob -> - fun i -> - let uu___ = - let uu___1 = FStar_Compiler_Dyn.undyn blob in - FStar_Compiler_Util.array_index uu___1 i in - FStar_Pervasives_Native.Some uu___)), - (FStar_TypeChecker_NBETerm.mixed_ternary_op - (fun uu___ -> - match uu___ with - | (elt_t, uu___1) -> FStar_Pervasives_Native.Some elt_t) - arg2_as_blob_nbe FStar_TypeChecker_NBETerm.arg_as_int (fun tm -> tm) - (fun _universes -> - fun _t -> - fun blob -> - fun i -> - let uu___ = - let uu___1 = FStar_Compiler_Dyn.undyn blob in - FStar_Compiler_Util.array_index uu___1 i in - FStar_Pervasives_Native.Some uu___))) in - FStar_Compiler_List.map (as_primitive_step true) - [of_list_op; length_op; index_op] let (short_circuit_ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Compiler_List.map (as_primitive_step true) @@ -1137,9 +446,9 @@ let (built_in_primitive_steps_list : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = FStar_Compiler_List.op_At simple_ops (FStar_Compiler_List.op_At short_circuit_ops - (FStar_Compiler_List.op_At issue_ops - (FStar_Compiler_List.op_At array_ops - (FStar_Compiler_List.op_At seal_steps + (FStar_Compiler_List.op_At FStar_TypeChecker_Primops_Issue.ops + (FStar_Compiler_List.op_At FStar_TypeChecker_Primops_Array.ops + (FStar_Compiler_List.op_At FStar_TypeChecker_Primops_Sealed.ops (FStar_Compiler_List.op_At FStar_TypeChecker_Primops_Erased.ops (FStar_Compiler_List.op_At @@ -1147,8 +456,13 @@ let (built_in_primitive_steps_list : (FStar_Compiler_List.op_At FStar_TypeChecker_Primops_MachineInts.ops (FStar_Compiler_List.op_At - FStar_TypeChecker_Primops_Eq.dec_eq_ops - FStar_TypeChecker_Primops_Errors_Msg.ops)))))))) + FStar_TypeChecker_Primops_Errors_Msg.ops + FStar_TypeChecker_Primops_Range.ops)))))))) let (equality_ops_list : - FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = - FStar_TypeChecker_Primops_Eq.prop_eq_ops \ No newline at end of file + FStar_TypeChecker_Env.env_t -> + FStar_TypeChecker_Primops_Base.primitive_step Prims.list) + = fun env -> FStar_TypeChecker_Primops_Eq.prop_eq_ops env +let (env_dependent_ops : + FStar_TypeChecker_Env.env_t -> + FStar_TypeChecker_Primops_Base.primitive_step Prims.list) + = fun env -> FStar_TypeChecker_Primops_Eq.dec_eq_ops env \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Array.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Array.ml new file mode 100644 index 00000000000..dee26997e27 --- /dev/null +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Array.ml @@ -0,0 +1,354 @@ +open Prims +let (as_primitive_step : + Prims.bool -> + (FStar_Ident.lident * Prims.int * Prims.int * + FStar_TypeChecker_Primops_Base.interp_t * + (FStar_Syntax_Syntax.universes -> + FStar_TypeChecker_NBETerm.args -> + FStar_TypeChecker_NBETerm.t FStar_Pervasives_Native.option)) + -> FStar_TypeChecker_Primops_Base.primitive_step) + = + fun is_strong -> + fun uu___ -> + match uu___ with + | (l, arity, u_arity, f, f_nbe) -> + FStar_TypeChecker_Primops_Base.as_primitive_step_nbecbs is_strong + (l, arity, u_arity, f, + (fun cb -> fun univs -> fun args -> f_nbe univs args)) +let (arg_as_int : + FStar_Syntax_Syntax.arg -> FStar_BigInt.t FStar_Pervasives_Native.option) = + fun a -> + FStar_TypeChecker_Primops_Base.try_unembed_simple + FStar_Syntax_Embeddings.e_int (FStar_Pervasives_Native.fst a) +let arg_as_list : + 'a . + 'a FStar_Syntax_Embeddings_Base.embedding -> + FStar_Syntax_Syntax.arg -> 'a Prims.list FStar_Pervasives_Native.option + = + fun e -> + fun a1 -> + FStar_TypeChecker_Primops_Base.try_unembed_simple + (FStar_Syntax_Embeddings.e_list e) (FStar_Pervasives_Native.fst a1) +let mixed_binary_op : + 'a 'b 'c . + (FStar_Syntax_Syntax.arg -> 'a FStar_Pervasives_Native.option) -> + (FStar_Syntax_Syntax.arg -> 'b FStar_Pervasives_Native.option) -> + (FStar_Compiler_Range_Type.range -> 'c -> FStar_Syntax_Syntax.term) + -> + (FStar_Compiler_Range_Type.range -> + FStar_Syntax_Syntax.universes -> + 'a -> 'b -> 'c FStar_Pervasives_Native.option) + -> + FStar_TypeChecker_Primops_Base.psc -> + FStar_Syntax_Embeddings_Base.norm_cb -> + FStar_Syntax_Syntax.universes -> + FStar_Syntax_Syntax.args -> + FStar_Syntax_Syntax.term FStar_Pervasives_Native.option + = + fun as_a -> + fun as_b -> + fun embed_c -> + fun f -> + fun psc -> + fun norm_cb -> + fun univs -> + fun args -> + match args with + | a1::b1::[] -> + let uu___ = + let uu___1 = as_a a1 in + let uu___2 = as_b b1 in (uu___1, uu___2) in + (match uu___ with + | (FStar_Pervasives_Native.Some a2, + FStar_Pervasives_Native.Some b2) -> + let uu___1 = + f psc.FStar_TypeChecker_Primops_Base.psc_range + univs a2 b2 in + (match uu___1 with + | FStar_Pervasives_Native.Some c1 -> + let uu___2 = + embed_c + psc.FStar_TypeChecker_Primops_Base.psc_range + c1 in + FStar_Pervasives_Native.Some uu___2 + | uu___2 -> FStar_Pervasives_Native.None) + | uu___1 -> FStar_Pervasives_Native.None) + | uu___ -> FStar_Pervasives_Native.None +let mixed_ternary_op : + 'a 'b 'c 'd . + (FStar_Syntax_Syntax.arg -> 'a FStar_Pervasives_Native.option) -> + (FStar_Syntax_Syntax.arg -> 'b FStar_Pervasives_Native.option) -> + (FStar_Syntax_Syntax.arg -> 'c FStar_Pervasives_Native.option) -> + (FStar_Compiler_Range_Type.range -> 'd -> FStar_Syntax_Syntax.term) + -> + (FStar_Compiler_Range_Type.range -> + FStar_Syntax_Syntax.universes -> + 'a -> 'b -> 'c -> 'd FStar_Pervasives_Native.option) + -> + FStar_TypeChecker_Primops_Base.psc -> + FStar_Syntax_Embeddings_Base.norm_cb -> + FStar_Syntax_Syntax.universes -> + FStar_Syntax_Syntax.args -> + FStar_Syntax_Syntax.term FStar_Pervasives_Native.option + = + fun as_a -> + fun as_b -> + fun as_c -> + fun embed_d -> + fun f -> + fun psc -> + fun norm_cb -> + fun univs -> + fun args -> + match args with + | a1::b1::c1::[] -> + let uu___ = + let uu___1 = as_a a1 in + let uu___2 = as_b b1 in + let uu___3 = as_c c1 in (uu___1, uu___2, uu___3) in + (match uu___ with + | (FStar_Pervasives_Native.Some a2, + FStar_Pervasives_Native.Some b2, + FStar_Pervasives_Native.Some c2) -> + let uu___1 = + f psc.FStar_TypeChecker_Primops_Base.psc_range + univs a2 b2 c2 in + (match uu___1 with + | FStar_Pervasives_Native.Some d1 -> + let uu___2 = + embed_d + psc.FStar_TypeChecker_Primops_Base.psc_range + d1 in + FStar_Pervasives_Native.Some uu___2 + | uu___2 -> FStar_Pervasives_Native.None) + | uu___1 -> FStar_Pervasives_Native.None) + | uu___ -> FStar_Pervasives_Native.None +let (bogus_cbs : FStar_TypeChecker_NBETerm.nbe_cbs) = + { + FStar_TypeChecker_NBETerm.iapp = (fun h -> fun _args -> h); + FStar_TypeChecker_NBETerm.translate = + (fun uu___ -> FStar_Compiler_Effect.failwith "bogus_cbs translate") + } +let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = + let of_list_op = + let emb_typ t = + let uu___ = + let uu___1 = + FStar_Ident.string_of_lid FStar_Parser_Const.immutable_array_t_lid in + (uu___1, [t]) in + FStar_Syntax_Syntax.ET_app uu___ in + let un_lazy universes t l r = + let uu___ = + let uu___1 = + FStar_Syntax_Util.fvar_const + FStar_Parser_Const.immutable_array_of_list_lid in + FStar_Syntax_Syntax.mk_Tm_uinst uu___1 universes in + let uu___1 = + let uu___2 = FStar_Syntax_Syntax.iarg t in + let uu___3 = let uu___4 = FStar_Syntax_Syntax.as_arg l in [uu___4] in + uu___2 :: uu___3 in + FStar_Syntax_Syntax.mk_Tm_app uu___ uu___1 r in + (FStar_Parser_Const.immutable_array_of_list_lid, (Prims.of_int (2)), + Prims.int_one, + (mixed_binary_op + (fun uu___ -> + match uu___ with + | (elt_t, uu___1) -> FStar_Pervasives_Native.Some elt_t) + (fun uu___ -> + match uu___ with + | (l, q) -> + let uu___1 = arg_as_list FStar_Syntax_Embeddings.e_any (l, q) in + (match uu___1 with + | FStar_Pervasives_Native.Some lst -> + FStar_Pervasives_Native.Some (l, lst) + | uu___2 -> FStar_Pervasives_Native.None)) + (fun r -> + fun uu___ -> + match uu___ with + | (universes, elt_t, (l, blob)) -> + let uu___1 = + let uu___2 = + let uu___3 = + let uu___4 = + let uu___5 = + let uu___6 = + FStar_Syntax_Embeddings_Base.emb_typ_of + FStar_Syntax_Embeddings.e_any () in + emb_typ uu___6 in + let uu___6 = + FStar_Thunk.mk + (fun uu___7 -> un_lazy universes elt_t l r) in + (uu___5, uu___6) in + FStar_Syntax_Syntax.Lazy_embedding uu___4 in + let uu___4 = + let uu___5 = + let uu___6 = + FStar_Syntax_Util.fvar_const + FStar_Parser_Const.immutable_array_t_lid in + FStar_Syntax_Syntax.mk_Tm_uinst uu___6 universes in + let uu___6 = + let uu___7 = FStar_Syntax_Syntax.as_arg elt_t in + [uu___7] in + FStar_Syntax_Syntax.mk_Tm_app uu___5 uu___6 r in + { + FStar_Syntax_Syntax.blob = blob; + FStar_Syntax_Syntax.lkind = uu___3; + FStar_Syntax_Syntax.ltyp = uu___4; + FStar_Syntax_Syntax.rng = r + } in + FStar_Syntax_Syntax.Tm_lazy uu___2 in + FStar_Syntax_Syntax.mk uu___1 r) + (fun r -> + fun universes -> + fun elt_t -> + fun uu___ -> + match uu___ with + | (l, lst) -> + let blob = FStar_ImmutableArray_Base.of_list lst in + let uu___1 = + let uu___2 = + let uu___3 = FStar_Compiler_Dyn.mkdyn blob in + (l, uu___3) in + (universes, elt_t, uu___2) in + FStar_Pervasives_Native.Some uu___1)), + (FStar_TypeChecker_NBETerm.mixed_binary_op + (fun uu___ -> + match uu___ with + | (elt_t, uu___1) -> FStar_Pervasives_Native.Some elt_t) + (fun uu___ -> + match uu___ with + | (l, q) -> + let uu___1 = + FStar_TypeChecker_NBETerm.arg_as_list + FStar_TypeChecker_NBETerm.e_any (l, q) in + (match uu___1 with + | FStar_Pervasives_Native.None -> + FStar_Pervasives_Native.None + | FStar_Pervasives_Native.Some lst -> + FStar_Pervasives_Native.Some (l, lst))) + (fun uu___ -> + match uu___ with + | (universes, elt_t, (l, blob)) -> + let uu___1 = + let uu___2 = + let uu___3 = + let uu___4 = + let uu___5 = + let uu___6 = + FStar_Syntax_Embeddings_Base.emb_typ_of + FStar_Syntax_Embeddings.e_any () in + emb_typ uu___6 in + (blob, uu___5) in + FStar_Pervasives.Inr uu___4 in + let uu___4 = + FStar_Thunk.mk + (fun uu___5 -> + let uu___6 = + let uu___7 = + let uu___8 = + FStar_Syntax_Syntax.lid_as_fv + FStar_Parser_Const.immutable_array_of_list_lid + FStar_Pervasives_Native.None in + let uu___9 = + let uu___10 = + FStar_TypeChecker_NBETerm.as_arg l in + [uu___10] in + (uu___8, universes, uu___9) in + FStar_TypeChecker_NBETerm.FV uu___7 in + FStar_TypeChecker_NBETerm.mk_t uu___6) in + (uu___3, uu___4) in + FStar_TypeChecker_NBETerm.Lazy uu___2 in + FStar_TypeChecker_NBETerm.mk_t uu___1) + (fun universes -> + fun elt_t -> + fun uu___ -> + match uu___ with + | (l, lst) -> + let blob = FStar_ImmutableArray_Base.of_list lst in + let uu___1 = + let uu___2 = + let uu___3 = FStar_Compiler_Dyn.mkdyn blob in + (l, uu___3) in + (universes, elt_t, uu___2) in + FStar_Pervasives_Native.Some uu___1))) in + let arg1_as_elt_t x = + FStar_Pervasives_Native.Some (FStar_Pervasives_Native.fst x) in + let arg2_as_blob x = + let uu___ = + let uu___1 = + FStar_Syntax_Subst.compress (FStar_Pervasives_Native.fst x) in + uu___1.FStar_Syntax_Syntax.n in + match uu___ with + | FStar_Syntax_Syntax.Tm_lazy + { FStar_Syntax_Syntax.blob = blob; + FStar_Syntax_Syntax.lkind = FStar_Syntax_Syntax.Lazy_embedding + (FStar_Syntax_Syntax.ET_app (head, uu___1), uu___2); + FStar_Syntax_Syntax.ltyp = uu___3; + FStar_Syntax_Syntax.rng = uu___4;_} + when + let uu___5 = + FStar_Ident.string_of_lid FStar_Parser_Const.immutable_array_t_lid in + head = uu___5 -> FStar_Pervasives_Native.Some blob + | uu___1 -> FStar_Pervasives_Native.None in + let arg2_as_blob_nbe x = + match (FStar_Pervasives_Native.fst x).FStar_TypeChecker_NBETerm.nbe_t + with + | FStar_TypeChecker_NBETerm.Lazy + (FStar_Pervasives.Inr + (blob, FStar_Syntax_Syntax.ET_app (head, uu___)), uu___1) + when + let uu___2 = + FStar_Ident.string_of_lid FStar_Parser_Const.immutable_array_t_lid in + head = uu___2 -> FStar_Pervasives_Native.Some blob + | uu___ -> FStar_Pervasives_Native.None in + let length_op = + let embed_int r i = + FStar_TypeChecker_Primops_Base.embed_simple + FStar_Syntax_Embeddings.e_int r i in + let run_op blob = + let uu___ = + let uu___1 = FStar_Compiler_Dyn.undyn blob in + FStar_Compiler_Util.array_length uu___1 in + FStar_Pervasives_Native.Some uu___ in + (FStar_Parser_Const.immutable_array_length_lid, (Prims.of_int (2)), + Prims.int_one, + (mixed_binary_op arg1_as_elt_t arg2_as_blob embed_int + (fun _r -> fun _universes -> fun uu___ -> fun blob -> run_op blob)), + (FStar_TypeChecker_NBETerm.mixed_binary_op + (fun uu___ -> + match uu___ with + | (elt_t, uu___1) -> FStar_Pervasives_Native.Some elt_t) + arg2_as_blob_nbe + (fun i -> + FStar_TypeChecker_NBETerm.embed FStar_TypeChecker_NBETerm.e_int + bogus_cbs i) + (fun _universes -> fun uu___ -> fun blob -> run_op blob))) in + let index_op = + (FStar_Parser_Const.immutable_array_index_lid, (Prims.of_int (3)), + Prims.int_one, + (mixed_ternary_op arg1_as_elt_t arg2_as_blob arg_as_int + (fun r -> fun tm -> tm) + (fun r -> + fun _universes -> + fun _t -> + fun blob -> + fun i -> + let uu___ = + let uu___1 = FStar_Compiler_Dyn.undyn blob in + FStar_Compiler_Util.array_index uu___1 i in + FStar_Pervasives_Native.Some uu___)), + (FStar_TypeChecker_NBETerm.mixed_ternary_op + (fun uu___ -> + match uu___ with + | (elt_t, uu___1) -> FStar_Pervasives_Native.Some elt_t) + arg2_as_blob_nbe FStar_TypeChecker_NBETerm.arg_as_int (fun tm -> tm) + (fun _universes -> + fun _t -> + fun blob -> + fun i -> + let uu___ = + let uu___1 = FStar_Compiler_Dyn.undyn blob in + FStar_Compiler_Util.array_index uu___1 i in + FStar_Pervasives_Native.Some uu___))) in + FStar_Compiler_List.map (as_primitive_step true) + [of_list_op; length_op; index_op] \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Base.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Base.ml index d1342807be4..bb035047116 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Base.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Base.ml @@ -1981,4 +1981,303 @@ let mk5' : "arity")) in as_primitive_step_nbecbs true (name, (Prims.of_int (5)), u_arity, - interp, nbe_interp) \ No newline at end of file + interp, nbe_interp) +let mk6' : + 'a 'b 'c 'd 'e 'f 'r 'na 'nb 'nc 'nd 'ne 'nf 'nr . + Prims.int -> + FStar_Ident.lid -> + 'a FStar_Syntax_Embeddings_Base.embedding -> + 'na FStar_TypeChecker_NBETerm.embedding -> + 'b FStar_Syntax_Embeddings_Base.embedding -> + 'nb FStar_TypeChecker_NBETerm.embedding -> + 'c FStar_Syntax_Embeddings_Base.embedding -> + 'nc FStar_TypeChecker_NBETerm.embedding -> + 'd FStar_Syntax_Embeddings_Base.embedding -> + 'nd FStar_TypeChecker_NBETerm.embedding -> + 'e FStar_Syntax_Embeddings_Base.embedding -> + 'ne FStar_TypeChecker_NBETerm.embedding -> + 'f FStar_Syntax_Embeddings_Base.embedding -> + 'nf FStar_TypeChecker_NBETerm.embedding -> + 'r FStar_Syntax_Embeddings_Base.embedding -> + 'nr FStar_TypeChecker_NBETerm.embedding -> + ('a -> + 'b -> + 'c -> + 'd -> + 'e -> + 'f -> + 'r + FStar_Pervasives_Native.option) + -> + ('na -> + 'nb -> + 'nc -> + 'nd -> + 'ne -> + 'nf -> + 'nr + FStar_Pervasives_Native.option) + -> primitive_step + = + fun u_arity -> + fun name -> + fun uu___ -> + fun uu___1 -> + fun uu___2 -> + fun uu___3 -> + fun uu___4 -> + fun uu___5 -> + fun uu___6 -> + fun uu___7 -> + fun uu___8 -> + fun uu___9 -> + fun uu___10 -> + fun uu___11 -> + fun uu___12 -> + fun uu___13 -> + fun ff -> + fun nbe_ff -> + let interp psc1 cb us args = + match args with + | (a1, uu___14)::(b1, uu___15):: + (c1, uu___16)::(d1, uu___17):: + (e1, uu___18)::(f1, uu___19)::[] + -> + Obj.magic + (Obj.repr + (let uu___20 = + let uu___21 = + let uu___22 = + let uu___23 = + let uu___24 = + let uu___25 = + let uu___26 = + try_unembed_simple + uu___ a1 in + Obj.magic + (FStar_Class_Monad.op_Less_Dollar_Greater + FStar_Class_Monad.monad_option + () () + (fun + uu___27 + -> + (Obj.magic + ff) + uu___27) + (Obj.magic + uu___26)) in + let uu___26 = + try_unembed_simple + uu___2 b1 in + Obj.magic + (FStar_Class_Monad.op_Less_Star_Greater + FStar_Class_Monad.monad_option + () () + (Obj.magic + uu___25) + (Obj.magic + uu___26)) in + let uu___25 = + try_unembed_simple + uu___4 c1 in + Obj.magic + (FStar_Class_Monad.op_Less_Star_Greater + FStar_Class_Monad.monad_option + () () + (Obj.magic + uu___24) + (Obj.magic + uu___25)) in + let uu___24 = + try_unembed_simple + uu___6 d1 in + Obj.magic + (FStar_Class_Monad.op_Less_Star_Greater + FStar_Class_Monad.monad_option + () () + (Obj.magic + uu___23) + (Obj.magic + uu___24)) in + let uu___23 = + try_unembed_simple + uu___8 e1 in + Obj.magic + (FStar_Class_Monad.op_Less_Star_Greater + FStar_Class_Monad.monad_option + () () + (Obj.magic uu___22) + (Obj.magic uu___23)) in + let uu___22 = + try_unembed_simple + uu___10 f1 in + Obj.magic + (FStar_Class_Monad.op_Less_Star_Greater + FStar_Class_Monad.monad_option + () () + (Obj.magic uu___21) + (Obj.magic uu___22)) in + FStar_Class_Monad.op_let_Bang + FStar_Class_Monad.monad_option + () () (Obj.magic uu___20) + (fun uu___21 -> + (fun r1 -> + let r1 = + Obj.magic r1 in + Obj.magic + (FStar_Class_Monad.op_let_Bang + FStar_Class_Monad.monad_option + () () + (Obj.magic r1) + (fun uu___21 + -> + (fun r2 -> + let r2 = + Obj.magic + r2 in + let uu___21 + = + embed_simple + uu___12 + psc1.psc_range + r2 in + Obj.magic + (FStar_Class_Monad.return + FStar_Class_Monad.monad_option + () + (Obj.magic + uu___21))) + uu___21))) + uu___21))) + | uu___14 -> + Obj.magic + (Obj.repr + (FStar_Compiler_Effect.failwith + "arity")) in + let nbe_interp cbs us args = + match args with + | (a1, uu___14)::(b1, uu___15):: + (c1, uu___16)::(d1, uu___17):: + (e1, uu___18)::(f1, uu___19)::[] + -> + Obj.magic + (Obj.repr + (let uu___20 = + let uu___21 = + let uu___22 = + let uu___23 = + let uu___24 = + let uu___25 = + let uu___26 = + FStar_TypeChecker_NBETerm.unembed + (solve + uu___1) + cbs a1 in + Obj.magic + (FStar_Class_Monad.op_Less_Dollar_Greater + FStar_Class_Monad.monad_option + () () + (fun + uu___27 + -> + (Obj.magic + nbe_ff) + uu___27) + (Obj.magic + uu___26)) in + let uu___26 = + FStar_TypeChecker_NBETerm.unembed + (solve uu___3) + cbs b1 in + Obj.magic + (FStar_Class_Monad.op_Less_Star_Greater + FStar_Class_Monad.monad_option + () () + (Obj.magic + uu___25) + (Obj.magic + uu___26)) in + let uu___25 = + FStar_TypeChecker_NBETerm.unembed + (solve uu___5) + cbs c1 in + Obj.magic + (FStar_Class_Monad.op_Less_Star_Greater + FStar_Class_Monad.monad_option + () () + (Obj.magic + uu___24) + (Obj.magic + uu___25)) in + let uu___24 = + FStar_TypeChecker_NBETerm.unembed + (solve uu___7) + cbs d1 in + Obj.magic + (FStar_Class_Monad.op_Less_Star_Greater + FStar_Class_Monad.monad_option + () () + (Obj.magic + uu___23) + (Obj.magic + uu___24)) in + let uu___23 = + FStar_TypeChecker_NBETerm.unembed + (solve uu___9) cbs + e1 in + Obj.magic + (FStar_Class_Monad.op_Less_Star_Greater + FStar_Class_Monad.monad_option + () () + (Obj.magic uu___22) + (Obj.magic uu___23)) in + let uu___22 = + FStar_TypeChecker_NBETerm.unembed + (solve uu___11) cbs + f1 in + Obj.magic + (FStar_Class_Monad.op_Less_Star_Greater + FStar_Class_Monad.monad_option + () () + (Obj.magic uu___21) + (Obj.magic uu___22)) in + FStar_Class_Monad.op_let_Bang + FStar_Class_Monad.monad_option + () () (Obj.magic uu___20) + (fun uu___21 -> + (fun r1 -> + let r1 = + Obj.magic r1 in + Obj.magic + (FStar_Class_Monad.op_let_Bang + FStar_Class_Monad.monad_option + () () + (Obj.magic r1) + (fun uu___21 + -> + (fun r2 -> + let r2 = + Obj.magic + r2 in + let uu___21 + = + FStar_TypeChecker_NBETerm.embed + (solve + uu___13) + cbs r2 in + Obj.magic + (FStar_Class_Monad.return + FStar_Class_Monad.monad_option + () + (Obj.magic + uu___21))) + uu___21))) + uu___21))) + | uu___14 -> + Obj.magic + (Obj.repr + (FStar_Compiler_Effect.failwith + "arity")) in + as_primitive_step_nbecbs true + (name, (Prims.of_int (6)), u_arity, + interp, nbe_interp) \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Eq.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Eq.ml index 833b8d1e78e..257be3a2c80 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Eq.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Eq.ml @@ -1,38 +1,46 @@ open Prims let (s_eq : - FStar_Syntax_Embeddings.abstract_term -> + FStar_TypeChecker_Env.env_t -> FStar_Syntax_Embeddings.abstract_term -> FStar_Syntax_Embeddings.abstract_term -> - Prims.bool FStar_Pervasives_Native.option) + FStar_Syntax_Embeddings.abstract_term -> + Prims.bool FStar_Pervasives_Native.option) = - fun _typ -> - fun x -> - fun y -> - let uu___ = - FStar_Syntax_Util.eq_tm - (FStar_Syntax_Embeddings.__proj__Abstract__item__t x) - (FStar_Syntax_Embeddings.__proj__Abstract__item__t y) in - match uu___ with - | FStar_Syntax_Util.Equal -> FStar_Pervasives_Native.Some true - | FStar_Syntax_Util.NotEqual -> FStar_Pervasives_Native.Some false - | uu___1 -> FStar_Pervasives_Native.None + fun env -> + fun _typ -> + fun x -> + fun y -> + let uu___ = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env + (FStar_Syntax_Embeddings.__proj__Abstract__item__t x) + (FStar_Syntax_Embeddings.__proj__Abstract__item__t y) in + match uu___ with + | FStar_TypeChecker_TermEqAndSimplify.Equal -> + FStar_Pervasives_Native.Some true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> + FStar_Pervasives_Native.Some false + | uu___1 -> FStar_Pervasives_Native.None let (nbe_eq : - FStar_TypeChecker_NBETerm.abstract_nbe_term -> + FStar_TypeChecker_Env.env_t -> FStar_TypeChecker_NBETerm.abstract_nbe_term -> FStar_TypeChecker_NBETerm.abstract_nbe_term -> - Prims.bool FStar_Pervasives_Native.option) + FStar_TypeChecker_NBETerm.abstract_nbe_term -> + Prims.bool FStar_Pervasives_Native.option) = - fun _typ -> - fun x -> - fun y -> - let uu___ = - FStar_TypeChecker_NBETerm.eq_t - (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t x) - (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t y) in - match uu___ with - | FStar_Syntax_Util.Equal -> FStar_Pervasives_Native.Some true - | FStar_Syntax_Util.NotEqual -> FStar_Pervasives_Native.Some false - | uu___1 -> FStar_Pervasives_Native.None + fun env -> + fun _typ -> + fun x -> + fun y -> + let uu___ = + FStar_TypeChecker_NBETerm.eq_t env + (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t x) + (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t y) in + match uu___ with + | FStar_TypeChecker_TermEqAndSimplify.Equal -> + FStar_Pervasives_Native.Some true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> + FStar_Pervasives_Native.Some false + | uu___1 -> FStar_Pervasives_Native.None let push3 : 'uuuuu 'uuuuu1 'uuuuu2 'uuuuu3 'uuuuu4 . ('uuuuu -> 'uuuuu1) -> @@ -55,142 +63,76 @@ let negopt3 : (Obj.magic (FStar_Class_Monad.fmap FStar_Class_Monad.monad_option () () (fun uu___1 -> (Obj.magic Prims.op_Negation) uu___1))) uu___1) -let (dec_eq_ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = - let uu___ = - FStar_TypeChecker_Primops_Base.mk3' Prims.int_zero - FStar_Parser_Const.op_Eq FStar_Syntax_Embeddings.e_abstract_term - FStar_TypeChecker_NBETerm.e_abstract_nbe_term - FStar_Syntax_Embeddings.e_abstract_term - FStar_TypeChecker_NBETerm.e_abstract_nbe_term - FStar_Syntax_Embeddings.e_abstract_term - FStar_TypeChecker_NBETerm.e_abstract_nbe_term - FStar_Syntax_Embeddings.e_bool FStar_TypeChecker_NBETerm.e_bool s_eq - nbe_eq in - let uu___1 = - let uu___2 = +let (dec_eq_ops : + FStar_TypeChecker_Env.env_t -> + FStar_TypeChecker_Primops_Base.primitive_step Prims.list) + = + fun env -> + let uu___ = FStar_TypeChecker_Primops_Base.mk3' Prims.int_zero - FStar_Parser_Const.op_notEq FStar_Syntax_Embeddings.e_abstract_term + FStar_Parser_Const.op_Eq FStar_Syntax_Embeddings.e_abstract_term FStar_TypeChecker_NBETerm.e_abstract_nbe_term FStar_Syntax_Embeddings.e_abstract_term FStar_TypeChecker_NBETerm.e_abstract_nbe_term FStar_Syntax_Embeddings.e_abstract_term FStar_TypeChecker_NBETerm.e_abstract_nbe_term FStar_Syntax_Embeddings.e_bool FStar_TypeChecker_NBETerm.e_bool - ((negopt3 ()) s_eq) ((negopt3 ()) nbe_eq) in - [uu___2] in - uu___ :: uu___1 + (s_eq env) (nbe_eq env) in + let uu___1 = + let uu___2 = + FStar_TypeChecker_Primops_Base.mk3' Prims.int_zero + FStar_Parser_Const.op_notEq FStar_Syntax_Embeddings.e_abstract_term + FStar_TypeChecker_NBETerm.e_abstract_nbe_term + FStar_Syntax_Embeddings.e_abstract_term + FStar_TypeChecker_NBETerm.e_abstract_nbe_term + FStar_Syntax_Embeddings.e_abstract_term + FStar_TypeChecker_NBETerm.e_abstract_nbe_term + FStar_Syntax_Embeddings.e_bool FStar_TypeChecker_NBETerm.e_bool + ((negopt3 ()) (s_eq env)) ((negopt3 ()) (nbe_eq env)) in + [uu___2] in + uu___ :: uu___1 let (s_eq2 : - FStar_Syntax_Embeddings.abstract_term -> - FStar_Syntax_Embeddings.abstract_term -> - FStar_Syntax_Embeddings.abstract_term -> - FStar_Syntax_Embeddings.abstract_term FStar_Pervasives_Native.option) - = - fun _typ -> - fun x -> - fun y -> - let uu___ = - FStar_Syntax_Util.eq_tm - (FStar_Syntax_Embeddings.__proj__Abstract__item__t x) - (FStar_Syntax_Embeddings.__proj__Abstract__item__t y) in - match uu___ with - | FStar_Syntax_Util.Equal -> - FStar_Pervasives_Native.Some - (FStar_Syntax_Embeddings.Abstract FStar_Syntax_Util.t_true) - | FStar_Syntax_Util.NotEqual -> - FStar_Pervasives_Native.Some - (FStar_Syntax_Embeddings.Abstract FStar_Syntax_Util.t_false) - | uu___1 -> FStar_Pervasives_Native.None -let (nbe_eq2 : - FStar_TypeChecker_NBETerm.abstract_nbe_term -> - FStar_TypeChecker_NBETerm.abstract_nbe_term -> - FStar_TypeChecker_NBETerm.abstract_nbe_term -> - FStar_TypeChecker_NBETerm.abstract_nbe_term - FStar_Pervasives_Native.option) - = - fun _typ -> - fun x -> - fun y -> - let uu___ = - FStar_TypeChecker_NBETerm.eq_t - (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t x) - (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t y) in - match uu___ with - | FStar_Syntax_Util.Equal -> - let uu___1 = - let uu___2 = - let uu___3 = - FStar_Syntax_Syntax.lid_as_fv FStar_Parser_Const.true_lid - FStar_Pervasives_Native.None in - FStar_TypeChecker_NBETerm.mkFV uu___3 [] [] in - FStar_TypeChecker_NBETerm.AbstractNBE uu___2 in - FStar_Pervasives_Native.Some uu___1 - | FStar_Syntax_Util.NotEqual -> - let uu___1 = - let uu___2 = - let uu___3 = - FStar_Syntax_Syntax.lid_as_fv FStar_Parser_Const.false_lid - FStar_Pervasives_Native.None in - FStar_TypeChecker_NBETerm.mkFV uu___3 [] [] in - FStar_TypeChecker_NBETerm.AbstractNBE uu___2 in - FStar_Pervasives_Native.Some uu___1 - | FStar_Syntax_Util.Unknown -> FStar_Pervasives_Native.None -let (s_eq3 : - FStar_Syntax_Embeddings.abstract_term -> + FStar_TypeChecker_Env.env_t -> FStar_Syntax_Embeddings.abstract_term -> FStar_Syntax_Embeddings.abstract_term -> FStar_Syntax_Embeddings.abstract_term -> FStar_Syntax_Embeddings.abstract_term FStar_Pervasives_Native.option) = - fun typ1 -> - fun typ2 -> + fun env -> + fun _typ -> fun x -> fun y -> let uu___ = - let uu___1 = - FStar_Syntax_Util.eq_tm - (FStar_Syntax_Embeddings.__proj__Abstract__item__t typ1) - (FStar_Syntax_Embeddings.__proj__Abstract__item__t typ2) in - let uu___2 = - FStar_Syntax_Util.eq_tm - (FStar_Syntax_Embeddings.__proj__Abstract__item__t x) - (FStar_Syntax_Embeddings.__proj__Abstract__item__t y) in - (uu___1, uu___2) in + FStar_TypeChecker_TermEqAndSimplify.eq_tm env + (FStar_Syntax_Embeddings.__proj__Abstract__item__t x) + (FStar_Syntax_Embeddings.__proj__Abstract__item__t y) in match uu___ with - | (FStar_Syntax_Util.Equal, FStar_Syntax_Util.Equal) -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> FStar_Pervasives_Native.Some (FStar_Syntax_Embeddings.Abstract FStar_Syntax_Util.t_true) - | (FStar_Syntax_Util.NotEqual, uu___1) -> - FStar_Pervasives_Native.Some - (FStar_Syntax_Embeddings.Abstract FStar_Syntax_Util.t_false) - | (uu___1, FStar_Syntax_Util.NotEqual) -> + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> FStar_Pervasives_Native.Some (FStar_Syntax_Embeddings.Abstract FStar_Syntax_Util.t_false) | uu___1 -> FStar_Pervasives_Native.None -let (nbe_eq3 : - FStar_TypeChecker_NBETerm.abstract_nbe_term -> +let (nbe_eq2 : + FStar_TypeChecker_Env.env_t -> FStar_TypeChecker_NBETerm.abstract_nbe_term -> FStar_TypeChecker_NBETerm.abstract_nbe_term -> FStar_TypeChecker_NBETerm.abstract_nbe_term -> FStar_TypeChecker_NBETerm.abstract_nbe_term FStar_Pervasives_Native.option) = - fun typ1 -> - fun typ2 -> + fun env -> + fun _typ -> fun x -> fun y -> let uu___ = - let uu___1 = - FStar_TypeChecker_NBETerm.eq_t - (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t typ1) - (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t typ2) in - let uu___2 = - FStar_TypeChecker_NBETerm.eq_t - (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t x) - (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t y) in - (uu___1, uu___2) in + FStar_TypeChecker_NBETerm.eq_t env + (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t x) + (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t y) in match uu___ with - | (FStar_Syntax_Util.Equal, FStar_Syntax_Util.Equal) -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> let uu___1 = let uu___2 = let uu___3 = @@ -199,51 +141,142 @@ let (nbe_eq3 : FStar_TypeChecker_NBETerm.mkFV uu___3 [] [] in FStar_TypeChecker_NBETerm.AbstractNBE uu___2 in FStar_Pervasives_Native.Some uu___1 - | (FStar_Syntax_Util.NotEqual, uu___1) -> - let uu___2 = - let uu___3 = - let uu___4 = + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> + let uu___1 = + let uu___2 = + let uu___3 = FStar_Syntax_Syntax.lid_as_fv FStar_Parser_Const.false_lid FStar_Pervasives_Native.None in - FStar_TypeChecker_NBETerm.mkFV uu___4 [] [] in - FStar_TypeChecker_NBETerm.AbstractNBE uu___3 in - FStar_Pervasives_Native.Some uu___2 - | (uu___1, FStar_Syntax_Util.NotEqual) -> + FStar_TypeChecker_NBETerm.mkFV uu___3 [] [] in + FStar_TypeChecker_NBETerm.AbstractNBE uu___2 in + FStar_Pervasives_Native.Some uu___1 + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> + FStar_Pervasives_Native.None +let (s_eq3 : + FStar_TypeChecker_Env.env_t -> + FStar_Syntax_Embeddings.abstract_term -> + FStar_Syntax_Embeddings.abstract_term -> + FStar_Syntax_Embeddings.abstract_term -> + FStar_Syntax_Embeddings.abstract_term -> + FStar_Syntax_Embeddings.abstract_term + FStar_Pervasives_Native.option) + = + fun env -> + fun typ1 -> + fun typ2 -> + fun x -> + fun y -> + let uu___ = + let uu___1 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env + (FStar_Syntax_Embeddings.__proj__Abstract__item__t typ1) + (FStar_Syntax_Embeddings.__proj__Abstract__item__t typ2) in let uu___2 = - let uu___3 = - let uu___4 = - FStar_Syntax_Syntax.lid_as_fv - FStar_Parser_Const.false_lid - FStar_Pervasives_Native.None in - FStar_TypeChecker_NBETerm.mkFV uu___4 [] [] in - FStar_TypeChecker_NBETerm.AbstractNBE uu___3 in - FStar_Pervasives_Native.Some uu___2 - | uu___1 -> FStar_Pervasives_Native.None -let (prop_eq_ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) + FStar_TypeChecker_TermEqAndSimplify.eq_tm env + (FStar_Syntax_Embeddings.__proj__Abstract__item__t x) + (FStar_Syntax_Embeddings.__proj__Abstract__item__t y) in + (uu___1, uu___2) in + match uu___ with + | (FStar_TypeChecker_TermEqAndSimplify.Equal, + FStar_TypeChecker_TermEqAndSimplify.Equal) -> + FStar_Pervasives_Native.Some + (FStar_Syntax_Embeddings.Abstract FStar_Syntax_Util.t_true) + | (FStar_TypeChecker_TermEqAndSimplify.NotEqual, uu___1) -> + FStar_Pervasives_Native.Some + (FStar_Syntax_Embeddings.Abstract FStar_Syntax_Util.t_false) + | (uu___1, FStar_TypeChecker_TermEqAndSimplify.NotEqual) -> + FStar_Pervasives_Native.Some + (FStar_Syntax_Embeddings.Abstract FStar_Syntax_Util.t_false) + | uu___1 -> FStar_Pervasives_Native.None +let (nbe_eq3 : + FStar_TypeChecker_Env.env_t -> + FStar_TypeChecker_NBETerm.abstract_nbe_term -> + FStar_TypeChecker_NBETerm.abstract_nbe_term -> + FStar_TypeChecker_NBETerm.abstract_nbe_term -> + FStar_TypeChecker_NBETerm.abstract_nbe_term -> + FStar_TypeChecker_NBETerm.abstract_nbe_term + FStar_Pervasives_Native.option) = - let uu___ = - FStar_TypeChecker_Primops_Base.mk3' Prims.int_one - FStar_Parser_Const.eq2_lid FStar_Syntax_Embeddings.e_abstract_term - FStar_TypeChecker_NBETerm.e_abstract_nbe_term - FStar_Syntax_Embeddings.e_abstract_term - FStar_TypeChecker_NBETerm.e_abstract_nbe_term - FStar_Syntax_Embeddings.e_abstract_term - FStar_TypeChecker_NBETerm.e_abstract_nbe_term - FStar_Syntax_Embeddings.e_abstract_term - FStar_TypeChecker_NBETerm.e_abstract_nbe_term s_eq2 nbe_eq2 in - let uu___1 = - let uu___2 = - FStar_TypeChecker_Primops_Base.mk4' (Prims.of_int (2)) - FStar_Parser_Const.eq3_lid FStar_Syntax_Embeddings.e_abstract_term - FStar_TypeChecker_NBETerm.e_abstract_nbe_term - FStar_Syntax_Embeddings.e_abstract_term + fun env -> + fun typ1 -> + fun typ2 -> + fun x -> + fun y -> + let uu___ = + let uu___1 = + FStar_TypeChecker_NBETerm.eq_t env + (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t + typ1) + (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t + typ2) in + let uu___2 = + FStar_TypeChecker_NBETerm.eq_t env + (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t x) + (FStar_TypeChecker_NBETerm.__proj__AbstractNBE__item__t y) in + (uu___1, uu___2) in + match uu___ with + | (FStar_TypeChecker_TermEqAndSimplify.Equal, + FStar_TypeChecker_TermEqAndSimplify.Equal) -> + let uu___1 = + let uu___2 = + let uu___3 = + FStar_Syntax_Syntax.lid_as_fv + FStar_Parser_Const.true_lid + FStar_Pervasives_Native.None in + FStar_TypeChecker_NBETerm.mkFV uu___3 [] [] in + FStar_TypeChecker_NBETerm.AbstractNBE uu___2 in + FStar_Pervasives_Native.Some uu___1 + | (FStar_TypeChecker_TermEqAndSimplify.NotEqual, uu___1) -> + let uu___2 = + let uu___3 = + let uu___4 = + FStar_Syntax_Syntax.lid_as_fv + FStar_Parser_Const.false_lid + FStar_Pervasives_Native.None in + FStar_TypeChecker_NBETerm.mkFV uu___4 [] [] in + FStar_TypeChecker_NBETerm.AbstractNBE uu___3 in + FStar_Pervasives_Native.Some uu___2 + | (uu___1, FStar_TypeChecker_TermEqAndSimplify.NotEqual) -> + let uu___2 = + let uu___3 = + let uu___4 = + FStar_Syntax_Syntax.lid_as_fv + FStar_Parser_Const.false_lid + FStar_Pervasives_Native.None in + FStar_TypeChecker_NBETerm.mkFV uu___4 [] [] in + FStar_TypeChecker_NBETerm.AbstractNBE uu___3 in + FStar_Pervasives_Native.Some uu___2 + | uu___1 -> FStar_Pervasives_Native.None +let (prop_eq_ops : + FStar_TypeChecker_Env.env_t -> + FStar_TypeChecker_Primops_Base.primitive_step Prims.list) + = + fun env -> + let uu___ = + FStar_TypeChecker_Primops_Base.mk3' Prims.int_one + FStar_Parser_Const.eq2_lid FStar_Syntax_Embeddings.e_abstract_term FStar_TypeChecker_NBETerm.e_abstract_nbe_term FStar_Syntax_Embeddings.e_abstract_term FStar_TypeChecker_NBETerm.e_abstract_nbe_term FStar_Syntax_Embeddings.e_abstract_term FStar_TypeChecker_NBETerm.e_abstract_nbe_term FStar_Syntax_Embeddings.e_abstract_term - FStar_TypeChecker_NBETerm.e_abstract_nbe_term s_eq3 nbe_eq3 in - [uu___2] in - uu___ :: uu___1 \ No newline at end of file + FStar_TypeChecker_NBETerm.e_abstract_nbe_term (s_eq2 env) + (nbe_eq2 env) in + let uu___1 = + let uu___2 = + FStar_TypeChecker_Primops_Base.mk4' (Prims.of_int (2)) + FStar_Parser_Const.eq3_lid FStar_Syntax_Embeddings.e_abstract_term + FStar_TypeChecker_NBETerm.e_abstract_nbe_term + FStar_Syntax_Embeddings.e_abstract_term + FStar_TypeChecker_NBETerm.e_abstract_nbe_term + FStar_Syntax_Embeddings.e_abstract_term + FStar_TypeChecker_NBETerm.e_abstract_nbe_term + FStar_Syntax_Embeddings.e_abstract_term + FStar_TypeChecker_NBETerm.e_abstract_nbe_term + FStar_Syntax_Embeddings.e_abstract_term + FStar_TypeChecker_NBETerm.e_abstract_nbe_term (s_eq3 env) + (nbe_eq3 env) in + [uu___2] in + uu___ :: uu___1 \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Issue.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Issue.ml new file mode 100644 index 00000000000..85e367274c4 --- /dev/null +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Issue.ml @@ -0,0 +1,108 @@ +open Prims +let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = + let mk_lid l = FStar_Parser_Const.p2l ["FStar"; "Issue"; l] in + let uu___ = + let uu___1 = mk_lid "message_of_issue" in + FStar_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___1 + FStar_Syntax_Embeddings.e_issue FStar_TypeChecker_NBETerm.e_issue + (FStar_Syntax_Embeddings.e_list FStar_Syntax_Embeddings.e_document) + (FStar_TypeChecker_NBETerm.e_list FStar_TypeChecker_NBETerm.e_document) + FStar_Errors.__proj__Mkissue__item__issue_msg in + let uu___1 = + let uu___2 = + let uu___3 = mk_lid "level_of_issue" in + FStar_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___3 + FStar_Syntax_Embeddings.e_issue FStar_TypeChecker_NBETerm.e_issue + FStar_Syntax_Embeddings.e_string FStar_TypeChecker_NBETerm.e_string + (fun i -> + FStar_Errors.string_of_issue_level i.FStar_Errors.issue_level) in + let uu___3 = + let uu___4 = + let uu___5 = mk_lid "number_of_issue" in + FStar_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___5 + FStar_Syntax_Embeddings.e_issue FStar_TypeChecker_NBETerm.e_issue + (FStar_Syntax_Embeddings.e_option FStar_Syntax_Embeddings.e_int) + (FStar_TypeChecker_NBETerm.e_option FStar_TypeChecker_NBETerm.e_int) + (fun uu___6 -> + (fun i -> + Obj.magic + (FStar_Class_Monad.fmap FStar_Class_Monad.monad_option () + () + (fun uu___6 -> (Obj.magic FStar_BigInt.of_int_fs) uu___6) + (Obj.magic i.FStar_Errors.issue_number))) uu___6) in + let uu___5 = + let uu___6 = + let uu___7 = mk_lid "range_of_issue" in + FStar_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___7 + FStar_Syntax_Embeddings.e_issue FStar_TypeChecker_NBETerm.e_issue + (FStar_Syntax_Embeddings.e_option FStar_Syntax_Embeddings.e_range) + (FStar_TypeChecker_NBETerm.e_option + FStar_TypeChecker_NBETerm.e_range) + FStar_Errors.__proj__Mkissue__item__issue_range in + let uu___7 = + let uu___8 = + let uu___9 = mk_lid "context_of_issue" in + FStar_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___9 + FStar_Syntax_Embeddings.e_issue + FStar_TypeChecker_NBETerm.e_issue + FStar_Syntax_Embeddings.e_string_list + FStar_TypeChecker_NBETerm.e_string_list + FStar_Errors.__proj__Mkissue__item__issue_ctx in + let uu___9 = + let uu___10 = + let uu___11 = mk_lid "render_issue" in + FStar_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___11 + FStar_Syntax_Embeddings.e_issue + FStar_TypeChecker_NBETerm.e_issue + FStar_Syntax_Embeddings.e_string + FStar_TypeChecker_NBETerm.e_string FStar_Errors.format_issue in + let uu___11 = + let uu___12 = + let uu___13 = mk_lid "mk_issue_doc" in + FStar_TypeChecker_Primops_Base.mk5 Prims.int_zero uu___13 + FStar_Syntax_Embeddings.e_string + FStar_TypeChecker_NBETerm.e_string + (FStar_Syntax_Embeddings.e_list + FStar_Syntax_Embeddings.e_document) + (FStar_TypeChecker_NBETerm.e_list + FStar_TypeChecker_NBETerm.e_document) + (FStar_Syntax_Embeddings.e_option + FStar_Syntax_Embeddings.e_range) + (FStar_TypeChecker_NBETerm.e_option + FStar_TypeChecker_NBETerm.e_range) + (FStar_Syntax_Embeddings.e_option + FStar_Syntax_Embeddings.e_int) + (FStar_TypeChecker_NBETerm.e_option + FStar_TypeChecker_NBETerm.e_int) + FStar_Syntax_Embeddings.e_string_list + FStar_TypeChecker_NBETerm.e_string_list + FStar_Syntax_Embeddings.e_issue + FStar_TypeChecker_NBETerm.e_issue + (fun level -> + fun msg -> + fun range -> + fun number -> + fun context -> + let uu___14 = + FStar_Errors.issue_level_of_string level in + let uu___15 = + Obj.magic + (FStar_Class_Monad.fmap + FStar_Class_Monad.monad_option () () + (fun uu___16 -> + (Obj.magic FStar_BigInt.to_int_fs) + uu___16) (Obj.magic number)) in + { + FStar_Errors.issue_msg = msg; + FStar_Errors.issue_level = uu___14; + FStar_Errors.issue_range = range; + FStar_Errors.issue_number = uu___15; + FStar_Errors.issue_ctx = context + }) in + [uu___12] in + uu___10 :: uu___11 in + uu___8 :: uu___9 in + uu___6 :: uu___7 in + uu___4 :: uu___5 in + uu___2 :: uu___3 in + uu___ :: uu___1 \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Range.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Range.ml new file mode 100644 index 00000000000..426a3fb43ac --- /dev/null +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Range.ml @@ -0,0 +1,35 @@ +open Prims +let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = + let uu___ = + FStar_TypeChecker_Primops_Base.mk5 Prims.int_zero + FStar_Parser_Const.mk_range_lid FStar_Syntax_Embeddings.e_string + FStar_TypeChecker_NBETerm.e_string FStar_Syntax_Embeddings.e_int + FStar_TypeChecker_NBETerm.e_int FStar_Syntax_Embeddings.e_int + FStar_TypeChecker_NBETerm.e_int FStar_Syntax_Embeddings.e_int + FStar_TypeChecker_NBETerm.e_int FStar_Syntax_Embeddings.e_int + FStar_TypeChecker_NBETerm.e_int FStar_Syntax_Embeddings.e_range + FStar_TypeChecker_NBETerm.e_range + (fun fn -> + fun from_l -> + fun from_c -> + fun to_l -> + fun to_c -> + let uu___1 = + let uu___2 = FStar_BigInt.to_int_fs from_l in + let uu___3 = FStar_BigInt.to_int_fs from_c in + FStar_Compiler_Range_Type.mk_pos uu___2 uu___3 in + let uu___2 = + let uu___3 = FStar_BigInt.to_int_fs to_l in + let uu___4 = FStar_BigInt.to_int_fs to_c in + FStar_Compiler_Range_Type.mk_pos uu___3 uu___4 in + FStar_Compiler_Range_Type.mk_range fn uu___1 uu___2) in + let uu___1 = + let uu___2 = + FStar_TypeChecker_Primops_Base.mk2 Prims.int_zero + FStar_Parser_Const.join_range_lid FStar_Syntax_Embeddings.e_range + FStar_TypeChecker_NBETerm.e_range FStar_Syntax_Embeddings.e_range + FStar_TypeChecker_NBETerm.e_range FStar_Syntax_Embeddings.e_range + FStar_TypeChecker_NBETerm.e_range + FStar_Compiler_Range_Ops.union_ranges in + [uu___2] in + uu___ :: uu___1 \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Sealed.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Sealed.ml new file mode 100644 index 00000000000..e4896738c37 --- /dev/null +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Primops_Sealed.ml @@ -0,0 +1,198 @@ +open Prims +let (bogus_cbs : FStar_TypeChecker_NBETerm.nbe_cbs) = + { + FStar_TypeChecker_NBETerm.iapp = (fun h -> fun _args -> h); + FStar_TypeChecker_NBETerm.translate = + (fun uu___ -> FStar_Compiler_Effect.failwith "bogus_cbs translate") + } +let (ops : FStar_TypeChecker_Primops_Base.primitive_step Prims.list) = + FStar_Compiler_List.map + (fun p -> + let uu___ = + FStar_TypeChecker_Primops_Base.as_primitive_step_nbecbs true p in + { + FStar_TypeChecker_Primops_Base.name = + (uu___.FStar_TypeChecker_Primops_Base.name); + FStar_TypeChecker_Primops_Base.arity = + (uu___.FStar_TypeChecker_Primops_Base.arity); + FStar_TypeChecker_Primops_Base.univ_arity = + (uu___.FStar_TypeChecker_Primops_Base.univ_arity); + FStar_TypeChecker_Primops_Base.auto_reflect = + (uu___.FStar_TypeChecker_Primops_Base.auto_reflect); + FStar_TypeChecker_Primops_Base.strong_reduction_ok = + (uu___.FStar_TypeChecker_Primops_Base.strong_reduction_ok); + FStar_TypeChecker_Primops_Base.requires_binder_substitution = + (uu___.FStar_TypeChecker_Primops_Base.requires_binder_substitution); + FStar_TypeChecker_Primops_Base.renorm_after = true; + FStar_TypeChecker_Primops_Base.interpretation = + (uu___.FStar_TypeChecker_Primops_Base.interpretation); + FStar_TypeChecker_Primops_Base.interpretation_nbe = + (uu___.FStar_TypeChecker_Primops_Base.interpretation_nbe) + }) + [(FStar_Parser_Const.map_seal_lid, (Prims.of_int (4)), + (Prims.of_int (2)), + ((fun psc -> + fun univs -> + fun cbs -> + fun args -> + match args with + | (ta, uu___)::(tb, uu___1)::(s, uu___2)::(f, uu___3)::[] -> + let try_unembed e x = + FStar_Syntax_Embeddings_Base.try_unembed e x + FStar_Syntax_Embeddings_Base.id_norm_cb in + let uu___4 = + let uu___5 = + try_unembed FStar_Syntax_Embeddings.e_any ta in + let uu___6 = + try_unembed FStar_Syntax_Embeddings.e_any tb in + let uu___7 = + try_unembed + (FStar_Syntax_Embeddings.e_sealed + FStar_Syntax_Embeddings.e_any) s in + let uu___8 = + try_unembed FStar_Syntax_Embeddings.e_any f in + (uu___5, uu___6, uu___7, uu___8) in + (match uu___4 with + | (FStar_Pervasives_Native.Some ta1, + FStar_Pervasives_Native.Some tb1, + FStar_Pervasives_Native.Some s1, + FStar_Pervasives_Native.Some f1) -> + let r = + let uu___5 = + let uu___6 = + FStar_Syntax_Syntax.as_arg + (FStar_Compiler_Sealed.unseal s1) in + [uu___6] in + FStar_Syntax_Util.mk_app f1 uu___5 in + let emb = + FStar_Syntax_Embeddings_Base.set_type ta1 + FStar_Syntax_Embeddings.e_any in + let uu___5 = + FStar_TypeChecker_Primops_Base.embed_simple + (FStar_Syntax_Embeddings.e_sealed emb) + psc.FStar_TypeChecker_Primops_Base.psc_range + (FStar_Compiler_Sealed.seal r) in + FStar_Pervasives_Native.Some uu___5 + | uu___5 -> FStar_Pervasives_Native.None) + | uu___ -> FStar_Pervasives_Native.None)), + ((fun cb -> + fun univs -> + fun args -> + match args with + | (ta, uu___)::(tb, uu___1)::(s, uu___2)::(f, uu___3)::[] -> + let try_unembed e x = + FStar_TypeChecker_NBETerm.unembed e bogus_cbs x in + let uu___4 = + let uu___5 = + try_unembed FStar_TypeChecker_NBETerm.e_any ta in + let uu___6 = + try_unembed FStar_TypeChecker_NBETerm.e_any tb in + let uu___7 = + try_unembed + (FStar_TypeChecker_NBETerm.e_sealed + FStar_TypeChecker_NBETerm.e_any) s in + let uu___8 = + try_unembed FStar_TypeChecker_NBETerm.e_any f in + (uu___5, uu___6, uu___7, uu___8) in + (match uu___4 with + | (FStar_Pervasives_Native.Some ta1, + FStar_Pervasives_Native.Some tb1, + FStar_Pervasives_Native.Some s1, + FStar_Pervasives_Native.Some f1) -> + let r = + let uu___5 = + let uu___6 = + FStar_TypeChecker_NBETerm.as_arg + (FStar_Compiler_Sealed.unseal s1) in + [uu___6] in + cb.FStar_TypeChecker_NBETerm.iapp f1 uu___5 in + let emb = + FStar_TypeChecker_NBETerm.set_type ta1 + FStar_TypeChecker_NBETerm.e_any in + let uu___5 = + FStar_TypeChecker_NBETerm.embed + (FStar_TypeChecker_NBETerm.e_sealed emb) cb + (FStar_Compiler_Sealed.seal r) in + FStar_Pervasives_Native.Some uu___5 + | uu___5 -> FStar_Pervasives_Native.None) + | uu___ -> FStar_Pervasives_Native.None))); + (FStar_Parser_Const.bind_seal_lid, (Prims.of_int (4)), + (Prims.of_int (2)), + ((fun psc -> + fun univs -> + fun cbs -> + fun args -> + match args with + | (ta, uu___)::(tb, uu___1)::(s, uu___2)::(f, uu___3)::[] -> + let try_unembed e x = + FStar_Syntax_Embeddings_Base.try_unembed e x + FStar_Syntax_Embeddings_Base.id_norm_cb in + let uu___4 = + let uu___5 = + try_unembed FStar_Syntax_Embeddings.e_any ta in + let uu___6 = + try_unembed FStar_Syntax_Embeddings.e_any tb in + let uu___7 = + try_unembed + (FStar_Syntax_Embeddings.e_sealed + FStar_Syntax_Embeddings.e_any) s in + let uu___8 = + try_unembed FStar_Syntax_Embeddings.e_any f in + (uu___5, uu___6, uu___7, uu___8) in + (match uu___4 with + | (FStar_Pervasives_Native.Some ta1, + FStar_Pervasives_Native.Some tb1, + FStar_Pervasives_Native.Some s1, + FStar_Pervasives_Native.Some f1) -> + let r = + let uu___5 = + let uu___6 = + FStar_Syntax_Syntax.as_arg + (FStar_Compiler_Sealed.unseal s1) in + [uu___6] in + FStar_Syntax_Util.mk_app f1 uu___5 in + let uu___5 = + FStar_TypeChecker_Primops_Base.embed_simple + FStar_Syntax_Embeddings.e_any + psc.FStar_TypeChecker_Primops_Base.psc_range r in + FStar_Pervasives_Native.Some uu___5 + | uu___5 -> FStar_Pervasives_Native.None) + | uu___ -> FStar_Pervasives_Native.None)), + ((fun cb -> + fun univs -> + fun args -> + match args with + | (ta, uu___)::(tb, uu___1)::(s, uu___2)::(f, uu___3)::[] -> + let try_unembed e x = + FStar_TypeChecker_NBETerm.unembed e bogus_cbs x in + let uu___4 = + let uu___5 = + try_unembed FStar_TypeChecker_NBETerm.e_any ta in + let uu___6 = + try_unembed FStar_TypeChecker_NBETerm.e_any tb in + let uu___7 = + try_unembed + (FStar_TypeChecker_NBETerm.e_sealed + FStar_TypeChecker_NBETerm.e_any) s in + let uu___8 = + try_unembed FStar_TypeChecker_NBETerm.e_any f in + (uu___5, uu___6, uu___7, uu___8) in + (match uu___4 with + | (FStar_Pervasives_Native.Some ta1, + FStar_Pervasives_Native.Some tb1, + FStar_Pervasives_Native.Some s1, + FStar_Pervasives_Native.Some f1) -> + let r = + let uu___5 = + let uu___6 = + FStar_TypeChecker_NBETerm.as_arg + (FStar_Compiler_Sealed.unseal s1) in + [uu___6] in + cb.FStar_TypeChecker_NBETerm.iapp f1 uu___5 in + let emb = + FStar_TypeChecker_NBETerm.set_type ta1 + FStar_TypeChecker_NBETerm.e_any in + let uu___5 = FStar_TypeChecker_NBETerm.embed emb cb r in + FStar_Pervasives_Native.Some uu___5 + | uu___5 -> FStar_Pervasives_Native.None) + | uu___ -> FStar_Pervasives_Native.None)))] \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Quals.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Quals.ml index 9da0d84e52f..1e4676af129 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Quals.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Quals.ml @@ -499,85 +499,88 @@ let (check_must_erase_attribute : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.sigelt -> unit) = fun env -> fun se -> - match se.FStar_Syntax_Syntax.sigel with - | FStar_Syntax_Syntax.Sig_let - { FStar_Syntax_Syntax.lbs1 = lbs; FStar_Syntax_Syntax.lids1 = l;_} - -> - let uu___ = - let uu___1 = FStar_Options.ide () in Prims.op_Negation uu___1 in - if uu___ - then - let uu___1 = - let uu___2 = FStar_TypeChecker_Env.dsenv env in - let uu___3 = FStar_TypeChecker_Env.current_module env in - FStar_Syntax_DsEnv.iface_decls uu___2 uu___3 in - (match uu___1 with - | FStar_Pervasives_Native.None -> () - | FStar_Pervasives_Native.Some iface_decls -> - FStar_Compiler_List.iter - (fun lb -> - let lbname = - FStar_Compiler_Util.right - lb.FStar_Syntax_Syntax.lbname in - let has_iface_val = - let uu___2 = - let uu___3 = - FStar_Ident.ident_of_lid - (lbname.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - FStar_Parser_AST.decl_is_val uu___3 in - FStar_Compiler_Util.for_some uu___2 iface_decls in - if has_iface_val - then - let must_erase = - FStar_TypeChecker_Util.must_erase_for_extraction - env lb.FStar_Syntax_Syntax.lbdef in - let has_attr = - FStar_TypeChecker_Env.fv_has_attr env lbname - FStar_Parser_Const.must_erase_for_extraction_attr in - (if must_erase && (Prims.op_Negation has_attr) - then - let uu___2 = - FStar_Syntax_Syntax.range_of_fv lbname in - let uu___3 = - let uu___4 = + let uu___ = FStar_Options.ide () in + if uu___ + then () + else + (match se.FStar_Syntax_Syntax.sigel with + | FStar_Syntax_Syntax.Sig_let + { FStar_Syntax_Syntax.lbs1 = lbs; + FStar_Syntax_Syntax.lids1 = l;_} + -> + let uu___2 = + let uu___3 = FStar_TypeChecker_Env.dsenv env in + let uu___4 = FStar_TypeChecker_Env.current_module env in + FStar_Syntax_DsEnv.iface_decls uu___3 uu___4 in + (match uu___2 with + | FStar_Pervasives_Native.None -> () + | FStar_Pervasives_Native.Some iface_decls -> + FStar_Compiler_List.iter + (fun lb -> + let lbname = + FStar_Compiler_Util.right + lb.FStar_Syntax_Syntax.lbname in + let has_iface_val = + let uu___3 = + let uu___4 = + FStar_Ident.ident_of_lid + (lbname.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in + FStar_Parser_AST.decl_is_val uu___4 in + FStar_Compiler_Util.for_some uu___3 iface_decls in + if has_iface_val + then + let must_erase = + FStar_TypeChecker_Util.must_erase_for_extraction + env lb.FStar_Syntax_Syntax.lbdef in + let has_attr = + FStar_TypeChecker_Env.fv_has_attr env lbname + FStar_Parser_Const.must_erase_for_extraction_attr in + (if must_erase && (Prims.op_Negation has_attr) + then + let uu___3 = + FStar_Syntax_Syntax.range_of_fv lbname in + let uu___4 = + let uu___5 = + let uu___6 = + let uu___7 = + let uu___8 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_fv lbname in + let uu___9 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_fv lbname in + FStar_Compiler_Util.format2 + "Values of type `%s` will be erased during extraction, but its interface hides this fact. Add the `must_erase_for_extraction` attribute to the `val %s` declaration for this symbol in the interface" + uu___8 uu___9 in + FStar_Errors_Msg.text uu___7 in + [uu___6] in + (FStar_Errors_Codes.Error_MustEraseMissing, + uu___5) in + FStar_Errors.log_issue_doc uu___3 uu___4 + else + if has_attr && (Prims.op_Negation must_erase) + then + (let uu___4 = + FStar_Syntax_Syntax.range_of_fv lbname in let uu___5 = let uu___6 = let uu___7 = - FStar_Syntax_Print.fv_to_string lbname in - let uu___8 = - FStar_Syntax_Print.fv_to_string lbname in - FStar_Compiler_Util.format2 - "Values of type `%s` will be erased during extraction, but its interface hides this fact. Add the `must_erase_for_extraction` attribute to the `val %s` declaration for this symbol in the interface" - uu___7 uu___8 in - FStar_Errors_Msg.text uu___6 in - [uu___5] in - (FStar_Errors_Codes.Error_MustEraseMissing, - uu___4) in - FStar_Errors.log_issue_doc uu___2 uu___3 - else - if has_attr && (Prims.op_Negation must_erase) - then - (let uu___3 = - FStar_Syntax_Syntax.range_of_fv lbname in - let uu___4 = - let uu___5 = - let uu___6 = - let uu___7 = - let uu___8 = - FStar_Syntax_Print.fv_to_string - lbname in - FStar_Compiler_Util.format1 - "Values of type `%s` cannot be erased during extraction, but the `must_erase_for_extraction` attribute claims that it can. Please remove the attribute." - uu___8 in - FStar_Errors_Msg.text uu___7 in - [uu___6] in - (FStar_Errors_Codes.Error_MustEraseMissing, - uu___5) in - FStar_Errors.log_issue_doc uu___3 uu___4) - else ()) - else ()) (FStar_Pervasives_Native.snd lbs)) - else () - | uu___ -> () + let uu___8 = + let uu___9 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_fv + lbname in + FStar_Compiler_Util.format1 + "Values of type `%s` cannot be erased during extraction, but the `must_erase_for_extraction` attribute claims that it can. Please remove the attribute." + uu___9 in + FStar_Errors_Msg.text uu___8 in + [uu___7] in + (FStar_Errors_Codes.Error_MustEraseMissing, + uu___6) in + FStar_Errors.log_issue_doc uu___4 uu___5) + else ()) + else ()) (FStar_Pervasives_Native.snd lbs)) + | uu___2 -> ()) let (check_typeclass_instance_attribute : FStar_TypeChecker_Env.env -> FStar_Compiler_Range_Type.range -> FStar_Syntax_Syntax.sigelt -> unit) @@ -597,67 +600,68 @@ let (check_typeclass_instance_attribute : let uu___ = FStar_Syntax_Util.arrow_formals_comp ty in match uu___ with | (uu___1, res) -> - let uu___2 = FStar_Syntax_Util.is_total_comp res in - if uu___2 - then - let t = FStar_Syntax_Util.comp_result res in + ((let uu___3 = + let uu___4 = FStar_Syntax_Util.is_total_comp res in + Prims.op_Negation uu___4 in + if uu___3 + then + let uu___4 = + let uu___5 = + let uu___6 = + FStar_Errors_Msg.text + "Instances are expected to be total." in + let uu___7 = + let uu___8 = + let uu___9 = + FStar_Errors_Msg.text "This instance has effect" in + let uu___10 = + FStar_Class_PP.pp FStar_Ident.pretty_lident + (FStar_Syntax_Util.comp_effect_name res) in + FStar_Pprint.op_Hat_Hat uu___9 uu___10 in + [uu___8] in + uu___6 :: uu___7 in + (FStar_Errors_Codes.Error_UnexpectedTypeclassInstance, + uu___5) in + FStar_Errors.log_issue_doc rng uu___4 + else ()); + (let t = FStar_Syntax_Util.comp_result res in let uu___3 = FStar_Syntax_Util.head_and_args t in - (match uu___3 with - | (head, uu___4) -> - let err uu___5 = - let uu___6 = - let uu___7 = - let uu___8 = - FStar_Errors_Msg.text - "Instances must define instances of `class` types." in - let uu___9 = - let uu___10 = - let uu___11 = FStar_Errors_Msg.text "Type" in - let uu___12 = - let uu___13 = - FStar_Class_PP.pp - FStar_Syntax_Print.pretty_term t in - let uu___14 = - FStar_Errors_Msg.text "is not a class." in - FStar_Pprint.op_Hat_Slash_Hat uu___13 - uu___14 in - FStar_Pprint.op_Hat_Slash_Hat uu___11 uu___12 in - [uu___10] in - uu___8 :: uu___9 in - (FStar_Errors_Codes.Error_UnexpectedTypeclassInstance, - uu___7) in - FStar_Errors.log_issue_doc rng uu___6 in - let uu___5 = - let uu___6 = FStar_Syntax_Util.un_uinst head in - uu___6.FStar_Syntax_Syntax.n in - (match uu___5 with - | FStar_Syntax_Syntax.Tm_fvar fv -> - let uu___6 = - let uu___7 = - FStar_TypeChecker_Env.fv_has_attr env fv - FStar_Parser_Const.tcclass_lid in - Prims.op_Negation uu___7 in - if uu___6 then err () else () - | uu___6 -> err ())) - else - (let uu___4 = - let uu___5 = - let uu___6 = - FStar_Errors_Msg.text - "Instances are expected to be total." in - let uu___7 = - let uu___8 = - let uu___9 = - FStar_Errors_Msg.text "This instance has effect" in - let uu___10 = - FStar_Class_PP.pp FStar_Ident.pretty_lident - (FStar_Syntax_Util.comp_effect_name res) in - FStar_Pprint.op_Hat_Hat uu___9 uu___10 in - [uu___8] in - uu___6 :: uu___7 in - (FStar_Errors_Codes.Error_UnexpectedTypeclassInstance, - uu___5) in - FStar_Errors.log_issue_doc rng uu___4) in + match uu___3 with + | (head, uu___4) -> + let err uu___5 = + let uu___6 = + let uu___7 = + let uu___8 = + FStar_Errors_Msg.text + "Instances must define instances of `class` types." in + let uu___9 = + let uu___10 = + let uu___11 = FStar_Errors_Msg.text "Type" in + let uu___12 = + let uu___13 = + FStar_Class_PP.pp + FStar_Syntax_Print.pretty_term t in + let uu___14 = + FStar_Errors_Msg.text "is not a class." in + FStar_Pprint.op_Hat_Slash_Hat uu___13 uu___14 in + FStar_Pprint.op_Hat_Slash_Hat uu___11 uu___12 in + [uu___10] in + uu___8 :: uu___9 in + (FStar_Errors_Codes.Error_UnexpectedTypeclassInstance, + uu___7) in + FStar_Errors.log_issue_doc rng uu___6 in + let uu___5 = + let uu___6 = FStar_Syntax_Util.un_uinst head in + uu___6.FStar_Syntax_Syntax.n in + (match uu___5 with + | FStar_Syntax_Syntax.Tm_fvar fv -> + let uu___6 = + let uu___7 = + FStar_TypeChecker_Env.fv_has_attr env fv + FStar_Parser_Const.tcclass_lid in + Prims.op_Negation uu___7 in + if uu___6 then err () else () + | uu___6 -> err ()))) in if is_tc_instance then match se.FStar_Syntax_Syntax.sigel with diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml index a2e6368f008..3f4e75e181e 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Rel.ml @@ -45,6 +45,40 @@ let (__proj__Implicit_has_typing_guard__item___0 : (FStar_Syntax_Syntax.term * FStar_Syntax_Syntax.typ)) = fun projectee -> match projectee with | Implicit_has_typing_guard _0 -> _0 +let (dbg_Disch : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Disch" +let (dbg_Discharge : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Discharge" +let (dbg_EQ : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "EQ" +let (dbg_ExplainRel : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "ExplainRel" +let (dbg_GenUniverses : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "GenUniverses" +let (dbg_ImplicitTrace : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "ImplicitTrace" +let (dbg_Imps : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Imps" +let (dbg_LayeredEffectsApp : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "LayeredEffectsApp" +let (dbg_LayeredEffectsEqns : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "LayeredEffectsEqns" +let (dbg_Rel : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Rel" +let (dbg_RelBench : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "RelBench" +let (dbg_RelDelta : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "RelDelta" +let (dbg_RelTop : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "RelTop" +let (dbg_ResolveImplicitsHook : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "ResolveImplicitsHook" +let (dbg_Simplification : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Simplification" +let (dbg_SMTQuery : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "SMTQuery" +let (dbg_Tac : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Tac" let (showable_implicit_checking_status : implicit_checking_status FStar_Class_Show.showable) = { @@ -76,14 +110,32 @@ let (is_base_type : | FStar_Syntax_Syntax.Tm_fvar uu___2 -> true | FStar_Syntax_Syntax.Tm_type uu___2 -> true | uu___2 -> false) +let (term_is_uvar : + FStar_Syntax_Syntax.ctx_uvar -> FStar_Syntax_Syntax.term -> Prims.bool) = + fun uv -> + fun t -> + let uu___ = + let uu___1 = FStar_Syntax_Util.unascribe t in + uu___1.FStar_Syntax_Syntax.n in + match uu___ with + | FStar_Syntax_Syntax.Tm_uvar (uv', uu___1) -> + FStar_Syntax_Unionfind.equiv uv.FStar_Syntax_Syntax.ctx_uvar_head + uv'.FStar_Syntax_Syntax.ctx_uvar_head + | uu___1 -> false let (binders_as_bv_set : FStar_Syntax_Syntax.binders -> - FStar_Syntax_Syntax.bv FStar_Compiler_Set.set) + FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.t) = - fun bs -> - let uu___ = - FStar_Compiler_List.map (fun b -> b.FStar_Syntax_Syntax.binder_bv) bs in - FStar_Compiler_Set.from_list FStar_Syntax_Syntax.ord_bv uu___ + fun uu___ -> + (fun bs -> + let uu___ = + FStar_Compiler_List.map (fun b -> b.FStar_Syntax_Syntax.binder_bv) + bs in + Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) uu___)) uu___ type lstring = Prims.string FStar_Thunk.t let (mklstr : (unit -> Prims.string) -> Prims.string FStar_Thunk.thunk) = fun f -> @@ -118,7 +170,7 @@ let (uu___is_DeferAny : defer_ok_t -> Prims.bool) = let (uu___is_DeferFlexFlexOnly : defer_ok_t -> Prims.bool) = fun projectee -> match projectee with | DeferFlexFlexOnly -> true | uu___ -> false -let (uu___76 : defer_ok_t FStar_Class_Show.showable) = +let (uu___85 : defer_ok_t FStar_Class_Show.showable) = { FStar_Class_Show.show = (fun uu___ -> @@ -145,7 +197,7 @@ type worklist = tcenv: FStar_TypeChecker_Env.env ; wl_implicits: FStar_TypeChecker_Common.implicits ; repr_subcomp_allowed: Prims.bool ; - typeclass_variables: FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_Set.t } + typeclass_variables: FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_RBSet.t } let (__proj__Mkworklist__item__attempting : worklist -> FStar_TypeChecker_Common.probs) = fun projectee -> @@ -219,14 +271,12 @@ let (__proj__Mkworklist__item__repr_subcomp_allowed : worklist -> Prims.bool) umax_heuristic_ok; tcenv; wl_implicits; repr_subcomp_allowed; typeclass_variables;_} -> repr_subcomp_allowed let (__proj__Mkworklist__item__typeclass_variables : - worklist -> FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_Set.t) = + worklist -> FStar_Syntax_Syntax.ctx_uvar FStar_Compiler_RBSet.t) = fun projectee -> match projectee with | { attempting; wl_deferred; wl_deferred_to_tac; ctr; defer_ok; smt_ok; umax_heuristic_ok; tcenv; wl_implicits; repr_subcomp_allowed; typeclass_variables;_} -> typeclass_variables -let (debug : worklist -> FStar_Options.debug_level_t -> Prims.bool) = - fun wl -> fun lvl -> FStar_TypeChecker_Env.debug wl.tcenv lvl let (as_deferred : (Prims.int * FStar_TypeChecker_Common.deferred_reason * lstring * FStar_TypeChecker_Common.prob) Prims.list -> @@ -305,7 +355,7 @@ let (new_uvar : FStar_TypeChecker_Common.imp_range = r } in (let uu___2 = - debug wl (FStar_Options.Other "ImplicitTrace") in + FStar_Compiler_Effect.op_Bang dbg_ImplicitTrace in if uu___2 then let uu___3 = @@ -539,7 +589,8 @@ let invert : (p.FStar_TypeChecker_Common.logical_guard_uvar); FStar_TypeChecker_Common.reason = (p.FStar_TypeChecker_Common.reason); FStar_TypeChecker_Common.loc = (p.FStar_TypeChecker_Common.loc); - FStar_TypeChecker_Common.rank = (p.FStar_TypeChecker_Common.rank) + FStar_TypeChecker_Common.rank = (p.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = (p.FStar_TypeChecker_Common.logical) } let maybe_invert : 'uuuuu . @@ -578,7 +629,9 @@ let (make_prob_eq : FStar_TypeChecker_Common.reason = (p.FStar_TypeChecker_Common.reason); FStar_TypeChecker_Common.loc = (p.FStar_TypeChecker_Common.loc); - FStar_TypeChecker_Common.rank = (p.FStar_TypeChecker_Common.rank) + FStar_TypeChecker_Common.rank = (p.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (p.FStar_TypeChecker_Common.logical) } | FStar_TypeChecker_Common.CProb p -> FStar_TypeChecker_Common.CProb @@ -596,7 +649,9 @@ let (make_prob_eq : FStar_TypeChecker_Common.reason = (p.FStar_TypeChecker_Common.reason); FStar_TypeChecker_Common.loc = (p.FStar_TypeChecker_Common.loc); - FStar_TypeChecker_Common.rank = (p.FStar_TypeChecker_Common.rank) + FStar_TypeChecker_Common.rank = (p.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (p.FStar_TypeChecker_Common.logical) } let (vary_rel : FStar_TypeChecker_Common.rel -> variance -> FStar_TypeChecker_Common.rel) = @@ -902,12 +957,17 @@ let (hasBinders_prob : FStar_TypeChecker_Common.prob FStar_Class_Binders.hasBinders) = { FStar_Class_Binders.boundNames = - (fun prob -> - let uu___ = - let uu___1 = p_scope prob in - FStar_Compiler_List.map (fun b -> b.FStar_Syntax_Syntax.binder_bv) - uu___1 in - FStar_Compiler_Set.from_list FStar_Syntax_Syntax.ord_bv uu___) + (fun uu___ -> + (fun prob -> + let uu___ = + let uu___1 = p_scope prob in + FStar_Compiler_List.map + (fun b -> b.FStar_Syntax_Syntax.binder_bv) uu___1 in + Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) uu___)) uu___) } let (def_check_term_scoped_in_prob : Prims.string -> @@ -1008,11 +1068,23 @@ let (prob_to_string : let uu___4 = let uu___5 = let uu___6 = term_to_string p.FStar_TypeChecker_Common.rhs in - [uu___6] in + let uu___7 = + let uu___8 = + let uu___9 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + p.FStar_TypeChecker_Common.logical in + [uu___9] in + (match p.FStar_TypeChecker_Common.reason with + | [] -> "" + | r::uu___9 -> r) :: uu___8 in + uu___6 :: uu___7 in (rel_to_string p.FStar_TypeChecker_Common.relation) :: uu___5 in uu___3 :: uu___4 in uu___1 :: uu___2 in - FStar_Compiler_Util.format "\n%s:\t%s \n\t\t%s\n\t%s\n" uu___ + FStar_Compiler_Util.format + "\n%s:\t%s \n\t\t%s\n\t%s\n\t(reason:%s) (logical:%s)\n" uu___ | FStar_TypeChecker_Common.CProb p -> let uu___ = FStar_Compiler_Util.string_of_int p.FStar_TypeChecker_Common.pid in @@ -1060,7 +1132,12 @@ let (uvis_to_string : fun uvis -> (FStar_Common.string_of_list ()) (uvi_to_string env) uvis let (empty_worklist : FStar_TypeChecker_Env.env -> worklist) = fun env -> - let uu___ = FStar_Compiler_Set.empty FStar_Syntax_Free.ord_ctx_uvar () in + let uu___ = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Free.ord_ctx_uvar)) ()) in { attempting = []; wl_deferred = []; @@ -1079,7 +1156,7 @@ let (giveup : fun wl -> fun reason -> fun prob -> - (let uu___1 = debug wl (FStar_Options.Other "Rel") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___1 then let uu___2 = FStar_Thunk.force reason in @@ -1220,6 +1297,60 @@ let (p_invert : FStar_TypeChecker_Common.TProb (invert p) | FStar_TypeChecker_Common.CProb p -> FStar_TypeChecker_Common.CProb (invert p) +let (p_logical : FStar_TypeChecker_Common.prob -> Prims.bool) = + fun uu___ -> + match uu___ with + | FStar_TypeChecker_Common.TProb p -> p.FStar_TypeChecker_Common.logical + | FStar_TypeChecker_Common.CProb p -> p.FStar_TypeChecker_Common.logical +let (set_logical : + Prims.bool -> + FStar_TypeChecker_Common.prob -> FStar_TypeChecker_Common.prob) + = + fun b -> + fun uu___ -> + match uu___ with + | FStar_TypeChecker_Common.TProb p -> + FStar_TypeChecker_Common.TProb + { + FStar_TypeChecker_Common.pid = (p.FStar_TypeChecker_Common.pid); + FStar_TypeChecker_Common.lhs = (p.FStar_TypeChecker_Common.lhs); + FStar_TypeChecker_Common.relation = + (p.FStar_TypeChecker_Common.relation); + FStar_TypeChecker_Common.rhs = (p.FStar_TypeChecker_Common.rhs); + FStar_TypeChecker_Common.element = + (p.FStar_TypeChecker_Common.element); + FStar_TypeChecker_Common.logical_guard = + (p.FStar_TypeChecker_Common.logical_guard); + FStar_TypeChecker_Common.logical_guard_uvar = + (p.FStar_TypeChecker_Common.logical_guard_uvar); + FStar_TypeChecker_Common.reason = + (p.FStar_TypeChecker_Common.reason); + FStar_TypeChecker_Common.loc = (p.FStar_TypeChecker_Common.loc); + FStar_TypeChecker_Common.rank = + (p.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = b + } + | FStar_TypeChecker_Common.CProb p -> + FStar_TypeChecker_Common.CProb + { + FStar_TypeChecker_Common.pid = (p.FStar_TypeChecker_Common.pid); + FStar_TypeChecker_Common.lhs = (p.FStar_TypeChecker_Common.lhs); + FStar_TypeChecker_Common.relation = + (p.FStar_TypeChecker_Common.relation); + FStar_TypeChecker_Common.rhs = (p.FStar_TypeChecker_Common.rhs); + FStar_TypeChecker_Common.element = + (p.FStar_TypeChecker_Common.element); + FStar_TypeChecker_Common.logical_guard = + (p.FStar_TypeChecker_Common.logical_guard); + FStar_TypeChecker_Common.logical_guard_uvar = + (p.FStar_TypeChecker_Common.logical_guard_uvar); + FStar_TypeChecker_Common.reason = + (p.FStar_TypeChecker_Common.reason); + FStar_TypeChecker_Common.loc = (p.FStar_TypeChecker_Common.loc); + FStar_TypeChecker_Common.rank = + (p.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = b + } let (is_top_level_prob : FStar_TypeChecker_Common.prob -> Prims.bool) = fun p -> (FStar_Compiler_List.length (p_reason p)) = Prims.int_one let (next_pid : unit -> Prims.int) = @@ -1292,7 +1423,8 @@ let mk_problem : (p_reason orig)); FStar_TypeChecker_Common.loc = (p_loc orig); FStar_TypeChecker_Common.rank = - FStar_Pervasives_Native.None + FStar_Pervasives_Native.None; + FStar_TypeChecker_Common.logical = (p_logical orig) } in (prob, wl1) let (mk_t_problem : @@ -1424,7 +1556,8 @@ let new_problem : FStar_TypeChecker_Common.reason = [reason]; FStar_TypeChecker_Common.loc = loc; FStar_TypeChecker_Common.rank = - FStar_Pervasives_Native.None + FStar_Pervasives_Native.None; + FStar_TypeChecker_Common.logical = false } in (prob, wl1) let (problem_using_guard : @@ -1457,7 +1590,8 @@ let (problem_using_guard : (p_reason orig)); FStar_TypeChecker_Common.loc = (p_loc orig); FStar_TypeChecker_Common.rank = - FStar_Pervasives_Native.None + FStar_Pervasives_Native.None; + FStar_TypeChecker_Common.logical = (p_logical orig) } in def_check_prob reason (FStar_TypeChecker_Common.TProb p); p let (guard_on_element : @@ -1493,8 +1627,8 @@ let (explain : fun d -> fun s -> let uu___ = - (debug wl (FStar_Options.Other "ExplainRel")) || - (debug wl (FStar_Options.Other "Rel")) in + (FStar_Compiler_Effect.op_Bang dbg_ExplainRel) || + (FStar_Compiler_Effect.op_Bang dbg_Rel) in if uu___ then let uu___1 = FStar_Compiler_Range_Ops.string_of_range (p_loc d) in @@ -2031,10 +2165,11 @@ let (flex_uvar_head : (match uu___1 with | FStar_Syntax_Syntax.Tm_uvar (u, uu___2) -> u | uu___2 -> FStar_Compiler_Effect.failwith "Not a flex-uvar") -let (ensure_no_uvar_subst : - FStar_TypeChecker_Env.env -> - FStar_Syntax_Syntax.term -> - worklist -> (FStar_Syntax_Syntax.term * worklist)) +let ensure_no_uvar_subst : + 'uuuuu . + 'uuuuu -> + FStar_Syntax_Syntax.term -> + worklist -> (FStar_Syntax_Syntax.term * worklist) = fun env -> fun t0 -> @@ -2105,8 +2240,7 @@ let (ensure_no_uvar_subst : FStar_Syntax_Syntax.mk_Tm_app t_v args_sol t0.FStar_Syntax_Syntax.pos in ((let uu___6 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___6 then let uu___7 = @@ -2150,9 +2284,16 @@ let (ensure_no_uvar_subst : let (no_free_uvars : FStar_Syntax_Syntax.term -> Prims.bool) = fun t -> (let uu___ = FStar_Syntax_Free.uvars t in - FStar_Compiler_Set.is_empty FStar_Syntax_Free.ord_ctx_uvar uu___) && + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___)) + && (let uu___ = FStar_Syntax_Free.univs t in - FStar_Compiler_Set.is_empty FStar_Syntax_Free.ord_univ_uvar uu___) + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_univ_uvar)) (Obj.magic uu___)) let rec (may_relate_with_logical_guard : FStar_TypeChecker_Env.env -> Prims.bool -> FStar_Syntax_Syntax.typ -> Prims.bool) @@ -2279,7 +2420,7 @@ let (solve_prob' : | FStar_Pervasives_Native.None -> FStar_Syntax_Util.t_true | FStar_Pervasives_Native.Some phi1 -> phi1 in let assign_solution xs uv phi1 = - (let uu___2 = debug wl (FStar_Options.Other "Rel") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___2 then let uu___3 = FStar_Compiler_Util.string_of_int (p_pid prob) in @@ -2378,7 +2519,7 @@ let (extend_universe_solution : fun pid -> fun sol -> fun wl -> - (let uu___1 = debug wl (FStar_Options.Other "Rel") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___1 then let uu___2 = FStar_Compiler_Util.string_of_int pid in @@ -2411,7 +2552,7 @@ let (solve_prob : def_check_prob "solve_prob.prob" prob; FStar_Compiler_Util.iter_opt logical_guard (def_check_term_scoped_in_prob "solve_prob.guard" prob); - (let uu___3 = debug wl (FStar_Options.Other "Rel") in + (let uu___3 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___3 then let uu___4 = FStar_Compiler_Util.string_of_int (p_pid prob) in @@ -2428,7 +2569,10 @@ let (occurs : fun t -> let uvars = let uu___ = FStar_Syntax_Free.uvars t in - FStar_Compiler_Set.elems FStar_Syntax_Free.ord_ctx_uvar uu___ in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___) in let occurs1 = FStar_Compiler_Util.for_some (fun uv -> @@ -2467,7 +2611,10 @@ let (occurs_full : fun t -> let uvars = let uu___ = FStar_Syntax_Free.uvars_full t in - FStar_Compiler_Set.elems FStar_Syntax_Free.ord_ctx_uvar uu___ in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___) in let occurs1 = FStar_Compiler_Util.for_some (fun uv -> @@ -2650,8 +2797,11 @@ let restrict_all_uvars : binders_as_bv_set src.FStar_Syntax_Syntax.ctx_uvar_binders in let uu___ = - FStar_Compiler_Set.subset FStar_Syntax_Syntax.ord_bv - ctx_src ctx_tgt in + FStar_Class_Setlike.subset () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic ctx_src) (Obj.magic ctx_tgt) in if uu___ then wl1 else restrict_ctx env tgt [] src wl1) sources wl | uu___ -> @@ -2666,21 +2816,48 @@ let (intersect_binders : fun v1 -> fun v2 -> let as_set v = + let uu___ = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) ()) in FStar_Compiler_List.fold_left - (fun out -> - fun x -> - FStar_Compiler_Set.add FStar_Syntax_Syntax.ord_bv - x.FStar_Syntax_Syntax.binder_bv out) - FStar_Syntax_Syntax.no_names v in + (fun uu___2 -> + fun uu___1 -> + (fun out -> + fun x -> + Obj.magic + (FStar_Class_Setlike.add () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) + x.FStar_Syntax_Syntax.binder_bv (Obj.magic out))) + uu___2 uu___1) uu___ v in let v1_set = as_set v1 in let ctx_binders = + let uu___ = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) ()) in FStar_Compiler_List.fold_left - (fun out -> - fun b -> - match b with - | FStar_Syntax_Syntax.Binding_var x -> - FStar_Compiler_Set.add FStar_Syntax_Syntax.ord_bv x out - | uu___ -> out) FStar_Syntax_Syntax.no_names g in + (fun uu___2 -> + fun uu___1 -> + (fun out -> + fun b -> + match b with + | FStar_Syntax_Syntax.Binding_var x -> + Obj.magic + (Obj.repr + (FStar_Class_Setlike.add () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) x + (Obj.magic out))) + | uu___1 -> Obj.magic (Obj.repr out)) uu___2 uu___1) + uu___ g in let uu___ = FStar_Compiler_List.fold_left (fun uu___1 -> @@ -2694,8 +2871,11 @@ let (intersect_binders : | (x, imp) -> let uu___3 = let uu___4 = - FStar_Compiler_Set.mem - FStar_Syntax_Syntax.ord_bv x v1_set in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_bv)) x + (Obj.magic v1_set) in Prims.op_Negation uu___4 in if uu___3 then (isect, isect_set) @@ -2704,13 +2884,20 @@ let (intersect_binders : FStar_Syntax_Free.names x.FStar_Syntax_Syntax.sort in let uu___5 = - FStar_Compiler_Set.subset - FStar_Syntax_Syntax.ord_bv fvs isect_set in + FStar_Class_Setlike.subset () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic fvs) (Obj.magic isect_set) in if uu___5 then let uu___6 = - FStar_Compiler_Set.add - FStar_Syntax_Syntax.ord_bv x isect_set in + Obj.magic + (FStar_Class_Setlike.add () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) x + (Obj.magic isect_set)) in ((b :: isect), uu___6) else (isect, isect_set)))) ([], ctx_binders) v2 in match uu___ with | (isect, uu___1) -> FStar_Compiler_List.rev isect @@ -2811,88 +2998,6 @@ let (head_match : match_result -> match_result) = | MisMatch (i, j) -> MisMatch (i, j) | HeadMatch (true) -> HeadMatch true | uu___1 -> HeadMatch false -let (fv_delta_depth : - FStar_TypeChecker_Env.env -> - FStar_Syntax_Syntax.fv -> FStar_Syntax_Syntax.delta_depth) - = - fun env -> - fun fv -> - let d = FStar_TypeChecker_Env.delta_depth_of_fv env fv in - match d with - | FStar_Syntax_Syntax.Delta_abstract d1 -> - let uu___ = - (let uu___1 = - FStar_Ident.string_of_lid env.FStar_TypeChecker_Env.curmodule in - let uu___2 = - FStar_Ident.nsstr - (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - uu___1 = uu___2) && - (Prims.op_Negation env.FStar_TypeChecker_Env.is_iface) in - if uu___ then d1 else FStar_Syntax_Syntax.delta_constant - | FStar_Syntax_Syntax.Delta_constant_at_level i when i > Prims.int_zero - -> - let uu___ = - FStar_TypeChecker_Env.lookup_definition - [FStar_TypeChecker_Env.Unfold - FStar_Syntax_Syntax.delta_constant] env - (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - (match uu___ with - | FStar_Pervasives_Native.None -> - FStar_Syntax_Syntax.delta_constant - | uu___1 -> d) - | d1 -> d1 -let rec (delta_depth_of_term : - FStar_TypeChecker_Env.env -> - FStar_Syntax_Syntax.term -> - FStar_Syntax_Syntax.delta_depth FStar_Pervasives_Native.option) - = - fun env -> - fun t -> - let t1 = FStar_Syntax_Util.unmeta t in - match t1.FStar_Syntax_Syntax.n with - | FStar_Syntax_Syntax.Tm_meta uu___ -> - FStar_Compiler_Effect.failwith "Impossible (delta depth of term)" - | FStar_Syntax_Syntax.Tm_delayed uu___ -> - FStar_Compiler_Effect.failwith "Impossible (delta depth of term)" - | FStar_Syntax_Syntax.Tm_lazy i -> - let uu___ = FStar_Syntax_Util.unfold_lazy i in - delta_depth_of_term env uu___ - | FStar_Syntax_Syntax.Tm_unknown -> FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Tm_bvar uu___ -> FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Tm_name uu___ -> FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Tm_uvar uu___ -> FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Tm_let uu___ -> FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Tm_match uu___ -> FStar_Pervasives_Native.None - | FStar_Syntax_Syntax.Tm_uinst (t2, uu___) -> - delta_depth_of_term env t2 - | FStar_Syntax_Syntax.Tm_ascribed - { FStar_Syntax_Syntax.tm = t2; FStar_Syntax_Syntax.asc = uu___; - FStar_Syntax_Syntax.eff_opt = uu___1;_} - -> delta_depth_of_term env t2 - | FStar_Syntax_Syntax.Tm_app - { FStar_Syntax_Syntax.hd = t2; FStar_Syntax_Syntax.args = uu___;_} - -> delta_depth_of_term env t2 - | FStar_Syntax_Syntax.Tm_refine - { - FStar_Syntax_Syntax.b = - { FStar_Syntax_Syntax.ppname = uu___; - FStar_Syntax_Syntax.index = uu___1; - FStar_Syntax_Syntax.sort = t2;_}; - FStar_Syntax_Syntax.phi = uu___2;_} - -> delta_depth_of_term env t2 - | FStar_Syntax_Syntax.Tm_constant uu___ -> - FStar_Pervasives_Native.Some FStar_Syntax_Syntax.delta_constant - | FStar_Syntax_Syntax.Tm_type uu___ -> - FStar_Pervasives_Native.Some FStar_Syntax_Syntax.delta_constant - | FStar_Syntax_Syntax.Tm_arrow uu___ -> - FStar_Pervasives_Native.Some FStar_Syntax_Syntax.delta_constant - | FStar_Syntax_Syntax.Tm_quoted uu___ -> - FStar_Pervasives_Native.Some FStar_Syntax_Syntax.delta_constant - | FStar_Syntax_Syntax.Tm_abs uu___ -> - FStar_Pervasives_Native.Some FStar_Syntax_Syntax.delta_constant - | FStar_Syntax_Syntax.Tm_fvar fv -> - let uu___ = fv_delta_depth env fv in - FStar_Pervasives_Native.Some uu___ let (universe_has_max : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.universe -> Prims.bool) = fun env -> @@ -2910,8 +3015,7 @@ let rec (head_matches : fun t2 -> let t11 = FStar_Syntax_Util.unmeta t1 in let t21 = FStar_Syntax_Util.unmeta t2 in - (let uu___1 = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "RelDelta") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_RelDelta in if uu___1 then ((let uu___3 = @@ -2969,10 +3073,10 @@ let rec (head_matches : else (let uu___3 = let uu___4 = - let uu___5 = fv_delta_depth env f in + let uu___5 = FStar_TypeChecker_Env.fv_delta_depth env f in FStar_Pervasives_Native.Some uu___5 in let uu___5 = - let uu___6 = fv_delta_depth env g in + let uu___6 = FStar_TypeChecker_Env.fv_delta_depth env g in FStar_Pervasives_Native.Some uu___6 in (uu___4, uu___5) in MisMatch uu___3) @@ -3053,281 +3157,298 @@ let rec (head_matches : | (FStar_Syntax_Syntax.Tm_abs uu___1, FStar_Syntax_Syntax.Tm_abs uu___2) -> HeadMatch true | uu___1 -> + let maybe_dd t = + let uu___2 = + let uu___3 = FStar_Syntax_Subst.compress t in + uu___3.FStar_Syntax_Syntax.n in + match uu___2 with + | FStar_Syntax_Syntax.Tm_unknown -> + FStar_Pervasives_Native.None + | FStar_Syntax_Syntax.Tm_bvar uu___3 -> + FStar_Pervasives_Native.None + | FStar_Syntax_Syntax.Tm_name uu___3 -> + FStar_Pervasives_Native.None + | FStar_Syntax_Syntax.Tm_uvar uu___3 -> + FStar_Pervasives_Native.None + | FStar_Syntax_Syntax.Tm_let uu___3 -> + FStar_Pervasives_Native.None + | FStar_Syntax_Syntax.Tm_match uu___3 -> + FStar_Pervasives_Native.None + | uu___3 -> + let uu___4 = + FStar_TypeChecker_Env.delta_depth_of_term env t in + FStar_Pervasives_Native.Some uu___4 in let uu___2 = - let uu___3 = delta_depth_of_term env t11 in - let uu___4 = delta_depth_of_term env t21 in (uu___3, uu___4) in + let uu___3 = maybe_dd t11 in + let uu___4 = maybe_dd t21 in (uu___3, uu___4) in MisMatch uu___2) let (head_matches_delta : FStar_TypeChecker_Env.env -> Prims.bool -> - FStar_Syntax_Syntax.typ -> + Prims.bool -> FStar_Syntax_Syntax.typ -> - (match_result * (FStar_Syntax_Syntax.typ * FStar_Syntax_Syntax.typ) - FStar_Pervasives_Native.option)) + FStar_Syntax_Syntax.typ -> + (match_result * (FStar_Syntax_Syntax.typ * + FStar_Syntax_Syntax.typ) FStar_Pervasives_Native.option)) = fun env -> - fun smt_ok -> - fun t1 -> - fun t2 -> - let maybe_inline t = - let head = - let uu___ = unrefine env t in FStar_Syntax_Util.head_of uu___ in - (let uu___1 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelDelta") in - if uu___1 - then - let uu___2 = - FStar_Class_Show.show FStar_Syntax_Print.showable_term t in - let uu___3 = - FStar_Class_Show.show FStar_Syntax_Print.showable_term head in - FStar_Compiler_Util.print2 "Head of %s is %s\n" uu___2 uu___3 - else ()); - (let uu___1 = - let uu___2 = FStar_Syntax_Util.un_uinst head in - uu___2.FStar_Syntax_Syntax.n in - match uu___1 with - | FStar_Syntax_Syntax.Tm_fvar fv -> + fun logical -> + fun smt_ok -> + fun t1 -> + fun t2 -> + let base_steps = + FStar_Compiler_List.op_At + (if logical then [FStar_TypeChecker_Env.UnfoldTac] else []) + [FStar_TypeChecker_Env.Primops; + FStar_TypeChecker_Env.Weak; + FStar_TypeChecker_Env.HNF] in + let maybe_inline t = + let head = + let uu___ = unrefine env t in FStar_Syntax_Util.head_of uu___ in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_RelDelta in + if uu___1 + then let uu___2 = - FStar_TypeChecker_Env.lookup_definition - [FStar_TypeChecker_Env.Unfold - FStar_Syntax_Syntax.delta_constant; - FStar_TypeChecker_Env.Eager_unfolding_only] env - (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - (match uu___2 with - | FStar_Pervasives_Native.None -> - ((let uu___4 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelDelta") in - if uu___4 - then - let uu___5 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term head in - FStar_Compiler_Util.print1 - "No definition found for %s\n" uu___5 - else ()); - FStar_Pervasives_Native.None) - | FStar_Pervasives_Native.Some uu___3 -> - let basic_steps = - [FStar_TypeChecker_Env.UnfoldUntil - FStar_Syntax_Syntax.delta_constant; - FStar_TypeChecker_Env.Weak; - FStar_TypeChecker_Env.HNF; - FStar_TypeChecker_Env.Primops; - FStar_TypeChecker_Env.Beta; - FStar_TypeChecker_Env.Eager_unfolding; - FStar_TypeChecker_Env.Iota] in - let steps = - if smt_ok - then basic_steps - else - (FStar_TypeChecker_Env.Exclude - FStar_TypeChecker_Env.Zeta) - :: basic_steps in - let t' = - norm_with_steps - "FStar.TypeChecker.Rel.norm_with_steps.1" steps env - t in - let uu___4 = - let uu___5 = FStar_Syntax_Util.eq_tm t t' in - uu___5 = FStar_Syntax_Util.Equal in - if uu___4 - then FStar_Pervasives_Native.None - else - ((let uu___7 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelDelta") in - if uu___7 + FStar_Class_Show.show FStar_Syntax_Print.showable_term t in + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term + head in + FStar_Compiler_Util.print2 "Head of %s is %s\n" uu___2 + uu___3 + else ()); + (let uu___1 = + let uu___2 = FStar_Syntax_Util.un_uinst head in + uu___2.FStar_Syntax_Syntax.n in + match uu___1 with + | FStar_Syntax_Syntax.Tm_fvar fv -> + let uu___2 = + FStar_TypeChecker_Env.lookup_definition + [FStar_TypeChecker_Env.Unfold + FStar_Syntax_Syntax.delta_constant; + FStar_TypeChecker_Env.Eager_unfolding_only] env + (fv.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in + (match uu___2 with + | FStar_Pervasives_Native.None -> + ((let uu___4 = + FStar_Compiler_Effect.op_Bang dbg_RelDelta in + if uu___4 then - let uu___8 = - FStar_Class_Show.show - FStar_Syntax_Print.showable_term t in - let uu___9 = + let uu___5 = FStar_Class_Show.show - FStar_Syntax_Print.showable_term t' in - FStar_Compiler_Util.print2 "Inlined %s to %s\n" - uu___8 uu___9 + FStar_Syntax_Print.showable_term head in + FStar_Compiler_Util.print1 + "No definition found for %s\n" uu___5 else ()); - FStar_Pervasives_Native.Some t')) - | uu___2 -> FStar_Pervasives_Native.None) in - let success d r t11 t21 = - (r, - (if d > Prims.int_zero - then FStar_Pervasives_Native.Some (t11, t21) - else FStar_Pervasives_Native.None)) in - let fail d r t11 t21 = - (r, - (if d > Prims.int_zero - then FStar_Pervasives_Native.Some (t11, t21) - else FStar_Pervasives_Native.None)) in - let made_progress t t' = - let uu___ = - let uu___1 = - let uu___2 = FStar_Syntax_Util.head_and_args t in - FStar_Pervasives_Native.fst uu___2 in - let uu___2 = - let uu___3 = FStar_Syntax_Util.head_and_args t' in - FStar_Pervasives_Native.fst uu___3 in - (uu___1, uu___2) in - match uu___ with - | (head, head') -> - let uu___1 = - let uu___2 = FStar_Syntax_Util.eq_tm head head' in - uu___2 = FStar_Syntax_Util.Equal in - Prims.op_Negation uu___1 in - let rec aux retry n_delta t11 t21 = - let r = head_matches env t11 t21 in - (let uu___1 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelDelta") in + FStar_Pervasives_Native.None) + | FStar_Pervasives_Native.Some uu___3 -> + let basic_steps = + FStar_Compiler_List.op_At + (if logical + then [FStar_TypeChecker_Env.UnfoldTac] + else []) + [FStar_TypeChecker_Env.UnfoldUntil + FStar_Syntax_Syntax.delta_constant; + FStar_TypeChecker_Env.Weak; + FStar_TypeChecker_Env.HNF; + FStar_TypeChecker_Env.Primops; + FStar_TypeChecker_Env.Beta; + FStar_TypeChecker_Env.Eager_unfolding; + FStar_TypeChecker_Env.Iota] in + let steps = + if smt_ok + then basic_steps + else + (FStar_TypeChecker_Env.Exclude + FStar_TypeChecker_Env.Zeta) + :: basic_steps in + let t' = + norm_with_steps + "FStar.TypeChecker.Rel.norm_with_steps.1" steps + env t in + let uu___4 = + let uu___5 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t + t' in + uu___5 = FStar_TypeChecker_TermEqAndSimplify.Equal in + if uu___4 + then FStar_Pervasives_Native.None + else + ((let uu___7 = + FStar_Compiler_Effect.op_Bang dbg_RelDelta in + if uu___7 + then + let uu___8 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t in + let uu___9 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t' in + FStar_Compiler_Util.print2 "Inlined %s to %s\n" + uu___8 uu___9 + else ()); + FStar_Pervasives_Native.Some t')) + | uu___2 -> FStar_Pervasives_Native.None) in + let success d r t11 t21 = + (r, + (if d > Prims.int_zero + then FStar_Pervasives_Native.Some (t11, t21) + else FStar_Pervasives_Native.None)) in + let fail d r t11 t21 = + (r, + (if d > Prims.int_zero + then FStar_Pervasives_Native.Some (t11, t21) + else FStar_Pervasives_Native.None)) in + let made_progress t t' = + let head = + let uu___ = FStar_Syntax_Util.head_and_args t in + FStar_Pervasives_Native.fst uu___ in + let head' = + let uu___ = FStar_Syntax_Util.head_and_args t' in + FStar_Pervasives_Native.fst uu___ in + let uu___ = FStar_Syntax_Util.term_eq head head' in + Prims.op_Negation uu___ in + let rec aux retry n_delta t11 t21 = + let r = head_matches env t11 t21 in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_RelDelta in + if uu___1 + then + let uu___2 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term t11 in + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term t21 in + let uu___4 = string_of_match_result r in + FStar_Compiler_Util.print3 "head_matches (%s, %s) = %s\n" + uu___2 uu___3 uu___4 + else ()); + (let reduce_one_and_try_again d1 d2 = + let d1_greater_than_d2 = + FStar_TypeChecker_Common.delta_depth_greater_than d1 d2 in + let uu___1 = + if d1_greater_than_d2 + then + let t1' = + normalize_refinement + ((FStar_TypeChecker_Env.UnfoldUntil d2) :: + base_steps) env t11 in + let uu___2 = made_progress t11 t1' in (t1', t21, uu___2) + else + (let t2' = + normalize_refinement + ((FStar_TypeChecker_Env.UnfoldUntil d1) :: + base_steps) env t21 in + let uu___3 = made_progress t21 t2' in + (t11, t2', uu___3)) in + match uu___1 with + | (t12, t22, made_progress1) -> + if made_progress1 + then aux retry (n_delta + Prims.int_one) t12 t22 + else fail n_delta r t12 t22 in + let reduce_both_and_try_again d r1 = + let uu___1 = FStar_TypeChecker_Common.decr_delta_depth d in + match uu___1 with + | FStar_Pervasives_Native.None -> fail n_delta r1 t11 t21 + | FStar_Pervasives_Native.Some d1 -> + let t1' = + normalize_refinement + ((FStar_TypeChecker_Env.UnfoldUntil d1) :: + base_steps) env t11 in + let t2' = + normalize_refinement + ((FStar_TypeChecker_Env.UnfoldUntil d1) :: + base_steps) env t21 in + let uu___2 = + (made_progress t11 t1') && (made_progress t21 t2') in + if uu___2 + then aux retry (n_delta + Prims.int_one) t1' t2' + else fail n_delta r1 t11 t21 in + match r with + | MisMatch + (FStar_Pervasives_Native.Some + (FStar_Syntax_Syntax.Delta_equational_at_level i), + FStar_Pervasives_Native.Some + (FStar_Syntax_Syntax.Delta_equational_at_level j)) + when + ((i > Prims.int_zero) || (j > Prims.int_zero)) && (i <> j) + -> + reduce_one_and_try_again + (FStar_Syntax_Syntax.Delta_equational_at_level i) + (FStar_Syntax_Syntax.Delta_equational_at_level j) + | MisMatch + (FStar_Pervasives_Native.Some + (FStar_Syntax_Syntax.Delta_equational_at_level uu___1), + uu___2) + -> + if Prims.op_Negation retry + then fail n_delta r t11 t21 + else + (let uu___4 = + let uu___5 = maybe_inline t11 in + let uu___6 = maybe_inline t21 in (uu___5, uu___6) in + match uu___4 with + | (FStar_Pervasives_Native.None, + FStar_Pervasives_Native.None) -> + fail n_delta r t11 t21 + | (FStar_Pervasives_Native.Some t12, + FStar_Pervasives_Native.None) -> + aux false (n_delta + Prims.int_one) t12 t21 + | (FStar_Pervasives_Native.None, + FStar_Pervasives_Native.Some t22) -> + aux false (n_delta + Prims.int_one) t11 t22 + | (FStar_Pervasives_Native.Some t12, + FStar_Pervasives_Native.Some t22) -> + aux false (n_delta + Prims.int_one) t12 t22) + | MisMatch + (uu___1, FStar_Pervasives_Native.Some + (FStar_Syntax_Syntax.Delta_equational_at_level uu___2)) + -> + if Prims.op_Negation retry + then fail n_delta r t11 t21 + else + (let uu___4 = + let uu___5 = maybe_inline t11 in + let uu___6 = maybe_inline t21 in (uu___5, uu___6) in + match uu___4 with + | (FStar_Pervasives_Native.None, + FStar_Pervasives_Native.None) -> + fail n_delta r t11 t21 + | (FStar_Pervasives_Native.Some t12, + FStar_Pervasives_Native.None) -> + aux false (n_delta + Prims.int_one) t12 t21 + | (FStar_Pervasives_Native.None, + FStar_Pervasives_Native.Some t22) -> + aux false (n_delta + Prims.int_one) t11 t22 + | (FStar_Pervasives_Native.Some t12, + FStar_Pervasives_Native.Some t22) -> + aux false (n_delta + Prims.int_one) t12 t22) + | MisMatch + (FStar_Pervasives_Native.Some d1, + FStar_Pervasives_Native.Some d2) + when d1 = d2 -> reduce_both_and_try_again d1 r + | MisMatch + (FStar_Pervasives_Native.Some d1, + FStar_Pervasives_Native.Some d2) + -> reduce_one_and_try_again d1 d2 + | MisMatch uu___1 -> fail n_delta r t11 t21 + | uu___1 -> success n_delta r t11 t21) in + let r = aux true Prims.int_zero t1 t2 in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_RelDelta in if uu___1 then let uu___2 = - FStar_Class_Show.show FStar_Syntax_Print.showable_term t11 in + FStar_Class_Show.show FStar_Syntax_Print.showable_term t1 in let uu___3 = - FStar_Class_Show.show FStar_Syntax_Print.showable_term t21 in - let uu___4 = string_of_match_result r in - FStar_Compiler_Util.print3 "head_matches (%s, %s) = %s\n" - uu___2 uu___3 uu___4 + FStar_Class_Show.show FStar_Syntax_Print.showable_term t2 in + let uu___4 = + FStar_Class_Show.show + (FStar_Class_Show.show_tuple2 showable_match_result + (FStar_Class_Show.show_option + (FStar_Class_Show.show_tuple2 + FStar_Syntax_Print.showable_term + FStar_Syntax_Print.showable_term))) r in + FStar_Compiler_Util.print3 + "head_matches_delta (%s, %s) = %s\n" uu___2 uu___3 uu___4 else ()); - (let reduce_one_and_try_again d1 d2 = - let d1_greater_than_d2 = - FStar_TypeChecker_Common.delta_depth_greater_than d1 d2 in - let uu___1 = - if d1_greater_than_d2 - then - let t1' = - normalize_refinement - [FStar_TypeChecker_Env.UnfoldUntil d2; - FStar_TypeChecker_Env.Primops; - FStar_TypeChecker_Env.Weak; - FStar_TypeChecker_Env.HNF] env t11 in - let uu___2 = made_progress t11 t1' in (t1', t21, uu___2) - else - (let t2' = - normalize_refinement - [FStar_TypeChecker_Env.UnfoldUntil d1; - FStar_TypeChecker_Env.Primops; - FStar_TypeChecker_Env.Weak; - FStar_TypeChecker_Env.HNF] env t21 in - let uu___3 = made_progress t21 t2' in (t11, t2', uu___3)) in - match uu___1 with - | (t12, t22, made_progress1) -> - if made_progress1 - then aux retry (n_delta + Prims.int_one) t12 t22 - else fail n_delta r t12 t22 in - let reduce_both_and_try_again d r1 = - let uu___1 = FStar_TypeChecker_Common.decr_delta_depth d in - match uu___1 with - | FStar_Pervasives_Native.None -> fail n_delta r1 t11 t21 - | FStar_Pervasives_Native.Some d1 -> - let t1' = - normalize_refinement - [FStar_TypeChecker_Env.UnfoldUntil d1; - FStar_TypeChecker_Env.Primops; - FStar_TypeChecker_Env.Weak; - FStar_TypeChecker_Env.HNF] env t11 in - let t2' = - normalize_refinement - [FStar_TypeChecker_Env.UnfoldUntil d1; - FStar_TypeChecker_Env.Primops; - FStar_TypeChecker_Env.Weak; - FStar_TypeChecker_Env.HNF] env t21 in - let uu___2 = - (made_progress t11 t1') && (made_progress t21 t2') in - if uu___2 - then aux retry (n_delta + Prims.int_one) t1' t2' - else fail n_delta r1 t11 t21 in - match r with - | MisMatch - (FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Delta_equational_at_level i), - FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Delta_equational_at_level j)) - when - ((i > Prims.int_zero) || (j > Prims.int_zero)) && (i <> j) - -> - reduce_one_and_try_again - (FStar_Syntax_Syntax.Delta_equational_at_level i) - (FStar_Syntax_Syntax.Delta_equational_at_level j) - | MisMatch - (FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Delta_equational_at_level uu___1), - uu___2) - -> - if Prims.op_Negation retry - then fail n_delta r t11 t21 - else - (let uu___4 = - let uu___5 = maybe_inline t11 in - let uu___6 = maybe_inline t21 in (uu___5, uu___6) in - match uu___4 with - | (FStar_Pervasives_Native.None, - FStar_Pervasives_Native.None) -> - fail n_delta r t11 t21 - | (FStar_Pervasives_Native.Some t12, - FStar_Pervasives_Native.None) -> - aux false (n_delta + Prims.int_one) t12 t21 - | (FStar_Pervasives_Native.None, - FStar_Pervasives_Native.Some t22) -> - aux false (n_delta + Prims.int_one) t11 t22 - | (FStar_Pervasives_Native.Some t12, - FStar_Pervasives_Native.Some t22) -> - aux false (n_delta + Prims.int_one) t12 t22) - | MisMatch - (uu___1, FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Delta_equational_at_level uu___2)) - -> - if Prims.op_Negation retry - then fail n_delta r t11 t21 - else - (let uu___4 = - let uu___5 = maybe_inline t11 in - let uu___6 = maybe_inline t21 in (uu___5, uu___6) in - match uu___4 with - | (FStar_Pervasives_Native.None, - FStar_Pervasives_Native.None) -> - fail n_delta r t11 t21 - | (FStar_Pervasives_Native.Some t12, - FStar_Pervasives_Native.None) -> - aux false (n_delta + Prims.int_one) t12 t21 - | (FStar_Pervasives_Native.None, - FStar_Pervasives_Native.Some t22) -> - aux false (n_delta + Prims.int_one) t11 t22 - | (FStar_Pervasives_Native.Some t12, - FStar_Pervasives_Native.Some t22) -> - aux false (n_delta + Prims.int_one) t12 t22) - | MisMatch - (FStar_Pervasives_Native.Some d1, - FStar_Pervasives_Native.Some d2) - when d1 = d2 -> reduce_both_and_try_again d1 r - | MisMatch - (FStar_Pervasives_Native.Some d1, - FStar_Pervasives_Native.Some d2) - -> reduce_one_and_try_again d1 d2 - | MisMatch uu___1 -> fail n_delta r t11 t21 - | uu___1 -> success n_delta r t11 t21) in - let r = aux true Prims.int_zero t1 t2 in - (let uu___1 = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "RelDelta") in - if uu___1 - then - let uu___2 = - FStar_Class_Show.show FStar_Syntax_Print.showable_term t1 in - let uu___3 = - FStar_Class_Show.show FStar_Syntax_Print.showable_term t2 in - let uu___4 = - FStar_Class_Show.show - (FStar_Class_Show.show_tuple2 showable_match_result - (FStar_Class_Show.show_option - (FStar_Class_Show.show_tuple2 - FStar_Syntax_Print.showable_term - FStar_Syntax_Print.showable_term))) r in - FStar_Compiler_Util.print3 "head_matches_delta (%s, %s) = %s\n" - uu___2 uu___3 uu___4 - else ()); - r + r let (kind_type : FStar_Syntax_Syntax.binders -> FStar_Compiler_Range_Type.range -> FStar_Syntax_Syntax.typ) @@ -3377,7 +3498,9 @@ let (compress_tprob : (p.FStar_TypeChecker_Common.logical_guard_uvar); FStar_TypeChecker_Common.reason = (p.FStar_TypeChecker_Common.reason); FStar_TypeChecker_Common.loc = (p.FStar_TypeChecker_Common.loc); - FStar_TypeChecker_Common.rank = (p.FStar_TypeChecker_Common.rank) + FStar_TypeChecker_Common.rank = (p.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (p.FStar_TypeChecker_Common.logical) } let (compress_cprob : worklist -> @@ -3409,7 +3532,9 @@ let (compress_cprob : (p.FStar_TypeChecker_Common.logical_guard_uvar); FStar_TypeChecker_Common.reason = (p.FStar_TypeChecker_Common.reason); FStar_TypeChecker_Common.loc = (p.FStar_TypeChecker_Common.loc); - FStar_TypeChecker_Common.rank = (p.FStar_TypeChecker_Common.rank) + FStar_TypeChecker_Common.rank = (p.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (p.FStar_TypeChecker_Common.logical) } let (compress_prob : worklist -> FStar_TypeChecker_Common.prob -> FStar_TypeChecker_Common.prob) @@ -3488,7 +3613,9 @@ let (rank : FStar_TypeChecker_Common.loc = (tp.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (tp.FStar_TypeChecker_Common.rank) + (tp.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (tp.FStar_TypeChecker_Common.logical) }) | (FStar_Syntax_Syntax.Tm_uvar uu___3, FStar_Syntax_Syntax.Tm_type uu___4) -> @@ -3513,7 +3640,9 @@ let (rank : FStar_TypeChecker_Common.loc = (tp.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (tp.FStar_TypeChecker_Common.rank) + (tp.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (tp.FStar_TypeChecker_Common.logical) }) | (FStar_Syntax_Syntax.Tm_type uu___3, FStar_Syntax_Syntax.Tm_uvar uu___4) -> @@ -3538,7 +3667,9 @@ let (rank : FStar_TypeChecker_Common.loc = (tp.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (tp.FStar_TypeChecker_Common.rank) + (tp.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (tp.FStar_TypeChecker_Common.logical) }) | (uu___3, FStar_Syntax_Syntax.Tm_uvar uu___4) -> (FStar_TypeChecker_Common.Rigid_flex, tp) @@ -3572,7 +3703,9 @@ let (rank : FStar_TypeChecker_Common.loc = (tp1.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (FStar_Pervasives_Native.Some rank1) + (FStar_Pervasives_Native.Some rank1); + FStar_TypeChecker_Common.logical = + (tp1.FStar_TypeChecker_Common.logical) }))))) | FStar_TypeChecker_Common.CProb cp -> (FStar_TypeChecker_Common.Rigid_rigid, @@ -3598,7 +3731,9 @@ let (rank : (cp.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = (FStar_Pervasives_Native.Some - FStar_TypeChecker_Common.Rigid_rigid) + FStar_TypeChecker_Common.Rigid_rigid); + FStar_TypeChecker_Common.logical = + (cp.FStar_TypeChecker_Common.logical) })) let (next_prob : worklist -> @@ -4067,7 +4202,7 @@ let (should_defer_flex_to_user_tac : worklist -> flex_t -> Prims.bool) = FStar_TypeChecker_DeferredImplicits.should_defer_uvar_to_user_tac wl.tcenv u in ((let uu___4 = - debug wl (FStar_Options.Other "ResolveImplicitsHook") in + FStar_Compiler_Effect.op_Bang dbg_ResolveImplicitsHook in if uu___4 then let uu___5 = FStar_Syntax_Print.ctx_uvar_to_string_no_reason u in @@ -4306,8 +4441,7 @@ let (run_meta_arg_tac : FStar_TypeChecker_Env.core_check = (env.FStar_TypeChecker_Env.core_check) } in - ((let uu___1 = - FStar_TypeChecker_Env.debug env1 (FStar_Options.Other "Tac") in + ((let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Tac in if uu___1 then let uu___2 = @@ -4330,9 +4464,7 @@ let (simplify_vc : fun full_norm_allowed -> fun env -> fun t -> - (let uu___1 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Simplification") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Simplification in if uu___1 then let uu___2 = @@ -4351,9 +4483,7 @@ let (simplify_vc : else FStar_TypeChecker_Env.NoFullNorm :: steps in let t' = norm_with_steps "FStar.TypeChecker.Rel.simplify_vc" steps1 env t in - (let uu___2 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Simplification") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Simplification in if uu___2 then let uu___3 = @@ -4462,8 +4592,6 @@ let (apply_substitutive_indexed_subcomp : fun wl -> fun subcomp_name -> fun r1 -> - let debug1 = - debug wl (FStar_Options.Other "LayeredEffectsApp") in let uu___ = let uu___1 = bs in match uu___1 with @@ -4649,19 +4777,22 @@ let (apply_substitutive_indexed_subcomp : FStar_TypeChecker_Env.uvars_for_binders env [b] ss (fun b1 -> - if debug1 + let uu___7 = + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsApp in + if uu___7 then - let uu___7 = + let uu___8 = FStar_Syntax_Print.binder_to_string b1 in - let uu___8 = + let uu___9 = FStar_Compiler_Range_Ops.string_of_range r1 in FStar_Compiler_Util.format3 "implicit var for additional binder %s in subcomp %s at %s" - uu___7 - subcomp_name uu___8 + subcomp_name + uu___9 else "apply_substitutive_indexed_subcomp") r1 in @@ -4765,8 +4896,6 @@ let (apply_ad_hoc_indexed_subcomp : fun wl -> fun subcomp_name -> fun r1 -> - let dbg = - debug wl (FStar_Options.Other "LayeredEffectsApp") in let stronger_t_shape_error s = let uu___ = FStar_Ident.string_of_lid @@ -4808,16 +4937,19 @@ let (apply_ad_hoc_indexed_subcomp : ((a_b.FStar_Syntax_Syntax.binder_bv), (ct2.FStar_Syntax_Syntax.result_typ))] (fun b -> - if dbg + let uu___2 = + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsApp in + if uu___2 then - let uu___2 = - FStar_Syntax_Print.binder_to_string b in let uu___3 = + FStar_Syntax_Print.binder_to_string b in + let uu___4 = FStar_Compiler_Range_Ops.string_of_range r1 in FStar_Compiler_Util.format3 "implicit for binder %s in subcomp %s at %s" - uu___2 subcomp_name uu___3 + uu___3 subcomp_name uu___4 else "apply_ad_hoc_indexed_subcomp") r1 in (match uu___1 with | (rest_bs_uvars, g_uvars) -> @@ -4875,9 +5007,8 @@ let (apply_ad_hoc_indexed_subcomp : match uu___4 with | (ps, wl2) -> ((let uu___6 = - debug wl2 - (FStar_Options.Other - "LayeredEffectsEqns") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsApp in if uu___6 then let uu___7 = @@ -4932,9 +5063,8 @@ let (apply_ad_hoc_indexed_subcomp : match uu___5 with | (ps, wl3) -> ((let uu___7 = - debug wl3 - (FStar_Options.Other - "LayeredEffectsEqns") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsApp in if uu___7 then let uu___8 = @@ -4987,10 +5117,13 @@ let (has_typeclass_constraint : FStar_Syntax_Syntax.ctx_uvar -> worklist -> Prims.bool) = fun u -> fun wl -> - FStar_Compiler_Set.for_any FStar_Syntax_Free.ord_ctx_uvar + FStar_Class_Setlike.for_any () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset FStar_Syntax_Free.ord_ctx_uvar)) (fun v -> FStar_Syntax_Unionfind.equiv v.FStar_Syntax_Syntax.ctx_uvar_head - u.FStar_Syntax_Syntax.ctx_uvar_head) wl.typeclass_variables + u.FStar_Syntax_Syntax.ctx_uvar_head) + (Obj.magic wl.typeclass_variables) let (lazy_complete_repr : FStar_Syntax_Syntax.lazy_kind -> Prims.bool) = fun k -> match k with @@ -5007,7 +5140,10 @@ let (has_free_uvars : FStar_Syntax_Syntax.term -> Prims.bool) = fun t -> let uu___ = let uu___1 = FStar_Syntax_Free.uvars_uncached t in - FStar_Compiler_Set.is_empty FStar_Syntax_Free.ord_ctx_uvar uu___1 in + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___1) in Prims.op_Negation uu___ let (env_has_free_uvars : FStar_TypeChecker_Env.env_t -> Prims.bool) = fun e -> @@ -5046,13 +5182,13 @@ let (__proj__Reveal__item___0 : = fun projectee -> match projectee with | Reveal _0 -> _0 let rec (solve : worklist -> solution) = fun probs -> - (let uu___1 = debug probs (FStar_Options.Other "Rel") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___1 then let uu___2 = wl_to_string probs in FStar_Compiler_Util.print1 "solve:\n\t%s\n" uu___2 else ()); - (let uu___2 = debug probs (FStar_Options.Other "ImplicitTrace") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_ImplicitTrace in if uu___2 then let uu___3 = @@ -5126,7 +5262,9 @@ let rec (solve : worklist -> solution) = FStar_TypeChecker_Common.loc = (tp.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (tp.FStar_TypeChecker_Common.rank) + (tp.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (tp.FStar_TypeChecker_Common.logical) } probs1 else solve_rigid_flex_or_flex_rigid_subtyping rank1 tp @@ -5260,7 +5398,7 @@ and (giveup_or_defer : fun msg -> if wl.defer_ok = DeferAny then - ((let uu___1 = debug wl (FStar_Options.Other "Rel") in + ((let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___1 then let uu___2 = prob_to_string wl.tcenv orig in @@ -5281,7 +5419,7 @@ and (giveup_or_defer_flex_flex : fun msg -> if wl.defer_ok <> NoDefer then - ((let uu___1 = debug wl (FStar_Options.Other "Rel") in + ((let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___1 then let uu___2 = prob_to_string wl.tcenv orig in @@ -5296,7 +5434,7 @@ and (defer_to_user_tac : fun orig -> fun reason -> fun wl -> - (let uu___1 = debug wl (FStar_Options.Other "Rel") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___1 then let uu___2 = prob_to_string wl.tcenv orig in @@ -5391,7 +5529,7 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : (FStar_TypeChecker_Common.TProb p); ((FStar_TypeChecker_Common.TProb p), wl3)) in let pairwise t1 t2 wl2 = - (let uu___2 = debug wl2 (FStar_Options.Other "Rel") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___2 then let uu___3 = @@ -5403,8 +5541,8 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : else ()); (let uu___2 = head_matches_delta - (p_env wl2 (FStar_TypeChecker_Common.TProb tp)) wl2.smt_ok - t1 t2 in + (p_env wl2 (FStar_TypeChecker_Common.TProb tp)) + tp.FStar_TypeChecker_Common.logical wl2.smt_ok t1 t2 in match uu___2 with | (mr, ts1) -> (match mr with @@ -5658,7 +5796,7 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : (match uu___4 with | (t12, ps, wl3) -> ((let uu___6 = - debug wl3 (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___6 then let uu___7 = @@ -5717,7 +5855,7 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : | FStar_Pervasives_Native.Some (flex_bs, flex_t1) -> ((let uu___7 = - debug wl1 (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___7 then let uu___8 = @@ -5756,11 +5894,13 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : FStar_TypeChecker_Common.loc = (tp.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (tp.FStar_TypeChecker_Common.rank) + (tp.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (tp.FStar_TypeChecker_Common.logical) }] wl in solve uu___5) | uu___3 -> - ((let uu___5 = debug wl (FStar_Options.Other "Rel") in + ((let uu___5 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___5 then let uu___6 = @@ -5916,9 +6056,8 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : (FStar_TypeChecker_Common.TProb eq_prob); (let uu___13 = - debug wl1 - (FStar_Options.Other - "Rel") in + FStar_Compiler_Effect.op_Bang + dbg_Rel in if uu___13 then let wl'1 = @@ -6049,9 +6188,8 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : solve wl4) | Failed (p, msg) -> ((let uu___16 = - debug wl1 - (FStar_Options.Other - "Rel") in + FStar_Compiler_Effect.op_Bang + dbg_Rel in if uu___16 then let uu___17 = @@ -6437,7 +6575,7 @@ and (solve_binders : fun orig -> fun wl -> fun rhs -> - (let uu___1 = debug wl (FStar_Options.Other "Rel") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___1 then let uu___2 = FStar_Syntax_Print.binders_to_string ", " bs1 in @@ -6449,8 +6587,7 @@ and (solve_binders : match (a1, a2) with | (FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit b1), FStar_Pervasives_Native.Some - (FStar_Syntax_Syntax.Implicit b2)) -> - FStar_Syntax_Util.Equal + (FStar_Syntax_Syntax.Implicit b2)) -> true | uu___1 -> FStar_Syntax_Util.eq_bqual a1 a2 in let compat_positivity_qualifiers p1 p2 = match p_rel orig with @@ -6466,7 +6603,7 @@ and (solve_binders : let uu___1 = rhs wl1 scope subst in (match uu___1 with | (rhs_prob, wl2) -> - ((let uu___3 = debug wl2 (FStar_Options.Other "Rel") in + ((let uu___3 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___3 then let uu___4 = @@ -6477,10 +6614,9 @@ and (solve_binders : (let formula = p_guard rhs_prob in ((FStar_Pervasives.Inl ([rhs_prob], formula)), wl2)))) | (x::xs1, y::ys1) when - (let uu___1 = - eq_bqual x.FStar_Syntax_Syntax.binder_qual - y.FStar_Syntax_Syntax.binder_qual in - uu___1 = FStar_Syntax_Util.Equal) && + (eq_bqual x.FStar_Syntax_Syntax.binder_qual + y.FStar_Syntax_Syntax.binder_qual) + && (compat_positivity_qualifiers x.FStar_Syntax_Syntax.binder_positivity y.FStar_Syntax_Syntax.binder_positivity) @@ -6573,8 +6709,8 @@ and (solve_binders : FStar_Syntax_Util.mk_conj (p_guard prob) uu___5 in ((let uu___6 = - debug wl3 - (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang + dbg_Rel in if uu___6 then let uu___7 = @@ -6707,9 +6843,13 @@ and (solve_t_flex_rigid_eq : fun wl -> fun lhs -> fun rhs -> - (let uu___1 = debug wl (FStar_Options.Other "Rel") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___1 - then FStar_Compiler_Util.print_string "solve_t_flex_rigid_eq\n" + then + let uu___2 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term rhs in + FStar_Compiler_Util.print1 "solve_t_flex_rigid_eq rhs=%s\n" + uu___2 else ()); (let uu___1 = should_defer_flex_to_user_tac wl lhs in if uu___1 @@ -6727,8 +6867,11 @@ and (solve_t_flex_rigid_eq : let uu___7 = FStar_Syntax_Free.names (FStar_Pervasives_Native.fst arg) in - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_bv x - uu___7 in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) x + (Obj.magic uu___7) in Prims.op_Negation uu___6 in let bv_not_free_in_args x args1 = FStar_Compiler_Util.for_all (bv_not_free_in_arg x) @@ -6745,8 +6888,10 @@ and (solve_t_flex_rigid_eq : (fun x -> fun y -> let uu___7 = - FStar_Syntax_Util.eq_tm x y in - uu___7 = FStar_Syntax_Util.Equal) + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env x y in + uu___7 = + FStar_TypeChecker_TermEqAndSimplify.Equal) b.FStar_Syntax_Syntax.binder_attrs a.FStar_Syntax_Syntax.aqual_attributes) | uu___6 -> false in @@ -6798,7 +6943,7 @@ and (solve_t_flex_rigid_eq : u_abs uu___7 uu___8 rhs2 in [TERM (ctx_u, sol)]) in let try_quasi_pattern orig1 env wl1 lhs1 rhs1 = - (let uu___4 = debug wl1 (FStar_Options.Other "Rel") in + (let uu___4 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___4 then FStar_Compiler_Util.print_string "try_quasi_pattern\n" else ()); @@ -6833,9 +6978,12 @@ and (solve_t_flex_rigid_eq : let fvs_rhs = FStar_Syntax_Free.names rhs1 in let uu___9 = let uu___10 = - FStar_Compiler_Set.subset - FStar_Syntax_Syntax.ord_bv fvs_rhs - fvs_lhs in + FStar_Class_Setlike.subset () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic fvs_rhs) + (Obj.magic fvs_lhs) in Prims.op_Negation uu___10 in if uu___9 then @@ -7056,7 +7204,7 @@ and (solve_t_flex_rigid_eq : attempt sub_probs uu___9 in solve uu___8)))) in let imitate orig1 env wl1 lhs1 rhs1 = - (let uu___4 = debug wl1 (FStar_Options.Other "Rel") in + (let uu___4 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___4 then FStar_Compiler_Util.print_string "imitate\n" else ()); @@ -7109,7 +7257,7 @@ and (solve_t_flex_rigid_eq : msg))) in let try_first_order orig1 env wl1 lhs1 rhs1 = let inapplicable msg lstring_opt = - (let uu___4 = debug wl1 (FStar_Options.Other "Rel") in + (let uu___4 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___4 then let extra_msg = @@ -7122,7 +7270,7 @@ and (solve_t_flex_rigid_eq : extra_msg else ()); FStar_Pervasives.Inl "first_order doesn't apply" in - (let uu___4 = debug wl1 (FStar_Options.Other "Rel") in + (let uu___4 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___4 then let uu___5 = flex_t_to_string lhs1 in @@ -7169,9 +7317,12 @@ and (solve_t_flex_rigid_eq : let uu___14 = binders_as_bv_set ctx_uv.FStar_Syntax_Syntax.ctx_uvar_binders in - FStar_Compiler_Set.subset - FStar_Syntax_Syntax.ord_bv - uu___13 uu___14 in + FStar_Class_Setlike.subset () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic uu___13) + (Obj.magic uu___14) in Prims.op_Negation uu___12 in if uu___11 then @@ -7443,19 +7594,18 @@ and (solve_t_flex_rigid_eq : let uu___17 = FStar_Syntax_Util.ctx_uvar_typ ctx_uv in - FStar_Syntax_Util.eq_tm - t_head uu___17 in + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env t_head uu___17 in uu___16 = - FStar_Syntax_Util.Equal in + FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___15 then solve_sub_probs_if_head_types_equal uvars_head wl1 else ((let uu___18 = - debug wl1 - (FStar_Options.Other - "Rel") in + FStar_Compiler_Effect.op_Bang + dbg_Rel in if uu___18 then let uu___19 = @@ -7498,9 +7648,13 @@ and (solve_t_flex_rigid_eq : let uu___20 = FStar_Syntax_Free.uvars head1 in - FStar_Compiler_Set.elems - FStar_Syntax_Free.ord_ctx_uvar - uu___20 in + FStar_Class_Setlike.elems + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic + uu___20) in solve_sub_probs_if_head_types_equal uu___19 wl2 | FStar_Pervasives.Inr @@ -7538,7 +7692,7 @@ and (solve_t_flex_rigid_eq : (match uu___4 with | FStar_Pervasives_Native.Some lhs_binders -> ((let uu___6 = - debug wl (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___6 then FStar_Compiler_Util.print_string @@ -7554,65 +7708,102 @@ and (solve_t_flex_rigid_eq : let uu___6 = occurs_check ctx_uv rhs1 in match uu___6 with | (uvars, occurs_ok, msg) -> - if Prims.op_Negation occurs_ok - then - let uu___7 = - let uu___8 = - let uu___9 = - FStar_Compiler_Option.get msg in - Prims.strcat "occurs-check failed: " - uu___9 in - FStar_Thunk.mkv uu___8 in - giveup_or_defer orig wl - FStar_TypeChecker_Common.Deferred_occur_check_failed - uu___7 - else - (let uu___8 = - FStar_Compiler_Set.subset - FStar_Syntax_Syntax.ord_bv fvs2 fvs1 in - if uu___8 - then - let sol = - mk_solution env lhs lhs_binders rhs1 in - let wl1 = - restrict_all_uvars env ctx_uv - lhs_binders uvars wl in - let uu___9 = - solve_prob orig - FStar_Pervasives_Native.None sol - wl1 in - solve uu___9 - else - if wl.defer_ok = DeferAny + let uu___7 = + if occurs_ok + then ((uvars, occurs_ok, msg), rhs1) + else + (let rhs2 = + FStar_TypeChecker_Normalize.normalize + [FStar_TypeChecker_Env.Primops; + FStar_TypeChecker_Env.Weak; + FStar_TypeChecker_Env.HNF; + FStar_TypeChecker_Env.Beta; + FStar_TypeChecker_Env.Eager_unfolding; + FStar_TypeChecker_Env.Unascribe] + (p_env wl orig) rhs1 in + let uu___9 = occurs_check ctx_uv rhs2 in + (uu___9, rhs2)) in + (match uu___7 with + | ((uvars1, occurs_ok1, msg1), rhs2) -> + let uu___8 = + (term_is_uvar ctx_uv rhs2) && + (Prims.uu___is_Nil args_lhs) in + if uu___8 then - (let msg1 = - mklstr - (fun uu___10 -> - let uu___11 = - FStar_Class_Show.show - (FStar_Compiler_Set.showable_set - FStar_Syntax_Syntax.ord_bv - FStar_Syntax_Print.showable_bv) - fvs2 in - let uu___12 = - FStar_Class_Show.show - (FStar_Compiler_Set.showable_set - FStar_Syntax_Syntax.ord_bv - FStar_Syntax_Print.showable_bv) - fvs1 in - let uu___13 = - FStar_Syntax_Print.binders_to_string - ", " - (FStar_Compiler_List.op_At - ctx_uv.FStar_Syntax_Syntax.ctx_uvar_binders - lhs_binders) in - FStar_Compiler_Util.format3 - "free names in the RHS {%s} are out of scope for the LHS: {%s}, {%s}" - uu___11 uu___12 uu___13) in - giveup_or_defer orig wl - FStar_TypeChecker_Common.Deferred_free_names_check_failed - msg1) - else imitate orig env wl lhs rhs1))) + let uu___9 = + solve_prob orig + FStar_Pervasives_Native.None [] + wl in + solve uu___9 + else + if Prims.op_Negation occurs_ok1 + then + (let uu___10 = + let uu___11 = + let uu___12 = + FStar_Compiler_Option.get + msg1 in + Prims.strcat + "occurs-check failed: " + uu___12 in + FStar_Thunk.mkv uu___11 in + giveup_or_defer orig wl + FStar_TypeChecker_Common.Deferred_occur_check_failed + uu___10) + else + (let uu___11 = + FStar_Class_Setlike.subset () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic fvs2) + (Obj.magic fvs1) in + if uu___11 + then + let sol = + mk_solution env lhs + lhs_binders rhs2 in + let wl1 = + restrict_all_uvars env ctx_uv + lhs_binders uvars1 wl in + let uu___12 = + solve_prob orig + FStar_Pervasives_Native.None + sol wl1 in + solve uu___12 + else + if wl.defer_ok = DeferAny + then + (let msg2 = + mklstr + (fun uu___13 -> + let uu___14 = + FStar_Class_Show.show + (FStar_Compiler_FlatSet.showable_set + FStar_Syntax_Syntax.ord_bv + FStar_Syntax_Print.showable_bv) + fvs2 in + let uu___15 = + FStar_Class_Show.show + (FStar_Compiler_FlatSet.showable_set + FStar_Syntax_Syntax.ord_bv + FStar_Syntax_Print.showable_bv) + fvs1 in + let uu___16 = + FStar_Syntax_Print.binders_to_string + ", " + (FStar_Compiler_List.op_At + ctx_uv.FStar_Syntax_Syntax.ctx_uvar_binders + lhs_binders) in + FStar_Compiler_Util.format3 + "free names in the RHS {%s} are out of scope for the LHS: {%s}, {%s}" + uu___14 uu___15 + uu___16) in + giveup_or_defer orig wl + FStar_TypeChecker_Common.Deferred_free_names_check_failed + msg2) + else + imitate orig env wl lhs rhs2)))) | uu___5 -> if wl.defer_ok = DeferAny then @@ -7660,7 +7851,7 @@ and (solve_t_flex_flex : let run_meta_arg_tac_and_try_again flex = let uv = flex_uvar flex in let t = run_meta_arg_tac env uv in - (let uu___1 = debug wl (FStar_Options.Other "Rel") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___1 then let uu___2 = @@ -7802,7 +7993,7 @@ and (solve_t_flex_flex : let uu___21 = let uu___22 = FStar_Class_Show.show - uu___76 wl.defer_ok in + uu___85 wl.defer_ok in FStar_Compiler_Util.format1 "flex-flex: occurs\n defer_ok=%s\n" uu___22 in @@ -7898,9 +8089,8 @@ and (solve_t_flex_flex : w uu___24 w.FStar_Syntax_Syntax.pos in ((let uu___25 = - debug wl1 - (FStar_Options.Other - "Rel") in + FStar_Compiler_Effect.op_Bang + dbg_Rel in if uu___25 then let uu___26 = @@ -8027,7 +8217,7 @@ and (solve_t' : tprob -> worklist -> solution) = let rigid_heads_match need_unif torig wl1 t1 t2 = let orig = FStar_TypeChecker_Common.TProb torig in let env = p_env wl1 orig in - (let uu___2 = debug wl1 (FStar_Options.Other "Rel") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___2 then let uu___3 = @@ -8105,8 +8295,10 @@ and (solve_t' : tprob -> worklist -> solution) = else (let uu___5 = (nargs = Prims.int_zero) || - (let uu___6 = FStar_Syntax_Util.eq_args args1 args2 in - uu___6 = FStar_Syntax_Util.Equal) in + (let uu___6 = + FStar_TypeChecker_TermEqAndSimplify.eq_args env + args1 args2 in + uu___6 = FStar_TypeChecker_TermEqAndSimplify.Equal) in if uu___5 then (if need_unif1 @@ -8130,7 +8322,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } wl1 else solve_head_then wl1 @@ -8192,8 +8386,8 @@ and (solve_t' : tprob -> worklist -> solution) = match uu___9 with | (subprobs, wl3) -> ((let uu___11 = - debug wl3 - (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang + dbg_Rel in if uu___11 then let uu___12 = @@ -8269,8 +8463,8 @@ and (solve_t' : tprob -> worklist -> solution) = match uu___9 with | (prob, reason) -> ((let uu___11 = - debug wl2 - (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang + dbg_Rel in if uu___11 then let uu___12 = @@ -8308,25 +8502,26 @@ and (solve_t' : tprob -> worklist -> solution) = -> let uu___16 = let uu___17 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env1 head1' head1 in let uu___18 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env1 head2' head2 in (uu___17, uu___18) in (match uu___16 with - | (FStar_Syntax_Util.Equal, - FStar_Syntax_Util.Equal) + | (FStar_TypeChecker_TermEqAndSimplify.Equal, + FStar_TypeChecker_TermEqAndSimplify.Equal) -> ((let uu___18 = - debug wl2 - (FStar_Options.Other - "Rel") in + FStar_Compiler_Effect.op_Bang + dbg_Rel in if uu___18 then @@ -8390,13 +8585,15 @@ and (solve_t' : tprob -> worklist -> solution) = (torig.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (torig.FStar_TypeChecker_Common.rank) + (torig.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical + = + (torig.FStar_TypeChecker_Common.logical) } in ((let uu___19 = - debug wl2 - (FStar_Options.Other - "Rel") in + FStar_Compiler_Effect.op_Bang + dbg_Rel in if uu___19 then @@ -8417,13 +8614,10 @@ and (solve_t' : tprob -> worklist -> solution) = solve_sub_probs env1 wl2)) in let d = let uu___9 = - delta_depth_of_term env head1 in - match uu___9 with - | FStar_Pervasives_Native.None -> - FStar_Pervasives_Native.None - | FStar_Pervasives_Native.Some d1 -> - FStar_TypeChecker_Common.decr_delta_depth - d1 in + FStar_TypeChecker_Env.delta_depth_of_term + env head1 in + FStar_TypeChecker_Common.decr_delta_depth + uu___9 in let treat_as_injective = let uu___9 = let uu___10 = @@ -8475,7 +8669,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } wl1)))))) in let try_match_heuristic orig wl1 s1 s2 t1t2_opt = let env = p_env wl1 orig in @@ -8521,7 +8717,7 @@ and (solve_t' : tprob -> worklist -> solution) = uu___7 in FStar_Syntax_Util.unrefine uu___6 in (let uu___7 = - debug wl3 (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___7 then let uu___8 = @@ -8540,7 +8736,7 @@ and (solve_t' : tprob -> worklist -> solution) = match uu___7 with | (pat_term2, pat_term_t, g_pat_term) -> ((let uu___9 = - debug wl3 (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___9 then let uu___10 = @@ -8656,7 +8852,7 @@ and (solve_t' : tprob -> worklist -> solution) = | FStar_Pervasives_Native.None -> FStar_Pervasives.Inr FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some (t1, t2) -> - ((let uu___2 = debug wl1 (FStar_Options.Other "Rel") in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___2 then let uu___3 = @@ -8689,7 +8885,7 @@ and (solve_t' : tprob -> worklist -> solution) = Prims.op_Negation uu___10 in if uu___9 then - ((let uu___11 = debug wl1 (FStar_Options.Other "Rel") in + ((let uu___11 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___11 then let uu___12 = @@ -8702,7 +8898,7 @@ and (solve_t' : tprob -> worklist -> solution) = else if wl1.defer_ok = DeferAny then - ((let uu___12 = debug wl1 (FStar_Options.Other "Rel") in + ((let uu___12 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___12 then FStar_Compiler_Util.print_string @@ -8710,7 +8906,7 @@ and (solve_t' : tprob -> worklist -> solution) = else ()); FStar_Pervasives.Inl "defer") else - ((let uu___13 = debug wl1 (FStar_Options.Other "Rel") in + ((let uu___13 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___13 then let uu___14 = @@ -8747,7 +8943,7 @@ and (solve_t' : tprob -> worklist -> solution) = | (uu___14, uu___15, t') -> let uu___16 = head_matches_delta (p_env wl1 orig) - wl1.smt_ok s t' in + (p_logical orig) wl1.smt_ok s t' in (match uu___16 with | (FullMatch, uu___17) -> true | (HeadMatch uu___17, uu___18) -> true @@ -8756,7 +8952,7 @@ and (solve_t' : tprob -> worklist -> solution) = match head_matching_branch with | FStar_Pervasives_Native.None -> ((let uu___14 = - debug wl1 (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___14 then FStar_Compiler_Util.print_string @@ -8787,7 +8983,7 @@ and (solve_t' : tprob -> worklist -> solution) = (match uu___13 with | (p, uu___14, e) -> ((let uu___16 = - debug wl1 (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___16 then let uu___17 = @@ -8819,7 +9015,7 @@ and (solve_t' : tprob -> worklist -> solution) = Prims.op_Negation uu___10 in if uu___9 then - ((let uu___11 = debug wl1 (FStar_Options.Other "Rel") in + ((let uu___11 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___11 then let uu___12 = @@ -8832,7 +9028,7 @@ and (solve_t' : tprob -> worklist -> solution) = else if wl1.defer_ok = DeferAny then - ((let uu___12 = debug wl1 (FStar_Options.Other "Rel") in + ((let uu___12 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___12 then FStar_Compiler_Util.print_string @@ -8840,7 +9036,7 @@ and (solve_t' : tprob -> worklist -> solution) = else ()); FStar_Pervasives.Inl "defer") else - ((let uu___13 = debug wl1 (FStar_Options.Other "Rel") in + ((let uu___13 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___13 then let uu___14 = @@ -8877,7 +9073,7 @@ and (solve_t' : tprob -> worklist -> solution) = | (uu___14, uu___15, t') -> let uu___16 = head_matches_delta (p_env wl1 orig) - wl1.smt_ok s t' in + (p_logical orig) wl1.smt_ok s t' in (match uu___16 with | (FullMatch, uu___17) -> true | (HeadMatch uu___17, uu___18) -> true @@ -8886,7 +9082,7 @@ and (solve_t' : tprob -> worklist -> solution) = match head_matching_branch with | FStar_Pervasives_Native.None -> ((let uu___14 = - debug wl1 (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___14 then FStar_Compiler_Util.print_string @@ -8917,7 +9113,7 @@ and (solve_t' : tprob -> worklist -> solution) = (match uu___13 with | (p, uu___14, e) -> ((let uu___16 = - debug wl1 (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___16 then let uu___17 = @@ -8933,7 +9129,7 @@ and (solve_t' : tprob -> worklist -> solution) = try_solve_branch scrutinee p in FStar_Pervasives.Inr uu___16))))) | uu___3 -> - ((let uu___5 = debug wl1 (FStar_Options.Other "Rel") in + ((let uu___5 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___5 then let uu___6 = FStar_Syntax_Print.tag_of_term t1 in @@ -8945,7 +9141,7 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_Pervasives.Inr FStar_Pervasives_Native.None))) in let rigid_rigid_delta torig wl1 head1 head2 t1 t2 = let orig = FStar_TypeChecker_Common.TProb torig in - (let uu___2 = debug wl1 (FStar_Options.Other "RelDelta") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_RelDelta in if uu___2 then let uu___3 = FStar_Syntax_Print.tag_of_term t1 in @@ -8958,7 +9154,9 @@ and (solve_t' : tprob -> worklist -> solution) = "rigid_rigid_delta of %s-%s (%s, %s)\n" uu___3 uu___4 uu___5 uu___6 else ()); - (let uu___2 = head_matches_delta (p_env wl1 orig) wl1.smt_ok t1 t2 in + (let uu___2 = + head_matches_delta (p_env wl1 orig) (p_logical orig) wl1.smt_ok + t1 t2 in match uu___2 with | (m, o) -> (match (m, o) with @@ -9095,7 +9293,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } wl1 | FStar_Pervasives_Native.None -> let uu___7 = @@ -9127,38 +9327,22 @@ and (solve_t' : tprob -> worklist -> solution) = head1 in let uu___12 = let uu___13 = - let uu___14 = - delta_depth_of_term wl1.tcenv - head1 in - FStar_Compiler_Util.bind_opt - uu___14 - (fun x -> - let uu___15 = - FStar_Class_Show.show - FStar_Syntax_Syntax.showable_delta_depth - x in - FStar_Pervasives_Native.Some - uu___15) in - FStar_Compiler_Util.dflt "" uu___13 in + FStar_TypeChecker_Env.delta_depth_of_term + wl1.tcenv head1 in + FStar_Class_Show.show + FStar_Syntax_Syntax.showable_delta_depth + uu___13 in let uu___13 = FStar_Class_Show.show FStar_Syntax_Print.showable_term head2 in let uu___14 = let uu___15 = - let uu___16 = - delta_depth_of_term wl1.tcenv - head2 in - FStar_Compiler_Util.bind_opt - uu___16 - (fun x -> - let uu___17 = - FStar_Class_Show.show - FStar_Syntax_Syntax.showable_delta_depth - x in - FStar_Pervasives_Native.Some - uu___17) in - FStar_Compiler_Util.dflt "" uu___15 in + FStar_TypeChecker_Env.delta_depth_of_term + wl1.tcenv head2 in + FStar_Class_Show.show + FStar_Syntax_Syntax.showable_delta_depth + uu___15 in FStar_Compiler_Util.format4 "head mismatch (%s (%s) vs %s (%s))" uu___11 uu___12 uu___13 uu___14) in @@ -9210,7 +9394,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } wl1 | (HeadMatch need_unif, FStar_Pervasives_Native.None) -> rigid_heads_match need_unif torig wl1 t1 t2 @@ -9245,7 +9431,7 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_Class_Binders.hasBinders_list_bv FStar_Class_Binders.hasNames_term FStar_Syntax_Print.pretty_term (p_loc orig) "ref.t2" uu___6 t2); - (let uu___7 = debug wl (FStar_Options.Other "Rel") in + (let uu___7 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___7 then let uu___8 = @@ -9265,10 +9451,16 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_Class_Show.show FStar_Syntax_Print.showable_term t2 in Prims.strcat "::" uu___13 in Prims.strcat uu___11 uu___12 in - FStar_Compiler_Util.print4 - "Attempting %s (%s vs %s); rel = (%s)\n" uu___8 uu___9 - uu___10 + let uu___11 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_nat) + (FStar_Compiler_List.length wl.attempting) in + FStar_Compiler_Util.print5 + "Attempting %s (%s vs %s); rel = (%s); number of problems in wl = %s\n" + uu___8 uu___9 uu___10 (rel_to_string problem.FStar_TypeChecker_Common.relation) + uu___11 else ()); (match ((t1.FStar_Syntax_Syntax.n), (t2.FStar_Syntax_Syntax.n)) with @@ -9300,7 +9492,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } in solve_t' uu___9 wl | (FStar_Syntax_Syntax.Tm_meta uu___7, uu___8) -> @@ -9325,7 +9519,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } in solve_t' uu___9 wl | (uu___7, FStar_Syntax_Syntax.Tm_ascribed uu___8) -> @@ -9350,7 +9546,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } in solve_t' uu___9 wl | (uu___7, FStar_Syntax_Syntax.Tm_meta uu___8) -> @@ -9375,7 +9573,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } in solve_t' uu___9 wl | (FStar_Syntax_Syntax.Tm_quoted (t11, uu___7), @@ -9479,7 +9679,7 @@ and (solve_t' : tprob -> worklist -> solution) = let env = p_env wl (FStar_TypeChecker_Common.TProb problem) in let uu___7 = let uu___8 = - head_matches_delta env wl.smt_ok + head_matches_delta env false wl.smt_ok x1.FStar_Syntax_Syntax.sort x2.FStar_Syntax_Syntax.sort in match uu___8 with | (FullMatch, FStar_Pervasives_Native.Some (t11, t21)) -> @@ -9537,7 +9737,7 @@ and (solve_t' : tprob -> worklist -> solution) = (match uu___9 with | (x22, phi21) -> ((let uu___11 = - debug wl (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___11 then ((let uu___13 = @@ -9638,16 +9838,20 @@ and (solve_t' : tprob -> worklist -> solution) = (let uu___12 = let uu___13 = FStar_Syntax_Free.uvars phi12 in - FStar_Compiler_Set.is_empty - FStar_Syntax_Free.ord_ctx_uvar - uu___13 in + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uu___13) in Prims.op_Negation uu___12) || (let uu___12 = let uu___13 = FStar_Syntax_Free.uvars phi22 in - FStar_Compiler_Set.is_empty - FStar_Syntax_Free.ord_ctx_uvar - uu___13 in + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uu___13) in Prims.op_Negation uu___12) in if (problem.FStar_TypeChecker_Common.relation @@ -9669,13 +9873,15 @@ and (solve_t' : tprob -> worklist -> solution) = "refinement formula" in (match uu___12 with | (ref_prob, wl2) -> + let ref_prob1 = + set_logical true ref_prob in let tx = FStar_Syntax_Unionfind.new_transaction () in let uu___13 = solve { - attempting = [ref_prob]; + attempting = [ref_prob1]; wl_deferred = []; wl_deferred_to_tac = (wl2.wl_deferred_to_tac); @@ -9717,7 +9923,7 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___16 = guard_on_element wl2 problem x13 - (p_guard ref_prob) in + (p_guard ref_prob1) in FStar_Syntax_Util.mk_conj (p_guard base_prob) uu___16 in @@ -9910,7 +10116,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } wl | (FStar_Syntax_Syntax.Tm_app { @@ -9944,7 +10152,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } wl | (uu___7, FStar_Syntax_Syntax.Tm_uvar uu___8) -> let uu___9 = @@ -10003,7 +10213,8 @@ and (solve_t' : tprob -> worklist -> solution) = solve_t_flex_rigid_eq orig wl1 flex t_abs) else (let uu___11 = - head_matches_delta env wl.smt_ok not_abs t_abs in + head_matches_delta env false wl.smt_ok not_abs + t_abs in match uu___11 with | (HeadMatch uu___12, FStar_Pervasives_Native.Some (not_abs', uu___13)) -> @@ -10026,7 +10237,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } wl | uu___12 -> let uu___13 = @@ -10064,7 +10277,8 @@ and (solve_t' : tprob -> worklist -> solution) = solve_t_flex_rigid_eq orig wl1 flex t_abs) else (let uu___11 = - head_matches_delta env wl.smt_ok not_abs t_abs in + head_matches_delta env false wl.smt_ok not_abs + t_abs in match uu___11 with | (HeadMatch uu___12, FStar_Pervasives_Native.Some (not_abs', uu___13)) -> @@ -10087,7 +10301,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } wl | uu___12 -> let uu___13 = @@ -10136,7 +10352,8 @@ and (solve_t' : tprob -> worklist -> solution) = solve_t_flex_rigid_eq orig wl1 flex t_abs) else (let uu___11 = - head_matches_delta env wl.smt_ok not_abs t_abs in + head_matches_delta env false wl.smt_ok not_abs + t_abs in match uu___11 with | (HeadMatch uu___12, FStar_Pervasives_Native.Some (not_abs', uu___13)) -> @@ -10159,7 +10376,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } wl | uu___12 -> let uu___13 = @@ -10197,7 +10416,8 @@ and (solve_t' : tprob -> worklist -> solution) = solve_t_flex_rigid_eq orig wl1 flex t_abs) else (let uu___11 = - head_matches_delta env wl.smt_ok not_abs t_abs in + head_matches_delta env false wl.smt_ok not_abs + t_abs in match uu___11 with | (HeadMatch uu___12, FStar_Pervasives_Native.Some (not_abs', uu___13)) -> @@ -10220,7 +10440,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } wl | uu___12 -> let uu___13 = @@ -10272,7 +10494,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } wl | (uu___7, FStar_Syntax_Syntax.Tm_refine uu___8) -> let t11 = @@ -10298,7 +10522,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } wl | (FStar_Syntax_Syntax.Tm_match { FStar_Syntax_Syntax.scrutinee = s1; @@ -10400,9 +10626,8 @@ and (solve_t' : tprob -> worklist -> solution) = (match uu___21 with | (prob, wl3) -> ((let uu___23 = - debug wl3 - (FStar_Options.Other - "Rel") in + FStar_Compiler_Effect.op_Bang + dbg_Rel in if uu___23 then let uu___24 = @@ -10458,7 +10683,7 @@ and (solve_t' : tprob -> worklist -> solution) = match uu___14 with | (scope, p) -> FStar_TypeChecker_Env.close_forall - wl2.tcenv scope (p_guard p)) + (p_env wl2 orig) scope (p_guard p)) sub_probs1 in FStar_Syntax_Util.mk_conj_l uu___13 in let tx = FStar_Syntax_Unionfind.new_transaction () in @@ -10508,16 +10733,21 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStar_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = debug wl (FStar_Options.Other "Rel") in + ((let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = let uu___12 = - FStar_Compiler_Util.string_of_int + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) problem.FStar_TypeChecker_Common.pid in let uu___13 = let uu___14 = - FStar_Compiler_Util.string_of_bool wl.smt_ok in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + wl.smt_ok in let uu___15 = let uu___16 = FStar_Class_Show.show @@ -10527,11 +10757,17 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___19 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head1 in - FStar_Compiler_Util.string_of_bool uu___19 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___19 in let uu___19 = let uu___20 = let uu___21 = no_free_uvars t1 in - FStar_Compiler_Util.string_of_bool uu___21 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___21 in let uu___21 = let uu___22 = FStar_Class_Show.show @@ -10541,12 +10777,16 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___25 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___25 in let uu___25 = let uu___26 = let uu___27 = no_free_uvars t2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___27 in [uu___26] in uu___24 :: uu___25 in @@ -10561,11 +10801,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -10573,7 +10815,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -10582,8 +10823,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -10644,16 +10887,21 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStar_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = debug wl (FStar_Options.Other "Rel") in + ((let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = let uu___12 = - FStar_Compiler_Util.string_of_int + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) problem.FStar_TypeChecker_Common.pid in let uu___13 = let uu___14 = - FStar_Compiler_Util.string_of_bool wl.smt_ok in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + wl.smt_ok in let uu___15 = let uu___16 = FStar_Class_Show.show @@ -10663,11 +10911,17 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___19 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head1 in - FStar_Compiler_Util.string_of_bool uu___19 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___19 in let uu___19 = let uu___20 = let uu___21 = no_free_uvars t1 in - FStar_Compiler_Util.string_of_bool uu___21 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___21 in let uu___21 = let uu___22 = FStar_Class_Show.show @@ -10677,12 +10931,16 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___25 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___25 in let uu___25 = let uu___26 = let uu___27 = no_free_uvars t2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___27 in [uu___26] in uu___24 :: uu___25 in @@ -10697,11 +10955,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -10709,7 +10969,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -10718,8 +10977,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -10780,16 +11041,21 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStar_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = debug wl (FStar_Options.Other "Rel") in + ((let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = let uu___12 = - FStar_Compiler_Util.string_of_int + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) problem.FStar_TypeChecker_Common.pid in let uu___13 = let uu___14 = - FStar_Compiler_Util.string_of_bool wl.smt_ok in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + wl.smt_ok in let uu___15 = let uu___16 = FStar_Class_Show.show @@ -10799,11 +11065,17 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___19 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head1 in - FStar_Compiler_Util.string_of_bool uu___19 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___19 in let uu___19 = let uu___20 = let uu___21 = no_free_uvars t1 in - FStar_Compiler_Util.string_of_bool uu___21 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___21 in let uu___21 = let uu___22 = FStar_Class_Show.show @@ -10813,12 +11085,16 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___25 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___25 in let uu___25 = let uu___26 = let uu___27 = no_free_uvars t2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___27 in [uu___26] in uu___24 :: uu___25 in @@ -10833,11 +11109,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -10845,7 +11123,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -10854,8 +11131,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -10916,16 +11195,21 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStar_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = debug wl (FStar_Options.Other "Rel") in + ((let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = let uu___12 = - FStar_Compiler_Util.string_of_int + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) problem.FStar_TypeChecker_Common.pid in let uu___13 = let uu___14 = - FStar_Compiler_Util.string_of_bool wl.smt_ok in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + wl.smt_ok in let uu___15 = let uu___16 = FStar_Class_Show.show @@ -10935,11 +11219,17 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___19 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head1 in - FStar_Compiler_Util.string_of_bool uu___19 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___19 in let uu___19 = let uu___20 = let uu___21 = no_free_uvars t1 in - FStar_Compiler_Util.string_of_bool uu___21 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___21 in let uu___21 = let uu___22 = FStar_Class_Show.show @@ -10949,12 +11239,16 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___25 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___25 in let uu___25 = let uu___26 = let uu___27 = no_free_uvars t2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___27 in [uu___26] in uu___24 :: uu___25 in @@ -10969,11 +11263,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -10981,7 +11277,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -10990,8 +11285,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -11052,16 +11349,21 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStar_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = debug wl (FStar_Options.Other "Rel") in + ((let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = let uu___12 = - FStar_Compiler_Util.string_of_int + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) problem.FStar_TypeChecker_Common.pid in let uu___13 = let uu___14 = - FStar_Compiler_Util.string_of_bool wl.smt_ok in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + wl.smt_ok in let uu___15 = let uu___16 = FStar_Class_Show.show @@ -11071,11 +11373,17 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___19 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head1 in - FStar_Compiler_Util.string_of_bool uu___19 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___19 in let uu___19 = let uu___20 = let uu___21 = no_free_uvars t1 in - FStar_Compiler_Util.string_of_bool uu___21 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___21 in let uu___21 = let uu___22 = FStar_Class_Show.show @@ -11085,12 +11393,16 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___25 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___25 in let uu___25 = let uu___26 = let uu___27 = no_free_uvars t2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___27 in [uu___26] in uu___24 :: uu___25 in @@ -11105,11 +11417,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -11117,7 +11431,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -11126,8 +11439,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -11188,16 +11503,21 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStar_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = debug wl (FStar_Options.Other "Rel") in + ((let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = let uu___12 = - FStar_Compiler_Util.string_of_int + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) problem.FStar_TypeChecker_Common.pid in let uu___13 = let uu___14 = - FStar_Compiler_Util.string_of_bool wl.smt_ok in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + wl.smt_ok in let uu___15 = let uu___16 = FStar_Class_Show.show @@ -11207,11 +11527,17 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___19 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head1 in - FStar_Compiler_Util.string_of_bool uu___19 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___19 in let uu___19 = let uu___20 = let uu___21 = no_free_uvars t1 in - FStar_Compiler_Util.string_of_bool uu___21 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___21 in let uu___21 = let uu___22 = FStar_Class_Show.show @@ -11221,12 +11547,16 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___25 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___25 in let uu___25 = let uu___26 = let uu___27 = no_free_uvars t2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___27 in [uu___26] in uu___24 :: uu___25 in @@ -11241,11 +11571,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -11253,7 +11585,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -11262,8 +11593,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -11324,16 +11657,21 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStar_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = debug wl (FStar_Options.Other "Rel") in + ((let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = let uu___12 = - FStar_Compiler_Util.string_of_int + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) problem.FStar_TypeChecker_Common.pid in let uu___13 = let uu___14 = - FStar_Compiler_Util.string_of_bool wl.smt_ok in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + wl.smt_ok in let uu___15 = let uu___16 = FStar_Class_Show.show @@ -11343,11 +11681,17 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___19 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head1 in - FStar_Compiler_Util.string_of_bool uu___19 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___19 in let uu___19 = let uu___20 = let uu___21 = no_free_uvars t1 in - FStar_Compiler_Util.string_of_bool uu___21 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___21 in let uu___21 = let uu___22 = FStar_Class_Show.show @@ -11357,12 +11701,16 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___25 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___25 in let uu___25 = let uu___26 = let uu___27 = no_free_uvars t2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___27 in [uu___26] in uu___24 :: uu___25 in @@ -11377,11 +11725,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -11389,7 +11739,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -11398,8 +11747,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -11460,16 +11811,21 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStar_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = debug wl (FStar_Options.Other "Rel") in + ((let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = let uu___12 = - FStar_Compiler_Util.string_of_int + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) problem.FStar_TypeChecker_Common.pid in let uu___13 = let uu___14 = - FStar_Compiler_Util.string_of_bool wl.smt_ok in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + wl.smt_ok in let uu___15 = let uu___16 = FStar_Class_Show.show @@ -11479,11 +11835,17 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___19 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head1 in - FStar_Compiler_Util.string_of_bool uu___19 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___19 in let uu___19 = let uu___20 = let uu___21 = no_free_uvars t1 in - FStar_Compiler_Util.string_of_bool uu___21 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___21 in let uu___21 = let uu___22 = FStar_Class_Show.show @@ -11493,12 +11855,16 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___25 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___25 in let uu___25 = let uu___26 = let uu___27 = no_free_uvars t2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___27 in [uu___26] in uu___24 :: uu___25 in @@ -11513,11 +11879,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -11525,7 +11893,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -11534,8 +11901,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -11596,16 +11965,21 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStar_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = debug wl (FStar_Options.Other "Rel") in + ((let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = let uu___12 = - FStar_Compiler_Util.string_of_int + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) problem.FStar_TypeChecker_Common.pid in let uu___13 = let uu___14 = - FStar_Compiler_Util.string_of_bool wl.smt_ok in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + wl.smt_ok in let uu___15 = let uu___16 = FStar_Class_Show.show @@ -11615,11 +11989,17 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___19 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head1 in - FStar_Compiler_Util.string_of_bool uu___19 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___19 in let uu___19 = let uu___20 = let uu___21 = no_free_uvars t1 in - FStar_Compiler_Util.string_of_bool uu___21 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___21 in let uu___21 = let uu___22 = FStar_Class_Show.show @@ -11629,12 +12009,16 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___25 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___25 in let uu___25 = let uu___26 = let uu___27 = no_free_uvars t2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___27 in [uu___26] in uu___24 :: uu___25 in @@ -11649,11 +12033,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -11661,7 +12047,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -11670,8 +12055,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -11732,16 +12119,21 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStar_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = debug wl (FStar_Options.Other "Rel") in + ((let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = let uu___12 = - FStar_Compiler_Util.string_of_int + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) problem.FStar_TypeChecker_Common.pid in let uu___13 = let uu___14 = - FStar_Compiler_Util.string_of_bool wl.smt_ok in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + wl.smt_ok in let uu___15 = let uu___16 = FStar_Class_Show.show @@ -11751,11 +12143,17 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___19 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head1 in - FStar_Compiler_Util.string_of_bool uu___19 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___19 in let uu___19 = let uu___20 = let uu___21 = no_free_uvars t1 in - FStar_Compiler_Util.string_of_bool uu___21 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___21 in let uu___21 = let uu___22 = FStar_Class_Show.show @@ -11765,12 +12163,16 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___25 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___25 in let uu___25 = let uu___26 = let uu___27 = no_free_uvars t2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___27 in [uu___26] in uu___24 :: uu___25 in @@ -11785,11 +12187,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -11797,7 +12201,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -11806,8 +12209,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -11868,16 +12273,21 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStar_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = debug wl (FStar_Options.Other "Rel") in + ((let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = let uu___12 = - FStar_Compiler_Util.string_of_int + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) problem.FStar_TypeChecker_Common.pid in let uu___13 = let uu___14 = - FStar_Compiler_Util.string_of_bool wl.smt_ok in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + wl.smt_ok in let uu___15 = let uu___16 = FStar_Class_Show.show @@ -11887,11 +12297,17 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___19 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head1 in - FStar_Compiler_Util.string_of_bool uu___19 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___19 in let uu___19 = let uu___20 = let uu___21 = no_free_uvars t1 in - FStar_Compiler_Util.string_of_bool uu___21 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___21 in let uu___21 = let uu___22 = FStar_Class_Show.show @@ -11901,12 +12317,16 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___25 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___25 in let uu___25 = let uu___26 = let uu___27 = no_free_uvars t2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___27 in [uu___26] in uu___24 :: uu___25 in @@ -11921,11 +12341,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -11933,7 +12355,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -11942,8 +12363,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -12004,16 +12427,21 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStar_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = debug wl (FStar_Options.Other "Rel") in + ((let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = let uu___12 = - FStar_Compiler_Util.string_of_int + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) problem.FStar_TypeChecker_Common.pid in let uu___13 = let uu___14 = - FStar_Compiler_Util.string_of_bool wl.smt_ok in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + wl.smt_ok in let uu___15 = let uu___16 = FStar_Class_Show.show @@ -12023,11 +12451,17 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___19 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head1 in - FStar_Compiler_Util.string_of_bool uu___19 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___19 in let uu___19 = let uu___20 = let uu___21 = no_free_uvars t1 in - FStar_Compiler_Util.string_of_bool uu___21 in + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) + uu___21 in let uu___21 = let uu___22 = FStar_Class_Show.show @@ -12037,12 +12471,16 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___25 = FStar_TypeChecker_Env.is_interpreted wl.tcenv head2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___25 in let uu___25 = let uu___26 = let uu___27 = no_free_uvars t2 in - FStar_Compiler_Util.string_of_bool + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool) uu___27 in [uu___26] in uu___24 :: uu___25 in @@ -12057,11 +12495,13 @@ and (solve_t' : tprob -> worklist -> solution) = uu___11 else ()); (let equal t11 t21 = - let r = FStar_Syntax_Util.eq_tm t11 t21 in + let env = p_env wl orig in + let r = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t11 t21 in match r with - | FStar_Syntax_Util.Equal -> true - | FStar_Syntax_Util.NotEqual -> false - | FStar_Syntax_Util.Unknown -> + | FStar_TypeChecker_TermEqAndSimplify.Equal -> true + | FStar_TypeChecker_TermEqAndSimplify.NotEqual -> false + | FStar_TypeChecker_TermEqAndSimplify.Unknown -> let steps = [FStar_TypeChecker_Env.UnfoldUntil FStar_Syntax_Syntax.delta_constant; @@ -12069,7 +12509,6 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Env.Beta; FStar_TypeChecker_Env.Eager_unfolding; FStar_TypeChecker_Env.Iota] in - let env = p_env wl orig in let t12 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps @@ -12078,8 +12517,10 @@ and (solve_t' : tprob -> worklist -> solution) = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t21 in - let uu___10 = FStar_Syntax_Util.eq_tm t12 t22 in - uu___10 = FStar_Syntax_Util.Equal in + let uu___10 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env t12 + t22 in + uu___10 = FStar_TypeChecker_TermEqAndSimplify.Equal in let uu___10 = ((FStar_TypeChecker_Env.is_interpreted wl.tcenv head1) || (FStar_TypeChecker_Env.is_interpreted wl.tcenv head2)) @@ -12207,7 +12648,9 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } in solve_t' uu___7 wl | uu___7 -> @@ -12236,7 +12679,7 @@ and (solve_c : mk_t_problem wl1 [] orig t1 rel t2 FStar_Pervasives_Native.None reason in let solve_eq c1_comp c2_comp g_lift = - (let uu___1 = debug wl (FStar_Options.Other "EQ") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_EQ in if uu___1 then let uu___2 = @@ -12404,7 +12847,7 @@ and (solve_c : Prims.op_Negation uu___1)) && (FStar_TypeChecker_Env.is_reifiable_effect wl.tcenv c22) in let solve_layered_sub c11 c21 = - (let uu___1 = debug wl (FStar_Options.Other "LayeredEffectsApp") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in if uu___1 then let uu___2 = @@ -12616,9 +13059,8 @@ and (solve_c : if uu___14 then ((let uu___16 = - debug wl2 - (FStar_Options.Other - "LayeredEffectsEqns") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsEqns in if uu___16 then let uu___17 = @@ -12698,9 +13140,8 @@ and (solve_c : (FStar_Pervasives_Native.Some guard) [] wl4 in ((let uu___12 = - debug wl5 - (FStar_Options.Other - "LayeredEffectsApp") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsApp in if uu___12 then FStar_Compiler_Util.print_string @@ -12907,7 +13348,7 @@ and (solve_c : if is_null_wp_2 then ((let uu___10 = - debug wl (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then FStar_Compiler_Util.print_string @@ -12970,7 +13411,7 @@ and (solve_c : } in FStar_Syntax_Syntax.Tm_app uu___11 in FStar_Syntax_Syntax.mk uu___10 r)) in - (let uu___9 = debug wl (FStar_Options.Other "Rel") in + (let uu___9 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___9 then let uu___10 = @@ -13007,7 +13448,7 @@ and (solve_c : let uu___1 = solve_prob orig FStar_Pervasives_Native.None [] wl in solve uu___1 else - ((let uu___3 = debug wl (FStar_Options.Other "Rel") in + ((let uu___3 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___3 then let uu___4 = @@ -13105,7 +13546,9 @@ and (solve_c : FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } in solve_c uu___6 wl | (FStar_Syntax_Syntax.Total uu___4, FStar_Syntax_Syntax.Comp @@ -13134,7 +13577,9 @@ and (solve_c : FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } in solve_c uu___6 wl | (FStar_Syntax_Syntax.Comp uu___4, FStar_Syntax_Syntax.GTotal @@ -13163,7 +13608,9 @@ and (solve_c : FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } in solve_c uu___6 wl | (FStar_Syntax_Syntax.Comp uu___4, FStar_Syntax_Syntax.Total @@ -13192,7 +13639,9 @@ and (solve_c : FStar_TypeChecker_Common.loc = (problem.FStar_TypeChecker_Common.loc); FStar_TypeChecker_Common.rank = - (problem.FStar_TypeChecker_Common.rank) + (problem.FStar_TypeChecker_Common.rank); + FStar_TypeChecker_Common.logical = + (problem.FStar_TypeChecker_Common.logical) } in solve_c uu___6 wl | (FStar_Syntax_Syntax.Comp uu___4, FStar_Syntax_Syntax.Comp @@ -13251,7 +13700,7 @@ and (solve_c : FStar_TypeChecker_Env.unfold_effect_abbrev env c11 in let c22 = FStar_TypeChecker_Env.unfold_effect_abbrev env c21 in - (let uu___10 = debug wl (FStar_Options.Other "Rel") in + (let uu___10 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -13345,10 +13794,8 @@ let (guard_to_string : | FStar_TypeChecker_Common.Trivial -> "trivial" | FStar_TypeChecker_Common.NonTrivial f -> let uu___1 = - ((FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Rel")) - || - (FStar_TypeChecker_Env.debug env FStar_Options.Extreme)) + ((FStar_Compiler_Effect.op_Bang dbg_Rel) || + (FStar_Compiler_Debug.extreme ())) || (FStar_Options.print_implicits ()) in if uu___1 then FStar_TypeChecker_Normalize.term_to_string env f @@ -13390,8 +13837,8 @@ let (new_t_problem : fun loc -> let reason = let uu___ = - (debug wl (FStar_Options.Other "ExplainRel")) || - (debug wl (FStar_Options.Other "Rel")) in + (FStar_Compiler_Effect.op_Bang dbg_ExplainRel) || + (FStar_Compiler_Effect.op_Bang dbg_Rel) in if uu___ then let uu___1 = @@ -13443,7 +13890,7 @@ let (solve_and_commit : fun wl -> fun err -> let tx = FStar_Syntax_Unionfind.new_transaction () in - (let uu___1 = debug wl (FStar_Options.Other "RelBench") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_RelBench in if uu___1 then let uu___2 = @@ -13455,7 +13902,7 @@ let (solve_and_commit : (let uu___1 = FStar_Compiler_Util.record_time (fun uu___2 -> solve wl) in match uu___1 with | (sol, ms) -> - ((let uu___3 = debug wl (FStar_Options.Other "RelBench") in + ((let uu___3 = FStar_Compiler_Effect.op_Bang dbg_RelBench in if uu___3 then let uu___4 = FStar_Compiler_Util.string_of_int ms in @@ -13469,7 +13916,7 @@ let (solve_and_commit : (match uu___3 with | ((), ms1) -> ((let uu___5 = - debug wl (FStar_Options.Other "RelBench") in + FStar_Compiler_Effect.op_Bang dbg_RelBench in if uu___5 then let uu___6 = FStar_Compiler_Util.string_of_int ms1 in @@ -13480,8 +13927,8 @@ let (solve_and_commit : (deferred, defer_to_tac, implicits))) | Failed (d, s) -> ((let uu___4 = - (debug wl (FStar_Options.Other "ExplainRel")) || - (debug wl (FStar_Options.Other "Rel")) in + (FStar_Compiler_Effect.op_Bang dbg_ExplainRel) || + (FStar_Compiler_Effect.op_Bang dbg_Rel) in if uu___4 then let uu___5 = explain wl d s in @@ -13548,12 +13995,7 @@ let (try_teq : FStar_Pervasives_Native.Some uu___3 in FStar_Profiling.profile (fun uu___3 -> - (let uu___5 = - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Rel")) - || - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelTop")) in + (let uu___5 = FStar_Compiler_Effect.op_Bang dbg_RelTop in if uu___5 then let uu___6 = @@ -13582,12 +14024,7 @@ let (try_teq : solve_and_commit (singleton wl prob smt_ok1) (fun uu___7 -> FStar_Pervasives_Native.None) in with_guard env prob uu___6 in - ((let uu___7 = - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Rel")) - || - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelTop")) in + ((let uu___7 = FStar_Compiler_Effect.op_Bang dbg_RelTop in if uu___7 then let uu___8 = @@ -13611,14 +14048,12 @@ let (teq : let uu___3 = FStar_TypeChecker_Err.basic_type_error env FStar_Pervasives_Native.None t2 t1 in - FStar_Errors.log_issue uu___2 uu___3); + FStar_Errors.log_issue_doc uu___2 uu___3); FStar_TypeChecker_Common.trivial_guard) | FStar_Pervasives_Native.Some g -> ((let uu___2 = - (FStar_TypeChecker_Env.debug env (FStar_Options.Other "Rel")) - || - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelTop")) in + (FStar_Compiler_Effect.op_Bang dbg_Rel) || + (FStar_Compiler_Effect.op_Bang dbg_RelTop) in if uu___2 then let uu___3 = @@ -13641,8 +14076,8 @@ let (get_teq_predicate : fun t1 -> fun t2 -> (let uu___1 = - (FStar_TypeChecker_Env.debug env (FStar_Options.Other "Rel")) || - (FStar_TypeChecker_Env.debug env (FStar_Options.Other "RelTop")) in + (FStar_Compiler_Effect.op_Bang dbg_Rel) || + (FStar_Compiler_Effect.op_Bang dbg_RelTop) in if uu___1 then let uu___2 = @@ -13663,10 +14098,8 @@ let (get_teq_predicate : (fun uu___3 -> FStar_Pervasives_Native.None) in with_guard env prob uu___2 in ((let uu___3 = - (FStar_TypeChecker_Env.debug env (FStar_Options.Other "Rel")) - || - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelTop")) in + (FStar_Compiler_Effect.op_Bang dbg_Rel) || + (FStar_Compiler_Effect.op_Bang dbg_RelTop) in if uu___3 then let uu___4 = @@ -13694,7 +14127,7 @@ let (subtype_fail : let uu___1 = FStar_TypeChecker_Err.basic_type_error env (FStar_Pervasives_Native.Some e) t2 t1 in - FStar_Errors.log_issue uu___ uu___1 + FStar_Errors.log_issue_doc uu___ uu___1 let (sub_or_eq_comp : FStar_TypeChecker_Env.env -> Prims.bool -> @@ -13718,11 +14151,8 @@ let (sub_or_eq_comp : then FStar_TypeChecker_Common.EQ else FStar_TypeChecker_Common.SUB in (let uu___3 = - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Rel")) - || - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelTop")) in + (FStar_Compiler_Effect.op_Bang dbg_Rel) || + (FStar_Compiler_Effect.op_Bang dbg_RelTop) in if uu___3 then let uu___4 = @@ -13768,8 +14198,7 @@ let (sub_or_eq_comp : match uu___5 with | (r, ms) -> ((let uu___7 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelBench") in + FStar_Compiler_Effect.op_Bang dbg_RelBench in if uu___7 then let uu___8 = @@ -13955,8 +14384,7 @@ let (solve_universe_inequalities' : then true else ((let uu___7 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "GenUniverses") in + FStar_Compiler_Effect.op_Bang dbg_GenUniverses in if uu___7 then let uu___8 = @@ -13972,9 +14400,7 @@ let (solve_universe_inequalities' : if uu___2 then () else - ((let uu___5 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "GenUniverses") in + ((let uu___5 = FStar_Compiler_Effect.op_Bang dbg_GenUniverses in if uu___5 then ((let uu___7 = ineqs_to_string (variables, ineqs) in @@ -14052,14 +14478,19 @@ let (try_solve_deferred_constraints : i.FStar_TypeChecker_Common.imp_uvar in let uvs = FStar_Syntax_Free.uvars goal_type in - FStar_Compiler_Set.elems - FStar_Syntax_Free.ord_ctx_uvar - uvs + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uvs) else []) | uu___4 -> []) g.FStar_TypeChecker_Common.implicits in - FStar_Compiler_Set.from_list - FStar_Syntax_Free.ord_ctx_uvar uu___3 in + Obj.magic + (FStar_Class_Setlike.from_list () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Free.ord_ctx_uvar)) uu___3) in let wl = let uu___3 = wl_of_guard env g.FStar_TypeChecker_Common.deferred in @@ -14084,12 +14515,10 @@ let (try_solve_deferred_constraints : FStar_Errors.raise_error (FStar_Errors_Codes.Fatal_ErrorInSolveDeferredConstraints, msg) (p_loc d) in - (let uu___4 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Rel") in + (let uu___4 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___4 then - let uu___5 = FStar_Class_Show.show uu___76 defer_ok in + let uu___5 = FStar_Class_Show.show uu___85 defer_ok in let uu___6 = FStar_Class_Show.show (FStar_Class_Show.printableshow @@ -14149,8 +14578,8 @@ let (try_solve_deferred_constraints : "FStar.TypeChecker.Rel.solve_deferred_to_tactic_goals" else g1 in (let uu___6 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "ResolveImplicitsHook") in + FStar_Compiler_Effect.op_Bang + dbg_ResolveImplicitsHook in if uu___6 then let uu___7 = guard_to_string env g2 in @@ -14216,17 +14645,14 @@ let (do_discharge_vc : fun use_env_range_msg -> fun env -> fun vc -> - let debug1 = - ((FStar_TypeChecker_Env.debug env (FStar_Options.Other "Rel")) || - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "SMTQuery"))) - || - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Discharge")) in + let debug = + ((FStar_Compiler_Effect.op_Bang dbg_Rel) || + (FStar_Compiler_Effect.op_Bang dbg_SMTQuery)) + || (FStar_Compiler_Effect.op_Bang dbg_Discharge) in let diag_doc = let uu___ = FStar_TypeChecker_Env.get_range env in FStar_Errors.diag_doc uu___ in - if debug1 + if debug then (let uu___1 = let uu___2 = @@ -14250,7 +14676,7 @@ let (do_discharge_vc : env vc in match uu___4 with | (did_anything, vcs1) -> - (if debug1 && did_anything + (if debug && did_anything then (let uu___6 = let uu___7 = @@ -14306,7 +14732,7 @@ let (do_discharge_vc : goal in (match uu___7 with | FStar_TypeChecker_Common.Trivial -> - (if debug1 + (if debug then (let uu___9 = let uu___10 = @@ -14352,7 +14778,7 @@ let (do_discharge_vc : FStar_Options.with_saved_options (fun uu___2 -> FStar_Options.set opts; - if debug1 + if debug then (let uu___5 = let uu___6 = @@ -14380,8 +14806,7 @@ let (discharge_guard' : fun g -> fun use_smt -> (let uu___1 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "ResolveImplicitsHook") in + FStar_Compiler_Effect.op_Bang dbg_ResolveImplicitsHook in if uu___1 then let uu___2 = guard_to_string env g in @@ -14397,13 +14822,10 @@ let (discharge_guard' : let deferred_to_tac_ok = true in try_solve_deferred_constraints defer_ok smt_ok deferred_to_tac_ok env g in - let debug1 = - ((FStar_TypeChecker_Env.debug env (FStar_Options.Other "Rel")) - || - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "SMTQuery"))) - || - (FStar_TypeChecker_Env.debug env (FStar_Options.Other "Disch")) in + let debug = + ((FStar_Compiler_Effect.op_Bang dbg_Rel) || + (FStar_Compiler_Effect.op_Bang dbg_SMTQuery)) + || (FStar_Compiler_Effect.op_Bang dbg_Discharge) in let diag_doc = let uu___1 = FStar_TypeChecker_Env.get_range env in FStar_Errors.diag_doc uu___1 in @@ -14426,8 +14848,7 @@ let (discharge_guard' : if uu___1 then (if - debug1 && - (Prims.op_Negation env.FStar_TypeChecker_Env.phase1) + debug && (Prims.op_Negation env.FStar_TypeChecker_Env.phase1) then (let uu___3 = let uu___4 = @@ -14444,7 +14865,7 @@ let (discharge_guard' : FStar_Pervasives_Native.Some ret_g | FStar_TypeChecker_Common.NonTrivial vc when Prims.op_Negation use_smt -> - (if debug1 + (if debug then (let uu___4 = let uu___5 = @@ -14515,8 +14936,8 @@ let (subtype_nosmt : fun t1 -> fun t2 -> (let uu___1 = - (FStar_TypeChecker_Env.debug env (FStar_Options.Other "Rel")) || - (FStar_TypeChecker_Env.debug env (FStar_Options.Other "RelTop")) in + (FStar_Compiler_Effect.op_Bang dbg_Rel) || + (FStar_Compiler_Effect.op_Bang dbg_RelTop) in if uu___1 then let uu___2 = FStar_TypeChecker_Normalize.term_to_string env t1 in @@ -14561,10 +14982,8 @@ let (check_subtyping : FStar_Profiling.profile (fun uu___1 -> (let uu___3 = - (FStar_TypeChecker_Env.debug env (FStar_Options.Other "Rel")) - || - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelTop")) in + (FStar_Compiler_Effect.op_Bang dbg_Rel) || + (FStar_Compiler_Effect.op_Bang dbg_RelTop) in if uu___3 then let uu___4 = @@ -14589,11 +15008,8 @@ let (check_subtyping : (fun uu___5 -> FStar_Pervasives_Native.None) in with_guard env_x prob uu___4 in ((let uu___5 = - ((FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Rel")) - || - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "RelTop"))) + ((FStar_Compiler_Effect.op_Bang dbg_Rel) || + (FStar_Compiler_Effect.op_Bang dbg_RelTop)) && (FStar_Compiler_Util.is_some g) in if uu___5 then @@ -14761,8 +15177,7 @@ let (check_implicit_solution_and_discharge_guard : let uvar_ty = FStar_Syntax_Util.ctx_uvar_typ imp_uvar in let uvar_should_check = FStar_Syntax_Util.ctx_uvar_should_check imp_uvar in - ((let uu___2 = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "Rel") in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___2 then let uu___3 = @@ -15113,10 +15528,14 @@ let (is_tac_implicit_resolved : fun env -> fun i -> let uu___ = FStar_Syntax_Free.uvars i.FStar_TypeChecker_Common.imp_tm in - FStar_Compiler_Set.for_all FStar_Syntax_Free.ord_ctx_uvar + FStar_Class_Setlike.for_all () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (fun uv -> let uu___1 = FStar_Syntax_Util.ctx_uvar_should_check uv in - FStar_Syntax_Syntax.uu___is_Allow_unresolved uu___1) uu___ + FStar_Syntax_Syntax.uu___is_Allow_unresolved uu___1) + (Obj.magic uu___) let (resolve_implicits' : FStar_TypeChecker_Env.env -> Prims.bool -> @@ -15130,7 +15549,26 @@ let (resolve_implicits' : fun is_gen -> fun implicits -> let cacheable tac = - FStar_Syntax_Util.is_fvar FStar_Parser_Const.tcresolve_lid tac in + (FStar_Syntax_Util.is_fvar FStar_Parser_Const.tcresolve_lid tac) + || + (let uu___ = + let uu___1 = FStar_Syntax_Subst.compress tac in + uu___1.FStar_Syntax_Syntax.n in + match uu___ with + | FStar_Syntax_Syntax.Tm_abs + { FStar_Syntax_Syntax.bs = uu___1::[]; + FStar_Syntax_Syntax.body = body; + FStar_Syntax_Syntax.rc_opt = uu___2;_} + -> + let uu___3 = FStar_Syntax_Util.head_and_args body in + (match uu___3 with + | (hd, args) -> + (FStar_Syntax_Util.is_fvar + FStar_Parser_Const.tcresolve_lid hd) + && + ((FStar_Compiler_List.length args) = Prims.int_one)) + | uu___1 -> false) in + let meta_tac_allowed_for_open_problem tac = cacheable tac in let __meta_arg_cache = FStar_Compiler_Util.mk_ref [] in let meta_arg_cache_result tac e ty res = let uu___ = @@ -15154,7 +15592,7 @@ let (resolve_implicits' : let rec until_fixpoint acc implicits1 = let uu___ = acc in match uu___ with - | (out, changed) -> + | (out, changed, defer_open_metas) -> (match implicits1 with | [] -> if changed @@ -15162,39 +15600,49 @@ let (resolve_implicits' : let uu___1 = FStar_Compiler_List.map FStar_Pervasives_Native.fst out in - until_fixpoint ([], false) uu___1 + until_fixpoint ([], false, true) uu___1 else - (let uu___2 = - let uu___3 = + if defer_open_metas + then + (let uu___2 = FStar_Compiler_List.map FStar_Pervasives_Native.fst out in - try_solve_single_valued_implicits env is_tac uu___3 in - match uu___2 with - | (imps, changed1) -> - if changed1 - then until_fixpoint ([], false) imps - else - (let uu___4 = pick_a_univ_deffered_implicit out in - match uu___4 with - | (imp_opt, rest) -> - (match imp_opt with - | FStar_Pervasives_Native.None -> rest - | FStar_Pervasives_Native.Some imp -> - let force_univ_constraints = true in - let imps1 = - let uu___5 = - check_implicit_solution_and_discharge_guard - env imp is_tac - force_univ_constraints in - FStar_Compiler_Util.must uu___5 in - let uu___5 = + until_fixpoint ([], false, false) uu___2) + else + (let uu___3 = + let uu___4 = + FStar_Compiler_List.map + FStar_Pervasives_Native.fst out in + try_solve_single_valued_implicits env is_tac + uu___4 in + match uu___3 with + | (imps, changed1) -> + if changed1 + then until_fixpoint ([], false, true) imps + else + (let uu___5 = + pick_a_univ_deffered_implicit out in + match uu___5 with + | (imp_opt, rest) -> + (match imp_opt with + | FStar_Pervasives_Native.None -> rest + | FStar_Pervasives_Native.Some imp -> + let force_univ_constraints = true in + let imps1 = + let uu___6 = + check_implicit_solution_and_discharge_guard + env imp is_tac + force_univ_constraints in + FStar_Compiler_Util.must uu___6 in let uu___6 = - FStar_Compiler_List.map - FStar_Pervasives_Native.fst - rest in - FStar_Compiler_List.op_At imps1 - uu___6 in - until_fixpoint ([], false) uu___5))) + let uu___7 = + FStar_Compiler_List.map + FStar_Pervasives_Native.fst + rest in + FStar_Compiler_List.op_At imps1 + uu___7 in + until_fixpoint ([], false, true) + uu___6))) | hd::tl -> let uu___1 = hd in (match uu___1 with @@ -15215,8 +15663,7 @@ let (resolve_implicits' : = uvar_decoration_should_check;_} -> ((let uu___5 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Rel") in + FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___5 then let uu___6 = @@ -15241,7 +15688,9 @@ let (resolve_implicits' : if FStar_Syntax_Syntax.uu___is_Allow_unresolved uvar_decoration_should_check - then until_fixpoint (out, true) tl + then + until_fixpoint + (out, true, defer_open_metas) tl else if (unresolved ctx_u) && @@ -15394,82 +15843,96 @@ let (resolve_implicits' : let typ = FStar_Syntax_Util.ctx_uvar_typ ctx_u in - let uu___6 = - ((has_free_uvars typ) || - (gamma_has_free_uvars - ctx_u.FStar_Syntax_Syntax.ctx_uvar_gamma)) - && - (let uu___7 = - FStar_Options.ext_getv - "compat:open_metas" in - uu___7 = "") in - if uu___6 + let is_open = + (has_free_uvars typ) || + (gamma_has_free_uvars + ctx_u.FStar_Syntax_Syntax.ctx_uvar_gamma) in + if defer_open_metas && is_open then - ((let uu___8 = - (FStar_TypeChecker_Env.debug - env1 - (FStar_Options.Other "Rel")) + ((let uu___7 = + (FStar_Compiler_Effect.op_Bang + dbg_Rel) || - (FStar_TypeChecker_Env.debug - env1 - (FStar_Options.Other - "Imps")) in - if uu___8 + (FStar_Compiler_Effect.op_Bang + dbg_Imps) in + if uu___7 then - let uu___9 = + let uu___8 = FStar_Class_Show.show FStar_Syntax_Print.showable_ctxu ctx_u in FStar_Compiler_Util.print1 "Deferring implicit due to open ctx/typ %s\n" - uu___9 + uu___8 else ()); until_fixpoint (((hd, Implicit_unresolved) :: - out), changed) tl) + out), changed, + defer_open_metas) tl) else - (let solve_with t = - let extra = - let uu___8 = - teq_nosmt env1 t tm in - match uu___8 with - | FStar_Pervasives_Native.None - -> - FStar_Compiler_Effect.failwith - "resolve_implicits: unifying with an unresolved uvar failed?" - | FStar_Pervasives_Native.Some - g -> - g.FStar_TypeChecker_Common.implicits in - until_fixpoint (out, true) - (FStar_Compiler_List.op_At - extra tl) in - let uu___8 = cacheable tac in - if uu___8 + (let uu___7 = + (is_open && + (let uu___8 = + meta_tac_allowed_for_open_problem + tac in + Prims.op_Negation uu___8)) + && + (let uu___8 = + FStar_Options.ext_getv + "compat:open_metas" in + uu___8 = "") in + if uu___7 then - let uu___9 = - meta_arg_cache_lookup tac - env1 typ in - match uu___9 with - | FStar_Pervasives_Native.Some - res -> solve_with res - | FStar_Pervasives_Native.None - -> - let t = + until_fixpoint + (((hd, Implicit_unresolved) + :: out), changed, + defer_open_metas) tl + else + (let solve_with t = + let extra = + let uu___9 = + teq_nosmt env1 t tm in + match uu___9 with + | FStar_Pervasives_Native.None + -> + FStar_Compiler_Effect.failwith + "resolve_implicits: unifying with an unresolved uvar failed?" + | FStar_Pervasives_Native.Some + g -> + g.FStar_TypeChecker_Common.implicits in + until_fixpoint + (out, true, + defer_open_metas) + (FStar_Compiler_List.op_At + extra tl) in + let uu___9 = cacheable tac in + if uu___9 + then + let uu___10 = + meta_arg_cache_lookup tac + env1 typ in + match uu___10 with + | FStar_Pervasives_Native.Some + res -> solve_with res + | FStar_Pervasives_Native.None + -> + let t = + run_meta_arg_tac env1 + ctx_u in + (meta_arg_cache_result + tac env1 typ t; + solve_with t) + else + (let t = run_meta_arg_tac env1 ctx_u in - (meta_arg_cache_result tac - env1 typ t; - solve_with t) - else - (let t = - run_meta_arg_tac env1 ctx_u in - solve_with t))) + solve_with t)))) else if unresolved ctx_u then until_fixpoint (((hd, Implicit_unresolved) :: out), - changed) tl + changed, defer_open_metas) tl else if ((FStar_Syntax_Syntax.uu___is_Allow_untyped @@ -15478,7 +15941,9 @@ let (resolve_implicits' : (FStar_Syntax_Syntax.uu___is_Already_checked uvar_decoration_should_check)) || is_gen - then until_fixpoint (out, true) tl + then + until_fixpoint + (out, true, defer_open_metas) tl else (let env1 = { @@ -15659,7 +16124,9 @@ let (resolve_implicits' : "Impossible: check_implicit_solution_and_discharge_guard for tac must return Some []" else ()) else ()); - until_fixpoint (out, true) tl) + until_fixpoint + (out, true, defer_open_metas) + tl) else (let force_univ_constraints = false in @@ -15672,7 +16139,8 @@ let (resolve_implicits' : until_fixpoint (((hd1, Implicit_checking_defers_univ_constraint) - :: out), changed) tl + :: out), changed, + defer_open_metas) tl | FStar_Pervasives_Native.Some imps -> let uu___6 = @@ -15685,18 +16153,17 @@ let (resolve_implicits' : imps in FStar_Compiler_List.op_At uu___8 out in - (uu___7, true) in + (uu___7, true, + defer_open_metas) in until_fixpoint uu___6 tl)))))) in - until_fixpoint ([], false) implicits + until_fixpoint ([], false, true) implicits let (resolve_implicits : FStar_TypeChecker_Env.env -> FStar_TypeChecker_Common.guard_t -> FStar_TypeChecker_Common.guard_t) = fun env -> fun g -> - (let uu___1 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "ResolveImplicitsHook") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_ResolveImplicitsHook in if uu___1 then let uu___2 = guard_to_string env g in @@ -15707,9 +16174,7 @@ let (resolve_implicits : (let tagged_implicits1 = resolve_implicits' env false false g.FStar_TypeChecker_Common.implicits in - (let uu___2 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "ResolveImplicitsHook") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_ResolveImplicitsHook in if uu___2 then FStar_Compiler_Util.print_string @@ -15762,9 +16227,7 @@ let (force_trivial_guard : FStar_TypeChecker_Env.env -> FStar_TypeChecker_Common.guard_t -> unit) = fun env -> fun g -> - (let uu___1 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "ResolveImplicitsHook") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_ResolveImplicitsHook in if uu___1 then let uu___2 = guard_to_string env g in @@ -15854,9 +16317,7 @@ let (layered_effect_teq : fun t1 -> fun t2 -> fun reason -> - (let uu___1 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsEqns") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsEqns in if uu___1 then let uu___2 = diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Tc.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Tc.ml index 6ad32cd8636..139cc8ff795 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Tc.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Tc.ml @@ -1,4 +1,14 @@ open Prims +let (dbg_TwoPhases : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "TwoPhases" +let (dbg_IdInfoOn : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "IdInfoOn" +let (dbg_Normalize : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Normalize" +let (dbg_UF : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "UF" +let (dbg_LogTypes : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "LogTypes" let (sigelt_typ : FStar_Syntax_Syntax.sigelt -> FStar_Syntax_Syntax.typ FStar_Pervasives_Native.option) @@ -10,13 +20,15 @@ let (sigelt_typ : FStar_Syntax_Syntax.params = uu___2; FStar_Syntax_Syntax.num_uniform_params = uu___3; FStar_Syntax_Syntax.t = t; FStar_Syntax_Syntax.mutuals = uu___4; - FStar_Syntax_Syntax.ds = uu___5;_} + FStar_Syntax_Syntax.ds = uu___5; + FStar_Syntax_Syntax.injective_type_params = uu___6;_} -> FStar_Pervasives_Native.Some t | FStar_Syntax_Syntax.Sig_datacon { FStar_Syntax_Syntax.lid1 = uu___; FStar_Syntax_Syntax.us1 = uu___1; FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___2; FStar_Syntax_Syntax.num_ty_params = uu___3; - FStar_Syntax_Syntax.mutuals1 = uu___4;_} + FStar_Syntax_Syntax.mutuals1 = uu___4; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_} -> FStar_Pervasives_Native.Some t | FStar_Syntax_Syntax.Sig_declare_typ { FStar_Syntax_Syntax.lid2 = uu___; FStar_Syntax_Syntax.us2 = uu___1; @@ -382,7 +394,7 @@ let (tc_inductive' : fun quals -> fun attrs -> fun lids -> - (let uu___1 = FStar_TypeChecker_Env.debug env FStar_Options.Low in + (let uu___1 = FStar_Compiler_Debug.low () in if uu___1 then let uu___2 = @@ -435,7 +447,9 @@ let (tc_inductive' : uu___9; FStar_Syntax_Syntax.t = uu___10; FStar_Syntax_Syntax.mutuals = uu___11; - FStar_Syntax_Syntax.ds = uu___12;_} + FStar_Syntax_Syntax.ds = uu___12; + FStar_Syntax_Syntax.injective_type_params + = uu___13;_} -> (lid, (ty.FStar_Syntax_Syntax.sigrng)) | uu___7 -> FStar_Compiler_Effect.failwith @@ -464,7 +478,9 @@ let (tc_inductive' : FStar_Syntax_Syntax.t1 = uu___8; FStar_Syntax_Syntax.ty_lid = ty_lid; FStar_Syntax_Syntax.num_ty_params = uu___9; - FStar_Syntax_Syntax.mutuals1 = uu___10;_} + FStar_Syntax_Syntax.mutuals1 = uu___10; + FStar_Syntax_Syntax.injective_type_params1 + = uu___11;_} -> (data_lid, ty_lid) | uu___7 -> FStar_Compiler_Effect.failwith "Impossible" in @@ -506,7 +522,9 @@ let (tc_inductive' : uu___6; FStar_Syntax_Syntax.t = uu___7; FStar_Syntax_Syntax.mutuals = uu___8; - FStar_Syntax_Syntax.ds = uu___9;_} + FStar_Syntax_Syntax.ds = uu___9; + FStar_Syntax_Syntax.injective_type_params = + uu___10;_} -> lid1 | uu___4 -> FStar_Compiler_Effect.failwith "Impossible" in @@ -977,8 +995,8 @@ let (tc_sig_let : FStar_TypeChecker_Env.preprocess env1 tau lb.FStar_Syntax_Syntax.lbdef in (let uu___4 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "TwoPhases") in + (FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang dbg_TwoPhases) in if uu___4 then let uu___5 = @@ -1368,8 +1386,9 @@ let (tc_sig_let : | (e3, uu___8, uu___9) -> e3) uu___5 "FStar.TypeChecker.Tc.tc_sig_let-tc-phase1" in (let uu___6 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "TwoPhases") in + (FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang + dbg_TwoPhases) in if uu___6 then let uu___7 = @@ -1384,8 +1403,9 @@ let (tc_sig_let : env' e2 in drop_lbtyp uu___6 in (let uu___7 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "TwoPhases") in + (FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang + dbg_TwoPhases) in if uu___7 then let uu___8 = @@ -1852,9 +1872,11 @@ let (tc_sig_let : let uu___11 = FStar_Syntax_Free.fvars lb.FStar_Syntax_Syntax.lbtyp in - FStar_Compiler_Set.elems - FStar_Syntax_Syntax.ord_fv - uu___11 in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Syntax_Syntax.ord_fv)) + (Obj.magic uu___11) in FStar_Compiler_List.tryFind (fun lid -> let uu___11 = @@ -2112,8 +2134,7 @@ let (tc_decl' : } else env in let env'1 = FStar_TypeChecker_Env.push env' "expect_failure" in - ((let uu___3 = - FStar_TypeChecker_Env.debug env FStar_Options.Low in + ((let uu___3 = FStar_Compiler_Debug.low () in if uu___3 then let uu___4 = @@ -2138,7 +2159,7 @@ let (tc_decl' : | (errs, uu___4) -> ((let uu___6 = (FStar_Options.print_expected_failures ()) || - (FStar_TypeChecker_Env.debug env FStar_Options.Low) in + (FStar_Compiler_Debug.low ()) in if uu___6 then (FStar_Compiler_Util.print_string @@ -2338,8 +2359,8 @@ let (tc_decl' : uu___5 in FStar_Syntax_Util.ses_of_sigbundle uu___4 in (let uu___5 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "TwoPhases") in + (FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang dbg_TwoPhases) in if uu___5 then let uu___6 = @@ -2646,8 +2667,8 @@ let (tc_decl' : uu___6 in FStar_Syntax_Util.eff_decl_of_new_effect uu___5 in (let uu___6 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "TwoPhases") in + (FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang dbg_TwoPhases) in if uu___6 then let uu___7 = @@ -3062,15 +3083,18 @@ let (tc_decl' : match uu___6 with | (uvs1, t1) -> ((let uu___8 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "TwoPhases") in + (FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang + dbg_TwoPhases) in if uu___8 then let uu___9 = - FStar_Syntax_Print.term_to_string t1 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t1 in let uu___10 = - FStar_Syntax_Print.univ_names_to_string - uvs1 in + FStar_Class_Show.show + (FStar_Class_Show.show_list + FStar_Ident.showable_ident) uvs1 in FStar_Compiler_Util.print2 "Val declaration after phase 1: %s and uvs: %s\n" uu___9 uu___10 @@ -3243,15 +3267,18 @@ let (tc_decl' : match uu___6 with | (uvs1, t1) -> ((let uu___8 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "TwoPhases") in + (FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang + dbg_TwoPhases) in if uu___8 then let uu___9 = - FStar_Syntax_Print.term_to_string t1 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t1 in let uu___10 = - FStar_Syntax_Print.univ_names_to_string - uvs1 in + FStar_Class_Show.show + (FStar_Class_Show.show_list + FStar_Ident.showable_ident) uvs1 in FStar_Compiler_Util.print2 "Assume after phase 1: %s and uvs: %s\n" uu___9 uu___10 @@ -3291,7 +3318,7 @@ let (tc_decl' : FStar_Syntax_Syntax.lids2 = lids; FStar_Syntax_Syntax.tac = t;_} -> - ((let uu___3 = FStar_Options.debug_any () in + ((let uu___3 = FStar_Compiler_Debug.any () in if uu___3 then let uu___4 = @@ -3509,8 +3536,7 @@ let (tc_decl' : FStar_TypeChecker_Env.core_check = (env.FStar_TypeChecker_Env.core_check) } in - (let uu___4 = - FStar_TypeChecker_Env.debug env1 FStar_Options.Low in + (let uu___4 = FStar_Compiler_Debug.low () in if uu___4 then let uu___5 = @@ -3710,8 +3736,9 @@ let (tc_decl' : match uu___6 with | (t2, ty) -> ((let uu___8 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "TwoPhases") in + (FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang + dbg_TwoPhases) in if uu___8 then let uu___9 = @@ -3952,8 +3979,9 @@ let (tc_decl' : match uu___6 with | (t2, ty) -> ((let uu___8 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "TwoPhases") in + (FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang + dbg_TwoPhases) in if uu___8 then let uu___9 = @@ -4028,23 +4056,13 @@ let (tc_decl : fun env -> fun se -> let env1 = set_hint_correlator env se in - (let uu___1 = - let uu___2 = - FStar_Ident.string_of_lid env1.FStar_TypeChecker_Env.curmodule in - FStar_Options.debug_module uu___2 in + (let uu___1 = FStar_Compiler_Debug.any () in if uu___1 then - let uu___2 = - let uu___3 = - let uu___4 = - FStar_Ident.string_of_lid env1.FStar_TypeChecker_Env.curmodule in - FStar_Options.debug_at_level uu___4 FStar_Options.High in - if uu___3 - then FStar_Syntax_Print.sigelt_to_string se - else FStar_Syntax_Print.sigelt_to_string_short se in + let uu___2 = FStar_Syntax_Print.sigelt_to_string_short se in FStar_Compiler_Util.print1 "Processing %s\n" uu___2 else ()); - (let uu___2 = FStar_TypeChecker_Env.debug env1 FStar_Options.Low in + (let uu___2 = FStar_Compiler_Debug.low () in if uu___2 then let uu___3 = @@ -4077,7 +4095,7 @@ let (add_sigelt_to_env : fun env -> fun se -> fun from_cache -> - (let uu___1 = FStar_TypeChecker_Env.debug env FStar_Options.Low in + (let uu___1 = FStar_Compiler_Debug.low () in if uu___1 then let uu___2 = @@ -4664,12 +4682,11 @@ let (tc_decls : (FStar_Pervasives_Native.Some (se.FStar_Syntax_Syntax.sigrng)); (let uu___2 = env1.FStar_TypeChecker_Env.nosynth && - (FStar_Options.debug_any ()) in + (FStar_Compiler_Debug.any ()) in if uu___2 then ((ses1, env1), []) else - ((let uu___5 = - FStar_TypeChecker_Env.debug env1 FStar_Options.Low in + ((let uu___5 = FStar_Compiler_Debug.low () in if uu___5 then let uu___6 = FStar_Syntax_Print.tag_of_sigelt se in @@ -4682,9 +4699,7 @@ let (tc_decls : if uu___6 then FStar_TypeChecker_Env.toggle_id_info env1 false else ()); - (let uu___7 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "IdInfoOn") in + (let uu___7 = FStar_Compiler_Effect.op_Bang dbg_IdInfoOn in if uu___7 then FStar_TypeChecker_Env.toggle_id_info env1 true else ()); @@ -4706,8 +4721,7 @@ let (tc_decls : FStar_Compiler_List.map (fun se1 -> (let uu___9 = - FStar_TypeChecker_Env.debug env2 - (FStar_Options.Other "UF") in + FStar_Compiler_Effect.op_Bang dbg_UF in if uu___9 then let uu___10 = @@ -4721,8 +4735,7 @@ let (tc_decls : FStar_Compiler_List.map (fun se1 -> (let uu___9 = - FStar_TypeChecker_Env.debug env2 - (FStar_Options.Other "UF") in + FStar_Compiler_Effect.op_Bang dbg_UF in if uu___9 then let uu___10 = @@ -4746,21 +4759,15 @@ let (tc_decls : env2 ses'2 in FStar_Syntax_Unionfind.reset (); (let uu___11 = - (FStar_Options.log_types ()) || - (FStar_TypeChecker_Env.debug env3 - (FStar_Options.Other "LogTypes")) in + ((FStar_Options.log_types ()) || + (FStar_Compiler_Debug.medium ())) + || (FStar_Compiler_Effect.op_Bang dbg_LogTypes) in if uu___11 then let uu___12 = - FStar_Compiler_List.fold_left - (fun s -> - fun se1 -> - let uu___13 = - let uu___14 = - FStar_Syntax_Print.sigelt_to_string - se1 in - Prims.strcat uu___14 "\n" in - Prims.strcat s uu___13) "" ses'2 in + FStar_Class_Show.show + (FStar_Class_Show.show_list + FStar_Syntax_Print.showable_sigelt) ses'2 in FStar_Compiler_Util.print1 "Checked: %s\n" uu___12 else ()); (let uu___12 = @@ -4793,7 +4800,7 @@ let (tc_decls : (fun uu___4 -> process_one_decl acc se) uu___3 "FStar.TypeChecker.Tc.process_one_decl" in ((let uu___4 = - (FStar_Options.profile_group_by_decls ()) || + (FStar_Options.profile_group_by_decl ()) || (FStar_Options.timing ()) in if uu___4 then @@ -4813,7 +4820,7 @@ let (tc_decls : ([], env) ses) in match uu___ with | (ses1, env1) -> ((FStar_Compiler_List.rev_append ses1 []), env1) -let (uu___876 : unit) = +let (uu___873 : unit) = FStar_Compiler_Effect.op_Colon_Equals tc_decls_knot (FStar_Pervasives_Native.Some tc_decls) let (snapshot_context : @@ -4866,20 +4873,30 @@ let (tc_partial_modul : if modul.FStar_Syntax_Syntax.is_interface then "interface" else "implementation" in - (let uu___1 = FStar_Options.debug_any () in + (let uu___1 = FStar_Compiler_Debug.any () in if uu___1 then let uu___2 = FStar_Ident.string_of_lid modul.FStar_Syntax_Syntax.name in FStar_Compiler_Util.print3 "Now %s %s of %s\n" action label uu___2 else ()); + FStar_Compiler_Debug.disable_all (); + (let uu___3 = + let uu___4 = + FStar_Ident.string_of_lid modul.FStar_Syntax_Syntax.name in + FStar_Options.should_check uu___4 in + if uu___3 + then + let uu___4 = FStar_Options.debug_keys () in + FStar_Compiler_Debug.enable_toggles uu___4 + else ()); (let name = - let uu___1 = + let uu___3 = FStar_Ident.string_of_lid modul.FStar_Syntax_Syntax.name in FStar_Compiler_Util.format2 "%s %s" (if modul.FStar_Syntax_Syntax.is_interface then "interface" - else "module") uu___1 in + else "module") uu___3 in let env1 = { FStar_TypeChecker_Env.solver = (env.FStar_TypeChecker_Env.solver); @@ -4980,23 +4997,23 @@ let (tc_partial_modul : let env2 = FStar_TypeChecker_Env.set_current_module env1 modul.FStar_Syntax_Syntax.name in - let uu___1 = - let uu___2 = - let uu___3 = + let uu___3 = + let uu___4 = + let uu___5 = FStar_Ident.string_of_lid modul.FStar_Syntax_Syntax.name in - FStar_Options.should_check uu___3 in - Prims.op_Negation uu___2 in - let uu___2 = - let uu___3 = + FStar_Options.should_check uu___5 in + Prims.op_Negation uu___4 in + let uu___4 = + let uu___5 = FStar_Ident.string_of_lid modul.FStar_Syntax_Syntax.name in - FStar_Compiler_Util.format2 "While loading dependency %s%s" uu___3 + FStar_Compiler_Util.format2 "While loading dependency %s%s" uu___5 (if modul.FStar_Syntax_Syntax.is_interface then " (interface)" else "") in - FStar_Errors.with_ctx_if uu___1 uu___2 - (fun uu___3 -> - let uu___4 = tc_decls env2 modul.FStar_Syntax_Syntax.declarations in - match uu___4 with + FStar_Errors.with_ctx_if uu___3 uu___4 + (fun uu___5 -> + let uu___6 = tc_decls env2 modul.FStar_Syntax_Syntax.declarations in + match uu___6 with | (ses, env3) -> ({ FStar_Syntax_Syntax.name = @@ -5110,10 +5127,19 @@ let (load_checked_module : = fun en -> fun m -> - let m1 = deep_compress_modul m in - let env = load_checked_module_sigelts en m1 in - let uu___ = finish_partial_modul true true env m1 in - match uu___ with | (uu___1, env1) -> env1 + (let uu___1 = + (let uu___2 = FStar_Ident.string_of_lid m.FStar_Syntax_Syntax.name in + FStar_Options.should_check uu___2) || + (FStar_Options.debug_all_modules ()) in + if uu___1 + then + let uu___2 = FStar_Options.debug_keys () in + FStar_Compiler_Debug.enable_toggles uu___2 + else FStar_Compiler_Debug.disable_all ()); + (let m1 = deep_compress_modul m in + let env = load_checked_module_sigelts en m1 in + let uu___1 = finish_partial_modul true true env m1 in + match uu___1 with | (uu___2, env1) -> env1) let (load_partial_checked_module : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.modul -> FStar_TypeChecker_Env.env) @@ -5129,7 +5155,7 @@ let (check_module : fun env -> fun m -> fun b -> - (let uu___1 = FStar_Options.debug_any () in + (let uu___1 = FStar_Compiler_Debug.any () in if uu___1 then let uu___2 = @@ -5272,10 +5298,7 @@ let (check_module : (let uu___6 = FStar_Ident.string_of_lid m1.FStar_Syntax_Syntax.name in FStar_Options.dump_module uu___6) && - (let uu___6 = - FStar_Ident.string_of_lid m1.FStar_Syntax_Syntax.name in - FStar_Options.debug_at_level uu___6 - (FStar_Options.Other "Normalize")) in + (FStar_Compiler_Effect.op_Bang dbg_Normalize) in if uu___5 then let normalize_toplevel_lets se = diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcEffect.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcEffect.ml index 226e42cdf27..9eada3e1a95 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcEffect.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcEffect.ml @@ -1,4 +1,8 @@ open Prims +let (dbg : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "ED" +let (dbg_LayeredEffectsTc : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "LayeredEffectsTc" let (dmff_cps_and_elaborate : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.eff_decl -> @@ -266,8 +270,9 @@ let (bind_combinator_kind : fun has_range_binders -> let debug s = let uu___ = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsTc") in + (FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsTc) in if uu___ then FStar_Compiler_Util.print1 "%s\n" s else () in @@ -692,11 +697,12 @@ let (bind_combinator_kind : = let uu___14 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env g_sig_b_arrow_t (g_b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in uu___14 = - FStar_Syntax_Util.Equal in + FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___13 then @@ -706,11 +712,12 @@ let (bind_combinator_kind : = let uu___16 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env g_sig_b_sort (g_b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in uu___16 = - FStar_Syntax_Util.Equal in + FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___15 then @@ -963,11 +970,12 @@ let (bind_combinator_kind : = let uu___15 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env (f_b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort expected_f_b_sort in uu___15 = - FStar_Syntax_Util.Equal in + FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___14 then @@ -1190,11 +1198,12 @@ let (bind_combinator_kind : = let uu___16 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env (g_b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort expected_g_b_sort in uu___16 = - FStar_Syntax_Util.Equal in + FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___15 then @@ -1626,11 +1635,11 @@ let (validate_indexed_effect_bind_shape : FStar_Syntax_Syntax.Substitutive_combinator l in (let uu___8 = - FStar_TypeChecker_Env.debug - env + (FStar_Compiler_Debug.medium + ()) || ( - FStar_Options.Other - "LayeredEffectsTc") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsTc) in if uu___8 then let uu___9 @@ -1923,11 +1932,12 @@ let (subcomp_combinator_kind : uu___8 uu___9 in let uu___8 = let uu___9 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env (f_b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort expected_f_b_sort in uu___9 = - FStar_Syntax_Util.Equal in + FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___8 then FStar_Pervasives_Native.Some @@ -2052,12 +2062,13 @@ let (subcomp_combinator_kind : uu___9 in let uu___8 = let uu___9 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env (FStar_Syntax_Util.comp_result k_c) expected_t in uu___9 = - FStar_Syntax_Util.Equal in + FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___8 then FStar_Pervasives_Native.Some @@ -2399,9 +2410,9 @@ let (validate_indexed_effect_subcomp_shape : (FStar_Compiler_List.op_At (a_b :: rest_bs) [f]) c in ((let uu___4 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other - "LayeredEffectsTc") in + (FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsTc) in if uu___4 then let uu___5 = @@ -2458,9 +2469,10 @@ let (validate_indexed_effect_subcomp_shape : | FStar_Pervasives_Native.Some k2 -> k2 in (let uu___6 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other - "LayeredEffectsTc") in + (FStar_Compiler_Debug.medium ()) + || + (FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsTc) in if uu___6 then let uu___7 = @@ -2668,11 +2680,12 @@ let (ite_combinator_kind : FStar_Compiler_Range_Type.dummyRange in let uu___10 = let uu___11 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env (f_b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort expected_f_b_sort in uu___11 = - FStar_Syntax_Util.Equal in + FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___10 then FStar_Pervasives_Native.Some @@ -2731,11 +2744,12 @@ let (ite_combinator_kind : FStar_Compiler_Range_Type.dummyRange in let uu___10 = let uu___11 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env (g_b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort expected_g_b_sort in uu___11 = - FStar_Syntax_Util.Equal in + FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___10 then FStar_Pervasives_Native.Some @@ -3096,9 +3110,9 @@ let (validate_indexed_effect_ite_shape : FStar_Syntax_Syntax.Ad_hoc_combinator) | FStar_Pervasives_Native.Some k2 -> k2 in (let uu___5 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other - "LayeredEffectsTc") in + (FStar_Compiler_Debug.medium ()) || + (FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsTc) in if uu___5 then let uu___6 = @@ -3465,10 +3479,12 @@ let (lift_combinator_kind : uu___8 in let uu___7 = let uu___8 = - FStar_Syntax_Util.eq_tm + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env (f_b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort expected_f_b_sort in - uu___8 = FStar_Syntax_Util.Equal in + uu___8 = + FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___7 then FStar_Pervasives_Native.Some () else FStar_Pervasives_Native.None in @@ -3730,9 +3746,10 @@ let (validate_indexed_effect_lift_shape : FStar_Syntax_Syntax.Substitutive_combinator l in (let uu___8 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other - "LayeredEffectsTc") in + (FStar_Compiler_Debug.medium ()) + || + (FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsTc) in if uu___8 then let uu___9 = @@ -3762,8 +3779,7 @@ let (tc_layered_eff_decl : FStar_Errors.with_ctx uu___ (fun uu___1 -> (let uu___3 = - FStar_TypeChecker_Env.debug env0 - (FStar_Options.Other "LayeredEffectsTc") in + FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsTc in if uu___3 then let uu___4 = FStar_Syntax_Print.eff_decl_to_string false ed in @@ -3797,8 +3813,7 @@ let (tc_layered_eff_decl : match uu___4 with | (us, t, ty) -> let uu___5 = - FStar_TypeChecker_Env.debug env0 - (FStar_Options.Other "LayeredEffectsTc") in + FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsTc in if uu___5 then let uu___6 = @@ -4298,9 +4313,8 @@ let (tc_layered_eff_decl : | (stronger_us, stronger_t, stronger_ty) -> ((let uu___14 = - FStar_TypeChecker_Env.debug env0 - (FStar_Options.Other - "LayeredEffectsTc") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsTc in if uu___14 then let uu___15 = @@ -5732,10 +5746,11 @@ let (tc_layered_eff_decl : | (act_defn, uu___19, g_d) -> ((let uu___21 = - FStar_TypeChecker_Env.debug - env1 - (FStar_Options.Other - "LayeredEffectsTc") in + (FStar_Compiler_Debug.medium + ()) + || + (FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsTc) in if uu___21 then let uu___22 = @@ -5867,10 +5882,10 @@ let (tc_layered_eff_decl : | (k, g_k) -> ((let uu___23 = - FStar_TypeChecker_Env.debug - env1 - (FStar_Options.Other - "LayeredEffectsTc") in + (FStar_Compiler_Debug.medium + ()) || + (FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsTc) in if uu___23 then @@ -5897,10 +5912,10 @@ let (tc_layered_eff_decl : ( let uu___25 = - FStar_TypeChecker_Env.debug - env1 - (FStar_Options.Other - "LayeredEffectsTc") in + (FStar_Compiler_Debug.medium + ()) || + (FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsTc) in if uu___25 then @@ -6069,10 +6084,10 @@ let (tc_layered_eff_decl : ( let uu___26 = - FStar_TypeChecker_Env.debug - env1 - (FStar_Options.Other - "LayeredEffectsTc") in + (FStar_Compiler_Debug.medium + ()) || + (FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsTc) in if uu___26 then @@ -6344,10 +6359,8 @@ let (tc_layered_eff_decl : FStar_Syntax_Syntax.Extract_none m))) in (let uu___15 = - FStar_TypeChecker_Env.debug - env0 - (FStar_Options.Other - "LayeredEffectsTc") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsTc in if uu___15 then let uu___16 = @@ -6452,8 +6465,7 @@ let (tc_non_layered_eff_decl : "While checking effect definition `%s`" uu___1 in FStar_Errors.with_ctx uu___ (fun uu___1 -> - (let uu___3 = - FStar_TypeChecker_Env.debug env0 (FStar_Options.Other "ED") in + (let uu___3 = FStar_Compiler_Effect.op_Bang dbg in if uu___3 then let uu___4 = FStar_Syntax_Print.eff_decl_to_string false ed in @@ -6675,8 +6687,7 @@ let (tc_non_layered_eff_decl : (ed1.FStar_Syntax_Syntax.extraction_mode) } in ((let uu___7 = - FStar_TypeChecker_Env.debug env0 - (FStar_Options.Other "ED") in + FStar_Compiler_Effect.op_Bang dbg in if uu___7 then let uu___8 = @@ -6811,8 +6822,7 @@ let (tc_non_layered_eff_decl : FStar_Pervasives_Native.None uu___7 FStar_Pervasives_Native.None in (let uu___8 = - FStar_TypeChecker_Env.debug env0 - (FStar_Options.Other "ED") in + FStar_Compiler_Effect.op_Bang dbg in if uu___8 then let uu___9 = @@ -6878,8 +6888,7 @@ let (tc_non_layered_eff_decl : | uu___12 -> fail signature1) in let log_combinator s ts = let uu___8 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "ED") in + FStar_Compiler_Effect.op_Bang dbg in if uu___8 then let uu___9 = @@ -7530,7 +7539,8 @@ let (tc_non_layered_eff_decl : = let uu___21 = FStar_Compiler_Util.for_some - (FStar_Syntax_Util.attr_eq + (FStar_TypeChecker_TermEqAndSimplify.eq_tm_bool + env FStar_Syntax_Util.dm4f_bind_range_attr) ed2.FStar_Syntax_Syntax.eff_attrs in if uu___21 @@ -8093,10 +8103,8 @@ let (tc_non_layered_eff_decl : } in ((let uu___25 = - FStar_TypeChecker_Env.debug - env1 - (FStar_Options.Other - "ED") in + FStar_Compiler_Effect.op_Bang + dbg in if uu___25 then let uu___26 @@ -8692,9 +8700,8 @@ let (tc_non_layered_eff_decl : (ed2.FStar_Syntax_Syntax.extraction_mode) } in ((let uu___16 = - FStar_TypeChecker_Env.debug - env - (FStar_Options.Other "ED") in + FStar_Compiler_Effect.op_Bang + dbg in if uu___16 then let uu___17 = @@ -8763,9 +8770,7 @@ let (tc_layered_lift : = fun env0 -> fun sub -> - (let uu___1 = - FStar_TypeChecker_Env.debug env0 - (FStar_Options.Other "LayeredEffectsTc") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsTc in if uu___1 then let uu___2 = FStar_Syntax_Print.sub_eff_to_string sub in @@ -8776,9 +8781,7 @@ let (tc_layered_lift : let uu___1 = check_and_gen env0 "" "lift" Prims.int_one lift_ts in match uu___1 with | (us, lift, lift_ty) -> - ((let uu___3 = - FStar_TypeChecker_Env.debug env0 - (FStar_Options.Other "LayeredEffectsTc") in + ((let uu___3 = FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsTc in if uu___3 then let uu___4 = FStar_Syntax_Print.tscheme_to_string (us, lift) in @@ -8817,8 +8820,7 @@ let (tc_layered_lift : (FStar_Pervasives_Native.Some kind) } in ((let uu___6 = - FStar_TypeChecker_Env.debug env0 - (FStar_Options.Other "LayeredEffectsTc") in + FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsTc in if uu___6 then let uu___7 = @@ -9055,8 +9057,7 @@ let (tc_lift : (match uu___7 with | (uvs, lift1) -> ((let uu___9 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "ED") in + FStar_Compiler_Effect.op_Bang dbg in if uu___9 then let uu___10 = @@ -9757,8 +9758,7 @@ let (tc_polymonadic_bind : (match uu___4 with | (k, kind) -> ((let uu___6 = - FStar_TypeChecker_Env.debug env1 - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme () in if uu___6 then let uu___7 = @@ -9846,9 +9846,7 @@ let (tc_polymonadic_subcomp : Prims.int_zero uu___10 in (match uu___4 with | (k, kind) -> - ((let uu___6 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + ((let uu___6 = FStar_Compiler_Debug.extreme () in if uu___6 then let uu___7 = diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml index 676e915c74f..667d0acc8f9 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcInductive.ml @@ -1,10 +1,296 @@ open Prims +let (dbg_GenUniverses : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "GenUniverses" +let (dbg_LogTypes : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "LogTypes" +let (dbg_Injectivity : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Injectivity" let (unfold_whnf : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term) = FStar_TypeChecker_Normalize.unfold_whnf' [FStar_TypeChecker_Env.AllowUnboundUniverses] +let (check_sig_inductive_injectivity_on_params : + FStar_TypeChecker_Env.env_t -> + FStar_Syntax_Syntax.sigelt -> FStar_Syntax_Syntax.sigelt) + = + fun tcenv -> + fun se -> + if tcenv.FStar_TypeChecker_Env.phase1 + then se + else + (let uu___1 = se.FStar_Syntax_Syntax.sigel in + match uu___1 with + | FStar_Syntax_Syntax.Sig_inductive_typ dd -> + let uu___2 = dd in + (match uu___2 with + | { FStar_Syntax_Syntax.lid = t; + FStar_Syntax_Syntax.us = universe_names; + FStar_Syntax_Syntax.params = tps; + FStar_Syntax_Syntax.num_uniform_params = uu___3; + FStar_Syntax_Syntax.t = k; + FStar_Syntax_Syntax.mutuals = uu___4; + FStar_Syntax_Syntax.ds = uu___5; + FStar_Syntax_Syntax.injective_type_params = uu___6;_} -> + let t_lid = t in + let uu___7 = + FStar_Syntax_Subst.univ_var_opening universe_names in + (match uu___7 with + | (usubst, uvs) -> + let uu___8 = + let uu___9 = + FStar_TypeChecker_Env.push_univ_vars tcenv uvs in + let uu___10 = + FStar_Syntax_Subst.subst_binders usubst tps in + let uu___11 = + let uu___12 = + FStar_Syntax_Subst.shift_subst + (FStar_Compiler_List.length tps) usubst in + FStar_Syntax_Subst.subst uu___12 k in + (uu___9, uu___10, uu___11) in + (match uu___8 with + | (tcenv1, tps1, k1) -> + let uu___9 = FStar_Syntax_Subst.open_term tps1 k1 in + (match uu___9 with + | (tps2, k2) -> + let uu___10 = + FStar_Syntax_Util.arrow_formals k2 in + (match uu___10 with + | (uu___11, k3) -> + let uu___12 = + FStar_TypeChecker_TcTerm.tc_binders + tcenv1 tps2 in + (match uu___12 with + | (tps3, env_tps, uu___13, us) -> + let u_k = + let uu___14 = + let uu___15 = + FStar_Syntax_Syntax.fvar t + FStar_Pervasives_Native.None in + let uu___16 = + let uu___17 = + FStar_Syntax_Util.args_of_binders + tps3 in + FStar_Pervasives_Native.snd + uu___17 in + let uu___17 = + FStar_Ident.range_of_lid t in + FStar_Syntax_Syntax.mk_Tm_app + uu___15 uu___16 uu___17 in + FStar_TypeChecker_TcTerm.level_of_type + env_tps uu___14 k3 in + let rec universe_leq u v = + match (u, v) with + | (FStar_Syntax_Syntax.U_zero, + uu___14) -> true + | (FStar_Syntax_Syntax.U_succ + u0, + FStar_Syntax_Syntax.U_succ + v0) -> universe_leq u0 v0 + | (FStar_Syntax_Syntax.U_name + u0, + FStar_Syntax_Syntax.U_name + v0) -> + FStar_Ident.ident_equals u0 + v0 + | (FStar_Syntax_Syntax.U_name + uu___14, + FStar_Syntax_Syntax.U_succ + v0) -> universe_leq u v0 + | (FStar_Syntax_Syntax.U_max + us1, uu___14) -> + FStar_Compiler_Util.for_all + (fun u1 -> + universe_leq u1 v) us1 + | (uu___14, + FStar_Syntax_Syntax.U_max vs) + -> + FStar_Compiler_Util.for_some + (universe_leq u) vs + | (FStar_Syntax_Syntax.U_unknown, + uu___14) -> + let uu___15 = + let uu___16 = + FStar_Ident.string_of_lid + t in + let uu___17 = + FStar_Syntax_Print.univ_to_string + u in + let uu___18 = + FStar_Syntax_Print.univ_to_string + v in + FStar_Compiler_Util.format3 + "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" + uu___16 uu___17 uu___18 in + FStar_Compiler_Effect.failwith + uu___15 + | (uu___14, + FStar_Syntax_Syntax.U_unknown) + -> + let uu___15 = + let uu___16 = + FStar_Ident.string_of_lid + t in + let uu___17 = + FStar_Syntax_Print.univ_to_string + u in + let uu___18 = + FStar_Syntax_Print.univ_to_string + v in + FStar_Compiler_Util.format3 + "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" + uu___16 uu___17 uu___18 in + FStar_Compiler_Effect.failwith + uu___15 + | (FStar_Syntax_Syntax.U_unif + uu___14, uu___15) -> + let uu___16 = + let uu___17 = + FStar_Ident.string_of_lid + t in + let uu___18 = + FStar_Syntax_Print.univ_to_string + u in + let uu___19 = + FStar_Syntax_Print.univ_to_string + v in + FStar_Compiler_Util.format3 + "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" + uu___17 uu___18 uu___19 in + FStar_Compiler_Effect.failwith + uu___16 + | (uu___14, + FStar_Syntax_Syntax.U_unif + uu___15) -> + let uu___16 = + let uu___17 = + FStar_Ident.string_of_lid + t in + let uu___18 = + FStar_Syntax_Print.univ_to_string + u in + let uu___19 = + FStar_Syntax_Print.univ_to_string + v in + FStar_Compiler_Util.format3 + "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" + uu___17 uu___18 uu___19 in + FStar_Compiler_Effect.failwith + uu___16 + | uu___14 -> false in + let u_leq_u_k u = + let u1 = + FStar_TypeChecker_Normalize.normalize_universe + env_tps u in + universe_leq u1 u_k in + let tp_ok tp u_tp = + let t_tp = + (tp.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort in + let uu___14 = u_leq_u_k u_tp in + if uu___14 + then true + else + (let t_tp1 = + FStar_TypeChecker_Normalize.normalize + [FStar_TypeChecker_Env.Unrefine; + FStar_TypeChecker_Env.Unascribe; + FStar_TypeChecker_Env.Unmeta; + FStar_TypeChecker_Env.Primops; + FStar_TypeChecker_Env.HNF; + FStar_TypeChecker_Env.UnfoldUntil + FStar_Syntax_Syntax.delta_constant; + FStar_TypeChecker_Env.Beta] + env_tps t_tp in + let uu___16 = + FStar_Syntax_Util.arrow_formals + t_tp1 in + match uu___16 with + | (formals, t1) -> + let uu___17 = + FStar_TypeChecker_TcTerm.tc_binders + env_tps formals in + (match uu___17 with + | (uu___18, uu___19, + uu___20, u_formals) + -> + let inj = + FStar_Compiler_Util.for_all + (fun u_formal -> + u_leq_u_k + u_formal) + u_formals in + if inj + then + let uu___21 = + let uu___22 = + FStar_Syntax_Subst.compress + t1 in + uu___22.FStar_Syntax_Syntax.n in + (match uu___21 + with + | FStar_Syntax_Syntax.Tm_type + u -> + u_leq_u_k u + | uu___22 -> + false) + else false)) in + let injective_type_params = + FStar_Compiler_List.forall2 + tp_ok tps3 us in + ((let uu___15 = + FStar_Compiler_Effect.op_Bang + dbg_Injectivity in + if uu___15 + then + let uu___16 = + FStar_Ident.string_of_lid t in + FStar_Compiler_Util.print2 + "%s injectivity for %s\n" + (if injective_type_params + then "YES" + else "NO") uu___16 + else ()); + { + FStar_Syntax_Syntax.sigel = + (FStar_Syntax_Syntax.Sig_inductive_typ + { + FStar_Syntax_Syntax.lid + = + (dd.FStar_Syntax_Syntax.lid); + FStar_Syntax_Syntax.us = + (dd.FStar_Syntax_Syntax.us); + FStar_Syntax_Syntax.params + = + (dd.FStar_Syntax_Syntax.params); + FStar_Syntax_Syntax.num_uniform_params + = + (dd.FStar_Syntax_Syntax.num_uniform_params); + FStar_Syntax_Syntax.t = + (dd.FStar_Syntax_Syntax.t); + FStar_Syntax_Syntax.mutuals + = + (dd.FStar_Syntax_Syntax.mutuals); + FStar_Syntax_Syntax.ds = + (dd.FStar_Syntax_Syntax.ds); + FStar_Syntax_Syntax.injective_type_params + = + injective_type_params + }); + FStar_Syntax_Syntax.sigrng = + (se.FStar_Syntax_Syntax.sigrng); + FStar_Syntax_Syntax.sigquals = + (se.FStar_Syntax_Syntax.sigquals); + FStar_Syntax_Syntax.sigmeta = + (se.FStar_Syntax_Syntax.sigmeta); + FStar_Syntax_Syntax.sigattrs = + (se.FStar_Syntax_Syntax.sigattrs); + FStar_Syntax_Syntax.sigopens_and_abbrevs + = + (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); + FStar_Syntax_Syntax.sigopts = + (se.FStar_Syntax_Syntax.sigopts) + })))))))) let (tc_tycon : FStar_TypeChecker_Env.env_t -> FStar_Syntax_Syntax.sigelt -> @@ -19,36 +305,37 @@ let (tc_tycon : FStar_Syntax_Syntax.params = tps; FStar_Syntax_Syntax.num_uniform_params = n_uniform; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = mutuals; - FStar_Syntax_Syntax.ds = data;_} + FStar_Syntax_Syntax.ds = data; + FStar_Syntax_Syntax.injective_type_params = uu___;_} -> let env0 = env in - let uu___ = FStar_Syntax_Subst.univ_var_opening uvs in - (match uu___ with + let uu___1 = FStar_Syntax_Subst.univ_var_opening uvs in + (match uu___1 with | (usubst, uvs1) -> - let uu___1 = - let uu___2 = FStar_TypeChecker_Env.push_univ_vars env uvs1 in - let uu___3 = FStar_Syntax_Subst.subst_binders usubst tps in - let uu___4 = - let uu___5 = + let uu___2 = + let uu___3 = FStar_TypeChecker_Env.push_univ_vars env uvs1 in + let uu___4 = FStar_Syntax_Subst.subst_binders usubst tps in + let uu___5 = + let uu___6 = FStar_Syntax_Subst.shift_subst (FStar_Compiler_List.length tps) usubst in - FStar_Syntax_Subst.subst uu___5 k in - (uu___2, uu___3, uu___4) in - (match uu___1 with + FStar_Syntax_Subst.subst uu___6 k in + (uu___3, uu___4, uu___5) in + (match uu___2 with | (env1, tps1, k1) -> - let uu___2 = FStar_Syntax_Subst.open_term tps1 k1 in - (match uu___2 with + let uu___3 = FStar_Syntax_Subst.open_term tps1 k1 in + (match uu___3 with | (tps2, k2) -> - let uu___3 = + let uu___4 = FStar_TypeChecker_TcTerm.tc_binders env1 tps2 in - (match uu___3 with + (match uu___4 with | (tps3, env_tps, guard_params, us) -> - let uu___4 = - let uu___5 = + let uu___5 = + let uu___6 = FStar_TypeChecker_TcTerm.tc_tot_or_gtot_term env_tps k2 in - match uu___5 with - | (k3, uu___6, g) -> + match uu___6 with + | (k3, uu___7, g) -> let k4 = FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Env.Exclude @@ -60,23 +347,23 @@ let (tc_tycon : FStar_TypeChecker_Env.Exclude FStar_TypeChecker_Env.Beta] env_tps k3 in - let uu___7 = - FStar_Syntax_Util.arrow_formals k4 in let uu___8 = - let uu___9 = + FStar_Syntax_Util.arrow_formals k4 in + let uu___9 = + let uu___10 = FStar_TypeChecker_Env.conj_guard guard_params g in FStar_TypeChecker_Rel.discharge_guard - env_tps uu___9 in - (uu___7, uu___8) in - (match uu___4 with + env_tps uu___10 in + (uu___8, uu___9) in + (match uu___5 with | ((indices, t), guard) -> let k3 = - let uu___5 = + let uu___6 = FStar_Syntax_Syntax.mk_Total t in - FStar_Syntax_Util.arrow indices uu___5 in - let uu___5 = FStar_Syntax_Util.type_u () in - (match uu___5 with + FStar_Syntax_Util.arrow indices uu___6 in + let uu___6 = FStar_Syntax_Util.type_u () in + (match uu___6 with | (t_type, u) -> let valid_type = (((FStar_Syntax_Util.is_eqtype_no_unrefine @@ -96,21 +383,21 @@ let (tc_tycon : env1 t t_type) in (if Prims.op_Negation valid_type then - (let uu___7 = - let uu___8 = - let uu___9 = + (let uu___8 = + let uu___9 = + let uu___10 = FStar_Syntax_Print.term_to_string t in - let uu___10 = + let uu___11 = FStar_Ident.string_of_lid tc in FStar_Compiler_Util.format2 "Type annotation %s for inductive %s is not Type or eqtype, or it is eqtype but contains noeq/unopteq qualifiers" - uu___9 uu___10 in + uu___10 uu___11 in (FStar_Errors_Codes.Error_InductiveAnnotNotAType, - uu___8) in + uu___9) in FStar_Errors.raise_error_text - uu___7 + uu___8 s.FStar_Syntax_Syntax.sigrng) else (); (let usubst1 = @@ -120,22 +407,22 @@ let (tc_tycon : FStar_TypeChecker_Util.close_guard_implicits env1 false tps3 guard in let t_tc = - let uu___7 = - let uu___8 = + let uu___8 = + let uu___9 = FStar_Syntax_Subst.subst_binders usubst1 tps3 in - let uu___9 = - let uu___10 = + let uu___10 = + let uu___11 = FStar_Syntax_Subst.shift_subst (FStar_Compiler_List.length tps3) usubst1 in FStar_Syntax_Subst.subst_binders - uu___10 indices in + uu___11 indices in FStar_Compiler_List.op_At - uu___8 uu___9 in - let uu___8 = - let uu___9 = - let uu___10 = + uu___9 uu___10 in + let uu___9 = + let uu___10 = + let uu___11 = FStar_Syntax_Subst.shift_subst ((FStar_Compiler_List.length tps3) @@ -143,46 +430,46 @@ let (tc_tycon : (FStar_Compiler_List.length indices)) usubst1 in FStar_Syntax_Subst.subst - uu___10 t in + uu___11 t in FStar_Syntax_Syntax.mk_Total - uu___9 in - FStar_Syntax_Util.arrow uu___7 - uu___8 in + uu___10 in + FStar_Syntax_Util.arrow uu___8 + uu___9 in let tps4 = FStar_Syntax_Subst.close_binders tps3 in let k4 = FStar_Syntax_Subst.close tps4 k3 in - let uu___7 = - let uu___8 = + let uu___8 = + let uu___9 = FStar_Syntax_Subst.subst_binders usubst1 tps4 in - let uu___9 = - let uu___10 = + let uu___10 = + let uu___11 = FStar_Syntax_Subst.shift_subst (FStar_Compiler_List.length tps4) usubst1 in FStar_Syntax_Subst.subst - uu___10 k4 in - (uu___8, uu___9) in - match uu___7 with + uu___11 k4 in + (uu___9, uu___10) in + match uu___8 with | (tps5, k5) -> let fv_tc = FStar_Syntax_Syntax.lid_as_fv tc FStar_Pervasives_Native.None in - let uu___8 = + let uu___9 = FStar_Syntax_Subst.open_univ_vars uvs1 t_tc in - (match uu___8 with + (match uu___9 with | (uvs2, t_tc1) -> - let uu___9 = + let uu___10 = FStar_TypeChecker_Env.push_let_binding env0 (FStar_Pervasives.Inr fv_tc) (uvs2, t_tc1) in - (uu___9, + (uu___10, { FStar_Syntax_Syntax.sigel = @@ -201,7 +488,9 @@ let (tc_tycon : FStar_Syntax_Syntax.mutuals = mutuals; FStar_Syntax_Syntax.ds - = data + = data; + FStar_Syntax_Syntax.injective_type_params + = false }); FStar_Syntax_Syntax.sigrng = @@ -245,47 +534,50 @@ let (tc_data : FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = tc_lid; FStar_Syntax_Syntax.num_ty_params = ntps; - FStar_Syntax_Syntax.mutuals1 = mutual_tcs;_} + FStar_Syntax_Syntax.mutuals1 = mutual_tcs; + FStar_Syntax_Syntax.injective_type_params1 = uu___;_} -> - let uu___ = FStar_Syntax_Subst.univ_var_opening _uvs in - (match uu___ with + let uu___1 = FStar_Syntax_Subst.univ_var_opening _uvs in + (match uu___1 with | (usubst, _uvs1) -> - let uu___1 = - let uu___2 = + let uu___2 = + let uu___3 = FStar_TypeChecker_Env.push_univ_vars env _uvs1 in - let uu___3 = FStar_Syntax_Subst.subst usubst t in - (uu___2, uu___3) in - (match uu___1 with + let uu___4 = FStar_Syntax_Subst.subst usubst t in + (uu___3, uu___4) in + (match uu___2 with | (env1, t1) -> - let uu___2 = + let uu___3 = let tps_u_opt = FStar_Compiler_Util.find_map tcs - (fun uu___3 -> - match uu___3 with + (fun uu___4 -> + match uu___4 with | (se1, u_tc) -> - let uu___4 = - let uu___5 = - let uu___6 = + let uu___5 = + let uu___6 = + let uu___7 = FStar_Syntax_Util.lid_of_sigelt se1 in - FStar_Compiler_Util.must uu___6 in - FStar_Ident.lid_equals tc_lid uu___5 in - if uu___4 + FStar_Compiler_Util.must uu___7 in + FStar_Ident.lid_equals tc_lid uu___6 in + if uu___5 then (match se1.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_inductive_typ - { FStar_Syntax_Syntax.lid = uu___5; - FStar_Syntax_Syntax.us = uu___6; + { FStar_Syntax_Syntax.lid = uu___6; + FStar_Syntax_Syntax.us = uu___7; FStar_Syntax_Syntax.params = tps; FStar_Syntax_Syntax.num_uniform_params - = uu___7; - FStar_Syntax_Syntax.t = uu___8; + = uu___8; + FStar_Syntax_Syntax.t = uu___9; FStar_Syntax_Syntax.mutuals = - uu___9; - FStar_Syntax_Syntax.ds = uu___10;_} + uu___10; + FStar_Syntax_Syntax.ds = uu___11; + FStar_Syntax_Syntax.injective_type_params + = uu___12;_} -> let tps1 = - let uu___11 = + let uu___13 = FStar_Syntax_Subst.subst_binders usubst tps in FStar_Compiler_List.map @@ -304,37 +596,37 @@ let (tc_data : FStar_Syntax_Syntax.binder_attrs = (x.FStar_Syntax_Syntax.binder_attrs) - }) uu___11 in + }) uu___13 in let tps2 = FStar_Syntax_Subst.open_binders tps1 in - let uu___11 = - let uu___12 = + let uu___13 = + let uu___14 = FStar_TypeChecker_Env.push_binders env1 tps2 in - (uu___12, tps2, u_tc) in + (uu___14, tps2, u_tc) in FStar_Pervasives_Native.Some - uu___11 - | uu___5 -> + uu___13 + | uu___6 -> FStar_Compiler_Effect.failwith "Impossible") else FStar_Pervasives_Native.None) in match tps_u_opt with | FStar_Pervasives_Native.Some x -> x | FStar_Pervasives_Native.None -> - let uu___3 = + let uu___4 = FStar_Ident.lid_equals tc_lid FStar_Parser_Const.exn_lid in - if uu___3 + if uu___4 then (env1, [], FStar_Syntax_Syntax.U_zero) else FStar_Errors.raise_error (FStar_Errors_Codes.Fatal_UnexpectedDataConstructor, "Unexpected data constructor") se.FStar_Syntax_Syntax.sigrng in - (match uu___2 with + (match uu___3 with | (env2, tps, u_tc) -> - let uu___3 = + let uu___4 = let t2 = FStar_TypeChecker_Normalize.normalize (FStar_Compiler_List.op_At @@ -342,18 +634,18 @@ let (tc_data : [FStar_TypeChecker_Env.AllowUnboundUniverses]) env2 t1 in let t3 = FStar_Syntax_Util.canon_arrow t2 in - let uu___4 = - let uu___5 = FStar_Syntax_Subst.compress t3 in - uu___5.FStar_Syntax_Syntax.n in - match uu___4 with + let uu___5 = + let uu___6 = FStar_Syntax_Subst.compress t3 in + uu___6.FStar_Syntax_Syntax.n in + match uu___5 with | FStar_Syntax_Syntax.Tm_arrow { FStar_Syntax_Syntax.bs1 = bs; FStar_Syntax_Syntax.comp = res;_} -> - let uu___5 = + let uu___6 = FStar_Compiler_Util.first_N ntps bs in - (match uu___5 with - | (uu___6, bs') -> + (match uu___6 with + | (uu___7, bs') -> let t4 = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_arrow @@ -364,71 +656,69 @@ let (tc_data : let subst = FStar_Compiler_List.mapi (fun i -> - fun uu___7 -> - match uu___7 with + fun uu___8 -> + match uu___8 with | { FStar_Syntax_Syntax.binder_bv = x; FStar_Syntax_Syntax.binder_qual - = uu___8; - FStar_Syntax_Syntax.binder_positivity = uu___9; + FStar_Syntax_Syntax.binder_positivity + = uu___10; FStar_Syntax_Syntax.binder_attrs - = uu___10;_} + = uu___11;_} -> FStar_Syntax_Syntax.DB ((ntps - (Prims.int_one + i)), x)) tps in - let uu___7 = - let uu___8 = + let uu___8 = + let uu___9 = FStar_Syntax_Subst.subst subst t4 in FStar_Syntax_Util.arrow_formals_comp - uu___8 in - (match uu___7 with + uu___9 in + (match uu___8 with | (bs1, c1) -> - let uu___8 = + let uu___9 = (FStar_Options.ml_ish ()) || (FStar_Syntax_Util.is_total_comp c1) in - if uu___8 + if uu___9 then (bs1, (FStar_Syntax_Util.comp_result c1)) else - (let uu___10 = + (let uu___11 = FStar_Ident.range_of_lid (FStar_Syntax_Util.comp_effect_name c1) in FStar_Errors.raise_error (FStar_Errors_Codes.Fatal_UnexpectedConstructorType, "Constructors cannot have effects") - uu___10))) - | uu___5 -> ([], t3) in - (match uu___3 with + uu___11))) + | uu___6 -> ([], t3) in + (match uu___4 with | (arguments, result) -> - ((let uu___5 = - FStar_TypeChecker_Env.debug env2 - FStar_Options.Low in - if uu___5 + ((let uu___6 = FStar_Compiler_Debug.low () in + if uu___6 then - let uu___6 = - FStar_Syntax_Print.lid_to_string c in let uu___7 = + FStar_Syntax_Print.lid_to_string c in + let uu___8 = FStar_Syntax_Print.binders_to_string "->" arguments in - let uu___8 = + let uu___9 = FStar_Syntax_Print.term_to_string result in FStar_Compiler_Util.print3 "Checking datacon %s : %s -> %s \n" - uu___6 uu___7 uu___8 + uu___7 uu___8 uu___9 else ()); - (let uu___5 = + (let uu___6 = FStar_TypeChecker_TcTerm.tc_tparams env2 arguments in - match uu___5 with + match uu___6 with | (arguments1, env', us) -> let type_u_tc = FStar_Syntax_Syntax.mk @@ -437,23 +727,23 @@ let (tc_data : let env'1 = FStar_TypeChecker_Env.set_expected_typ env' type_u_tc in - let uu___6 = + let uu___7 = FStar_TypeChecker_TcTerm.tc_trivial_guard env'1 result in - (match uu___6 with + (match uu___7 with | (result1, res_lcomp) -> - let uu___7 = + let uu___8 = FStar_Syntax_Util.head_and_args_full result1 in - (match uu___7 with + (match uu___8 with | (head, args) -> let g_uvs = - let uu___8 = - let uu___9 = + let uu___9 = + let uu___10 = FStar_Syntax_Subst.compress head in - uu___9.FStar_Syntax_Syntax.n in - match uu___8 with + uu___10.FStar_Syntax_Syntax.n in + match uu___9 with | FStar_Syntax_Syntax.Tm_uinst ({ FStar_Syntax_Syntax.n @@ -461,11 +751,11 @@ let (tc_data : FStar_Syntax_Syntax.Tm_fvar fv; FStar_Syntax_Syntax.pos - = uu___9; - FStar_Syntax_Syntax.vars = uu___10; + FStar_Syntax_Syntax.vars + = uu___11; FStar_Syntax_Syntax.hash_code - = uu___11;_}, + = uu___12;_}, tuvs) when FStar_Syntax_Syntax.fv_eq_lid @@ -482,15 +772,15 @@ let (tc_data : (fun g -> fun u1 -> fun u2 -> - let uu___12 + let uu___13 = - let uu___13 + let uu___14 = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_type u1) FStar_Compiler_Range_Type.dummyRange in - let uu___14 + let uu___15 = FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_type @@ -499,10 +789,10 @@ let (tc_data : FStar_Compiler_Range_Type.dummyRange in FStar_TypeChecker_Rel.teq env'1 - uu___13 - uu___14 in + uu___14 + uu___15 in FStar_TypeChecker_Env.conj_guard - g uu___12) + g uu___13) FStar_TypeChecker_Env.trivial_guard tuvs _uvs1 else @@ -516,138 +806,138 @@ let (tc_data : fv tc_lid -> FStar_TypeChecker_Env.trivial_guard - | uu___9 -> - let uu___10 = - let uu___11 = - let uu___12 = + | uu___10 -> + let uu___11 = + let uu___12 = + let uu___13 = FStar_Syntax_Print.lid_to_string tc_lid in - let uu___13 = + let uu___14 = FStar_Syntax_Print.term_to_string head in FStar_Compiler_Util.format2 "Expected a constructor of type %s; got %s" - uu___12 uu___13 in + uu___13 uu___14 in (FStar_Errors_Codes.Fatal_UnexpectedConstructorType, - uu___11) in + uu___12) in FStar_Errors.raise_error - uu___10 + uu___11 se.FStar_Syntax_Syntax.sigrng in let g = FStar_Compiler_List.fold_left2 (fun g1 -> - fun uu___8 -> + fun uu___9 -> fun u_x -> - match uu___8 with + match uu___9 with | { FStar_Syntax_Syntax.binder_bv = x; FStar_Syntax_Syntax.binder_qual - = uu___9; - FStar_Syntax_Syntax.binder_positivity = uu___10; + FStar_Syntax_Syntax.binder_positivity + = uu___11; FStar_Syntax_Syntax.binder_attrs - = uu___11;_} + = uu___12;_} -> - let uu___12 = + let uu___13 = FStar_TypeChecker_Rel.universe_inequality u_x u_tc in FStar_TypeChecker_Env.conj_guard - g1 uu___12) + g1 uu___13) g_uvs arguments1 us in (FStar_Errors.stop_if_err (); (let p_args = - let uu___9 = + let uu___10 = FStar_Compiler_Util.first_N (FStar_Compiler_List.length tps) args in FStar_Pervasives_Native.fst - uu___9 in + uu___10 in FStar_Compiler_List.iter2 - (fun uu___10 -> - fun uu___11 -> - match (uu___10, - uu___11) + (fun uu___11 -> + fun uu___12 -> + match (uu___11, + uu___12) with | ({ FStar_Syntax_Syntax.binder_bv = bv; FStar_Syntax_Syntax.binder_qual - = uu___12; - FStar_Syntax_Syntax.binder_positivity = uu___13; + FStar_Syntax_Syntax.binder_positivity + = uu___14; FStar_Syntax_Syntax.binder_attrs - = uu___14;_}, - (t2, uu___15)) -> - let uu___16 = - let uu___17 = + = uu___15;_}, + (t2, uu___16)) -> + let uu___17 = + let uu___18 = FStar_Syntax_Subst.compress t2 in - uu___17.FStar_Syntax_Syntax.n in - (match uu___16 + uu___18.FStar_Syntax_Syntax.n in + (match uu___17 with | FStar_Syntax_Syntax.Tm_name bv' when FStar_Syntax_Syntax.bv_eq bv bv' -> () - | uu___17 -> - let uu___18 - = - let uu___19 + | uu___18 -> + let uu___19 = let uu___20 = + let uu___21 + = FStar_Syntax_Print.bv_to_string bv in - let uu___21 + let uu___22 = FStar_Syntax_Print.term_to_string t2 in FStar_Compiler_Util.format2 "This parameter is not constant: expected %s, got %s" - uu___20 - uu___21 in + uu___21 + uu___22 in (FStar_Errors_Codes.Error_BadInductiveParam, - uu___19) in + uu___20) in FStar_Errors.raise_error - uu___18 + uu___19 t2.FStar_Syntax_Syntax.pos)) tps p_args; (let ty = - let uu___10 = + let uu___11 = unfold_whnf env2 res_lcomp.FStar_TypeChecker_Common.res_typ in FStar_Syntax_Util.unrefine - uu___10 in - (let uu___11 = - let uu___12 = + uu___11 in + (let uu___12 = + let uu___13 = FStar_Syntax_Subst.compress ty in - uu___12.FStar_Syntax_Syntax.n in - match uu___11 with + uu___13.FStar_Syntax_Syntax.n in + match uu___12 with | FStar_Syntax_Syntax.Tm_type - uu___12 -> () - | uu___12 -> - let uu___13 = - let uu___14 = - let uu___15 = + uu___13 -> () + | uu___13 -> + let uu___14 = + let uu___15 = + let uu___16 = FStar_Syntax_Print.term_to_string result1 in - let uu___16 = + let uu___17 = FStar_Syntax_Print.term_to_string ty in FStar_Compiler_Util.format2 "The type of %s is %s, but since this is the result type of a constructor its type should be Type" - uu___15 uu___16 in + uu___16 uu___17 in (FStar_Errors_Codes.Fatal_WrongResultTypeAfterConstrutor, - uu___14) in + uu___15) in FStar_Errors.raise_error - uu___13 + uu___14 se.FStar_Syntax_Syntax.sigrng); (let t2 = - let uu___11 = - let uu___12 = + let uu___12 = + let uu___13 = FStar_Compiler_List.map (fun b -> { @@ -667,12 +957,12 @@ let (tc_data : (b.FStar_Syntax_Syntax.binder_attrs) }) tps in FStar_Compiler_List.op_At - uu___12 arguments1 in - let uu___12 = + uu___13 arguments1 in + let uu___13 = FStar_Syntax_Syntax.mk_Total result1 in FStar_Syntax_Util.arrow - uu___11 uu___12 in + uu___12 uu___13 in let t3 = FStar_Syntax_Subst.close_univ_vars _uvs1 t2 in @@ -692,7 +982,9 @@ let (tc_data : FStar_Syntax_Syntax.num_ty_params = ntps; FStar_Syntax_Syntax.mutuals1 - = mutual_tcs + = mutual_tcs; + FStar_Syntax_Syntax.injective_type_params1 + = false }); FStar_Syntax_Syntax.sigrng = @@ -737,12 +1029,13 @@ let (generalize_and_inst_within : FStar_Syntax_Syntax.num_uniform_params = uu___4; FStar_Syntax_Syntax.t = k; FStar_Syntax_Syntax.mutuals = uu___5; - FStar_Syntax_Syntax.ds = uu___6;_} + FStar_Syntax_Syntax.ds = uu___6; + FStar_Syntax_Syntax.injective_type_params = uu___7;_} -> - let uu___7 = - let uu___8 = FStar_Syntax_Syntax.mk_Total k in - FStar_Syntax_Util.arrow tps uu___8 in - FStar_Syntax_Syntax.null_binder uu___7 + let uu___8 = + let uu___9 = FStar_Syntax_Syntax.mk_Total k in + FStar_Syntax_Util.arrow tps uu___9 in + FStar_Syntax_Syntax.null_binder uu___8 | uu___2 -> FStar_Compiler_Effect.failwith "Impossible")) tcs in let binders' = @@ -755,16 +1048,15 @@ let (generalize_and_inst_within : FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___2; FStar_Syntax_Syntax.num_ty_params = uu___3; - FStar_Syntax_Syntax.mutuals1 = uu___4;_} + FStar_Syntax_Syntax.mutuals1 = uu___4; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_} -> FStar_Syntax_Syntax.null_binder t | uu___ -> FStar_Compiler_Effect.failwith "Impossible") datas in let t = let uu___ = FStar_Syntax_Syntax.mk_Total FStar_Syntax_Syntax.t_unit in FStar_Syntax_Util.arrow (FStar_Compiler_List.op_At binders binders') uu___ in - (let uu___1 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "GenUniverses") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_GenUniverses in if uu___1 then let uu___2 = FStar_TypeChecker_Normalize.term_to_string env t in @@ -774,9 +1066,7 @@ let (generalize_and_inst_within : (let uu___1 = FStar_TypeChecker_Generalize.generalize_universes env t in match uu___1 with | (uvs, t1) -> - ((let uu___3 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "GenUniverses") in + ((let uu___3 = FStar_Compiler_Effect.op_Bang dbg_GenUniverses in if uu___3 then let uu___4 = @@ -828,19 +1118,21 @@ let (generalize_and_inst_within : FStar_Syntax_Syntax.mutuals = mutuals; FStar_Syntax_Syntax.ds = - datas1;_} + datas1; + FStar_Syntax_Syntax.injective_type_params + = uu___15;_} -> let ty = FStar_Syntax_Subst.close_univ_vars uvs1 x.FStar_Syntax_Syntax.sort in - let uu___15 = - let uu___16 = - let uu___17 = + let uu___16 = + let uu___17 = + let uu___18 = FStar_Syntax_Subst.compress ty in - uu___17.FStar_Syntax_Syntax.n in - match uu___16 with + uu___18.FStar_Syntax_Syntax.n in + match uu___17 with | FStar_Syntax_Syntax.Tm_arrow { FStar_Syntax_Syntax.bs1 @@ -848,18 +1140,18 @@ let (generalize_and_inst_within : FStar_Syntax_Syntax.comp = c;_} -> - let uu___17 = + let uu___18 = FStar_Compiler_Util.first_N (FStar_Compiler_List.length tps) binders1 in - (match uu___17 with + (match uu___18 with | (tps1, rest) -> let t3 = match rest with | [] -> FStar_Syntax_Util.comp_result c - | uu___18 -> + | uu___19 -> FStar_Syntax_Syntax.mk (FStar_Syntax_Syntax.Tm_arrow { @@ -870,8 +1162,8 @@ let (generalize_and_inst_within : }) (x.FStar_Syntax_Syntax.sort).FStar_Syntax_Syntax.pos in (tps1, t3)) - | uu___17 -> ([], ty) in - (match uu___15 with + | uu___18 -> ([], ty) in + (match uu___16 with | (tps1, t3) -> { FStar_Syntax_Syntax.sigel @@ -891,7 +1183,9 @@ let (generalize_and_inst_within : FStar_Syntax_Syntax.mutuals = mutuals; FStar_Syntax_Syntax.ds - = datas1 + = datas1; + FStar_Syntax_Syntax.injective_type_params + = false }); FStar_Syntax_Syntax.sigrng = @@ -945,19 +1239,21 @@ let (generalize_and_inst_within : FStar_Syntax_Syntax.mutuals = uu___13; FStar_Syntax_Syntax.ds = - uu___14;_}; + uu___14; + FStar_Syntax_Syntax.injective_type_params + = uu___15;_}; FStar_Syntax_Syntax.sigrng = - uu___15; - FStar_Syntax_Syntax.sigquals = uu___16; - FStar_Syntax_Syntax.sigmeta = + FStar_Syntax_Syntax.sigquals = uu___17; - FStar_Syntax_Syntax.sigattrs = + FStar_Syntax_Syntax.sigmeta = uu___18; + FStar_Syntax_Syntax.sigattrs = + uu___19; FStar_Syntax_Syntax.sigopens_and_abbrevs - = uu___19; + = uu___20; FStar_Syntax_Syntax.sigopts = - uu___20;_} + uu___21;_} -> (tc, uvs_universes) | uu___9 -> FStar_Compiler_Effect.failwith @@ -991,15 +1287,17 @@ let (generalize_and_inst_within : FStar_Syntax_Syntax.num_ty_params = ntps; FStar_Syntax_Syntax.mutuals1 - = mutuals;_} + = mutuals; + FStar_Syntax_Syntax.injective_type_params1 + = uu___14;_} -> let ty = - let uu___14 = + let uu___15 = FStar_Syntax_InstFV.instantiate tc_insts t3.FStar_Syntax_Syntax.sort in FStar_Syntax_Subst.close_univ_vars - uvs1 uu___14 in + uvs1 uu___15 in { FStar_Syntax_Syntax.sigel = @@ -1016,7 +1314,9 @@ let (generalize_and_inst_within : FStar_Syntax_Syntax.num_ty_params = ntps; FStar_Syntax_Syntax.mutuals1 - = mutuals + = mutuals; + FStar_Syntax_Syntax.injective_type_params1 + = false }); FStar_Syntax_Syntax.sigrng = @@ -1049,7 +1349,8 @@ let (datacon_typ : FStar_Syntax_Syntax.sigelt -> FStar_Syntax_Syntax.term) = { FStar_Syntax_Syntax.lid1 = uu___; FStar_Syntax_Syntax.us1 = uu___1; FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___2; FStar_Syntax_Syntax.num_ty_params = uu___3; - FStar_Syntax_Syntax.mutuals1 = uu___4;_} + FStar_Syntax_Syntax.mutuals1 = uu___4; + FStar_Syntax_Syntax.injective_type_params1 = uu___5;_} -> t | uu___ -> FStar_Compiler_Effect.failwith "Impossible!" let (haseq_suffix : Prims.string) = "__uu___haseq" @@ -1102,7 +1403,8 @@ let (get_optimized_haseq_axiom : FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = t; FStar_Syntax_Syntax.mutuals = uu___3; - FStar_Syntax_Syntax.ds = uu___4;_} + FStar_Syntax_Syntax.ds = uu___4; + FStar_Syntax_Syntax.injective_type_params = uu___5;_} -> (lid, bs, t) | uu___1 -> FStar_Compiler_Effect.failwith "Impossible!" in match uu___ with @@ -1299,10 +1601,27 @@ let (optimized_haseq_soundness_for_data : ((b.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort).FStar_Syntax_Syntax.pos in let haseq_b1 = let uu___2 = - let uu___3 = FStar_Ident.string_of_lid ty_lid in - FStar_Compiler_Util.format1 - "Failed to prove that the type '%s' supports decidable equality because of this argument; add either the 'noeq' or 'unopteq' qualifier" - uu___3 in + let uu___3 = + let uu___4 = + FStar_Errors_Msg.text + "Failed to prove that the type" in + let uu___5 = + let uu___6 = + let uu___7 = + FStar_Class_PP.pp + FStar_Ident.pretty_lident ty_lid in + FStar_Pprint.squotes uu___7 in + let uu___7 = + FStar_Errors_Msg.text + "supports decidable equality because of this argument." in + FStar_Pprint.op_Hat_Slash_Hat uu___6 uu___7 in + FStar_Pprint.op_Hat_Slash_Hat uu___4 uu___5 in + let uu___4 = + let uu___5 = + FStar_Errors_Msg.text + "Add either the 'noeq' or 'unopteq' qualifier" in + [uu___5] in + uu___3 :: uu___4 in FStar_TypeChecker_Util.label uu___2 sort_range haseq_b in FStar_Syntax_Util.mk_conj t haseq_b1) @@ -1359,7 +1678,8 @@ let (optimized_haseq_ty : FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = uu___3; FStar_Syntax_Syntax.mutuals = uu___4; - FStar_Syntax_Syntax.ds = uu___5;_} + FStar_Syntax_Syntax.ds = uu___5; + FStar_Syntax_Syntax.injective_type_params = uu___6;_} -> lid1 | uu___ -> FStar_Compiler_Effect.failwith "Impossible!" in let uu___ = acc in @@ -1387,7 +1707,9 @@ let (optimized_haseq_ty : FStar_Syntax_Syntax.ty_lid = t_lid; FStar_Syntax_Syntax.num_ty_params = uu___9; - FStar_Syntax_Syntax.mutuals1 = uu___10;_} + FStar_Syntax_Syntax.mutuals1 = uu___10; + FStar_Syntax_Syntax.injective_type_params1 + = uu___11;_} -> t_lid = lid | uu___6 -> FStar_Compiler_Effect.failwith @@ -1425,7 +1747,8 @@ let (optimized_haseq_scheme : FStar_Syntax_Syntax.num_uniform_params = uu___3; FStar_Syntax_Syntax.t = t; FStar_Syntax_Syntax.mutuals = uu___4; - FStar_Syntax_Syntax.ds = uu___5;_} + FStar_Syntax_Syntax.ds = uu___5; + FStar_Syntax_Syntax.injective_type_params = uu___6;_} -> (us, t) | uu___1 -> FStar_Compiler_Effect.failwith "Impossible!" in match uu___ with @@ -1652,7 +1975,8 @@ let (unoptimized_haseq_ty : FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = t; FStar_Syntax_Syntax.mutuals = uu___3; - FStar_Syntax_Syntax.ds = d_lids;_} + FStar_Syntax_Syntax.ds = d_lids; + FStar_Syntax_Syntax.injective_type_params = uu___4;_} -> (lid, bs, t, d_lids) | uu___1 -> FStar_Compiler_Effect.failwith "Impossible!" in match uu___ with @@ -1715,7 +2039,9 @@ let (unoptimized_haseq_ty : FStar_Syntax_Syntax.ty_lid = t_lid; FStar_Syntax_Syntax.num_ty_params = uu___5; - FStar_Syntax_Syntax.mutuals1 = uu___6;_} + FStar_Syntax_Syntax.mutuals1 = uu___6; + FStar_Syntax_Syntax.injective_type_params1 + = uu___7;_} -> t_lid = lid | uu___2 -> FStar_Compiler_Effect.failwith "Impossible") @@ -1820,7 +2146,8 @@ let (unoptimized_haseq_scheme : FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = uu___3; FStar_Syntax_Syntax.mutuals = uu___4; - FStar_Syntax_Syntax.ds = uu___5;_} + FStar_Syntax_Syntax.ds = uu___5; + FStar_Syntax_Syntax.injective_type_params = uu___6;_} -> lid | uu___ -> FStar_Compiler_Effect.failwith "Impossible!") tcs in let uu___ = @@ -1832,7 +2159,8 @@ let (unoptimized_haseq_scheme : FStar_Syntax_Syntax.num_uniform_params = uu___2; FStar_Syntax_Syntax.t = uu___3; FStar_Syntax_Syntax.mutuals = uu___4; - FStar_Syntax_Syntax.ds = uu___5;_} + FStar_Syntax_Syntax.ds = uu___5; + FStar_Syntax_Syntax.injective_type_params = uu___6;_} -> (lid, us) | uu___1 -> FStar_Compiler_Effect.failwith "Impossible!" in match uu___ with @@ -1933,7 +2261,9 @@ let (check_inductive_well_typedness : FStar_Syntax_Syntax.num_uniform_params = uu___6; FStar_Syntax_Syntax.t = uu___7; FStar_Syntax_Syntax.mutuals = uu___8; - FStar_Syntax_Syntax.ds = uu___9;_} + FStar_Syntax_Syntax.ds = uu___9; + FStar_Syntax_Syntax.injective_type_params = + uu___10;_} -> uvs | uu___4 -> FStar_Compiler_Effect.failwith @@ -1951,9 +2281,7 @@ let (check_inductive_well_typedness : let g' = FStar_TypeChecker_Rel.universe_inequality FStar_Syntax_Syntax.U_zero tc_u in - ((let uu___6 = - FStar_TypeChecker_Env.debug env2 - FStar_Options.Low in + ((let uu___6 = FStar_Compiler_Debug.low () in if uu___6 then let uu___7 = @@ -2010,8 +2338,7 @@ let (check_inductive_well_typedness : (g2.FStar_TypeChecker_Common.implicits) } in (let uu___6 = - FStar_TypeChecker_Env.debug env0 - (FStar_Options.Other "GenUniverses") in + FStar_Compiler_Effect.op_Bang dbg_GenUniverses in if uu___6 then let uu___7 = @@ -2045,49 +2372,51 @@ let (check_inductive_well_typedness : = num_uniform; FStar_Syntax_Syntax.t = typ; FStar_Syntax_Syntax.mutuals = ts; - FStar_Syntax_Syntax.ds = ds;_} + FStar_Syntax_Syntax.ds = ds; + FStar_Syntax_Syntax.injective_type_params + = uu___5;_} -> let fail expected inferred = - let uu___5 = - let uu___6 = - let uu___7 = + let uu___6 = + let uu___7 = + let uu___8 = FStar_Syntax_Print.tscheme_to_string expected in - let uu___8 = + let uu___9 = FStar_Syntax_Print.tscheme_to_string inferred in FStar_Compiler_Util.format2 "Expected an inductive with type %s; got %s" - uu___7 uu___8 in + uu___8 uu___9 in (FStar_Errors_Codes.Fatal_UnexpectedInductivetype, - uu___6) in - FStar_Errors.raise_error uu___5 + uu___7) in + FStar_Errors.raise_error uu___6 se.FStar_Syntax_Syntax.sigrng in let copy_binder_attrs_from_val binders1 expected = let expected_attrs = - let uu___5 = - let uu___6 = + let uu___6 = + let uu___7 = FStar_TypeChecker_Normalize.get_n_binders env1 (FStar_Compiler_List.length binders1) expected in FStar_Pervasives_Native.fst - uu___6 in + uu___7 in FStar_Compiler_List.map - (fun uu___6 -> - match uu___6 with + (fun uu___7 -> + match uu___7 with | { FStar_Syntax_Syntax.binder_bv - = uu___7; - FStar_Syntax_Syntax.binder_qual = uu___8; + FStar_Syntax_Syntax.binder_qual + = uu___9; FStar_Syntax_Syntax.binder_positivity = pqual; FStar_Syntax_Syntax.binder_attrs = attrs;_} -> (attrs, pqual)) - uu___5 in + uu___6 in if (FStar_Compiler_List.length expected_attrs) @@ -2095,44 +2424,44 @@ let (check_inductive_well_typedness : (FStar_Compiler_List.length binders1) then - let uu___5 = - let uu___6 = - let uu___7 = + let uu___6 = + let uu___7 = + let uu___8 = FStar_Compiler_Util.string_of_int (FStar_Compiler_List.length binders1) in - let uu___8 = + let uu___9 = FStar_Syntax_Print.term_to_string expected in FStar_Compiler_Util.format2 "Could not get %s type parameters from val type %s" - uu___7 uu___8 in + uu___8 uu___9 in (FStar_Errors_Codes.Fatal_UnexpectedInductivetype, - uu___6) in - FStar_Errors.raise_error uu___5 + uu___7) in + FStar_Errors.raise_error uu___6 se.FStar_Syntax_Syntax.sigrng else FStar_Compiler_List.map2 - (fun uu___6 -> + (fun uu___7 -> fun b -> - match uu___6 with + match uu___7 with | (ex_attrs, pqual) -> - ((let uu___8 = - let uu___9 = + ((let uu___9 = + let uu___10 = FStar_TypeChecker_Common.check_positivity_qual true pqual b.FStar_Syntax_Syntax.binder_positivity in Prims.op_Negation - uu___9 in - if uu___8 + uu___10 in + if uu___9 then - let uu___9 = + let uu___10 = FStar_Syntax_Syntax.range_of_bv b.FStar_Syntax_Syntax.binder_bv in FStar_Errors.raise_error (FStar_Errors_Codes.Fatal_UnexpectedInductivetype, "Incompatible positivity annotation") - uu___9 + uu___10 else ()); { FStar_Syntax_Syntax.binder_bv @@ -2155,32 +2484,32 @@ let (check_inductive_well_typedness : let body = match binders1 with | [] -> typ - | uu___5 -> - let uu___6 = - let uu___7 = - let uu___8 = + | uu___6 -> + let uu___7 = + let uu___8 = + let uu___9 = FStar_Syntax_Syntax.mk_Total typ in { FStar_Syntax_Syntax.bs1 = binders1; FStar_Syntax_Syntax.comp - = uu___8 + = uu___9 } in FStar_Syntax_Syntax.Tm_arrow - uu___7 in + uu___8 in FStar_Syntax_Syntax.mk - uu___6 + uu___7 se.FStar_Syntax_Syntax.sigrng in (univs1, body) in - let uu___5 = + let uu___6 = FStar_TypeChecker_Env.try_lookup_val_decl env0 l in - (match uu___5 with + (match uu___6 with | FStar_Pervasives_Native.None -> se | FStar_Pervasives_Native.Some - (expected_typ, uu___6) -> + (expected_typ, uu___7) -> if (FStar_Compiler_List.length univs1) @@ -2189,32 +2518,32 @@ let (check_inductive_well_typedness : (FStar_Pervasives_Native.fst expected_typ)) then - let uu___7 = + let uu___8 = FStar_Syntax_Subst.open_univ_vars univs1 (FStar_Pervasives_Native.snd expected_typ) in - (match uu___7 with - | (uu___8, expected) -> + (match uu___8 with + | (uu___9, expected) -> let binders1 = copy_binder_attrs_from_val binders expected in let inferred_typ = inferred_typ_with_binders binders1 in - let uu___9 = + let uu___10 = FStar_Syntax_Subst.open_univ_vars univs1 (FStar_Pervasives_Native.snd inferred_typ) in - (match uu___9 with - | (uu___10, inferred) + (match uu___10 with + | (uu___11, inferred) -> - let uu___11 = + let uu___12 = FStar_TypeChecker_Rel.teq_nosmt_force env0 inferred expected in - if uu___11 + if uu___12 then { FStar_Syntax_Syntax.sigel @@ -2236,7 +2565,9 @@ let (check_inductive_well_typedness : FStar_Syntax_Syntax.mutuals = ts; FStar_Syntax_Syntax.ds - = ds + = ds; + FStar_Syntax_Syntax.injective_type_params + = false }); FStar_Syntax_Syntax.sigrng = @@ -2261,11 +2592,94 @@ let (check_inductive_well_typedness : fail expected_typ inferred_typ)) else - (let uu___8 = + (let uu___9 = inferred_typ_with_binders binders in - fail expected_typ uu___8)) + fail expected_typ uu___9)) | uu___5 -> se) tcs1 in + let tcs3 = + FStar_Compiler_List.map + (check_sig_inductive_injectivity_on_params + env0) tcs2 in + let is_injective l = + let uu___5 = + FStar_Compiler_List.tryPick + (fun se -> + let uu___6 = + se.FStar_Syntax_Syntax.sigel in + match uu___6 with + | FStar_Syntax_Syntax.Sig_inductive_typ + { FStar_Syntax_Syntax.lid = lid; + FStar_Syntax_Syntax.us = uu___7; + FStar_Syntax_Syntax.params = + uu___8; + FStar_Syntax_Syntax.num_uniform_params + = uu___9; + FStar_Syntax_Syntax.t = uu___10; + FStar_Syntax_Syntax.mutuals = + uu___11; + FStar_Syntax_Syntax.ds = uu___12; + FStar_Syntax_Syntax.injective_type_params + = injective_type_params;_} + -> + let uu___13 = + FStar_Ident.lid_equals l lid in + if uu___13 + then + FStar_Pervasives_Native.Some + injective_type_params + else FStar_Pervasives_Native.None) + tcs3 in + match uu___5 with + | FStar_Pervasives_Native.None -> false + | FStar_Pervasives_Native.Some i -> i in + let datas3 = + FStar_Compiler_List.map + (fun se -> + let uu___5 = + se.FStar_Syntax_Syntax.sigel in + match uu___5 with + | FStar_Syntax_Syntax.Sig_datacon dd -> + let uu___6 = + let uu___7 = + let uu___8 = + is_injective + dd.FStar_Syntax_Syntax.ty_lid in + { + FStar_Syntax_Syntax.lid1 = + (dd.FStar_Syntax_Syntax.lid1); + FStar_Syntax_Syntax.us1 = + (dd.FStar_Syntax_Syntax.us1); + FStar_Syntax_Syntax.t1 = + (dd.FStar_Syntax_Syntax.t1); + FStar_Syntax_Syntax.ty_lid = + (dd.FStar_Syntax_Syntax.ty_lid); + FStar_Syntax_Syntax.num_ty_params + = + (dd.FStar_Syntax_Syntax.num_ty_params); + FStar_Syntax_Syntax.mutuals1 = + (dd.FStar_Syntax_Syntax.mutuals1); + FStar_Syntax_Syntax.injective_type_params1 + = uu___8 + } in + FStar_Syntax_Syntax.Sig_datacon + uu___7 in + { + FStar_Syntax_Syntax.sigel = uu___6; + FStar_Syntax_Syntax.sigrng = + (se.FStar_Syntax_Syntax.sigrng); + FStar_Syntax_Syntax.sigquals = + (se.FStar_Syntax_Syntax.sigquals); + FStar_Syntax_Syntax.sigmeta = + (se.FStar_Syntax_Syntax.sigmeta); + FStar_Syntax_Syntax.sigattrs = + (se.FStar_Syntax_Syntax.sigattrs); + FStar_Syntax_Syntax.sigopens_and_abbrevs + = + (se.FStar_Syntax_Syntax.sigopens_and_abbrevs); + FStar_Syntax_Syntax.sigopts = + (se.FStar_Syntax_Syntax.sigopts) + }) datas2 in let sig_bndle = let uu___5 = FStar_TypeChecker_Env.get_range env0 in @@ -2278,8 +2692,8 @@ let (check_inductive_well_typedness : (FStar_Syntax_Syntax.Sig_bundle { FStar_Syntax_Syntax.ses = - (FStar_Compiler_List.op_At tcs2 - datas2); + (FStar_Compiler_List.op_At tcs3 + datas3); FStar_Syntax_Syntax.lids = lids }); FStar_Syntax_Syntax.sigrng = uu___5; @@ -2292,7 +2706,7 @@ let (check_inductive_well_typedness : FStar_Syntax_Syntax.sigopts = FStar_Pervasives_Native.None } in - (sig_bndle, tcs2, datas2))))) + (sig_bndle, tcs3, datas3))))) let (early_prims_inductives : Prims.string Prims.list) = ["empty"; "trivial"; "equals"; "pair"; "sum"] let (mk_discriminator_and_indexed_projectors : @@ -2364,8 +2778,6 @@ let (mk_discriminator_and_indexed_projectors : let uu___1 = FStar_Ident.set_lid_range disc_name p in FStar_Syntax_Syntax.fvar_with_dd uu___1 - (FStar_Syntax_Syntax.Delta_equational_at_level - Prims.int_one) FStar_Pervasives_Native.None in let uu___1 = let uu___2 = @@ -2507,8 +2919,7 @@ let (mk_discriminator_and_indexed_projectors : FStar_Pervasives_Native.None } in (let uu___2 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LogTypes") in + FStar_Compiler_Effect.op_Bang dbg_LogTypes in if uu___2 then let uu___3 = @@ -2622,9 +3033,6 @@ let (mk_discriminator_and_indexed_projectors : } in FStar_Syntax_Syntax.Tm_match uu___5 in FStar_Syntax_Syntax.mk uu___4 p) in - let dd = - FStar_Syntax_Syntax.Delta_equational_at_level - Prims.int_one in let imp = FStar_Syntax_Util.abs binders body FStar_Pervasives_Native.None in @@ -2636,7 +3044,7 @@ let (mk_discriminator_and_indexed_projectors : let uu___3 = let uu___4 = FStar_Syntax_Syntax.lid_and_dd_as_fv - discriminator_name dd + discriminator_name FStar_Pervasives_Native.None in FStar_Pervasives.Inr uu___4 in let uu___4 = @@ -2676,8 +3084,8 @@ let (mk_discriminator_and_indexed_projectors : FStar_Pervasives_Native.None } in (let uu___4 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LogTypes") in + FStar_Compiler_Effect.op_Bang + dbg_LogTypes in if uu___4 then let uu___5 = @@ -2842,10 +3250,8 @@ let (mk_discriminator_and_indexed_projectors : FStar_Pervasives_Native.None } in ((let uu___8 = - FStar_TypeChecker_Env.debug - env - (FStar_Options.Other - "LogTypes") in + FStar_Compiler_Effect.op_Bang + dbg_LogTypes in if uu___8 then let uu___9 = @@ -3036,7 +3442,7 @@ let (mk_discriminator_and_indexed_projectors : let uu___9 = let uu___10 = FStar_Syntax_Syntax.lid_and_dd_as_fv - field_name dd + field_name FStar_Pervasives_Native.None in FStar_Pervasives.Inr uu___10 in @@ -3098,10 +3504,8 @@ let (mk_discriminator_and_indexed_projectors : FStar_Pervasives_Native.None } in (let uu___10 = - FStar_TypeChecker_Env.debug - env - (FStar_Options.Other - "LogTypes") in + FStar_Compiler_Effect.op_Bang + dbg_LogTypes in if uu___10 then let uu___11 = @@ -3161,142 +3565,145 @@ let (mk_data_operations : FStar_Syntax_Syntax.us1 = uvs; FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = typ_lid; FStar_Syntax_Syntax.num_ty_params = n_typars; - FStar_Syntax_Syntax.mutuals1 = uu___;_} + FStar_Syntax_Syntax.mutuals1 = uu___; + FStar_Syntax_Syntax.injective_type_params1 = uu___1;_} -> - let uu___1 = FStar_Syntax_Subst.univ_var_opening uvs in - (match uu___1 with + let uu___2 = FStar_Syntax_Subst.univ_var_opening uvs in + (match uu___2 with | (univ_opening, uvs1) -> let t1 = FStar_Syntax_Subst.subst univ_opening t in - let uu___2 = FStar_Syntax_Util.arrow_formals t1 in - (match uu___2 with - | (formals, uu___3) -> - let uu___4 = + let uu___3 = FStar_Syntax_Util.arrow_formals t1 in + (match uu___3 with + | (formals, uu___4) -> + let uu___5 = let tps_opt = FStar_Compiler_Util.find_map tcs (fun se1 -> - let uu___5 = - let uu___6 = - let uu___7 = + let uu___6 = + let uu___7 = + let uu___8 = FStar_Syntax_Util.lid_of_sigelt se1 in - FStar_Compiler_Util.must uu___7 in - FStar_Ident.lid_equals typ_lid uu___6 in - if uu___5 + FStar_Compiler_Util.must uu___8 in + FStar_Ident.lid_equals typ_lid uu___7 in + if uu___6 then match se1.FStar_Syntax_Syntax.sigel with | FStar_Syntax_Syntax.Sig_inductive_typ - { FStar_Syntax_Syntax.lid = uu___6; + { FStar_Syntax_Syntax.lid = uu___7; FStar_Syntax_Syntax.us = uvs'; FStar_Syntax_Syntax.params = tps; FStar_Syntax_Syntax.num_uniform_params - = uu___7; + = uu___8; FStar_Syntax_Syntax.t = typ0; FStar_Syntax_Syntax.mutuals = - uu___8; - FStar_Syntax_Syntax.ds = constrs;_} + uu___9; + FStar_Syntax_Syntax.ds = constrs; + FStar_Syntax_Syntax.injective_type_params + = uu___10;_} -> FStar_Pervasives_Native.Some (tps, typ0, ((FStar_Compiler_List.length constrs) > Prims.int_one)) - | uu___6 -> + | uu___7 -> FStar_Compiler_Effect.failwith "Impossible" else FStar_Pervasives_Native.None) in match tps_opt with | FStar_Pervasives_Native.Some x -> x | FStar_Pervasives_Native.None -> - let uu___5 = + let uu___6 = FStar_Ident.lid_equals typ_lid FStar_Parser_Const.exn_lid in - if uu___5 + if uu___6 then ([], FStar_Syntax_Util.ktype0, true) else FStar_Errors.raise_error (FStar_Errors_Codes.Fatal_UnexpectedDataConstructor, "Unexpected data constructor") se.FStar_Syntax_Syntax.sigrng in - (match uu___4 with + (match uu___5 with | (inductive_tps, typ0, should_refine) -> let inductive_tps1 = FStar_Syntax_Subst.subst_binders univ_opening inductive_tps in let typ01 = - let uu___5 = + let uu___6 = FStar_Syntax_Subst.shift_subst (FStar_Compiler_List.length inductive_tps1) univ_opening in - FStar_Syntax_Subst.subst uu___5 typ0 in - let uu___5 = + FStar_Syntax_Subst.subst uu___6 typ0 in + let uu___6 = FStar_Syntax_Util.arrow_formals typ01 in - (match uu___5 with - | (indices, uu___6) -> + (match uu___6 with + | (indices, uu___7) -> let refine_domain = - let uu___7 = + let uu___8 = FStar_Compiler_Util.for_some - (fun uu___8 -> - match uu___8 with + (fun uu___9 -> + match uu___9 with | FStar_Syntax_Syntax.RecordConstructor - uu___9 -> true - | uu___9 -> false) + uu___10 -> true + | uu___10 -> false) se.FStar_Syntax_Syntax.sigquals in - if uu___7 then false else should_refine in + if uu___8 then false else should_refine in let fv_qual = - let filter_records uu___7 = - match uu___7 with + let filter_records uu___8 = + match uu___8 with | FStar_Syntax_Syntax.RecordConstructor - (uu___8, fns) -> + (uu___9, fns) -> FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Record_ctor (typ_lid, fns)) - | uu___8 -> + | uu___9 -> FStar_Pervasives_Native.None in - let uu___7 = + let uu___8 = FStar_Compiler_Util.find_map se.FStar_Syntax_Syntax.sigquals filter_records in - match uu___7 with + match uu___8 with | FStar_Pervasives_Native.None -> FStar_Syntax_Syntax.Data_ctor | FStar_Pervasives_Native.Some q -> q in let fields = - let uu___7 = + let uu___8 = FStar_Compiler_Util.first_N n_typars formals in - match uu___7 with + match uu___8 with | (imp_tps, fields1) -> let rename = FStar_Compiler_List.map2 - (fun uu___8 -> - fun uu___9 -> - match (uu___8, uu___9) + (fun uu___9 -> + fun uu___10 -> + match (uu___9, uu___10) with | ({ FStar_Syntax_Syntax.binder_bv = x; FStar_Syntax_Syntax.binder_qual - = uu___10; - FStar_Syntax_Syntax.binder_positivity = uu___11; + FStar_Syntax_Syntax.binder_positivity + = uu___12; FStar_Syntax_Syntax.binder_attrs - = uu___12;_}, + = uu___13;_}, { FStar_Syntax_Syntax.binder_bv = x'; FStar_Syntax_Syntax.binder_qual - = uu___13; - FStar_Syntax_Syntax.binder_positivity = uu___14; + FStar_Syntax_Syntax.binder_positivity + = uu___15; FStar_Syntax_Syntax.binder_attrs - = uu___15;_}) + = uu___16;_}) -> - let uu___16 = - let uu___17 = + let uu___17 = + let uu___18 = FStar_Syntax_Syntax.bv_to_name x' in - (x, uu___17) in + (x, uu___18) in FStar_Syntax_Syntax.NT - uu___16) imp_tps + uu___17) imp_tps inductive_tps1 in FStar_Syntax_Subst.subst_binders rename fields1 in diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml index 6d10584120e..e1bb518cbd2 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TcTerm.ml @@ -1,4 +1,22 @@ open Prims +let (dbg_Exports : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Exports" +let (dbg_LayeredEffects : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "LayeredEffects" +let (dbg_NYC : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "NYC" +let (dbg_Patterns : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Patterns" +let (dbg_Range : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Range" +let (dbg_RelCheck : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "RelCheck" +let (dbg_RFD : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "RFD" +let (dbg_Tac : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Tac" +let (dbg_UniverseOf : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "UniverseOf" let (instantiate_both : FStar_TypeChecker_Env.env -> FStar_TypeChecker_Env.env) = fun env -> @@ -211,7 +229,9 @@ let (check_no_escape : let uu___3 = let uu___4 = let uu___5 = - let uu___6 = FStar_Syntax_Print.bv_to_string x in + let uu___6 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_bv x in FStar_Pprint.doc_of_string uu___6 in FStar_Pprint.squotes uu___5 in let uu___5 = @@ -231,7 +251,9 @@ let (check_no_escape : let uu___3 = let uu___4 = let uu___5 = - let uu___6 = FStar_Syntax_Print.bv_to_string x in + let uu___6 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_bv x in FStar_Pprint.doc_of_string uu___6 in FStar_Pprint.squotes uu___5 in let uu___5 = @@ -264,8 +286,11 @@ let (check_no_escape : let uu___2 = FStar_Compiler_List.tryFind (fun x -> - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_bv - x fvs') fvs in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) x + (Obj.magic fvs')) fvs in match uu___2 with | FStar_Pervasives_Native.None -> (t1, FStar_TypeChecker_Env.trivial_guard) @@ -515,14 +540,14 @@ let (value_check_expected_typ : lc t' use_eq in (match uu___3 with | (e1, lc1, g) -> - ((let uu___5 = - FStar_TypeChecker_Env.debug env - FStar_Options.Medium in + ((let uu___5 = FStar_Compiler_Debug.medium () in if uu___5 then let uu___6 = FStar_TypeChecker_Common.lcomp_to_string lc1 in - let uu___7 = FStar_Syntax_Print.term_to_string t' in + let uu___7 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t' in let uu___8 = FStar_TypeChecker_Rel.guard_to_string env g in let uu___9 = @@ -779,17 +804,18 @@ let (check_expected_effect : c4.FStar_Syntax_Syntax.pos "check_expected_effect.c.after_assume" env c4; - (let uu___8 = - FStar_TypeChecker_Env.debug env - FStar_Options.Medium in + (let uu___8 = FStar_Compiler_Debug.medium () in if uu___8 then let uu___9 = - FStar_Syntax_Print.term_to_string e in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e in let uu___10 = - FStar_Syntax_Print.comp_to_string c4 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_comp c4 in let uu___11 = - FStar_Syntax_Print.comp_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_comp expected_c in let uu___12 = FStar_Compiler_Util.string_of_bool @@ -806,12 +832,13 @@ let (check_expected_effect : let g1 = let uu___10 = FStar_TypeChecker_Env.get_range env in + let uu___11 = + FStar_Errors_Msg.mkmsg + "Could not prove post-condition" in FStar_TypeChecker_Util.label_guard - uu___10 - "Could not prove post-condition" g in + uu___10 uu___11 g in ((let uu___11 = - FStar_TypeChecker_Env.debug env - FStar_Options.Medium in + FStar_Compiler_Debug.medium () in if uu___11 then let uu___12 = @@ -861,7 +888,7 @@ let (print_expected_ty_str : FStar_TypeChecker_Env.env -> Prims.string) = match uu___ with | FStar_Pervasives_Native.None -> "Expected type is None" | FStar_Pervasives_Native.Some (t, use_eq) -> - let uu___1 = FStar_Syntax_Print.term_to_string t in + let uu___1 = FStar_Class_Show.show FStar_Syntax_Print.showable_term t in let uu___2 = FStar_Compiler_Util.string_of_bool use_eq in FStar_Compiler_Util.format2 "Expected type is (%s, use_eq = %s)" uu___1 uu___2 @@ -872,65 +899,95 @@ let (print_expected_ty : FStar_TypeChecker_Env.env -> unit) = let rec (get_pat_vars' : FStar_Syntax_Syntax.bv Prims.list -> Prims.bool -> - FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.bv FStar_Compiler_Set.t) + FStar_Syntax_Syntax.term -> + FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.t) = - fun all -> - fun andlist -> - fun pats -> - let pats1 = FStar_Syntax_Util.unmeta pats in - let uu___ = FStar_Syntax_Util.head_and_args pats1 in - match uu___ with - | (head, args) -> - let uu___1 = - let uu___2 = - let uu___3 = FStar_Syntax_Util.un_uinst head in - uu___3.FStar_Syntax_Syntax.n in - (uu___2, args) in - (match uu___1 with - | (FStar_Syntax_Syntax.Tm_fvar fv, uu___2) when - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.nil_lid - -> - if andlist - then - FStar_Compiler_Set.from_list FStar_Syntax_Syntax.ord_bv - all - else FStar_Compiler_Set.empty FStar_Syntax_Syntax.ord_bv () - | (FStar_Syntax_Syntax.Tm_fvar fv, - (uu___2, FStar_Pervasives_Native.Some - { FStar_Syntax_Syntax.aqual_implicit = true; - FStar_Syntax_Syntax.aqual_attributes = uu___3;_}):: - (hd, FStar_Pervasives_Native.None)::(tl, - FStar_Pervasives_Native.None)::[]) - when - FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.cons_lid - -> - let hdvs = get_pat_vars' all false hd in - let tlvs = get_pat_vars' all andlist tl in - if andlist - then - FStar_Compiler_Set.inter FStar_Syntax_Syntax.ord_bv hdvs - tlvs - else - FStar_Compiler_Set.union FStar_Syntax_Syntax.ord_bv hdvs - tlvs - | (FStar_Syntax_Syntax.Tm_fvar fv, - (uu___2, FStar_Pervasives_Native.Some - { FStar_Syntax_Syntax.aqual_implicit = true; - FStar_Syntax_Syntax.aqual_attributes = uu___3;_}):: - (pat, FStar_Pervasives_Native.None)::[]) when - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.smtpat_lid - -> FStar_Syntax_Free.names pat - | (FStar_Syntax_Syntax.Tm_fvar fv, - (subpats, FStar_Pervasives_Native.None)::[]) when - FStar_Syntax_Syntax.fv_eq_lid fv - FStar_Parser_Const.smtpatOr_lid - -> get_pat_vars' all true subpats - | uu___2 -> - FStar_Compiler_Set.empty FStar_Syntax_Syntax.ord_bv ()) + fun uu___2 -> + fun uu___1 -> + fun uu___ -> + (fun all -> + fun andlist -> + fun pats -> + let pats1 = FStar_Syntax_Util.unmeta pats in + let uu___ = FStar_Syntax_Util.head_and_args pats1 in + match uu___ with + | (head, args) -> + let uu___1 = + let uu___2 = + let uu___3 = FStar_Syntax_Util.un_uinst head in + uu___3.FStar_Syntax_Syntax.n in + (uu___2, args) in + (match uu___1 with + | (FStar_Syntax_Syntax.Tm_fvar fv, uu___2) when + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.nil_lid + -> + Obj.magic + (Obj.repr + (if andlist + then + FStar_Class_Setlike.from_list () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) all + else + FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) ())) + | (FStar_Syntax_Syntax.Tm_fvar fv, + (uu___2, FStar_Pervasives_Native.Some + { FStar_Syntax_Syntax.aqual_implicit = true; + FStar_Syntax_Syntax.aqual_attributes = uu___3;_}):: + (hd, FStar_Pervasives_Native.None)::(tl, + FStar_Pervasives_Native.None)::[]) + when + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.cons_lid + -> + Obj.magic + (Obj.repr + (let hdvs = get_pat_vars' all false hd in + let tlvs = get_pat_vars' all andlist tl in + if andlist + then + FStar_Class_Setlike.inter () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic hdvs) (Obj.magic tlvs) + else + FStar_Class_Setlike.union () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic hdvs) (Obj.magic tlvs))) + | (FStar_Syntax_Syntax.Tm_fvar fv, + (uu___2, FStar_Pervasives_Native.Some + { FStar_Syntax_Syntax.aqual_implicit = true; + FStar_Syntax_Syntax.aqual_attributes = uu___3;_}):: + (pat, FStar_Pervasives_Native.None)::[]) when + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.smtpat_lid + -> Obj.magic (Obj.repr (FStar_Syntax_Free.names pat)) + | (FStar_Syntax_Syntax.Tm_fvar fv, + (subpats, FStar_Pervasives_Native.None)::[]) when + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.smtpatOr_lid + -> + Obj.magic (Obj.repr (get_pat_vars' all true subpats)) + | uu___2 -> + Obj.magic + (Obj.repr + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) ())))) + uu___2 uu___1 uu___ let (get_pat_vars : FStar_Syntax_Syntax.bv Prims.list -> - FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.bv FStar_Compiler_Set.t) + FStar_Syntax_Syntax.term -> + FStar_Syntax_Syntax.bv FStar_Compiler_FlatSet.t) = fun all -> fun pats -> get_pat_vars' all false pats let (check_pat_fvs : FStar_Compiler_Range_Type.range -> @@ -959,8 +1016,11 @@ let (check_pat_fvs : FStar_Syntax_Syntax.binder_positivity = uu___3; FStar_Syntax_Syntax.binder_attrs = uu___4;_} -> let uu___5 = - FStar_Compiler_Set.mem FStar_Syntax_Syntax.ord_bv b - pat_vars in + FStar_Class_Setlike.mem () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) b + (Obj.magic pat_vars) in Prims.op_Negation uu___5) bs in match uu___ with | FStar_Pervasives_Native.None -> () @@ -972,7 +1032,8 @@ let (check_pat_fvs : -> let uu___4 = let uu___5 = - let uu___6 = FStar_Syntax_Print.bv_to_string x in + let uu___6 = + FStar_Class_Show.show FStar_Syntax_Print.showable_bv x in FStar_Compiler_Util.format1 "Pattern misses at least one bound variable: %s" uu___6 in (FStar_Errors_Codes.Warning_SMTPatternIllFormed, uu___5) in @@ -1062,21 +1123,25 @@ let (check_no_smt_theory_symbols : if (FStar_Compiler_List.length tlist) = Prims.int_zero then () else - (let msg = - FStar_Compiler_List.fold_left - (fun s -> - fun t1 -> - let uu___1 = - let uu___2 = FStar_Syntax_Print.term_to_string t1 in - Prims.strcat " " uu___2 in - Prims.strcat s uu___1) "" tlist in - let uu___1 = + (let uu___1 = let uu___2 = - FStar_Compiler_Util.format1 - "Pattern uses these theory symbols or terms that should not be in an smt pattern: %s" - msg in + let uu___3 = + let uu___4 = + FStar_Errors_Msg.text + "Pattern uses these theory symbols or terms that should not be in an SMT pattern:" in + let uu___5 = + let uu___6 = + let uu___7 = + let uu___8 = FStar_Pprint.break_ Prims.int_one in + FStar_Pprint.op_Hat_Hat FStar_Pprint.comma uu___8 in + FStar_Pprint.separate_map uu___7 + (FStar_Class_PP.pp FStar_Syntax_Print.pretty_term) tlist in + FStar_Pprint.group uu___6 in + FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one uu___4 + uu___5 in + [uu___3] in (FStar_Errors_Codes.Warning_SMTPatternIllFormed, uu___2) in - FStar_Errors.log_issue t.FStar_Syntax_Syntax.pos uu___1) + FStar_Errors.log_issue_doc t.FStar_Syntax_Syntax.pos uu___1) let (check_smt_pat : FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax -> @@ -1224,12 +1289,12 @@ let (guard_letrecs : (env.FStar_TypeChecker_Env.core_check) } in let decreases_clause bs c = - (let uu___1 = - FStar_TypeChecker_Env.debug env1 FStar_Options.Low in + (let uu___1 = FStar_Compiler_Debug.low () in if uu___1 then let uu___2 = FStar_Syntax_Print.binders_to_string ", " bs in - let uu___3 = FStar_Syntax_Print.comp_to_string c in + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_comp c in FStar_Compiler_Util.print2 "Building a decreases clause over (%s) and %s\n" uu___2 uu___3 @@ -1305,8 +1370,10 @@ let (guard_letrecs : FStar_Syntax_Util.unrefine uu___ in let rec warn t11 t21 = let uu___ = - let uu___1 = FStar_Syntax_Util.eq_tm t11 t21 in - uu___1 = FStar_Syntax_Util.Equal in + let uu___1 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env2 t11 + t21 in + uu___1 = FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___ then false else @@ -1357,7 +1424,10 @@ let (guard_letrecs : | (uu___3, FStar_Syntax_Syntax.Tm_uvar uu___4) -> false | (uu___3, uu___4) -> true) in - (let uu___1 = should_warn && (warn t1 t2) in + (let uu___1 = + ((Prims.op_Negation env2.FStar_TypeChecker_Env.phase1) + && should_warn) + && (warn t1 t2) in if uu___1 then let uu___2 = @@ -1377,25 +1447,86 @@ let (guard_letrecs : let uu___7 = let uu___8 = let uu___9 = - FStar_Syntax_Print.term_to_string e1 in + FStar_Errors_Msg.text + "In the decreases clause for this function, the SMT solver may not be able to prove that the types of" in let uu___10 = - FStar_Compiler_Range_Ops.string_of_range - e1.FStar_Syntax_Syntax.pos in + let uu___11 = + let uu___12 = + FStar_Class_PP.pp + FStar_Syntax_Print.pretty_term e1 in + let uu___13 = + let uu___14 = + let uu___15 = + FStar_Errors_Msg.text "bound in" in + let uu___16 = + FStar_Class_PP.pp + FStar_Compiler_Range_Ops.pretty_range + e1.FStar_Syntax_Syntax.pos in + FStar_Pprint.op_Hat_Slash_Hat + uu___15 uu___16 in + FStar_Pprint.parens uu___14 in + FStar_Pprint.op_Hat_Slash_Hat uu___12 + uu___13 in + FStar_Pprint.group uu___11 in + FStar_Pprint.prefix (Prims.of_int (2)) + Prims.int_one uu___9 uu___10 in + let uu___9 = + let uu___10 = + let uu___11 = FStar_Errors_Msg.text "and" in + let uu___12 = + let uu___13 = + let uu___14 = + FStar_Class_PP.pp + FStar_Syntax_Print.pretty_term e2 in + let uu___15 = + let uu___16 = + let uu___17 = + FStar_Errors_Msg.text "bound in" in + let uu___18 = + FStar_Class_PP.pp + FStar_Compiler_Range_Ops.pretty_range + e2.FStar_Syntax_Syntax.pos in + FStar_Pprint.op_Hat_Slash_Hat + uu___17 uu___18 in + FStar_Pprint.parens uu___16 in + FStar_Pprint.op_Hat_Slash_Hat uu___14 + uu___15 in + FStar_Pprint.group uu___13 in + FStar_Pprint.prefix (Prims.of_int (2)) + Prims.int_one uu___11 uu___12 in + let uu___11 = + FStar_Errors_Msg.text "are equal." in + FStar_Pprint.op_Hat_Slash_Hat uu___10 + uu___11 in + FStar_Pprint.op_Hat_Slash_Hat uu___8 uu___9 in + let uu___8 = + let uu___9 = + let uu___10 = + FStar_Errors_Msg.text + "The type of the first term is:" in + let uu___11 = + FStar_Class_PP.pp + FStar_Syntax_Print.pretty_term t1 in + FStar_Pprint.prefix (Prims.of_int (2)) + Prims.int_one uu___10 uu___11 in + let uu___10 = let uu___11 = - FStar_Syntax_Print.term_to_string t1 in + let uu___12 = + FStar_Errors_Msg.text + "The type of the second term is:" in + let uu___13 = + FStar_Class_PP.pp + FStar_Syntax_Print.pretty_term t2 in + FStar_Pprint.prefix (Prims.of_int (2)) + Prims.int_one uu___12 uu___13 in let uu___12 = - FStar_Syntax_Print.term_to_string e2 in - let uu___13 = - FStar_Compiler_Range_Ops.string_of_range - e2.FStar_Syntax_Syntax.pos in - let uu___14 = - FStar_Syntax_Print.term_to_string t2 in - FStar_Compiler_Util.format6 - "SMT may not be able to prove the types of %s at %s (%s) and %s at %s (%s) to be equal, if the proof fails, try annotating these with the same type" - uu___9 uu___10 uu___11 uu___12 uu___13 - uu___14 in - FStar_Errors_Msg.text uu___8 in - [uu___7] in + let uu___13 = + FStar_Errors_Msg.text + "If the proof fails, try annotating these with the same type." in + [uu___13] in + uu___11 :: uu___12 in + uu___9 :: uu___10 in + uu___7 :: uu___8 in (FStar_Errors_Codes.Warning_Defensive, uu___6) in FStar_Errors.log_issue_doc e1.FStar_Syntax_Syntax.pos uu___5 @@ -1495,8 +1626,10 @@ let (guard_letrecs : uu___1 :: uu___2 in FStar_Syntax_Syntax.mk_Tm_app rel uu___ r in let uu___ = - let uu___1 = FStar_Syntax_Util.eq_tm rel rel_prev in - uu___1 = FStar_Syntax_Util.Equal in + let uu___1 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env2 rel + rel_prev in + uu___1 = FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___ then rel_guard else @@ -1570,9 +1703,10 @@ let (guard_letrecs : FStar_TypeChecker_Env.push_binders env1 formals1 in mk_precedes env2 dec previous_dec in let precedes1 = - FStar_TypeChecker_Util.label - "Could not prove termination of this recursive call" - r precedes in + let uu___3 = + FStar_Errors_Msg.mkmsg + "Could not prove termination of this recursive call" in + FStar_TypeChecker_Util.label uu___3 r precedes in let uu___3 = FStar_Compiler_Util.prefix formals1 in match uu___3 with | (bs, @@ -1600,17 +1734,20 @@ let (guard_letrecs : FStar_Compiler_List.op_At bs uu___4 in let t' = FStar_Syntax_Util.arrow refined_formals c in - ((let uu___5 = - FStar_TypeChecker_Env.debug env1 - FStar_Options.Medium in + ((let uu___5 = FStar_Compiler_Debug.medium () in if uu___5 then let uu___6 = - FStar_Syntax_Print.lbname_to_string l in + FStar_Class_Show.show + (FStar_Class_Show.show_either + FStar_Syntax_Print.showable_bv + FStar_Syntax_Print.showable_fv) l in let uu___7 = - FStar_Syntax_Print.term_to_string t in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t in let uu___8 = - FStar_Syntax_Print.term_to_string t' in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t' in FStar_Compiler_Util.print3 "Refined let rec %s\n\tfrom type %s\n\tto type %s\n" uu___6 uu___7 uu___8 @@ -1679,7 +1816,7 @@ let rec (tc_term : FStar_Defensive.def_check_scoped FStar_TypeChecker_Env.hasBinders_env FStar_Class_Binders.hasNames_term FStar_Syntax_Print.pretty_term e.FStar_Syntax_Syntax.pos "tc_term.entry" env e; - (let uu___2 = FStar_TypeChecker_Env.debug env FStar_Options.Medium in + (let uu___2 = FStar_Compiler_Debug.medium () in if uu___2 then let uu___3 = @@ -1688,7 +1825,8 @@ let rec (tc_term : let uu___4 = FStar_Compiler_Util.string_of_bool env.FStar_TypeChecker_Env.phase1 in - let uu___5 = FStar_Syntax_Print.term_to_string e in + let uu___5 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term e in let uu___6 = let uu___7 = FStar_Syntax_Subst.compress e in FStar_Syntax_Print.tag_of_term uu___7 in @@ -1806,14 +1944,14 @@ let rec (tc_term : } e) in match uu___2 with | (r, ms) -> - ((let uu___4 = - FStar_TypeChecker_Env.debug env FStar_Options.Medium in + ((let uu___4 = FStar_Compiler_Debug.medium () in if uu___4 then ((let uu___6 = let uu___7 = FStar_TypeChecker_Env.get_range env in FStar_Compiler_Range_Ops.string_of_range uu___7 in - let uu___7 = FStar_Syntax_Print.term_to_string e in + let uu___7 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term e in let uu___8 = let uu___9 = FStar_Syntax_Subst.compress e in FStar_Syntax_Print.tag_of_term uu___9 in @@ -1827,7 +1965,9 @@ let rec (tc_term : let uu___8 = let uu___9 = FStar_TypeChecker_Env.get_range env in FStar_Compiler_Range_Ops.string_of_range uu___9 in - let uu___9 = FStar_Syntax_Print.term_to_string e1 in + let uu___9 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term + e1 in let uu___10 = FStar_TypeChecker_Common.lcomp_to_string lc in let uu___11 = @@ -1854,12 +1994,13 @@ and (tc_maybe_toplevel_term : FStar_Class_Binders.hasNames_term FStar_Syntax_Print.pretty_term e.FStar_Syntax_Syntax.pos "tc_maybe_toplevel_term.entry" env1 e; (let top = FStar_Syntax_Subst.compress e in - (let uu___2 = FStar_TypeChecker_Env.debug env1 FStar_Options.Medium in + (let uu___2 = FStar_Compiler_Debug.medium () in if uu___2 then let uu___3 = let uu___4 = FStar_TypeChecker_Env.get_range env1 in - FStar_Class_Show.show FStar_Compiler_Range_Ops.show_range uu___4 in + FStar_Class_Show.show FStar_Compiler_Range_Ops.showable_range + uu___4 in let uu___4 = FStar_Syntax_Print.tag_of_term top in let uu___5 = FStar_Class_Show.show FStar_Syntax_Print.showable_term top in @@ -2440,13 +2581,12 @@ and (tc_maybe_toplevel_term : FStar_Syntax_Syntax.Tm_ascribed uu___12 in FStar_Syntax_Syntax.mk uu___11 e1.FStar_Syntax_Syntax.pos in - (let uu___12 = - FStar_TypeChecker_Env.debug env0 - FStar_Options.Extreme in + (let uu___12 = FStar_Compiler_Debug.extreme () in if uu___12 then let uu___13 = - FStar_Syntax_Print.term_to_string e2 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e2 in FStar_Compiler_Util.print1 "Typechecking ascribed reflect, inner ascribed term: %s\n" uu___13 @@ -2456,12 +2596,12 @@ and (tc_maybe_toplevel_term : | (e3, uu___13, g_e) -> let e4 = FStar_Syntax_Util.unascribe e3 in ((let uu___15 = - FStar_TypeChecker_Env.debug env0 - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme () in if uu___15 then let uu___16 = - FStar_Syntax_Print.term_to_string e4 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e4 in let uu___17 = FStar_TypeChecker_Rel.guard_to_string env0 g_e in @@ -2603,8 +2743,7 @@ and (tc_maybe_toplevel_term : FStar_TypeChecker_Util.strengthen_precondition (FStar_Pervasives_Native.Some (fun uu___9 -> - FStar_Compiler_Util.return_all - FStar_TypeChecker_Err.ill_kinded_type)) + FStar_TypeChecker_Err.ill_kinded_type)) uu___8 e2 c f in (match uu___7 with | (c1, f1) -> @@ -2856,7 +2995,8 @@ and (tc_maybe_toplevel_term : -> let uu___6 = let uu___7 = - let uu___8 = FStar_Syntax_Print.term_to_string top in + let uu___8 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term top in FStar_Compiler_Util.format1 "Ill-applied constant %s" uu___8 in (FStar_Errors_Codes.Fatal_IllAppliedConstant, uu___7) in FStar_Errors.raise_error uu___6 e.FStar_Syntax_Syntax.pos @@ -2873,7 +3013,8 @@ and (tc_maybe_toplevel_term : -> let uu___6 = let uu___7 = - let uu___8 = FStar_Syntax_Print.term_to_string top in + let uu___8 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term top in FStar_Compiler_Util.format1 "Ill-applied constant %s" uu___8 in (FStar_Errors_Codes.Fatal_IllAppliedConstant, uu___7) in FStar_Errors.raise_error uu___6 e.FStar_Syntax_Syntax.pos @@ -3090,7 +3231,8 @@ and (tc_maybe_toplevel_term : FStar_Syntax_Print.tag_of_term expected_repr_typ in let uu___20 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term expected_repr_typ in FStar_Compiler_Util.format3 "Expected repr type for %s is not an application node (%s:%s)" @@ -3152,94 +3294,93 @@ and (tc_maybe_toplevel_term : { FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar { FStar_Syntax_Syntax.fv_name = uu___2; - FStar_Syntax_Syntax.fv_delta = uu___3; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Unresolved_constructor uc);_}; - FStar_Syntax_Syntax.pos = uu___4; - FStar_Syntax_Syntax.vars = uu___5; - FStar_Syntax_Syntax.hash_code = uu___6;_}; + FStar_Syntax_Syntax.pos = uu___3; + FStar_Syntax_Syntax.vars = uu___4; + FStar_Syntax_Syntax.hash_code = uu___5;_}; FStar_Syntax_Syntax.args = args;_} -> - let uu___7 = - let uu___8 = + let uu___6 = + let uu___7 = if uc.FStar_Syntax_Syntax.uc_base_term then match args with - | (b, uu___9)::rest -> + | (b, uu___8)::rest -> ((FStar_Pervasives_Native.Some b), rest) - | uu___9 -> FStar_Compiler_Effect.failwith "Impossible" + | uu___8 -> FStar_Compiler_Effect.failwith "Impossible" else (FStar_Pervasives_Native.None, args) in - match uu___8 with + match uu___7 with | (base_term, fields) -> if (FStar_Compiler_List.length uc.FStar_Syntax_Syntax.uc_fields) <> (FStar_Compiler_List.length fields) then - let uu___9 = - let uu___10 = - let uu___11 = + let uu___8 = + let uu___9 = + let uu___10 = FStar_Class_Show.show (FStar_Class_Show.printableshow FStar_Class_Printable.printable_nat) (FStar_Compiler_List.length uc.FStar_Syntax_Syntax.uc_fields) in - let uu___12 = + let uu___11 = FStar_Class_Show.show (FStar_Class_Show.printableshow FStar_Class_Printable.printable_nat) (FStar_Compiler_List.length fields) in FStar_Compiler_Util.format2 "Could not resolve constructor; expected %s fields but only found %s" - uu___11 uu___12 in - (FStar_Errors_Codes.Fatal_IdentifierNotFound, uu___10) in - FStar_Errors.raise_error uu___9 + uu___10 uu___11 in + (FStar_Errors_Codes.Fatal_IdentifierNotFound, uu___9) in + FStar_Errors.raise_error uu___8 top.FStar_Syntax_Syntax.pos else - (let uu___10 = - let uu___11 = + (let uu___9 = + let uu___10 = FStar_Compiler_List.map FStar_Pervasives_Native.fst fields in FStar_Compiler_List.zip - uc.FStar_Syntax_Syntax.uc_fields uu___11 in - (base_term, uu___10)) in - (match uu___7 with + uc.FStar_Syntax_Syntax.uc_fields uu___10 in + (base_term, uu___9)) in + (match uu___6 with | (base_term, uc_fields) -> - let uu___8 = - let uu___9 = FStar_TypeChecker_Env.expected_typ env1 in - match uu___9 with - | FStar_Pervasives_Native.Some (t, uu___10) -> - let uu___11 = + let uu___7 = + let uu___8 = FStar_TypeChecker_Env.expected_typ env1 in + match uu___8 with + | FStar_Pervasives_Native.Some (t, uu___9) -> + let uu___10 = FStar_TypeChecker_Util.find_record_or_dc_from_typ env1 (FStar_Pervasives_Native.Some t) uc top.FStar_Syntax_Syntax.pos in - (uu___11, + (uu___10, (FStar_Pervasives_Native.Some (FStar_Pervasives.Inl t))) | FStar_Pervasives_Native.None -> (match base_term with | FStar_Pervasives_Native.Some e1 -> - let uu___10 = tc_term env1 e1 in - (match uu___10 with - | (uu___11, lc, uu___12) -> - let uu___13 = + let uu___9 = tc_term env1 e1 in + (match uu___9 with + | (uu___10, lc, uu___11) -> + let uu___12 = FStar_TypeChecker_Util.find_record_or_dc_from_typ env1 (FStar_Pervasives_Native.Some (lc.FStar_TypeChecker_Common.res_typ)) uc top.FStar_Syntax_Syntax.pos in - (uu___13, + (uu___12, (FStar_Pervasives_Native.Some (FStar_Pervasives.Inr (lc.FStar_TypeChecker_Common.res_typ))))) | FStar_Pervasives_Native.None -> - let uu___10 = + let uu___9 = FStar_TypeChecker_Util.find_record_or_dc_from_typ env1 FStar_Pervasives_Native.None uc top.FStar_Syntax_Syntax.pos in - (uu___10, FStar_Pervasives_Native.None)) in - (match uu___8 with + (uu___9, FStar_Pervasives_Native.None)) in + (match uu___7 with | ((rdc, constrname, constructor), topt) -> let rdc1 = rdc in let constructor1 = @@ -3256,10 +3397,10 @@ and (tc_maybe_toplevel_term : (constrname, i)) else FStar_Pervasives_Native.None in let candidate = - let uu___9 = + let uu___8 = FStar_Ident.set_lid_range projname x.FStar_Syntax_Syntax.pos in - FStar_Syntax_Syntax.fvar uu___9 qual in + FStar_Syntax_Syntax.fvar uu___8 qual in FStar_Syntax_Syntax.mk_Tm_app candidate [(x, FStar_Pervasives_Native.None)] x.FStar_Syntax_Syntax.pos in @@ -3269,9 +3410,9 @@ and (tc_maybe_toplevel_term : (fun field_name -> match base_term with | FStar_Pervasives_Native.Some x -> - let uu___9 = mk_field_projector field_name x in - FStar_Pervasives_Native.Some uu___9 - | uu___9 -> FStar_Pervasives_Native.None) + let uu___8 = mk_field_projector field_name x in + FStar_Pervasives_Native.Some uu___8 + | uu___8 -> FStar_Pervasives_Native.None) top.FStar_Syntax_Syntax.pos in let args1 = FStar_Compiler_List.map @@ -3289,27 +3430,26 @@ and (tc_maybe_toplevel_term : FStar_Syntax_Syntax.fv_name = { FStar_Syntax_Syntax.v = field_name; FStar_Syntax_Syntax.p = uu___2;_}; - FStar_Syntax_Syntax.fv_delta = uu___3; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Unresolved_projector candidate);_}; - FStar_Syntax_Syntax.pos = uu___4; - FStar_Syntax_Syntax.vars = uu___5; - FStar_Syntax_Syntax.hash_code = uu___6;_}; + FStar_Syntax_Syntax.pos = uu___3; + FStar_Syntax_Syntax.vars = uu___4; + FStar_Syntax_Syntax.hash_code = uu___5;_}; FStar_Syntax_Syntax.args = (e1, FStar_Pervasives_Native.None)::rest;_} -> let proceed_with choice = match choice with | FStar_Pervasives_Native.None -> - let uu___7 = - let uu___8 = - let uu___9 = FStar_Ident.string_of_lid field_name in + let uu___6 = + let uu___7 = + let uu___8 = FStar_Ident.string_of_lid field_name in FStar_Compiler_Util.format1 - "Field name %s could not be resolved" uu___9 in - (FStar_Errors_Codes.Fatal_IdentifierNotFound, uu___8) in - let uu___8 = FStar_Ident.range_of_lid field_name in - FStar_Errors.raise_error uu___7 uu___8 + "Field name %s could not be resolved" uu___8 in + (FStar_Errors_Codes.Fatal_IdentifierNotFound, uu___7) in + let uu___7 = FStar_Ident.range_of_lid field_name in + FStar_Errors.raise_error uu___6 uu___7 | FStar_Pervasives_Native.Some choice1 -> let f = FStar_Syntax_Syntax.fv_to_tm choice1 in let term = @@ -3317,55 +3457,57 @@ and (tc_maybe_toplevel_term : ((e1, FStar_Pervasives_Native.None) :: rest) top.FStar_Syntax_Syntax.pos in tc_term env1 term in - let uu___7 = - let uu___8 = FStar_TypeChecker_Env.clear_expected_typ env1 in - match uu___8 with | (env2, uu___9) -> tc_term env2 e1 in - (match uu___7 with - | (uu___8, lc, uu___9) -> + let uu___6 = + let uu___7 = FStar_TypeChecker_Env.clear_expected_typ env1 in + match uu___7 with | (env2, uu___8) -> tc_term env2 e1 in + (match uu___6 with + | (uu___7, lc, uu___8) -> let t0 = FStar_TypeChecker_Normalize.unfold_whnf' [FStar_TypeChecker_Env.Unascribe; FStar_TypeChecker_Env.Unmeta; FStar_TypeChecker_Env.Unrefine] env1 lc.FStar_TypeChecker_Common.res_typ in - let uu___10 = FStar_Syntax_Util.head_and_args t0 in - (match uu___10 with - | (thead, uu___11) -> - ((let uu___13 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "RFD") in - if uu___13 + let uu___9 = FStar_Syntax_Util.head_and_args t0 in + (match uu___9 with + | (thead, uu___10) -> + ((let uu___12 = FStar_Compiler_Effect.op_Bang dbg_RFD in + if uu___12 then - let uu___14 = - FStar_Syntax_Print.term_to_string + let uu___13 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term lc.FStar_TypeChecker_Common.res_typ in - let uu___15 = FStar_Syntax_Print.term_to_string t0 in - let uu___16 = - FStar_Syntax_Print.term_to_string thead in + let uu___14 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t0 in + let uu___15 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term thead in FStar_Compiler_Util.print3 "Got lc.res_typ=%s; t0 = %s; thead = %s\n" - uu___14 uu___15 uu___16 + uu___13 uu___14 uu___15 else ()); - (let uu___13 = - let uu___14 = - let uu___15 = FStar_Syntax_Util.un_uinst thead in - FStar_Syntax_Subst.compress uu___15 in - uu___14.FStar_Syntax_Syntax.n in - match uu___13 with + (let uu___12 = + let uu___13 = + let uu___14 = FStar_Syntax_Util.un_uinst thead in + FStar_Syntax_Subst.compress uu___14 in + uu___13.FStar_Syntax_Syntax.n in + match uu___12 with | FStar_Syntax_Syntax.Tm_fvar type_name -> - let uu___14 = + let uu___13 = FStar_TypeChecker_Util.try_lookup_record_type env1 (type_name.FStar_Syntax_Syntax.fv_name).FStar_Syntax_Syntax.v in - (match uu___14 with + (match uu___13 with | FStar_Pervasives_Native.None -> proceed_with candidate | FStar_Pervasives_Native.Some rdc -> let i = FStar_Compiler_List.tryFind - (fun uu___15 -> - match uu___15 with - | (i1, uu___16) -> + (fun uu___14 -> + match uu___14 with + | (i1, uu___15) -> FStar_TypeChecker_Util.field_name_matches field_name rdc i1) rdc.FStar_Syntax_DsEnv.fields in @@ -3373,15 +3515,15 @@ and (tc_maybe_toplevel_term : | FStar_Pervasives_Native.None -> proceed_with candidate | FStar_Pervasives_Native.Some - (i1, uu___15) -> + (i1, uu___14) -> let constrname = - let uu___16 = - let uu___17 = + let uu___15 = + let uu___16 = FStar_Ident.ns_of_lid rdc.FStar_Syntax_DsEnv.typename in - FStar_Compiler_List.op_At uu___17 + FStar_Compiler_List.op_At uu___16 [rdc.FStar_Syntax_DsEnv.constrname] in - FStar_Ident.lid_of_ids uu___16 in + FStar_Ident.lid_of_ids uu___15 in let projname = FStar_Syntax_Util.mk_field_projector_name_from_ident constrname i1 in @@ -3393,17 +3535,17 @@ and (tc_maybe_toplevel_term : (constrname, i1)) else FStar_Pervasives_Native.None in let choice = - let uu___16 = - let uu___17 = + let uu___15 = + let uu___16 = FStar_Ident.range_of_lid field_name in FStar_Ident.set_lid_range projname - uu___17 in - FStar_Syntax_Syntax.lid_as_fv uu___16 + uu___16 in + FStar_Syntax_Syntax.lid_as_fv uu___15 qual in proceed_with (FStar_Pervasives_Native.Some choice))) - | uu___14 -> proceed_with candidate)))) + | uu___13 -> proceed_with candidate)))) | FStar_Syntax_Syntax.Tm_app { FStar_Syntax_Syntax.hd = head; FStar_Syntax_Syntax.args = @@ -3467,14 +3609,14 @@ and (tc_maybe_toplevel_term : let uu___3 = FStar_TypeChecker_Env.clear_expected_typ env1 in FStar_Pervasives_Native.fst uu___3 in instantiate_both uu___2 in - ((let uu___3 = - FStar_TypeChecker_Env.debug env2 FStar_Options.High in + ((let uu___3 = FStar_Compiler_Debug.high () in if uu___3 then let uu___4 = FStar_Compiler_Range_Ops.string_of_range top.FStar_Syntax_Syntax.pos in - let uu___5 = FStar_Syntax_Print.term_to_string top in + let uu___5 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term top in let uu___6 = print_expected_ty_str env0 in FStar_Compiler_Util.print3 "(%s) Checking app %s, %s\n" uu___4 uu___5 uu___6 @@ -3539,8 +3681,7 @@ and (tc_maybe_toplevel_term : (match uu___6 with | (e2, c1, implicits) -> ((let uu___8 = - FStar_TypeChecker_Env.debug env2 - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme () in if uu___8 then let uu___9 = @@ -3561,12 +3702,12 @@ and (tc_maybe_toplevel_term : FStar_TypeChecker_Env.conj_guard gres implicits in ((let uu___10 = - FStar_TypeChecker_Env.debug env2 - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme () in if uu___10 then let uu___11 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e3 in let uu___12 = FStar_TypeChecker_Rel.guard_to_string @@ -3710,7 +3851,8 @@ and (tc_match : let uu___7 = let uu___8 = let uu___9 = - FStar_Syntax_Print.term_to_string e12 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e12 in let uu___10 = FStar_Ident.string_of_lid c11.FStar_TypeChecker_Common.eff_name in @@ -4134,8 +4276,7 @@ and (tc_match : (match uu___6 with | (e2, cres2, g_expected_type) -> ((let uu___8 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme () in if uu___8 then let uu___9 = @@ -4189,8 +4330,7 @@ and (tc_synth : "synth_by_tactic: bad application") rng in match uu___ with | (tau, atyp) -> - ((let uu___2 = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "Tac") in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Tac in if uu___2 then let uu___3 = @@ -4215,7 +4355,8 @@ and (tc_synth : (let uu___4 = let uu___5 = let uu___6 = - FStar_Syntax_Print.term_to_string t in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t in FStar_Compiler_Util.format1 "Equality ascription in synth (%s) is not yet supported, please use subtyping" uu___6 in @@ -4259,12 +4400,12 @@ and (tc_synth : (tau1.FStar_Syntax_Syntax.hash_code) } in (let uu___9 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Tac") in + FStar_Compiler_Effect.op_Bang dbg_Tac in if uu___9 then let uu___10 = - FStar_Syntax_Print.term_to_string t in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t in FStar_Compiler_Util.print1 "Got %s\n" uu___10 else ()); FStar_TypeChecker_Util.check_uvars @@ -4457,7 +4598,8 @@ and (tc_value : | FStar_Syntax_Syntax.Tm_bvar x -> let uu___ = let uu___1 = - let uu___2 = FStar_Syntax_Print.term_to_string top in + let uu___2 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term top in FStar_Compiler_Util.format1 "Violation of locally nameless convention: %s" uu___2 in (FStar_Errors_Codes.Error_IllScopedTerm, uu___1) in @@ -4486,7 +4628,9 @@ and (tc_value : then (let uu___3 = let uu___4 = - let uu___5 = FStar_Syntax_Print.term_to_string t in + let uu___5 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t in FStar_Compiler_Util.format1 "Equality ascription as an expected type for unk (:%s) is not yet supported, please use subtyping" uu___5 in @@ -4580,7 +4724,9 @@ and (tc_value : then (let uu___6 = let uu___7 = - let uu___8 = FStar_Syntax_Print.fv_to_string fv1 in + let uu___8 = + FStar_Class_Show.show FStar_Syntax_Print.showable_fv + fv1 in let uu___9 = FStar_Compiler_Util.string_of_int (FStar_Compiler_List.length us1) in @@ -4608,11 +4754,14 @@ and (tc_value : let uu___8 = let uu___9 = let uu___10 = - FStar_Syntax_Print.fv_to_string fv1 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_fv fv1 in let uu___11 = - FStar_Syntax_Print.univ_to_string ul in + FStar_Class_Show.show + FStar_Syntax_Print.showable_univ ul in let uu___12 = - FStar_Syntax_Print.univ_to_string ur in + FStar_Class_Show.show + FStar_Syntax_Print.showable_univ ur in FStar_Compiler_Util.format3 "Incompatible universe application for %s, expected %s got %s\n" uu___10 uu___11 uu___12 in @@ -4642,14 +4791,12 @@ and (tc_value : | ((us, t), range) -> let fv1 = FStar_Syntax_Syntax.set_range_of_fv fv range in (maybe_warn_on_use env1 fv1; - (let uu___3 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "Range") in + (let uu___3 = FStar_Compiler_Effect.op_Bang dbg_Range in if uu___3 then let uu___4 = let uu___5 = FStar_Syntax_Syntax.lid_of_fv fv1 in - FStar_Syntax_Print.lid_to_string uu___5 in + FStar_Class_Show.show FStar_Ident.showable_lident uu___5 in let uu___5 = FStar_Compiler_Range_Ops.string_of_range e.FStar_Syntax_Syntax.pos in @@ -4657,7 +4804,8 @@ and (tc_value : FStar_Compiler_Range_Ops.string_of_range range in let uu___7 = FStar_Compiler_Range_Ops.string_of_use_range range in - let uu___8 = FStar_Syntax_Print.term_to_string t in + let uu___8 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term t in FStar_Compiler_Util.print5 "Lookup up fvar %s at location %s (lid range = defined at %s, used at %s); got universes type %s\n" uu___4 uu___5 uu___6 uu___7 uu___8 @@ -4752,18 +4900,18 @@ and (tc_value : tc_binder env2 uu___4 in (match uu___3 with | (x2, env3, f1, u) -> - ((let uu___5 = - FStar_TypeChecker_Env.debug env3 - FStar_Options.High in + ((let uu___5 = FStar_Compiler_Debug.high () in if uu___5 then let uu___6 = FStar_Compiler_Range_Ops.string_of_range top.FStar_Syntax_Syntax.pos in let uu___7 = - FStar_Syntax_Print.term_to_string phi1 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term phi1 in let uu___8 = - FStar_Syntax_Print.bv_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_bv x2.FStar_Syntax_Syntax.binder_bv in FStar_Compiler_Util.print3 "(%s) Checking refinement formula %s; binder is %s\n" @@ -4812,12 +4960,11 @@ and (tc_value : FStar_Syntax_Syntax.rc_opt = uu___;_} -> let bs1 = FStar_TypeChecker_Util.maybe_add_implicit_binders env1 bs in - ((let uu___2 = - FStar_TypeChecker_Env.debug env1 FStar_Options.Medium in + ((let uu___2 = FStar_Compiler_Debug.medium () in if uu___2 then let uu___3 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show FStar_Syntax_Print.showable_term { FStar_Syntax_Syntax.n = (FStar_Syntax_Syntax.Tm_abs @@ -4838,7 +4985,8 @@ and (tc_value : match uu___2 with | (bs2, body1) -> tc_abs env1 top bs2 body1)) | uu___ -> let uu___1 = - let uu___2 = FStar_Syntax_Print.term_to_string top in + let uu___2 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term top in let uu___3 = FStar_Syntax_Print.tag_of_term top in FStar_Compiler_Util.format2 "Unexpected value: %s (%s)" uu___2 uu___3 in @@ -5272,7 +5420,9 @@ and (tc_universe : else (let uu___2 = let uu___3 = - let uu___4 = FStar_Syntax_Print.univ_to_string u2 in + let uu___4 = + FStar_Class_Show.show FStar_Syntax_Print.showable_univ + u2 in Prims.strcat uu___4 " not found" in Prims.strcat "Universe variable " uu___3 in FStar_Compiler_Effect.failwith uu___2) in @@ -5960,12 +6110,14 @@ and (tc_abs_check_binders : let uu___2 = (Prims.op_Negation (special imp imp')) && (let uu___3 = FStar_Syntax_Util.eq_bqual imp imp' in - uu___3 <> FStar_Syntax_Util.Equal) in + Prims.op_Negation uu___3) in if uu___2 then let uu___3 = let uu___4 = - let uu___5 = FStar_Syntax_Print.bv_to_string hd in + let uu___5 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_bv hd in FStar_Compiler_Util.format1 "Inconsistent implicit argument annotation on argument %s" uu___5 in @@ -5991,7 +6143,9 @@ and (tc_abs_check_binders : then let uu___4 = let uu___5 = - let uu___6 = FStar_Syntax_Print.bv_to_string hd in + let uu___6 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_bv hd in FStar_Compiler_Util.format3 "Inconsistent positivity qualifier on argument %s; Expected qualifier %s, found qualifier %s" uu___6 @@ -6016,13 +6170,12 @@ and (tc_abs_check_binders : (expected_t, FStar_TypeChecker_Env.trivial_guard) | uu___5 -> - ((let uu___7 = - FStar_TypeChecker_Env.debug env1 - FStar_Options.High in + ((let uu___7 = FStar_Compiler_Debug.high () in if uu___7 then let uu___8 = - FStar_Syntax_Print.bv_to_string hd in + FStar_Class_Show.show + FStar_Syntax_Print.showable_bv hd in FStar_Compiler_Util.print1 "Checking binder %s\n" uu___8 else ()); @@ -6033,10 +6186,12 @@ and (tc_abs_check_binders : | (t, uu___8, g1_env) -> let g2_env = let label_guard g = + let uu___9 = + FStar_Errors_Msg.mkmsg + "Type annotation on parameter incompatible with the expected type" in FStar_TypeChecker_Util.label_guard (hd.FStar_Syntax_Syntax.sort).FStar_Syntax_Syntax.pos - "Type annotation on parameter incompatible with the expected type" - g in + uu___9 g in let uu___9 = FStar_TypeChecker_Rel.teq_nosmt env1 t expected_t in @@ -6066,7 +6221,7 @@ and (tc_abs_check_binders : let uu___13 = FStar_TypeChecker_Env.get_range env1 in - FStar_Errors.raise_error + FStar_Errors.raise_error_doc uu___12 uu___13 | FStar_Pervasives_Native.Some g_env -> label_guard g_env) in @@ -6092,9 +6247,10 @@ and (tc_abs_check_binders : FStar_Compiler_List.existsb (fun attr -> let uu___5 = - FStar_Syntax_Util.eq_tm attr - attr' in - uu___5 = FStar_Syntax_Util.Equal) + FStar_TypeChecker_TermEqAndSimplify.eq_tm + env1 attr attr' in + uu___5 = + FStar_TypeChecker_TermEqAndSimplify.Equal) attrs1 in Prims.op_Negation uu___4) attrs'1 in FStar_Compiler_List.op_At attrs1 diff in @@ -6165,15 +6321,16 @@ and (tc_abs : let uu___ = FStar_TypeChecker_Env.clear_expected_typ env in match uu___ with | (env1, topt) -> - ((let uu___2 = - FStar_TypeChecker_Env.debug env1 FStar_Options.High in + ((let uu___2 = FStar_Compiler_Debug.high () in if uu___2 then let uu___3 = match topt with | FStar_Pervasives_Native.None -> "None" | FStar_Pervasives_Native.Some (t, use_eq) -> - let uu___4 = FStar_Syntax_Print.term_to_string t in + let uu___4 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t in let uu___5 = let uu___6 = FStar_Compiler_Util.string_of_bool use_eq in @@ -6192,21 +6349,21 @@ and (tc_abs : match uu___2 with | (tfun_opt, bs1, letrec_binders, c_opt, envbody, body1, g_env) -> - ((let uu___4 = - FStar_TypeChecker_Env.debug env1 - FStar_Options.Extreme in + ((let uu___4 = FStar_Compiler_Debug.extreme () in if uu___4 then let uu___5 = match tfun_opt with | FStar_Pervasives_Native.None -> "None" | FStar_Pervasives_Native.Some t -> - FStar_Syntax_Print.term_to_string t in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t in let uu___6 = match c_opt with | FStar_Pervasives_Native.None -> "None" | FStar_Pervasives_Native.Some t -> - FStar_Syntax_Print.comp_to_string t in + FStar_Class_Show.show + FStar_Syntax_Print.showable_comp t in let uu___7 = let uu___8 = FStar_TypeChecker_Env.expected_typ envbody in @@ -6214,7 +6371,8 @@ and (tc_abs : | FStar_Pervasives_Native.None -> "None" | FStar_Pervasives_Native.Some (t, use_eq) -> let uu___9 = - FStar_Syntax_Print.term_to_string t in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t in let uu___10 = let uu___11 = FStar_Compiler_Util.string_of_bool use_eq in @@ -6224,9 +6382,7 @@ and (tc_abs : "After expected_function_typ, tfun_opt: %s, c_opt: %s, and expected type in envbody: %s\n" uu___5 uu___6 uu___7 else ()); - (let uu___5 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "NYC") in + (let uu___5 = FStar_Compiler_Effect.op_Bang dbg_NYC in if uu___5 then let uu___6 = @@ -6472,9 +6628,7 @@ and (tc_abs : (body3, cbody1, uu___10)))) in match uu___5 with | (body2, cbody, guard_body) -> - ((let uu___7 = - FStar_TypeChecker_Env.debug env1 - FStar_Options.Extreme in + ((let uu___7 = FStar_Compiler_Debug.extreme () in if uu___7 then let uu___8 = @@ -6486,9 +6640,7 @@ and (tc_abs : (let guard_body1 = if env1.FStar_TypeChecker_Env.top_level then - ((let uu___8 = - FStar_TypeChecker_Env.debug env1 - FStar_Options.Medium in + ((let uu___8 = FStar_Compiler_Debug.medium () in if uu___8 then let uu___9 = @@ -6540,7 +6692,8 @@ and (tc_abs : let uu___12 = let uu___13 = let uu___14 = - FStar_Syntax_Print.binder_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_binder b in FStar_Compiler_Util.format1 "Binder %s is marked unused, but its use in the definition is not" @@ -6568,7 +6721,8 @@ and (tc_abs : let uu___12 = let uu___13 = let uu___14 = - FStar_Syntax_Print.binder_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_binder b in FStar_Compiler_Util.format1 "Binder %s is marked strictly positive, but its use in the definition is not" @@ -6656,16 +6810,22 @@ and (check_application_args : let n_args = FStar_Compiler_List.length args in let r = FStar_TypeChecker_Env.get_range env in let thead = FStar_Syntax_Util.comp_result chead in - (let uu___1 = - FStar_TypeChecker_Env.debug env FStar_Options.High in + (let uu___1 = FStar_Compiler_Debug.high () in if uu___1 then let uu___2 = - FStar_Compiler_Range_Ops.string_of_range + FStar_Class_Show.show + FStar_Compiler_Range_Ops.showable_range head.FStar_Syntax_Syntax.pos in - let uu___3 = FStar_Syntax_Print.term_to_string thead in - FStar_Compiler_Util.print2 "(%s) Type of head is %s\n" - uu___2 uu___3 + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term + thead in + let uu___4 = + FStar_Class_Show.show FStar_Syntax_Print.showable_args + args in + FStar_Compiler_Util.print3 + "(%s) Type of head is %s\nArgs = %s\n" uu___2 uu___3 + uu___4 else ()); (let monadic_application uu___1 subst arg_comps_rev arg_rets_rev guard fvs bs = @@ -6704,12 +6864,12 @@ and (check_application_args : (match uu___4 with | (cres2, guard2) -> ((let uu___6 = - FStar_TypeChecker_Env.debug env - FStar_Options.Medium in + FStar_Compiler_Debug.medium () in if uu___6 then let uu___7 = - FStar_Syntax_Print.comp_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_comp cres2 in FStar_Compiler_Util.print1 "\t Type of result cres is %s\n" @@ -6765,12 +6925,13 @@ and (check_application_args : if uu___8 then ((let uu___10 = - FStar_TypeChecker_Env.debug - env FStar_Options.Extreme in + FStar_Compiler_Debug.extreme + () in if uu___10 then let uu___11 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term term in FStar_Compiler_Util.print1 "(a) Monadic app: Return inserted in monadic application: %s\n" @@ -6782,12 +6943,13 @@ and (check_application_args : (uu___10, true))) else ((let uu___11 = - FStar_TypeChecker_Env.debug - env FStar_Options.Extreme in + FStar_Compiler_Debug.extreme + () in if uu___11 then let uu___12 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term term in FStar_Compiler_Util.print1 "(a) Monadic app: No return inserted in monadic application: %s\n" @@ -6841,9 +7003,8 @@ and (check_application_args : ((e, q), x, c)) -> ((let uu___12 = - FStar_TypeChecker_Env.debug - env - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme + () in if uu___12 then let uu___13 @@ -6856,11 +7017,13 @@ and (check_application_args : | FStar_Pervasives_Native.Some x1 -> - FStar_Syntax_Print.bv_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_bv x1 in let uu___14 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e in let uu___15 = @@ -6930,13 +7093,13 @@ and (check_application_args : env arg_rets_names_opt in ((let uu___11 = - FStar_TypeChecker_Env.debug - env1 - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme + () in if uu___11 then let uu___12 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term head1 in let uu___13 = FStar_TypeChecker_Common.lcomp_to_string @@ -7016,13 +7179,13 @@ and (check_application_args : | ((e, q), uu___11, c) -> ((let uu___13 = - FStar_TypeChecker_Env.debug - env - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme + () in if uu___13 then let uu___14 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e in let uu___15 = FStar_TypeChecker_Common.lcomp_to_string @@ -7039,9 +7202,8 @@ and (check_application_args : then ((let uu___15 = - FStar_TypeChecker_Env.debug - env - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme + () in if uu___15 then FStar_Compiler_Util.print_string @@ -7091,15 +7253,18 @@ and (check_application_args : = let uu___18 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e in let uu___19 = - FStar_Ident.string_of_lid + FStar_Class_Show.show + FStar_Ident.showable_lident c.FStar_TypeChecker_Common.eff_name in let uu___20 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term head1 in FStar_Compiler_Util.format3 "Effectful argument %s (%s) to erased function %s, consider let binding it" @@ -7114,9 +7279,8 @@ and (check_application_args : else (); (let uu___17 = - FStar_TypeChecker_Env.debug - env - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme + () in if uu___17 then FStar_Compiler_Util.print_string @@ -7262,13 +7426,13 @@ and (check_application_args : (match uu___8 with | (comp1, g) -> ((let uu___10 = - FStar_TypeChecker_Env.debug - env - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme + () in if uu___10 then let uu___11 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term app in let uu___12 = FStar_TypeChecker_Common.lcomp_to_string @@ -7512,21 +7676,27 @@ and (check_application_args : (x.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = targ } in - ((let uu___4 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + ((let uu___4 = FStar_Compiler_Debug.extreme () in if uu___4 then - let uu___5 = FStar_Syntax_Print.bv_to_string x1 in + let uu___5 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_bv x1 in let uu___6 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term x1.FStar_Syntax_Syntax.sort in let uu___7 = - FStar_Syntax_Print.term_to_string e in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e in let uu___8 = - FStar_Syntax_Print.subst_to_string subst in + FStar_Class_Show.show + (FStar_Class_Show.show_list + FStar_Syntax_Print.showable_subst_elt) + subst in let uu___9 = - FStar_Syntax_Print.term_to_string targ in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term targ in FStar_Compiler_Util.print5 "\tFormal is %s : %s\tType of arg %s (after subst %s) = %s\n" uu___5 uu___6 uu___7 uu___8 uu___9 @@ -7540,17 +7710,18 @@ and (check_application_args : let env1 = FStar_TypeChecker_Env.set_expected_typ_maybe_eq env targ1 (is_eq bqual1) in - ((let uu___6 = - FStar_TypeChecker_Env.debug env1 - FStar_Options.High in + ((let uu___6 = FStar_Compiler_Debug.high () in if uu___6 then let uu___7 = FStar_Syntax_Print.tag_of_term e in let uu___8 = - FStar_Syntax_Print.term_to_string e in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e in let uu___9 = - FStar_Syntax_Print.term_to_string targ1 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term + targ1 in let uu___10 = FStar_Compiler_Util.string_of_bool (is_eq bqual1) in @@ -7640,8 +7811,8 @@ and (check_application_args : (head1, chead2, ghead3, cres'1) in ((let uu___7 = - FStar_TypeChecker_Env.debug - env FStar_Options.Low in + FStar_Compiler_Debug.low + () in if uu___7 then FStar_Errors.log_issue @@ -7806,17 +7977,18 @@ and (check_application_args : (match uu___4 with | (cres, guard2) -> let bs_cres = FStar_Syntax_Util.arrow bs cres in - ((let uu___6 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + ((let uu___6 = FStar_Compiler_Debug.extreme () in if uu___6 then let uu___7 = - FStar_Syntax_Print.term_to_string head in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term head in let uu___8 = - FStar_Syntax_Print.term_to_string tf in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term tf in let uu___9 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term bs_cres in FStar_Compiler_Util.print3 "Forcing the type of %s from %s to %s\n" @@ -7895,16 +8067,18 @@ and (check_application_args : | (cres, guard2) -> let bs_cres = FStar_Syntax_Util.arrow bs cres in ((let uu___10 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme () in if uu___10 then let uu___11 = - FStar_Syntax_Print.term_to_string head in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term head in let uu___12 = - FStar_Syntax_Print.term_to_string tf in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term tf in let uu___13 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term bs_cres in FStar_Compiler_Util.print3 "Forcing the type of %s from %s to %s\n" @@ -7926,19 +8100,20 @@ and (check_application_args : (match uu___2 with | (bs1, c1) -> let head_info = (head, chead, ghead, c1) in - ((let uu___4 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + ((let uu___4 = FStar_Compiler_Debug.extreme () in if uu___4 then let uu___5 = - FStar_Syntax_Print.term_to_string head in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term head in let uu___6 = - FStar_Syntax_Print.term_to_string tf in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term tf in let uu___7 = FStar_Syntax_Print.binders_to_string ", " bs1 in let uu___8 = - FStar_Syntax_Print.comp_to_string c1 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_comp c1 in FStar_Compiler_Util.print4 "######tc_args of head %s @ %s with formals=%s and result type=%s\n" uu___5 uu___6 uu___7 uu___8 @@ -8130,69 +8305,83 @@ and (tc_pat : scrutinee_t in aux false uu___ in let pat_typ_ok env1 pat_t1 scrutinee_t = - (let uu___1 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "Patterns") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Patterns in if uu___1 then - let uu___2 = FStar_Syntax_Print.term_to_string pat_t1 in - let uu___3 = FStar_Syntax_Print.term_to_string scrutinee_t in + let uu___2 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term pat_t1 in + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term + scrutinee_t in FStar_Compiler_Util.print2 "$$$$$$$$$$$$pat_typ_ok? %s vs. %s\n" uu___2 uu___3 else ()); + FStar_Defensive.def_check_scoped + FStar_TypeChecker_Env.hasBinders_env + FStar_Class_Binders.hasNames_term FStar_Syntax_Print.pretty_term + pat_t1.FStar_Syntax_Syntax.pos "pat_typ_ok.pat_t.entry" env1 + pat_t1; (let fail1 msg_str = let msg = if msg_str = "" then [] - else (let uu___2 = FStar_Errors_Msg.text msg_str in [uu___2]) in + else (let uu___3 = FStar_Errors_Msg.text msg_str in [uu___3]) in let msg1 = - let uu___1 = - let uu___2 = - let uu___3 = FStar_Syntax_Print.term_to_string pat_t1 in - let uu___4 = FStar_Syntax_Print.term_to_string scrutinee_t in - FStar_Compiler_Util.format2 - "Type of pattern (%s) does not match type of scrutinee (%s)" - uu___3 uu___4 in - FStar_Errors_Msg.text uu___2 in - uu___1 :: msg in + let uu___2 = + let uu___3 = + let uu___4 = FStar_Errors_Msg.text "Type of pattern" in + let uu___5 = + FStar_Class_PP.pp FStar_Syntax_Print.pretty_term pat_t1 in + FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one + uu___4 uu___5 in + let uu___4 = + let uu___5 = + FStar_Errors_Msg.text "does not match type of scrutinee" in + let uu___6 = + FStar_Class_PP.pp FStar_Syntax_Print.pretty_term + scrutinee_t in + FStar_Pprint.prefix (Prims.of_int (2)) Prims.int_one + uu___5 uu___6 in + FStar_Pprint.op_Hat_Slash_Hat uu___3 uu___4 in + uu___2 :: msg in FStar_Errors.raise_error_doc (FStar_Errors_Codes.Fatal_MismatchedPatternType, msg1) p0.FStar_Syntax_Syntax.p in - let uu___1 = FStar_Syntax_Util.head_and_args scrutinee_t in - match uu___1 with + let uu___2 = FStar_Syntax_Util.head_and_args scrutinee_t in + match uu___2 with | (head_s, args_s) -> let pat_t2 = FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Env.Beta] env1 pat_t1 in - let uu___2 = FStar_Syntax_Util.un_uinst head_s in - (match uu___2 with + let uu___3 = FStar_Syntax_Util.un_uinst head_s in + (match uu___3 with | { FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar - uu___3; - FStar_Syntax_Syntax.pos = uu___4; - FStar_Syntax_Syntax.vars = uu___5; - FStar_Syntax_Syntax.hash_code = uu___6;_} -> - let uu___7 = FStar_Syntax_Util.head_and_args pat_t2 in - (match uu___7 with + uu___4; + FStar_Syntax_Syntax.pos = uu___5; + FStar_Syntax_Syntax.vars = uu___6; + FStar_Syntax_Syntax.hash_code = uu___7;_} -> + let uu___8 = FStar_Syntax_Util.head_and_args pat_t2 in + (match uu___8 with | (head_p, args_p) -> - let uu___8 = + let uu___9 = FStar_TypeChecker_Rel.teq_nosmt_force env1 head_p head_s in - if uu___8 + if uu___9 then - let uu___9 = - let uu___10 = FStar_Syntax_Util.un_uinst head_p in - uu___10.FStar_Syntax_Syntax.n in - (match uu___9 with + let uu___10 = + let uu___11 = FStar_Syntax_Util.un_uinst head_p in + uu___11.FStar_Syntax_Syntax.n in + (match uu___10 with | FStar_Syntax_Syntax.Tm_fvar f -> - ((let uu___11 = - let uu___12 = - let uu___13 = + ((let uu___12 = + let uu___13 = + let uu___14 = FStar_Syntax_Syntax.lid_of_fv f in FStar_TypeChecker_Env.is_type_constructor - env1 uu___13 in - Prims.op_Negation uu___12 in - if uu___11 + env1 uu___14 in + Prims.op_Negation uu___13 in + if uu___12 then fail1 "Pattern matching a non-inductive type" @@ -8202,53 +8391,55 @@ and (tc_pat : (FStar_Compiler_List.length args_s) then fail1 "" else (); - (let uu___12 = - let uu___13 = - let uu___14 = + (let uu___13 = + let uu___14 = + let uu___15 = FStar_Syntax_Syntax.lid_of_fv f in FStar_TypeChecker_Env.num_inductive_ty_params - env1 uu___14 in - match uu___13 with + env1 uu___15 in + match uu___14 with | FStar_Pervasives_Native.None -> (args_p, args_s) | FStar_Pervasives_Native.Some n -> - let uu___14 = + let uu___15 = FStar_Compiler_Util.first_N n args_p in - (match uu___14 with - | (params_p, uu___15) -> - let uu___16 = + (match uu___15 with + | (params_p, uu___16) -> + let uu___17 = FStar_Compiler_Util.first_N n args_s in - (match uu___16 with - | (params_s, uu___17) -> + (match uu___17 with + | (params_s, uu___18) -> (params_p, params_s))) in - match uu___12 with + match uu___13 with | (params_p, params_s) -> FStar_Compiler_List.fold_left2 (fun out -> - fun uu___13 -> - fun uu___14 -> - match (uu___13, uu___14) with - | ((p, uu___15), (s, uu___16)) + fun uu___14 -> + fun uu___15 -> + match (uu___14, uu___15) with + | ((p, uu___16), (s, uu___17)) -> - let uu___17 = + let uu___18 = FStar_TypeChecker_Rel.teq_nosmt env1 p s in - (match uu___17 with + (match uu___18 with | FStar_Pervasives_Native.None -> - let uu___18 = - let uu___19 = - FStar_Syntax_Print.term_to_string - p in + let uu___19 = let uu___20 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term + p in + let uu___21 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term s in FStar_Compiler_Util.format2 "Parameter %s <> Parameter %s" - uu___19 uu___20 in - fail1 uu___18 + uu___20 uu___21 in + fail1 uu___19 | FStar_Pervasives_Native.Some g -> let g1 = @@ -8258,21 +8449,23 @@ and (tc_pat : g1 out)) FStar_TypeChecker_Env.trivial_guard params_p params_s)) - | uu___10 -> + | uu___11 -> fail1 "Pattern matching a non-inductive type") else - (let uu___10 = - let uu___11 = - FStar_Syntax_Print.term_to_string head_p in + (let uu___11 = let uu___12 = - FStar_Syntax_Print.term_to_string head_s in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term head_p in + let uu___13 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term head_s in FStar_Compiler_Util.format2 - "Head mismatch %s vs %s" uu___11 uu___12 in - fail1 uu___10)) - | uu___3 -> - let uu___4 = + "Head mismatch %s vs %s" uu___12 uu___13 in + fail1 uu___11)) + | uu___4 -> + let uu___5 = FStar_TypeChecker_Rel.teq_nosmt env1 pat_t2 scrutinee_t in - (match uu___4 with + (match uu___5 with | FStar_Pervasives_Native.None -> fail1 "" | FStar_Pervasives_Native.Some g -> let g1 = @@ -8600,13 +8793,13 @@ and (tc_pat : formals args)))) | uu___1 -> fail "Not a simple pattern") in let rec check_nested_pattern env1 p t = - (let uu___1 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "Patterns") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Patterns in if uu___1 then - let uu___2 = FStar_Syntax_Print.pat_to_string p in - let uu___3 = FStar_Syntax_Print.term_to_string t in + let uu___2 = + FStar_Class_Show.show FStar_Syntax_Print.showable_pat p in + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term t in FStar_Compiler_Util.print2 "Checking pattern %s at type %s\n" uu___2 uu___3 else ()); @@ -8677,7 +8870,8 @@ and (tc_pat : match p.FStar_Syntax_Syntax.v with | FStar_Syntax_Syntax.Pat_dot_term uu___1 -> let uu___2 = - let uu___3 = FStar_Syntax_Print.pat_to_string p in + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_pat p in FStar_Compiler_Util.format1 "Impossible: Expected an undecorated pattern, got %s" uu___3 in @@ -8706,7 +8900,9 @@ and (tc_pat : | FStar_Const.Const_string uu___2 -> () | uu___2 -> let uu___3 = - let uu___4 = FStar_Syntax_Print.const_to_string c in + let uu___4 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_const c in FStar_Compiler_Util.format1 "Pattern matching a constant that does not have decidable equality: %s" uu___4 in @@ -8733,10 +8929,12 @@ and (tc_pat : then let uu___10 = let uu___11 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term lc.FStar_TypeChecker_Common.res_typ in let uu___12 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term expected_t in FStar_Compiler_Util.format2 "Type of pattern (%s) does not match type of scrutinee (%s)" @@ -8747,17 +8945,16 @@ and (tc_pat : FStar_TypeChecker_Env.trivial_guard, false)))))) | FStar_Syntax_Syntax.Pat_cons ({ FStar_Syntax_Syntax.fv_name = uu___1; - FStar_Syntax_Syntax.fv_delta = uu___2; FStar_Syntax_Syntax.fv_qual = FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Unresolved_constructor uc);_}, us_opt, sub_pats) -> - let uu___3 = + let uu___2 = FStar_TypeChecker_Util.find_record_or_dc_from_typ env1 (FStar_Pervasives_Native.Some t) uc p.FStar_Syntax_Syntax.p in - (match uu___3 with - | (rdc, uu___4, constructor_fv) -> + (match uu___2 with + | (rdc, uu___3, constructor_fv) -> let f_sub_pats = FStar_Compiler_List.zip uc.FStar_Syntax_Syntax.uc_fields sub_pats in @@ -8766,18 +8963,18 @@ and (tc_pat : uc (FStar_Pervasives_Native.Some (FStar_Pervasives.Inl t)) rdc f_sub_pats - (fun uu___5 -> + (fun uu___4 -> let x = FStar_Syntax_Syntax.new_bv FStar_Pervasives_Native.None FStar_Syntax_Syntax.tun in - let uu___6 = - let uu___7 = + let uu___5 = + let uu___6 = FStar_Syntax_Syntax.withinfo (FStar_Syntax_Syntax.Pat_var x) p.FStar_Syntax_Syntax.p in - (uu___7, false) in - FStar_Pervasives_Native.Some uu___6) + (uu___6, false) in + FStar_Pervasives_Native.Some uu___5) p.FStar_Syntax_Syntax.p in let p1 = { @@ -8839,7 +9036,8 @@ and (tc_pat : FStar_Compiler_Range_Ops.string_of_range p.FStar_Syntax_Syntax.p in let uu___5 = - FStar_Syntax_Print.pat_to_string simple_pat in + FStar_Class_Show.show + FStar_Syntax_Print.showable_pat simple_pat in let uu___6 = FStar_Compiler_Util.string_of_int (FStar_Compiler_List.length sub_pats1) in @@ -8865,9 +9063,12 @@ and (tc_pat : FStar_Pervasives_Native.snd uu___5 in let g' = let uu___5 = + FStar_TypeChecker_Env.push_bvs env1 + simple_bvs1 in + let uu___6 = expected_pat_typ env1 p0.FStar_Syntax_Syntax.p t in - pat_typ_ok env1 simple_pat_t uu___5 in + pat_typ_ok uu___5 simple_pat_t uu___6 in let guard1 = let fml = FStar_TypeChecker_Env.guard_form guard in @@ -8901,15 +9102,16 @@ and (tc_pat : let guard2 = FStar_TypeChecker_Env.conj_guard guard1 g' in ((let uu___6 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "Patterns") in + FStar_Compiler_Effect.op_Bang dbg_Patterns in if uu___6 then let uu___7 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term simple_pat_e1 in let uu___8 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term simple_pat_t in let uu___9 = let uu___10 = @@ -8917,12 +9119,14 @@ and (tc_pat : (fun x -> let uu___11 = let uu___12 = - FStar_Syntax_Print.bv_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_bv x in let uu___13 = let uu___14 = let uu___15 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term x.FStar_Syntax_Syntax.sort in Prims.strcat uu___15 ")" in Prims.strcat " : " uu___14 in @@ -9085,11 +9289,11 @@ and (tc_pat : let uu___6 = reconstruct_nested_pat simple_pat_elab in (bvs, tms, pat_e, uu___6, g, erasable1)))))) in - (let uu___1 = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "Patterns") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Patterns in if uu___1 then - let uu___2 = FStar_Syntax_Print.pat_to_string p0 in + let uu___2 = + FStar_Class_Show.show FStar_Syntax_Print.showable_pat p0 in FStar_Compiler_Util.print1 "Checking pattern: %s\n" uu___2 else ()); (let uu___1 = @@ -9105,13 +9309,14 @@ and (tc_pat : let pat_e_norm = FStar_TypeChecker_Normalize.normalize [FStar_TypeChecker_Env.Beta] extended_env pat_e in - ((let uu___3 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Patterns") in + ((let uu___3 = FStar_Compiler_Effect.op_Bang dbg_Patterns in if uu___3 then - let uu___4 = FStar_Syntax_Print.pat_to_string pat in - let uu___5 = FStar_Syntax_Print.term_to_string pat_e in + let uu___4 = + FStar_Class_Show.show FStar_Syntax_Print.showable_pat pat in + let uu___5 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term + pat_e in FStar_Compiler_Util.print2 "Done checking pattern %s as expression %s\n" uu___4 uu___5 @@ -9157,29 +9362,22 @@ and (tc_eqn : (match uu___5 with | (pattern1, pat_bvs, pat_bv_tms, pat_env, pat_exp, norm_pat_exp, guard_pat, erasable) -> - ((let uu___7 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + ((let uu___7 = FStar_Compiler_Debug.extreme () in if uu___7 then let uu___8 = - FStar_Syntax_Print.pat_to_string pattern1 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_pat pattern1 in let uu___9 = FStar_Syntax_Print.bvs_to_string ";" pat_bvs in let uu___10 = - FStar_Compiler_List.fold_left - (fun s -> - fun t -> - let uu___11 = - let uu___12 = - FStar_Syntax_Print.term_to_string - t in - Prims.strcat ";" uu___12 in - Prims.strcat s uu___11) "" + FStar_Class_Show.show + (FStar_Class_Show.show_list + FStar_Syntax_Print.showable_term) pat_bv_tms in FStar_Compiler_Util.print3 - "tc_eqn: typechecked pattern %s with bvs %s and pat_bv_tms %s\n" + "tc_eqn: typechecked pattern %s with bvs %s and pat_bv_tms=%s\n" uu___8 uu___9 uu___10 else ()); (let uu___7 = @@ -9339,7 +9537,8 @@ and (tc_eqn : FStar_Compiler_Range_Ops.string_of_range pat_exp1.FStar_Syntax_Syntax.pos in let uu___15 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term pat_exp1 in let uu___16 = FStar_Syntax_Print.tag_of_term @@ -9370,7 +9569,8 @@ and (tc_eqn : FStar_Compiler_Range_Ops.string_of_range pattern2.FStar_Syntax_Syntax.p in let uu___15 = - FStar_Syntax_Print.pat_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_pat pattern2 in FStar_Compiler_Util.format2 "Impossible (%s): scrutinee of match is not defined %s" @@ -9606,10 +9806,12 @@ and (tc_eqn : | uu___12 -> let uu___13 = let uu___14 = - FStar_Syntax_Print.pat_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_pat pattern2 in let uu___15 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term pat_exp2 in FStar_Compiler_Util.format2 "Internal error: unexpected elaborated pattern: %s and pattern expression %s" @@ -9657,12 +9859,12 @@ and (tc_eqn : branch_guard1 w in branch_guard2) in (let uu___11 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme () in if uu___11 then let uu___12 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term branch_guard in FStar_Compiler_Util.print1 "tc_eqn: branch guard : %s\n" @@ -9880,10 +10082,8 @@ and (tc_eqn : then ((let uu___16 = - FStar_TypeChecker_Env.debug - env - (FStar_Options.Other - "LayeredEffects") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffects in if uu___16 then FStar_Compiler_Util.print_string @@ -10134,50 +10334,24 @@ and (tc_eqn : uu___16 in (let uu___17 = - FStar_TypeChecker_Env.debug - env - (FStar_Options.Other - "LayeredEffects") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffects in if uu___17 then let uu___18 = - FStar_Compiler_List.fold_left - (fun s -> - fun t -> - let uu___19 - = - let uu___20 - = - FStar_Syntax_Print.term_to_string - t in - Prims.strcat - ";" - uu___20 in - Prims.strcat - s uu___19) - "" + FStar_Class_Show.show + (FStar_Class_Show.show_list + FStar_Syntax_Print.showable_term) pat_bv_tms2 in let uu___19 = - FStar_Compiler_List.fold_left - (fun s -> - fun t -> - let uu___20 - = - let uu___21 - = - FStar_Syntax_Print.bv_to_string - t in - Prims.strcat - ";" - uu___21 in - Prims.strcat - s uu___20) - "" + FStar_Class_Show.show + (FStar_Class_Show.show_list + FStar_Syntax_Print.showable_bv) pat_bvs in FStar_Compiler_Util.print2 - "tc_eqn: typechecked pat_bv_tms %s (pat_bvs : %s)\n" + "tc_eqn: typechecked pat_bv_tms=%s (pat_bvs=%s)\n" uu___18 uu___19 else ()); @@ -10262,8 +10436,8 @@ and (tc_eqn : FStar_TypeChecker_Env.conj_guard g_when1 g_branch1 in ((let uu___13 = - FStar_TypeChecker_Env.debug - env FStar_Options.High in + FStar_Compiler_Debug.high + () in if uu___13 then let uu___14 = @@ -10376,13 +10550,12 @@ and (check_top_level_let : (uu___6, c12))) in (match uu___2 with | (e21, c12) -> - ((let uu___4 = - FStar_TypeChecker_Env.debug env1 - FStar_Options.Medium in + ((let uu___4 = FStar_Compiler_Debug.medium () in if uu___4 then let uu___5 = - FStar_Syntax_Print.term_to_string e11 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e11 in FStar_Compiler_Util.print1 "Let binding BEFORE tcnorm: %s\n" uu___5 else ()); @@ -10401,13 +10574,12 @@ and (check_top_level_let : FStar_TypeChecker_Env.DoNotUnfoldPureLets] env1 e11 else e11 in - (let uu___5 = - FStar_TypeChecker_Env.debug env1 - FStar_Options.Medium in + (let uu___5 = FStar_Compiler_Debug.medium () in if uu___5 then let uu___6 = - FStar_Syntax_Print.term_to_string e12 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e12 in FStar_Compiler_Util.print1 "Let binding AFTER tcnorm: %s\n" uu___6 else ()); @@ -10609,9 +10781,11 @@ and (check_inner_let : then let uu___4 = let uu___5 = - let uu___6 = FStar_Syntax_Print.term_to_string e1 in + let uu___6 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e1 in let uu___7 = - FStar_Syntax_Print.lid_to_string + FStar_Class_Show.show FStar_Ident.showable_lident c1.FStar_TypeChecker_Common.eff_name in FStar_Compiler_Util.format2 "Definitions marked @inline_let are expected to be pure or ghost; got an expression \"%s\" with effect \"%s\"" @@ -10648,7 +10822,8 @@ and (check_inner_let : FStar_TypeChecker_Util.strengthen_precondition (FStar_Pervasives_Native.Some (fun uu___7 -> - "folding guard g2 of e2 in the lcomp")) + FStar_Errors_Msg.mkmsg + "folding guard g2 of e2 in the lcomp")) env_x e22 c2 g2 in (match uu___6 with | (c21, g21) -> (e22, c21, g21)) in (match uu___4 with @@ -10735,14 +10910,15 @@ and (check_inner_let : FStar_Compiler_Option.get uu___7 in FStar_Pervasives_Native.fst uu___6 in ((let uu___7 = - FStar_TypeChecker_Env.debug env2 - (FStar_Options.Other "Exports") in + FStar_Compiler_Effect.op_Bang dbg_Exports in if uu___7 then let uu___8 = - FStar_Syntax_Print.term_to_string tt in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term tt in let uu___9 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term cres.FStar_TypeChecker_Common.res_typ in FStar_Compiler_Util.print2 "Got expected type from env %s\ncres.res_typ=%s\n" @@ -10757,15 +10933,17 @@ and (check_inner_let : match uu___7 with | (t, g_ex) -> ((let uu___9 = - FStar_TypeChecker_Env.debug env2 - (FStar_Options.Other "Exports") in + FStar_Compiler_Effect.op_Bang + dbg_Exports in if uu___9 then let uu___10 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term cres.FStar_TypeChecker_Common.res_typ in let uu___11 = - FStar_Syntax_Print.term_to_string t in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t in FStar_Compiler_Util.print2 "Checked %s has no escaping types; normalized to %s\n" uu___10 uu___11 @@ -11039,9 +11217,13 @@ and (check_inner_let_rec : if uu___6 then let bvss = - FStar_Compiler_Set.from_list - FStar_Syntax_Syntax.ord_bv - bvs in + Obj.magic + (FStar_Class_Setlike.from_list + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + bvs) in FStar_TypeChecker_Common.apply_lcomp (fun c -> let uu___7 = @@ -11057,13 +11239,23 @@ and (check_inner_let_rec : let uu___13 = FStar_Syntax_Free.names t in - FStar_Compiler_Set.inter - FStar_Syntax_Syntax.ord_bv - bvss - uu___13 in - FStar_Compiler_Set.is_empty - FStar_Syntax_Syntax.ord_bv - uu___12 in + Obj.magic + (FStar_Class_Setlike.inter + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic + bvss) + (Obj.magic + uu___13)) in + FStar_Class_Setlike.is_empty + () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic + uu___12) in Prims.op_Negation uu___11) uu___8 in if uu___7 @@ -11191,9 +11383,11 @@ and (build_let_rec_env : let uu___7 = FStar_Syntax_Print.tag_of_term lbdef in let uu___8 = - FStar_Syntax_Print.term_to_string lbdef in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term lbdef in let uu___9 = - FStar_Syntax_Print.term_to_string lbtyp in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term lbtyp in FStar_Compiler_Util.format3 "Only function literals with arrow types can be defined recursively; got (%s) %s : %s" uu___7 uu___8 uu___9 in @@ -11211,7 +11405,10 @@ and (build_let_rec_env : ((let uu___7 = let uu___8 = let uu___9 = - FStar_Syntax_Print.lbname_to_string lbname in + FStar_Class_Show.show + (FStar_Class_Show.show_either + FStar_Syntax_Print.showable_bv + FStar_Syntax_Print.showable_fv) lbname in Prims.strcat "Admitting termination of " uu___9 in (FStar_Errors_Codes.Warning_WarnOnUse, uu___8) in @@ -11385,15 +11582,15 @@ and (build_let_rec_env : | FStar_Pervasives_Native.Some (arity, lbdef1) -> ((let uu___7 = - FStar_TypeChecker_Env.debug env2 - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme () in if uu___7 then let uu___8 = FStar_Compiler_Util.string_of_int arity in let uu___9 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term lbdef1 in FStar_Compiler_Util.print2 "termination_check_enabled returned arity: %s and lbdef: %s\n" @@ -11595,10 +11792,14 @@ and (check_let_recs : let uu___3 = let uu___4 = let uu___5 = - FStar_Syntax_Print.lbname_to_string + FStar_Class_Show.show + (FStar_Class_Show.show_either + FStar_Syntax_Print.showable_bv + FStar_Syntax_Print.showable_fv) lb.FStar_Syntax_Syntax.lbname in let uu___6 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_term lb.FStar_Syntax_Syntax.lbdef in FStar_Compiler_Util.format2 "Only function literals may be defined recursively; %s is defined to be %s" @@ -11841,13 +12042,14 @@ and (check_let_bound_def : | (c11, guard_f) -> let g11 = FStar_TypeChecker_Env.conj_guard g1 guard_f in - ((let uu___7 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + ((let uu___7 = FStar_Compiler_Debug.extreme () in if uu___7 then let uu___8 = - FStar_Syntax_Print.lbname_to_string + FStar_Class_Show.show + (FStar_Class_Show.show_either + FStar_Syntax_Print.showable_bv + FStar_Syntax_Print.showable_fv) lb.FStar_Syntax_Syntax.lbname in let uu___9 = FStar_TypeChecker_Common.lcomp_to_string @@ -11917,8 +12119,7 @@ and (check_lbtyp : (match uu___6 with | (t2, uu___7, g) -> ((let uu___9 = - FStar_TypeChecker_Env.debug env - FStar_Options.Medium in + FStar_Compiler_Debug.medium () in if uu___9 then let uu___10 = @@ -11928,7 +12129,8 @@ and (check_lbtyp : FStar_Compiler_Range_Ops.string_of_range uu___11 in let uu___11 = - FStar_Syntax_Print.term_to_string t2 in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t2 in FStar_Compiler_Util.print2 "(%s) Checked type annotation %s\n" uu___10 uu___11 @@ -11955,15 +12157,17 @@ and (tc_binder : let uu___1 = FStar_Syntax_Util.type_u () in (match uu___1 with | (tu, u) -> - ((let uu___3 = - FStar_TypeChecker_Env.debug env FStar_Options.Extreme in + ((let uu___3 = FStar_Compiler_Debug.extreme () in if uu___3 then - let uu___4 = FStar_Syntax_Print.bv_to_string x in + let uu___4 = + FStar_Class_Show.show FStar_Syntax_Print.showable_bv x in let uu___5 = - FStar_Syntax_Print.term_to_string + FStar_Class_Show.show FStar_Syntax_Print.showable_term x.FStar_Syntax_Syntax.sort in - let uu___6 = FStar_Syntax_Print.term_to_string tu in + let uu___6 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term + tu in FStar_Compiler_Util.print3 "Checking binder %s:%s at type %s\n" uu___4 uu___5 uu___6 @@ -12002,16 +12206,16 @@ and (tc_binder : (x.FStar_Syntax_Syntax.index); FStar_Syntax_Syntax.sort = t } imp1 pqual attrs1 in - (let uu___9 = - FStar_TypeChecker_Env.debug env - FStar_Options.High in + (let uu___9 = FStar_Compiler_Debug.high () in if uu___9 then let uu___10 = - FStar_Syntax_Print.bv_to_string + FStar_Class_Show.show + FStar_Syntax_Print.showable_bv x1.FStar_Syntax_Syntax.binder_bv in let uu___11 = - FStar_Syntax_Print.term_to_string t in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t in FStar_Compiler_Util.print2 "Pushing binder %s at type %s\n" uu___10 uu___11 @@ -12026,7 +12230,7 @@ and (tc_binders : = fun env -> fun bs -> - (let uu___1 = FStar_TypeChecker_Env.debug env FStar_Options.Extreme in + (let uu___1 = FStar_Compiler_Debug.extreme () in if uu___1 then let uu___2 = FStar_Syntax_Print.binders_to_string ", " bs in @@ -12147,13 +12351,13 @@ and (tc_tot_or_gtot_term_maybe_solve_deferred : let uu___7 = FStar_TypeChecker_Err.expected_ghost_expression e1 c2 msg in - FStar_Errors.raise_error uu___7 + FStar_Errors.raise_error_doc uu___7 e1.FStar_Syntax_Syntax.pos else (let uu___8 = FStar_TypeChecker_Err.expected_pure_expression e1 c2 msg in - FStar_Errors.raise_error uu___8 + FStar_Errors.raise_error_doc uu___8 e1.FStar_Syntax_Syntax.pos)))) and (tc_tot_or_gtot_term' : FStar_TypeChecker_Env.env -> @@ -12237,11 +12441,11 @@ let (typeof_tot_or_gtot_term : fun env -> fun e -> fun must_tot -> - (let uu___1 = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "RelCheck") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_RelCheck in if uu___1 then - let uu___2 = FStar_Syntax_Print.term_to_string e in + let uu___2 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term e in FStar_Compiler_Util.print1 "Checking term %s\n" uu___2 else ()); (let env1 = @@ -12368,7 +12572,9 @@ let (typeof_tot_or_gtot_term : else (let uu___4 = let uu___5 = - let uu___6 = FStar_Syntax_Print.term_to_string e in + let uu___6 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term e in FStar_Compiler_Util.format1 "Implicit argument: Expected a total term; got a ghost term: %s" uu___6 in @@ -12389,7 +12595,8 @@ let level_of_type_fail : let uu___1 = let uu___2 = let uu___3 = - let uu___4 = FStar_Syntax_Print.term_to_string e in + let uu___4 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term e in FStar_Compiler_Util.format2 "Expected a type; got %s of type %s" uu___4 t in FStar_Errors_Msg.text uu___3 in @@ -12533,7 +12740,9 @@ let (level_of_type : let g = FStar_TypeChecker_Rel.teq env1 t1 t_u in ((match g.FStar_TypeChecker_Common.guard_f with | FStar_TypeChecker_Common.NonTrivial f -> - let uu___5 = FStar_Syntax_Print.term_to_string t1 in + let uu___5 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term t1 in level_of_type_fail env1 e uu___5 | uu___5 -> FStar_TypeChecker_Rel.force_trivial_guard env1 g); @@ -12624,19 +12833,22 @@ let rec (universe_of_aux : match uu___ with | FStar_Syntax_Syntax.Tm_bvar uu___1 -> let uu___2 = - let uu___3 = FStar_Syntax_Print.term_to_string e in + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term e in Prims.strcat "TcTerm.universe_of:Impossible (bvar/unknown/lazy) " uu___3 in FStar_Compiler_Effect.failwith uu___2 | FStar_Syntax_Syntax.Tm_unknown -> let uu___1 = - let uu___2 = FStar_Syntax_Print.term_to_string e in + let uu___2 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term e in Prims.strcat "TcTerm.universe_of:Impossible (bvar/unknown/lazy) " uu___2 in FStar_Compiler_Effect.failwith uu___1 | FStar_Syntax_Syntax.Tm_delayed uu___1 -> let uu___2 = - let uu___3 = FStar_Syntax_Print.term_to_string e in + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term e in Prims.strcat "TcTerm.universe_of:Impossible (bvar/unknown/lazy) " uu___3 in FStar_Compiler_Effect.failwith uu___2 @@ -12717,11 +12929,14 @@ let rec (universe_of_aux : let uu___9 = let uu___10 = let uu___11 = - FStar_Syntax_Print.fv_to_string fv in + FStar_Class_Show.show + FStar_Syntax_Print.showable_fv fv in let uu___12 = - FStar_Syntax_Print.univ_to_string ul in + FStar_Class_Show.show + FStar_Syntax_Print.showable_univ ul in let uu___13 = - FStar_Syntax_Print.univ_to_string ur in + FStar_Class_Show.show + FStar_Syntax_Print.showable_univ ur in FStar_Compiler_Util.format3 "Incompatible universe application for %s, expected %s got %s\n" uu___11 uu___12 uu___13 in @@ -12936,14 +13151,15 @@ let rec (universe_of_aux : (env2.FStar_TypeChecker_Env.core_check) } in ((let uu___5 = - FStar_TypeChecker_Env.debug env3 - (FStar_Options.Other "UniverseOf") in + FStar_Compiler_Effect.op_Bang dbg_UniverseOf in if uu___5 then let uu___6 = let uu___7 = FStar_TypeChecker_Env.get_range env3 in FStar_Compiler_Range_Ops.string_of_range uu___7 in - let uu___7 = FStar_Syntax_Print.term_to_string hd2 in + let uu___7 = + FStar_Class_Show.show + FStar_Syntax_Print.showable_term hd2 in FStar_Compiler_Util.print2 "%s: About to type-check %s\n" uu___6 uu___7 else ()); @@ -12967,7 +13183,9 @@ let rec (universe_of_aux : (match uu___2 with | FStar_Pervasives_Native.Some t1 -> t1 | FStar_Pervasives_Native.None -> - let uu___3 = FStar_Syntax_Print.term_to_string t in + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term + t in level_of_type_fail env e uu___3)) | FStar_Syntax_Syntax.Tm_match { FStar_Syntax_Syntax.scrutinee = uu___1; @@ -12995,10 +13213,11 @@ let (universe_of : fun e -> FStar_Errors.with_ctx "While attempting to compute a universe level" (fun uu___ -> - (let uu___2 = FStar_TypeChecker_Env.debug env FStar_Options.High in + (let uu___2 = FStar_Compiler_Debug.high () in if uu___2 then - let uu___3 = FStar_Syntax_Print.term_to_string e in + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term e in FStar_Compiler_Util.print1 "Calling universe_of_aux with %s {\n" uu___3 else ()); @@ -13007,10 +13226,11 @@ let (universe_of : FStar_Class_Binders.hasNames_term FStar_Syntax_Print.pretty_term e.FStar_Syntax_Syntax.pos "universe_of entry" env e; (let r = universe_of_aux env e in - (let uu___4 = FStar_TypeChecker_Env.debug env FStar_Options.High in + (let uu___4 = FStar_Compiler_Debug.high () in if uu___4 then - let uu___5 = FStar_Syntax_Print.term_to_string r in + let uu___5 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term r in FStar_Compiler_Util.print1 "Got result from universe_of_aux = %s }\n" uu___5 else ()); @@ -13045,12 +13265,14 @@ let rec (__typeof_tot_or_gtot_term_fastpath : match t1.FStar_Syntax_Syntax.n with | FStar_Syntax_Syntax.Tm_delayed uu___ -> let uu___1 = - let uu___2 = FStar_Syntax_Print.term_to_string t1 in + let uu___2 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term t1 in Prims.strcat "Impossible: " uu___2 in FStar_Compiler_Effect.failwith uu___1 | FStar_Syntax_Syntax.Tm_bvar uu___ -> let uu___1 = - let uu___2 = FStar_Syntax_Print.term_to_string t1 in + let uu___2 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term t1 in Prims.strcat "Impossible: " uu___2 in FStar_Compiler_Effect.failwith uu___1 | FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_reify uu___) -> diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_TermEqAndSimplify.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_TermEqAndSimplify.ml new file mode 100644 index 00000000000..3adb921da18 --- /dev/null +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_TermEqAndSimplify.ml @@ -0,0 +1,1324 @@ +open Prims +type eq_result = + | Equal + | NotEqual + | Unknown +let (uu___is_Equal : eq_result -> Prims.bool) = + fun projectee -> match projectee with | Equal -> true | uu___ -> false +let (uu___is_NotEqual : eq_result -> Prims.bool) = + fun projectee -> match projectee with | NotEqual -> true | uu___ -> false +let (uu___is_Unknown : eq_result -> Prims.bool) = + fun projectee -> match projectee with | Unknown -> true | uu___ -> false +let (injectives : Prims.string Prims.list) = + ["FStar.Int8.int_to_t"; + "FStar.Int16.int_to_t"; + "FStar.Int32.int_to_t"; + "FStar.Int64.int_to_t"; + "FStar.Int128.int_to_t"; + "FStar.UInt8.uint_to_t"; + "FStar.UInt16.uint_to_t"; + "FStar.UInt32.uint_to_t"; + "FStar.UInt64.uint_to_t"; + "FStar.UInt128.uint_to_t"; + "FStar.SizeT.uint_to_t"; + "FStar.Int8.__int_to_t"; + "FStar.Int16.__int_to_t"; + "FStar.Int32.__int_to_t"; + "FStar.Int64.__int_to_t"; + "FStar.Int128.__int_to_t"; + "FStar.UInt8.__uint_to_t"; + "FStar.UInt16.__uint_to_t"; + "FStar.UInt32.__uint_to_t"; + "FStar.UInt64.__uint_to_t"; + "FStar.UInt128.__uint_to_t"; + "FStar.SizeT.__uint_to_t"] +let (eq_inj : eq_result -> eq_result -> eq_result) = + fun r -> + fun s -> + match (r, s) with + | (Equal, Equal) -> Equal + | (NotEqual, uu___) -> NotEqual + | (uu___, NotEqual) -> NotEqual + | (uu___, uu___1) -> Unknown +let (equal_if : Prims.bool -> eq_result) = + fun uu___ -> if uu___ then Equal else Unknown +let (equal_iff : Prims.bool -> eq_result) = + fun uu___ -> if uu___ then Equal else NotEqual +let (eq_and : eq_result -> (unit -> eq_result) -> eq_result) = + fun r -> + fun s -> + let uu___ = (r = Equal) && (let uu___1 = s () in uu___1 = Equal) in + if uu___ then Equal else Unknown +let rec (eq_tm : + FStar_TypeChecker_Env.env_t -> + FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term -> eq_result) + = + fun env -> + fun t1 -> + fun t2 -> + let t11 = FStar_Syntax_Util.canon_app t1 in + let t21 = FStar_Syntax_Util.canon_app t2 in + let equal_data f1 args1 f2 args2 n_parms = + let uu___ = FStar_Syntax_Syntax.fv_eq f1 f2 in + if uu___ + then + let n1 = FStar_Compiler_List.length args1 in + let n2 = FStar_Compiler_List.length args2 in + (if (n1 = n2) && (n_parms <= n1) + then + let uu___1 = FStar_Compiler_List.splitAt n_parms args1 in + match uu___1 with + | (parms1, args11) -> + let uu___2 = FStar_Compiler_List.splitAt n_parms args2 in + (match uu___2 with + | (parms2, args21) -> + let eq_arg_list as1 as2 = + FStar_Compiler_List.fold_left2 + (fun acc -> + fun uu___3 -> + fun uu___4 -> + match (uu___3, uu___4) with + | ((a1, q1), (a2, q2)) -> + let uu___5 = eq_tm env a1 a2 in + eq_inj acc uu___5) Equal as1 as2 in + eq_arg_list args11 args21) + else Unknown) + else NotEqual in + let qual_is_inj uu___ = + match uu___ with + | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Data_ctor) -> + true + | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Record_ctor + uu___1) -> true + | uu___1 -> false in + let heads_and_args_in_case_both_data = + let uu___ = + let uu___1 = FStar_Syntax_Util.unmeta t11 in + FStar_Syntax_Util.head_and_args uu___1 in + match uu___ with + | (head1, args1) -> + let uu___1 = + let uu___2 = FStar_Syntax_Util.unmeta t21 in + FStar_Syntax_Util.head_and_args uu___2 in + (match uu___1 with + | (head2, args2) -> + let uu___2 = + let uu___3 = + let uu___4 = FStar_Syntax_Util.un_uinst head1 in + uu___4.FStar_Syntax_Syntax.n in + let uu___4 = + let uu___5 = FStar_Syntax_Util.un_uinst head2 in + uu___5.FStar_Syntax_Syntax.n in + (uu___3, uu___4) in + (match uu___2 with + | (FStar_Syntax_Syntax.Tm_fvar f, + FStar_Syntax_Syntax.Tm_fvar g) when + (qual_is_inj f.FStar_Syntax_Syntax.fv_qual) && + (qual_is_inj g.FStar_Syntax_Syntax.fv_qual) + -> + let uu___3 = + let uu___4 = FStar_Syntax_Syntax.lid_of_fv f in + FStar_TypeChecker_Env.num_datacon_non_injective_ty_params + env uu___4 in + (match uu___3 with + | FStar_Pervasives_Native.Some n -> + FStar_Pervasives_Native.Some + (f, args1, g, args2, n) + | uu___4 -> FStar_Pervasives_Native.None) + | uu___3 -> FStar_Pervasives_Native.None)) in + let t12 = FStar_Syntax_Util.unmeta t11 in + let t22 = FStar_Syntax_Util.unmeta t21 in + match ((t12.FStar_Syntax_Syntax.n), (t22.FStar_Syntax_Syntax.n)) with + | (FStar_Syntax_Syntax.Tm_bvar bv1, FStar_Syntax_Syntax.Tm_bvar bv2) + -> + equal_if + (bv1.FStar_Syntax_Syntax.index = bv2.FStar_Syntax_Syntax.index) + | (FStar_Syntax_Syntax.Tm_lazy uu___, uu___1) -> + let uu___2 = FStar_Syntax_Util.unlazy t12 in eq_tm env uu___2 t22 + | (uu___, FStar_Syntax_Syntax.Tm_lazy uu___1) -> + let uu___2 = FStar_Syntax_Util.unlazy t22 in eq_tm env t12 uu___2 + | (FStar_Syntax_Syntax.Tm_name a, FStar_Syntax_Syntax.Tm_name b) -> + let uu___ = FStar_Syntax_Syntax.bv_eq a b in equal_if uu___ + | uu___ when + FStar_Pervasives_Native.uu___is_Some + heads_and_args_in_case_both_data + -> + let uu___1 = + FStar_Compiler_Util.must heads_and_args_in_case_both_data in + (match uu___1 with + | (f, args1, g, args2, n) -> equal_data f args1 g args2 n) + | (FStar_Syntax_Syntax.Tm_fvar f, FStar_Syntax_Syntax.Tm_fvar g) -> + let uu___ = FStar_Syntax_Syntax.fv_eq f g in equal_if uu___ + | (FStar_Syntax_Syntax.Tm_uinst (f, us), FStar_Syntax_Syntax.Tm_uinst + (g, vs)) -> + let uu___ = eq_tm env f g in + eq_and uu___ + (fun uu___1 -> + let uu___2 = FStar_Syntax_Util.eq_univs_list us vs in + equal_if uu___2) + | (FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_range uu___), + FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_range uu___1)) + -> Unknown + | (FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_real r1), + FStar_Syntax_Syntax.Tm_constant (FStar_Const.Const_real r2)) -> + equal_if (r1 = r2) + | (FStar_Syntax_Syntax.Tm_constant c, FStar_Syntax_Syntax.Tm_constant + d) -> let uu___ = FStar_Const.eq_const c d in equal_iff uu___ + | (FStar_Syntax_Syntax.Tm_uvar (u1, ([], uu___)), + FStar_Syntax_Syntax.Tm_uvar (u2, ([], uu___1))) -> + let uu___2 = + FStar_Syntax_Unionfind.equiv + u1.FStar_Syntax_Syntax.ctx_uvar_head + u2.FStar_Syntax_Syntax.ctx_uvar_head in + equal_if uu___2 + | (FStar_Syntax_Syntax.Tm_app + { FStar_Syntax_Syntax.hd = h1; FStar_Syntax_Syntax.args = args1;_}, + FStar_Syntax_Syntax.Tm_app + { FStar_Syntax_Syntax.hd = h2; FStar_Syntax_Syntax.args = args2;_}) + -> + let uu___ = + let uu___1 = + let uu___2 = FStar_Syntax_Util.un_uinst h1 in + uu___2.FStar_Syntax_Syntax.n in + let uu___2 = + let uu___3 = FStar_Syntax_Util.un_uinst h2 in + uu___3.FStar_Syntax_Syntax.n in + (uu___1, uu___2) in + (match uu___ with + | (FStar_Syntax_Syntax.Tm_fvar f1, FStar_Syntax_Syntax.Tm_fvar + f2) when + (FStar_Syntax_Syntax.fv_eq f1 f2) && + (let uu___1 = + let uu___2 = FStar_Syntax_Syntax.lid_of_fv f1 in + FStar_Ident.string_of_lid uu___2 in + FStar_Compiler_List.mem uu___1 injectives) + -> equal_data f1 args1 f2 args2 Prims.int_zero + | uu___1 -> + let uu___2 = eq_tm env h1 h2 in + eq_and uu___2 (fun uu___3 -> eq_args env args1 args2)) + | (FStar_Syntax_Syntax.Tm_match + { FStar_Syntax_Syntax.scrutinee = t13; + FStar_Syntax_Syntax.ret_opt = uu___; + FStar_Syntax_Syntax.brs = bs1; + FStar_Syntax_Syntax.rc_opt1 = uu___1;_}, + FStar_Syntax_Syntax.Tm_match + { FStar_Syntax_Syntax.scrutinee = t23; + FStar_Syntax_Syntax.ret_opt = uu___2; + FStar_Syntax_Syntax.brs = bs2; + FStar_Syntax_Syntax.rc_opt1 = uu___3;_}) + -> + if + (FStar_Compiler_List.length bs1) = + (FStar_Compiler_List.length bs2) + then + let uu___4 = FStar_Compiler_List.zip bs1 bs2 in + let uu___5 = eq_tm env t13 t23 in + FStar_Compiler_List.fold_right + (fun uu___6 -> + fun a -> + match uu___6 with + | (b1, b2) -> + eq_and a (fun uu___7 -> branch_matches env b1 b2)) + uu___4 uu___5 + else Unknown + | (FStar_Syntax_Syntax.Tm_type u, FStar_Syntax_Syntax.Tm_type v) -> + let uu___ = FStar_Syntax_Util.eq_univs u v in equal_if uu___ + | (FStar_Syntax_Syntax.Tm_quoted (t13, q1), + FStar_Syntax_Syntax.Tm_quoted (t23, q2)) -> Unknown + | (FStar_Syntax_Syntax.Tm_refine + { FStar_Syntax_Syntax.b = t13; FStar_Syntax_Syntax.phi = phi1;_}, + FStar_Syntax_Syntax.Tm_refine + { FStar_Syntax_Syntax.b = t23; FStar_Syntax_Syntax.phi = phi2;_}) + -> + let uu___ = + eq_tm env t13.FStar_Syntax_Syntax.sort + t23.FStar_Syntax_Syntax.sort in + eq_and uu___ (fun uu___1 -> eq_tm env phi1 phi2) + | (FStar_Syntax_Syntax.Tm_abs + { FStar_Syntax_Syntax.bs = bs1; FStar_Syntax_Syntax.body = body1; + FStar_Syntax_Syntax.rc_opt = uu___;_}, + FStar_Syntax_Syntax.Tm_abs + { FStar_Syntax_Syntax.bs = bs2; FStar_Syntax_Syntax.body = body2; + FStar_Syntax_Syntax.rc_opt = uu___1;_}) + when + (FStar_Compiler_List.length bs1) = + (FStar_Compiler_List.length bs2) + -> + let uu___2 = + FStar_Compiler_List.fold_left2 + (fun r -> + fun b1 -> + fun b2 -> + eq_and r + (fun uu___3 -> + eq_tm env + (b1.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort + (b2.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort)) + Equal bs1 bs2 in + eq_and uu___2 (fun uu___3 -> eq_tm env body1 body2) + | (FStar_Syntax_Syntax.Tm_arrow + { FStar_Syntax_Syntax.bs1 = bs1; FStar_Syntax_Syntax.comp = c1;_}, + FStar_Syntax_Syntax.Tm_arrow + { FStar_Syntax_Syntax.bs1 = bs2; FStar_Syntax_Syntax.comp = c2;_}) + when + (FStar_Compiler_List.length bs1) = + (FStar_Compiler_List.length bs2) + -> + let uu___ = + FStar_Compiler_List.fold_left2 + (fun r -> + fun b1 -> + fun b2 -> + eq_and r + (fun uu___1 -> + eq_tm env + (b1.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort + (b2.FStar_Syntax_Syntax.binder_bv).FStar_Syntax_Syntax.sort)) + Equal bs1 bs2 in + eq_and uu___ (fun uu___1 -> eq_comp env c1 c2) + | uu___ -> Unknown +and (eq_antiquotations : + FStar_TypeChecker_Env.env_t -> + FStar_Syntax_Syntax.term Prims.list -> + FStar_Syntax_Syntax.term Prims.list -> eq_result) + = + fun env -> + fun a1 -> + fun a2 -> + match (a1, a2) with + | ([], []) -> Equal + | ([], uu___) -> NotEqual + | (uu___, []) -> NotEqual + | (t1::a11, t2::a21) -> + let uu___ = eq_tm env t1 t2 in + (match uu___ with + | NotEqual -> NotEqual + | Unknown -> + let uu___1 = eq_antiquotations env a11 a21 in + (match uu___1 with + | NotEqual -> NotEqual + | uu___2 -> Unknown) + | Equal -> eq_antiquotations env a11 a21) +and (branch_matches : + FStar_TypeChecker_Env.env_t -> + (FStar_Syntax_Syntax.pat' FStar_Syntax_Syntax.withinfo_t * + FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax + FStar_Pervasives_Native.option * FStar_Syntax_Syntax.term' + FStar_Syntax_Syntax.syntax) -> + (FStar_Syntax_Syntax.pat' FStar_Syntax_Syntax.withinfo_t * + FStar_Syntax_Syntax.term' FStar_Syntax_Syntax.syntax + FStar_Pervasives_Native.option * FStar_Syntax_Syntax.term' + FStar_Syntax_Syntax.syntax) -> eq_result) + = + fun env -> + fun b1 -> + fun b2 -> + let related_by f o1 o2 = + match (o1, o2) with + | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) -> + true + | (FStar_Pervasives_Native.Some x, FStar_Pervasives_Native.Some y) + -> f x y + | (uu___, uu___1) -> false in + let uu___ = b1 in + match uu___ with + | (p1, w1, t1) -> + let uu___1 = b2 in + (match uu___1 with + | (p2, w2, t2) -> + let uu___2 = FStar_Syntax_Syntax.eq_pat p1 p2 in + if uu___2 + then + let uu___3 = + (let uu___4 = eq_tm env t1 t2 in uu___4 = Equal) && + (related_by + (fun t11 -> + fun t21 -> + let uu___4 = eq_tm env t11 t21 in + uu___4 = Equal) w1 w2) in + (if uu___3 then Equal else Unknown) + else Unknown) +and (eq_args : + FStar_TypeChecker_Env.env_t -> + FStar_Syntax_Syntax.args -> FStar_Syntax_Syntax.args -> eq_result) + = + fun env -> + fun a1 -> + fun a2 -> + match (a1, a2) with + | ([], []) -> Equal + | ((a, uu___)::a11, (b, uu___1)::b1) -> + let uu___2 = eq_tm env a b in + (match uu___2 with + | Equal -> eq_args env a11 b1 + | uu___3 -> Unknown) + | uu___ -> Unknown +and (eq_comp : + FStar_TypeChecker_Env.env_t -> + FStar_Syntax_Syntax.comp -> FStar_Syntax_Syntax.comp -> eq_result) + = + fun env -> + fun c1 -> + fun c2 -> + match ((c1.FStar_Syntax_Syntax.n), (c2.FStar_Syntax_Syntax.n)) with + | (FStar_Syntax_Syntax.Total t1, FStar_Syntax_Syntax.Total t2) -> + eq_tm env t1 t2 + | (FStar_Syntax_Syntax.GTotal t1, FStar_Syntax_Syntax.GTotal t2) -> + eq_tm env t1 t2 + | (FStar_Syntax_Syntax.Comp ct1, FStar_Syntax_Syntax.Comp ct2) -> + let uu___ = + let uu___1 = + FStar_Syntax_Util.eq_univs_list + ct1.FStar_Syntax_Syntax.comp_univs + ct2.FStar_Syntax_Syntax.comp_univs in + equal_if uu___1 in + eq_and uu___ + (fun uu___1 -> + let uu___2 = + let uu___3 = + FStar_Ident.lid_equals + ct1.FStar_Syntax_Syntax.effect_name + ct2.FStar_Syntax_Syntax.effect_name in + equal_if uu___3 in + eq_and uu___2 + (fun uu___3 -> + let uu___4 = + eq_tm env ct1.FStar_Syntax_Syntax.result_typ + ct2.FStar_Syntax_Syntax.result_typ in + eq_and uu___4 + (fun uu___5 -> + eq_args env ct1.FStar_Syntax_Syntax.effect_args + ct2.FStar_Syntax_Syntax.effect_args))) + | uu___ -> NotEqual +let (eq_tm_bool : + FStar_TypeChecker_Env.env_t -> + FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term -> Prims.bool) + = fun e -> fun t1 -> fun t2 -> let uu___ = eq_tm e t1 t2 in uu___ = Equal +let (simplify : + Prims.bool -> + FStar_TypeChecker_Env.env_t -> + FStar_Syntax_Syntax.term -> FStar_Syntax_Syntax.term) + = + fun debug -> + fun env -> + fun tm -> + let w t = + { + FStar_Syntax_Syntax.n = (t.FStar_Syntax_Syntax.n); + FStar_Syntax_Syntax.pos = (tm.FStar_Syntax_Syntax.pos); + FStar_Syntax_Syntax.vars = (t.FStar_Syntax_Syntax.vars); + FStar_Syntax_Syntax.hash_code = (t.FStar_Syntax_Syntax.hash_code) + } in + let simp_t t = + let uu___ = + let uu___1 = FStar_Syntax_Util.unmeta t in + uu___1.FStar_Syntax_Syntax.n in + match uu___ with + | FStar_Syntax_Syntax.Tm_fvar fv when + FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.true_lid -> + FStar_Pervasives_Native.Some true + | FStar_Syntax_Syntax.Tm_fvar fv when + FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.false_lid + -> FStar_Pervasives_Native.Some false + | uu___1 -> FStar_Pervasives_Native.None in + let rec args_are_binders args bs = + match (args, bs) with + | ((t, uu___)::args1, b::bs1) -> + let uu___1 = + let uu___2 = FStar_Syntax_Subst.compress t in + uu___2.FStar_Syntax_Syntax.n in + (match uu___1 with + | FStar_Syntax_Syntax.Tm_name bv' -> + (FStar_Syntax_Syntax.bv_eq b.FStar_Syntax_Syntax.binder_bv + bv') + && (args_are_binders args1 bs1) + | uu___2 -> false) + | ([], []) -> true + | (uu___, uu___1) -> false in + let is_applied bs t = + if debug + then + (let uu___1 = FStar_Syntax_Print.term_to_string t in + let uu___2 = FStar_Syntax_Print.tag_of_term t in + FStar_Compiler_Util.print2 "WPE> is_applied %s -- %s\n" uu___1 + uu___2) + else (); + (let uu___1 = FStar_Syntax_Util.head_and_args_full t in + match uu___1 with + | (hd, args) -> + let uu___2 = + let uu___3 = FStar_Syntax_Subst.compress hd in + uu___3.FStar_Syntax_Syntax.n in + (match uu___2 with + | FStar_Syntax_Syntax.Tm_name bv when + args_are_binders args bs -> + (if debug + then + (let uu___4 = FStar_Syntax_Print.term_to_string t in + let uu___5 = FStar_Syntax_Print.bv_to_string bv in + let uu___6 = FStar_Syntax_Print.term_to_string hd in + FStar_Compiler_Util.print3 + "WPE> got it\n>>>>top = %s\n>>>>b = %s\n>>>>hd = %s\n" + uu___4 uu___5 uu___6) + else (); + FStar_Pervasives_Native.Some bv) + | uu___3 -> FStar_Pervasives_Native.None)) in + let is_applied_maybe_squashed bs t = + if debug + then + (let uu___1 = FStar_Syntax_Print.term_to_string t in + let uu___2 = FStar_Syntax_Print.tag_of_term t in + FStar_Compiler_Util.print2 + "WPE> is_applied_maybe_squashed %s -- %s\n" uu___1 uu___2) + else (); + (let uu___1 = FStar_Syntax_Util.is_squash t in + match uu___1 with + | FStar_Pervasives_Native.Some (uu___2, t') -> is_applied bs t' + | uu___2 -> + let uu___3 = FStar_Syntax_Util.is_auto_squash t in + (match uu___3 with + | FStar_Pervasives_Native.Some (uu___4, t') -> + is_applied bs t' + | uu___4 -> is_applied bs t)) in + let is_const_match phi = + let uu___ = + let uu___1 = FStar_Syntax_Subst.compress phi in + uu___1.FStar_Syntax_Syntax.n in + match uu___ with + | FStar_Syntax_Syntax.Tm_match + { FStar_Syntax_Syntax.scrutinee = uu___1; + FStar_Syntax_Syntax.ret_opt = uu___2; + FStar_Syntax_Syntax.brs = br::brs; + FStar_Syntax_Syntax.rc_opt1 = uu___3;_} + -> + let uu___4 = br in + (match uu___4 with + | (uu___5, uu___6, e) -> + let r = + let uu___7 = simp_t e in + match uu___7 with + | FStar_Pervasives_Native.None -> + FStar_Pervasives_Native.None + | FStar_Pervasives_Native.Some b -> + let uu___8 = + FStar_Compiler_List.for_all + (fun uu___9 -> + match uu___9 with + | (uu___10, uu___11, e') -> + let uu___12 = simp_t e' in + uu___12 = + (FStar_Pervasives_Native.Some b)) brs in + if uu___8 + then FStar_Pervasives_Native.Some b + else FStar_Pervasives_Native.None in + r) + | uu___1 -> FStar_Pervasives_Native.None in + let maybe_auto_squash t = + let uu___ = FStar_Syntax_Util.is_sub_singleton t in + if uu___ + then t + else FStar_Syntax_Util.mk_auto_squash FStar_Syntax_Syntax.U_zero t in + let squashed_head_un_auto_squash_args t = + let maybe_un_auto_squash_arg uu___ = + match uu___ with + | (t1, q) -> + let uu___1 = FStar_Syntax_Util.is_auto_squash t1 in + (match uu___1 with + | FStar_Pervasives_Native.Some + (FStar_Syntax_Syntax.U_zero, t2) -> (t2, q) + | uu___2 -> (t1, q)) in + let uu___ = FStar_Syntax_Util.head_and_args t in + match uu___ with + | (head, args) -> + let args1 = + FStar_Compiler_List.map maybe_un_auto_squash_arg args in + FStar_Syntax_Syntax.mk_Tm_app head args1 + t.FStar_Syntax_Syntax.pos in + let rec clearly_inhabited ty = + let uu___ = + let uu___1 = FStar_Syntax_Util.unmeta ty in + uu___1.FStar_Syntax_Syntax.n in + match uu___ with + | FStar_Syntax_Syntax.Tm_uinst (t, uu___1) -> clearly_inhabited t + | FStar_Syntax_Syntax.Tm_arrow + { FStar_Syntax_Syntax.bs1 = uu___1; + FStar_Syntax_Syntax.comp = c;_} + -> clearly_inhabited (FStar_Syntax_Util.comp_result c) + | FStar_Syntax_Syntax.Tm_fvar fv -> + let l = FStar_Syntax_Syntax.lid_of_fv fv in + (((FStar_Ident.lid_equals l FStar_Parser_Const.int_lid) || + (FStar_Ident.lid_equals l FStar_Parser_Const.bool_lid)) + || (FStar_Ident.lid_equals l FStar_Parser_Const.string_lid)) + || (FStar_Ident.lid_equals l FStar_Parser_Const.exn_lid) + | uu___1 -> false in + let simplify1 arg = + let uu___ = simp_t (FStar_Pervasives_Native.fst arg) in + (uu___, arg) in + let uu___ = + let uu___1 = FStar_Syntax_Subst.compress tm in + uu___1.FStar_Syntax_Syntax.n in + match uu___ with + | FStar_Syntax_Syntax.Tm_app + { + FStar_Syntax_Syntax.hd = + { + FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_uinst + ({ + FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar fv; + FStar_Syntax_Syntax.pos = uu___1; + FStar_Syntax_Syntax.vars = uu___2; + FStar_Syntax_Syntax.hash_code = uu___3;_}, + uu___4); + FStar_Syntax_Syntax.pos = uu___5; + FStar_Syntax_Syntax.vars = uu___6; + FStar_Syntax_Syntax.hash_code = uu___7;_}; + FStar_Syntax_Syntax.args = args;_} + -> + let uu___8 = + FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.and_lid in + if uu___8 + then + let uu___9 = FStar_Compiler_List.map simplify1 args in + (match uu___9 with + | (FStar_Pervasives_Native.Some (true), uu___10)::(uu___11, + (arg, + uu___12))::[] + -> maybe_auto_squash arg + | (uu___10, (arg, uu___11))::(FStar_Pervasives_Native.Some + (true), uu___12)::[] + -> maybe_auto_squash arg + | (FStar_Pervasives_Native.Some (false), uu___10)::uu___11::[] + -> w FStar_Syntax_Util.t_false + | uu___10::(FStar_Pervasives_Native.Some (false), uu___11)::[] + -> w FStar_Syntax_Util.t_false + | uu___10 -> squashed_head_un_auto_squash_args tm) + else + (let uu___10 = + FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.or_lid in + if uu___10 + then + let uu___11 = FStar_Compiler_List.map simplify1 args in + match uu___11 with + | (FStar_Pervasives_Native.Some (true), uu___12)::uu___13::[] + -> w FStar_Syntax_Util.t_true + | uu___12::(FStar_Pervasives_Native.Some (true), uu___13)::[] + -> w FStar_Syntax_Util.t_true + | (FStar_Pervasives_Native.Some (false), uu___12)::(uu___13, + (arg, + uu___14))::[] + -> maybe_auto_squash arg + | (uu___12, (arg, uu___13))::(FStar_Pervasives_Native.Some + (false), uu___14)::[] + -> maybe_auto_squash arg + | uu___12 -> squashed_head_un_auto_squash_args tm + else + (let uu___12 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.imp_lid in + if uu___12 + then + let uu___13 = FStar_Compiler_List.map simplify1 args in + match uu___13 with + | uu___14::(FStar_Pervasives_Native.Some (true), uu___15)::[] + -> w FStar_Syntax_Util.t_true + | (FStar_Pervasives_Native.Some (false), uu___14)::uu___15::[] + -> w FStar_Syntax_Util.t_true + | (FStar_Pervasives_Native.Some (true), uu___14):: + (uu___15, (arg, uu___16))::[] -> + maybe_auto_squash arg + | (uu___14, (p, uu___15))::(uu___16, (q, uu___17))::[] -> + let uu___18 = FStar_Syntax_Util.term_eq p q in + (if uu___18 + then w FStar_Syntax_Util.t_true + else squashed_head_un_auto_squash_args tm) + | uu___14 -> squashed_head_un_auto_squash_args tm + else + (let uu___14 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.iff_lid in + if uu___14 + then + let uu___15 = FStar_Compiler_List.map simplify1 args in + match uu___15 with + | (FStar_Pervasives_Native.Some (true), uu___16):: + (FStar_Pervasives_Native.Some (true), uu___17)::[] + -> w FStar_Syntax_Util.t_true + | (FStar_Pervasives_Native.Some (false), uu___16):: + (FStar_Pervasives_Native.Some (false), uu___17)::[] + -> w FStar_Syntax_Util.t_true + | (FStar_Pervasives_Native.Some (true), uu___16):: + (FStar_Pervasives_Native.Some (false), uu___17)::[] + -> w FStar_Syntax_Util.t_false + | (FStar_Pervasives_Native.Some (false), uu___16):: + (FStar_Pervasives_Native.Some (true), uu___17)::[] + -> w FStar_Syntax_Util.t_false + | (uu___16, (arg, uu___17))::(FStar_Pervasives_Native.Some + (true), uu___18)::[] + -> maybe_auto_squash arg + | (FStar_Pervasives_Native.Some (true), uu___16):: + (uu___17, (arg, uu___18))::[] -> + maybe_auto_squash arg + | (uu___16, (arg, uu___17))::(FStar_Pervasives_Native.Some + (false), uu___18)::[] + -> + let uu___19 = FStar_Syntax_Util.mk_neg arg in + maybe_auto_squash uu___19 + | (FStar_Pervasives_Native.Some (false), uu___16):: + (uu___17, (arg, uu___18))::[] -> + let uu___19 = FStar_Syntax_Util.mk_neg arg in + maybe_auto_squash uu___19 + | (uu___16, (p, uu___17))::(uu___18, (q, uu___19))::[] + -> + let uu___20 = FStar_Syntax_Util.term_eq p q in + (if uu___20 + then w FStar_Syntax_Util.t_true + else squashed_head_un_auto_squash_args tm) + | uu___16 -> squashed_head_un_auto_squash_args tm + else + (let uu___16 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.not_lid in + if uu___16 + then + let uu___17 = + FStar_Compiler_List.map simplify1 args in + match uu___17 with + | (FStar_Pervasives_Native.Some (true), uu___18)::[] + -> w FStar_Syntax_Util.t_false + | (FStar_Pervasives_Native.Some (false), uu___18)::[] + -> w FStar_Syntax_Util.t_true + | uu___18 -> squashed_head_un_auto_squash_args tm + else + (let uu___18 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.forall_lid in + if uu___18 + then + match args with + | (t, uu___19)::[] -> + let uu___20 = + let uu___21 = + FStar_Syntax_Subst.compress t in + uu___21.FStar_Syntax_Syntax.n in + (match uu___20 with + | FStar_Syntax_Syntax.Tm_abs + { FStar_Syntax_Syntax.bs = uu___21::[]; + FStar_Syntax_Syntax.body = body; + FStar_Syntax_Syntax.rc_opt = uu___22;_} + -> + let uu___23 = simp_t body in + (match uu___23 with + | FStar_Pervasives_Native.Some (true) + -> w FStar_Syntax_Util.t_true + | uu___24 -> tm) + | uu___21 -> tm) + | (ty, FStar_Pervasives_Native.Some + { FStar_Syntax_Syntax.aqual_implicit = true; + FStar_Syntax_Syntax.aqual_attributes = + uu___19;_})::(t, uu___20)::[] + -> + let uu___21 = + let uu___22 = + FStar_Syntax_Subst.compress t in + uu___22.FStar_Syntax_Syntax.n in + (match uu___21 with + | FStar_Syntax_Syntax.Tm_abs + { FStar_Syntax_Syntax.bs = uu___22::[]; + FStar_Syntax_Syntax.body = body; + FStar_Syntax_Syntax.rc_opt = uu___23;_} + -> + let uu___24 = simp_t body in + (match uu___24 with + | FStar_Pervasives_Native.Some (true) + -> w FStar_Syntax_Util.t_true + | FStar_Pervasives_Native.Some (false) + when clearly_inhabited ty -> + w FStar_Syntax_Util.t_false + | uu___25 -> tm) + | uu___22 -> tm) + | uu___19 -> tm + else + (let uu___20 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.exists_lid in + if uu___20 + then + match args with + | (t, uu___21)::[] -> + let uu___22 = + let uu___23 = + FStar_Syntax_Subst.compress t in + uu___23.FStar_Syntax_Syntax.n in + (match uu___22 with + | FStar_Syntax_Syntax.Tm_abs + { + FStar_Syntax_Syntax.bs = + uu___23::[]; + FStar_Syntax_Syntax.body = body; + FStar_Syntax_Syntax.rc_opt = + uu___24;_} + -> + let uu___25 = simp_t body in + (match uu___25 with + | FStar_Pervasives_Native.Some + (false) -> + w FStar_Syntax_Util.t_false + | uu___26 -> tm) + | uu___23 -> tm) + | (ty, FStar_Pervasives_Native.Some + { + FStar_Syntax_Syntax.aqual_implicit = + true; + FStar_Syntax_Syntax.aqual_attributes = + uu___21;_})::(t, uu___22)::[] + -> + let uu___23 = + let uu___24 = + FStar_Syntax_Subst.compress t in + uu___24.FStar_Syntax_Syntax.n in + (match uu___23 with + | FStar_Syntax_Syntax.Tm_abs + { + FStar_Syntax_Syntax.bs = + uu___24::[]; + FStar_Syntax_Syntax.body = body; + FStar_Syntax_Syntax.rc_opt = + uu___25;_} + -> + let uu___26 = simp_t body in + (match uu___26 with + | FStar_Pervasives_Native.Some + (false) -> + w FStar_Syntax_Util.t_false + | FStar_Pervasives_Native.Some + (true) when + clearly_inhabited ty -> + w FStar_Syntax_Util.t_true + | uu___27 -> tm) + | uu___24 -> tm) + | uu___21 -> tm + else + (let uu___22 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.b2t_lid in + if uu___22 + then + match args with + | ({ + FStar_Syntax_Syntax.n = + FStar_Syntax_Syntax.Tm_constant + (FStar_Const.Const_bool (true)); + FStar_Syntax_Syntax.pos = uu___23; + FStar_Syntax_Syntax.vars = uu___24; + FStar_Syntax_Syntax.hash_code = + uu___25;_}, + uu___26)::[] -> + w FStar_Syntax_Util.t_true + | ({ + FStar_Syntax_Syntax.n = + FStar_Syntax_Syntax.Tm_constant + (FStar_Const.Const_bool (false)); + FStar_Syntax_Syntax.pos = uu___23; + FStar_Syntax_Syntax.vars = uu___24; + FStar_Syntax_Syntax.hash_code = + uu___25;_}, + uu___26)::[] -> + w FStar_Syntax_Util.t_false + | uu___23 -> tm + else + (let uu___24 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.haseq_lid in + if uu___24 + then + let t_has_eq_for_sure t = + let haseq_lids = + [FStar_Parser_Const.int_lid; + FStar_Parser_Const.bool_lid; + FStar_Parser_Const.unit_lid; + FStar_Parser_Const.string_lid] in + let uu___25 = + let uu___26 = + FStar_Syntax_Subst.compress t in + uu___26.FStar_Syntax_Syntax.n in + match uu___25 with + | FStar_Syntax_Syntax.Tm_fvar fv1 + when + FStar_Compiler_List.existsb + (fun l -> + FStar_Syntax_Syntax.fv_eq_lid + fv1 l) haseq_lids + -> true + | uu___26 -> false in + (if + (FStar_Compiler_List.length args) = + Prims.int_one + then + let t = + let uu___25 = + FStar_Compiler_List.hd args in + FStar_Pervasives_Native.fst + uu___25 in + let uu___25 = t_has_eq_for_sure t in + (if uu___25 + then w FStar_Syntax_Util.t_true + else + (let uu___27 = + let uu___28 = + FStar_Syntax_Subst.compress + t in + uu___28.FStar_Syntax_Syntax.n in + match uu___27 with + | FStar_Syntax_Syntax.Tm_refine + uu___28 -> + let t1 = + FStar_Syntax_Util.unrefine + t in + let uu___29 = + t_has_eq_for_sure t1 in + if uu___29 + then + w FStar_Syntax_Util.t_true + else + (let haseq_tm = + let uu___31 = + let uu___32 = + FStar_Syntax_Subst.compress + tm in + uu___32.FStar_Syntax_Syntax.n in + match uu___31 with + | FStar_Syntax_Syntax.Tm_app + { + FStar_Syntax_Syntax.hd + = hd; + FStar_Syntax_Syntax.args + = uu___32;_} + -> hd + | uu___32 -> + FStar_Compiler_Effect.failwith + "Impossible! We have already checked that this is a Tm_app" in + let uu___31 = + let uu___32 = + FStar_Syntax_Syntax.as_arg + t1 in + [uu___32] in + FStar_Syntax_Util.mk_app + haseq_tm uu___31) + | uu___28 -> tm)) + else tm) + else + (let uu___26 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.eq2_lid in + if uu___26 + then + match args with + | (_typ, uu___27)::(a1, uu___28):: + (a2, uu___29)::[] -> + let uu___30 = eq_tm env a1 a2 in + (match uu___30 with + | Equal -> + w FStar_Syntax_Util.t_true + | NotEqual -> + w FStar_Syntax_Util.t_false + | uu___31 -> tm) + | uu___27 -> tm + else + (let uu___28 = + FStar_Syntax_Util.is_auto_squash + tm in + match uu___28 with + | FStar_Pervasives_Native.Some + (FStar_Syntax_Syntax.U_zero, t) + when + FStar_Syntax_Util.is_sub_singleton + t + -> t + | uu___29 -> tm)))))))))) + | FStar_Syntax_Syntax.Tm_app + { + FStar_Syntax_Syntax.hd = + { FStar_Syntax_Syntax.n = FStar_Syntax_Syntax.Tm_fvar fv; + FStar_Syntax_Syntax.pos = uu___1; + FStar_Syntax_Syntax.vars = uu___2; + FStar_Syntax_Syntax.hash_code = uu___3;_}; + FStar_Syntax_Syntax.args = args;_} + -> + let uu___4 = + FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.and_lid in + if uu___4 + then + let uu___5 = FStar_Compiler_List.map simplify1 args in + (match uu___5 with + | (FStar_Pervasives_Native.Some (true), uu___6)::(uu___7, + (arg, + uu___8))::[] + -> maybe_auto_squash arg + | (uu___6, (arg, uu___7))::(FStar_Pervasives_Native.Some + (true), uu___8)::[] + -> maybe_auto_squash arg + | (FStar_Pervasives_Native.Some (false), uu___6)::uu___7::[] + -> w FStar_Syntax_Util.t_false + | uu___6::(FStar_Pervasives_Native.Some (false), uu___7)::[] + -> w FStar_Syntax_Util.t_false + | uu___6 -> squashed_head_un_auto_squash_args tm) + else + (let uu___6 = + FStar_Syntax_Syntax.fv_eq_lid fv FStar_Parser_Const.or_lid in + if uu___6 + then + let uu___7 = FStar_Compiler_List.map simplify1 args in + match uu___7 with + | (FStar_Pervasives_Native.Some (true), uu___8)::uu___9::[] + -> w FStar_Syntax_Util.t_true + | uu___8::(FStar_Pervasives_Native.Some (true), uu___9)::[] + -> w FStar_Syntax_Util.t_true + | (FStar_Pervasives_Native.Some (false), uu___8)::(uu___9, + (arg, + uu___10))::[] + -> maybe_auto_squash arg + | (uu___8, (arg, uu___9))::(FStar_Pervasives_Native.Some + (false), uu___10)::[] + -> maybe_auto_squash arg + | uu___8 -> squashed_head_un_auto_squash_args tm + else + (let uu___8 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.imp_lid in + if uu___8 + then + let uu___9 = FStar_Compiler_List.map simplify1 args in + match uu___9 with + | uu___10::(FStar_Pervasives_Native.Some (true), uu___11)::[] + -> w FStar_Syntax_Util.t_true + | (FStar_Pervasives_Native.Some (false), uu___10)::uu___11::[] + -> w FStar_Syntax_Util.t_true + | (FStar_Pervasives_Native.Some (true), uu___10):: + (uu___11, (arg, uu___12))::[] -> + maybe_auto_squash arg + | (uu___10, (p, uu___11))::(uu___12, (q, uu___13))::[] -> + let uu___14 = FStar_Syntax_Util.term_eq p q in + (if uu___14 + then w FStar_Syntax_Util.t_true + else squashed_head_un_auto_squash_args tm) + | uu___10 -> squashed_head_un_auto_squash_args tm + else + (let uu___10 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.iff_lid in + if uu___10 + then + let uu___11 = FStar_Compiler_List.map simplify1 args in + match uu___11 with + | (FStar_Pervasives_Native.Some (true), uu___12):: + (FStar_Pervasives_Native.Some (true), uu___13)::[] + -> w FStar_Syntax_Util.t_true + | (FStar_Pervasives_Native.Some (false), uu___12):: + (FStar_Pervasives_Native.Some (false), uu___13)::[] + -> w FStar_Syntax_Util.t_true + | (FStar_Pervasives_Native.Some (true), uu___12):: + (FStar_Pervasives_Native.Some (false), uu___13)::[] + -> w FStar_Syntax_Util.t_false + | (FStar_Pervasives_Native.Some (false), uu___12):: + (FStar_Pervasives_Native.Some (true), uu___13)::[] + -> w FStar_Syntax_Util.t_false + | (uu___12, (arg, uu___13))::(FStar_Pervasives_Native.Some + (true), uu___14)::[] + -> maybe_auto_squash arg + | (FStar_Pervasives_Native.Some (true), uu___12):: + (uu___13, (arg, uu___14))::[] -> + maybe_auto_squash arg + | (uu___12, (arg, uu___13))::(FStar_Pervasives_Native.Some + (false), uu___14)::[] + -> + let uu___15 = FStar_Syntax_Util.mk_neg arg in + maybe_auto_squash uu___15 + | (FStar_Pervasives_Native.Some (false), uu___12):: + (uu___13, (arg, uu___14))::[] -> + let uu___15 = FStar_Syntax_Util.mk_neg arg in + maybe_auto_squash uu___15 + | (uu___12, (p, uu___13))::(uu___14, (q, uu___15))::[] + -> + let uu___16 = FStar_Syntax_Util.term_eq p q in + (if uu___16 + then w FStar_Syntax_Util.t_true + else squashed_head_un_auto_squash_args tm) + | uu___12 -> squashed_head_un_auto_squash_args tm + else + (let uu___12 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.not_lid in + if uu___12 + then + let uu___13 = + FStar_Compiler_List.map simplify1 args in + match uu___13 with + | (FStar_Pervasives_Native.Some (true), uu___14)::[] + -> w FStar_Syntax_Util.t_false + | (FStar_Pervasives_Native.Some (false), uu___14)::[] + -> w FStar_Syntax_Util.t_true + | uu___14 -> squashed_head_un_auto_squash_args tm + else + (let uu___14 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.forall_lid in + if uu___14 + then + match args with + | (t, uu___15)::[] -> + let uu___16 = + let uu___17 = + FStar_Syntax_Subst.compress t in + uu___17.FStar_Syntax_Syntax.n in + (match uu___16 with + | FStar_Syntax_Syntax.Tm_abs + { FStar_Syntax_Syntax.bs = uu___17::[]; + FStar_Syntax_Syntax.body = body; + FStar_Syntax_Syntax.rc_opt = uu___18;_} + -> + let uu___19 = simp_t body in + (match uu___19 with + | FStar_Pervasives_Native.Some (true) + -> w FStar_Syntax_Util.t_true + | uu___20 -> tm) + | uu___17 -> tm) + | (ty, FStar_Pervasives_Native.Some + { FStar_Syntax_Syntax.aqual_implicit = true; + FStar_Syntax_Syntax.aqual_attributes = + uu___15;_})::(t, uu___16)::[] + -> + let uu___17 = + let uu___18 = + FStar_Syntax_Subst.compress t in + uu___18.FStar_Syntax_Syntax.n in + (match uu___17 with + | FStar_Syntax_Syntax.Tm_abs + { FStar_Syntax_Syntax.bs = uu___18::[]; + FStar_Syntax_Syntax.body = body; + FStar_Syntax_Syntax.rc_opt = uu___19;_} + -> + let uu___20 = simp_t body in + (match uu___20 with + | FStar_Pervasives_Native.Some (true) + -> w FStar_Syntax_Util.t_true + | FStar_Pervasives_Native.Some (false) + when clearly_inhabited ty -> + w FStar_Syntax_Util.t_false + | uu___21 -> tm) + | uu___18 -> tm) + | uu___15 -> tm + else + (let uu___16 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.exists_lid in + if uu___16 + then + match args with + | (t, uu___17)::[] -> + let uu___18 = + let uu___19 = + FStar_Syntax_Subst.compress t in + uu___19.FStar_Syntax_Syntax.n in + (match uu___18 with + | FStar_Syntax_Syntax.Tm_abs + { + FStar_Syntax_Syntax.bs = + uu___19::[]; + FStar_Syntax_Syntax.body = body; + FStar_Syntax_Syntax.rc_opt = + uu___20;_} + -> + let uu___21 = simp_t body in + (match uu___21 with + | FStar_Pervasives_Native.Some + (false) -> + w FStar_Syntax_Util.t_false + | uu___22 -> tm) + | uu___19 -> tm) + | (ty, FStar_Pervasives_Native.Some + { + FStar_Syntax_Syntax.aqual_implicit = + true; + FStar_Syntax_Syntax.aqual_attributes = + uu___17;_})::(t, uu___18)::[] + -> + let uu___19 = + let uu___20 = + FStar_Syntax_Subst.compress t in + uu___20.FStar_Syntax_Syntax.n in + (match uu___19 with + | FStar_Syntax_Syntax.Tm_abs + { + FStar_Syntax_Syntax.bs = + uu___20::[]; + FStar_Syntax_Syntax.body = body; + FStar_Syntax_Syntax.rc_opt = + uu___21;_} + -> + let uu___22 = simp_t body in + (match uu___22 with + | FStar_Pervasives_Native.Some + (false) -> + w FStar_Syntax_Util.t_false + | FStar_Pervasives_Native.Some + (true) when + clearly_inhabited ty -> + w FStar_Syntax_Util.t_true + | uu___23 -> tm) + | uu___20 -> tm) + | uu___17 -> tm + else + (let uu___18 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.b2t_lid in + if uu___18 + then + match args with + | ({ + FStar_Syntax_Syntax.n = + FStar_Syntax_Syntax.Tm_constant + (FStar_Const.Const_bool (true)); + FStar_Syntax_Syntax.pos = uu___19; + FStar_Syntax_Syntax.vars = uu___20; + FStar_Syntax_Syntax.hash_code = + uu___21;_}, + uu___22)::[] -> + w FStar_Syntax_Util.t_true + | ({ + FStar_Syntax_Syntax.n = + FStar_Syntax_Syntax.Tm_constant + (FStar_Const.Const_bool (false)); + FStar_Syntax_Syntax.pos = uu___19; + FStar_Syntax_Syntax.vars = uu___20; + FStar_Syntax_Syntax.hash_code = + uu___21;_}, + uu___22)::[] -> + w FStar_Syntax_Util.t_false + | uu___19 -> tm + else + (let uu___20 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.haseq_lid in + if uu___20 + then + let t_has_eq_for_sure t = + let haseq_lids = + [FStar_Parser_Const.int_lid; + FStar_Parser_Const.bool_lid; + FStar_Parser_Const.unit_lid; + FStar_Parser_Const.string_lid] in + let uu___21 = + let uu___22 = + FStar_Syntax_Subst.compress t in + uu___22.FStar_Syntax_Syntax.n in + match uu___21 with + | FStar_Syntax_Syntax.Tm_fvar fv1 + when + FStar_Compiler_List.existsb + (fun l -> + FStar_Syntax_Syntax.fv_eq_lid + fv1 l) haseq_lids + -> true + | uu___22 -> false in + (if + (FStar_Compiler_List.length args) = + Prims.int_one + then + let t = + let uu___21 = + FStar_Compiler_List.hd args in + FStar_Pervasives_Native.fst + uu___21 in + let uu___21 = t_has_eq_for_sure t in + (if uu___21 + then w FStar_Syntax_Util.t_true + else + (let uu___23 = + let uu___24 = + FStar_Syntax_Subst.compress + t in + uu___24.FStar_Syntax_Syntax.n in + match uu___23 with + | FStar_Syntax_Syntax.Tm_refine + uu___24 -> + let t1 = + FStar_Syntax_Util.unrefine + t in + let uu___25 = + t_has_eq_for_sure t1 in + if uu___25 + then + w FStar_Syntax_Util.t_true + else + (let haseq_tm = + let uu___27 = + let uu___28 = + FStar_Syntax_Subst.compress + tm in + uu___28.FStar_Syntax_Syntax.n in + match uu___27 with + | FStar_Syntax_Syntax.Tm_app + { + FStar_Syntax_Syntax.hd + = hd; + FStar_Syntax_Syntax.args + = uu___28;_} + -> hd + | uu___28 -> + FStar_Compiler_Effect.failwith + "Impossible! We have already checked that this is a Tm_app" in + let uu___27 = + let uu___28 = + FStar_Syntax_Syntax.as_arg + t1 in + [uu___28] in + FStar_Syntax_Util.mk_app + haseq_tm uu___27) + | uu___24 -> tm)) + else tm) + else + (let uu___22 = + FStar_Syntax_Syntax.fv_eq_lid fv + FStar_Parser_Const.eq2_lid in + if uu___22 + then + match args with + | (_typ, uu___23)::(a1, uu___24):: + (a2, uu___25)::[] -> + let uu___26 = eq_tm env a1 a2 in + (match uu___26 with + | Equal -> + w FStar_Syntax_Util.t_true + | NotEqual -> + w FStar_Syntax_Util.t_false + | uu___27 -> tm) + | uu___23 -> tm + else + (let uu___24 = + FStar_Syntax_Util.is_auto_squash + tm in + match uu___24 with + | FStar_Pervasives_Native.Some + (FStar_Syntax_Syntax.U_zero, t) + when + FStar_Syntax_Util.is_sub_singleton + t + -> t + | uu___25 -> tm)))))))))) + | FStar_Syntax_Syntax.Tm_refine + { FStar_Syntax_Syntax.b = bv; FStar_Syntax_Syntax.phi = t;_} -> + let uu___1 = simp_t t in + (match uu___1 with + | FStar_Pervasives_Native.Some (true) -> + bv.FStar_Syntax_Syntax.sort + | FStar_Pervasives_Native.Some (false) -> tm + | FStar_Pervasives_Native.None -> tm) + | FStar_Syntax_Syntax.Tm_match uu___1 -> + let uu___2 = is_const_match tm in + (match uu___2 with + | FStar_Pervasives_Native.Some (true) -> + w FStar_Syntax_Util.t_true + | FStar_Pervasives_Native.Some (false) -> + w FStar_Syntax_Util.t_false + | FStar_Pervasives_Native.None -> tm) + | uu___1 -> tm \ No newline at end of file diff --git a/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml b/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml index 1e54853ffc9..26e80802dd4 100644 --- a/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml +++ b/ocaml/fstar-lib/generated/FStar_TypeChecker_Util.ml @@ -2,6 +2,30 @@ open Prims type lcomp_with_binder = (FStar_Syntax_Syntax.bv FStar_Pervasives_Native.option * FStar_TypeChecker_Common.lcomp) +let (dbg_bind : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Bind" +let (dbg_Coercions : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Coercions" +let (dbg_Dec : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Dec" +let (dbg_Extraction : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Extraction" +let (dbg_LayeredEffects : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "LayeredEffects" +let (dbg_LayeredEffectsApp : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "LayeredEffectsApp" +let (dbg_Pat : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Pat" +let (dbg_Rel : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Rel" +let (dbg_ResolveImplicitsHook : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "ResolveImplicitsHook" +let (dbg_Return : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Return" +let (dbg_Simplification : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Simplification" +let (dbg_SMTEncodingReify : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "SMTEncodingReify" let (report : FStar_TypeChecker_Env.env -> Prims.string Prims.list -> unit) = fun env -> fun errs -> @@ -45,9 +69,7 @@ let (close_guard_implicits : g.FStar_TypeChecker_Common.deferred in match uu___1 with | (solve_now, defer) -> - ((let uu___3 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Rel") in + ((let uu___3 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___3 then (FStar_Compiler_Util.print_string @@ -107,7 +129,10 @@ let (check_uvars : let uvs = FStar_Syntax_Free.uvars t in let uu___ = let uu___1 = - FStar_Compiler_Set.is_empty FStar_Syntax_Free.ord_ctx_uvar uvs in + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Free.ord_ctx_uvar)) (Obj.magic uvs) in Prims.op_Negation uu___1 in if uu___ then @@ -118,7 +143,7 @@ let (check_uvars : let uu___6 = let uu___7 = FStar_Class_Show.show - (FStar_Compiler_Set.showable_set + (FStar_Compiler_FlatSet.showable_set FStar_Syntax_Free.ord_ctx_uvar FStar_Syntax_Print.showable_ctxu) uvs in let uu___8 = @@ -152,9 +177,7 @@ let (extract_let_rec_annotation : | (u_subst, univ_vars1) -> let e1 = FStar_Syntax_Subst.subst u_subst e in let t2 = FStar_Syntax_Subst.subst u_subst t1 in - ((let uu___6 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Dec") in + ((let uu___6 = FStar_Compiler_Effect.op_Bang dbg_Dec in if uu___6 then let uu___7 = FStar_Syntax_Print.term_to_string e1 in @@ -842,9 +865,7 @@ let (mk_wp_return : FStar_Syntax_Syntax.mk_Tm_app uu___6 uu___7 e.FStar_Syntax_Syntax.pos) in mk_comp ed u_a a wp [FStar_Syntax_Syntax.RETURN])) in - (let uu___1 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Return") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Return in if uu___1 then let uu___2 = @@ -858,7 +879,7 @@ let (mk_wp_return : else ()); c let (label : - Prims.string -> + FStar_Pprint.document Prims.list -> FStar_Compiler_Range_Type.range -> FStar_Syntax_Syntax.typ -> FStar_Syntax_Syntax.typ) = @@ -874,7 +895,8 @@ let (label : }) f.FStar_Syntax_Syntax.pos let (label_opt : FStar_TypeChecker_Env.env -> - (unit -> Prims.string) FStar_Pervasives_Native.option -> + (unit -> FStar_Pprint.document Prims.list) FStar_Pervasives_Native.option + -> FStar_Compiler_Range_Type.range -> FStar_Syntax_Syntax.typ -> FStar_Syntax_Syntax.typ) = @@ -893,7 +915,7 @@ let (label_opt : else (let uu___2 = reason1 () in label uu___2 r f) let (label_guard : FStar_Compiler_Range_Type.range -> - Prims.string -> + FStar_Pprint.document Prims.list -> FStar_TypeChecker_Env.guard_t -> FStar_TypeChecker_Env.guard_t) = fun r -> @@ -1260,8 +1282,7 @@ let (substitutive_indexed_close_substs : fun num_effect_params -> fun r -> let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsApp") in + FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in let uu___ = let uu___1 = close_bs in match uu___1 with @@ -1529,8 +1550,8 @@ let (substitutive_indexed_bind_substs : fun num_effect_params -> fun has_range_binders -> let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsApp") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsApp in let bind_name uu___ = if debug then @@ -1896,8 +1917,7 @@ let (ad_hoc_indexed_bind_substs : fun r1 -> fun has_range_binders -> let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsApp") in + FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in let bind_name uu___ = if debug then @@ -1993,9 +2013,8 @@ let (ad_hoc_indexed_bind_substs : (match uu___1 with | (rest_bs_uvars, g_uvars) -> ((let uu___3 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other - "ResolveImplicitsHook") in + FStar_Compiler_Effect.op_Bang + dbg_ResolveImplicitsHook in if uu___3 then FStar_Compiler_List.iter @@ -2064,10 +2083,8 @@ let (ad_hoc_indexed_bind_substs : fun i1 -> fun f_i1 -> (let uu___5 = - FStar_TypeChecker_Env.debug - env - (FStar_Options.Other - "ResolveImplicitsHook") in + FStar_Compiler_Effect.op_Bang + dbg_ResolveImplicitsHook in if uu___5 then let uu___6 = @@ -2166,10 +2183,8 @@ let (ad_hoc_indexed_bind_substs : fun i1 -> fun g_i1 -> (let uu___6 = - FStar_TypeChecker_Env.debug - env - (FStar_Options.Other - "ResolveImplicitsHook") in + FStar_Compiler_Effect.op_Bang + dbg_ResolveImplicitsHook in if uu___6 then let uu___7 = @@ -2214,9 +2229,7 @@ let (mk_indexed_return : fun a -> fun e -> fun r -> - let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsApp") in + let debug = FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in if debug then (let uu___1 = @@ -2372,8 +2385,8 @@ let (mk_indexed_bind : fun num_effect_params -> fun has_range_binders -> let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsApp") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsApp in if debug then (let uu___1 = @@ -2387,8 +2400,8 @@ let (mk_indexed_bind : uu___1 uu___2) else (); (let uu___2 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "ResolveImplicitsHook") in + FStar_Compiler_Effect.op_Bang + dbg_ResolveImplicitsHook in if uu___2 then let uu___3 = @@ -2617,10 +2630,8 @@ let (mk_indexed_bind : FStar_TypeChecker_Env.conj_guards uu___9 in (let uu___10 = - FStar_TypeChecker_Env.debug - env - (FStar_Options.Other - "ResolveImplicitsHook") in + FStar_Compiler_Effect.op_Bang + dbg_ResolveImplicitsHook in if uu___10 then let uu___11 = @@ -2791,7 +2802,8 @@ let (mk_bind : (c, uu___5))))) let (strengthen_comp : FStar_TypeChecker_Env.env -> - (unit -> Prims.string) FStar_Pervasives_Native.option -> + (unit -> FStar_Pprint.document Prims.list) FStar_Pervasives_Native.option + -> FStar_Syntax_Syntax.comp -> FStar_Syntax_Syntax.formula -> FStar_Syntax_Syntax.cflag Prims.list -> @@ -2979,7 +2991,8 @@ let (weaken_precondition : lc.FStar_TypeChecker_Common.eff_name lc.FStar_TypeChecker_Common.res_typ uu___ weaken let (strengthen_precondition : - (unit -> Prims.string) FStar_Pervasives_Native.option -> + (unit -> FStar_Pprint.document Prims.list) FStar_Pervasives_Native.option + -> FStar_TypeChecker_Env.env -> FStar_Syntax_Syntax.term -> FStar_TypeChecker_Common.lcomp -> @@ -3035,9 +3048,7 @@ let (strengthen_precondition : match uu___5 with | FStar_TypeChecker_Common.Trivial -> (c, g_c) | FStar_TypeChecker_Common.NonTrivial f -> - ((let uu___7 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + ((let uu___7 = FStar_Compiler_Debug.extreme () in if uu___7 then let uu___8 = @@ -3148,10 +3159,8 @@ let (bind : | (b, lc2) -> let debug f = let uu___1 = - (FStar_TypeChecker_Env.debug env FStar_Options.Extreme) - || - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "bind")) in + (FStar_Compiler_Debug.extreme ()) || + (FStar_Compiler_Effect.op_Bang dbg_bind) in if uu___1 then f () else () in let uu___1 = FStar_TypeChecker_Normalize.ghost_to_pure_lcomp2 env @@ -3858,8 +3867,7 @@ let (substitutive_indexed_ite_substs : fun num_effect_params -> fun r -> let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsApp") in + FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in let uu___ = let uu___1 = bs in match uu___1 with @@ -4077,8 +4085,7 @@ let (ad_hoc_indexed_ite_substs : fun ct_else -> fun r -> let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsApp") in + FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in let conjunction_name uu___ = if debug then @@ -4258,8 +4265,7 @@ let (mk_layered_conjunction : fun ct2 -> fun r -> let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsApp") in + FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in let conjunction_t_error s = let uu___ = let uu___1 = @@ -4825,8 +4831,7 @@ let (check_comp : FStar_Class_Binders.hasNames_comp FStar_Syntax_Print.pretty_comp c'.FStar_Syntax_Syntax.pos "check_comp.c'" env c'; - (let uu___3 = - FStar_TypeChecker_Env.debug env FStar_Options.Extreme in + (let uu___3 = FStar_Compiler_Debug.extreme () in if uu___3 then let uu___4 = FStar_Syntax_Print.term_to_string e in @@ -4849,13 +4854,13 @@ let (check_comp : FStar_TypeChecker_Err.computed_computation_type_does_not_match_annotation_eq env e c c' in let uu___5 = FStar_TypeChecker_Env.get_range env in - FStar_Errors.raise_error uu___4 uu___5 + FStar_Errors.raise_error_doc uu___4 uu___5 else (let uu___5 = FStar_TypeChecker_Err.computed_computation_type_does_not_match_annotation env e c c' in let uu___6 = FStar_TypeChecker_Env.get_range env in - FStar_Errors.raise_error uu___5 uu___6) + FStar_Errors.raise_error_doc uu___5 uu___6) | FStar_Pervasives_Native.Some g -> (e, c', g)) let (universe_of_comp : FStar_TypeChecker_Env.env -> @@ -5002,8 +5007,7 @@ let (coerce_with : match uu___ with | FStar_Pervasives_Native.Some uu___1 -> ((let uu___3 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Coercions") in + FStar_Compiler_Effect.op_Bang dbg_Coercions in if uu___3 then let uu___4 = FStar_Ident.string_of_lid f in @@ -5168,8 +5172,11 @@ let rec (check_erased : let uu___11 = let uu___12 = FStar_Syntax_Free.names br_body in - FStar_Compiler_Set.elems - FStar_Syntax_Syntax.ord_bv uu___12 in + FStar_Class_Setlike.elems () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Syntax_Syntax.ord_bv)) + (Obj.magic uu___12) in FStar_TypeChecker_Env.push_bvs env uu___11 in check_erased uu___10 br_body in @@ -5699,9 +5706,7 @@ let (maybe_coerce_lc : if Prims.op_Negation should_coerce then (e, lc, FStar_TypeChecker_Env.trivial_guard) else - ((let uu___2 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Coercions") in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Coercions in if uu___2 then let uu___3 = @@ -5719,9 +5724,7 @@ let (maybe_coerce_lc : (let uu___2 = find_coercion env lc exp_t e in match uu___2 with | FStar_Pervasives_Native.Some (coerced, lc1, g) -> - ((let uu___4 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Coercions") in + ((let uu___4 = FStar_Compiler_Effect.op_Bang dbg_Coercions in if uu___4 then let uu___5 = @@ -5734,9 +5737,7 @@ let (maybe_coerce_lc : else ()); (coerced, lc1, g)) | FStar_Pervasives_Native.None -> - ((let uu___4 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Coercions") in + ((let uu___4 = FStar_Compiler_Effect.op_Bang dbg_Coercions in if uu___4 then let uu___5 = @@ -5836,7 +5837,7 @@ let (weaken_result_typ : fun lc -> fun t -> fun use_eq -> - (let uu___1 = FStar_TypeChecker_Env.debug env FStar_Options.High in + (let uu___1 = FStar_Compiler_Debug.high () in if uu___1 then let uu___2 = FStar_Syntax_Print.term_to_string e in @@ -5876,7 +5877,8 @@ let (weaken_result_typ : FStar_TypeChecker_Err.basic_type_error env (FStar_Pervasives_Native.Some e) t lc.FStar_TypeChecker_Common.res_typ in - FStar_Errors.raise_error uu___2 e.FStar_Syntax_Syntax.pos + FStar_Errors.raise_error_doc uu___2 + e.FStar_Syntax_Syntax.pos else (FStar_TypeChecker_Rel.subtype_fail env e lc.FStar_TypeChecker_Common.res_typ t; @@ -5902,13 +5904,14 @@ let (weaken_result_typ : let set_result_typ c1 = FStar_Syntax_Util.set_result_typ c1 t in let uu___4 = - let uu___5 = FStar_Syntax_Util.eq_tm t res_t in - uu___5 = FStar_Syntax_Util.Equal in + let uu___5 = + FStar_TypeChecker_TermEqAndSimplify.eq_tm env + t res_t in + uu___5 = + FStar_TypeChecker_TermEqAndSimplify.Equal in if uu___4 then - ((let uu___6 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + ((let uu___6 = FStar_Compiler_Debug.extreme () in if uu___6 then let uu___7 = @@ -5962,8 +5965,7 @@ let (weaken_result_typ : (FStar_Pervasives_Native.Some e) uu___7 uu___8 in ((let uu___8 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme () in if uu___8 then let uu___9 = @@ -5994,8 +5996,7 @@ let (weaken_result_typ : (uu___9, uu___10))) else ((let uu___8 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme () in if uu___8 then let uu___9 = @@ -6077,8 +6078,7 @@ let (weaken_result_typ : (match uu___7 with | (c, g_c) -> ((let uu___9 = - FStar_TypeChecker_Env.debug env - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme () in if uu___9 then let uu___10 = @@ -6180,9 +6180,8 @@ let (weaken_result_typ : (match uu___11 with | (c2, g_lc) -> ((let uu___13 = - FStar_TypeChecker_Env.debug - env - FStar_Options.Extreme in + FStar_Compiler_Debug.extreme + () in if uu___13 then let uu___14 = @@ -6389,9 +6388,7 @@ let (norm_reify : FStar_TypeChecker_Env.AllowUnboundUniverses; FStar_TypeChecker_Env.Exclude FStar_TypeChecker_Env.Zeta] steps) env t in - (let uu___2 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "SMTEncodingReify") in + (let uu___2 = FStar_Compiler_Effect.op_Bang dbg_SMTEncodingReify in if uu___2 then let uu___3 = FStar_Syntax_Print.term_to_string t in @@ -6457,17 +6454,21 @@ let (maybe_instantiate : if Prims.op_Negation env.FStar_TypeChecker_Env.instantiate_imp then (e, torig, FStar_TypeChecker_Env.trivial_guard) else - ((let uu___2 = FStar_TypeChecker_Env.debug env FStar_Options.High in + ((let uu___2 = FStar_Compiler_Debug.high () in if uu___2 then - let uu___3 = FStar_Syntax_Print.term_to_string e in - let uu___4 = FStar_Syntax_Print.term_to_string t in + let uu___3 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term e in + let uu___4 = + FStar_Class_Show.show FStar_Syntax_Print.showable_term t in let uu___5 = let uu___6 = FStar_TypeChecker_Env.expected_typ env in - match uu___6 with - | FStar_Pervasives_Native.None -> "None" - | FStar_Pervasives_Native.Some (t1, uu___7) -> - FStar_Syntax_Print.term_to_string t1 in + FStar_Class_Show.show + (FStar_Class_Show.show_option + (FStar_Class_Show.show_tuple2 + FStar_Syntax_Print.showable_term + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_bool))) uu___6 in FStar_Compiler_Util.print3 "maybe_instantiate: starting check for (%s) of type (%s), expected type is %s\n" uu___3 uu___4 uu___5 @@ -6497,11 +6498,9 @@ let (maybe_instantiate : FStar_Syntax_Syntax.binder_positivity = uu___5; FStar_Syntax_Syntax.binder_attrs = uu___6;_} -> (FStar_Compiler_Option.isNone imp) || - (let uu___7 = - FStar_Syntax_Util.eq_bqual imp - (FStar_Pervasives_Native.Some - FStar_Syntax_Syntax.Equality) in - uu___7 = FStar_Syntax_Util.Equal)) formals in + (FStar_Syntax_Util.eq_bqual imp + (FStar_Pervasives_Native.Some + FStar_Syntax_Syntax.Equality))) formals in match uu___2 with | FStar_Pervasives_Native.None -> FStar_Compiler_List.length formals @@ -6593,13 +6592,12 @@ let (maybe_instantiate : e.FStar_Syntax_Syntax.pos env t2 in (match uu___6 with | (v, uu___7, g) -> - ((let uu___9 = - FStar_TypeChecker_Env.debug env - FStar_Options.High in + ((let uu___9 = FStar_Compiler_Debug.high () in if uu___9 then let uu___10 = - FStar_Syntax_Print.term_to_string v in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term v in FStar_Compiler_Util.print1 "maybe_instantiate: Instantiating implicit with %s\n" uu___10 @@ -6654,13 +6652,12 @@ let (maybe_instantiate : (FStar_Pervasives_Native.Some meta_t) in (match uu___5 with | (v, uu___6, g) -> - ((let uu___8 = - FStar_TypeChecker_Env.debug env - FStar_Options.High in + ((let uu___8 = FStar_Compiler_Debug.high () in if uu___8 then let uu___9 = - FStar_Syntax_Print.term_to_string v in + FStar_Class_Show.show + FStar_Syntax_Print.showable_term v in FStar_Compiler_Util.print1 "maybe_instantiate: Instantiating meta argument with %s\n" uu___9 @@ -6769,9 +6766,7 @@ let (check_has_type_maybe_coerce : let g = check_has_type env1 e1 lc1.FStar_TypeChecker_Common.res_typ t2 use_eq in - ((let uu___2 = - FStar_TypeChecker_Env.debug env1 - (FStar_Options.Other "Rel") in + ((let uu___2 = FStar_Compiler_Effect.op_Bang dbg_Rel in if uu___2 then let uu___3 = FStar_TypeChecker_Rel.guard_to_string env1 g in @@ -6790,8 +6785,7 @@ let (check_top_level : fun lc -> FStar_Errors.with_ctx "While checking for top-level effects" (fun uu___ -> - (let uu___2 = - FStar_TypeChecker_Env.debug env FStar_Options.Medium in + (let uu___2 = FStar_Compiler_Debug.medium () in if uu___2 then let uu___3 = FStar_TypeChecker_Common.lcomp_to_string lc in @@ -6876,9 +6870,8 @@ let (check_top_level : FStar_Errors.raise_error uu___8 uu___9 | FStar_Pervasives_Native.Some (bs, uu___8) -> let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other - "LayeredEffectsApp") in + FStar_Compiler_Effect.op_Bang + dbg_LayeredEffectsApp in let uu___9 = FStar_Syntax_Subst.open_binders bs in (match uu___9 with @@ -6976,8 +6969,8 @@ let (check_top_level : match uu___7 with | (ct, vc, g_pre) -> ((let uu___9 = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "Simplification") in + FStar_Compiler_Effect.op_Bang + dbg_Simplification in if uu___9 then let uu___10 = @@ -7206,8 +7199,7 @@ let (must_erase_for_extraction : FStar_TypeChecker_Env.Unascribe] env t1 in let res = (FStar_TypeChecker_Env.non_informative env t2) || (descend env t2) in - (let uu___1 = - FStar_TypeChecker_Env.debug env (FStar_Options.Other "Extraction") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_Extraction in if uu___1 then let uu___2 = FStar_Syntax_Print.term_to_string t2 in @@ -7252,8 +7244,7 @@ let (fresh_effect_repr : match uu___ with | (uu___1, signature) -> let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsApp") in + FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in let uu___2 = let uu___3 = FStar_Syntax_Subst.compress signature in uu___3.FStar_Syntax_Syntax.n in @@ -7455,9 +7446,7 @@ let (substitutive_indexed_lift_substs : fun ct -> fun lift_name -> fun r -> - let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsApp") in + let debug = FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in let uu___ = let uu___1 = bs in match uu___1 with @@ -7542,9 +7531,7 @@ let (ad_hoc_indexed_lift_substs : fun ct -> fun lift_name -> fun r -> - let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsApp") in + let debug = FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in let lift_t_shape_error s = FStar_Compiler_Util.format2 "Lift %s has unexpected shape, reason: %s" lift_name s in @@ -7632,9 +7619,7 @@ let (lift_tf_layered_effect : fun kind -> fun env -> fun c -> - let debug = - FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffectsApp") in + let debug = FStar_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in if debug then (let uu___1 = FStar_Syntax_Print.comp_to_string c in @@ -7708,11 +7693,9 @@ let (lift_tf_layered_effect : lift_ct.FStar_Syntax_Syntax.result_typ wp FStar_Compiler_Range_Type.dummyRange in ((let uu___7 = - (FStar_TypeChecker_Env.debug env - (FStar_Options.Other "LayeredEffects")) - && - (FStar_TypeChecker_Env.debug env - FStar_Options.Extreme) in + (FStar_Compiler_Effect.op_Bang + dbg_LayeredEffects) + && (FStar_Compiler_Debug.extreme ()) in if uu___7 then let uu___8 = @@ -8238,24 +8221,26 @@ let (try_lookup_record_type : FStar_Syntax_Syntax.t1 = t; FStar_Syntax_Syntax.ty_lid = uu___5; FStar_Syntax_Syntax.num_ty_params = nparms; - FStar_Syntax_Syntax.mutuals1 = uu___6;_}; - FStar_Syntax_Syntax.sigrng = uu___7; - FStar_Syntax_Syntax.sigquals = uu___8; - FStar_Syntax_Syntax.sigmeta = uu___9; - FStar_Syntax_Syntax.sigattrs = uu___10; - FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___11; - FStar_Syntax_Syntax.sigopts = uu___12;_} + FStar_Syntax_Syntax.mutuals1 = uu___6; + FStar_Syntax_Syntax.injective_type_params1 = + uu___7;_}; + FStar_Syntax_Syntax.sigrng = uu___8; + FStar_Syntax_Syntax.sigquals = uu___9; + FStar_Syntax_Syntax.sigmeta = uu___10; + FStar_Syntax_Syntax.sigattrs = uu___11; + FStar_Syntax_Syntax.sigopens_and_abbrevs = uu___12; + FStar_Syntax_Syntax.sigopts = uu___13;_} -> - let uu___13 = FStar_Syntax_Util.arrow_formals t in - (match uu___13 with + let uu___14 = FStar_Syntax_Util.arrow_formals t in + (match uu___14 with | (formals, c) -> if nparms < (FStar_Compiler_List.length formals) then - let uu___14 = + let uu___15 = FStar_Compiler_List.splitAt nparms formals in - (match uu___14 with - | (uu___15, fields) -> + (match uu___15 with + | (uu___16, fields) -> let fields1 = FStar_Compiler_List.filter (fun b -> @@ -8263,8 +8248,8 @@ let (try_lookup_record_type : with | FStar_Pervasives_Native.Some (FStar_Syntax_Syntax.Implicit - uu___16) -> false - | uu___16 -> true) fields in + uu___17) -> false + | uu___17 -> true) fields in let fields2 = FStar_Compiler_List.map (fun b -> @@ -8275,13 +8260,13 @@ let (try_lookup_record_type : FStar_TypeChecker_Env.is_record env typename in let r = - let uu___16 = + let uu___17 = FStar_Ident.ident_of_lid dc in { FStar_Syntax_DsEnv.typename = typename; FStar_Syntax_DsEnv.constrname = - uu___16; + uu___17; FStar_Syntax_DsEnv.parms = []; FStar_Syntax_DsEnv.fields = fields2; FStar_Syntax_DsEnv.is_private = diff --git a/ocaml/fstar-lib/generated/FStar_Universal.ml b/ocaml/fstar-lib/generated/FStar_Universal.ml index 34d55f874e0..73a13be47a2 100644 --- a/ocaml/fstar-lib/generated/FStar_Universal.ml +++ b/ocaml/fstar-lib/generated/FStar_Universal.ml @@ -1361,8 +1361,7 @@ let rec (tc_fold_interleave : (match uu___2 with | (remaining1, nmod, mllib, env) -> ((let uu___4 = - let uu___5 = - FStar_Options.profile_group_by_decls () in + let uu___5 = FStar_Options.profile_group_by_decl () in Prims.op_Negation uu___5 in if uu___4 then @@ -1375,6 +1374,8 @@ let rec (tc_fold_interleave : ((FStar_Compiler_List.op_At mods [nmod]), (FStar_Compiler_List.op_At mllibs (as_list env_before mllib)), env) remaining1))) +let (dbg_dep : Prims.bool FStar_Compiler_Effect.ref) = + FStar_Compiler_Debug.get_toggle "Dep" let (batch_mode_tc : Prims.string Prims.list -> FStar_Parser_Dep.deps -> @@ -1382,8 +1383,7 @@ let (batch_mode_tc : = fun filenames -> fun dep_graph -> - (let uu___1 = - FStar_Options.debug_at_level_no_module (FStar_Options.Other "Dep") in + (let uu___1 = FStar_Compiler_Effect.op_Bang dbg_dep in if uu___1 then (FStar_Compiler_Util.print_endline diff --git a/ocaml/fstar-tests/generated/FStar_Tests_Data.ml b/ocaml/fstar-tests/generated/FStar_Tests_Data.ml new file mode 100644 index 00000000000..c31ecd1a8eb --- /dev/null +++ b/ocaml/fstar-tests/generated/FStar_Tests_Data.ml @@ -0,0 +1,180 @@ +open Prims +let rec insert : + 'set . + Prims.int -> + (Prims.int, 'set) FStar_Class_Setlike.setlike -> 'set -> 'set + = + fun n -> + fun uu___ -> + fun s -> + if n = Prims.int_zero + then s + else + (let uu___2 = + Obj.magic + (FStar_Class_Setlike.add () (Obj.magic uu___) n (Obj.magic s)) in + insert (n - Prims.int_one) uu___ uu___2) +let rec all_mem : + 'set . + Prims.int -> + (Prims.int, 'set) FStar_Class_Setlike.setlike -> 'set -> Prims.bool + = + fun n -> + fun uu___ -> + fun s -> + if n = Prims.int_zero + then true + else + (FStar_Class_Setlike.mem () (Obj.magic uu___) n (Obj.magic s)) && + (all_mem (n - Prims.int_one) uu___ s) +let rec all_remove : + 'set . + Prims.int -> + (Prims.int, 'set) FStar_Class_Setlike.setlike -> 'set -> 'set + = + fun n -> + fun uu___ -> + fun s -> + if n = Prims.int_zero + then s + else + (let uu___2 = + Obj.magic + (FStar_Class_Setlike.remove () (Obj.magic uu___) n + (Obj.magic s)) in + all_remove (n - Prims.int_one) uu___ uu___2) +let (nn : Prims.int) = (Prims.of_int (10000)) +let (run_all : unit -> unit) = + fun uu___ -> + FStar_Compiler_Util.print_string "data tests\n"; + (let uu___2 = + FStar_Compiler_Util.record_time + (fun uu___3 -> + let uu___4 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Class_Ord.ord_int)) ()) in + insert nn + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Class_Ord.ord_int) uu___4) in + match uu___2 with + | (f, ms) -> + ((let uu___4 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) ms in + FStar_Compiler_Util.print1 "FlatSet insert: %s\n" uu___4); + (let uu___4 = + FStar_Compiler_Util.record_time + (fun uu___5 -> + all_mem nn + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Class_Ord.ord_int) f) in + match uu___4 with + | (f_ok, ms1) -> + ((let uu___6 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) ms1 in + FStar_Compiler_Util.print1 "FlatSet all_mem: %s\n" uu___6); + (let uu___6 = + FStar_Compiler_Util.record_time + (fun uu___7 -> + all_remove nn + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Class_Ord.ord_int) f) in + match uu___6 with + | (f1, ms2) -> + ((let uu___8 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) ms2 in + FStar_Compiler_Util.print1 "FlatSet all_remove: %s\n" + uu___8); + if Prims.op_Negation f_ok + then + FStar_Compiler_Effect.failwith + "FlatSet all_mem failed" + else (); + (let uu___10 = + let uu___11 = + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_FlatSet.setlike_flat_set + FStar_Class_Ord.ord_int)) (Obj.magic f1) in + Prims.op_Negation uu___11 in + if uu___10 + then + FStar_Compiler_Effect.failwith + "FlatSet all_remove failed" + else ()); + (let uu___10 = + FStar_Compiler_Util.record_time + (fun uu___11 -> + let uu___12 = + Obj.magic + (FStar_Class_Setlike.empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_int)) ()) in + insert nn + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_int) uu___12) in + match uu___10 with + | (rb, ms3) -> + ((let uu___12 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) ms3 in + FStar_Compiler_Util.print1 "RBSet insert: %s\n" + uu___12); + (let uu___12 = + FStar_Compiler_Util.record_time + (fun uu___13 -> + all_mem nn + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_int) rb) in + match uu___12 with + | (rb_ok, ms4) -> + ((let uu___14 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) + ms4 in + FStar_Compiler_Util.print1 + "RBSet all_mem: %s\n" uu___14); + (let uu___14 = + FStar_Compiler_Util.record_time + (fun uu___15 -> + all_remove nn + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_int) rb) in + match uu___14 with + | (rb1, ms5) -> + ((let uu___16 = + FStar_Class_Show.show + (FStar_Class_Show.printableshow + FStar_Class_Printable.printable_int) + ms5 in + FStar_Compiler_Util.print1 + "RBSet all_remove: %s\n" uu___16); + if Prims.op_Negation rb_ok + then + FStar_Compiler_Effect.failwith + "RBSet all_mem failed" + else (); + (let uu___18 = + let uu___19 = + FStar_Class_Setlike.is_empty () + (Obj.magic + (FStar_Compiler_RBSet.setlike_rbset + FStar_Class_Ord.ord_int)) + (Obj.magic rb1) in + Prims.op_Negation uu___19 in + if uu___18 + then + FStar_Compiler_Effect.failwith + "RBSet all_remove failed" + else ()))))))))))))) \ No newline at end of file diff --git a/ocaml/fstar-tests/generated/FStar_Tests_Test.ml b/ocaml/fstar-tests/generated/FStar_Tests_Test.ml index 51943f3372f..37482c0ceea 100644 --- a/ocaml/fstar-tests/generated/FStar_Tests_Test.ml +++ b/ocaml/fstar-tests/generated/FStar_Tests_Test.ml @@ -26,6 +26,7 @@ let main : 'uuuuu 'uuuuu1 . 'uuuuu -> 'uuuuu1 = if uu___8 then () else FStar_Compiler_Effect.exit Prims.int_one); + FStar_Tests_Data.run_all (); FStar_Compiler_Effect.exit Prims.int_zero) | FStar_Getopt.Success -> (FStar_Main.setup_hooks (); @@ -36,6 +37,7 @@ let main : 'uuuuu 'uuuuu1 . 'uuuuu -> 'uuuuu1 = if uu___8 then () else FStar_Compiler_Effect.exit Prims.int_one); + FStar_Tests_Data.run_all (); FStar_Compiler_Effect.exit Prims.int_zero)))) () with | FStar_Errors.Error (err, msg, r, _ctx) when diff --git a/ocaml/fstar-tests/generated/FStar_Tests_Unif.ml b/ocaml/fstar-tests/generated/FStar_Tests_Unif.ml index 64fefa85358..55912cfcad9 100644 --- a/ocaml/fstar-tests/generated/FStar_Tests_Unif.ml +++ b/ocaml/fstar-tests/generated/FStar_Tests_Unif.ml @@ -155,8 +155,11 @@ let (check_core : (let env = tcenv () in let res = if subtyping - then FStar_TypeChecker_Core.check_term_subtyping env x y - else FStar_TypeChecker_Core.check_term_equality env x y in + then + FStar_TypeChecker_Core.check_term_subtyping true true env x + y + else + FStar_TypeChecker_Core.check_term_equality true true env x y in (match res with | FStar_Pervasives.Inl (FStar_Pervasives_Native.None) -> let uu___2 = FStar_Compiler_Util.string_of_int i in @@ -286,50 +289,43 @@ let (run_all : unit -> Prims.bool) = match uu___13 with | (tm, us) -> let sol = FStar_Tests_Pars.tc "fun (x:Type0) -> Prims.pair x x" in - ((let uu___15 = - let uu___16 = - FStar_Options.debug_at_level_no_module - (FStar_Options.Other "Core") in - FStar_Compiler_Util.string_of_bool uu___16 in - FStar_Compiler_Util.print1 - "Processed args: debug_at_level Core? %s\n" uu___15); - unify_check (Prims.of_int (9)) [] tm sol + (unify_check (Prims.of_int (9)) [] tm sol FStar_TypeChecker_Common.Trivial - (fun uu___16 -> - let uu___17 = - let uu___18 = - let uu___19 = FStar_Compiler_List.hd us in - norm uu___19 in - let uu___19 = norm sol in - FStar_Tests_Util.term_eq uu___18 uu___19 in - FStar_Tests_Util.always (Prims.of_int (9)) uu___17); - (let uu___16 = - let uu___17 = + (fun uu___15 -> + let uu___16 = + let uu___17 = + let uu___18 = FStar_Compiler_List.hd us in + norm uu___18 in + let uu___18 = norm sol in + FStar_Tests_Util.term_eq uu___17 uu___18 in + FStar_Tests_Util.always (Prims.of_int (9)) uu___16); + (let uu___15 = + let uu___16 = FStar_Tests_Pars.tc "fun (u: int -> int -> int) (x:int) -> u x" in - inst Prims.int_one uu___17 in - match uu___16 with + inst Prims.int_one uu___16 in + match uu___15 with | (tm1, us1) -> let sol1 = FStar_Tests_Pars.tc "fun (x y:int) -> x + y" in (unify_check (Prims.of_int (10)) [] tm1 sol1 FStar_TypeChecker_Common.Trivial - (fun uu___18 -> - let uu___19 = - let uu___20 = - let uu___21 = FStar_Compiler_List.hd us1 in - norm uu___21 in - let uu___21 = norm sol1 in - FStar_Tests_Util.term_eq uu___20 uu___21 in - FStar_Tests_Util.always (Prims.of_int (10)) uu___19); + (fun uu___17 -> + let uu___18 = + let uu___19 = + let uu___20 = FStar_Compiler_List.hd us1 in + norm uu___20 in + let uu___20 = norm sol1 in + FStar_Tests_Util.term_eq uu___19 uu___20 in + FStar_Tests_Util.always (Prims.of_int (10)) uu___18); (let tm11 = FStar_Tests_Pars.tc "x:int -> y:int{eq2 y x} -> bool" in let tm2 = FStar_Tests_Pars.tc "x:int -> y:int -> bool" in - (let uu___19 = - let uu___20 = + (let uu___18 = + let uu___19 = FStar_Tests_Pars.tc "forall (x:int). (forall (y:int). y==x)" in - FStar_TypeChecker_Common.NonTrivial uu___20 in - unify1 (Prims.of_int (11)) [] tm11 tm2 uu___19); + FStar_TypeChecker_Common.NonTrivial uu___19 in + unify1 (Prims.of_int (11)) [] tm11 tm2 uu___18); (let tm12 = FStar_Tests_Pars.tc "a:Type0 -> b:(a -> Type0) -> x:a -> y:b x -> Tot Type0" in @@ -338,7 +334,7 @@ let (run_all : unit -> Prims.bool) = "a:Type0 -> b:(a -> Type0) -> x:a -> y:b x -> Tot Type0" in unify1 (Prims.of_int (12)) [] tm12 tm21 FStar_TypeChecker_Common.Trivial; - (let uu___20 = + (let uu___19 = let int_typ = FStar_Tests_Pars.tc "int" in let x1 = FStar_Syntax_Syntax.new_bv @@ -351,40 +347,40 @@ let (run_all : unit -> Prims.bool) = FStar_Syntax_Syntax.new_bv FStar_Pervasives_Native.None typ in let tm13 = - let uu___21 = - let uu___22 = - let uu___23 = FStar_Syntax_Syntax.bv_to_name q in - [uu___23] in - FStar_Tests_Util.app l uu___22 in - norm uu___21 in + let uu___20 = + let uu___21 = + let uu___22 = FStar_Syntax_Syntax.bv_to_name q in + [uu___22] in + FStar_Tests_Util.app l uu___21 in + norm uu___20 in let l1 = FStar_Tests_Pars.tc "fun (p:unit -> Type0) -> p" in let unit = FStar_Tests_Pars.tc "()" in let env = - let uu___21 = FStar_Tests_Pars.init () in - let uu___22 = - let uu___23 = FStar_Syntax_Syntax.mk_binder x1 in - let uu___24 = - let uu___25 = FStar_Syntax_Syntax.mk_binder q in - [uu___25] in - uu___23 :: uu___24 in - FStar_TypeChecker_Env.push_binders uu___21 uu___22 in - let uu___21 = + let uu___20 = FStar_Tests_Pars.init () in + let uu___21 = + let uu___22 = FStar_Syntax_Syntax.mk_binder x1 in + let uu___23 = + let uu___24 = FStar_Syntax_Syntax.mk_binder q in + [uu___24] in + uu___22 :: uu___23 in + FStar_TypeChecker_Env.push_binders uu___20 uu___21 in + let uu___20 = FStar_TypeChecker_Util.new_implicit_var "" FStar_Compiler_Range_Type.dummyRange env typ in - match uu___21 with - | (u_p, uu___22, uu___23) -> + match uu___20 with + | (u_p, uu___21, uu___22) -> let tm22 = - let uu___24 = - let uu___25 = FStar_Tests_Util.app l1 [u_p] in - norm uu___25 in - FStar_Tests_Util.app uu___24 [unit] in + let uu___23 = + let uu___24 = FStar_Tests_Util.app l1 [u_p] in + norm uu___24 in + FStar_Tests_Util.app uu___23 [unit] in (tm13, tm22, [x1; q]) in - match uu___20 with + match uu___19 with | (tm13, tm22, bvs_13) -> (unify1 (Prims.of_int (13)) bvs_13 tm13 tm22 FStar_TypeChecker_Common.Trivial; - (let uu___22 = + (let uu___21 = let int_typ = FStar_Tests_Pars.tc "int" in let x1 = FStar_Syntax_Syntax.new_bv @@ -397,47 +393,47 @@ let (run_all : unit -> Prims.bool) = FStar_Syntax_Syntax.new_bv FStar_Pervasives_Native.None typ in let tm14 = - let uu___23 = - let uu___24 = - let uu___25 = + let uu___22 = + let uu___23 = + let uu___24 = FStar_Syntax_Syntax.bv_to_name q in - [uu___25] in - FStar_Tests_Util.app l uu___24 in - norm uu___23 in + [uu___24] in + FStar_Tests_Util.app l uu___23 in + norm uu___22 in let l1 = FStar_Tests_Pars.tc "fun (p:pure_post unit) -> p" in let unit = FStar_Tests_Pars.tc "()" in let env = - let uu___23 = FStar_Tests_Pars.init () in - let uu___24 = - let uu___25 = + let uu___22 = FStar_Tests_Pars.init () in + let uu___23 = + let uu___24 = FStar_Syntax_Syntax.mk_binder x1 in - let uu___26 = - let uu___27 = + let uu___25 = + let uu___26 = FStar_Syntax_Syntax.mk_binder q in - [uu___27] in - uu___25 :: uu___26 in - FStar_TypeChecker_Env.push_binders uu___23 - uu___24 in - let uu___23 = + [uu___26] in + uu___24 :: uu___25 in + FStar_TypeChecker_Env.push_binders uu___22 + uu___23 in + let uu___22 = FStar_TypeChecker_Util.new_implicit_var "" FStar_Compiler_Range_Type.dummyRange env typ in - match uu___23 with - | (u_p, uu___24, uu___25) -> + match uu___22 with + | (u_p, uu___23, uu___24) -> let tm23 = - let uu___26 = - let uu___27 = + let uu___25 = + let uu___26 = FStar_Tests_Util.app l1 [u_p] in - norm uu___27 in - FStar_Tests_Util.app uu___26 [unit] in + norm uu___26 in + FStar_Tests_Util.app uu___25 [unit] in (tm14, tm23, [x1; q]) in - match uu___22 with + match uu___21 with | (tm14, tm23, bvs_14) -> (unify1 (Prims.of_int (14)) bvs_14 tm14 tm23 FStar_TypeChecker_Common.Trivial; - (let uu___24 = + (let uu___23 = FStar_Tests_Pars.pars_and_tc_fragment "let ty0 n = x:int { x >= n }\nlet ty1 n = x:ty0 n { x > n }\nassume val tc (t:Type0) : Type0"; (let t0 = FStar_Tests_Pars.tc "ty1 17" in @@ -445,11 +441,11 @@ let (run_all : unit -> Prims.bool) = FStar_Tests_Pars.tc "x:ty0 17 { x > 17 }" in (t0, t1)) in - match uu___24 with + match uu___23 with | (tm15, tm24) -> (check_core (Prims.of_int (15)) false false tm15 tm24; - (let uu___26 = + (let uu___25 = let t0 = FStar_Tests_Pars.tc "x:int { x >= 17 /\\ x > 17 }" in @@ -457,11 +453,11 @@ let (run_all : unit -> Prims.bool) = FStar_Tests_Pars.tc "x:ty0 17 { x > 17 }" in (t0, t1) in - match uu___26 with + match uu___25 with | (tm16, tm25) -> (check_core (Prims.of_int (16)) false false tm16 tm25; - (let uu___28 = + (let uu___27 = FStar_Tests_Pars.pars_and_tc_fragment "let defn17_0 (x:nat) : nat -> nat -> Type0 = fun y z -> a:int { a + x == y + z }"; (let t0 = @@ -483,12 +479,12 @@ let (run_all : unit -> Prims.bool) = FStar_Pervasives_Native.None)] t0.FStar_Syntax_Syntax.pos in (t0, t1)) in - match uu___28 with + match uu___27 with | (tm17, tm26) -> (check_core (Prims.of_int (17)) false false tm17 tm26; - (let uu___30 = + (let uu___29 = let t0 = FStar_Tests_Pars.tc "dp:((dtuple2 int (fun (y:int) -> z:int{ z > y })) <: Type0) { let (| x, _ |) = dp in x > 17 }" in @@ -496,13 +492,13 @@ let (run_all : unit -> Prims.bool) = FStar_Tests_Pars.tc "(dtuple2 int (fun (y:int) -> z:int{ z > y }))" in (t0, t1) in - match uu___30 with + match uu___29 with | (tm18, tm27) -> (check_core (Prims.of_int (18)) true false tm18 tm27; - (let uu___32 = + (let uu___31 = FStar_Tests_Pars.pars_and_tc_fragment "type vprop' = { t:Type0 ; n:nat }"; (let t0 = @@ -512,13 +508,13 @@ let (run_all : unit -> Prims.bool) = FStar_Tests_Pars.tc "x:bool{ x == false }" in (t0, t1)) in - match uu___32 with + match uu___31 with | (tm19, tm28) -> (check_core (Prims.of_int (19)) false false tm19 tm28; - (let uu___34 + (let uu___33 = let t0 = FStar_Tests_Pars.tc @@ -527,7 +523,7 @@ let (run_all : unit -> Prims.bool) = FStar_Tests_Pars.tc "j:(i:nat{ i > 17 } <: Type0){j > 42}" in (t0, t1) in - match uu___34 + match uu___33 with | (tm110, tm29) -> @@ -536,7 +532,7 @@ let (run_all : unit -> Prims.bool) = true true tm110 tm29; - (let uu___36 + (let uu___35 = FStar_Tests_Pars.pars_and_tc_fragment "assume val tstr21 (x:string) : Type0"; @@ -548,7 +544,7 @@ let (run_all : unit -> Prims.bool) = FStar_Tests_Pars.tc "bool -> int -> tstr21 \"hello\" -> bool" in (t0, ty)) in - match uu___36 + match uu___35 with | (tm3, ty) @@ -558,12 +554,12 @@ let (run_all : unit -> Prims.bool) = tm3 ty; FStar_Options.__clear_unit_tests (); - (let uu___40 + (let uu___39 = FStar_Compiler_Effect.op_Bang success in if - uu___40 + uu___39 then FStar_Compiler_Util.print_string "Unifier ok\n" diff --git a/ocaml/fstar-tests/generated/FStar_Tests_Util.ml b/ocaml/fstar-tests/generated/FStar_Tests_Util.ml index 2c8c8f06c83..9dc829fbdca 100644 --- a/ocaml/fstar-tests/generated/FStar_Tests_Util.ml +++ b/ocaml/fstar-tests/generated/FStar_Tests_Util.ml @@ -69,9 +69,8 @@ let rec (term_eq' : fun uu___1 -> match (uu___, uu___1) with | ((a, imp), (b, imp')) -> - (term_eq' a b) && - (let uu___2 = FStar_Syntax_Util.eq_aqual imp imp' in - uu___2 = FStar_Syntax_Util.Equal)) xs ys) in + (term_eq' a b) && (FStar_Syntax_Util.eq_aqual imp imp')) + xs ys) in let comp_eq c d = match ((c.FStar_Syntax_Syntax.n), (d.FStar_Syntax_Syntax.n)) with | (FStar_Syntax_Syntax.Total t, FStar_Syntax_Syntax.Total s) -> diff --git a/src/basic/FStar.Compiler.Debug.fst b/src/basic/FStar.Compiler.Debug.fst new file mode 100644 index 00000000000..c15927371a8 --- /dev/null +++ b/src/basic/FStar.Compiler.Debug.fst @@ -0,0 +1,99 @@ +(* + Copyright 2008-2020 Microsoft Research + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + +module FStar.Compiler.Debug + +module BU = FStar.Compiler.Util + +(* Mutable state *) +let anyref = BU.mk_ref false +let _debug_all : ref bool = BU.mk_ref false +let toggle_list : ref (list (string & ref bool)) = + BU.mk_ref [] + +type saved_state = { + toggles : list (string & bool); + any : bool; + all : bool; +} + +let snapshot () : saved_state = { + toggles = !toggle_list |> List.map (fun (k, r) -> (k, !r)); + any = !anyref; + all = !_debug_all; +} + +let register_toggle (k : string) : ref bool = + let r = BU.mk_ref false in + if !_debug_all then + r := true; + toggle_list := (k, r) :: !toggle_list; + r + +let get_toggle (k : string) : ref bool = + match List.tryFind (fun (k', _) -> k = k') !toggle_list with + | Some (_, r) -> r + | None -> register_toggle k + +let restore (snapshot : saved_state) : unit = + (* Set everything to false, then set all the saved ones + to true. *) + !toggle_list |> List.iter (fun (_, r) -> r := false); + snapshot.toggles |> List.iter (fun (k, b) -> + let r = get_toggle k in + r := b); + (* Also restore these references. *) + anyref := snapshot.any; + _debug_all := snapshot.all; + () + +let list_all_toggles () : list string = + List.map fst !toggle_list + +let any () = !anyref || !_debug_all +let enable () = anyref := true + +let dbg_level = BU.mk_ref 0 + +let low () = !dbg_level >= 1 || !_debug_all +let medium () = !dbg_level >= 2 || !_debug_all +let high () = !dbg_level >= 3 || !_debug_all +let extreme () = !dbg_level >= 4 || !_debug_all + +let set_level_low () = dbg_level := 1 +let set_level_medium () = dbg_level := 2 +let set_level_high () = dbg_level := 3 +let set_level_extreme () = dbg_level := 4 + +let enable_toggles (keys : list string) : unit = + if Cons? keys then enable (); + keys |> List.iter (fun k -> + if k = "Low" then set_level_low () + else if k = "Medium" then set_level_medium () + else if k = "High" then set_level_high () + else if k = "Extreme" then set_level_extreme () + else + let t = get_toggle k in + t := true + ) + +let disable_all () : unit = + anyref := false; + dbg_level := 0; + List.iter (fun (_, r) -> r := false) !toggle_list + +let set_debug_all () : unit = + _debug_all := true \ No newline at end of file diff --git a/src/basic/FStar.Compiler.Debug.fsti b/src/basic/FStar.Compiler.Debug.fsti new file mode 100644 index 00000000000..e5ab5dc3ad0 --- /dev/null +++ b/src/basic/FStar.Compiler.Debug.fsti @@ -0,0 +1,65 @@ +(* + Copyright 2008-2020 Microsoft Research + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + +module FStar.Compiler.Debug + +open FStar +open FStar.Compiler +open FStar.Compiler.Effect + +(* State handling for this module. Used by FStar.Options, which +is the only module that modifies the debug state. *) +val saved_state : Type0 +val snapshot () : saved_state +val restore (s:saved_state) : unit + +(* Enable debugging. This will make any() return true, but +does not enable any particular toggle. *) +val enable () : unit + +(* Are we doing *any* kind of debugging? *) +val any () : bool + +(* Obtain the toggle for a given debug key *) +val get_toggle (k : string) : ref bool + +(* List all registered toggles *) +val list_all_toggles () : list string + +(* Vanilla debug levels. Each level implies the previous lower one. *) +val low () : bool +val medium () : bool +val high () : bool +val extreme () : bool + +(* Enable a list of debug toggles. If will also call enable() +is key is non-empty, and will recognize "Low", "Medium", +"High", "Extreme" as special and call the corresponding +set_level_* function. *) +val enable_toggles (keys : list string) : unit + +(* Sets the debug level to zero and sets all registered toggles +to false. any() will return false after this. *) +val disable_all () : unit + +(* Nuclear option: enable ALL debug toggles. *) +val set_debug_all () : unit + +(* Not used externally at the moment. *) +val set_level_low () : unit +val set_level_medium () : unit +val set_level_high () : unit +val set_level_extreme () : unit diff --git a/src/basic/FStar.Compiler.Range.Ops.fst b/src/basic/FStar.Compiler.Range.Ops.fst index b08a5ffe172..6cf7eb0afd8 100644 --- a/src/basic/FStar.Compiler.Range.Ops.fst +++ b/src/basic/FStar.Compiler.Range.Ops.fst @@ -121,6 +121,10 @@ let json_of_def_range r = (start_of_range r) (end_of_range r) -instance show_range = { +instance showable_range = { show = string_of_range; } + +instance pretty_range = { + pp = (fun r -> Pprint.doc_of_string (string_of_range r)); +} diff --git a/src/basic/FStar.Compiler.Range.Ops.fsti b/src/basic/FStar.Compiler.Range.Ops.fsti index 84f6500ddde..9ab5cda9b6f 100644 --- a/src/basic/FStar.Compiler.Range.Ops.fsti +++ b/src/basic/FStar.Compiler.Range.Ops.fsti @@ -18,6 +18,7 @@ module FStar.Compiler.Range.Ops open FStar.Compiler.Range.Type open FStar.Compiler.Effect open FStar.Class.Show +open FStar.Class.PP val union_rng: rng -> rng -> rng val union_ranges: range -> range -> range @@ -47,4 +48,5 @@ val json_of_pos : pos -> Json.json val json_of_use_range : range -> Json.json val json_of_def_range : range -> Json.json -instance val show_range : showable range +instance val showable_range : showable range +instance val pretty_range : pretty range diff --git a/src/basic/FStar.Defensive.fst b/src/basic/FStar.Defensive.fst index d176b1c04d5..2333de123eb 100644 --- a/src/basic/FStar.Defensive.fst +++ b/src/basic/FStar.Defensive.fst @@ -9,6 +9,7 @@ open FStar.Class.Ord open FStar.Errors open FStar.Errors.Msg open FStar.Pprint +open FStar.Class.Setlike let () = let open FStar.Syntax.Print in () @@ -24,24 +25,24 @@ instance pp_bv : pretty FStar.Syntax.Syntax.bv = { pp = (fun bv -> arbitrary_string (show bv)); } -instance pp_set #a (_ : ord a) (_ : pretty a) : Tot (pretty (Set.set a)) = { +instance pp_set #a (_ : ord a) (_ : pretty a) : Tot (pretty (FlatSet.t a)) = { pp = (fun s -> let doclist (ds : list Pprint.document) : Pprint.document = surround_separate 2 0 (doc_of_string "[]") lbracket (semi ^^ break_ 1) rbracket ds in - doclist (Set.elems s |> List.map pp)) + doclist (elems s |> List.map pp)) } let __def_check_scoped rng msg env thing = let free = freeNames thing in let scope = boundNames env in - if not (Set.subset free scope) then + if not (subset free scope) then Errors.log_issue_doc rng (Errors.Warning_Defensive, [ text "Internal: term is not well-scoped " ^/^ parens (doc_of_string msg); text "t =" ^/^ pp thing; text "FVs =" ^/^ pp free; text "Scope =" ^/^ pp scope; - text "Diff =" ^/^ pp (Set.diff free scope); + text "Diff =" ^/^ pp (diff free scope); ]) let def_check_scoped rng msg env thing = diff --git a/src/basic/FStar.Errors.Msg.fst b/src/basic/FStar.Errors.Msg.fst index 230b36cda20..f7dd92e0c19 100644 --- a/src/basic/FStar.Errors.Msg.fst +++ b/src/basic/FStar.Errors.Msg.fst @@ -33,7 +33,7 @@ let backtrace_doc () : document = text "Stack trace:" ^/^ arbitrary_string (trim_string s) -let subdoc d = +let subdoc' (indent:bool) d = (* NOTE: slight hack here, using equality on Pprint documents. This works fine, particularly for this case, since empty is just a constructor Empty. There is even a new function to check if a document is empty, added two weeks ago! @@ -42,7 +42,9 @@ let subdoc d = switch to using that function. (I won't right now as it is not released). *) if d = empty then empty - else blank 2 ^^ doc_of_string "-" ^^ blank 1 ^^ align d ^^ hardline + else (if indent then blank 2 else empty) ^^ doc_of_string "-" ^^ blank 1 ^^ align d ^^ hardline + +let subdoc d = subdoc' true d let rendermsg (ds : list document) : string = renderdoc (concat (List.map (fun d -> subdoc (group d)) ds)) diff --git a/src/basic/FStar.Errors.Msg.fsti b/src/basic/FStar.Errors.Msg.fsti index 50a945cafe5..984c94a4fe3 100644 --- a/src/basic/FStar.Errors.Msg.fsti +++ b/src/basic/FStar.Errors.Msg.fsti @@ -41,6 +41,9 @@ one, but if that's the case it's probably better to build a doc instead of lifting from a string. NB: mkmsg s is equal to [doc_of_string s]. *) val mkmsg : string -> error_message +(* As subdoc, but allows to not indent. *) +val subdoc' : indent:bool -> document -> document + (* A nested document that can be concatenated with another one *) val subdoc : document -> document diff --git a/src/basic/FStar.Errors.fst b/src/basic/FStar.Errors.fst index 21f10308208..317cf8a2e1c 100644 --- a/src/basic/FStar.Errors.fst +++ b/src/basic/FStar.Errors.fst @@ -17,6 +17,7 @@ module FStar.Errors open FStar.Pervasives open FStar.String +open FStar.Compiler open FStar.Compiler.Effect open FStar.Compiler.List open FStar.Compiler.Util @@ -182,6 +183,9 @@ let format_issue' (print_hdr:bool) (issue:issue) : string = List.fold_left (fun l r -> l ^^ hardline ^^ d1 r) (d1 h) t | _ -> empty in + (* We only indent if we are are printing the header. I.e., only ident for batch errors, + not for VS code diagnostics window. *) + let subdoc = subdoc' print_hdr in let mainmsg : document = concat (List.map (fun d -> subdoc (group d)) issue.issue_msg) in @@ -199,7 +203,7 @@ let format_issue issue : string = format_issue' true issue let print_issue issue = let printer = match issue.issue_level with - | EInfo -> (fun s -> BU.print_string (colorize_magenta s)) + | EInfo -> (fun s -> BU.print_string (colorize_cyan s)) | EWarning -> BU.print_warning | EError -> BU.print_error | ENotImplemented -> BU.print_error in @@ -253,7 +257,7 @@ let mk_default_handler print = err_count := 1 + !err_count); begin match e.issue_level with | EInfo -> print_issue e - | _ when print && Options.debug_any () -> print_issue e + | _ when print && Debug.any () -> print_issue e | _ -> issues := e :: !issues end; if Options.defensive_abort () && e.issue_number = Some defensive_errno then @@ -352,7 +356,7 @@ let maybe_add_backtrace (msg : error_message) : error_message = msg let diag_doc r msg = - if Options.debug_any() then + if Debug.any() then let msg = maybe_add_backtrace msg in let ctx = get_ctx () in add_one (mk_issue EInfo (Some r) msg None ctx) @@ -361,7 +365,7 @@ let diag r msg = diag_doc r (mkmsg msg) let diag0 msg = - if Options.debug_any() + if Debug.any() then add_one (mk_issue EInfo None (mkmsg msg) None []) let diag1 f a = diag0 (BU.format1 f a) diff --git a/src/basic/FStar.Options.fst b/src/basic/FStar.Options.fst index c95fc04e594..29c84f73fcf 100644 --- a/src/basic/FStar.Options.fst +++ b/src/basic/FStar.Options.fst @@ -89,42 +89,54 @@ let copy_optionstate m = Util.smap_copy m * * No stack should ever be empty! Any of these failwiths should never be * triggered externally. IOW, the API should protect this invariant. + * + * We also keep a snapshot of the Debug module's state. *) -let fstar_options : ref (list (list optionstate)) = Util.mk_ref [] +let fstar_options : ref (list (list (Debug.saved_state & optionstate))) = Util.mk_ref [] -let internal_peek () = List.hd (List.hd !fstar_options) +let internal_peek () = snd <| List.hd (List.hd !fstar_options) let peek () = copy_optionstate (internal_peek()) let pop () = // already signal-atomic - match !fstar_options with - | [] - | [_] -> failwith "TOO MANY POPS!" - | _::tl -> fstar_options := tl + match !fstar_options with + | [] + | [_] -> failwith "TOO MANY POPS!" + | _::tl -> + fstar_options := tl + let push () = // already signal-atomic - fstar_options := List.map copy_optionstate (List.hd !fstar_options) :: !fstar_options + let new_st = + List.hd !fstar_options |> + List.map (fun (dbg, opts) -> (dbg, copy_optionstate opts)) + in + fstar_options := new_st :: !fstar_options let internal_pop () = - let curstack = List.hd !fstar_options in - match curstack with - | [] -> failwith "impossible: empty current option stack" - | [_] -> false - | _::tl -> (fstar_options := tl :: List.tl !fstar_options; true) + let curstack = List.hd !fstar_options in + match curstack with + | [] -> failwith "impossible: empty current option stack" + | [_] -> false + | _::tl -> + fstar_options := tl :: List.tl !fstar_options; + Debug.restore (fst (List.hd tl)); + true let internal_push () = - let curstack = List.hd !fstar_options in - let stack' = copy_optionstate (List.hd curstack) :: curstack in - fstar_options := stack' :: List.tl !fstar_options + let curstack = List.hd !fstar_options in + let stack' = (Debug.snapshot (), copy_optionstate (snd <| List.hd curstack)) :: curstack in + fstar_options := stack' :: List.tl !fstar_options let set o = - match !fstar_options with - | [] -> failwith "set on empty option stack" - | []::_ -> failwith "set on empty current option stack" - | (_::tl)::os -> fstar_options := ((o::tl)::os) + match !fstar_options with + | [] -> failwith "set on empty option stack" + | []::_ -> failwith "set on empty current option stack" + | ((dbg, _)::tl)::os -> + fstar_options := (((dbg, o)::tl)::os) let snapshot () = Common.snapshot push fstar_options () let rollback depth = Common.rollback pop fstar_options depth let set_option k v = - let map = internal_peek() in + let map : optionstate = internal_peek() in if k = "report_assumes" then match Util.smap_try_find map k with | Some (String "error") -> @@ -153,9 +165,10 @@ let defaults = ("cmi" , Bool false); ("codegen" , Unset); ("codegen-lib" , List []); - ("debug" , List []); - ("debug_level" , List []); ("defensive" , String "no"); + ("debug" , List []); + ("debug_all" , Bool false); + ("debug_all_modules" , Bool false); ("dep" , Unset); ("detail_errors" , Bool false); ("detail_hint_replay" , Bool false); @@ -281,7 +294,7 @@ let init () = let clear () = let o = Util.smap_create 50 in - fstar_options := [[o]]; //clear and reset the options stack + fstar_options := [[(Debug.snapshot (), o)]]; //clear and reset the options stack init() let _run = clear() @@ -347,8 +360,6 @@ let get_print_cache_version () = lookup_opt "print_cache_version" let get_cmi () = lookup_opt "cmi" as_bool let get_codegen () = lookup_opt "codegen" (as_option as_string) let get_codegen_lib () = lookup_opt "codegen-lib" (as_list as_string) -let get_debug () = lookup_opt "debug" as_comma_string_list -let get_debug_level () = lookup_opt "debug_level" as_comma_string_list let get_defensive () = lookup_opt "defensive" as_string let get_dep () = lookup_opt "dep" (as_option as_string) let get_detail_errors () = lookup_opt "detail_errors" as_bool @@ -460,20 +471,6 @@ let get_profile () = lookup_opt "profile" let get_profile_group_by_decl () = lookup_opt "profile_group_by_decl" as_bool let get_profile_component () = lookup_opt "profile_component" (as_option (as_list as_string)) -let dlevel = function - | "Low" -> Low - | "Medium" -> Medium - | "High" -> High - | "Extreme" -> Extreme - | s -> Other s -let one_debug_level_geq l1 l2 = match l1 with - | Other _ - | Low -> l1 = l2 - | Medium -> (l2 = Low || l2 = Medium) - | High -> (l2 = Low || l2 = Medium || l2 = High) - | Extreme -> (l2 = Low || l2 = Medium || l2 = High || l2 = Extreme) -let debug_level_geq l2 = get_debug_level() |> Util.for_some (fun l1 -> one_debug_level_geq (dlevel l1) l2) - // Note: the "ulib/fstar" is for the case where package is installed in the // standard "unix" way (e.g. opam) and the lib directory is $PREFIX/lib/fstar let universe_include_path_base_dirs = @@ -494,6 +491,10 @@ let display_version () = Util.print_string (Util.format5 "F* %s\nplatform=%s\ncompiler=%s\ndate=%s\ncommit=%s\n" !_version !_platform !_compiler !_date !_commit) +let display_debug_keys () = + let keys = Debug.list_all_toggles () in + keys |> List.sortWith String.compare |> List.iter (fun s -> Util.print_string (s ^ "\n")) + let display_usage_aux specs = let open FStar.Pprint in let open FStar.Errors.Msg in @@ -737,15 +738,32 @@ let rec specs_with_types warn_unsafe : list (char * string * opt_type * Pprint.d Accumulated (SimpleStr "namespace"), text "External runtime library (i.e. M.N.x extracts to M.N.X instead of M_N.x)"); - ( noshort, + ( 'd', "debug", - Accumulated (SimpleStr "module_name"), - text "Print lots of debugging information while checking module"); - - ( noshort, - "debug_level", - Accumulated (OpenEnumStr (["Low"; "Medium"; "High"; "Extreme"], "...")), - text "Control the verbosity of debugging info"); + PostProcessed ( + (fun o -> + let keys = as_comma_string_list o in + Debug.enable_toggles keys; + o), Accumulated (SimpleStr "debug toggles")), + text "Debug toggles (comma-separated list of debug keys)"); + + ( noshort, + "debug_all", + PostProcessed ( + (fun o -> + match o with + | Bool true -> + Debug.set_debug_all (); + o + | _ -> failwith "?" + ), Const (Bool true)), + text "Enable all debug toggles. WARNING: this will cause a lot of output!"); + + ( noshort, + "debug_all_modules", + Const (Bool true), + text "Enable to make the effect of --debug apply to every module processed by the compiler, \ + including dependencies."); ( noshort, "defensive", @@ -1246,7 +1264,7 @@ let rec specs_with_types warn_unsafe : list (char * string * opt_type * Pprint.d Const (Bool true), text "Print the time it takes to verify each top-level definition. \ This is just an alias for an invocation of the profiler, so it may not work well if combined with --profile. \ - In particular, it implies --profile_group_by_decls."); + In particular, it implies --profile_group_by_decl."); ( noshort, "trace_error", @@ -1429,7 +1447,13 @@ let rec specs_with_types warn_unsafe : list (char * string * opt_type * Pprint.d "help", WithSideEffect ((fun _ -> display_usage_aux (specs warn_unsafe); exit 0), (Const (Bool true))), - text "Display this information") + text "Display this information"); + + ( noshort, + "list_debug_keys", + WithSideEffect ((fun _ -> display_debug_keys(); exit 0), + (Const (Bool true))), + text "List all debug keys and exit"); ] and specs (warn_unsafe:bool) : list (FStar.Getopt.opt & Pprint.document) = @@ -1449,7 +1473,8 @@ let settable = function | "compat_pre_typed_indexed_effects" | "disallow_unification_guards" | "debug" - | "debug_level" + | "debug_all" + | "debug_all_modules" | "defensive" | "detail_errors" | "detail_hint_replay" @@ -1804,13 +1829,8 @@ let codegen () = (fun s -> parse_codegen s |> must) let codegen_libs () = get_codegen_lib () |> List.map (fun x -> Util.split x ".") -let debug_any () = get_debug () <> [] -let debug_module modul = (get_debug () |> List.existsb (module_name_eq modul)) -let debug_at_level_no_module level = debug_level_geq level -let debug_at_level modul level = debug_module modul && debug_at_level_no_module level - -let profile_group_by_decls () = get_profile_group_by_decl () +let profile_group_by_decl () = get_profile_group_by_decl () let defensive () = get_defensive () <> "no" let defensive_error () = get_defensive () = "error" let defensive_abort () = get_defensive () = "abort" @@ -1944,6 +1964,10 @@ let use_nbe_for_extraction () = get_use_nbe_for_extraction () let trivial_pre_for_unannotated_effectful_fns () = get_trivial_pre_for_unannotated_effectful_fns () +let debug_keys () = lookup_opt "debug" as_comma_string_list +let debug_all () = lookup_opt "debug_all" as_bool +let debug_all_modules () = lookup_opt "debug_all_modules" as_bool + let with_saved_options f = // take some care to not mess up the stack on errors // (unless we're trying to track down an error) diff --git a/src/basic/FStar.Options.fsti b/src/basic/FStar.Options.fsti index 7605213f317..9168dab155d 100644 --- a/src/basic/FStar.Options.fsti +++ b/src/basic/FStar.Options.fsti @@ -23,13 +23,6 @@ open FStar.Compiler //let __test_norm_all = Util.mk_ref false -type debug_level_t = - | Low - | Medium - | High - | Extreme - | Other of string - type split_queries_t = | No | OnFailure | Always type option_val = @@ -56,7 +49,7 @@ type opt_type = | EnumStr of list string // --codegen OCaml | OpenEnumStr of list string (* suggested values (not exhaustive) *) * string (* label *) - // --debug_level … + // --debug … | PostProcessed of ((option_val -> option_val) (* validator *) * opt_type (* elem spec *)) // For options like --extract_module that require post-processing or validation | Accumulated of opt_type (* elem spec *) @@ -117,7 +110,7 @@ val codegen : unit -> option codegen_t val parse_codegen : string -> option codegen_t val codegen_libs : unit -> list (list string) val profile_enabled : module_name:option string -> profile_phase:string -> bool -val profile_group_by_decls : unit -> bool +val profile_group_by_decl : unit -> bool val defensive : unit -> bool // true if checks should be performed val defensive_error : unit -> bool // true if "error" val defensive_abort : unit -> bool // true if "abort" @@ -249,19 +242,12 @@ val use_nbe_for_extraction : unit -> bool val trivial_pre_for_unannotated_effectful_fns : unit -> bool -(* True iff the user passed '--debug M' for some M *) -val debug_any : unit -> bool - -(* True for M when the user passed '--debug M' *) -val debug_module : string -> bool - -(* True for M and L when the user passed '--debug M --debug_level L' - * (and possibly more) *) -val debug_at_level : string -> debug_level_t -> bool +(* List of enabled debug toggles. *) +val debug_keys : unit -> list string -(* True for L when the user passed '--debug_level L' - * (and possibly more, but independent of --debug) *) -val debug_at_level_no_module : debug_level_t -> bool +(* Whether we are debugging every module and not just the ones +in the cmdline. *) +val debug_all_modules : unit -> bool // HACK ALERT! This is to ensure we have no dependency from Options to Version, // otherwise, since Version is regenerated all the time, this invalidates the diff --git a/src/class/FStar.Class.Binders.fst b/src/class/FStar.Class.Binders.fst index 7f48a989d73..da81f383375 100644 --- a/src/class/FStar.Class.Binders.fst +++ b/src/class/FStar.Class.Binders.fst @@ -4,7 +4,7 @@ open FStar.Compiler open FStar.Compiler.Effect open FStar.Compiler.Range open FStar.Compiler.Util -open FStar.Compiler.Set +open FStar.Compiler.FlatSet open FStar.Syntax.Syntax module F = FStar.Syntax.Free open FStar.Errors @@ -18,12 +18,12 @@ instance hasNames_comp : hasNames comp = { freeNames = (fun c -> match c.n with | Total t | GTotal t -> F.names t - | Comp ct -> List.fold_left Set.union (Set.empty ()) + | Comp ct -> List.fold_left union (empty ()) (F.names ct.result_typ :: (List.map (fun (a,_) -> F.names a) ct.effect_args))) } instance hasBinders_list_bv = { - boundNames = Set.from_list; + boundNames = from_list; } instance hasBinders_set_bv = { diff --git a/src/class/FStar.Class.Binders.fsti b/src/class/FStar.Class.Binders.fsti index ae5ee389b2c..2c4c13bbef7 100644 --- a/src/class/FStar.Class.Binders.fsti +++ b/src/class/FStar.Class.Binders.fsti @@ -1,19 +1,20 @@ module FStar.Class.Binders open FStar.Compiler.Util -open FStar.Compiler.Set +open FStar.Compiler.FlatSet open FStar.Syntax.Syntax +(* TODO: should be for any setlike *) class hasNames (a:Type) = { - freeNames : a -> set bv; + freeNames : a -> flat_set bv; } class hasBinders (a:Type) = { - boundNames : a -> set bv; + boundNames : a -> flat_set bv; } instance val hasNames_term : hasNames term instance val hasNames_comp : hasNames comp instance val hasBinders_list_bv : hasBinders (list bv) -instance val hasBinders_set_bv : hasBinders (set bv) +instance val hasBinders_set_bv : hasBinders (flat_set bv) diff --git a/src/class/FStar.Class.Setlike.fst b/src/class/FStar.Class.Setlike.fst new file mode 100644 index 00000000000..ab9963f178c --- /dev/null +++ b/src/class/FStar.Class.Setlike.fst @@ -0,0 +1,6 @@ +module FStar.Class.Setlike + +open FStar.Compiler.Effect +open FStar.Class.Ord + +let symdiff s1 s2 = diff s1 s2 diff --git a/src/class/FStar.Class.Setlike.fsti b/src/class/FStar.Class.Setlike.fsti new file mode 100644 index 00000000000..edfa7d4b8e2 --- /dev/null +++ b/src/class/FStar.Class.Setlike.fsti @@ -0,0 +1,28 @@ +module FStar.Class.Setlike + +open FStar.Compiler.Effect +open FStar.Class.Ord + +[@@Tactics.Typeclasses.fundeps [0]] +class setlike (e:Type) (s:Type) = { + empty : unit -> s; + singleton : e -> s; + is_empty : s -> bool; + add : e -> s -> s; + remove : e -> s -> s; + mem : e -> s -> bool; + equal : s -> s -> bool; + subset : s -> s -> bool; + union : s -> s -> s; + inter : s -> s -> s; + diff : s -> s -> s; + for_all : (e -> bool) -> s -> bool; + for_any : (e -> bool) -> s -> bool; + elems : s -> list e; + + collect : (e -> s) -> list e -> s; + from_list : list e -> s; + addn : list e -> s -> s; +} + +val symdiff (#e #s : Type) {| setlike e s |} : s -> s -> s diff --git a/src/data/FStar.Compiler.Set.fst b/src/data/FStar.Compiler.FlatSet.fst similarity index 54% rename from src/data/FStar.Compiler.Set.fst rename to src/data/FStar.Compiler.FlatSet.fst index 7dd53f4f918..1d8a54231be 100644 --- a/src/data/FStar.Compiler.Set.fst +++ b/src/data/FStar.Compiler.FlatSet.fst @@ -16,7 +16,7 @@ limitations under the License. *) -module FStar.Compiler.Set +module FStar.Compiler.FlatSet open FStar.Class.Ord open FStar.Compiler.Effect @@ -29,46 +29,85 @@ the exact order of `elems` provided by this list representation, so we cannot (yet) do big changes here. *) (* Inv: no duplication. We are left-biased. *) -let set t = list t +let flat_set t = list t +val add (#a:Type) {| ord a |} : a -> flat_set a -> flat_set a let rec add x s = match s with | [] -> [x] | y::yy -> if x =? y then s else y :: add x yy +val empty (#a:Type) : unit -> flat_set a let empty () = [] +val from_list (#a:Type) {| ord a |} : list a -> flat_set a let from_list xs = dedup xs +val mem (#a:Type) {| ord a |} : a -> flat_set a -> bool let mem x s = List.existsb (fun y -> x =? y) s +val singleton (#a:Type) {| ord a |} : a -> flat_set a let singleton x = [x] +val is_empty (#a:Type) : flat_set a -> bool let is_empty s = Nil? s +val addn (#a:Type) {| ord a |} : list a -> flat_set a -> flat_set a let addn xs ys = List.fold_right add xs ys +val remove (#a:Type) {| ord a |} : a -> flat_set a -> flat_set a let rec remove x s = match s with | [] -> [] | y::yy -> if x =? y then yy else y :: remove x yy +val elems (#a:Type) : flat_set a -> list a let elems s = s +val for_all (#a:Type) : (a -> bool) -> flat_set a -> bool let for_all p s = elems s |> List.for_all p + +val for_any (#a:Type) : (a -> bool) -> flat_set a -> bool let for_any p s = elems s |> List.existsb p +val subset (#a:Type) {| ord a |} : flat_set a -> flat_set a -> bool let subset s1 s2 = for_all (fun y -> mem y s2) s1 + +val equal (#a:Type) {| ord a |} : flat_set a -> flat_set a -> bool let equal s1 s2 = sort s1 =? sort s2 +val union (#a:Type) {| ord a |} : flat_set a -> flat_set a -> flat_set a let union s1 s2 = List.fold_left (fun s x -> add x s) s1 s2 -let inter s1 s2 = List.filter (fun y -> mem y s2) s1 -let diff s1 s2 = List.filter (fun y -> not (mem y s2)) s1 +val inter (#a:Type) {| ord a |} : flat_set a -> flat_set a -> flat_set a +let inter s1 s2 = List.filter (fun y -> mem y s2) s1 +val diff (#a:Type) {| ord a |} : flat_set a -> flat_set a -> flat_set a +let diff s1 s2 = List.filter (fun y -> not (mem y s2)) s1 +val collect (#a #b:Type) {| ord b |} : (a -> flat_set b) -> list a -> flat_set b let collect f l = List.fold_right (fun x acc -> f x `union` acc) l (empty ()) -instance showable_set (a:Type) (_ : ord a) (_ : showable a) : Tot (showable (set a)) = { +instance showable_set (a:Type) (_ : ord a) (_ : showable a) : Tot (showable (flat_set a)) = { show = (fun s -> show (elems s)); } + +instance setlike_flat_set (a:Type) (_ : ord a) : Tot (setlike a (flat_set a)) = { + empty = empty; + from_list = from_list; + singleton = singleton; + is_empty = is_empty; + add = add; + addn = addn; + remove = remove; + mem = mem; + elems = elems; + for_all = for_all; + for_any = for_any; + subset = subset; + equal = equal; + union = union; + inter = inter; + diff = diff; + collect = collect; +} diff --git a/src/data/FStar.Compiler.FlatSet.fsti b/src/data/FStar.Compiler.FlatSet.fsti new file mode 100644 index 00000000000..fbc5939fe01 --- /dev/null +++ b/src/data/FStar.Compiler.FlatSet.fsti @@ -0,0 +1,33 @@ +(* + Copyright 2008-2017 Microsoft Research + + Authors: Aseem Rastogi, Nikhil Swamy, Jonathan Protzenko + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + +module FStar.Compiler.FlatSet + +open FStar.Class.Ord +open FStar.Class.Show +open FStar.Class.Setlike +include FStar.Class.Setlike + +val flat_set (a:Type0) : Type0 +type t = flat_set + +instance +val showable_set (a:Type) (_ : ord a) (_ : showable a) : Tot (showable (flat_set a)) + +instance +val setlike_flat_set (a:Type0) (_ : ord a) : Tot (setlike a (flat_set a)) diff --git a/src/data/FStar.Compiler.RBSet.fst b/src/data/FStar.Compiler.RBSet.fst new file mode 100644 index 00000000000..a8245ddecf0 --- /dev/null +++ b/src/data/FStar.Compiler.RBSet.fst @@ -0,0 +1,173 @@ +(* + Copyright 2008-2017 Microsoft Research + + Authors: Aseem Rastogi, Nikhil Swamy, Jonathan Protzenko + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + +module FStar.Compiler.RBSet + +open FStar.Class.Ord +open FStar.Class.Show +open FStar.Class.Setlike + +include FStar.Class.Setlike + +type color = | R | B + +type rbset (a:Type0) : Type0 = + | L + | N of color * rbset a * a * rbset a + +let empty () = L + +let singleton (x:'a) : rbset 'a = N (R, L, x, L) + +let is_empty = L? + +let balance c l x r = + match c, l, x, r with + | B, N (R, N (R, a, x, b), y, c), z, d + | B, a, x, N (R, N (R, b, y, c), z, d) + | B, N (R, a, x, N (R, b, y, c)), z, d + | B, a, x, N (R, b, y, N (R, c, z, d)) -> + N (R, N (B, a, x, b), y, N (B, c, z, d)) + | c, l, x, r -> N (c, l, x, r) + +let blackroot (t:rbset 'a{N? t}) : rbset 'a = + match t with + | N (_, l, x, r) -> N (B, l, x, r) + +let add {| ord 'a |} (x:'a) (s:rbset 'a) : rbset 'a = + let rec add' (s:rbset 'a) : rbset 'a = + match s with + | L -> N (R, L, x, L) + | N (c, a, y, b) -> + if x ? y then balance c a y (add' b) + else s + in + blackroot (add' s) + +let rec extract_min #a {| ord a |} (t : rbset a{N? t}) : rbset a & a = + match t with + | N (_, L, x, r) -> r, x + | N (c, a, x, b) -> + let (a', y) = extract_min a in + balance c a' x b, y + +(* This is not the right way, see https://www.cs.cornell.edu/courses/cs3110/2020sp/a4/deletion.pdf +for how to do it. But if we reach that complexity, I would like for +this whole module to be verified. *) +let rec remove {| ord 'a |} (x:'a) (t:rbset 'a) : rbset 'a = + match t with + | L -> L + | N (c, l, y, r) -> + if x ? y then balance c l y (remove x r) + else + if L? r + then + l + else + let (r', y') = extract_min r in + balance c l y' r' + +let rec mem {| ord 'a |} (x:'a) (s:rbset 'a) : bool = + match s with + | L -> false + | N (_, a, y, b) -> + if x ? y then mem x b + else true + +let rec elems (s:rbset 'a) : list 'a = + match s with + | L -> [] + | N (_, a, x, b) -> elems a @ [x] @ elems b + +let equal {| ord 'a |} (s1:rbset 'a) (s2:rbset 'a) : bool = + elems s1 =? elems s2 + +let rec union {| ord 'a |} (s1:rbset 'a) (s2:rbset 'a) : rbset 'a = + match s1 with + | L -> s2 + | N (c, a, x, b) -> union a (union b (add x s2)) + +let inter {| ord 'a |} (s1:rbset 'a) (s2:rbset 'a) : rbset 'a = + let rec aux (s1:rbset 'a) (acc : rbset 'a) : rbset 'a = + match s1 with + | L -> acc + | N (_, a, x, b) -> + if mem x s2 + then add x (aux a (aux b acc)) + else aux a (aux b acc) + in + aux s1 L + +let rec diff {| ord 'a |} (s1:rbset 'a) (s2:rbset 'a) : rbset 'a = + match s2 with + | L -> s1 + | N (_, a, x, b) -> diff (diff (remove x s1) a) b + +let rec subset {| ord 'a |} (s1:rbset 'a) (s2:rbset 'a) : bool = + match s1 with + | L -> true + | N (_, a, x, b) -> mem x s2 && subset a s2 && subset b s2 + +let rec for_all (p:'a -> bool) (s:rbset 'a) : bool = + match s with + | L -> true + | N (_, a, x, b) -> p x && for_all p a && for_all p b + +let rec for_any (p:'a -> bool) (s:rbset 'a) : bool = + match s with + | L -> false + | N (_, a, x, b) -> p x || for_any p a || for_any p b + +// Make this faster +let from_list {| ord 'a |} (xs : list 'a) : rbset 'a = + List.fold_left (fun s e -> add e s) L xs + +let addn {| ord 'a |} (xs : list 'a) (s : rbset 'a) : rbset 'a = + List.fold_left (fun s e -> add e s) s xs + +let collect #a {| ord a |} (f : a -> rbset a) + (l : list a) : rbset a = + List.fold_left (fun s e -> union (f e) s) L l + +instance setlike_rbset (a:Type) (_ : ord a) : Tot (setlike a (rbset a)) = { + empty = empty; + singleton = singleton; + is_empty = is_empty; + add = add; + remove = remove; + mem = mem; + equal = equal; + subset = subset; + union = union; + inter = inter; + diff = diff; + for_all = for_all; + for_any = for_any; + elems = elems; + + collect = collect; + from_list = from_list; + addn = addn; +} + +instance showable_rbset (a:Type) (_ : showable a) : Tot (showable (rbset a)) = { + show = (fun s -> "RBSet " ^ show (elems s)); +} diff --git a/tests/micro-benchmarks/NegativeTests.ZZImplicitFalse.fst b/src/data/FStar.Compiler.RBSet.fsti similarity index 56% rename from tests/micro-benchmarks/NegativeTests.ZZImplicitFalse.fst rename to src/data/FStar.Compiler.RBSet.fsti index 6ae82c4e5f5..9f0ba48a0b5 100644 --- a/tests/micro-benchmarks/NegativeTests.ZZImplicitFalse.fst +++ b/src/data/FStar.Compiler.RBSet.fsti @@ -1,5 +1,7 @@ (* - Copyright 2008-2018 Microsoft Research + Copyright 2008-2017 Microsoft Research + + Authors: Aseem Rastogi, Nikhil Swamy, Jonathan Protzenko Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. @@ -13,8 +15,21 @@ See the License for the specific language governing permissions and limitations under the License. *) -module NegativeTests.ZZImplicitFalse -val wtf: unit -> Lemma False -[@@ expect_failure] // error 19 (assertion failed) on 1-phase, error 66 (failed to resolve impl) on 2-phase -let wtf _ = let _:False = _ in () +module FStar.Compiler.RBSet + +open FStar.Class.Ord +open FStar.Class.Show +open FStar.Class.Setlike +include FStar.Class.Setlike + +new +val rbset (a:Type0) : Type0 + +type t = rbset + +instance +val setlike_rbset (a:Type0) (_ : ord a) : Tot (setlike a (t a)) + +instance +val showable_rbset (a:Type0) (_ : showable a) : Tot (showable (t a)) diff --git a/src/data/FStar.Compiler.Set.fsti b/src/data/FStar.Compiler.Set.fsti deleted file mode 100644 index e34239b9c2a..00000000000 --- a/src/data/FStar.Compiler.Set.fsti +++ /dev/null @@ -1,56 +0,0 @@ -(* - Copyright 2008-2017 Microsoft Research - - Authors: Aseem Rastogi, Nikhil Swamy, Jonathan Protzenko - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. -*) - -module FStar.Compiler.Set - -open FStar.Class.Ord -open FStar.Class.Show - -val set (a:Type0) : Type0 - -type t = set - -val empty (#a:Type) {| ord a |} () : set a -val singleton (#a:Type) {| ord a |} (x:a) : set a - -val is_empty (#a:Type) {| ord a |} (s:set a) : bool - -val from_list (#a:Type) {| ord a |} (l:list a) : set a -val elems (#a:Type) {| ord a |} (s:set a) : list a - -val add (#a:Type) {| ord a |} (x:a) (s:set a) : set a -val addn (#a:Type) {| ord a |} (x:list a) (s:set a) : set a - -val remove (#a:Type) {| ord a |} (x:a) (s:set a) : set a - -val mem (#a:Type) {| ord a |} (x:a) (s:set a) : bool - -val equal (#a:Type) {| ord a |} (s1:set a) (s2:set a) : bool - -val subset (#a:Type) {| ord a |} (s1:set a) (s2:set a) : bool - -val union (#a:Type) {| ord a |} (s1:set a) (s2:set a) : set a -val inter (#a:Type) {| ord a |} (s1:set a) (s2:set a) : set a -val diff (#a:Type) {| ord a |} (s1:set a) (s2:set a) : set a - -val collect (#a:Type) (#b:Type) {| ord b |} (f : a -> set b) (l : list a) : set b - -val for_all (#a:Type) {| ord a |} (p:(a -> bool)) (s:set a) : bool -val for_any (#a:Type) {| ord a |} (p:(a -> bool)) (s:set a) : bool - -instance val showable_set (a:Type) (_ : ord a) (_ : showable a) : Tot (showable (set a)) diff --git a/src/extraction/FStar.Extraction.ML.Modul.fst b/src/extraction/FStar.Extraction.ML.Modul.fst index 268f03d4817..16770cf6dc4 100644 --- a/src/extraction/FStar.Extraction.ML.Modul.fst +++ b/src/extraction/FStar.Extraction.ML.Modul.fst @@ -50,6 +50,8 @@ module EMB = FStar.Syntax.Embeddings module Cfg = FStar.TypeChecker.Cfg module PO = FStar.TypeChecker.Primops +let dbg_ExtractionReify = Debug.get_toggle "ExtractionReify" + type tydef_declaration = (mlsymbol * FStar.Extraction.ML.Syntax.metadata * int) //int is the arity type iface = { @@ -554,7 +556,7 @@ let extract_reifiable_effect g ed in let rec extract_fv tm = - if Env.debug (tcenv_of_uenv g) <| Options.Other "ExtractionReify" then + if !dbg_ExtractionReify then BU.print1 "extract_fv term: %s\n" (Print.term_to_string tm); match (SS.compress tm).n with | Tm_uinst (tm, _) -> extract_fv tm @@ -569,7 +571,7 @@ let extract_reifiable_effect g ed let extract_action g (a:S.action) = assert (match a.action_params with | [] -> true | _ -> false); - if Env.debug (tcenv_of_uenv g) <| Options.Other "ExtractionReify" then + if !dbg_ExtractionReify then BU.print2 "Action type %s and term %s\n" (Print.term_to_string a.action_typ) (Print.term_to_string a.action_defn); @@ -585,9 +587,9 @@ let extract_reifiable_effect g ed | None -> failwith "No type scheme") | _ -> failwith "Impossible" in let a_nm, a_lid, exp_b, g = extend_with_action_name g ed a tysc in - if Env.debug (tcenv_of_uenv g) <| Options.Other "ExtractionReify" then + if !dbg_ExtractionReify then BU.print1 "Extracted action term: %s\n" (Code.string_of_mlexpr a_nm a_let); - if Env.debug (tcenv_of_uenv g) <| Options.Other "ExtractionReify" then begin + if !dbg_ExtractionReify then begin BU.print1 "Extracted action type: %s\n" (Code.string_of_mlty a_nm (snd tysc)); List.iter (fun x -> BU.print1 "and binders: %s\n" x) (ty_param_names (fst tysc)) end; let iface, impl = extend_iface a_lid a_nm exp exp_b in @@ -877,7 +879,7 @@ let extract_iface' (g:env_t) modul = let extract_iface (g:env_t) modul = let g, iface = UF.with_uf_enabled (fun () -> - if Options.debug_any() + if Debug.any() then FStar.Compiler.Util.measure_execution_time (BU.format1 "Extracted interface of %s" (string_of_lid modul.name)) (fun () -> extract_iface' g modul) @@ -1290,7 +1292,7 @@ let extract' (g:uenv) (m:modul) : uenv * option mllib = let g, sigs = BU.fold_map (fun g se -> - if Options.debug_module (string_of_lid m.name) + if Debug.any () then let nm = FStar.Syntax.Util.lids_of_sigelt se |> List.map Ident.string_of_lid |> String.concat ", " in BU.print1 "+++About to extract {%s}\n" nm; FStar.Compiler.Util.measure_execution_time diff --git a/src/extraction/FStar.Extraction.ML.RegEmb.fst b/src/extraction/FStar.Extraction.ML.RegEmb.fst index 113465cdef2..f7fdb53fa8e 100644 --- a/src/extraction/FStar.Extraction.ML.RegEmb.fst +++ b/src/extraction/FStar.Extraction.ML.RegEmb.fst @@ -123,12 +123,16 @@ let fresh : string -> string = s^"_"^(string_of_int v) let not_implemented_warning (r: Range.range) (t: string) (msg: string) = - Errors.log_issue r - (Errors.Warning_PluginNotImplemented, - BU.format3 "Plugin `%s' can not run natively because %s (use --warn_error -%s to carry on)." - t - msg - (string_of_int <| Errors.error_number (Errors.lookup Errors.Warning_PluginNotImplemented))) + let open FStar.Pprint in + let open FStar.Errors.Msg in + let open FStar.Class.PP in + Errors.log_issue_doc r (Errors.Warning_PluginNotImplemented, [ + prefix 2 1 (text (BU.format1 "Plugin `%s' can not run natively because:" t)) + (text msg); + text "Use --warn_error -" + ^^ pp (Errors.error_number (Errors.lookup Errors.Warning_PluginNotImplemented)) + ^/^ text "to carry on." + ]) type embedding_data = { arity : int; @@ -191,9 +195,11 @@ let builtin_embeddings : list (Ident.lident & embedding_data) = (RC.fstar_refl_data_lid "qualifier", {arity=0; syn_emb=refl_emb_lid "e_qualifier"; nbe_emb=Some(nbe_refl_emb_lid "e_qualifier")}); ] +let dbg_plugin = Debug.get_toggle "Plugins" + let local_fv_embeddings : ref (list (Ident.lident & embedding_data)) = BU.mk_ref [] let register_embedding (l: Ident.lident) (d: embedding_data) : unit = - if Options.debug_at_level_no_module (Options.Other "Plugins") then + if !dbg_plugin then BU.print1 "Registering local embedding for %s\n" (Ident.string_of_lid l); local_fv_embeddings := (l,d) :: !local_fv_embeddings diff --git a/src/extraction/FStar.Extraction.ML.RemoveUnusedParameters.fst b/src/extraction/FStar.Extraction.ML.RemoveUnusedParameters.fst index a157982cb1f..bf761800536 100644 --- a/src/extraction/FStar.Extraction.ML.RemoveUnusedParameters.fst +++ b/src/extraction/FStar.Extraction.ML.RemoveUnusedParameters.fst @@ -25,6 +25,7 @@ open FStar.Compiler.Util open FStar.Const open FStar.BaseTypes open FStar.Extraction.ML.Syntax +open FStar.Class.Setlike (** This module implements a transformation on the FStar.Extraction.ML.Syntax @@ -75,12 +76,12 @@ let lookup_tyname (env:env_t) (name:mlpath) = BU.psmap_try_find env.tydef_map (string_of_mlpath name) (** Free variables of a type: Computed to check which parameters are used *) -type var_set = Set.set mlident -let empty_var_set : Set.set string = Set.empty () +type var_set = RBSet.t mlident +let empty_var_set : RBSet.t string = empty () let rec freevars_of_mlty' (vars:var_set) (t:mlty) = match t with | MLTY_Var i -> - Set.add i vars + add i vars | MLTY_Fun (t0, _, t1) -> freevars_of_mlty' (freevars_of_mlty' vars t0) t1 | MLTY_Named (tys, _) @@ -206,7 +207,7 @@ let elim_tydef (env:env_t) name metadata parameters mlty List.fold_left (fun (i, params, entry) param -> let p = param.ty_param_name in - if Set.mem p freevars + if mem p freevars then begin if must_eliminate i then begin diff --git a/src/extraction/FStar.Extraction.ML.Term.fst b/src/extraction/FStar.Extraction.ML.Term.fst index 224d91a7237..ebc0a728662 100644 --- a/src/extraction/FStar.Extraction.ML.Term.fst +++ b/src/extraction/FStar.Extraction.ML.Term.fst @@ -48,6 +48,9 @@ module TcTerm = FStar.TypeChecker.TcTerm module TcUtil = FStar.TypeChecker.Util module U = FStar.Syntax.Util +let dbg_Extraction = Debug.get_toggle "Extraction" +let dbg_ExtractionNorm = Debug.get_toggle "ExtractionNorm" + exception Un_extractable @@ -104,7 +107,7 @@ let err_unexpected_eff env t ty f0 f1 = prefix 4 1 (text "For expression") (Print.term_to_doc t) ^/^ prefix 4 1 (text "of type") (arbitrary_string (Code.string_of_mlty (current_module_of_uenv env) ty)); prefix 4 1 (text "Expected effect") (arbitrary_string (eff_to_string f0)) ^/^ - prefix 4 1 (text "got effect") (arbitrary_string (eff_to_string f0))]) + prefix 4 1 (text "got effect") (arbitrary_string (eff_to_string f1))]) let err_cannot_extract_effect (l:lident) (r:Range.range) (reason:string) (ctxt:string) = Errors.raise_error_doc @@ -1894,7 +1897,7 @@ and term_as_mlexpr' (g:uenv) (top:term) : (mlexpr * e_tag * mlty) = // (Ident.lid_of_path ((fst (current_module_of_uenv g)) @ [snd (current_module_of_uenv g)]) Range.dummyRange) in // debug g (fun () -> // BU.print1 "!!!!!!!About to normalize: %s\n" (Print.term_to_string lb.lbdef); - // Options.set_option "debug_level" (Options.List [Options.String "Norm"; Options.String "Extraction"])); + // Options.set_option "debug" (Options.List [Options.String "Norm"; Options.String "Extraction"])); let lbdef = let norm_call () = Profiling.profile @@ -1903,8 +1906,7 @@ and term_as_mlexpr' (g:uenv) (top:term) : (mlexpr * e_tag * mlty) = (Some (Ident.string_of_lid (Env.current_module tcenv))) "FStar.Extraction.ML.Term.normalize_lb_def" in - if TcEnv.debug tcenv <| Options.Other "Extraction" - || TcEnv.debug tcenv <| Options.Other "ExtractNorm" + if !dbg_Extraction || !dbg_ExtractionNorm then let _ = BU.print2 "Starting to normalize top-level let %s = %s\n" (Print.lbname_to_string lb.lbname) (Print.term_to_string lb.lbdef) diff --git a/src/extraction/FStar.Extraction.ML.UEnv.fst b/src/extraction/FStar.Extraction.ML.UEnv.fst index 5df27365f1f..91a01472176 100644 --- a/src/extraction/FStar.Extraction.ML.UEnv.fst +++ b/src/extraction/FStar.Extraction.ML.UEnv.fst @@ -118,9 +118,10 @@ let with_typars_env (u:uenv) (f:_) = // Only for debug printing in Modul.fs let bindings_of_uenv u = u.env_bindings +let dbg = Debug.get_toggle "Extraction" let debug g f = let c = string_of_mlpath g.currentModule in - if Options.debug_at_level c (Options.Other "Extraction") + if !dbg then f () let print_mlpath_map (g:uenv) = diff --git a/src/fstar/FStar.CheckedFiles.fst b/src/fstar/FStar.CheckedFiles.fst index fd7da3807fc..3b3c75743f9 100644 --- a/src/fstar/FStar.CheckedFiles.fst +++ b/src/fstar/FStar.CheckedFiles.fst @@ -16,15 +16,10 @@ module FStar.CheckedFiles open FStar -open FStar.Pervasives -open FStar.Compiler.Effect open FStar.Compiler -open FStar.Errors +open FStar.Compiler.Effect open FStar.Compiler.Util -open FStar.Getopt -open FStar.Syntax.Syntax -open FStar.TypeChecker.Env -open FStar.Syntax.DsEnv + open FStar.Class.Show (* Module abbreviations for the universal type-checker *) @@ -34,13 +29,14 @@ module SMT = FStar.SMTEncoding.Solver module BU = FStar.Compiler.Util module Dep = FStar.Parser.Dep +let dbg = Debug.get_toggle "CheckedFiles" (* * We write this version number to the cache files, and * detect when loading the cache that the version number is same * It needs to be kept in sync with prims.fst *) -let cache_version_number = 65 +let cache_version_number = 67 (* * Abbreviation for what we store in the checked files (stages as described below) @@ -158,7 +154,7 @@ let hash_dependences (deps:Dep.deps) (fn:string) :either string (list (string * "hash_dependences::the interface checked file %s does not exist\n" iface in - if Options.debug_at_level_no_module (Options.Other "CheckedFiles") + if !dbg then BU.print1 "%s\n" msg; Inl msg @@ -182,7 +178,7 @@ let hash_dependences (deps:Dep.deps) (fn:string) :either string (list (string * match BU.smap_try_find mcache cache_fn with | None -> let msg = BU.format2 "For dependency %s, cache file %s is not loaded" fn cache_fn in - if Options.debug_at_level_no_module (Options.Other "CheckedFiles") + if !dbg then BU.print1 "%s\n" msg; Inl msg | Some (Invalid msg, _) -> Inl msg @@ -207,7 +203,7 @@ let hash_dependences (deps:Dep.deps) (fn:string) :either string (list (string * * See above for the two steps of loading the checked files *) let load_checked_file (fn:string) (checked_fn:string) :cache_t = - if Options.debug_at_level_no_module (Options.Other "CheckedFiles") then + if !dbg then BU.print1 "Trying to load checked file result %s\n" checked_fn; let elt = checked_fn |> BU.smap_try_find mcache in if elt |> is_some then elt |> must //already loaded @@ -228,7 +224,7 @@ let load_checked_file (fn:string) (checked_fn:string) :cache_t = else let current_digest = BU.digest_of_file fn in if x.digest <> current_digest then begin - if Options.debug_at_level_no_module (Options.Other "CheckedFiles") then + if !dbg then BU.print4 "Checked file %s is stale since incorrect digest of %s, \ expected: %s, found: %s\n" checked_fn fn current_digest x.digest; @@ -244,7 +240,7 @@ let load_checked_file (fn:string) (checked_fn:string) :cache_t = *) let load_checked_file_with_tc_result (deps:Dep.deps) (fn:string) (checked_fn:string) :either string tc_result = - if Options.debug_at_level_no_module (Options.Other "CheckedFiles") then + if !dbg then BU.print1 "Trying to load checked file with tc result %s\n" checked_fn; let load_tc_result (fn:string) :list (string * string) * tc_result = @@ -313,7 +309,7 @@ let load_checked_file_with_tc_result (deps:Dep.deps) (fn:string) (checked_fn:str Inr tc_result end else begin - if Options.debug_at_level_no_module (Options.Other "CheckedFiles") + if !dbg then begin BU.print4 "Expected (%s) hashes:\n%s\n\nGot (%s) hashes:\n\t%s\n" (BU.string_of_int (List.length deps_dig')) @@ -408,7 +404,7 @@ let load_module_from_cache = cache_file with | Inl msg -> fail msg cache_file; None | Inr tc_result -> - if Options.debug_at_level_no_module (Options.Other "CheckedFiles") then + if !dbg then BU.print1 "Successfully loaded module from checked file %s\n" cache_file; Some tc_result (* | _ -> failwith "load_checked_file_tc_result must have an Invalid or Valid entry" *) diff --git a/src/fstar/FStar.Interactive.Ide.fst b/src/fstar/FStar.Interactive.Ide.fst index 022514d7d28..6fbb616d1da 100644 --- a/src/fstar/FStar.Interactive.Ide.fst +++ b/src/fstar/FStar.Interactive.Ide.fst @@ -31,6 +31,8 @@ open FStar.Interactive.PushHelper open FStar.Interactive.Ide.Types module BU = FStar.Compiler.Util +let dbg = Debug.get_toggle "IDE" + open FStar.Universal open FStar.TypeChecker.Env open FStar.TypeChecker.Common @@ -138,7 +140,7 @@ This function is stateful: it uses ``push_repl`` and ``pop_repl``. let run_repl_ld_transactions (st: repl_state) (tasks: list repl_task) (progress_callback: repl_task -> unit) = let debug verb task = - if Options.debug_at_level_no_module (Options.Other "IDE") then + if !dbg then Util.print2 "%s %s" verb (string_of_repl_task task) in (* Run as many ``pop_repl`` as there are entries in the input stack. @@ -744,7 +746,7 @@ let run_push_without_deps st query ((status, json_errors), Inl st) let run_push_with_deps st query = - if Options.debug_at_level_no_module (Options.Other "IDE") then + if !dbg then Util.print_string "Reloading dependencies"; TcEnv.toggle_id_info st.repl_env false; match load_deps st with @@ -968,7 +970,7 @@ let st_cost = function type search_candidate = { sc_lid: lid; sc_typ: ref (option Syntax.Syntax.typ); - sc_fvars: ref (option (Set.t lid)) } + sc_fvars: ref (option (RBSet.t lid)) } let sc_of_lid lid = { sc_lid = lid; sc_typ = Util.mk_ref None; @@ -997,13 +999,12 @@ exception InvalidSearch of string let run_search st search_str = let tcenv = st.repl_env in - let empty_fv_set = SS.new_fv_set () in let st_matches candidate term = let found = match term.st_term with | NameContainsStr str -> Util.contains (string_of_lid candidate.sc_lid) str - | TypeContainsLid lid -> Set.mem lid (sc_fvars tcenv candidate) in + | TypeContainsLid lid -> Class.Setlike.mem lid (sc_fvars tcenv candidate) in found <> term.st_negate in let parse search_str = @@ -1075,7 +1076,7 @@ let run_query_result = (query_status * list json) * either repl_state int let maybe_cancel_queries st l = let log_cancellation l = - if Options.debug_at_level_no_module (Options.Other "IDE") + if !dbg then List.iter (fun q -> BU.print1 "Cancelling query: %s\n" (query_to_string q)) l in match st.repl_buffered_input_queries with @@ -1173,7 +1174,7 @@ let rec run_query st (q: query) : (query_status * list json) * either repl_state and validate_and_run_query st query = let query = validate_query st query in repl_current_qid := Some query.qid; - if Options.debug_at_level_no_module (Options.Other "IDE") + if !dbg then BU.print2 "Running query %s: %s\n" query.qid (query_to_string query); run_query st query diff --git a/src/fstar/FStar.Interactive.Incremental.fst b/src/fstar/FStar.Interactive.Incremental.fst index 77a6fa37db0..cc576289d4f 100644 --- a/src/fstar/FStar.Interactive.Incremental.fst +++ b/src/fstar/FStar.Interactive.Incremental.fst @@ -313,7 +313,7 @@ let run_full_buffer (st:repl_state) run_qst (inspect_repl_stack (!repl_stack) decls push_kind with_symbols write_full_buffer_fragment_progress) qid in if request_type <> Cache then log_syntax_issues err_opt; - if Options.debug_any() + if Debug.any() then ( BU.print1 "Generating queries\n%s\n" (String.concat "\n" (List.map query_to_string queries)) diff --git a/src/fstar/FStar.Interactive.Legacy.fst b/src/fstar/FStar.Interactive.Legacy.fst index 6ca6a742da6..7268e17aa7a 100644 --- a/src/fstar/FStar.Interactive.Legacy.fst +++ b/src/fstar/FStar.Interactive.Legacy.fst @@ -127,7 +127,7 @@ let the_interactive_state = { let rec read_chunk () = let s = the_interactive_state in let log : string -> unit = - if Options.debug_any() then + if Debug.any() then let transcript = match !s.log with | Some transcript -> transcript diff --git a/src/fstar/FStar.Main.fst b/src/fstar/FStar.Main.fst index c06f5c14405..e13497bfcdd 100644 --- a/src/fstar/FStar.Main.fst +++ b/src/fstar/FStar.Main.fst @@ -98,7 +98,7 @@ let load_native_tactics () = end in let cmxs_files = (modules_to_load@cmxs_to_load) |> List.map cmxs_file in - if Options.debug_any () then + if Debug.any () then Util.print1 "Will try to load cmxs files: [%s]\n" (String.concat ", " cmxs_files); Tactics.Load.load_tactics cmxs_files; iter_opt (Options.use_native_tactics ()) Tactics.Load.load_tactics_dir; diff --git a/src/fstar/FStar.Universal.fst b/src/fstar/FStar.Universal.fst index 48820fb1e12..58381412abd 100644 --- a/src/fstar/FStar.Universal.fst +++ b/src/fstar/FStar.Universal.fst @@ -546,15 +546,16 @@ let rec tc_fold_interleave (deps:FStar.Parser.Dep.deps) //used to query parsing | _ -> let mods, mllibs, env_before = acc in let remaining, nmod, mllib, env = tc_one_file_from_remaining remaining env_before deps in - if not (Options.profile_group_by_decls()) + if not (Options.profile_group_by_decl()) then Profiling.report_and_clear (Ident.string_of_lid nmod.checked_module.name); tc_fold_interleave deps (mods@[nmod], mllibs@(as_list env_before mllib), env) remaining (***********************************************************************) (* Batch mode: checking many files *) (***********************************************************************) +let dbg_dep = Debug.get_toggle "Dep" let batch_mode_tc filenames dep_graph = - if Options.debug_at_level_no_module (Options.Other "Dep") then begin + if !dbg_dep then begin FStar.Compiler.Util.print_endline "Auto-deps kicked in; here's some info."; FStar.Compiler.Util.print1 "Here's the list of filenames we will process: %s\n" (String.concat " " filenames); diff --git a/src/parser/FStar.Parser.AST.Util.fsti b/src/parser/FStar.Parser.AST.Util.fsti index 83e6a629dec..c63877238b0 100644 --- a/src/parser/FStar.Parser.AST.Util.fsti +++ b/src/parser/FStar.Parser.AST.Util.fsti @@ -37,11 +37,18 @@ type error_message = { range: FStar.Compiler.Range.range; } -type extension_parser = - open_namespaces_and_abbreviations -> - contents:string -> - p:FStar.Compiler.Range.range -> - either error_message decl +type extension_parser = { + parse_decl_name: + (contents:string -> + FStar.Compiler.Range.range -> + either error_message FStar.Ident.ident); + + parse_decl: + (open_namespaces_and_abbreviations -> + contents:string -> + p:FStar.Compiler.Range.range -> + either error_message decl) +} val register_extension_parser (extension_name:string) (parser:extension_parser) : unit -val lookup_extension_parser (extension_name:string) : option extension_parser \ No newline at end of file +val lookup_extension_parser (extension_name:string) : option extension_parser diff --git a/src/parser/FStar.Parser.AST.fst b/src/parser/FStar.Parser.AST.fst index 251f28b53a6..93b9987d5d0 100644 --- a/src/parser/FStar.Parser.AST.fst +++ b/src/parser/FStar.Parser.AST.fst @@ -328,15 +328,15 @@ let string_to_op s = match s with | "Amp" -> Some ("&", None) | "At" -> Some ("@", None) - | "Plus" -> Some ("+", None) + | "Plus" -> Some ("+", Some 2) | "Minus" -> Some ("-", None) | "Subtraction" -> Some ("-", Some 2) | "Tilde" -> Some ("~", None) - | "Slash" -> Some ("/", None) + | "Slash" -> Some ("/", Some 2) | "Backslash" -> Some ("\\", None) - | "Less" -> Some ("<", None) + | "Less" -> Some ("<", Some 2) | "Equals" -> Some ("=", None) - | "Greater" -> Some (">", None) + | "Greater" -> Some (">", Some 2) | "Underscore" -> Some ("_", None) | "Bar" -> Some ("|", None) | "Bang" -> Some ("!", None) diff --git a/src/parser/FStar.Parser.AST.fsti b/src/parser/FStar.Parser.AST.fsti index 101885e3cb5..55023b6d754 100644 --- a/src/parser/FStar.Parser.AST.fsti +++ b/src/parser/FStar.Parser.AST.fsti @@ -303,7 +303,7 @@ val strip_prefix : string -> string -> option string val compile_op : int -> string -> range -> string val compile_op' : string -> range -> string -val string_to_op : string -> option (string & option int) +val string_to_op : string -> option (string & option int) // returns operator symbol and optional arity val string_of_fsdoc : string & list (string & string) -> string val string_of_let_qualifier : let_qualifier -> string diff --git a/src/parser/FStar.Parser.Const.fst b/src/parser/FStar.Parser.Const.fst index 007271cfdb2..0e3829a144b 100644 --- a/src/parser/FStar.Parser.Const.fst +++ b/src/parser/FStar.Parser.Const.fst @@ -314,6 +314,7 @@ let __range_lid = p2l ["FStar"; "Range"; "__range"] let range_lid = p2l ["FStar"; "Range"; "range"] (* this is a sealed version of the above *) let range_0 = p2l ["FStar"; "Range"; "range_0"] let mk_range_lid = p2l ["FStar"; "Range"; "mk_range"] +let join_range_lid = p2l ["FStar"; "Range"; "join_range"] let guard_free = pconst "guard_free" let inversion_lid = p2l ["FStar"; "Pervasives"; "inversion"] diff --git a/src/parser/FStar.Parser.Dep.fst b/src/parser/FStar.Parser.Dep.fst index d90736b626d..34b61a34ca1 100644 --- a/src/parser/FStar.Parser.Dep.fst +++ b/src/parser/FStar.Parser.Dep.fst @@ -39,7 +39,7 @@ open FStar.Class.Show module Const = FStar.Parser.Const module BU = FStar.Compiler.Util -module Set = FStar.Compiler.Set +let dbg = Debug.get_toggle "Dep" let profile f c = Profiling.profile f None c @@ -555,18 +555,18 @@ let dep_subsumed_by d d' = let enter_namespace (original_map: files_for_module_name) (working_map: files_for_module_name) - (prefix: string) + (sprefix: string) (implicit_open:bool) : bool = let found = BU.mk_ref false in - let prefix = prefix ^ "." in + let sprefix = sprefix ^ "." in let suffix_exists mopt = match mopt with | None -> false | Some (intf, impl) -> is_some intf || is_some impl in smap_iter original_map (fun k _ -> - if Util.starts_with k prefix then + if Util.starts_with k sprefix then let suffix = - String.substring k (String.length prefix) (String.length k - String.length prefix) + String.substring k (String.length sprefix) (String.length k - String.length sprefix) in begin @@ -574,11 +574,19 @@ let enter_namespace if implicit_open && suffix_exists suffix_filename then let str = suffix_filename |> must |> intf_and_impl_to_string in - FStar.Errors.log_issue_doc Range.dummyRange - (Errors.Warning_UnexpectedFile, - [Errors.text <| - BU.format4 "Implicitly opening %s namespace shadows (%s -> %s), rename %s to \ - avoid conflicts" prefix suffix str str]) + let open FStar.Pprint in + log_issue_doc Range.dummyRange + (Errors.Warning_UnexpectedFile, [ + flow (break_ 1) [ + text "Implicitly opening namespace"; + squotes (doc_of_string sprefix); + text "shadows module"; + squotes (doc_of_string suffix); + text "in file"; + dquotes (doc_of_string str) ^^ dot; + ]; + text "Rename" ^/^ dquotes (doc_of_string str) ^/^ text "to avoid conflicts."; + ]) end; let filename = must (smap_try_find original_map k) in @@ -682,7 +690,7 @@ let collect_one end in - let record_open_namespace lid (implicit_open:bool) = + let record_open_namespace lid (implicit_open:bool) = let key = lowercase_join_longident lid true in let r = enter_namespace original_map working_map key implicit_open in if not r && not implicit_open then //suppress the warning for implicit opens @@ -722,7 +730,7 @@ let collect_one let add_dep_on_module (module_name : lid) (is_friend : bool) = if add_dependence_edge working_map module_name is_friend then () - else if Options.debug_at_level_no_module (Options.Other "Dep") then + else if !dbg then FStar.Errors.log_issue (range_of_lid module_name) (Errors.Warning_UnboundModuleReference, (BU.format1 "Unbound module reference %s" (Ident.string_of_lid module_name))) @@ -772,7 +780,7 @@ let collect_one if data_from_cache |> is_some then begin //we found the parsing data in the checked file let deps, has_inline_for_extraction, mo_roots = from_parsing_data (data_from_cache |> must) original_map filename in - if Options.debug_at_level_no_module (Options.Other "Dep") then + if !dbg then BU.print2 "Reading the parsing data for %s from its checked file .. found [%s]\n" filename (show deps); data_from_cache |> must, deps, has_inline_for_extraction, mo_roots @@ -1244,7 +1252,7 @@ let topological_dependences_of' * dependencies. Otherwise, the map only contains its direct dependencies. *) all_friends, all_files | White -> - if Options.debug_at_level_no_module (Options.Other "Dep") + if !dbg then BU.print2 "Visiting %s: direct deps are %s\n" filename (show dep_node.edges); (* Unvisited. Compute. *) @@ -1259,7 +1267,7 @@ let topological_dependences_of' in (* Mutate the graph to mark the node as visited *) deps_add_dep dep_graph filename ({dep_node with color=Black}); - if Options.debug_at_level_no_module (Options.Other "Dep") + if !dbg then BU.print1 "Adding %s\n" filename; (* Also build the topological sort (Tarjan's algorithm). *) List.collect @@ -1341,7 +1349,7 @@ let topological_dependences_of' let friends, all_files_0 = all_friend_deps dep_graph [] ([], []) root_files in - if Options.debug_at_level_no_module (Options.Other "Dep") + if !dbg then BU.print3 "Phase1 complete:\n\t\ all_files = %s\n\t\ all_friends=%s\n\t\ @@ -1353,11 +1361,11 @@ let topological_dependences_of' widen_deps friends dep_graph file_system_map widened in let _, all_files = - if Options.debug_at_level_no_module (Options.Other "Dep") + if !dbg then BU.print_string "==============Phase2==================\n"; all_friend_deps dep_graph [] ([], []) root_files in - if Options.debug_at_level_no_module (Options.Other "Dep") + if !dbg then BU.print1 "Phase2 complete: all_files = %s\n" (String.concat ", " all_files); all_files, widened @@ -1368,7 +1376,7 @@ let phase1 interfaces_needing_inlining for_extraction = - if Options.debug_at_level_no_module (Options.Other "Dep") + if !dbg then BU.print_string "==============Phase1==================\n"; let widened = false in if Options.cmi() @@ -1590,7 +1598,7 @@ let collect (all_cmd_line_files: list file_name) (Options.codegen()<>None)) "FStar.Parser.Dep.topological_dependences_of" in - if Options.debug_at_level_no_module (Options.Other "Dep") + if !dbg then BU.print1 "Interfaces needing inlining: %s\n" (String.concat ", " inlining_ifaces); all_files, mk_deps dep_graph file_system_map all_cmd_line_files all_files inlining_ifaces parse_results diff --git a/src/reflection/FStar.Reflection.V1.Builtins.fst b/src/reflection/FStar.Reflection.V1.Builtins.fst index ce917c84858..4652661bf5b 100644 --- a/src/reflection/FStar.Reflection.V1.Builtins.fst +++ b/src/reflection/FStar.Reflection.V1.Builtins.fst @@ -639,12 +639,14 @@ let pack_sigelt (sv:sigelt_view) : sigelt = check_lid ind_lid; let s = SS.univ_var_closing us_names in let nparam = List.length param_bs in + //We can't tust the value of injective_type_params; set it to false here and let the typechecker recompute + let injective_type_params = false in let pack_ctor (c:ctor) : sigelt = let (nm, ty) = c in let lid = Ident.lid_of_path nm Range.dummyRange in let ty = U.arrow param_bs (S.mk_Total ty) in let ty = SS.subst s ty in (* close univs *) - mk_sigelt <| Sig_datacon {lid; us=us_names; t=ty; ty_lid=ind_lid; num_ty_params=nparam; mutuals=[]} + mk_sigelt <| Sig_datacon {lid; us=us_names; t=ty; ty_lid=ind_lid; num_ty_params=nparam; mutuals=[]; injective_type_params } in let ctor_ses : list sigelt = List.map pack_ctor ctors in @@ -665,7 +667,8 @@ let pack_sigelt (sv:sigelt_view) : sigelt = num_uniform_params=None; t=ty; mutuals=[]; - ds=c_lids} + ds=c_lids; + injective_type_params } in let se = mk_sigelt <| Sig_bundle {ses=ind_se::ctor_ses; lids=ind_lid::c_lids} in { se with sigquals = Noeq::se.sigquals } diff --git a/src/reflection/FStar.Reflection.V2.Builtins.fst b/src/reflection/FStar.Reflection.V2.Builtins.fst index 13670f59ab0..484a5925f37 100644 --- a/src/reflection/FStar.Reflection.V2.Builtins.fst +++ b/src/reflection/FStar.Reflection.V2.Builtins.fst @@ -448,14 +448,16 @@ let compare_namedv (x:bv) (y:bv) : order = else if n = 0 then Eq else Gt +let lookup_attr_ses (attr:term) (env:Env.env) : list sigelt = + match (SS.compress_subst attr).n with + | Tm_fvar fv -> Env.lookup_attr env (Ident.string_of_lid (lid_of_fv fv)) + | _ -> [] + let lookup_attr (attr:term) (env:Env.env) : list fv = - match (SS.compress_subst attr).n with - | Tm_fvar fv -> - let ses = Env.lookup_attr env (Ident.string_of_lid (lid_of_fv fv)) in - List.concatMap (fun se -> match U.lid_of_sigelt se with - | None -> [] - | Some l -> [S.lid_as_fv l None]) ses - | _ -> [] + let ses = lookup_attr_ses attr env in + List.concatMap (fun se -> match U.lid_of_sigelt se with + | None -> [] + | Some l -> [S.lid_as_fv l None]) ses let all_defs_in_env (env:Env.env) : list fv = List.map (fun l -> S.lid_as_fv l None) (Env.lidents env) // |> take 10 @@ -601,10 +603,12 @@ let pack_sigelt (sv:sigelt_view) : sigelt = let ind_lid = Ident.lid_of_path nm Range.dummyRange in check_lid ind_lid; let nparam = List.length param_bs in + //We can't tust the value of injective_type_params; set it to false here and let the typechecker recompute + let injective_type_params = false in let pack_ctor (c:ctor) : sigelt = let (nm, ty) = c in let lid = Ident.lid_of_path nm Range.dummyRange in - mk_sigelt <| Sig_datacon {lid; us=us_names; t=ty; ty_lid=ind_lid; num_ty_params=nparam; mutuals=[]} + mk_sigelt <| Sig_datacon {lid; us=us_names; t=ty; ty_lid=ind_lid; num_ty_params=nparam; mutuals=[]; injective_type_params } in let ctor_ses : list sigelt = List.map pack_ctor ctors in @@ -619,7 +623,8 @@ let pack_sigelt (sv:sigelt_view) : sigelt = num_uniform_params=None; t=ty; mutuals=[]; - ds=c_lids} + ds=c_lids; + injective_type_params } in let se = mk_sigelt <| Sig_bundle {ses=ind_se::ctor_ses; lids=ind_lid::c_lids} in { se with sigquals = Noeq::se.sigquals } diff --git a/src/reflection/FStar.Reflection.V2.Builtins.fsti b/src/reflection/FStar.Reflection.V2.Builtins.fsti index 90ddd29d622..4922de6881f 100644 --- a/src/reflection/FStar.Reflection.V2.Builtins.fsti +++ b/src/reflection/FStar.Reflection.V2.Builtins.fsti @@ -35,6 +35,7 @@ module Z = FStar.BigInt val compare_bv : bv -> bv -> order val compare_namedv : namedv -> namedv -> order val lookup_typ : Env.env -> list string -> option sigelt +val lookup_attr_ses : term -> Env.env -> list sigelt val lookup_attr : term -> Env.env -> list fv val all_defs_in_env : Env.env -> list fv val defs_in_module : Env.env -> name -> list fv diff --git a/src/reflection/FStar.Reflection.V2.Interpreter.fst b/src/reflection/FStar.Reflection.V2.Interpreter.fst index 3df1f5a2491..dc66ee81453 100644 --- a/src/reflection/FStar.Reflection.V2.Interpreter.fst +++ b/src/reflection/FStar.Reflection.V2.Interpreter.fst @@ -163,6 +163,10 @@ let reflection_primops : list PO.primitive_step = [ #NRE.e_namedv #NRE.e_namedv #_ RB.compare_namedv; + mk2 "lookup_attr_ses" + #RE.e_term + RB.lookup_attr_ses; + mk2 "lookup_attr" #RE.e_term RB.lookup_attr; diff --git a/src/smtencoding/FStar.SMTEncoding.Encode.fst b/src/smtencoding/FStar.SMTEncoding.Encode.fst index 231e2de59b4..0ee51771545 100644 --- a/src/smtencoding/FStar.SMTEncoding.Encode.fst +++ b/src/smtencoding/FStar.SMTEncoding.Encode.fst @@ -42,6 +42,11 @@ module SS = FStar.Syntax.Subst module TcUtil = FStar.TypeChecker.Util module UF = FStar.Syntax.Unionfind module U = FStar.Syntax.Util +module TEQ = FStar.TypeChecker.TermEqAndSimplify + +let dbg_SMTEncoding = Debug.get_toggle "SMTEncoding" +let dbg_SMTQuery = Debug.get_toggle "SMTQuery" +let dbg_Time = Debug.get_toggle "Time" let norm_before_encoding env t = let steps = [Env.Eager_unfolding; @@ -168,14 +173,19 @@ let prims = {mk=mk; is=is} -let pretype_axiom rng env tapp vars = +let pretype_axiom term_constr_eq rng env tapp vars = let xxsym, xx = fresh_fvar env.current_module_name "x" Term_sort in let ffsym, ff = fresh_fvar env.current_module_name "f" Fuel_sort in let xx_has_type = mk_HasTypeFuel ff xx tapp in let tapp_hash = Term.hash_of_term tapp in let module_name = env.current_module_name in Util.mkAssume(mkForall rng ([[xx_has_type]], mk_fv (xxsym, Term_sort)::mk_fv (ffsym, Fuel_sort)::vars, - mkImp(xx_has_type, mkEq(tapp, mkApp("PreType", [xx])))), + mkImp(xx_has_type, + (if term_constr_eq + then mkEq(mkApp ("Term_constr_id", [tapp]), + mkApp ("Term_constr_id", [mkApp("PreType", [xx])])) + else mkEq(tapp, + mkApp("PreType", [xx]))))), Some "pretyping", (varops.mk_unique (module_name ^ "_pretyping_" ^ (BU.digest_of_string tapp_hash)))) @@ -533,7 +543,7 @@ let encode_free_var uninterpreted env fv tt t_norm quals :decls_t * env_t = let freshness = if quals |> List.contains New then [Term.fresh_constructor (S.range_of_fv fv) (vname, vars |> List.map fv_sort, Term_sort, varops.next_id()); - pretype_axiom (S.range_of_fv fv) env vapp vars] + pretype_axiom false (S.range_of_fv fv) env vapp vars] else [] in let g = decls1@decls2@decls3@(freshness@typingAx::mk_disc_proj_axioms guard encoded_res_t vapp vars |> mk_decls_trivial) in @@ -565,7 +575,7 @@ let encode_top_level_val uninterpreted env fv t quals = env.tcenv t else norm_before_encoding env t in - // if Env.debug env.tcenv <| Options.Other "SMTEncoding" + // if !dbg_SMTEncoding // then BU.print3 "Encoding top-level val %s : %s\Normalized to is %s\n" // (Print.fv_to_string fv) // (Print.term_to_string t) @@ -753,7 +763,7 @@ let encode_top_level_let : (* Open binders *) let (binders, body, t_body_comp) = destruct_bound_function t_norm e in let t_body = U.comp_result t_body_comp in - if Env.debug env.tcenv <| Options.Other "SMTEncoding" + if !dbg_SMTEncoding then BU.print2 "Encoding let : binders=[%s], body=%s\n" (Print.binders_to_string ", " binders) (Print.term_to_string body); @@ -848,7 +858,7 @@ let encode_top_level_let : | _ -> failwith "Impossible" in {env with tcenv=tcenv'}, e, t_norm in - if Env.debug env0.tcenv <| Options.Other "SMTEncoding" + if !dbg_SMTEncoding then BU.print3 "Encoding let rec %s : %s = %s\n" (Print.lbname_to_string lbn) (Print.term_to_string t_norm) @@ -858,7 +868,7 @@ let encode_top_level_let : let (binders, body, tres_comp) = destruct_bound_function t_norm e in let curry = fvb.smt_arity <> List.length binders in let pre_opt, tres = TcUtil.pure_or_ghost_pre_and_post env.tcenv tres_comp in - if Env.debug env0.tcenv <| Options.Other "SMTEncoding" + if !dbg_SMTEncoding then BU.print4 "Encoding let rec %s: \n\tbinders=[%s], \n\tbody=%s, \n\ttres=%s\n" (Print.lbname_to_string lbn) (Print.binders_to_string ", " binders) @@ -999,6 +1009,463 @@ let encode_top_level_let : let decl = Caption ("let rec unencodeable: Skipping: " ^msg) in [decl] |> mk_decls_trivial, env +let encode_sig_inductive (env:env_t) (se:sigelt) +: decls_t * env_t += let Sig_inductive_typ + { lid=t; us=universe_names; params=tps; + t=k; ds=datas; injective_type_params } = se.sigel in + let t_lid = t in + let tcenv = env.tcenv in + let quals = se.sigquals in + let is_logical = quals |> BU.for_some (function Logic | Assumption -> true | _ -> false) in + let constructor_or_logic_type_decl (c:constructor_t) = + if is_logical + then [Term.DeclFun(c.constr_name, c.constr_fields |> List.map (fun f -> f.field_sort), Term_sort, None)] + else constructor_to_decl (Ident.range_of_lid t) c in + let inversion_axioms env tapp vars = + if datas |> BU.for_some (fun l -> Env.try_lookup_lid env.tcenv l |> Option.isNone) //Q: Why would this happen? + then [] + else ( + let xxsym, xx = fresh_fvar env.current_module_name "x" Term_sort in + let data_ax, decls = + datas |> + List.fold_left + (fun (out, decls) l -> + let is_l = mk_data_tester env l xx in + let inversion_case, decls' = + if injective_type_params + || Options.ext_getv "compat:injectivity" <> "" + then ( + let _, data_t = Env.lookup_datacon env.tcenv l in + let args, res = U.arrow_formals data_t in + let indices = res |> U.head_and_args_full |> snd in + let env = args |> List.fold_left + (fun env ({binder_bv=x}) -> push_term_var env x (mkApp(mk_term_projector_name l x, [xx]))) + env in + let indices, decls' = encode_args indices env in + if List.length indices <> List.length vars + then failwith "Impossible"; + let eqs = List.map2 (fun v a -> mkEq(mkFreeV v, a)) vars indices in + mkAnd(is_l, mk_and_l eqs), decls' + ) + else is_l, [] + in + mkOr(out, inversion_case), decls@decls') + (mkFalse, []) + in + let ffsym, ff = fresh_fvar env.current_module_name "f" Fuel_sort in + let fuel_guarded_inversion = + let xx_has_type_sfuel = + if List.length datas > 1 + then mk_HasTypeFuel (mkApp("SFuel", [ff])) xx tapp + else mk_HasTypeFuel ff xx tapp //no point requiring non-zero fuel if there are no disjunctions + in + Util.mkAssume( + mkForall + (Ident.range_of_lid t) + ([[xx_has_type_sfuel]], + add_fuel (mk_fv (ffsym, Fuel_sort)) (mk_fv (xxsym, Term_sort)::vars), + mkImp(xx_has_type_sfuel, data_ax)), + Some "inversion axiom", //this name matters! see Sig_bundle case near line 1493 + (varops.mk_unique ("fuel_guarded_inversion_"^(string_of_lid t)))) + in + decls + @([fuel_guarded_inversion] |> mk_decls_trivial) + ) + in + let formals, res = + let k = + match tps with + | [] -> k + | _ -> S.mk (Tm_arrow {bs=tps; comp=S.mk_Total k}) k.pos + in + let k = norm_before_encoding env k in + U.arrow_formals k + in + let vars, guards, env', binder_decls, _ = encode_binders None formals env in + let arity = List.length vars in + let tname, ttok, env = new_term_constant_and_tok_from_lid env t arity in + let ttok_tm = mkApp(ttok, []) in + let guard = mk_and_l guards in + let tapp = mkApp(tname, List.map mkFreeV vars) in //arity ok + let decls, env = + //See: https://github.com/FStarLang/FStar/commit/b75225bfbe427c8aef5b59f70ff6d79aa014f0b4 + //See: https://github.com/FStarLang/FStar/issues/349 + let tname_decl = + constructor_or_logic_type_decl + { + constr_name = tname; + constr_fields = vars |> List.map (fun fv -> {field_name=tname^fv_name fv; field_sort=fv_sort fv; field_projectible=false}) ; + //The field_projectible=false above is extremely important; it makes sure that type-formers are not injective + constr_sort=Term_sort; + constr_id=Some (varops.next_id()); + constr_base=false + } + in + let tok_decls, env = + match vars with + | [] -> [], push_free_var env t arity tname (Some <| mkApp(tname, [])) + | _ -> + let ttok_decl = Term.DeclFun(ttok, [], Term_sort, Some "token") in + let ttok_fresh = Term.fresh_token (ttok, Term_sort) (varops.next_id()) in + let ttok_app = mk_Apply ttok_tm vars in + let pats = [[ttok_app]; [tapp]] in + // These patterns allow rewriting (ApplyT T@tok args) to (T args) and vice versa + // This seems necessary for some proofs, but the bidirectional rewriting may be inefficient + let name_tok_corr = + Util.mkAssume(mkForall' (Ident.range_of_lid t) (pats, None, vars, mkEq(ttok_app, tapp)), + Some "name-token correspondence", + ("token_correspondence_"^ttok)) in + [ttok_decl; ttok_fresh; name_tok_corr], env + in + tname_decl@tok_decls, env + in + let kindingAx = + let k, decls = encode_term_pred None res env' tapp in + let karr = + if List.length formals > 0 + then [Util.mkAssume(mk_tester "Tm_arrow" (mk_PreType ttok_tm), Some "kinding", ("pre_kinding_"^ttok))] + else [] + in + let rng = Ident.range_of_lid t in + let tot_fun_axioms = EncodeTerm.isTotFun_axioms rng ttok_tm vars (List.map (fun _ -> mkTrue) vars) true in + decls@(karr@[Util.mkAssume(mkAnd(tot_fun_axioms, mkForall rng ([[tapp]], vars, mkImp(guard, k))), + None, + ("kinding_"^ttok))] |> mk_decls_trivial) + in + let aux = + kindingAx + @(inversion_axioms env tapp vars) + @([pretype_axiom (not injective_type_params) (Ident.range_of_lid t) env tapp vars] |> mk_decls_trivial) + in + (decls |> mk_decls_trivial)@binder_decls@aux, env + +let encode_datacon (env:env_t) (se:sigelt) +: decls_t * env_t += let Sig_datacon {lid=d; t; num_ty_params=n_tps; mutuals; injective_type_params } = se.sigel in + let quals = se.sigquals in + let t = norm_before_encoding env t in + let formals, t_res = U.arrow_formals t in + let arity = List.length formals in + let ddconstrsym, ddtok, env = new_term_constant_and_tok_from_lid env d arity in + let ddtok_tm = mkApp(ddtok, []) in + let fuel_var, fuel_tm = fresh_fvar env.current_module_name "f" Fuel_sort in + let s_fuel_tm = mkApp("SFuel", [fuel_tm]) in + let vars, guards, env', binder_decls, names = encode_binders (Some fuel_tm) formals env in + let injective_type_params = + injective_type_params || Options.ext_getv "compat:injectivity" <> "" + in + let fields = + names |> + List.mapi + (fun n x -> + let field_projectible = + n >= n_tps || //either this field is not a type parameter + injective_type_params //or we are allowed to be injective on parameters + in + { field_name=mk_term_projector_name d x; + field_sort=Term_sort; + field_projectible }) + in + let datacons = { + constr_name=ddconstrsym; + constr_fields=fields; + constr_sort=Term_sort; + constr_id=Some (varops.next_id()); + constr_base=not injective_type_params + } |> Term.constructor_to_decl (Ident.range_of_lid d) in + let app = mk_Apply ddtok_tm vars in + let guard = mk_and_l guards in + let xvars = List.map mkFreeV vars in + let dapp = mkApp(ddconstrsym, xvars) in //arity ok; |xvars| = |formals| = arity + + let tok_typing, decls3 = encode_term_pred None t env ddtok_tm in + let tok_typing = + match fields with + | _::_ -> + let ff = mk_fv ("ty", Term_sort) in + let f = mkFreeV ff in + let vtok_app_l = mk_Apply ddtok_tm [ff] in + let vtok_app_r = mk_Apply f [mk_fv (ddtok, Term_sort)] in + //guard the token typing assumption with a Apply(tok, f) or Apply(f, tok) + //Additionally, the body of the term becomes NoHoist f (HasType tok ...) + // to prevent the Z3 simplifier from hoisting the (HasType tok ...) part out + //Since the top-levels of modules are full of function typed terms + //not guarding it this way causes every typing assumption of an arrow type to be fired immediately + //regardless of whether or not the function is used ... leading to bloat + //these patterns aim to restrict the use of the typing assumption until such point as it is actually needed + mkForall (Ident.range_of_lid d) + ([[vtok_app_l]; [vtok_app_r]], + [ff], + Term.mk_NoHoist f tok_typing) + | _ -> tok_typing in + let ty_pred', t_res_tm, decls_pred = + let t_res_tm, t_res_decls = encode_term t_res env' in + mk_HasTypeWithFuel (Some fuel_tm) dapp t_res_tm, t_res_tm, t_res_decls in + let proxy_fresh = match formals with + | [] -> [] + | _ -> [Term.fresh_token (ddtok, Term_sort) (varops.next_id())] in + + let encode_elim () = + let head, args = U.head_and_args t_res in + match (SS.compress head).n with + | Tm_uinst({n=Tm_fvar fv}, _) + | Tm_fvar fv -> + let encoded_head_fvb = lookup_free_var_name env' fv.fv_name in + let encoded_args, arg_decls = encode_args args env' in + let _, arg_vars, elim_eqns_or_guards, _ = + List.fold_left + (fun (env, arg_vars, eqns_or_guards, i) (orig_arg, arg) -> + let _, xv, env = gen_term_var env (S.new_bv None tun) in + (* we only get equations induced on the type indices, not parameters; *) + (* Also see https://github.com/FStarLang/FStar/issues/349 *) + let eqns = + if i < n_tps + then eqns_or_guards + else mkEq(arg, xv)::eqns_or_guards + in + (env, xv::arg_vars, eqns, i + 1)) + (env', [], [], 0) + (FStar.Compiler.List.zip args encoded_args) + in + let arg_vars = List.rev arg_vars in + let arg_params, _ = List.splitAt n_tps arg_vars in + let data_arg_params, _ = List.splitAt n_tps vars in + //Express the guards in terms of the parameters of the type constructor + //not the arguments of the data constructor + let elim_eqns_and_guards = + List.fold_left2 + (fun elim_eqns_and_guards data_arg_param arg_param -> + Term.subst elim_eqns_and_guards data_arg_param arg_param) + (mk_and_l (elim_eqns_or_guards@guards)) + data_arg_params + arg_params + in + let ty = maybe_curry_fvb fv.fv_name.p encoded_head_fvb arg_vars in + let xvars = List.map mkFreeV vars in + let dapp = mkApp(ddconstrsym, xvars) in //arity ok; |xvars| = |formals| = arity + let ty_pred = mk_HasTypeWithFuel (Some s_fuel_tm) dapp ty in + let arg_binders = List.map fv_of_term arg_vars in + let typing_inversion = + Util.mkAssume(mkForall (Ident.range_of_lid d) ([[ty_pred]], + add_fuel (mk_fv (fuel_var, Fuel_sort)) (vars@arg_binders), + mkImp(ty_pred, elim_eqns_and_guards)), + Some "data constructor typing elim", + ("data_elim_" ^ ddconstrsym)) in + let lex_t = mkFreeV <| mk_fv (string_of_lid Const.lex_t_lid, Term_sort) in + let subterm_ordering = + (* subterm ordering *) + let prec = + vars + |> List.mapi (fun i v -> + (* it's a parameter, so it's inaccessible and no need for a sub-term ordering on it *) + if i < n_tps + then [] + else [mk_Precedes lex_t lex_t (mkFreeV v) dapp]) + |> List.flatten + in + Util.mkAssume(mkForall (Ident.range_of_lid d) + ([[ty_pred]], + add_fuel (mk_fv (fuel_var, Fuel_sort)) (vars@arg_binders), + mkImp(ty_pred, mk_and_l prec)), + Some "subterm ordering", + ("subterm_ordering_"^ddconstrsym)) + in + let codomain_ordering, codomain_decls = + let _, formals' = BU.first_N n_tps formals in (* no codomain ordering for the parameters *) + let _, vars' = BU.first_N n_tps vars in + let norm t = + N.unfold_whnf' [Env.AllowUnboundUniverses; + Env.EraseUniverses; + Env.Unascribe; + //we don't know if this will terminate; so don't do recursive steps + Env.Exclude Env.Zeta] + env'.tcenv + t + in + let warn_compat () = + FStar.Errors.log_issue + (S.range_of_fv fv) + (FStar.Errors.Warning_DeprecatedGeneric, + "Using 'compat:2954' to use a permissive encoding of the subterm ordering on the codomain of a constructor.\n\ + This is deprecated and will be removed in a future version of F*.") + in + let codomain_prec_l, cod_decls = + List.fold_left2 + (fun (codomain_prec_l, cod_decls) formal var -> + let rec binder_and_codomain_type t = + let t = U.unrefine t in + match (SS.compress t).n with + | Tm_arrow _ -> + let bs, c = U.arrow_formals_comp (U.unrefine t) in + begin + match bs with + | [] -> None + | _ when not (U.is_tot_or_gtot_comp c) -> None + | _ -> + if U.is_lemma_comp c + then None //not useful for lemmas + else + let t = U.unrefine (U.comp_result c) in + let t = norm t in + if is_type t || U.is_sub_singleton t + then None //ordering on Type and squashed values is not useful + else ( + let head, _ = U.head_and_args_full t in + match (U.un_uinst head).n with + | Tm_fvar fv -> + if BU.for_some (S.fv_eq_lid fv) mutuals + then Some (bs, c) + else if Options.ext_getv "compat:2954" <> "" + then (warn_compat(); Some (bs, c)) //compatibility mode + else None + | _ -> + if Options.ext_getv "compat:2954" <> "" + then (warn_compat(); Some (bs, c)) //compatibility mode + else None + ) + end + | _ -> + let head, _ = U.head_and_args t in + let t' = norm t in + let head', _ = U.head_and_args t' in + match TEQ.eq_tm env.tcenv head head' with + | TEQ.Equal -> None //no progress after whnf + | TEQ.NotEqual -> binder_and_codomain_type t' + | _ -> + //Did we actually make progress? Be conservative to avoid an infinite loop + match (SS.compress head).n with + | Tm_fvar _ + | Tm_name _ + | Tm_uinst _ -> + //The underlying name must have changed, otherwise we would have got Equal + //so, we made some progress + binder_and_codomain_type t' + | _ -> + //unclear if we made progress or not + None + + in + match binder_and_codomain_type formal.binder_bv.sort with + | None -> + codomain_prec_l, cod_decls + | Some (bs, c) -> + //var bs << D ... var ... + let bs', guards', _env', bs_decls, _ = encode_binders None bs env' in + let fun_app = mk_Apply (mkFreeV var) bs' in + mkForall (Ident.range_of_lid d) + ([[mk_Precedes lex_t lex_t fun_app dapp]], + bs', + //need to use ty_pred' here, to avoid variable capture + //Note, ty_pred' is indexed by fuel, not S_fuel + //That's ok, since the outer pattern is guarded on S_fuel + mkImp (mk_and_l (ty_pred'::guards'), + mk_Precedes lex_t lex_t fun_app dapp)) + :: codomain_prec_l, + bs_decls @ cod_decls) + ([],[]) + formals' + vars' + in + match codomain_prec_l with + | [] -> + [], cod_decls + | _ -> + [Util.mkAssume(mkForall (Ident.range_of_lid d) + ([[ty_pred]],//we use ty_pred here as the pattern, which has an S_fuel guard + add_fuel (mk_fv (fuel_var, Fuel_sort)) (vars@arg_binders), + mk_and_l codomain_prec_l), + Some "well-founded ordering on codomain", + ("well_founded_ordering_on_codomain_"^ddconstrsym))], + cod_decls + in + arg_decls @ codomain_decls, + [typing_inversion; subterm_ordering] @ codomain_ordering + + | _ -> + Errors.log_issue se.sigrng + (Errors.Warning_ConstructorBuildsUnexpectedType, + BU.format2 "Constructor %s builds an unexpected type %s\n" + (Print.lid_to_string d) (Print.term_to_string head)); + [], [] + in + let decls2, elim = encode_elim () in + let data_cons_typing_intro_decl = + // + //AR: + // + //Typing intro for the data constructor + // + //We do a bit of manipulation for type indices + //Consider the Cons data constructor of a length-indexed vector type: + // type vector : nat -> Type = | Emp : vector 0 + // | Cons: n:nat -> hd:nat -> tl:vec n -> vec (n+1) + // + //So far we have + // ty_pred' = HasTypeFuel f (Cons n hd tl) (vector (n+1)) + // vars = n, hd, tl + // guard = And of typing guards for n, hd, tl (i.e. (HasType n nat) etc.) + // + //If we emitted the straightforward typing axiom: + // forall n hd tl. HasTypeFuel f (Cons n hd tl) (vector (n+1)) + //with pattern + // HasTypeFuel f (Cons n hd tl) (vecor (n+1)) + // + //It results in too restrictive a pattern, + //Specifically, if we need to prove HasTypeFuel f (Cons 0 1 Emp) (vector 1), + // the axiom will not fire, since the pattern is specifically looking for + // (n+1) in the resulting vector type, whereas here we have a term 1, + // which is not addition syntactically + // + //So we do a little bit of surgery below to emit an axiom of the form: + // forall n hd tl m. m = n + 1 ==> HasTypeFuel f (Cons n hd tl) (vector m) + //where m is a fresh variable + // + //Also see #2456 + // + let ty_pred', vars, guard = + match t_res_tm.tm with + | App (op, args) -> + //iargs are index arguments in the return type of the data constructor + let targs, iargs = List.splitAt n_tps args in + //fresh vars for iargs + let fresh_ivars, fresh_iargs = + iargs |> List.map (fun _ -> fresh_fvar env.current_module_name "i" Term_sort) + |> List.split in + //equality guards + let additional_guards = + mk_and_l (List.map2 (fun a fresh_a -> mkEq (a, fresh_a)) iargs fresh_iargs) in + + mk_HasTypeWithFuel + (Some fuel_tm) + dapp + ({t_res_tm with tm = App (op, targs@fresh_iargs)}), + + vars@(fresh_ivars |> List.map (fun s -> mk_fv (s, Term_sort))), + + mkAnd (guard, additional_guards) + + | _ -> ty_pred', vars, guard in //When will this case arise? + + Util.mkAssume(mkForall (Ident.range_of_lid d) + ([[ty_pred']],add_fuel (mk_fv (fuel_var, Fuel_sort)) vars, mkImp(guard, ty_pred')), + Some "data constructor typing intro", + ("data_typing_intro_"^ddtok)) in + + let g = binder_decls + @decls2 + @decls3 + @([Term.DeclFun(ddtok, [], Term_sort, Some (BU.format1 "data constructor proxy: %s" (Print.lid_to_string d)))] + @proxy_fresh |> mk_decls_trivial) + @decls_pred + @([Util.mkAssume(tok_typing, Some "typing for data constructor proxy", ("typing_tok_"^ddtok)); + Util.mkAssume(mkForall (Ident.range_of_lid d) + ([[app]], vars, + mkEq(app, dapp)), Some "equality for proxy", ("equality_tok_"^ddtok)); + data_cons_typing_intro_decl; + ]@elim |> mk_decls_trivial) in + (datacons |> mk_decls_trivial) @ g, env + let rec encode_sigelt (env:env_t) (se:sigelt) : (decls_t * env_t) = let nm = Print.sigelt_to_string_short se in @@ -1010,7 +1477,7 @@ let rec encode_sigelt (env:env_t) (se:sigelt) : (decls_t * env_t) = match g with | [] -> begin - if Env.debug env.tcenv <| Options.Other "SMTEncoding" then + if !dbg_SMTEncoding then BU.print1 "Skipped encoding of %s\n" nm; [Caption (BU.format1 "" nm)] |> mk_decls_trivial end @@ -1021,7 +1488,7 @@ let rec encode_sigelt (env:env_t) (se:sigelt) : (decls_t * env_t) = g, env and encode_sigelt' (env:env_t) (se:sigelt) : (decls_t * env_t) = - if Env.debug env.tcenv <| Options.Other "SMTEncoding" + if !dbg_SMTEncoding then (BU.print1 "@@@Encoding sigelt %s\n" (Print.sigelt_to_string se)); let is_opaque_to_smt (t:S.term) = @@ -1174,7 +1641,7 @@ and encode_sigelt' (env:env_t) (se:sigelt) : (decls_t * env_t) = (* Discriminators *) | Sig_let _ when (se.sigquals |> BU.for_some (function Discriminator _ -> true | _ -> false)) -> //Discriminators are encoded directly via (our encoding of) theory of datatypes - if Env.debug env.tcenv <| Options.Other "SMTEncoding" then + if !dbg_SMTEncoding then BU.print1 "Not encoding discriminator '%s'\n" (Print.sigelt_to_string_short se); [], env @@ -1182,7 +1649,7 @@ and encode_sigelt' (env:env_t) (se:sigelt) : (decls_t * env_t) = | Sig_let {lids} when (lids |> BU.for_some (fun (l:lident) -> string_of_id (List.hd (ns_of_lid l)) = "Prims") && se.sigquals |> BU.for_some (function Unfold_for_unification_and_vcgen -> true | _ -> false)) -> //inline lets from prims are never encoded as definitions --- since they will be inlined - if Env.debug env.tcenv <| Options.Other "SMTEncoding" then + if !dbg_SMTEncoding then BU.print1 "Not encoding unfold let from Prims '%s'\n" (Print.sigelt_to_string_short se); [], env @@ -1214,514 +1681,62 @@ and encode_sigelt' (env:env_t) (se:sigelt) : (decls_t * env_t) = encode_top_level_let env (is_rec, bindings) se.sigquals | Sig_bundle {ses} -> - let g, env = encode_sigelts env ses in - let g', inversions = List.fold_left (fun (g', inversions) elt -> - let elt_g', elt_inversions = elt.decls |> List.partition (function - | Term.Assume({assumption_caption=Some "inversion axiom"}) -> false - | _ -> true) in - g' @ [ { elt with decls = elt_g' } ], inversions @ elt_inversions - ) ([], []) g in - let decls, elts, rest = List.fold_left (fun (decls, elts, rest) elt -> - if elt.key |> BU.is_some && List.existsb (function | Term.DeclFun _ -> true | _ -> false) elt.decls - then decls, elts@[elt], rest - else let elt_decls, elt_rest = elt.decls |> List.partition (function - | Term.DeclFun _ -> true - | _ -> false) in - decls @ elt_decls, elts, rest @ [ { elt with decls = elt_rest }] - ) ([], [], []) g' in - (decls |> mk_decls_trivial) @ elts @ rest @ (inversions |> mk_decls_trivial), env - - | Sig_inductive_typ {lid=t; - us=universe_names; - params=tps; - t=k; - ds=datas} -> - let tcenv = env.tcenv in - let is_injective = - let usubst, uvs = SS.univ_var_opening universe_names in - let env, tps, k = - Env.push_univ_vars tcenv uvs, - SS.subst_binders usubst tps, - SS.subst (SS.shift_subst (List.length tps) usubst) k - in - let tps, k = SS.open_term tps k in - let _, k = U.arrow_formals k in //don't care about indices here - let tps, env_tps, _, us = TcTerm.tc_binders env tps in - let u_k = - TcTerm.level_of_type - env_tps - (S.mk_Tm_app - (S.fvar t None) - (snd (U.args_of_binders tps)) - (Ident.range_of_lid t)) - k - in - //BU.print2 "Universe of tycon: %s : %s\n" (Ident.string_of_lid t) (Print.univ_to_string u_k); - let rec universe_leq u v = - match u, v with - | U_zero, _ -> true - | U_succ u0, U_succ v0 -> universe_leq u0 v0 - | U_name u0, U_name v0 -> Ident.ident_equals u0 v0 - | U_name _, U_succ v0 -> universe_leq u v0 - | U_max us, _ -> us |> BU.for_all (fun u -> universe_leq u v) - | _, U_max vs -> vs |> BU.for_some (universe_leq u) - | U_unknown, _ - | _, U_unknown - | U_unif _, _ - | _, U_unif _ -> failwith (BU.format3 "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" - (Ident.string_of_lid t) - (Print.univ_to_string u) - (Print.univ_to_string v)) - | _ -> false - in - let u_leq_u_k u = - universe_leq (N.normalize_universe env_tps u) u_k - in - let tp_ok (tp:S.binder) (u_tp:universe) = - let t_tp = tp.binder_bv.sort in - if u_leq_u_k u_tp - then true - else let formals, _ = U.arrow_formals t_tp in - let _, _, _, u_formals = TcTerm.tc_binders env_tps formals in - //List.iter (fun u -> BU.print1 "Universe of formal: %s\n" (Print.univ_to_string u)) u_formals; - BU.for_all (fun u_formal -> u_leq_u_k u_formal) u_formals - in - List.forall2 tp_ok tps us - in - if Env.debug env.tcenv <| Options.Other "SMTEncoding" - then BU.print2 "%s injectivity for %s\n" - (if is_injective then "YES" else "NO") - (Ident.string_of_lid t); - let quals = se.sigquals in - let is_logical = quals |> BU.for_some (function Logic | Assumption -> true | _ -> false) in - let constructor_or_logic_type_decl (c:constructor_t) = - if is_logical - then [Term.DeclFun(c.constr_name, c.constr_fields |> List.map (fun f -> f.field_sort), Term_sort, None)] - else constructor_to_decl (Ident.range_of_lid t) c in - let inversion_axioms env tapp vars = - if datas |> BU.for_some (fun l -> Env.try_lookup_lid env.tcenv l |> Option.isNone) //Q: Why would this happen? - then [] - else - let xxsym, xx = fresh_fvar env.current_module_name "x" Term_sort in - let data_ax, decls = datas |> List.fold_left (fun (out, decls) l -> - let _, data_t = Env.lookup_datacon env.tcenv l in - let args, res = U.arrow_formals data_t in - let indices = res |> U.head_and_args_full |> snd in - let env = args |> List.fold_left - (fun env ({binder_bv=x}) -> push_term_var env x (mkApp(mk_term_projector_name l x, [xx]))) - env in - let indices, decls' = encode_args indices env in - if List.length indices <> List.length vars - then failwith "Impossible"; - let eqs = - if is_injective - then List.map2 (fun v a -> mkEq(mkFreeV v, a)) vars indices - else [] in - mkOr(out, mkAnd(mk_data_tester env l xx, eqs |> mk_and_l)), decls@decls') (mkFalse, []) in - let ffsym, ff = fresh_fvar env.current_module_name "f" Fuel_sort in - let fuel_guarded_inversion = - let xx_has_type_sfuel = - if List.length datas > 1 - then mk_HasTypeFuel (mkApp("SFuel", [ff])) xx tapp - else mk_HasTypeFuel ff xx tapp in //no point requiring non-zero fuel if there are no disjunctions - Util.mkAssume(mkForall (Ident.range_of_lid t) ([[xx_has_type_sfuel]], add_fuel (mk_fv (ffsym, Fuel_sort)) (mk_fv (xxsym, Term_sort)::vars), - mkImp(xx_has_type_sfuel, data_ax)), - Some "inversion axiom", //this name matters! see Sig_bundle case near line 1493 - (varops.mk_unique ("fuel_guarded_inversion_"^(string_of_lid t)))) in - decls - @([fuel_guarded_inversion] |> mk_decls_trivial) in - - let formals, res = - let k = - match tps with - | [] -> k - | _ -> S.mk (Tm_arrow {bs=tps; comp=S.mk_Total k}) k.pos - in - let k = norm_before_encoding env k in - U.arrow_formals k - in - - let vars, guards, env', binder_decls, _ = encode_binders None formals env in - let arity = List.length vars in - let tname, ttok, env = new_term_constant_and_tok_from_lid env t arity in - let ttok_tm = mkApp(ttok, []) in - let guard = mk_and_l guards in - let tapp = mkApp(tname, List.map mkFreeV vars) in //arity ok - let decls, env = - //See: https://github.com/FStarLang/FStar/commit/b75225bfbe427c8aef5b59f70ff6d79aa014f0b4 - //See: https://github.com/FStarLang/FStar/issues/349 - let tname_decl = - constructor_or_logic_type_decl - { - constr_name = tname; - constr_fields = vars |> List.map (fun fv -> {field_name=tname^fv_name fv; field_sort=fv_sort fv; field_projectible=false}) ; - //The field_projectible=false above is extremely important; it makes sure that type-formers are not injective - constr_sort=Term_sort; - constr_id=Some (varops.next_id()) - } + let g, env = + ses |> + List.fold_left + (fun (g, env) se -> + let g', env = + match se.sigel with + | Sig_inductive_typ _ -> + encode_sig_inductive env se + | Sig_datacon _ -> + encode_datacon env se + | _ -> + encode_sigelt env se in - let tok_decls, env = - match vars with - | [] -> [], push_free_var env t arity tname (Some <| mkApp(tname, [])) - | _ -> - let ttok_decl = Term.DeclFun(ttok, [], Term_sort, Some "token") in - let ttok_fresh = Term.fresh_token (ttok, Term_sort) (varops.next_id()) in - let ttok_app = mk_Apply ttok_tm vars in - let pats = [[ttok_app]; [tapp]] in - // These patterns allow rewriting (ApplyT T@tok args) to (T args) and vice versa - // This seems necessary for some proofs, but the bidirectional rewriting may be inefficient - let name_tok_corr = Util.mkAssume(mkForall' (Ident.range_of_lid t) (pats, None, vars, mkEq(ttok_app, tapp)), - Some "name-token correspondence", - ("token_correspondence_"^ttok)) in - [ttok_decl; ttok_fresh; name_tok_corr], env in - tname_decl@tok_decls, env in - let kindingAx = - let k, decls = encode_term_pred None res env' tapp in - let karr = - if List.length formals > 0 - then [Util.mkAssume(mk_tester "Tm_arrow" (mk_PreType ttok_tm), Some "kinding", ("pre_kinding_"^ttok))] - else [] - in - let rng = Ident.range_of_lid t in - let tot_fun_axioms = - EncodeTerm.isTotFun_axioms rng ttok_tm vars (List.map (fun _ -> mkTrue) vars) true - in - - decls@(karr@[Util.mkAssume(mkAnd(tot_fun_axioms, mkForall rng ([[tapp]], vars, mkImp(guard, k))), None, ("kinding_"^ttok))] - |> mk_decls_trivial) in - let aux = - kindingAx - @(inversion_axioms env tapp vars) - @([pretype_axiom (Ident.range_of_lid t) env tapp vars] |> mk_decls_trivial) in - - let g = (decls |> mk_decls_trivial) - @binder_decls - @aux in - g, env - - | Sig_datacon {lid=d; t; num_ty_params=n_tps; mutuals} -> - let quals = se.sigquals in - let t = norm_before_encoding env t in - let formals, t_res = U.arrow_formals t in - let arity = List.length formals in - let ddconstrsym, ddtok, env = new_term_constant_and_tok_from_lid env d arity in - let ddtok_tm = mkApp(ddtok, []) in - let fuel_var, fuel_tm = fresh_fvar env.current_module_name "f" Fuel_sort in - let s_fuel_tm = mkApp("SFuel", [fuel_tm]) in - let vars, guards, env', binder_decls, names = encode_binders (Some fuel_tm) formals env in - let fields = names |> List.mapi (fun n x -> - { field_name=mk_term_projector_name d x; - field_sort=Term_sort; - field_projectible=true }) - in - let datacons = - {constr_name=ddconstrsym; - constr_fields=fields; - constr_sort=Term_sort; - constr_id=Some (varops.next_id()) - } |> Term.constructor_to_decl (Ident.range_of_lid d) in - let app = mk_Apply ddtok_tm vars in - let guard = mk_and_l guards in - let xvars = List.map mkFreeV vars in - let dapp = mkApp(ddconstrsym, xvars) in //arity ok; |xvars| = |formals| = arity - - let tok_typing, decls3 = encode_term_pred None t env ddtok_tm in - let tok_typing = - match fields with - | _::_ -> - let ff = mk_fv ("ty", Term_sort) in - let f = mkFreeV ff in - let vtok_app_l = mk_Apply ddtok_tm [ff] in - let vtok_app_r = mk_Apply f [mk_fv (ddtok, Term_sort)] in - //guard the token typing assumption with a Apply(tok, f) or Apply(f, tok) - //Additionally, the body of the term becomes NoHoist f (HasType tok ...) - // to prevent the Z3 simplifier from hoisting the (HasType tok ...) part out - //Since the top-levels of modules are full of function typed terms - //not guarding it this way causes every typing assumption of an arrow type to be fired immediately - //regardless of whether or not the function is used ... leading to bloat - //these patterns aim to restrict the use of the typing assumption until such point as it is actually needed - mkForall (Ident.range_of_lid d) - ([[vtok_app_l]; [vtok_app_r]], - [ff], - Term.mk_NoHoist f tok_typing) - | _ -> tok_typing in - let ty_pred', t_res_tm, decls_pred = - let t_res_tm, t_res_decls = encode_term t_res env' in - mk_HasTypeWithFuel (Some fuel_tm) dapp t_res_tm, t_res_tm, t_res_decls in - let proxy_fresh = match formals with - | [] -> [] - | _ -> [Term.fresh_token (ddtok, Term_sort) (varops.next_id())] in - - let encode_elim () = - let head, args = U.head_and_args t_res in - match (SS.compress head).n with - | Tm_uinst({n=Tm_fvar fv}, _) - | Tm_fvar fv -> - let encoded_head_fvb = lookup_free_var_name env' fv.fv_name in - let encoded_args, arg_decls = encode_args args env' in - let guards_for_parameter (orig_arg:S.term)(arg:term) xv = - let fv = - match arg.tm with - | FreeV fv -> fv - | _ -> - Errors.raise_error (Errors.Fatal_NonVariableInductiveTypeParameter, - BU.format1 "Inductive type parameter %s must be a variable ; \ - You may want to change it to an index." - (FStar.Syntax.Print.term_to_string orig_arg)) orig_arg.pos - in - let guards = guards |> List.collect (fun g -> - if List.contains fv (Term.free_variables g) - then [Term.subst g fv xv] - else []) - in - mk_and_l guards - in - let _, arg_vars, elim_eqns_or_guards, _ = - List.fold_left - (fun (env, arg_vars, eqns_or_guards, i) (orig_arg, arg) -> - let _, xv, env = gen_term_var env (S.new_bv None tun) in - (* we only get equations induced on the type indices, not parameters; *) - (* Also see https://github.com/FStarLang/FStar/issues/349 *) - let eqns = - if i < n_tps - then guards_for_parameter (fst orig_arg) arg xv::eqns_or_guards - else mkEq(arg, xv)::eqns_or_guards - in - (env, xv::arg_vars, eqns, i + 1)) - (env', [], [], 0) - (FStar.Compiler.List.zip args encoded_args) - in - let arg_vars = List.rev arg_vars in - let ty = maybe_curry_fvb fv.fv_name.p encoded_head_fvb arg_vars in - let xvars = List.map mkFreeV vars in - let dapp = mkApp(ddconstrsym, xvars) in //arity ok; |xvars| = |formals| = arity - let ty_pred = mk_HasTypeWithFuel (Some s_fuel_tm) dapp ty in - let arg_binders = List.map fv_of_term arg_vars in - let typing_inversion = - Util.mkAssume(mkForall (Ident.range_of_lid d) ([[ty_pred]], - add_fuel (mk_fv (fuel_var, Fuel_sort)) (vars@arg_binders), - mkImp(ty_pred, mk_and_l (elim_eqns_or_guards@guards))), - Some "data constructor typing elim", - ("data_elim_" ^ ddconstrsym)) in - let lex_t = mkFreeV <| mk_fv (string_of_lid Const.lex_t_lid, Term_sort) in - let subterm_ordering = - (* subterm ordering *) - let prec = - vars - |> List.mapi (fun i v -> - (* it's a parameter, so it's inaccessible and no need for a sub-term ordering on it *) - if i < n_tps - then [] - else [mk_Precedes lex_t lex_t (mkFreeV v) dapp]) - |> List.flatten - in - Util.mkAssume(mkForall (Ident.range_of_lid d) - ([[ty_pred]], - add_fuel (mk_fv (fuel_var, Fuel_sort)) (vars@arg_binders), - mkImp(ty_pred, mk_and_l prec)), - Some "subterm ordering", - ("subterm_ordering_"^ddconstrsym)) + g@g', env) + ([], env) + in + //reorder the generated decls in proper def-use order, + //i.e, declare all the function symbols first + //1. move the inversions last; they rely on all the symbols + let g', inversions = + List.fold_left + (fun (g', inversions) elt -> + let elt_g', elt_inversions = + elt.decls |> + List.partition + (function + | Term.Assume({assumption_caption=Some "inversion axiom"}) -> false + | _ -> true) in - let codomain_ordering, codomain_decls = - let _, formals' = BU.first_N n_tps formals in (* no codomain ordering for the parameters *) - let _, vars' = BU.first_N n_tps vars in - let norm t = - N.unfold_whnf' [Env.AllowUnboundUniverses; - Env.EraseUniverses; - Env.Unascribe; - //we don't know if this will terminate; so don't do recursive steps - Env.Exclude Env.Zeta] - env'.tcenv - t - in - let warn_compat () = - FStar.Errors.log_issue - (S.range_of_fv fv) - (FStar.Errors.Warning_DeprecatedGeneric, - "Using 'compat:2954' to use a permissive encoding of the subterm ordering on the codomain of a constructor.\n\ - This is deprecated and will be removed in a future version of F*.") - in - let codomain_prec_l, cod_decls = - List.fold_left2 - (fun (codomain_prec_l, cod_decls) formal var -> - let rec binder_and_codomain_type t = - let t = U.unrefine t in - match (SS.compress t).n with - | Tm_arrow _ -> - let bs, c = U.arrow_formals_comp (U.unrefine t) in - begin - match bs with - | [] -> None - | _ when not (U.is_tot_or_gtot_comp c) -> None - | _ -> - if U.is_lemma_comp c - then None //not useful for lemmas - else - let t = U.unrefine (U.comp_result c) in - let t = norm t in - if is_type t || U.is_sub_singleton t - then None //ordering on Type and squashed values is not useful - else ( - let head, _ = U.head_and_args_full t in - match (U.un_uinst head).n with - | Tm_fvar fv -> - if BU.for_some (S.fv_eq_lid fv) mutuals - then Some (bs, c) - else if Options.ext_getv "compat:2954" <> "" - then (warn_compat(); Some (bs, c)) //compatibility mode - else None - | _ -> - if Options.ext_getv "compat:2954" <> "" - then (warn_compat(); Some (bs, c)) //compatibility mode - else None - ) - end - | _ -> - let head, _ = U.head_and_args t in - let t' = norm t in - let head', _ = U.head_and_args t' in - match U.eq_tm head head' with - | U.Equal -> None //no progress after whnf - | U.NotEqual -> binder_and_codomain_type t' - | _ -> - //Did we actually make progress? Be conservative to avoid an infinite loop - match (SS.compress head).n with - | Tm_fvar _ - | Tm_name _ - | Tm_uinst _ -> - //The underlying name must have changed, otherwise we would have got Equal - //so, we made some progress - binder_and_codomain_type t' - | _ -> - //unclear if we made progress or not - None - - in - match binder_and_codomain_type formal.binder_bv.sort with - | None -> - codomain_prec_l, cod_decls - | Some (bs, c) -> - //var bs << D ... var ... - let bs', guards', _env', bs_decls, _ = encode_binders None bs env' in - let fun_app = mk_Apply (mkFreeV var) bs' in - mkForall (Ident.range_of_lid d) - ([[mk_Precedes lex_t lex_t fun_app dapp]], - bs', - //need to use ty_pred' here, to avoid variable capture - //Note, ty_pred' is indexed by fuel, not S_fuel - //That's ok, since the outer pattern is guarded on S_fuel - mkImp (mk_and_l (ty_pred'::guards'), - mk_Precedes lex_t lex_t fun_app dapp)) - :: codomain_prec_l, - bs_decls @ cod_decls) - ([],[]) - formals' - vars' - in - match codomain_prec_l with - | [] -> - [], cod_decls - | _ -> - [Util.mkAssume(mkForall (Ident.range_of_lid d) - ([[ty_pred]],//we use ty_pred here as the pattern, which has an S_fuel guard - add_fuel (mk_fv (fuel_var, Fuel_sort)) (vars@arg_binders), - mk_and_l codomain_prec_l), - Some "well-founded ordering on codomain", - ("well_founded_ordering_on_codomain_"^ddconstrsym))], - cod_decls + g' @ [ { elt with decls = elt_g' } ], + inversions @ elt_inversions) + ([], []) + g + in + //2. decls are all the function symbol declarations + // elts: all elements that have a key and which contain function declarations (not sure why this class is important to pull out) + // rest: all the non-declarations, excepting the inversion axiom which is already identified above + let decls, elts, rest = + List.fold_left + (fun (decls, elts, rest) elt -> + if BU.is_some elt.key //NS: Not sure what this case is for + && List.existsb (function | Term.DeclFun _ -> true | _ -> false) elt.decls + then decls, elts@[elt], rest + else ( //Pull the function symbol decls to the front + let elt_decls, elt_rest = + elt.decls |> + List.partition + (function + | Term.DeclFun _ -> true + | _ -> false) in - arg_decls @ codomain_decls, - [typing_inversion; subterm_ordering] @ codomain_ordering - - | _ -> - Errors.log_issue se.sigrng - (Errors.Warning_ConstructorBuildsUnexpectedType, - BU.format2 "Constructor %s builds an unexpected type %s\n" - (Print.lid_to_string d) (Print.term_to_string head)); - [], [] - in - let decls2, elim = encode_elim () in - let data_cons_typing_intro_decl = - // - //AR: - // - //Typing intro for the data constructor - // - //We do a bit of manipulation for type indices - //Consider the Cons data constructor of a length-indexed vector type: - // type vector : nat -> Type = | Emp : vector 0 - // | Cons: n:nat -> hd:nat -> tl:vec n -> vec (n+1) - // - //So far we have - // ty_pred' = HasTypeFuel f (Cons n hd tl) (vector (n+1)) - // vars = n, hd, tl - // guard = And of typing guards for n, hd, tl (i.e. (HasType n nat) etc.) - // - //If we emitted the straightforward typing axiom: - // forall n hd tl. HasTypeFuel f (Cons n hd tl) (vector (n+1)) - //with pattern - // HasTypeFuel f (Cons n hd tl) (vecor (n+1)) - // - //It results in too restrictive a pattern, - //Specifically, if we need to prove HasTypeFuel f (Cons 0 1 Emp) (vector 1), - // the axiom will not fire, since the pattern is specifically looking for - // (n+1) in the resulting vector type, whereas here we have a term 1, - // which is not addition syntactically - // - //So we do a little bit of surgery below to emit an axiom of the form: - // forall n hd tl m. m = n + 1 ==> HasTypeFuel f (Cons n hd tl) (vector m) - //where m is a fresh variable - // - //Also see #2456 - // - let ty_pred', vars, guard = - match t_res_tm.tm with - | App (op, args) -> - //iargs are index arguments in the return type of the data constructor - let targs, iargs = List.splitAt n_tps args in - //fresh vars for iargs - let fresh_ivars, fresh_iargs = - iargs |> List.map (fun _ -> fresh_fvar env.current_module_name "i" Term_sort) - |> List.split in - //equality guards - let additional_guards = - mk_and_l (List.map2 (fun a fresh_a -> mkEq (a, fresh_a)) iargs fresh_iargs) in - - mk_HasTypeWithFuel - (Some fuel_tm) - dapp - ({t_res_tm with tm = App (op, targs@fresh_iargs)}), - - vars@(fresh_ivars |> List.map (fun s -> mk_fv (s, Term_sort))), - - mkAnd (guard, additional_guards) - - | _ -> ty_pred', vars, guard in //When will this case arise? - - Util.mkAssume(mkForall (Ident.range_of_lid d) - ([[ty_pred']],add_fuel (mk_fv (fuel_var, Fuel_sort)) vars, mkImp(guard, ty_pred')), - Some "data constructor typing intro", - ("data_typing_intro_"^ddtok)) in - - let g = binder_decls - @decls2 - @decls3 - @([Term.DeclFun(ddtok, [], Term_sort, Some (BU.format1 "data constructor proxy: %s" (Print.lid_to_string d)))] - @proxy_fresh |> mk_decls_trivial) - @decls_pred - @([Util.mkAssume(tok_typing, Some "typing for data constructor proxy", ("typing_tok_"^ddtok)); - Util.mkAssume(mkForall (Ident.range_of_lid d) - ([[app]], vars, - mkEq(app, dapp)), Some "equality for proxy", ("equality_tok_"^ddtok)); - data_cons_typing_intro_decl; - ]@elim |> mk_decls_trivial) in - (datacons |> mk_decls_trivial) @ g, env - -and encode_sigelts env ses :(decls_t * env_t) = - ses |> List.fold_left (fun (g, env) se -> - let g', env = encode_sigelt env se in - g@g', env) ([], env) - + decls @ elt_decls, elts, rest @ [ { elt with decls = elt_rest }] + )) + ([], [], []) g' + in + (decls |> mk_decls_trivial) @ elts @ rest @ (inversions |> mk_decls_trivial), env let encode_env_bindings (env:env_t) (bindings:list S.binding) : (decls_t * env_t) = (* Encoding Binding_var and Binding_typ as local constants leads to breakages in hash consing. @@ -1754,7 +1769,7 @@ let encode_env_bindings (env:env_t) (bindings:list S.binding) : (decls_t * env_t | S.Binding_var x -> let t1 = norm_before_encoding env x.sort in - if Env.debug env.tcenv <| Options.Other "SMTEncoding" + if !dbg_SMTEncoding then (BU.print3 "Normalized %s : %s to %s\n" (Print.bv_to_string x) (Print.term_to_string x.sort) (Print.term_to_string t1)); let t, decls' = encode_term t1 env in let t_hash = Term.hash_of_term t in @@ -1886,7 +1901,7 @@ let encode_sig tcenv se = if Options.log_queries() then Term.Caption ("encoding sigelt " ^ Print.sigelt_to_string_short se)::decls else decls in - if Env.debug tcenv Options.Medium + if Debug.medium () then BU.print1 "+++++++++++Encoding sigelt %s\n" (Print.sigelt_to_string se); let env = get_env (Env.current_module tcenv) tcenv in let decls, env = encode_top_level_facts env se in @@ -1911,7 +1926,7 @@ let encode_modul tcenv modul = UF.with_uf_enabled (fun () -> varops.reset_fresh (); let name = BU.format2 "%s %s" (if modul.is_interface then "interface" else "module") (string_of_lid modul.name) in - if Env.debug tcenv Options.Medium + if Debug.medium () then BU.print2 "+++++++++++Encoding externals for %s ... %s declarations\n" name (List.length modul.declarations |> string_of_int); let env = get_env modul.name tcenv |> reset_current_module_fvbs in let encode_signature (env:env_t) (ses:sigelts) = @@ -1921,7 +1936,7 @@ let encode_modul tcenv modul = in let decls, env = encode_signature ({env with warn=false}) modul.declarations in give_decls_to_z3_and_set_env env name decls; - if Env.debug tcenv Options.Medium then BU.print1 "Done encoding externals for %s\n" name; + if Debug.medium () then BU.print1 "Done encoding externals for %s\n" name; decls, env |> get_current_module_fvbs ) end @@ -1930,7 +1945,7 @@ let encode_modul_from_cache tcenv tcmod (decls, fvbs) = else let tcenv = Env.set_current_module tcenv tcmod.name in let name = BU.format2 "%s %s" (if tcmod.is_interface then "interface" else "module") (string_of_lid tcmod.name) in - if Env.debug tcenv Options.Medium + if Debug.medium () then BU.print2 "+++++++++++Encoding externals from cache for %s ... %s decls\n" name (List.length decls |> string_of_int); let env = get_env tcmod.name tcenv |> reset_current_module_fvbs in let env = @@ -1938,7 +1953,7 @@ let encode_modul_from_cache tcenv tcmod (decls, fvbs) = add_fvar_binding_to_env fvb env ) env in give_decls_to_z3_and_set_env env name decls; - if Env.debug tcenv Options.Medium then BU.print1 "Done encoding externals from cache for %s\n" name + if Debug.medium () then BU.print1 "Done encoding externals from cache for %s\n" name open FStar.SMTEncoding.Z3 let encode_query use_env_msg (tcenv:Env.env) (q:S.term) @@ -1969,9 +1984,7 @@ let encode_query use_env_msg (tcenv:Env.env) (q:S.term) U.close_forall_no_univs (List.rev closing) q, bindings in let env_decls, env = encode_env_bindings env bindings in - if debug tcenv Options.Medium - || debug tcenv <| Options.Other "SMTEncoding" - || debug tcenv <| Options.Other "SMTQuery" + if Debug.medium () || !dbg_SMTEncoding || !dbg_SMTQuery then BU.print1 "Encoding query formula {: %s\n" (Print.term_to_string q); let (phi, qdecls), ms = BU.record_time (fun () -> encode_formula q env) in let labels, phi = ErrorReporting.label_goals use_env_msg (Env.get_range tcenv) phi in @@ -1992,14 +2005,9 @@ let encode_query use_env_msg (tcenv:Env.env) (q:S.term) let qry = Util.mkAssume(mkNot phi, Some "query", (varops.mk_unique "@query")) in let suffix = [Term.Echo ""] @ label_suffix @ [Term.Echo ""; Term.Echo "Done!"] in - if debug tcenv Options.Medium - || debug tcenv <| Options.Other "SMTEncoding" - || debug tcenv <| Options.Other "SMTQuery" + if Debug.medium () || !dbg_SMTEncoding || !dbg_SMTQuery then BU.print_string "} Done encoding\n"; - if debug tcenv Options.Medium - || debug tcenv <| Options.Other "SMTEncoding" - || debug tcenv <| Options.Other "SMTQuery" - || debug tcenv <| Options.Other "Time" + if Debug.medium () || !dbg_SMTEncoding || !dbg_Time then BU.print1 "Encoding took %sms\n" (string_of_int ms); query_prelude, labels, qry, suffix ) diff --git a/src/smtencoding/FStar.SMTEncoding.EncodeTerm.fst b/src/smtencoding/FStar.SMTEncoding.EncodeTerm.fst index 177b51681bb..2bb8b91d479 100644 --- a/src/smtencoding/FStar.SMTEncoding.EncodeTerm.fst +++ b/src/smtencoding/FStar.SMTEncoding.EncodeTerm.fst @@ -48,6 +48,11 @@ module TcUtil = FStar.TypeChecker.Util module U = FStar.Syntax.Util open FStar.Class.Show +open FStar.Class.Setlike + +let dbg_PartialApp = Debug.get_toggle "PartialApp" +let dbg_SMTEncoding = Debug.get_toggle "SMTEncoding" +let dbg_SMTEncodingReify = Debug.get_toggle "SMTEncodingReify" (*---------------------------------------------------------------------------------*) (* *) @@ -223,8 +228,8 @@ let check_pattern_vars env vars pats = match pats with | [] -> () | hd::tl -> - let pat_vars = List.fold_left (fun out x -> Set.union out (Free.names x)) (Free.names hd) tl in - match vars |> BU.find_opt (fun ({binder_bv=b}) -> not(Set.mem b pat_vars)) with + let pat_vars = List.fold_left (fun out x -> union out (Free.names x)) (Free.names hd) tl in + match vars |> BU.find_opt (fun ({binder_bv=b}) -> not (mem b pat_vars)) with | None -> () | Some ({binder_bv=x}) -> let pos = List.fold_left (fun out t -> Range.union_ranges out t.pos) hd.pos tl in @@ -373,7 +378,7 @@ and encode_binders (fuel_opt:option term) (bs:Syntax.binders) (env:env_t) : * decls_t (* top-level decls to be emitted *) * list bv) (* names *) = - if Env.debug env.tcenv Options.Medium then BU.print1 "Encoding binders %s\n" (Print.binders_to_string ", " bs); + if Debug.medium () then BU.print1 "Encoding binders %s\n" (Print.binders_to_string ", " bs); let vars, guards, env, decls, names = bs |> List.fold_left @@ -620,7 +625,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t def_check_scoped t.pos "encode_term" env.tcenv t; let t = SS.compress t in let t0 = t in - if Env.debug env.tcenv <| Options.Other "SMTEncoding" + if !dbg_SMTEncoding then BU.print2 "(%s) %s\n" (Print.tag_of_term t) (Print.term_to_string t); match t.n with | Tm_delayed _ @@ -632,7 +637,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t | Tm_lazy i -> let e = U.unfold_lazy i in - if Env.debug env.tcenv <| Options.Other "SMTEncoding" then + if !dbg_SMTEncoding then BU.print2 ">> Unfolded (%s) ~> (%s)\n" (Print.term_to_string t) (Print.term_to_string e); encode_term e env @@ -652,7 +657,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t // // Actual encoding: `q ~> pack qv where qv is the view of q let tv = EMB.embed (R.inspect_ln qt) t.pos None EMB.id_norm_cb in - if Env.debug env.tcenv <| Options.Other "SMTEncoding" then + if !dbg_SMTEncoding then BU.print2 ">> Inspected (%s) ~> (%s)\n" (Print.term_to_string t0) (Print.term_to_string tv); let t = U.mk_app (RC.refl_constant_term RC.fstar_refl_pack_ln) [S.as_arg tv] in @@ -837,7 +842,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t issue #3028 *) let env0 = env in let fstar_fvs, (env, fv_decls, fv_vars, fv_tms, fv_guards) = - let fvs = Free.names t0 |> Set.elems in + let fvs = Free.names t0 |> elems in let getfreeV (t:term) : fv = match t.tm with @@ -930,7 +935,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t let tkey = mkForall t0.pos ([], ffv::xfv::cvars, encoding) in let tkey_hash = Term.hash_of_term tkey in - if Env.debug env.tcenv (Options.Other "SMTEncoding") + if !dbg_SMTEncoding then BU.print3 "Encoding Tm_refine %s with tkey_hash %s and digest %s\n" (Syntax.Print.term_to_string f) tkey_hash (BU.digest_of_string tkey_hash) else (); @@ -1045,7 +1050,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t | _ -> let e0 = TcUtil.norm_reify env.tcenv [] (U.mk_reify (args_e |> List.hd |> fst) lopt) in - if Env.debug env.tcenv <| Options.Other "SMTEncodingReify" + if !dbg_SMTEncodingReify then BU.print1 "Result of normalization %s\n" (Print.term_to_string e0); let e = S.mk_Tm_app (TcUtil.remove_reify e0) (List.tl args_e) t0.pos in encode_term e env) @@ -1072,7 +1077,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t match ht_opt with | _ when 1=1 -> app_tm, decls@decls' //NS: Intentionally using a default case here to disable the axiom below | Some (head_type, formals, c) -> - if Env.debug env.tcenv (Options.Other "PartialApp") + if !dbg_PartialApp then BU.print5 "Encoding partial application:\n\thead=%s\n\thead_type=%s\n\tformals=%s\n\tcomp=%s\n\tactual args=%s\n" (Print.term_to_string head) (Print.term_to_string head_type) @@ -1082,7 +1087,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t let formals, rest = BU.first_N (List.length args_e) formals in let subst = List.map2 (fun ({binder_bv=bv}) (a, _) -> Syntax.NT(bv, a)) formals args_e in let ty = U.arrow rest c |> SS.subst subst in - if Env.debug env.tcenv (Options.Other "PartialApp") + if !dbg_PartialApp then BU.print1 "Encoding partial application, after subst:\n\tty=%s\n" (Print.term_to_string ty); let vars, pattern, has_type, decls'' = @@ -1090,7 +1095,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t List.fold_left2 (fun (t_hyps, decls) ({binder_bv=bv}) e -> let t = SS.subst subst bv.sort in let t_hyp, decls' = encode_term_pred None t env e in - if Env.debug env.tcenv (Options.Other "PartialApp") + if !dbg_PartialApp then BU.print2 "Encoded typing hypothesis for %s ... got %s\n" (Print.term_to_string t) (Term.print_smt_term t_hyp); @@ -1132,7 +1137,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t has_type, decls@decls'@decls'' in - if Env.debug env.tcenv (Options.Other "PartialApp") + if !dbg_PartialApp then BU.print1 "Encoding partial application, after SMT encoded predicate:\n\t=%s\n" (Term.print_smt_term has_type); let tkey_hash = Term.hash_of_term app_tm in @@ -1181,7 +1186,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t head_type, formals, c else head_type, formals, c in - if Env.debug env.tcenv (Options.Other "PartialApp") + if !dbg_PartialApp then BU.print3 "Encoding partial application, head_type = %s, formals = %s, args = %s\n" (Print.term_to_string head_type) (Print.binders_to_string ", " formals) @@ -1206,7 +1211,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t (* We need to compute all free variables of this lambda expression and parametrize the encoding wrt to them. See issue #3028 *) - let fvs = Free.names t0 |> Set.elems in + let fvs = Free.names t0 |> elems in let tms = List.map (lookup_term_var env) fvs in (List.map (fun _ -> Term_sort) fvs <: list sort), tms @@ -1259,10 +1264,15 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t begin match lopt with | None -> + let open FStar.Class.PP in + let open FStar.Pprint in + let open FStar.Errors.Msg in //we don't even know if this is a pure function, so give up - Errors.log_issue t0.pos (Errors.Warning_FunctionLiteralPrecisionLoss, (BU.format1 - "Losing precision when encoding a function literal: %s\n\ - (Unnannotated abstraction in the compiler ?)" (Print.term_to_string t0))); + Errors.log_issue_doc t0.pos (Errors.Warning_FunctionLiteralPrecisionLoss, [ + prefix 2 1 (text "Losing precision when encoding a function literal:") + (pp t0); + text "Unannotated abstraction in the compiler?" + ]); fallback () | Some rc -> @@ -1297,7 +1307,7 @@ and encode_term (t:typ) (env:env_t) : (term (* encoding of t, expects t in let tkey = mkForall t0.pos ([], cvars, key_body) in let tkey_hash = Term.hash_of_term tkey in - if Env.debug env.tcenv <| Options.Other "PartialApp" + if !dbg_PartialApp then BU.print2 "Checking eta expansion of\n\tvars={%s}\n\tbody=%s\n" (List.map fv_name vars |> String.concat ", ") (print_smt_term body); @@ -1391,7 +1401,7 @@ and encode_match (e:S.term) (pats:list S.branch) (default_case:term) (env:env_t) mkLet' ([mk_fv (scrsym,Term_sort), scr], match_tm) Range.dummyRange, decls and encode_pat (env:env_t) (pat:S.pat) : (env_t * pattern) = - if Env.debug env.tcenv Options.Medium then BU.print1 "Encoding pattern %s\n" (Print.pat_to_string pat); + if Debug.medium () then BU.print1 "Encoding pattern %s\n" (Print.pat_to_string pat); let vars, pat_term = FStar.TypeChecker.Util.decorated_pattern_as_term pat in let env, vars = vars |> List.fold_left (fun (env, vars) v -> @@ -1489,7 +1499,7 @@ and encode_smt_patterns (pats_l:list (list S.arg)) env : list (list term) * decl and encode_formula (phi:typ) (env:env_t) : (term * decls_t) = (* expects phi to be normalized; the existential variables are all labels *) let debug phi = - if Env.debug env.tcenv <| Options.Other "SMTEncoding" + if !dbg_SMTEncoding then BU.print2 "Formula (%s) %s\n" (Print.tag_of_term phi) (Print.term_to_string phi) in @@ -1592,15 +1602,17 @@ and encode_formula (phi:typ) (env:env_t) : (term * decls_t) = (* expects phi to encode_formula phi env | Tm_fvar fv, [(r, _); (msg, _); (phi, _)] when S.fv_eq_lid fv Const.labeled_lid -> //interpret (labeled r msg t) as Tm_meta(t, Meta_labeled(msg, r, false) + (* NB: below we use Errors.mkmsg since FStar.Range.labeled takes a string, but + the Meta_labeled node needs a list of docs (Errors.error_message). *) begin match SE.try_unembed r SE.id_norm_cb, SE.try_unembed msg SE.id_norm_cb with | Some r, Some s -> - let phi = S.mk (Tm_meta {tm=phi; meta=Meta_labeled(s, r, false)}) r in + let phi = S.mk (Tm_meta {tm=phi; meta=Meta_labeled(Errors.mkmsg s, r, false)}) r in fallback phi (* If we could not unembed the position, still use the string *) | None, Some s -> - let phi = S.mk (Tm_meta {tm=phi; meta=Meta_labeled(s, phi.pos, false)}) phi.pos in + let phi = S.mk (Tm_meta {tm=phi; meta=Meta_labeled(Errors.mkmsg s, phi.pos, false)}) phi.pos in fallback phi | _ -> diff --git a/src/smtencoding/FStar.SMTEncoding.Env.fst b/src/smtencoding/FStar.SMTEncoding.Env.fst index efa5d086317..e17bcac26b7 100644 --- a/src/smtencoding/FStar.SMTEncoding.Env.fst +++ b/src/smtencoding/FStar.SMTEncoding.Env.fst @@ -31,6 +31,8 @@ module SS = FStar.Syntax.Subst module BU = FStar.Compiler.Util module U = FStar.Syntax.Util +let dbg_PartialApp = Debug.get_toggle "PartialApp" + exception Inner_let_rec of list (string * Range.range) //name of the inner let-rec(s) and their locations let add_fuel x tl = if (Options.unthrottle_inductives()) then tl else x::tl @@ -305,7 +307,7 @@ let try_lookup_free_var env l = match lookup_fvar_binding env l with | None -> None | Some fvb -> - if TcEnv.debug env.tcenv <| Options.Other "PartialApp" + if !dbg_PartialApp then BU.print2 "Looked up %s found\n%s\n" (Ident.string_of_lid l) (fvb_to_string fvb); diff --git a/src/smtencoding/FStar.SMTEncoding.ErrorReporting.fst b/src/smtencoding/FStar.SMTEncoding.ErrorReporting.fst index 597c6ce2bdd..5ff32433445 100644 --- a/src/smtencoding/FStar.SMTEncoding.ErrorReporting.fst +++ b/src/smtencoding/FStar.SMTEncoding.ErrorReporting.fst @@ -37,7 +37,7 @@ type ranges = list (option string * Range.range) //decorate a term with an error label let __ctr = BU.mk_ref 0 -let fresh_label : string -> Range.range -> term -> label * term = +let fresh_label : Errors.error_message -> Range.range -> term -> label * term = fun message range t -> let l = incr __ctr; format1 "label_%s" (string_of_int !__ctr) in let lvar = mk_fv (l, Bool_sort) in @@ -86,11 +86,12 @@ let label_goals use_env_msg //when present, provides an alternate error message in let is_a_named_continuation lhs = conjuncts lhs |> BU.for_some is_guard_free in let flag, msg_prefix = match use_env_msg with - | None -> false, "" - | Some f -> true, f() in + | None -> false, Pprint.empty + | Some f -> true, Pprint.doc_of_string (f()) in let fresh_label msg ropt rng t = + let open FStar.Pprint in let msg = if flag - then "Failed to verify implicit argument: " ^ msg_prefix ^ " :: " ^ msg + then (Errors.Msg.text "Failed to verify implicit argument: " ^^ msg_prefix) :: msg else msg in let rng = match ropt with | None -> rng @@ -100,7 +101,7 @@ let label_goals use_env_msg //when present, provides an alternate error message in fresh_label msg rng t in - let rec aux (default_msg:string) //the error message text to generate at a label + let rec aux (default_msg : Errors.error_message) //the error message text to generate at a label (ropt:option Range.range) //an optional position, if there was an enclosing Labeled node (post_name_opt:option string) //the name of the current post-condition variable --- it is left uninstrumented (labels:list label) //the labels accumulated so far @@ -114,7 +115,7 @@ let label_goals use_env_msg //when present, provides an alternate error message | LblPos _ -> failwith "Impossible" //these get added after errorReporting instrumentation only - | Labeled(arg, "Could not prove post-condition", label_range) -> + | Labeled(arg, [d], label_range) when Errors.Msg.renderdoc d = "Could not prove post-condition" -> //printfn "GOT A LABELED WP IMPLICATION\n\t%s" // (Term.print_smt_term q); let fallback debug_msg = @@ -138,7 +139,7 @@ let label_goals use_env_msg //when present, provides an alternate error message | Quant(Forall, pats_ens, iopt_ens, sorts_ens, {tm=App(Imp, [ensures_conjuncts; post]); rng=rng_ens}) -> if is_a_post_condition (Some post_name) post then - let labels, ensures_conjuncts = aux "Could not prove post-condition" None (Some post_name) labels ensures_conjuncts in + let labels, ensures_conjuncts = aux (Errors.mkmsg "Could not prove post-condition") None (Some post_name) labels ensures_conjuncts in let pats_ens = match pats_ens with | [] @@ -295,7 +296,7 @@ let label_goals use_env_msg //when present, provides an alternate error message labels, Term.mkLet (es, body) q.rng in __ctr := 0; - aux "Assertion failed" None None [] q + aux (Errors.mkmsg "Assertion failed") None None [] q (* @@ -325,15 +326,16 @@ let detail_errors hint_replay in let print_result ((_, msg, r), success) = + let open FStar.Pprint in + let open FStar.Errors.Msg in if success then BU.print1 "OK: proof obligation at %s was proven in isolation\n" (Range.string_of_range r) else if hint_replay - then FStar.Errors.log_issue r (Errors.Warning_HintFailedToReplayProof, - "Hint failed to replay this sub-proof: " ^ msg) - else FStar.Errors.log_issue r (Errors.Error_ProofObligationFailed, - BU.format2 "XX: proof obligation at %s failed\n\t%s\n" - (Range.string_of_range r) - msg) + then FStar.Errors.log_issue_doc r (Errors.Warning_HintFailedToReplayProof, + (text "Hint failed to replay this sub-proof" :: msg)) + else FStar.Errors.log_issue_doc r (Errors.Error_ProofObligationFailed, [ + text <| BU.format1 "XX: proof obligation at %s failed." (Class.Show.show r); + ] @ msg) in let elim labs = //assumes that all the labs are true, effectively removing them from the query diff --git a/src/smtencoding/FStar.SMTEncoding.Solver.fst b/src/smtencoding/FStar.SMTEncoding.Solver.fst index 569a6561fca..1445c9a48e7 100644 --- a/src/smtencoding/FStar.SMTEncoding.Solver.fst +++ b/src/smtencoding/FStar.SMTEncoding.Solver.fst @@ -41,6 +41,8 @@ module TcUtil = FStar.TypeChecker.Util module U = FStar.Syntax.Util exception SplitQueryAndRetry +let dbg_SMTFail = Debug.get_toggle "SMTFail" + (****************************************************************************) (* Hint databases for record and replay (private) *) (****************************************************************************) @@ -321,7 +323,7 @@ let query_errors settings z3result = error_messages = error_labels |> List.map (fun (_, x, y) -> Errors.Error_Z3SolverError, - Errors.mkmsg x, + x, y, Errors.get_ctx ()) // FIXME: leaking abstraction } @@ -442,7 +444,7 @@ let errors_to_report (tried_recovery : bool) (settings : query_settings) : list //we have a unique label already; just report it FStar.TypeChecker.Err.errors_smt_detail settings.query_env - [(Error_Z3SolverError, mkmsg msg, rng, get_ctx())] + [(Error_Z3SolverError, msg, rng, get_ctx())] recovery_failed_msg | None, _ -> @@ -461,9 +463,10 @@ let errors_to_report (tried_recovery : bool) (settings : query_settings) : list //with no labeled sub-goals and so no error location to report. //So, print the source location and the query term itself let dummy_fv = Term.mk_fv ("", dummy_sort) in - let msg = - BU.format1 "Failed to prove the following goal, although it appears to be trivial: %s" - (Print.term_to_string settings.query_term) + let msg = [ + Errors.Msg.text "Failed to prove the following goal, although it appears to be trivial:" + ^/^ pp settings.query_term; + ] in let range = Env.get_range settings.query_env in [dummy_fv, msg, range] @@ -490,7 +493,7 @@ let errors_to_report (tried_recovery : bool) (settings : query_settings) : list List.collect (fun (_, msg, rng) -> FStar.TypeChecker.Err.errors_smt_detail settings.query_env - [(Error_Z3SolverError, mkmsg msg, rng, get_ctx())] + [(Error_Z3SolverError, msg, rng, get_ctx())] recovery_failed_msg ) ) @@ -670,8 +673,8 @@ let query_info settings z3result = ]; if Options.print_z3_statistics () then process_unsat_core core; errs |> List.iter (fun (_, msg, range) -> - let tag = if used_hint settings then "(Hint-replay failed): " else "" in - FStar.Errors.log_issue range (FStar.Errors.Warning_HitReplayFailed, (tag ^ msg))) + let msg = if used_hint settings then Pprint.doc_of_string "Hint-replay failed" :: msg else msg in + FStar.Errors.log_issue_doc range (FStar.Errors.Warning_HitReplayFailed, msg)) end //caller must ensure that the recorded_hints is already initiailized @@ -970,7 +973,7 @@ let ask_solver_quake then (nsucc, nfail, rs) else begin if quaking_or_retrying - && (Options.interactive () || Options.debug_any ()) (* only on emacs or when debugging *) + && (Options.interactive () || Debug.any ()) (* only on emacs or when debugging *) && n>0 then (* no need to print last *) BU.print5 "%s: so far query %s %sfailed %s (%s runs remain)\n" (if quaking then "Quake" else "Retry") @@ -1106,6 +1109,7 @@ let ask_solver_recover let failing_query_ctr : ref int = BU.mk_ref 0 let maybe_save_failing_query (env:env_t) (prefix:list decl) (qs:query_settings) : unit = + (* Save failing query to a clean file if --log_failing_queries. *) if Options.log_failing_queries () then ( let mod = show (Env.current_module env) in let n = (failing_query_ctr := !failing_query_ctr + 1; !failing_query_ctr) in @@ -1120,7 +1124,18 @@ let maybe_save_failing_query (env:env_t) (prefix:list decl) (qs:query_settings) in write_file file_name query_str; () - ) + ); + (* Also print it out if --debug SMTFail. *) + if !dbg_SMTFail then ( + let open FStar.Pprint in + let open FStar.Class.PP in + let open FStar.Errors.Msg in + Errors.diag_doc qs.query_range [ + text "This query failed:"; + pp qs.query_term; + ] + ); + () let ask_solver (can_split : bool) @@ -1297,7 +1312,7 @@ let encode_and_ask (can_split:bool) (is_retry:bool) use_env_msg tcenv q : (list | Assume _ -> if (is_retry || Options.split_queries() = Options.Always) - && Options.debug_any() + && Debug.any() then ( let n = List.length labels in if n <> 1 diff --git a/src/smtencoding/FStar.SMTEncoding.Term.fst b/src/smtencoding/FStar.SMTEncoding.Term.fst index caa0b727566..0088c0644df 100644 --- a/src/smtencoding/FStar.SMTEncoding.Term.fst +++ b/src/smtencoding/FStar.SMTEncoding.Term.fst @@ -18,8 +18,6 @@ module FStar.SMTEncoding.Term open FStar open FStar.Compiler open FStar.Compiler.Effect -open FStar.Compiler.List -open FStar.Class.Ord module S = FStar.Syntax.Syntax module BU = FStar.Compiler.Util @@ -145,10 +143,8 @@ let fv_sort (x:fv) = let FV (_, sort, _) = x in sort let fv_force (x:fv) = let FV (_, _, force) = x in force let fv_eq (x:fv) (y:fv) = fv_name x = fv_name y let fvs_subset_of (x:fvs) (y:fvs) = - let cmp_fv x y = - BU.compare (fv_name x) (fv_name y) - in - Set.subset (Set.from_list x) (Set.from_list y) + let open FStar.Class.Setlike in + subset (from_list x <: RBSet.t fv) (from_list y) let freevar_eq x y = match x.tm, y.tm with | FreeV x, FreeV y -> fv_eq x y @@ -235,7 +231,7 @@ let rec hash_of_term' t = match t with | BoundV i -> "@"^string_of_int i | FreeV x -> fv_name x ^ ":" ^ strSort (fv_sort x) //Question: Why is the sort part of the hash? | App(op, tms) -> "("^(op_to_string op)^(List.map hash_of_term tms |> String.concat " ")^")" - | Labeled(t, r1, r2) -> hash_of_term t ^ r1 ^ (Range.string_of_range r2) + | Labeled(t, r1, r2) -> hash_of_term t ^ Errors.Msg.rendermsg r1 ^ (Range.string_of_range r2) | LblPos(t, r) -> "(! " ^hash_of_term t^ " :lblpos " ^r^ ")" | Quant(qop, pats, wopt, sorts, body) -> "(" @@ -433,7 +429,7 @@ let check_pattern_ok (t:term) : option term = | BoundV n -> BU.format1 "(BoundV %s)" (BU.string_of_int n) | FreeV fv -> BU.format1 "(FreeV %s)" (fv_name fv) | App (op, l) -> BU.format2 "(%s %s)" (op_to_string op) (print_smt_term_list l) - | Labeled(t, r1, r2) -> BU.format2 "(Labeled '%s' %s)" r1 (print_smt_term t) + | Labeled(t, r1, r2) -> BU.format2 "(Labeled '%s' %s)" (Errors.Msg.rendermsg r1) (print_smt_term t) | LblPos(t, s) -> BU.format2 "(LblPos %s %s)" s (print_smt_term t) | Quant (qop, l, _, _, t) -> BU.format3 "(%s %s %s)" (qop_to_string qop) (print_smt_term_list_list l) (print_smt_term t) | Let (es, body) -> BU.format2 "(let %s %s)" (print_smt_term_list es) (print_smt_term body) @@ -585,23 +581,23 @@ let injective_constructor let capp = mkApp(name, bvars) norng in fields |> List.mapi (fun i {field_projectible=projectible; field_name=name; field_sort=s} -> - let cproj_app = mkApp(name, [capp]) norng in - let proj_name = DeclFun(name, [sort], s, Some "Projector") in if projectible - then let a = { + then + let cproj_app = mkApp(name, [capp]) norng in + let proj_name = DeclFun(name, [sort], s, Some "Projector") in + let a = { assumption_name = escape ("projection_inverse_"^name); assumption_caption = Some "Projection inverse"; assumption_term = mkForall rng ([[capp]], bvar_names, mkEq(cproj_app, bvar i s norng) norng); assumption_fact_ids = [] } in - [proj_name; Assume a] - else [proj_name]) + [proj_name; Assume a] + else []) |> List.flatten let discriminator_name constr = "is-"^constr.constr_name let constructor_to_decl rng constr = - let injective = true in let sort = constr.constr_sort in let field_sorts = constr.constr_fields |> List.map (fun f -> f.field_sort) in let cdecl = DeclFun(constr.constr_name, field_sorts, constr.constr_sort, Some "Constructor") in @@ -638,8 +634,36 @@ let constructor_to_decl rng constr = Some "Discriminator definition") in def in let projs = injective_constructor rng (constr.constr_name, constr.constr_fields, sort) in + let base = + if not constr.constr_base + then [] + else ( + let arg_sorts = + constr.constr_fields + |> List.filter (fun f -> f.field_projectible) + |> List.map (fun _ -> Term_sort) + in + let base_name = constr.constr_name ^ "@base" in + let decl = DeclFun(base_name, arg_sorts, Term_sort, Some "Constructor base") in + let formals = List.mapi (fun i _ -> mk_fv ("x" ^ string_of_int i, Term_sort)) constr.constr_fields in + let constructed_term = mkApp(constr.constr_name, List.map (fun fv -> mkFreeV fv norng) formals) norng in + let inj_formals = List.flatten <| List.map2 (fun f fld -> if fld.field_projectible then [f] else []) formals constr.constr_fields in + let base_term = mkApp(base_name, List.map (fun fv -> mkFreeV fv norng) inj_formals) norng in + let eq = mkEq(constructed_term, base_term) norng in + let guard = mkApp(discriminator_name constr, [constructed_term]) norng in + let q = mkForall rng ([[constructed_term]], formals, mkImp (guard, eq) norng) in + //forall (x0...xn:Term). {:pattern (C x0 ...xn)} is-C (C x0..xn) ==> C x0..xn == C-base x2 x3..xn + let a = { + assumption_name=escape ("constructor_base_" ^ constr.constr_name); + assumption_caption=Some "Constructor base"; + assumption_term=q; + assumption_fact_ids=[] + } in + [decl; Assume a] + ) + in Caption (format1 "" constr.constr_name):: - [cdecl]@cid@projs@[disc] + [cdecl]@cid@projs@[disc]@base @[Caption (format1 "" constr.constr_name)] (****************************************************************************) @@ -906,7 +930,8 @@ and mkPrelude z3options = = { constr_name=name; constr_fields=List.map (fun (field_name, field_sort, field_projectible) -> {field_name; field_sort; field_projectible}) fields; constr_sort=sort; - constr_id=Some id } + constr_id=Some id; + constr_base=false } in let constrs : constructors = List.map as_constr @@ -986,7 +1011,8 @@ let mkBvConstructor (sz : int) = constr_name=fst (boxBitVecFun sz); constr_sort=Term_sort; constr_id=None; - constr_fields=[{field_projectible=true; field_name=snd (boxBitVecFun sz); field_sort=BitVec_sort sz }] + constr_fields=[{field_projectible=true; field_name=snd (boxBitVecFun sz); field_sort=BitVec_sort sz }]; + constr_base=false } in constructor_to_decl norng constr, constr.constr_name, diff --git a/src/smtencoding/FStar.SMTEncoding.Term.fsti b/src/smtencoding/FStar.SMTEncoding.Term.fsti index 462b1c41477..38604196f5a 100644 --- a/src/smtencoding/FStar.SMTEncoding.Term.fsti +++ b/src/smtencoding/FStar.SMTEncoding.Term.fsti @@ -20,6 +20,8 @@ open FStar.Compiler open FStar.Compiler.Effect open FStar.Compiler.Util open FStar.Class.Show +open FStar.Compiler.List +open FStar.Class.Ord module S = FStar.Syntax.Syntax @@ -84,8 +86,8 @@ type term' = | App of op * list term | Quant of qop * list (list pat) * option int * list sort * term | Let of list term * term - | Labeled of term * string * Range.range - | LblPos of term * string + | Labeled of term * Errors.error_message * Range.range + | LblPos of term * string // FIXME: this case is unused and pat = term and term = {tm:term'; freevars:S.memo fvs; rng:Range.range} and fv = | FV of string * sort * bool (* bool iff variable must be forced/unthunked *) @@ -102,8 +104,10 @@ type constructor_t = { constr_name:string; constr_fields:list constructor_field; constr_sort:sort; - constr_id:option int; //Some i, if a term whose head is this constructor is distinct from - //terms with other head constructors + constr_id:option int; + //Some i, if a term whose head is this constructor is distinct from + //terms with other head constructors + constr_base: bool; //generate a base to eliminate non-injective arguments } type constructors = list constructor_t type fact_db_id = @@ -190,7 +194,7 @@ val mk_decls_trivial: list decl -> decls_t *) val decls_list_of: decls_t -> list decl -type error_label = (fv * string * Range.range) +type error_label = (fv * Errors.error_message * Range.range) type error_labels = list error_label val escape: string -> string diff --git a/src/smtencoding/FStar.SMTEncoding.Z3.fst b/src/smtencoding/FStar.SMTEncoding.Z3.fst index 54b0f101f37..5af9d24f80f 100644 --- a/src/smtencoding/FStar.SMTEncoding.Z3.fst +++ b/src/smtencoding/FStar.SMTEncoding.Z3.fst @@ -75,7 +75,7 @@ let z3_exe : unit -> string = else if inpath z3_v then z3_v else Platform.exe "z3" in - if Options.debug_any () then + if Debug.any () then BU.print1 "Chosen Z3 executable: %s\n" path; path ) @@ -448,7 +448,7 @@ let doZ3Exe (log_file:_) (r:Range.range) (fresh:bool) (input:string) (label_mess res else ru) in let status = - if Options.debug_any() then print_string <| format1 "Z3 says: %s\n" (String.concat "\n" smt_output.smt_result); + if Debug.any() then print_string <| format1 "Z3 says: %s\n" (String.concat "\n" smt_output.smt_result); match smt_output.smt_result with | ["unsat"] -> UNSAT unsat_core | ["sat"] -> SAT (labels, reason_unknown) diff --git a/src/syntax/FStar.Syntax.Compress.fst b/src/syntax/FStar.Syntax.Compress.fst index 73fa4be6d4a..5e634c8aed6 100644 --- a/src/syntax/FStar.Syntax.Compress.fst +++ b/src/syntax/FStar.Syntax.Compress.fst @@ -25,7 +25,7 @@ let compress1_t (allow_uvars: bool) (allow_names: bool) : term -> term = | Tm_name bv when not allow_names -> (* This currently happens, and often, but it should not! *) - if Options.debug_any () then + if Debug.any () then Errors.log_issue t.pos (Err.Warning_NameEscape, format1 "Tm_name %s in deep compress" (show bv)); mk (Tm_name ({bv with sort = mk Tm_unknown})) @@ -39,7 +39,7 @@ let compress1_u (allow_uvars:bool) (allow_names:bool) : universe -> universe = fun u -> match u with | U_name bv when not allow_names -> - if Options.debug_any () then + if Debug.any () then Errors.log_issue Range.dummyRange (Err.Warning_NameEscape, format1 "U_name %s in deep compress" (show bv)); u diff --git a/src/syntax/FStar.Syntax.DsEnv.fst b/src/syntax/FStar.Syntax.DsEnv.fst index 81317defd36..65470c0fb77 100644 --- a/src/syntax/FStar.Syntax.DsEnv.fst +++ b/src/syntax/FStar.Syntax.DsEnv.fst @@ -27,7 +27,9 @@ open FStar.Syntax.Util open FStar.Parser open FStar.Ident open FStar.Errors + open FStar.Class.Show +open FStar.Class.Setlike let ugly_sigelt_to_string_hook : ref (sigelt -> string) = BU.mk_ref (fun _ -> "") let ugly_sigelt_to_string (se:sigelt) : string = !ugly_sigelt_to_string_hook se @@ -38,7 +40,7 @@ module BU = FStar.Compiler.Util module Const = FStar.Parser.Const type local_binding = (ident * bv * used_marker) (* local name binding for name resolution, paired with an env-generated unique name *) -type rec_binding = (ident * lid * delta_depth * (* name bound by recursive type and top-level let-bindings definitions only *) +type rec_binding = (ident * lid * (* name bound by recursive type and top-level let-bindings definitions only *) used_marker) (* this ref marks whether it was used, so we can warn if not *) type scope_mod = @@ -49,7 +51,7 @@ type scope_mod = | Top_level_def of ident (* top-level definition for an unqualified identifier x to be resolved as curmodule.x. *) | Record_or_dc of record_or_dc (* to honor interleavings of "open" and record definitions *) -type string_set = Set.t string +type string_set = RBSet.t string type exported_id_kind = (* kinds of identifiers exported by a module *) | Exported_id_term_type (* term and type identifiers *) @@ -110,7 +112,7 @@ let transitive_exported_ids env lid = let module_name = Ident.string_of_lid lid in match BU.smap_try_find env.trans_exported_ids module_name with | None -> [] - | Some exported_id_set -> !(exported_id_set Exported_id_term_type) |> Set.elems + | Some exported_id_set -> !(exported_id_set Exported_id_term_type) |> elems let opens_and_abbrevs env : list (either open_module_or_namespace module_abbrev) = List.collect (function @@ -184,13 +186,13 @@ let set_bv_range bv r = let bv_to_name bv r = bv_to_name (set_bv_range bv r) -let unmangleMap = [("op_ColonColon", "Cons", delta_constant, Some Data_ctor); - ("not", "op_Negation", delta_equational, None)] +let unmangleMap = [("op_ColonColon", "Cons", Some Data_ctor); + ("not", "op_Negation", None)] let unmangleOpName (id:ident) : option term = - find_map unmangleMap (fun (x,y,dd,dq) -> + find_map unmangleMap (fun (x,y,dq) -> if string_of_id id = x - then Some (S.fvar_with_dd (lid_of_path ["Prims"; y] (range_of_id id)) dd dq) //NS delta ok + then Some (S.fvar_with_dd (lid_of_path ["Prims"; y] (range_of_id id)) dq) else None) type cont_t 'a = @@ -258,7 +260,7 @@ let find_in_module_with_includes | None -> true | Some mex -> let mexports = !(mex eikind) in - Set.mem idstr mexports + mem idstr mexports in let mincludes = match BU.smap_try_find env.includes mname with | None -> [] @@ -291,7 +293,7 @@ let try_lookup_id'' (id', _, _) -> string_of_id id' = string_of_id id in let check_rec_binding_id : rec_binding -> bool = function - (id', _, _, _) -> string_of_id id' = string_of_id id + (id', _, _) -> string_of_id id' = string_of_id id in let curmod_ns = ids_of_lid (current_module env) in let proc = function @@ -303,7 +305,7 @@ let try_lookup_id'' | Rec_binding r when check_rec_binding_id r -> - let (_, _, _, used_marker) = r in + let (_, _, used_marker) = r in used_marker := true; k_rec_binding r @@ -523,16 +525,6 @@ let ns_of_lid_equals (lid: lident) (ns: lident) = List.length (ns_of_lid lid) = List.length (ids_of_lid ns) && lid_equals (lid_of_ids (ns_of_lid lid)) ns -let delta_depth_of_declaration (lid:lident) (quals:list qualifier) = - let dd = if U.is_primop_lid lid - || (quals |> BU.for_some (function Projector _ | Discriminator _ -> true | _ -> false)) - then delta_equational - else delta_constant in - if quals |> BU.for_some (function Assumption -> true | _ -> false) - && not (quals |> BU.for_some (function New -> true | _ -> false)) - then Delta_abstract dd - else dd - let try_lookup_name any_val exclude_interf env (lid:lident) : option foundname = let occurrence_range = Ident.range_of_lid lid in @@ -540,39 +532,38 @@ let try_lookup_name any_val exclude_interf env (lid:lident) : option foundname = | (_, true) when exclude_interf -> None | (se, _) -> begin match se.sigel with - | Sig_inductive_typ _ -> Some (Term_name (S.fvar_with_dd source_lid delta_constant None, se.sigattrs)) //NS delta: ok - | Sig_datacon _ -> Some (Term_name (S.fvar_with_dd source_lid delta_constant (fv_qual_of_se se), se.sigattrs)) //NS delta: ok + | Sig_inductive_typ _ -> Some (Term_name (S.fvar_with_dd source_lid None, se.sigattrs)) + | Sig_datacon _ -> Some (Term_name (S.fvar_with_dd source_lid (fv_qual_of_se se), se.sigattrs)) | Sig_let {lbs=(_, lbs)} -> let fv = lb_fv lbs source_lid in - Some (Term_name (S.fvar_with_dd source_lid (fv.fv_delta |> must) fv.fv_qual, se.sigattrs)) + Some (Term_name (S.fvar_with_dd source_lid fv.fv_qual, se.sigattrs)) | Sig_declare_typ {lid} -> let quals = se.sigquals in if any_val //only in scope in an interface (any_val is true) or if the val is assumed || quals |> BU.for_some (function Assumption -> true | _ -> false) then let lid = Ident.set_lid_range lid (Ident.range_of_lid source_lid) in - let dd = delta_depth_of_declaration lid quals in begin match BU.find_map quals (function Reflectable refl_monad -> Some refl_monad | _ -> None) with //this is really a M?.reflect | Some refl_monad -> let refl_const = S.mk (Tm_constant (FStar.Const.Const_reflect refl_monad)) occurrence_range in Some (Term_name (refl_const, se.sigattrs)) | _ -> - Some (Term_name(fvar_with_dd lid dd (fv_qual_of_se se), se.sigattrs)) //NS delta: ok + Some (Term_name(fvar_with_dd lid (fv_qual_of_se se), se.sigattrs)) end else None | Sig_new_effect(ne) -> Some (Eff_name(se, set_lid_range ne.mname (range_of_lid source_lid))) | Sig_effect_abbrev _ -> Some (Eff_name(se, source_lid)) | Sig_splice {lids; tac=t} -> // TODO: This depth is probably wrong - Some (Term_name (S.fvar_with_dd source_lid (Delta_constant_at_level 1) None, [])) //NS delta: wrong + Some (Term_name (S.fvar_with_dd source_lid None, [])) | _ -> None end in let k_local_binding r = let t = found_local_binding (range_of_lid lid) r in Some (Term_name (t, [])) in - let k_rec_binding (id, l, dd, used_marker) = + let k_rec_binding (id, l, used_marker) = used_marker := true; - Some (Term_name(S.fvar_with_dd (set_lid_range l (range_of_lid lid)) dd None, [])) //NS delta: ok + Some (Term_name(S.fvar_with_dd (set_lid_range l (range_of_lid lid)) None, [])) in let found_unmangled = match ns_of_lid lid with @@ -650,7 +641,7 @@ let try_lookup_let env (lid:lident) = let k_global_def lid = function | ({ sigel = Sig_let {lbs=(_, lbs)} }, _) -> let fv = lb_fv lbs lid in - Some (fvar_with_dd lid (fv.fv_delta |> must) fv.fv_qual) //NS delta: ok + Some (fvar_with_dd lid fv.fv_qual) | _ -> None in resolve_in_open_namespaces' env lid (fun _ -> None) (fun _ -> None) k_global_def @@ -779,12 +770,12 @@ let try_lookup_datacon env (lid:lident) = match se with | ({ sigel = Sig_declare_typ _; sigquals = quals }, _) -> if quals |> BU.for_some (function Assumption -> true | _ -> false) - then Some (lid_and_dd_as_fv lid delta_constant None) + then Some (lid_and_dd_as_fv lid None) else None | ({ sigel = Sig_splice _ }, _) (* A spliced datacon *) | ({ sigel = Sig_datacon _ }, _) -> let qual = fv_qual_of_se (fst se) in - Some (lid_and_dd_as_fv lid delta_constant qual) + Some (lid_and_dd_as_fv lid qual) | _ -> None in resolve_in_open_namespaces' env lid (fun _ -> None) (fun _ -> None) k_global_def @@ -878,13 +869,13 @@ let extract_record (e:env) (new_globs: ref (list scope_mod)) = fun se -> match s match get_exported_id_set e modul with | Some my_ex -> let my_exported_ids = my_ex Exported_id_field in - let () = my_exported_ids := Set.add (string_of_id id) !my_exported_ids in + let () = my_exported_ids := add (string_of_id id) !my_exported_ids in (* also add the projector name *) let projname = mk_field_projector_name_from_ident constrname id |> ident_of_lid |> string_of_id in - let () = my_exported_ids := Set.add projname !my_exported_ids in + let () = my_exported_ids := add projname !my_exported_ids in () | None -> () (* current module was not prepared? should not happen *) in @@ -956,7 +947,7 @@ let try_lookup_dc_by_field_name env (fieldname:lident) = | Some r -> Some (set_lid_range (lid_of_ids (ns_of_lid r.typename @ [r.constrname])) (range_of_lid fieldname), r.is_record) | _ -> None -let string_set_ref_new () : ref (Set.t string) = BU.mk_ref (Set.empty ()) +let string_set_ref_new () : ref string_set = BU.mk_ref (empty ()) let exported_id_set_new () = let term_type_set = string_set_ref_new () in let field_set = string_set_ref_new () in @@ -989,12 +980,12 @@ let push_bv env x = let (env, bv, _) = push_bv' env x in (env, bv) -let push_top_level_rec_binding env0 (x:ident) dd : env * ref bool = +let push_top_level_rec_binding env0 (x:ident) : env * ref bool = let l = qualify env0 x in if unique false true env0 l || Options.interactive () then let used_marker = BU.mk_ref false in - (push_scope_mod env0 (Rec_binding (x,l,dd,used_marker)), used_marker) + (push_scope_mod env0 (Rec_binding (x,l,used_marker)), used_marker) else raise_error (Errors.Fatal_DuplicateTopLevelNames, ("Duplicate top-level names " ^ (string_of_lid l))) (range_of_lid l) let push_sigelt' fail_on_dup env s = @@ -1038,7 +1029,7 @@ let push_sigelt' fail_on_dup env s = let () = match get_exported_id_set env modul with | Some f -> let my_exported_ids = f Exported_id_term_type in - my_exported_ids := Set.add (string_of_id (ident_of_lid lid)) !my_exported_ids + my_exported_ids := add (string_of_id (ident_of_lid lid)) !my_exported_ids | None -> () (* current module was not prepared? should not happen *) in let is_iface = env.iface && not env.admitted_iface in @@ -1102,9 +1093,9 @@ let push_include env ns = let update_exports (k: exported_id_kind) = let ns_ex = ! (ns_trans_exports k) in let ex = cur_exports k in - let () = ex := Set.diff (!ex) ns_ex in + let () = ex := diff (!ex) ns_ex in let trans_ex = cur_trans_exports k in - let () = trans_ex := Set.union (!trans_ex) ns_ex in + let () = trans_ex := union (!trans_ex) ns_ex in () in List.iter update_exports all_exported_id_kinds @@ -1193,7 +1184,7 @@ let finish env modul = let update_exports eikind = let cur_ex_set = ! (cur_ex eikind) in let cur_trans_ex_set_ref = cur_trans_ex eikind in - cur_trans_ex_set_ref := Set.union cur_ex_set (!cur_trans_ex_set_ref) + cur_trans_ex_set_ref := union cur_ex_set (!cur_trans_ex_set_ref) in List.iter update_exports all_exported_id_kinds | _ -> () @@ -1255,12 +1246,12 @@ let finish_module_or_interface env modul = finish env modul, modul type exported_ids = { - exported_id_terms:list string; - exported_id_fields:list string + exported_id_terms : string_set; + exported_id_fields: string_set; } let as_exported_ids (e:exported_id_set) = - let terms = Set.elems (!(e Exported_id_term_type)) in - let fields = Set.elems (!(e Exported_id_field)) in + let terms = (!(e Exported_id_term_type)) in + let fields = (!(e Exported_id_field)) in {exported_id_terms=terms; exported_id_fields=fields} @@ -1269,9 +1260,9 @@ let as_exported_id_set (e:option exported_ids) = | None -> exported_id_set_new () | Some e -> let terms = - BU.mk_ref (Set.from_list e.exported_id_terms) in + BU.mk_ref (e.exported_id_terms) in let fields = - BU.mk_ref (Set.from_list e.exported_id_fields) in + BU.mk_ref (e.exported_id_fields) in function | Exported_id_term_type -> terms | Exported_id_field -> fields @@ -1400,5 +1391,4 @@ let resolve_name (e:env) (name:lident) | _ -> None ) | Some (Eff_name(se, l)) -> - let _ = delta_depth_of_declaration in - Some (Inr (S.lid_and_dd_as_fv l delta_constant None)) + Some (Inr (S.lid_and_dd_as_fv l None)) diff --git a/src/syntax/FStar.Syntax.DsEnv.fsti b/src/syntax/FStar.Syntax.DsEnv.fsti index f8379d61251..9449f6f35a8 100644 --- a/src/syntax/FStar.Syntax.DsEnv.fsti +++ b/src/syntax/FStar.Syntax.DsEnv.fsti @@ -20,6 +20,7 @@ open FStar.Compiler.Effect open FStar open FStar.Compiler open FStar.Compiler.Util +open FStar.Compiler.Effect open FStar.Syntax open FStar.Syntax.Syntax open FStar.Syntax.Util @@ -110,11 +111,10 @@ val lookup_letbinding_quals_and_attrs: env -> lident -> list qualifier * list at val resolve_module_name: env:env -> lid:lident -> honor_ns:bool -> option lident val resolve_to_fully_qualified_name : env:env -> l:lident -> option lident val fv_qual_of_se : sigelt -> option fv_qual -val delta_depth_of_declaration: lident -> list qualifier -> delta_depth val push_bv': env -> ident -> env * bv * used_marker val push_bv: env -> ident -> env * bv -val push_top_level_rec_binding: env -> ident -> S.delta_depth -> env * ref bool +val push_top_level_rec_binding: env -> ident -> env * ref bool val push_sigelt: env -> sigelt -> env val push_namespace: env -> lident -> env val push_include: env -> lident -> env diff --git a/src/syntax/FStar.Syntax.Free.fst b/src/syntax/FStar.Syntax.Free.fst index 8c9f98f7ad5..0db13dcc650 100644 --- a/src/syntax/FStar.Syntax.Free.fst +++ b/src/syntax/FStar.Syntax.Free.fst @@ -22,7 +22,6 @@ open FStar.Compiler.List open FStar open FStar.Compiler open FStar.Compiler.Util -open FStar.Compiler.Set open FStar.Syntax open FStar.Syntax.Syntax module Util = FStar.Compiler.Util @@ -30,6 +29,7 @@ module UF = FStar.Syntax.Unionfind open FStar.Class.Ord open FStar.Class.Show +open FStar.Class.Setlike let compare_uv uv1 uv2 = UF.uvar_id uv1.ctx_uvar_head - UF.uvar_id uv2.ctx_uvar_head let compare_universe_uvar x y = UF.univ_uvar_id x - UF.univ_uvar_id y @@ -62,7 +62,9 @@ type use_cache_t = | NoCache | Full -type free_vars_and_fvars = free_vars * set Ident.lident +(* We use an RBSet for the fvars, as order definitely does not matter here +and it's faster. *) +type free_vars_and_fvars = free_vars * RBSet.t Ident.lident (* Snoc without duplicates *) val snoc : #a:Type -> {| deq a |} -> list a -> a -> list a @@ -76,29 +78,34 @@ let rec snoc xx y = val (@@) : #a:Type -> {| deq a |} -> list a -> list a -> list a let (@@) xs ys = List.fold_left (fun xs y -> snoc xs y) xs ys -let no_free_vars = { - free_names=[]; - free_uvars=[]; - free_univs=[]; - free_univ_names=[]; -}, new_fv_set () +let no_free_vars : free_vars_and_fvars = { + free_names = empty(); + free_uvars = empty(); + free_univs = empty(); + free_univ_names = empty(); +}, empty () -let singleton_fvar fv = +let singleton_fvar fv : free_vars_and_fvars = fst no_free_vars, - Set.add fv.fv_name.v (new_fv_set ()) - -let singleton_bv x = {fst no_free_vars with free_names=[x]}, snd no_free_vars -let singleton_uv x = {fst no_free_vars with free_uvars=[x]}, snd no_free_vars -let singleton_univ x = {fst no_free_vars with free_univs=[x]}, snd no_free_vars -let singleton_univ_name x = {fst no_free_vars with free_univ_names=[x]}, snd no_free_vars - -let union (f1 : free_vars_and_fvars) (f2 : free_vars_and_fvars) = { - free_names=(fst f1).free_names @@ (fst f2).free_names; - free_uvars=(fst f1).free_uvars @@ (fst f2).free_uvars; - free_univs=(fst f1).free_univs @@ (fst f2).free_univs; - free_univ_names=(fst f1).free_univ_names @@ (fst f2).free_univ_names; //THE ORDER HERE IS IMPORTANT! + add fv.fv_name.v (empty ()) + +let singleton_bv x = + {fst no_free_vars with free_names = singleton x}, snd no_free_vars +let singleton_uv x = + {fst no_free_vars with free_uvars = singleton x}, snd no_free_vars +let singleton_univ x = + {fst no_free_vars with free_univs = singleton x}, snd no_free_vars +let singleton_univ_name x = + {fst no_free_vars with free_univ_names = singleton x}, snd no_free_vars + +(* Union of free vars *) +let ( ++ ) (f1 : free_vars_and_fvars) (f2 : free_vars_and_fvars) = { + free_names=(fst f1).free_names `union` (fst f2).free_names; + free_uvars=(fst f1).free_uvars `union` (fst f2).free_uvars; + free_univs=(fst f1).free_univs `union` (fst f2).free_univs; + free_univ_names=(fst f1).free_univ_names `union` (fst f2).free_univ_names; //THE ORDER HERE IS IMPORTANT! //We expect the free_univ_names list to be in fifo order to get the right order of universe generalization -}, Set.union (snd f1) (snd f2) +}, union (snd f1) (snd f2) let rec free_univs u = match Subst.compress_univ u with | U_zero @@ -106,7 +113,7 @@ let rec free_univs u = match Subst.compress_univ u with | U_unknown -> no_free_vars | U_name uname -> singleton_univ_name uname | U_succ u -> free_univs u - | U_max us -> List.fold_left (fun out x -> union out (free_univs x)) no_free_vars us + | U_max us -> List.fold_left (fun out x -> out ++ free_univs x) no_free_vars us | U_unif u -> singleton_univ u //the interface of Syntax.Free now supports getting fvars in a term also @@ -120,7 +127,7 @@ let rec free_univs u = match Subst.compress_univ u with let rec free_names_and_uvs' tm (use_cache:use_cache_t) : free_vars_and_fvars = let aux_binders (bs : binders) (from_body : free_vars_and_fvars) = let from_binders = free_names_and_uvars_binders bs use_cache in - union from_binders from_body + from_binders ++ from_body in let t = Subst.compress tm in match t.n with @@ -130,8 +137,10 @@ let rec free_names_and_uvs' tm (use_cache:use_cache_t) : free_vars_and_fvars = singleton_bv x | Tm_uvar (uv, (s, _)) -> - union (singleton_uv uv) - (if use_cache = Full then free_names_and_uvars (ctx_uvar_typ uv) use_cache else no_free_vars) + singleton_uv uv ++ + (if use_cache = Full + then free_names_and_uvars (ctx_uvar_typ uv) use_cache + else no_free_vars) | Tm_type u -> free_univs u @@ -146,13 +155,13 @@ let rec free_names_and_uvs' tm (use_cache:use_cache_t) : free_vars_and_fvars = | Tm_uinst(t, us) -> let f = free_names_and_uvars t use_cache in - List.fold_left (fun out u -> union out (free_univs u)) f us + List.fold_left (fun out u -> out ++ free_univs u) f us | Tm_abs {bs; body=t; rc_opt=ropt} -> - union (aux_binders bs (free_names_and_uvars t use_cache)) - (match ropt with - | Some { residual_typ = Some t } -> free_names_and_uvars t use_cache - | _ -> no_free_vars) + aux_binders bs (free_names_and_uvars t use_cache) ++ + (match ropt with + | Some { residual_typ = Some t } -> free_names_and_uvars t use_cache + | _ -> no_free_vars) | Tm_arrow {bs; comp=c} -> aux_binders bs (free_names_and_uvars_comp c use_cache) @@ -163,7 +172,11 @@ let rec free_names_and_uvs' tm (use_cache:use_cache_t) : free_vars_and_fvars = | Tm_app {hd=t; args} -> free_names_and_uvars_args args (free_names_and_uvars t use_cache) use_cache - | Tm_match {scrutinee=t; ret_opt=asc_opt; brs=pats} -> + | Tm_match {scrutinee=t; ret_opt=asc_opt; brs=pats; rc_opt} -> + (match rc_opt with + | Some { residual_typ = Some t } -> free_names_and_uvars t use_cache + | _ -> no_free_vars) ++ + begin pats |> List.fold_left (fun n (p, wopt, t) -> let n1 = match wopt with | None -> no_free_vars @@ -171,29 +184,31 @@ let rec free_names_and_uvs' tm (use_cache:use_cache_t) : free_vars_and_fvars = in let n2 = free_names_and_uvars t use_cache in let n = - pat_bvs p |> List.fold_left (fun n x -> union n (free_names_and_uvars x.sort use_cache)) n + pat_bvs p |> List.fold_left (fun n x -> n ++ free_names_and_uvars x.sort use_cache) n in - union n (union n1 n2)) - (union (free_names_and_uvars t use_cache) - (match asc_opt with - | None -> no_free_vars - | Some (b, asc) -> - union - (free_names_and_uvars_binders [b] use_cache) - (free_names_and_uvars_ascription asc use_cache))) + n ++ n1 ++ n2) + (free_names_and_uvars t use_cache + ++ (match asc_opt with + | None -> no_free_vars + | Some (b, asc) -> + free_names_and_uvars_binders [b] use_cache ++ + free_names_and_uvars_ascription asc use_cache)) + end | Tm_ascribed {tm=t1; asc} -> - union (free_names_and_uvars t1 use_cache) - (free_names_and_uvars_ascription asc use_cache) + free_names_and_uvars t1 use_cache ++ + free_names_and_uvars_ascription asc use_cache | Tm_let {lbs; body=t} -> snd lbs |> List.fold_left (fun n lb -> - union n (union (free_names_and_uvars lb.lbtyp use_cache) (free_names_and_uvars lb.lbdef use_cache))) - (free_names_and_uvars t use_cache) + n ++ + free_names_and_uvars lb.lbtyp use_cache ++ + free_names_and_uvars lb.lbdef use_cache) + (free_names_and_uvars t use_cache) | Tm_quoted (tm, qi) -> begin match qi.qkind with - | Quote_static -> List.fold_left (fun n t -> union n (free_names_and_uvars t use_cache)) no_free_vars (snd qi.antiquotations) + | Quote_static -> List.fold_left (fun n t -> n ++ free_names_and_uvars t use_cache) no_free_vars (snd qi.antiquotations) | Quote_dynamic -> free_names_and_uvars tm use_cache end @@ -204,10 +219,10 @@ let rec free_names_and_uvs' tm (use_cache:use_cache_t) : free_vars_and_fvars = List.fold_right (fun a acc -> free_names_and_uvars_args a acc use_cache) args u1 | Meta_monadic(_, t') -> - union u1 (free_names_and_uvars t' use_cache) + u1 ++ free_names_and_uvars t' use_cache | Meta_monadic_lift(_, _, t') -> - union u1 (free_names_and_uvars t' use_cache) + u1 ++ free_names_and_uvars t' use_cache | Meta_labeled _ | Meta_desugared _ @@ -217,38 +232,37 @@ let rec free_names_and_uvs' tm (use_cache:use_cache_t) : free_vars_and_fvars = and free_names_and_uvars_binders bs use_cache = bs |> List.fold_left (fun n b -> - union n (free_names_and_uvars b.binder_bv.sort use_cache)) no_free_vars + n ++ free_names_and_uvars b.binder_bv.sort use_cache) no_free_vars and free_names_and_uvars_ascription asc use_cache = let asc, tacopt, _ = asc in - union (match asc with - | Inl t -> free_names_and_uvars t use_cache - | Inr c -> free_names_and_uvars_comp c use_cache) - (match tacopt with - | None -> no_free_vars - | Some tac -> free_names_and_uvars tac use_cache) - + (match asc with + | Inl t -> free_names_and_uvars t use_cache + | Inr c -> free_names_and_uvars_comp c use_cache) ++ + (match tacopt with + | None -> no_free_vars + | Some tac -> free_names_and_uvars tac use_cache) and free_names_and_uvars t use_cache = let t = Subst.compress t in match !t.vars with - | Some n when not (should_invalidate_cache n use_cache) -> n, new_fv_set () + | Some n when not (should_invalidate_cache n use_cache) -> n, empty () | _ -> t.vars := None; let n = free_names_and_uvs' t use_cache in if use_cache <> Full then t.vars := Some (fst n); n -and free_names_and_uvars_args args (acc:free_vars * set Ident.lident) use_cache = - args |> List.fold_left (fun n (x, _) -> union n (free_names_and_uvars x use_cache)) acc +and free_names_and_uvars_args args (acc : free_vars_and_fvars) use_cache = + args |> List.fold_left (fun n (x, _) -> n ++ (free_names_and_uvars x use_cache)) acc and free_names_and_uvars_comp c use_cache = match !c.vars with | Some n -> if should_invalidate_cache n use_cache then (c.vars := None; free_names_and_uvars_comp c use_cache) - else n, new_fv_set () + else n, empty () | _ -> let n = match c.n with | GTotal t @@ -264,11 +278,11 @@ and free_names_and_uvars_comp c use_cache = free_names_and_uvars_dec_order dec_order use_cache in //decreases clause + return type - let us = union (free_names_and_uvars ct.result_typ use_cache) decreases_vars in + let us = free_names_and_uvars ct.result_typ use_cache ++ decreases_vars in //decreases clause + return type + effect args let us = free_names_and_uvars_args ct.effect_args us use_cache in //decreases clause + return type + effect args + comp_univs - List.fold_left (fun us u -> union us (free_univs u)) us ct.comp_univs + List.fold_left (fun us u -> us ++ free_univs u) us ct.comp_univs in c.vars := Some (fst n); n @@ -276,38 +290,35 @@ and free_names_and_uvars_comp c use_cache = and free_names_and_uvars_dec_order dec_order use_cache = match dec_order with | Decreases_lex l -> - l |> List.fold_left (fun acc t -> union acc (free_names_and_uvars t use_cache)) no_free_vars + l |> List.fold_left (fun acc t -> acc ++ free_names_and_uvars t use_cache) no_free_vars | Decreases_wf (rel, e) -> - union (free_names_and_uvars rel use_cache) - (free_names_and_uvars e use_cache) + free_names_and_uvars rel use_cache ++ + free_names_and_uvars e use_cache and should_invalidate_cache n use_cache = (use_cache <> Def) || - (n.free_uvars |> Util.for_some (fun u -> + (n.free_uvars |> for_any (fun u -> match UF.find u.ctx_uvar_head with | Some _ -> true | _ -> false)) || - (n.free_univs |> Util.for_some (fun u -> + (n.free_univs |> for_any (fun u -> match UF.univ_find u with | Some _ -> true | None -> false)) //note use_cache is set false ONLY for fvars, which is not maintained at each AST node //see the comment above -let new_uv_set () : uvars = Set.empty () -let new_universe_uvar_set () : set universe_uvar = Set.empty () -let empty = Set.empty () -let names t = Set.from_list (fst (free_names_and_uvars t Def)).free_names -let uvars t = Set.from_list (fst (free_names_and_uvars t Def)).free_uvars -let univs t = Set.from_list (fst (free_names_and_uvars t Def)).free_univs +let names t = (fst (free_names_and_uvars t Def)).free_names +let uvars t = (fst (free_names_and_uvars t Def)).free_uvars +let univs t = (fst (free_names_and_uvars t Def)).free_univs -let univnames t = Set.from_list (fst (free_names_and_uvars t Def)).free_univ_names -let univnames_comp c = Set.from_list (fst (free_names_and_uvars_comp c Def)).free_univ_names +let univnames t = (fst (free_names_and_uvars t Def)).free_univ_names +let univnames_comp c = (fst (free_names_and_uvars_comp c Def)).free_univ_names let fvars t = snd (free_names_and_uvars t NoCache) let names_of_binders (bs:binders) = - Set.from_list ((fst (free_names_and_uvars_binders bs Def)).free_names) + ((fst (free_names_and_uvars_binders bs Def)).free_names) -let uvars_uncached t = Set.from_list (fst (free_names_and_uvars t NoCache)).free_uvars -let uvars_full t = Set.from_list (fst (free_names_and_uvars t Full)).free_uvars +let uvars_uncached t = (fst (free_names_and_uvars t NoCache)).free_uvars +let uvars_full t = (fst (free_names_and_uvars t Full)).free_uvars diff --git a/src/syntax/FStar.Syntax.Free.fsti b/src/syntax/FStar.Syntax.Free.fsti index 10cfce41997..77bae21698e 100644 --- a/src/syntax/FStar.Syntax.Free.fsti +++ b/src/syntax/FStar.Syntax.Free.fsti @@ -19,24 +19,23 @@ open Prims open FStar open FStar.Compiler open FStar.Compiler.Util -open FStar.Compiler.Set +open FStar.Compiler.FlatSet open FStar.Syntax open FStar.Syntax.Syntax -val new_uv_set : unit -> uvars -val new_universe_uvar_set : unit -> set universe_uvar +val names : term -> FlatSet.t bv +val names_of_binders : binders -> FlatSet.t bv -val empty: set bv -val names: term -> set bv -val uvars: term -> set ctx_uvar -val univs: term -> set universe_uvar -val univnames: term -> set univ_name -val univnames_comp: comp -> set univ_name -val fvars: term -> set Ident.lident -val names_of_binders: binders -> set bv +val fvars : term -> RBSet.t Ident.lident -val uvars_uncached: term -> set ctx_uvar -val uvars_full: term -> set ctx_uvar +val uvars : term -> FlatSet.t ctx_uvar +val uvars_uncached : term -> FlatSet.t ctx_uvar +val uvars_full : term -> FlatSet.t ctx_uvar + +val univs : term -> FlatSet.t universe_uvar + +val univnames : term -> FlatSet.t univ_name +val univnames_comp : comp -> FlatSet.t univ_name (* Bad place for these instances. But they cannot be instance Syntax.Syntax since they reference the UF graph. *) diff --git a/src/syntax/FStar.Syntax.Hash.fst b/src/syntax/FStar.Syntax.Hash.fst index fb48dfdd8e9..b6e70f29a5b 100644 --- a/src/syntax/FStar.Syntax.Hash.fst +++ b/src/syntax/FStar.Syntax.Hash.fst @@ -73,12 +73,17 @@ let mix_list_lit = mix_list let hash_list (h:'a -> mm H.hash_code) (ts:list 'a) : mm H.hash_code = mix_list (List.map h ts) - let hash_option (h:'a -> mm H.hash_code) (o:option 'a) : mm H.hash_code = match o with | None -> ret (H.of_int 1237) | Some o -> mix (ret (H.of_int 1249)) (h o) +// hash the string. +let hash_doc (d : Pprint.document) : mm H.hash_code = + of_string (Pprint.pretty_string (float_of_string "1.0") 80 d) + +let hash_doc_list (ds : list Pprint.document) : mm H.hash_code = + hash_list hash_doc ds let hash_pair (h:'a -> mm H.hash_code) (i:'b -> mm H.hash_code) (x:('a * 'b)) : mm H.hash_code @@ -94,7 +99,7 @@ and hash_comp c and hash_term' (t:term) : mm H.hash_code - = // if Options.debug_any () + = // if Debug.any () // then FStar.Compiler.Util.print1 "Hash_term %s\n" (FStar.Syntax.Print.term_to_string t); match (SS.compress t).n with | Tm_bvar bv -> mix (of_int 3) (of_int bv.index) @@ -298,7 +303,7 @@ and hash_meta m = | Meta_labeled (s, r, _) -> mix_list_lit [ of_int 1031; - of_string s; + hash_doc_list s; of_string (Range.string_of_range r) ] | Meta_desugared msi -> mix_list_lit diff --git a/src/syntax/FStar.Syntax.MutRecTy.fst b/src/syntax/FStar.Syntax.MutRecTy.fst index ce8e61f5432..34e9c74ea70 100644 --- a/src/syntax/FStar.Syntax.MutRecTy.fst +++ b/src/syntax/FStar.Syntax.MutRecTy.fst @@ -193,7 +193,9 @@ let disentangle_abbrevs_from_bundle let unfold_in_sig (x: sigelt) = match x.sigel with | Sig_inductive_typ {lid; us=univs; params=bnd; - num_uniform_params=num_uniform; t=ty; mutuals=mut; ds=dc} -> + num_uniform_params=num_uniform; + t=ty; mutuals=mut; ds=dc; + injective_type_params } -> let bnd' = inst_binders unfold_fv bnd in let ty' = inst unfold_fv ty in let mut' = filter_out_type_abbrevs mut in @@ -203,9 +205,12 @@ let disentangle_abbrevs_from_bundle num_uniform_params=num_uniform; t=ty'; mutuals=mut'; - ds=dc} }] + ds=dc; + injective_type_params } }] - | Sig_datacon {lid; us=univs; t=ty; ty_lid=res; num_ty_params=npars; mutuals=mut} -> + | Sig_datacon {lid; us=univs; t=ty; ty_lid=res; + num_ty_params=npars; mutuals=mut; + injective_type_params } -> let ty' = inst unfold_fv ty in let mut' = filter_out_type_abbrevs mut in [{ x with sigel = Sig_datacon {lid; @@ -213,7 +218,8 @@ let disentangle_abbrevs_from_bundle t=ty'; ty_lid=res; num_ty_params=npars; - mutuals=mut'} }] + mutuals=mut'; + injective_type_params } }] | Sig_let _ -> [] diff --git a/src/syntax/FStar.Syntax.Print.Pretty.fst b/src/syntax/FStar.Syntax.Print.Pretty.fst index a6e6cb4ea40..a926b380e68 100644 --- a/src/syntax/FStar.Syntax.Print.Pretty.fst +++ b/src/syntax/FStar.Syntax.Print.Pretty.fst @@ -125,7 +125,7 @@ let tscheme_to_string (ts:tscheme) : string = GenSym.with_frozen_gensym (fun () ) let pat_to_string (p:pat) : string = GenSym.with_frozen_gensym (fun () -> - let e = Resugar.resugar_pat p Syntax.no_names in + let e = Resugar.resugar_pat p (Class.Setlike.empty ()) in let d = ToDocument.pat_to_document e in pp d ) diff --git a/src/syntax/FStar.Syntax.Print.fst b/src/syntax/FStar.Syntax.Print.fst index 651bfc27bcb..56e0fbbd58b 100644 --- a/src/syntax/FStar.Syntax.Print.fst +++ b/src/syntax/FStar.Syntax.Print.fst @@ -249,7 +249,7 @@ and term_to_string x = | Tm_meta {tm=t; meta=Meta_monadic_lift(m0, m1, t')} -> U.format4 ("(MetaMonadicLift-{%s : %s -> %s} %s)") (term_to_string t') (sli m0) (sli m1) (term_to_string t) | Tm_meta {tm=t; meta=Meta_labeled(l,r,b)} -> - U.format3 "Meta_labeled(%s, %s){%s}" l (Range.string_of_range r) (term_to_string t) + U.format3 "Meta_labeled(%s, %s){%s}" (Errors.Msg.rendermsg l) (Range.string_of_range r) (term_to_string t) | Tm_meta {tm=t; meta=Meta_named(l)} -> U.format3 "Meta_named(%s, %s){%s}" (lid_to_string l) (Range.string_of_range t.pos) (term_to_string t) @@ -559,7 +559,7 @@ and metadata_to_string = function U.format1 "{Meta_named %s}" (sli lid) | Meta_labeled (l, r, _) -> - U.format2 "{Meta_labeled (%s, %s)}" l (Range.string_of_range r) + U.format2 "{Meta_labeled (%s, %s)}" (Errors.Msg.rendermsg l) (Range.string_of_range r) | Meta_desugared msi -> "{Meta_desugared}" @@ -572,6 +572,7 @@ and metadata_to_string = function let aqual_to_string aq = aqual_to_string' "" aq let bqual_to_string bq = bqual_to_string' "" bq +let lb_to_string lb = lbs_to_string [] (false, [lb]) let comp_to_string' env c = if Options.ugly () @@ -1010,6 +1011,9 @@ instance showable_pragma = { show = pragma_to_string; } instance showable_subst_elt = { show = subst_elt_to_string; } instance showable_branch = { show = branch_to_string; } instance showable_qualifier = { show = qual_to_string; } +instance showable_pat = { show = pat_to_string; } +instance showable_const = { show = const_to_string; } +instance showable_letbinding = { show = lb_to_string; } instance pretty_term = { pp = term_to_doc; } instance pretty_univ = { pp = univ_to_doc; } @@ -1018,3 +1022,12 @@ instance pretty_comp = { pp = comp_to_doc; } instance pretty_ctxu = { pp = (fun x -> Pprint.doc_of_string (show x)); } instance pretty_uvar = { pp = (fun x -> Pprint.doc_of_string (show x)); } instance pretty_binder = { pp = (fun x -> Pprint.doc_of_string (show x)); } +instance pretty_bv = { pp = (fun x -> Pprint.doc_of_string (show x)); } + +open FStar.Pprint + +instance pretty_binding : pretty binding = { + pp = (function Binding_var bv -> pp bv + | Binding_lid (l, (us, t)) -> pp l ^^ colon ^^ pp t + | Binding_univ u -> pp u); +} diff --git a/src/syntax/FStar.Syntax.Print.fsti b/src/syntax/FStar.Syntax.Print.fsti index b42e89b7616..40cdc3bd8d7 100644 --- a/src/syntax/FStar.Syntax.Print.fsti +++ b/src/syntax/FStar.Syntax.Print.fsti @@ -104,6 +104,9 @@ instance val showable_pragma : showable pragma instance val showable_subst_elt : showable subst_elt instance val showable_branch : showable branch instance val showable_qualifier : showable qualifier +instance val showable_pat : showable pat +instance val showable_const : showable sconst +instance val showable_letbinding : showable letbinding instance val pretty_term : pretty term instance val pretty_univ : pretty universe @@ -112,3 +115,5 @@ instance val pretty_sigelt : pretty sigelt instance val pretty_uvar : pretty uvar instance val pretty_ctxu : pretty ctx_uvar instance val pretty_binder : pretty binder +instance val pretty_bv : pretty bv +instance val pretty_binding : pretty binding diff --git a/src/syntax/FStar.Syntax.Resugar.fst b/src/syntax/FStar.Syntax.Resugar.fst index 639f879a2bc..fc944263ea0 100644 --- a/src/syntax/FStar.Syntax.Resugar.fst +++ b/src/syntax/FStar.Syntax.Resugar.fst @@ -27,6 +27,7 @@ open FStar.Const open FStar.Compiler.List open FStar.Parser.AST open FStar.Class.Monad +open FStar.Class.Setlike module I = FStar.Ident module S = FStar.Syntax.Syntax @@ -83,7 +84,7 @@ let label s t = else A.mk_term (A.Labeled (t,s,true)) t.range A.Un let rec universe_to_int n u = - match u with + match Subst.compress_univ u with | U_succ u -> universe_to_int (n+1) u | _ -> (n, u) @@ -97,7 +98,8 @@ let rec resugar_universe (u:S.universe) r: A.term = //augment `a` an Unknown level (the level is unimportant ... we should maybe remove it altogether) A.mk_term a r A.Un in - begin match Subst.compress_univ u with + let u = Subst.compress_univ u in + begin match u with | U_zero -> mk (A.Const(Const_int ("0", None))) r @@ -409,7 +411,11 @@ let rec resugar_term' (env: DsEnv.env) (t : S.term) : A.term = when can_resugar_machine_integer fv -> resugar_machine_integer fv i t.pos - | Tm_app {hd=e; args} -> + | Tm_app _ -> + let t = U.canon_app t in + let Tm_app {hd=e; args} = t.n in + (* NB: This cannot fail since U.canon_app constructs a Tm_app. *) + (* Op("=!=", args) is desugared into Op("~", Op("==") and not resugared back as "=!=" *) let rec last = function | hd :: [] -> [hd] @@ -440,6 +446,34 @@ let rec resugar_term' (env: DsEnv.env) (t : S.term) : A.term = if Options.print_implicits () then args else filter_imp_args args in + + let is_projector (t:S.term) : option (lident & ident) = + (* Detect projectors and resugar them as t.x instead of Mkt?.x t *) + match (U.un_uinst (SS.compress t)).n with + | Tm_fvar fv -> + let a = fv.fv_name.v in + let length = String.length (nsstr fv.fv_name.v) in + let s = if length=0 then string_of_lid a + else BU.substring_from (string_of_lid a) (length+1) in + if BU.starts_with s U.field_projector_prefix then + let rest = BU.substring_from s (String.length U.field_projector_prefix) in + let r = BU.split rest U.field_projector_sep in + begin match r with + | [fst; snd] -> + let l = lid_of_path [fst] t.pos in + let r = I.mk_ident (snd, t.pos) in + Some (l, r) + | _ -> + failwith "wrong projector format" + end + else None + | _ -> None + in + if Some? (is_projector e) && List.length args = 1 then + let (_, fi) = Some?.v (is_projector e) in + let arg = resugar_term' env (fst (List.hd args)) in + mk <| Project (arg, Ident.lid_of_ids [fi]) + else begin match resugar_term_as_op e with | None-> resugar_as_app e args @@ -592,7 +626,7 @@ let rec resugar_term' (env: DsEnv.env) (t : S.term) : A.term = body | Meta_labeled (s, r, p) -> // this case can occur in typechecker when a failure is wrapped in meta_labeled - [], mk (A.Labeled (body, s, p)) + [], mk (A.Labeled (body, Errors.Msg.rendermsg s, p)) | _ -> failwith "wrong pattern format for QForall/QExists" in pats, body @@ -1052,9 +1086,9 @@ and resugar_binder' env (b:S.binder) r : option A.binder = A.mk_binder (A.Annotated (bv_as_unique_ident b.binder_bv, e)) r A.Type_level imp end -and resugar_bv_as_pat' env (v: S.bv) aqual (body_bv: Set.set bv) typ_opt = +and resugar_bv_as_pat' env (v: S.bv) aqual (body_bv: FlatSet.t bv) typ_opt = let mk a = A.mk_pattern a (S.range_of_bv v) in - let used = Set.mem v body_bv in + let used = mem v body_bv in let pat = mk (if used then A.PatVar (bv_as_unique_ident v, aqual, []) @@ -1070,7 +1104,7 @@ and resugar_bv_as_pat env (x:S.bv) qual body_bv: option A.pattern = (resugar_bqual env qual) (fun bq -> resugar_bv_as_pat' env x bq body_bv (Some <| SS.compress x.sort)) -and resugar_pat' env (p:S.pat) (branch_bv: Set.set bv) : A.pattern = +and resugar_pat' env (p:S.pat) (branch_bv: FlatSet.t bv) : A.pattern = (* We lose information when desugar PatAscribed to able to resugar it back *) let mk a = A.mk_pattern a p.p in let to_arg_qual bopt = // FIXME do (Some false) and None mean the same thing? @@ -1081,7 +1115,7 @@ and resugar_pat' env (p:S.pat) (branch_bv: Set.set bv) : A.pattern = //FIXME let might_be_used = match pattern.v with - | Pat_var bv -> Set.mem bv branch_bv + | Pat_var bv -> mem bv branch_bv | _ -> true in is_implicit && might_be_used) args) in let resugar_plain_pat_cons' fv args = @@ -1502,7 +1536,7 @@ let resugar_sigelt se : option A.decl = let resugar_comp (c:S.comp) : A.term = noenv resugar_comp' c -let resugar_pat (p:S.pat) (branch_bv: Set.set bv) : A.pattern = +let resugar_pat (p:S.pat) (branch_bv: FlatSet.t bv) : A.pattern = noenv resugar_pat' p branch_bv let resugar_binder (b:S.binder) r : option A.binder = diff --git a/src/syntax/FStar.Syntax.Resugar.fsti b/src/syntax/FStar.Syntax.Resugar.fsti index c4d40395dfa..cdf7515409d 100644 --- a/src/syntax/FStar.Syntax.Resugar.fsti +++ b/src/syntax/FStar.Syntax.Resugar.fsti @@ -36,7 +36,7 @@ module DsEnv = FStar.Syntax.DsEnv val resugar_term: S.term -> A.term val resugar_sigelt: S.sigelt -> option A.decl val resugar_comp: S.comp -> A.term -val resugar_pat: S.pat -> Set.t S.bv -> A.pattern +val resugar_pat: S.pat -> FlatSet.t S.bv -> A.pattern val resugar_universe: S.universe -> Range.range -> A.term val resugar_binder: S.binder -> Range.range -> option A.binder val resugar_tscheme: S.tscheme -> A.decl @@ -45,7 +45,7 @@ val resugar_eff_decl: Range.range -> list S.qualifier -> eff_decl -> A.decl val resugar_term': DsEnv.env -> S.term -> A.term val resugar_sigelt': DsEnv.env -> S.sigelt -> option A.decl val resugar_comp': DsEnv.env -> S.comp -> A.term -val resugar_pat': DsEnv.env -> S.pat -> Set.t S.bv -> A.pattern +val resugar_pat': DsEnv.env -> S.pat -> FlatSet.t S.bv -> A.pattern val resugar_universe': DsEnv.env -> S.universe -> Range.range -> A.term val resugar_binder': DsEnv.env -> S.binder -> Range.range -> option A.binder val resugar_tscheme': DsEnv.env -> S.tscheme -> A.decl diff --git a/src/syntax/FStar.Syntax.Syntax.fst b/src/syntax/FStar.Syntax.Syntax.fst index b9991d214ab..3046c83fbf4 100644 --- a/src/syntax/FStar.Syntax.Syntax.fst +++ b/src/syntax/FStar.Syntax.Syntax.fst @@ -29,13 +29,13 @@ open FStar.VConfig open FStar.Class.Ord open FStar.Class.HasRange - +open FStar.Class.Setlike module O = FStar.Options module PC = FStar.Parser.Const module Err = FStar.Errors module GS = FStar.GenSym -module Set = FStar.Compiler.Set +module FlatSet = FStar.Compiler.FlatSet let rec emb_typ_to_string = function | ET_abstract -> "abstract" @@ -160,18 +160,10 @@ instance ord_fv : ord lident = let syn p k f = f k p let mk_fvs () = Util.mk_ref None let mk_uvs () = Util.mk_ref None -let new_bv_set () : Set.t bv = Set.empty () -let new_id_set () : Set.t ident = Set.empty () -let new_fv_set () : Set.t lident = Set.empty () -let new_universe_names_set () : Set.t univ_name = Set.empty () - -let no_names = new_bv_set() -let no_fvars = new_fv_set() -let no_universe_names = new_universe_names_set () + //let memo_no_uvs = Util.mk_ref (Some no_uvs) //let memo_no_names = Util.mk_ref (Some no_names) -let freenames_of_list l = Set.addn l no_names -let list_of_freenames (fvs:freenames) = Set.elems fvs +let list_of_freenames (fvs:freenames) = elems fvs (* Constructors for each term form; NO HASH CONSING; just makes all the auxiliary data at each node *) let mk (t:'a) r = { @@ -295,10 +287,10 @@ let is_top_level = function | _ -> false let freenames_of_binders (bs:binders) : freenames = - List.fold_right (fun b out -> Set.add b.binder_bv out) bs no_names + List.fold_right (fun b out -> add b.binder_bv out) bs (empty ()) let binders_of_list fvs : binders = (fvs |> List.map (fun t -> mk_binder t)) -let binders_of_freenames (fvs:freenames) = Set.elems fvs |> binders_of_list +let binders_of_freenames (fvs:freenames) = elems fvs |> binders_of_list let is_bqual_implicit = function Some (Implicit _) -> true | _ -> false let is_aqual_implicit = function Some { aqual_implicit = b } -> b | _ -> false let is_bqual_implicit_or_meta = function Some (Implicit _) | Some (Meta _) -> true | _ -> false @@ -328,18 +320,16 @@ let fv_eq_lid fv lid = lid_equals fv.fv_name.v lid let set_bv_range bv r = {bv with ppname = set_id_range r bv.ppname} -let lid_and_dd_as_fv l dd dq : fv = { +let lid_and_dd_as_fv l dq : fv = { fv_name=withinfo l (range_of_lid l); - fv_delta=Some dd; fv_qual =dq; } let lid_as_fv l dq : fv = { fv_name=withinfo l (range_of_lid l); - fv_delta=None; fv_qual =dq; } let fv_to_tm (fv:fv) : term = mk (Tm_fvar fv) (range_of_lid fv.fv_name.v) -let fvar_with_dd l dd dq = fv_to_tm (lid_and_dd_as_fv l dd dq) +let fvar_with_dd l dq = fv_to_tm (lid_and_dd_as_fv l dq) let fvar l dq = fv_to_tm (lid_as_fv l dq) let lid_of_fv (fv:fv) = fv.fv_name.v let range_of_fv (fv:fv) = range_of_lid (lid_of_fv fv) @@ -376,10 +366,10 @@ let rec eq_pat (p1 : pat) (p2 : pat) : bool = /////////////////////////////////////////////////////////////////////// let delta_constant = Delta_constant_at_level 0 let delta_equational = Delta_equational_at_level 0 -let fvconst l = lid_and_dd_as_fv l delta_constant None +let fvconst l = lid_and_dd_as_fv l None let tconst l = mk (Tm_fvar (fvconst l)) Range.dummyRange -let tabbrev l = mk (Tm_fvar(lid_and_dd_as_fv l (Delta_constant_at_level 1) None)) Range.dummyRange -let tdataconstr l = fv_to_tm (lid_and_dd_as_fv l delta_constant (Some Data_ctor)) +let tabbrev l = mk (Tm_fvar(lid_and_dd_as_fv l None)) Range.dummyRange +let tdataconstr l = fv_to_tm (lid_and_dd_as_fv l (Some Data_ctor)) let t_unit = tconst PC.unit_lid let t_bool = tconst PC.bool_lid let t_int = tconst PC.int_lid diff --git a/src/syntax/FStar.Syntax.Syntax.fsti b/src/syntax/FStar.Syntax.Syntax.fsti index b534081360b..cb8949e9ea3 100644 --- a/src/syntax/FStar.Syntax.Syntax.fsti +++ b/src/syntax/FStar.Syntax.Syntax.fsti @@ -107,10 +107,16 @@ type maybe_set_use_range = [@@ PpxDerivingYoJson; PpxDerivingShow ] type delta_depth = - | Delta_constant_at_level of int //A symbol that can be unfolded n types to a term whose head is a constant, e.g., nat is (Delta_unfoldable 1) to int, level 0 is a constant - | Delta_equational_at_level of int //level 0 is a symbol that may be equated to another by extensional reasoning, n > 0 can be unfolded n times to a Delta_equational_at_level 0 term - | Delta_abstract of delta_depth //A symbol marked abstract whose depth is the argument d - + | Delta_constant_at_level of int + // ^ A symbol that can be unfolded n times to a term whose head is a + // constant, e.g., nat is (Delta_constant_at_level 1) to int, level 0 + // is a literal constant. + | Delta_equational_at_level of int + // ^ Level 0 is a symbol that may be equated to another by + // extensional reasoning, n > 0 can be unfolded n times to a + // Delta_equational_at_level 0 term. + | Delta_abstract of delta_depth + // ^ A symbol marked abstract whose depth is the argument d. [@@ PpxDerivingYoJson; PpxDerivingShow ] type should_check_uvar = @@ -196,7 +202,7 @@ and uvar_decoration = { } and uvar = Unionfind.p_uvar (option term * uvar_decoration) * version * Range.range -and uvars = Set.t ctx_uvar +and uvars = FlatSet.t ctx_uvar and match_returns_ascription = binder * ascription (* as x returns C|t *) and branch = pat * option term * term (* optional when clause in each branch *) and ascription = either term comp * option term * bool (* e <: t [by tac] or e <: C [by tac] *) @@ -321,7 +327,7 @@ and cflag = (* flags applic and metadata = | Meta_pattern of list term * list args (* Patterns for SMT quantifier instantiation; the first arg instantiation *) | Meta_named of lident (* Useful for pretty printing to keep the type abbreviation around *) - | Meta_labeled of string * Range.range * bool (* Sub-terms in a VC are labeled with error messages to be reported, used in SMT encoding *) + | Meta_labeled of list Pprint.document * Range.range * bool (* Sub-terms in a VC are labeled with error messages to be reported, used in SMT encoding *) | Meta_desugared of meta_source_info (* Node tagged with some information about source term before desugaring *) | Meta_monadic of monad_name * typ (* Annotation on a Tm_app or Tm_let node in case it is monadic for m not in {Pure, Ghost, Div} *) (* Contains the name of the monadic effect and the type of the subterm *) @@ -356,7 +362,7 @@ and subst_elt = | NT of bv * term (* NT x t: replace a local name with a term t *) | UN of int * universe (* UN u v: replace universes variable u with universe term v *) | UD of univ_name * int (* UD x i: replace universe name x with de Bruijn index i *) -and freenames = Set.t bv +and freenames = FlatSet.t bv and syntax 'a = { n:'a; pos:Range.range; @@ -370,14 +376,13 @@ and bv = { } and fv = { fv_name :var; - fv_delta:option delta_depth; fv_qual :option fv_qual } and free_vars = { - free_names:list bv; - free_uvars:list ctx_uvar; - free_univs:list universe_uvar; - free_univ_names:list univ_name; //fifo + free_names : FlatSet.t bv; + free_uvars : uvars; + free_univs : FlatSet.t universe_uvar; + free_univ_names : FlatSet.t univ_name; //fifo } (* Residual of a computation type after typechecking *) @@ -656,6 +661,7 @@ type sigelt' = t:typ; //t mutuals:list lident; //mutually defined types ds:list lident; //data constructors for this type + injective_type_params:bool //is this type injective in its type parameters? } (* a datatype definition is a Sig_bundle of all mutually defined `Sig_inductive_typ`s and `Sig_datacon`s. perhaps it would be nicer to let this have a 2-level structure, e.g. list list sigelt, @@ -673,6 +679,7 @@ type sigelt' = ty_lid:lident; //the inductive type of the value this constructs num_ty_params:int; //and the number of parameters of the inductive mutuals:list lident; //mutually defined types + injective_type_params:bool //is this type injective in its type parameters? } | Sig_declare_typ { lid:lident; @@ -751,10 +758,6 @@ val lookup_aq : bv -> antiquotations -> term // This is set in FStar.Main.main, where all modules are in-scope. val lazy_chooser : ref (option (lazy_kind -> lazyinfo -> term)) -val new_bv_set: unit -> Set.t bv -val new_id_set: unit -> Set.t ident -val new_fv_set: unit -> Set.t lident -val new_universe_names_set: unit -> Set.t univ_name val mod_name: modul -> lident @@ -804,13 +807,7 @@ val teff: term val is_teff: term -> bool val is_type: term -> bool -val no_names: freenames -val no_universe_names: Set.t univ_name -val no_fvars: Set.t lident - -val freenames_of_list: list bv -> freenames val freenames_of_binders: binders -> freenames -val list_of_freenames: freenames -> list bv val binders_of_freenames: freenames -> binders val binders_of_list: list bv -> binders @@ -840,10 +837,10 @@ val gen_bv : string -> option Range.range -> typ -> bv val gen_bv' : ident -> option Range.range -> typ -> bv val new_bv : option range -> typ -> bv val new_univ_name : option range -> univ_name -val lid_and_dd_as_fv : lident -> delta_depth -> option fv_qual -> fv +val lid_and_dd_as_fv : lident -> option fv_qual -> fv val lid_as_fv : lident -> option fv_qual -> fv val fv_to_tm : fv -> term -val fvar_with_dd : lident -> delta_depth -> option fv_qual -> term +val fvar_with_dd : lident -> option fv_qual -> term val fvar : lident -> option fv_qual -> term val fv_eq : fv -> fv -> bool val fv_eq_lid : fv -> lident -> bool diff --git a/src/syntax/FStar.Syntax.Util.fst b/src/syntax/FStar.Syntax.Util.fst index c5857f506f7..644aa3675c8 100644 --- a/src/syntax/FStar.Syntax.Util.fst +++ b/src/syntax/FStar.Syntax.Util.fst @@ -34,6 +34,7 @@ module PC = FStar.Parser.Const open FStar.Class.Show open FStar.Class.Monad +open FStar.Class.Setlike (********************************************************************************) (**************************Utilities for identifiers ****************************) @@ -107,8 +108,6 @@ let null_binders_of_tks (tks:list (typ * bqual)) : binders = let binders_of_tks (tks:list (typ * bqual)) : binders = tks |> List.map (fun (t, imp) -> mk_binder_with_attrs (new_bv (Some t.pos) t) imp None []) -let binders_of_freevars fvs = Set.elems fvs |> List.map mk_binder - let mk_subst s = [s] let subst_of_list (formals:binders) (actuals:args) : subst_t = @@ -223,6 +222,10 @@ let rec compare_univs (u1:universe) (u2:universe) : int = let eq_univs u1 u2 = compare_univs u1 u2 = 0 +let eq_univs_list (us:universes) (vs:universes) : bool = + List.length us = List.length vs + && List.forall2 eq_univs us vs + (********************************************************************************) (*********************** Utilities for computation types ************************) (********************************************************************************) @@ -497,315 +500,6 @@ let canon_app t = let hd, args = head_and_args_full (unascribe t) in mk_Tm_app hd args t.pos -(* ---------------------------------------------------------------------- *) -(* Syntactic equality of terms *) -(* ---------------------------------------------------------------------- *) -type eq_result = - | Equal - | NotEqual - | Unknown - -// Functions that we specially treat as injective, to make normalization -// (particularly of decidable equality) better. We should make sure they -// are actually proved to be injective. -let injectives = - ["FStar.Int8.int_to_t"; - "FStar.Int16.int_to_t"; - "FStar.Int32.int_to_t"; - "FStar.Int64.int_to_t"; - "FStar.Int128.int_to_t"; - "FStar.UInt8.uint_to_t"; - "FStar.UInt16.uint_to_t"; - "FStar.UInt32.uint_to_t"; - "FStar.UInt64.uint_to_t"; - "FStar.UInt128.uint_to_t"; - "FStar.SizeT.uint_to_t"; - "FStar.Int8.__int_to_t"; - "FStar.Int16.__int_to_t"; - "FStar.Int32.__int_to_t"; - "FStar.Int64.__int_to_t"; - "FStar.Int128.__int_to_t"; - "FStar.UInt8.__uint_to_t"; - "FStar.UInt16.__uint_to_t"; - "FStar.UInt32.__uint_to_t"; - "FStar.UInt64.__uint_to_t"; - "FStar.UInt128.__uint_to_t"; - "FStar.SizeT.__uint_to_t"; - ] - -// Compose two eq_result injectively, as in a pair -let eq_inj r s = - match r, s with - | Equal, Equal -> Equal - | NotEqual, _ - | _, NotEqual -> NotEqual - | _, _ -> Unknown - -// Promote a bool to eq_result, conservatively. -let equal_if = function - | true -> Equal - | _ -> Unknown - -// Promote a bool to an eq_result, taking a false to bet NotEqual. -// This is only useful for fully decidable equalities. -// Use with care, see note about Const_real below and #2806. -let equal_iff = function - | true -> Equal - | _ -> NotEqual - -// Compose two equality results, NOT assuming a NotEqual implies anything. -// This is useful, e.g., for checking the equality of applications. Consider -// f x ~ g y -// if f=g and x=y then we know these two expressions are equal, but cannot say -// anything when either result is NotEqual or Unknown, hence this returns Unknown -// in most cases. -// The second comparison is thunked for efficiency. -let eq_and r s = - if r = Equal && s () = Equal - then Equal - else Unknown - -(* Precondition: terms are well-typed in a common environment, or this can return false positives *) -let rec eq_tm (t1:term) (t2:term) : eq_result = - let t1 = canon_app t1 in - let t2 = canon_app t2 in - let equal_data (f1:fv) (args1:Syntax.args) (f2:fv) (args2:Syntax.args) = - // we got constructors! we know they are injective and disjoint, so we can do some - // good analysis on them - if fv_eq f1 f2 - then ( - assert (List.length args1 = List.length args2); - List.fold_left (fun acc ((a1, q1), (a2, q2)) -> - //if q1 <> q2 - //then failwith (U.format1 "Arguments of %s mismatch on implicit qualifier\n" - // (Ident.string_of_lid f1.fv_name.v)); - //NS: 05/06/2018 ...this does not always hold - // it's been succeeding because the assert is disabled in the non-debug builds - //assert (q1 = q2); - eq_inj acc (eq_tm a1 a2)) Equal <| List.zip args1 args2 - ) else NotEqual - in - let qual_is_inj = function - | Some Data_ctor - | Some (Record_ctor _) -> true - | _ -> false - in - let heads_and_args_in_case_both_data :option (fv * args * fv * args) = - let head1, args1 = t1 |> unmeta |> head_and_args in - let head2, args2 = t2 |> unmeta |> head_and_args in - match (un_uinst head1).n, (un_uinst head2).n with - | Tm_fvar f, Tm_fvar g when qual_is_inj f.fv_qual && - qual_is_inj g.fv_qual -> Some (f, args1, g, args2) - | _ -> None - in - let t1 = unmeta t1 in - let t2 = unmeta t2 in - match t1.n, t2.n with - // We sometimes compare open terms, as we get alpha-equivalence - // for free. - | Tm_bvar bv1, Tm_bvar bv2 -> - equal_if (bv1.index = bv2.index) - - | Tm_lazy _, _ -> eq_tm (unlazy t1) t2 - | _, Tm_lazy _ -> eq_tm t1 (unlazy t2) - - | Tm_name a, Tm_name b -> - equal_if (bv_eq a b) - - | _ when heads_and_args_in_case_both_data |> is_some -> //matches only when both are data constructors - heads_and_args_in_case_both_data |> must |> (fun (f, args1, g, args2) -> - equal_data f args1 g args2 - ) - - | Tm_fvar f, Tm_fvar g -> equal_if (fv_eq f g) - - | Tm_uinst(f, us), Tm_uinst(g, vs) -> - // If the fvars and universe instantiations match, then Equal, - // otherwise Unknown. - eq_and (eq_tm f g) (fun () -> equal_if (eq_univs_list us vs)) - - | Tm_constant (Const_range _), Tm_constant (Const_range _) -> - // Ranges should be opaque, even to the normalizer. c.f. #1312 - Unknown - - | Tm_constant (Const_real r1), Tm_constant (Const_real r2) -> - // We cannot decide equality of reals. Use a conservative approach here. - // If the strings match, they are equal, otherwise we don't know. If this - // goes via the eq_iff case below, it will falsely claim that "1.0R" and - // "01.R" are different, since eq_const does not canonizalize the string - // representations. - equal_if (r1 = r2) - - | Tm_constant c, Tm_constant d -> - // NOTE: this relies on the fact that eq_const *correctly decides* - // semantic equality of constants. This needs some care. For instance, - // since integers are represented by a string, eq_const needs to take care - // of ignoring leading zeroes, and match 0 with -0. An exception to this - // are real number literals (handled above). See #2806. - // - // Currently (24/Jan/23) this seems to be correctly implemented, but - // updates should be done with care. - equal_iff (eq_const c d) - - | Tm_uvar (u1, ([], _)), Tm_uvar (u2, ([], _)) -> - equal_if (Unionfind.equiv u1.ctx_uvar_head u2.ctx_uvar_head) - - | Tm_app {hd=h1; args=args1}, Tm_app {hd=h2; args=args2} -> - begin match (un_uinst h1).n, (un_uinst h2).n with - | Tm_fvar f1, Tm_fvar f2 when fv_eq f1 f2 && List.mem (string_of_lid (lid_of_fv f1)) injectives -> - equal_data f1 args1 f2 args2 - - | _ -> // can only assert they're equal if they syntactically match, nothing else - eq_and (eq_tm h1 h2) (fun () -> eq_args args1 args2) - end - - | Tm_match {scrutinee=t1; brs=bs1}, Tm_match {scrutinee=t2; brs=bs2} -> //AR: note: no return annotations - if List.length bs1 = List.length bs2 - then List.fold_right (fun (b1, b2) a -> eq_and a (fun () -> branch_matches b1 b2)) - (List.zip bs1 bs2) - (eq_tm t1 t2) - else Unknown - - | Tm_type u, Tm_type v -> - equal_if (eq_univs u v) - - | Tm_quoted (t1, q1), Tm_quoted (t2, q2) -> - // NOTE: we do NOT ever provide a meaningful result for quoted terms. Even - // if term_eq (the syntactic equality) returns true, that does not mean we - // can present the equality to userspace since term_eq ignores the names - // of binders, but the view exposes them. Hence, we simply always return - // Unknown. We do not seem to rely anywhere on simplifying equalities of - // quoted literals. See also #2806. - Unknown - - | Tm_refine {b=t1; phi=phi1}, Tm_refine {b=t2; phi=phi2} -> - eq_and (eq_tm t1.sort t2.sort) (fun () -> eq_tm phi1 phi2) - - (* - * AR: ignoring residual comp here, that's an ascription added by the typechecker - * do we care if that's different? - *) - | Tm_abs {bs=bs1; body=body1}, Tm_abs {bs=bs2; body=body2} - when List.length bs1 = List.length bs2 -> - - eq_and (List.fold_left2 (fun r b1 b2 -> eq_and r (fun () -> eq_tm b1.binder_bv.sort b2.binder_bv.sort)) - Equal bs1 bs2) - (fun () -> eq_tm body1 body2) - - | Tm_arrow {bs=bs1; comp=c1}, Tm_arrow {bs=bs2; comp=c2} - when List.length bs1 = List.length bs2 -> - eq_and (List.fold_left2 (fun r b1 b2 -> eq_and r (fun () -> eq_tm b1.binder_bv.sort b2.binder_bv.sort)) - Equal bs1 bs2) - (fun () -> eq_comp c1 c2) - - | _ -> Unknown - -and eq_antiquotations a1 a2 = - // Basically this; - // List.fold_left2 (fun acc t1 t2 -> eq_inj acc (eq_tm t1 t2)) Equal a1 a2 - // but lazy and handling lists of different size - match a1, a2 with - | [], [] -> Equal - | [], _ - | _, [] -> NotEqual - | t1::a1, t2::a2 -> - match eq_tm t1 t2 with - | NotEqual -> NotEqual - | Unknown -> - (match eq_antiquotations a1 a2 with - | NotEqual -> NotEqual - | _ -> Unknown) - | Equal -> eq_antiquotations a1 a2 - -and branch_matches b1 b2 = - let related_by f o1 o2 = - match o1, o2 with - | None, None -> true - | Some x, Some y -> f x y - | _, _ -> false - in - let (p1, w1, t1) = b1 in - let (p2, w2, t2) = b2 in - if eq_pat p1 p2 - then begin - // We check the `when` branches too, even if unsupported for now - if eq_tm t1 t2 = Equal && related_by (fun t1 t2 -> eq_tm t1 t2 = Equal) w1 w2 - then Equal - else Unknown - end - else Unknown - -and eq_args (a1:args) (a2:args) : eq_result = - match a1, a2 with - | [], [] -> Equal - | (a, _)::a1, (b, _)::b1 -> - (match eq_tm a b with - | Equal -> eq_args a1 b1 - | _ -> Unknown) - | _ -> Unknown - -and eq_univs_list (us:universes) (vs:universes) : bool = - List.length us = List.length vs - && List.forall2 eq_univs us vs - -and eq_comp (c1 c2:comp) : eq_result = - match c1.n, c2.n with - | Total t1, Total t2 - | GTotal t1, GTotal t2 -> - eq_tm t1 t2 - | Comp ct1, Comp ct2 -> - eq_and (equal_if (eq_univs_list ct1.comp_univs ct2.comp_univs)) - (fun _ -> - eq_and (equal_if (Ident.lid_equals ct1.effect_name ct2.effect_name)) - (fun _ -> - eq_and (eq_tm ct1.result_typ ct2.result_typ) - (fun _ -> eq_args ct1.effect_args ct2.effect_args))) - //ignoring cflags - | _ -> NotEqual - -(* Only used in term_eq *) -let eq_quoteinfo q1 q2 = - if q1.qkind <> q2.qkind - then NotEqual - else eq_antiquotations (snd q1.antiquotations) (snd q2.antiquotations) - -(* Only used in term_eq *) -let eq_bqual a1 a2 = - match a1, a2 with - | None, None -> Equal - | None, _ - | _, None -> NotEqual - | Some (Implicit b1), Some (Implicit b2) when b1=b2 -> Equal - | Some (Meta t1), Some (Meta t2) -> eq_tm t1 t2 - | Some Equality, Some Equality -> Equal - | _ -> NotEqual - -(* Only used in term_eq *) -let eq_aqual a1 a2 = - match a1, a2 with - | Some a1, Some a2 -> - if a1.aqual_implicit = a2.aqual_implicit - && List.length a1.aqual_attributes = List.length a2.aqual_attributes - then List.fold_left2 - (fun out t1 t2 -> - match out with - | NotEqual -> out - | Unknown -> - (match eq_tm t1 t2 with - | NotEqual -> NotEqual - | _ -> Unknown) - | Equal -> - eq_tm t1 t2) - Equal - a1.aqual_attributes - a2.aqual_attributes - else NotEqual - | None, None -> - Equal - | _ -> - NotEqual - - let rec unrefine t = let t = compress t in match t.n with @@ -1114,11 +808,11 @@ let let_rec_arity (lb:letbinding) : int * option (list bool) = match d with | Decreases_lex l -> l |> List.fold_left (fun s t -> - Set.union s (FStar.Syntax.Free.names t)) (Set.empty ()) + union s (FStar.Syntax.Free.names t)) (empty #bv ()) | Decreases_wf (rel, e) -> - Set.union (FStar.Syntax.Free.names rel) (FStar.Syntax.Free.names e) in + union (Free.names rel) (Free.names e) in Common.tabulate n_univs (fun _ -> false) - @ (bs |> List.map (fun b -> Set.mem b.binder_bv d_bvs))) + @ (bs |> List.map (fun b -> mem b.binder_bv d_bvs))) let abs_formals_maybe_unascribe_body maybe_unascribe t = let subst_lcomp_opt s l = match l with @@ -1265,11 +959,11 @@ let type_u () : typ * universe = let type_with_u (u:universe) : typ = mk (Tm_type u) dummyRange -// works on anything, really -let attr_eq a a' = - match eq_tm a a' with - | Equal -> true - | _ -> false +// // works on anything, really +// let attr_eq a a' = +// match eq_tm a a' with +// | Equal -> true +// | _ -> false let attr_substitute = mk (Tm_fvar (lid_as_fv PC.attr_substitute_lid None)) Range.dummyRange @@ -1283,17 +977,17 @@ let exp_int s : term = mk (Tm_constant (Const_int (s,None))) dummyRange let exp_char c : term = mk (Tm_constant (Const_char c)) dummyRange let exp_string s : term = mk (Tm_constant (Const_string (s, dummyRange))) dummyRange -let fvar_const l = fvar_with_dd l delta_constant None +let fvar_const l = fvar_with_dd l None let tand = fvar_const PC.and_lid let tor = fvar_const PC.or_lid -let timp = fvar_with_dd PC.imp_lid (Delta_constant_at_level 1) None //NS delta: wrong? level 2 -let tiff = fvar_with_dd PC.iff_lid (Delta_constant_at_level 2) None //NS delta: wrong? level 3 +let timp = fvar_with_dd PC.imp_lid None +let tiff = fvar_with_dd PC.iff_lid None let t_bool = fvar_const PC.bool_lid let b2t_v = fvar_const PC.b2t_lid let t_not = fvar_const PC.not_lid // These are `True` and `False`, not the booleans -let t_false = fvar_const PC.false_lid //NS delta: wrong? should be Delta_constant_at_level 2 -let t_true = fvar_const PC.true_lid //NS delta: wrong? should be Delta_constant_at_level 2 +let t_false = fvar_const PC.false_lid +let t_true = fvar_const PC.true_lid let tac_opaque_attr = exp_string "tac_opaque" let dm4f_bind_range_attr = fvar_const PC.dm4f_bind_range_attr let tcdecltime_attr = fvar_const PC.tcdecltime_attr @@ -1314,7 +1008,7 @@ let mk_binop op_t phi1 phi2 = mk (Tm_app {hd=op_t; args=[as_arg phi1; as_arg phi let mk_neg phi = mk (Tm_app {hd=t_not; args=[as_arg phi]}) phi.pos let mk_conj phi1 phi2 = mk_binop tand phi1 phi2 let mk_conj_l phi = match phi with - | [] -> fvar_with_dd PC.true_lid delta_constant None //NS delta: wrong, see a t_true + | [] -> fvar_with_dd PC.true_lid None | hd::tl -> List.fold_right mk_conj tl hd let mk_disj phi1 phi2 = mk_binop tor phi1 phi2 let mk_disj_l phi = match phi with @@ -1359,9 +1053,9 @@ let mk_has_type t x t' = let t_has_type = mk (Tm_uinst(t_has_type, [U_zero; U_zero])) dummyRange in mk (Tm_app {hd=t_has_type; args=[iarg t; as_arg x; as_arg t']}) dummyRange -let tforall = fvar_with_dd PC.forall_lid (Delta_constant_at_level 1) None //NS delta: wrong level 2 -let texists = fvar_with_dd PC.exists_lid (Delta_constant_at_level 1) None //NS delta: wrong level 2 -let t_haseq = fvar_with_dd PC.haseq_lid delta_constant None //NS delta: wrong Delta_abstract (Delta_constant_at_level 0)? +let tforall = fvar_with_dd PC.forall_lid None +let texists = fvar_with_dd PC.exists_lid None +let t_haseq = fvar_with_dd PC.haseq_lid None let decidable_eq = fvar_const PC.op_Eq let mk_decidable_eq t e1 e2 = @@ -1435,11 +1129,11 @@ let if_then_else b t1 t2 = // Operations on squashed and other irrelevant/sub-singleton types ////////////////////////////////////////////////////////////////////////////////////// let mk_squash u p = - let sq = fvar_with_dd PC.squash_lid (Delta_constant_at_level 1) None in //NS delta: ok + let sq = fvar_with_dd PC.squash_lid None in mk_app (mk_Tm_uinst sq [u]) [as_arg p] let mk_auto_squash u p = - let sq = fvar_with_dd PC.auto_squash_lid (Delta_constant_at_level 2) None in //NS delta: ok + let sq = fvar_with_dd PC.auto_squash_lid None in mk_app (mk_Tm_uinst sq [u]) [as_arg p] let un_squash t = @@ -1459,7 +1153,7 @@ let un_squash t = | _ -> failwith "impossible" in // A bit paranoid, but need this check for terms like `u:unit{u == ()}` - if Set.mem b.binder_bv (Free.names p) + if mem b.binder_bv (Free.names p) then None else Some p | _ -> None @@ -1531,12 +1225,12 @@ let arrow_one (t:typ) : option (binder * comp) = Some (b, c)) let is_free_in (bv:bv) (t:term) : bool = - Set.mem bv (FStar.Syntax.Free.names t) + mem bv (FStar.Syntax.Free.names t) let action_as_lb eff_lid a pos = let lb = close_univs_and_mk_letbinding None - (Inr (lid_and_dd_as_fv a.action_name delta_equational None)) + (Inr (lid_and_dd_as_fv a.action_name None)) a.action_univs (arrow a.action_params (mk_Total a.action_typ)) PC.effect_Tot_lid @@ -1565,40 +1259,12 @@ let mk_reflect t = (* Some utilities for clients who wish to build top-level bindings and keep * their delta-qualifiers correct (e.g. dmff). *) -let rec delta_qualifier t = - let t = Subst.compress t in - match t.n with - | Tm_delayed _ -> failwith "Impossible" - | Tm_lazy i -> delta_qualifier (unfold_lazy i) - | Tm_fvar fv -> (match fv.fv_delta with - | Some d -> d - | None -> delta_constant) - | Tm_bvar _ - | Tm_name _ - | Tm_match _ - | Tm_uvar _ - | Tm_unknown -> delta_equational - | Tm_type _ - | Tm_quoted _ - | Tm_constant _ - | Tm_arrow _ -> delta_constant - | Tm_uinst(t, _) - | Tm_refine {b={sort=t}} - | Tm_meta {tm=t} - | Tm_ascribed {tm=t} - | Tm_app {hd=t} - | Tm_abs {body=t} - | Tm_let {body=t} -> delta_qualifier t - let rec incr_delta_depth d = match d with | Delta_constant_at_level i -> Delta_constant_at_level (i + 1) | Delta_equational_at_level i -> Delta_equational_at_level (i + 1) | Delta_abstract d -> incr_delta_depth d -let incr_delta_qualifier t = - incr_delta_depth (delta_qualifier t) - let is_unknown t = match (Subst.compress t).n with | Tm_unknown -> true | _ -> false let rec apply_last f l = match l with @@ -1718,7 +1384,7 @@ let rec term_eq_dbg (dbg : bool) t1 t2 = check "uvar" (u1.ctx_uvar_head = u2.ctx_uvar_head) | Tm_quoted (qt1, qi1), Tm_quoted (qt2, qi2) -> - (check "tm_quoted qi" (eq_quoteinfo qi1 qi2 = Equal)) && + (check "tm_quoted qi" (quote_info_eq_dbg dbg qi1 qi2)) && (check "tm_quoted payload" (term_eq_dbg dbg qt1 qt2)) | Tm_meta {tm=t1; meta=m1}, Tm_meta {tm=t2; meta=m2} -> @@ -1768,11 +1434,11 @@ let rec term_eq_dbg (dbg : bool) t1 t2 = and arg_eq_dbg (dbg : bool) a1 a2 = eqprod (fun t1 t2 -> check dbg "arg tm" (term_eq_dbg dbg t1 t2)) - (fun q1 q2 -> check dbg "arg qual" (eq_aqual q1 q2 = Equal)) + (fun q1 q2 -> check dbg "arg qual" (aqual_eq_dbg dbg q1 q2)) a1 a2 and binder_eq_dbg (dbg : bool) b1 b2 = (check dbg "binder_sort" (term_eq_dbg dbg b1.binder_bv.sort b2.binder_bv.sort)) && - (check dbg "binder qual" (eq_bqual b1.binder_qual b2.binder_qual = Equal)) && //AR: not checking attributes, should we? + (check dbg "binder qual" (bqual_eq_dbg dbg b1.binder_qual b2.binder_qual)) && //AR: not checking attributes, should we? (check dbg "binder attrs" (eqlist (term_eq_dbg dbg) b1.binder_attrs b2.binder_attrs)) and comp_eq_dbg (dbg : bool) c1 c2 = @@ -1800,6 +1466,56 @@ and letbinding_eq_dbg (dbg : bool) (lb1 : letbinding) lb2 = (check dbg "lb def" (term_eq_dbg dbg lb1.lbdef lb2.lbdef)) // Ignoring eff and attrs.. +and quote_info_eq_dbg (dbg:bool) q1 q2 = + if q1.qkind <> q2.qkind + then false + else antiquotations_eq_dbg dbg (snd q1.antiquotations) (snd q2.antiquotations) + +and antiquotations_eq_dbg (dbg:bool) a1 a2 = + // Basically this; + // List.fold_left2 (fun acc t1 t2 -> eq_inj acc (eq_tm t1 t2)) Equal a1 a2 + // but lazy and handling lists of different size + match a1, a2 with + | [], [] -> true + | [], _ + | _, [] -> false + | t1::a1, t2::a2 -> + if not <| term_eq_dbg dbg t1 t2 + then false + else antiquotations_eq_dbg dbg a1 a2 + +and bqual_eq_dbg dbg a1 a2 = + match a1, a2 with + | None, None -> true + | None, _ + | _, None -> false + | Some (Implicit b1), Some (Implicit b2) when b1=b2 -> true + | Some (Meta t1), Some (Meta t2) -> term_eq_dbg dbg t1 t2 + | Some Equality, Some Equality -> true + | _ -> false + +and aqual_eq_dbg dbg a1 a2 = + match a1, a2 with + | Some a1, Some a2 -> + if a1.aqual_implicit = a2.aqual_implicit + && List.length a1.aqual_attributes = List.length a2.aqual_attributes + then List.fold_left2 + (fun out t1 t2 -> + if not out + then false + else term_eq_dbg dbg t1 t2) + true + a1.aqual_attributes + a2.aqual_attributes + else false + | None, None -> + true + | _ -> + false + +let eq_aqual a1 a2 = aqual_eq_dbg false a1 a2 +let eq_bqual b1 b2 = bqual_eq_dbg false b1 b2 + let term_eq t1 t2 = let r = term_eq_dbg !debug_term_eq t1 t2 in debug_term_eq := false; @@ -2391,7 +2107,7 @@ let is_binder_unused (b:binder) = b.binder_positivity = Some BinderUnused let deduplicate_terms (l:list term) = - FStar.Compiler.List.deduplicate (fun x y -> eq_tm x y = Equal) l + FStar.Compiler.List.deduplicate (fun x y -> term_eq x y) l let eq_binding b1 b2 = match b1, b2 with diff --git a/src/syntax/FStar.Syntax.VisitM.fst b/src/syntax/FStar.Syntax.VisitM.fst index 8af505aba0a..e55a731b2a9 100644 --- a/src/syntax/FStar.Syntax.VisitM.fst +++ b/src/syntax/FStar.Syntax.VisitM.fst @@ -377,18 +377,18 @@ let on_sub_action #m {|d : lvm m |} (a : action) : m action = let rec on_sub_sigelt' #m {|d : lvm m |} (se : sigelt') : m sigelt' = match se with - | Sig_inductive_typ {lid; us; params; num_uniform_params; t; mutuals; ds} -> + | Sig_inductive_typ {lid; us; params; num_uniform_params; t; mutuals; ds; injective_type_params } -> let! params = params |> mapM f_binder in let! t = t |> f_term in - return <| Sig_inductive_typ {lid; us; params; num_uniform_params; t; mutuals; ds} + return <| Sig_inductive_typ {lid; us; params; num_uniform_params; t; mutuals; ds; injective_type_params } | Sig_bundle {ses; lids} -> let! ses = ses |> mapM on_sub_sigelt in return <| Sig_bundle {ses; lids} - | Sig_datacon {lid; us; t; ty_lid; num_ty_params; mutuals} -> + | Sig_datacon {lid; us; t; ty_lid; num_ty_params; mutuals; injective_type_params } -> let! t = t |> f_term in - return <| Sig_datacon {lid; us; t; ty_lid; num_ty_params; mutuals} + return <| Sig_datacon {lid; us; t; ty_lid; num_ty_params; mutuals; injective_type_params } | Sig_declare_typ {lid; us; t} -> let! t = t |> f_term in diff --git a/src/tactics/FStar.Tactics.Hooks.fst b/src/tactics/FStar.Tactics.Hooks.fst index c11516170fa..249b81cf5a3 100644 --- a/src/tactics/FStar.Tactics.Hooks.fst +++ b/src/tactics/FStar.Tactics.Hooks.fst @@ -44,11 +44,15 @@ module Env = FStar.TypeChecker.Env module TcUtil = FStar.TypeChecker.Util module TcRel = FStar.TypeChecker.Rel module TcTerm = FStar.TypeChecker.TcTerm +module TEQ = FStar.TypeChecker.TermEqAndSimplify (* We only use the _abstract_ embeddings from this module, hence there is no v1/v2 distinction. *) module RE = FStar.Reflection.V2.Embeddings +let dbg_Tac = Debug.get_toggle "Tac" +let dbg_SpinoffAll = Debug.get_toggle "SpinoffAll" + let run_tactic_on_typ (rng_tac : Range.range) (rng_goal : Range.range) (tactic:term) (env:Env.env) (typ:term) @@ -138,13 +142,17 @@ let by_tactic_interp (pol:pol) (e:Env.env) (t:term) : tres = begin match pol with | StrictlyPositive | Pos -> - Simplified (FStar.Syntax.Util.t_true, [fst <| goal_of_goal_ty e assertion]) + let g = fst <| goal_of_goal_ty e assertion in + let g = set_label "spun-off assertion" g in + Simplified (FStar.Syntax.Util.t_true, [g]) | Both -> - Dual (assertion, FStar.Syntax.Util.t_true, [fst <| goal_of_goal_ty e assertion]) + let g = fst <| goal_of_goal_ty e assertion in + let g = set_label "spun-off assertion" g in + Dual (assertion, FStar.Syntax.Util.t_true, [g]) | Neg -> - Simplified (assertion, []) + Simplified (assertion, []) end // rewrite_with_tactic marker @@ -300,8 +308,7 @@ let preprocess (env:Env.env) (goal:term) (* bool=true iff any tactic actually ran *) = Errors.with_ctx "While preprocessing VC with a tactic" (fun () -> - tacdbg := Env.debug env (O.Other "Tac"); - if !tacdbg then + if !dbg_Tac then BU.print2 "About to preprocess %s |= %s\n" (Env.all_binders env |> Print.binders_to_string ",") (show goal); @@ -313,7 +320,7 @@ let preprocess (env:Env.env) (goal:term) | Simplified (t', gs) -> true, (t', gs) | _ -> failwith "preprocess: impossible, traverse returned a Dual" in - if !tacdbg then + if !dbg_Tac then BU.print2 "Main goal simplified to: %s |- %s\n" (Env.all_binders env |> Print.binders_to_string ", ") (show t'); @@ -325,11 +332,15 @@ let preprocess (env:Env.env) (goal:term) (BU.format1 "Tactic returned proof-relevant goal: %s" (show (goal_type g)))) env.range | Some phi -> phi in - if !tacdbg then + if !dbg_Tac then BU.print2 "Got goal #%s: %s\n" (show n) (show (goal_type g)); let label = - "Could not prove goal #" ^ show n ^ - (if get_label g = "" then "" else " (" ^ get_label g ^ ")") + let open FStar.Pprint in + let open FStar.Class.PP in + [ + doc_of_string "Could not prove goal #" ^^ pp n ^/^ + (if get_label g = "" then empty else parens (doc_of_string <| get_label g)) + ] in let gt' = TcUtil.label label (goal_range g) phi in (n+1, (goal_env g, gt', goal_opts g)::gs)) s gs in @@ -341,20 +352,19 @@ let preprocess (env:Env.env) (goal:term) let rec traverse_for_spinoff (pol:pol) - (label_ctx:option (string & Range.range)) + (label_ctx:option (list Pprint.document & Range.range)) (e:Env.env) (t:term) : tres = - let debug_any = Options.debug_any () in - let debug = Env.debug e (O.Other "SpinoffAll") in + let debug_any = Debug.any () in let traverse pol e t = traverse_for_spinoff pol label_ctx e t in - let traverse_ctx pol ctx e t = + let traverse_ctx pol (ctx : list Pprint.document & Range.range) (e:Env.env) (t:term) : tres = let print_lc (msg, rng) = BU.format3 "(%s,%s) : %s" (Range.string_of_def_range rng) (Range.string_of_use_range rng) - msg + (Errors.Msg.rendermsg msg) in - if debug + if !dbg_SpinoffAll then BU.print2 "Changing label context from %s to %s" (match label_ctx with | None -> "None" @@ -385,7 +395,7 @@ let rec traverse_for_spinoff res in let maybe_spinoff pol - (label_ctx:option (string & Range.range)) + (label_ctx:option (list Pprint.document & Range.range)) (e:Env.env) (t:term) : tres = @@ -406,7 +416,7 @@ let rec traverse_for_spinoff let spinoff t = match pol with | StrictlyPositive -> - if debug then BU.print1 "Spinning off %s\n" (show t); + if !dbg_SpinoffAll then BU.print1 "Spinning off %s\n" (show t); Simplified (FStar.Syntax.Util.t_true, [label_goal (e,t)]) | _ -> @@ -576,10 +586,10 @@ let rec traverse_for_spinoff | Tm_fvar fv, [(t, _)] when simplified && S.fv_eq_lid fv PC.squash_lid && - U.eq_tm t U.t_true = U.Equal -> + TEQ.eq_tm e t U.t_true = TEQ.Equal -> //simplify squash True to True //important for simplifying queries to Trivial - if debug then BU.print_string "Simplified squash True to True"; + if !dbg_SpinoffAll then BU.print_string "Simplified squash True to True"; U.t_true.n | _ -> @@ -625,8 +635,7 @@ let pol_to_string = function let spinoff_strictly_positive_goals (env:Env.env) (goal:term) : list (Env.env * term) - = let debug = Env.debug env (O.Other "SpinoffAll") in - if debug then BU.print1 "spinoff_all called with %s\n" (show goal); + = if !dbg_SpinoffAll then BU.print1 "spinoff_all called with %s\n" (show goal); Errors.with_ctx "While spinning off all goals" (fun () -> let initial = (1, []) in // This match should never fail @@ -644,7 +653,7 @@ let spinoff_strictly_positive_goals (env:Env.env) (goal:term) match t with | Trivial -> [] | NonTrivial t -> - if debug + if !dbg_SpinoffAll then ( let msg = BU.format2 "Main goal simplified to: %s |- %s\n" (Env.all_binders env |> Print.binders_to_string ", ") @@ -678,7 +687,7 @@ let spinoff_strictly_positive_goals (env:Env.env) (goal:term) match FStar.TypeChecker.Common.check_trivial t with | Trivial -> None | NonTrivial t -> - if debug + if !dbg_SpinoffAll then BU.print1 "Got goal: %s\n" (show t); Some (env, t)) in @@ -696,7 +705,6 @@ let synthesize (env:Env.env) (typ:typ) (tau:term) : term = if env.nosynth then mk_Tm_app (TcUtil.fvar_env env PC.magic_lid) [S.as_arg U.exp_unit] typ.pos else begin - tacdbg := Env.debug env (O.Other "Tac"); let gs, w = run_tactic_on_typ tau.pos typ.pos tau env typ in // Check that all goals left are irrelevant and provable @@ -706,7 +714,7 @@ let synthesize (env:Env.env) (typ:typ) (tau:term) : term = match getprop (goal_env g) (goal_type g) with | Some vc -> begin - if !tacdbg then + if !dbg_Tac then BU.print1 "Synthesis left a goal: %s\n" (show vc); let guard = { guard_f = NonTrivial vc ; deferred_to_tac = [] @@ -725,7 +733,6 @@ let solve_implicits (env:Env.env) (tau:term) (imps:Env.implicits) : unit = Errors.with_ctx "While solving implicits with a tactic" (fun () -> if env.nosynth then () else begin - tacdbg := Env.debug env (O.Other "Tac"); let gs = run_tactic_on_all_implicits tau.pos (Env.get_range env) tau env imps in // Check that all goals left are irrelevant and provable @@ -741,7 +748,7 @@ let solve_implicits (env:Env.env) (tau:term) (imps:Env.implicits) : unit = match getprop (goal_env g) (goal_type g) with | Some vc -> begin - if !tacdbg then + if !dbg_Tac then BU.print1 "Synthesis left a goal: %s\n" (show vc); if not (Options.admit_smt_queries()) then ( @@ -787,17 +794,11 @@ let handle_smt_goal env goal = | Sig_let {lids=[lid]} -> let qn = Env.lookup_qname env lid in let fv = S.lid_as_fv lid None in - let dd = - match Env.delta_depth_of_qninfo fv qn with - | Some dd -> dd - | None -> failwith "Expected a dd" - in S.fv_to_tm (S.lid_as_fv lid None) | _ -> failwith "Resolve_tac not found" in let gs = Errors.with_ctx "While handling an SMT goal with a tactic" (fun () -> - tacdbg := Env.debug env (O.Other "Tac"); (* Executing the tactic on the goal. *) let gs, _ = run_tactic_on_typ tau.pos (Env.get_range env) tau env (U.mk_squash U_zero goal) in @@ -805,7 +806,7 @@ let handle_smt_goal env goal = gs |> List.map (fun g -> match getprop (goal_env g) (goal_type g) with | Some vc -> - if !tacdbg then + if !dbg_Tac then BU.print1 "handle_smt_goals left a goal: %s\n" (show vc); (goal_env g), vc | None -> @@ -818,10 +819,25 @@ let handle_smt_goal env goal = (* No such tactic was available in the current context *) | None -> [env, goal] -let splice (env:Env.env) (is_typed:bool) (lids:list Ident.lident) (tau:term) (rng:Range.range) : list sigelt = +// TODO: this is somehow needed for tcresolve to infer the embeddings in run_tactic_on_ps below +instance _ = RE.e_term + +type blob_t = option (string & term) +type dsl_typed_sigelt_t = bool & sigelt & blob_t +type dsl_tac_result_t = + list dsl_typed_sigelt_t & + dsl_typed_sigelt_t & + list dsl_typed_sigelt_t + +let splice + (env:Env.env) + (is_typed:bool) + (lids:list Ident.lident) + (tau:term) + (rng:Range.range) : list sigelt = + Errors.with_ctx "While running splice with a tactic" (fun () -> if env.nosynth then [] else begin - tacdbg := Env.debug env (O.Other "Tac"); let tau, _, g = if is_typed @@ -836,27 +852,65 @@ let splice (env:Env.env) (is_typed:bool) (lids:list Ident.lident) (tau:term) (rn let gs, sigelts = if is_typed then begin - let e_blob = e_option (e_tuple2 e_string RE.e_term) in - let gs, sig_blobs = run_tactic_on_ps tau.pos tau.pos false - RE.e_env - {env with gamma=[]} - (e_list (e_tuple3 e_bool RE.e_sigelt e_blob)) - tau - tactic_already_typed - ps - in - let sigelts = sig_blobs |> map (fun (checked, se, blob_opt) -> - { se with - sigmeta = { se.sigmeta with - sigmeta_extension_data = - (match blob_opt with - | Some (s, blob) -> [s, Dyn.mkdyn blob] - | None -> []); - sigmeta_already_checked = checked; } - } - ) - in - gs, sigelts + // + // See if there is a val for the lid + // + if List.length lids > 1 + then Err.raise_error + (Errors.Error_BadSplice, + BU.format1 "Typed splice: unexpected lids length (> 1) (%s)" (show lids)) + rng + else begin + let val_t : option typ = // val type, if any, for the lid + // + // For spliced vals, their lids is set to [] + // (see ToSyntax.fst:desugar_decl, splice case) + // + if List.length lids = 0 + then None + else + match Env.try_lookup_val_decl env (List.hd lids) with + | None -> None + | Some ((uvs, tval), _) -> + // + // No universe polymorphic typed splice yet + // + if List.length uvs <> 0 + then + Err.raise_error + (Errors.Error_BadSplice, + BU.format1 "Typed splice: val declaration for %s is universe polymorphic in %s universes, expected 0" + (string_of_int (List.length uvs))) + rng + else Some tval in + + // + // The arguments to run_tactic_on_ps here are in sync with ulib/FStar.Tactics.dsl_tac_t + // + let (gs, (sig_blobs_before, sig_blob, sig_blobs_after)) + : list goal & dsl_tac_result_t = + run_tactic_on_ps tau.pos tau.pos false + FStar.Tactics.Typeclasses.solve + ({env with gamma=[]}, val_t) + FStar.Tactics.Typeclasses.solve + tau + tactic_already_typed + ps + in + let sig_blobs = sig_blobs_before@(sig_blob::sig_blobs_after) in + let sigelts = sig_blobs |> map (fun (checked, se, blob_opt) -> + { se with + sigmeta = { se.sigmeta with + sigmeta_extension_data = + (match blob_opt with + | Some (s, blob) -> [s, Dyn.mkdyn blob] + | None -> []); + sigmeta_already_checked = checked; } + } + ) + in + gs, sigelts + end end else run_tactic_on_ps tau.pos tau.pos false e_unit () @@ -867,8 +921,7 @@ let splice (env:Env.env) (is_typed:bool) (lids:list Ident.lident) (tau:term) (rn let sigelts = let set_lb_dd lb = let {lbname=Inr fv; lbdef} = lb in - {lb with lbname=Inr {fv with fv_delta=U.incr_delta_qualifier lbdef - |> Some}} in + {lb with lbname=Inr fv} in List.map (fun se -> match se.sigel with | Sig_let {lbs=(is_rec, lbs); lids} -> @@ -884,7 +937,7 @@ let splice (env:Env.env) (is_typed:bool) (lids:list Ident.lident) (tau:term) (rn match getprop (goal_env g) (goal_type g) with | Some vc -> begin - if !tacdbg then + if !dbg_Tac then BU.print1 "Splice left a goal: %s\n" (show vc); let guard = { guard_f = NonTrivial vc ; deferred_to_tac = [] @@ -909,7 +962,7 @@ let splice (env:Env.env) (is_typed:bool) (lids:list Ident.lident) (tau:term) (rn | _ -> () ) lids; - if !tacdbg then + if !dbg_Tac then BU.print1 "splice: got decls = {\n\n%s\n\n}\n" (show sigelts); (* Check for bare Sig_datacon and Sig_inductive_typ, and abort if so. Also set range. *) @@ -945,7 +998,6 @@ let splice (env:Env.env) (is_typed:bool) (lids:list Ident.lident) (tau:term) (rn let mpreprocess (env:Env.env) (tau:term) (tm:term) : term = Errors.with_ctx "While preprocessing a definition with a tactic" (fun () -> if env.nosynth then tm else begin - tacdbg := Env.debug env (O.Other "Tac"); let ps = FStar.Tactics.V2.Basic.proofstate_of_goals tm.pos env [] [] in let tactic_already_typed = false in let gs, tm = run_tactic_on_ps tau.pos tm.pos false RE.e_term tm RE.e_term tau tactic_already_typed ps in @@ -956,7 +1008,6 @@ let mpreprocess (env:Env.env) (tau:term) (tm:term) : term = let postprocess (env:Env.env) (tau:term) (typ:term) (tm:term) : term = Errors.with_ctx "While postprocessing a definition with a tactic" (fun () -> if env.nosynth then tm else begin - tacdbg := Env.debug env (O.Other "Tac"); //we know that tm:typ //and we have a goal that u == tm //so if we solve that equality, we don't need to retype the solution of `u : typ` @@ -971,7 +1022,7 @@ let postprocess (env:Env.env) (tau:term) (typ:term) (tm:term) : term = match getprop (goal_env g) (goal_type g) with | Some vc -> begin - if !tacdbg then + if !dbg_Tac then BU.print1 "Postprocessing left a goal: %s\n" (show vc); let guard = { guard_f = NonTrivial vc ; deferred_to_tac = [] diff --git a/src/tactics/FStar.Tactics.InterpFuns.fst b/src/tactics/FStar.Tactics.InterpFuns.fst index 84a64884c12..3bedc1a9ed5 100644 --- a/src/tactics/FStar.Tactics.InterpFuns.fst +++ b/src/tactics/FStar.Tactics.InterpFuns.fst @@ -103,6 +103,13 @@ let mk_tac_step_4 univ_arity nm f nbe_f : PO.primitive_step = (fun a b c d ps -> Some (run_wrap nm (f a b c d) ps)) (fun a b c d ps -> Some (run_wrap nm (nbe_f a b c d) ps)) +let mk_tac_step_5 univ_arity nm f nbe_f : PO.primitive_step = + let lid = builtin_lid nm in + set_auto_reflect 5 <| + PO.mk6' univ_arity lid + (fun a b c d e ps -> Some (run_wrap nm (f a b c d e) ps)) + (fun a b c d e ps -> Some (run_wrap nm (nbe_f a b c d e) ps)) + let max_tac_arity = 20 (* NOTE: THE REST OF THIS MODULE IS AUTOGENERATED diff --git a/src/tactics/FStar.Tactics.InterpFuns.fsti b/src/tactics/FStar.Tactics.InterpFuns.fsti index f22c51f0203..a1d40c37d64 100644 --- a/src/tactics/FStar.Tactics.InterpFuns.fsti +++ b/src/tactics/FStar.Tactics.InterpFuns.fsti @@ -127,3 +127,22 @@ val mk_tac_step_4 : ('t1 -> 't2 -> 't3 -> 't4 -> tac 'res) -> ('nt1 -> 'nt2 -> 'nt3 -> 'nt4 -> tac 'nres) -> PO.primitive_step + +val mk_tac_step_5 : + univ_arity:int -> + string -> + {| embedding 't1 |} -> + {| embedding 't2 |} -> + {| embedding 't3 |} -> + {| embedding 't4 |} -> + {| embedding 't5 |} -> + {| embedding 'res |} -> + {| NBET.embedding 'nt1 |} -> + {| NBET.embedding 'nt2 |} -> + {| NBET.embedding 'nt3 |} -> + {| NBET.embedding 'nt4 |} -> + {| NBET.embedding 'nt5 |} -> + {| NBET.embedding 'nres |} -> + ('t1 -> 't2 -> 't3 -> 't4 -> 't5 -> tac 'res) -> + ('nt1 -> 'nt2 -> 'nt3 -> 'nt4 -> 'nt5 -> tac 'nres) -> + PO.primitive_step diff --git a/src/tactics/FStar.Tactics.Interpreter.fst b/src/tactics/FStar.Tactics.Interpreter.fst index 951ec71af94..6db239b1f85 100644 --- a/src/tactics/FStar.Tactics.Interpreter.fst +++ b/src/tactics/FStar.Tactics.Interpreter.fst @@ -60,8 +60,9 @@ module TcRel = FStar.TypeChecker.Rel module TcTerm = FStar.TypeChecker.TcTerm module U = FStar.Syntax.Util +let dbg_Tac = Debug.get_toggle "Tac" + let solve (#a:Type) {| ev : a |} : Tot a = ev -let tacdbg = BU.mk_ref false let embed {|embedding 'a|} r (x:'a) norm_cb = embed x r None norm_cb let unembed {|embedding 'a|} a norm_cb : option 'a = unembed a norm_cb @@ -300,7 +301,7 @@ let run_unembedded_tactic_on_ps let ps = { ps with main_context = { ps.main_context with intactics = true } } in let ps = { ps with main_context = { ps.main_context with range = rng_goal } } in let env = ps.main_context in - (* if !tacdbg then *) + (* if !dbg_Tac then *) (* BU.print1 "Running tactic with goal = (%s) {\n" (show typ); *) let res = Profiling.profile @@ -308,15 +309,15 @@ let run_unembedded_tactic_on_ps (Some (Ident.string_of_lid (Env.current_module ps.main_context))) "FStar.Tactics.Interpreter.run_safe" in - if !tacdbg then + if !dbg_Tac then BU.print_string "}\n"; match res with | Success (ret, ps) -> - if !tacdbg then + if !dbg_Tac then do_dump_proofstate ps "at the finish line"; - (* if !tacdbg || Options.tactics_info () then *) + (* if !dbg_Tac || Options.tactics_info () then *) (* BU.print1 "Tactic generated proofterm %s\n" (show w); *) let remaining_smt_goals = ps.goals@ps.smt_goals in List.iter @@ -324,7 +325,7 @@ let run_unembedded_tactic_on_ps mark_goal_implicit_already_checked g;//all of these will be fed to SMT anyway if is_irrelevant g then ( - if !tacdbg then BU.print1 "Assigning irrelevant goal %s\n" (show (goal_witness g)); + if !dbg_Tac then BU.print1 "Assigning irrelevant goal %s\n" (show (goal_witness g)); if TcRel.teq_nosmt_force (goal_env g) (goal_witness g) U.exp_unit then () else failwith (BU.format1 "Irrelevant tactic witness does not unify with (): %s" @@ -334,19 +335,19 @@ let run_unembedded_tactic_on_ps // Check that all implicits were instantiated Errors.with_ctx "While checking implicits left by a tactic" (fun () -> - if !tacdbg then + if !dbg_Tac then BU.print1 "About to check tactic implicits: %s\n" (FStar.Common.string_of_list (fun imp -> show imp.imp_uvar) ps.all_implicits); let g = {Env.trivial_guard with TcComm.implicits=ps.all_implicits} in let g = TcRel.solve_deferred_constraints env g in - if !tacdbg then + if !dbg_Tac then BU.print2 "Checked %s implicits (1): %s\n" (show (List.length ps.all_implicits)) (show ps.all_implicits); let tagged_implicits = TcRel.resolve_implicits_tac env g in - if !tacdbg then + if !dbg_Tac then BU.print2 "Checked %s implicits (2): %s\n" (show (List.length ps.all_implicits)) (show ps.all_implicits); @@ -366,7 +367,8 @@ let run_unembedded_tactic_on_ps (* Any other error, including exceptions being raised by the metaprograms. *) | Failed (e, ps) -> - do_dump_proofstate ps "at the time of failure"; + if ps.dump_on_failure then + do_dump_proofstate ps "at the time of failure"; let open FStar.Pprint in let texn_to_doc e = match e with @@ -386,7 +388,7 @@ let run_unembedded_tactic_on_ps in let open FStar.Pprint in Err.raise_error_doc (Err.Fatal_UserTacticFailure, ( - [doc_of_string "Tactic failed"] + (if ps.dump_on_failure then [doc_of_string "Tactic failed"] else []) @ texn_to_doc e) ) rng @@ -405,7 +407,7 @@ let run_tactic_on_ps' * 'b // return value = let env = ps.main_context in - if !tacdbg then + if !dbg_Tac then BU.print2 "Typechecking tactic: (%s) (already_typed: %s) {\n" (show tactic) (show tactic_already_typed); @@ -420,7 +422,7 @@ let run_tactic_on_ps' g in - if !tacdbg then + if !dbg_Tac then BU.print_string "}\n"; TcRel.force_trivial_guard env g; diff --git a/src/tactics/FStar.Tactics.Interpreter.fsti b/src/tactics/FStar.Tactics.Interpreter.fsti index 7be4c054309..e24ebb9f649 100644 --- a/src/tactics/FStar.Tactics.Interpreter.fsti +++ b/src/tactics/FStar.Tactics.Interpreter.fsti @@ -52,9 +52,6 @@ val report_implicits : range -> FStar.TypeChecker.Rel.tagged_implicits -> unit (* Called by Main *) val register_tactic_primitive_step : FStar.TypeChecker.Primops.primitive_step -> unit -(* For debugging only *) -val tacdbg : ref bool - open FStar.Tactics.Monad module NBET = FStar.TypeChecker.NBETerm val e_tactic_thunk (er : embedding 'r) : embedding (tac 'r) diff --git a/src/tactics/FStar.Tactics.Monad.fst b/src/tactics/FStar.Tactics.Monad.fst index 0243d28e258..95705ad02b3 100644 --- a/src/tactics/FStar.Tactics.Monad.fst +++ b/src/tactics/FStar.Tactics.Monad.fst @@ -28,9 +28,11 @@ open FStar.Tactics.Types open FStar.Tactics.Result open FStar.Tactics.Printing open FStar.Tactics.Common -open FStar.Class.Show open FStar.Errors.Msg +open FStar.Class.Show +open FStar.Class.Setlike + module O = FStar.Options module BU = FStar.Compiler.Util module Err = FStar.Errors @@ -43,6 +45,11 @@ module Env = FStar.TypeChecker.Env module Rel = FStar.TypeChecker.Rel module Core = FStar.TypeChecker.Core +let dbg_Core = Debug.get_toggle "Core" +let dbg_CoreEq = Debug.get_toggle "CoreEq" +let dbg_RegisterGoal = Debug.get_toggle "RegisterGoal" +let dbg_TacFail = Debug.get_toggle "TacFail" + let goal_ctr = BU.mk_ref 0 let get_goal_ctr () = !goal_ctr let incr_goal_ctr () = let v = !goal_ctr in goal_ctr := v + 1; v @@ -53,7 +60,7 @@ let is_goal_safe_as_well_typed (g:goal) = List.for_all (fun uv -> match UF.find uv.ctx_uvar_head with - | Some t -> Set.is_empty (FStar.Syntax.Free.uvars t) + | Some t -> is_empty (FStar.Syntax.Free.uvars t) | _ -> false) (U.ctx_uvar_typedness_deps uv) in @@ -67,21 +74,19 @@ let register_goal (g:goal) = let i = Core.incr_goal_ctr () in if Allow_untyped? (U.ctx_uvar_should_check g.goal_ctx_uvar) then () else let env = {env with gamma = uv.ctx_uvar_gamma } in - if Env.debug env <| Options.Other "CoreEq" + if !dbg_CoreEq then BU.print1 "(%s) Registering goal\n" (show i); let should_register = is_goal_safe_as_well_typed g in if not should_register then ( - if Env.debug env <| Options.Other "Core" - || Env.debug env <| Options.Other "RegisterGoal" + if !dbg_Core || !dbg_RegisterGoal then BU.print1 "(%s) Not registering goal since it has unresolved uvar deps\n" (show i); () ) else ( - if Env.debug env <| Options.Other "Core" - || Env.debug env <| Options.Other "RegisterGoal" + if !dbg_Core || !dbg_RegisterGoal then BU.print2 "(%s) Registering goal for %s\n" (show i) (show uv); @@ -151,7 +156,7 @@ let log ps (f : unit -> unit) : unit = let fail_doc (msg:error_message) = mk_tac (fun ps -> - if Env.debug ps.main_context (Options.Other "TacFail") then + if !dbg_TacFail then do_dump_proofstate ps ("TACTIC FAILING: " ^ renderdoc (hd msg)); Failed (TacticFailure msg, ps) ) diff --git a/src/tactics/FStar.Tactics.Printing.fst b/src/tactics/FStar.Tactics.Printing.fst index 92790499d68..3a0c4933b3d 100644 --- a/src/tactics/FStar.Tactics.Printing.fst +++ b/src/tactics/FStar.Tactics.Printing.fst @@ -38,6 +38,8 @@ module U = FStar.Syntax.Util module Cfg = FStar.TypeChecker.Cfg module PO = FStar.TypeChecker.Primops +let dbg_Imp = Debug.get_toggle "Imp" + let term_to_string (e:Env.env) (t:term) : string = Print.term_to_string' e.dsenv t @@ -136,7 +138,7 @@ let ps_to_string (msg, ps) = (if ps.entry_range <> Range.dummyRange then BU.format1 "Location: %s\n" (Range.string_of_def_range ps.entry_range) else ""); - (if Env.debug ps.main_context (Options.Other "Imp") + (if !dbg_Imp then BU.format1 "Imps: %s\n" (FStar.Common.string_of_list p_imp ps.all_implicits) else "")] @ (List.mapi (fun i g -> goal_to_string "Goal" (Some (1 + i, n)) ps g) ps.goals) diff --git a/src/tactics/FStar.Tactics.Types.fsti b/src/tactics/FStar.Tactics.Types.fsti index 1988282d9ac..07b6aeb16f7 100644 --- a/src/tactics/FStar.Tactics.Types.fsti +++ b/src/tactics/FStar.Tactics.Types.fsti @@ -49,6 +49,7 @@ type guard_policy = | SMT | SMTSync | Force + | ForceSMT | Drop // unsound type proofstate = { @@ -77,6 +78,8 @@ type proofstate = { urgency : int; // When printing a proofstate due to an error, this // is used by emacs to decide whether it should pop // open a buffer or not (default: 1). + + dump_on_failure : bool; // Whether to dump the proofstate to the user when a failure occurs. } val decr_depth : proofstate -> proofstate diff --git a/src/tactics/FStar.Tactics.V1.Basic.fst b/src/tactics/FStar.Tactics.V1.Basic.fst index fd20fc9a57d..eb1885697f0 100644 --- a/src/tactics/FStar.Tactics.V1.Basic.fst +++ b/src/tactics/FStar.Tactics.V1.Basic.fst @@ -60,6 +60,13 @@ module Core = FStar.TypeChecker.Core module PO = FStar.TypeChecker.Primops open FStar.Class.Monad +open FStar.Class.Setlike + +let dbg_2635 = Debug.get_toggle "2635" +let dbg_ReflTc = Debug.get_toggle "ReflTc" +let dbg_Tac = Debug.get_toggle "Tac" +let dbg_TacUnify = Debug.get_toggle "TacUnify" + let ret #a (x:a) : tac a = return x let bind #a #b : tac a -> (a -> tac b) -> tac b = ( let! ) let idtac : tac unit = return () @@ -75,7 +82,7 @@ let core_check env sol t must_tot : either (option typ) Core.error = if not (Options.compat_pre_core_should_check()) then Inl None else let debug f = - if Options.debug_any() + if Debug.any() then f () else () in @@ -154,7 +161,7 @@ let print (msg:string) : tac unit = let debugging () : tac bool = bind get (fun ps -> - ret (Env.debug ps.main_context (Options.Other "Tac"))) + ret !dbg_Tac) let do_dump_ps (msg:string) (ps:proofstate) : unit = let psc = ps.psc in @@ -182,7 +189,7 @@ let dump_all (print_resolved:bool) (msg:string) : tac unit = let dump_uvars_of (g:goal) (msg:string) : tac unit = mk_tac (fun ps -> - let uvs = SF.uvars (goal_type g) |> Set.elems in + let uvs = SF.uvars (goal_type g) |> elems in let gs = List.map (goal_of_ctx_uvar g) uvs in let gs = List.filter (fun g -> not (check_goal_solved g)) gs in let ps' = { ps with smt_goals = [] ; goals = gs } in @@ -380,11 +387,11 @@ let __do_unify_wflags let all_uvars = (match check_side with - | Check_none -> Free.new_uv_set () + | Check_none -> empty () | Check_left_only -> Free.uvars t1 | Check_right_only -> Free.uvars t2 - | Check_both -> Set.union (Free.uvars t1) (Free.uvars t2)) - |> Set.elems in + | Check_both -> union (Free.uvars t1) (Free.uvars t2)) + |> elems in match! catch (//restore UF graph in case anything fails @@ -431,15 +438,14 @@ let __do_unify (check_side:check_unifier_solved_implicits_side) (env:env) (t1:term) (t2:term) : tac (option guard_t) = - let dbg = Env.debug env (Options.Other "TacUnify") in bind idtac (fun () -> - if dbg then begin + if !dbg_TacUnify then begin Options.push (); - let _ = Options.set_options "--debug_level Rel --debug_level RelCheck" in + let _ = Options.set_options "--debug Rel,RelCheck" in () end; - bind (__do_unify_wflags dbg allow_guards must_tot check_side env t1 t2) (fun r -> - if dbg then Options.pop (); + bind (__do_unify_wflags !dbg_TacUnify allow_guards must_tot check_side env t1 t2) (fun r -> + if !dbg_TacUnify then Options.pop (); ret r)) (* SMT-free unification. *) @@ -473,7 +479,7 @@ let do_match (must_tot:bool) (env:Env.env) (t1:term) (t2:term) : tac bool = bind (do_unify_aux must_tot Check_right_only env t1 t2) (fun r -> if r then begin let uvs2 = SF.uvars_uncached t1 in - if not (Set.equal uvs1 uvs2) + if not (equal uvs1 uvs2) then (UF.rollback tx; ret false) else ret true end @@ -494,7 +500,7 @@ let do_match_on_lhs (must_tot:bool) (env:Env.env) (t1:term) (t2:term) : tac bool bind (do_unify_aux must_tot Check_right_only env t1 t2) (fun r -> if r then begin let uvs2 = SF.uvars_uncached lhs in - if not (Set.equal uvs1 uvs2) + if not (equal uvs1 uvs2) then (UF.rollback tx; ret false) else ret true end @@ -740,7 +746,7 @@ let intro () : tac binder = wrap_err "intro" <| ( //BU.print1 "[intro]: old goal is %s" (goal_to_string goal); //BU.print1 "[intro]: new goal is %s" // (show ctx_uvar); - //ignore (FStar.Options.set_options "--debug_level Rel"); + //ignore (FStar.Options.set_options "--debug Rel"); (* Suppose if instead of simply assigning `?u` to the lambda term on the RHS, we tried to unify `?u` with the `(fun (x:t) -> ?v @ [NM(x, 0)])`. @@ -984,11 +990,11 @@ let t_apply (uopt:bool) (only_match:bool) (tc_resolved_uvars:bool) (tm:term) : t let w = List.fold_right (fun (uvt, q, _) w -> U.mk_app w [(uvt, q)]) uvs tm in let uvset = List.fold_right - (fun (_, _, uv) s -> Set.union s (SF.uvars (U.ctx_uvar_typ uv))) + (fun (_, _, uv) s -> union s (SF.uvars (U.ctx_uvar_typ uv))) uvs - (SF.new_uv_set ()) + (empty ()) in - let free_in_some_goal uv = Set.mem uv uvset in + let free_in_some_goal uv = mem uv uvset in solve' goal w ;! // //process uvs @@ -1067,7 +1073,7 @@ let t_apply_lemma (noinst:bool) (noinst_lhs:bool) |> Some) deps (rangeof goal) in - if Env.debug env <| Options.Other "2635" + if Debug.medium () || !dbg_2635 then BU.print2 "Apply lemma created a new uvar %s while applying %s\n" (show u) @@ -1102,7 +1108,7 @@ let t_apply_lemma (noinst:bool) (noinst_lhs:bool) let goal_sc = should_check_goal_uvar goal in solve' goal U.exp_unit ;! let is_free_uvar uv t = - let free_uvars = List.map (fun x -> x.ctx_uvar_head) (Set.elems (SF.uvars t)) in + let free_uvars = List.map (fun x -> x.ctx_uvar_head) (elems (SF.uvars t)) in List.existsML (fun u -> UF.equiv u uv) free_uvars in let appears uv goals = List.existsML (fun g' -> is_free_uvar uv (goal_type g')) goals in @@ -1298,7 +1304,7 @@ let revert () : tac unit = let g = mk_goal env' u_r goal.opts goal.is_guard goal.label in replace_cur g -let free_in bv t = Set.mem bv (SF.names t) +let free_in bv t = mem bv (SF.names t) let clear (b : binder) : tac unit = let bv = b.binder_bv in @@ -1391,7 +1397,7 @@ let _t_trefl (allow_guards:bool) (l : term) (r : term) : tac unit = | Inl (u, _, _) -> is_uvar_untyped_or_already_checked u in let t = U.ctx_uvar_typ g.goal_ctx_uvar in - let uvars = Set.elems (FStar.Syntax.Free.uvars t) in + let uvars = elems (FStar.Syntax.Free.uvars t) in if BU.for_all is_uvar_untyped_or_already_checked uvars then skip_register //all the uvars are already checked or untyped else ( @@ -1423,7 +1429,7 @@ let _t_trefl (allow_guards:bool) (l : term) (r : term) : tac unit = with | Inr _ -> false | Inl (_, t_ty) -> ( // ignoring the effect, ghost is ok - match Core.check_term_subtyping env ty t_ty with + match Core.check_term_subtyping true true env ty t_ty with | Inl None -> //unconditional subtype mark_uvar_as_already_checked u; true @@ -2287,13 +2293,13 @@ let t_smt_sync (vcfg : vconfig) : tac unit = wrap_err "t_smt_sync" <| ( let free_uvars (tm : term) : tac (list Z.t) = idtac ;! - let uvs = Syntax.Free.uvars_uncached tm |> Set.elems |> List.map (fun u -> Z.of_int_fs (UF.uvar_id u.ctx_uvar_head)) in + let uvs = Syntax.Free.uvars_uncached tm |> elems |> List.map (fun u -> Z.of_int_fs (UF.uvar_id u.ctx_uvar_head)) in ret uvs (***** Builtins used in the meta DSL framework *****) let dbg_refl (g:env) (msg:unit -> string) = - if Env.debug g <| Options.Other "ReflTc" + if !dbg_ReflTc then BU.print_string (msg ()) let issues = list Errors.issue @@ -2317,8 +2323,8 @@ let refl_typing_builtin_wrapper (f:unit -> 'a) : tac (option 'a & issues) = else ret (r, errs) let no_uvars_in_term (t:term) : bool = - t |> Free.uvars |> Set.is_empty && - t |> Free.univs |> Set.is_empty + t |> Free.uvars |> is_empty && + t |> Free.univs |> is_empty let no_uvars_in_g (g:env) : bool = g.gamma |> BU.for_all (function diff --git a/src/tactics/FStar.Tactics.V2.Basic.fst b/src/tactics/FStar.Tactics.V2.Basic.fst index 054f886ecbd..3679c59562b 100644 --- a/src/tactics/FStar.Tactics.V2.Basic.fst +++ b/src/tactics/FStar.Tactics.V2.Basic.fst @@ -60,9 +60,15 @@ module Z = FStar.BigInt module Core = FStar.TypeChecker.Core module PO = FStar.TypeChecker.Primops +let dbg_TacUnify = Debug.get_toggle "TacUnify" +let dbg_2635 = Debug.get_toggle "2635" +let dbg_ReflTc = Debug.get_toggle "ReflTc" +let dbg_TacVerbose = Debug.get_toggle "TacVerbose" + open FStar.Class.Show open FStar.Class.Monad open FStar.Class.PP +open FStar.Class.Setlike let compress (t:term) : tac term = return ();! @@ -72,7 +78,7 @@ let core_check env sol t must_tot : either (option typ) Core.error = if not (Options.compat_pre_core_should_check()) then Inl None else let debug f = - if Options.debug_any() + if Debug.any() then f () else () in @@ -126,9 +132,10 @@ let print (msg:string) : tac unit = tacprint msg; return () +let dbg_Tac = Debug.get_toggle "Tac" let debugging () : tac bool = let! ps = get in - return (Env.debug ps.main_context (Options.Other "Tac")) + return !dbg_Tac let do_dump_ps (msg:string) (ps:proofstate) : unit = let psc = ps.psc in @@ -156,7 +163,7 @@ let dump_all (print_resolved:bool) (msg:string) : tac unit = let dump_uvars_of (g:goal) (msg:string) : tac unit = mk_tac (fun ps -> - let uvs = SF.uvars (goal_type g) |> Set.elems in // Set.elems order dependent but OK + let uvs = SF.uvars (goal_type g) |> elems in // elems order dependent but OK let gs = List.map (goal_of_ctx_uvar g) uvs in let gs = List.filter (fun g -> not (check_goal_solved g)) gs in let ps' = { ps with smt_goals = [] ; goals = gs } in @@ -257,6 +264,16 @@ let proc_guard_formula | _ -> mlog (fun () -> BU.print1 "guard = %s\n" (show f)) (fun () -> fail1 "Forcing the guard failed (%s)" reason)) + | ForceSMT -> + mlog (fun () -> BU.print2 "Forcing guard WITH SMT (%s:%s)\n" reason (show f)) (fun () -> + let g = { Env.trivial_guard with guard_f = NonTrivial f } in + try if not (Env.is_trivial <| Rel.discharge_guard e g) + then fail1 "Forcing the guard failed (%s)" reason + else return () + with + | _ -> mlog (fun () -> BU.print1 "guard = %s\n" (show f)) (fun () -> + fail1 "Forcing the guard failed (%s)" reason)) + let proc_guard' (simplify:bool) (reason:string) (e : env) (g : guard_t) (sc_opt:option should_check_uvar) (rng:Range.range) : tac unit = mlog (fun () -> BU.print2 "Processing guard (%s:%s)\n" reason (Rel.guard_to_string e g)) (fun () -> @@ -363,11 +380,11 @@ let __do_unify_wflags let all_uvars = (match check_side with - | Check_none -> Free.new_uv_set () + | Check_none -> empty () | Check_left_only -> Free.uvars t1 | Check_right_only -> Free.uvars t2 - | Check_both -> Set.union (Free.uvars t1) (Free.uvars t2)) - |> Set.elems /// GGG order dependent but does not seem too bad + | Check_both -> union (Free.uvars t1) (Free.uvars t2)) + |> elems /// GGG order dependent but does not seem too bad in match! @@ -414,15 +431,14 @@ let __do_unify (check_side:check_unifier_solved_implicits_side) (env:env) (t1:term) (t2:term) : tac (option guard_t) = - let dbg = Env.debug env (Options.Other "TacUnify") in return ();! - if dbg then begin + if !dbg_TacUnify then begin Options.push (); - let _ = Options.set_options "--debug_level Rel --debug_level RelCheck" in + let _ = Options.set_options "--debug Rel,RelCheck" in () end; - let! r = __do_unify_wflags dbg allow_guards must_tot check_side env t1 t2 in - if dbg then Options.pop (); + let! r = __do_unify_wflags !dbg_TacUnify allow_guards must_tot check_side env t1 t2 in + if !dbg_TacUnify then Options.pop (); return r (* SMT-free unification. *) @@ -457,7 +473,7 @@ let do_match (must_tot:bool) (env:Env.env) (t1:term) (t2:term) : tac bool = let! r = do_unify_aux must_tot Check_right_only env t1 t2 in if r then begin let uvs2 = SF.uvars_uncached t1 in - if not (Set.equal uvs1 uvs2) + if not (equal uvs1 uvs2) then (UF.rollback tx; return false) else return true end @@ -477,7 +493,7 @@ let do_match_on_lhs (must_tot:bool) (env:Env.env) (t1:term) (t2:term) : tac bool let! r = do_unify_aux must_tot Check_right_only env t1 t2 in if r then begin let uvs2 = SF.uvars_uncached lhs in - if not (Set.equal uvs1 uvs2) + if not (equal uvs1 uvs2) then (UF.rollback tx; return false) else return true end @@ -572,7 +588,7 @@ let tadmit_t (t:term) : tac unit = wrap_err "tadmit_t" <| ( let! ps = get in let! g = cur_goal in // should somehow taint the state instead of just printing a warning - Err.log_issue (pos #_ #(has_range_syntax ()) (goal_type g)) + Err.log_issue (pos (goal_type g)) (Errors.Warning_TacAdmit, BU.format1 "Tactics admitted goal <%s>\n\n" (goal_to_string "" None ps g)); solve' g t) @@ -740,7 +756,7 @@ let intro () : tac RD.binding = wrap_err "intro" <| ( //BU.print1 "[intro]: old goal is %s" (goal_to_string goal); //BU.print1 "[intro]: new goal is %s" // (show ctx_uvar); - //ignore (FStar.Options.set_options "--debug_level Rel"); + //ignore (FStar.Options.set_options "--debug Rel"); (* Suppose if instead of simply assigning `?u` to the lambda term on the RHS, we tried to unify `?u` with the `(fun (x:t) -> ?v @ [NM(x, 0)])`. @@ -801,18 +817,26 @@ let norm (s : list Pervasives.norm_step) : tac unit = let t = normalize steps (goal_env goal) (goal_type goal) in replace_cur (goal_with_type goal t) - -let norm_term_env (e : env) (s : list Pervasives.norm_step) (t : term) : tac term = wrap_err "norm_term" <| ( +let __norm_term_env + (well_typed:bool) (e : env) (s : list Pervasives.norm_step) (t : term) + : tac term += wrap_err "norm_term" <| ( let! ps = get in if_verbose (fun () -> BU.print1 "norm_term_env: t = %s\n" (show t)) ;! // only for elaborating lifts and all that, we don't care if it's actually well-typed - let! t, _, _ = __tc_lax e t in + let! t = + if well_typed + then return t + else let! t, _, _ = __tc_lax e t in return t + in let steps = [Env.Reify; Env.UnfoldTac]@(Cfg.translate_norm_steps s) in let t = normalize steps ps.main_context t in if_verbose (fun () -> BU.print1 "norm_term_env: t' = %s\n" (show t)) ;! return t ) +let norm_term_env e s t = __norm_term_env false e s t +let refl_norm_well_typed_term e s t = __norm_term_env true e s t let refine_intro () : tac unit = wrap_err "refine_intro" <| ( let! g = cur_goal in @@ -976,7 +1000,7 @@ let t_apply (uopt:bool) (only_match:bool) (tc_resolved_uvars:bool) (tm:term) : t (Rel.guard_to_string e guard)) ;! // Focus helps keep the goal order let typ = bnorm e typ in - if only_match && not (Set.is_empty (Free.uvars_uncached typ)) then + if only_match && not (is_empty (Free.uvars_uncached typ)) then fail "t_apply: only_match is on, but the type of the term to apply is not a uvar" else return ();! let! uvs = try_unify_by_application (Some should_check) only_match e typ (goal_type goal) (rangeof goal) in @@ -986,11 +1010,11 @@ let t_apply (uopt:bool) (only_match:bool) (tc_resolved_uvars:bool) (tm:term) : t let w = List.fold_right (fun (uvt, q, _) w -> U.mk_app w [(uvt, q)]) uvs tm in let uvset = List.fold_right - (fun (_, _, uv) s -> Set.union s (SF.uvars (U.ctx_uvar_typ uv))) + (fun (_, _, uv) s -> union s (SF.uvars (U.ctx_uvar_typ uv))) uvs - (SF.new_uv_set ()) + (empty ()) in - let free_in_some_goal uv = Set.mem uv uvset in + let free_in_some_goal uv = mem uv uvset in solve' goal w ;! // //process uvs @@ -1064,7 +1088,7 @@ let t_apply_lemma (noinst:bool) (noinst_lhs:bool) |> Some) deps (rangeof goal) in - if Env.debug env <| Options.Other "2635" + if !dbg_2635 then BU.print2 "Apply lemma created a new uvar %s while applying %s\n" (show u) @@ -1105,7 +1129,7 @@ let t_apply_lemma (noinst:bool) (noinst_lhs:bool) let goal_sc = should_check_goal_uvar goal in solve' goal U.exp_unit ;! let is_free_uvar uv t = - Set.for_any (fun u -> UF.equiv u.ctx_uvar_head uv) (SF.uvars t) + for_any (fun u -> UF.equiv u.ctx_uvar_head uv) (SF.uvars t) in let appears uv goals = List.existsML (fun g' -> is_free_uvar uv (goal_type g')) goals in let checkone t goals = @@ -1301,7 +1325,7 @@ let revert () : tac unit = let g = mk_goal env' u_r goal.opts goal.is_guard goal.label in replace_cur g -let free_in bv t = Set.mem bv (SF.names t) +let free_in bv t = mem bv (SF.names t) let clear (b : RD.binding) : tac unit = let bv = binding_to_bv b in @@ -1395,7 +1419,7 @@ let _t_trefl (allow_guards:bool) (l : term) (r : term) : tac unit = in let t = U.ctx_uvar_typ g.goal_ctx_uvar in let uvars = FStar.Syntax.Free.uvars t in - if Set.for_all is_uvar_untyped_or_already_checked uvars + if for_all is_uvar_untyped_or_already_checked uvars then skip_register //all the uvars are already checked or untyped else ( let head, args = @@ -1426,7 +1450,7 @@ let _t_trefl (allow_guards:bool) (l : term) (r : term) : tac unit = with | Inr _ -> false | Inl (_, t_ty) -> ( // ignoring effect, ghost is ok - match Core.check_term_subtyping env ty t_ty with + match Core.check_term_subtyping true true env ty t_ty with | Inl None -> //unconditional subtype mark_uvar_as_already_checked u; true @@ -1960,6 +1984,11 @@ let set_urgency (u:Z.t) : tac unit = let ps = { ps with urgency = Z.to_int_fs u } in set ps +let set_dump_on_failure (b:bool) : tac unit = + let! ps = get in + let ps = { ps with dump_on_failure = b } in + set ps + let t_commute_applied_match () : tac unit = wrap_err "t_commute_applied_match" <| ( let! g = cur_goal in match destruct_eq (goal_env g) (goal_type g) with @@ -2104,7 +2133,7 @@ let t_smt_sync (vcfg : vconfig) : tac unit = wrap_err "t_smt_sync" <| ( let free_uvars (tm : term) : tac (list Z.t) = return ();! let uvs = Free.uvars_uncached tm - |> Set.elems // GGG bad, order dependent, but userspace does not have sets + |> elems // GGG bad, order dependent, but userspace does not have sets |> List.map (fun u -> Z.of_int_fs (UF.uvar_id u.ctx_uvar_head)) in return uvs @@ -2137,7 +2166,7 @@ let write (r:tref 'a) (x:'a) : tac unit = (***** Builtins used in the meta DSL framework *****) let dbg_refl (g:env) (msg:unit -> string) = - if Env.debug g <| Options.Other "ReflTc" + if !dbg_ReflTc then BU.print_string (msg ()) let issues = list Errors.issue @@ -2223,11 +2252,11 @@ let refl_typing_builtin_wrapper (label:string) (f:unit -> 'a & list (env & typ)) return (o, errs) let no_uvars_in_term (t:term) : bool = - t |> Free.uvars |> Set.is_empty && - t |> Free.univs |> Set.is_empty + t |> Free.uvars |> is_empty && + t |> Free.univs |> is_empty let no_univ_uvars_in_term (t:term) : bool = - t |> Free.univs |> Set.is_empty + t |> Free.univs |> is_empty let no_uvars_in_g (g:env) : bool = g.gamma |> BU.for_all (function @@ -2268,7 +2297,7 @@ let refl_is_non_informative (g:env) (t:typ) : tac (option unit & issues) = return (None, [unexpected_uvars_issue (Env.get_range g)]) ) -let refl_check_relation (g:env) (t0 t1:typ) (rel:relation) +let refl_check_relation (rel:relation) (smt_ok:bool) (unfolding_ok:bool) (g:env) (t0 t1:typ) : tac (option unit * issues) = if no_uvars_in_g g && @@ -2285,12 +2314,12 @@ let refl_check_relation (g:env) (t0 t1:typ) (rel:relation) if rel = Subtyping then Core.check_term_subtyping else Core.check_term_equality in - match f g t0 t1 with + match f smt_ok unfolding_ok g t0 t1 with | Inl None -> - dbg_refl g (fun _ -> "refl_check_relation: succeeded (no guard)"); + dbg_refl g (fun _ -> "refl_check_relation: succeeded (no guard)\n"); ((), []) | Inl (Some guard_f) -> - dbg_refl g (fun _ -> "refl_check_relation: succeeded"); + dbg_refl g (fun _ -> "refl_check_relation: succeeded\n"); ((), [(g, guard_f)]) | Inr err -> dbg_refl g (fun _ -> BU.format1 "refl_check_relation failed: %s\n" (Core.print_error err)); @@ -2301,10 +2330,9 @@ let refl_check_relation (g:env) (t0 t1:typ) (rel:relation) ) let refl_check_subtyping (g:env) (t0 t1:typ) : tac (option unit & issues) = - refl_check_relation g t0 t1 Subtyping + refl_check_relation Subtyping true true g t0 t1 -let refl_check_equiv (g:env) (t0 t1:typ) : tac (option unit & issues) = - refl_check_relation g t0 t1 Equality +let t_refl_check_equiv = refl_check_relation Equality let to_must_tot (eff:Core.tot_or_ghost) : bool = match eff with @@ -2689,7 +2717,7 @@ let refl_try_unify (g:env) (uvs:list (bv & typ)) (t0 t1:term) let allow_uvars = true in let allow_names = true in let t = SC.deep_compress allow_uvars allow_names t in - if t |> Syntax.Free.uvars_full |> Set.is_empty + if t |> Syntax.Free.uvars_full |> is_empty then (bv, t)::l else l | None -> l @@ -2755,9 +2783,14 @@ let resolve_name (e:env) (n:list string) = let log_issues (is : list Errors.issue) : tac unit = let open FStar.Errors in let! ps = get in - (* Prepend an error component *) - let is = is |> - List.map (fun i -> { i with issue_msg = (Errors.text "Tactic logged issue:")::i.issue_msg }) + (* Prepend an error component, unless the tactic handles its own errors. *) + let is = + if ps.dump_on_failure + then + is |> + List.map (fun i -> { i with issue_msg = (Errors.text "Tactic logged issue:")::i.issue_msg }) + else + is in add_issues is; return () @@ -2784,9 +2817,10 @@ let proofstate_of_goals rng env goals imps = entry_range = rng; guard_policy = SMT; freshness = 0; - tac_verb_dbg = Env.debug env (Options.Other "TacVerbose"); + tac_verb_dbg = !dbg_TacVerbose; local_state = BU.psmap_empty (); urgency = 1; + dump_on_failure = true; } in ps @@ -2813,9 +2847,10 @@ let proofstate_of_all_implicits rng env imps = entry_range = rng; guard_policy = SMT; freshness = 0; - tac_verb_dbg = Env.debug env (Options.Other "TacVerbose"); + tac_verb_dbg = !dbg_TacVerbose; local_state = BU.psmap_empty (); urgency = 1; + dump_on_failure = true; } in (ps, w) @@ -2852,6 +2887,7 @@ let call_subtac (g:env) (f : tac unit) (_u:universe) (goal_ty : typ) : tac (opti return ();! // thunk let rng = Env.get_range g in let ps, w = proofstate_of_goal_ty rng g goal_ty in + let ps = { ps with dump_on_failure = false } in // subtacs can fail gracefully, do not dump the failed proofstate. match Errors.catch_errors_and_ignore_rest (fun () -> run_unembedded_tactic_on_ps_and_solve_remaining rng rng false () (fun () -> f) ps) with diff --git a/src/tactics/FStar.Tactics.V2.Basic.fsti b/src/tactics/FStar.Tactics.V2.Basic.fsti index e0a2308c80d..4b7a9756e5f 100644 --- a/src/tactics/FStar.Tactics.V2.Basic.fsti +++ b/src/tactics/FStar.Tactics.V2.Basic.fsti @@ -98,6 +98,7 @@ val lget : typ -> string -> tac term val lset : typ -> string -> term -> tac unit val curms : unit -> tac Z.t val set_urgency : Z.t -> tac unit +val set_dump_on_failure : bool -> tac unit val t_commute_applied_match : unit -> tac unit val string_to_term : env -> string -> tac term val push_bv_dsenv : env -> string -> tac (env * RD.binding) @@ -127,7 +128,7 @@ val write : tref 'a -> 'a -> tac unit let issues = list FStar.Errors.issue val refl_is_non_informative : env -> typ -> tac (option unit & issues) val refl_check_subtyping : env -> typ -> typ -> tac (option unit & issues) -val refl_check_equiv : env -> typ -> typ -> tac (option unit & issues) +val t_refl_check_equiv : smt_ok:bool -> unfolding_ok:bool -> env -> typ -> typ -> tac (option unit & issues) val refl_core_compute_term_type : env -> term -> tac (option (Core.tot_or_ghost & typ) & issues) val refl_core_check_term : env -> term -> typ -> Core.tot_or_ghost -> tac (option unit & issues) val refl_core_check_term_at_type : env -> term -> typ -> tac (option Core.tot_or_ghost & issues) @@ -139,6 +140,7 @@ val refl_instantiate_implicits : env -> term -> tac (option (list (bv & t val refl_try_unify : env -> list (bv & typ) -> term -> term -> tac (option (list (bv & term)) & issues) val refl_maybe_relate_after_unfolding : env -> term -> term -> tac (option Core.side & issues) val refl_maybe_unfold_head : env -> term -> tac (option term & issues) +val refl_norm_well_typed_term : env -> list norm_step -> term -> tac term val push_open_namespace : env -> list string -> tac env val push_module_abbrev : env -> string -> list string -> tac env diff --git a/src/tactics/FStar.Tactics.V2.Primops.fst b/src/tactics/FStar.Tactics.V2.Primops.fst index bfc652203ac..73d803b88cf 100644 --- a/src/tactics/FStar.Tactics.V2.Primops.fst +++ b/src/tactics/FStar.Tactics.V2.Primops.fst @@ -90,8 +90,8 @@ let ops = [ mk_tot_step_1 0 "goals_of" goals_of goals_of; mk_tot_step_1 0 "smt_goals_of" smt_goals_of smt_goals_of; mk_tot_step_1 0 "goal_env" goal_env goal_env; - mk_tot_step_1 0 "goal_type" #_ #RE.e_term goal_type goal_type; - mk_tot_step_1 0 "goal_witness" #_ #RE.e_term goal_witness goal_witness; + mk_tot_step_1 0 "goal_type" goal_type goal_type; + mk_tot_step_1 0 "goal_witness" goal_witness goal_witness; mk_tot_step_1 0 "is_guard" is_guard is_guard; mk_tot_step_1 0 "get_label" get_label get_label; mk_tot_step_2 0 "set_label" set_label set_label; @@ -100,7 +100,7 @@ let ops = [ unseal_step; - mk_tac_step_1 0 "compress" #RE.e_term #RE.e_term compress compress; + mk_tac_step_1 0 "compress" compress compress; mk_tac_step_1 0 "set_goals" set_goals set_goals; mk_tac_step_1 0 "set_smt_goals" set_smt_goals set_smt_goals; @@ -119,7 +119,7 @@ let ops = [ mk_tac_step_1 0 "intro" intro intro; mk_tac_step_1 0 "intro_rec" intro_rec intro_rec; mk_tac_step_1 0 "norm" norm norm; - mk_tac_step_3 0 "norm_term_env" #_ #_ #RE.e_term #RE.e_term norm_term_env norm_term_env; + mk_tac_step_3 0 "norm_term_env" norm_term_env norm_term_env; mk_tac_step_2 0 "norm_binding_type" norm_binding_type norm_binding_type; mk_tac_step_2 0 "rename_to" rename_to rename_to; mk_tac_step_1 0 "var_retype" var_retype var_retype; @@ -128,13 +128,13 @@ let ops = [ mk_tac_step_1 0 "clear" clear clear; mk_tac_step_1 0 "rewrite" rewrite rewrite; mk_tac_step_1 0 "refine_intro" refine_intro refine_intro; - mk_tac_step_3 0 "t_exact" #_ #_ #RE.e_term t_exact t_exact; - mk_tac_step_4 0 "t_apply" #_ #_ #_ #RE.e_term t_apply t_apply; - mk_tac_step_3 0 "t_apply_lemma" #_ #_ #RE.e_term t_apply_lemma t_apply_lemma; + mk_tac_step_3 0 "t_exact" t_exact t_exact; + mk_tac_step_4 0 "t_apply" t_apply t_apply; + mk_tac_step_3 0 "t_apply_lemma" t_apply_lemma t_apply_lemma; mk_tac_step_1 0 "set_options" set_options set_options; - mk_tac_step_2 0 "tcc" #_ #RE.e_term tcc tcc; - mk_tac_step_2 0 "tc" #_ #RE.e_term #RE.e_term tc tc; - mk_tac_step_1 0 "unshelve" #RE.e_term unshelve unshelve; + mk_tac_step_2 0 "tcc" tcc tcc; + mk_tac_step_2 0 "tc" tc tc; + mk_tac_step_1 0 "unshelve" unshelve unshelve; mk_tac_step_2 1 "unquote" #e_any #RE.e_term #e_any @@ -162,20 +162,20 @@ let ops = [ mk_tac_step_1 0 "t_trefl" t_trefl t_trefl; mk_tac_step_1 0 "dup" dup dup; - mk_tac_step_1 0 "tadmit_t" #RE.e_term tadmit_t tadmit_t; + mk_tac_step_1 0 "tadmit_t" tadmit_t tadmit_t; mk_tac_step_1 0 "join" join join; - mk_tac_step_1 0 "t_destruct" #RE.e_term t_destruct t_destruct; + mk_tac_step_1 0 "t_destruct" t_destruct t_destruct; mk_tac_step_1 0 "top_env" top_env top_env; mk_tac_step_1 0 "fresh" fresh fresh; mk_tac_step_1 0 "curms" curms curms; - mk_tac_step_2 0 "uvar_env" #_ #(e_option RE.e_term) #RE.e_term uvar_env uvar_env; - mk_tac_step_2 0 "ghost_uvar_env" #_ #RE.e_term #RE.e_term ghost_uvar_env ghost_uvar_env; - mk_tac_step_1 0 "fresh_universe_uvar" #_ #RE.e_term fresh_universe_uvar fresh_universe_uvar; - mk_tac_step_3 0 "unify_env" #_ #RE.e_term #RE.e_term unify_env unify_env; - mk_tac_step_3 0 "unify_guard_env" #_ #RE.e_term #RE.e_term unify_guard_env unify_guard_env; - mk_tac_step_3 0 "match_env" #_ #RE.e_term #RE.e_term match_env match_env; + mk_tac_step_2 0 "uvar_env" uvar_env uvar_env; + mk_tac_step_2 0 "ghost_uvar_env" ghost_uvar_env ghost_uvar_env; + mk_tac_step_1 0 "fresh_universe_uvar" fresh_universe_uvar fresh_universe_uvar; + mk_tac_step_3 0 "unify_env" unify_env unify_env; + mk_tac_step_3 0 "unify_guard_env" unify_guard_env unify_guard_env; + mk_tac_step_3 0 "match_env" match_env match_env; mk_tac_step_3 0 "launch_process" launch_process launch_process; - mk_tac_step_1 0 "change" #RE.e_term change change; + mk_tac_step_1 0 "change" change change; mk_tac_step_1 0 "get_guard_policy" get_guard_policy get_guard_policy; mk_tac_step_1 0 "set_guard_policy" set_guard_policy set_guard_policy; mk_tac_step_1 0 "lax_on" lax_on lax_on; @@ -193,18 +193,19 @@ let ops = [ (fun _ _ _ -> fail "sorry, `lset` does not work in NBE"); mk_tac_step_1 1 "set_urgency" set_urgency set_urgency; + mk_tac_step_1 1 "set_dump_on_failure" set_dump_on_failure set_dump_on_failure; mk_tac_step_1 1 "t_commute_applied_match" t_commute_applied_match t_commute_applied_match; mk_tac_step_1 0 "gather_or_solve_explicit_guards_for_resolved_goals" gather_explicit_guards_for_resolved_goals gather_explicit_guards_for_resolved_goals; - mk_tac_step_2 0 "string_to_term" #_ #_ #RE.e_term string_to_term string_to_term; + mk_tac_step_2 0 "string_to_term" string_to_term string_to_term; mk_tac_step_2 0 "push_bv_dsenv" push_bv_dsenv push_bv_dsenv; - mk_tac_step_1 0 "term_to_string" #RE.e_term term_to_string term_to_string; + mk_tac_step_1 0 "term_to_string" term_to_string term_to_string; mk_tac_step_1 0 "comp_to_string" comp_to_string comp_to_string; - mk_tac_step_1 0 "term_to_doc" #RE.e_term term_to_doc term_to_doc; + mk_tac_step_1 0 "term_to_doc" term_to_doc term_to_doc; mk_tac_step_1 0 "comp_to_doc" comp_to_doc comp_to_doc; mk_tac_step_1 0 "range_to_string" range_to_string range_to_string; - mk_tac_step_2 0 "term_eq_old" #RE.e_term #RE.e_term term_eq_old term_eq_old; + mk_tac_step_2 0 "term_eq_old" term_eq_old term_eq_old; mk_tac_step_3 1 "with_compat_pre_core" #e_any #e_int #(TI.e_tactic_thunk e_any) #e_any @@ -215,7 +216,7 @@ let ops = [ mk_tac_step_1 0 "get_vconfig" get_vconfig get_vconfig; mk_tac_step_1 0 "set_vconfig" set_vconfig set_vconfig; mk_tac_step_1 0 "t_smt_sync" t_smt_sync t_smt_sync; - mk_tac_step_1 0 "free_uvars" #RE.e_term free_uvars free_uvars; + mk_tac_step_1 0 "free_uvars" free_uvars free_uvars; mk_tac_step_1 0 "all_ext_options" all_ext_options all_ext_options; mk_tac_step_1 0 "ext_getv" ext_getv ext_getv; mk_tac_step_1 0 "ext_getns" ext_getns ext_getns; @@ -240,26 +241,28 @@ let ops = [ // reflection typechecker callbacks (part of the DSL framework) - mk_tac_step_2 0 "is_non_informative" #_ #RE.e_term refl_is_non_informative refl_is_non_informative; - mk_tac_step_3 0 "check_subtyping" #_ #RE.e_term #RE.e_term refl_check_subtyping refl_check_subtyping; - mk_tac_step_3 0 "check_equiv" #_ #RE.e_term #RE.e_term refl_check_equiv refl_check_equiv; - mk_tac_step_2 0 "core_compute_term_type" #_ #RE.e_term #(e_ret_t (e_tuple2 solve RE.e_term)) refl_core_compute_term_type refl_core_compute_term_type; - mk_tac_step_4 0 "core_check_term" #_ #RE.e_term #RE.e_term refl_core_check_term refl_core_check_term; - mk_tac_step_3 0 "core_check_term_at_type" #_ #RE.e_term #RE.e_term refl_core_check_term_at_type refl_core_check_term_at_type; - mk_tac_step_2 0 "tc_term" #_ #RE.e_term #(e_ret_t (e_tuple2 RE.e_term (e_tuple2 solve RE.e_term))) refl_tc_term refl_tc_term; - mk_tac_step_2 0 "universe_of" #_ #RE.e_term refl_universe_of refl_universe_of; - mk_tac_step_2 0 "check_prop_validity" #_ #RE.e_term refl_check_prop_validity refl_check_prop_validity; - mk_tac_step_4 0 "check_match_complete" #_ #RE.e_term #RE.e_term refl_check_match_complete refl_check_match_complete; + mk_tac_step_2 0 "is_non_informative" refl_is_non_informative refl_is_non_informative; + mk_tac_step_3 0 "check_subtyping" refl_check_subtyping refl_check_subtyping; + mk_tac_step_5 0 "t_check_equiv" t_refl_check_equiv t_refl_check_equiv; + mk_tac_step_2 0 "core_compute_term_type" refl_core_compute_term_type refl_core_compute_term_type; + mk_tac_step_4 0 "core_check_term" refl_core_check_term refl_core_check_term; + mk_tac_step_3 0 "core_check_term_at_type" refl_core_check_term_at_type refl_core_check_term_at_type; + mk_tac_step_2 0 "tc_term" refl_tc_term refl_tc_term; + mk_tac_step_2 0 "universe_of" refl_universe_of refl_universe_of; + mk_tac_step_2 0 "check_prop_validity" refl_check_prop_validity refl_check_prop_validity; + mk_tac_step_4 0 "check_match_complete" refl_check_match_complete refl_check_match_complete; mk_tac_step_2 0 "instantiate_implicits" #_ #_ #(e_ret_t (e_tuple3 (e_list (e_tuple2 RE.e_namedv solve)) solve solve)) #_ #_ #(nbe_e_ret_t (NBET.e_tuple3 (NBET.e_list (NBET.e_tuple2 NRE.e_namedv solve)) solve solve)) refl_instantiate_implicits refl_instantiate_implicits; mk_tac_step_4 0 "try_unify" - #RE.e_env #(e_list (e_tuple2 RE.e_namedv RE.e_term)) #RE.e_term #RE.e_term #(e_ret_t (e_list (e_tuple2 RE.e_namedv RE.e_term))) - #NRE.e_env #(NBET.e_list (NBET.e_tuple2 NRE.e_namedv NRE.e_term)) #NRE.e_term #NRE.e_term #(nbe_e_ret_t (NBET.e_list (NBET.e_tuple2 NRE.e_namedv NRE.e_term))) + #_ #(e_list (e_tuple2 RE.e_namedv RE.e_term)) #_ #_ #(e_ret_t (e_list (e_tuple2 RE.e_namedv RE.e_term))) + #_ #(NBET.e_list (NBET.e_tuple2 NRE.e_namedv NRE.e_term)) #_ #_ #(nbe_e_ret_t (NBET.e_list (NBET.e_tuple2 NRE.e_namedv NRE.e_term))) refl_try_unify refl_try_unify; mk_tac_step_3 0 "maybe_relate_after_unfolding" refl_maybe_relate_after_unfolding refl_maybe_relate_after_unfolding; mk_tac_step_2 0 "maybe_unfold_head" refl_maybe_unfold_head refl_maybe_unfold_head; + mk_tac_step_3 0 "norm_well_typed_term" refl_norm_well_typed_term refl_norm_well_typed_term; + mk_tac_step_2 0 "push_open_namespace" push_open_namespace push_open_namespace; mk_tac_step_3 0 "push_module_abbrev" push_module_abbrev push_module_abbrev; mk_tac_step_2 0 "resolve_name" diff --git a/src/tests/FStar.Tests.Data.fst b/src/tests/FStar.Tests.Data.fst new file mode 100644 index 00000000000..01be3b858a2 --- /dev/null +++ b/src/tests/FStar.Tests.Data.fst @@ -0,0 +1,66 @@ +(* + Copyright 2008-2014 Nikhil Swamy and Microsoft Research + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) +module FStar.Tests.Data +// tests about data structures + + +open FStar +open FStar.Compiler +open FStar.Compiler.Effect +module BU = FStar.Compiler.Util + +module FlatSet = FStar.Compiler.FlatSet +module RBSet = FStar.Compiler.RBSet + +open FStar.Class.Setlike +open FStar.Class.Show + +let rec insert (n:int) {| setlike int 'set |} (s : 'set) = + if n = 0 then s + else insert (n-1) (add n s) + +let rec all_mem (n:int) {| setlike int 'set |} (s : 'set) = + if n = 0 then true + else mem n s && all_mem (n-1) s + +let rec all_remove (n:int) {| setlike int 'set |} (s : 'set) = + if n = 0 then s + else all_remove (n-1) (remove n s) + +let nn = 10000 + +let run_all () = + BU.print_string "data tests\n"; + let (f, ms) = BU.record_time (fun () -> insert nn (empty () <: FlatSet.t int)) in + BU.print1 "FlatSet insert: %s\n" (show ms); + let (f_ok, ms) = BU.record_time (fun () -> all_mem nn f) in + BU.print1 "FlatSet all_mem: %s\n" (show ms); + let (f, ms) = BU.record_time (fun () -> all_remove nn f) in + BU.print1 "FlatSet all_remove: %s\n" (show ms); + + if not f_ok then failwith "FlatSet all_mem failed"; + if not (is_empty f) then failwith "FlatSet all_remove failed"; + + let (rb, ms) = BU.record_time (fun () -> insert nn (empty () <: RBSet.t int)) in + BU.print1 "RBSet insert: %s\n" (show ms); + let (rb_ok, ms) = BU.record_time (fun () -> all_mem nn rb) in + BU.print1 "RBSet all_mem: %s\n" (show ms); + let (rb, ms) = BU.record_time (fun () -> all_remove nn rb) in + BU.print1 "RBSet all_remove: %s\n" (show ms); + + if not rb_ok then failwith "RBSet all_mem failed"; + if not (is_empty rb) then failwith "RBSet all_remove failed"; + () diff --git a/src/tests/FStar.Tests.Norm.fst b/src/tests/FStar.Tests.Norm.fst index 7b803e69819..07e601e7454 100644 --- a/src/tests/FStar.Tests.Norm.fst +++ b/src/tests/FStar.Tests.Norm.fst @@ -264,7 +264,7 @@ let run_either i r expected normalizer = Options.set_option "print_implicits" (Options.Bool true); Options.set_option "ugly" (Options.Bool true); Options.set_option "print_bound_var_types" (Options.Bool true); - // ignore (Options.set_options "--debug Test --debug_level univ_norm --debug_level NBE"); + // ignore (Options.set_options "--debug Test --debug univ_norm,NBE"); always i (term_eq (U.unascribe x) expected) let run_whnf i r expected = diff --git a/src/tests/FStar.Tests.Test.fst b/src/tests/FStar.Tests.Test.fst index fb6c18a065e..0a6317fd476 100644 --- a/src/tests/FStar.Tests.Test.fst +++ b/src/tests/FStar.Tests.Test.fst @@ -42,6 +42,7 @@ let main argv = Pars.parse_incremental_decls(); Norm.run_all (); if Unif.run_all () then () else exit 1; + Data.run_all (); exit 0 with | Error(err, msg, r, _ctx) when not <| O.trace_error() -> diff --git a/src/tests/FStar.Tests.Unif.fst b/src/tests/FStar.Tests.Unif.fst index 570d2344380..5f103c74beb 100644 --- a/src/tests/FStar.Tests.Unif.fst +++ b/src/tests/FStar.Tests.Unif.fst @@ -96,8 +96,8 @@ let check_core i subtyping guard_ok x y = let env = tcenv () in let res = if subtyping - then FStar.TypeChecker.Core.check_term_subtyping env x y - else FStar.TypeChecker.Core.check_term_equality env x y + then FStar.TypeChecker.Core.check_term_subtyping true true env x y + else FStar.TypeChecker.Core.check_term_equality true true env x y in let _ = match res with @@ -197,7 +197,6 @@ let run_all () = FStar.Main.process_args () |> ignore; //set options let tm, us = inst 1 (tc "fun (u:Type0 -> Type0) (x:Type0) -> u x") in let sol = tc "fun (x:Type0) -> Prims.pair x x" in - BU.print1 "Processed args: debug_at_level Core? %s\n" (BU.string_of_bool (Options.debug_at_level_no_module (Options.Other "Core"))); unify_check 9 [] tm sol Trivial diff --git a/src/tests/FStar.Tests.Util.fst b/src/tests/FStar.Tests.Util.fst index 94afeb89a9a..7961ba068bb 100644 --- a/src/tests/FStar.Tests.Util.fst +++ b/src/tests/FStar.Tests.Util.fst @@ -55,7 +55,7 @@ let rec term_eq' t1 t2 = && List.forall2 (fun (x:binder) (y:binder) -> term_eq' x.binder_bv.sort y.binder_bv.sort) xs ys in let args_eq xs ys = List.length xs = List.length ys - && List.forall2 (fun (a, imp) (b, imp') -> term_eq' a b && U.eq_aqual imp imp'=U.Equal) xs ys in + && List.forall2 (fun (a, imp) (b, imp') -> term_eq' a b && U.eq_aqual imp imp') xs ys in let comp_eq (c:S.comp) (d:S.comp) = match c.n, d.n with | S.Total t, S.Total s -> term_eq' t s diff --git a/src/tosyntax/FStar.ToSyntax.Interleave.fst b/src/tosyntax/FStar.ToSyntax.Interleave.fst index 79ce8f8b230..7d0b3a9d0a3 100644 --- a/src/tosyntax/FStar.ToSyntax.Interleave.fst +++ b/src/tosyntax/FStar.ToSyntax.Interleave.fst @@ -26,6 +26,8 @@ open FStar.Errors open FStar.Syntax.Syntax open FStar.Parser.AST +module BU = FStar.Compiler.Util + (* Some basic utilities *) let id_eq_lid i (l:lident) = (string_of_id i) = (string_of_id (ident_of_lid l)) @@ -38,8 +40,10 @@ let is_type x d = match d.d with tys |> Util.for_some (fun t -> id_of_tycon t = (string_of_id x)) | _ -> false +// //is d of of the form 'let x = ...' or 'type x = ...' or 'splice[..., x, ...] tac' // returns unqualified lids +// let definition_lids d = match d.d with | TopLevelLet(_, defs) -> @@ -52,6 +56,23 @@ let definition_lids d = [Ident.lid_of_ids [id]] | _ -> []) | Splice (_, ids, _) -> List.map (fun id -> Ident.lid_of_ids [id]) ids + | DeclSyntaxExtension (extension_name, code, _, range) -> begin + let ext_parser = FStar.Parser.AST.Util.lookup_extension_parser extension_name in + match ext_parser with + | None -> + raise_error + (Errors.Fatal_SyntaxError, + BU.format1 "Unknown syntax extension %s" extension_name) + d.drange + | Some parser -> + match parser.parse_decl_name code range with + | Inl error -> + raise_error + (Errors.Fatal_SyntaxError, error.message) + error.range + | Inr id -> + [Ident.lid_of_ids [id]] + end | _ -> [] let is_definition_of x d = diff --git a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst index be4e0cdd8fd..881d6741bad 100644 --- a/src/tosyntax/FStar.ToSyntax.ToSyntax.fst +++ b/src/tosyntax/FStar.ToSyntax.ToSyntax.fst @@ -30,6 +30,7 @@ open FStar.Ident open FStar.Const open FStar.Errors open FStar.Syntax +open FStar.Class.Setlike module C = FStar.Parser.Const module S = FStar.Syntax.Syntax @@ -40,6 +41,8 @@ module P = FStar.Syntax.Print module EMB = FStar.Syntax.Embeddings module SS = FStar.Syntax.Subst +let dbg_attrs = Debug.get_toggle "attrs" + type antiquotations_temp = list (bv * S.term) let tun_r (r:Range.range) : S.term = { tun with pos = r } @@ -218,33 +221,21 @@ let desugar_name mk setpos env resolve l = let compile_op_lid n s r = [mk_ident(compile_op n s r, r)] |> lid_of_ids let op_as_term env arity op : option S.term = - let r l dd = Some (S.lid_and_dd_as_fv (set_lid_range l (range_of_id op)) dd None |> S.fv_to_tm) in + let r l = Some (S.lid_and_dd_as_fv (set_lid_range l (range_of_id op)) None |> S.fv_to_tm) in let fallback () = match Ident.string_of_id op with - | "=" -> - r C.op_Eq delta_equational - | "<" -> - r C.op_LT delta_equational - | "<=" -> - r C.op_LTE delta_equational - | ">" -> - r C.op_GT delta_equational - | ">=" -> - r C.op_GTE delta_equational - | "&&" -> - r C.op_And delta_equational - | "||" -> - r C.op_Or delta_equational - | "+" -> - r C.op_Addition delta_equational - | "-" when (arity=1) -> - r C.op_Minus delta_equational - | "-" -> - r C.op_Subtraction delta_equational - | "/" -> - r C.op_Division delta_equational - | "%" -> - r C.op_Modulus delta_equational + | "=" -> r C.op_Eq + | "<" -> r C.op_LT + | "<=" -> r C.op_LTE + | ">" -> r C.op_GT + | ">=" -> r C.op_GTE + | "&&" -> r C.op_And + | "||" -> r C.op_Or + | "+" -> r C.op_Addition + | "-" when (arity=1) -> r C.op_Minus + | "-" -> r C.op_Subtraction + | "/" -> r C.op_Division + | "%" -> r C.op_Modulus | "@" -> FStar.Errors.log_issue_doc (range_of_id op) @@ -252,24 +243,16 @@ let op_as_term env arity op : option S.term = Errors.Msg.text "The operator '@' has been resolved to FStar.List.Tot.append even though \ FStar.List.Tot is not in scope. Please add an 'open FStar.List.Tot' to \ stop relying on this deprecated, special treatment of '@'."]); - r C.list_tot_append_lid (Delta_equational_at_level 2) - - | "<>" -> - r C.op_notEq delta_equational - | "~" -> - r C.not_lid (Delta_constant_at_level 2) - | "==" -> - r C.eq2_lid (Delta_constant_at_level 2) - | "<<" -> - r C.precedes_lid delta_constant - | "/\\" -> - r C.and_lid (Delta_constant_at_level 1) - | "\\/" -> - r C.or_lid (Delta_constant_at_level 1) - | "==>" -> - r C.imp_lid (Delta_constant_at_level 1) - | "<==>" -> - r C.iff_lid (Delta_constant_at_level 2) + r C.list_tot_append_lid + + | "<>" -> r C.op_notEq + | "~" -> r C.not_lid + | "==" -> r C.eq2_lid + | "<<" -> r C.precedes_lid + | "/\\" -> r C.and_lid + | "\\/" -> r C.or_lid + | "==>" -> r C.imp_lid + | "<==>" -> r C.iff_lid | _ -> None in match desugar_name' (fun t -> {t with pos=(range_of_id op)}) @@ -515,7 +498,7 @@ let rec destruct_app_pattern (env:env_t) (is_top_level:bool) (p:pattern) | _ -> failwith "Not an app pattern" -let rec gather_pattern_bound_vars_maybe_top acc p = +let rec gather_pattern_bound_vars_maybe_top (acc : FlatSet.t ident) p = let gather_pattern_bound_vars_from_list = List.fold_left gather_pattern_bound_vars_maybe_top acc in @@ -527,15 +510,15 @@ let rec gather_pattern_bound_vars_maybe_top acc p = | PatOp _ -> acc | PatApp (phead, pats) -> gather_pattern_bound_vars_from_list (phead::pats) | PatTvar (x, _, _) - | PatVar (x, _, _) -> Set.add x acc + | PatVar (x, _, _) -> add x acc | PatList pats | PatTuple (pats, _) | PatOr pats -> gather_pattern_bound_vars_from_list pats | PatRecord guarded_pats -> gather_pattern_bound_vars_from_list (List.map snd guarded_pats) | PatAscribed (pat, _) -> gather_pattern_bound_vars_maybe_top acc pat -let gather_pattern_bound_vars : pattern -> Set.set Ident.ident = - let acc = Set.empty () in +let gather_pattern_bound_vars : pattern -> FlatSet.t Ident.ident = + let acc = empty #ident () in fun p -> gather_pattern_bound_vars_maybe_top acc p type bnd = @@ -563,24 +546,6 @@ let mk_lb (attrs, n, t, e, pos) = { } let no_annot_abs bs t = U.abs bs t None -let mk_ref_read tm = - let tm' = Tm_app ({ - hd=S.fv_to_tm (S.lid_and_dd_as_fv C.sread_lid delta_constant None); - args=[ tm, S.as_aqual_implicit false ]}) in - S.mk tm' tm.pos - -let mk_ref_alloc tm = - let tm' = Tm_app ({ - hd=S.fv_to_tm (S.lid_and_dd_as_fv C.salloc_lid delta_constant None); - args=[ tm, S.as_aqual_implicit false ]}) in - S.mk tm' tm.pos - -let mk_ref_assign t1 t2 pos = - let tm = Tm_app ({ - hd=S.fv_to_tm (S.lid_and_dd_as_fv C.swrite_lid delta_constant None); - args=[ t1, S.as_aqual_implicit false; t2, S.as_aqual_implicit false ]}) in - S.mk tm pos - (* * Collect the explicitly annotated universes in the sigelt, close the sigelt with them, and stash them appropriately in the sigelt *) @@ -592,10 +557,10 @@ let rec generalize_annotated_univs (s:sigelt) :sigelt = list that we update as we find universes. We also keep a set of 'seen' universes, whose order we do not care, just for efficiency. *) let vars : ref (list univ_name) = mk_ref [] in - let seen : ref (Set.t univ_name) = mk_ref (Set.empty ()) in + let seen : ref (RBSet.t univ_name) = mk_ref (empty ()) in let reg (u:univ_name) : unit = - if not (Set.mem u !seen) then ( - seen := Set.add u !seen; + if not (mem u !seen) then ( + seen := add u !seen; vars := u::!vars ) in @@ -626,14 +591,16 @@ let rec generalize_annotated_univs (s:sigelt) :sigelt = num_uniform_params=num_uniform; t=Subst.subst (Subst.shift_subst (List.length bs) usubst) t; mutuals=lids1; - ds=lids2} } + ds=lids2; + injective_type_params=false} } | Sig_datacon {lid;t;ty_lid=tlid;num_ty_params=n;mutuals=lids} -> { se with sigel = Sig_datacon {lid; us=unames; t=Subst.subst usubst t; ty_lid=tlid; num_ty_params=n; - mutuals=lids} } + mutuals=lids; + injective_type_params=false} } | _ -> failwith "Impossible: collect_annotated_universes: Sig_bundle should not have a non data/type sigelt" ); lids} } | Sig_declare_typ {lid; t} -> @@ -663,11 +630,11 @@ let rec generalize_annotated_univs (s:sigelt) :sigelt = let generalize_annotated_univs_signature (s : effect_signature) : effect_signature = match s with | Layered_eff_sig (n, (_, t)) -> - let uvs = Free.univnames t |> Set.elems in + let uvs = Free.univnames t |> elems in let usubst = Subst.univ_var_closing uvs in Layered_eff_sig (n, (uvs, Subst.subst usubst t)) | WP_eff_sig (_, t) -> - let uvs = Free.univnames t |> Set.elems in + let uvs = Free.univnames t |> elems in let usubst = Subst.univ_var_closing uvs in WP_eff_sig (uvs, Subst.subst usubst t) in @@ -773,23 +740,24 @@ let check_no_aq (aq : antiquotations_temp) : unit = let check_linear_pattern_variables pats r = // returns the set of pattern variables - let rec pat_vars p = match p.v with + let rec pat_vars p : RBSet.t bv = + match p.v with | Pat_dot_term _ - | Pat_constant _ -> S.no_names + | Pat_constant _ -> empty () | Pat_var x -> (* Only consider variables that actually have names, not wildcards. *) if string_of_id x.ppname = Ident.reserved_prefix - then S.no_names - else Set.add x S.no_names + then empty () + else singleton x | Pat_cons(_, _, pats) -> let aux out (p, _) = let p_vars = pat_vars p in - let intersection = Set.inter p_vars out in - if Set.is_empty intersection - then Set.union out p_vars + let intersection = inter p_vars out in + if is_empty intersection + then union out p_vars else - let duplicate_bv = List.hd (Set.elems intersection) in + let duplicate_bv = List.hd (elems intersection) in raise_error ( Errors.Fatal_NonLinearPatternNotPermitted, BU.format1 "Non-linear patterns are not permitted: `%s` appears more than once in this pattern." @@ -797,7 +765,7 @@ let check_linear_pattern_variables pats r = r in - List.fold_left aux S.no_names pats + List.fold_left aux (empty ()) pats in // check that the same variables are bound in each pattern @@ -807,10 +775,10 @@ let check_linear_pattern_variables pats r = | p::ps -> let pvars = pat_vars p in let aux p = - if Set.equal pvars (pat_vars p) then () else - let symdiff s1 s2 = Set.union (Set.diff s1 s2) (Set.diff s2 s1) in + if equal pvars (pat_vars p) then () else + let symdiff s1 s2 = union (diff s1 s2) (diff s2 s1) in let nonlinear_vars = symdiff pvars (pat_vars p) in - let first_nonlinear_var = List.hd (Set.elems nonlinear_vars) in + let first_nonlinear_var = List.hd (elems nonlinear_vars) in raise_error ( Errors.Fatal_IncoherentPatterns, BU.format1 "Patterns in this match are incoherent, variable %s is bound in some but not all patterns." @@ -970,8 +938,8 @@ let rec desugar_data_pat loc, aqs, env, ans@annots, pat::pats) pats (loc, aqs, env, [], []) in let pat = List.fold_right (fun hd tl -> let r = Range.union_ranges hd.p tl.p in - pos_r r <| Pat_cons(S.lid_and_dd_as_fv C.cons_lid delta_constant (Some Data_ctor), None, [(hd, false);(tl, false)])) pats - (pos_r (Range.end_range p.prange) <| Pat_cons(S.lid_and_dd_as_fv C.nil_lid delta_constant (Some Data_ctor), None, [])) in + pos_r r <| Pat_cons(S.lid_and_dd_as_fv C.cons_lid (Some Data_ctor), None, [(hd, false);(tl, false)])) pats + (pos_r (Range.end_range p.prange) <| Pat_cons(S.lid_and_dd_as_fv C.nil_lid (Some Data_ctor), None, [])) in let x = S.new_bv (Some p.prange) (tun_r p.prange) in loc, aqs, env, LocalBinder(x, None, []), pat, annots @@ -1006,7 +974,6 @@ let rec desugar_data_pat let lid = lid_of_path ["__dummy__"] p.prange in S.lid_and_dd_as_fv lid - delta_constant (Some (Unresolved_constructor ({ uc_base_term = false; @@ -1141,7 +1108,7 @@ and desugar_machine_integer env repr (signedness, width) range = begin match intro_term.n with | Tm_fvar fv -> let private_lid = lid_of_path (path_of_text private_intro_nm) range in - let private_fv = S.lid_and_dd_as_fv private_lid (U.incr_delta_depth (Some?.v fv.fv_delta)) fv.fv_qual in + let private_fv = S.lid_and_dd_as_fv private_lid fv.fv_qual in {intro_term with n=Tm_fvar private_fv} | _ -> failwith ("Unexpected non-fvar for " ^ intro_nm) @@ -1245,7 +1212,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an raise_error (Errors.Fatal_UnepxectedOrUnboundOperator, "Unexpected or unbound operator: " ^ Ident.string_of_id s) - top.range + (range_of_id s) | Some op -> if List.length args > 0 then let args, aqs = args |> List.map (fun t -> let t', s = desugar_term_aq env t in @@ -1277,10 +1244,10 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an | Name lid when string_of_lid lid = "Effect" -> mk (Tm_constant Const_effect), noaqs | Name lid when string_of_lid lid = "True" -> - S.fvar_with_dd (Ident.set_lid_range Const.true_lid top.range) delta_constant None, //NS delta: wrong, but maybe intentionally so + S.fvar_with_dd (Ident.set_lid_range Const.true_lid top.range) None, noaqs | Name lid when string_of_lid lid = "False" -> - S.fvar_with_dd (Ident.set_lid_range Const.false_lid top.range) delta_constant None, //NS delta: wrong, but maybe intentionally so + S.fvar_with_dd (Ident.set_lid_range Const.false_lid top.range) None, noaqs | Projector (eff_name, id) when is_special_effect_combinator (string_of_id id) && Env.is_effect_name env eff_name -> @@ -1290,7 +1257,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an begin match try_lookup_effect_defn env eff_name with | Some ed -> let lid = U.dm4f_lid ed txt in - S.fvar_with_dd lid (Delta_constant_at_level 1) None, noaqs + S.fvar_with_dd lid None, noaqs | None -> failwith (BU.format2 "Member %s of effect %s is not accessible \ (using an effect abbreviation instead of the original effect ?)" @@ -1416,25 +1383,27 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an | Abs(binders, body) -> (* First of all, forbid definitions such as `f x x = ...` *) let bvss = List.map gather_pattern_bound_vars binders in - let check_disjoint (sets : list (Set.set ident)) : option ident = + let check_disjoint (sets : list (FlatSet.t ident)) : option ident = let rec aux acc sets = match sets with | [] -> None | set::sets -> - let i = Set.inter acc set in - if Set.is_empty i - then aux (Set.union acc set) sets - else Some (List.hd (Set.elems i)) + let i = inter acc set in + if is_empty i + then aux (union acc set) sets + else Some (List.hd (elems i)) in - aux (S.new_id_set ()) sets + aux (empty ()) sets in begin match check_disjoint bvss with | None -> () | Some id -> - raise_error (Errors.Fatal_NonLinearPatternNotPermitted, - BU.format1 - "Non-linear patterns are not permitted: `%s` appears more than once in this function definition." (string_of_id id)) - (range_of_id id) + let open FStar.Pprint in + let open FStar.Class.PP in + raise_error_doc (Errors.Fatal_NonLinearPatternNotPermitted, [ + text "Non-linear patterns are not permitted."; + text "The variable " ^/^ squotes (pp id) ^/^ text " appears more than once in this function definition." + ]) (range_of_id id) end; let binders = binders |> List.map replace_unit_pattern in @@ -1489,13 +1458,13 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an | Some p, Some (sc, p') -> begin match sc.n, p'.v with | Tm_name _, _ -> - let tup2 = S.lid_and_dd_as_fv (C.mk_tuple_data_lid 2 top.range) delta_constant (Some Data_ctor) in + let tup2 = S.lid_and_dd_as_fv (C.mk_tuple_data_lid 2 top.range) (Some Data_ctor) in let sc = S.mk (Tm_app {hd=mk (Tm_fvar tup2); args=[as_arg sc; as_arg <| S.bv_to_name x]}) top.range in let p = withinfo (Pat_cons(tup2, None, [(p', false);(p, false)])) (Range.union_ranges p'.p p.p) in Some(sc, p) | Tm_app {args}, Pat_cons(_, _, pats) -> - let tupn = S.lid_and_dd_as_fv (C.mk_tuple_data_lid (1 + List.length args) top.range) delta_constant (Some Data_ctor) in + let tupn = S.lid_and_dd_as_fv (C.mk_tuple_data_lid (1 + List.length args) top.range) (Some Data_ctor) in let sc = mk (Tm_app {hd=mk (Tm_fvar tupn); args=args@[as_arg <| S.bv_to_name x]}) in let p = withinfo (Pat_cons(tupn, None, pats@[(p, false)])) (Range.union_ranges p'.p p.p) in @@ -1643,7 +1612,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an let dummy_ref = BU.mk_ref true in env, Inl xx, S.mk_binder xx::rec_bindings, used_marker::used_markers | Inr l -> - let env, used_marker = push_top_level_rec_binding env (ident_of_lid l) S.delta_equational in + let env, used_marker = push_top_level_rec_binding env (ident_of_lid l) in env, Inr l, rec_bindings, used_marker::used_markers in env, (lbname::fnames), rec_bindings, used_markers) (env, [], [], []) funs in @@ -1702,7 +1671,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an let body, aq = desugar_term_aq env def in let lbname = match lbname with | Inl x -> Inl x - | Inr l -> Inr (S.lid_and_dd_as_fv l (incr_delta_qualifier body) None) in + | Inr l -> Inr (S.lid_and_dd_as_fv l None) in let body = if is_rec then Subst.close rec_bindings body else body in let attrs = match attrs_opt with | None -> [] @@ -1752,7 +1721,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an "Tactic annotation with a value type is not supported yet, \ try annotating with a computation type; this tactic annotation will be ignored"); let body, aq = desugar_term_aq env t2 in - let fv = S.lid_and_dd_as_fv l (incr_delta_qualifier t1) None in + let fv = S.lid_and_dd_as_fv l None in mk <| Tm_let {lbs=(false, [mk_lb (attrs, Inr fv, t, t1, t1.pos)]); body}, aq | LocalBinder (x,_,_) -> @@ -1791,7 +1760,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an | If(t1, None, asc_opt, t2, t3) -> let x = Syntax.new_bv (Some t3.range) (tun_r t3.range) in - let t_bool = mk (Tm_fvar(S.lid_and_dd_as_fv C.bool_lid delta_constant None)) in + let t_bool = mk (Tm_fvar(S.lid_and_dd_as_fv C.bool_lid None)) in let t1', aq1 = desugar_term_aq env t1 in let t1' = U.ascribe t1' (Inl t_bool, None, false) in let asc_opt, aq0 = desugar_match_returns env t1' asc_opt in @@ -1886,7 +1855,6 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an let head = let lid = lid_of_path ["__dummy__"] top.range in S.fvar_with_dd lid - delta_constant (Some (Unresolved_constructor uc)) in let mk_result args = S.mk_Tm_app head args top.range in @@ -1921,15 +1889,15 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an let head = match try_lookup_dc_by_field_name env f with | None -> - S.fvar_with_dd f (Delta_equational_at_level 1) (Some (Unresolved_projector None)) + S.fvar_with_dd f (Some (Unresolved_projector None)) | Some (constrname, is_rec) -> let projname = mk_field_projector_name_from_ident constrname (ident_of_lid f) in let qual = if is_rec then Some (Record_projector (constrname, ident_of_lid f)) else None in - let candidate_projector = S.lid_and_dd_as_fv (Ident.set_lid_range projname top.range) (Delta_equational_at_level 1) qual in //NS delta: ok, projector + let candidate_projector = S.lid_and_dd_as_fv (Ident.set_lid_range projname top.range) qual in let qual = Unresolved_projector (Some candidate_projector) in let f = List.hd (qualify_field_names constrname [f]) in - S.fvar_with_dd f (Delta_equational_at_level 1) (Some qual) + S.fvar_with_dd f (Some qual) in //The fvar at the head of the term just records the fieldname that the user wrote //and in TcTerm, we use that field name combined with type info to disambiguate @@ -1952,7 +1920,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an let tm = SS.close vt_binders tm in // but we need to close the variables in tm let () = let fvs = Free.names tm in - if not (Set.is_empty fvs) then + if not (is_empty fvs) then raise_error (Errors.Fatal_MissingFieldInRecord, BU.format1 "Static quotation refers to external variables: %s" (Class.Show.show fvs)) (e.range) @@ -2068,7 +2036,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an forall_intro an (fun xn -> p) (fun xn -> e))) *) let mk_forall_intro t p pf = - let head = S.fv_to_tm (S.lid_and_dd_as_fv C.forall_intro_lid S.delta_equational None) in + let head = S.fv_to_tm (S.lid_and_dd_as_fv C.forall_intro_lid None) in let args = [(t, None); (p, None); (pf, None)] in @@ -2103,7 +2071,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an *) let mk_exists_intro t p v e = - let head = S.fv_to_tm (S.lid_and_dd_as_fv C.exists_intro_lid S.delta_equational None) in + let head = S.fv_to_tm (S.lid_and_dd_as_fv C.exists_intro_lid None) in let args = [(t, None); (p, None); (v, None); @@ -2134,7 +2102,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an let q = desugar_term env q in let env', [x] = desugar_binders env [x] in let e = desugar_term env' e in - let head = S.fv_to_tm (S.lid_and_dd_as_fv C.implies_intro_lid S.delta_equational None) in + let head = S.fv_to_tm (S.lid_and_dd_as_fv C.implies_intro_lid None) in let args = [(p, None); (mk_thunk q, None); (U.abs [x] e None, None)] in @@ -2150,7 +2118,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an then C.or_intro_left_lid else C.or_intro_right_lid in - let head = S.fv_to_tm (S.lid_and_dd_as_fv lid S.delta_equational None) in + let head = S.fv_to_tm (S.lid_and_dd_as_fv lid None) in let args = [(p, None); (mk_thunk q, None); (mk_thunk e, None)] in @@ -2161,7 +2129,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an let q = desugar_term env q in let e1 = desugar_term env e1 in let e2 = desugar_term env e2 in - let head = S.fv_to_tm (S.lid_and_dd_as_fv C.and_intro_lid S.delta_equational None) in + let head = S.fv_to_tm (S.lid_and_dd_as_fv C.and_intro_lid None) in let args = [(p, None); (mk_thunk q, None); (mk_thunk e1, None); @@ -2179,7 +2147,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an (forall_elim #a0 #(fun x0 -> forall xs. p) v0 ()))) *) let mk_forall_elim a p v tok = - let head = S.fv_to_tm (S.lid_and_dd_as_fv C.forall_elim_lid S.delta_equational None) in + let head = S.fv_to_tm (S.lid_and_dd_as_fv C.forall_elim_lid None) in let args = [(a, S.as_aqual_implicit true); (p, S.as_aqual_implicit true); (v, None); @@ -2218,7 +2186,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an | [] -> failwith "Impossible" | [b] -> let x = b.binder_bv in - let head = S.fv_to_tm (S.lid_and_dd_as_fv C.exists_lid S.delta_equational None) in + let head = S.fv_to_tm (S.lid_and_dd_as_fv C.exists_lid None) in let args = [(x.sort, S.as_aqual_implicit true); (U.abs [List.hd bs] p None, None)] in S.mk_Tm_app head args p.pos @@ -2227,7 +2195,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an mk_exists [b] body in let mk_exists_elim t x_p s_ex_p f r = - let head = S.fv_to_tm (S.lid_and_dd_as_fv C.exists_elim_lid S.delta_equational None) in + let head = S.fv_to_tm (S.lid_and_dd_as_fv C.exists_elim_lid None) in let args = [(t, S.as_aqual_implicit true); (x_p, S.as_aqual_implicit true); (s_ex_p, None); @@ -2283,7 +2251,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an let p = desugar_term env p in let q = desugar_term env q in let e = desugar_term env e in - let head = S.fv_to_tm (S.lid_and_dd_as_fv C.implies_elim_lid S.delta_equational None) in + let head = S.fv_to_tm (S.lid_and_dd_as_fv C.implies_elim_lid None) in let args = [(p, None); (q, None); ({ U.exp_unit with pos = Range.union_ranges p.pos q.pos }, None); @@ -2298,7 +2266,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an let e1 = desugar_term env_x e1 in let env_y, [y] = desugar_binders env [y] in let e2 = desugar_term env_y e2 in - let head = S.fv_to_tm (S.lid_and_dd_as_fv C.or_elim_lid S.delta_equational None) in + let head = S.fv_to_tm (S.lid_and_dd_as_fv C.or_elim_lid None) in let extra_binder = S.mk_binder (S.new_bv None S.tun) in let args = [(p, None); (mk_thunk q, None); @@ -2314,7 +2282,7 @@ and desugar_term_maybe_top (top_level:bool) (env:env_t) (top:term) : S.term * an let r = desugar_term env r in let env', [x;y] = desugar_binders env [x;y] in let e = desugar_term env' e in - let head = S.fv_to_tm (S.lid_and_dd_as_fv C.and_elim_lid S.delta_equational None) in + let head = S.fv_to_tm (S.lid_and_dd_as_fv C.and_elim_lid None) in let args = [(p, None); (mk_thunk q, None); (r, None); @@ -2599,7 +2567,7 @@ and desugar_comp r (allow_type_promotion:bool) env t = | Tm_fvar fv when S.fv_eq_lid fv Const.nil_lid -> let nil = S.mk_Tm_uinst pat [U_zero] in let pattern = - S.fvar_with_dd (Ident.set_lid_range Const.pattern_lid pat.pos) delta_constant None //NS delta: incorrect, should be Delta_abstract (Delta_constant_at_level 1)? + S.fvar_with_dd (Ident.set_lid_range Const.pattern_lid pat.pos) None in S.mk_Tm_app nil [(pattern, S.as_aqual_implicit true)] pat.pos | _ -> pat @@ -2666,7 +2634,8 @@ and desugar_formula env (f:term) : S.term = match (unparen f).tm with | Labeled(f, l, p) -> let f = desugar_formula env f in - mk <| Tm_meta {tm=f; meta=Meta_labeled(l, f.pos, p)} + // GM: I don't think this case really happens? + mk <| Tm_meta {tm=f; meta=Meta_labeled(Errors.Msg.mkmsg l, f.pos, p)} | QForall([], _, _) | QExists([], _, _) @@ -2686,16 +2655,12 @@ and desugar_formula env (f:term) : S.term = | QForall([b], pats, body) -> let q = C.forall_lid in - let q_head = //NS delta: wrong? Delta_constant_at_level 2? - S.fvar_with_dd (set_lid_range q b.brange) (Delta_constant_at_level 1) None - in + let q_head = S.fvar_with_dd (set_lid_range q b.brange) None in desugar_quant q_head b pats true body | QExists([b], pats, body) -> let q = C.exists_lid in - let q_head = //NS delta: wrong? Delta_constant_at_level 2? - S.fvar_with_dd (set_lid_range q b.brange) (Delta_constant_at_level 1) None - in + let q_head = S.fvar_with_dd (set_lid_range q b.brange) None in desugar_quant q_head b pats true body | QuantOp(i, [b], pats, body) -> @@ -2848,9 +2813,8 @@ let mk_indexed_projector_names iquals fvq attrs env lid (fields:list S.binder) = if only_decl then [decl] //only the signature else - let dd = Delta_equational_at_level 1 in let lb = { - lbname=Inr (S.lid_and_dd_as_fv field_name dd None); + lbname=Inr (S.lid_and_dd_as_fv field_name None); lbunivs=[]; lbtyp=tun; lbeff=C.effect_Tot_lid; @@ -2900,9 +2864,8 @@ let mk_typ_abbrev env d lid uvs typars kopt t lids quals rng = * TopLevelLet (see comment there) *) let attrs = U.deduplicate_terms (List.map (desugar_term env) d.attrs) in let val_attrs = Env.lookup_letbinding_quals_and_attrs env lid |> snd in - let dd = incr_delta_qualifier t in let lb = { - lbname=Inr (S.lid_and_dd_as_fv lid dd None); + lbname=Inr (S.lid_and_dd_as_fv lid None); lbunivs=uvs; lbdef=no_annot_abs typars t; lbtyp=if is_some kopt then U.arrow typars (S.mk_Total (kopt |> must)) else tun; @@ -3003,7 +2966,8 @@ let rec desugar_tycon env (d: AST.decl) (d_attrs:list S.term) quals tcs : (env_t num_uniform_params=None; t=k; mutuals; - ds=[]}; + ds=[]; + injective_type_params=false}; sigquals = quals; sigrng = range_of_id id; sigmeta = default_sigmeta; @@ -3011,8 +2975,8 @@ let rec desugar_tycon env (d: AST.decl) (d_attrs:list S.term) quals tcs : (env_t sigopts = None; sigopens_and_abbrevs = opens_and_abbrevs env } in - let _env, _ = Env.push_top_level_rec_binding _env id S.delta_constant in - let _env2, _ = Env.push_top_level_rec_binding _env' id S.delta_constant in + let _env, _ = Env.push_top_level_rec_binding _env id in + let _env2, _ = Env.push_top_level_rec_binding _env' id in _env, _env2, se, tconstr | _ -> failwith "Unexpected tycon" in let push_tparams env bs = @@ -3144,7 +3108,8 @@ let rec desugar_tycon env (d: AST.decl) (d_attrs:list S.term) quals tcs : (env_t params=tpars; num_uniform_params=num_uniform; t=k; - mutuals}; sigquals = tname_quals }, + mutuals; + injective_type_params}; sigquals = tname_quals }, constrs, tconstr, quals) -> let mk_tot t = let tot = mk_term (Name C.effect_Tot_lid) t.range t.level in @@ -3173,7 +3138,8 @@ let rec desugar_tycon env (d: AST.decl) (d_attrs:list S.term) quals tcs : (env_t t=U.arrow data_tpars (mk_Total (t |> U.name_function_binders)); ty_lid=tname; num_ty_params=ntps; - mutuals}; + mutuals; + injective_type_params}; sigquals = quals; sigrng = range_of_lid name; sigmeta = default_sigmeta ; @@ -3182,7 +3148,7 @@ let rec desugar_tycon env (d: AST.decl) (d_attrs:list S.term) quals tcs : (env_t sigopens_and_abbrevs = opens_and_abbrevs env })))) in - if Options.debug_at_level_no_module (Options.Other "attrs") + if !dbg_attrs then ( BU.print3 "Adding attributes to type %s: val_attrs=[@@%s] attrs=[@@%s]\n" (string_of_lid tname) @@ -3195,7 +3161,8 @@ let rec desugar_tycon env (d: AST.decl) (d_attrs:list S.term) quals tcs : (env_t num_uniform_params=num_uniform; t=k; mutuals; - ds=constrNames}; + ds=constrNames; + injective_type_params}; sigquals = tname_quals; sigrng = range_of_lid tname; sigmeta = default_sigmeta ; @@ -3207,7 +3174,7 @@ let rec desugar_tycon env (d: AST.decl) (d_attrs:list S.term) quals tcs : (env_t in let sigelts = tps_sigelts |> List.map (fun (_, se) -> se) in let bundle, abbrevs = FStar.Syntax.MutRecTy.disentangle_abbrevs_from_bundle sigelts quals (List.collect U.lids_of_sigelt sigelts) rng in - if Options.debug_at_level_no_module (Options.Other "attrs") + if !dbg_attrs then ( BU.print1 "After disentangling: %s\n" (Print.sigelt_to_string bundle) @@ -3686,6 +3653,12 @@ and desugar_decl_maybe_fail_attr env (d: decl): (env_t * sigelts) = | errs, ropt -> (* failed! check that it failed as expected *) let errnos = List.concatMap (fun i -> FStar.Common.list_of_option i.issue_number) errs in + if Options.print_expected_failures () then ( + (* Print errors if asked for *) + BU.print_string ">> Got issues: [\n"; + List.iter Errors.print_issue errs; + BU.print_string ">>]\n" + ); if expected_errs = [] then env0, [] else begin @@ -3769,7 +3742,7 @@ and desugar_decl_core env (d_attrs:list S.term) (d:decl) : (env_t * sigelts) = else quals in let env, ses = desugar_tycon env d d_attrs (List.map (trans_qual None) quals) tcs in - if Options.debug_at_level_no_module (Options.Other "attrs") + if !dbg_attrs then ( BU.print2 "Desugared tycon from {%s} to {%s}\n" (FStar.Parser.AST.decl_to_string d) @@ -3867,13 +3840,13 @@ and desugar_decl_core env (d_attrs:list S.term) (d:decl) : (env_t * sigelts) = let ses = List.map add_class_attr ses in { se with sigel = Sig_bundle {ses; lids} ; sigattrs = U.deduplicate_terms - (S.fvar_with_dd FStar.Parser.Const.tcclass_lid S.delta_constant None + (S.fvar_with_dd FStar.Parser.Const.tcclass_lid None :: se.sigattrs) } | Sig_inductive_typ _ -> { se with sigattrs = U.deduplicate_terms - (S.fvar_with_dd FStar.Parser.Const.tcclass_lid S.delta_constant None + (S.fvar_with_dd FStar.Parser.Const.tcclass_lid None :: se.sigattrs) } | _ -> se @@ -4021,7 +3994,7 @@ and desugar_decl_core env (d_attrs:list S.term) (d:decl) : (env_t * sigelts) = let build_projection (env, ses) id = build_generic_projection (env, ses) (Some id) in let build_coverage_check (env, ses) = build_generic_projection (env, ses) None in - let bvs = gather_pattern_bound_vars pat |> Set.elems in + let bvs = gather_pattern_bound_vars pat |> elems in (* If there are no variables in the pattern (and it is not a * wildcard), we should still check to see that it is complete, @@ -4080,7 +4053,7 @@ and desugar_decl_core env (d_attrs:list S.term) (d:decl) : (env_t * sigelts) = let l = qualify env id in let qual = [ExceptionConstructor] in let top_attrs = d_attrs in - let se = { sigel = Sig_datacon {lid=l;us=[];t;ty_lid=C.exn_lid;num_ty_params=0;mutuals=[C.exn_lid]}; + let se = { sigel = Sig_datacon {lid=l;us=[];t;ty_lid=C.exn_lid;num_ty_params=0;mutuals=[C.exn_lid];injective_type_params=false}; sigquals = qual; sigrng = d.drange; sigmeta = default_sigmeta ; @@ -4227,7 +4200,7 @@ and desugar_decl_core env (d_attrs:list S.term) (d:decl) : (env_t * sigelts) = open_namespaces = open_modules_and_namespaces env; module_abbreviations = module_abbrevs env } in - match parser opens code range with + match parser.parse_decl opens code range with | Inl error -> raise_error (Errors.Fatal_SyntaxError, error.message) diff --git a/src/typechecker/FStar.TypeChecker.Cfg.fst b/src/typechecker/FStar.TypeChecker.Cfg.fst index 27ec41553c1..0cbfa68d7b1 100644 --- a/src/typechecker/FStar.TypeChecker.Cfg.fst +++ b/src/typechecker/FStar.TypeChecker.Cfg.fst @@ -251,7 +251,8 @@ let prim_from_list (l : list primitive_step) : prim_step_set = (* Turn the lists into psmap sets, for efficiency of lookup *) let built_in_primitive_steps = prim_from_list built_in_primitive_steps_list -let equality_ops = prim_from_list equality_ops_list +let env_dependent_ops env = prim_from_list (env_dependent_ops env) +let equality_ops env = prim_from_list (equality_ops_list env) instance showable_cfg : showable cfg = { show = (fun cfg -> @@ -282,8 +283,9 @@ let log_cfg cfg f = let log_primops cfg f = if cfg.debug.primop then f () else () +let dbg_unfolding = Debug.get_toggle "Unfolding" let log_unfolding cfg f = - if cfg.debug.unfolding then f () else () + if !dbg_unfolding then f () else () let log_nbe cfg f = if cfg.debug.debug_nbe then f () @@ -358,6 +360,17 @@ let add_nbe s = // ZP : Turns nbe flag on, to be used as the default norm strate then { s with nbe_step = true } else s +let dbg_Norm = Debug.get_toggle "Norm" +let dbg_NormTop = Debug.get_toggle "NormTop" +let dbg_NormCfg = Debug.get_toggle "NormCfg" +let dbg_Primops = Debug.get_toggle "Primops" +let dbg_Unfolding = Debug.get_toggle "Unfolding" +let dbg_380 = Debug.get_toggle "380" +let dbg_WPE = Debug.get_toggle "WPE" +let dbg_NormDelayed = Debug.get_toggle "NormDelayed" +let dbg_print_normalized = Debug.get_toggle "print_normalized_terms" +let dbg_NBE = Debug.get_toggle "NBE" +let dbg_UNSOUND_EraseErasableArgs = Debug.get_toggle "UNSOUND_EraseErasableArgs" let config' psteps s e = let d = s |> List.collect (function @@ -373,39 +386,35 @@ let config' psteps s e = | [] -> [Env.NoDelta] | _ -> d in let steps = to_fsteps s |> add_nbe in - let psteps = add_steps (cached_steps ()) psteps in + let psteps = add_steps (merge_steps (env_dependent_ops e) (cached_steps ())) psteps in let dbg_flag = List.contains NormDebug s in - {tcenv = e; - debug = if dbg_flag || Options.debug_any () then - { gen = Env.debug e (Options.Other "Norm") || dbg_flag - ; top = Env.debug e (Options.Other "NormTop") || dbg_flag - ; cfg = Env.debug e (Options.Other "NormCfg") - ; primop = Env.debug e (Options.Other "Primops") - ; unfolding = Env.debug e (Options.Other "Unfolding") - ; b380 = Env.debug e (Options.Other "380") - ; wpe = Env.debug e (Options.Other "WPE") - ; norm_delayed = Env.debug e (Options.Other "NormDelayed") - ; print_normalized = Env.debug e (Options.Other "print_normalized_terms") - ; debug_nbe = Env.debug e (Options.Other "NBE") - ; erase_erasable_args = - (let b = Env.debug e (Options.Other "UNSOUND_EraseErasableArgs") in - if b - then Errors.log_issue - (Env.get_range e) - (Errors.Warning_WarnOnUse, - "The 'UNSOUND_EraseErasableArgs' setting is for debugging only; it is not sound"); - b) - } - else no_debug_switches - ; - steps = steps; - delta_level = d; - primitive_steps = psteps; - strong = false; - memoize_lazy = true; - normalize_pure_lets = (not steps.pure_subterms_within_computations) || Options.normalize_pure_terms_for_extraction(); - reifying = false; - compat_memo_ignore_cfg = Options.ext_getv "compat:normalizer_memo_ignore_cfg" <> ""; + { + tcenv = e; + debug = { + gen = !dbg_Norm || dbg_flag; + top = !dbg_NormTop || dbg_flag; + cfg = !dbg_NormCfg; + primop = !dbg_Primops; + unfolding = !dbg_Unfolding; + b380 = !dbg_380; + wpe = !dbg_WPE; + norm_delayed = !dbg_NormDelayed; + print_normalized = !dbg_print_normalized; + debug_nbe = !dbg_NBE; + erase_erasable_args = ( + if !dbg_UNSOUND_EraseErasableArgs then + Errors.log_issue (Env.get_range e) (Errors.Warning_WarnOnUse, + "The 'UNSOUND_EraseErasableArgs' setting is for debugging only; it is not sound"); + !dbg_UNSOUND_EraseErasableArgs); + }; + steps = steps; + delta_level = d; + primitive_steps = psteps; + strong = false; + memoize_lazy = true; + normalize_pure_lets = (not steps.pure_subterms_within_computations) || Options.normalize_pure_terms_for_extraction(); + reifying = false; + compat_memo_ignore_cfg = Options.ext_getv "compat:normalizer_memo_ignore_cfg" <> ""; } let config s e = config' [] s e diff --git a/src/typechecker/FStar.TypeChecker.Cfg.fsti b/src/typechecker/FStar.TypeChecker.Cfg.fsti index d5683f2f060..7843a7808eb 100644 --- a/src/typechecker/FStar.TypeChecker.Cfg.fsti +++ b/src/typechecker/FStar.TypeChecker.Cfg.fsti @@ -137,7 +137,7 @@ val find_prim_step: cfg -> fv -> option primitive_step // val try_unembed_simple: EMB.embedding 'a -> term -> option 'a val built_in_primitive_steps : BU.psmap primitive_step -val equality_ops : BU.psmap primitive_step +val equality_ops (env:Env.env_t): BU.psmap primitive_step val register_plugin: primitive_step -> unit val register_extra_step: primitive_step -> unit diff --git a/src/typechecker/FStar.TypeChecker.Common.fst b/src/typechecker/FStar.TypeChecker.Common.fst index 1a25708ce24..9f844bed437 100644 --- a/src/typechecker/FStar.TypeChecker.Common.fst +++ b/src/typechecker/FStar.TypeChecker.Common.fst @@ -350,270 +350,6 @@ let lcomp_of_comp_guard c0 g = let lcomp_of_comp c0 = lcomp_of_comp_guard c0 trivial_guard -//////////////////////////////////////////////////////////////////////////////// -// Core logical simplification of terms -//////////////////////////////////////////////////////////////////////////////// -module SS = FStar.Syntax.Subst -open FStar.Syntax.Util -open FStar.Const -let simplify (debug:bool) (tm:term) : term = - let w t = {t with pos=tm.pos} in - let simp_t t = - // catch annotated subformulae too - match (U.unmeta t).n with - | Tm_fvar fv when S.fv_eq_lid fv PC.true_lid -> Some true - | Tm_fvar fv when S.fv_eq_lid fv PC.false_lid -> Some false - | _ -> None - in - let rec args_are_binders args bs = - match args, bs with - | (t, _)::args, b::bs -> - begin match (SS.compress t).n with - | Tm_name bv' -> S.bv_eq b.binder_bv bv' && args_are_binders args bs - | _ -> false - end - | [], [] -> true - | _, _ -> false - in - let is_applied (bs:binders) (t : term) : option bv = - if debug then - BU.print2 "WPE> is_applied %s -- %s\n" (Print.term_to_string t) (Print.tag_of_term t); - let hd, args = U.head_and_args_full t in - match (SS.compress hd).n with - | Tm_name bv when args_are_binders args bs -> - if debug then - BU.print3 "WPE> got it\n>>>>top = %s\n>>>>b = %s\n>>>>hd = %s\n" - (Print.term_to_string t) - (Print.bv_to_string bv) - (Print.term_to_string hd); - Some bv - | _ -> None - in - let is_applied_maybe_squashed (bs : binders) (t : term) : option bv = - if debug then - BU.print2 "WPE> is_applied_maybe_squashed %s -- %s\n" (Print.term_to_string t) (Print.tag_of_term t); - match is_squash t with - - | Some (_, t') -> is_applied bs t' - | _ -> begin match is_auto_squash t with - | Some (_, t') -> is_applied bs t' - | _ -> is_applied bs t - end - in - let is_const_match (phi : term) : option bool = - match (SS.compress phi).n with - (* Trying to be efficient, but just checking if they all agree *) - (* Note, if we wanted to do this for any term instead of just True/False - * we need to open the terms *) - | Tm_match {brs=br::brs} -> - let (_, _, e) = br in - let r = begin match simp_t e with - | None -> None - | Some b -> if List.for_all (fun (_, _, e') -> simp_t e' = Some b) brs - then Some b - else None - end - in - r - | _ -> None - in - let maybe_auto_squash t = - if U.is_sub_singleton t - then t - else U.mk_auto_squash U_zero t - in - let squashed_head_un_auto_squash_args t = - //The head of t is already a squashed operator, e.g. /\ etc. - //no point also squashing its arguments if they're already in U_zero - let maybe_un_auto_squash_arg (t,q) = - match U.is_auto_squash t with - | Some (U_zero, t) -> - //if we're squashing from U_zero to U_zero - // then just remove it - t, q - | _ -> - t,q - in - let head, args = U.head_and_args t in - let args = List.map maybe_un_auto_squash_arg args in - S.mk_Tm_app head args t.pos - in - let rec clearly_inhabited (ty : typ) : bool = - match (U.unmeta ty).n with - | Tm_uinst (t, _) -> clearly_inhabited t - | Tm_arrow {comp=c} -> clearly_inhabited (U.comp_result c) - | Tm_fvar fv -> - let l = S.lid_of_fv fv in - (Ident.lid_equals l PC.int_lid) - || (Ident.lid_equals l PC.bool_lid) - || (Ident.lid_equals l PC.string_lid) - || (Ident.lid_equals l PC.exn_lid) - | _ -> false - in - let simplify arg = (simp_t (fst arg), arg) in - match (SS.compress tm).n with - | Tm_app {hd={n=Tm_uinst({n=Tm_fvar fv}, _)}; args} - | Tm_app {hd={n=Tm_fvar fv}; args} -> - if S.fv_eq_lid fv PC.and_lid - then match args |> List.map simplify with - | [(Some true, _); (_, (arg, _))] - | [(_, (arg, _)); (Some true, _)] -> maybe_auto_squash arg - | [(Some false, _); _] - | [_; (Some false, _)] -> w U.t_false - | _ -> squashed_head_un_auto_squash_args tm - else if S.fv_eq_lid fv PC.or_lid - then match args |> List.map simplify with - | [(Some true, _); _] - | [_; (Some true, _)] -> w U.t_true - | [(Some false, _); (_, (arg, _))] - | [(_, (arg, _)); (Some false, _)] -> maybe_auto_squash arg - | _ -> squashed_head_un_auto_squash_args tm - else if S.fv_eq_lid fv PC.imp_lid - then match args |> List.map simplify with - | [_; (Some true, _)] - | [(Some false, _); _] -> w U.t_true - | [(Some true, _); (_, (arg, _))] -> maybe_auto_squash arg - | [(_, (p, _)); (_, (q, _))] -> - if U.term_eq p q - then w U.t_true - else squashed_head_un_auto_squash_args tm - | _ -> squashed_head_un_auto_squash_args tm - else if S.fv_eq_lid fv PC.iff_lid - then match args |> List.map simplify with - | [(Some true, _) ; (Some true, _)] - | [(Some false, _) ; (Some false, _)] -> w U.t_true - | [(Some true, _) ; (Some false, _)] - | [(Some false, _) ; (Some true, _)] -> w U.t_false - | [(_, (arg, _)) ; (Some true, _)] - | [(Some true, _) ; (_, (arg, _))] -> maybe_auto_squash arg - | [(_, (arg, _)) ; (Some false, _)] - | [(Some false, _) ; (_, (arg, _))] -> maybe_auto_squash (U.mk_neg arg) - | [(_, (p, _)); (_, (q, _))] -> - if U.term_eq p q - then w U.t_true - else squashed_head_un_auto_squash_args tm - | _ -> squashed_head_un_auto_squash_args tm - else if S.fv_eq_lid fv PC.not_lid - then match args |> List.map simplify with - | [(Some true, _)] -> w U.t_false - | [(Some false, _)] -> w U.t_true - | _ -> squashed_head_un_auto_squash_args tm - else if S.fv_eq_lid fv PC.forall_lid - then match args with - (* Simplify ∀x. True to True *) - | [(t, _)] -> - begin match (SS.compress t).n with - | Tm_abs {bs=[_]; body} -> - (match simp_t body with - | Some true -> w U.t_true - | _ -> tm) - | _ -> tm - end - (* Simplify ∀x. True to True, and ∀x. False to False, if the domain is not empty *) - | [(ty, Some ({ aqual_implicit = true })); (t, _)] -> - begin match (SS.compress t).n with - | Tm_abs {bs=[_]; body} -> - (match simp_t body with - | Some true -> w U.t_true - | Some false when clearly_inhabited ty -> w U.t_false - | _ -> tm) - | _ -> tm - end - | _ -> tm - else if S.fv_eq_lid fv PC.exists_lid - then match args with - (* Simplify ∃x. False to False *) - | [(t, _)] -> - begin match (SS.compress t).n with - | Tm_abs {bs=[_]; body} -> - (match simp_t body with - | Some false -> w U.t_false - | _ -> tm) - | _ -> tm - end - (* Simplify ∃x. False to False and ∃x. True to True, if the domain is not empty *) - | [(ty, Some ({ aqual_implicit = true })); (t, _)] -> - begin match (SS.compress t).n with - | Tm_abs {bs=[_]; body} -> - (match simp_t body with - | Some false -> w U.t_false - | Some true when clearly_inhabited ty -> w U.t_true - | _ -> tm) - | _ -> tm - end - | _ -> tm - else if S.fv_eq_lid fv PC.b2t_lid - then match args with - | [{n=Tm_constant (Const_bool true)}, _] -> w U.t_true - | [{n=Tm_constant (Const_bool false)}, _] -> w U.t_false - | _ -> tm //its arg is a bool, can't unsquash - else if S.fv_eq_lid fv PC.haseq_lid - then begin - (* - * AR: We try to mimic the hasEq related axioms in Prims - * and the axiom related to refinements - * For other types, such as lists, whose hasEq is derived by the typechecker, - * we leave them as is - *) - let t_has_eq_for_sure (t:S.term) :bool = - //Axioms from prims - let haseq_lids = [PC.int_lid; PC.bool_lid; PC.unit_lid; PC.string_lid] in - match (SS.compress t).n with - | Tm_fvar fv when haseq_lids |> List.existsb (fun l -> S.fv_eq_lid fv l) -> true - | _ -> false - in - if List.length args = 1 then - let t = args |> List.hd |> fst in - if t |> t_has_eq_for_sure then w U.t_true - else - match (SS.compress t).n with - | Tm_refine _ -> - let t = U.unrefine t in - if t |> t_has_eq_for_sure then w U.t_true - else - //get the hasEq term itself - let haseq_tm = - match (SS.compress tm).n with - | Tm_app {hd} -> hd - | _ -> failwith "Impossible! We have already checked that this is a Tm_app" - in - //and apply it to the unrefined type - mk_app (haseq_tm) [t |> as_arg] - | _ -> tm - else tm - end - else if S.fv_eq_lid fv PC.eq2_lid - then match args with - | [(_typ, _); (a1, _); (a2, _)] -> //eq2 - (match U.eq_tm a1 a2 with - | U.Equal -> w U.t_true - | U.NotEqual -> w U.t_false - | _ -> tm) - | _ -> tm - else - begin - match U.is_auto_squash tm with - | Some (U_zero, t) - when U.is_sub_singleton t -> - //remove redundant auto_squashes - t - | _ -> - tm - end - | Tm_refine {b=bv; phi=t} -> - begin match simp_t t with - | Some true -> bv.sort - | Some false -> tm - | None -> tm - end - | Tm_match _ -> - begin match is_const_match tm with - | Some true -> w U.t_true - | Some false -> w U.t_false - | None -> tm - end - | _ -> tm - let check_positivity_qual subtyping p0 p1 = if p0 = p1 then true else if subtyping diff --git a/src/typechecker/FStar.TypeChecker.Common.fsti b/src/typechecker/FStar.TypeChecker.Common.fsti index b95180e7aa1..5ea1d828ae5 100644 --- a/src/typechecker/FStar.TypeChecker.Common.fsti +++ b/src/typechecker/FStar.TypeChecker.Common.fsti @@ -58,6 +58,7 @@ type problem 'a = { //Try to prove: lhs rel rhs ~ guard reason: list string; //why we generated this problem, for error reporting loc: Range.range; //and the source location where this arose rank: option rank_t; + logical : bool; //logical problems cannot unfold connectives } type prob = @@ -192,7 +193,7 @@ val mk_lcomp: val lcomp_comp: lcomp -> (comp * guard_t) val apply_lcomp : (comp -> comp) -> (guard_t -> guard_t) -> lcomp -> lcomp -val lcomp_to_string : lcomp -> string +val lcomp_to_string : lcomp -> string (* CAUTION! can have side effects of forcing the lcomp *) val lcomp_set_flags : lcomp -> list S.cflag -> lcomp val is_total_lcomp : lcomp -> bool val is_tot_or_gtot_lcomp : lcomp -> bool @@ -204,7 +205,6 @@ val residual_comp_of_lcomp : lcomp -> residual_comp val lcomp_of_comp_guard : comp -> guard_t -> lcomp //lcomp_of_comp_guard with trivial guard val lcomp_of_comp : comp -> lcomp -val simplify : debug:bool -> term -> term val check_positivity_qual (subtyping:bool) (p0 p1:option positivity_qualifier) : bool diff --git a/src/typechecker/FStar.TypeChecker.Core.fst b/src/typechecker/FStar.TypeChecker.Core.fst index ee59a716f2b..ac88107b760 100644 --- a/src/typechecker/FStar.TypeChecker.Core.fst +++ b/src/typechecker/FStar.TypeChecker.Core.fst @@ -16,7 +16,15 @@ module BU = FStar.Compiler.Util module TcUtil = FStar.TypeChecker.Util module Hash = FStar.Syntax.Hash module Subst = FStar.Syntax.Subst +module TEQ = FStar.TypeChecker.TermEqAndSimplify + open FStar.Class.Show +open FStar.Class.Setlike + +let dbg = Debug.get_toggle "Core" +let dbg_Eq = Debug.get_toggle "CoreEq" +let dbg_Top = Debug.get_toggle "CoreTop" +let dbg_Exit = Debug.get_toggle "CoreExit" let goal_ctr = BU.mk_ref 0 let get_goal_ctr () = !goal_ctr @@ -163,14 +171,16 @@ let context_term_to_string (c:context_term) = type context = { no_guard : bool; + unfolding_ok : bool; error_context: list (string & option context_term) } (* The instance prints some brief info on the error_context. `print_context` below is a full printer. *) instance showable_context : showable context = { - show = (fun context -> BU.format2 "{no_guard=%s, error_context=%s}" + show = (fun context -> BU.format3 "{no_guard=%s; unfolding_ok=%s; error_context=%s}" (show context.no_guard) + (show context.unfolding_ok) (show (List.map fst context.error_context))); } @@ -602,7 +612,7 @@ let lookup (g:env) (e:term) : result (tot_or_ghost & typ) = let check_no_escape (bs:binders) t = let xs = FStar.Syntax.Free.names t in - if BU.for_all (fun b -> not (Set.mem b.binder_bv xs)) bs + if BU.for_all (fun b -> not (mem b.binder_bv xs)) bs then return () else fail "Name escapes its scope" @@ -691,8 +701,12 @@ let guard_not_allowed : result bool = fun ctx -> Success (ctx.no_guard, None) +let unfolding_ok + : result bool + = fun ctx -> Success (ctx.unfolding_ok, None) + let debug g f = - if Env.debug g.tcenv (Options.Other "Core") + if !dbg then f () instance showable_side = { @@ -732,27 +746,15 @@ let combine_path_and_branch_condition (path_condition:term) next_path_condition //:bool let maybe_relate_after_unfolding (g:Env.env) t0 t1 : side = - let rec delta_depth_of_head t = - let head = U.leftmost_head t in - match (U.un_uinst head).n with - | Tm_fvar fv -> Some (Env.delta_depth_of_fv g fv) - | Tm_match {scrutinee=t} -> delta_depth_of_head t - | _ -> None in - - let dd0 = delta_depth_of_head t0 in - let dd1 = delta_depth_of_head t1 in - - match dd0, dd1 with - | Some _, None -> Left - | None, Some _ -> Right - | Some dd0, Some dd1 -> - if dd0 = dd1 - then Both - else if Common.delta_depth_greater_than dd0 dd1 - then Left - else Right - | None, None -> - Neither + let dd0 = Env.delta_depth_of_term g t0 in + let dd1 = Env.delta_depth_of_term g t1 in + + if dd0 = dd1 then + Both + else if Common.delta_depth_greater_than dd0 dd1 then + Left + else + Right (* G |- e : t0 <: t1 | p @@ -778,7 +780,7 @@ let rec check_relation (g:env) (rel:relation) (t0 t1:typ) | EQUALITY -> "=?=" | SUBTYPING _ -> "<:?" in - if Env.debug g.tcenv (Options.Other "Core") + if !dbg then BU.print5 "check_relation (%s) %s %s (%s) %s\n" (P.tag_of_term t0) (show t0) @@ -830,11 +832,13 @@ let rec check_relation (g:env) (rel:relation) (t0 t1:typ) "FStar.TypeChecker.Core.maybe_unfold_side" in let maybe_unfold t0 t1 - : option (term & term) - = maybe_unfold_side (which_side_to_unfold t0 t1) t0 t1 + : result (option (term & term)) + = if! unfolding_ok + then return (maybe_unfold_side (which_side_to_unfold t0 t1) t0 t1) + else return None in let emit_guard t0 t1 = - let! _, t_typ = do_check g t0 in + let! _, t_typ = with_context "checking lhs while emitting guard" None (fun _ -> do_check g t0) in let! u = universe_of g t_typ in guard (U.mk_eq2 u t_typ t0 t1) in @@ -847,29 +851,22 @@ let rec check_relation (g:env) (rel:relation) (t0 t1:typ) else err () in let maybe_unfold_side_and_retry side t0 t1 = - match maybe_unfold_side side t0 t1 with - | None -> fallback t0 t1 - | Some (t0, t1) -> check_relation g rel t0 t1 + if! unfolding_ok then + match maybe_unfold_side side t0 t1 with + | None -> fallback t0 t1 + | Some (t0, t1) -> check_relation g rel t0 t1 + else + fallback t0 t1 in let maybe_unfold_and_retry t0 t1 = maybe_unfold_side_and_retry (which_side_to_unfold t0 t1) t0 t1 in let beta_iota_reduce t = let t = Subst.compress t in + let t = N.normalize [Env.HNF; Env.Weak; Env.Beta; Env.Iota; Env.Primops] g.tcenv t in match t.n with - | Tm_app _ -> - let head = U.leftmost_head t in - (match (Subst.compress head).n with - | Tm_abs _ -> N.normalize [Env.Beta; Env.Iota; Env.Primops] g.tcenv t - | _ -> t) - - | Tm_let _ - | Tm_match _ -> - N.normalize [Env.Beta;Env.Iota;Env.Primops] g.tcenv t - | Tm_refine _ -> U.flatten_refinement t - | _ -> t in let beta_iota_reduce t = @@ -948,8 +945,11 @@ let rec check_relation (g:env) (rel:relation) (t0 t1:typ) guard (U.mk_forall u b.binder_bv (U.mk_imp f0 f1))) ) else ( - match maybe_unfold x0.sort x1.sort with - | None -> fallback t0 t1 + match! maybe_unfold x0.sort x1.sort with + | None -> + if !dbg then + BU.print2 "Cannot match ref heads %s and %s\n" (show x0.sort) (show x1.sort); + fallback t0 t1 | Some (t0, t1) -> let lhs = S.mk (Tm_refine {b={x0 with sort = t0}; phi=f0}) t0.pos in let rhs = S.mk (Tm_refine {b={x1 with sort = t1}; phi=f1}) t1.pos in @@ -960,7 +960,7 @@ let rec check_relation (g:env) (rel:relation) (t0 t1:typ) if head_matches x0.sort t1 then check_relation g rel x0.sort t1 else ( - match maybe_unfold x0.sort t1 with + match! maybe_unfold x0.sort t1 with | None -> fallback t0 t1 | Some (t0, t1) -> let lhs = S.mk (Tm_refine {b={x0 with sort = t0}; phi=f0}) t0.pos in @@ -994,7 +994,7 @@ let rec check_relation (g:env) (rel:relation) (t0 t1:typ) guard (U.mk_forall u1 b1.binder_bv f1) ) else ( - match maybe_unfold t0 x1.sort with + match! maybe_unfold t0 x1.sort with | None -> fallback t0 t1 | Some (t0, t1) -> let rhs = S.mk (Tm_refine {b={x1 with sort = t1}; phi=f1}) t1.pos in @@ -1104,7 +1104,7 @@ let rec check_relation (g:env) (rel:relation) (t0 t1:typ) let bs0 = List.map S.mk_binder bvs0 in // We need universes for the binders let! us = check_binders g bs0 in - with_binders bs0 us (check_relation g' rel body0 body1) + with_context "relate_branch" None (fun _ -> with_binders bs0 us (check_relation g' rel body0 body1)) | _ -> fail "raw_pat_as_exp failed in check_equality match rule" end | _ -> fail "Core does not support branches with when" @@ -1138,7 +1138,7 @@ and check_relation_comp (g:env) rel (c0 c1:comp) match destruct_comp c0, destruct_comp c1 with | None, _ | _, None -> - if U.eq_comp c0 c1 = U.Equal + if TEQ.eq_comp g.tcenv c0 c1 = TEQ.Equal then return () else ( let ct_eq res0 args0 res1 args1 = @@ -1374,7 +1374,7 @@ and do_check (g:env) (e:term) let! eff, te = check "ascription head" g e in let! _ = with_context "ascription comp" None (fun _ -> check_comp g c) in let c_e = as_comp g (eff, te) in - check_relation_comp g (SUBTYPING (Some e)) c_e c;! + with_context "ascription subtyping (comp)" None (fun _ -> check_relation_comp g (SUBTYPING (Some e)) c_e c);! let Some (eff, t) = comp_as_tot_or_ghost_and_type c in return (eff, t) ) @@ -1383,12 +1383,12 @@ and do_check (g:env) (e:term) | Tm_let {lbs=(false, [lb]); body} -> let Inl x = lb.lbname in let g', x, body = open_term g (S.mk_binder x) body in - if I.lid_equals lb.lbeff PC.effect_Tot_lid + if U.is_pure_or_ghost_effect lb.lbeff then ( let! eff_def, tdef = check "let definition" g lb.lbdef in let! _, ttyp = check "let type" g lb.lbtyp in let! u = is_type g ttyp in - with_context "let subtyping" None (fun _ -> check_subtype g (Some lb.lbdef) tdef ttyp) ;! + with_context "let subtyping" None (fun _ -> check_subtype g (Some lb.lbdef) tdef lb.lbtyp) ;! with_definition x u lb.lbdef ( let! eff_body, t = check "let body" g' body in check_no_escape [x] t;! @@ -1523,7 +1523,7 @@ and do_check (g:env) (e:term) then EQUALITY else SUBTYPING (Some b) in - check_relation g' rel tbr expect_tbr;! + with_context "branch check relation" None (fun _ -> check_relation g' rel tbr expect_tbr);! return (join_eff eff_br acc_eff, expect_tbr))) in match p.v with | Pat_var _ -> @@ -1615,7 +1615,7 @@ and check_pat (g:env) (p:pat) (t_sc:typ) : result (binders & universes) = | _ -> mk (Tm_constant c) p.p in let! _, t_const = check "pat_const" g e in - let! _ = check_subtype g (Some e) t_const (unrefine_tsc t_sc) in + let! _ = with_context "check_pat constant" None (fun () -> check_subtype g (Some e) t_const (unrefine_tsc t_sc)) in return ([], []) | Pat_var bv -> @@ -1649,7 +1649,7 @@ and check_pat (g:env) (p:pat) (t_sc:typ) : result (binders & universes) = | _ -> fail "check_pat in core has unset dot pattern" in let! _, p_t = check "pat dot term" g pat_dot_t in - let!_ = check_subtype g (Some pat_dot_t) p_t expected_t in + let!_ = with_context "check_pat cons" None (fun _ -> check_subtype g (Some pat_dot_t) p_t expected_t) in return (ss@[NT (f, pat_dot_t)])) [] dot_formals dot_pats in @@ -1843,19 +1843,18 @@ let simplify_steps = let check_term_top_gh g e topt (must_tot:bool) (gh:option guard_handler_t) : __result ((tot_or_ghost & S.typ) & precondition) - = if Env.debug g (Options.Other "CoreEq") + = if !dbg_Eq then BU.print1 "(%s) Entering core ... \n" (BU.string_of_int (get_goal_ctr())); - if Env.debug g (Options.Other "Core") - || Env.debug g (Options.Other "CoreTop") + if !dbg || !dbg_Top then BU.print3 "(%s) Entering core with %s <: %s\n" (BU.string_of_int (get_goal_ctr())) (P.term_to_string e) (match topt with None -> "" | Some t -> P.term_to_string t); THT.reset_counters table; reset_cache_stats(); - let ctx = { no_guard = false; error_context = [("Top", None)] } in + let ctx = { unfolding_ok = true; no_guard = false; error_context = [("Top", None)] } in let res = Profiling.profile (fun () -> @@ -1870,18 +1869,16 @@ let check_term_top_gh g e topt (must_tot:bool) (gh:option guard_handler_t) match res with | Success (et, Some guard0) -> // Options.push(); - // Options.set_option "debug_level" (Options.List [Options.String "Unfolding"]); + // Options.set_option "debug" (Options.List [Options.String "Unfolding"]); let guard = N.normalize simplify_steps g guard0 in // Options.pop(); - if Env.debug g (Options.Other "CoreExit") - || Env.debug g (Options.Other "Core") - || Env.debug g (Options.Other "CoreTop") + if !dbg || !dbg_Top || !dbg_Exit then begin BU.print3 "(%s) Exiting core: Simplified guard from {{%s}} to {{%s}}\n" (BU.string_of_int (get_goal_ctr())) (P.term_to_string guard0) (P.term_to_string guard); - let guard_names = Syntax.Free.names guard |> Set.elems in + let guard_names = Syntax.Free.names guard |> elems in match List.tryFind (fun bv -> List.for_all (fun binding_env -> match binding_env with | Binding_var bv_env -> not (S.bv_eq bv_env bv) @@ -1893,20 +1890,18 @@ let check_term_top_gh g e topt (must_tot:bool) (gh:option guard_handler_t) Success (et, Some guard) | Success _ -> - if Env.debug g (Options.Other "Core") - || Env.debug g (Options.Other "CoreTop") + if !dbg || !dbg_Top then BU.print1 "(%s) Exiting core (ok)\n" (BU.string_of_int (get_goal_ctr())); res | Error _ -> - if Env.debug g (Options.Other "Core") - || Env.debug g (Options.Other "CoreTop") + if !dbg || !dbg_Top then BU.print1 "(%s) Exiting core (failed)\n" (BU.string_of_int (get_goal_ctr())); res in - if Env.debug g (Options.Other "CoreEq") + if !dbg_Eq then ( THT.print_stats table; let cs = report_cache_stats() in @@ -1946,13 +1941,14 @@ let open_binders_in_comp (env:Env.env) (bs:binders) (c:comp) = let g', bs, c = open_comp_binders g bs c in g'.tcenv, bs, c -let check_term_equality g t0 t1 +let check_term_equality guard_ok unfolding_ok g t0 t1 = let g = initial_env g None in - if Env.debug g.tcenv (Options.Other "CoreTop") then - BU.print2 "Entering check_term_equality with %s and %s {\n" (show t0) (show t1); - let ctx = { no_guard = false ; error_context = [("Eq", None)] } in + if !dbg_Top then + BU.print4 "Entering check_term_equality with %s and %s (guard_ok=%s; unfolding_ok=%s) {\n" + (show t0) (show t1) (show guard_ok) (show unfolding_ok); + let ctx = { unfolding_ok = unfolding_ok; no_guard = not guard_ok; error_context = [("Eq", None)] } in let r = check_relation g EQUALITY t0 t1 ctx in - if Env.debug g.tcenv (Options.Other "CoreTop") then + if !dbg_Top then BU.print3 "} Exiting check_term_equality (%s, %s). Result = %s.\n" (show t0) (show t1) (show r); let r = match r with @@ -1961,9 +1957,9 @@ let check_term_equality g t0 t1 in r -let check_term_subtyping g t0 t1 +let check_term_subtyping guard_ok unfolding_ok g t0 t1 = let g = initial_env g None in - let ctx = { no_guard = false; error_context = [("Subtyping", None)] } in + let ctx = { unfolding_ok = unfolding_ok; no_guard = not guard_ok; error_context = [("Subtyping", None)] } in match check_relation g (SUBTYPING None) t0 t1 ctx with | Success (_, g) -> Inl g | Error err -> Inr err diff --git a/src/typechecker/FStar.TypeChecker.Core.fsti b/src/typechecker/FStar.TypeChecker.Core.fsti index 9d2e3432609..6f05e4fa321 100644 --- a/src/typechecker/FStar.TypeChecker.Core.fsti +++ b/src/typechecker/FStar.TypeChecker.Core.fsti @@ -43,11 +43,11 @@ val open_binders_in_term (g:Env.env) (bs:binders) (t:term) val open_binders_in_comp (g:Env.env) (bs:binders) (c:comp) : Env.env & binders & comp -(* for unit testing *) -val check_term_equality (g:Env.env) (t0 t1:typ) +(* For unit testing, and exposed to tactics *) +val check_term_equality (guard_ok:bool) (unfolding_ok:bool) (g:Env.env) (t0 t1:typ) : either (option typ) error -val check_term_subtyping (g:Env.env) (t0 t1:typ) +val check_term_subtyping (guard_ok:bool) (unfolding_ok:bool) (g:Env.env) (t0 t1:typ) : either (option typ) error val print_error (err:error) diff --git a/src/typechecker/FStar.TypeChecker.DMFF.fst b/src/typechecker/FStar.TypeChecker.DMFF.fst index ac6d797e8da..efa5a2b6d7a 100644 --- a/src/typechecker/FStar.TypeChecker.DMFF.fst +++ b/src/typechecker/FStar.TypeChecker.DMFF.fst @@ -40,6 +40,11 @@ module TcTerm = FStar.TypeChecker.TcTerm module BU = FStar.Compiler.Util //basic util module U = FStar.Syntax.Util module PC = FStar.Parser.Const +module TEQ = FStar.TypeChecker.TermEqAndSimplify + +open FStar.Class.Setlike + +let dbg = Debug.get_toggle "ED" let d s = BU.print1 "\x1b[01;36m%s\x1b[00m\n" s @@ -47,12 +52,12 @@ let d s = BU.print1 "\x1b[01;36m%s\x1b[00m\n" s // return a term that's a suitable reference (a [Tm_fv]) to the definition let mk_toplevel_definition (env: env_t) lident (def: term): sigelt * term = // Debug - if Env.debug env (Options.Other "ED") then begin + if !dbg then begin d (string_of_lid lident); BU.print2 "Registering top-level definition: %s\n%s\n" (string_of_lid lident) (Print.term_to_string def) end; // Allocate a new top-level name. - let fv = S.lid_and_dd_as_fv lident (U.incr_delta_qualifier def) None in + let fv = S.lid_and_dd_as_fv lident None in let lbname: lbname = Inr fv in let lb: letbindings = // the effect label will be recomputed correctly @@ -82,7 +87,7 @@ let gen_wps_for_free // Debugging let d s = BU.print1 "\x1b[01;36m%s\x1b[00m\n" s in - if Env.debug env (Options.Other "ED") then begin + if !dbg then begin d "Elaborating extra WP combinators"; BU.print1 "wp_a is: %s\n" (Print.term_to_string wp_a) end; @@ -120,7 +125,7 @@ let gen_wps_for_free let mk_lid name : lident = U.dm4f_lid ed name in let gamma = collect_binders wp_a |> U.name_binders in - if Env.debug env (Options.Other "ED") then + if !dbg then d (BU.format1 "Gamma is %s\n" (Print.binders_to_string ", " gamma)); let unknown = S.tun in let mk x = mk x Range.dummyRange in @@ -297,7 +302,7 @@ let gen_wps_for_free let result_comp = (mk_Total ((U.arrow [ S.null_binder wp_a; S.null_binder wp_a ] (mk_Total wp_a)))) in let c = S.gen_bv "c" None U.ktype in U.abs (binders @ S.binders_of_list [ a; c ]) ( - let l_ite = fvar_with_dd PC.ite_lid (S.Delta_constant_at_level 2) None in + let l_ite = fvar_with_dd PC.ite_lid None in U.ascribe ( U.mk_app c_lift2 (List.map S.as_arg [ U.mk_app l_ite [S.as_arg (S.bv_to_name c)] @@ -352,7 +357,7 @@ let gen_wps_for_free in let rec mk_rel rel t x y = let mk_rel = mk_rel rel in - let t = N.normalize [ Env.Beta; Env.Eager_unfolding; Env.UnfoldUntil S.delta_constant ] env t in + let t = N.normalize [ Env.Beta; Env.Eager_unfolding; Env.UnfoldTac; Env.UnfoldUntil S.delta_constant ] env t in match (SS.compress t).n with | Tm_type _ -> (* BU.print2 "type0, x=%s, y=%s\n" (Print.term_to_string x) (Print.term_to_string y); *) @@ -392,13 +397,13 @@ let gen_wps_for_free let wp1 = S.gen_bv "wp1" None wp_a in let wp2 = S.gen_bv "wp2" None wp_a in let rec mk_stronger t x y = - let t = N.normalize [ Env.Beta; Env.Eager_unfolding; Env.UnfoldUntil S.delta_constant ] env t in + let t = N.normalize [ Env.Beta; Env.Eager_unfolding; Env.UnfoldTac; Env.UnfoldUntil S.delta_constant ] env t in match (SS.compress t).n with | Tm_type _ -> U.mk_imp x y | Tm_app {hd=head; args} when is_tuple_constructor (SS.compress head) -> let project i tuple = (* TODO : I guess a projector shouldn't be handled as a constant... *) - let projector = S.fvar_with_dd (Env.lookup_projector env (PC.mk_tuple_data_lid (List.length args) Range.dummyRange) i) (S.Delta_constant_at_level 1) None in + let projector = S.fvar_with_dd (Env.lookup_projector env (PC.mk_tuple_data_lid (List.length args) Range.dummyRange) i) None in mk_app projector [tuple, None] in let (rel0,rels) = @@ -436,7 +441,7 @@ let gen_wps_for_free match destruct_typ_as_formula eq with | Some (QAll (binders, [], body)) -> let k_app = U.mk_app k_tm (args_of_binders binders) in - let guard_free = S.fv_to_tm (S.lid_and_dd_as_fv PC.guard_free delta_constant None) in + let guard_free = S.fv_to_tm (S.lid_and_dd_as_fv PC.guard_free None) in let pat = U.mk_app guard_free [as_arg k_app] in let pattern_guarded_body = mk (Tm_meta {tm=body; meta=Meta_pattern(binders_to_names binders, [[as_arg pat]])}) in @@ -477,7 +482,7 @@ let gen_wps_for_free let wp_trivial = register env (mk_lid "wp_trivial") wp_trivial in let wp_trivial = mk_generic_app wp_trivial in - if Env.debug env (Options.Other "ED") then + if !dbg then d "End Dijkstra monads for free"; let c = close binders in @@ -582,7 +587,7 @@ and star_type' env t = // (st a)* every time. let debug t s = let string_of_set f s = - let elts = Set.elems s in + let elts = elems s in match elts with | [] -> "{}" | x::xs -> @@ -606,15 +611,15 @@ and star_type' env t = else try let non_dependent_or_raise s ty = - let sinter = Set.inter (Free.names ty) s in - if not (Set.is_empty sinter) + let sinter = inter (Free.names ty) s in + if not (is_empty sinter) then (debug ty sinter ; raise Not_found) in let binders, c = SS.open_comp binders c in let s = List.fold_left (fun s ({binder_bv=bv}) -> non_dependent_or_raise s bv.sort ; - Set.add bv s - ) S.no_names binders in + add bv s + ) (Class.Setlike.empty ()) binders in let ct = U.comp_result c in non_dependent_or_raise s ct ; let k = n - List.length binders in @@ -640,7 +645,7 @@ and star_type' env t = if is_non_dependent_arrow ty (List.length args) then // We need to check that the result of the application is a datatype - let res = N.normalize [Env.EraseUniverses; Env.Inlining ; Env.UnfoldUntil S.delta_constant] env.tcenv t in + let res = N.normalize [Env.EraseUniverses; Env.Inlining ; Env.UnfoldTac; Env.UnfoldUntil S.delta_constant] env.tcenv t in begin match (SS.compress res).n with | Tm_app _ -> true | _ -> @@ -896,7 +901,7 @@ let rec check (env: env) (e: term) (context_nm: nm): nm * term * term = and infer (env: env) (e: term): nm * term * term = // BU.print1 "[debug]: infer %s\n" (Print.term_to_string e); let mk x = mk x e.pos in - let normalize = N.normalize [ Env.Beta; Env.Eager_unfolding; Env.UnfoldUntil S.delta_constant; Env.EraseUniverses ] env.tcenv in + let normalize = N.normalize [ Env.Beta; Env.Eager_unfolding; Env.UnfoldTac; Env.UnfoldUntil S.delta_constant; Env.EraseUniverses ] env.tcenv in match (SS.compress e).n with | Tm_bvar bv -> failwith "I failed to open a binder... boo" @@ -974,7 +979,7 @@ and infer (env: env) (e: term): nm * term * term = Some rc | Some rt -> - let rt = N.normalize [ Env.Beta; Env.Eager_unfolding; Env.UnfoldUntil S.delta_constant; Env.EraseUniverses ] (get_env env) rt in + let rt = N.normalize [ Env.Beta; Env.Eager_unfolding; Env.UnfoldTac; Env.UnfoldUntil S.delta_constant; Env.EraseUniverses ] (get_env env) rt in if rc.residual_flags |> BU.for_some (function CPS -> true | _ -> false) then let flags = List.filter (function CPS -> false | _ -> true) rc.residual_flags in @@ -1296,7 +1301,7 @@ and trans_F_ (env: env_) (c: typ) (wp: term): term = failwith "mismatch"; mk (Tm_app {hd=head; args=List.map2 (fun (arg, q) (wp_arg, q') -> let print_implicit q = if S.is_aqual_implicit q then "implicit" else "explicit" in - if eq_aqual q q' <> Equal + if not (eq_aqual q q') then Errors.log_issue head.pos (Errors.Warning_IncoherentImplicitQualifier, @@ -1344,7 +1349,7 @@ and trans_G (env: env_) (h: typ) (is_monadic: bool) (wp: typ): comp = // A helper -------------------------------------------------------------------- (* KM : why is there both NoDeltaSteps and UnfoldUntil Delta_constant ? *) -let n = N.normalize [ Env.Beta; Env.UnfoldUntil delta_constant; Env.DoNotUnfoldPureLets; Env.Eager_unfolding; Env.EraseUniverses ] +let n = N.normalize [ Env.UnfoldTac; Env.Beta; Env.UnfoldUntil delta_constant; Env.DoNotUnfoldPureLets; Env.Eager_unfolding; Env.EraseUniverses ] // Exported definitions ------------------------------------------------------- @@ -1360,10 +1365,10 @@ let trans_F (env: env_) (c: typ) (wp: term): term = // A helper to check that the terms elaborated by DMFF are well-typed let recheck_debug (s:string) (env:FStar.TypeChecker.Env.env) (t:S.term) : S.term = - if Env.debug env (Options.Other "ED") then + if !dbg then BU.print2 "Term has been %s-transformed to:\n%s\n----------\n" s (Print.term_to_string t); let t', _, _ = TcTerm.tc_term env t in - if Env.debug env (Options.Other "ED") then + if !dbg then BU.print1 "Re-checked; got:\n%s\n----------\n" (Print.term_to_string t'); t' @@ -1418,7 +1423,7 @@ let cps_and_elaborate (env:FStar.TypeChecker.Env.env) (ed:S.eff_decl) // TODO: check that [_comp] is [Tot Type] let repr, _comp = open_and_check env [] (ed |> U.get_eff_repr |> must |> snd) in - if Env.debug env (Options.Other "ED") then + if !dbg then BU.print1 "Representation is: %s\n" (Print.term_to_string repr); let ed_range = Env.get_range env in @@ -1533,7 +1538,7 @@ let cps_and_elaborate (env:FStar.TypeChecker.Env.env) (ed:S.eff_decl) match (SS.compress bind_wp).n with | Tm_abs {bs=binders; body; rc_opt=what} -> // TODO: figure out how to deal with ranges - //let r = S.lid_and_dd_as_fv PC.range_lid (S.Delta_constant_at_level 1) None in + //let r = S.lid_and_dd_as_fv PC.range_lid None in U.abs binders body what | _ -> raise_error (Errors.Fatal_UnexpectedBindShape, "unexpected shape for bind") @@ -1557,10 +1562,9 @@ let cps_and_elaborate (env:FStar.TypeChecker.Env.env) (ed:S.eff_decl) let l' = lid_of_path p' ed_range in match try_lookup_lid env l' with | Some (_us,_t) -> begin - if Options.debug_any () then + if Debug.any () then BU.print1 "DM4F: Applying override %s\n" (string_of_lid l'); - // TODO: GM: get exact delta depth, needs a change of interfaces - fv_to_tm (lid_and_dd_as_fv l' delta_equational None) + fv_to_tm (lid_and_dd_as_fv l' None) end | None -> let sigelt, fv = mk_toplevel_definition env (mk_lid name) (U.abs effect_binders item None) in @@ -1609,7 +1613,7 @@ let cps_and_elaborate (env:FStar.TypeChecker.Env.env) (ed:S.eff_decl) | [] -> action_typ_with_wp | _ -> flat_arrow action_params (S.mk_Total action_typ_with_wp) in - if Env.debug env <| Options.Other "ED" + if !dbg then BU.print4 "original action_params %s, end action_params %s, type %s, term %s\n" (Print.binders_to_string "," params_un) (Print.binders_to_string "," action_params) @@ -1652,7 +1656,7 @@ let cps_and_elaborate (env:FStar.TypeChecker.Env.env) (ed:S.eff_decl) let wp_binders, c = SS.open_comp wp_binders c in let pre_args, post_args = List.partition (fun ({binder_bv=bv}) -> - Free.names bv.sort |> Set.mem type_param.binder_bv |> not + Free.names bv.sort |> mem type_param.binder_bv |> not ) wp_binders in let post = match post_args with @@ -1705,7 +1709,7 @@ let cps_and_elaborate (env:FStar.TypeChecker.Env.env) (ed:S.eff_decl) // Generate the missing combinators. let sigelts', ed = gen_wps_for_free env effect_binders a wp_a ed in - if Env.debug env (Options.Other "ED") then + if !dbg then BU.print_string (Print.eff_decl_to_string true ed); let lift_from_pure_opt = diff --git a/src/typechecker/FStar.TypeChecker.DeferredImplicits.fst b/src/typechecker/FStar.TypeChecker.DeferredImplicits.fst index f25a796c536..3099e3a51d8 100644 --- a/src/typechecker/FStar.TypeChecker.DeferredImplicits.fst +++ b/src/typechecker/FStar.TypeChecker.DeferredImplicits.fst @@ -35,6 +35,9 @@ module BU = FStar.Compiler.Util module S = FStar.Syntax.Syntax module U = FStar.Syntax.Util module SS = FStar.Syntax.Subst +module TEQ = FStar.TypeChecker.TermEqAndSimplify + +open FStar.Class.Setlike let is_flex t = let head, _args = U.head_and_args_full t in @@ -54,31 +57,6 @@ type goal_type = | Can_be_split_into of term * term * ctx_uvar | Imp of ctx_uvar -type goal_dep = - { - goal_dep_id : int; // Assign each goal an id, for cycle detection - goal_type : goal_type; // What sort of goal ... - goal_imp : implicit; // The entire implicit from which this was generated - assignees : Set.t ctx_uvar; // The set of uvars assigned by the goal - goal_dep_uvars : Set.t ctx_uvar; // The set of uvars this goal depends on - dependences : ref goal_deps; // NB: mutable; the goals that must precede this one in the order - visited : ref int // NB: mutable; a field to mark visited goals during the sort - } -and goal_deps = list goal_dep - -let print_uvar_set (s:Set.t ctx_uvar) = - (Set.elems s - |> List.map (fun u -> "?" ^ (string_of_int <| Unionfind.uvar_id u.ctx_uvar_head)) - |> String.concat "; ") - -let print_goal_dep gd = - BU.format4 "%s:{assignees=[%s], dependences=[%s]}\n\t%s\n" - (BU.string_of_int gd.goal_dep_id) - (print_uvar_set gd.assignees) - (List.map (fun gd -> string_of_int gd.goal_dep_id) (!gd.dependences) - |> String.concat "; ") - (Print.ctx_uvar_to_string gd.goal_imp.imp_uvar) - (* If [u] is tagged with attribute [a] @@ -138,7 +116,7 @@ let find_user_tac_for_uvar env (u:ctx_uvar) : option sigelt = (* candidates: hooks that also have the attribute [a] *) let candidates = hooks |> List.filter - (fun hook -> hook.sigattrs |> BU.for_some (U.attr_eq a)) + (fun hook -> hook.sigattrs |> BU.for_some (TEQ.eq_tm_bool env a)) in (* The environment sometimes returns duplicates in the candidate list; filter out dups *) let candidates = @@ -169,7 +147,7 @@ let find_user_tac_for_uvar env (u:ctx_uvar) : option sigelt = | Tm_fvar fv, [_; (a', _); (overrides, _)] //type argument may be missing, since it is just an attr | Tm_fvar fv, [(a', _); (overrides, _)] when fv_eq_lid fv FStar.Parser.Const.override_resolve_implicits_handler_lid - && U.attr_eq a a' -> + && TEQ.eq_tm_bool env a a' -> //other has an attribute [@@override_resolve_implicits_handler a overrides] begin match attr_list_elements overrides with @@ -215,11 +193,6 @@ let solve_goals_with_tac env g (deferred_goals:implicits) (tac:sigelt) = | Sig_let {lids=[lid]} -> let qn = Env.lookup_qname env lid in let fv = S.lid_as_fv lid None in - let dd = - match Env.delta_depth_of_qninfo fv qn with - | Some dd -> dd - | None -> failwith "Expected a dd" - in let term = S.fv_to_tm (S.lid_as_fv lid None) in term | _ -> failwith "Resolve_tac not found" diff --git a/src/typechecker/FStar.TypeChecker.Env.fst b/src/typechecker/FStar.TypeChecker.Env.fst index e9997ec08c3..75c5ef69b7e 100644 --- a/src/typechecker/FStar.TypeChecker.Env.fst +++ b/src/typechecker/FStar.TypeChecker.Env.fst @@ -28,6 +28,7 @@ open FStar.Ident open FStar.Compiler.Range open FStar.Errors open FStar.TypeChecker.Common +open FStar.Class.Setlike open FStar.Class.Show open FStar.Class.PP @@ -42,6 +43,9 @@ module TcComm = FStar.TypeChecker.Common open FStar.Defensive +let dbg_ImplicitTrace = Debug.get_toggle "ImplicitTrace" +let dbg_LayeredEffectsEqns = Debug.get_toggle "LayeredEffectsEqns" + let rec eq_step s1 s2 = match s1, s2 with | Beta, Beta @@ -343,8 +347,7 @@ let incr_query_index env = //////////////////////////////////////////////////////////// // Checking the per-module debug level and position info // //////////////////////////////////////////////////////////// -let debug env (l:Options.debug_level_t) = - Options.debug_at_level (string_of_lid env.curmodule) l + let set_range e r = if r=dummyRange then e else {e with range=r} let get_range e = e.range @@ -494,7 +497,8 @@ let lookup_attr (env:env) (attr:string) : list sigelt = let add_se_to_attrtab env se = let add_one env se attr = BU.smap_add (attrtab env) attr (se :: lookup_attr env attr) in List.iter (fun attr -> - match (Subst.compress attr).n with + let hd, _ = U.head_and_args attr in + match (Subst.compress hd).n with | Tm_fvar fv -> add_one env se (string_of_lid (lid_of_fv fv)) | _ -> ()) se.sigattrs @@ -743,6 +747,12 @@ let typ_of_datacon env lid = | Some (Inr ({ sigel = Sig_datacon {ty_lid=l} }, _), _) -> l | _ -> failwith (BU.format1 "Not a datacon: %s" (Print.lid_to_string lid)) +let num_datacon_non_injective_ty_params env lid = + match lookup_qname env lid with + | Some (Inr ({ sigel = Sig_datacon {num_ty_params; injective_type_params} }, _), _) -> + if injective_type_params then Some 0 else Some num_ty_params + | _ -> None + let lookup_definition_qninfo_aux rec_ok delta_levels lid (qninfo : qninfo) = let visible quals = delta_levels |> BU.for_some (fun dl -> quals |> BU.for_some (visible_at dl)) @@ -771,96 +781,112 @@ let lookup_definition delta_levels env lid = let lookup_nonrec_definition delta_levels env lid = lookup_definition_qninfo_aux false delta_levels lid <| lookup_qname env lid -let delta_depth_of_qninfo_lid lid (qn:qninfo) : option delta_depth = - match qn with - | None - | Some (Inl _, _) -> Some (Delta_constant_at_level 0) - | Some (Inr(se, _), _) -> - match se.sigel with - | Sig_inductive_typ _ - | Sig_bundle _ - | Sig_datacon _ -> Some (Delta_constant_at_level 0) - | Sig_declare_typ _ -> Some (FStar.Syntax.DsEnv.delta_depth_of_declaration lid se.sigquals) - | Sig_let {lbs=(_,lbs)} -> - BU.find_map lbs (fun lb -> - let fv = right lb.lbname in - if fv_eq_lid fv lid - then fv.fv_delta - else None) - - | Sig_fail _ - | Sig_splice _ -> - failwith "impossible: delta_depth_of_qninfo" - - | Sig_assume _ - | Sig_new_effect _ - | Sig_sub_effect _ - | Sig_effect_abbrev _ (* None? *) - | Sig_pragma _ - | Sig_polymonadic_bind _ - | Sig_polymonadic_subcomp _ -> None - - -// -// For the following prims symbols, -// delta depth is handled specially -// Instead of looking it up in the env, -// we return as is set in the input fv.fv_delta -// No principled reason, for backward compatibility -// -let prims_dd_lids = [ - Const.and_lid; - Const.or_lid; - Const.imp_lid; - Const.iff_lid; - Const.true_lid; - Const.false_lid; - Const.not_lid; - Const.b2t_lid; - Const.eq2_lid; - Const.eq3_lid; - Const.op_Eq; - Const.op_LT; - Const.op_LTE; - Const.op_GT; - Const.op_GTE; - Const.forall_lid; - Const.exists_lid; - Const.haseq_lid; - Const.op_And; - Const.op_Or; - Const.op_Negation; -] - -let is_prims_dd_lid (l:lident) = - List.existsb (fun l0 -> lid_equals l l0) prims_dd_lids - -let delta_depth_of_qninfo (fv:fv) (qn:qninfo) : option delta_depth = - let lid = fv.fv_name.v in - if is_prims_dd_lid lid && Some? fv.fv_delta - then fv.fv_delta //NS delta: too many special cases in existing code - else delta_depth_of_qninfo_lid lid qn - -let delta_depth_of_fv env fv = +let rec delta_depth_of_qninfo_lid env lid (qn:qninfo) : delta_depth = + match qn with + | None + | Some (Inl _, _) -> delta_constant + | Some (Inr(se, _), _) -> + match se.sigel with + | Sig_inductive_typ _ + | Sig_bundle _ + | Sig_datacon _ -> delta_constant + + | Sig_declare_typ _ -> + let d0 = + if U.is_primop_lid lid + then delta_equational + else delta_constant + in + if se.sigquals |> BU.for_some (Assumption?) + && not (se.sigquals |> BU.for_some (New?)) + then Delta_abstract d0 + else d0 + + | Sig_let {lbs=(_,lbs)} -> + BU.find_map lbs (fun lb -> + let fv = right lb.lbname in + if fv_eq_lid fv lid then + Some (incr_delta_depth <| delta_depth_of_term env lb.lbdef) + else None) |> must + + | Sig_fail _ + | Sig_splice _ -> + failwith "impossible: delta_depth_of_qninfo" + + | Sig_assume _ + | Sig_new_effect _ + | Sig_sub_effect _ + | Sig_effect_abbrev _ (* None? *) + | Sig_pragma _ + | Sig_polymonadic_bind _ + | Sig_polymonadic_subcomp _ -> + delta_constant + +and delta_depth_of_qninfo env (fv:fv) (qn:qninfo) : delta_depth = + delta_depth_of_qninfo_lid env fv.fv_name.v qn + +(* Computes the canonical delta_depth of a given fvar, by looking at its +definition (and recursing) if needed. Results are memoized in the env. + +NB: The cache is never invalidated. A potential problem here would be +if we memoize the delta_depth of a `val` before seeing the corresponding +`let`, but I don't think that can happen. Before seeing the `let`, other code +cannot refer to the name. *) +and delta_depth_of_fv (env:env) (fv:S.fv) : delta_depth = let lid = fv.fv_name.v in - if is_prims_dd_lid lid && Some? fv.fv_delta - then fv.fv_delta |> must - else - //try cache - (string_of_lid lid) |> BU.smap_try_find env.fv_delta_depths |> (fun d_opt -> - if d_opt |> is_some then d_opt |> must - else - match delta_depth_of_qninfo fv (lookup_qname env fv.fv_name.v) with - | None -> failwith (BU.format1 "Delta depth not found for %s" (FStar.Syntax.Print.fv_to_string fv)) - | Some d -> - if Some? fv.fv_delta && d <> Some?.v fv.fv_delta - && Options.debug_any() - then BU.print3 "WARNING WARNING WARNING fv=%s, delta_depth=%s, env.delta_depth=%s\n" - (Print.fv_to_string fv) - (show (Some?.v fv.fv_delta)) - (show d); - BU.smap_add env.fv_delta_depths (string_of_lid lid) d; - d) + (string_of_lid lid) |> BU.smap_try_find env.fv_delta_depths |> (function + | Some dd -> dd + | None -> + BU.smap_add env.fv_delta_depths (string_of_lid lid) delta_equational; + // ^ To prevent an infinite loop on recursive functions, we pre-seed the cache with + // a delta_equational. If we run into the same function while computing its delta_depth, + // we will return delta_equational. If not, we override the cache with the correct delta_depth. + let d = delta_depth_of_qninfo env fv (lookup_qname env fv.fv_name.v) in + // if Debug.any () then + // BU.print2_error "Memoizing delta_depth_of_fv %s ->\t%s\n" (show lid) (show d); + BU.smap_add env.fv_delta_depths (string_of_lid lid) d; + d) + +(* Computes the delta_depth of an fv, but taking into account the visibility +in the current module. *) +and fv_delta_depth (env:env) (fv:S.fv) : delta_depth = + let d = delta_depth_of_fv env fv in + match d with + | Delta_abstract (Delta_constant_at_level l) -> + if string_of_lid env.curmodule = nsstr fv.fv_name.v && not env.is_iface + //AR: TODO: this is to prevent unfolding of abstract symbols in the extracted interface + //a better way would be create new fvs with appripriate delta_depth at extraction time + then Delta_constant_at_level l //we're in the defining module + else delta_constant + | d -> d + +(* Computes the delta_depth of a term. This is the single way to compute it. *) +and delta_depth_of_term env t = + let t = U.unmeta t in + match t.n with + | Tm_meta _ + | Tm_delayed _ -> failwith "Impossible (delta depth of term)" + | Tm_lazy i -> delta_depth_of_term env (U.unfold_lazy i) + + | Tm_fvar fv -> fv_delta_depth env fv + + | Tm_bvar _ + | Tm_name _ + | Tm_match _ + | Tm_uvar _ + | Tm_unknown -> delta_equational + + | Tm_type _ + | Tm_quoted _ + | Tm_constant _ + | Tm_arrow _ -> delta_constant + + | Tm_uinst(t, _) + | Tm_refine {b={sort=t}} + | Tm_ascribed {tm=t} + | Tm_app {hd=t} + | Tm_abs {body=t} + | Tm_let {body=t} -> delta_depth_of_term env t let quals_of_qninfo (qninfo : qninfo) : option (list qualifier) = match qninfo with @@ -1241,7 +1267,7 @@ let all_binders env = binders_of_bindings env.gamma let bound_vars env = bound_vars_of_bindings env.gamma instance hasBinders_env : hasBinders env = { - boundNames = (fun e -> Set.from_list (bound_vars e) ); + boundNames = (fun e -> FlatSet.from_list (bound_vars e) ); } instance hasNames_lcomp : hasNames lcomp = { @@ -1254,7 +1280,7 @@ instance pretty_lcomp : pretty lcomp = { instance hasNames_guard : hasNames guard_t = { freeNames = (fun g -> match g.guard_f with - | Trivial -> Set.empty () + | Trivial -> FlatSet.empty () | NonTrivial f -> freeNames f); } @@ -1745,35 +1771,32 @@ let finish_module = // Collections from the environment // //////////////////////////////////////////////////////////// let uvars_in_env env = - let no_uvs = Free.new_uv_set () in - let ext out uvs = Set.union out uvs in + let no_uvs = empty () in let rec aux out g = match g with | [] -> out | Binding_univ _ :: tl -> aux out tl | Binding_lid(_, (_, t))::tl - | Binding_var({sort=t})::tl -> aux (ext out (Free.uvars t)) tl + | Binding_var({sort=t})::tl -> aux (union out (Free.uvars t)) tl in aux no_uvs env.gamma let univ_vars env = - let no_univs = Free.new_universe_uvar_set () in - let ext out uvs = Set.union out uvs in + let no_univs = empty () in let rec aux out g = match g with | [] -> out | Binding_univ _ :: tl -> aux out tl | Binding_lid(_, (_, t))::tl - | Binding_var({sort=t})::tl -> aux (ext out (Free.univs t)) tl + | Binding_var({sort=t})::tl -> aux (union out (Free.univs t)) tl in aux no_univs env.gamma let univnames env = - let no_univ_names = Syntax.no_universe_names in - let ext out uvs = Set.union out uvs in + let no_univ_names = empty () in let rec aux out g = match g with | [] -> out - | Binding_univ uname :: tl -> aux (Set.add uname out) tl + | Binding_univ uname :: tl -> aux (add uname out) tl | Binding_lid(_, (_, t))::tl - | Binding_var({sort=t})::tl -> aux (ext out (Free.univnames t)) tl + | Binding_var({sort=t})::tl -> aux (union out (Free.univnames t)) tl in aux no_univ_names env.gamma @@ -1804,15 +1827,15 @@ let rem_proof_ns e path = cons_proof_ns false e path let get_proof_ns e = e.proof_ns let set_proof_ns ns e = {e with proof_ns = ns} -let unbound_vars (e : env) (t : term) : Set.t bv = +let unbound_vars (e : env) (t : term) : FlatSet.t bv = // FV(t) \ Vars(Γ) - List.fold_left (fun s bv -> Set.remove bv s) (Free.names t) (bound_vars e) + List.fold_left (fun s bv -> remove bv s) (Free.names t) (bound_vars e) let closed (e : env) (t : term) = - Set.is_empty (unbound_vars e t) + is_empty (unbound_vars e t) let closed' (t : term) = - Set.is_empty (Free.names t) + is_empty (Free.names t) let string_of_proof_ns env = let aux (p,b) = @@ -1957,7 +1980,7 @@ let new_tac_implicit_var reason r env k should_check uvar_typedness_deps meta = ; imp_uvar = ctx_uvar ; imp_range = r } in - if debug env (Options.Other "ImplicitTrace") then + if !dbg_ImplicitTrace then BU.print1 "Just created uvar for implicit {%s}\n" (Print.uvar_to_string ctx_uvar.ctx_uvar_head); let g = {trivial_guard with implicits=[imp]} in t, [(ctx_uvar, r)], g @@ -1990,7 +2013,7 @@ let uvars_for_binders env (bs:S.binders) substs reason r = else Strict) ctx_uvar_meta_t in - if debug env <| Options.Other "LayeredEffectsEqns" + if !dbg_LayeredEffectsEqns then List.iter (fun (ctx_uvar, _) -> BU.print1 "Layered Effect uvar : %s\n" (Print.ctx_uvar_to_string ctx_uvar)) l_ctx_uvars; @@ -2027,11 +2050,6 @@ let get_letrec_arity (env:env) (lbname:lbname) : option int = let fvar_of_nonqual_lid env lid = let qn = lookup_qname env lid in - let dd = - match delta_depth_of_qninfo_lid lid qn with - | None -> failwith "Unexpected no delta_depth" - | Some dd -> dd - in fvar lid None let split_smt_query (e:env) (q:term) diff --git a/src/typechecker/FStar.TypeChecker.Env.fsti b/src/typechecker/FStar.TypeChecker.Env.fsti index 5c23de1131b..578f4588f08 100644 --- a/src/typechecker/FStar.TypeChecker.Env.fsti +++ b/src/typechecker/FStar.TypeChecker.Env.fsti @@ -36,7 +36,7 @@ type step = | ZetaFull //fixed points, even under blocked matches | Exclude of step //the first three kinds are included by default, unless Excluded explicity | Weak //Do not descend into binders - | HNF //Only produce a head normal form + | HNF //Only produce a head normal form: Do not descend into function arguments or into binder types | Primops //reduce primitive operators like +, -, *, /, etc. | Eager_unfolding | Inlining @@ -289,7 +289,6 @@ val snapshot : env -> string -> (tcenv_depth_t * env) val rollback : solver_t -> string -> option tcenv_depth_t -> env (* Checking the per-module debug level and position info *) -val debug : env -> Options.debug_level_t -> bool val current_module : env -> lident val set_range : env -> Range.range -> env val get_range : env -> Range.range @@ -344,7 +343,8 @@ val is_irreducible : env -> lident -> bool val is_type_constructor : env -> lident -> bool val num_inductive_ty_params: env -> lident -> option int val num_inductive_uniform_ty_params: env -> lident -> option int -val delta_depth_of_qninfo : fv -> qninfo -> option delta_depth +val num_datacon_non_injective_ty_params : env -> lident -> option int +val delta_depth_of_qninfo : env -> fv -> qninfo -> delta_depth val delta_depth_of_fv : env -> fv -> delta_depth (* Universe instantiation *) @@ -405,8 +405,8 @@ val bound_vars : env -> list bv val all_binders : env -> binders val modules : env -> list modul val uvars_in_env : env -> uvars -val univ_vars : env -> Set.set universe_uvar -val univnames : env -> Set.set univ_name +val univ_vars : env -> FlatSet.t universe_uvar +val univnames : env -> FlatSet.t univ_name val lidents : env -> list lident (* operations on monads *) @@ -456,7 +456,7 @@ val set_proof_ns : proof_namespace -> env -> env val string_of_proof_ns : env -> string (* Check that all free variables of the term are defined in the environment *) -val unbound_vars : env -> term -> Set.set bv +val unbound_vars : env -> term -> FlatSet.t bv val closed : env -> term -> bool val closed' : term -> bool @@ -546,3 +546,6 @@ instance val hasNames_lcomp : hasNames lcomp instance val pretty_lcomp : FStar.Class.PP.pretty lcomp instance val hasNames_guard : hasNames guard_t instance val pretty_guard : FStar.Class.PP.pretty guard_t + +val fv_delta_depth : env -> fv -> delta_depth +val delta_depth_of_term : env -> term -> delta_depth diff --git a/src/typechecker/FStar.TypeChecker.Err.fst b/src/typechecker/FStar.TypeChecker.Err.fst index 0a7110365ba..7ed7da4421d 100644 --- a/src/typechecker/FStar.TypeChecker.Err.fst +++ b/src/typechecker/FStar.TypeChecker.Err.fst @@ -33,6 +33,9 @@ module BU = FStar.Compiler.Util //basic util module Env = FStar.TypeChecker.Env open FStar.TypeChecker.Common +open FStar.Errors.Msg +open FStar.Class.PP + let info_at_pos env file row col = match TypeChecker.Common.id_info_at_pos !env.identifier_info file row col with | None -> None @@ -123,12 +126,6 @@ let print_discrepancy (#a:Type) (#b:eqtype) (f : a -> b) (x : a) (y : a) : b * b in Options.with_saved_options (fun () -> go bas) -(* - * AR: smt_detail is either an Inr of a long multi-line message or Inr of a short one - * in the first case, we print it starting from a newline, - * while in the latter, it is printed on the same line - * GM: TODO: Use a document? - *) let errors_smt_detail env (errs : list Errors.error) (smt_detail : Errors.error_message) @@ -179,14 +176,20 @@ let err_msg_comp_strings env c1 c2 :(string * string) = print_discrepancy (N.comp_to_string env) c1 c2 (* Error messages for labels in VCs *) -let exhaustiveness_check = "Patterns are incomplete" +let exhaustiveness_check = [ + FStar.Errors.Msg.text "Patterns are incomplete" +] -let subtyping_failed : env -> typ -> typ -> unit -> string = +let subtyping_failed : env -> typ -> typ -> unit -> error_message = fun env t1 t2 () -> - let s1, s2 = err_msg_type_strings env t1 t2 in - BU.format2 "Subtyping check failed; expected type %s; got type %s" s2 s1 -let ill_kinded_type = "Ill-kinded type" -let totality_check = "This term may not terminate" + // let s1, s2 = err_msg_type_strings env t1 t2 in + let ppt = N.term_to_doc env in + [text "Subtyping check failed"; + prefix 2 1 (text "Expected type") (ppt t2) ^/^ + prefix 2 1 (text "got type") (ppt t1); + ] + +let ill_kinded_type = Errors.mkmsg "Ill-kinded type" let unexpected_signature_for_monad env m k = (Errors.Fatal_UnexpectedSignatureForMonad, (format2 "Unexpected signature for monad \"%s\". Expected a signature of the form (a:Type -> WP a -> Effect); got %s" @@ -219,9 +222,18 @@ let expected_pattern_of_type env t1 e t2 = let basic_type_error env eopt t1 t2 = let s1, s2 = err_msg_type_strings env t1 t2 in + let open FStar.Errors.Msg in let msg = match eopt with - | None -> format2 "Expected type \"%s\"; got type \"%s\"" s1 s2 - | Some e -> format3 "Expected type \"%s\"; but \"%s\" has type \"%s\"" s1 (N.term_to_string env e) s2 in + | None -> [ + prefix 4 1 (text "Expected type") (N.term_to_doc env t1) ^/^ + prefix 4 1 (text "got type") (N.term_to_doc env t2); + ] + | Some e -> [ + prefix 4 1 (text "Expected type") (N.term_to_doc env t1) ^/^ + prefix 4 1 (text "but") (N.term_to_doc env e) ^/^ + prefix 4 1 (text "has type") (N.term_to_doc env t2); + ] + in (Errors.Error_TypeError, msg) let occurs_check = @@ -260,41 +272,42 @@ let name_and_result c = match c.n with | Comp ct -> Print.lid_to_string ct.effect_name, ct.result_typ let computed_computation_type_does_not_match_annotation env e c c' = + let ppt = N.term_to_doc env in let f1, r1 = name_and_result c in let f2, r2 = name_and_result c' in - let s1, s2 = err_msg_type_strings env r1 r2 in - (Errors.Fatal_ComputedTypeNotMatchAnnotation, (format4 - "Computed type \"%s\" and effect \"%s\" is not compatible with the annotated type \"%s\" effect \"%s\"" - s1 f1 s2 f2)) + (Errors.Fatal_ComputedTypeNotMatchAnnotation, [ + prefix 2 1 (text "Computed type") (ppt r1) ^/^ + prefix 2 1 (text "and effect") (text f1) ^/^ + prefix 2 1 (text "is not compatible with the annotated type") (ppt r2) ^/^ + prefix 2 1 (text "and effect") (text f2) + ]) let computed_computation_type_does_not_match_annotation_eq env e c c' = - let s1, s2 = err_msg_comp_strings env c c' in - (Errors.Fatal_ComputedTypeNotMatchAnnotation, (format2 - "Computed type \"%s\" does not match annotated type \"%s\", and no subtyping was allowed" - s1 s2)) + let ppc = N.comp_to_doc env in + (Errors.Fatal_ComputedTypeNotMatchAnnotation, ([ + prefix 2 1 (text "Computed type") (ppc c) ^/^ + prefix 2 1 (text "does not match annotated type") (ppc c') ^/^ + text "and no subtyping was allowed"; + ])) let unexpected_non_trivial_precondition_on_term env f = (Errors.Fatal_UnExpectedPreCondition, (format1 "Term has an unexpected non-trivial pre-condition: %s" (N.term_to_string env f))) -let expected_pure_expression e c reason = - let msg = "Expected a pure expression" in - let msg = - if reason = "" - then msg - else BU.format1 (msg ^ " (%s)") reason in - (Errors.Fatal_ExpectedPureExpression, - format2 (msg ^ "; got an expression \"%s\" with effect \"%s\"") - (Print.term_to_string e) (fst <| name_and_result c)) - -let expected_ghost_expression e c reason = - let msg = "Expected a ghost expression" in - let msg = - if reason = "" - then msg - else BU.format1 (msg ^ " (%s)") reason in - (Errors.Fatal_ExpectedGhostExpression, - format2 (msg ^ "; got an expression \"%s\" with effect \"%s\"") - (Print.term_to_string e) (fst <| name_and_result c)) +let __expected_eff_expression (effname:string) (e:term) (c:comp) (reason:string) = + let open FStar.Class.PP in + let open FStar.Pprint in + (Errors.Fatal_ExpectedGhostExpression, [ + text ("Expected a " ^ effname ^ " expression."); + (if reason = "" then empty else flow (break_ 1) (doc_of_string "Because:" :: words (reason ^ "."))); + prefix 2 1 (text "Got an expression") (pp e) ^/^ + prefix 2 1 (text "with effect") (squotes (doc_of_string (fst <| name_and_result c))) ^^ dot; + ]) + +let expected_pure_expression (e:term) (c:comp) (reason:string) = + __expected_eff_expression "pure" e c reason + +let expected_ghost_expression (e:term) (c:comp) (reason:string) = + __expected_eff_expression "ghost" e c reason let expected_effect_1_got_effect_2 (c1:lident) (c2:lident) = (Errors.Fatal_UnexpectedEffect, (format2 "Expected a computation with effect %s; but it has effect %s" (Print.lid_to_string c1) (Print.lid_to_string c2))) diff --git a/src/typechecker/FStar.TypeChecker.Generalize.fst b/src/typechecker/FStar.TypeChecker.Generalize.fst index 540bb1237fa..6d6a2b10d47 100644 --- a/src/typechecker/FStar.TypeChecker.Generalize.fst +++ b/src/typechecker/FStar.TypeChecker.Generalize.fst @@ -26,6 +26,7 @@ open FStar.Syntax.Syntax open FStar.TypeChecker.Env open FStar.Class.Show +open FStar.Class.Setlike module BU = FStar.Compiler.Util module S = FStar.Syntax.Syntax @@ -37,6 +38,8 @@ module UF = FStar.Syntax.Unionfind module Env = FStar.TypeChecker.Env module N = FStar.TypeChecker.Normalize +let dbg_Gen = Debug.get_toggle "Gen" + instance showable_univ_var : showable universe_uvar = { show = (fun u -> show (U_unif u)); } @@ -45,15 +48,15 @@ instance showable_univ_var : showable universe_uvar = { (* Generalizing types *) (**************************************************************************************) -let gen_univs env (x:Set.t universe_uvar) : list univ_name = - if Set.is_empty x then [] - else let s = Set.diff x (Env.univ_vars env) |> Set.elems in // GGG: bad, order dependent - if Env.debug env <| Options.Other "Gen" then +let gen_univs env (x:FlatSet.t universe_uvar) : list univ_name = + if is_empty x then [] + else let s = diff x (Env.univ_vars env) |> elems in // GGG: bad, order dependent + if !dbg_Gen then BU.print1 "univ_vars in env: %s\n" (show (Env.univ_vars env)); let r = Some (Env.get_range env) in let u_names = s |> List.map (fun u -> let u_name = Syntax.new_univ_name r in - if Env.debug env <| Options.Other "Gen" then + if !dbg_Gen then BU.print3 "Setting ?%s (%s) to %s\n" (string_of_int <| UF.univ_uvar_id u) (show (U_unif u)) @@ -63,10 +66,10 @@ let gen_univs env (x:Set.t universe_uvar) : list univ_name = in u_names -let gather_free_univnames env t : Set.t univ_name = +let gather_free_univnames env t : FlatSet.t univ_name = let ctx_univnames = Env.univnames env in let tm_univnames = Free.univnames t in - let univnames = Set.diff tm_univnames ctx_univnames in + let univnames = diff tm_univnames ctx_univnames in // BU.print4 "Closing universe variables in term %s : %s in ctx, %s in tm, %s globally\n" // (show t) // (Common.string_of_set Ident.string_of_id ctx_univnames) @@ -89,14 +92,14 @@ let check_universe_generalization let generalize_universes (env:env) (t0:term) : tscheme = Errors.with_ctx "While generalizing universes" (fun () -> let t = N.normalize [Env.NoFullNorm; Env.Beta; Env.DoNotUnfoldPureLets] env t0 in - let univnames = Set.elems (gather_free_univnames env t) in /// GGG: bad, order dependent - if Env.debug env <| Options.Other "Gen" + let univnames = elems (gather_free_univnames env t) in /// GGG: bad, order dependent + if !dbg_Gen then BU.print2 "generalizing universes in the term (post norm): %s with univnames: %s\n" (show t) (show univnames); let univs = Free.univs t in - if Env.debug env <| Options.Other "Gen" + if !dbg_Gen then BU.print1 "univs to gen : %s\n" (show univs); let gen = gen_univs env univs in - if Env.debug env <| Options.Other "Gen" + if !dbg_Gen then BU.print2 "After generalization, t: %s and univs: %s\n" (show t) (show gen); let univs = check_universe_generalization univnames gen t0 in let t = N.reduce_uvar_solutions env t in @@ -109,30 +112,30 @@ let gen env (is_rec:bool) (lecs:list (lbname * term * comp)) : option (list (lbn then None else let norm c = - if debug env Options.Medium + if Debug.medium () then BU.print1 "Normalizing before generalizing:\n\t %s\n" (show c); let c = Normalize.normalize_comp [Env.Beta; Env.Exclude Env.Zeta; Env.NoFullNorm; Env.DoNotUnfoldPureLets] env c in - if debug env Options.Medium then + if Debug.medium () then BU.print1 "Normalized to:\n\t %s\n" (show c); c in let env_uvars = Env.uvars_in_env env in - let gen_uvars uvs = Set.diff uvs env_uvars |> Set.elems in /// GGG: bad, order depenedent + let gen_uvars uvs = diff uvs env_uvars |> elems in /// GGG: bad, order depenedent let univs_and_uvars_of_lec (lbname, e, c) = let c = norm c in let t = U.comp_result c in let univs = Free.univs t in let uvt = Free.uvars t in - if Env.debug env <| Options.Other "Gen" + if !dbg_Gen then BU.print2 "^^^^\n\tFree univs = %s\n\tFree uvt=%s\n" (show univs) (show uvt); let univs = List.fold_left - (fun univs uv -> Set.union univs (Free.univs (U.ctx_uvar_typ uv))) + (fun univs uv -> union univs (Free.univs (U.ctx_uvar_typ uv))) univs - (Set.elems uvt) // Bad; order dependent + (elems uvt) // Bad; order dependent in let uvs = gen_uvars uvt in - if Env.debug env <| Options.Other "Gen" + if !dbg_Gen then BU.print2 "^^^^\n\tFree univs = %s\n\tgen_uvars = %s\n" (show univs) (show uvs); @@ -140,7 +143,7 @@ let gen env (is_rec:bool) (lecs:list (lbname * term * comp)) : option (list (lbn in let univs, uvs, lec_hd = univs_and_uvars_of_lec (List.hd lecs) in let force_univs_eq lec2 u1 u2 = - if Set.equal u1 u2 + if equal u1 u2 then () else let lb1, _, _ = lec_hd in let lb2, _, _ = lec2 in @@ -198,7 +201,7 @@ let gen env (is_rec:bool) (lecs:list (lbname * term * comp)) : option (list (lbn match (U.unrefine (N.unfold_whnf env kres)).n with | Tm_type _ -> let free = FStar.Syntax.Free.names kres in - if not (Set.is_empty free) then + if not (is_empty free) then [] else let a = S.new_bv (Some <| Env.get_range env) kres in @@ -261,23 +264,23 @@ let gen env (is_rec:bool) (lecs:list (lbname * term * comp)) : option (list (lbn let generalize' env (is_rec:bool) (lecs:list (lbname*term*comp)) : (list (lbname*univ_names*term*comp*list binder)) = assert (List.for_all (fun (l, _, _) -> is_right l) lecs); //only generalize top-level lets - if debug env Options.Low then + if Debug.low () then BU.print1 "Generalizing: %s\n" (show <| List.map (fun (lb, _, _) -> Print.lbname_to_string lb) lecs); let univnames_lecs = - let empty = Set.from_list [] in + let empty = from_list [] in List.fold_left (fun out (l, t, c) -> - Set.union out (gather_free_univnames env t)) + union out (gather_free_univnames env t)) empty lecs in - let univnames_lecs = Set.elems univnames_lecs in /// GGG: bad, order dependent + let univnames_lecs = elems univnames_lecs in /// GGG: bad, order dependent let generalized_lecs = match gen env is_rec lecs with | None -> lecs |> List.map (fun (l,t,c) -> l,[],t,c,[]) | Some luecs -> - if debug env Options.Medium + if Debug.medium () then luecs |> List.iter (fun (l, us, e, c, gvs) -> BU.print5 "(%s) Generalized %s at type %s\n%s\nVars = (%s)\n" diff --git a/src/typechecker/FStar.TypeChecker.NBE.fst b/src/typechecker/FStar.TypeChecker.NBE.fst index 2056e1d8061..467201b9c96 100644 --- a/src/typechecker/FStar.TypeChecker.NBE.fst +++ b/src/typechecker/FStar.TypeChecker.NBE.fst @@ -45,9 +45,13 @@ module NU = FStar.TypeChecker.Normalize.Unfolding module FC = FStar.Const module EMB = FStar.Syntax.Embeddings module PC = FStar.Parser.Const +module TEQ = FStar.TypeChecker.TermEqAndSimplify open FStar.Class.Show +let dbg_NBE = Debug.get_toggle "NBE" +let dbg_NBETop = Debug.get_toggle "NBETop" + (* Broadly, the algorithm implemented here is inspired by Full Reduction at Full Throttle: @@ -1070,7 +1074,7 @@ and translate_monadic (m, ty) cfg bs e : t = S.mk (Tm_abs {bs=[S.mk_binder (BU.left lb.lbname)]; body; rc_opt=Some body_rc}) body.pos in let maybe_range_arg = - if BU.for_some (U.attr_eq U.dm4f_bind_range_attr) ed.eff_attrs + if BU.for_some (TEQ.eq_tm_bool cfg.core_cfg.tcenv U.dm4f_bind_range_attr) ed.eff_attrs then [translate cfg [] (PO.embed_simple lb.lbpos lb.lbpos), None; translate cfg [] (PO.embed_simple body.pos body.pos), None] else [] @@ -1289,7 +1293,7 @@ and readback (cfg:config) (x:t) : term = let refinement = U.refine x body in with_range ( if cfg.core_cfg.steps.simplify - then Common.simplify cfg.core_cfg.debug.wpe refinement + then TEQ.simplify cfg.core_cfg.debug.wpe cfg.core_cfg.tcenv refinement else refinement ) @@ -1326,7 +1330,7 @@ and readback (cfg:config) (x:t) : term = let app = U.mk_app (S.mk_Tm_uinst fv (List.rev us)) args in with_range ( if cfg.core_cfg.steps.simplify - then Common.simplify cfg.core_cfg.debug.wpe app + then TEQ.simplify cfg.core_cfg.debug.wpe cfg.core_cfg.tcenv app else app ) @@ -1338,7 +1342,7 @@ and readback (cfg:config) (x:t) : term = let app = U.mk_app (S.bv_to_name bv) args in with_range ( if cfg.core_cfg.steps.simplify - then Common.simplify cfg.core_cfg.debug.wpe app + then TEQ.simplify cfg.core_cfg.debug.wpe cfg.core_cfg.tcenv app else app ) @@ -1380,7 +1384,7 @@ and readback (cfg:config) (x:t) : term = let app = U.mk_app head args in with_range ( if cfg.core_cfg.steps.simplify - then Common.simplify cfg.core_cfg.debug.wpe app + then TEQ.simplify cfg.core_cfg.debug.wpe cfg.core_cfg.tcenv app else app ) @@ -1517,13 +1521,11 @@ let normalize psteps (steps:list Env.step) let cfg = Cfg.config' psteps steps env in //debug_sigmap env.sigtab; let cfg = {cfg with steps={cfg.steps with reify_=true}} in - if Env.debug env (Options.Other "NBETop") - || Env.debug env (Options.Other "NBE") + if !dbg_NBETop || !dbg_NBE then BU.print1 "Calling NBE with (%s) {\n" (P.term_to_string e); let cfg = new_config cfg in let r = readback cfg (translate cfg [] e) in - if Env.debug env (Options.Other "NBETop") - || Env.debug env (Options.Other "NBE") + if !dbg_NBETop || !dbg_NBE then BU.print1 "}\nNBE returned (%s)\n" (P.term_to_string r); r diff --git a/src/typechecker/FStar.TypeChecker.NBETerm.fst b/src/typechecker/FStar.TypeChecker.NBETerm.fst index db10421a0b9..827b5adc481 100644 --- a/src/typechecker/FStar.TypeChecker.NBETerm.fst +++ b/src/typechecker/FStar.TypeChecker.NBETerm.fst @@ -31,6 +31,8 @@ module P = FStar.Syntax.Print module BU = FStar.Compiler.Util module C = FStar.Const module SE = FStar.Syntax.Embeddings +module TEQ = FStar.TypeChecker.TermEqAndSimplify + open FStar.VConfig open FStar.Class.Show @@ -82,74 +84,88 @@ let mkAccuMatch (s:t) (ret:(unit -> option match_returns_ascription)) (bs:(unit // Term equality let equal_if = function - | true -> U.Equal - | _ -> U.Unknown + | true -> TEQ.Equal + | _ -> TEQ.Unknown let equal_iff = function - | true -> U.Equal - | _ -> U.NotEqual + | true -> TEQ.Equal + | _ -> TEQ.NotEqual let eq_inj r1 r2 = match r1, r2 with - | U.Equal, U.Equal -> U.Equal - | U.NotEqual, _ - | _, U.NotEqual -> U.NotEqual - | U.Unknown, _ - | _, U.Unknown -> U.Unknown + | TEQ.Equal, TEQ.Equal -> TEQ.Equal + | TEQ.NotEqual, _ + | _, TEQ.NotEqual -> TEQ.NotEqual + | TEQ.Unknown, _ + | _, TEQ.Unknown -> TEQ.Unknown let eq_and f g = match f with - | U.Equal -> g() - | _ -> U.Unknown + | TEQ.Equal -> g() + | _ -> TEQ.Unknown let eq_constant (c1 : constant) (c2 : constant) = match c1, c2 with -| Unit, Unit -> U.Equal +| Unit, Unit -> TEQ.Equal | Bool b1, Bool b2 -> equal_iff (b1 = b2) | Int i1, Int i2 -> equal_iff (i1 = i2) | String (s1, _), String (s2, _) -> equal_iff (s1 = s2) | Char c1, Char c2 -> equal_iff (c1 = c2) -| Range r1, Range r2 -> U.Unknown (* Seems that ranges are opaque *) -| _, _ -> U.NotEqual +| Range r1, Range r2 -> TEQ.Unknown (* Seems that ranges are opaque *) +| _, _ -> TEQ.NotEqual -let rec eq_t (t1 : t) (t2 : t) : U.eq_result = +let rec eq_t env (t1 : t) (t2 : t) : TEQ.eq_result = match t1.nbe_t, t2.nbe_t with - | Lam _, Lam _ -> U.Unknown - | Accu(a1, as1), Accu(a2, as2) -> eq_and (eq_atom a1 a2) (fun () -> eq_args as1 as2) + | Lam _, Lam _ -> TEQ.Unknown + | Accu(a1, as1), Accu(a2, as2) -> eq_and (eq_atom a1 a2) (fun () -> eq_args env as1 as2) | Construct(v1, us1, args1), Construct(v2, us2, args2) -> if S.fv_eq v1 v2 then begin if List.length args1 <> List.length args2 then failwith "eq_t, different number of args on Construct"; - List.fold_left (fun acc ((a1, _), (a2, _)) -> - eq_inj acc (eq_t a1 a2)) U.Equal <| List.zip args1 args2 - end else U.NotEqual + match Env.num_datacon_non_injective_ty_params env (lid_of_fv v1) with + | None -> TEQ.Unknown + | Some n -> + if n <= List.length args1 + then ( + let eq_args as1 as2 = + List.fold_left2 + (fun acc (a1, _) (a2, _) -> eq_inj acc (eq_t env a1 a2)) + TEQ.Equal + as1 as2 + in + let parms1, args1 = List.splitAt n args1 in + let parms2, args2 = List.splitAt n args2 in + eq_args args1 args2 + ) + else TEQ.Unknown + end else TEQ.NotEqual | FV(v1, us1, args1), FV(v2, us2, args2) -> if S.fv_eq v1 v2 then - eq_and (equal_iff (U.eq_univs_list us1 us2)) (fun () -> eq_args args1 args2) - else U.Unknown + eq_and (equal_iff (U.eq_univs_list us1 us2)) (fun () -> eq_args env args1 args2) + else TEQ.Unknown | Constant c1, Constant c2 -> eq_constant c1 c2 | Type_t u1, Type_t u2 | Univ u1, Univ u2 -> equal_iff (U.eq_univs u1 u2) | Refinement(r1, t1), Refinement(r2, t2) -> let x = S.new_bv None S.t_unit in (* bogus type *) - eq_and (eq_t (fst (t1 ())) (fst (t2 ()))) (fun () -> eq_t (r1 (mkAccuVar x)) (r2 (mkAccuVar x))) - | Unknown, Unknown -> U.Equal - | _, _ -> U.Unknown (* XXX following eq_tm *) + eq_and (eq_t env (fst (t1 ())) (fst (t2 ()))) (fun () -> eq_t env (r1 (mkAccuVar x)) (r2 (mkAccuVar x))) + | Unknown, Unknown -> TEQ.Equal + | _, _ -> TEQ.Unknown (* XXX following eq_tm *) -and eq_atom (a1 : atom) (a2 : atom) : U.eq_result = +and eq_atom (a1 : atom) (a2 : atom) : TEQ.eq_result = match a1, a2 with | Var bv1, Var bv2 -> equal_if (bv_eq bv1 bv2) (* ZP : TODO if or iff?? *) - | _, _ -> U.Unknown (* XXX Cannot compare suspended matches (?) *) - -and eq_arg (a1 : arg) (a2 : arg) = eq_t (fst a1) (fst a2) -and eq_args (as1 : args) (as2 : args) : U.eq_result = -match as1, as2 with -| [], [] -> U.Equal -| x :: xs, y :: ys -> eq_and (eq_arg x y) (fun () -> eq_args xs ys) -| _, _ -> U.Unknown (* ZP: following tm_eq, but why not U.NotEqual? *) + | _, _ -> TEQ.Unknown (* XXX Cannot compare suspended matches (?) *) + +and eq_arg env (a1 : arg) (a2 : arg) = eq_t env (fst a1) (fst a2) +and eq_args env (as1 : args) (as2 : args) : TEQ.eq_result = + match as1, as2 with + | [], [] -> TEQ.Equal + | x :: xs, y :: ys -> eq_and (eq_arg env x y) (fun () -> eq_args env xs ys) + | _, _ -> TEQ.Unknown (* ZP: following tm_eq, but why not TEQ.NotEqual? *) // Printing functions diff --git a/src/typechecker/FStar.TypeChecker.NBETerm.fsti b/src/typechecker/FStar.TypeChecker.NBETerm.fsti index 180ea8ebd23..0dbe63e90fa 100644 --- a/src/typechecker/FStar.TypeChecker.NBETerm.fsti +++ b/src/typechecker/FStar.TypeChecker.NBETerm.fsti @@ -29,7 +29,7 @@ open FStar.Char module S = FStar.Syntax.Syntax module U = FStar.Syntax.Util module Z = FStar.BigInt - +module TEQ = FStar.TypeChecker.TermEqAndSimplify open FStar.Class.Show val interleave_hack : int @@ -238,7 +238,7 @@ class embedding (a:Type0) = { e_typ : unit -> emb_typ; } -val eq_t : t -> t -> U.eq_result +val eq_t : Env.env_t -> t -> t -> TEQ.eq_result // Printing functions diff --git a/src/typechecker/FStar.TypeChecker.Normalize.Unfolding.fst b/src/typechecker/FStar.TypeChecker.Normalize.Unfolding.fst index 08c273bfbe0..ff4aa39686d 100644 --- a/src/typechecker/FStar.TypeChecker.Normalize.Unfolding.fst +++ b/src/typechecker/FStar.TypeChecker.Normalize.Unfolding.fst @@ -15,6 +15,8 @@ module PC = FStar.Parser.Const module Print = FStar.Syntax.Print module S = FStar.Syntax.Syntax module U = FStar.Syntax.Util +module TEQ = FStar.TypeChecker.TermEqAndSimplify + open FStar.Class.Show (* Max number of warnings to print in a single run. @@ -142,7 +144,7 @@ let should_unfold cfg should_reify fv qninfo : should_unfold_res = meets_some_criterion // UnfoldTac means never unfold FVs marked [@"tac_opaque"] - | _, _, _, _, _, _ when cfg.steps.unfold_tac && BU.for_some (U.attr_eq U.tac_opaque_attr) attrs -> + | _, _, _, _, _, _ when cfg.steps.unfold_tac && BU.for_some (TEQ.eq_tm_bool cfg.tcenv U.tac_opaque_attr) attrs -> log_unfolding cfg (fun () -> BU.print_string " >> tac_opaque, not unfolding\n"); no diff --git a/src/typechecker/FStar.TypeChecker.Normalize.fst b/src/typechecker/FStar.TypeChecker.Normalize.fst index 33831383b31..e576d208104 100644 --- a/src/typechecker/FStar.TypeChecker.Normalize.fst +++ b/src/typechecker/FStar.TypeChecker.Normalize.fst @@ -48,10 +48,13 @@ module I = FStar.Ident module EMB = FStar.Syntax.Embeddings module Z = FStar.BigInt module TcComm = FStar.TypeChecker.Common - +module TEQ = FStar.TypeChecker.TermEqAndSimplify module PO = FStar.TypeChecker.Primops open FStar.TypeChecker.Normalize.Unfolding +let dbg_univ_norm = Debug.get_toggle "univ_norm" +let dbg_NormRebuild = Debug.get_toggle "NormRebuild" + (********************************************************************************************** * Reduction of types via the Krivine Abstract Machine (KN), with lazy * reduction and strong reduction (under binders), as described in: @@ -218,7 +221,7 @@ let norm_universe cfg (env:env) u = begin try match snd (List.nth env x) with | Univ u -> - if Env.debug cfg.tcenv <| Options.Other "univ_norm" then + if !dbg_univ_norm then BU.print1 "Univ (in norm_universe): %s\n" (Print.univ_to_string u) else (); aux u | Dummy -> [u] @@ -749,7 +752,7 @@ let reduce_primops norm_cb cfg env tm : term & bool = let reduce_equality norm_cb cfg tm = reduce_primops norm_cb ({cfg with steps = { default_steps with primops = true }; - primitive_steps=equality_ops}) tm + primitive_steps=equality_ops cfg.tcenv}) tm (********************************************************************************************************************) (* Main normalization function of the abstract machine *) @@ -1155,7 +1158,7 @@ let is_forall_const cfg (phi : term) : option term = (* GM: Please consider this function private outside of this recursive * group, and call `normalize` instead. `normalize` will print timing - * information when --debug_level NormTop is given, which makes it a + * information when --debug NormTop is given, which makes it a * whole lot easier to find normalization calls that are taking a long * time. *) let rec norm : cfg -> env -> stack -> term -> term = @@ -1205,8 +1208,8 @@ let rec norm : cfg -> env -> stack -> term -> term = let lid = S.lid_of_fv fv in let qninfo = Env.lookup_qname cfg.tcenv lid in begin - match Env.delta_depth_of_qninfo fv qninfo with - | Some (Delta_constant_at_level 0) -> + match Env.delta_depth_of_qninfo cfg.tcenv fv qninfo with + | Delta_constant_at_level 0 -> log_unfolding cfg (fun () -> BU.print1 " >> This is a constant: %s\n" (Print.term_to_string t)); rebuild cfg empty_env stack t | _ -> @@ -1534,7 +1537,8 @@ let rec norm : cfg -> env -> stack -> term -> term = then rebuild cfg env stack (closure_as_term cfg env t) else let bs, c = open_comp bs c in let c = norm_comp cfg (bs |> List.fold_left (fun env _ -> dummy::env) env) c in - let t = arrow (norm_binders cfg env bs) c in + let bs = if cfg.steps.hnf then (close_binders cfg env bs)._1 else norm_binders cfg env bs in + let t = arrow bs c in rebuild cfg env stack t | Tm_ascribed {tm=t1; eff_opt=l} when cfg.steps.unascribe -> @@ -1813,7 +1817,7 @@ and do_unfold_fv cfg stack (t0:term) (qninfo : qninfo) (f:fv) : term = if n > 0 then match stack with //universe beta reduction | UnivArgs(us', _)::stack -> - if Env.debug cfg.tcenv <| Options.Other "univ_norm" then + if !dbg_univ_norm then List.iter (fun x -> BU.print1 "Univ (normalizer) %s\n" (Print.univ_to_string x)) us' else (); let env = us' |> List.fold_left (fun env u -> (None, Univ u)::env) empty_env in @@ -1976,7 +1980,7 @@ and do_reify_monadic fallback cfg env stack (top : term) (m : monad_name) (t : t (S.as_arg lb.lbtyp)::(S.as_arg t)::(unit_args@range_args@[S.as_arg f_arg; S.as_arg body]) else let maybe_range_arg = - if BU.for_some (U.attr_eq U.dm4f_bind_range_attr) ed.eff_attrs + if BU.for_some (TEQ.eq_tm_bool cfg.tcenv U.dm4f_bind_range_attr) ed.eff_attrs then [as_arg (PO.embed_simple lb.lbpos lb.lbpos); as_arg (PO.embed_simple body.pos body.pos)] else [] @@ -2539,7 +2543,7 @@ and rebuild (cfg:cfg) (env:env) (stack:stack) (t:term) : term = (show t) (show (List.length env)) (show (fst <| firstn 4 stack)); - if Env.debug cfg.tcenv (Options.Other "NormRebuild") + if !dbg_NormRebuild then match FStar.Syntax.Util.unbound_variables t with | [] -> () | bvs -> @@ -3183,7 +3187,7 @@ let term_to_doc env t = try normalize [AllowUnboundUniverses] env t with e -> Errors.log_issue t.pos (Errors.Warning_NormalizationFailure, (BU.format1 "Normalization failed with error %s\n" (BU.message_of_exn e))) ; t in - FStar.Syntax.Print.Pretty.term_to_doc' (DsEnv.set_current_module env.dsenv env.curmodule) t + FStar.Syntax.Print.term_to_doc' (DsEnv.set_current_module env.dsenv env.curmodule) t let term_to_string env t = GenSym.with_frozen_gensym (fun () -> let t = @@ -3199,6 +3203,13 @@ let comp_to_string env c = GenSym.with_frozen_gensym (fun () -> in Print.comp_to_string' (DsEnv.set_current_module env.dsenv env.curmodule) c) +let comp_to_doc env c = GenSym.with_frozen_gensym (fun () -> + let c = + try norm_comp (config [AllowUnboundUniverses] env) [] c + with e -> Errors.log_issue c.pos (Errors.Warning_NormalizationFailure, (BU.format1 "Normalization failed with error %s\n" (BU.message_of_exn e))) ; c + in + Print.comp_to_doc' (DsEnv.set_current_module env.dsenv env.curmodule) c) + let normalize_refinement steps env t0 = let t = normalize (steps@[Beta]) env t0 in U.flatten_refinement t @@ -3289,7 +3300,8 @@ let rec elim_uvars (env:Env.env) (s:sigelt) = num_uniform_params=num_uniform; t=typ; mutuals=lids; - ds=lids'} -> + ds=lids'; + injective_type_params} -> let univ_names, binders, typ = elim_uvars_aux_t env univ_names binders typ in {s with sigel = Sig_inductive_typ {lid; us=univ_names; @@ -3297,19 +3309,21 @@ let rec elim_uvars (env:Env.env) (s:sigelt) = num_uniform_params=num_uniform; t=typ; mutuals=lids; - ds=lids'}} + ds=lids'; + injective_type_params}} | Sig_bundle {ses=sigs; lids} -> {s with sigel = Sig_bundle {ses=List.map (elim_uvars env) sigs; lids}} - | Sig_datacon {lid; us=univ_names; t=typ; ty_lid=lident; num_ty_params=i; mutuals=lids} -> + | Sig_datacon {lid; us=univ_names; t=typ; ty_lid=lident; num_ty_params=i; mutuals=lids; injective_type_params} -> let univ_names, _, typ = elim_uvars_aux_t env univ_names [] typ in {s with sigel = Sig_datacon {lid; us=univ_names; t=typ; ty_lid=lident; num_ty_params=i; - mutuals=lids}} + mutuals=lids; + injective_type_params}} | Sig_declare_typ {lid; us=univ_names; t=typ} -> let univ_names, _, typ = elim_uvars_aux_t env univ_names [] typ in diff --git a/src/typechecker/FStar.TypeChecker.Normalize.fsti b/src/typechecker/FStar.TypeChecker.Normalize.fsti index df706f61092..d79f5599b0b 100644 --- a/src/typechecker/FStar.TypeChecker.Normalize.fsti +++ b/src/typechecker/FStar.TypeChecker.Normalize.fsti @@ -56,6 +56,7 @@ val normalize_with_primitive_steps : list Primops.primitive_step -> steps -> Env val term_to_string: Env.env -> term -> string val term_to_doc: Env.env -> term -> Pprint.document val comp_to_string: Env.env -> comp -> string +val comp_to_doc: Env.env -> comp -> Pprint.document val elim_uvars: Env.env -> sigelt -> sigelt val erase_universes: Env.env -> term -> term diff --git a/src/typechecker/FStar.TypeChecker.PatternUtils.fst b/src/typechecker/FStar.TypeChecker.PatternUtils.fst index 92a96fcfcea..484f8fc9b4c 100644 --- a/src/typechecker/FStar.TypeChecker.PatternUtils.fst +++ b/src/typechecker/FStar.TypeChecker.PatternUtils.fst @@ -37,6 +37,8 @@ module U = FStar.Syntax.Util module P = FStar.Syntax.Print module C = FStar.Parser.Const +let dbg_Patterns = Debug.get_toggle "Patterns" + (************************************************************************) (* Utilities on patterns *) (************************************************************************) @@ -208,7 +210,7 @@ let pat_as_exp (introduce_bv_uvars:bool) | Pat_dot_term eopt -> (match eopt with | None -> - if Env.debug env <| Options.Other "Patterns" + if !dbg_Patterns then begin if not env.phase1 then BU.print1 "Found a non-instantiated dot pattern in phase2 (%s)\n" diff --git a/src/typechecker/FStar.TypeChecker.Positivity.fst b/src/typechecker/FStar.TypeChecker.Positivity.fst index f26fcaee9f5..b0789f04a2f 100644 --- a/src/typechecker/FStar.TypeChecker.Positivity.fst +++ b/src/typechecker/FStar.TypeChecker.Positivity.fst @@ -33,6 +33,13 @@ module N = FStar.TypeChecker.Normalize module L = FStar.Compiler.List module C = FStar.Parser.Const +open FStar.Class.Setlike + +let dbg_Positivity = Debug.get_toggle "Positivity" +let debug_positivity (env:env_t) (msg:unit -> string) : unit = + if !dbg_Positivity + then BU.print_string ("Positivity::" ^ msg () ^ "\n") + (** This module implements the strict positivity check on inductive type @@ -134,11 +141,6 @@ module C = FStar.Parser.Const let string_of_lids lids = List.map string_of_lid lids |> String.concat ", " -(* Used extensively for verbose debugging output at debug_level Positivity *) -let debug_positivity (env:env_t) (msg:unit -> string) : unit = - if Env.debug env <| Options.Other "Positivity" - then BU.print_string ("Positivity::" ^ msg () ^ "\n") - (* Normalize a term before checking for non-strictly positive occurrences *) let normalize env t = N.normalize [Env.Beta; @@ -184,7 +186,7 @@ let apply_constr_arrow (dlid:lident) (dt:term) (all_params:list arg) let ty_occurs_in (ty_lid:lident) (t:term) : bool - = Set.mem ty_lid (Free.fvars t) + = mem ty_lid (Free.fvars t) (* Checks if `t` is a name or fv and returns it, if so. *) let rec term_as_fv_or_name (t:term) @@ -364,7 +366,7 @@ let mark_uniform_type_parameters (env:env_t) (sig:sigelt) : sigelt = let mark_tycon_parameters tc datas = - let Sig_inductive_typ {lid=tc_lid; us; params=ty_param_binders; t; mutuals; ds=data_lids} = tc.sigel in + let Sig_inductive_typ {lid=tc_lid; us; params=ty_param_binders; t; mutuals; ds=data_lids; injective_type_params } = tc.sigel in let env, (tc_lid, us, ty_params) = open_sig_inductive_typ env tc in let _, ty_param_args = U.args_of_binders ty_params in let datacon_fields : list (list binder) = @@ -416,7 +418,8 @@ let mark_uniform_type_parameters (env:env_t) num_uniform_params=Some max_uniform_prefix; t; mutuals; - ds=data_lids} in + ds=data_lids; + injective_type_params} in { tc with sigel } in match sig.sigel with diff --git a/src/typechecker/FStar.TypeChecker.Primops.Array.fst b/src/typechecker/FStar.TypeChecker.Primops.Array.fst new file mode 100644 index 00000000000..5265b9020cd --- /dev/null +++ b/src/typechecker/FStar.TypeChecker.Primops.Array.fst @@ -0,0 +1,183 @@ +module FStar.TypeChecker.Primops.Array + +open FStar +open FStar.Compiler +open FStar.Compiler.Effect +open FStar.Errors +open FStar.Class.Monad +open FStar.Syntax.Syntax +open FStar.Syntax.Embeddings + +open FStar.TypeChecker.Primops.Base + +module BU = FStar.Compiler.Util +module EMB = FStar.Syntax.Embeddings +module NBETerm = FStar.TypeChecker.NBETerm +module PC = FStar.Parser.Const +module S = FStar.Syntax.Syntax +module SS = FStar.Syntax.Subst +module U = FStar.Syntax.Util +module Z = FStar.BigInt + +let as_primitive_step is_strong (l, arity, u_arity, f, f_nbe) = + FStar.TypeChecker.Primops.Base.as_primitive_step_nbecbs is_strong (l, arity, u_arity, f, (fun cb univs args -> f_nbe univs args)) + +let arg_as_int (a:arg) : option Z.t = fst a |> try_unembed_simple + +let arg_as_list {|e:EMB.embedding 'a|} (a:arg) +: option (list 'a) + = fst a |> try_unembed_simple + +let mixed_binary_op + (as_a : arg -> option 'a) + (as_b : arg -> option 'b) + (embed_c : Range.range -> 'c -> term) + (f : Range.range -> universes -> 'a -> 'b -> option 'c) + (psc : psc) + (norm_cb : EMB.norm_cb) + (univs : universes) + (args : args) + : option term + = match args with + | [a;b] -> + begin + match as_a a, as_b b with + | Some a, Some b -> + (match f psc.psc_range univs a b with + | Some c -> Some (embed_c psc.psc_range c) + | _ -> None) + | _ -> None + end + | _ -> None + +let mixed_ternary_op + (as_a : arg -> option 'a) + (as_b : arg -> option 'b) + (as_c : arg -> option 'c) + (embed_d : Range.range -> 'd -> term) + (f : Range.range -> universes -> 'a -> 'b -> 'c -> option 'd) + (psc : psc) + (norm_cb : EMB.norm_cb) + (univs : universes) + (args : args) + : option term + = match args with + | [a;b;c] -> + begin + match as_a a, as_b b, as_c c with + | Some a, Some b, Some c -> + (match f psc.psc_range univs a b c with + | Some d -> Some (embed_d psc.psc_range d) + | _ -> None) + | _ -> None + end + | _ -> None + + +let bogus_cbs = { + NBETerm.iapp = (fun h _args -> h); + NBETerm.translate = (fun _ -> failwith "bogus_cbs translate"); +} + +let ops : list primitive_step = + let of_list_op = + let emb_typ t = ET_app(PC.immutable_array_t_lid |> Ident.string_of_lid, [t]) in + let un_lazy universes t l r = + S.mk_Tm_app + (S.mk_Tm_uinst (U.fvar_const PC.immutable_array_of_list_lid) universes) + [S.iarg t; S.as_arg l] + r + in + ( PC.immutable_array_of_list_lid, 2, 1, + mixed_binary_op + (fun (elt_t, _) -> Some elt_t) //the first arg of of_list is the element type + (fun (l, q) -> //2nd arg: try_unembed_simple as a list term + match arg_as_list #_ #FStar.Syntax.Embeddings.e_any (l, q) with + | Some lst -> Some (l, lst) + | _ -> None) + (fun r (universes, elt_t, (l, blob)) -> + //embed the result back as a Tm_lazy with the `ImmutableArray.t term` as the blob + //The kind records the type of the blob as IA.t "any" + //and the interesting thing here is that the thunk represents the blob back as pure F* term + //IA.of_list u#universes elt_t l. + //This unreduced representation can be used in a context where the blob doesn't make sense, + //e.g., in the SMT encoding, we represent the blob computed by of_list l + //just as the unreduced term `of_list l` + S.mk (Tm_lazy { blob; + lkind=Lazy_embedding (emb_typ EMB.(emb_typ_of _ #e_any ()), Thunk.mk (fun _ -> un_lazy universes elt_t l r)); + ltyp=S.mk_Tm_app (S.mk_Tm_uinst (U.fvar_const PC.immutable_array_t_lid) universes) [S.as_arg elt_t] r; + rng=r }) r) + (fun r universes elt_t (l, lst) -> + //The actual primitive step computing the IA.t blob + let blob = FStar.ImmutableArray.Base.of_list #term lst in + Some (universes, elt_t, (l, FStar.Compiler.Dyn.mkdyn blob))), + NBETerm.mixed_binary_op + (fun (elt_t, _) -> Some elt_t) + (fun (l, q) -> + match NBETerm.arg_as_list NBETerm.e_any (l, q) with + | None -> None + | Some lst -> Some (l, lst)) + (fun (universes, elt_t, (l, blob)) -> + //The embedding is similar to the non-NBE case + //But, this time the thunk is the NBE.t representation of `of_list l` + NBETerm.mk_t <| + NBETerm.Lazy (Inr (blob, emb_typ EMB.(emb_typ_of _ #e_any ())), + Thunk.mk (fun _ -> + NBETerm.mk_t <| NBETerm.FV (S.lid_as_fv PC.immutable_array_of_list_lid None, + universes, + [NBETerm.as_arg l])))) + (fun universes elt_t (l, lst) -> + let blob = FStar.ImmutableArray.Base.of_list #NBETerm.t lst in + Some (universes, elt_t, (l, FStar.Compiler.Dyn.mkdyn blob)))) + in + let arg1_as_elt_t (x:arg) : option term = Some (fst x) in + let arg2_as_blob (x:arg) : option FStar.Compiler.Dyn.dyn = + //try_unembed_simple an arg as a IA.t blob if the emb_typ + //of the lkind tells us it has the right type + match (SS.compress (fst x)).n with + | Tm_lazy {blob=blob; lkind=Lazy_embedding (ET_app(head, _), _)} + when head=Ident.string_of_lid PC.immutable_array_t_lid -> Some blob + | _ -> None + in + let arg2_as_blob_nbe (x:NBETerm.arg) : option FStar.Compiler.Dyn.dyn = + //try_unembed_simple an arg as a IA.t blob if the emb_typ + //tells us it has the right type + let open FStar.TypeChecker.NBETerm in + match (fst x).nbe_t with + | Lazy (Inr (blob, ET_app(head, _)), _) + when head=Ident.string_of_lid PC.immutable_array_t_lid -> Some blob + | _ -> None + in + let length_op = + let embed_int (r:Range.range) (i:Z.t) : term = embed_simple r i in + let run_op (blob:FStar.Compiler.Dyn.dyn) : option Z.t = + Some (BU.array_length #term (FStar.Compiler.Dyn.undyn blob)) + in + ( PC.immutable_array_length_lid, 2, 1, + mixed_binary_op arg1_as_elt_t //1st arg of length is the type + arg2_as_blob //2nd arg is the IA.t term blob + embed_int //the result is just an int, so embed it back + (fun _r _universes _ blob -> run_op blob), + //NBE case is similar + NBETerm.mixed_binary_op + (fun (elt_t, _) -> Some elt_t) + arg2_as_blob_nbe + (fun (i:Z.t) -> NBETerm.embed NBETerm.e_int bogus_cbs i) + (fun _universes _ blob -> run_op blob) ) + in + let index_op = + (PC.immutable_array_index_lid, 3, 1, + mixed_ternary_op arg1_as_elt_t //1st arg of index is the type + arg2_as_blob //2nd arg is the `IA.t term` blob + arg_as_int //3rd arg is an int + (fun r tm -> tm) //the result is just a term, so the embedding is the identity + (fun r _universes _t blob i -> Some (BU.array_index #term (FStar.Compiler.Dyn.undyn blob) i)), + NBETerm.mixed_ternary_op + (fun (elt_t, _) -> Some elt_t) + arg2_as_blob_nbe //2nd arg is an `IA.t NBEterm.t` blob + NBETerm.arg_as_int + (fun tm -> tm) //In this case, the result is a NBE.t, so embedding is the identity + (fun _universes _t blob i -> Some (BU.array_index #NBETerm.t (FStar.Compiler.Dyn.undyn blob) i))) + in + List.map (as_primitive_step true) + [of_list_op; length_op; index_op] diff --git a/src/typechecker/FStar.TypeChecker.Primops.Array.fsti b/src/typechecker/FStar.TypeChecker.Primops.Array.fsti new file mode 100644 index 00000000000..9026f882e67 --- /dev/null +++ b/src/typechecker/FStar.TypeChecker.Primops.Array.fsti @@ -0,0 +1,5 @@ +module FStar.TypeChecker.Primops.Array + +open FStar.TypeChecker.Primops.Base + +val ops : list primitive_step diff --git a/src/typechecker/FStar.TypeChecker.Primops.Base.fst b/src/typechecker/FStar.TypeChecker.Primops.Base.fst index 0ebe55d5c31..14efd9337f2 100644 --- a/src/typechecker/FStar.TypeChecker.Primops.Base.fst +++ b/src/typechecker/FStar.TypeChecker.Primops.Base.fst @@ -424,3 +424,36 @@ let mk5' #a #b #c #d #e #r #na #nb #nc #nd #ne #nr | _ -> failwith "arity" in as_primitive_step_nbecbs true (name, 5, u_arity, interp, nbe_interp) + +let mk6' #a #b #c #d #e #f #r #na #nb #nc #nd #ne #nf #nr + (u_arity : int) + (name : Ident.lid) + {| EMB.embedding a |} {| NBE.embedding na |} + {| EMB.embedding b |} {| NBE.embedding nb |} + {| EMB.embedding c |} {| NBE.embedding nc |} + {| EMB.embedding d |} {| NBE.embedding nd |} + {| EMB.embedding e |} {| NBE.embedding ne |} + {| EMB.embedding f |} {| NBE.embedding nf |} + {| EMB.embedding r |} {| NBE.embedding nr |} + (ff : a -> b -> c -> d -> e -> f -> option r) + (nbe_ff : na -> nb -> nc -> nd -> ne -> nf -> option nr) + : primitive_step = + let interp : interp_t = + fun psc cb us args -> + match args with + | [(a, _); (b, _); (c, _); (d, _); (e, _); (f, _)] -> + let! r = ff <$> try_unembed_simple a <*> try_unembed_simple b <*> try_unembed_simple c <*> try_unembed_simple d <*> try_unembed_simple e <*> try_unembed_simple f in + let! r = r in + return (embed_simple psc.psc_range r) + | _ -> failwith "arity" + in + let nbe_interp : nbe_interp_t = + fun cbs us args -> + match args with + | [(a, _); (b, _); (c, _); (d, _); (e, _); (f, _)] -> + let! r = nbe_ff <$> NBE.unembed solve cbs a <*> NBE.unembed solve cbs b <*> NBE.unembed solve cbs c <*> NBE.unembed solve cbs d <*> NBE.unembed solve cbs e <*> NBE.unembed solve cbs f in + let! r = r in + return (NBE.embed solve cbs r) + | _ -> failwith "arity" + in + as_primitive_step_nbecbs true (name, 6, u_arity, interp, nbe_interp) diff --git a/src/typechecker/FStar.TypeChecker.Primops.Base.fsti b/src/typechecker/FStar.TypeChecker.Primops.Base.fsti index 1cf83250573..edac4fb7e8d 100644 --- a/src/typechecker/FStar.TypeChecker.Primops.Base.fsti +++ b/src/typechecker/FStar.TypeChecker.Primops.Base.fsti @@ -6,7 +6,7 @@ open FStar.Compiler open FStar.Compiler.Effect open FStar.Compiler.List open FStar.Syntax.Syntax - +module Env = FStar.TypeChecker.Env module EMB = FStar.Syntax.Embeddings module NBE = FStar.TypeChecker.NBETerm @@ -222,3 +222,17 @@ val mk5' #a #b #c #d #e #r #na #nb #nc #nd #ne #nr (f : a -> b -> c -> d -> e -> option r) (f : na -> nb -> nc -> nd -> ne -> option nr) : primitive_step + +val mk6' #a #b #c #d #e #f #r #na #nb #nc #nd #ne #nf #nr + (u_arity : int) + (name : Ident.lid) + {| EMB.embedding a |} {| NBE.embedding na |} + {| EMB.embedding b |} {| NBE.embedding nb |} + {| EMB.embedding c |} {| NBE.embedding nc |} + {| EMB.embedding d |} {| NBE.embedding nd |} + {| EMB.embedding e |} {| NBE.embedding ne |} + {| EMB.embedding f |} {| NBE.embedding nf |} + {| EMB.embedding r |} {| NBE.embedding nr |} + (f : a -> b -> c -> d -> e -> f -> option r) + (f : na -> nb -> nc -> nd -> ne -> nf -> option nr) + : primitive_step diff --git a/src/typechecker/FStar.TypeChecker.Primops.Eq.fst b/src/typechecker/FStar.TypeChecker.Primops.Eq.fst index cc3c0a2ac41..ce471a23881 100644 --- a/src/typechecker/FStar.TypeChecker.Primops.Eq.fst +++ b/src/typechecker/FStar.TypeChecker.Primops.Eq.fst @@ -14,63 +14,65 @@ module S = FStar.Syntax.Syntax module U = FStar.Syntax.Util module EMB = FStar.Syntax.Embeddings module NBE = FStar.TypeChecker.NBETerm +module TEQ = FStar.TypeChecker.TermEqAndSimplify +module Env = FStar.TypeChecker.Env open FStar.TypeChecker.Primops.Base -let s_eq (_typ x y : EMB.abstract_term) : option bool = - match U.eq_tm x.t y.t with - | U.Equal -> Some true - | U.NotEqual -> Some false +let s_eq (env:Env.env_t) (_typ x y : EMB.abstract_term) : option bool = + match TEQ.eq_tm env x.t y.t with + | TEQ.Equal -> Some true + | TEQ.NotEqual -> Some false | _ -> None -let nbe_eq (_typ x y : NBETerm.abstract_nbe_term) : option bool = - match NBETerm.eq_t x.t y.t with - | U.Equal -> Some true - | U.NotEqual -> Some false +let nbe_eq env (_typ x y : NBETerm.abstract_nbe_term) : option bool = + match NBETerm.eq_t env x.t y.t with + | TEQ.Equal -> Some true + | TEQ.NotEqual -> Some false | _ -> None let push3 f g x y z = f (g x y z) let negopt3 = push3 (fmap #option not) -let dec_eq_ops : list primitive_step = [ - mk3' 0 PC.op_Eq s_eq nbe_eq; - mk3' 0 PC.op_notEq (negopt3 s_eq) (negopt3 nbe_eq); +let dec_eq_ops env : list primitive_step = [ + mk3' 0 PC.op_Eq (s_eq env) (nbe_eq env); + mk3' 0 PC.op_notEq (negopt3 (s_eq env)) (negopt3 (nbe_eq env)); ] (* Propositional equality follows. We use the abstract newtypes to easily embed exactly the term we want. *) -let s_eq2 (_typ x y : EMB.abstract_term) : option EMB.abstract_term = - match U.eq_tm x.t y.t with - | U.Equal -> Some (EMB.Abstract U.t_true) - | U.NotEqual -> Some (EMB.Abstract U.t_false) +let s_eq2 env (_typ x y : EMB.abstract_term) : option EMB.abstract_term = + match TEQ.eq_tm env x.t y.t with + | TEQ.Equal -> Some (EMB.Abstract U.t_true) + | TEQ.NotEqual -> Some (EMB.Abstract U.t_false) | _ -> None -let nbe_eq2 (_typ x y : NBE.abstract_nbe_term) : option NBE.abstract_nbe_term = +let nbe_eq2 env (_typ x y : NBE.abstract_nbe_term) : option NBE.abstract_nbe_term = let open FStar.TypeChecker.NBETerm in - match NBETerm.eq_t x.t y.t with - | U.Equal -> Some (AbstractNBE (mkFV (S.lid_as_fv PC.true_lid None) [] [])) - | U.NotEqual -> Some (AbstractNBE (mkFV (S.lid_as_fv PC.false_lid None) [] [])) - | U.Unknown -> None + match NBETerm.eq_t env x.t y.t with + | TEQ.Equal -> Some (AbstractNBE (mkFV (S.lid_as_fv PC.true_lid None) [] [])) + | TEQ.NotEqual -> Some (AbstractNBE (mkFV (S.lid_as_fv PC.false_lid None) [] [])) + | TEQ.Unknown -> None -let s_eq3 (typ1 typ2 x y : EMB.abstract_term) : option EMB.abstract_term = - match U.eq_tm typ1.t typ2.t, U.eq_tm x.t y.t with - | U.Equal, U.Equal -> Some (EMB.Abstract U.t_true) - | U.NotEqual, _ - | _, U.NotEqual -> +let s_eq3 env (typ1 typ2 x y : EMB.abstract_term) : option EMB.abstract_term = + match TEQ.eq_tm env typ1.t typ2.t, TEQ.eq_tm env x.t y.t with + | TEQ.Equal, TEQ.Equal -> Some (EMB.Abstract U.t_true) + | TEQ.NotEqual, _ + | _, TEQ.NotEqual -> Some (EMB.Abstract U.t_false) | _ -> None -let nbe_eq3 (typ1 typ2 x y : NBE.abstract_nbe_term) : option NBE.abstract_nbe_term = +let nbe_eq3 env (typ1 typ2 x y : NBE.abstract_nbe_term) : option NBE.abstract_nbe_term = let open FStar.TypeChecker.NBETerm in - match eq_t typ1.t typ2.t, eq_t x.t y.t with - | U.Equal, U.Equal -> Some (AbstractNBE (mkFV (S.lid_as_fv PC.true_lid None) [] [])) - | U.NotEqual, _ - | _, U.NotEqual -> + match eq_t env typ1.t typ2.t, eq_t env x.t y.t with + | TEQ.Equal, TEQ.Equal -> Some (AbstractNBE (mkFV (S.lid_as_fv PC.true_lid None) [] [])) + | TEQ.NotEqual, _ + | _, TEQ.NotEqual -> Some (AbstractNBE (mkFV (S.lid_as_fv PC.false_lid None) [] [])) | _ -> None -let prop_eq_ops : list primitive_step = [ - mk3' 1 PC.eq2_lid s_eq2 nbe_eq2; - mk4' 2 PC.eq3_lid s_eq3 nbe_eq3; +let prop_eq_ops env : list primitive_step = [ + mk3' 1 PC.eq2_lid (s_eq2 env) (nbe_eq2 env); + mk4' 2 PC.eq3_lid (s_eq3 env) (nbe_eq3 env); ] diff --git a/src/typechecker/FStar.TypeChecker.Primops.Eq.fsti b/src/typechecker/FStar.TypeChecker.Primops.Eq.fsti index 7dd929e8ac8..c884d7c6a02 100644 --- a/src/typechecker/FStar.TypeChecker.Primops.Eq.fsti +++ b/src/typechecker/FStar.TypeChecker.Primops.Eq.fsti @@ -1,7 +1,7 @@ module FStar.TypeChecker.Primops.Eq - +module Env = FStar.TypeChecker.Env open FStar.TypeChecker.Primops.Base -val dec_eq_ops : list primitive_step +val dec_eq_ops (_:Env.env_t) : list primitive_step -val prop_eq_ops : list primitive_step \ No newline at end of file +val prop_eq_ops (_:Env.env_t) : list primitive_step \ No newline at end of file diff --git a/src/typechecker/FStar.TypeChecker.Primops.Issue.fst b/src/typechecker/FStar.TypeChecker.Primops.Issue.fst new file mode 100644 index 00000000000..bbea2da7e4b --- /dev/null +++ b/src/typechecker/FStar.TypeChecker.Primops.Issue.fst @@ -0,0 +1,29 @@ +module FStar.TypeChecker.Primops.Issue + +open FStar +open FStar.Compiler +open FStar.Compiler.Effect +open FStar.Errors +open FStar.Class.Monad + +open FStar.TypeChecker.Primops.Base + +module PC = FStar.Parser.Const +module Z = FStar.BigInt + +let ops : list primitive_step = + let mk_lid l = PC.p2l ["FStar"; "Issue"; l] in [ + mk1 0 (mk_lid "message_of_issue") Mkissue?.issue_msg; + mk1 0 (mk_lid "level_of_issue") (fun i -> Errors.string_of_issue_level i.issue_level); + mk1 0 (mk_lid "number_of_issue") (fun i -> fmap Z.of_int_fs i.issue_number); + mk1 0 (mk_lid "range_of_issue") Mkissue?.issue_range; + mk1 0 (mk_lid "context_of_issue") Mkissue?.issue_ctx; + mk1 0 (mk_lid "render_issue") Errors.format_issue; + mk5 0 (mk_lid "mk_issue_doc") (fun level msg range number context -> + { issue_level = Errors.issue_level_of_string level; + issue_range = range; + issue_number = fmap Z.to_int_fs number; + issue_msg = msg; + issue_ctx = context} + ); + ] diff --git a/src/typechecker/FStar.TypeChecker.Primops.Issue.fsti b/src/typechecker/FStar.TypeChecker.Primops.Issue.fsti new file mode 100644 index 00000000000..0c00810fca7 --- /dev/null +++ b/src/typechecker/FStar.TypeChecker.Primops.Issue.fsti @@ -0,0 +1,5 @@ +module FStar.TypeChecker.Primops.Issue + +open FStar.TypeChecker.Primops.Base + +val ops : list primitive_step diff --git a/src/typechecker/FStar.TypeChecker.Primops.Range.fst b/src/typechecker/FStar.TypeChecker.Primops.Range.fst new file mode 100644 index 00000000000..d38193d6da5 --- /dev/null +++ b/src/typechecker/FStar.TypeChecker.Primops.Range.fst @@ -0,0 +1,24 @@ +module FStar.TypeChecker.Primops.Range + +open FStar +open FStar.Compiler +open FStar.Compiler.Effect +open FStar.Compiler.List +open FStar.Class.Monad + +open FStar.TypeChecker.Primops.Base +open FStar.Compiler.Range + +module PC = FStar.Parser.Const +module Z = FStar.BigInt + +(* Range ops *) + +let ops = [ + mk5 0 PC.mk_range_lid (fun fn from_l from_c to_l to_c -> + mk_range fn (mk_pos (Z.to_int_fs from_l) (Z.to_int_fs from_c)) + (mk_pos (Z.to_int_fs to_l) (Z.to_int_fs to_c)) + ); + + mk2 0 PC.join_range_lid FStar.Compiler.Range.union_ranges; +] diff --git a/src/typechecker/FStar.TypeChecker.Primops.Range.fsti b/src/typechecker/FStar.TypeChecker.Primops.Range.fsti new file mode 100644 index 00000000000..484e936c99d --- /dev/null +++ b/src/typechecker/FStar.TypeChecker.Primops.Range.fsti @@ -0,0 +1,5 @@ +module FStar.TypeChecker.Primops.Range + +open FStar.TypeChecker.Primops.Base + +val ops : list primitive_step diff --git a/src/typechecker/FStar.TypeChecker.Primops.Sealed.fst b/src/typechecker/FStar.TypeChecker.Primops.Sealed.fst new file mode 100644 index 00000000000..6e3e0e480ab --- /dev/null +++ b/src/typechecker/FStar.TypeChecker.Primops.Sealed.fst @@ -0,0 +1,102 @@ +module FStar.TypeChecker.Primops.Sealed + +open FStar +open FStar.Compiler +open FStar.Compiler.Effect +open FStar.Syntax.Syntax + +open FStar.TypeChecker.Primops.Base + +module EMB = FStar.Syntax.Embeddings +module NBETerm = FStar.TypeChecker.NBETerm +module PC = FStar.Parser.Const +module S = FStar.Syntax.Syntax +module U = FStar.Syntax.Util + +let bogus_cbs = { + NBETerm.iapp = (fun h _args -> h); + NBETerm.translate = (fun _ -> failwith "bogus_cbs translate"); +} + +let ops = + List.map (fun p -> { as_primitive_step_nbecbs true p with renorm_after = true}) [ + (PC.map_seal_lid, 4, 2, + (fun psc univs cbs args -> + match args with + | [(ta, _); (tb, _); (s, _); (f, _)] -> + begin + let open EMB in + let try_unembed (#a:Type) (e:embedding a) (x:term) : option a = + try_unembed x id_norm_cb + in + match try_unembed e_any ta, + try_unembed e_any tb, + try_unembed (e_sealed e_any) s, + try_unembed e_any f with + | Some ta, Some tb, Some s, Some f -> + let r = U.mk_app f [S.as_arg (Sealed.unseal s)] in + let emb = set_type ta e_any in + Some (embed_simple psc.psc_range (Sealed.seal r)) + | _ -> None + end + | _ -> None), + (fun cb univs args -> + match args with + | [(ta, _); (tb, _); (s, _); (f, _)] -> + begin + let open FStar.TypeChecker.NBETerm in + let try_unembed (#a:Type) (e:embedding a) (x:NBETerm.t) : option a = + unembed e bogus_cbs x + in + match try_unembed e_any ta, + try_unembed e_any tb, + try_unembed (e_sealed e_any) s, + try_unembed e_any f with + | Some ta, Some tb, Some s, Some f -> + let r = cb.iapp f [as_arg (Sealed.unseal s)] in + let emb = set_type ta e_any in + Some (embed (e_sealed emb) cb (Sealed.seal r)) + | _ -> None + end + | _ -> None + )); + (PC.bind_seal_lid, 4, 2, + (fun psc univs cbs args -> + match args with + | [(ta, _); (tb, _); (s, _); (f, _)] -> + begin + let open EMB in + let try_unembed (#a:Type) (e:embedding a) (x:term) : option a = + try_unembed x id_norm_cb + in + match try_unembed e_any ta, + try_unembed e_any tb, + try_unembed (e_sealed e_any) s, + try_unembed e_any f with + | Some ta, Some tb, Some s, Some f -> + let r = U.mk_app f [S.as_arg (Sealed.unseal s)] in + Some (embed_simple #_ #e_any psc.psc_range r) + | _ -> None + end + | _ -> None), + (fun cb univs args -> + match args with + | [(ta, _); (tb, _); (s, _); (f, _)] -> + begin + let open FStar.TypeChecker.NBETerm in + let try_unembed (#a:Type) (e:embedding a) (x:NBETerm.t) : option a = + unembed e bogus_cbs x + in + match try_unembed e_any ta, + try_unembed e_any tb, + try_unembed (e_sealed e_any) s, + try_unembed e_any f with + | Some ta, Some tb, Some s, Some f -> + let r = cb.iapp f [as_arg (Sealed.unseal s)] in + let emb = set_type ta e_any in + Some (embed emb cb r) + | _ -> None + end + | _ -> None + )); + ] diff --git a/src/typechecker/FStar.TypeChecker.Primops.Sealed.fsti b/src/typechecker/FStar.TypeChecker.Primops.Sealed.fsti new file mode 100644 index 00000000000..5c590c15a8f --- /dev/null +++ b/src/typechecker/FStar.TypeChecker.Primops.Sealed.fsti @@ -0,0 +1,5 @@ +module FStar.TypeChecker.Primops.Sealed + +open FStar.TypeChecker.Primops.Base + +val ops : list primitive_step diff --git a/src/typechecker/FStar.TypeChecker.Primops.fst b/src/typechecker/FStar.TypeChecker.Primops.fst index e19e2e18fe7..5ad46485a33 100644 --- a/src/typechecker/FStar.TypeChecker.Primops.fst +++ b/src/typechecker/FStar.TypeChecker.Primops.fst @@ -3,31 +3,20 @@ module FStar.TypeChecker.Primops (* This module just contains the list of all builtin primitive steps with their implementations. *) -open FStar.Compiler.Effect -open FStar.Compiler.List open FStar open FStar.Compiler +open FStar.Compiler.Effect +open FStar.Compiler.List open FStar.String -open FStar.Const -open FStar.Char open FStar.Syntax open FStar.Syntax.Syntax -open FStar.TypeChecker -open FStar.TypeChecker.Env -open FStar.Errors open FStar.Class.Monad -open FStar.Class.Show module S = FStar.Syntax.Syntax -module SS = FStar.Syntax.Subst module BU = FStar.Compiler.Util -module FC = FStar.Const module PC = FStar.Parser.Const -module U = FStar.Syntax.Util -module I = FStar.Ident module EMB = FStar.Syntax.Embeddings module Z = FStar.BigInt -module NBE = FStar.TypeChecker.NBETerm open FStar.TypeChecker.Primops.Base @@ -35,61 +24,10 @@ open FStar.TypeChecker.Primops.Base (* Semantics for primitive operators (+, -, >, &&, ...) *) (*******************************************************************) -let arg_as_int (a:arg) : option Z.t = fst a |> try_unembed_simple - -let arg_as_list {|e:EMB.embedding 'a|} (a:arg) -: option (list 'a) - = fst a |> try_unembed_simple - (* Most primitive steps don't use the NBE cbs, so they can use this wrapper. *) let as_primitive_step is_strong (l, arity, u_arity, f, f_nbe) = Primops.Base.as_primitive_step_nbecbs is_strong (l, arity, u_arity, f, (fun cb univs args -> f_nbe univs args)) -let mixed_binary_op - (as_a : arg -> option 'a) - (as_b : arg -> option 'b) - (embed_c : Range.range -> 'c -> term) - (f : Range.range -> universes -> 'a -> 'b -> option 'c) - (psc : psc) - (norm_cb : EMB.norm_cb) - (univs : universes) - (args : args) - : option term - = match args with - | [a;b] -> - begin - match as_a a, as_b b with - | Some a, Some b -> - (match f psc.psc_range univs a b with - | Some c -> Some (embed_c psc.psc_range c) - | _ -> None) - | _ -> None - end - | _ -> None - -let mixed_ternary_op - (as_a : arg -> option 'a) - (as_b : arg -> option 'b) - (as_c : arg -> option 'c) - (embed_d : Range.range -> 'd -> term) - (f : Range.range -> universes -> 'a -> 'b -> 'c -> option 'd) - (psc : psc) - (norm_cb : EMB.norm_cb) - (univs : universes) - (args : args) - : option term - = match args with - | [a;b;c] -> - begin - match as_a a, as_b b, as_c c with - | Some a, Some b, Some c -> - (match f psc.psc_range univs a b c with - | Some d -> Some (embed_d psc.psc_range d) - | _ -> None) - | _ -> None - end - | _ -> None - (* and_op and or_op are special cased because they are short-circuting, * can run without unembedding its second argument. *) let and_op : psc -> EMB.norm_cb -> universes -> args -> option term @@ -167,223 +105,8 @@ let simple_ops : list primitive_step = [ mk2 0 PC.string_index_lid String.index; mk2 0 PC.string_index_of_lid String.index_of; mk3 0 PC.string_sub_lid (fun s o l -> String.substring s (Z.to_int_fs o) (Z.to_int_fs l)); - - (* Range ops *) - mk5 0 PC.mk_range_lid (fun fn from_l from_c to_l to_c -> - let open FStar.Compiler.Range in - mk_range fn (mk_pos (Z.to_int_fs from_l) (Z.to_int_fs from_c)) - (mk_pos (Z.to_int_fs to_l) (Z.to_int_fs to_c)) - ); ] -let bogus_cbs = { - NBE.iapp = (fun h _args -> h); - NBE.translate = (fun _ -> failwith "bogus_cbs translate"); -} - -let issue_ops : list primitive_step = - let mk_lid l = PC.p2l ["FStar"; "Issue"; l] in [ - mk1 0 (mk_lid "message_of_issue") Mkissue?.issue_msg; - mk1 0 (mk_lid "level_of_issue") (fun i -> Errors.string_of_issue_level i.issue_level); - mk1 0 (mk_lid "number_of_issue") (fun i -> fmap Z.of_int_fs i.issue_number); - mk1 0 (mk_lid "range_of_issue") Mkissue?.issue_range; - mk1 0 (mk_lid "context_of_issue") Mkissue?.issue_ctx; - mk1 0 (mk_lid "render_issue") Errors.format_issue; - mk5 0 (mk_lid "mk_issue_doc") (fun level msg range number context -> - { issue_level = Errors.issue_level_of_string level; - issue_range = range; - issue_number = fmap Z.to_int_fs number; - issue_msg = msg; - issue_ctx = context} - ); - ] - -let seal_steps = - List.map (fun p -> { as_primitive_step_nbecbs true p with renorm_after = true}) [ - (PC.map_seal_lid, 4, 2, - (fun psc univs cbs args -> - match args with - | [(ta, _); (tb, _); (s, _); (f, _)] -> - begin - let open EMB in - let try_unembed (#a:Type) (e:embedding a) (x:term) : option a = - try_unembed x id_norm_cb - in - match try_unembed e_any ta, - try_unembed e_any tb, - try_unembed (e_sealed e_any) s, - try_unembed e_any f with - | Some ta, Some tb, Some s, Some f -> - let r = U.mk_app f [S.as_arg (Sealed.unseal s)] in - let emb = set_type ta e_any in - Some (embed_simple psc.psc_range (Sealed.seal r)) - | _ -> None - end - | _ -> None), - (fun cb univs args -> - match args with - | [(ta, _); (tb, _); (s, _); (f, _)] -> - begin - let open FStar.TypeChecker.NBETerm in - let try_unembed (#a:Type) (e:embedding a) (x:NBETerm.t) : option a = - unembed e bogus_cbs x - in - match try_unembed e_any ta, - try_unembed e_any tb, - try_unembed (e_sealed e_any) s, - try_unembed e_any f with - | Some ta, Some tb, Some s, Some f -> - let r = cb.iapp f [as_arg (Sealed.unseal s)] in - let emb = set_type ta e_any in - Some (embed (e_sealed emb) cb (Sealed.seal r)) - | _ -> None - end - | _ -> None - )); - (PC.bind_seal_lid, 4, 2, - (fun psc univs cbs args -> - match args with - | [(ta, _); (tb, _); (s, _); (f, _)] -> - begin - let open EMB in - let try_unembed (#a:Type) (e:embedding a) (x:term) : option a = - try_unembed x id_norm_cb - in - match try_unembed e_any ta, - try_unembed e_any tb, - try_unembed (e_sealed e_any) s, - try_unembed e_any f with - | Some ta, Some tb, Some s, Some f -> - let r = U.mk_app f [S.as_arg (Sealed.unseal s)] in - Some (embed_simple #_ #e_any psc.psc_range r) - | _ -> None - end - | _ -> None), - (fun cb univs args -> - match args with - | [(ta, _); (tb, _); (s, _); (f, _)] -> - begin - let open FStar.TypeChecker.NBETerm in - let try_unembed (#a:Type) (e:embedding a) (x:NBETerm.t) : option a = - unembed e bogus_cbs x - in - match try_unembed e_any ta, - try_unembed e_any tb, - try_unembed (e_sealed e_any) s, - try_unembed e_any f with - | Some ta, Some tb, Some s, Some f -> - let r = cb.iapp f [as_arg (Sealed.unseal s)] in - let emb = set_type ta e_any in - Some (embed emb cb r) - | _ -> None - end - | _ -> None - )); - ] - - let array_ops : list primitive_step = - let of_list_op = - let emb_typ t = ET_app(PC.immutable_array_t_lid |> Ident.string_of_lid, [t]) in - let un_lazy universes t l r = - S.mk_Tm_app - (S.mk_Tm_uinst (U.fvar_const PC.immutable_array_of_list_lid) universes) - [S.iarg t; S.as_arg l] - r - in - ( PC.immutable_array_of_list_lid, 2, 1, - mixed_binary_op - (fun (elt_t, _) -> Some elt_t) //the first arg of of_list is the element type - (fun (l, q) -> //2nd arg: try_unembed_simple as a list term - match arg_as_list #_ #FStar.Syntax.Embeddings.e_any (l, q) with - | Some lst -> Some (l, lst) - | _ -> None) - (fun r (universes, elt_t, (l, blob)) -> - //embed the result back as a Tm_lazy with the `ImmutableArray.t term` as the blob - //The kind records the type of the blob as IA.t "any" - //and the interesting thing here is that the thunk represents the blob back as pure F* term - //IA.of_list u#universes elt_t l. - //This unreduced representation can be used in a context where the blob doesn't make sense, - //e.g., in the SMT encoding, we represent the blob computed by of_list l - //just as the unreduced term `of_list l` - S.mk (Tm_lazy { blob; - lkind=Lazy_embedding (emb_typ EMB.(emb_typ_of _ #e_any ()), Thunk.mk (fun _ -> un_lazy universes elt_t l r)); - ltyp=S.mk_Tm_app (S.mk_Tm_uinst (U.fvar_const PC.immutable_array_t_lid) universes) [S.as_arg elt_t] r; - rng=r }) r) - (fun r universes elt_t (l, lst) -> - //The actual primitive step computing the IA.t blob - let blob = FStar.ImmutableArray.Base.of_list #term lst in - Some (universes, elt_t, (l, FStar.Compiler.Dyn.mkdyn blob))), - NBETerm.mixed_binary_op - (fun (elt_t, _) -> Some elt_t) - (fun (l, q) -> - match NBETerm.arg_as_list NBETerm.e_any (l, q) with - | None -> None - | Some lst -> Some (l, lst)) - (fun (universes, elt_t, (l, blob)) -> - //The embedding is similar to the non-NBE case - //But, this time the thunk is the NBE.t representation of `of_list l` - NBETerm.mk_t <| - NBETerm.Lazy (Inr (blob, emb_typ EMB.(emb_typ_of _ #e_any ())), - Thunk.mk (fun _ -> - NBETerm.mk_t <| NBETerm.FV (S.lid_as_fv PC.immutable_array_of_list_lid None, - universes, - [NBETerm.as_arg l])))) - (fun universes elt_t (l, lst) -> - let blob = FStar.ImmutableArray.Base.of_list #NBETerm.t lst in - Some (universes, elt_t, (l, FStar.Compiler.Dyn.mkdyn blob)))) - in - let arg1_as_elt_t (x:arg) : option term = Some (fst x) in - let arg2_as_blob (x:arg) : option FStar.Compiler.Dyn.dyn = - //try_unembed_simple an arg as a IA.t blob if the emb_typ - //of the lkind tells us it has the right type - match (SS.compress (fst x)).n with - | Tm_lazy {blob=blob; lkind=Lazy_embedding (ET_app(head, _), _)} - when head=Ident.string_of_lid PC.immutable_array_t_lid -> Some blob - | _ -> None - in - let arg2_as_blob_nbe (x:NBETerm.arg) : option FStar.Compiler.Dyn.dyn = - //try_unembed_simple an arg as a IA.t blob if the emb_typ - //tells us it has the right type - let open FStar.TypeChecker.NBETerm in - match (fst x).nbe_t with - | Lazy (Inr (blob, ET_app(head, _)), _) - when head=Ident.string_of_lid PC.immutable_array_t_lid -> Some blob - | _ -> None - in - let length_op = - let embed_int (r:Range.range) (i:Z.t) : term = embed_simple r i in - let run_op (blob:FStar.Compiler.Dyn.dyn) : option Z.t = - Some (BU.array_length #term (FStar.Compiler.Dyn.undyn blob)) - in - ( PC.immutable_array_length_lid, 2, 1, - mixed_binary_op arg1_as_elt_t //1st arg of length is the type - arg2_as_blob //2nd arg is the IA.t term blob - embed_int //the result is just an int, so embed it back - (fun _r _universes _ blob -> run_op blob), - //NBE case is similar - NBETerm.mixed_binary_op - (fun (elt_t, _) -> Some elt_t) - arg2_as_blob_nbe - (fun (i:Z.t) -> NBETerm.embed NBETerm.e_int bogus_cbs i) - (fun _universes _ blob -> run_op blob) ) - in - let index_op = - (PC.immutable_array_index_lid, 3, 1, - mixed_ternary_op arg1_as_elt_t //1st arg of index is the type - arg2_as_blob //2nd arg is the `IA.t term` blob - arg_as_int //3rd arg is an int - (fun r tm -> tm) //the result is just a term, so the embedding is the identity - (fun r _universes _t blob i -> Some (BU.array_index #term (FStar.Compiler.Dyn.undyn blob) i)), - NBETerm.mixed_ternary_op - (fun (elt_t, _) -> Some elt_t) - arg2_as_blob_nbe //2nd arg is an `IA.t NBEterm.t` blob - NBETerm.arg_as_int - (fun tm -> tm) //In this case, the result is a NBE.t, so embedding is the identity - (fun _universes _t blob i -> Some (BU.array_index #NBETerm.t (FStar.Compiler.Dyn.undyn blob) i))) - in - List.map (as_primitive_step true) - [of_list_op; length_op; index_op] - let short_circuit_ops : list primitive_step = List.map (as_primitive_step true) [ @@ -394,14 +117,16 @@ let short_circuit_ops : list primitive_step = let built_in_primitive_steps_list : list primitive_step = simple_ops @ short_circuit_ops - @ issue_ops - @ array_ops - @ seal_steps + @ Primops.Issue.ops + @ Primops.Array.ops + @ Primops.Sealed.ops @ Primops.Erased.ops @ Primops.Docs.ops @ Primops.MachineInts.ops - @ Primops.Eq.dec_eq_ops @ Primops.Errors.Msg.ops + @ Primops.Range.ops + +let equality_ops_list env : list primitive_step = + Primops.Eq.prop_eq_ops env -let equality_ops_list : list primitive_step = - Primops.Eq.prop_eq_ops +let env_dependent_ops (env:Env.env_t) = Primops.Eq.dec_eq_ops env \ No newline at end of file diff --git a/src/typechecker/FStar.TypeChecker.Primops.fsti b/src/typechecker/FStar.TypeChecker.Primops.fsti index 455dc428ba7..7d8faad331c 100644 --- a/src/typechecker/FStar.TypeChecker.Primops.fsti +++ b/src/typechecker/FStar.TypeChecker.Primops.fsti @@ -1,9 +1,11 @@ module FStar.TypeChecker.Primops +open FStar.Compiler.Effect include FStar.TypeChecker.Primops.Base (* This module just contains the list of all builtin primitive steps with their implementations. *) val built_in_primitive_steps_list : list primitive_step -val equality_ops_list : list primitive_step +val equality_ops_list (env:Env.env_t) : list primitive_step +val env_dependent_ops (env:Env.env_t) : list primitive_step diff --git a/src/typechecker/FStar.TypeChecker.Quals.fst b/src/typechecker/FStar.TypeChecker.Quals.fst index 5eed1531e85..d95a41d712d 100644 --- a/src/typechecker/FStar.TypeChecker.Quals.fst +++ b/src/typechecker/FStar.TypeChecker.Quals.fst @@ -230,54 +230,39 @@ let check_erasable env quals r se = * if and only if `e` is a type that's non-informative (e..g., unit, t -> unit, etc.) *) let check_must_erase_attribute env se = - match se.sigel with - | Sig_let {lbs; lids=l} -> - if not (Options.ide()) - then - begin - match DsEnv.iface_decls (Env.dsenv env) (Env.current_module env) with - | None -> - () - - | Some iface_decls -> - snd lbs |> List.iter (fun lb -> - let lbname = BU.right lb.lbname in - let has_iface_val = - iface_decls |> BU.for_some (FStar.Parser.AST.decl_is_val (ident_of_lid lbname.fv_name.v)) - in - if has_iface_val - then - let must_erase = - TcUtil.must_erase_for_extraction env lb.lbdef in - let has_attr = - Env.fv_has_attr env - lbname - FStar.Parser.Const.must_erase_for_extraction_attr in - if must_erase && not has_attr - then - FStar.Errors.log_issue_doc - (range_of_fv lbname) - (FStar.Errors.Error_MustEraseMissing, - [Errors.text (BU.format2 - "Values of type `%s` will be erased during extraction, \ - but its interface hides this fact. Add the `must_erase_for_extraction` \ - attribute to the `val %s` declaration for this symbol in the interface" - (Print.fv_to_string lbname) - (Print.fv_to_string lbname) - )]) - else if has_attr && not must_erase - then FStar.Errors.log_issue_doc - (range_of_fv lbname) - (FStar.Errors.Error_MustEraseMissing, - [Errors.text (BU.format1 - "Values of type `%s` cannot be erased during extraction, \ - but the `must_erase_for_extraction` attribute claims that it can. \ - Please remove the attribute." - (Print.fv_to_string lbname) - )])) - end + if Options.ide() then () else + match se.sigel with + | Sig_let {lbs; lids=l} -> + begin match DsEnv.iface_decls (Env.dsenv env) (Env.current_module env) with + | None -> + () - | _ -> () + | Some iface_decls -> + snd lbs |> List.iter (fun lb -> + let lbname = BU.right lb.lbname in + let has_iface_val = + iface_decls |> BU.for_some (Parser.AST.decl_is_val (ident_of_lid lbname.fv_name.v)) + in + if has_iface_val + then + let must_erase = TcUtil.must_erase_for_extraction env lb.lbdef in + let has_attr = Env.fv_has_attr env lbname C.must_erase_for_extraction_attr in + if must_erase && not has_attr + then log_issue_doc (range_of_fv lbname) (Error_MustEraseMissing, [ + text (BU.format2 "Values of type `%s` will be erased during extraction, \ + but its interface hides this fact. Add the `must_erase_for_extraction` \ + attribute to the `val %s` declaration for this symbol in the interface" + (show lbname) (show lbname)); + ]) + else if has_attr && not must_erase + then log_issue_doc (range_of_fv lbname) (Error_MustEraseMissing, [ + text (BU.format1 "Values of type `%s` cannot be erased during extraction, \ + but the `must_erase_for_extraction` attribute claims that it can. \ + Please remove the attribute." + (show lbname)); + ])) + end + | _ -> () let check_typeclass_instance_attribute env rng se = let is_tc_instance = @@ -289,26 +274,26 @@ let check_typeclass_instance_attribute env rng se = in let check_instance_typ (ty:typ) : unit = let _, res = U.arrow_formals_comp ty in - if U.is_total_comp res - then let t = U.comp_result res in - let head, _ = U.head_and_args t in - let err () = - FStar.Errors.log_issue_doc rng (FStar.Errors.Error_UnexpectedTypeclassInstance, [ - text "Instances must define instances of `class` types."; - text "Type" ^/^ pp t ^/^ text "is not a class."; - ]) - in - match (U.un_uinst head).n with - | Tm_fvar fv -> - if not (Env.fv_has_attr env fv FStar.Parser.Const.tcclass_lid) - then err () - | _ -> - err () - else - FStar.Errors.log_issue_doc rng (FStar.Errors.Error_UnexpectedTypeclassInstance, [ + if not (U.is_total_comp res) then + log_issue_doc rng (FStar.Errors.Error_UnexpectedTypeclassInstance, [ text "Instances are expected to be total."; text "This instance has effect" ^^ pp (U.comp_effect_name res); - ]) + ]); + + let t = U.comp_result res in + let head, _ = U.head_and_args t in + let err () = + FStar.Errors.log_issue_doc rng (FStar.Errors.Error_UnexpectedTypeclassInstance, [ + text "Instances must define instances of `class` types."; + text "Type" ^/^ pp t ^/^ text "is not a class."; + ]) + in + match (U.un_uinst head).n with + | Tm_fvar fv -> + if not (Env.fv_has_attr env fv FStar.Parser.Const.tcclass_lid) then + err () + | _ -> + err () in if is_tc_instance then match se.sigel with diff --git a/src/typechecker/FStar.TypeChecker.Rel.fst b/src/typechecker/FStar.TypeChecker.Rel.fst index 9c0465f5a2a..ca9c47bbe8c 100644 --- a/src/typechecker/FStar.TypeChecker.Rel.fst +++ b/src/typechecker/FStar.TypeChecker.Rel.fst @@ -39,6 +39,7 @@ open FStar.Common open FStar.Class.Deq open FStar.Class.Show +open FStar.Class.Setlike module BU = FStar.Compiler.Util //basic util module U = FStar.Syntax.Util @@ -49,6 +50,25 @@ module UF = FStar.Syntax.Unionfind module PC = FStar.Parser.Const module FC = FStar.Const module TcComm = FStar.TypeChecker.Common +module TEQ = FStar.TypeChecker.TermEqAndSimplify + +let dbg_Disch = Debug.get_toggle "Disch" +let dbg_Discharge = Debug.get_toggle "Discharge" +let dbg_EQ = Debug.get_toggle "EQ" +let dbg_ExplainRel = Debug.get_toggle "ExplainRel" +let dbg_GenUniverses = Debug.get_toggle "GenUniverses" +let dbg_ImplicitTrace = Debug.get_toggle "ImplicitTrace" +let dbg_Imps = Debug.get_toggle "Imps" +let dbg_LayeredEffectsApp = Debug.get_toggle "LayeredEffectsApp" +let dbg_LayeredEffectsEqns = Debug.get_toggle "LayeredEffectsEqns" +let dbg_Rel = Debug.get_toggle "Rel" +let dbg_RelBench = Debug.get_toggle "RelBench" +let dbg_RelDelta = Debug.get_toggle "RelDelta" +let dbg_RelTop = Debug.get_toggle "RelTop" +let dbg_ResolveImplicitsHook = Debug.get_toggle "ResolveImplicitsHook" +let dbg_Simplification = Debug.get_toggle "Simplification" +let dbg_SMTQuery = Debug.get_toggle "SMTQuery" +let dbg_Tac = Debug.get_toggle "Tac" instance showable_implicit_checking_status : showable implicit_checking_status = { show = (function @@ -66,8 +86,13 @@ let is_base_type env typ = | Tm_type _ -> true | _ -> false -let binders_as_bv_set (bs:binders) = - Set.from_list (List.map (fun b -> b.binder_bv) bs) +let term_is_uvar (uv:ctx_uvar) (t:term) : bool = + match (U.unascribe t).n with + | Tm_uvar (uv', _) -> UF.equiv uv.ctx_uvar_head uv'.ctx_uvar_head + | _ -> false + +let binders_as_bv_set (bs:binders) : FlatSet.t bv = + from_list (List.map (fun b -> b.binder_bv) bs) (* lazy string, for error reporting *) type lstring = Thunk.t string @@ -116,7 +141,7 @@ type worklist = { //is allowed; disabled by default, enabled in //sub_comp which is called by the typechecker, and //will insert the appropriate lifts. - typeclass_variables: Set.t ctx_uvar //variables that will be solved by typeclass instantiation + typeclass_variables: RBSet.t ctx_uvar //variables that will be solved by typeclass instantiation } (* A NOTE ON ENVIRONMENTS @@ -141,8 +166,6 @@ with the problem being tackled. The uses of push_bv/push_binder should be few. *) -let debug (wl:worklist) (lvl:_) : bool = Env.debug wl.tcenv lvl - let as_deferred (wl_def:list (int * deferred_reason * lstring * prob)) : deferred = List.map (fun (_, reason, m, p) -> reason, Thunk.force m, p) wl_def @@ -174,7 +197,7 @@ let new_uvar reason wl r gamma binders k should_check meta : ctx_uvar * term * w ; imp_uvar = ctx_uvar ; imp_range = r } in - if debug wl (Options.Other "ImplicitTrace") then + if !dbg_ImplicitTrace then BU.print1 "Just created uvar (Rel) {%s}\n" (Print.uvar_to_string ctx_uvar.ctx_uvar_head); ctx_uvar, t, {wl with wl_implicits=imp::wl.wl_implicits} @@ -290,7 +313,7 @@ let def_scope_wf msg rng r = in aux [] r instance hasBinders_prob : Class.Binders.hasBinders prob = { - boundNames = (fun prob -> Set.from_list (List.map (fun b -> b.binder_bv) <| p_scope prob)); + boundNames = (fun prob -> from_list (List.map (fun b -> b.binder_bv) <| p_scope prob)); } let def_check_term_scoped_in_prob msg prob phi = @@ -341,11 +364,13 @@ let term_to_string t = let prob_to_string env prob = match prob with | TProb p -> - BU.format "\n%s:\t%s \n\t\t%s\n\t%s\n" //\twith guard %s\n\telement= %s\n" // (guard %s)\n\t\t\n\t\t\t%s\n\t\t" + BU.format "\n%s:\t%s \n\t\t%s\n\t%s\n\t(reason:%s) (logical:%s)\n" //\twith guard %s\n\telement= %s\n" // (guard %s)\n\t\t\n\t\t\t%s\n\t\t" [(BU.string_of_int p.pid); (term_to_string p.lhs); (rel_to_string p.relation); (term_to_string p.rhs); + (match p.reason with | [] -> "" | r::_ -> r); + (show p.logical) //(term_to_string p.logical_guard); //(match p.element with None -> "none" | Some t -> term_to_string t) (* (N.term_to_string env (fst p.logical_guard)); *) @@ -390,11 +415,11 @@ let empty_worklist env = { umax_heuristic_ok=true; wl_implicits=[]; repr_subcomp_allowed=false; - typeclass_variables = Set.empty(); + typeclass_variables = empty(); } let giveup wl (reason : lstring) prob = - if debug wl <| Options.Other "Rel" then + if !dbg_Rel then BU.print2 "Failed %s:\n%s\n" (Thunk.force reason) (prob_to_string' wl prob); Failed (prob, reason) @@ -431,6 +456,13 @@ let mk_eq2 wl prob t1 t2 : term * worklist = let p_invert = function | TProb p -> TProb <| invert p | CProb p -> CProb <| invert p +let p_logical = function + | TProb p -> p.logical + | CProb p -> p.logical +let set_logical (b:bool) = function + | TProb p -> TProb {p with logical=b} + | CProb p -> CProb {p with logical=b} + let is_top_level_prob p = p_reason p |> List.length = 1 let next_pid = let ctr = BU.mk_ref 0 in @@ -469,6 +501,7 @@ let mk_problem wl scope orig lhs rel rhs elt reason = reason=reason::p_reason orig; loc=p_loc orig; rank=None; + logical=p_logical orig; } in (prob, wl) @@ -520,6 +553,7 @@ let new_problem wl env lhs rel rhs (subject:option bv) loc reason = reason=[reason]; loc=loc; rank=None; + logical=false; (* use set_logical to set this *) } in prob, wl @@ -535,6 +569,7 @@ let problem_using_guard orig lhs rel rhs elt reason = reason=reason::p_reason orig; loc=p_loc orig; rank=None; + logical = p_logical orig; } in def_check_prob reason (TProb p); p @@ -548,8 +583,7 @@ let guard_on_element wl problem x phi : term = | Some e -> Subst.subst [NT(x,S.bv_to_name e)] phi let explain wl d (s : lstring) = - if debug wl <| Options.Other "ExplainRel" - || debug wl <| Options.Other "Rel" + if !dbg_ExplainRel || !dbg_Rel then BU.format4 "(%s) Failed to solve the sub-problem\n%s\nWhich arose because:\n\t%s\nFailed because:%s\n" (Range.string_of_range <| p_loc d) (prob_to_string' wl d) @@ -576,7 +610,7 @@ let explain wl d (s : lstring) = let set_uvar env u (should_check_opt:option S.should_check_uvar) t = // Useful for debugging uvars setting bugs - // if Env.debug env <| Options.Other "Rel" + // if !dbg_Rel // then ( // BU.print2 "Setting uvar %s to %s\n" // (show u) @@ -901,7 +935,7 @@ let ensure_no_uvar_subst env (t0:term) (wl:worklist) (* Solve the old variable *) let args_sol = List.map U.arg_of_non_null_binder dom_binders in let sol = S.mk_Tm_app t_v args_sol t0.pos in - if Env.debug env <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "ensure_no_uvar_subst solving %s with %s\n" (show uv) (show sol); @@ -919,7 +953,7 @@ let ensure_no_uvar_subst env (t0:term) (wl:worklist) (Print.tag_of_term head) (Print.tag_of_term (SS.compress head))) -let no_free_uvars t = Set.is_empty (Free.uvars t) && Set.is_empty (Free.univs t) +let no_free_uvars t = is_empty (Free.uvars t) && is_empty (Free.univs t) (* Deciding when it's okay to issue an SMT query for * equating a term whose head symbol is `head` with another term @@ -993,7 +1027,7 @@ let solve_prob' resolve_ok prob logical_guard uvis wl = | None -> U.t_true | Some phi -> phi in let assign_solution xs uv phi = - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print3 "Solving %s (%s) with formula %s\n" (string_of_int (p_pid prob)) (show uv) @@ -1035,7 +1069,7 @@ let solve_prob' resolve_ok prob logical_guard uvis wl = {wl with ctr=wl.ctr + 1} let extend_universe_solution pid sol wl = - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "Solving %s: with [%s]\n" (string_of_int pid) (uvis_to_string wl.tcenv sol); commit wl.tcenv sol; @@ -1044,7 +1078,7 @@ let extend_universe_solution pid sol wl = let solve_prob (prob : prob) (logical_guard : option term) (uvis : list uvi) (wl:worklist) : worklist = def_check_prob "solve_prob.prob" prob; BU.iter_opt logical_guard (def_check_term_scoped_in_prob "solve_prob.guard" prob); - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "Solving %s: with %s\n" (string_of_int <| p_pid prob) (uvis_to_string wl.tcenv uvis); solve_prob' false prob logical_guard uvis wl @@ -1060,7 +1094,7 @@ let solve_prob (prob : prob) (logical_guard : option term) (uvis : list uvi) (wl let occurs (uk:ctx_uvar) t = let uvars = Free.uvars t - |> Set.elems // Bad: order dependent + |> elems // Bad: order dependent in let occurs = (uvars @@ -1079,7 +1113,7 @@ let occurs_check (uk:ctx_uvar) t = let occurs_full (uk:ctx_uvar) t = let uvars = Free.uvars_full t - |> Set.elems // Bad: order dependent + |> elems // Bad: order dependent in let occurs = (uvars @@ -1165,7 +1199,7 @@ let restrict_all_uvars env (tgt:ctx_uvar) (bs:binders) (sources:list ctx_uvar) w List.fold_right (fun (src:ctx_uvar) wl -> let ctx_src = binders_as_bv_set src.ctx_uvar_binders in - if Set.subset ctx_src ctx_tgt + if subset ctx_src ctx_tgt then wl // no need to restrict source, it's context is included in the context of the tgt else restrict_ctx env tgt [] src wl) sources @@ -1175,24 +1209,25 @@ let restrict_all_uvars env (tgt:ctx_uvar) (bs:binders) (sources:list ctx_uvar) w List.fold_right (restrict_ctx env tgt bs) sources wl let intersect_binders (g:gamma) (v1:binders) (v2:binders) : binders = - let as_set v = - v |> List.fold_left (fun out x -> Set.add x.binder_bv out) S.no_names in + let as_set (v:binders) : RBSet.t bv = + v |> List.fold_left (fun out x -> add x.binder_bv out) (empty ()) + in let v1_set = as_set v1 in let ctx_binders = - List.fold_left (fun out b -> match b with Binding_var x -> Set.add x out | _ -> out) - S.no_names + List.fold_left (fun out b -> match b with Binding_var x -> add x out | _ -> out) + (empty ()) g in let isect, _ = v2 |> List.fold_left (fun (isect, isect_set) b -> let x, imp = b.binder_bv, b.binder_qual in - if not <| Set.mem x v1_set + if not <| mem x v1_set then //definitely not in the intersection isect, isect_set else //maybe in the intersect, if its type is only dependent on prior elements in the telescope let fvs = Free.names x.sort in - if Set.subset fvs isect_set - then b::isect, Set.add x isect_set + if subset fvs isect_set + then b::isect, add x isect_set else isect, isect_set) ([], ctx_binders) in List.rev isect @@ -1238,45 +1273,6 @@ let head_match = function | HeadMatch true -> HeadMatch true | _ -> HeadMatch false -let fv_delta_depth env fv = - let d = Env.delta_depth_of_fv env fv in - match d with - | Delta_abstract d -> - if string_of_lid env.curmodule = nsstr fv.fv_name.v && not env.is_iface //AR: TODO: this is to prevent unfolding of abstract symbols in the extracted interface - // a better way would be create new fvs with appripriate delta_depth at extraction time - then d //we're in the defining module - else delta_constant - | Delta_constant_at_level i when i > 0 -> - begin match Env.lookup_definition [Unfold delta_constant] env fv.fv_name.v with - | None -> delta_constant //there's no definition to unfold, e.g., because it's marked irreducible - | _ -> d - end - | d -> - d - -let rec delta_depth_of_term env t = - let t = U.unmeta t in - match t.n with - | Tm_meta _ - | Tm_delayed _ -> failwith "Impossible (delta depth of term)" - | Tm_lazy i -> delta_depth_of_term env (U.unfold_lazy i) - | Tm_unknown - | Tm_bvar _ - | Tm_name _ - | Tm_uvar _ - | Tm_let _ - | Tm_match _ -> None - | Tm_uinst(t, _) - | Tm_ascribed {tm=t} - | Tm_app {hd=t} - | Tm_refine {b={sort=t}} -> delta_depth_of_term env t - | Tm_constant _ - | Tm_type _ - | Tm_arrow _ - | Tm_quoted _ - | Tm_abs _ -> Some delta_constant - | Tm_fvar fv -> Some (fv_delta_depth env fv) - let universe_has_max env u = let u = N.normalize_universe env u in match u with @@ -1286,7 +1282,7 @@ let universe_has_max env u = let rec head_matches env t1 t2 : match_result = let t1 = U.unmeta t1 in let t2 = U.unmeta t2 in - if Env.debug env <| Options.Other "RelDelta" then ( + if !dbg_RelDelta then ( BU.print2 "head_matches %s %s\n" (show t1) (show t2); BU.print2 " %s -- %s\n" (Print.tag_of_term t1) (Print.tag_of_term t2); () @@ -1326,13 +1322,31 @@ let rec head_matches env t1 t2 : match_result = | Tm_quoted _, Tm_quoted _ | Tm_abs _, Tm_abs _ -> HeadMatch true - | _ -> MisMatch(delta_depth_of_term env t1, delta_depth_of_term env t2) + | _ -> + (* GM: I am retaining this logic here. I think it is meant to disable + unfolding of possibly-equational terms. This probably deserves a rework now + with the .logical field. *) + let maybe_dd (t:term) : option delta_depth = + match (SS.compress t).n with + | Tm_unknown + | Tm_bvar _ + | Tm_name _ + | Tm_uvar _ + | Tm_let _ + | Tm_match _ -> None + | _ -> Some (delta_depth_of_term env t) + in + MisMatch (maybe_dd t1, maybe_dd t2) (* Does t1 head-match t2, after some delta steps? *) -let head_matches_delta env smt_ok t1 t2 : (match_result & option (typ&typ)) = +let head_matches_delta env (logical:bool) smt_ok t1 t2 : (match_result & option (typ&typ)) = + let base_steps = + (if logical then [Env.UnfoldTac] else []) @ + [Env.Primops; Env.Weak; Env.HNF] + in let maybe_inline t = let head = U.head_of (unrefine env t) in - if Env.debug env <| Options.Other "RelDelta" then + if !dbg_RelDelta then BU.print2 "Head of %s is %s\n" (show t) (show head); match (U.un_uinst head).n with | Tm_fvar fv -> @@ -1344,11 +1358,12 @@ let head_matches_delta env smt_ok t1 t2 : (match_result & option (typ&typ)) = fv.fv_name.v with | None -> - if Env.debug env <| Options.Other "RelDelta" then + if !dbg_RelDelta then BU.print1 "No definition found for %s\n" (show head); None | Some _ -> let basic_steps = + (if logical then [Env.UnfoldTac] else []) @ [Env.UnfoldUntil delta_constant; Env.Weak; Env.HNF; @@ -1365,9 +1380,9 @@ let head_matches_delta env smt_ok t1 t2 : (match_result & option (typ&typ)) = //should we always disable Zeta here? in let t' = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.1" steps env t in - if U.eq_tm t t' = U.Equal //if we didn't inline anything + if TEQ.eq_tm env t t' = TEQ.Equal //if we didn't inline anything then None - else let _ = if Env.debug env <| Options.Other "RelDelta" + else let _ = if !dbg_RelDelta then BU.print2 "Inlined %s to %s\n" (show t) (show t') in @@ -1385,14 +1400,23 @@ let head_matches_delta env smt_ok t1 t2 : (match_result & option (typ&typ)) = * in an unfolding call to the normalizer * This made_progress function is checking that we have made progress in unfolding t to t' * See #2184 + * + * GM: Updated 2024/05/18 to check for a discrepancy in syntactic equality, instead of + * eq_tm *not* returning Equal. We can have syntactically equal terms for which eq_tm + * returns unknown, so this code would falsely claim progress. For instance, Tm_let + * nodes are not handled by eq_tm and it always returns unknown. That should probably + * be improved, but in either case I think we want a syntactic check here (which is + * faster too) than eq_tm which is meant for decidable equality. *) let made_progress t t' = - let head, head' = U.head_and_args t |> fst, U.head_and_args t' |> fst in - not (U.eq_tm head head' = U.Equal) in + let head = U.head_and_args t |> fst in + let head' = U.head_and_args t' |> fst in + not (U.term_eq head head') + in let rec aux retry n_delta t1 t2 = let r = head_matches env t1 t2 in - if Env.debug env <| Options.Other "RelDelta" then + if !dbg_RelDelta then BU.print3 "head_matches (%s, %s) = %s\n" (show t1) (show t2) @@ -1401,9 +1425,9 @@ let head_matches_delta env smt_ok t1 t2 : (match_result & option (typ&typ)) = let d1_greater_than_d2 = Common.delta_depth_greater_than d1 d2 in let t1, t2, made_progress = if d1_greater_than_d2 - then let t1' = normalize_refinement [Env.UnfoldUntil d2; Env.Primops; Env.Weak; Env.HNF] env t1 in + then let t1' = normalize_refinement (Env.UnfoldUntil d2 :: base_steps) env t1 in t1', t2, made_progress t1 t1' - else let t2' = normalize_refinement [Env.UnfoldUntil d1; Env.Primops; Env.Weak; Env.HNF] env t2 in + else let t2' = normalize_refinement (Env.UnfoldUntil d1 :: base_steps) env t2 in t1, t2', made_progress t2 t2' in if made_progress then aux retry (n_delta + 1) t1 t2 @@ -1414,8 +1438,8 @@ let head_matches_delta env smt_ok t1 t2 : (match_result & option (typ&typ)) = match Common.decr_delta_depth d with | None -> fail n_delta r t1 t2 | Some d -> - let t1' = normalize_refinement [Env.UnfoldUntil d; Env.Primops; Env.Weak; Env.HNF] env t1 in - let t2' = normalize_refinement [Env.UnfoldUntil d; Env.Primops; Env.Weak; Env.HNF] env t2 in + let t1' = normalize_refinement (Env.UnfoldUntil d :: base_steps) env t1 in + let t2' = normalize_refinement (Env.UnfoldUntil d :: base_steps) env t2 in if made_progress t1 t1' && made_progress t2 t2' then aux retry (n_delta + 1) t1' t2' @@ -1448,7 +1472,7 @@ let head_matches_delta env smt_ok t1 t2 : (match_result & option (typ&typ)) = | _ -> success n_delta r t1 t2 in let r = aux true 0 t1 t2 in - if Env.debug env <| Options.Other "RelDelta" then + if !dbg_RelDelta then BU.print3 "head_matches_delta (%s, %s) = %s\n" (show t1) (show t2) (show r); r @@ -1778,7 +1802,7 @@ let should_defer_flex_to_user_tac (wl:worklist) (f:flex_t) = let (Flex (_, u, _)) = f in let b = DeferredImplicits.should_defer_uvar_to_user_tac wl.tcenv u in - if debug wl <| Options.Other "ResolveImplicitsHook" + if !dbg_ResolveImplicitsHook then BU.print3 "Rel.should_defer_flex_to_user_tac for %s returning %s (env.enable_defer_to_tac: %s)\n" (Print.ctx_uvar_to_string_no_reason u) (string_of_bool b) (string_of_bool wl.tcenv.enable_defer_to_tac); @@ -1848,7 +1872,7 @@ let run_meta_arg_tac (env:env_t) (ctx_u:ctx_uvar) : term = match ctx_u.ctx_uvar_meta with | Some (Ctx_uvar_meta_tac tau) -> let env = { env with gamma = ctx_u.ctx_uvar_gamma } in - if Env.debug env (Options.Other "Tac") then + if !dbg_Tac then BU.print1 "Running tactic for meta-arg %s\n" (show ctx_u); Errors.with_ctx "Running tactic for meta-arg" (fun () -> env.synth_hook env (U.ctx_uvar_typ ctx_u) tau) @@ -1856,7 +1880,7 @@ let run_meta_arg_tac (env:env_t) (ctx_u:ctx_uvar) : term = failwith "run_meta_arg_tac must have been called with a uvar that has a meta tac" let simplify_vc full_norm_allowed env t = - if Env.debug env <| Options.Other "Simplification" then + if !dbg_Simplification then BU.print1 "Simplifying guard %s\n" (show t); let steps = [Env.Beta; Env.Eager_unfolding; @@ -1865,7 +1889,7 @@ let simplify_vc full_norm_allowed env t = Env.Exclude Env.Zeta] in let steps = if full_norm_allowed then steps else Env.NoFullNorm::steps in let t' = norm_with_steps "FStar.TypeChecker.Rel.simplify_vc" steps env t in - if Env.debug env <| Options.Other "Simplification" then + if !dbg_Simplification then BU.print1 "Simplified guard to %s\n" (show t'); t' @@ -1916,8 +1940,6 @@ let apply_substitutive_indexed_subcomp (env:Env.env) : typ & list prob & worklist = - let debug = debug wl <| Options.Other "LayeredEffectsApp" in - // // We will collect the substitutions in subst, // bs will be the remaining binders (that are not in subst yet) @@ -1985,7 +2007,7 @@ let apply_substitutive_indexed_subcomp (env:Env.env) List.fold_left (fun (ss, wl) b -> let [uv_t], g = Env.uvars_for_binders env [b] ss (fun b -> - if debug + if !dbg_LayeredEffectsApp then BU.format3 "implicit var for additional binder %s in subcomp %s at %s" (Print.binder_to_string b) subcomp_name @@ -2029,8 +2051,6 @@ let apply_ad_hoc_indexed_subcomp (env:Env.env) : typ & list prob & worklist = - let dbg = debug wl <| Options.Other "LayeredEffectsApp" in - let stronger_t_shape_error s = BU.format2 "Unexpected shape of stronger for %s, reason: %s" (Ident.string_of_lid ct2.effect_name) s in @@ -2049,7 +2069,7 @@ let apply_ad_hoc_indexed_subcomp (env:Env.env) Env.uvars_for_binders env rest_bs [NT (a_b.binder_bv, ct2.result_typ)] (fun b -> - if dbg + if !dbg_LayeredEffectsApp then BU.format3 "implicit for binder %s in subcomp %s at %s" (Print.binder_to_string b) subcomp_name @@ -2071,7 +2091,7 @@ let apply_ad_hoc_indexed_subcomp (env:Env.env) |> List.map (SS.subst substs) in List.fold_left2 (fun (ps, wl) f_sort_i c1_i -> - if debug wl <| Options.Other "LayeredEffectsEqns" + if !dbg_LayeredEffectsApp then BU.print3 "Layered Effects (%s) %s = %s\n" subcomp_name (show f_sort_i) (show c1_i); let p, wl = sub_prob wl f_sort_i EQ c1_i "indices of c1" in @@ -2088,7 +2108,7 @@ let apply_ad_hoc_indexed_subcomp (env:Env.env) r1 (stronger_t_shape_error "subcomp return type is not a repr") in List.fold_left2 (fun (ps, wl) g_sort_i c2_i -> - if debug wl <| Options.Other "LayeredEffectsEqns" + if !dbg_LayeredEffectsApp then BU.print3 "Layered Effects (%s) %s = %s\n" subcomp_name (show g_sort_i) (show c2_i); let p, wl = sub_prob wl g_sort_i EQ c2_i "indices of c2" in @@ -2105,7 +2125,7 @@ let apply_ad_hoc_indexed_subcomp (env:Env.env) let has_typeclass_constraint (u:ctx_uvar) (wl:worklist) : bool - = wl.typeclass_variables |> Set.for_any (fun v -> UF.equiv v.ctx_uvar_head u.ctx_uvar_head) + = wl.typeclass_variables |> for_any (fun v -> UF.equiv v.ctx_uvar_head u.ctx_uvar_head) (* This function returns true for those lazykinds that are "complete" in the sense that unfolding them does not @@ -2128,7 +2148,7 @@ let lazy_complete_repr (k:lazy_kind) : bool = | _ -> false let has_free_uvars (t:term) : bool = - not (Set.is_empty (Free.uvars_uncached t)) + not (is_empty (Free.uvars_uncached t)) let env_has_free_uvars (e:env_t) : bool = List.existsb (fun b -> has_free_uvars b.binder_bv.sort) (Env.all_binders e) @@ -2146,9 +2166,9 @@ type reveal_hide_t = (******************************************************************************************************) let rec solve (probs :worklist) : solution = // printfn "Solving TODO:\n%s;;" (List.map prob_to_string probs.attempting |> String.concat "\n\t"); - if debug probs <| Options.Other "Rel" + if !dbg_Rel then BU.print1 "solve:\n\t%s\n" (wl_to_string probs); - if debug probs <| Options.Other "ImplicitTrace" then + if !dbg_ImplicitTrace then BU.print1 "solve: wl_implicits = %s\n" (Common.implicits_to_string probs.wl_implicits); @@ -2236,7 +2256,7 @@ and solve_maybe_uinsts (orig:prob) (t1:term) (t2:term) (wl:worklist) : univ_eq_s and giveup_or_defer (orig:prob) (wl:worklist) (reason:deferred_reason) (msg:lstring) : solution = if wl.defer_ok = DeferAny then begin - if debug wl <| Options.Other "Rel" then + if !dbg_Rel then BU.print2 "\n\t\tDeferring %s\n\t\tBecause %s\n" (prob_to_string wl.tcenv orig) (Thunk.force msg); solve (defer reason msg orig wl) end @@ -2245,14 +2265,14 @@ and giveup_or_defer (orig:prob) (wl:worklist) (reason:deferred_reason) (msg:lstr and giveup_or_defer_flex_flex (orig:prob) (wl:worklist) (reason:deferred_reason) (msg:lstring) : solution = if wl.defer_ok <> NoDefer then begin - if debug wl <| Options.Other "Rel" then + if !dbg_Rel then BU.print2 "\n\t\tDeferring %s\n\t\tBecause %s\n" (prob_to_string wl.tcenv orig) (Thunk.force msg); solve (defer reason msg orig wl) end else giveup wl msg orig and defer_to_user_tac (orig:prob) reason (wl:worklist) : solution = - if debug wl <| Options.Other "Rel" then + if !dbg_Rel then BU.print1 "\n\t\tDeferring %s to a tactic\n" (prob_to_string wl.tcenv orig); let wl = solve_prob orig None [] wl in let wl = {wl with wl_deferred_to_tac=(wl.ctr, @@ -2311,9 +2331,9 @@ and solve_rigid_flex_or_flex_rigid_subtyping TProb p, wl in let pairwise t1 t2 wl = - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "[meet/join]: pairwise: %s and %s\n" (show t1) (show t2); - let mr, ts = head_matches_delta (p_env wl (TProb tp)) wl.smt_ok t1 t2 in + let mr, ts = head_matches_delta (p_env wl (TProb tp)) tp.logical wl.smt_ok t1 t2 in match mr with | HeadMatch true | MisMatch _ -> @@ -2424,7 +2444,7 @@ and solve_rigid_flex_or_flex_rigid_subtyping (t, [p], wl) in let t1, ps, wl = combine t1 t2 wl in - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print1 "pairwise fallback2 succeeded: %s" (show t1); t1, ps, wl @@ -2456,7 +2476,7 @@ and solve_rigid_flex_or_flex_rigid_subtyping match quasi_pattern wl.tcenv flex with | None -> giveup_lit wl "flex-arrow subtyping, not a quasi pattern" (TProb tp) | Some (flex_bs, flex_t) -> - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print1 "Trying to solve by imitating arrow:%s\n" (string_of_int tp.pid); imitate_arrow (TProb tp) wl flex flex_bs flex_t tp.relation this_rigid end @@ -2464,7 +2484,7 @@ and solve_rigid_flex_or_flex_rigid_subtyping solve (attempt [TProb ({tp with relation=EQ})] wl) | _ -> - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print1 "Trying to solve by meeting refinements:%s\n" (string_of_int tp.pid); let u, _args = U.head_and_args this_flex in let env = p_env wl (TProb tp) in @@ -2540,7 +2560,7 @@ and solve_rigid_flex_or_flex_rigid_subtyping (if flip then "joining refinements" else "meeting refinements") in def_check_prob "meet_or_join2" (TProb eq_prob); - let _ = if debug wl <| Options.Other "Rel" + let _ = if !dbg_Rel then let wl' = {wl with attempting=TProb eq_prob::sub_probs} in BU.print1 "After meet/join refinements: %s\n" (wl_to_string wl') in @@ -2563,7 +2583,7 @@ and solve_rigid_flex_or_flex_rigid_subtyping solve wl | Failed (p, msg) -> - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print1 "meet/join attempted and failed to solve problems:\n%s\n" (List.map (prob_to_string env) (TProb eq_prob::sub_probs) |> String.concat "\n"); (match rank, base_and_refinement env bound_typ with @@ -2676,7 +2696,7 @@ and imitate_arrow (orig:prob) (wl:worklist) and solve_binders (bs1:binders) (bs2:binders) (orig:prob) (wl:worklist) (rhs:worklist -> binders -> list subst_elt -> (prob * worklist)) : solution = - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print3 "solve_binders\n\t%s\n%s\n\t%s\n" (Print.binders_to_string ", " bs1) (rel_to_string (p_rel orig)) @@ -2685,7 +2705,7 @@ and solve_binders (bs1:binders) (bs2:binders) (orig:prob) (wl:worklist) let eq_bqual a1 a2 = match a1, a2 with | Some (Implicit b1), Some (Implicit b2) -> - U.Equal //we don't care about comparing the dot qualifier in this context + true //we don't care about comparing the dot qualifier in this context | _ -> U.eq_bqual a1 a2 in @@ -2715,13 +2735,13 @@ and solve_binders (bs1:binders) (bs2:binders) (orig:prob) (wl:worklist) match xs, ys with | [], [] -> let rhs_prob, wl = rhs wl scope subst in - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print1 "rhs_prob = %s\n" (prob_to_string (p_env wl rhs_prob) rhs_prob); let formula = p_guard rhs_prob in Inl ([rhs_prob], formula), wl | x::xs, y::ys - when (eq_bqual x.binder_qual y.binder_qual = U.Equal && + when (eq_bqual x.binder_qual y.binder_qual && compat_positivity_qualifiers x.binder_positivity y.binder_positivity) -> let hd1, imp = x.binder_bv, x.binder_qual in let hd2, imp' = y.binder_bv, y.binder_qual in @@ -2736,7 +2756,7 @@ and solve_binders (bs1:binders) (bs2:binders) (orig:prob) (wl:worklist) let phi = U.mk_conj (p_guard prob) (close_forall (p_env wl prob) [{x with binder_bv=hd1}] phi) in - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "Formula is %s\n\thd1=%s\n" (show phi) (Print.bv_to_string hd1); Inl (prob::sub_probs, phi), wl @@ -2818,8 +2838,10 @@ and solve_t (problem:tprob) (wl:worklist) : solution = and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) : solution = - if debug wl <| Options.Other "Rel" then - BU.print_string "solve_t_flex_rigid_eq\n"; + if !dbg_Rel then ( + BU.print1 "solve_t_flex_rigid_eq rhs=%s\n" + (show rhs) + ); if should_defer_flex_to_user_tac wl lhs then defer_to_user_tac orig (flex_reason lhs) wl @@ -2846,7 +2868,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) let (Flex (_, ctx_u, args)) = lhs in let bs, rhs = let bv_not_free_in_arg x arg = - not (Set.mem x (Free.names (fst arg))) + not (mem x (Free.names (fst arg))) in let bv_not_free_in_args x args = BU.for_all (bv_not_free_in_arg x) args @@ -2856,7 +2878,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) | None, None -> true | Some (Implicit _), Some a -> a.aqual_implicit && - U.eqlist (fun x y -> U.eq_tm x y = U.Equal) + U.eqlist (fun x y -> TEQ.eq_tm env x y = TEQ.Equal) b.binder_attrs a.aqual_attributes | _ -> false @@ -2941,7 +2963,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) let try_quasi_pattern (orig:prob) (env:Env.env) (wl:worklist) (lhs:flex_t) (rhs:term) : either string (list uvi) * worklist = - if debug wl <| Options.Other "Rel" then + if !dbg_Rel then BU.print_string "try_quasi_pattern\n"; match quasi_pattern env lhs with | None -> @@ -2954,7 +2976,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) then Inl ("quasi-pattern, occurs-check failed: " ^ (Option.get msg)), wl else let fvs_lhs = binders_as_bv_set (ctx_u.ctx_uvar_binders@bs) in let fvs_rhs = Free.names rhs in - if not (Set.subset fvs_rhs fvs_lhs) + if not (subset fvs_rhs fvs_lhs) then Inl ("quasi-pattern, free names on the RHS are not included in the LHS"), wl else Inr (mk_solution env lhs bs rhs), restrict_all_uvars env ctx_u [] uvars wl in @@ -3002,7 +3024,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) (lhs:flex_t) (bs_lhs:binders) (t_res_lhs:term) (rhs:term) : solution = - // if debug wl <| Options.Other "Rel" + // if !dbg_Rel // then BU.print4 "imitate_app 1:\n\tlhs=%s\n\tbs_lhs=%s\n\tt_res_lhs=%s\n\trhs=%s\n" // (flex_t_to_string lhs) // (Print.binders_to_string ", " bs_lhs) @@ -3011,7 +3033,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) let rhs_hd, args = U.head_and_args rhs in let args_rhs, last_arg_rhs = BU.prefix args in let rhs' = S.mk_Tm_app rhs_hd args_rhs rhs.pos in - // if debug wl <| Options.Other "Rel" + // if !dbg_Rel // then BU.print2 "imitate_app 2:\n\trhs'=%s\n\tlast_arg_rhs=%s\n" // (show rhs') // (show [last_arg_rhs]); @@ -3033,7 +3055,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) let _, lhs'_last_arg, wl = copy_uvar u_lhs bs_lhs t_last_arg wl in lhs', lhs'_last_arg, wl in - // if debug wl <| Options.Other "Rel" + // if !dbg_Rel // then BU.print2 "imitate_app 3:\n\tlhs'=%s\n\tlast_arg_lhs=%s\n" // (show lhs') // (show lhs'_last_arg); @@ -3062,7 +3084,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) let imitate (orig:prob) (env:Env.env) (wl:worklist) (lhs:flex_t) (rhs:term) : solution = - if debug wl <| Options.Other "Rel" then + if !dbg_Rel then BU.print_string "imitate\n"; let is_app rhs = let _, args = U.head_and_args rhs in @@ -3107,7 +3129,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) *) let try_first_order orig env wl lhs rhs = let inapplicable msg lstring_opt = - if debug wl <| Options.Other "Rel" + if !dbg_Rel then ( let extra_msg = match lstring_opt with @@ -3118,7 +3140,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) ); Inl "first_order doesn't apply" in - if debug wl <| Options.Other "Rel" then + if !dbg_Rel then BU.print2 "try_first_order\n\tlhs=%s\n\trhs=%s\n" (flex_t_to_string lhs) (show rhs); @@ -3135,8 +3157,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) let uvars_head, occurs_ok, _ = occurs_check ctx_uv head in if not occurs_ok then inapplicable "occurs check failed" None - else if not (Set.subset (Free.names head) - (binders_as_bv_set ctx_uv.ctx_uvar_binders)) + else if not (Free.names head `subset` binders_as_bv_set ctx_uv.ctx_uvar_binders) then inapplicable "free name inclusion failed" None else ( let t_head, _ = @@ -3174,7 +3195,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) UF.rollback tx; inapplicable "Subprobs failed: " (Some lstring) in - if U.eq_tm t_head (U.ctx_uvar_typ ctx_uv) = U.Equal + if TEQ.eq_tm env t_head (U.ctx_uvar_typ ctx_uv) = TEQ.Equal then // // eq_tm doesn't unify, so uvars_head computed remains consistent @@ -3182,7 +3203,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) // solve_sub_probs_if_head_types_equal uvars_head wl else ( - if debug wl (Options.Other "Rel") + if !dbg_Rel then BU.print2 "first-order: head type mismatch:\n\tlhs=%s\n\trhs=%s\n" (show (U.ctx_uvar_typ ctx_uv)) (show t_head); @@ -3198,7 +3219,7 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) // will also try to restrict them // solve_sub_probs_if_head_types_equal - (head |> Free.uvars |> Set.elems) + (head |> Free.uvars |> elems) wl | Inr msg -> UF.rollback tx; @@ -3218,12 +3239,12 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) let env = p_env wl orig in match pat_vars env ctx_uv.ctx_uvar_binders args_lhs with | Some lhs_binders -> //Pattern - if debug wl <| Options.Other "Rel" then + if !dbg_Rel then BU.print_string "it's a pattern\n"; let rhs = sn env rhs in let fvs1 = binders_as_bv_set (ctx_uv.ctx_uvar_binders @ lhs_binders) in let fvs2 = Free.names rhs in - //if debug wl <| Options.Other "Rel" then + //if !dbg_Rel then // BU.print4 "lhs \t= %s\n\ // FV(lhs) \t= %s\n\ // rhs \t= %s\n\ @@ -3233,11 +3254,30 @@ and solve_t_flex_rigid_eq (orig:prob) (wl:worklist) (lhs:flex_t) (rhs:term) // (show rhs) // (show fvs2); let uvars, occurs_ok, msg = occurs_check ctx_uv rhs in + + (* If the occurs check fails, attempt to do a bit more normalization + and try it again. *) + let (uvars, occurs_ok, msg), rhs = + if occurs_ok + then (uvars, occurs_ok, msg), rhs + else + let rhs = N.normalize + [Env.Primops; Env.Weak; Env.HNF; Env.Beta; Env.Eager_unfolding; Env.Unascribe] + (p_env wl orig) rhs in + occurs_check ctx_uv rhs, rhs + in + + (* If, possibly after some extra normalization in the above block, + the RHS has become syntactically equal to the LHS, solve the problem + and carry on. See #3264. *) + if term_is_uvar ctx_uv rhs && Nil? args_lhs then + solve (solve_prob orig None [] wl) + else if not occurs_ok then giveup_or_defer orig wl Deferred_occur_check_failed (Thunk.mkv <| "occurs-check failed: " ^ (Option.get msg)) - else if Set.subset fvs2 fvs1 + else if subset fvs2 fvs1 then let sol = mk_solution env lhs lhs_binders rhs in let wl = restrict_all_uvars env ctx_uv lhs_binders uvars wl in solve (solve_prob orig None sol wl) @@ -3287,7 +3327,7 @@ and solve_t_flex_flex env orig wl (lhs:flex_t) (rhs:flex_t) : solution = let run_meta_arg_tac_and_try_again (flex:flex_t) = let uv = flex_uvar flex in let t = run_meta_arg_tac env uv in - if debug wl <| Options.Other "Rel" then + if !dbg_Rel then BU.print2 "solve_t_flex_flex: solving meta arg uvar %s with %s\n" (show uv) (show t); set_uvar env uv None t; solve (attempt [orig] wl) in @@ -3353,7 +3393,7 @@ and solve_t_flex_flex env orig wl (lhs:flex_t) (rhs:flex_t) : solution = (show wl.defer_ok))) else begin // let _ = - // if debug wl <| Options.Other "Rel" + // if !dbg_Rel // then BU.print1 "flex-flex quasi: %s\n" // (BU.stack_dump()) // in @@ -3374,7 +3414,7 @@ and solve_t_flex_flex env orig wl (lhs:flex_t) (rhs:flex_t) : solution = in let w_app = S.mk_Tm_app w (List.map (fun ({binder_bv=z}) -> S.as_arg (S.bv_to_name z)) zs) w.pos in let _ = - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print "flex-flex quasi:\n\t\ lhs=%s\n\t\ rhs=%s\n\t\ @@ -3411,7 +3451,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = let rigid_heads_match (need_unif:bool) (torig:tprob) (wl:worklist) (t1:term) (t2:term) : solution = let orig = TProb torig in let env = p_env wl orig in - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print5 "Heads %s: %s (%s) and %s (%s)\n" (if need_unif then "need unification" else "match") (show t1) (Print.tag_of_term t1) @@ -3442,7 +3482,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = (show head1) (show args1) (show head2) (show args2))) orig else - if nargs=0 || U.eq_args args1 args2=U.Equal //special case: for easily proving things like nat <: nat, or greater_than i <: greater_than i etc. + if nargs=0 || TEQ.eq_args env args1 args2=TEQ.Equal //special case: for easily proving things like nat <: nat, or greater_than i <: greater_than i etc. then if need_unif then solve_t ({problem with lhs=head1; rhs=head2}) wl else solve_head_then wl (fun ok wl -> @@ -3475,7 +3515,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = argp ([], wl) in - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "Adding subproblems for arguments (smtok=%s): %s" (string_of_bool wl.smt_ok) @@ -3502,7 +3542,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = solve (attempt subprobs wl)) in let unfold_and_retry d wl (prob, reason) = - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "Failed to solve %s because a sub-problem is not solvable without SMT because %s" (prob_to_string env orig) (Thunk.force reason); @@ -3514,9 +3554,9 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = let head1', _ = U.head_and_args t1' in let head2', _ = U.head_and_args t2' in begin - match U.eq_tm head1' head1, U.eq_tm head2' head2 with - | U.Equal, U.Equal -> //unfolding didn't make progress - if debug wl <| Options.Other "Rel" + match TEQ.eq_tm env head1' head1, TEQ.eq_tm env head2' head2 with + | TEQ.Equal, TEQ.Equal -> //unfolding didn't make progress + if !dbg_Rel then BU.print4 "Unfolding didn't make progress ... got %s ~> %s;\nand %s ~> %s\n" (show t1) @@ -3526,7 +3566,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = solve_sub_probs env wl //fallback to trying to solve with SMT on | _ -> let torig' = {torig with lhs=t1'; rhs=t2'} in - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print1 "Unfolded and now trying %s\n" (prob_to_string env (TProb torig')); solve_t torig' wl @@ -3534,11 +3574,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = | _ -> solve_sub_probs env wl //fallback to trying to solve with SMT on in - let d = - match delta_depth_of_term env head1 with - | None -> None - | Some d -> decr_delta_depth d - in + let d = decr_delta_depth <| delta_depth_of_term env head1 in let treat_as_injective = match (U.un_uinst head1).n with | Tm_fvar fv -> @@ -3623,7 +3659,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = |> fst |> N.normalize_refinement N.whnf_steps env |> U.unrefine in - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print1 "Match heuristic, typechecking the pattern term: %s {\n\n" (show pat_term); let pat_term, pat_term_t, g_pat_term = @@ -3631,7 +3667,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = (Env.set_expected_typ env scrutinee_t) pat_term must_tot in - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "} Match heuristic, typechecked pattern term to %s and type %s\n" (show pat_term) (show pat_term_t); @@ -3644,7 +3680,8 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = then begin let prob, wl = new_problem wl env scrutinee EQ pat_term None scrutinee.pos - "match heuristic" in + "match heuristic" + in let wl' = extend_wl ({wl with defer_ok=NoDefer; smt_ok=false; @@ -3678,7 +3715,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = match t1t2_opt with | None -> Inr None | Some (t1, t2) -> - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "Trying match heuristic for %s vs. %s\n" (show t1) (show t2); @@ -3687,16 +3724,16 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = | (s, t), (_, {n=Tm_match {scrutinee; brs=branches}}) -> if not (is_flex scrutinee) then begin - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print1 "match head %s is not a flex term\n" (show scrutinee); Inr None end else if wl.defer_ok = DeferAny - then (if debug wl <| Options.Other "Rel" + then (if !dbg_Rel then BU.print_string "Deferring ... \n"; Inl "defer") else begin - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "Heuristic applicable with scrutinee %s and other side = %s\n" (show scrutinee) (show t); @@ -3712,7 +3749,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = if pat_discriminates b then let (_, _, t') = SS.open_branch b in - match head_matches_delta (p_env wl orig) wl.smt_ok s t' with + match head_matches_delta (p_env wl orig) (p_logical orig) wl.smt_ok s t' with | FullMatch, _ | HeadMatch _, _ -> true @@ -3722,7 +3759,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = begin match head_matching_branch with | None -> - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print_string "No head_matching branch\n"; let try_branches = match BU.prefix_until (fun b -> not (pat_discriminates b)) branches with @@ -3735,7 +3772,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = | Some b -> let (p, _, e) = SS.open_branch b in - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "Found head matching branch %s -> %s\n" (Print.pat_to_string p) (show e); @@ -3744,7 +3781,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = end end | _ -> - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "Heuristic not applicable: tag lhs=%s, rhs=%s\n" (Print.tag_of_term t1) (Print.tag_of_term t2); Inr None @@ -3755,13 +3792,13 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = (head1:term) (head2:term) (t1:term) (t2:term) : solution = let orig = TProb torig in - if debug wl <| Options.Other "RelDelta" then + if !dbg_RelDelta then BU.print4 "rigid_rigid_delta of %s-%s (%s, %s)\n" (Print.tag_of_term t1) (Print.tag_of_term t2) (show t1) (show t2); - let m, o = head_matches_delta (p_env wl orig) wl.smt_ok t1 t2 in + let m, o = head_matches_delta (p_env wl orig) (p_logical orig) wl.smt_ok t1 t2 in match m, o with | (MisMatch _, _) -> //heads definitely do not match let try_reveal_hide t1 t2 = @@ -3854,14 +3891,9 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = solve (solve_prob orig (Some guard) [] wl) else giveup wl (mklstr (fun () -> BU.format4 "head mismatch (%s (%s) vs %s (%s))" (show head1) - (BU.dflt "" - (BU.bind_opt (delta_depth_of_term wl.tcenv head1) - (fun x -> Some (show x)))) + (show (delta_depth_of_term wl.tcenv head1)) (show head2) - (BU.dflt "" - (BU.bind_opt (delta_depth_of_term wl.tcenv head2) - (fun x -> Some (show x)))) - )) orig + (show (delta_depth_of_term wl.tcenv head2)))) orig end | (HeadMatch true, _) when problem.relation <> EQ -> @@ -3896,11 +3928,12 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = def_check_scoped (p_loc orig) "ref.t1" (List.map (fun b -> b.binder_bv) (p_scope orig)) t1; def_check_scoped (p_loc orig) "ref.t2" (List.map (fun b -> b.binder_bv) (p_scope orig)) t2; let _ = - if debug wl (Options.Other "Rel") - then BU.print4 "Attempting %s (%s vs %s); rel = (%s)\n" (string_of_int problem.pid) + if !dbg_Rel + then BU.print5 "Attempting %s (%s vs %s); rel = (%s); number of problems in wl = %s\n" (string_of_int problem.pid) (Print.tag_of_term t1 ^ "::" ^ show t1) (Print.tag_of_term t2 ^ "::" ^ show t2) (rel_to_string problem.relation) + (show (List.length wl.attempting)) in match t1.n, t2.n with | Tm_delayed _, _ @@ -3971,7 +4004,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = *) let env = p_env wl (TProb problem) in let x1, x2 = - match head_matches_delta env wl.smt_ok x1.sort x2.sort with + match head_matches_delta env false wl.smt_ok x1.sort x2.sort with (* We allow (HeadMatch true) since we're gonna unify them again anyway via base_prob *) | FullMatch, Some (t1, t2) | HeadMatch _, Some (t1, t2) -> @@ -3985,7 +4018,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = let x1, phi1 = as_refinement false env t1 in let x2, phi2 = as_refinement false env t2 in (* / hack *) - if debug wl (Options.Other "Rel") then begin + if !dbg_Rel then begin BU.print3 "ref1 = (%s):(%s){%s}\n" (show x1) (show x1.sort) (show phi1); @@ -3999,26 +4032,28 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = let phi1 = Subst.subst subst phi1 in let phi2 = Subst.subst subst phi2 in let mk_imp imp phi1 phi2 = imp phi1 phi2 |> guard_on_element wl problem x1 in - let fallback () = - let impl = - if problem.relation = EQ - then mk_imp U.mk_iff phi1 phi2 - else mk_imp U.mk_imp phi1 phi2 in - let guard = U.mk_conj (p_guard base_prob) impl in - def_check_scoped (p_loc orig) "ref.1" (List.map (fun b -> b.binder_bv) (p_scope orig)) (p_guard base_prob); - def_check_scoped (p_loc orig) "ref.2" (List.map (fun b -> b.binder_bv) (p_scope orig)) impl; - let wl = solve_prob orig (Some guard) [] wl in - solve (attempt [base_prob] wl) - in + let fallback () = + let impl = + if problem.relation = EQ + then mk_imp U.mk_iff phi1 phi2 + else mk_imp U.mk_imp phi1 phi2 in + let guard = U.mk_conj (p_guard base_prob) impl in + def_check_scoped (p_loc orig) "ref.1" (List.map (fun b -> b.binder_bv) (p_scope orig)) (p_guard base_prob); + def_check_scoped (p_loc orig) "ref.2" (List.map (fun b -> b.binder_bv) (p_scope orig)) impl; + let wl = solve_prob orig (Some guard) [] wl in + solve (attempt [base_prob] wl) + in let has_uvars = - not (Set.is_empty (FStar.Syntax.Free.uvars phi1)) - || not (Set.is_empty (FStar.Syntax.Free.uvars phi2)) + not (is_empty (FStar.Syntax.Free.uvars phi1)) + || not (is_empty (FStar.Syntax.Free.uvars phi2)) in if problem.relation = EQ || (not env.uvar_subtyping && has_uvars) then let ref_prob, wl = mk_t_problem wl [mk_binder x1] orig phi1 EQ phi2 None "refinement formula" in + let ref_prob = set_logical true ref_prob in + let tx = UF.new_transaction () in (* We set wl_implicits to false, since in the success case we will * extend the original wl with the extra implicits we get, and we @@ -4117,7 +4152,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = then let flex, wl = destruct_flex_t not_abs wl in solve_t_flex_rigid_eq orig wl flex t_abs else begin - match head_matches_delta env wl.smt_ok not_abs t_abs with + match head_matches_delta env false wl.smt_ok not_abs t_abs with | HeadMatch _, Some (not_abs', _) -> solve_t ({problem with lhs=not_abs'; rhs=t_abs}) wl @@ -4177,7 +4212,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = (* Branch body *) // GM: Could use problem.relation here instead of EQ? let prob, wl = mk_t_problem wl scope orig e1 EQ e2 None "branch body" in - if debug wl <| Options.Other "Rel" + if !dbg_Rel then BU.print2 "Created problem for branches %s with scope %s\n" (prob_to_string' wl prob) (Print.binders_to_string ", " scope); @@ -4195,7 +4230,7 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = | Some (sub_probs, wl) -> let sc_prob, wl = mk_t_problem wl [] orig s1 EQ s2 None "match scrutinee" in let sub_probs = ([], sc_prob)::sub_probs in - let formula = U.mk_conj_l (List.map (fun (scope, p) -> close_forall wl.tcenv scope (p_guard p)) sub_probs) in + let formula = U.mk_conj_l (List.map (fun (scope, p) -> close_forall (p_env wl orig) scope (p_guard p)) sub_probs) in let tx = UF.new_transaction () in let wl = solve_prob orig (Some formula) [] wl in begin match solve (attempt (List.map snd sub_probs) ({wl with smt_ok = false})) with @@ -4225,35 +4260,35 @@ and solve_t' (problem:tprob) (wl:worklist) : solution = let head1 = U.head_and_args t1 |> fst in let head2 = U.head_and_args t2 |> fst in let _ = - if debug wl (Options.Other "Rel") + if !dbg_Rel then BU.print ">> (%s) (smtok=%s)\n>>> head1 = %s [interpreted=%s; no_free_uvars=%s]\n>>> head2 = %s [interpreted=%s; no_free_uvars=%s]\n" - [(string_of_int problem.pid); - (string_of_bool wl.smt_ok); + [(show problem.pid); + (show wl.smt_ok); (show head1); - (string_of_bool (Env.is_interpreted wl.tcenv head1)); - (string_of_bool (no_free_uvars t1)); + (show (Env.is_interpreted wl.tcenv head1)); + (show (no_free_uvars t1)); (show head2); - (string_of_bool (Env.is_interpreted wl.tcenv head2)); - (string_of_bool (no_free_uvars t2))] + (show (Env.is_interpreted wl.tcenv head2)); + (show (no_free_uvars t2))] in let equal t1 t2 : bool = (* Try comparing the terms as they are. If we get Equal or NotEqual, we are done. If we get an Unknown, attempt some normalization. *) - let r = U.eq_tm t1 t2 in + let env = p_env wl orig in + let r = TEQ.eq_tm env t1 t2 in match r with - | U.Equal -> true - | U.NotEqual -> false - | U.Unknown -> + | TEQ.Equal -> true + | TEQ.NotEqual -> false + | TEQ.Unknown -> let steps = [ Env.UnfoldUntil delta_constant; Env.Primops; Env.Beta; Env.Eager_unfolding; Env.Iota ] in - let env = p_env wl orig in let t1 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.2" steps env t1 in let t2 = norm_with_steps "FStar.TypeChecker.Rel.norm_with_steps.3" steps env t2 in - U.eq_tm t1 t2 = U.Equal + TEQ.eq_tm env t1 t2 = TEQ.Equal in if (Env.is_interpreted wl.tcenv head1 || Env.is_interpreted wl.tcenv head2) //we have something like (+ x1 x2) =?= (- y1 y2) && problem.relation = EQ @@ -4322,7 +4357,7 @@ and solve_c (problem:problem comp) (wl:worklist) : solution = fun wl t1 rel t2 reason -> mk_t_problem wl [] orig t1 rel t2 None reason in let solve_eq c1_comp c2_comp g_lift = - let _ = if debug wl <| Options.Other "EQ" + let _ = if !dbg_EQ then BU.print2 "solve_c is using an equality constraint (%s vs %s)\n" (show (mk_Comp c1_comp)) (show (mk_Comp c2_comp)) in @@ -4383,7 +4418,7 @@ and solve_c (problem:problem comp) (wl:worklist) : solution = // primitive effects. let solve_layered_sub c1 c2 = - if debug wl <| Options.Other "LayeredEffectsApp" then + if !dbg_LayeredEffectsApp then BU.print2 "solve_layered_sub c1: %s and c2: %s {\n" (c1 |> S.mk_Comp |> show) (c2 |> S.mk_Comp |> show); @@ -4491,7 +4526,7 @@ and solve_c (problem:problem comp) (wl:worklist) : solution = List.fold_right2 (fun (a1, _) (a2, _) (is_sub_probs, wl) -> if is_uvar a1 then begin - if debug wl <| Options.Other "LayeredEffectsEqns" then + if !dbg_LayeredEffectsEqns then BU.print2 "Layered Effects teq (rel c1 index uvar) %s = %s\n" (show a1) (show a2); let p, wl = sub_prob wl a1 EQ a2 "l.h.s. effect index uvar" in @@ -4524,7 +4559,7 @@ and solve_c (problem:problem comp) (wl:worklist) : solution = U.mk_conj guard fml in let wl = solve_prob orig (Some guard) [] wl in - if debug wl <| Options.Other "LayeredEffectsApp" + if !dbg_LayeredEffectsApp then BU.print_string "}\n"; solve (attempt sub_probs wl) in @@ -4593,7 +4628,7 @@ and solve_c (problem:problem comp) (wl:worklist) : solution = U.t_true else let wpc1_2 = lift_c1 () |> (fun ct -> List.hd ct.effect_args) in if is_null_wp_2 - then let _ = if debug wl <| Options.Other "Rel" + then let _ = if !dbg_Rel then BU.print_string "Using trivial wp ... \n" in let c1_univ = env.universe_of env c1.result_typ in let trivial = @@ -4606,7 +4641,7 @@ and solve_c (problem:problem comp) (wl:worklist) : solution = let stronger = c2_decl |> U.get_stronger_vc_combinator |> fst in mk (Tm_app {hd=inst_effect_fun_with [c2_univ] env c2_decl stronger; args=[as_arg c2.result_typ; as_arg wpc2; wpc1_2]}) r in - if debug wl <| Options.Other "Rel" then + if !dbg_Rel then BU.print1 "WP guard (simplifed) is (%s)\n" (show (N.normalize [Env.Iota; Env.Eager_unfolding; Env.Primops; Env.Simplify] env g)); let base_prob, wl = sub_prob wl c1.result_typ problem.relation c2.result_typ "result type" in let wl = solve_prob orig (Some <| U.mk_conj (p_guard base_prob) g) [] wl in @@ -4615,7 +4650,7 @@ and solve_c (problem:problem comp) (wl:worklist) : solution = if BU.physical_equality c1 c2 then solve (solve_prob orig None [] wl) - else let _ = if debug wl <| Options.Other "Rel" + else let _ = if !dbg_Rel then BU.print3 "solve_c %s %s %s\n" (show c1) (rel_to_string problem.relation) @@ -4673,7 +4708,7 @@ and solve_c (problem:problem comp) (wl:worklist) : solution = else begin let c1 = Env.unfold_effect_abbrev env c1 in let c2 = Env.unfold_effect_abbrev env c2 in - if debug wl <| Options.Other "Rel" then BU.print2 "solve_c for %s and %s\n" (string_of_lid c1.effect_name) (string_of_lid c2.effect_name); + if !dbg_Rel then BU.print2 "solve_c for %s and %s\n" (string_of_lid c1.effect_name) (string_of_lid c2.effect_name); if Env.is_layered_effect env c2.effect_name then solve_layered_sub c1 c2 else match Env.monad_leq env c1.effect_name c2.effect_name with @@ -4713,8 +4748,8 @@ let guard_to_string (env:env) g = let form = match g.guard_f with | Trivial -> "trivial" | NonTrivial f -> - if Env.debug env <| Options.Other "Rel" - || Env.debug env <| Options.Extreme + if !dbg_Rel + || Debug.extreme () || Options.print_implicits () then N.term_to_string env f else "non-trivial" in @@ -4725,8 +4760,8 @@ let guard_to_string (env:env) g = (ineqs_to_string g.univ_ineqs) imps let new_t_problem wl env lhs rel rhs elt loc = - let reason = if debug wl <| Options.Other "ExplainRel" - || debug wl <| Options.Other "Rel" + let reason = if !dbg_ExplainRel + || !dbg_Rel then BU.format3 "Top-level:\n%s\n\t%s\n%s" (N.term_to_string env lhs) (rel_to_string rel) (N.term_to_string env rhs) @@ -4744,22 +4779,22 @@ let solve_and_commit wl err : option (deferred * deferred * implicits) = let tx = UF.new_transaction () in - if debug wl <| Options.Other "RelBench" then + if !dbg_RelBench then BU.print1 "solving problems %s {\n" (FStar.Common.string_of_list (fun p -> string_of_int (p_pid p)) wl.attempting); let (sol, ms) = BU.record_time (fun () -> solve wl) in - if debug wl <| Options.Other "RelBench" then + if !dbg_RelBench then BU.print1 "} solved in %s ms\n" (string_of_int ms); match sol with | Success (deferred, defer_to_tac, implicits) -> let ((), ms) = BU.record_time (fun () -> UF.commit tx) in - if debug wl <| Options.Other "RelBench" then + if !dbg_RelBench then BU.print1 "committed in %s ms\n" (string_of_int ms); Some (deferred, defer_to_tac, implicits) | Failed (d,s) -> - if debug wl <| Options.Other "ExplainRel" - || debug wl <| Options.Other "Rel" + if !dbg_ExplainRel + || !dbg_Rel then BU.print_string <| explain wl d s; let result = err (d,s) in UF.rollback tx; @@ -4784,11 +4819,11 @@ let try_teq smt_ok env t1 t2 : option guard_t = let smt_ok = smt_ok && not (Options.ml_ish ()) in Profiling.profile (fun () -> - if Env.debug env <| Options.Other "Rel" || Env.debug env <| Options.Other "RelTop" then + if !dbg_RelTop then BU.print3 "try_teq of %s and %s in %s {\n" (show t1) (show t2) (show env.gamma); let prob, wl = new_t_problem (empty_worklist env) env t1 EQ t2 None (Env.get_range env) in let g = with_guard env prob <| solve_and_commit (singleton wl prob smt_ok) (fun _ -> None) in - if Env.debug env <| Options.Other "Rel" || Env.debug env <| Options.Other "RelTop" then + if !dbg_RelTop then BU.print1 "} res = %s\n" (FStar.Common.string_of_option (guard_to_string env) g); g) (Some (Ident.string_of_lid (Env.current_module env))) @@ -4798,12 +4833,12 @@ let try_teq smt_ok env t1 t2 : option guard_t = let teq env t1 t2 : guard_t = match try_teq true env t1 t2 with | None -> - FStar.Errors.log_issue + FStar.Errors.log_issue_doc (Env.get_range env) (Err.basic_type_error env None t2 t1); trivial_guard | Some g -> - if Env.debug env <| Options.Other "Rel" || Env.debug env <| Options.Other "RelTop" then + if !dbg_Rel || !dbg_RelTop then BU.print3 "teq of %s and %s succeeded with guard %s\n" (show t1) (show t2) (guard_to_string env g); g @@ -4815,11 +4850,11 @@ let teq env t1 t2 : guard_t = * But that may change the existing VCs shape a bit *) let get_teq_predicate env t1 t2 = - if Env.debug env <| Options.Other "Rel" || Env.debug env <| Options.Other "RelTop" then + if !dbg_Rel || !dbg_RelTop then BU.print2 "get_teq_predicate of %s and %s {\n" (show t1) (show t2); let prob, x, wl = new_t_prob (empty_worklist env) env t1 EQ t2 in let g = with_guard env prob <| solve_and_commit (singleton wl prob true) (fun _ -> None) in - if Env.debug env <| Options.Other "Rel" || Env.debug env <| Options.Other "RelTop" then + if !dbg_Rel || !dbg_RelTop then BU.print1 "} res teq predicate = %s\n" (FStar.Common.string_of_option (guard_to_string env) g); match g with @@ -4827,12 +4862,12 @@ let get_teq_predicate env t1 t2 = | Some g -> Some (abstract_guard (S.mk_binder x) g) let subtype_fail env e t1 t2 = - Errors.log_issue (Env.get_range env) (Err.basic_type_error env (Some e) t2 t1) + Errors.log_issue_doc (Env.get_range env) (Err.basic_type_error env (Some e) t2 t1) let sub_or_eq_comp env (use_eq:bool) c1 c2 = Profiling.profile (fun () -> let rel = if use_eq then EQ else SUB in - if Env.debug env <| Options.Other "Rel" || Env.debug env <| Options.Other "RelTop" then + if !dbg_Rel || !dbg_RelTop then BU.print3 "sub_comp of %s --and-- %s --with-- %s\n" (show c1) (show c2) (if rel = EQ then "EQ" else "SUB"); let prob, wl = new_problem (empty_worklist env) env c1 rel c2 None (Env.get_range env) "sub_comp" in let wl = { wl with repr_subcomp_allowed = true } in @@ -4841,7 +4876,7 @@ let sub_or_eq_comp env (use_eq:bool) c1 c2 = let (r, ms) = BU.record_time (fun () -> with_guard env prob <| solve_and_commit (singleton wl prob true) (fun _ -> None)) in - if Env.debug env <| Options.Other "RelBench" then + if !dbg_RelBench then BU.print4 "sub_comp of %s --and-- %s --with-- %s --- solved in %s ms\n" (show c1) (show c2) (if rel = EQ then "EQ" else "SUB") (string_of_int ms); r) (Some (Ident.string_of_lid (Env.current_module env))) @@ -4924,11 +4959,11 @@ let solve_universe_inequalities' tx env (variables, ineqs) : unit = if ineqs |> BU.for_all (fun (u, v) -> if check_ineq (u, v) then true - else (if Env.debug env <| Options.Other "GenUniverses" + else (if !dbg_GenUniverses then BU.print2 "%s []) |> Set.from_list + | _ -> []) |> from_list in let wl = {wl_of_guard env g.deferred with defer_ok=defer_ok ; smt_ok=smt_ok @@ -4966,7 +5001,7 @@ let try_solve_deferred_constraints (defer_ok:defer_ok_t) smt_ok deferred_to_tac_ let msg = explain wl d s in raise_error (Errors.Fatal_ErrorInSolveDeferredConstraints, msg) (p_loc d) in - if Env.debug env <| Options.Other "Rel" + if !dbg_Rel then begin BU.print4 "Trying to solve carried problems (defer_ok=%s) (deferred_to_tac_ok=%s): begin\n\t%s\nend\n and %s implicits\n" (show defer_ok) @@ -4995,7 +5030,7 @@ let try_solve_deferred_constraints (defer_ok:defer_ok_t) smt_ok deferred_to_tac_ "FStar.TypeChecker.Rel.solve_deferred_to_tactic_goals" else g in - if Env.debug env <| Options.Other "ResolveImplicitsHook" + if !dbg_ResolveImplicitsHook then BU.print2 "ResolveImplicitsHook: Solved deferred to tactic goals, remaining guard is\n%s (and %s implicits)\n" (guard_to_string env g) (string_of_int (List.length g.implicits)); @@ -5024,11 +5059,7 @@ let do_discharge_vc use_env_range_msg env vc : unit = let open FStar.Pprint in let open FStar.Errors.Msg in let open FStar.Class.PP in - let debug : bool = - (Env.debug env <| Options.Other "Rel") - || (Env.debug env <| Options.Other "SMTQuery") - || (Env.debug env <| Options.Other "Discharge") - in + let debug : bool = !dbg_Rel || !dbg_SMTQuery || !dbg_Discharge in let diag_doc = Errors.diag_doc (Env.get_range env) in if debug then diag_doc [text "Checking VC:" ^/^ pp vc]; @@ -5121,7 +5152,7 @@ let do_discharge_vc use_env_range_msg env vc : unit = // In every case, when this function returns [Some g], then the logical // part of [g] is [Trivial]. let discharge_guard' use_env_range_msg env (g:guard_t) (use_smt:bool) : option guard_t = - if Env.debug env <| Options.Other "ResolveImplicitsHook" + if !dbg_ResolveImplicitsHook then BU.print1 "///////////////////ResolveImplicitsHook: discharge_guard'\n\ guard = %s\n" (guard_to_string env g); @@ -5135,11 +5166,7 @@ let discharge_guard' use_env_range_msg env (g:guard_t) (use_smt:bool) : option g let open FStar.Pprint in let open FStar.Errors.Msg in let open FStar.Class.PP in - let debug : bool = - (Env.debug env <| Options.Other "Rel") - || (Env.debug env <| Options.Other "SMTQuery") - || (Env.debug env <| Options.Other "Disch") - in + let debug : bool = !dbg_Rel || !dbg_SMTQuery || !dbg_Discharge in let diag_doc = Errors.diag_doc (Env.get_range env) in let ret_g = {g with guard_f = Trivial} in if not (Env.should_verify env) then ( @@ -5181,7 +5208,7 @@ let teq_nosmt (env:env) (t1:typ) (t2:typ) : option guard_t = | Some g -> discharge_guard' None env g false let subtype_nosmt env t1 t2 = - if Env.debug env <| Options.Other "Rel" || Env.debug env <| Options.Other "RelTop" + if !dbg_Rel || !dbg_RelTop then BU.print2 "try_subtype_no_smt of %s and %s\n" (N.term_to_string env t1) (N.term_to_string env t2); let prob, x, wl = new_t_prob (empty_worklist env) env t1 SUB t2 in let g = with_guard env prob <| solve_and_commit (singleton wl prob false) (fun _ -> None) in @@ -5194,15 +5221,13 @@ let subtype_nosmt env t1 t2 = /////////////////////////////////////////////////////////////////// let check_subtyping env t1 t2 = Profiling.profile (fun () -> - if Env.debug env <| Options.Other "Rel" || Env.debug env <| Options.Other "RelTop" - + if !dbg_Rel || !dbg_RelTop then BU.print2 "check_subtyping of %s and %s\n" (N.term_to_string env t1) (N.term_to_string env t2); let prob, x, wl = new_t_prob (empty_worklist env) env t1 SUB t2 in let env_x = Env.push_bv env x in let smt_ok = not (Options.ml_ish ()) in let g = with_guard env_x prob <| solve_and_commit (singleton wl prob smt_ok) (fun _ -> None) in - if (Env.debug env <| Options.Other "Rel" || Env.debug env <| Options.Other "RelTop") - && BU.is_some g + if (!dbg_Rel || !dbg_RelTop) && BU.is_some g then BU.print3 "check_subtyping succeeded: %s <: %s\n\tguard is %s\n" (N.term_to_string env_x t1) (N.term_to_string env_x t2) @@ -5309,7 +5334,7 @@ let check_implicit_solution_and_discharge_guard env let uvar_ty = U.ctx_uvar_typ imp_uvar in let uvar_should_check = U.ctx_uvar_should_check imp_uvar in - if Env.debug env <| Options.Other "Rel" + if !dbg_Rel then BU.print5 "Checking uvar %s resolved to %s at type %s, introduce for %s at %s\n" (Print.uvar_to_string imp_uvar.ctx_uvar_head) (show imp_tm) @@ -5437,7 +5462,7 @@ let pick_a_univ_deffered_implicit (out : tagged_implicits) let is_tac_implicit_resolved (env:env) (i:implicit) : bool = i.imp_tm |> Free.uvars - |> Set.for_all (fun uv -> Allow_unresolved? (U.ctx_uvar_should_check uv)) + |> for_all (fun uv -> Allow_unresolved? (U.ctx_uvar_should_check uv)) // is_tac: this is a call from within the tactic engine, hence do not use @@ -5460,7 +5485,19 @@ let resolve_implicits' env is_tac is_gen (implicits:Env.implicits) g (1 + 1) we cannot reuse the solution for each +, since there is an extra unit binder when we check `g ...`. But it does lead to big gains in expressions like `1 + 1 + 1 ...`. *) - let cacheable tac = U.is_fvar PC.tcresolve_lid tac in + let cacheable tac = + (* Detect either an unapplied tcresolve or an eta expanded variant. This is + mostly in support of solve, which has to be written eta expanded. *) + (U.is_fvar PC.tcresolve_lid tac) || ( + match (SS.compress tac).n with + | Tm_abs ({bs=[_]; body}) -> + let hd, args = U.head_and_args body in + U.is_fvar PC.tcresolve_lid hd && List.length args = 1 + | _ -> false + ) + in + (* tcresolve is also the only tactic we ever run for an open problem. *) + let meta_tac_allowed_for_open_problem tac = cacheable tac in let __meta_arg_cache : ref (list (term & env_t & typ & term)) = BU.mk_ref [] in let meta_arg_cache_result (tac : term) (e : env_t) (ty : term) (res : term) : unit = __meta_arg_cache := (tac, e, ty, res) :: !__meta_arg_cache @@ -5480,23 +5517,35 @@ let resolve_implicits' env is_tac is_gen (implicits:Env.implicits) in (* / cache *) - let rec until_fixpoint (acc : tagged_implicits & (*changed:*)bool) + let rec until_fixpoint (acc : tagged_implicits & (*changed:*)bool & (*defer_open_metas:*)bool ) (implicits:Env.implicits) : tagged_implicits = - let out, changed = acc in + let out, changed, defer_open_metas = acc in + (* changed: we made some progress + defer_open_metas: starts at true, it means to not try to run + meta arg tactics in environments/types that have unresolved + uvars. We first do a pass with this set to true, and if nothing + changed, we then give up and set it to false, trying to eagerly + solve some partially-unresolved constraints. This is definitely + not ideal, maybe the right thing to do is to never run metas + in open contexts, but that is raising many regressions rihgt now, + particularly in Steel (which uses the resolve_implicits hook pervasively). *) match implicits with | [] -> if changed then ( (* We made some progress, keep going from the start *) - until_fixpoint ([], false) (List.map fst out) + until_fixpoint ([], false, true) (List.map fst out) + ) else if defer_open_metas then ( + (* No progress... but we could try being more eager with metas. *) + until_fixpoint ([], false, false) (List.map fst out) ) else ( //Nothing changed in this iteration of the loop //We will try to make progress by either solving a single valued implicit, // or solving an implicit that generates univ constraint, with force flag on let imps, changed = try_solve_single_valued_implicits env is_tac (List.map fst out) in - if changed then until_fixpoint ([], false) imps + if changed then until_fixpoint ([], false, true) imps else let imp_opt, rest = pick_a_univ_deffered_implicit out in (match imp_opt with | None -> rest //No such implicit exists, return remaining implicits @@ -5508,31 +5557,35 @@ let resolve_implicits' env is_tac is_gen (implicits:Env.implicits) imp is_tac force_univ_constraints |> must in - until_fixpoint ([], false) (imps@List.map fst rest)) + until_fixpoint ([], false, true) (imps@List.map fst rest)) ) | hd::tl -> let { imp_reason = reason; imp_tm = tm; imp_uvar = ctx_u; imp_range = r } = hd in let { uvar_decoration_typ; uvar_decoration_should_check } = UF.find_decoration ctx_u.ctx_uvar_head in - if Env.debug env <| Options.Other "Rel" then + if !dbg_Rel then BU.print4 "resolve_implicits' loop, imp_tm=%s and ctx_u=%s, is_tac=%s, should_check=%s\n" (show tm) (show ctx_u) (show is_tac) (show uvar_decoration_should_check); begin match () with | _ when Allow_unresolved? uvar_decoration_should_check -> - until_fixpoint (out, true) tl + until_fixpoint (out, true, defer_open_metas) tl | _ when unresolved ctx_u && flex_uvar_has_meta_tac ctx_u -> let Some (Ctx_uvar_meta_tac tac) = ctx_u.ctx_uvar_meta in let env = { env with gamma = ctx_u.ctx_uvar_gamma } in let typ = U.ctx_uvar_typ ctx_u in - if (has_free_uvars typ || gamma_has_free_uvars ctx_u.ctx_uvar_gamma) - && Options.ext_getv "compat:open_metas" = "" then // i.e. compat option unset - ( + let is_open = has_free_uvars typ || gamma_has_free_uvars ctx_u.ctx_uvar_gamma in + if defer_open_metas && is_open then ( (* If the result type or env for this meta arg has a free uvar, delay it. Some other meta arg being solved may instantiate the uvar. See #3130. *) - if Env.debug env <| Options.Other "Rel" || Env.debug env <| Options.Other "Imps" then + if !dbg_Rel || !dbg_Imps then BU.print1 "Deferring implicit due to open ctx/typ %s\n" (show ctx_u); - until_fixpoint ((hd, Implicit_unresolved)::out, changed) tl + until_fixpoint ((hd, Implicit_unresolved)::out, changed, defer_open_metas) tl + ) else if is_open && not (meta_tac_allowed_for_open_problem tac) + && Options.ext_getv "compat:open_metas" = "" then ( // i.e. compat option unset + (* If the tactic is not explicitly whitelisted to run with open problems, + then defer. *) + until_fixpoint ((hd, Implicit_unresolved)::out, changed, defer_open_metas) tl ) else ( let solve_with (t:term) = let extra = @@ -5540,7 +5593,7 @@ let resolve_implicits' env is_tac is_gen (implicits:Env.implicits) | None -> failwith "resolve_implicits: unifying with an unresolved uvar failed?" | Some g -> g.implicits in - until_fixpoint (out, true) (extra @ tl) + until_fixpoint (out, true, defer_open_metas) (extra @ tl) in if cacheable tac then match meta_arg_cache_lookup tac env typ with @@ -5555,12 +5608,12 @@ let resolve_implicits' env is_tac is_gen (implicits:Env.implicits) ) | _ when unresolved ctx_u -> - until_fixpoint ((hd, Implicit_unresolved)::out, changed) tl + until_fixpoint ((hd, Implicit_unresolved)::out, changed, defer_open_metas) tl | _ when Allow_untyped? uvar_decoration_should_check || Already_checked? uvar_decoration_should_check || is_gen -> - until_fixpoint (out, true) tl + until_fixpoint (out, true, defer_open_metas) tl | _ -> let env = {env with gamma=ctx_u.ctx_uvar_gamma} in (* @@ -5583,7 +5636,7 @@ let resolve_implicits' env is_tac is_gen (implicits:Env.implicits) then failwith "Impossible: check_implicit_solution_and_discharge_guard for tac must return Some []" else () else (); - until_fixpoint (out, true) tl + until_fixpoint (out, true, defer_open_metas) tl end else begin @@ -5597,22 +5650,22 @@ let resolve_implicits' env is_tac is_gen (implicits:Env.implicits) match imps_opt with | None -> - until_fixpoint ((hd, Implicit_checking_defers_univ_constraint)::out, changed) tl //Move hd to out + until_fixpoint ((hd, Implicit_checking_defers_univ_constraint)::out, changed, defer_open_metas) tl //Move hd to out | Some imps -> //add imps to out - until_fixpoint ((imps |> List.map (fun i -> i, Implicit_unresolved))@out, true) tl + until_fixpoint ((imps |> List.map (fun i -> i, Implicit_unresolved))@out, true, defer_open_metas) tl end end in - until_fixpoint ([], false) implicits + until_fixpoint ([], false, true) implicits let resolve_implicits env g = - if Env.debug env <| Options.Other "ResolveImplicitsHook" + if !dbg_ResolveImplicitsHook then BU.print1 "//////////////////////////ResolveImplicitsHook: resolve_implicits begin////////////\n\ guard = %s {\n" (guard_to_string env g); let tagged_implicits = resolve_implicits' env false false g.implicits in - if Env.debug env <| Options.Other "ResolveImplicitsHook" + if !dbg_ResolveImplicitsHook then BU.print_string "//////////////////////////ResolveImplicitsHook: resolve_implicits end////////////\n\ }\n"; {g with implicits = List.map fst tagged_implicits} @@ -5624,7 +5677,7 @@ let resolve_generalization_implicits env g = let resolve_implicits_tac env g = resolve_implicits' env true false g.implicits let force_trivial_guard env g = - if Env.debug env <| Options.Other "ResolveImplicitsHook" + if !dbg_ResolveImplicitsHook then BU.print1 "//////////////////////////ResolveImplicitsHook: force_trivial_guard////////////\n\ guard = %s\n" (guard_to_string env g); @@ -5661,7 +5714,7 @@ let teq_nosmt_force (env:env) (t1:typ) (t2:typ) :bool = true let layered_effect_teq env (t1:term) (t2:term) (reason:option string) : guard_t = - if Env.debug env <| Options.Other "LayeredEffectsEqns" + if !dbg_LayeredEffectsEqns then BU.print3 "Layered Effect (%s) %s = %s\n" (if reason |> is_none then "_" else reason |> must) (show t1) (show t2); diff --git a/src/typechecker/FStar.TypeChecker.Rel.fsti b/src/typechecker/FStar.TypeChecker.Rel.fsti index 5eb6e62a0bf..aecadb6b4a4 100644 --- a/src/typechecker/FStar.TypeChecker.Rel.fsti +++ b/src/typechecker/FStar.TypeChecker.Rel.fsti @@ -48,7 +48,7 @@ val prob_to_string: env -> prob -> string val flex_prob_closing : env -> binders -> prob -> bool -val head_matches_delta (env:env) (smt_ok:bool) (t1 t2:typ) : (match_result & option (typ & typ)) +val head_matches_delta (env:env) (logical:bool) (smt_ok:bool) (t1 t2:typ) : (match_result & option (typ & typ)) val may_relate_with_logical_guard (env:env) (is_equality:bool) (head:typ) : bool val guard_to_string : env -> guard_t -> string val simplify_guard : env -> guard_t -> guard_t diff --git a/src/typechecker/FStar.TypeChecker.Tc.fst b/src/typechecker/FStar.TypeChecker.Tc.fst index f8770e9ec43..7fbc18077c4 100644 --- a/src/typechecker/FStar.TypeChecker.Tc.fst +++ b/src/typechecker/FStar.TypeChecker.Tc.fst @@ -32,7 +32,9 @@ open FStar.Syntax.Subst open FStar.Syntax.Util open FStar.Const open FStar.TypeChecker.TcTerm + open FStar.Class.Show +open FStar.Class.Setlike module S = FStar.Syntax.Syntax module SP = FStar.Syntax.Print @@ -51,6 +53,12 @@ module EMB = FStar.Syntax.Embeddings module ToSyntax = FStar.ToSyntax.ToSyntax module O = FStar.Options +let dbg_TwoPhases = Debug.get_toggle "TwoPhases" +let dbg_IdInfoOn = Debug.get_toggle "IdInfoOn" +let dbg_Normalize = Debug.get_toggle "Normalize" +let dbg_UF = Debug.get_toggle "UF" +let dbg_LogTypes = Debug.get_toggle "LogTypes" + let sigelt_typ (se:sigelt) : option typ = match se.sigel with | Sig_inductive_typ {t} @@ -127,7 +135,7 @@ let tc_decl_attributes env se = {se with sigattrs = blacklisted_attrs @ other_attrs } let tc_inductive' env ses quals attrs lids = - if Env.debug env Options.Low then + if Debug.low () then BU.print1 ">>>>>>>>>>>>>>tc_inductive %s\n" (FStar.Common.string_of_list Print.sigelt_to_string ses); let ses = List.map (tc_decl_attributes env) ses in @@ -380,7 +388,7 @@ let tc_sig_let env r se lbs lids : list sigelt * list sigelt * Env.env = let preprocess_lb (tau:term) (lb:letbinding) : letbinding = let lbdef = Env.preprocess env tau lb.lbdef in - if Env.debug env <| Options.Other "TwoPhases" then + if Debug.medium () || !dbg_TwoPhases then BU.print1 "lb preprocessed into: %s\n" (Print.term_to_string lbdef); { lb with lbdef = lbdef } in @@ -427,13 +435,13 @@ let tc_sig_let env r se lbs lids : list sigelt * list sigelt * Env.env = "FStar.TypeChecker.Tc.tc_sig_let-tc-phase1" in - if Env.debug env <| Options.Other "TwoPhases" then + if Debug.medium () || !dbg_TwoPhases then BU.print1 "Let binding after phase 1, before removing uvars: %s\n" (Print.term_to_string e); let e = N.remove_uvar_solutions env' e |> drop_lbtyp in - if Env.debug env <| Options.Other "TwoPhases" then + if Debug.medium () || !dbg_TwoPhases then BU.print1 "Let binding after phase 1, uvars removed: %s\n" (Print.term_to_string e); e) @@ -505,7 +513,7 @@ let tc_sig_let env r se lbs lids : list sigelt * list sigelt * Env.env = then err ("no_subtype annotation on a non-lemma") lb.lbpos else let lid_opt = Free.fvars lb.lbtyp - |> Set.elems + |> elems |> List.tryFind (fun lid -> not (lid |> Ident.path_of_lid |> List.hd = "Prims" || lid_equals lid PC.pattern_lid)) in @@ -573,7 +581,7 @@ let tc_decl' env0 se: list sigelt * list sigelt * Env.env = * follow it. See #1956 for an example of what goes wrong if we * don't pop the context (spoiler: we prove false). *) - if Env.debug env Options.Low then + if Debug.low () then BU.print1 ">> Expecting errors: [%s]\n" (String.concat "; " <| List.map string_of_int expected_errors); let errs, _ = Errors.catch_errors (fun () -> @@ -581,7 +589,7 @@ let tc_decl' env0 se: list sigelt * list sigelt * Env.env = BU.must (!tc_decls_knot) env' ses)) in if Options.print_expected_failures () - || Env.debug env Options.Low then + || Debug.low () then begin BU.print_string ">> Got issues: [\n"; List.iter Errors.print_issue errs; @@ -625,7 +633,7 @@ let tc_decl' env0 se: list sigelt * list sigelt * Env.env = |> fst |> N.elim_uvars env |> U.ses_of_sigbundle in - if Env.debug env <| Options.Other "TwoPhases" + if Debug.medium () || !dbg_TwoPhases then BU.print1 "Inductive after phase 1: %s\n" (Print.sigelt_to_string ({ se with sigel = Sig_bundle {ses; lids} })); ses) else ses @@ -666,7 +674,7 @@ let tc_decl' env0 se: list sigelt * list sigelt * Env.env = TcEff.tc_eff_decl ({ env with phase1 = true; lax = true }) ne se.sigquals se.sigattrs |> (fun ne -> { se with sigel = Sig_new_effect ne }) |> N.elim_uvars env |> U.eff_decl_of_new_effect in - if Env.debug env <| Options.Other "TwoPhases" + if Debug.medium () || !dbg_TwoPhases then BU.print1 "Effect decl after phase 1: %s\n" (Print.sigelt_to_string ({ se with sigel = Sig_new_effect ne })); ne) @@ -721,7 +729,7 @@ let tc_decl' env0 se: list sigelt * list sigelt * Env.env = let uvs, t = if do_two_phases env then run_phase1 (fun _ -> let uvs, t = tc_declare_typ ({ env with phase1 = true; lax = true }) (uvs, t) se.sigrng in //|> N.normalize [Env.NoFullNorm; Env.Beta; Env.DoNotUnfoldPureLets] env in - if Env.debug env <| Options.Other "TwoPhases" then BU.print2 "Val declaration after phase 1: %s and uvs: %s\n" (Print.term_to_string t) (Print.univ_names_to_string uvs); + if Debug.medium () || !dbg_TwoPhases then BU.print2 "Val declaration after phase 1: %s and uvs: %s\n" (show t) (show uvs); uvs, t) else uvs, t in @@ -739,7 +747,7 @@ let tc_decl' env0 se: list sigelt * list sigelt * Env.env = let uvs, t = if do_two_phases env then run_phase1 (fun _ -> let uvs, t = tc_assume ({ env with phase1 = true; lax = true }) (uvs, t) se.sigrng in - if Env.debug env <| Options.Other "TwoPhases" then BU.print2 "Assume after phase 1: %s and uvs: %s\n" (Print.term_to_string t) (Print.univ_names_to_string uvs); + if Debug.medium () || !dbg_TwoPhases then BU.print2 "Assume after phase 1: %s and uvs: %s\n" (show t) (show uvs); uvs, t) else uvs, t in @@ -748,7 +756,7 @@ let tc_decl' env0 se: list sigelt * list sigelt * Env.env = [ { se with sigel = Sig_assume {lid; us=uvs; phi=t} }], [], env0 | Sig_splice {is_typed; lids; tac=t} -> - if Options.debug_any () then + if Debug.any () then BU.print3 "%s: Found splice of (%s) with is_typed: %s\n" (string_of_lid env.curmodule) (Print.term_to_string t) @@ -779,7 +787,7 @@ let tc_decl' env0 se: list sigelt * list sigelt * Env.env = let dsenv = List.fold_left DsEnv.push_sigelt_force env.dsenv ses in let env = { env with dsenv = dsenv } in - if Env.debug env Options.Low then + if Debug.low () then BU.print1 "Splice returned sigelts {\n%s\n}\n" (String.concat "\n" <| List.map Print.sigelt_to_string ses); @@ -811,7 +819,7 @@ let tc_decl' env0 se: list sigelt * list sigelt * Env.env = match se.sigel with | Sig_polymonadic_bind {tm=t; typ=ty} -> t, ty | _ -> failwith "Impossible! tc for Sig_polymonadic_bind must be a Sig_polymonadic_bind") in - if Env.debug env <| Options.Other "TwoPhases" + if Debug.medium () || !dbg_TwoPhases then BU.print1 "Polymonadic bind after phase 1: %s\n" (Print.sigelt_to_string ({ se with sigel = Sig_polymonadic_bind {m_lid=m; n_lid=n; @@ -845,7 +853,7 @@ let tc_decl' env0 se: list sigelt * list sigelt * Env.env = match se.sigel with | Sig_polymonadic_subcomp {tm=t; typ=ty} -> t, ty | _ -> failwith "Impossible! tc for Sig_polymonadic_subcomp must be a Sig_polymonadic_subcomp") in - if Env.debug env <| Options.Other "TwoPhases" + if Debug.medium () || !dbg_TwoPhases then BU.print1 "Polymonadic subcomp after phase 1: %s\n" (Print.sigelt_to_string ({ se with sigel = Sig_polymonadic_subcomp {m_lid=m; n_lid=n; @@ -868,12 +876,9 @@ let tc_decl' env0 se: list sigelt * list sigelt * Env.env = * during typechecking but not yet typechecked *) let tc_decl env se: list sigelt * list sigelt * Env.env = let env = set_hint_correlator env se in - if Options.debug_module (string_of_lid env.curmodule) then - BU.print1 "Processing %s\n" - (if Options.debug_at_level (string_of_lid env.curmodule) Options.High - then Print.sigelt_to_string se - else Print.sigelt_to_string_short se); - if Env.debug env Options.Low then + if Debug.any () then + BU.print1 "Processing %s\n" (Print.sigelt_to_string_short se); + if Debug.low () then BU.print1 ">>>>>>>>>>>>>>tc_decl %s\n" (show se); let result = if se.sigmeta.sigmeta_already_checked then @@ -897,7 +902,7 @@ let tc_decl env se: list sigelt * list sigelt * Env.env = (* adds the typechecked sigelt to the env, also performs any processing required in the env (such as reset options) *) (* AR: we now call this function when loading checked modules as well to be more consistent *) let add_sigelt_to_env (env:Env.env) (se:sigelt) (from_cache:bool) : Env.env = - if Env.debug env Options.Low + if Debug.low () then BU.print2 ">>>>>>>>>>>>>>Adding top-level decl to environment: %s (from_cache:%s)\n" (show se) (show from_cache); @@ -974,16 +979,16 @@ let tc_decls env ses = (* If emacs is peeking, and debugging is on, don't do anything, * otherwise the user will see a bunch of output from typechecking * definitions that were not yet advanced over. *) - if env.nosynth && Options.debug_any () + if env.nosynth && Debug.any () then (ses, env), [] else begin - if Env.debug env Options.Low + if Debug.low () then BU.print2 ">>>>>>>>>>>>>>Checking top-level %s decl %s\n" (Print.tag_of_sigelt se) (Print.sigelt_to_string se); if Options.ide_id_info_off() then Env.toggle_id_info env false; - if Env.debug env (Options.Other "IdInfoOn") then Env.toggle_id_info env true; + if !dbg_IdInfoOn then Env.toggle_id_info env true; let ses', ses_elaborated, env = Errors.with_ctx (BU.format2 "While typechecking the %stop-level declaration `%s`" @@ -993,11 +998,11 @@ let tc_decls env ses = in let ses' = ses' |> List.map (fun se -> - if Env.debug env (Options.Other "UF") + if !dbg_UF then BU.print1 "About to elim vars from %s\n" (Print.sigelt_to_string se); N.elim_uvars env se) in let ses_elaborated = ses_elaborated |> List.map (fun se -> - if Env.debug env (Options.Other "UF") + if !dbg_UF then BU.print1 "About to elim vars from (elaborated) %s\n" (Print.sigelt_to_string se); N.elim_uvars env se) in @@ -1006,14 +1011,37 @@ let tc_decls env ses = // Compress all checked sigelts. Uvars and names are not OK after a full typecheck let ses' = ses' |> List.map (Compress.deep_compress_se false false) in + // Make sure to update all the delta_depths of the definitions we will add to the + // environment. These can change if the body of the letbinding is transformed by any means, + // such as by resolving an `_ by ...`, or a pre/post process hook. + // let fixup_dd_lb (lb:letbinding) : letbinding = + // (* The delta depth of the fv is 1 + the dd of its body *) + // let Inr fv = lb.lbname in + // // BU.print2_error "Checking depth of %s = %s\n" (show lb.lbname) (show fv.fv_delta); + // // let dd = incr_delta_depth <| delta_qualifier lb.lbdef in + // let dd = incr_delta_depth <| delta_depth_of_term env lb.lbdef in + // // if Some dd <> fv.fv_delta then ( + // // BU.print3_error "Fixing up delta depth of %s from %s to %s\n" (Print.lbname_to_string lb.lbname) (show fv.fv_delta) (show dd) + // // ); + // // BU.print1_error "Definition = (%s)\n\n" (show lb.lbdef); + // let fv = { fv with fv_delta = Some dd } in + // { lb with lbname = Inr fv } + // in + // let fixup_delta_depth (se:sigelt) : sigelt = + // match se.sigel with + // | Sig_let {lbs; lids} -> + // let lbs = fst lbs, List.map fixup_dd_lb (snd lbs) in + // { se with sigel = Sig_let {lbs; lids} } + // | _ -> se + // in + // let ses' = ses' |> List.map fixup_delta_depth in + // Add to the environment let env = ses' |> List.fold_left (fun env se -> add_sigelt_to_env env se false) env in UF.reset(); - if Options.log_types() || Env.debug env <| Options.Other "LogTypes" - then begin - BU.print1 "Checked: %s\n" (List.fold_left (fun s se -> s ^ Print.sigelt_to_string se ^ "\n") "" ses') - end; + if Options.log_types () || Debug.medium () || !dbg_LogTypes + then BU.print1 "Checked: %s\n" (show ses'); Profiling.profile (fun () -> List.iter (fun se -> env.solver.encode_sig env se) ses') @@ -1035,8 +1063,8 @@ let tc_decls env ses = // ^ See a special case for this phase in FStar.Options. --timing // enables it. in - if Options.profile_group_by_decls() - || Options.timing () // --timing implies --profile_group_by_decls + if Options.profile_group_by_decl() + || Options.timing () // --timing implies --profile_group_by_decl then begin let tag = match lids_of_sigelt se with @@ -1069,9 +1097,13 @@ let tc_partial_modul env modul = let verify = Options.should_verify (string_of_lid modul.name) in let action = if verify then "verifying" else "lax-checking" in let label = if modul.is_interface then "interface" else "implementation" in - if Options.debug_any () then + if Debug.any () then BU.print3 "Now %s %s of %s\n" action label (string_of_lid modul.name); + Debug.disable_all (); + if Options.should_check (string_of_lid modul.name) // || Options.debug_all_modules () + then Debug.enable_toggles (Options.debug_keys ()); + let name = BU.format2 "%s %s" (if modul.is_interface then "interface" else "module") (string_of_lid modul.name) in let env = {env with Env.is_iface=modul.is_interface; admit=not verify} in let env = Env.set_current_module env modul.name in @@ -1139,6 +1171,12 @@ let load_checked_module_sigelts (en:env) (m:modul) : env = let load_checked_module (en:env) (m:modul) :env = (* Another compression pass to make sure we are not loading a corrupt module. *) + + (* Reset debug flags *) + if Options.should_check (string_of_lid m.name) || Options.debug_all_modules () + then Debug.enable_toggles (Options.debug_keys ()) + else Debug.disable_all (); + let m = deep_compress_modul m in let env = load_checked_module_sigelts en m in //And then call finish_partial_modul, which is the normal workflow of tc_modul below @@ -1152,7 +1190,7 @@ let load_partial_checked_module (en:env) (m:modul) : env = load_checked_module_sigelts en m let check_module env m b = - if Options.debug_any() + if Debug.any() then BU.print2 "Checking %s: %s\n" (if m.is_interface then "i'face" else "module") (Print.lid_to_string m.name); if Options.dump_module (string_of_lid m.name) then BU.print1 "Module before type checking:\n%s\n" (Print.modul_to_string m); @@ -1163,7 +1201,7 @@ let check_module env m b = (* Debug information for level Normalize : normalizes all toplevel declarations an dump the current module *) if Options.dump_module (string_of_lid m.name) then BU.print1 "Module after type checking:\n%s\n" (Print.modul_to_string m); - if Options.dump_module (string_of_lid m.name) && Options.debug_at_level (string_of_lid m.name) (Options.Other "Normalize") + if Options.dump_module (string_of_lid m.name) && !dbg_Normalize then begin let normalize_toplevel_lets = fun se -> match se.sigel with | Sig_let {lbs=(b, lbs); lids=ids} -> diff --git a/src/typechecker/FStar.TypeChecker.TcEffect.fst b/src/typechecker/FStar.TypeChecker.TcEffect.fst index 39299526b31..71772f8eea8 100644 --- a/src/typechecker/FStar.TypeChecker.TcEffect.fst +++ b/src/typechecker/FStar.TypeChecker.TcEffect.fst @@ -38,10 +38,14 @@ module Env = FStar.TypeChecker.Env module N = FStar.TypeChecker.Normalize module TcUtil = FStar.TypeChecker.Util module Gen = FStar.TypeChecker.Generalize +module TEQ = FStar.TypeChecker.TermEqAndSimplify module BU = FStar.Compiler.Util open FStar.Class.Show +let dbg = Debug.get_toggle "ED" +let dbg_LayeredEffectsTc = Debug.get_toggle "LayeredEffectsTc" + let dmff_cps_and_elaborate env ed = (* This is only an elaboration rule not a typechecking one *) @@ -154,7 +158,7 @@ let bind_combinator_kind (env:env) : option (list indexed_effect_binder_kind) = let debug s = - if Env.debug env <| Options.Other "LayeredEffectsTc" + if Debug.medium () || !dbg_LayeredEffectsTc then BU.print1 "%s\n" s in debug (BU.format1 @@ -254,9 +258,9 @@ let bind_combinator_kind (env:env) U.arrow [S.mk_binder x_bv] (mk_Total g_sig_b_sort) in let g_b_kind = - if U.eq_tm g_sig_b_arrow_t g_b.binder_bv.sort = U.Equal + if TEQ.eq_tm env g_sig_b_arrow_t g_b.binder_bv.sort = TEQ.Equal then Substitutive_binder - else if U.eq_tm g_sig_b_sort g_b.binder_bv.sort = U.Equal + else if TEQ.eq_tm env g_sig_b_sort g_b.binder_bv.sort = TEQ.Equal then BindCont_no_abstraction_binder else Ad_hoc_binder in let ss = ss@[NT (g_sig_b.binder_bv, g_b.binder_bv |> S.bv_to_name)] in @@ -301,7 +305,7 @@ let bind_combinator_kind (env:env) result_typ = a_b.binder_bv |> S.bv_to_name; effect_args = repr_app_bs |> List.map (fun b -> b.binder_bv |> S.bv_to_name |> S.as_arg); flags = []})) in - if U.eq_tm f_b.binder_bv.sort expected_f_b_sort = U.Equal + if TEQ.eq_tm env f_b.binder_bv.sort expected_f_b_sort = TEQ.Equal then Some () else None in @@ -335,7 +339,7 @@ let bind_combinator_kind (env:env) effect_args = repr_args; flags = []})) in U.arrow [x_bv |> S.mk_binder] (mk_Total thunk_t) in - if U.eq_tm g_b.binder_bv.sort expected_g_b_sort = U.Equal + if TEQ.eq_tm env g_b.binder_bv.sort expected_g_b_sort = TEQ.Equal then Some () else None in @@ -496,7 +500,7 @@ let validate_indexed_effect_bind_shape (env:env) Ad_hoc_combinator | Some l -> Substitutive_combinator l in - if Env.debug env <| Options.Other "LayeredEffectsTc" + if Debug.medium () || !dbg_LayeredEffectsTc then BU.print2 "Bind %s has %s kind\n" bind_name (Print.indexed_effect_combinator_kind_to_string kind); @@ -579,7 +583,7 @@ let subcomp_combinator_kind (env:env) result_typ = a_b.binder_bv |> S.bv_to_name; effect_args = (eff_params_bs@f_bs) |> List.map (fun b -> b.binder_bv |> S.bv_to_name |> S.as_arg); flags = []})) in - if U.eq_tm f_b.binder_bv.sort expected_f_b_sort = U.Equal + if TEQ.eq_tm env f_b.binder_bv.sort expected_f_b_sort = TEQ.Equal then Some () else None in @@ -600,7 +604,7 @@ let subcomp_combinator_kind (env:env) result_typ = a_b.binder_bv |> S.bv_to_name; effect_args = (eff_params_bs@f_or_g_bs) |> List.map (fun b -> b.binder_bv |> S.bv_to_name |> S.as_arg); flags = []})) in - if U.eq_tm (U.comp_result k_c) expected_t = U.Equal + if TEQ.eq_tm env (U.comp_result k_c) expected_t = TEQ.Equal then Some () else None in @@ -710,7 +714,7 @@ let validate_indexed_effect_subcomp_shape (env:env) let k = U.arrow (a_b::rest_bs@[f]) c in - if Env.debug env <| Options.Other "LayeredEffectsTc" then + if Debug.medium () || !dbg_LayeredEffectsTc then BU.print1 "Expected type of subcomp before unification: %s\n" (Print.term_to_string k); @@ -746,7 +750,7 @@ let validate_indexed_effect_subcomp_shape (env:env) Ad_hoc_combinator | Some k -> k in - if Env.debug env <| Options.Other "LayeredEffectsTc" + if Debug.medium () || !dbg_LayeredEffectsTc then BU.print2 "Subcomp %s has %s kind\n" subcomp_name (Print.indexed_effect_combinator_kind_to_string kind); @@ -810,7 +814,7 @@ let ite_combinator_kind (env:env) ((a_b.binder_bv |> S.bv_to_name |> S.as_arg):: (List.map (fun {binder_bv=b} -> b |> S.bv_to_name |> S.as_arg) (eff_params_bs@f_bs))) Range.dummyRange in - if U.eq_tm f_b.binder_bv.sort expected_f_b_sort = U.Equal + if TEQ.eq_tm env f_b.binder_bv.sort expected_f_b_sort = TEQ.Equal then Some () else None in @@ -821,7 +825,7 @@ let ite_combinator_kind (env:env) ((a_b.binder_bv |> S.bv_to_name |> S.as_arg):: (List.map (fun {binder_bv=b} -> b |> S.bv_to_name |> S.as_arg) (eff_params_bs@f_or_g_bs))) Range.dummyRange in - if U.eq_tm g_b.binder_bv.sort expected_g_b_sort = U.Equal + if TEQ.eq_tm env g_b.binder_bv.sort expected_g_b_sort = TEQ.Equal then Some () else None in @@ -957,7 +961,7 @@ let validate_indexed_effect_ite_shape (env:env) Ad_hoc_combinator | Some k -> k in - if Env.debug env <| Options.Other "LayeredEffectsTc" + if Debug.medium () || !dbg_LayeredEffectsTc then BU.print2 "Ite %s has %s kind\n" ite_name (Print.indexed_effect_combinator_kind_to_string kind); @@ -1078,7 +1082,7 @@ let lift_combinator_kind (env:env) result_typ = a_b.binder_bv |> S.bv_to_name; effect_args = f_bs |> List.map (fun b -> b.binder_bv |> S.bv_to_name |> S.as_arg); flags = []})) in - if U.eq_tm f_b.binder_bv.sort expected_f_b_sort = U.Equal + if TEQ.eq_tm env f_b.binder_bv.sort expected_f_b_sort = TEQ.Equal then Some () else None in @@ -1192,7 +1196,7 @@ let validate_indexed_effect_lift_shape (env:env) Ad_hoc_combinator | Some l -> Substitutive_combinator l in - if Env.debug env <| Options.Other "LayeredEffectsTc" + if Debug.medium () || !dbg_LayeredEffectsTc then BU.print2 "Lift %s has %s kind\n" lift_name (Print.indexed_effect_combinator_kind_to_string kind); @@ -1206,7 +1210,7 @@ let validate_indexed_effect_lift_shape (env:env) *) let tc_layered_eff_decl env0 (ed : S.eff_decl) (quals : list qualifier) (attrs : list S.attribute) = Errors.with_ctx (BU.format1 "While checking layered effect definition `%s`" (string_of_lid ed.mname)) (fun () -> - if Env.debug env0 <| Options.Other "LayeredEffectsTc" then + if !dbg_LayeredEffectsTc then BU.print1 "Typechecking layered effect: \n\t%s\n" (Print.eff_decl_to_string false ed); //we don't support effect binders in layered effects yet @@ -1216,7 +1220,7 @@ Errors.with_ctx (BU.format1 "While checking layered effect definition `%s`" (str (range_of_lid ed.mname); let log_combinator s (us, t, ty) = - if Env.debug env0 <| Options.Other "LayeredEffectsTc" then + if !dbg_LayeredEffectsTc then BU.print4 "Typechecked %s:%s = %s:%s\n" (string_of_lid ed.mname) s (Print.tscheme_to_string (us, t)) (Print.tscheme_to_string (us, ty)) in @@ -1433,7 +1437,7 @@ Errors.with_ctx (BU.format1 "While checking layered effect definition `%s`" (str let stronger_us, stronger_t, stronger_ty = check_and_gen "stronger_repr" 1 stronger_repr in - if Env.debug env0 <| Options.Other "LayeredEffectsTc" then + if !dbg_LayeredEffectsTc then BU.print2 "stronger combinator typechecked with term: %s and type: %s\n" (Print.tscheme_to_string (stronger_us, stronger_t)) (Print.tscheme_to_string (stronger_us, stronger_ty)); @@ -1814,7 +1818,7 @@ Errors.with_ctx (BU.format1 "While checking layered effect definition `%s`" (str ({ Env.set_expected_typ env act_typ with instantiate_imp = false }) act.action_defn in - if Env.debug env <| Options.Other "LayeredEffectsTc" then + if Debug.medium () || !dbg_LayeredEffectsTc then BU.print2 "Typechecked action definition: %s and action type: %s\n" (Print.term_to_string act_defn) (Print.term_to_string act_typ); @@ -1834,13 +1838,13 @@ Errors.with_ctx (BU.format1 "While checking layered effect definition `%s`" (str BU.format3 "Unexpected non-function type for action %s:%s (%s)" (string_of_lid ed.mname) (string_of_lid act.action_name) (Print.term_to_string act_typ)) r in - if Env.debug env <| Options.Other "LayeredEffectsTc" then + if Debug.medium () || !dbg_LayeredEffectsTc then BU.print1 "Expected action type: %s\n" (Print.term_to_string k); let g = Rel.teq env act_typ k in List.iter (Rel.force_trivial_guard env) [g_t; g_d; g_k; g]; - if Env.debug env <| Options.Other "LayeredEffectsTc" then + if Debug.medium () || !dbg_LayeredEffectsTc then BU.print1 "Expected action type after unification: %s\n" (Print.term_to_string k); let act_typ = @@ -1869,7 +1873,7 @@ Errors.with_ctx (BU.format1 "While checking layered effect definition `%s`" (str U.arrow bs (S.mk_Comp ct) | _ -> raise_error (Errors.Fatal_ActionMustHaveFunctionType, err_msg k) r in - if Env.debug env <| Options.Other "LayeredEffectsTc" then + if Debug.medium () || !dbg_LayeredEffectsTc then BU.print1 "Action type after injecting it into the monad: %s\n" (Print.term_to_string act_typ); let act = @@ -1938,7 +1942,7 @@ Errors.with_ctx (BU.format1 "While checking layered effect definition `%s`" (str end in - if Env.debug env0 <| Options.Other "LayeredEffectsTc" + if !dbg_LayeredEffectsTc then BU.print2 "Effect %s has extraction mode %s\n" (string_of_lid ed.mname) (Print.eff_extraction_mode_to_string extraction_mode); @@ -1966,7 +1970,7 @@ Errors.with_ctx (BU.format1 "While checking layered effect definition `%s`" (str let tc_non_layered_eff_decl env0 (ed:S.eff_decl) (_quals : list qualifier) (_attrs : list S.attribute) : S.eff_decl = Errors.with_ctx (BU.format1 "While checking effect definition `%s`" (string_of_lid ed.mname)) (fun () -> - if Env.debug env0 <| Options.Other "ED" then + if !dbg then BU.print1 "Typechecking eff_decl: \n\t%s\n" (Print.eff_decl_to_string false ed); let us, bs = @@ -2026,7 +2030,7 @@ Errors.with_ctx (BU.format1 "While checking effect definition `%s`" (string_of_l action_typ = snd (op (a.action_univs, a.action_typ)) }) ed.actions; } in - if Env.debug env0 <| Options.Other "ED" then + if !dbg then BU.print1 "After typechecking binders eff_decl: \n\t%s\n" (Print.eff_decl_to_string false ed); let env = Env.push_binders (Env.push_univ_vars env0 ed_univs) ed_bs in @@ -2070,7 +2074,7 @@ Errors.with_ctx (BU.format1 "While checking effect definition `%s`" (string_of_l let signature = check_and_gen' "signature" 1 None (U.effect_sig_ts ed.signature) None in - if Env.debug env0 <| Options.Other "ED" then + if !dbg then BU.print1 "Typechecked signature: %s\n" (Print.tscheme_to_string signature); (* @@ -2090,7 +2094,7 @@ Errors.with_ctx (BU.format1 "While checking effect definition `%s`" (string_of_l in let log_combinator s ts = - if Env.debug env <| Options.Other "ED" then + if !dbg then BU.print3 "Typechecked %s:%s = %s\n" (string_of_lid ed.mname) s (Print.tscheme_to_string ts) in let ret_wp = @@ -2221,7 +2225,7 @@ Errors.with_ctx (BU.format1 "While checking effect definition `%s`" (string_of_l mk_repr b wp in let maybe_range_arg = - if BU.for_some (U.attr_eq U.dm4f_bind_range_attr) ed.eff_attrs + if BU.for_some (TEQ.eq_tm_bool env U.dm4f_bind_range_attr) ed.eff_attrs then [S.null_binder S.t_range; S.null_binder S.t_range] else [] in @@ -2278,7 +2282,7 @@ Errors.with_ctx (BU.format1 "While checking effect definition `%s`" (string_of_l // 1) Check action definition, setting its expected type to // [action_typ] let env' = { Env.set_expected_typ env act_typ with instantiate_imp = false } in - if Env.debug env (Options.Other "ED") then + if !dbg then BU.print3 "Checking action %s:\n[definition]: %s\n[cps'd type]: %s\n" (string_of_lid act.action_name) (Print.term_to_string act.action_defn) (Print.term_to_string act_typ); @@ -2393,7 +2397,7 @@ Errors.with_ctx (BU.format1 "While checking effect definition `%s`" (string_of_l action_typ = cl (a.action_univs, a.action_typ) |> snd; action_defn = cl (a.action_univs, a.action_defn) |> snd }) actions } in - if Env.debug env <| Options.Other "ED" then + if !dbg then BU.print1 "Typechecked effect declaration:\n\t%s\n" (Print.eff_decl_to_string false ed); ed @@ -2421,7 +2425,7 @@ let monad_signature env m s = * *) let tc_layered_lift env0 (sub:S.sub_eff) : S.sub_eff = - if Env.debug env0 <| Options.Other "LayeredEffectsTc" then + if !dbg_LayeredEffectsTc then BU.print1 "Typechecking sub_effect: %s\n" (Print.sub_eff_to_string sub); let lift_ts = sub.lift |> must in @@ -2429,7 +2433,7 @@ let tc_layered_lift env0 (sub:S.sub_eff) : S.sub_eff = let us, lift, lift_ty = check_and_gen env0 "" "lift" 1 lift_ts in - if Env.debug env0 <| Options.Other "LayeredEffectsTc" then + if !dbg_LayeredEffectsTc then BU.print2 "Typechecked lift: %s and lift_ty: %s\n" (Print.tscheme_to_string (us, lift)) (Print.tscheme_to_string ((us, lift_ty))); @@ -2443,7 +2447,7 @@ let tc_layered_lift env0 (sub:S.sub_eff) : S.sub_eff = lift_wp = Some (us, k |> SS.close_univ_vars us); kind = Some kind } in - if Env.debug env0 <| Options.Other "LayeredEffectsTc" then + if !dbg_LayeredEffectsTc then BU.print1 "Final sub_effect: %s\n" (Print.sub_eff_to_string sub); sub @@ -2523,7 +2527,7 @@ let tc_lift env sub r = uvs, SS.subst usubst lift else [], lift in - if Env.debug env (Options.Other "ED") + if !dbg then BU.print1 "Lift for free : %s\n" (Print.term_to_string lift); let dmff_env = DMFF.empty env (tc_constant env Range.dummyRange) in let lift, comp, _ = tc_term (Env.push_univ_vars env uvs) lift in //AR: push univs in the env @@ -2712,7 +2716,7 @@ let tc_polymonadic_bind env (m:lident) (n:lident) (p:lident) (ts:S.tscheme) 0 false in - if Env.debug env <| Options.Extreme + if Debug.extreme () then BU.print3 "Polymonadic bind %s after typechecking (%s::%s)\n" eff_name (Print.tscheme_to_string (us, t)) (Print.tscheme_to_string (us, k)); @@ -2753,7 +2757,7 @@ let tc_polymonadic_subcomp env0 (m:lident) (n:lident) (ts:S.tscheme) = 0 (Env.get_range env) in - if Env.debug env <| Options.Extreme + if Debug.extreme () then BU.print3 "Polymonadic subcomp %s after typechecking (%s::%s)\n" combinator_name (Print.tscheme_to_string (us, t)) diff --git a/src/typechecker/FStar.TypeChecker.TcInductive.fst b/src/typechecker/FStar.TypeChecker.TcInductive.fst index f4c6c9baffe..e3aeda86ed4 100644 --- a/src/typechecker/FStar.TypeChecker.TcInductive.fst +++ b/src/typechecker/FStar.TypeChecker.TcInductive.fst @@ -44,8 +44,97 @@ module U = FStar.Syntax.Util module PP = FStar.Syntax.Print module C = FStar.Parser.Const +let dbg_GenUniverses = Debug.get_toggle "GenUniverses" +let dbg_LogTypes = Debug.get_toggle "LogTypes" +let dbg_Injectivity = Debug.get_toggle "Injectivity" + let unfold_whnf = N.unfold_whnf' [Env.AllowUnboundUniverses] +let check_sig_inductive_injectivity_on_params (tcenv:env_t) (se:sigelt) + : sigelt + = if tcenv.phase1 then se else + let Sig_inductive_typ dd = se.sigel in + let { lid=t; us=universe_names; params=tps; t=k } = dd in + let t_lid = t in + let usubst, uvs = SS.univ_var_opening universe_names in + let tcenv, tps, k = + Env.push_univ_vars tcenv uvs, + SS.subst_binders usubst tps, + SS.subst (SS.shift_subst (List.length tps) usubst) k + in + let tps, k = SS.open_term tps k in + let _, k = U.arrow_formals k in //don't care about indices here + let tps, env_tps, _, us = TcTerm.tc_binders tcenv tps in + let u_k = + TcTerm.level_of_type + env_tps + (S.mk_Tm_app + (S.fvar t None) + (snd (U.args_of_binders tps)) + (Ident.range_of_lid t)) + k + in + //BU.print2 "Universe of tycon: %s : %s\n" (Ident.string_of_lid t) (Print.univ_to_string u_k); + let rec universe_leq u v = + match u, v with + | U_zero, _ -> true + | U_succ u0, U_succ v0 -> universe_leq u0 v0 + | U_name u0, U_name v0 -> Ident.ident_equals u0 v0 + | U_name _, U_succ v0 -> universe_leq u v0 + | U_max us, _ -> us |> BU.for_all (fun u -> universe_leq u v) + | _, U_max vs -> vs |> BU.for_some (universe_leq u) + | U_unknown, _ + | _, U_unknown + | U_unif _, _ + | _, U_unif _ -> failwith (BU.format3 "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" + (Ident.string_of_lid t) + (Print.univ_to_string u) + (Print.univ_to_string v)) + | _ -> false + in + let u_leq_u_k u = + let u = N.normalize_universe env_tps u in + universe_leq u u_k + in + let tp_ok (tp:S.binder) (u_tp:universe) = + let t_tp = tp.binder_bv.sort in + if u_leq_u_k u_tp + then true + else ( + let t_tp = + N.normalize + [Unrefine; Unascribe; Unmeta; + Primops; HNF; UnfoldUntil delta_constant; Beta] + env_tps t_tp + in + let formals, t = U.arrow_formals t_tp in + let _, _, _, u_formals = TcTerm.tc_binders env_tps formals in + let inj = BU.for_all (fun u_formal -> u_leq_u_k u_formal) u_formals in + if inj + then ( + match (SS.compress t).n with + | Tm_type u -> + (* retain injectivity for parameters that are type functions + from small universes (i.e., all formals are smaller than the constructed type) + to a universe <= the universe of the constructed type. + See BugBoxInjectivity.fst *) + u_leq_u_k u + | _ -> + false + ) + else ( + false + ) + + ) + in + let injective_type_params = List.forall2 tp_ok tps us in + if !dbg_Injectivity + then BU.print2 "%s injectivity for %s\n" + (if injective_type_params then "YES" else "NO") + (Ident.string_of_lid t); + { se with sigel = Sig_inductive_typ { dd with injective_type_params } } + let tc_tycon (env:env_t) (* environment that contains all mutually defined type constructors *) (s:sigelt) (* a Sig_inductive_type (aka tc) that needs to be type-checked *) : env_t (* environment extended with a refined type for the type-constructor *) @@ -104,7 +193,8 @@ let tc_tycon (env:env_t) (* environment that contains all mutually defined t num_uniform_params=n_uniform; t=k; mutuals; - ds=data} }, + ds=data; + injective_type_params=false} }, u, guard @@ -165,7 +255,7 @@ let tc_data (env:env_t) (tcs : list (sigelt * universe)) | _ -> [], t in - if Env.debug env Options.Low then BU.print3 "Checking datacon %s : %s -> %s \n" + if Debug.low () then BU.print3 "Checking datacon %s : %s -> %s \n" (Print.lid_to_string c) (Print.binders_to_string "->" arguments) (Print.term_to_string result); @@ -235,7 +325,8 @@ let tc_data (env:env_t) (tcs : list (sigelt * universe)) t; ty_lid=tc_lid; num_ty_params=ntps; - mutuals=mutual_tcs} }, + mutuals=mutual_tcs; + injective_type_params=false} }, g | _ -> failwith "impossible" @@ -257,10 +348,10 @@ let generalize_and_inst_within (env:env_t) (tcs:list (sigelt * universe)) (datas | Sig_datacon {t} -> S.null_binder t | _ -> failwith "Impossible") in let t = U.arrow (binders@binders') (S.mk_Total t_unit) in - if Env.debug env <| Options.Other "GenUniverses" + if !dbg_GenUniverses then BU.print1 "@@@@@@Trying to generalize universes in %s\n" (N.term_to_string env t); let (uvs, t) = Gen.generalize_universes env t in - if Env.debug env <| Options.Other "GenUniverses" + if !dbg_GenUniverses then BU.print2 "@@@@@@Generalized to (%s, %s)\n" (uvs |> List.map (fun u -> (string_of_id u)) |> String.concat ", ") (Print.term_to_string t); @@ -290,7 +381,8 @@ let generalize_and_inst_within (env:env_t) (tcs:list (sigelt * universe)) (datas num_uniform_params=num_uniform; t; mutuals; - ds=datas} } + ds=datas; + injective_type_params=false} } | _ -> failwith "Impossible") tc_types tcs in @@ -310,7 +402,8 @@ let generalize_and_inst_within (env:env_t) (tcs:list (sigelt * universe)) (datas t=ty; ty_lid=tc; num_ty_params=ntps; - mutuals} } + mutuals; + injective_type_params=false} } | _ -> failwith "Impossible") data_types datas in @@ -412,8 +505,14 @@ let optimized_haseq_soundness_for_data (ty_lid:lident) (data:sigelt) (usubst:lis let haseq_b = mk_Tm_app U.t_haseq [S.as_arg b.binder_bv.sort] Range.dummyRange in //label the haseq predicate so that we get a proper error message if the assertion fails let sort_range = b.binder_bv.sort.pos in + let open FStar.Errors.Msg in + let open FStar.Pprint in + let open FStar.Class.PP in let haseq_b = TcUtil.label - (BU.format1 "Failed to prove that the type '%s' supports decidable equality because of this argument; add either the 'noeq' or 'unopteq' qualifier" (string_of_lid ty_lid)) + [ + text "Failed to prove that the type" ^/^ squotes (pp ty_lid) ^/^ text "supports decidable equality because of this argument."; + text "Add either the 'noeq' or 'unopteq' qualifier"; + ] sort_range haseq_b in @@ -751,7 +850,7 @@ let check_inductive_well_typedness (env:env_t) (ses:list sigelt) (quals:list qua let env, tcs, g = List.fold_right (fun tc (env, all_tcs, g) -> let env, tc, tc_u, guard = tc_tycon env tc in let g' = Rel.universe_inequality S.U_zero tc_u in - if Env.debug env Options.Low then BU.print1 "Checked inductive: %s\n" (Print.sigelt_to_string tc); + if Debug.low () then BU.print1 "Checked inductive: %s\n" (Print.sigelt_to_string tc); env, (tc, tc_u)::all_tcs, Env.conj_guard g (Env.conj_guard guard g') ) tys (env, [], Env.trivial_guard) in @@ -770,7 +869,7 @@ let check_inductive_well_typedness (env:env_t) (ses:list sigelt) (quals:list qua let tc_universe_vars = List.map snd tcs in let g = {g with univ_ineqs=tc_universe_vars, snd (g.univ_ineqs)} in - if Env.debug env0 <| Options.Other "GenUniverses" + if !dbg_GenUniverses then BU.print1 "@@@@@@Guard before (possible) generalization: %s\n" (Rel.guard_to_string env g); Rel.force_trivial_guard env0 g; @@ -857,13 +956,33 @@ let check_inductive_well_typedness (env:env_t) (ses:list sigelt) (quals:list qua num_uniform_params=num_uniform; t=typ; mutuals=ts; - ds}} + ds; + injective_type_params=false}} end else fail expected_typ inferred_typ else fail expected_typ (inferred_typ_with_binders binders) end | _ -> se) in + let tcs = tcs |> List.map (check_sig_inductive_injectivity_on_params env0) in + let is_injective l = + match + List.tryPick + (fun se -> + let Sig_inductive_typ {lid=lid; injective_type_params} = se.sigel in + if lid_equals l lid then Some injective_type_params else None) + tcs + with + | None -> false + | Some i -> i + in + let datas = + datas |> + List.map + (fun se -> + let Sig_datacon dd = se.sigel in + { se with sigel=Sig_datacon { dd with injective_type_params=is_injective dd.ty_lid }}) + in let sig_bndle = { sigel = Sig_bundle {ses=tcs@datas; lids}; sigquals = quals; sigrng = Env.get_range env0; @@ -914,7 +1033,7 @@ let mk_discriminator_and_indexed_projectors iquals (* Qualifie else let disc_name = U.mk_discriminator lid in let x = S.new_bv (Some p) arg_typ in let sort = - let disc_fvar = S.fvar_with_dd (Ident.set_lid_range disc_name p) (Delta_equational_at_level 1) None in + let disc_fvar = S.fvar_with_dd (Ident.set_lid_range disc_name p) None in U.refine x (U.b2t (S.mk_Tm_app (S.mk_Tm_uinst disc_fvar inst_univs) [as_arg <| S.bv_to_name x] p)) in S.mk_binder ({projectee arg_typ with sort = sort}) @@ -966,7 +1085,7 @@ let mk_discriminator_and_indexed_projectors iquals (* Qualifie sigattrs = attrs; sigopts = None; sigopens_and_abbrevs=[] } in - if Env.debug env (Options.Other "LogTypes") + if !dbg_LogTypes then BU.print1 "Declaration of a discriminator %s\n" (Print.sigelt_to_string decl); if only_decl @@ -991,11 +1110,10 @@ let mk_discriminator_and_indexed_projectors iquals (* Qualifie brs=[U.branch pat_true ; U.branch pat_false]; rc_opt=None}) p in - let dd = Delta_equational_at_level 1 in let imp = U.abs binders body None in let lbtyp = if no_decl then t else tun in let lb = U.mk_letbinding - (Inr (S.lid_and_dd_as_fv discriminator_name dd None)) + (Inr (S.lid_and_dd_as_fv discriminator_name None)) uvs lbtyp C.effect_Tot_lid @@ -1010,7 +1128,7 @@ let mk_discriminator_and_indexed_projectors iquals (* Qualifie sigattrs = attrs; sigopts = None; sigopens_and_abbrevs=[] } in - if Env.debug env (Options.Other "LogTypes") + if !dbg_LogTypes then BU.print1 "Implementation of a discriminator %s\n" (Print.sigelt_to_string impl); (* TODO : Are there some cases where we don't want one of these ? *) (* If not the declaration is useless, isn't it ?*) @@ -1071,7 +1189,7 @@ let mk_discriminator_and_indexed_projectors iquals (* Qualifie sigattrs = attrs; sigopts = None; sigopens_and_abbrevs=[] } in - if Env.debug env (Options.Other "LogTypes") + if !dbg_LogTypes then BU.print1 "Declaration of a projector %s\n" (Print.sigelt_to_string decl); if only_decl then [decl] //only the signature @@ -1104,7 +1222,7 @@ let mk_discriminator_and_indexed_projectors iquals (* Qualifie let dd = Delta_equational_at_level 1 in let lbtyp = if no_decl then t else tun in let lb = { - lbname=Inr (S.lid_and_dd_as_fv field_name dd None); + lbname=Inr (S.lid_and_dd_as_fv field_name None); lbunivs=uvs; lbtyp=lbtyp; lbeff=C.effect_Tot_lid; @@ -1119,7 +1237,7 @@ let mk_discriminator_and_indexed_projectors iquals (* Qualifie sigattrs = attrs; sigopts = None; sigopens_and_abbrevs=[] } in - if Env.debug env (Options.Other "LogTypes") + if !dbg_LogTypes then BU.print1 "Implementation of a projector %s\n" (Print.sigelt_to_string impl); if no_decl then [impl] else [decl;impl]) |> List.flatten in diff --git a/src/typechecker/FStar.TypeChecker.TcTerm.fst b/src/typechecker/FStar.TypeChecker.TcTerm.fst index 245739fb447..6319e1dec89 100644 --- a/src/typechecker/FStar.TypeChecker.TcTerm.fst +++ b/src/typechecker/FStar.TypeChecker.TcTerm.fst @@ -36,6 +36,7 @@ open FStar.Compiler.Dyn open FStar.TypeChecker.Rel open FStar.Class.Show +open FStar.Class.Setlike module S = FStar.Syntax.Syntax module SS = FStar.Syntax.Subst @@ -48,6 +49,17 @@ module U = FStar.Syntax.Util module PP = FStar.Syntax.Print module UF = FStar.Syntax.Unionfind module Const = FStar.Parser.Const +module TEQ = FStar.TypeChecker.TermEqAndSimplify + +let dbg_Exports = Debug.get_toggle "Exports" +let dbg_LayeredEffects = Debug.get_toggle "LayeredEffects" +let dbg_NYC = Debug.get_toggle "NYC" +let dbg_Patterns = Debug.get_toggle "Patterns" +let dbg_Range = Debug.get_toggle "Range" +let dbg_RelCheck = Debug.get_toggle "RelCheck" +let dbg_RFD = Debug.get_toggle "RFD" +let dbg_Tac = Debug.get_toggle "Tac" +let dbg_UniverseOf = Debug.get_toggle "UniverseOf" (* Some local utilities *) let instantiate_both env = {env with Env.instantiate_imp=true} @@ -74,12 +86,12 @@ let check_no_escape (head_opt : option term) let msg = match head_opt with | None -> [ - text "Bound variable" ^/^ squotes (doc_of_string (Print.bv_to_string x)) + text "Bound variable" ^/^ squotes (doc_of_string (show x)) ^/^ text "would escape in the type of this letbinding"; text "Add a type annotation that does not mention it"; ] | Some head -> [ - text "Bound variable" ^/^ squotes (doc_of_string (Print.bv_to_string x)) + text "Bound variable" ^/^ squotes (doc_of_string (show x)) ^/^ text "escapes because of impure applications in the type of" ^/^ squotes (N.term_to_doc env head); text "Add explicit let-bindings to avoid this"; @@ -93,7 +105,7 @@ let check_no_escape (head_opt : option term) let rec aux try_norm t = let t = if try_norm then norm env t else t in let fvs' = Free.names t in - match List.tryFind (fun x -> Set.mem x fvs') fvs with + match List.tryFind (fun x -> mem x fvs') fvs with | None -> t, Env.trivial_guard | Some x -> (* some variable x seems to escape, try normalizing if we haven't *) @@ -238,9 +250,9 @@ let value_check_expected_typ env (e:term) (tlc:either term lcomp) (guard:guard_t | None -> memo_tk e t, lc, guard | Some (t', use_eq) -> let e, lc, g = TcUtil.check_has_type_maybe_coerce env e lc t' use_eq in - if debug env Options.Medium + if Debug.medium () then BU.print4 "value_check_expected_typ: type is %s<:%s \tguard is %s, %s\n" - (TcComm.lcomp_to_string lc) (Print.term_to_string t') + (TcComm.lcomp_to_string lc) (show t') (Rel.guard_to_string env g) (Rel.guard_to_string env guard); let t = lc.res_typ in let g = Env.conj_guard g guard in @@ -349,15 +361,15 @@ let check_expected_effect env (use_eq:bool) (copt:option comp) (ec : term * comp let c = TcUtil.maybe_assume_result_eq_pure_term env e (TcComm.lcomp_of_comp c) in let c, g_c = TcComm.lcomp_comp c in def_check_scoped c.pos "check_expected_effect.c.after_assume" env c; - if debug env <| Options.Medium then + if Debug.medium () then BU.print4 "In check_expected_effect, asking rel to solve the problem on e=(%s) and c=(%s), expected_c=(%s), and use_eq=%s\n" - (Print.term_to_string e) - (Print.comp_to_string c) - (Print.comp_to_string expected_c) + (show e) + (show c) + (show expected_c) (string_of_bool use_eq); let e, _, g = TcUtil.check_comp env use_eq e c expected_c in - let g = TcUtil.label_guard (Env.get_range env) "Could not prove post-condition" g in - if debug env Options.Medium + let g = TcUtil.label_guard (Env.get_range env) (Errors.mkmsg "Could not prove post-condition") g in + if Debug.medium () then BU.print2 "(%s) DONE check_expected_effect;\n\tguard is: %s\n" (Range.string_of_range e.pos) (guard_to_string env g); @@ -375,7 +387,7 @@ let print_expected_ty_str env = | Some (t, use_eq) -> BU.format2 "Expected type is (%s, use_eq = %s)" - (Print.term_to_string t) + (show t) (string_of_bool use_eq) @@ -387,14 +399,14 @@ let print_expected_ty env = BU.print1 "%s\n" (print_expected_ty_str env) (* andlist: whether we're inside an SMTPatOr and we should take the * intersection of the sub-variables instead of the union. *) -let rec get_pat_vars' all (andlist : bool) (pats:term) : Set.t bv = +let rec get_pat_vars' all (andlist : bool) (pats:term) : FlatSet.t bv = let pats = unmeta pats in let head, args = head_and_args pats in match (un_uinst head).n, args with | Tm_fvar fv, _ when fv_eq_lid fv Const.nil_lid -> if andlist - then Set.from_list all - else Set.empty () + then from_list all + else empty () | Tm_fvar fv, [(_, Some ({ aqual_implicit = true })); (hd, None); (tl, None)] when fv_eq_lid fv Const.cons_lid -> (* The head is not under the scope of the SMTPatOr, consider @@ -404,8 +416,8 @@ let rec get_pat_vars' all (andlist : bool) (pats:term) : Set.t bv = let tlvs = get_pat_vars' all andlist tl in if andlist - then Set.inter hdvs tlvs - else Set.union hdvs tlvs + then inter hdvs tlvs + else union hdvs tlvs | Tm_fvar fv, [(_, Some ({ aqual_implicit = true })); (pat, None)] when fv_eq_lid fv Const.smtpat_lid -> Free.names pat @@ -413,18 +425,18 @@ let rec get_pat_vars' all (andlist : bool) (pats:term) : Set.t bv = | Tm_fvar fv, [(subpats, None)] when fv_eq_lid fv Const.smtpatOr_lid -> get_pat_vars' all true subpats - | _ -> Set.empty () + | _ -> empty () let get_pat_vars all pats = get_pat_vars' all false pats let check_pat_fvs rng env pats bs = let pat_vars = get_pat_vars (List.map (fun b -> b.binder_bv) bs) (N.normalize [Env.Beta] env pats) in - begin match bs |> BU.find_opt (fun ({binder_bv=b}) -> not(Set.mem b pat_vars)) with + begin match bs |> BU.find_opt (fun ({binder_bv=b}) -> not (mem b pat_vars)) with | None -> () | Some ({binder_bv=x}) -> Errors.log_issue rng (Errors.Warning_SMTPatternIllFormed, - (BU.format1 "Pattern misses at least one bound variable: %s" (Print.bv_to_string x))) + (BU.format1 "Pattern misses at least one bound variable: %s" (show x))) end (* @@ -471,11 +483,14 @@ let check_no_smt_theory_symbols (en:env) (t:term) :unit = let tlist = t |> pat_terms |> List.collect aux in if List.length tlist = 0 then () //did not find any offending term else + let open FStar.Pprint in + let open FStar.Class.PP in //string to be displayed in the warning - let msg = List.fold_left (fun s t -> s ^ " " ^ (Print.term_to_string t)) "" tlist in - Errors.log_issue t.pos (Errors.Warning_SMTPatternIllFormed, - BU.format1 "Pattern uses these theory symbols or terms that should not be in an smt pattern: %s" - msg) + Errors.log_issue_doc t.pos (Errors.Warning_SMTPatternIllFormed, [ + prefix 2 1 + (text "Pattern uses these theory symbols or terms that should not be in an SMT pattern:") + (group <| separate_map (comma ^^ break_ 1) pp tlist) + ]) let check_smt_pat env t bs c = if U.is_smt_lemma t //check patterns cover the bound vars @@ -497,9 +512,9 @@ let guard_letrecs env actuals expected_c : list (lbname*typ*univ_names) = let env = {env with letrecs=[]} in let decreases_clause bs c = - if debug env Options.Low + if Debug.low () then BU.print2 "Building a decreases clause over (%s) and %s\n" - (Print.binders_to_string ", " bs) (Print.comp_to_string c); + (Print.binders_to_string ", " bs) (show c); //exclude types and function-typed arguments from the decreases clause //and reveal and erased arguments @@ -554,7 +569,7 @@ let guard_letrecs env actuals expected_c : list (lbname*typ*univ_names) = let t1 = env.typeof_well_typed_tot_or_gtot_term env e1 false |> fst |> U.unrefine in let t2 = env.typeof_well_typed_tot_or_gtot_term env e2 false |> fst |> U.unrefine in let rec warn t1 t2 = - if U.eq_tm t1 t2 = Equal + if TEQ.eq_tm env t1 t2 = TEQ.Equal then false else match (SS.compress t1).n, (SS.compress t2).n with | Tm_uinst (t1, _), Tm_uinst (t2, _) -> warn t1 t2 @@ -568,18 +583,22 @@ let guard_letrecs env actuals expected_c : list (lbname*typ*univ_names) = | _, Tm_uvar _ -> false | _, _ -> true in - (if should_warn && warn t1 t2 + (if not env.phase1 && should_warn && warn t1 t2 then match (SS.compress t1).n, (SS.compress t2).n with | Tm_name _, Tm_name _ -> () | _, _ -> + let open FStar.Pprint in + let open FStar.Class.PP in Errors.log_issue_doc e1.pos (Errors.Warning_Defensive, [ - Errors.Msg.text <| BU.format6 "SMT may not be able to prove the types of %s at %s (%s) and %s at %s (%s) to be equal, if the proof fails, try annotating these with the same type" - (Print.term_to_string e1) - (Range.string_of_range e1.pos) - (Print.term_to_string t1) - (Print.term_to_string e2) - (Range.string_of_range e2.pos) - (Print.term_to_string t2)])); + prefix 2 1 (text "In the decreases clause for this function, the SMT solver may not be able to prove that the types of") + (group (pp e1 ^/^ parens (text "bound in" ^/^ pp e1.pos))) ^/^ + prefix 2 1 (text "and") + (group (pp e2 ^/^ parens (text "bound in" ^/^ pp e2.pos))) ^/^ + text "are equal."; + prefix 2 1 (text "The type of the first term is:") (pp t1); + prefix 2 1 (text "The type of the second term is:") (pp t2); + text "If the proof fails, try annotating these with the same type."; + ])); t1, t2 in match l, l_prev with @@ -618,7 +637,7 @@ let guard_letrecs env actuals expected_c : list (lbname*typ*univ_names) = * just prove that (rel e e_prev) *) let rel_guard = mk_Tm_app rel [as_arg e; as_arg e_prev] r in - if U.eq_tm rel rel_prev = U.Equal + if TEQ.eq_tm env rel rel_prev = TEQ.Equal then rel_guard else ( (* if the relation is dependent on parameters in scope, @@ -662,14 +681,14 @@ let guard_letrecs env actuals expected_c : list (lbname*typ*univ_names) = let precedes = let env = Env.push_binders env formals in mk_precedes env dec previous_dec in - let precedes = TcUtil.label "Could not prove termination of this recursive call" r precedes in + let precedes = TcUtil.label (Errors.mkmsg "Could not prove termination of this recursive call") r precedes in let bs, ({binder_bv=last; binder_positivity=pqual; binder_attrs=attrs; binder_qual=imp}) = BU.prefix formals in let last = {last with sort=U.refine last precedes} in let refined_formals = bs@[S.mk_binder_with_attrs last imp pqual attrs] in let t' = U.arrow refined_formals c in - if debug env Options.Medium + if Debug.medium () then BU.print3 "Refined let rec %s\n\tfrom type %s\n\tto type %s\n" - (Print.lbname_to_string l) (Print.term_to_string t) (Print.term_to_string t'); + (show l) (show t) (show t'); l, t', u_names in letrecs |> List.map guard_one_letrec @@ -708,24 +727,24 @@ let is_comp_ascribed_reflect (e:term) : option (lident * term * aqual) = (************************************************************************************************************) let rec tc_term env e = def_check_scoped e.pos "tc_term.entry" env e; - if Env.debug env Options.Medium then + if Debug.medium () then BU.print5 "(%s) Starting tc_term (phase1=%s) of %s (%s), %s {\n" (Range.string_of_range <| Env.get_range env) (string_of_bool env.phase1) - (Print.term_to_string e) + (show e) (Print.tag_of_term (SS.compress e)) (print_expected_ty_str env); let r, ms = BU.record_time (fun () -> tc_maybe_toplevel_term ({env with top_level=false}) e) in - if Env.debug env Options.Medium then begin + if Debug.medium () then begin BU.print4 "(%s) } tc_term of %s (%s) took %sms\n" (Range.string_of_range <| Env.get_range env) - (Print.term_to_string e) + (show e) (Print.tag_of_term (SS.compress e)) (string_of_int ms); let e, lc , _ = r in BU.print4 "(%s) Result is: (%s:%s) (%s)\n" (Range.string_of_range <| Env.get_range env) - (Print.term_to_string e) + (show e) (TcComm.lcomp_to_string lc) (Print.tag_of_term (SS.compress e)) end; @@ -737,7 +756,7 @@ and tc_maybe_toplevel_term env (e:term) : term (* type-checked let env = if e.pos=Range.dummyRange then env else Env.set_range env e.pos in def_check_scoped e.pos "tc_maybe_toplevel_term.entry" env e; let top = SS.compress e in - if debug env Options.Medium then + if Debug.medium () then BU.print3 "Typechecking %s (%s): %s\n" (show <| Env.get_range env) (Print.tag_of_term top) (show top); match top.n with | Tm_delayed _ -> failwith "Impossible" @@ -933,16 +952,16 @@ and tc_maybe_toplevel_term env (e:term) : term (* type-checked // e <: Tot repr let e = S.mk (Tm_ascribed {tm=e; asc=(Inr (S.mk_Total repr), None, use_eq); eff_opt=None}) e.pos in - if Env.debug env0 <| Options.Extreme + if Debug.extreme () then BU.print1 "Typechecking ascribed reflect, inner ascribed term: %s\n" - (Print.term_to_string e); + (show e); let e, _, g_e = tc_tot_or_gtot_term env0 e in let e = U.unascribe e in - if Env.debug env0 <| Options.Extreme + if Debug.extreme () then BU.print2 "Typechecking ascribed reflect, after typechecking inner ascribed term: %s and guard: %s\n" - (Print.term_to_string e) (Rel.guard_to_string env0 g_e); + (show e) (Rel.guard_to_string env0 g_e); //reconstruct (M.reflect e) < M a is let top = @@ -981,7 +1000,7 @@ and tc_maybe_toplevel_term env (e:term) : term (* type-checked let t, _, f = tc_check_tot_or_gtot_term env t k "" in let e, c, g = tc_term (Env.set_expected_typ_maybe_eq env t use_eq) e in //NS: Maybe redundant strengthen - let c, f = TcUtil.strengthen_precondition (Some (fun () -> return_all Err.ill_kinded_type)) (Env.set_range env t.pos) e c f in + let c, f = TcUtil.strengthen_precondition (Some (fun () -> Err.ill_kinded_type)) (Env.set_range env t.pos) e c f in let e, c, f2 = comp_check_expected_typ env (mk (Tm_ascribed {tm=e; asc=(Inl t, None, use_eq); eff_opt=Some c.eff_name}) top.pos) c in @@ -1020,7 +1039,7 @@ and tc_maybe_toplevel_term env (e:term) : term (* type-checked | Tm_app {hd={n=Tm_constant Const_range_of}} | Tm_app {hd={n=Tm_constant Const_set_range_of}} -> - raise_error (Errors.Fatal_IllAppliedConstant, BU.format1 "Ill-applied constant %s" (Print.term_to_string top)) e.pos + raise_error (Errors.Fatal_IllAppliedConstant, BU.format1 "Ill-applied constant %s" (show top)) e.pos | Tm_app {hd={n=Tm_constant (Const_reify _)}; args=[(e, aqual)]} -> if Option.isSome aqual @@ -1100,7 +1119,7 @@ and tc_maybe_toplevel_term env (e:term) : term (* type-checked raise_error (Errors.Fatal_UnexpectedEffect, BU.format3 "Expected repr type for %s is not an application node (%s:%s)" (Ident.string_of_lid l) (Print.tag_of_term expected_repr_typ) - (Print.term_to_string expected_repr_typ)) top.pos in + (show expected_repr_typ)) top.pos in let c = S.mk_Comp ({ comp_univs=[u_a]; @@ -1203,12 +1222,12 @@ and tc_maybe_toplevel_term env (e:term) : term (* type-checked begin let t0 = N.unfold_whnf' [Unascribe; Unmeta; Unrefine] env lc.res_typ in let thead, _ = U.head_and_args t0 in - if Env.debug env <| Options.Other "RFD" + if !dbg_RFD then ( BU.print3 "Got lc.res_typ=%s; t0 = %s; thead = %s\n" - (Print.term_to_string lc.res_typ) - (Print.term_to_string t0) - (Print.term_to_string thead) + (show lc.res_typ) + (show t0) + (show thead) ); match (SS.compress (U.un_uinst thead)).n with | Tm_fvar type_name -> ( @@ -1267,10 +1286,10 @@ and tc_maybe_toplevel_term env (e:term) : term (* type-checked | Tm_app {hd=head; args} -> let env0 = env in let env = Env.clear_expected_typ env |> fst |> instantiate_both in - if debug env Options.High + if Debug.high () then BU.print3 "(%s) Checking app %s, %s\n" (Range.string_of_range top.pos) - (Print.term_to_string top) + (show top) (print_expected_ty_str env0); //Don't instantiate head; instantiations will be computed below, accounting for implicits/explicits @@ -1297,14 +1316,14 @@ and tc_maybe_toplevel_term env (e:term) : term (* type-checked e, TcComm.set_result_typ_lc c res_typ, implicits else e, c, Env.trivial_guard in - if Env.debug env Options.Extreme + if Debug.extreme () then BU.print1 "Introduced {%s} implicits in application\n" (Rel.print_pending_implicits g); let e, c, g' = comp_check_expected_typ env0 e c in let gres = Env.conj_guard g g' in let gres = Env.conj_guard gres implicits in - if Env.debug env Options.Extreme + if Debug.extreme () then BU.print2 "Guard from application node %s is %s\n" - (Print.term_to_string e) + (show e) (Rel.guard_to_string env gres); e, c, gres @@ -1422,7 +1441,7 @@ and tc_match (env : Env.env) (top : term) : term * lcomp * guard_t = BU.format2 "For a match with returns annotation, the scrutinee should be pure/ghost, \ found %s with effect %s" - (Print.term_to_string e1) + (show e1) (string_of_lid c1.eff_name)) e1.pos; //Clear the expected type in the environment for the branches @@ -1588,7 +1607,7 @@ and tc_match (env : Env.env) (top : term) : term * lcomp * guard_t = | None -> e, cres, Env.trivial_guard | _ -> comp_check_expected_typ env e cres in - if debug env Options.Extreme + if Debug.extreme () then BU.print2 "(%s) Typechecked Tm_match, comp type = %s\n" (Range.string_of_range top.pos) (TcComm.lcomp_to_string cres); @@ -1608,7 +1627,7 @@ and tc_synth head env args rng = raise_error (Errors.Fatal_SynthByTacticError, "synth_by_tactic: bad application") rng in - if Env.debug env <| Options.Other "Tac" then + if !dbg_Tac then BU.print2 "Processing synth of %s at type %s\n" (show tau) (show atyp); let typ = @@ -1621,7 +1640,7 @@ and tc_synth head env args rng = (Errors.Fatal_NotSupported, BU.format1 "Equality ascription in synth (%s) is not yet supported, \ please use subtyping" - (Print.term_to_string t)) t.pos; + (show t)) t.pos; t | None -> raise_error (Errors.Fatal_SynthByTacticError, "synth_by_tactic: need a type annotation when no expected type is present") (Env.get_range env) end @@ -1636,8 +1655,8 @@ and tc_synth head env args rng = Rel.force_trivial_guard env g2; let t = env.synth_hook env typ ({ tau with pos = rng }) in - if Env.debug env <| Options.Other "Tac" then - BU.print1 "Got %s\n" (Print.term_to_string t); + if !dbg_Tac then + BU.print1 "Got %s\n" (show t); // Should never trigger, meta-F* will check it before. TcUtil.check_uvars tau.pos t; @@ -1665,7 +1684,7 @@ and check_instantiated_fvar (env:Env.env) (v:S.var) (q:option S.fv_qual) (e:term let t = U.remove_inacc t0 in let e, t, implicits = TcUtil.maybe_instantiate env e t in -// BU.print3 "Instantiated type of %s from %s to %s\n" (Print.term_to_string e) (Print.term_to_string t0) (Print.term_to_string t); +// BU.print3 "Instantiated type of %s from %s to %s\n" (show e) (show t0) (show t); let tc = if Env.should_verify env then Inl t @@ -1690,7 +1709,7 @@ and tc_value env (e:term) : term | Tm_bvar x -> (* This can happen if user tactics build an ill-scoped term *) raise_error (Errors.Error_IllScopedTerm, - BU.format1 "Violation of locally nameless convention: %s" (Print.term_to_string top)) + BU.format1 "Violation of locally nameless convention: %s" (show top)) top.pos | Tm_uvar (u, s) -> //the type of a uvar is given directly with it; we do not recheck the type @@ -1712,7 +1731,7 @@ and tc_value env (e:term) : term (Errors.Fatal_NotSupported, BU.format1 "Equality ascription as an expected type for unk (:%s) is not yet supported, \ please use subtyping" - (Print.term_to_string t)) e.pos; + (show t)) e.pos; t, [], Env.trivial_guard in let e, _, g1 = TcUtil.new_implicit_var @@ -1741,7 +1760,7 @@ and tc_value env (e:term) : term if List.length us <> List.length us' then raise_error (Errors.Fatal_UnexpectedNumberOfUniverse, BU.format3 "Unexpected number of universe instantiations for \"%s\" (%s vs %s)" - (Print.fv_to_string fv) + (show fv) (string_of_int (List.length us)) (string_of_int (List.length us'))) (Env.get_range env); @@ -1758,9 +1777,9 @@ and tc_value env (e:term) : term | _ -> raise_error (Errors.Fatal_IncompatibleUniverse, BU.format3 "Incompatible universe application for %s, expected %s got %s\n" - (Print.fv_to_string fv) - (Print.univ_to_string ul) - (Print.univ_to_string ur)) + (show fv) + (show ul) + (show ur)) (Env.get_range env)) us' us; @@ -1778,13 +1797,13 @@ and tc_value env (e:term) : term let (us, t), range = Env.lookup_lid env fv.fv_name.v in let fv = S.set_range_of_fv fv range in maybe_warn_on_use env fv; - if Env.debug env <| Options.Other "Range" + if !dbg_Range then BU.print5 "Lookup up fvar %s at location %s (lid range = defined at %s, used at %s); got universes type %s\n" - (Print.lid_to_string (lid_of_fv fv)) + (show (lid_of_fv fv)) (Range.string_of_range e.pos) (Range.string_of_range range) (Range.string_of_use_range range) - (Print.term_to_string t); + (show t); Env.insert_fv_info env fv t; let e = S.mk_Tm_uinst (mk (Tm_fvar fv) e.pos) us in check_instantiated_fvar env fv.fv_name fv.fv_qual e t @@ -1825,9 +1844,9 @@ and tc_value env (e:term) : term let env0 = env in let env, _ = Env.clear_expected_typ env in let x, env, f1, u = tc_binder env (List.hd x) in - if debug env Options.High + if Debug.high () then BU.print3 "(%s) Checking refinement formula %s; binder is %s\n" - (Range.string_of_range top.pos) (Print.term_to_string phi) (Print.bv_to_string x.binder_bv); + (Range.string_of_range top.pos) (show phi) (show x.binder_bv); let t_phi, _ = U.type_u () in let phi, _, f2 = tc_check_tot_or_gtot_term env phi t_phi "refinement formula must be pure or ghost" in @@ -1840,13 +1859,13 @@ and tc_value env (e:term) : term | Tm_abs {bs; body} -> (* in case we use type variables which are implicitly quantified, we add quantifiers here *) let bs = TcUtil.maybe_add_implicit_binders env bs in - if Env.debug env Options.Medium - then BU.print1 "Abstraction is: %s\n" (Print.term_to_string ({top with n=Tm_abs {bs; body; rc_opt=None}})); + if Debug.medium () + then BU.print1 "Abstraction is: %s\n" (show ({top with n=Tm_abs {bs; body; rc_opt=None}})); let bs, body = SS.open_term bs body in tc_abs env top bs body | _ -> - failwith (BU.format2 "Unexpected value: %s (%s)" (Print.term_to_string top) (Print.tag_of_term top)) + failwith (BU.format2 "Unexpected value: %s (%s)" (show top) (Print.tag_of_term top)) and tc_constant (env:env_t) r (c:sconst) : typ = let res = @@ -1980,7 +1999,7 @@ and tc_universe env u : universe = | U_name x -> if Env.lookup_univ env x then u - else failwith ("Universe variable " ^ (Print.univ_to_string u) ^ " not found") + else failwith ("Universe variable " ^ (show u) ^ " not found") in if env.lax_universes then U_zero else (match u with | U_unknown -> U.type_u () |> snd @@ -2082,7 +2101,7 @@ and tc_abs_expected_function_typ env (bs:binders) (t0:option (typ * bool)) (body let envbody, letrec_binders, g = letrecs |> List.fold_left (fun (env, letrec_binders, g) (l,t,u_names) -> //let t = N.normalize [Env.EraseUniverses; Env.Beta] env t in - //printfn "Checking let rec annot: %s\n" (Print.term_to_string t); + //printfn "Checking let rec annot: %s\n" (show t); let t, _, g' = tc_term (Env.clear_expected_typ env |> fst) t in let env = Env.push_let_binding env l (u_names, t) in let lb = match l with @@ -2152,9 +2171,9 @@ and tc_abs_check_binders env bs bs_expected use_eq | Some (Implicit _), Some (Meta _) -> true | _ -> false in - if not (special imp imp') && U.eq_bqual imp imp' <> U.Equal + if not (special imp imp') && not (U.eq_bqual imp imp') then raise_error (Errors.Fatal_InconsistentImplicitArgumentAnnotation, - BU.format1 "Inconsistent implicit argument annotation on argument %s" (Print.bv_to_string hd)) + BU.format1 "Inconsistent implicit argument annotation on argument %s" (show hd)) (S.range_of_bv hd) end; @@ -2172,7 +2191,7 @@ and tc_abs_check_binders env bs bs_expected use_eq BU.format3 "Inconsistent positivity qualifier on argument %s; \ Expected qualifier %s, \ found qualifier %s" - (Print.bv_to_string hd) + (show hd) (positivity_qual_to_string pqual_expected) (positivity_qual_to_string pqual_actual)) (S.range_of_bv hd); @@ -2187,13 +2206,13 @@ and tc_abs_check_binders env bs bs_expected use_eq * 2) add an extra guard that the two types must be equal (use_eq will be used in Rel.teq *) | _ -> - if Env.debug env Options.High then BU.print1 "Checking binder %s\n" (Print.bv_to_string hd); + if Debug.high () then BU.print1 "Checking binder %s\n" (show hd); let t, _, g1_env = tc_tot_or_gtot_term env hd.sort in let g2_env = let label_guard g = TcUtil.label_guard hd.sort.pos - "Type annotation on parameter incompatible with the expected type" + (Errors.mkmsg "Type annotation on parameter incompatible with the expected type") g in //cf issue #57 (the discussion at the end about subtyping vs. equality in check_binders) @@ -2206,14 +2225,14 @@ and tc_abs_check_binders env bs bs_expected use_eq then Rel.teq env t expected_t |> label_guard else match Rel.get_subtyping_prop env expected_t t with | None -> - raise_error (Err.basic_type_error env None expected_t t) (Env.get_range env) + raise_error_doc (Err.basic_type_error env None expected_t t) (Env.get_range env) | Some g_env -> label_guard g_env in t, Env.conj_guard g1_env g2_env in let hd = {hd with sort=t} in let combine_attrs (attrs:list S.attribute) (attrs':list S.attribute) : list S.attribute = let diff = List.filter (fun attr' -> - not (List.existsb (fun attr -> U.eq_tm attr attr' = U.Equal) attrs) + not (List.existsb (fun attr -> TEQ.eq_tm env attr attr' = TEQ.Equal) attrs) ) attrs' in attrs@diff in @@ -2246,29 +2265,29 @@ and tc_abs env (top:term) (bs:binders) (body:term) : term * lcomp * guard_t = (* topt is the expected type of the expression obtained from the env *) let env, topt = Env.clear_expected_typ env in - if Env.debug env Options.High + if Debug.high () then BU.print2 "!!!!!!!!!!!!!!!Expected type is (%s), top_level=%s\n" (match topt with | None -> "None" - | Some (t, use_eq) -> Print.term_to_string t ^ ", use_eq = " ^ string_of_bool use_eq) + | Some (t, use_eq) -> show t ^ ", use_eq = " ^ string_of_bool use_eq) (show env.top_level); let tfun_opt, bs, letrec_binders, c_opt, envbody, body, g_env = tc_abs_expected_function_typ env bs topt body in - if Env.debug env Options.Extreme + if Debug.extreme () then BU.print3 "After expected_function_typ, tfun_opt: %s, c_opt: %s, and expected type in envbody: %s\n" (match tfun_opt with | None -> "None" - | Some t -> Print.term_to_string t) + | Some t -> show t) (match c_opt with | None -> "None" - | Some t -> Print.comp_to_string t) + | Some t -> show t) (match Env.expected_typ envbody with | None -> "None" - | Some (t, use_eq) -> Print.term_to_string t ^ ", use_eq = " ^ string_of_bool use_eq); + | Some (t, use_eq) -> show t ^ ", use_eq = " ^ string_of_bool use_eq); - if Env.debug env <| Options.Other "NYC" + if !dbg_NYC then BU.print2 "!!!!!!!!!!!!!!!Guard for function with binders %s is %s\n" (Print.binders_to_string ", " bs) (guard_to_string env g_env); @@ -2340,7 +2359,7 @@ and tc_abs env (top:term) (bs:binders) (body:term) : term * lcomp * guard_t = body, cbody, Env.conj_guard guard_body g_lc in - if Env.debug env <| Options.Extreme + if Debug.extreme () then BU.print1 "tc_abs: guard_body: %s\n" (Rel.guard_to_string env guard_body); @@ -2350,7 +2369,7 @@ and tc_abs env (top:term) (bs:binders) (body:term) : term * lcomp * guard_t = only typeable in the extended environment which contains the Binding_lids. Closing the guard (below) won't help with that. *) if env.top_level then ( - if Env.debug env <| Options.Medium then + if Debug.medium () then BU.print1 "tc_abs: FORCING guard_body: %s\n" (Rel.guard_to_string env guard_body); Rel.discharge_guard envbody guard_body ) else ( @@ -2383,14 +2402,14 @@ and tc_abs env (top:term) (bs:binders) (body:term) : term * lcomp * guard_t = && not (Positivity.name_unused_in_type envbody b.binder_bv body) then raise_error (Error_InductiveTypeNotSatisfyPositivityCondition, BU.format1 "Binder %s is marked unused, but its use in the definition is not" - (Print.binder_to_string b)) + (show b)) (S.range_of_bv b.binder_bv); if U.is_binder_strictly_positive b && not (Positivity.name_strictly_positive_in_type envbody b.binder_bv body) then raise_error (Error_InductiveTypeNotSatisfyPositivityCondition, BU.format1 "Binder %s is marked strictly positive, but its use in the definition is not" - (Print.binder_to_string b)) + (show b)) (S.range_of_bv b.binder_bv) )) bs @@ -2441,7 +2460,8 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term let n_args = List.length args in let r = Env.get_range env in let thead = U.comp_result chead in - if debug env Options.High then BU.print2 "(%s) Type of head is %s\n" (Range.string_of_range head.pos) (Print.term_to_string thead); + if Debug.high () then + BU.print3 "(%s) Type of head is %s\nArgs = %s\n" (show head.pos) (show thead) (show args); (* given |- head : chead | ghead where head is a computation returning a function of type (bs0@bs -> cres) @@ -2462,7 +2482,7 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term let monadic_application (head, chead, ghead, cres) (* the head of the application, its lcomp chead, and guard ghead, returning a bs -> cres *) subst (* substituting actuals for formals seen so far, when actual is pure *) - (arg_comps_rev:list (arg * option bv * lcomp)) (* type-checked actual arguments, so far; in reverse order *) + (arg_comps_rev:list (arg * option bv * lcomp)) (* type-checked actual arguments, so far; in reverse order *) arg_rets_rev (* The results of each argument at the logic level, in reverse order *) guard (* conjoined guard formula for all the actuals *) fvs (* unsubstituted formals, to check that they do not occur free elsewhere in the type of f *) @@ -2493,9 +2513,9 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term U.set_result_typ cres rt, Env.conj_guard g0 guard in - if debug env Options.Medium + if Debug.medium () then BU.print1 "\t Type of result cres is %s\n" - (Print.comp_to_string cres); + (show cres); let chead, cres = SS.subst_comp subst chead |> TcComm.lcomp_of_comp, SS.subst_comp subst cres |> TcComm.lcomp_of_comp in @@ -2541,9 +2561,9 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term if TcComm.is_pure_or_ghost_lcomp cres && (head_is_pure_and_some_arg_is_effectful) // || Option.isSome (Env.expected_typ env)) - then let _ = if Env.debug env Options.Extreme then BU.print1 "(a) Monadic app: Return inserted in monadic application: %s\n" (Print.term_to_string term) in + then let _ = if Debug.extreme () then BU.print1 "(a) Monadic app: Return inserted in monadic application: %s\n" (show term) in TcUtil.maybe_assume_result_eq_pure_term env term cres, true - else let _ = if Env.debug env Options.Extreme then BU.print1 "(a) Monadic app: No return inserted in monadic application: %s\n" (Print.term_to_string term) in + else let _ = if Debug.extreme () then BU.print1 "(a) Monadic app: No return inserted in monadic application: %s\n" (show term) in cres, false in @@ -2589,11 +2609,11 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term let _, comp = List.fold_left (fun (i, out_c) ((e, q), x, c) -> - if Env.debug env Options.Extreme then + if Debug.extreme () then BU.print3 "(b) Monadic app: Binding argument %s : %s of type (%s)\n" (match x with | None -> "_" - | Some x -> Print.bv_to_string x) - (Print.term_to_string e) + | Some x -> show x) + (show e) (TcComm.lcomp_to_string c); // //Push first (List.length arg_rets_names_opt - i) names in the env @@ -2616,10 +2636,10 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term //Bind head //Push all arg ret names in the env let env = push_option_names_to_env env arg_rets_names_opt in - if Env.debug env Options.Extreme + if Debug.extreme () then BU.print2 "(c) Monadic app: Binding head %s, chead: %s\n" - (Print.term_to_string head) + (show head) (TcComm.lcomp_to_string chead); if TcComm.is_pure_or_ghost_lcomp chead then TcUtil.bind head.pos env (Some head) chead (None, comp) @@ -2653,11 +2673,11 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term (* a fresh variable and lift the actual argument to comp. *) let lifted_args, head, args = let map_fun ((e, q), _ , c) = - if Env.debug env Options.Extreme then - BU.print2 "For arg e=(%s) c=(%s)... " (Print.term_to_string e) (TcComm.lcomp_to_string c); + if Debug.extreme () then + BU.print2 "For arg e=(%s) c=(%s)... " (show e) (TcComm.lcomp_to_string c); if TcComm.is_pure_or_ghost_lcomp c then begin - if Env.debug env Options.Extreme then + if Debug.extreme () then BU.print_string "... not lifting\n"; None, (e, q) end else begin @@ -2672,8 +2692,8 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term if warn_effectful_args then Errors.log_issue e.pos (Errors.Warning_EffectfulArgumentToErasedFunction, (format3 "Effectful argument %s (%s) to erased function %s, consider let binding it" - (Print.term_to_string e) (string_of_lid c.eff_name) (Print.term_to_string head))); - if Env.debug env Options.Extreme then + (show e) (show c.eff_name) (show head))); + if Debug.extreme () then BU.print_string "... lifting!\n"; let x = S.new_bv None c.res_typ in let e = TcUtil.maybe_lift env e c.eff_name comp.eff_name c.res_typ in @@ -2706,8 +2726,8 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term //NS: Maybe redundant strengthen // let comp, g = comp, guard in let comp, g = TcUtil.strengthen_precondition None env app comp guard in - if Env.debug env Options.Extreme then BU.print2 "(d) Monadic app: type of app\n\t(%s)\n\t: %s\n" - (Print.term_to_string app) + if Debug.extreme () then BU.print2 "(d) Monadic app: type of app\n\t(%s)\n\t: %s\n" + (show app) (TcComm.lcomp_to_string comp); app, comp, g in @@ -2814,20 +2834,16 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term let targ = SS.subst subst x.sort in let bqual = SS.subst_bqual subst bqual in let x = {x with sort=targ} in - if debug env Options.Extreme + if Debug.extreme () then BU.print5 "\tFormal is %s : %s\tType of arg %s (after subst %s) = %s\n" - (Print.bv_to_string x) - (Print.term_to_string x.sort) - (Print.term_to_string e) - (Print.subst_to_string subst) - (Print.term_to_string targ); + (show x) (show x.sort) (show e) (show subst) (show targ); let targ, g_ex = check_no_escape (Some head) env fvs targ in let env = Env.set_expected_typ_maybe_eq env targ (is_eq bqual) in - if debug env Options.High + if Debug.high () then BU.print4 "Checking arg (%s) %s at type %s with use_eq:%s\n" (Print.tag_of_term e) - (Print.term_to_string e) - (Print.term_to_string targ) + (show e) + (show targ) (bqual |> is_eq |> string_of_bool); let e, c, g_e = tc_term env e in let g = Env.conj_guard g_ex <| Env.conj_guard g g_e in @@ -2852,7 +2868,7 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term | Tm_arrow {bs; comp=cres'} -> let bs, cres' = SS.open_comp bs cres' in let head_info = (head, chead, ghead, cres') in - if debug env Options.Low + if Debug.low () then FStar.Errors.log_issue tres.pos (Errors.Warning_RedundantExplicitCurrying, "Potentially redundant explicit currying of a function type"); tc_args head_info ([], [], [], Env.trivial_guard, []) bs args @@ -2900,11 +2916,11 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term else S.mk_Total t, Env.conj_guard guard g in let bs_cres = U.arrow bs cres in - if Env.debug env <| Options.Extreme + if Debug.extreme () then BU.print3 "Forcing the type of %s from %s to %s\n" - (Print.term_to_string head) - (Print.term_to_string tf) - (Print.term_to_string bs_cres); + (show head) + (show tf) + (show bs_cres); //Yes, force only the guard for this equation; the other uvars will not be solved yet let g = Rel.solve_deferred_constraints env (Rel.teq env tf bs_cres) in check_function_app bs_cres (Env.conj_guard g guard) @@ -2912,12 +2928,12 @@ and check_application_args env head (chead:comp) ghead args expected_topt : term | Tm_arrow {bs; comp=c} -> let bs, c = SS.open_comp bs c in let head_info = head, chead, ghead, c in - if Env.debug env Options.Extreme + if Debug.extreme () then BU.print4 "######tc_args of head %s @ %s with formals=%s and result type=%s\n" - (Print.term_to_string head) - (Print.term_to_string tf) + (show head) + (show tf) (Print.binders_to_string ", " bs) - (Print.comp_to_string c); + (show c); tc_args head_info ([], [], [], guard, []) bs args | Tm_refine {b=bv} -> @@ -3013,18 +3029,22 @@ and tc_pat env (pat_t:typ) (p0:pat) : aux false (N.normalize [Env.Beta;Env.Iota] env scrutinee_t) in let pat_typ_ok env pat_t scrutinee_t : guard_t = - if Env.debug env <| Options.Other "Patterns" + if !dbg_Patterns then BU.print2 "$$$$$$$$$$$$pat_typ_ok? %s vs. %s\n" - (Print.term_to_string pat_t) - (Print.term_to_string scrutinee_t); + (show pat_t) (show scrutinee_t); + def_check_scoped pat_t.pos "pat_typ_ok.pat_t.entry" env pat_t; let fail : string -> 'a = fun msg_str -> let msg = if msg_str = "" then [] else [Errors.text msg_str] in let msg = - (Errors.text (BU.format2 "Type of pattern (%s) does not match type of scrutinee (%s)" - (Print.term_to_string pat_t) - (Print.term_to_string scrutinee_t))) :: msg + let open FStar.Pprint in + let open FStar.Class.PP in + let open FStar.Errors.Msg in + ( + prefix 2 1 (text "Type of pattern") (pp pat_t) ^/^ + prefix 2 1 (text "does not match type of scrutinee") (pp scrutinee_t) + ) :: msg in raise_error_doc (Errors.Fatal_MismatchedPatternType, msg) p0.p in @@ -3057,8 +3077,8 @@ and tc_pat env (pat_t:typ) (p0:pat) : match Rel.teq_nosmt env p s with | None -> fail (BU.format2 "Parameter %s <> Parameter %s" - (Print.term_to_string p) - (Print.term_to_string s)) + (show p) + (show s)) | Some g -> let g = Rel.discharge_guard_no_smt env g in Env.conj_guard g out) @@ -3068,8 +3088,8 @@ and tc_pat env (pat_t:typ) (p0:pat) : | _ -> fail "Pattern matching a non-inductive type" else fail (BU.format2 "Head mismatch %s vs %s" - (Print.term_to_string head_p) - (Print.term_to_string head_s)) + (show head_p) + (show head_s)) | _ -> match Rel.teq_nosmt env pat_t scrutinee_t with @@ -3196,8 +3216,8 @@ and tc_pat env (pat_t:typ) (p0:pat) : * pat * guard_t * bool = - if Env.debug env <| Options.Other "Patterns" - then BU.print2 "Checking pattern %s at type %s\n" (Print.pat_to_string p) (Print.term_to_string t); + if !dbg_Patterns + then BU.print2 "Checking pattern %s at type %s\n" (show p) (show t); let id t = mk_Tm_app (S.fvar Const.id_lid None) @@ -3241,7 +3261,7 @@ and tc_pat env (pat_t:typ) (p0:pat) : match p.v with | Pat_dot_term _ -> - failwith (BU.format1 "Impossible: Expected an undecorated pattern, got %s" (Print.pat_to_string p)) + failwith (BU.format1 "Impossible: Expected an undecorated pattern, got %s" (show p)) | Pat_var x -> let x = {x with sort=t} in @@ -3263,15 +3283,15 @@ and tc_pat env (pat_t:typ) (p0:pat) : | _ -> fail (BU.format1 "Pattern matching a constant that does not have decidable equality: %s" - (Print.const_to_string c))); + (show c))); let _, e_c, _, _ = PatternUtils.pat_as_exp false false env p in let e_c, lc, g = tc_tot_or_gtot_term env e_c in Rel.force_trivial_guard env g; let expected_t = expected_pat_typ env p0.p t in if not (Rel.teq_nosmt_force env lc.res_typ expected_t) then fail (BU.format2 "Type of pattern (%s) does not match type of scrutinee (%s)" - (Print.term_to_string lc.res_typ) - (Print.term_to_string expected_t)); + (show lc.res_typ) + (show expected_t)); [], [], e_c, @@ -3321,7 +3341,7 @@ and tc_pat env (pat_t:typ) (p0:pat) : if List.length simple_bvs_pat <> List.length sub_pats then failwith (BU.format4 "(%s) Impossible: pattern bvar mismatch: %s; expected %s sub pats; got %s" (Range.string_of_range p.p) - (Print.pat_to_string simple_pat) + (show simple_pat) (BU.string_of_int (List.length sub_pats)) (BU.string_of_int (List.length simple_bvs_pat))); let simple_pat_e, simple_bvs, g1, erasable = @@ -3358,7 +3378,7 @@ and tc_pat env (pat_t:typ) (p0:pat) : |> BU.first_N (List.length simple_bvs - List.length simple_bvs_pat) |> snd in - let g' = pat_typ_ok env simple_pat_t (expected_pat_typ env p0.p t) in + let g' = pat_typ_ok (Env.push_bvs env simple_bvs) simple_pat_t (expected_pat_typ env p0.p t) in // // Now solve guard // guard may have logical payload coming from typechecking of the @@ -3373,11 +3393,11 @@ and tc_pat env (pat_t:typ) (p0:pat) : {guard with guard_f=fml} in // And combine with g' (the guard from pat_typ_ok) let guard = Env.conj_guard guard g' in - if Env.debug env <| Options.Other "Patterns" + if !dbg_Patterns then BU.print3 "$$$$$$$$$$$$Checked simple pattern %s at type %s with bvs=%s\n" - (Print.term_to_string simple_pat_e) - (Print.term_to_string simple_pat_t) - (List.map (fun x -> "(" ^ Print.bv_to_string x ^ " : " ^ Print.term_to_string x.sort ^ ")") simple_bvs + (show simple_pat_e) + (show simple_pat_t) + (List.map (fun x -> "(" ^ show x ^ " : " ^ show x.sort ^ ")") simple_bvs |> String.concat " "); simple_pat_e, simple_bvs, guard, erasable in @@ -3442,8 +3462,8 @@ and tc_pat env (pat_t:typ) (p0:pat) : g, erasable in - if Env.debug env <| Options.Other "Patterns" - then BU.print1 "Checking pattern: %s\n" (Print.pat_to_string p0); + if !dbg_Patterns + then BU.print1 "Checking pattern: %s\n" (show p0); let bvs, tms, pat_e, pat, g, erasable = check_nested_pattern (Env.clear_expected_typ env |> fst) @@ -3452,10 +3472,10 @@ and tc_pat env (pat_t:typ) (p0:pat) : in let extended_env = Env.push_bvs env bvs in let pat_e_norm = N.normalize [Env.Beta] extended_env pat_e in - if Env.debug env <| Options.Other "Patterns" + if !dbg_Patterns then BU.print2 "Done checking pattern %s as expression %s\n" - (Print.pat_to_string pat) - (Print.term_to_string pat_e); + (show pat) + (show pat_e); pat, bvs, tms, extended_env, pat_e, pat_e_norm, g, erasable @@ -3500,10 +3520,10 @@ and tc_eqn (scrutinee:bv) (env:Env.env) (ret_opt : option match_returns_ascripti tc_pat (Env.push_bv env scrutinee) pat_t pattern in - if Env.debug env <| Options.Extreme then - BU.print3 "tc_eqn: typechecked pattern %s with bvs %s and pat_bv_tms %s\n" - (Print.pat_to_string pattern) (Print.bvs_to_string ";" pat_bvs) - (List.fold_left (fun s t -> s ^ ";" ^ (Print.term_to_string t)) "" pat_bv_tms); + if Debug.extreme () then + BU.print3 "tc_eqn: typechecked pattern %s with bvs %s and pat_bv_tms=%s\n" + (show pattern) (Print.bvs_to_string ";" pat_bvs) + (show pat_bv_tms); (* 2. Check the when clause *) let when_clause, g_when = match when_clause with @@ -3592,7 +3612,7 @@ and tc_eqn (scrutinee:bv) (env:Env.env) (ret_opt : option match_returns_ascripti let fail () = failwith (BU.format3 "tc_eqn: Impossible (%s) %s (%s)" (Range.string_of_range pat_exp.pos) - (Print.term_to_string pat_exp) + (show pat_exp) (Print.tag_of_term pat_exp)) in let rec head_constructor t = match t.n with @@ -3604,7 +3624,7 @@ and tc_eqn (scrutinee:bv) (env:Env.env) (ret_opt : option match_returns_ascripti match scrutinee_tm with | None -> failwith (BU.format2 "Impossible (%s): scrutinee of match is not defined %s" (Range.string_of_range pattern.p) - (Print.pat_to_string pattern)) + (show pattern)) | Some t -> t in let pat_exp = SS.compress pat_exp |> U.unmeta in @@ -3663,8 +3683,8 @@ and tc_eqn (scrutinee:bv) (env:Env.env) (ret_opt : option match_returns_ascripti //a non-pattern sub-term computed via unification; no guard needeed since it is from a dot pattern | _ -> failwith (BU.format2 "Internal error: unexpected elaborated pattern: %s and pattern expression %s" - (Print.pat_to_string pattern) - (Print.term_to_string pat_exp)) + (show pattern) + (show pat_exp)) in (* 5 (b) *) @@ -3689,8 +3709,8 @@ and tc_eqn (scrutinee:bv) (env:Env.env) (ret_opt : option match_returns_ascripti branch_guard in - if Env.debug env <| Options.Extreme then - BU.print1 "tc_eqn: branch guard : %s\n" (Print.term_to_string branch_guard); + if Debug.extreme () then + BU.print1 "tc_eqn: branch guard : %s\n" (show branch_guard); (* 6 (a). Build equality conditions between the pattern and the scrutinee *) (* (b). Weaken the VCs of the branch and when clause with the equalities from 6 (a) and the when condition *) @@ -3778,7 +3798,7 @@ and tc_eqn (scrutinee:bv) (env:Env.env) (ret_opt : option match_returns_ascripti if close_branch_with_substitutions then let _ = - if Env.debug env <| Options.Other "LayeredEffects" + if !dbg_LayeredEffects then BU.print_string "Typechecking pat_bv_tms ...\n" in (* @@ -3821,10 +3841,10 @@ and tc_eqn (scrutinee:bv) (env:Env.env) (ret_opt : option match_returns_ascripti |> List.map (N.normalize [Env.Beta] env) in let _ = - if Env.debug env <| Options.Other "LayeredEffects" - then BU.print2 "tc_eqn: typechecked pat_bv_tms %s (pat_bvs : %s)\n" - (List.fold_left (fun s t -> s ^ ";" ^ (Print.term_to_string t)) "" pat_bv_tms) - (List.fold_left (fun s t -> s ^ ";" ^ (Print.bv_to_string t)) "" pat_bvs) in + if !dbg_LayeredEffects + then BU.print2 "tc_eqn: typechecked pat_bv_tms=%s (pat_bvs=%s)\n" + (show pat_bv_tms) (show pat_bvs) + in c_weak |> TcComm.apply_lcomp (fun c -> c) (fun g -> match eqs with @@ -3843,7 +3863,7 @@ and tc_eqn (scrutinee:bv) (env:Env.env) (ret_opt : option match_returns_ascripti let guard = Env.conj_guard g_when g_branch in - if Env.debug env Options.High + if Debug.high () then BU.print1 "Carrying guard from match: %s\n" <| guard_to_string env guard; SS.close_branch (pattern, when_clause, branch_exp), @@ -3888,16 +3908,16 @@ and check_top_level_let env e = in (* Unfold all @tcnorm subterms in the binding *) - if Env.debug env Options.Medium then - BU.print1 "Let binding BEFORE tcnorm: %s\n" (Print.term_to_string e1); + if Debug.medium () then + BU.print1 "Let binding BEFORE tcnorm: %s\n" (show e1); let e1 = if Options.tcnorm () then N.normalize [Env.UnfoldAttr [Const.tcnorm_attr]; Env.Exclude Env.Beta; Env.Exclude Env.Zeta; Env.NoFullNorm; Env.DoNotUnfoldPureLets] env e1 else e1 in - if Env.debug env Options.Medium then - BU.print1 "Let binding AFTER tcnorm: %s\n" (Print.term_to_string e1); + if Debug.medium () then + BU.print1 "Let binding AFTER tcnorm: %s\n" (show e1); (* * AR: comp for the whole `let x = e1 in e2`, where e2 = () @@ -3963,8 +3983,8 @@ and check_inner_let env e = then raise_error (Errors.Fatal_ExpectedPureExpression, BU.format2 "Definitions marked @inline_let are expected to be pure or ghost; \ got an expression \"%s\" with effect \"%s\"" - (Print.term_to_string e1) - (Print.lid_to_string c1.eff_name)) + (show e1) + (show c1.eff_name)) e1.pos in let x = {BU.left lb.lbname with sort=c1.res_typ} in @@ -3981,7 +4001,7 @@ and check_inner_let env e = tc_term env_x e2 |> (fun (e2, c2, g2) -> let c2, g2 = TcUtil.strengthen_precondition - ((fun _ -> "folding guard g2 of e2 in the lcomp") |> Some) + ((fun _ -> Errors.mkmsg "folding guard g2 of e2 in the lcomp") |> Some) env_x e2 c2 @@ -4025,17 +4045,17 @@ and check_inner_let env e = if Option.isSome (Env.expected_typ env) then (let tt = Env.expected_typ env |> Option.get |> fst in - if Env.debug env <| Options.Other "Exports" + if !dbg_Exports then BU.print2 "Got expected type from env %s\ncres.res_typ=%s\n" - (Print.term_to_string tt) - (Print.term_to_string cres.res_typ); + (show tt) + (show cres.res_typ); e, cres, guard) else (* no expected type; check that x doesn't escape it's scope *) (let t, g_ex = check_no_escape None env [x] cres.res_typ in - if Env.debug env <| Options.Other "Exports" + if !dbg_Exports then BU.print2 "Checked %s has no escaping types; normalized to %s\n" - (Print.term_to_string cres.res_typ) - (Print.term_to_string t); + (show cres.res_typ) + (show t); e, ({cres with res_typ=t}), Env.conj_guard g_ex guard) | _ -> failwith "Impossible (inner let with more than one lb)" @@ -4149,14 +4169,14 @@ and check_inner_let_rec env top = let cres = if cres.eff_name |> Env.norm_eff_name env |> Env.is_layered_effect env - then let bvss = Set.from_list bvs in + then let bvss = from_list bvs in TcComm.apply_lcomp (fun c -> if (c |> U.comp_effect_args |> List.existsb (fun (t, _) -> t |> Free.names - |> Set.inter bvss - |> Set.is_empty + |> inter bvss + |> is_empty |> not)) then raise_error (Errors.Fatal_EscapedBoundVar, "One of the inner let recs escapes in the \ @@ -4221,8 +4241,8 @@ and build_let_rec_env _top_level env lbs : list letbinding * env_t * guard_t = raise_error (Errors.Fatal_RecursiveFunctionLiteral, (BU.format3 "Only function literals with arrow types can be defined recursively; got (%s) %s : %s" (Print.tag_of_term lbdef) - (Print.term_to_string lbdef) - (Print.term_to_string lbtyp))) + (show lbdef) + (show lbtyp))) lbtyp.pos; // TODO: GM: maybe point to the one that's actually empty? let nformals = List.length formals in @@ -4234,7 +4254,7 @@ and build_let_rec_env _top_level env lbs : list letbinding * env_t * guard_t = * totality. Another way of seeing this check is that we take * the minimum amount of binders from the actuals and formals. *) if U.has_attribute attrs Const.admit_termination_lid then ( - log_issue env.range (Warning_WarnOnUse, "Admitting termination of " ^ Print.lbname_to_string lbname); + log_issue env.range (Warning_WarnOnUse, "Admitting termination of " ^ show lbname); None ) else if U.comp_effect_name c |> Env.lookup_effect_quals env |> List.contains TotalEffect then Some (nformals, U.abs actuals body body_lc) @@ -4267,9 +4287,9 @@ and build_let_rec_env _top_level env lbs : list letbinding * env_t * guard_t = // tc_abs adding universes here so that when we add the let binding, we // can add a typescheme with these universes | Some (arity, lbdef) -> - if Env.debug env <| Options.Extreme + if Debug.extreme () then BU.print2 "termination_check_enabled returned arity: %s and lbdef: %s\n" - (string_of_int arity) (Print.term_to_string lbdef); + (string_of_int arity) (show lbdef); let lb = {lb with lbtyp=lbtyp; lbunivs=univ_vars; lbdef=lbdef} in let env = {env with letrecs=(lb.lbname, arity, lbtyp, univ_vars)::env.letrecs} in lb, env @@ -4293,8 +4313,8 @@ and check_let_recs env lbts = | [] -> raise_error (Errors.Fatal_RecursiveFunctionLiteral, BU.format2 "Only function literals may be defined recursively; %s is defined to be %s" - (Print.lbname_to_string lb.lbname) - (Print.term_to_string lb.lbdef) + (show lb.lbname) + (show lb.lbdef) ) (S.range_of_lbname lb.lbname) | _ -> (); @@ -4365,9 +4385,9 @@ and check_let_bound_def top_level env lb (Env.set_range env1 e1.pos) e1 c1 wf_annot in let g1 = Env.conj_guard g1 guard_f in - if Env.debug env Options.Extreme + if Debug.extreme () then BU.print3 "checked let-bound def %s : %s guard is %s\n" - (Print.lbname_to_string lb.lbname) + (show lb.lbname) (TcComm.lcomp_to_string c1) (Rel.guard_to_string env g1); @@ -4401,21 +4421,21 @@ and check_lbtyp top_level env lb : option typ (* checked version of lb.lbtyp, i else //we have an inline annotation let k, _ = U.type_u () in let t, _, g = tc_check_tot_or_gtot_term env1 t k "" in - if debug env Options.Medium + if Debug.medium () then BU.print2 "(%s) Checked type annotation %s\n" (Range.string_of_range (range_of_lbname lb.lbname)) - (Print.term_to_string t); + (show t); let t = norm env1 t in Some t, g, univ_vars, univ_opening, Env.set_expected_typ env1 t ) and tc_binder env ({binder_bv=x;binder_qual=imp;binder_positivity=pqual;binder_attrs=attrs}) = let tu, u = U.type_u () in - if Env.debug env Options.Extreme + if Debug.extreme () then BU.print3 "Checking binder %s:%s at type %s\n" - (Print.bv_to_string x) - (Print.term_to_string x.sort) - (Print.term_to_string tu); + (show x) + (show x.sort) + (show tu); let t, _, g = tc_check_tot_or_gtot_term env x.sort tu "" in //ghost effect ok in the types of binders let imp, g' = match imp with @@ -4428,12 +4448,12 @@ and tc_binder env ({binder_bv=x;binder_qual=imp;binder_positivity=pqual;binder_a let g = Env.conj_guard g g_attrs in check_erasable_binder_attributes env attrs t; let x = S.mk_binder_with_attrs ({x with sort=t}) imp pqual attrs in - if Env.debug env Options.High - then BU.print2 "Pushing binder %s at type %s\n" (Print.bv_to_string x.binder_bv) (Print.term_to_string t); + if Debug.high () + then BU.print2 "Pushing binder %s at type %s\n" (show x.binder_bv) (show t); x, push_binding env x, g, u and tc_binders env bs = - if Env.debug env Options.Extreme then + if Debug.extreme () then BU.print1 "Checking binders %s\n" (Print.binders_to_string ", " bs); let rec aux env bs = match bs with | [] -> [], env, Env.trivial_guard, [] @@ -4475,8 +4495,8 @@ and tc_tot_or_gtot_term_maybe_solve_deferred (env:env) (e:term) (msg:string) (so | Some g' -> e, TcComm.lcomp_of_comp target_comp, Env.conj_guard g (Env.conj_guard g_c g') | _ -> if allow_ghost - then raise_error (Err.expected_ghost_expression e c msg) e.pos - else raise_error (Err.expected_pure_expression e c msg) e.pos + then raise_error_doc (Err.expected_ghost_expression e c msg) e.pos + else raise_error_doc (Err.expected_pure_expression e c msg) e.pos and tc_tot_or_gtot_term' (env:env) (e:term) (msg:string) : term * lcomp * guard_t @@ -4516,7 +4536,7 @@ let tc_check_trivial_guard env t k = in environment env *) let typeof_tot_or_gtot_term env e must_tot = - if Env.debug env <| Options.Other "RelCheck" then BU.print1 "Checking term %s\n" (Print.term_to_string e); + if !dbg_RelCheck then BU.print1 "Checking term %s\n" (show e); //let env, _ = Env.clear_expected_typ env in let env = {env with top_level=false; letrecs=[]} in let t, c, g = @@ -4528,12 +4548,12 @@ let typeof_tot_or_gtot_term env e must_tot = let c = N.maybe_ghost_to_pure_lcomp env c in if TcComm.is_total_lcomp c then t, c.res_typ, g - else raise_error (Errors.Fatal_UnexpectedImplictArgument, (BU.format1 "Implicit argument: Expected a total term; got a ghost term: %s" (Print.term_to_string e))) (Env.get_range env) + else raise_error (Errors.Fatal_UnexpectedImplictArgument, (BU.format1 "Implicit argument: Expected a total term; got a ghost term: %s" (show e))) (Env.get_range env) else t, c.res_typ, g -let level_of_type_fail env e t = +let level_of_type_fail env (e:term) (t:string) = raise_error_doc (Errors.Fatal_UnexpectedTermType, - [Errors.text (BU.format2 "Expected a type; got %s of type %s" (Print.term_to_string e) t)]) + [Errors.text (BU.format2 "Expected a type; got %s of type %s" (show e) t)]) (Env.get_range env) let level_of_type env e t = @@ -4557,7 +4577,7 @@ let level_of_type env e t = let g = FStar.TypeChecker.Rel.teq env t t_u in begin match g.guard_f with | NonTrivial f -> - level_of_type_fail env e (Print.term_to_string t) + level_of_type_fail env e (show t) | _ -> Rel.force_trivial_guard env g end; @@ -4621,7 +4641,7 @@ let rec universe_of_aux env e : term = | Tm_unknown | Tm_delayed _ -> failwith ("TcTerm.universe_of:Impossible (bvar/unknown/lazy) " ^ - (Print.term_to_string e)) + (show e)) //normalize let bindings away and then compute the universe | Tm_let _ -> let e = N.normalize [] env e in @@ -4659,9 +4679,9 @@ let rec universe_of_aux env e : term = | _ -> raise_error (Errors.Fatal_IncompatibleUniverse, BU.format3 "Incompatible universe application for %s, expected %s got %s\n" - (Print.fv_to_string fv) - (Print.univ_to_string ul) - (Print.univ_to_string ur)) + (show fv) + (show ul) + (show ur)) (Env.get_range env)) us' us; t @@ -4718,10 +4738,10 @@ let rec universe_of_aux env e : term = | _ -> let env, _ = Env.clear_expected_typ env in let env = {env with lax=true; top_level=false} in - if Env.debug env <| Options.Other "UniverseOf" + if !dbg_UniverseOf then BU.print2 "%s: About to type-check %s\n" (Range.string_of_range (Env.get_range env)) - (Print.term_to_string hd); + (show hd); let _, ({res_typ=t}), g = tc_term env hd in Rel.solve_deferred_constraints env g |> ignore; t, args @@ -4729,7 +4749,7 @@ let rec universe_of_aux env e : term = let t, args = type_of_head true env hd args in (match apply_well_typed env t args with | Some t -> t - | None -> level_of_type_fail env e (Print.term_to_string t)) + | None -> level_of_type_fail env e (show t)) | Tm_match {brs=b::_} -> //AR: TODO: use return annotation? let (pat, _, tm) = SS.open_branch b in let bvs = Syntax.pat_bvs pat in @@ -4740,13 +4760,13 @@ let rec universe_of_aux env e : term = let universe_of env e = Errors.with_ctx "While attempting to compute a universe level" (fun () -> - if debug env Options.High then - BU.print1 "Calling universe_of_aux with %s {\n" (Print.term_to_string e); + if Debug.high () then + BU.print1 "Calling universe_of_aux with %s {\n" (show e); def_check_scoped e.pos "universe_of entry" env e; let r = universe_of_aux env e in - if debug env Options.High then - BU.print1 "Got result from universe_of_aux = %s }\n" (Print.term_to_string r); + if Debug.high () then + BU.print1 "Got result from universe_of_aux = %s }\n" (show r); level_of_type env e r ) @@ -4763,7 +4783,7 @@ let rec __typeof_tot_or_gtot_term_fastpath (env:env) (t:term) (must_tot:bool) : let t = SS.compress t in match t.n with | Tm_delayed _ - | Tm_bvar _ -> failwith ("Impossible: " ^ Print.term_to_string t) + | Tm_bvar _ -> failwith ("Impossible: " ^ show t) (* Can't (easily) do this one efficiently, just return None *) | Tm_constant (Const_reify _) diff --git a/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fst b/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fst new file mode 100644 index 00000000000..87624e5b7aa --- /dev/null +++ b/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fst @@ -0,0 +1,550 @@ +module FStar.TypeChecker.TermEqAndSimplify +open FStar.Pervasives +open FStar.Compiler.Effect +open FStar.Compiler +open FStar.Compiler.Util +open FStar.Syntax +open FStar.Const +open FStar.Ident +open FStar.TypeChecker.Env +open FStar.Syntax.Syntax +open FStar.Syntax.Util +module SS = FStar.Syntax.Subst +module U = FStar.Syntax.Util +module PC = FStar.Parser.Const +module S = FStar.Syntax.Syntax +module BU = FStar.Compiler.Util + +// Functions that we specially treat as injective, to make normalization +// (particularly of decidable equality) better. We should make sure they +// are actually proved to be injective. +let injectives = + ["FStar.Int8.int_to_t"; + "FStar.Int16.int_to_t"; + "FStar.Int32.int_to_t"; + "FStar.Int64.int_to_t"; + "FStar.Int128.int_to_t"; + "FStar.UInt8.uint_to_t"; + "FStar.UInt16.uint_to_t"; + "FStar.UInt32.uint_to_t"; + "FStar.UInt64.uint_to_t"; + "FStar.UInt128.uint_to_t"; + "FStar.SizeT.uint_to_t"; + "FStar.Int8.__int_to_t"; + "FStar.Int16.__int_to_t"; + "FStar.Int32.__int_to_t"; + "FStar.Int64.__int_to_t"; + "FStar.Int128.__int_to_t"; + "FStar.UInt8.__uint_to_t"; + "FStar.UInt16.__uint_to_t"; + "FStar.UInt32.__uint_to_t"; + "FStar.UInt64.__uint_to_t"; + "FStar.UInt128.__uint_to_t"; + "FStar.SizeT.__uint_to_t"; + ] + +// Compose two eq_result injectively, as in a pair +let eq_inj r s = + match r, s with + | Equal, Equal -> Equal + | NotEqual, _ + | _, NotEqual -> NotEqual + | _, _ -> Unknown + +// Promote a bool to eq_result, conservatively. +let equal_if = function + | true -> Equal + | _ -> Unknown + +// Promote a bool to an eq_result, taking a false to bet NotEqual. +// This is only useful for fully decidable equalities. +// Use with care, see note about Const_real below and #2806. +let equal_iff = function + | true -> Equal + | _ -> NotEqual + +// Compose two equality results, NOT assuming a NotEqual implies anything. +// This is useful, e.g., for checking the equality of applications. Consider +// f x ~ g y +// if f=g and x=y then we know these two expressions are equal, but cannot say +// anything when either result is NotEqual or Unknown, hence this returns Unknown +// in most cases. +// The second comparison is thunked for efficiency. +let eq_and r s = + if r = Equal && s () = Equal + then Equal + else Unknown + +(* Precondition: terms are well-typed in a common environment, or this can return false positives *) +let rec eq_tm (env:env_t) (t1:term) (t2:term) : eq_result = + let t1 = canon_app t1 in + let t2 = canon_app t2 in + let equal_data (f1:S.fv) (args1:Syntax.args) (f2:fv) (args2:Syntax.args) (n_parms:int) = + // we got constructors! we know they are injective and disjoint, so we can do some + // good analysis on them + if fv_eq f1 f2 + then ( + let n1 = List.length args1 in + let n2 = List.length args2 in + if n1 = n2 && n_parms <= n1 + then ( + let parms1, args1 = List.splitAt n_parms args1 in + let parms2, args2 = List.splitAt n_parms args2 in + let eq_arg_list as1 as2 = + List.fold_left2 + (fun acc (a1, q1) (a2, q2) -> + //if q1 <> q2 + //then failwith (U.format1 "Arguments of %s mismatch on implicit qualifier\n" + // (Ident.string_of_lid f1.fv_name.v)); + //NS: 05/06/2018 ...this does not always hold + // it's been succeeding because the assert is disabled in the non-debug builds + //assert (q1 = q2); + eq_inj acc (eq_tm env a1 a2)) + Equal + as1 + as2 + in + eq_arg_list args1 args2 + ) + else Unknown + ) + else NotEqual + in + let qual_is_inj = function + | Some Data_ctor + | Some (Record_ctor _) -> true + | _ -> false + in + let heads_and_args_in_case_both_data : option (S.fv * args * S.fv * args * int) = + let head1, args1 = t1 |> unmeta |> head_and_args in + let head2, args2 = t2 |> unmeta |> head_and_args in + match (un_uinst head1).n, (un_uinst head2).n with + | Tm_fvar f, Tm_fvar g + when qual_is_inj f.fv_qual && + qual_is_inj g.fv_qual -> ( + match Env.num_datacon_non_injective_ty_params env (lid_of_fv f) with + | Some n -> Some (f, args1, g, args2, n) + | _ -> None + ) + | _ -> None + in + let t1 = unmeta t1 in + let t2 = unmeta t2 in + match t1.n, t2.n with + // We sometimes compare open terms, as we get alpha-equivalence + // for free. + | Tm_bvar bv1, Tm_bvar bv2 -> + equal_if (bv1.index = bv2.index) + + | Tm_lazy _, _ -> eq_tm env (unlazy t1) t2 + | _, Tm_lazy _ -> eq_tm env t1 (unlazy t2) + + | Tm_name a, Tm_name b -> + equal_if (bv_eq a b) + + | _ when heads_and_args_in_case_both_data |> Some? -> //matches only when both are data constructors + heads_and_args_in_case_both_data |> must |> (fun (f, args1, g, args2, n) -> + equal_data f args1 g args2 n + ) + + | Tm_fvar f, Tm_fvar g -> equal_if (fv_eq f g) + + | Tm_uinst(f, us), Tm_uinst(g, vs) -> + // If the fvars and universe instantiations match, then Equal, + // otherwise Unknown. + eq_and (eq_tm env f g) (fun () -> equal_if (eq_univs_list us vs)) + + | Tm_constant (Const_range _), Tm_constant (Const_range _) -> + // Ranges should be opaque, even to the normalizer. c.f. #1312 + Unknown + + | Tm_constant (Const_real r1), Tm_constant (Const_real r2) -> + // We cannot decide equality of reals. Use a conservative approach here. + // If the strings match, they are equal, otherwise we don't know. If this + // goes via the eq_iff case below, it will falsely claim that "1.0R" and + // "01.R" are different, since eq_const does not canonizalize the string + // representations. + equal_if (r1 = r2) + + | Tm_constant c, Tm_constant d -> + // NOTE: this relies on the fact that eq_const *correctly decides* + // semantic equality of constants. This needs some care. For instance, + // since integers are represented by a string, eq_const needs to take care + // of ignoring leading zeroes, and match 0 with -0. An exception to this + // are real number literals (handled above). See #2806. + // + // Currently (24/Jan/23) this seems to be correctly implemented, but + // updates should be done with care. + equal_iff (eq_const c d) + + | Tm_uvar (u1, ([], _)), Tm_uvar (u2, ([], _)) -> + equal_if (Unionfind.equiv u1.ctx_uvar_head u2.ctx_uvar_head) + + | Tm_app {hd=h1; args=args1}, Tm_app {hd=h2; args=args2} -> + begin match (un_uinst h1).n, (un_uinst h2).n with + | Tm_fvar f1, Tm_fvar f2 when fv_eq f1 f2 && List.mem (string_of_lid (lid_of_fv f1)) injectives -> + equal_data f1 args1 f2 args2 0 + + | _ -> // can only assert they're equal if they syntactically match, nothing else + eq_and (eq_tm env h1 h2) (fun () -> eq_args env args1 args2) + end + + | Tm_match {scrutinee=t1; brs=bs1}, Tm_match {scrutinee=t2; brs=bs2} -> //AR: note: no return annotations + if List.length bs1 = List.length bs2 + then List.fold_right (fun (b1, b2) a -> eq_and a (fun () -> branch_matches env b1 b2)) + (List.zip bs1 bs2) + (eq_tm env t1 t2) + else Unknown + + | Tm_type u, Tm_type v -> + equal_if (eq_univs u v) + + | Tm_quoted (t1, q1), Tm_quoted (t2, q2) -> + // NOTE: we do NOT ever provide a meaningful result for quoted terms. Even + // if term_eq (the syntactic equality) returns true, that does not mean we + // can present the equality to userspace since term_eq ignores the names + // of binders, but the view exposes them. Hence, we simply always return + // Unknown. We do not seem to rely anywhere on simplifying equalities of + // quoted literals. See also #2806. + Unknown + + | Tm_refine {b=t1; phi=phi1}, Tm_refine {b=t2; phi=phi2} -> + eq_and (eq_tm env t1.sort t2.sort) (fun () -> eq_tm env phi1 phi2) + + (* + * AR: ignoring residual comp here, that's an ascription added by the typechecker + * do we care if that's different? + *) + | Tm_abs {bs=bs1; body=body1}, Tm_abs {bs=bs2; body=body2} + when List.length bs1 = List.length bs2 -> + + eq_and (List.fold_left2 (fun r b1 b2 -> eq_and r (fun () -> eq_tm env b1.binder_bv.sort b2.binder_bv.sort)) + Equal bs1 bs2) + (fun () -> eq_tm env body1 body2) + + | Tm_arrow {bs=bs1; comp=c1}, Tm_arrow {bs=bs2; comp=c2} + when List.length bs1 = List.length bs2 -> + eq_and (List.fold_left2 (fun r b1 b2 -> eq_and r (fun () -> eq_tm env b1.binder_bv.sort b2.binder_bv.sort)) + Equal bs1 bs2) + (fun () -> eq_comp env c1 c2) + + | _ -> Unknown + +and eq_antiquotations (env:env_t) a1 a2 = + // Basically this; + // List.fold_left2 (fun acc t1 t2 -> eq_inj acc (eq_tm t1 t2)) Equal a1 a2 + // but lazy and handling lists of different size + match a1, a2 with + | [], [] -> Equal + | [], _ + | _, [] -> NotEqual + | t1::a1, t2::a2 -> + match eq_tm env t1 t2 with + | NotEqual -> NotEqual + | Unknown -> + (match eq_antiquotations env a1 a2 with + | NotEqual -> NotEqual + | _ -> Unknown) + | Equal -> eq_antiquotations env a1 a2 + +and branch_matches env b1 b2 = + let related_by f o1 o2 = + match o1, o2 with + | None, None -> true + | Some x, Some y -> f x y + | _, _ -> false + in + let (p1, w1, t1) = b1 in + let (p2, w2, t2) = b2 in + if eq_pat p1 p2 + then begin + // We check the `when` branches too, even if unsupported for now + if eq_tm env t1 t2 = Equal && related_by (fun t1 t2 -> eq_tm env t1 t2 = Equal) w1 w2 + then Equal + else Unknown + end + else Unknown + +and eq_args env (a1:args) (a2:args) : eq_result = + match a1, a2 with + | [], [] -> Equal + | (a, _)::a1, (b, _)::b1 -> + (match eq_tm env a b with + | Equal -> eq_args env a1 b1 + | _ -> Unknown) + | _ -> Unknown + +and eq_comp env (c1 c2:comp) : eq_result = + match c1.n, c2.n with + | Total t1, Total t2 + | GTotal t1, GTotal t2 -> + eq_tm env t1 t2 + | Comp ct1, Comp ct2 -> + eq_and (equal_if (eq_univs_list ct1.comp_univs ct2.comp_univs)) + (fun _ -> + eq_and (equal_if (Ident.lid_equals ct1.effect_name ct2.effect_name)) + (fun _ -> + eq_and (eq_tm env ct1.result_typ ct2.result_typ) + (fun _ -> eq_args env ct1.effect_args ct2.effect_args))) + //ignoring cflags + | _ -> NotEqual + +let eq_tm_bool e t1 t2 = eq_tm e t1 t2 = Equal + +let simplify (debug:bool) (env:env_t) (tm:term) : term = + let w t = {t with pos=tm.pos} in + let simp_t t = + // catch annotated subformulae too + match (U.unmeta t).n with + | Tm_fvar fv when S.fv_eq_lid fv PC.true_lid -> Some true + | Tm_fvar fv when S.fv_eq_lid fv PC.false_lid -> Some false + | _ -> None + in + let rec args_are_binders args bs = + match args, bs with + | (t, _)::args, b::bs -> + begin match (SS.compress t).n with + | Tm_name bv' -> S.bv_eq b.binder_bv bv' && args_are_binders args bs + | _ -> false + end + | [], [] -> true + | _, _ -> false + in + let is_applied (bs:binders) (t : term) : option bv = + if debug then + BU.print2 "WPE> is_applied %s -- %s\n" (Print.term_to_string t) (Print.tag_of_term t); + let hd, args = U.head_and_args_full t in + match (SS.compress hd).n with + | Tm_name bv when args_are_binders args bs -> + if debug then + BU.print3 "WPE> got it\n>>>>top = %s\n>>>>b = %s\n>>>>hd = %s\n" + (Print.term_to_string t) + (Print.bv_to_string bv) + (Print.term_to_string hd); + Some bv + | _ -> None + in + let is_applied_maybe_squashed (bs : binders) (t : term) : option bv = + if debug then + BU.print2 "WPE> is_applied_maybe_squashed %s -- %s\n" (Print.term_to_string t) (Print.tag_of_term t); + match is_squash t with + + | Some (_, t') -> is_applied bs t' + | _ -> begin match is_auto_squash t with + | Some (_, t') -> is_applied bs t' + | _ -> is_applied bs t + end + in + let is_const_match (phi : term) : option bool = + match (SS.compress phi).n with + (* Trying to be efficient, but just checking if they all agree *) + (* Note, if we wanted to do this for any term instead of just True/False + * we need to open the terms *) + | Tm_match {brs=br::brs} -> + let (_, _, e) = br in + let r = begin match simp_t e with + | None -> None + | Some b -> if List.for_all (fun (_, _, e') -> simp_t e' = Some b) brs + then Some b + else None + end + in + r + | _ -> None + in + let maybe_auto_squash t = + if U.is_sub_singleton t + then t + else U.mk_auto_squash U_zero t + in + let squashed_head_un_auto_squash_args t = + //The head of t is already a squashed operator, e.g. /\ etc. + //no point also squashing its arguments if they're already in U_zero + let maybe_un_auto_squash_arg (t,q) = + match U.is_auto_squash t with + | Some (U_zero, t) -> + //if we're squashing from U_zero to U_zero + // then just remove it + t, q + | _ -> + t,q + in + let head, args = U.head_and_args t in + let args = List.map maybe_un_auto_squash_arg args in + S.mk_Tm_app head args t.pos + in + let rec clearly_inhabited (ty : typ) : bool = + match (U.unmeta ty).n with + | Tm_uinst (t, _) -> clearly_inhabited t + | Tm_arrow {comp=c} -> clearly_inhabited (U.comp_result c) + | Tm_fvar fv -> + let l = S.lid_of_fv fv in + (Ident.lid_equals l PC.int_lid) + || (Ident.lid_equals l PC.bool_lid) + || (Ident.lid_equals l PC.string_lid) + || (Ident.lid_equals l PC.exn_lid) + | _ -> false + in + let simplify arg = (simp_t (fst arg), arg) in + match (SS.compress tm).n with + | Tm_app {hd={n=Tm_uinst({n=Tm_fvar fv}, _)}; args} + | Tm_app {hd={n=Tm_fvar fv}; args} -> + if S.fv_eq_lid fv PC.and_lid + then match args |> List.map simplify with + | [(Some true, _); (_, (arg, _))] + | [(_, (arg, _)); (Some true, _)] -> maybe_auto_squash arg + | [(Some false, _); _] + | [_; (Some false, _)] -> w U.t_false + | _ -> squashed_head_un_auto_squash_args tm + else if S.fv_eq_lid fv PC.or_lid + then match args |> List.map simplify with + | [(Some true, _); _] + | [_; (Some true, _)] -> w U.t_true + | [(Some false, _); (_, (arg, _))] + | [(_, (arg, _)); (Some false, _)] -> maybe_auto_squash arg + | _ -> squashed_head_un_auto_squash_args tm + else if S.fv_eq_lid fv PC.imp_lid + then match args |> List.map simplify with + | [_; (Some true, _)] + | [(Some false, _); _] -> w U.t_true + | [(Some true, _); (_, (arg, _))] -> maybe_auto_squash arg + | [(_, (p, _)); (_, (q, _))] -> + if U.term_eq p q + then w U.t_true + else squashed_head_un_auto_squash_args tm + | _ -> squashed_head_un_auto_squash_args tm + else if S.fv_eq_lid fv PC.iff_lid + then match args |> List.map simplify with + | [(Some true, _) ; (Some true, _)] + | [(Some false, _) ; (Some false, _)] -> w U.t_true + | [(Some true, _) ; (Some false, _)] + | [(Some false, _) ; (Some true, _)] -> w U.t_false + | [(_, (arg, _)) ; (Some true, _)] + | [(Some true, _) ; (_, (arg, _))] -> maybe_auto_squash arg + | [(_, (arg, _)) ; (Some false, _)] + | [(Some false, _) ; (_, (arg, _))] -> maybe_auto_squash (U.mk_neg arg) + | [(_, (p, _)); (_, (q, _))] -> + if U.term_eq p q + then w U.t_true + else squashed_head_un_auto_squash_args tm + | _ -> squashed_head_un_auto_squash_args tm + else if S.fv_eq_lid fv PC.not_lid + then match args |> List.map simplify with + | [(Some true, _)] -> w U.t_false + | [(Some false, _)] -> w U.t_true + | _ -> squashed_head_un_auto_squash_args tm + else if S.fv_eq_lid fv PC.forall_lid + then match args with + (* Simplify ∀x. True to True *) + | [(t, _)] -> + begin match (SS.compress t).n with + | Tm_abs {bs=[_]; body} -> + (match simp_t body with + | Some true -> w U.t_true + | _ -> tm) + | _ -> tm + end + (* Simplify ∀x. True to True, and ∀x. False to False, if the domain is not empty *) + | [(ty, Some ({ aqual_implicit = true })); (t, _)] -> + begin match (SS.compress t).n with + | Tm_abs {bs=[_]; body} -> + (match simp_t body with + | Some true -> w U.t_true + | Some false when clearly_inhabited ty -> w U.t_false + | _ -> tm) + | _ -> tm + end + | _ -> tm + else if S.fv_eq_lid fv PC.exists_lid + then match args with + (* Simplify ∃x. False to False *) + | [(t, _)] -> + begin match (SS.compress t).n with + | Tm_abs {bs=[_]; body} -> + (match simp_t body with + | Some false -> w U.t_false + | _ -> tm) + | _ -> tm + end + (* Simplify ∃x. False to False and ∃x. True to True, if the domain is not empty *) + | [(ty, Some ({ aqual_implicit = true })); (t, _)] -> + begin match (SS.compress t).n with + | Tm_abs {bs=[_]; body} -> + (match simp_t body with + | Some false -> w U.t_false + | Some true when clearly_inhabited ty -> w U.t_true + | _ -> tm) + | _ -> tm + end + | _ -> tm + else if S.fv_eq_lid fv PC.b2t_lid + then match args with + | [{n=Tm_constant (Const_bool true)}, _] -> w U.t_true + | [{n=Tm_constant (Const_bool false)}, _] -> w U.t_false + | _ -> tm //its arg is a bool, can't unsquash + else if S.fv_eq_lid fv PC.haseq_lid + then begin + (* + * AR: We try to mimic the hasEq related axioms in Prims + * and the axiom related to refinements + * For other types, such as lists, whose hasEq is derived by the typechecker, + * we leave them as is + *) + let t_has_eq_for_sure (t:S.term) :bool = + //Axioms from prims + let haseq_lids = [PC.int_lid; PC.bool_lid; PC.unit_lid; PC.string_lid] in + match (SS.compress t).n with + | Tm_fvar fv when haseq_lids |> List.existsb (fun l -> S.fv_eq_lid fv l) -> true + | _ -> false + in + if List.length args = 1 then + let t = args |> List.hd |> fst in + if t |> t_has_eq_for_sure then w U.t_true + else + match (SS.compress t).n with + | Tm_refine _ -> + let t = U.unrefine t in + if t |> t_has_eq_for_sure then w U.t_true + else + //get the hasEq term itself + let haseq_tm = + match (SS.compress tm).n with + | Tm_app {hd} -> hd + | _ -> failwith "Impossible! We have already checked that this is a Tm_app" + in + //and apply it to the unrefined type + mk_app (haseq_tm) [t |> as_arg] + | _ -> tm + else tm + end + else if S.fv_eq_lid fv PC.eq2_lid + then match args with + | [(_typ, _); (a1, _); (a2, _)] -> //eq2 + (match eq_tm env a1 a2 with + | Equal -> w U.t_true + | NotEqual -> w U.t_false + | _ -> tm) + | _ -> tm + else + begin + match U.is_auto_squash tm with + | Some (U_zero, t) + when U.is_sub_singleton t -> + //remove redundant auto_squashes + t + | _ -> + tm + end + | Tm_refine {b=bv; phi=t} -> + begin match simp_t t with + | Some true -> bv.sort + | Some false -> tm + | None -> tm + end + | Tm_match _ -> + begin match is_const_match tm with + | Some true -> w U.t_true + | Some false -> w U.t_false + | None -> tm + end + | _ -> tm diff --git a/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fsti b/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fsti new file mode 100644 index 00000000000..ba368f6f6de --- /dev/null +++ b/src/typechecker/FStar.TypeChecker.TermEqAndSimplify.fsti @@ -0,0 +1,16 @@ +module FStar.TypeChecker.TermEqAndSimplify +open FStar.Pervasives +open FStar.Compiler.Effect +open FStar.TypeChecker.Env +open FStar.Syntax.Syntax + +type eq_result = + | Equal + | NotEqual + | Unknown + +val eq_tm (_:env_t) (t1 t2:term) : eq_result +val eq_args (_:env_t) (t1 t2:args) : eq_result +val eq_comp (_:env_t) (t1 t2:comp) : eq_result +val eq_tm_bool (e:env_t) (t1 t2:term) : bool +val simplify (debug:bool) (_:env_t) (_:term) : term diff --git a/src/typechecker/FStar.TypeChecker.Util.fst b/src/typechecker/FStar.TypeChecker.Util.fst index cd28a4d35be..b27278d102b 100644 --- a/src/typechecker/FStar.TypeChecker.Util.fst +++ b/src/typechecker/FStar.TypeChecker.Util.fst @@ -46,6 +46,22 @@ module TcComm = FStar.TypeChecker.Common module P = FStar.Syntax.Print module C = FStar.Parser.Const module UF = FStar.Syntax.Unionfind +module TEQ = FStar.TypeChecker.TermEqAndSimplify + +open FStar.Class.Setlike + +let dbg_bind = Debug.get_toggle "Bind" +let dbg_Coercions = Debug.get_toggle "Coercions" +let dbg_Dec = Debug.get_toggle "Dec" +let dbg_Extraction = Debug.get_toggle "Extraction" +let dbg_LayeredEffects = Debug.get_toggle "LayeredEffects" +let dbg_LayeredEffectsApp = Debug.get_toggle "LayeredEffectsApp" +let dbg_Pat = Debug.get_toggle "Pat" +let dbg_Rel = Debug.get_toggle "Rel" +let dbg_ResolveImplicitsHook = Debug.get_toggle "ResolveImplicitsHook" +let dbg_Return = Debug.get_toggle "Return" +let dbg_Simplification = Debug.get_toggle "Simplification" +let dbg_SMTEncodingReify = Debug.get_toggle "SMTEncodingReify" //Reporting errors let report env errs = @@ -65,7 +81,7 @@ let close_guard_implicits env solve_deferred (xs:binders) (g:guard_t) : guard_t let solve_now, defer = g.deferred |> List.partition (fun (_, _, p) -> Rel.flex_prob_closing env xs p) in - if Env.debug env <| Options.Other "Rel" + if !dbg_Rel then begin BU.print_string "SOLVE BEFORE CLOSING:\n"; List.iter (fun (_, s, p) -> BU.print2 "%s: %s\n" s (Rel.prob_to_string env p)) solve_now; @@ -80,7 +96,7 @@ let close_guard_implicits env solve_deferred (xs:binders) (g:guard_t) : guard_t let check_uvars r t = let uvs = Free.uvars t in - if not (Set.is_empty uvs) then begin + if not (is_empty uvs) then begin (* ignoring the hide_uvar_nums and print_implicits flags here *) Options.push(); Options.set_option "hide_uvar_nums" (Options.Bool false); @@ -185,7 +201,7 @@ let extract_let_rec_annotation env {lbname=lbname; lbunivs=univ_vars; lbtyp=t; l let u_subst, univ_vars = SS.univ_var_opening univ_vars in let e = SS.subst u_subst e in let t = SS.subst u_subst t in - if Env.debug env <| Options.Other "Dec" + if !dbg_Dec then BU.print2 "extract_let_rec_annotation lbdef=%s; lbtyp=%s\n" (Print.term_to_string e) (Print.term_to_string t); @@ -383,7 +399,7 @@ let extract_let_rec_annotation env {lbname=lbname; lbunivs=univ_vars; lbtyp=t; l // | Pat_var x, Tm_name y -> // if not (bv_eq x y) // then failwith (BU.format2 "Expected pattern variable %s; got %s" (Print.bv_to_string x) (Print.bv_to_string y)); -// if Env.debug env <| Options.Other "Pat" +// if !dbg_Pat // then BU.print2 "Pattern variable %s introduced at type %s\n" (Print.bv_to_string x) (Normalize.term_to_string env y.sort); // let s = Normalize.normalize [Env.Beta] env y.sort in // let x = {x with sort=s} in @@ -533,7 +549,7 @@ let mk_wp_return env (ed:S.eff_decl) (u_a:universe) (a:typ) (e:term) (r:Range.ra e.pos in mk_comp ed u_a a wp [RETURN] in - if debug env <| Options.Other "Return" + if !dbg_Return then BU.print3 "(%s) returning %s at comp type %s\n" (Range.string_of_range e.pos) (P.term_to_string e) @@ -713,7 +729,7 @@ let substitutive_indexed_close_substs (env:env) : list subst_elt = - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in // go through the binders bs and aggregate substitutions let close_bs, subst = @@ -854,7 +870,7 @@ let substitutive_indexed_bind_substs env : list subst_elt & guard_t = - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in let bind_name () = if debug @@ -980,7 +996,7 @@ let ad_hoc_indexed_bind_substs env : list subst_elt & guard_t = - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in let bind_name () = if debug @@ -1021,7 +1037,7 @@ let ad_hoc_indexed_bind_substs env (Print.binder_to_string b) (bind_name ()) (Range.string_of_range r1) else "ad_hoc_indexed_bind_substs") r1 in - if Env.debug env <| Options.Other "ResolveImplicitsHook" + if !dbg_ResolveImplicitsHook then rest_bs_uvars |> List.iter (fun t -> match (SS.compress t).n with @@ -1043,7 +1059,7 @@ let ad_hoc_indexed_bind_substs env (U.is_layered m_ed) r1 |> List.map (SS.subst subst) in List.fold_left2 (fun g i1 f_i1 -> - if Env.debug env <| Options.Other "ResolveImplicitsHook" + if !dbg_ResolveImplicitsHook then BU.print2 "Generating constraint %s = %s\n" (Print.term_to_string i1) (Print.term_to_string f_i1); @@ -1071,7 +1087,7 @@ let ad_hoc_indexed_bind_substs env let env_g = Env.push_binders env [x_a] in List.fold_left2 (fun g i1 g_i1 -> - if Env.debug env <| Options.Other "ResolveImplicitsHook" + if !dbg_ResolveImplicitsHook then BU.print2 "Generating constraint %s = %s\n" (Print.term_to_string i1) (Print.term_to_string g_i1); @@ -1093,7 +1109,7 @@ let ad_hoc_indexed_bind_substs env let mk_indexed_return env (ed:S.eff_decl) (u_a:universe) (a:typ) (e:term) (r:Range.range) : comp * guard_t = - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in if debug then BU.print4 "Computing %s.return for u_a:%s, a:%s, and e:%s{\n" @@ -1158,13 +1174,13 @@ let mk_indexed_bind env (has_range_binders:bool) : comp * guard_t = - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in if debug then BU.print2 "Binding indexed effects: c1:%s and c2:%s {\n" (Print.comp_to_string (S.mk_Comp ct1)) (Print.comp_to_string (S.mk_Comp ct2)); - if Env.debug env <| Options.Other "ResolveImplicitsHook" + if !dbg_ResolveImplicitsHook then BU.print2 "///////////////////////////////Bind at %s/////////////////////\n\ with bind_t = %s\n" (Range.string_of_range (Env.get_range env)) @@ -1227,7 +1243,7 @@ let mk_indexed_bind env Env.guard_of_guard_formula (TcComm.NonTrivial fml)] in - if Env.debug env <| Options.Other "ResolveImplicitsHook" + if !dbg_ResolveImplicitsHook then BU.print2 "///////////////////////////////EndBind at %s/////////////////////\n\ guard = %s\n" (Range.string_of_range (Env.get_range env)) @@ -1300,7 +1316,7 @@ let mk_bind env else mk_wp_bind env m ct1 b ct2 flags r1, Env.trivial_guard in c, Env.conj_guard g_lift g_bind -let strengthen_comp env (reason:option (unit -> string)) (c:comp) (f:formula) flags : comp * guard_t = +let strengthen_comp env (reason:option (unit -> list Pprint.document)) (c:comp) (f:formula) flags : comp * guard_t = if env.lax || Env.too_early_in_prims env then c, Env.trivial_guard else let r = Env.get_range env in @@ -1413,7 +1429,7 @@ let weaken_precondition env lc (f:guard_formula) : lcomp = TcComm.mk_lcomp lc.eff_name lc.res_typ (weaken_flags lc.cflags) weaken let strengthen_precondition - (reason:option (unit -> string)) + (reason:option (unit -> list Pprint.document)) env (e_for_debugging_only:term) (lc:lcomp) @@ -1445,7 +1461,7 @@ let strengthen_precondition match guard_form g0 with | Trivial -> c, g_c | NonTrivial f -> - if Env.debug env <| Options.Extreme + if Debug.extreme () then BU.print2 "-------------Strengthening pre-condition of term %s with guard %s\n" (N.term_to_string env e_for_debugging_only) (N.term_to_string env f); @@ -1494,8 +1510,7 @@ let maybe_capture_unit_refinement (env:env) (t:term) (x:bv) (c:comp) : comp * gu let bind (r1:Range.range) (env:Env.env) (e1opt:option term) (lc1:lcomp) ((b, lc2):lcomp_with_binder) : lcomp = let debug f = - if debug env Options.Extreme - || debug env <| Options.Other "bind" + if Debug.extreme () || !dbg_bind then f () in let lc1, lc2 = N.ghost_to_pure_lcomp2 env (lc1, lc2) in //downgrade from ghost to pure, if possible @@ -1827,7 +1842,7 @@ let substitutive_indexed_ite_substs (env:env) : list subst_elt & guard_t = - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in // go through the binders bs and aggregate substitutions and guards @@ -1909,7 +1924,7 @@ let ad_hoc_indexed_ite_substs (env:env) : list subst_elt & guard_t = - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in let conjunction_name () = if debug then BU.format1 "%s.conjunction" (string_of_lid ct_then.effect_name) @@ -1972,7 +1987,7 @@ let ad_hoc_indexed_ite_substs (env:env) let mk_layered_conjunction env (ed:S.eff_decl) (u_a:universe) (a:term) (p:typ) (ct1:comp_typ) (ct2:comp_typ) (r:Range.range) : comp * guard_t = - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in let conjunction_t_error (s:string) = Errors.Fatal_UnexpectedEffect, [ @@ -2244,7 +2259,7 @@ let bind_cases env0 (res_t:typ) let check_comp env (use_eq:bool) (e:term) (c:comp) (c':comp) : term * comp * guard_t = def_check_scoped c.pos "check_comp.c" env c; def_check_scoped c'.pos "check_comp.c'" env c'; - if Env.debug env <| Options.Extreme then + if Debug.extreme () then BU.print4 "Checking comp relation:\n%s has type %s\n\t %s \n%s\n" (Print.term_to_string e) (Print.comp_to_string c) @@ -2254,8 +2269,8 @@ let check_comp env (use_eq:bool) (e:term) (c:comp) (c':comp) : term * comp * gua match f env c c' with | None -> if use_eq - then raise_error (Err.computed_computation_type_does_not_match_annotation_eq env e c c') (Env.get_range env) - else raise_error (Err.computed_computation_type_does_not_match_annotation env e c c') (Env.get_range env) + then raise_error_doc (Err.computed_computation_type_does_not_match_annotation_eq env e c c') (Env.get_range env) + else raise_error_doc (Err.computed_computation_type_does_not_match_annotation env e c c') (Env.get_range env) | Some g -> e, c', g let universe_of_comp env u_res c = @@ -2316,7 +2331,7 @@ let coerce_with (env:Env.env) : term * lcomp = match Env.try_lookup_lid env f with | Some _ -> - if Env.debug env (Options.Other "Coercions") then + if !dbg_Coercions then BU.print1 "Coercing with %s!\n" (Ident.string_of_lid f); let lc2 = TcComm.lcomp_of_comp <| comp2 in let lc_res = bind e.pos env (Some e) lc (None, lc2) in @@ -2392,7 +2407,7 @@ let rec check_erased (env:Env.env) (t:term) : isErased = |> check_erased (br_body |> Free.names - |> Set.elems // GGG: bad, order-depending + |> elems // GGG: bad, order-depending |> Env.push_bvs env) with | No -> No | _ -> Maybe) No @@ -2402,7 +2417,7 @@ let rec check_erased (env:Env.env) (t:term) : isErased = | _ -> No in - (* if Options.debug_any () then *) + (* if Debug.any () then *) (* BU.print2 "check_erased (%s) = %s\n" *) (* (Print.term_to_string t) *) (* (match r with *) @@ -2546,7 +2561,7 @@ let maybe_coerce_lc env (e:term) (lc:lcomp) (exp_t:term) : term * lcomp * guard_ if not should_coerce then (e, lc, Env.trivial_guard) else - let _ = if Env.debug env (Options.Other "Coercions") then + let _ = if !dbg_Coercions then BU.print4 "(%s) Trying to coerce %s from type (%s) to type (%s)\n" (Range.string_of_range e.pos) (Print.term_to_string e) @@ -2555,7 +2570,7 @@ let maybe_coerce_lc env (e:term) (lc:lcomp) (exp_t:term) : term * lcomp * guard_ in match find_coercion env lc exp_t e with | Some (coerced, lc, g) -> - let _ = if Env.debug env (Options.Other "Coercions") then + let _ = if !dbg_Coercions then BU.print3 "(%s) COERCING %s to %s\n" (Range.string_of_range e.pos) (Print.term_to_string e) @@ -2563,7 +2578,7 @@ let maybe_coerce_lc env (e:term) (lc:lcomp) (exp_t:term) : term * lcomp * guard_ in coerced, lc, g | None -> - let _ = if Env.debug env (Options.Other "Coercions") then + let _ = if !dbg_Coercions then BU.print1 "(%s) No user coercion found\n" (Range.string_of_range e.pos) in @@ -2612,7 +2627,7 @@ let maybe_coerce_lc env (e:term) (lc:lcomp) (exp_t:term) : term * lcomp * guard_ e, lc, Env.trivial_guard let weaken_result_typ env (e:term) (lc:lcomp) (t:typ) (use_eq:bool) : term * lcomp * guard_t = - if Env.debug env Options.High then + if Debug.high () then BU.print3 "weaken_result_typ e=(%s) lc=(%s) t=(%s)\n" (Print.term_to_string e) (TcComm.lcomp_to_string lc) @@ -2633,7 +2648,7 @@ let weaken_result_typ env (e:term) (lc:lcomp) (t:typ) (use_eq:bool) : term * lco * AR: 11/18: should this always fail hard? *) if env.failhard - then raise_error (Err.basic_type_error env (Some e) t lc.res_typ) e.pos + then raise_error_doc (Err.basic_type_error env (Some e) t lc.res_typ) e.pos else ( subtype_fail env e lc.res_typ t; //log a sub-typing error e, {lc with res_typ=t}, Env.trivial_guard //and keep going to type-check the result of the program @@ -2652,8 +2667,8 @@ let weaken_result_typ env (e:term) (lc:lcomp) (t:typ) (use_eq:bool) : term * lco let set_result_typ (c:comp) :comp = Util.set_result_typ c t in - if Util.eq_tm t res_t = Util.Equal then begin //if the two types res_t and t are same, then just set the result type - if Env.debug env <| Options.Extreme + if TEQ.eq_tm env t res_t = TEQ.Equal then begin //if the two types res_t and t are same, then just set the result type + if Debug.extreme() then BU.print2 "weaken_result_type::strengthen_trivial: res_t:%s is same as t:%s\n" (Print.term_to_string res_t) (Print.term_to_string t); set_result_typ c, g_c @@ -2674,13 +2689,13 @@ let weaken_result_typ env (e:term) (lc:lcomp) (t:typ) (use_eq:bool) : term * lco (comp_univ_opt c) res_t (S.bv_to_name x) in //AR: an M_M bind let lc = bind e.pos env (Some e) (TcComm.lcomp_of_comp c) (Some x, TcComm.lcomp_of_comp cret) in - if Env.debug env <| Options.Extreme + if Debug.extreme () then BU.print4 "weaken_result_type::strengthen_trivial: inserting a return for e: %s, c: %s, t: %s, and then post return lc: %s\n" (Print.term_to_string e) (Print.comp_to_string c) (Print.term_to_string t) (TcComm.lcomp_to_string lc); let c, g_lc = TcComm.lcomp_comp lc in set_result_typ c, Env.conj_guards [g_c; gret; g_lc] else begin - if Env.debug env <| Options.Extreme + if Debug.extreme () then BU.print2 "weaken_result_type::strengthen_trivial: res_t:%s is not a refinement, leaving c:%s as is\n" (Print.term_to_string res_t) (Print.comp_to_string c); set_result_typ c, g_c @@ -2707,7 +2722,7 @@ let weaken_result_typ env (e:term) (lc:lcomp) (t:typ) (use_eq:bool) : term * lco | _ -> let c, g_c = TcComm.lcomp_comp lc in - if Env.debug env <| Options.Extreme + if Debug.extreme () then BU.print4 "Weakened from %s to %s\nStrengthening %s with guard %s\n" (N.term_to_string env lc.res_typ) (N.term_to_string env t) @@ -2736,7 +2751,7 @@ let weaken_result_typ env (e:term) (lc:lcomp) (t:typ) (use_eq:bool) : term * lco //AR: M_M bind let c = bind e.pos env (Some e) (TcComm.lcomp_of_comp c) (Some x, eq_ret) in let c, g_lc = TcComm.lcomp_comp c in - if Env.debug env <| Options.Extreme + if Debug.extreme () then BU.print1 "Strengthened to %s\n" (Normalize.comp_to_string env c); c, Env.conj_guards [g_c; gret; g_lc] end @@ -2793,7 +2808,7 @@ let norm_reify (env:Env.env) (steps:Env.steps) (t:S.term) : S.term = let t' = N.normalize ([Env.Beta; Env.Reify; Env.Eager_unfolding; Env.EraseUniverses; Env.AllowUnboundUniverses; Env.Exclude Env.Zeta]@steps) env t in - if Env.debug env <| Options.Other "SMTEncodingReify" + if !dbg_SMTEncodingReify then BU.print2 "Reified body %s \nto %s\n" (Print.term_to_string t) (Print.term_to_string t') ; @@ -2826,12 +2841,9 @@ let maybe_instantiate (env:Env.env) e t = if not env.instantiate_imp then e, torig, Env.trivial_guard else begin - if Env.debug env Options.High then + if Debug.high () then BU.print3 "maybe_instantiate: starting check for (%s) of type (%s), expected type is %s\n" - (Print.term_to_string e) (Print.term_to_string t) - (match Env.expected_typ env with - | None -> "None" - | Some (t, _) -> Print.term_to_string t); + (show e) (show t) (show (Env.expected_typ env)); (* Similar to U.arrow_formals, but makes sure to unfold * recursively to catch all the binders across type * definitions. TODO: Move to library? Revise other uses @@ -2849,7 +2861,7 @@ let maybe_instantiate (env:Env.env) e t = let number_of_implicits t = let formals = unfolded_arrow_formals env t in let n_implicits = - match formals |> BU.prefix_until (fun ({binder_qual=imp}) -> Option.isNone imp || U.eq_bqual imp (Some Equality) = U.Equal) with + match formals |> BU.prefix_until (fun ({binder_qual=imp}) -> Option.isNone imp || U.eq_bqual imp (Some Equality)) with | None -> List.length formals | Some (implicits, _first_explicit, _rest) -> List.length implicits in n_implicits @@ -2884,9 +2896,8 @@ let maybe_instantiate (env:Env.env) e t = | _, ({binder_bv=x; binder_qual=Some (Implicit _);binder_attrs=[]})::rest -> let t = SS.subst subst x.sort in let v, _, g = new_implicit_var "Instantiation of implicit argument" e.pos env t in - if Env.debug env Options.High then - BU.print1 "maybe_instantiate: Instantiating implicit with %s\n" - (Print.term_to_string v); + if Debug.high () then + BU.print1 "maybe_instantiate: Instantiating implicit with %s\n" (show v); let subst = NT(x, v)::subst in let aq = U.aqual_of_binder (List.hd bs) in let args, bs, subst, g' = aux subst (decr_inst inst_n) rest in @@ -2914,9 +2925,8 @@ let maybe_instantiate (env:Env.env) e t = let v, _, g = Env.new_implicit_var_aux msg e.pos env t Strict (Some meta_t) in - if Env.debug env Options.High then - BU.print1 "maybe_instantiate: Instantiating meta argument with %s\n" - (Print.term_to_string v); + if Debug.high () then + BU.print1 "maybe_instantiate: Instantiating meta argument with %s\n" (show v); let subst = NT(x, v)::subst in let aq = U.aqual_of_binder (List.hd bs) in let args, bs, subst, g' = aux subst (decr_inst inst_n) rest in @@ -2975,14 +2985,14 @@ let check_has_type_maybe_coerce env (e:term) (lc:lcomp) (t2:typ) use_eq : term * let env = Env.set_range env e.pos in let e, lc, g_c = maybe_coerce_lc env e lc t2 in let g = check_has_type env e lc.res_typ t2 use_eq in - if debug env <| Options.Other "Rel" then + if !dbg_Rel then BU.print1 "Applied guard is %s\n" <| guard_to_string env g; e, lc, (Env.conj_guard g g_c) ///////////////////////////////////////////////////////////////////////////////// let check_top_level env g lc : (bool * comp) = Errors.with_ctx "While checking for top-level effects" (fun () -> - if debug env Options.Medium then + if Debug.medium () then BU.print1 "check_top_level, lc = %s\n" (TcComm.lcomp_to_string lc); let discharge g = force_trivial_guard env g; @@ -3039,7 +3049,7 @@ let check_top_level env g lc : (bool * comp) = (c_eff |> Ident.string_of_lid)) (Env.get_range env) | Some (bs, _) -> - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in // // Typechecking of effect abbreviation ensures that there is at least // one return type argument, so the following a::bs is ok @@ -3082,7 +3092,7 @@ let check_top_level env g lc : (bool * comp) = |> S.mk_Comp |> Normalize.normalize_comp steps env in let ct, vc, g_pre = check_trivial_precondition_wp env c in - if Env.debug env <| Options.Other "Simplification" + if !dbg_Simplification then BU.print1 "top-level VC: %s\n" (Print.term_to_string vc); discharge (Env.conj_guard g (Env.conj_guard g_c g_pre)), ct |> S.mk_Comp ) @@ -3211,7 +3221,7 @@ let must_erase_for_extraction (g:env) (t:typ) = Env.Unascribe] env t in // debug g (fun () -> BU.print1 "aux %s\n" (Print.term_to_string t)); let res = Env.non_informative env t || descend env t in - if Env.debug env <| Options.Other "Extraction" + if !dbg_Extraction then BU.print2 "must_erase=%s: %s\n" (if res then "true" else "false") (Print.term_to_string t); res in @@ -3227,7 +3237,7 @@ let fresh_effect_repr env r eff_name signature_ts repr_ts_opt u a_tm = let _, signature = Env.inst_tscheme signature_ts in - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in (* * We go through the binders in the signature a -> bs @@ -3310,7 +3320,7 @@ let substitutive_indexed_lift_substs (env:env) : list subst_elt & guard_t = - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in let bs, subst = let a_b::bs = bs in @@ -3344,7 +3354,7 @@ let ad_hoc_indexed_lift_substs (env:env) : list subst_elt & guard_t = - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in let lift_t_shape_error s = BU.format2 "Lift %s has unexpected shape, reason: %s" @@ -3386,7 +3396,7 @@ let ad_hoc_indexed_lift_substs (env:env) let lift_tf_layered_effect (tgt:lident) (lift_ts:tscheme) (kind:S.indexed_effect_combinator_kind) env (c:comp) : comp * guard_t = - let debug = Env.debug env <| Options.Other "LayeredEffectsApp" in + let debug = !dbg_LayeredEffectsApp in if debug then BU.print2 "Lifting indexed comp %s to %s {\n" @@ -3420,8 +3430,8 @@ let lift_tf_layered_effect (tgt:lident) (lift_ts:tscheme) (kind:S.indexed_effect let u, wp = List.hd lift_ct.comp_univs, fst (List.hd lift_ct.effect_args) in Env.pure_precondition_for_trivial_post env u lift_ct.result_typ wp Range.dummyRange in - if Env.debug env <| Options.Other "LayeredEffects" && - Env.debug env <| Options.Extreme + if !dbg_LayeredEffects && + Debug.extreme () then BU.print1 "Guard for lift is: %s" (Print.term_to_string fml); let c = mk_Comp ({ diff --git a/src/typechecker/FStar.TypeChecker.Util.fsti b/src/typechecker/FStar.TypeChecker.Util.fsti index 00cae991f5f..41ff4ed1e51 100644 --- a/src/typechecker/FStar.TypeChecker.Util.fsti +++ b/src/typechecker/FStar.TypeChecker.Util.fsti @@ -98,7 +98,7 @@ val bind_cases: env -> typ -> list (typ * lident * list cflag * (bool -> lcomp)) *) val weaken_result_typ: env -> term -> lcomp -> typ -> bool -> term * lcomp * guard_t -val strengthen_precondition: (option (unit -> string) -> env -> term -> lcomp -> guard_t -> lcomp*guard_t) +val strengthen_precondition: (option (unit -> list Pprint.document) -> env -> term -> lcomp -> guard_t -> lcomp*guard_t) val weaken_guard: guard_formula -> guard_formula -> guard_formula val weaken_precondition: env -> lcomp -> guard_formula -> lcomp val maybe_assume_result_eq_pure_term: env -> term -> lcomp -> lcomp @@ -132,8 +132,8 @@ val check_top_level: env -> guard_t -> lcomp -> bool*comp val maybe_coerce_lc : env -> term -> lcomp -> typ -> term * lcomp * guard_t //misc. -val label: string -> Range.range -> typ -> typ -val label_guard: Range.range -> string -> guard_t -> guard_t +val label: list Pprint.document -> Range.range -> typ -> typ +val label_guard: Range.range -> list Pprint.document -> guard_t -> guard_t val short_circuit: term -> args -> guard_formula val short_circuit_head: term -> bool val maybe_add_implicit_binders: env -> binders -> binders diff --git a/tests/Makefile b/tests/Makefile index ee282fcbe99..5bbeacd54d2 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -16,6 +16,7 @@ ALL_TEST_DIRS += struct ALL_TEST_DIRS += tactics ALL_TEST_DIRS += typeclasses ALL_TEST_DIRS += vale +ALL_TEST_DIRS += hacl HAS_OCAML := $(shell which ocamlfind 2>/dev/null) ifneq (,$(HAS_OCAML)) diff --git a/tests/bug-reports/Bug2172.fst b/tests/bug-reports/Bug2172.fst new file mode 100644 index 00000000000..055514abb71 --- /dev/null +++ b/tests/bug-reports/Bug2172.fst @@ -0,0 +1,12 @@ +module Bug2172 + +// one existential quantification over two variables (`p2` below) is +// different from two extistential quantifications over one variable +// each (`p1` below) + +let p1 = exists (x: int). exists (y: int). 0 == x + y +let p2 = exists (x: int) (y: int). 0 == x + y + +let _ = assert p1 +let _ = assert p2 +let _ = assert (p1 <==> p2) diff --git a/tests/bug-reports/Bug2478.fst b/tests/bug-reports/Bug2478.fst index 169562c4942..28015061902 100755 --- a/tests/bug-reports/Bug2478.fst +++ b/tests/bug-reports/Bug2478.fst @@ -28,7 +28,7 @@ let key0 (bytes:Type0) (#pf: bytes_like bytes) = bytes // assume // val ps_key0: #bytes:Type0 -> (#pf: bytes_like bytes ) -> test_type bytes (key0 bytes #pf) -// //#push-options "--debug Bug2478 --debug_level Rel,RelCheck,Tac --lax" +// //#push-options "--debug Rel,RelCheck,Tac --lax" // let ps_pair3_0 (bytes:Type0) (#pf: bytes_like bytes ): (test_type bytes (x0:bytes & (x1:bytes & bytes))) = // ps_key0 #_ #_;; // ps_key0 ;; @@ -39,7 +39,7 @@ let key (bytes:Type0) {|bytes_like bytes|} = bytes assume val ps_key: #bytes:Type0 -> {|bytes_like bytes|} -> test_type bytes (key bytes) -// #push-options "--debug Bug2478 --debug_level Rel,RelCheck,Tac --lax" +// #push-options "--debug Rel,RelCheck,Tac --lax" let ps_pair3 (bytes:Type0) {| pf: bytes_like bytes|}: (test_type bytes (x0:bytes & (x1:bytes & bytes))) = ps_key #_ #_;; ps_key;; diff --git a/tests/bug-reports/Bug2496.fst b/tests/bug-reports/Bug2496.fst index 07894eb874f..cb7fccefe08 100755 --- a/tests/bug-reports/Bug2496.fst +++ b/tests/bug-reports/Bug2496.fst @@ -34,7 +34,7 @@ let singleton_includes_argument_lemma () : Lemma (forall (ty: eqtype) (r: ty). includes (singleton r) r) = () -#push-options "--z3cliopt 'smt.qi.eager_threshold=100' --query_stats --fuel 1 --ifuel 1" +#push-options "--z3cliopt 'smt.qi.eager_threshold=100' --fuel 1 --ifuel 1" #restart-solver let singleton_includes_argument_lemma_bad () : Lemma (forall (ty: eqtype) (r: ty). includes (singleton r) r) diff --git a/tests/bug-reports/Bug3185.fst b/tests/bug-reports/Bug3185.fst index c3958930f13..e6b36678030 100644 --- a/tests/bug-reports/Bug3185.fst +++ b/tests/bug-reports/Bug3185.fst @@ -3,7 +3,7 @@ module Bug3185 module FT = FStar.Tactics.V2 #push-options "--print_bound_var_types --print_full_names" -// #push-options "--debug_level NBE --debug Test_NbeIllTyped" +// #push-options "--debug NBE" let test_normalise (): unit = assert (forall (i: int). op_LessThanOrEqual == op_LessThanOrEqual) diff --git a/tests/bug-reports/Bug3264a.fst b/tests/bug-reports/Bug3264a.fst new file mode 100644 index 00000000000..c738bebfd8a --- /dev/null +++ b/tests/bug-reports/Bug3264a.fst @@ -0,0 +1,20 @@ +module Bug3264a + +class class_a (t: Type0): Type u#1 = { + type_a: Type0; + f_a: t -> type_a +} +class class_b (t: Type0): Type u#1 = { + super_a: class_a t; + f_b: t -> super_a.type_a +} + +instance foo1 (t: Type) {| i: class_a t |}: class_b t = { + super_a = FStar.Tactics.Typeclasses.solve; + f_b = (fun (y: t) -> f_a y) +} + +instance foo2 (t: Type) {| i: class_a t |}: class_b t = { + super_a = (_ by (FStar.Tactics.Typeclasses.tcresolve ())); + f_b = (fun (y: t) -> f_a y) +} diff --git a/tests/bug-reports/Bug3264b.fst b/tests/bug-reports/Bug3264b.fst new file mode 100644 index 00000000000..bc6ce7c33f1 --- /dev/null +++ b/tests/bug-reports/Bug3264b.fst @@ -0,0 +1,15 @@ +module Bug3264b + +class class_a (t: Type0): Type u#1 = { + type_a: Type0; + f_a: t -> type_a +} +class class_b (t: Type0): Type u#1 = { + super_a: class_a t; + f_b: t -> super_a.type_a +} + +instance foo1 (t: Type) {| i: class_a t |}: class_b t = { + super_a = FStar.Tactics.Typeclasses.solve; + f_b = magic() +} diff --git a/tests/bug-reports/Bug3266.fst b/tests/bug-reports/Bug3266.fst new file mode 100644 index 00000000000..8427972b7e6 --- /dev/null +++ b/tests/bug-reports/Bug3266.fst @@ -0,0 +1,22 @@ +module Bug3266 + +assume +val s : Type0 +let st (a:Type) : Type = a & s + +let functor_laws + (map : (a:_ -> st a -> unit)) + = unit + +noeq +type functor = { + map : a:Type -> st a -> unit; + laws : functor_laws map; +} + +#set-options "--defensive abort" + +let ff : functor = { + map = (fun a (stf: st a) -> let x, s1 = stf in ()); //if you remove the pattern matching on stf then no error is reported + laws = admit () //if you remove the admit here, again no error +} diff --git a/tests/bug-reports/Bug575.fst b/tests/bug-reports/Bug575.fst index 62fc18e6e1b..a6b354f2d23 100644 --- a/tests/bug-reports/Bug575.fst +++ b/tests/bug-reports/Bug575.fst @@ -26,7 +26,7 @@ noeq type multi (r:relation) : int -> Type0 = // Because the dependent pattern matching here goes wrong // Probably because the abbreviation isn't unfolded at the right time -//#set-options "--debug Bug575 --debug_level Rel --debug_level RelCheck" +//#set-options "--debug Rel,RelCheck" let is_Multi_step (r:relation) (x:int) (projectee : multi r x) = match projectee with | Multi_step y ry -> true diff --git a/tests/bug-reports/BugBoxInjectivity.fst b/tests/bug-reports/BugBoxInjectivity.fst new file mode 100644 index 00000000000..bad8361afc5 --- /dev/null +++ b/tests/bug-reports/BugBoxInjectivity.fst @@ -0,0 +1,131 @@ +module BugBoxInjectivity + +open FStar.Functions +module CC = FStar.Cardinality.Universes + +//The original bug; using an indirection to subvert the injectivity check +let mytype1 = Type u#1 + +type my_t (a:mytype1) : Type u#0 = + | My : my_t a + +let inj_my_t (#a:Type u#1) (x:my_t a) +: Lemma (x == My #a) += () + +[@@expect_failure [19]] +let my_t_injective : squash (is_inj my_t) = + introduce forall f0 f1. + my_t f0 == my_t f1 ==> f0 == f1 + with introduce _ ==> _ + with _ . ( + inj_my_t #f0 My; + inj_my_t #f1 (coerce_eq () (My #f0)) + ) + +//Same thing without the indirection +type t (a:Type u#1) : Type u#0 = + | Mk : t a + +let inj_t (#a:Type u#1) (x:t a) +: Lemma (x == Mk #a) += () + +[@@expect_failure [19]] +let t_injective : squash (is_inj t) = + introduce forall f0 f1. + t f0 == t f1 ==> f0 == f1 + with introduce _ ==> _ + with _ . ( + inj_t #f0 Mk; + inj_t #f1 (coerce_eq () (Mk #f0)) + ) + +//Disabling the injectivity check on parameters is inconsistent +#push-options "--ext 'compat:injectivity'" +noeq +type test2 (a:Type u#2) : Type u#1 = + | Mk2 : test2 a +#pop-options + +let test2_inhabited (f:Type u#2) : test2 f = Mk2 +let test2_injective (f0 f1:Type u#2) +: Lemma + (ensures test2 f0 == test2 f1 ==> f0 == f1) += let x : test2 f0 = test2_inhabited f0 in + let Mk2 #_ = x in + () +let itest2_injective' : squash (is_inj test2) = + introduce forall f0 f1. + test2 f0 == test2 f1 ==> f0 == f1 + with introduce _ ==> _ + with _ . ( + test2_injective f0 f1 + ) +let fals () : squash False = + CC.no_inj_universes_suc test2 + + +//Another test case to make sure that indexed types can be inverted properly +noeq +type ceq (#a:Type) x : a -> Type = + | Refl : ceq #a x x + +let test a (x y:a) (h:ceq #a x y) : Lemma (x == y) = () + +//But without collapsing +[@expect_failure [19]] +let bad (h0:ceq true true) (h1:ceq false false) : Lemma (true == false) = + let Refl = h0 in + let Refl = h1 in + () + +//Another test case, to make sure that the normalizer doesn't enforce injectivity of +//type parameter arguments of a data constructor + +module T = FStar.Tactics +type idx : Type u#2 = | A1 | A2 + +noeq +type test3 (a:idx) : Type u#1 = + | Mk3 : test3 a + +[@@expect_failure [19]] +let eq_test3_should_fail (x0 : test3 A1) (x1 : test3 A2) : unit = + assert (test3 A1 == test3 A2) + +let case0 (x0 : test3 A1) (x1 : test3 A2) : Lemma False = + assume (test3 A1 == test3 A2); + assume (~ (Mk3 #A1 == coerce_eq () (Mk3 #A2))) + +[@@expect_failure [228]] +let case1 (x0 : test3 A1) (x1 : test3 A2) : Lemma False = + assume (test3 A1 == test3 A2); + assert (~ (Mk3 #A1 == coerce_eq () (Mk3 #A2))) + by (T.norm [delta;primops]; + T.trefl ()) + +[@@expect_failure [228]] +let case2 (x0 : test3 A1) (x1 : test3 A2) : Lemma False = + assume (test3 A1 == test3 A2); + assert (~ (Mk3 #A1 == coerce_eq () (Mk3 #A2))) + by (T.norm [delta;primops;nbe]; + T.trefl ()) + + +let case4 (x0 : test3 A1) (x1 : test3 A2) : Lemma (test3 A1 == test3 A2 ==> Mk3 #A1 == coerce_eq () (Mk3 #A2)) = + assume (test3 A1 == test3 A2); + assert (Mk3 #A1 == coerce_eq () (Mk3 #A2)) + by (T.norm [delta;primops]; + T.trivial()) //this can be proven by the normalizer alone + +let case5 (x0 : test3 A1) (x1 : test3 A2) : Lemma (test3 A1 == test3 A2 ==> Mk3 #A1 == coerce_eq () (Mk3 #A2)) = + assume (test3 A1 == test3 A2); + assert (Mk3 #A1 == coerce_eq () (Mk3 #A2)) + by (T.norm [delta;primops;nbe]; + T.trivial()) //this can be proven by the normalizer alone; and by nbe + +let case6 (x0 : test3 A1) (x1 : test3 A2) : Lemma (test3 A1 == test3 A2 ==> Mk3 #A1 == coerce_eq () (Mk3 #A2)) = + assume (test3 A1 == test3 A2); + assert (Mk3 #A1 == coerce_eq () (Mk3 #A2)) + by (T.smt()) //but it can also by SMT, since the parameters are irrelevant diff --git a/tests/bug-reports/BugTypeParamProjector.fst b/tests/bug-reports/BugTypeParamProjector.fst new file mode 100644 index 00000000000..67671dc1b55 --- /dev/null +++ b/tests/bug-reports/BugTypeParamProjector.fst @@ -0,0 +1,10 @@ +module BugTypeParamProjector + +type st : Type u#1 = + | MkST: f:int -> st + +noeq +type f (s:st) : (unit -> int) -> Type u#0 = + | MkF : f s (fun _ -> MkST?.f s) + +let test #s #g (x:f s g) = assert (MkF? x) diff --git a/tests/bug-reports/Makefile b/tests/bug-reports/Makefile index 880d5bd667f..7728449aa22 100644 --- a/tests/bug-reports/Makefile +++ b/tests/bug-reports/Makefile @@ -77,7 +77,9 @@ SHOULD_VERIFY_CLOSED=\ Bug2980.fst Bug3115.fst Bug2083.fst Bug2002.fst Bug1482.fst Bug1066.fst \ Bug3120a.fst Bug3120b.fst Bug3186.fst Bug3185.fst Bug3210.fst \ Bug3213.fst Bug3213b.fst Bug3207.fst Bug3207b.fst Bug3207c.fst \ - Bug2155.fst Bug3224a.fst Bug3224b.fst Bug3236.fst Bug3252.fst + Bug2155.fst Bug3224a.fst Bug3224b.fst Bug3236.fst Bug3252.fst \ + BugBoxInjectivity.fst BugTypeParamProjector.fst Bug2172.fst Bug3266.fst \ + Bug3264a.fst Bug3264b.fst SHOULD_VERIFY_INTERFACE_CLOSED=Bug771.fsti Bug771b.fsti SHOULD_VERIFY_AND_WARN_CLOSED=Bug016.fst diff --git a/tests/bug-reports/UnificationCrash.fst b/tests/bug-reports/UnificationCrash.fst index 3f6ec7a6ede..fe5f5b8e836 100644 --- a/tests/bug-reports/UnificationCrash.fst +++ b/tests/bug-reports/UnificationCrash.fst @@ -16,5 +16,5 @@ module UnificationCrash type tree (a:Type0) = | Tree : a -> tree a assume val tree_merge : #a:Type -> cmp:(a -> a -> bool) -> h1:tree a -> tree a -(* #set-options "--debug Crash --debug_level Rel --debug_level RelCheck --debug_level Extreme --debug_level Gen" *) +(* #set-options "--debug Rel,RelCheck,Extreme,Gen" *) let tree_insert cmp h = tree_merge cmp h diff --git a/tests/error-messages/ArrowRanges.fst.expected b/tests/error-messages/ArrowRanges.fst.expected index 71a4fea738e..a9e8c9b3356 100644 --- a/tests/error-messages/ArrowRanges.fst.expected +++ b/tests/error-messages/ArrowRanges.fst.expected @@ -1,6 +1,7 @@ >> Got issues: [ * Error 19 at ArrowRanges.fst(4,30-4,39): - - Subtyping check failed; expected type Prims.eqtype; got type Type0 + - Subtyping check failed + - Expected type Prims.eqtype got type Type0 - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(52,23-52,30) @@ -8,7 +9,10 @@ >>] >> Got issues: [ * Error 19 at ArrowRanges.fst(8,10-8,28): - - Failed to prove that the type 'ArrowRanges.ppof' supports decidable equality because of this argument; add either the 'noeq' or 'unopteq' qualifier + - Failed to prove that the type + 'ArrowRanges.ppof' + supports decidable equality because of this argument. + - Add either the 'noeq' or 'unopteq' qualifier - The SMT solver could not prove the query. Use --query_stats for more details. - See also ArrowRanges.fst(7,0-11,1) diff --git a/tests/error-messages/Bug1918.fst.expected b/tests/error-messages/Bug1918.fst.expected index cf82f56aeb7..2bdd2f33e19 100644 --- a/tests/error-messages/Bug1918.fst.expected +++ b/tests/error-messages/Bug1918.fst.expected @@ -1,13 +1,8 @@ -proof-state: State dump @ depth 0 (at the time of failure): -Location: FStar.Tactics.Typeclasses.fst(180,6-183,7) -Goal 1/1: - |- _ : Bug1918.mon - >> Got issues: [ * Error 228 at Bug1918.fst(11,13-11,14): - - Tactic failed + - Typeclass resolution failed. - Could not solve constraint Bug1918.mon - - See also FStar.Tactics.Typeclasses.fst(180,6-183,7) + - See also FStar.Tactics.Typeclasses.fst(301,6-305,7) >>] Verified module: Bug1918 diff --git a/tests/error-messages/Bug2021.fst.expected b/tests/error-messages/Bug2021.fst.expected index 41aadd84b21..b100795ac1f 100644 --- a/tests/error-messages/Bug2021.fst.expected +++ b/tests/error-messages/Bug2021.fst.expected @@ -36,8 +36,8 @@ >>] >> Got issues: [ -* Error 66 at Bug2021.fst(37,13-37,14): - - Failed to resolve implicit argument ?11 +* Error 66 at Bug2021.fst(37,13-37,17): + - Failed to resolve implicit argument ?13 of type Prims.int introduced for Instantiating implicit argument in application - See also Bug2021.fst(36,11-36,12) diff --git a/tests/error-messages/Bug3227.fst b/tests/error-messages/Bug3227.fst new file mode 100644 index 00000000000..946f145490d --- /dev/null +++ b/tests/error-messages/Bug3227.fst @@ -0,0 +1,8 @@ +module Bug3227 + +type box (a:Type) = { x : a; } +let proj (b : box (box (box int))) : int = b.x.x.x + +type box2 (a:Type) = | Box2 : x:a -> box2 a + +let test (b : box2 (box2 int)) = Box2? b && Box2? (Box2?.x b) \ No newline at end of file diff --git a/tests/error-messages/Bug3227.fst.expected b/tests/error-messages/Bug3227.fst.expected new file mode 100644 index 00000000000..4a4a9d19016 --- /dev/null +++ b/tests/error-messages/Bug3227.fst.expected @@ -0,0 +1,83 @@ +Module after desugaring: +module Bug3227 +Declarations: [ +type box (a: Type) = { } + +let proj b = x (x (x b)) <: Prims.int +type box2 (a: Type) = | Box2 : x: a -> Bug3227.box2 a + + + +let test b = Box2? b && Box2? b.x +] +Exports: [ +type box (a: Type) = { } + +let proj b = x (x (x b)) <: Prims.int +type box2 (a: Type) = | Box2 : x: a -> Bug3227.box2 a + + + +let test b = Box2? b && Box2? b.x +] + +Module before type checking: +module Bug3227 +Declarations: [ +type box (a: Type) = { } + +let proj b = x (x (x b)) <: Prims.int +type box2 (a: Type) = | Box2 : x: a -> Bug3227.box2 a + + + +let test b = Box2? b && Box2? b.x +] +Exports: [ +type box (a: Type) = { } + +let proj b = x (x (x b)) <: Prims.int +type box2 (a: Type) = | Box2 : x: a -> Bug3227.box2 a + + + +let test b = Box2? b && Box2? b.x +] + +Module after type checking: +module Bug3227 +Declarations: [ +type box (a: Type) = { x:a } +val box__uu___haseq: forall (a: Type). {:pattern Prims.hasEq (Bug3227.box a)} + Prims.l_True /\ Prims.hasEq a ==> Prims.hasEq (Bug3227.box a) + + +let proj b = b.x.x.x <: Prims.int +type box2 (a: Type) = | Box2 : x: a -> Bug3227.box2 a +val box2__uu___haseq: forall (a: Type). {:pattern Prims.hasEq (Bug3227.box2 a)} + Prims.l_True /\ Prims.hasEq a ==> Prims.hasEq (Bug3227.box2 a) + + + + +let test b = Box2? b && Box2? b.x +] +Exports: [ +type box (a: Type) = { x:a } +val box__uu___haseq: forall (a: Type). {:pattern Prims.hasEq (Bug3227.box a)} + Prims.l_True /\ Prims.hasEq a ==> Prims.hasEq (Bug3227.box a) + + +let proj b = b.x.x.x <: Prims.int +type box2 (a: Type) = | Box2 : x: a -> Bug3227.box2 a +val box2__uu___haseq: forall (a: Type). {:pattern Prims.hasEq (Bug3227.box2 a)} + Prims.l_True /\ Prims.hasEq a ==> Prims.hasEq (Bug3227.box2 a) + + + + +let test b = Box2? b && Box2? b.x +] + +Verified module: Bug3227 +All verification conditions discharged successfully diff --git a/tests/error-messages/Bug3292.fst b/tests/error-messages/Bug3292.fst new file mode 100644 index 00000000000..842482e4426 --- /dev/null +++ b/tests/error-messages/Bug3292.fst @@ -0,0 +1,19 @@ +module Bug3292 + +#set-options "--print_implicits" + +let op_Plus #a (x y : a) = (x,y) +let op_Minus #a (x y : a) = (x,y) +let op_Slash #a (x y : a) = (x,y) +let op_Greater #a (x y : a) = (x,y) +let op_Less #a (x y : a) = (x,y) +let op_GreaterEquals #a (x y : a) = (x,y) +let op_LessEquals #a (x y : a) = (x,y) + +let _ = 1 + 1 +let _ = 1 - 1 +let _ = 1 / 1 +let _ = 1 > 1 +let _ = 1 < 1 +let _ = 1 >= 1 +let _ = 1 <= 1 diff --git a/tests/error-messages/Bug3292.fst.expected b/tests/error-messages/Bug3292.fst.expected new file mode 100644 index 00000000000..a678197fff9 --- /dev/null +++ b/tests/error-messages/Bug3292.fst.expected @@ -0,0 +1,155 @@ +Module after desugaring: +module Bug3292 +Declarations: [ +#set-options "--print_implicits" +let op_Plus #a x y = x, y +let op_Minus #a x y = x, y +let op_Slash #a x y = x, y +let op_Greater #a x y = x, y +let op_Less #a x y = x, y +let op_GreaterEquals #a x y = x, y +let op_LessEquals #a x y = x, y +private +let _ = 1 + 1 +private +let _ = 1 - 1 +private +let _ = 1 / 1 +private +let _ = 1 > 1 +private +let _ = 1 < 1 +private +let _ = 1 >= 1 +private +let _ = 1 <= 1 +] +Exports: [ +#set-options "--print_implicits" +let op_Plus #a x y = x, y +let op_Minus #a x y = x, y +let op_Slash #a x y = x, y +let op_Greater #a x y = x, y +let op_Less #a x y = x, y +let op_GreaterEquals #a x y = x, y +let op_LessEquals #a x y = x, y +private +let _ = 1 + 1 +private +let _ = 1 - 1 +private +let _ = 1 / 1 +private +let _ = 1 > 1 +private +let _ = 1 < 1 +private +let _ = 1 >= 1 +private +let _ = 1 <= 1 +] + +Module before type checking: +module Bug3292 +Declarations: [ +#set-options "--print_implicits" +let op_Plus x y = x, y +let op_Minus x y = x, y +let op_Slash x y = x, y +let op_Greater x y = x, y +let op_Less x y = x, y +let op_GreaterEquals x y = x, y +let op_LessEquals x y = x, y +private +let _ = 1 + 1 +private +let _ = 1 - 1 +private +let _ = 1 / 1 +private +let _ = 1 > 1 +private +let _ = 1 < 1 +private +let _ = 1 >= 1 +private +let _ = 1 <= 1 +] +Exports: [ +#set-options "--print_implicits" +let op_Plus x y = x, y +let op_Minus x y = x, y +let op_Slash x y = x, y +let op_Greater x y = x, y +let op_Less x y = x, y +let op_GreaterEquals x y = x, y +let op_LessEquals x y = x, y +private +let _ = 1 + 1 +private +let _ = 1 - 1 +private +let _ = 1 / 1 +private +let _ = 1 > 1 +private +let _ = 1 < 1 +private +let _ = 1 >= 1 +private +let _ = 1 <= 1 +] + +Module after type checking: +module Bug3292 +Declarations: [ +#set-options "--print_implicits" +let op_Plus #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +let op_Minus #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +let op_Slash #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +let op_Greater #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +let op_Less #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +let op_GreaterEquals #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +let op_LessEquals #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +private +let _ = Bug3292.op_Plus #Prims.int 1 1 +private +let _ = 1 - 1 +private +let _ = Bug3292.op_Slash #Prims.int 1 1 +private +let _ = Bug3292.op_Greater #Prims.int 1 1 +private +let _ = Bug3292.op_Less #Prims.int 1 1 +private +let _ = 1 >= 1 +private +let _ = 1 <= 1 +] +Exports: [ +#set-options "--print_implicits" +let op_Plus #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +let op_Minus #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +let op_Slash #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +let op_Greater #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +let op_Less #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +let op_GreaterEquals #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +let op_LessEquals #a x y = FStar.Pervasives.Native.Mktuple2 #a #a x y +private +let _ = Bug3292.op_Plus #Prims.int 1 1 +private +let _ = 1 - 1 +private +let _ = Bug3292.op_Slash #Prims.int 1 1 +private +let _ = Bug3292.op_Greater #Prims.int 1 1 +private +let _ = Bug3292.op_Less #Prims.int 1 1 +private +let _ = 1 >= 1 +private +let _ = 1 <= 1 +] + +Verified module: Bug3292 +All verification conditions discharged successfully diff --git a/tests/error-messages/Calc.fst.expected b/tests/error-messages/Calc.fst.expected index 4e25b314bd7..b9a0da83c63 100644 --- a/tests/error-messages/Calc.fst.expected +++ b/tests/error-messages/Calc.fst.expected @@ -33,7 +33,8 @@ >>] >> Got issues: [ * Error 19 at Calc.fst(51,6-51,8): - - Subtyping check failed; expected type Prims.squash (1 == 2); got type Prims.unit + - Subtyping check failed + - Expected type Prims.squash (1 == 2) got type Prims.unit - The SMT solver could not prove the query. Use --query_stats for more details. - See also Calc.fst(51,3-51,5) @@ -41,7 +42,8 @@ >>] >> Got issues: [ * Error 19 at Calc.fst(65,6-65,8): - - Subtyping check failed; expected type Prims.squash (2 == 3); got type Prims.unit + - Subtyping check failed + - Expected type Prims.squash (2 == 3) got type Prims.unit - The SMT solver could not prove the query. Use --query_stats for more details. - See also Calc.fst(65,3-65,5) @@ -49,7 +51,8 @@ >>] >> Got issues: [ * Error 19 at Calc.fst(79,6-79,8): - - Subtyping check failed; expected type Prims.squash (3 == 4); got type Prims.unit + - Subtyping check failed + - Expected type Prims.squash (3 == 4) got type Prims.unit - The SMT solver could not prove the query. Use --query_stats for more details. - See also Calc.fst(79,3-79,5) @@ -57,7 +60,8 @@ >>] >> Got issues: [ * Error 19 at Calc.fst(93,42-93,44): - - Subtyping check failed; expected type Prims.squash q; got type Prims.unit + - Subtyping check failed + - Expected type Prims.squash q got type Prims.unit - The SMT solver could not prove the query. Use --query_stats for more details. - See also Calc.fst(91,20-91,21) @@ -65,7 +69,8 @@ >>] >> Got issues: [ * Error 19 at Calc.fst(100,10-100,12): - - Subtyping check failed; expected type Prims.squash q; got type Prims.unit + - Subtyping check failed + - Expected type Prims.squash q got type Prims.unit - The SMT solver could not prove the query. Use --query_stats for more details. - See also Calc.fst(101,4-101,5) diff --git a/tests/error-messages/Coercions.fst.expected b/tests/error-messages/Coercions.fst.expected index 57e39193959..e9de7cebab4 100644 --- a/tests/error-messages/Coercions.fst.expected +++ b/tests/error-messages/Coercions.fst.expected @@ -1,16 +1,23 @@ >> Got issues: [ * Error 34 at Coercions.fst(6,38-6,39): - - Computed type "Prims.int" and effect "GTot" is not compatible with the annotated type "Prims.int" effect "Tot" + - Computed type Prims.int + and effect GTot + is not compatible with the annotated type Prims.int + and effect Tot >>] >> Got issues: [ * Error 34 at Coercions.fst(19,37-19,38): - - Computed type "'a" and effect "GTot" is not compatible with the annotated type "'a" effect "Tot" + - Computed type 'a + and effect GTot + is not compatible with the annotated type 'a + and effect Tot >>] >> Got issues: [ * Error 19 at Coercions.fst(71,4-71,8): - - Subtyping check failed; expected type Prims.nat; got type Prims.int + - Subtyping check failed + - Expected type Prims.nat got type Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(659,18-659,24) @@ -18,7 +25,8 @@ >>] >> Got issues: [ * Error 19 at Coercions.fst(74,49-74,57): - - Subtyping check failed; expected type Prims.nat; got type Prims.int + - Subtyping check failed + - Expected type Prims.nat got type Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(659,18-659,24) @@ -26,7 +34,8 @@ >>] >> Got issues: [ * Error 19 at Coercions.fst(76,55-76,56): - - Subtyping check failed; expected type Prims.nat; got type Prims.int + - Subtyping check failed + - Expected type Prims.nat got type Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(659,18-659,24) @@ -34,7 +43,8 @@ >>] >> Got issues: [ * Error 19 at Coercions.fst(78,50-78,51): - - Subtyping check failed; expected type Prims.nat; got type Prims.int + - Subtyping check failed + - Expected type Prims.nat got type Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(659,18-659,24) @@ -42,7 +52,8 @@ >>] >> Got issues: [ * Error 19 at Coercions.fst(80,51-80,52): - - Subtyping check failed; expected type Prims.nat; got type Prims.int + - Subtyping check failed + - Expected type Prims.nat got type Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(659,18-659,24) diff --git a/tests/error-messages/DecreasesTypeWarning.fst b/tests/error-messages/DecreasesTypeWarning.fst new file mode 100644 index 00000000000..2b7e09286f9 --- /dev/null +++ b/tests/error-messages/DecreasesTypeWarning.fst @@ -0,0 +1,8 @@ +module DecreasesTypeWarning + +let rec f (x:nat) () : string = + if x = 0 then "" else f (x - 1) () +and g (xs:list nat) () : string = + match xs with + | [] -> "" + | x::xs -> f x () ^ g xs () diff --git a/tests/error-messages/DecreasesTypeWarning.fst.expected b/tests/error-messages/DecreasesTypeWarning.fst.expected new file mode 100644 index 00000000000..59780f51f72 --- /dev/null +++ b/tests/error-messages/DecreasesTypeWarning.fst.expected @@ -0,0 +1,22 @@ +* Warning 290 at DecreasesTypeWarning.fst(3,11-3,12): + - In the decreases clause for this function, the SMT solver may not be able to + prove that the types of + x (bound in DecreasesTypeWarning.fst(3,11-3,12)) + and xs (bound in DecreasesTypeWarning.fst(5,7-5,9)) + are equal. + - The type of the first term is: Prims.nat + - The type of the second term is: Prims.list Prims.nat + - If the proof fails, try annotating these with the same type. + +* Warning 290 at DecreasesTypeWarning.fst(5,7-5,9): + - In the decreases clause for this function, the SMT solver may not be able to + prove that the types of + xs (bound in DecreasesTypeWarning.fst(5,7-5,9)) + and x (bound in DecreasesTypeWarning.fst(3,11-3,12)) + are equal. + - The type of the first term is: Prims.list Prims.nat + - The type of the second term is: Prims.nat + - If the proof fails, try annotating these with the same type. + +Verified module: DecreasesTypeWarning +All verification conditions discharged successfully diff --git a/tests/error-messages/Erasable.fst.expected b/tests/error-messages/Erasable.fst.expected index 46c3c5ad118..d6068bb7848 100644 --- a/tests/error-messages/Erasable.fst.expected +++ b/tests/error-messages/Erasable.fst.expected @@ -6,12 +6,18 @@ >>] >> Got issues: [ * Error 34 at Erasable.fst(18,2-20,15): - - Computed type "Prims.int" and effect "GHOST" is not compatible with the annotated type "Prims.int" effect "Tot" + - Computed type Prims.int + and effect GHOST + is not compatible with the annotated type Prims.int + and effect Tot >>] >> Got issues: [ * Error 34 at Erasable.fst(28,42-28,52): - - Computed type "Prims.int" and effect "GTot" is not compatible with the annotated type "Prims.int" effect "Tot" + - Computed type Prims.int + and effect GTot + is not compatible with the annotated type Prims.int + and effect Tot >>] >> Got issues: [ diff --git a/tests/error-messages/GhostImplicits.fst.expected b/tests/error-messages/GhostImplicits.fst.expected index e488d256774..b45255a2634 100644 --- a/tests/error-messages/GhostImplicits.fst.expected +++ b/tests/error-messages/GhostImplicits.fst.expected @@ -1,6 +1,9 @@ >> Got issues: [ * Error 34 at GhostImplicits.fst(25,54-25,57): - - Computed type "Prims.nat" and effect "GHOST" is not compatible with the annotated type "Prims.nat" effect "Tot" + - Computed type Prims.nat + and effect GHOST + is not compatible with the annotated type Prims.nat + and effect Tot >>] Verified module: GhostImplicits diff --git a/tests/error-messages/Inference.fst.expected b/tests/error-messages/Inference.fst.expected index 90ad5402cb0..397a012e95d 100644 --- a/tests/error-messages/Inference.fst.expected +++ b/tests/error-messages/Inference.fst.expected @@ -1,12 +1,14 @@ >> Got issues: [ * Error 19 at Inference.fst(20,14-20,15): - - Subtyping check failed; expected type Prims.eqtype; got type Type0 + - Subtyping check failed + - Expected type Prims.eqtype got type Type0 - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(52,23-52,30) * Error 19 at Inference.fst(20,14-20,15): - - Subtyping check failed; expected type Prims.eqtype; got type Type0 + - Subtyping check failed + - Expected type Prims.eqtype got type Type0 - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(52,23-52,30) diff --git a/tests/error-messages/Makefile b/tests/error-messages/Makefile index 81db0989c74..325ea1fc27e 100644 --- a/tests/error-messages/Makefile +++ b/tests/error-messages/Makefile @@ -21,8 +21,12 @@ OTHERFLAGS := $(filter-out --hint_info, $(OTHERFLAGS)) check-all: $(addsuffix .check, $(FSTAR_FILES)) all: check-all +# For these tests, we check that the resugared output +# matches the expected file. Bug1997.fst.output: OTHERFLAGS+=--dump_module Bug1997 Bug2820.fst.output: OTHERFLAGS+=--dump_module Bug2820 +Bug3227.fst.output: OTHERFLAGS+=--dump_module Bug3227 +Bug3292.fst.output: OTHERFLAGS+=--dump_module Bug3292 CalcImpl.fst.output: OTHERFLAGS+=--dump_module CalcImpl include $(FSTAR_HOME)/examples/Makefile.common diff --git a/tests/error-messages/NegativeTests.BST.fst.expected b/tests/error-messages/NegativeTests.BST.fst.expected index 1ef5ca9a56c..64915039088 100644 --- a/tests/error-messages/NegativeTests.BST.fst.expected +++ b/tests/error-messages/NegativeTests.BST.fst.expected @@ -1,8 +1,12 @@ >> Got issues: [ * Error 19 at NegativeTests.BST.fst(37,38-37,42): - - Subtyping check failed; expected type right: - FStar.Pervasives.Native.option (tree 2) - {0 <= 1 /\ 1 <= 2 /\ None? right == (1 = 2) /\ None? FStar.Pervasives.Native.None == (1 = 0)}; got type FStar.Pervasives.Native.option (tree 2) + - Subtyping check failed + - Expected type + right: + FStar.Pervasives.Native.option (tree 2) + { 0 <= 1 /\ 1 <= 2 /\ None? right == (1 = 2) /\ + None? FStar.Pervasives.Native.None == (1 = 0) } + got type FStar.Pervasives.Native.option (tree 2) - The SMT solver could not prove the query. Use --query_stats for more details. - See also NegativeTests.BST.fst(27,36-27,58) @@ -10,10 +14,13 @@ >>] >> Got issues: [ * Error 19 at NegativeTests.BST.fst(40,61-40,65): - - Subtyping check failed; expected type right: - FStar.Pervasives.Native.option (tree (l + 1)) - { l <= l /\ l <= l + 1 /\ None? right == (l = l + 1) /\ - None? (FStar.Pervasives.Native.Some t) == (l = l) }; got type FStar.Pervasives.Native.option (tree (l + 1)) + - Subtyping check failed + - Expected type + right: + FStar.Pervasives.Native.option (tree (l + 1)) + { l <= l /\ l <= l + 1 /\ None? right == (l = l + 1) /\ + None? (FStar.Pervasives.Native.Some t) == (l = l) } + got type FStar.Pervasives.Native.option (tree (l + 1)) - The SMT solver could not prove the query. Use --query_stats for more details. - See also NegativeTests.BST.fst(27,36-27,58) @@ -21,10 +28,13 @@ >>] >> Got issues: [ * Error 19 at NegativeTests.BST.fst(43,78-43,87): - - Subtyping check failed; expected type right: - FStar.Pervasives.Native.option (tree (l + 1)) - { l <= l + 1 /\ l + 1 <= l + 1 /\ None? right == (l + 1 = l + 1) /\ - None? (FStar.Pervasives.Native.Some t1) == (l + 1 = l) }; got type FStar.Pervasives.Native.option (tree (l + 1)) + - Subtyping check failed + - Expected type + right: + FStar.Pervasives.Native.option (tree (l + 1)) + { l <= l + 1 /\ l + 1 <= l + 1 /\ None? right == (l + 1 = l + 1) /\ + None? (FStar.Pervasives.Native.Some t1) == (l + 1 = l) } + got type FStar.Pervasives.Native.option (tree (l + 1)) - The SMT solver could not prove the query. Use --query_stats for more details. - See also NegativeTests.BST.fst(27,36-27,58) diff --git a/tests/error-messages/NegativeTests.Bug260.fst.expected b/tests/error-messages/NegativeTests.Bug260.fst.expected index 1a052c517e1..fcc0b4cd296 100644 --- a/tests/error-messages/NegativeTests.Bug260.fst.expected +++ b/tests/error-messages/NegativeTests.Bug260.fst.expected @@ -1,6 +1,7 @@ >> Got issues: [ * Error 19 at NegativeTests.Bug260.fst(26,12-26,19): - - Subtyping check failed; expected type validity (S (S t)); got type validity (S t) + - Subtyping check failed + - Expected type validity (S (S t)) got type validity (S t) - The SMT solver could not prove the query. Use --query_stats for more details. - See also NegativeTests.Bug260.fst(23,37-26,9) diff --git a/tests/error-messages/NegativeTests.False.fst.expected b/tests/error-messages/NegativeTests.False.fst.expected index bb4d5d495cc..6f09d79b7c1 100644 --- a/tests/error-messages/NegativeTests.False.fst.expected +++ b/tests/error-messages/NegativeTests.False.fst.expected @@ -8,10 +8,14 @@ >>] >> Got issues: [ * Error 12 at NegativeTests.False.fst(30,18-30,41): - - Expected type "Prims.l_True \/ Prims.l_True"; but "Prims.Left Prims.T" has type "Prims.sum (*?u1*) _ Prims.l_True" + - Expected type Prims.l_True \/ Prims.l_True + but Prims.Left Prims.T + has type Prims.sum (*?u1*) _ Prims.l_True * Error 12 at NegativeTests.False.fst(30,42-30,66): - - Expected type "Prims.l_True \/ Prims.l_True"; but "Prims.Right Prims.T" has type "Prims.sum Prims.l_True (*?u6*) _" + - Expected type Prims.l_True \/ Prims.l_True + but Prims.Right Prims.T + has type Prims.sum Prims.l_True (*?u6*) _ >>] * Warning 240 at NegativeTests.False.fst(21,4-21,7): diff --git a/tests/error-messages/NegativeTests.Neg.fst.expected b/tests/error-messages/NegativeTests.Neg.fst.expected index 29e31b0711a..d0795e5626f 100644 --- a/tests/error-messages/NegativeTests.Neg.fst.expected +++ b/tests/error-messages/NegativeTests.Neg.fst.expected @@ -1,6 +1,7 @@ >> Got issues: [ * Error 19 at NegativeTests.Neg.fst(20,8-20,10): - - Subtyping check failed; expected type Prims.nat; got type Prims.int + - Subtyping check failed + - Expected type Prims.nat got type Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(659,18-659,24) @@ -8,7 +9,8 @@ >>] >> Got issues: [ * Error 19 at NegativeTests.Neg.fst(24,8-24,10): - - Subtyping check failed; expected type Prims.nat; got type Prims.int + - Subtyping check failed + - Expected type Prims.nat got type Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(659,18-659,24) @@ -46,7 +48,9 @@ >>] >> Got issues: [ * Error 19 at NegativeTests.Neg.fst(46,30-46,31): - - Subtyping check failed; expected type _: FStar.Pervasives.Native.option 'a {Some? _}; got type FStar.Pervasives.Native.option 'a + - Subtyping check failed + - Expected type _: FStar.Pervasives.Native.option 'a {Some? _} + got type FStar.Pervasives.Native.option 'a - The SMT solver could not prove the query. Use --query_stats for more details. - See also FStar.Pervasives.Native.fst(33,4-33,8) @@ -54,7 +58,9 @@ >>] >> Got issues: [ * Error 19 at NegativeTests.Neg.fst(50,45-50,47): - - Subtyping check failed; expected type _: FStar.Pervasives.result Prims.int {V? _}; got type FStar.Pervasives.result Prims.int + - Subtyping check failed + - Expected type _: FStar.Pervasives.result Prims.int {V? _} + got type FStar.Pervasives.result Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also FStar.Pervasives.fsti(519,4-519,5) @@ -62,7 +68,8 @@ >>] >> Got issues: [ * Error 19 at NegativeTests.Neg.fst(55,25-55,26): - - Subtyping check failed; expected type Prims.nat; got type Prims.int + - Subtyping check failed + - Expected type Prims.nat got type Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(659,18-659,24) diff --git a/tests/error-messages/NegativeTests.ShortCircuiting.fst.expected b/tests/error-messages/NegativeTests.ShortCircuiting.fst.expected index 41dccb71c77..5b635f71949 100644 --- a/tests/error-messages/NegativeTests.ShortCircuiting.fst.expected +++ b/tests/error-messages/NegativeTests.ShortCircuiting.fst.expected @@ -1,6 +1,7 @@ >> Got issues: [ * Error 19 at NegativeTests.ShortCircuiting.fst(21,16-21,33): - - Subtyping check failed; expected type b: Prims.bool{bad_p b}; got type Prims.bool + - Subtyping check failed + - Expected type b: Prims.bool{bad_p b} got type Prims.bool - The SMT solver could not prove the query. Use --query_stats for more details. - See also NegativeTests.ShortCircuiting.fst(19,31-19,38) diff --git a/tests/error-messages/NegativeTests.ZZImplicitFalse.fst b/tests/error-messages/NegativeTests.ZZImplicitFalse.fst index 6ae82c4e5f5..fafa14e9a8a 100644 --- a/tests/error-messages/NegativeTests.ZZImplicitFalse.fst +++ b/tests/error-messages/NegativeTests.ZZImplicitFalse.fst @@ -15,6 +15,6 @@ *) module NegativeTests.ZZImplicitFalse -val wtf: unit -> Lemma False -[@@ expect_failure] // error 19 (assertion failed) on 1-phase, error 66 (failed to resolve impl) on 2-phase -let wtf _ = let _:False = _ in () +val test : unit -> Lemma False +[@@expect_failure [19]] +let test _ = let _:False = _ in () diff --git a/tests/error-messages/NegativeTests.ZZImplicitFalse.fst.expected b/tests/error-messages/NegativeTests.ZZImplicitFalse.fst.expected index 403572a03fb..0d67288c4b1 100644 --- a/tests/error-messages/NegativeTests.ZZImplicitFalse.fst.expected +++ b/tests/error-messages/NegativeTests.ZZImplicitFalse.fst.expected @@ -1,14 +1,14 @@ >> Got issues: [ -* Error 66 at NegativeTests.ZZImplicitFalse.fst(20,26-20,27): - - Failed to resolve implicit argument ?1 - of type Prims.l_False - introduced for - user-provided implicit term at - NegativeTests.ZZImplicitFalse.fst(20,26-20,27) +* Error 19 at NegativeTests.ZZImplicitFalse.fst(20,27-20,28): + - Subtyping check failed + - Expected type Prims.l_False got type Prims.unit + - The SMT solver could not prove the query. Use --query_stats for more + details. + - See also prims.fst(138,29-138,34) >>] -* Warning 240 at NegativeTests.ZZImplicitFalse.fst(18,4-18,7): - - NegativeTests.ZZImplicitFalse.wtf is declared but no definition was found +* Warning 240 at NegativeTests.ZZImplicitFalse.fst(18,4-18,8): + - NegativeTests.ZZImplicitFalse.test is declared but no definition was found - Add an 'assume' if this is intentional Verified module: NegativeTests.ZZImplicitFalse diff --git a/tests/error-messages/PatAnnot.fst.expected b/tests/error-messages/PatAnnot.fst.expected index b4f19cac357..1f8012c1479 100644 --- a/tests/error-messages/PatAnnot.fst.expected +++ b/tests/error-messages/PatAnnot.fst.expected @@ -1,6 +1,7 @@ >> Got issues: [ * Error 19 at PatAnnot.fst(25,8-25,9): - - Subtyping check failed; expected type Prims.squash Prims.l_False; got type Prims.unit + - Subtyping check failed + - Expected type Prims.squash Prims.l_False got type Prims.unit - The SMT solver could not prove the query. Use --query_stats for more details. - See also PatAnnot.fst(25,19-25,24) @@ -24,7 +25,8 @@ >>] >> Got issues: [ * Error 19 at PatAnnot.fst(39,10-39,12): - - Subtyping check failed; expected type Prims.squash Prims.l_False; got type Prims.unit + - Subtyping check failed + - Expected type Prims.squash Prims.l_False got type Prims.unit - The SMT solver could not prove the query. Use --query_stats for more details. - See also PatAnnot.fst(40,26-40,31) @@ -32,7 +34,8 @@ >>] >> Got issues: [ * Error 19 at PatAnnot.fst(46,10-46,11): - - Subtyping check failed; expected type Prims.nat; got type Prims.int + - Subtyping check failed + - Expected type Prims.nat got type Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(659,18-659,24) diff --git a/tests/error-messages/PatternMatch.fst.expected b/tests/error-messages/PatternMatch.fst.expected index 29b451c8993..1fa2a510311 100644 --- a/tests/error-messages/PatternMatch.fst.expected +++ b/tests/error-messages/PatternMatch.fst.expected @@ -1,4 +1,19 @@ >> Got issues: [ +* Error 178 at PatternMatch.fst(15,27-15,34): + - Type ascriptions within patterns are only allowed on variables + +>>] +>> Got issues: [ +* Error 178 at PatternMatch.fst(18,29-18,48): + - Type ascriptions within patterns are only allowed on variables + +>>] +>> Got issues: [ +* Error 178 at PatternMatch.fst(41,3-41,24): + - Type ascriptions within patterns are only allowed on variables + +>>] +>> Got issues: [ * Error 19: - Patterns are incomplete - The SMT solver could not prove the query. Use --query_stats for more @@ -29,8 +44,7 @@ >>] >> Got issues: [ * Error 114 at PatternMatch.fst(35,4-35,5): - - Type of pattern (PatternMatch.ab) does not match type of scrutinee - (Prims.int) + - Type of pattern PatternMatch.ab does not match type of scrutinee Prims.int - Head mismatch PatternMatch.ab vs Prims.int >>] diff --git a/tests/error-messages/QuickTestNBE.fst b/tests/error-messages/QuickTestNBE.fst index c2c94cb687c..b47a932fe93 100755 --- a/tests/error-messages/QuickTestNBE.fst +++ b/tests/error-messages/QuickTestNBE.fst @@ -127,7 +127,7 @@ let va_qcode_Test2 : (quickCode unit) = ) #push-options "--print_expected_failures" -//#push-options "--debug QuickTestNBE --debug_level SMTQuery --ugly --print_implicits" +//#push-options "--debug SMTQuery --ugly --print_implicits" [@@expect_failure [19]] let va_lemma_Test2 (va_s0:vale_state) = wp_sound_code_norm diff --git a/tests/error-messages/SMTPatSymbols.fst b/tests/error-messages/SMTPatSymbols.fst new file mode 100644 index 00000000000..b7bf9f001a7 --- /dev/null +++ b/tests/error-messages/SMTPatSymbols.fst @@ -0,0 +1,4 @@ +module SMTPatSymbols + +val lem (x:int) : Lemma (x > x-1) [SMTPat (x-1 + 1)] +let lem (x:int) : Lemma (x > x-1) [SMTPat (x-1)] = () diff --git a/tests/error-messages/SMTPatSymbols.fst.expected b/tests/error-messages/SMTPatSymbols.fst.expected new file mode 100644 index 00000000000..dc55da4985d --- /dev/null +++ b/tests/error-messages/SMTPatSymbols.fst.expected @@ -0,0 +1,7 @@ +* Warning 271 at SMTPatSymbols.fst(3,34-3,52): + - Pattern uses these theory symbols or terms that should not be in an SMT + pattern: + Prims.op_Addition, Prims.op_Subtraction + +Verified module: SMTPatSymbols +All verification conditions discharged successfully diff --git a/tests/error-messages/Test.FunctionalExtensionality.fst.expected b/tests/error-messages/Test.FunctionalExtensionality.fst.expected index e9ec96e0ab5..fe6acd56d3c 100644 --- a/tests/error-messages/Test.FunctionalExtensionality.fst.expected +++ b/tests/error-messages/Test.FunctionalExtensionality.fst.expected @@ -1,6 +1,7 @@ >> Got issues: [ * Error 19 at Test.FunctionalExtensionality.fst(36,49-36,50): - - Subtyping check failed; expected type Prims.nat ^-> Prims.int; got type Prims.int ^-> Prims.int + - Subtyping check failed + - Expected type Prims.nat ^-> Prims.int got type Prims.int ^-> Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also FStar.FunctionalExtensionality.fsti(102,60-102,77) @@ -16,7 +17,8 @@ >>] >> Got issues: [ * Error 19 at Test.FunctionalExtensionality.fst(92,36-92,47): - - Subtyping check failed; expected type _: Prims.int -> Prims.int; got type Prims.nat ^-> Prims.int + - Subtyping check failed + - Expected type _: Prims.int -> Prims.int got type Prims.nat ^-> Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(659,18-659,24) @@ -24,7 +26,8 @@ >>] >> Got issues: [ * Error 19 at Test.FunctionalExtensionality.fst(142,57-142,58): - - Subtyping check failed; expected type Prims.int ^-> Prims.int; got type Prims.int ^-> Prims.nat + - Subtyping check failed + - Expected type Prims.int ^-> Prims.int got type Prims.int ^-> Prims.nat - The SMT solver could not prove the query. Use --query_stats for more details. - See also FStar.FunctionalExtensionality.fsti(102,60-102,77) diff --git a/tests/error-messages/TestErrorLocations.fst.expected b/tests/error-messages/TestErrorLocations.fst.expected index f8145bd0165..055a9d33019 100644 --- a/tests/error-messages/TestErrorLocations.fst.expected +++ b/tests/error-messages/TestErrorLocations.fst.expected @@ -30,7 +30,8 @@ >>] >> Got issues: [ * Error 19 at TestErrorLocations.fst(43,20-43,21): - - Subtyping check failed; expected type Prims.nat; got type Prims.int + - Subtyping check failed + - Expected type Prims.nat got type Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(659,18-659,24) @@ -62,7 +63,8 @@ >>] >> Got issues: [ * Error 19 at TestErrorLocations.fst(66,27-66,28): - - Subtyping check failed; expected type Prims.nat; got type Prims.int + - Subtyping check failed + - Expected type Prims.nat got type Prims.int - The SMT solver could not prove the query. Use --query_stats for more details. - See also prims.fst(659,18-659,24) @@ -70,7 +72,8 @@ >>] >> Got issues: [ * Error 19 at TestErrorLocations.fst(70,25-70,34): - - Subtyping check failed; expected type Type0; got type Type0 + - Subtyping check failed + - Expected type Type0 got type Type0 - The SMT solver could not prove the query. Use --query_stats for more details. - See also TestErrorLocations.fst(68,52-68,66) @@ -78,7 +81,9 @@ >>] >> Got issues: [ * Error 19 at TestErrorLocations.fst(89,20-89,36): - - Subtyping check failed; expected type Prims.squash (exists (x: Prims.nat). x = 0); got type Prims.unit + - Subtyping check failed + - Expected type Prims.squash (exists (x: Prims.nat). x = 0) + got type Prims.unit - The SMT solver could not prove the query. Use --query_stats for more details. - See also FStar.Classical.Sugar.fsti(66,22-66,41) @@ -86,14 +91,17 @@ >>] >> Got issues: [ * Error 19 at TestErrorLocations.fst(97,28-97,33): - - Subtyping check failed; expected type Prims.squash (forall (x: Prims.nat). x = 0); got type Prims.unit + - Subtyping check failed + - Expected type Prims.squash (forall (x: Prims.nat). x = 0) + got type Prims.unit - The SMT solver could not prove the query. Use --query_stats for more details. >>] >> Got issues: [ * Error 19 at TestErrorLocations.fst(102,12-102,13): - - Subtyping check failed; expected type Prims.squash (p /\ q); got type Prims.unit + - Subtyping check failed + - Expected type Prims.squash (p /\ q) got type Prims.unit - The SMT solver could not prove the query. Use --query_stats for more details. - See also TestErrorLocations.fst(101,19-101,20) @@ -101,7 +109,8 @@ >>] >> Got issues: [ * Error 19 at TestErrorLocations.fst(108,17-108,18): - - Subtyping check failed; expected type Prims.squash (p /\ q); got type Prims.unit + - Subtyping check failed + - Expected type Prims.squash (p /\ q) got type Prims.unit - The SMT solver could not prove the query. Use --query_stats for more details. - See also TestErrorLocations.fst(107,21-107,22) @@ -109,7 +118,8 @@ >>] >> Got issues: [ * Error 19 at TestErrorLocations.fst(114,12-114,18): - - Subtyping check failed; expected type Prims.squash (p \/ q); got type Prims.unit + - Subtyping check failed + - Expected type Prims.squash (p \/ q) got type Prims.unit - The SMT solver could not prove the query. Use --query_stats for more details. - See also FStar.Classical.Sugar.fsti(88,21-88,31) diff --git a/tests/error-messages/TestHasEq.fst.expected b/tests/error-messages/TestHasEq.fst.expected index 18365287095..5a272c71d6b 100644 --- a/tests/error-messages/TestHasEq.fst.expected +++ b/tests/error-messages/TestHasEq.fst.expected @@ -1,6 +1,9 @@ >> Got issues: [ * Error 19 at TestHasEq.fst(58,10-58,11): - - Failed to prove that the type 'TestHasEq.t3' supports decidable equality because of this argument; add either the 'noeq' or 'unopteq' qualifier + - Failed to prove that the type + 'TestHasEq.t3' + supports decidable equality because of this argument. + - Add either the 'noeq' or 'unopteq' qualifier - The SMT solver could not prove the query. Use --query_stats for more details. - See also TestHasEq.fst(57,0-58,19) @@ -8,7 +11,8 @@ >>] >> Got issues: [ * Error 19 at TestHasEq.fst(84,10-84,70): - - Subtyping check failed; expected type Prims.eqtype; got type Type0 + - Subtyping check failed + - Expected type Prims.eqtype got type Type0 - The SMT solver could not prove the query. Use --query_stats for more details. - See also TestHasEq.fst(84,12-84,22) diff --git a/tests/error-messages/UnboundOp.fst b/tests/error-messages/UnboundOp.fst new file mode 100644 index 00000000000..119c4218ea4 --- /dev/null +++ b/tests/error-messages/UnboundOp.fst @@ -0,0 +1,4 @@ +module UnboundOp + +[@@expect_failure] +let x = 1 ^%^ 2 diff --git a/tests/error-messages/UnboundOp.fst.expected b/tests/error-messages/UnboundOp.fst.expected new file mode 100644 index 00000000000..3c0f01aad45 --- /dev/null +++ b/tests/error-messages/UnboundOp.fst.expected @@ -0,0 +1,7 @@ +>> Got issues: [ +* Error 180 at UnboundOp.fst(4,10-4,13): + - Unexpected or unbound operator: ^%^ + +>>] +Verified module: UnboundOp +All verification conditions discharged successfully diff --git a/tests/hacl/HaclTests.fst.config.json b/tests/hacl/HaclTests.fst.config.json new file mode 100644 index 00000000000..6d6e73162ba --- /dev/null +++ b/tests/hacl/HaclTests.fst.config.json @@ -0,0 +1,7 @@ +{ + "fstar_exe": "fstar.exe", + "options": [ + ], + "include_dirs": [ + ] +} diff --git a/tests/hacl/Lib.IntTypes.fsti b/tests/hacl/Lib.IntTypes.fsti new file mode 100644 index 00000000000..6c7e3370f24 --- /dev/null +++ b/tests/hacl/Lib.IntTypes.fsti @@ -0,0 +1,988 @@ +module Lib.IntTypes + +open FStar.Mul + +#push-options "--max_fuel 0 --max_ifuel 1 --z3rlimit 20" + +// Other instances frollow from `FStar.UInt.pow2_values` which is in +// scope of every module depending on Lib.IntTypes +val pow2_2: n:nat -> Lemma (pow2 2 = 4) [SMTPat (pow2 n)] +val pow2_3: n:nat -> Lemma (pow2 3 = 8) [SMTPat (pow2 n)] +val pow2_4: n:nat -> Lemma (pow2 4 = 16) [SMTPat (pow2 n)] +val pow2_127: n:nat -> Lemma (pow2 127 = 0x80000000000000000000000000000000) [SMTPat (pow2 n)] + +/// +/// Definition of machine integer base types +/// + +type inttype = + | U1 | U8 | U16 | U32 | U64 | U128 | S8 | S16 | S32 | S64 | S128 + +[@(strict_on_arguments [0])] +unfold +inline_for_extraction +let unsigned = function + | U1 | U8 | U16 | U32 | U64 | U128 -> true + | _ -> false + +[@(strict_on_arguments [0])] +unfold +inline_for_extraction +let signed = function + | S8 | S16 | S32 | S64 | S128 -> true + | _ -> false + +/// +/// Operations on the underlying machine integer base types +/// + +[@(strict_on_arguments [0])] +unfold +inline_for_extraction +let numbytes = function + | U1 -> 1 + | U8 -> 1 + | S8 -> 1 + | U16 -> 2 + | S16 -> 2 + | U32 -> 4 + | S32 -> 4 + | U64 -> 8 + | S64 -> 8 + | U128 -> 16 + | S128 -> 16 + +[@(strict_on_arguments [0])] +unfold +inline_for_extraction +let bits = function + | U1 -> 1 + | U8 -> 8 + | S8 -> 8 + | U16 -> 16 + | S16 -> 16 + | U32 -> 32 + | S32 -> 32 + | U64 -> 64 + | S64 -> 64 + | U128 -> 128 + | S128 -> 128 + +val bits_numbytes: t:inttype{~(U1? t)} -> Lemma (bits t == 8 * numbytes t) +// [SMTPat [bits t; numbytes t]] + +unfold +let modulus (t:inttype) = pow2 (bits t) + +[@(strict_on_arguments [0])] +unfold +let maxint (t:inttype) = + if unsigned t then pow2 (bits t) - 1 else pow2 (bits t - 1) - 1 + +[@(strict_on_arguments [0])] +unfold +let minint (t:inttype) = + if unsigned t then 0 else -(pow2 (bits t - 1)) + +let range (n:int) (t:inttype) : Type0 = + minint t <= n /\ n <= maxint t + +unfold +type range_t (t:inttype) = x:int{range x t} + +/// +/// PUBLIC Machine Integers +/// + +inline_for_extraction +let pub_int_t = function + | U1 -> n:UInt8.t{UInt8.v n < 2} + | U8 -> UInt8.t + | U16 -> UInt16.t + | U32 -> UInt32.t + | U64 -> UInt64.t + | U128 -> UInt128.t + | S8 -> Int8.t + | S16 -> Int16.t + | S32 -> Int32.t + | S64 -> Int64.t + | S128 -> Int128.t + + +[@(strict_on_arguments [0])] +unfold +let pub_int_v #t (x:pub_int_t t) : range_t t = + match t with + | U1 -> UInt8.v x + | U8 -> UInt8.v x + | U16 -> UInt16.v x + | U32 -> UInt32.v x + | U64 -> UInt64.v x + | U128 -> UInt128.v x + | S8 -> Int8.v x + | S16 -> Int16.v x + | S32 -> Int32.v x + | S64 -> Int64.v x + | S128 -> Int128.v x + +/// +/// SECRET Machine Integers +/// + +type secrecy_level = + | SEC + | PUB + +inline_for_extraction +val sec_int_t: inttype -> Type0 + +val sec_int_v: #t:inttype -> sec_int_t t -> range_t t + +/// +/// GENERIC Machine Integers +/// + +inline_for_extraction +let int_t (t:inttype) (l:secrecy_level) = + match l with + | PUB -> pub_int_t t + | SEC -> sec_int_t t + +[@(strict_on_arguments [1])] +let v #t #l (u:int_t t l) : range_t t = + match l with + | PUB -> pub_int_v #t u + | SEC -> sec_int_v #t u + +unfold +let uint_t (t:inttype{unsigned t}) (l:secrecy_level) = int_t t l + +unfold +let sint_t (t:inttype{signed t}) (l:secrecy_level) = int_t t l + +unfold +let uint_v #t #l (u:uint_t t l) = v u + +unfold +let sint_v #t #l (u:sint_t t l) = v u + +unfold +type uint1 = uint_t U1 SEC + +unfold +type uint8 = uint_t U8 SEC + +unfold +type int8 = sint_t S8 SEC + +unfold +type uint16 = uint_t U16 SEC + +unfold +type int16 = sint_t S16 SEC + +unfold +type uint32 = uint_t U32 SEC + +unfold +type int32 = sint_t S32 SEC + +unfold +type uint64 = uint_t U64 SEC + +unfold +type int64 = sint_t S64 SEC + +unfold +type uint128 = uint_t U128 SEC + +unfold +type int128 = sint_t S128 SEC + +unfold +type bit_t = uint_t U1 PUB + +unfold +type byte_t = uint_t U8 PUB + +unfold +type size_t = uint_t U32 PUB + +// 2019.7.19: Used only by experimental Blake2b; remove? +unfold +type size128_t = uint_t U128 PUB + +unfold +type pub_uint8 = uint_t U8 PUB + +unfold +type pub_int8 = sint_t S8 PUB + +unfold +type pub_uint16 = uint_t U16 PUB + +unfold +type pub_int16 = sint_t S16 PUB + +unfold +type pub_uint32 = uint_t U32 PUB + +unfold +type pub_int32 = sint_t S32 PUB + +unfold +type pub_uint64 = uint_t U64 PUB + +unfold +type pub_int64 = sint_t S64 PUB + +unfold +type pub_uint128 = uint_t U128 PUB + +unfold +type pub_int128 = sint_t S128 PUB + +/// +/// Casts between mathematical and machine integers +/// + +inline_for_extraction +val secret: #t:inttype -> x:int_t t PUB -> y:int_t t SEC{v x == v y} + +[@(strict_on_arguments [0])] +inline_for_extraction +val mk_int: #t:inttype -> #l:secrecy_level -> n:range_t t -> u:int_t t l{v u == n} + +unfold +let uint (#t:inttype{unsigned t}) (#l:secrecy_level) (n:range_t t) = mk_int #t #l n + +unfold +let sint (#t:inttype{signed t}) (#l:secrecy_level) (n:range_t t) = mk_int #t #l n + +val v_injective: #t:inttype -> #l:secrecy_level -> a:int_t t l -> Lemma + (mk_int (v #t #l a) == a) + [SMTPat (v #t #l a)] + +val v_mk_int: #t:inttype -> #l:secrecy_level -> n:range_t t -> Lemma + (v #t #l (mk_int #t #l n) == n) + [SMTPat (v #t #l (mk_int #t #l n))] + +unfold +let u1 (n:range_t U1) : u:uint1{v u == n} = uint #U1 #SEC n + +unfold +let u8 (n:range_t U8) : u:uint8{v u == n} = uint #U8 #SEC n + +unfold +let i8 (n:range_t S8) : u:int8{v u == n} = sint #S8 #SEC n + +unfold +let u16 (n:range_t U16) : u:uint16{v u == n} = uint #U16 #SEC n + +unfold +let i16 (n:range_t S16) : u:int16{v u == n} = sint #S16 #SEC n + +unfold +let u32 (n:range_t U32) : u:uint32{v u == n} = uint #U32 #SEC n + +unfold +let i32 (n:range_t S32) : u:int32{v u == n} = sint #S32 #SEC n + +unfold +let u64 (n:range_t U64) : u:uint64{v u == n} = uint #U64 #SEC n + +unfold +let i64 (n:range_t S64) : u:int64{v u == n} = sint #S64 #SEC n + +(* We only support 64-bit literals, hence the unexpected upper limit *) +inline_for_extraction +val u128: n:range_t U64 -> u:uint128{v #U128 u == n} + +inline_for_extraction +val i128 (n:range_t S64) : u:int128{v #S128 u == n} + +unfold +let max_size_t = maxint U32 + +unfold +type size_nat = n:nat{n <= max_size_t} + +unfold +type size_pos = n:pos{n <= max_size_t} + +unfold +let size (n:size_nat) : size_t = uint #U32 #PUB n + +unfold +let size_v (s:size_t) = v s + +unfold +let byte (n:nat{n < 256}) : b:byte_t{v b == n} = uint #U8 #PUB n + +unfold +let byte_v (s:byte_t) : n:size_nat{v s == n} = v s + +inline_for_extraction +val size_to_uint32: s:size_t -> u:uint32{u == u32 (v s)} + +inline_for_extraction +val size_to_uint64: s:size_t -> u:uint64{u == u64 (v s)} + +inline_for_extraction +val byte_to_uint8: s:byte_t -> u:uint8{u == u8 (v s)} + +[@(strict_on_arguments [0])] +inline_for_extraction +let op_At_Percent_Dot x t = + if unsigned t then x % modulus t + else FStar.Int.(x @% modulus t) + +// Casting a value to a signed type is implementation-defined when the value can't +// be represented in the new type; e.g. (int8_t)128UL is implementation-defined +// We rule out this case in the type of `u1` +// See 6.3.1.3 in http://www.open-std.org/jtc1/sc22/wg14/www/docs/n1548.pdf +[@(strict_on_arguments [0;2])] +inline_for_extraction +val cast: #t:inttype -> #l:secrecy_level + -> t':inttype + -> l':secrecy_level{PUB? l \/ SEC? l'} + -> u1:int_t t l{unsigned t' \/ range (v u1) t'} + -> u2:int_t t' l'{v u2 == v u1 @%. t'} + +[@(strict_on_arguments [0])] +unfold +let to_u1 #t #l u : uint1 = cast #t #l U1 SEC u + +[@(strict_on_arguments [0])] +unfold +let to_u8 #t #l u : uint8 = cast #t #l U8 SEC u + +[@(strict_on_arguments [0])] +unfold +let to_i8 #t #l u : int8 = cast #t #l S8 SEC u + +[@(strict_on_arguments [0])] +unfold +let to_u16 #t #l u : uint16 = cast #t #l U16 SEC u + +[@(strict_on_arguments [0])] +unfold +let to_i16 #t #l u : int16 = cast #t #l S16 SEC u + +[@(strict_on_arguments [0])] +unfold +let to_u32 #t #l u : uint32 = cast #t #l U32 SEC u + +[@(strict_on_arguments [0])] +unfold +let to_i32 #t #l u : int32 = cast #t #l S32 SEC u + +[@(strict_on_arguments [0])] +unfold +let to_u64 #t #l u : uint64 = cast #t #l U64 SEC u + +[@(strict_on_arguments [0])] +unfold +let to_i64 #t #l u : int64 = cast #t #l S64 SEC u + +[@(strict_on_arguments [0])] +unfold +let to_u128 #t #l u : uint128 = cast #t #l U128 SEC u + +[@(strict_on_arguments [0])] +unfold +let to_i128 #t #l u : int128 = cast #t #l S128 SEC u + +/// +/// Bitwise operators for all machine integers +/// + +[@(strict_on_arguments [0])] +inline_for_extraction +let ones_v (t:inttype) = + match t with + | U1 | U8 | U16 | U32 | U64 | U128 -> maxint t + | S8 | S16 | S32 | S64 | S128 -> -1 + +[@(strict_on_arguments [0])] +inline_for_extraction +val ones: t:inttype -> l:secrecy_level -> n:int_t t l{v n = ones_v t} + +inline_for_extraction +val zeros: t:inttype -> l:secrecy_level -> n:int_t t l{v n = 0} + +[@(strict_on_arguments [0])] +inline_for_extraction +val add_mod: #t:inttype{unsigned t} -> #l:secrecy_level + -> int_t t l + -> int_t t l + -> int_t t l + +val add_mod_lemma: #t:inttype{unsigned t} -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l + -> Lemma + (v (add_mod a b) == (v a + v b) @%. t) + [SMTPat (v #t #l (add_mod #t #l a b))] + +[@(strict_on_arguments [0])] +inline_for_extraction +val add: #t:inttype -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l{range (v a + v b) t} + -> int_t t l + +val add_lemma: #t:inttype -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l{range (v a + v b) t} + -> Lemma + (v #t #l (add #t #l a b) == v a + v b) + [SMTPat (v #t #l (add #t #l a b))] + +[@(strict_on_arguments [0])] +inline_for_extraction +val incr: #t:inttype -> #l:secrecy_level + -> a:int_t t l{v a < maxint t} + -> int_t t l + +val incr_lemma: #t:inttype -> #l:secrecy_level + -> a:int_t t l{v a < maxint t} + -> Lemma (v (incr a) == v a + 1) + +[@(strict_on_arguments [0])] +inline_for_extraction +val mul_mod: #t:inttype{unsigned t /\ ~(U128? t)} -> #l:secrecy_level + -> int_t t l + -> int_t t l + -> int_t t l + +val mul_mod_lemma: #t:inttype{unsigned t /\ ~(U128? t)} -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l + -> Lemma (v (mul_mod a b) == (v a * v b) @%. t) + [SMTPat (v #t #l (mul_mod #t #l a b))] + +[@(strict_on_arguments [0])] +inline_for_extraction +val mul: #t:inttype{~(U128? t) /\ ~(S128? t)} -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l{range (v a * v b) t} + -> int_t t l + +val mul_lemma: #t:inttype{~(U128? t) /\ ~(S128? t)} -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l{range (v a * v b) t} + -> Lemma (v #t #l (mul #t #l a b) == v a * v b) + [SMTPat (v #t #l (mul #t #l a b))] + +inline_for_extraction +val mul64_wide: uint64 -> uint64 -> uint128 + +val mul64_wide_lemma: a:uint64 -> b:uint64 -> Lemma + (v (mul64_wide a b) == v a * v b) + [SMTPat (v (mul64_wide a b))] +// KB: I'd prefer +// v (mul64_wide a b) = (pow2 (bits t) + v a - v b) % pow2 (bits t) + +inline_for_extraction +val mul_s64_wide: int64 -> int64 -> int128 + +val mul_s64_wide_lemma: a:int64 -> b:int64 -> Lemma + (v (mul_s64_wide a b) == v a * v b) + [SMTPat (v (mul_s64_wide a b))] + +[@(strict_on_arguments [0])] +inline_for_extraction +val sub_mod: #t:inttype{unsigned t} -> #l:secrecy_level + -> int_t t l + -> int_t t l + -> int_t t l + +val sub_mod_lemma: #t:inttype{unsigned t} -> #l:secrecy_level -> a:int_t t l -> b:int_t t l + -> Lemma (v (sub_mod a b) == (v a - v b) @%. t) + [SMTPat (v #t #l (sub_mod #t #l a b))] + +[@(strict_on_arguments [0])] +inline_for_extraction +val sub: #t:inttype -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l{range (v a - v b) t} + -> int_t t l + +val sub_lemma: #t:inttype -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l{range (v a - v b) t} + -> Lemma (v (sub a b) == v a - v b) + [SMTPat (v #t #l (sub #t #l a b))] + +[@(strict_on_arguments [0])] +inline_for_extraction +val decr: #t:inttype -> #l:secrecy_level + -> a:int_t t l{minint t < v a} + -> int_t t l + +val decr_lemma: #t:inttype -> #l:secrecy_level + -> a:int_t t l{minint t < v a} + -> Lemma (v (decr a) == v a - 1) + +[@(strict_on_arguments [0])] +inline_for_extraction +val logxor: #t:inttype -> #l:secrecy_level + -> int_t t l + -> int_t t l + -> int_t t l + +val logxor_lemma: #t:inttype -> #l:secrecy_level -> a:int_t t l -> b:int_t t l -> Lemma + (a `logxor` (a `logxor` b) == b /\ + a `logxor` (b `logxor` a) == b /\ + a `logxor` (mk_int #t #l 0) == a) + +val logxor_lemma1: #t:inttype -> #l:secrecy_level -> a:int_t t l -> b:int_t t l -> Lemma + (requires range (v a) U1 /\ range (v b) U1) + (ensures range (v (a `logxor` b)) U1) + +let logxor_v (#t:inttype) (a:range_t t) (b:range_t t) : range_t t = + match t with + | S8 | S16 | S32 | S64 | S128 -> Int.logxor #(bits t) a b + | _ -> UInt.logxor #(bits t) a b + +val logxor_spec: #t:inttype -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l + -> Lemma (v (a `logxor` b) == v a `logxor_v` v b) + +[@(strict_on_arguments [0])] +inline_for_extraction +val logand: #t:inttype -> #l:secrecy_level + -> int_t t l + -> int_t t l + -> int_t t l + +val logand_zeros: #t:inttype -> #l:secrecy_level -> a:int_t t l -> + Lemma (v (a `logand` zeros t l) == 0) + +val logand_ones: #t:inttype -> #l:secrecy_level -> a:int_t t l -> + Lemma (v (a `logand` ones t l) == v a) + +// For backwards compatibility +val logand_lemma: #t:inttype -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l + -> Lemma + (requires v a = 0 \/ v a = ones_v t) + (ensures (if v a = 0 then v (a `logand` b) == 0 else v (a `logand` b) == v b)) + +let logand_v (#t:inttype) (a:range_t t) (b:range_t t) : range_t t = + match t with + | S8 | S16 | S32 | S64 | S128 -> Int.logand #(bits t) a b + | _ -> UInt.logand #(bits t) a b + +val logand_spec: #t:inttype -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l + -> Lemma (v (a `logand` b) == v a `logand_v` v b) + //[SMTPat (v (a `logand` b))] + +val logand_le:#t:inttype{unsigned t} -> #l:secrecy_level -> a:uint_t t l -> b:uint_t t l -> + Lemma (requires True) + (ensures v (logand a b) <= v a /\ v (logand a b) <= v b) + +val logand_mask: #t:inttype{unsigned t} -> #l:secrecy_level -> a:uint_t t l -> b:uint_t t l -> m:pos{m < bits t} -> + Lemma + (requires v b == pow2 m - 1) + (ensures v (logand #t #l a b) == v a % pow2 m) + +[@(strict_on_arguments [0])] +inline_for_extraction +val logor: #t:inttype -> #l:secrecy_level + -> int_t t l + -> int_t t l + -> int_t t l + +val logor_disjoint: #t:inttype{unsigned t} -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l + -> m:nat{m < bits t} + -> Lemma + (requires 0 <= v a /\ v a < pow2 m /\ v b % pow2 m == 0) + (ensures v (a `logor` b) == v a + v b) + //[SMTPat (v (a `logor` b))] + +val logor_zeros: #t: inttype -> #l: secrecy_level -> a: int_t t l -> + Lemma (v (a `logor` zeros t l) == v a) + +val logor_ones: #t: inttype -> #l: secrecy_level -> a: int_t t l -> + Lemma (v (a `logor` ones t l) == ones_v t) + +// For backwards compatibility +val logor_lemma: #t:inttype -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l + -> Lemma + (requires v a = 0 \/ v a = ones_v t) + (ensures (if v a = ones_v t then v (a `logor` b) == ones_v t else v (a `logor` b) == v b)) + +let logor_v (#t:inttype) (a:range_t t) (b:range_t t) : range_t t = + match t with + | S8 | S16 | S32 | S64 | S128 -> Int.logor #(bits t) a b + | _ -> UInt.logor #(bits t) a b + +val logor_spec: #t:inttype -> #l:secrecy_level + -> a:int_t t l + -> b:int_t t l + -> Lemma (v (a `logor` b) == v a `logor_v` v b) + + +[@(strict_on_arguments [0])] +inline_for_extraction +val lognot: #t:inttype -> #l:secrecy_level -> int_t t l -> int_t t l + +val lognot_lemma: #t: inttype -> #l: secrecy_level -> + a: int_t t l -> + Lemma + (requires v a = 0 \/ v a = ones_v t) + (ensures (if v a = ones_v t then v (lognot a) == 0 else v (lognot a) == ones_v t)) + +let lognot_v (#t:inttype) (a:range_t t) : range_t t = + match t with + | S8 | S16 | S32 | S64 | S128 -> Int.lognot #(bits t) a + | _ -> UInt.lognot #(bits t) a + +val lognot_spec: #t:inttype -> #l:secrecy_level + -> a:int_t t l + -> Lemma (v (lognot a) == lognot_v (v a)) + +inline_for_extraction +type shiftval (t:inttype) = u:size_t{v u < bits t} + +inline_for_extraction +type rotval (t:inttype) = u:size_t{0 < v u /\ v u < bits t} + +[@(strict_on_arguments [0])] +inline_for_extraction +val shift_right: #t:inttype -> #l:secrecy_level + -> int_t t l + -> shiftval t + -> int_t t l + +val shift_right_lemma: #t:inttype -> #l:secrecy_level + -> a:int_t t l + -> b:shiftval t + -> Lemma + (v (shift_right a b) == v a / pow2 (v b)) + [SMTPat (v #t #l (shift_right #t #l a b))] + +[@(strict_on_arguments [0])] +inline_for_extraction +val shift_left: #t:inttype -> #l:secrecy_level + -> a:int_t t l + -> s:shiftval t + -> Pure (int_t t l) + (requires unsigned t \/ (0 <= v a /\ v a * pow2 (v s) <= maxint t)) + (ensures fun _ -> True) + +val shift_left_lemma: + #t:inttype + -> #l:secrecy_level + -> a:int_t t l{unsigned t \/ 0 <= v a} + -> s:shiftval t{unsigned t \/ (0 <= v a /\ v a * pow2 (v s) <= maxint t)} + -> Lemma + (v (shift_left a s) == (v a * pow2 (v s)) @%. t) + [SMTPat (v #t #l (shift_left #t #l a s))] + +[@(strict_on_arguments [0])] +inline_for_extraction +val rotate_right: #t:inttype -> #l:secrecy_level + -> a:int_t t l{unsigned t} + -> rotval t + -> int_t t l + +[@(strict_on_arguments [0])] +inline_for_extraction +val rotate_left: #t:inttype -> #l:secrecy_level + -> a:int_t t l{unsigned t} + -> rotval t + -> int_t t l + +inline_for_extraction +let shift_right_i (#t:inttype) (#l:secrecy_level) (s:shiftval t{unsigned t}) (u:uint_t t l) : uint_t t l = shift_right u s + +inline_for_extraction +let shift_left_i (#t:inttype) (#l:secrecy_level) (s:shiftval t{unsigned t}) (u:uint_t t l) : uint_t t l = shift_left u s + +inline_for_extraction +let rotate_right_i (#t:inttype) (#l:secrecy_level) (s:rotval t{unsigned t}) (u:uint_t t l) : uint_t t l = rotate_right u s + +inline_for_extraction +let rotate_left_i (#t:inttype) (#l:secrecy_level) (s:rotval t{unsigned t}) (u:uint_t t l) : uint_t t l = rotate_left u s + + +[@(strict_on_arguments [0])] +inline_for_extraction +val ct_abs: #t:inttype{signed t /\ ~(S128? t)} -> #l:secrecy_level + -> a:int_t t l{minint t < v a} + -> b:int_t t l{v b == abs (v a)} + +/// +/// Masking operators for all machine integers +/// + +[@(strict_on_arguments [0])] +inline_for_extraction +val eq_mask: #t:inttype{~(S128? t)} -> int_t t SEC -> int_t t SEC -> int_t t SEC + +val eq_mask_lemma: #t:inttype{~(S128? t)} -> a:int_t t SEC -> b:int_t t SEC -> Lemma + (if v a = v b then v (eq_mask a b) == ones_v t + else v (eq_mask a b) == 0) + [SMTPat (eq_mask #t a b)] + +val eq_mask_logand_lemma: + #t:inttype{~(S128? t)} + -> a:int_t t SEC + -> b:int_t t SEC + -> c:int_t t SEC -> Lemma + (if v a = v b then v (c `logand` eq_mask a b) == v c + else v (c `logand` eq_mask a b) == 0) + [SMTPat (c `logand` eq_mask a b)] + +[@(strict_on_arguments [0])] +inline_for_extraction +val neq_mask: #t:inttype{~(S128? t)} -> a:int_t t SEC -> b:int_t t SEC -> int_t t SEC + +val neq_mask_lemma: #t:inttype{~(S128? t)} -> a:int_t t SEC -> b:int_t t SEC -> Lemma + (if v a = v b then v (neq_mask a b) == 0 + else v (neq_mask a b) == ones_v t) + [SMTPat (neq_mask #t a b)] + +[@(strict_on_arguments [0])] +inline_for_extraction +val gte_mask: #t:inttype{unsigned t} -> int_t t SEC -> b:int_t t SEC -> int_t t SEC + +val gte_mask_lemma: #t:inttype{unsigned t} -> a:int_t t SEC -> b:int_t t SEC -> Lemma + (if v a >= v b then v (gte_mask a b) == ones_v t + else v (gte_mask a b) == 0) + [SMTPat (gte_mask #t a b)] + +val gte_mask_logand_lemma: #t:inttype{unsigned t} + -> a:int_t t SEC + -> b:int_t t SEC + -> c:int_t t SEC + -> Lemma + (if v a >= v b then v (c `logand` gte_mask a b) == v c + else v (c `logand` gte_mask a b) == 0) + [SMTPat (c `logand` gte_mask a b)] + +[@(strict_on_arguments [0])] +inline_for_extraction +val lt_mask: #t:inttype{unsigned t} -> int_t t SEC -> int_t t SEC -> int_t t SEC + +val lt_mask_lemma: #t:inttype{unsigned t} -> a:int_t t SEC -> b:int_t t SEC -> Lemma + (if v a < v b then v (lt_mask a b) == ones_v t + else v (lt_mask a b) == 0) + [SMTPat (lt_mask #t a b)] + +[@(strict_on_arguments [0])] +inline_for_extraction +val gt_mask: #t:inttype{unsigned t} -> int_t t SEC -> b:int_t t SEC -> int_t t SEC + +val gt_mask_lemma: #t:inttype{unsigned t} -> a:int_t t SEC -> b:int_t t SEC -> Lemma + (if v a > v b then v (gt_mask a b) == ones_v t + else v (gt_mask a b) == 0) + [SMTPat (gt_mask #t a b)] + +[@(strict_on_arguments [0])] +inline_for_extraction +val lte_mask: #t:inttype{unsigned t} -> int_t t SEC -> int_t t SEC -> int_t t SEC + +val lte_mask_lemma: #t:inttype{unsigned t} -> a:int_t t SEC -> b:int_t t SEC -> Lemma + (if v a <= v b then v (lte_mask a b) == ones_v t + else v (lte_mask a b) == 0) + [SMTPat (lte_mask #t a b)] + +#push-options "--max_fuel 1" + +[@(strict_on_arguments [0])] +inline_for_extraction +let mod_mask (#t:inttype) (#l:secrecy_level) (m:shiftval t{pow2 (uint_v m) <= maxint t}) : int_t t l = + shift_left_lemma #t #l (mk_int 1) m; + (mk_int 1 `shift_left` m) `sub` mk_int 1 + +#pop-options + +val mod_mask_lemma: #t:inttype -> #l:secrecy_level + -> a:int_t t l -> m:shiftval t{pow2 (uint_v m) <= maxint t} + -> Lemma (v (a `logand` mod_mask m) == v a % pow2 (v m)) + [SMTPat (a `logand` mod_mask #t m)] + +(** Casts a value between two signed types using modular reduction *) +[@(strict_on_arguments [0;2])] +inline_for_extraction +val cast_mod: #t:inttype{signed t} -> #l:secrecy_level + -> t':inttype{signed t'} + -> l':secrecy_level{PUB? l \/ SEC? l'} + -> a:int_t t l + -> b:int_t t' l'{v b == v a @%. t'} + +/// +/// Operators available for all machine integers +/// + +unfold +let (+!) #t #l = add #t #l + +unfold +let (+.) #t #l = add_mod #t #l + +unfold +let ( *! ) #t #l = mul #t #l + +unfold +let ( *. ) #t #l = mul_mod #t #l + +unfold +let ( -! ) #t #l = sub #t #l + +unfold +let ( -. ) #t #l = sub_mod #t #l + +unfold +let ( >>. ) #t #l = shift_right #t #l + +unfold +let ( <<. ) #t #l = shift_left #t #l + +unfold +let ( >>>. ) #t #l = rotate_right #t #l + +unfold +let ( <<<. ) #t #l = rotate_left #t #l + +unfold +let ( ^. ) #t #l = logxor #t #l + +unfold +let ( |. ) #t #l = logor #t #l + +unfold +let ( &. ) #t #l = logand #t #l + +unfold +let ( ~. ) #t #l = lognot #t #l + +/// +/// Operations on public integers +/// + +[@(strict_on_arguments [0])] +inline_for_extraction +val div: #t:inttype{~(U128? t) /\ ~(S128? t)} + -> a:int_t t PUB + -> b:int_t t PUB{v b <> 0 /\ (unsigned t \/ range FStar.Int.(v a / v b) t)} + -> int_t t PUB + +val div_lemma: #t:inttype{~(U128? t) /\ ~(S128? t)} + -> a:int_t t PUB + -> b:int_t t PUB{v b <> 0 /\ (unsigned t \/ range FStar.Int.(v a / v b) t)} + -> Lemma (v (div a b) == FStar.Int.(v a / v b)) + [SMTPat (v #t (div #t a b))] + +[@(strict_on_arguments [0])] +inline_for_extraction +val mod: #t:inttype{~(U128? t) /\ ~(S128? t)} + -> a:int_t t PUB + -> b:int_t t PUB{v b <> 0 /\ (unsigned t \/ range FStar.Int.(v a / v b) t)} + -> int_t t PUB + +val mod_lemma: #t:inttype{~(U128? t) /\ ~(S128? t)} + -> a:int_t t PUB + -> b:int_t t PUB{v b <> 0 /\ (unsigned t \/ range FStar.Int.(v a / v b) t)} + -> Lemma (if signed t then + v (mod a b) == FStar.Int.mod #(bits t) (v a) (v b) + else + v (mod a b) == FStar.UInt.mod #(bits t) (v a) (v b)) + [SMTPat (v #t (mod #t a b))] + +[@(strict_on_arguments [0])] +inline_for_extraction +val eq: #t:inttype -> int_t t PUB -> int_t t PUB -> bool + +inline_for_extraction +val eq_lemma: #t:inttype + -> a:int_t t PUB + -> b:int_t t PUB + -> Lemma (a `eq` b == (v a = v b)) + [SMTPat (eq #t a b)] + +[@(strict_on_arguments [0])] +inline_for_extraction +val ne: #t:inttype -> int_t t PUB -> int_t t PUB -> bool + +val ne_lemma: #t:inttype + -> a:int_t t PUB + -> b:int_t t PUB + -> Lemma (a `ne` b == (v a <> v b)) + [SMTPat (ne #t a b)] + +[@(strict_on_arguments [0])] +inline_for_extraction +val lt: #t:inttype -> int_t t PUB -> int_t t PUB -> bool + +val lt_lemma: #t:inttype + -> a:int_t t PUB + -> b:int_t t PUB + -> Lemma (a `lt` b == (v a < v b)) + [SMTPat (lt #t a b)] + +[@(strict_on_arguments [0])] +inline_for_extraction +val lte: #t:inttype -> int_t t PUB -> int_t t PUB -> bool + +val lte_lemma: #t:inttype + -> a:int_t t PUB + -> b:int_t t PUB + -> Lemma (a `lte` b == (v a <= v b)) + [SMTPat (lte #t a b)] + +[@(strict_on_arguments [0])] +inline_for_extraction +val gt: #t:inttype -> int_t t PUB -> int_t t PUB -> bool + +val gt_lemma: #t:inttype + -> a:int_t t PUB + -> b:int_t t PUB + -> Lemma (a `gt` b == (v a > v b)) + [SMTPat (gt #t a b)] + +[@(strict_on_arguments [0])] +inline_for_extraction +val gte: #t:inttype -> int_t t PUB -> int_t t PUB -> bool + +val gte_lemma: #t:inttype + -> a:int_t t PUB + -> b:int_t t PUB + -> Lemma (a `gte` b == (v a >= v b)) + [SMTPat (gte #t a b)] + +unfold +let (/.) #t = div #t + +unfold +let (%.) #t = mod #t + +unfold +let (=.) #t = eq #t + +unfold +let (<>.) #t = ne #t + +unfold +let (<.) #t = lt #t + +unfold +let (<=.) #t = lte #t + +unfold +let (>.) #t = gt #t + +unfold +let (>=.) #t = gte #t diff --git a/tests/hacl/Lib.IntTypes.fsti.hints b/tests/hacl/Lib.IntTypes.fsti.hints new file mode 100644 index 00000000000..132cbccf421 --- /dev/null +++ b/tests/hacl/Lib.IntTypes.fsti.hints @@ -0,0 +1,1025 @@ +[ + "æ\t×\u000bÔ\u001e©\u001e×4†hÛÖ?Á", + [ + [ + "Lib.IntTypes.numbytes", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "disc_equation_Lib.IntTypes.S128", + "disc_equation_Lib.IntTypes.S16", "disc_equation_Lib.IntTypes.S32", + "disc_equation_Lib.IntTypes.S64", "disc_equation_Lib.IntTypes.S8", + "disc_equation_Lib.IntTypes.U1", "disc_equation_Lib.IntTypes.U128", + "disc_equation_Lib.IntTypes.U16", "disc_equation_Lib.IntTypes.U32", + "disc_equation_Lib.IntTypes.U64", "disc_equation_Lib.IntTypes.U8", + "fuel_guarded_inversion_Lib.IntTypes.inttype", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "9e2bb78b55b4b0e15a54a3e4d392bea8" + ], + [ + "Lib.IntTypes.bits", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "disc_equation_Lib.IntTypes.S128", + "disc_equation_Lib.IntTypes.S16", "disc_equation_Lib.IntTypes.S32", + "disc_equation_Lib.IntTypes.S64", "disc_equation_Lib.IntTypes.S8", + "disc_equation_Lib.IntTypes.U1", "disc_equation_Lib.IntTypes.U128", + "disc_equation_Lib.IntTypes.U16", "disc_equation_Lib.IntTypes.U32", + "disc_equation_Lib.IntTypes.U64", "disc_equation_Lib.IntTypes.U8", + "fuel_guarded_inversion_Lib.IntTypes.inttype", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "6df491e6cfab2c5858d32707ba9ebcb9" + ], + [ + "Lib.IntTypes.modulus", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.IntTypes.bits", + "fuel_guarded_inversion_Lib.IntTypes.inttype", + "projection_inverse_BoxInt_proj_0" + ], + 0, + "e8a504abdad1eb956688b98193cb8496" + ], + [ + "Lib.IntTypes.maxint", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.unsigned", + "fuel_guarded_inversion_Lib.IntTypes.inttype", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0" + ], + 0, + "e8ab8ee743cd8a9d5f2d78cb9d230f9b" + ], + [ + "Lib.IntTypes.minint", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.unsigned", + "fuel_guarded_inversion_Lib.IntTypes.inttype", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0" + ], + 0, + "88bf422951a779c19b61bd1c30c4667d" + ], + [ + "Lib.IntTypes.pub_int_t", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "disc_equation_Lib.IntTypes.S128", + "disc_equation_Lib.IntTypes.S16", "disc_equation_Lib.IntTypes.S32", + "disc_equation_Lib.IntTypes.S64", "disc_equation_Lib.IntTypes.S8", + "disc_equation_Lib.IntTypes.U1", "disc_equation_Lib.IntTypes.U128", + "disc_equation_Lib.IntTypes.U16", "disc_equation_Lib.IntTypes.U32", + "disc_equation_Lib.IntTypes.U64", "disc_equation_Lib.IntTypes.U8", + "fuel_guarded_inversion_Lib.IntTypes.inttype", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "d001b186588ce165afd6d544abd75b89" + ], + [ + "Lib.IntTypes.pub_int_v", + 1, + 0, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "b2t_def", "bool_inversion", + "constructor_distinct_Lib.IntTypes.S128", + "constructor_distinct_Lib.IntTypes.S16", + "constructor_distinct_Lib.IntTypes.S32", + "constructor_distinct_Lib.IntTypes.S64", + "constructor_distinct_Lib.IntTypes.S8", + "constructor_distinct_Lib.IntTypes.U1", + "constructor_distinct_Lib.IntTypes.U128", + "constructor_distinct_Lib.IntTypes.U16", + "constructor_distinct_Lib.IntTypes.U32", + "constructor_distinct_Lib.IntTypes.U64", + "constructor_distinct_Lib.IntTypes.U8", + "disc_equation_Lib.IntTypes.S128", "disc_equation_Lib.IntTypes.S16", + "disc_equation_Lib.IntTypes.S32", "disc_equation_Lib.IntTypes.S64", + "disc_equation_Lib.IntTypes.S8", "disc_equation_Lib.IntTypes.U1", + "disc_equation_Lib.IntTypes.U128", "disc_equation_Lib.IntTypes.U16", + "disc_equation_Lib.IntTypes.U32", "disc_equation_Lib.IntTypes.U64", + "disc_equation_Lib.IntTypes.U8", "equality_tok_Lib.IntTypes.S16@tok", + "equality_tok_Lib.IntTypes.S32@tok", + "equality_tok_Lib.IntTypes.S64@tok", + "equality_tok_Lib.IntTypes.S8@tok", + "equality_tok_Lib.IntTypes.U128@tok", + "equality_tok_Lib.IntTypes.U16@tok", + "equality_tok_Lib.IntTypes.U1@tok", + "equality_tok_Lib.IntTypes.U32@tok", + "equality_tok_Lib.IntTypes.U64@tok", + "equality_tok_Lib.IntTypes.U8@tok", "equation_FStar.Int.fits", + "equation_FStar.Int.max_int", "equation_FStar.Int.min_int", + "equation_FStar.Int.size", "equation_FStar.UInt.fits", + "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", + "equation_FStar.UInt.size", "equation_FStar.UInt128.n", + "equation_Lib.IntTypes.bits", "equation_Lib.IntTypes.maxint", + "equation_Lib.IntTypes.minint", "equation_Lib.IntTypes.pub_int_t", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.unsigned", + "equation_Prims.nat", "fuel_guarded_inversion_Lib.IntTypes.inttype", + "lemma_FStar.UInt.pow2_values", "primitive_Prims.op_AmpAmp", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Minus", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_e0b16d74ee3644bd585df5e7938934c6", + "typing_Lib.IntTypes.bits", "typing_Lib.IntTypes.uu___is_U1", + "typing_tok_Lib.IntTypes.U1@tok" + ], + 0, + "40343825a8f06b7c97658cd35f7375e2" + ], + [ + "Lib.IntTypes.int_t", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "disc_equation_Lib.IntTypes.PUB", + "disc_equation_Lib.IntTypes.SEC", + "fuel_guarded_inversion_Lib.IntTypes.secrecy_level", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "e2fac751a7003aed037df9676f4dde08" + ], + [ + "Lib.IntTypes.v", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "constructor_distinct_Lib.IntTypes.PUB", + "constructor_distinct_Lib.IntTypes.SEC", + "disc_equation_Lib.IntTypes.PUB", "disc_equation_Lib.IntTypes.SEC", + "equality_tok_Lib.IntTypes.PUB@tok", + "equality_tok_Lib.IntTypes.SEC@tok", "equation_Lib.IntTypes.int_t", + "fuel_guarded_inversion_Lib.IntTypes.secrecy_level", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "860dd2f9ac85a3e79e5b2748bb78890e" + ], + [ + "Lib.IntTypes.u128", + 1, + 0, + 1, + [ "@query" ], + 0, + "f491d27970b48a4ccd7d475d51aee3b5" + ], + [ + "Lib.IntTypes.i128", + 1, + 0, + 1, + [ "@query" ], + 0, + "61ff775dde8a4e2a1d0e70d15c931562" + ], + [ + "Lib.IntTypes.size", + 1, + 0, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.S16", + "constructor_distinct_Lib.IntTypes.U32", + "equality_tok_Lib.IntTypes.U32@tok", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.maxint", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.unsigned", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0" + ], + 0, + "82c5c162c6ddf6096fbc9029f3875380" + ], + [ + "Lib.IntTypes.byte", + 1, + 0, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "constructor_distinct_Lib.IntTypes.U8", + "equality_tok_Lib.IntTypes.U8@tok", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.maxint", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.unsigned", + "equation_Prims.nat", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_31c7d3d85d92cb942c95a78642e657c7", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "typing_Lib.IntTypes.bits", "typing_tok_Lib.IntTypes.U8@tok" + ], + 0, + "98d3556120d6c3c0581c038ec9958d9f" + ], + [ + "Lib.IntTypes.byte_v", + 1, + 0, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "constructor_distinct_Lib.IntTypes.U8", + "equality_tok_Lib.IntTypes.U8@tok", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.maxint", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.unsigned", + "equation_Prims.nat", "int_typing", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "typing_Lib.IntTypes.bits", "typing_tok_Lib.IntTypes.U8@tok" + ], + 0, + "cf36da756927afd2d372d1619820a23c" + ], + [ + "Lib.IntTypes.size_to_uint64", + 1, + 0, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "constructor_distinct_Lib.IntTypes.S16", + "constructor_distinct_Lib.IntTypes.S32", + "constructor_distinct_Lib.IntTypes.S8", + "constructor_distinct_Lib.IntTypes.U32", + "constructor_distinct_Lib.IntTypes.U64", + "equality_tok_Lib.IntTypes.U32@tok", + "equality_tok_Lib.IntTypes.U64@tok", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.maxint", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.unsigned", + "equation_Prims.nat", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "typing_Lib.IntTypes.bits", "typing_tok_Lib.IntTypes.U32@tok", + "typing_tok_Lib.IntTypes.U64@tok" + ], + 0, + "0224ed5192a3418a1b1ceeeab5f8cdf0" + ], + [ + "Lib.IntTypes.op_At_Percent_Dot", + 1, + 0, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Lib.IntTypes.bits", "equation_Lib.IntTypes.unsigned", + "equation_Prims.nat", "fuel_guarded_inversion_Lib.IntTypes.inttype", + "lemma_FStar.UInt.pow2_values", "primitive_Prims.op_Modulus", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "typing_Lib.IntTypes.bits" + ], + 0, + "c903cc7da03ad95b2caab1c932864e16" + ], + [ + "Lib.IntTypes.to_u1", + 1, + 0, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.SEC", + "disc_equation_Lib.IntTypes.SEC", + "equality_tok_Lib.IntTypes.SEC@tok", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "1553c1686d9988a0f5cc5cc835fd30e5" + ], + [ + "Lib.IntTypes.to_u8", + 1, + 0, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.SEC", + "disc_equation_Lib.IntTypes.SEC", + "equality_tok_Lib.IntTypes.SEC@tok", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "9549f3221d11d3d80962f4496073b213" + ], + [ + "Lib.IntTypes.to_i8", + 1, + 0, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.SEC", + "disc_equation_Lib.IntTypes.SEC", + "equality_tok_Lib.IntTypes.SEC@tok", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "55898475b0849a89802b46ed5d656517" + ], + [ + "Lib.IntTypes.to_u16", + 1, + 0, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.SEC", + "disc_equation_Lib.IntTypes.SEC", + "equality_tok_Lib.IntTypes.SEC@tok", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "732dac3cb985659db3de16c8adab37f6" + ], + [ + "Lib.IntTypes.to_i16", + 1, + 0, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.SEC", + "disc_equation_Lib.IntTypes.SEC", + "equality_tok_Lib.IntTypes.SEC@tok", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "1ce730547ce52b9e3a6ebeddec37cfd7" + ], + [ + "Lib.IntTypes.to_u32", + 1, + 0, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.SEC", + "disc_equation_Lib.IntTypes.SEC", + "equality_tok_Lib.IntTypes.SEC@tok", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "c18a0a9ae5fca7f7fd027557c558a5d0" + ], + [ + "Lib.IntTypes.to_i32", + 1, + 0, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.SEC", + "disc_equation_Lib.IntTypes.SEC", + "equality_tok_Lib.IntTypes.SEC@tok", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "9344e260f609709bcd60b84330eaf85d" + ], + [ + "Lib.IntTypes.to_u64", + 1, + 0, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.SEC", + "disc_equation_Lib.IntTypes.SEC", + "equality_tok_Lib.IntTypes.SEC@tok", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "8f87fe672e152c8a2e8190c871746c54" + ], + [ + "Lib.IntTypes.to_i64", + 1, + 0, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.SEC", + "disc_equation_Lib.IntTypes.SEC", + "equality_tok_Lib.IntTypes.SEC@tok", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "b26beb50016c1ee30282b45e79fdf04b" + ], + [ + "Lib.IntTypes.to_u128", + 1, + 0, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.SEC", + "disc_equation_Lib.IntTypes.SEC", + "equality_tok_Lib.IntTypes.SEC@tok", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "d6ae0f3520caa59f5f7c4fa90ebc1bbf" + ], + [ + "Lib.IntTypes.to_i128", + 1, + 0, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.SEC", + "disc_equation_Lib.IntTypes.SEC", + "equality_tok_Lib.IntTypes.SEC@tok", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "b01548ac72990c385be89b1cf8d589e0" + ], + [ + "Lib.IntTypes.ones_v", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "disc_equation_Lib.IntTypes.S128", + "disc_equation_Lib.IntTypes.S16", "disc_equation_Lib.IntTypes.S32", + "disc_equation_Lib.IntTypes.S64", "disc_equation_Lib.IntTypes.S8", + "disc_equation_Lib.IntTypes.U1", "disc_equation_Lib.IntTypes.U128", + "disc_equation_Lib.IntTypes.U16", "disc_equation_Lib.IntTypes.U32", + "disc_equation_Lib.IntTypes.U64", "disc_equation_Lib.IntTypes.U8", + "fuel_guarded_inversion_Lib.IntTypes.inttype", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "bb2d3fc6ccf843e96b4945a7266fbf59" + ], + [ + "Lib.IntTypes.logxor_lemma", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "constructor_distinct_Lib.IntTypes.S128", + "constructor_distinct_Lib.IntTypes.S16", + "constructor_distinct_Lib.IntTypes.S32", + "constructor_distinct_Lib.IntTypes.S64", + "constructor_distinct_Lib.IntTypes.S8", + "constructor_distinct_Lib.IntTypes.U1", + "constructor_distinct_Lib.IntTypes.U128", + "constructor_distinct_Lib.IntTypes.U16", + "constructor_distinct_Lib.IntTypes.U32", + "constructor_distinct_Lib.IntTypes.U64", + "constructor_distinct_Lib.IntTypes.U8", + "equality_tok_Lib.IntTypes.U128@tok", + "equality_tok_Lib.IntTypes.U16@tok", + "equality_tok_Lib.IntTypes.U1@tok", + "equality_tok_Lib.IntTypes.U32@tok", + "equality_tok_Lib.IntTypes.U64@tok", + "equality_tok_Lib.IntTypes.U8@tok", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.maxint", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.unsigned", + "equation_Prims.nat", "equation_Prims.pos", + "fuel_guarded_inversion_Lib.IntTypes.inttype", "int_typing", + "primitive_Prims.op_Minus", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "typing_Lib.IntTypes.bits", "typing_Prims.pow2", + "typing_tok_Lib.IntTypes.U128@tok", + "typing_tok_Lib.IntTypes.U16@tok", "typing_tok_Lib.IntTypes.U1@tok", + "typing_tok_Lib.IntTypes.U32@tok", "typing_tok_Lib.IntTypes.U64@tok", + "typing_tok_Lib.IntTypes.U8@tok" + ], + 0, + "0c99ed54fd557104f2de6280aa0fab68" + ], + [ + "Lib.IntTypes.logxor_v", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "b2t_def", "bool_inversion", + "constructor_distinct_Lib.IntTypes.S128", + "constructor_distinct_Lib.IntTypes.S16", + "constructor_distinct_Lib.IntTypes.S32", + "constructor_distinct_Lib.IntTypes.S64", + "constructor_distinct_Lib.IntTypes.S8", + "constructor_distinct_Lib.IntTypes.U1", + "constructor_distinct_Lib.IntTypes.U128", + "constructor_distinct_Lib.IntTypes.U16", + "constructor_distinct_Lib.IntTypes.U32", + "constructor_distinct_Lib.IntTypes.U64", + "constructor_distinct_Lib.IntTypes.U8", + "disc_equation_Lib.IntTypes.S128", "disc_equation_Lib.IntTypes.S16", + "disc_equation_Lib.IntTypes.S32", "disc_equation_Lib.IntTypes.S64", + "disc_equation_Lib.IntTypes.S8", + "equality_tok_Lib.IntTypes.S128@tok", + "equality_tok_Lib.IntTypes.S16@tok", + "equality_tok_Lib.IntTypes.S32@tok", + "equality_tok_Lib.IntTypes.S64@tok", + "equality_tok_Lib.IntTypes.S8@tok", "equation_FStar.Int.fits", + "equation_FStar.Int.max_int", "equation_FStar.Int.min_int", + "equation_FStar.Int.size", "equation_FStar.UInt.fits", + "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", + "equation_FStar.UInt.size", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.maxint", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.unsigned", + "fuel_guarded_inversion_Lib.IntTypes.inttype", "int_inversion", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_83845a86f2550cdf941eeb1d9b59602b", + "typing_FStar.Int.fits", "typing_Lib.IntTypes.uu___is_S8" + ], + 0, + "616cf8141c2ea4c0aac70a3227e079f9" + ], + [ + "Lib.IntTypes.logand_v", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "b2t_def", "bool_inversion", + "constructor_distinct_Lib.IntTypes.S128", + "constructor_distinct_Lib.IntTypes.S16", + "constructor_distinct_Lib.IntTypes.S32", + "constructor_distinct_Lib.IntTypes.S64", + "constructor_distinct_Lib.IntTypes.S8", + "constructor_distinct_Lib.IntTypes.U1", + "constructor_distinct_Lib.IntTypes.U128", + "constructor_distinct_Lib.IntTypes.U16", + "constructor_distinct_Lib.IntTypes.U32", + "constructor_distinct_Lib.IntTypes.U64", + "constructor_distinct_Lib.IntTypes.U8", + "disc_equation_Lib.IntTypes.S128", "disc_equation_Lib.IntTypes.S16", + "disc_equation_Lib.IntTypes.S32", "disc_equation_Lib.IntTypes.S64", + "disc_equation_Lib.IntTypes.S8", + "equality_tok_Lib.IntTypes.S128@tok", + "equality_tok_Lib.IntTypes.S16@tok", + "equality_tok_Lib.IntTypes.S32@tok", + "equality_tok_Lib.IntTypes.S64@tok", + "equality_tok_Lib.IntTypes.S8@tok", "equation_FStar.Int.fits", + "equation_FStar.Int.max_int", "equation_FStar.Int.min_int", + "equation_FStar.Int.size", "equation_FStar.UInt.fits", + "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", + "equation_FStar.UInt.size", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.maxint", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.unsigned", + "fuel_guarded_inversion_Lib.IntTypes.inttype", "int_inversion", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_83845a86f2550cdf941eeb1d9b59602b", + "typing_FStar.Int.fits", "typing_Lib.IntTypes.uu___is_S8" + ], + 0, + "f18a7229a159756737ae0b412d407790" + ], + [ + "Lib.IntTypes.logand_mask", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_812109ba662576a3f745174092d33c56" + ], + 0, + "10c64f04d1adbe5a223536ecc98f7286" + ], + [ + "Lib.IntTypes.logor_disjoint", + 1, + 0, + 1, + [ "@query" ], + 0, + "93cbcff1a894107f89f92acff3e68e5f" + ], + [ + "Lib.IntTypes.logor_v", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "b2t_def", "bool_inversion", + "constructor_distinct_Lib.IntTypes.S128", + "constructor_distinct_Lib.IntTypes.S16", + "constructor_distinct_Lib.IntTypes.S32", + "constructor_distinct_Lib.IntTypes.S64", + "constructor_distinct_Lib.IntTypes.S8", + "constructor_distinct_Lib.IntTypes.U1", + "constructor_distinct_Lib.IntTypes.U128", + "constructor_distinct_Lib.IntTypes.U16", + "constructor_distinct_Lib.IntTypes.U32", + "constructor_distinct_Lib.IntTypes.U64", + "constructor_distinct_Lib.IntTypes.U8", + "disc_equation_Lib.IntTypes.S128", "disc_equation_Lib.IntTypes.S16", + "disc_equation_Lib.IntTypes.S32", "disc_equation_Lib.IntTypes.S64", + "disc_equation_Lib.IntTypes.S8", + "equality_tok_Lib.IntTypes.S128@tok", + "equality_tok_Lib.IntTypes.S16@tok", + "equality_tok_Lib.IntTypes.S32@tok", + "equality_tok_Lib.IntTypes.S64@tok", + "equality_tok_Lib.IntTypes.S8@tok", "equation_FStar.Int.fits", + "equation_FStar.Int.max_int", "equation_FStar.Int.min_int", + "equation_FStar.Int.size", "equation_FStar.UInt.fits", + "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", + "equation_FStar.UInt.size", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.maxint", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.unsigned", + "fuel_guarded_inversion_Lib.IntTypes.inttype", "int_inversion", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_83845a86f2550cdf941eeb1d9b59602b", + "typing_FStar.Int.fits", "typing_Lib.IntTypes.uu___is_S8" + ], + 0, + "aab274c7be7bafd774e8e950eeb2e6d1" + ], + [ + "Lib.IntTypes.lognot_v", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "b2t_def", "bool_inversion", + "constructor_distinct_Lib.IntTypes.S128", + "constructor_distinct_Lib.IntTypes.S16", + "constructor_distinct_Lib.IntTypes.S32", + "constructor_distinct_Lib.IntTypes.S64", + "constructor_distinct_Lib.IntTypes.S8", + "constructor_distinct_Lib.IntTypes.U1", + "constructor_distinct_Lib.IntTypes.U128", + "constructor_distinct_Lib.IntTypes.U16", + "constructor_distinct_Lib.IntTypes.U32", + "constructor_distinct_Lib.IntTypes.U64", + "constructor_distinct_Lib.IntTypes.U8", + "disc_equation_Lib.IntTypes.S128", "disc_equation_Lib.IntTypes.S16", + "disc_equation_Lib.IntTypes.S32", "disc_equation_Lib.IntTypes.S64", + "disc_equation_Lib.IntTypes.S8", + "equality_tok_Lib.IntTypes.S128@tok", + "equality_tok_Lib.IntTypes.S16@tok", + "equality_tok_Lib.IntTypes.S32@tok", + "equality_tok_Lib.IntTypes.S64@tok", + "equality_tok_Lib.IntTypes.S8@tok", "equation_FStar.Int.fits", + "equation_FStar.Int.max_int", "equation_FStar.Int.min_int", + "equation_FStar.Int.size", "equation_FStar.UInt.fits", + "equation_FStar.UInt.max_int", "equation_FStar.UInt.min_int", + "equation_FStar.UInt.size", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.maxint", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.unsigned", + "fuel_guarded_inversion_Lib.IntTypes.inttype", "int_inversion", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_83845a86f2550cdf941eeb1d9b59602b", + "typing_Lib.IntTypes.uu___is_S8" + ], + 0, + "d0d652b85995f937275b0edbc1d07918" + ], + [ + "Lib.IntTypes.shift_right_lemma", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "constructor_distinct_Lib.IntTypes.U32", + "equality_tok_Lib.IntTypes.PUB@tok", + "equality_tok_Lib.IntTypes.U32@tok", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.shiftval", + "equation_Lib.IntTypes.unsigned", "equation_Lib.IntTypes.v", + "refinement_interpretation_Tm_refine_83845a86f2550cdf941eeb1d9b59602b", + "refinement_interpretation_Tm_refine_e40dba697735a60216c598c2a27841b5", + "typing_Lib.IntTypes.v", "typing_tok_Lib.IntTypes.PUB@tok", + "typing_tok_Lib.IntTypes.U32@tok" + ], + 0, + "4173c45fd3a237d93bdbdd7d5c99ac51" + ], + [ + "Lib.IntTypes.shift_left", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "constructor_distinct_Lib.IntTypes.U32", + "equality_tok_Lib.IntTypes.PUB@tok", + "equality_tok_Lib.IntTypes.U32@tok", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.shiftval", + "equation_Lib.IntTypes.unsigned", "equation_Lib.IntTypes.v", + "refinement_interpretation_Tm_refine_83845a86f2550cdf941eeb1d9b59602b", + "refinement_interpretation_Tm_refine_e40dba697735a60216c598c2a27841b5", + "typing_Lib.IntTypes.v", "typing_tok_Lib.IntTypes.PUB@tok", + "typing_tok_Lib.IntTypes.U32@tok" + ], + 0, + "8665ba9e4b62458a4b07e5e7e9beeb0b" + ], + [ + "Lib.IntTypes.shift_left_lemma", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "constructor_distinct_Lib.IntTypes.U32", + "equality_tok_Lib.IntTypes.PUB@tok", + "equality_tok_Lib.IntTypes.U32@tok", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.shiftval", + "equation_Lib.IntTypes.unsigned", "equation_Lib.IntTypes.v", + "refinement_interpretation_Tm_refine_4d1a190ec02a669657768f0db44948f9", + "refinement_interpretation_Tm_refine_83845a86f2550cdf941eeb1d9b59602b", + "refinement_interpretation_Tm_refine_e40dba697735a60216c598c2a27841b5", + "typing_Lib.IntTypes.v", "typing_tok_Lib.IntTypes.PUB@tok", + "typing_tok_Lib.IntTypes.U32@tok" + ], + 0, + "3386dd253c981077f1af8223ac54a057" + ], + [ + "Lib.IntTypes.shift_right_i", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_33026181614126bf2f989b87912ad69b" + ], + 0, + "5fbfd5f677fe23266d59d11513e5fb89" + ], + [ + "Lib.IntTypes.shift_right_i", + 2, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_33026181614126bf2f989b87912ad69b" + ], + 0, + "55d85badc03b89489c58b3478d6293cb" + ], + [ + "Lib.IntTypes.shift_left_i", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_33026181614126bf2f989b87912ad69b" + ], + 0, + "c4614a27c8d77ccfad1be044e40f0f12" + ], + [ + "Lib.IntTypes.shift_left_i", + 2, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_33026181614126bf2f989b87912ad69b" + ], + 0, + "4c7db43cfdec5e9a4f0c84f2f7d72f13" + ], + [ + "Lib.IntTypes.rotate_right_i", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_fe1f2b0fb92318a15c076125042e53a3" + ], + 0, + "7f7b8483bb7a087b012dcb242b05f08d" + ], + [ + "Lib.IntTypes.rotate_right_i", + 2, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_fe1f2b0fb92318a15c076125042e53a3" + ], + 0, + "28f89a774ababe46c89e64c01327da72" + ], + [ + "Lib.IntTypes.rotate_left_i", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_fe1f2b0fb92318a15c076125042e53a3" + ], + 0, + "d1dc071b4b951717c443bd99ab0a2fca" + ], + [ + "Lib.IntTypes.rotate_left_i", + 2, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_fe1f2b0fb92318a15c076125042e53a3" + ], + 0, + "c46dca3e175d725448688c03445d5ecf" + ], + [ + "Lib.IntTypes.mod_mask", + 1, + 1, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", + "@fuel_irrelevance_Prims.pow2.fuel_instrumented", "@query", + "constructor_distinct_Lib.IntTypes.U32", + "equality_tok_Lib.IntTypes.PUB@tok", + "equality_tok_Lib.IntTypes.U32@tok", + "equation_FStar.Int.op_At_Percent", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.maxint", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.op_At_Percent_Dot", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.shiftval", + "equation_Lib.IntTypes.unsigned", "equation_Lib.IntTypes.v", + "equation_Prims.abs", "equation_Prims.nat", "equation_Prims.pos", + "equation_with_fuel_Prims.pow2.fuel_instrumented", + "fuel_guarded_inversion_Lib.IntTypes.inttype", "int_inversion", + "int_typing", "lemma_FStar.Int.pow2_values", + "lemma_FStar.UInt.pow2_values", "lemma_Lib.IntTypes.pow2_127", + "lemma_Lib.IntTypes.pow2_2", "lemma_Lib.IntTypes.pow2_3", + "lemma_Lib.IntTypes.pow2_4", "primitive_Prims.op_GreaterThanOrEqual", + "primitive_Prims.op_Minus", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_83845a86f2550cdf941eeb1d9b59602b", + "refinement_interpretation_Tm_refine_ac5393c1a5eb4d36f425e5e42929859b", + "refinement_interpretation_Tm_refine_b6806f707b80b45deafff2826c0c9018", + "refinement_interpretation_Tm_refine_e40dba697735a60216c598c2a27841b5", + "typing_Lib.IntTypes.bits", "typing_Lib.IntTypes.v", + "typing_Prims.pow2", "typing_tok_Lib.IntTypes.PUB@tok", + "typing_tok_Lib.IntTypes.U32@tok" + ], + 0, + "1f621f0bea518f6fccc3023e46677200" + ], + [ + "Lib.IntTypes.mod_mask", + 2, + 1, + 1, + [ + "@query", "constructor_distinct_Lib.IntTypes.U32", + "equality_tok_Lib.IntTypes.U32@tok", "equation_Lib.IntTypes.minint", + "equation_Lib.IntTypes.range", "equation_Lib.IntTypes.unsigned" + ], + 0, + "1f7a8e0f9882d3262be6e777cfe35e35" + ], + [ + "Lib.IntTypes.mod_mask_lemma", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "b2t_def", + "constructor_distinct_Lib.IntTypes.PUB", + "constructor_distinct_Lib.IntTypes.U32", + "equality_tok_Lib.IntTypes.PUB@tok", + "equality_tok_Lib.IntTypes.U32@tok", "equation_FStar.UInt.fits", + "equation_FStar.UInt.min_int", "equation_FStar.UInt.size", + "equation_FStar.UInt.uint_t", "equation_Lib.IntTypes.int_t", + "equation_Lib.IntTypes.minint", "equation_Lib.IntTypes.pub_int_t", + "equation_Lib.IntTypes.pub_int_v", "equation_Lib.IntTypes.range", + "equation_Lib.IntTypes.shiftval", "equation_Lib.IntTypes.unsigned", + "equation_Lib.IntTypes.v", "primitive_Prims.op_AmpAmp", + "primitive_Prims.op_LessThanOrEqual", + "projection_inverse_BoxBool_proj_0", + "refinement_interpretation_Tm_refine_ac5393c1a5eb4d36f425e5e42929859b", + "refinement_interpretation_Tm_refine_e40dba697735a60216c598c2a27841b5", + "refinement_interpretation_Tm_refine_f13070840248fced9d9d60d77bdae3ec", + "typing_FStar.UInt32.v" + ], + 0, + "ff29dc6dbd3bd114671da7c8a2a61a9a" + ], + [ + "Lib.IntTypes.div", + 1, + 0, + 1, + [ "@query" ], + 0, + "7ac2f9a08e83e0f729fd11b54e6e6d4e" + ], + [ + "Lib.IntTypes.div_lemma", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_e450d0eda8ec6ce5c9eff42d01f0e81a" + ], + 0, + "5073732f269af350b22e9a0fc3d58023" + ], + [ + "Lib.IntTypes.mod", + 1, + 0, + 1, + [ "@query" ], + 0, + "395e988323e6f01258fbfa166b5077a2" + ], + [ + "Lib.IntTypes.mod_lemma", + 1, + 0, + 1, + [ + "@MaxIFuel_assumption", "@query", "b2t_def", "bool_inversion", + "constructor_distinct_Lib.IntTypes.PUB", + "constructor_distinct_Lib.IntTypes.S16", + "constructor_distinct_Lib.IntTypes.S32", + "constructor_distinct_Lib.IntTypes.S64", + "constructor_distinct_Lib.IntTypes.S8", + "constructor_distinct_Lib.IntTypes.U1", + "constructor_distinct_Lib.IntTypes.U16", + "constructor_distinct_Lib.IntTypes.U32", + "constructor_distinct_Lib.IntTypes.U64", + "constructor_distinct_Lib.IntTypes.U8", + "disc_equation_Lib.IntTypes.S128", "disc_equation_Lib.IntTypes.U128", + "equality_tok_Lib.IntTypes.PUB@tok", "equation_FStar.Int.int_t", + "equation_FStar.UInt.fits", "equation_FStar.UInt.max_int", + "equation_FStar.UInt.min_int", "equation_FStar.UInt.size", + "equation_FStar.UInt.uint_t", "equation_Lib.IntTypes.bits", + "equation_Lib.IntTypes.int_t", "equation_Lib.IntTypes.maxint", + "equation_Lib.IntTypes.minint", "equation_Lib.IntTypes.pub_int_t", + "equation_Lib.IntTypes.pub_int_v", "equation_Lib.IntTypes.range", + "equation_Lib.IntTypes.signed", "equation_Lib.IntTypes.unsigned", + "equation_Lib.IntTypes.v", + "fuel_guarded_inversion_Lib.IntTypes.inttype", + "primitive_Prims.op_AmpAmp", "primitive_Prims.op_LessThanOrEqual", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_83845a86f2550cdf941eeb1d9b59602b", + "refinement_interpretation_Tm_refine_b550ca9347e0645a53715102a08d8fa1", + "refinement_interpretation_Tm_refine_c156ecc6eab05d1687a383ef171435eb", + "refinement_interpretation_Tm_refine_e0b16d74ee3644bd585df5e7938934c6", + "refinement_interpretation_Tm_refine_e450d0eda8ec6ce5c9eff42d01f0e81a", + "refinement_interpretation_Tm_refine_f13070840248fced9d9d60d77bdae3ec", + "typing_FStar.Int16.v", "typing_FStar.Int32.v", + "typing_FStar.Int64.v", "typing_FStar.Int8.v", + "typing_FStar.UInt8.v", "typing_Lib.IntTypes.unsigned", + "typing_Lib.IntTypes.uu___is_S128", "typing_Lib.IntTypes.v", + "typing_tok_Lib.IntTypes.PUB@tok" + ], + 0, + "9bfcda4948ff6c6d67b056436946bfbb" + ] + ] +] \ No newline at end of file diff --git a/tests/hacl/Lib.LoopCombinators.fst b/tests/hacl/Lib.LoopCombinators.fst new file mode 100644 index 00000000000..38b2fe6e1b1 --- /dev/null +++ b/tests/hacl/Lib.LoopCombinators.fst @@ -0,0 +1,205 @@ +module Lib.LoopCombinators + +let rec repeat_left lo hi a f acc = + if lo = hi then acc + else repeat_left (lo + 1) hi a f (f lo acc) + +let rec repeat_left_all_ml lo hi a f acc = + if lo = hi then acc + else repeat_left_all_ml (lo + 1) hi a f (f lo acc) + +let rec repeat_right lo hi a f acc = + if lo = hi then acc + else f (hi - 1) (repeat_right lo (hi - 1) a f acc) + +let rec repeat_right_all_ml lo hi a f acc = + if lo = hi then acc + else f (hi - 1) (repeat_right_all_ml lo (hi - 1) a f acc) + +let rec repeat_right_plus lo mi hi a f acc = + if hi = mi then () + else repeat_right_plus lo mi (hi - 1) a f acc + +let unfold_repeat_right lo hi a f acc0 i = () + +let eq_repeat_right lo hi a f acc0 = () + +let rec repeat_left_right lo hi a f acc = + if lo = hi then () + else + begin + repeat_right_plus lo (lo + 1) hi a f acc; + repeat_left_right (lo + 1) hi a f (f lo acc) + end + +let repeat_gen n a f acc0 = + repeat_right 0 n a f acc0 + +let repeat_gen_all_ml n a f acc0 = + repeat_right_all_ml 0 n a f acc0 + +let unfold_repeat_gen n a f acc0 i = () +(* // Proof when using [repeat_left]: + repeat_left_right 0 (i + 1) a f acc0; + repeat_left_right 0 i a f acc0 +*) + +let eq_repeat_gen0 n a f acc0 = () + +let repeat_gen_def n a f acc0 = () + +let repeati #a n f acc0 = + repeat_gen n (fixed_a a) f acc0 + +let repeati_all_ml #a n f acc0 = + repeat_gen_all_ml n (fixed_a a) f acc0 + +let eq_repeati0 #a n f acc0 = () + +let unfold_repeati #a n f acc0 i = + unfold_repeat_gen n (fixed_a a) f acc0 i + +let repeati_def #a n f acc0 = () + +let repeat #a n f acc0 = + repeati n (fixed_i f) acc0 + +let eq_repeat0 #a f acc0 = () + +let unfold_repeat #a n f acc0 i = + unfold_repeati #a n (fixed_i f) acc0 i + + +let repeat_range #a min max f x = + repeat_left min max (fun _ -> a) f x + +let repeat_range_all_ml #a min max f x = + repeat_left_all_ml min max (fun _ -> a) f x + +let repeat_range_inductive #a min max pred f x = + repeat_left min max (fun i -> x:a{pred i x}) f x + +let repeati_inductive #a n pred f x0 = + repeat_range_inductive #a 0 n pred f x0 + +let unfold_repeat_right_once + (lo:nat) + (hi:nat{lo < hi}) + (a:(i:nat{lo <= i /\ i <= hi} -> Type)) + (f:(i:nat{lo <= i /\ i < hi} -> a i -> a (i + 1))) + (acc:a lo) + : Lemma (repeat_right lo hi a f acc == + f (hi - 1) (repeat_right lo (hi - 1) a f acc)) + = () + +module T = FStar.Tactics + +let refine_eq (a:Type) (p q:a -> prop) (x:squash (forall (i:a). p i <==> q i)) + : Lemma ((i:a{p i} == i:a{q i})) + = let pext (a:Type) (p q: a -> prop) (_:squash (forall (x:a). p x <==> q x)) (x:a) : Lemma (p x == q x) + = FStar.PropositionalExtensionality.apply (p x) (q x) + in + assert (i:a{p i} == i:a{q i}) + by (T.l_to_r [quote (pext a p q x)]; T.trefl()) + +let nat_refine_equiv (n:nat) + : Lemma ((i:nat{i <= n}) == (i:nat{0<=i /\ i<=n})) + = let b2t_prop (b:bool) + : Lemma ((b2t b) `subtype_of` unit) + = assert_norm (b2t b == squash (equals b true)) + in + refine_eq nat (fun (i:nat) -> b2t_prop (i <= n); b2t (i <= n)) (fun (i:nat) -> 0 <= i /\ i <= n) () + +let a' (#a:Type) (n:nat) (pred:(i:nat{i <= n} -> a -> Type)) = fun (i:nat{i<=n}) -> x:a{pred i x} + +let repeati_repeat_left_rewrite_type (#a:Type) (n:nat) (pred:(i:nat{i <= n} -> a -> Type)) + (f:repeatable #a #n pred) + (x0:a{pred 0 x0}) + : Lemma (repeati_inductive n pred f x0 == + repeat_left 0 n (a' n pred) f x0) + = assert (repeati_inductive n pred f x0 == + repeat_left 0 n (a' n pred) f x0) + by (T.norm [delta_only [`%repeati_inductive; + `%repeat_range_inductive; + `%a']]; + T.l_to_r [`nat_refine_equiv]; + T.trefl()) + +(* This proof is technical, for multiple reasons. + + 1. It requires an extensionality lemma at the level to types to + relate the type of a dependent function and an eta expansion of + that type + + 2. It requires an extensionality lemma at the level of the + computation, which also introduces an eta expansion on f to + retype it + + 3. The retyping introduces a function type at a different by + propositional equal domain, so it requires a use of rewriting + based on propositional extensionality to prove that the retyping + is benign + + The proof was simpler earlier, when F* had eta + equivalence. But the use of eta reduction in the SMT encoding which + this was relying on was a bit dodgy. In particular, the eta + reduction hid the retyping and so was silently (and + unintentionally) also enabling the use of propositional + extensionality. Now, that has to be explicit. +*) +let repeati_inductive_repeat_gen #a n pred f x0 = + let eta_a n (a:(i:nat{0 <= i /\ i <= n} -> Type)) = fun i -> a i in + let eta_f (f:repeatable #a #n pred) (i:nat{i < n}) (x:a' n pred i) : a' n pred (i + 1) = f i x in + let rec repeat_right_eta + (n:nat) + (hi:nat{hi <= n}) + (a:(i:nat{0 <= i /\ i <= n} -> Type)) + (f:(i:nat{0 <= i /\ i < n} -> a i -> a (i + 1))) + (acc:a 0) + : Lemma (ensures repeat_right 0 hi a f acc == repeat_right 0 hi (eta_a n a) f acc) + (decreases hi) + = if hi = 0 + then () + else (repeat_right_eta n (hi - 1) a f acc) + in + repeat_right_eta n n (a' n pred) (eta_f f) x0; + assert (repeat_gen n (fun i -> x:a{pred i x}) f x0 == + repeat_right 0 n (fun (i:nat{i <= n}) -> x:a{pred i x}) f x0) + by (T.norm [delta_only [`%repeat_gen]]; + T.trefl()); + assert_norm (a' n pred == (fun (i:nat{i <= n}) -> x:a{pred i x})); + assert (repeat_right 0 n (fun (i:nat{i <= n}) -> x:a{pred i x}) f x0 == + repeat_right 0 n (a' n pred) f x0); + let rec repeat_right_eta_f + (hi:nat{hi <= n}) + (acc:a' n pred 0) + : Lemma (ensures repeat_right 0 hi (a' n pred) f acc == + repeat_right 0 hi (a' n pred) (eta_f f) acc) + (decreases hi) + = if hi = 0 + then () + else (repeat_right_eta_f (hi - 1) acc) + in + repeati_repeat_left_rewrite_type n pred f x0; + assert (repeati_inductive n pred f x0 == + repeat_left 0 n (a' n pred) f x0); + repeat_left_right 0 n (a' n pred) f x0; + assert (repeat_left 0 n (a' n pred) f x0 == + repeat_right 0 n (a' n pred) f x0); + repeat_right_eta_f n x0 + + +let repeat_gen_inductive n a pred f x0 = + let f' (i:nat{i < n}) + (x:a i{pred i x /\ x == repeat_gen i a f x0}) + : x':a (i + 1){pred (i + 1) x' /\ x' == repeat_gen (i + 1) a f x0} + = f i x in + repeat_gen n (fun i -> x:a i{pred i x /\ x == repeat_gen i a f x0}) f' x0 + +let repeati_inductive' #a n pred f x0 = + let f' + (i:nat{i < n}) + (x:a{pred i x /\ x == repeati i f x0}) + : x':a{pred (i + 1) x' /\ x' == repeati (i + 1) f x0} + = f i x in + repeat_gen n (fun i -> x:a{pred i x /\ x == repeati i f x0}) f' x0 diff --git a/tests/hacl/Lib.LoopCombinators.fst.hints b/tests/hacl/Lib.LoopCombinators.fst.hints new file mode 100644 index 00000000000..7eaef893c2c --- /dev/null +++ b/tests/hacl/Lib.LoopCombinators.fst.hints @@ -0,0 +1,1299 @@ +[ + "üt?£Ô•å\u0005%dn²Ü'|", + [ + [ + "Lib.LoopCombinators.repeat_left", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "42d23e335d6b280831add0d597fe8a9f" + ], + [ + "Lib.LoopCombinators.repeat_left", + 2, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", + "Prims_pretyping_ae567c2fb75be05905677af440075565", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_1", + "binder_x_ef3cff77d20be12dde95f0777a90f70e_2", + "equation_Prims.eqtype", "equation_Prims.nat", + "function_token_typing_Prims.__cache_version_number__", + "function_token_typing_Prims.int", + "haseqTm_refine_542f9d4f129664613f2483a6c88bc7c2", "int_inversion", + "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Equality", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_2eb00ca989f9ebed0ed65e52a78766e7", + "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "well-founded-ordering-on-nat" + ], + 0, + "1307a808ed7f6454f185f3d1ef21c68e" + ], + [ + "Lib.LoopCombinators.repeat_left", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "f309da575b493602dd12b4d3fb97f12d" + ], + [ + "Lib.LoopCombinators.repeat_left_all_ml", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "47dae627966f1a2847fe08179a627cca" + ], + [ + "Lib.LoopCombinators.repeat_left_all_ml", + 2, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.eqtype", + "equation_Prims.nat", + "fuel_guarded_inversion_FStar.Pervasives.result", + "function_token_typing_Prims.int", + "haseqTm_refine_542f9d4f129664613f2483a6c88bc7c2", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Equality", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913" + ], + 0, + "09fccd65d1c1deab8168f08fd0e38c2e" + ], + [ + "Lib.LoopCombinators.repeat_left_all_ml", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "bdb464c52aa6d420bfb230631414ff38" + ], + [ + "Lib.LoopCombinators.repeat_right", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "11bfd416bebe9c6ce56462e30ae41258" + ], + [ + "Lib.LoopCombinators.repeat_right", + 2, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", + "Prims_pretyping_ae567c2fb75be05905677af440075565", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_1", + "binder_x_ef3cff77d20be12dde95f0777a90f70e_2", + "equation_Prims.eqtype", "equation_Prims.nat", + "function_token_typing_Prims.__cache_version_number__", + "function_token_typing_Prims.int", + "haseqTm_refine_542f9d4f129664613f2483a6c88bc7c2", "int_inversion", + "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Equality", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_2eb00ca989f9ebed0ed65e52a78766e7", + "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "well-founded-ordering-on-nat" + ], + 0, + "eb8947142f7aa0989bc3fda9268b099a" + ], + [ + "Lib.LoopCombinators.repeat_right", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "a60674830bbb72ae2aa198d48f8c7ffe" + ], + [ + "Lib.LoopCombinators.repeat_right_all_ml", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "dd4f80d0e603d278671c790fa8f82ec3" + ], + [ + "Lib.LoopCombinators.repeat_right_all_ml", + 2, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.eqtype", + "equation_Prims.nat", + "fuel_guarded_inversion_FStar.Pervasives.result", + "function_token_typing_Prims.int", + "haseqTm_refine_542f9d4f129664613f2483a6c88bc7c2", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Equality", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795" + ], + 0, + "a10c05ba359900cc3167262131a3d231" + ], + [ + "Lib.LoopCombinators.repeat_right_all_ml", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "bdb464c52aa6d420bfb230631414ff38" + ], + [ + "Lib.LoopCombinators.repeat_right_plus", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "9d0232c8f38c44386450065fd455b63f" + ], + [ + "Lib.LoopCombinators.repeat_right_plus", + 2, + 2, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@fuel_irrelevance_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "Lib.LoopCombinators_interpretation_Tm_arrow_475c5d8500e6c5accacf8430e17609c1", + "Lib.LoopCombinators_interpretation_Tm_arrow_d923f15fa51c1adf198e41a2a2b838b8", + "binder_x_1643872395c8718ea40fbc2752387c4d_5", + "binder_x_9c1467c8a1dc9d1a9cfdd135b2fced70_3", + "binder_x_af5edae8b4ff911e6a823e510ac6c756_6", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_1", + "binder_x_e1b475a8738f7fad7118cc46529602ed_4", + "binder_x_ef3cff77d20be12dde95f0777a90f70e_2", + "equation_Prims.eqtype", "equation_Prims.nat", + "equation_with_fuel_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "function_token_typing_Prims.int", + "haseqTm_refine_542f9d4f129664613f2483a6c88bc7c2", "int_inversion", + "int_typing", "primitive_Prims.op_Equality", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_2eb00ca989f9ebed0ed65e52a78766e7", + "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_64e0884aedfcc28624ca5710ec89a7e4", + "refinement_interpretation_Tm_refine_94b4e5d3116d0fdc2008285d6fe3b144", + "refinement_interpretation_Tm_refine_9f4b8102951be8af6f4ece9f995f631e", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795", + "typing_Lib.LoopCombinators.repeat_right", + "well-founded-ordering-on-nat" + ], + 0, + "a137c6d8e5f596d91b56f42f547eefeb" + ], + [ + "Lib.LoopCombinators.repeat_right_plus", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "5241d5e3cefac13fae120a1f9ace42da" + ], + [ + "Lib.LoopCombinators.unfold_repeat_right", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "ac9c2bb342d3d8dd79f60b8e3a6769cd" + ], + [ + "Lib.LoopCombinators.unfold_repeat_right", + 2, + 2, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@fuel_irrelevance_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "equation_Prims.nat", + "equation_with_fuel_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "int_inversion", "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Equality", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795" + ], + 0, + "f171e7e5272d108a26fe6c437dde2cd4" + ], + [ + "Lib.LoopCombinators.unfold_repeat_right", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "a0ccb861a71bc47b569ef13a06bdb1e2" + ], + [ + "Lib.LoopCombinators.eq_repeat_right", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "51042d47a5e2cac57e0a40edde2ba35f" + ], + [ + "Lib.LoopCombinators.eq_repeat_right", + 2, + 2, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "equation_Prims.nat", + "equation_with_fuel_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "int_inversion", "primitive_Prims.op_Equality", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795" + ], + 0, + "d9fd8b40efad65b255ca3bf11b1bf65c" + ], + [ + "Lib.LoopCombinators.eq_repeat_right", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "a0ccb861a71bc47b569ef13a06bdb1e2" + ], + [ + "Lib.LoopCombinators.repeat_left_right", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "0fd7a93741cee0204ded991972f24a08" + ], + [ + "Lib.LoopCombinators.repeat_left_right", + 2, + 2, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Lib.LoopCombinators.repeat_left.fuel_instrumented", + "@fuel_correspondence_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@fuel_irrelevance_Lib.LoopCombinators.repeat_left.fuel_instrumented", + "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "Lib.LoopCombinators_interpretation_Tm_arrow_73e03d6f682a7e8a0e2e4caa6e7e006f", + "Lib.LoopCombinators_interpretation_Tm_arrow_e54f60146c15ffc3c6fdfdf188f36184", + "Prims_pretyping_ae567c2fb75be05905677af440075565", + "binder_x_15a2a2aa213729b179fdecca4d6d5fcf_5", + "binder_x_57098d7a08a5c655d3e755e495233706_3", + "binder_x_61db9e95f5c6e22c0f798a9af5990a12_4", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_1", + "binder_x_ef3cff77d20be12dde95f0777a90f70e_2", + "equation_Prims.eqtype", "equation_Prims.nat", + "equation_with_fuel_Lib.LoopCombinators.repeat_left.fuel_instrumented", + "equation_with_fuel_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "function_token_typing_Prims.__cache_version_number__", + "function_token_typing_Prims.int", + "haseqTm_refine_542f9d4f129664613f2483a6c88bc7c2", "int_inversion", + "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Equality", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_2eb00ca989f9ebed0ed65e52a78766e7", + "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_5a9b6c458d60ee3d78bcb9cb8e632018", + "refinement_interpretation_Tm_refine_68812a9442c7946d522ecd05c6a1a9af", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795", + "well-founded-ordering-on-nat" + ], + 0, + "58a194224313f3e0929e898909503f6e" + ], + [ + "Lib.LoopCombinators.repeat_left_right", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "0713b9b066ae8981515276eed533d77b" + ], + [ + "Lib.LoopCombinators.repeat_gen", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "be7a6a147a0fafc2274d790d620fcefe" + ], + [ + "Lib.LoopCombinators.repeat_gen", + 2, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "3224e75d8064500709a0f824d69c7eaa" + ], + [ + "Lib.LoopCombinators.repeat_gen", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "2222842d8d3b083fc76c5a333087ddfa" + ], + [ + "Lib.LoopCombinators.repeat_gen_all_ml", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "e6c97eec7a540c912b9cb071cad3417a" + ], + [ + "Lib.LoopCombinators.repeat_gen_all_ml", + 2, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "0e67515adb428bb310fe49abc9c2d8ec" + ], + [ + "Lib.LoopCombinators.repeat_gen_all_ml", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "d57e348dfdc73dd1fca38436d72de847" + ], + [ + "Lib.LoopCombinators.unfold_repeat_gen", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "4d82b5454862b6f95f53e98c2d7aaa7f" + ], + [ + "Lib.LoopCombinators.unfold_repeat_gen", + 2, + 2, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@fuel_irrelevance_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "Lib.LoopCombinators_interpretation_Tm_arrow_d14b5cd1226e414731f21670beedcc84", + "Lib.LoopCombinators_interpretation_Tm_arrow_f77e174321f3ceca78193a141927037b", + "equation_Lib.LoopCombinators.repeat_gen", "equation_Prims.nat", + "equation_with_fuel_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "int_inversion", "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Equality", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795" + ], + 0, + "bbdfab59888d5784b4f41c25da9f9cc0" + ], + [ + "Lib.LoopCombinators.unfold_repeat_gen", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "d52678dd1849e665972f2e48cdc71297" + ], + [ + "Lib.LoopCombinators.eq_repeat_gen0", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "929cbb1edc9c891c7e15c2f726e82351" + ], + [ + "Lib.LoopCombinators.eq_repeat_gen0", + 2, + 2, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "Lib.LoopCombinators_interpretation_Tm_arrow_d14b5cd1226e414731f21670beedcc84", + "Lib.LoopCombinators_interpretation_Tm_arrow_f77e174321f3ceca78193a141927037b", + "equation_Lib.LoopCombinators.repeat_gen", "equation_Prims.nat", + "equation_with_fuel_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "int_inversion", "int_typing", "primitive_Prims.op_Equality", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795" + ], + 0, + "b322355d7af6072fe02c85d6806017ea" + ], + [ + "Lib.LoopCombinators.eq_repeat_gen0", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "d52678dd1849e665972f2e48cdc71297" + ], + [ + "Lib.LoopCombinators.repeat_gen_def", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "d7f01c29d0419205f870dd448bccaf64" + ], + [ + "Lib.LoopCombinators.repeat_gen_def", + 2, + 2, + 1, + [ "@query", "equation_Lib.LoopCombinators.repeat_gen" ], + 0, + "095e7fef79d47ec26b9eb7a7249c24c5" + ], + [ + "Lib.LoopCombinators.repeat_gen_def", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "d52678dd1849e665972f2e48cdc71297" + ], + [ + "Lib.LoopCombinators.eq_repeati0", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "046db2132a7d870326abb99b274f524c" + ], + [ + "Lib.LoopCombinators.eq_repeati0", + 2, + 2, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@query", + "FStar.List.Tot.Properties_interpretation_Tm_arrow_67c7b2626869cb316f118144000415b9", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "Lib.LoopCombinators_interpretation_Tm_arrow_c3cac0eaa5a8b41e6eb23c42c4532cc2", + "equation_Lib.LoopCombinators.fixed_a", + "equation_Lib.LoopCombinators.repeat_gen", + "equation_Lib.LoopCombinators.repeati", "equation_Prims.nat", + "equation_with_fuel_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "function_token_typing_Lib.LoopCombinators.fixed_a", "int_typing", + "primitive_Prims.op_Equality", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795", + "token_correspondence_Lib.LoopCombinators.fixed_a" + ], + 0, + "d6f183c98d7a6afc964187d0c765b8b6" + ], + [ + "Lib.LoopCombinators.unfold_repeati", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "16c18daf88c7ef4e7d19c92badfc45ac" + ], + [ + "Lib.LoopCombinators.unfold_repeati", + 2, + 2, + 1, + [ + "@query", "equation_Lib.LoopCombinators.repeati", + "primitive_Prims.op_Addition" + ], + 0, + "8f65debb5f082da91267766436b14847" + ], + [ + "Lib.LoopCombinators.repeati_def", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "bd786419a577a7005f4e241ff8220ace" + ], + [ + "Lib.LoopCombinators.repeati_def", + 2, + 2, + 1, + [ + "@query", "equation_Lib.LoopCombinators.repeat_gen", + "equation_Lib.LoopCombinators.repeati" + ], + 0, + "e84d4ae365e979edac6d616b661b2274" + ], + [ + "Lib.LoopCombinators.eq_repeat0", + 1, + 2, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@query", + "FStar.List.Tot.Properties_interpretation_Tm_arrow_67c7b2626869cb316f118144000415b9", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "Lib.LoopCombinators_interpretation_Tm_arrow_bfe22415bc48790397b6e21fcc88873f", + "equation_Lib.LoopCombinators.fixed_a", + "equation_Lib.LoopCombinators.repeat", + "equation_Lib.LoopCombinators.repeat_gen", + "equation_Lib.LoopCombinators.repeati", "equation_Prims.nat", + "equation_with_fuel_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "function_token_typing_Lib.LoopCombinators.fixed_a", + "function_token_typing_Lib.LoopCombinators.fixed_i", "int_typing", + "kinding_Tm_arrow_fcd589b21e6efcf1e5d17b07c282a015", + "primitive_Prims.op_Equality", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795", + "token_correspondence_Lib.LoopCombinators.fixed_a" + ], + 0, + "f5de0c84eaac1537d2f6aa205a9a78ca" + ], + [ + "Lib.LoopCombinators.unfold_repeat", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "d6dc2dd32b539245a4545fc80ffa9789" + ], + [ + "Lib.LoopCombinators.unfold_repeat", + 2, + 2, + 1, + [ + "@query", "equation_Lib.LoopCombinators.fixed_i", + "equation_Lib.LoopCombinators.repeat", "primitive_Prims.op_Addition", + "token_correspondence_Lib.LoopCombinators.fixed_i" + ], + 0, + "2d42eb7b7d777aee941e2d821196f63f" + ], + [ + "Lib.LoopCombinators.repeat_range", + 1, + 2, + 1, + [ "@query" ], + 0, + "3ce4704c270119d40f88ceb3587230a9" + ], + [ + "Lib.LoopCombinators.repeat_range_all_ml", + 1, + 2, + 1, + [ "@query" ], + 0, + "e2a1008ceb72c31d4b9c81a6cd2eaf77" + ], + [ + "Lib.LoopCombinators.repeatable", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "02d14827909e51ef0e384040eae92b7f" + ], + [ + "Lib.LoopCombinators.repeat_range_inductive", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913" + ], + 0, + "25cb649ef24121040c48a5b3d3f08683" + ], + [ + "Lib.LoopCombinators.repeat_range_inductive", + 2, + 2, + 1, + [ "@query" ], + 0, + "9c0bfe78289541ddb04bb655f0ff4cab" + ], + [ + "Lib.LoopCombinators.repeat_range_inductive", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913" + ], + 0, + "49086262ac8d86b397030cb44717775e" + ], + [ + "Lib.LoopCombinators.repeati_inductive", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "8061750c130c1a1647b5463343a389b4" + ], + [ + "Lib.LoopCombinators.repeati_inductive", + 2, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "2ae8e4a584123f5793c9817a36e6ca7a" + ], + [ + "Lib.LoopCombinators.repeati_inductive", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "511cd09a2e32914da722d2b7c8b232a9" + ], + [ + "Lib.LoopCombinators.unfold_repeat_right_once", + 1, + 2, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@fuel_irrelevance_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@query", "equation_Prims.nat", + "equation_with_fuel_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Equality", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_8233d76b57e95451540fc312b717fa79" + ], + 0, + "945afb8831af90fab5d06113cc935a6e" + ], + [ + "Lib.LoopCombinators.unfold_repeat_right_once", + 2, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_8233d76b57e95451540fc312b717fa79", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "4b663a34c19381841c547160a0c5eb2c" + ], + [ + "Lib.LoopCombinators.refine_eq", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_8b5d7075e8d63d9e18f39f46674687aa", + "true_interp" + ], + 0, + "1b4b5422a1d8cdc4ffaad7adc3f3f700" + ], + [ + "Lib.LoopCombinators.nat_refine_equiv", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.eq2", + "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "48dfb8e7d5bccd4a95057207cf4a16e7" + ], + [ + "Lib.LoopCombinators.repeati_repeat_left_rewrite_type", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "true_interp" + ], + 0, + "d383a938d1de89630009a2a1c300e87d" + ], + [ + "Lib.LoopCombinators.repeati_repeat_left_rewrite_type", + 2, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "351f1ac182a8efacf557afa1b5332c08" + ], + [ + "Lib.LoopCombinators.repeati_inductive_repeat_gen", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "b322ceb7328740d0e7361b7f4ac00fa0" + ], + [ + "Lib.LoopCombinators.repeati_inductive_repeat_gen", + 2, + 2, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@fuel_irrelevance_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "Lib.LoopCombinators_interpretation_Tm_arrow_3b60d90eb1b4e399c18b4b5c4092aefc", + "Lib.LoopCombinators_interpretation_Tm_arrow_42cbb8cae27472bfb50ad5eaa9ec2207", + "Lib.LoopCombinators_interpretation_Tm_arrow_8ccff8122f730b53066e07670f458695", + "Lib.LoopCombinators_interpretation_Tm_arrow_9228bb88100b5a0762d39b5c83174ad9", + "Lib.LoopCombinators_interpretation_Tm_arrow_a5015036cf1762e788e4ccbba6a8d538", + "Prims_pretyping_ae567c2fb75be05905677af440075565", + "equation_Prims.nat", + "equation_with_fuel_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "function_token_typing_Lib.LoopCombinators.a_", + "function_token_typing_Prims.__cache_version_number__", + "int_inversion", "int_typing", + "interpretation_Tm_abs_0e3034507692d95678dac3878d3c5d27", + "interpretation_Tm_abs_0ec465d1eb90963fef662a39d2cdb931", + "interpretation_Tm_abs_b095b3f008ad7213e01e88a9397b957d", + "interpretation_Tm_abs_d0296986d3220e0e72a50647421bdfbe", + "primitive_Prims.op_Addition", "primitive_Prims.op_Equality", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_08698b4b6e166624b5bf789ac071b4cf", + "refinement_interpretation_Tm_refine_0f5d287096bf7dd24d582019e4d18f0c", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_909c0555fed853bc5dc1098d3dd63f21", + "refinement_interpretation_Tm_refine_96e65b2359ce32ff1f5ca9648c355aa6", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795", + "refinement_interpretation_Tm_refine_fe46d1f42dd7ff873261424112f10419", + "refinement_kinding_Tm_refine_08698b4b6e166624b5bf789ac071b4cf", + "token_correspondence_Lib.LoopCombinators.a_", "true_interp", + "typing_Tm_abs_0ec465d1eb90963fef662a39d2cdb931", + "well-founded-ordering-on-nat" + ], + 0, + "208614e84cb01a5ff62e01bb7c3bd913" + ], + [ + "Lib.LoopCombinators.repeati_inductive_repeat_gen", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "511cd09a2e32914da722d2b7c8b232a9" + ], + [ + "Lib.LoopCombinators.preserves_predicate", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "2f547665e150e9bf0def438813b15cfc" + ], + [ + "Lib.LoopCombinators.preserves_predicate", + 2, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "89f57e6701114d7a0ad02a5c5f3ed489" + ], + [ + "Lib.LoopCombinators.repeat_gen_inductive", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "fa5ca35e98a2e19142d640239b3073e4" + ], + [ + "Lib.LoopCombinators.repeat_gen_inductive", + 2, + 2, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@fuel_irrelevance_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "Lib.LoopCombinators_interpretation_Tm_arrow_d14b5cd1226e414731f21670beedcc84", + "Lib.LoopCombinators_interpretation_Tm_arrow_f77e174321f3ceca78193a141927037b", + "equation_Lib.LoopCombinators.preserves_predicate", + "equation_Lib.LoopCombinators.repeat_gen", "equation_Prims.nat", + "equation_with_fuel_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "int_inversion", "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Equality", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_695fc9bad57438f078f1918065bbd3eb", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795" + ], + 0, + "809cb3036bfa98d8212fc2475fc283a2" + ], + [ + "Lib.LoopCombinators.repeat_gen_inductive", + 3, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "df07a7d4139455328332292ade1cbd22" + ], + [ + "Lib.LoopCombinators.preserves", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "b125bc03f0526cfa8ab0d4526da1da1b" + ], + [ + "Lib.LoopCombinators.repeati_inductive'", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "e1c6e20ef6264f5706cd72c4cb68f740" + ], + [ + "Lib.LoopCombinators.repeati_inductive'", + 2, + 2, + 1, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@fuel_irrelevance_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "@query", + "FStar.List.Tot.Properties_interpretation_Tm_arrow_67c7b2626869cb316f118144000415b9", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "Lib.LoopCombinators_interpretation_Tm_arrow_c3cac0eaa5a8b41e6eb23c42c4532cc2", + "Lib.LoopCombinators_interpretation_Tm_arrow_f77e174321f3ceca78193a141927037b", + "equation_Lib.LoopCombinators.fixed_a", + "equation_Lib.LoopCombinators.preserves", + "equation_Lib.LoopCombinators.repeat_gen", + "equation_Lib.LoopCombinators.repeati", "equation_Prims.nat", + "equation_with_fuel_Lib.LoopCombinators.repeat_right.fuel_instrumented", + "function_token_typing_Lib.LoopCombinators.fixed_a", "int_inversion", + "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Equality", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_41aef3833b617e5c5b9322c9c48c2c29", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795", + "token_correspondence_Lib.LoopCombinators.fixed_a" + ], + 0, + "de1258d1303d84213b7737a1c3acf664" + ] + ] +] \ No newline at end of file diff --git a/tests/hacl/Lib.LoopCombinators.fsti b/tests/hacl/Lib.LoopCombinators.fsti new file mode 100644 index 00000000000..c82d45b79c4 --- /dev/null +++ b/tests/hacl/Lib.LoopCombinators.fsti @@ -0,0 +1,291 @@ +module Lib.LoopCombinators + +(** +* fold_left-like loop combinator: +* [ repeat_left lo hi a f acc == f (hi - 1) .. ... (f (lo + 1) (f lo acc)) ] +* +* e.g. [ repeat_left 0 3 (fun _ -> list int) Cons [] == [2;1;0] ] +* +* It satisfies +* [ repeat_left lo hi (fun _ -> a) f acc == fold_left (flip f) acc [lo..hi-1] ] +* +* A simpler variant with a non-dependent accumuator used to be called [repeat_range] +*) + +val repeat_left: + lo:nat + -> hi:nat{lo <= hi} + -> a:(i:nat{lo <= i /\ i <= hi} -> Type) + -> f:(i:nat{lo <= i /\ i < hi} -> a i -> a (i + 1)) + -> acc:a lo + -> Tot (a hi) (decreases (hi - lo)) + + +val repeat_left_all_ml: + lo:nat + -> hi:nat{lo <= hi} + -> a:(i:nat{lo <= i /\ i <= hi} -> Type) + -> f:(i:nat{lo <= i /\ i < hi} -> a i -> FStar.All.ML (a (i + 1))) + -> acc:a lo + -> FStar.All.ML (a hi) + +(** +* fold_right-like loop combinator: +* [ repeat_right lo hi a f acc == f (hi - 1) .. ... (f (lo + 1) (f lo acc)) ] +* +* e.g. [ repeat_right 0 3 (fun _ -> list int) Cons [] == [2;1;0] ] +* +* It satisfies +* [ repeat_right lo hi (fun _ -> a) f acc == fold_right f acc [hi-1..lo] ] +*) +val repeat_right: + lo:nat + -> hi:nat{lo <= hi} + -> a:(i:nat{lo <= i /\ i <= hi} -> Type) + -> f:(i:nat{lo <= i /\ i < hi} -> a i -> a (i + 1)) + -> acc:a lo + -> Tot (a hi) (decreases (hi - lo)) + +val repeat_right_all_ml: + lo:nat + -> hi:nat{lo <= hi} + -> a:(i:nat{lo <= i /\ i <= hi} -> Type) + -> f:(i:nat{lo <= i /\ i < hi} -> a i -> FStar.All.ML (a (i + 1))) + -> acc:a lo + -> FStar.All.ML (a hi) (decreases (hi - lo)) + +(** Splitting a repetition *) +val repeat_right_plus: + lo:nat + -> mi:nat{lo <= mi} + -> hi:nat{mi <= hi} + -> a:(i:nat{lo <= i /\ i <= hi} -> Type) + -> f:(i:nat{lo <= i /\ i < hi} -> a i -> a (i + 1)) + -> acc:a lo + -> Lemma (ensures + repeat_right lo hi a f acc == + repeat_right mi hi a f (repeat_right lo mi a f acc)) + (decreases hi) + +(** Unfolding one iteration *) +val unfold_repeat_right: + lo:nat + -> hi:nat{lo <= hi} + -> a:(i:nat{lo <= i /\ i <= hi} -> Type) + -> f:(i:nat{lo <= i /\ i < hi} -> a i -> a (i + 1)) + -> acc0:a lo + -> i:nat{lo <= i /\ i < hi} + -> Lemma ( + repeat_right lo (i + 1) a f acc0 == + f i (repeat_right lo i a f acc0)) + +val eq_repeat_right: + lo:nat + -> hi:nat{lo <= hi} + -> a:(i:nat{lo <= i /\ i <= hi} -> Type) + -> f:(i:nat{lo <= i /\ i < hi} -> a i -> a (i + 1)) + -> acc0:a lo + -> Lemma (repeat_right lo lo a f acc0 == acc0) + +(** +* [repeat_left] and [repeat_right] are equivalent. +* +* This follows from the third duality theorem +* [ fold_right f acc xs = fold_left (flip f) acc (reverse xs) ] +*) +val repeat_left_right: + lo:nat + -> hi:nat{lo <= hi} + -> a:(i:nat{lo <= i /\ i <= hi} -> Type) + -> f:(i:nat{lo <= i /\ i < hi} -> a i -> a (i + 1)) + -> acc:a lo + -> Lemma (ensures repeat_right lo hi a f acc == repeat_left lo hi a f acc) + (decreases (hi - lo)) + +(** +* Repetition starting from 0 +* +* Defined as [repeat_right] for convenience, but [repeat_left] may be more +* efficient when extracted to OCaml. +*) + +val repeat_gen: + n:nat + -> a:(i:nat{i <= n} -> Type) + -> f:(i:nat{i < n} -> a i -> a (i + 1)) + -> acc0:a 0 + -> a n + +val repeat_gen_all_ml: + n:nat + -> a:(i:nat{i <= n} -> Type) + -> f:(i:nat{i < n} -> a i -> FStar.All.ML (a (i + 1))) + -> acc0:a 0 + -> FStar.All.ML (a n) + +(** Unfolding one iteration *) +val unfold_repeat_gen: + n:nat + -> a:(i:nat{i <= n} -> Type) + -> f:(i:nat{i < n} -> a i -> a (i + 1)) + -> acc0:a 0 + -> i:nat{i < n} + -> Lemma (repeat_gen (i + 1) a f acc0 == f i (repeat_gen i a f acc0)) + +val eq_repeat_gen0: + n:nat + -> a:(i:nat{i <= n} -> Type) + -> f:(i:nat{i < n} -> a i -> a (i + 1)) + -> acc0:a 0 + -> Lemma (repeat_gen 0 a f acc0 == acc0) + +val repeat_gen_def: + n:nat + -> a:(i:nat{i <= n} -> Type) + -> f:(i:nat{i < n} -> a i -> a (i + 1)) + -> acc0:a 0 + -> Lemma (repeat_gen n a f acc0 == repeat_right 0 n a f acc0) + + +(** +* Repetition with a fixed accumulator type +*) + +let fixed_a (a:Type) (i:nat) = a + +let fixed_i f (i:nat) = f + +val repeati: + #a:Type + -> n:nat + -> f:(i:nat{i < n} -> a -> a) + -> acc0:a + -> a + +val repeati_all_ml: + #a:Type + -> n:nat + -> f:(i:nat{i < n} -> a -> FStar.All.ML a) + -> acc0:a + -> FStar.All.ML a + +val eq_repeati0: + #a:Type + -> n:nat + -> f:(i:nat{i < n} -> a -> a) + -> acc0:a + -> Lemma (repeati #a 0 f acc0 == acc0) + +(** Unfolding one iteration *) +val unfold_repeati: + #a:Type + -> n:nat + -> f:(i:nat{i < n} -> a -> a) + -> acc0:a + -> i:nat{i < n} + -> Lemma (repeati #a (i + 1) f acc0 == f i (repeati #a i f acc0)) + +val repeati_def: + #a:Type + -> n:nat + -> f:(i:nat{i < n} -> a -> a) + -> acc:a + -> Lemma (repeati n f acc == repeat_right 0 n (fixed_a a) f acc) + +val repeat: + #a:Type + -> n:nat + -> f:(a -> a) + -> acc0:a + -> a + +val eq_repeat0: + #a:Type + -> f:(a -> a) + -> acc0:a + -> Lemma (repeat #a 0 f acc0 == acc0) + +val unfold_repeat: + #a:Type + -> n:nat + -> f:(a -> a) + -> acc0:a + -> i:nat{i < n} + -> Lemma (repeat #a (i + 1) f acc0 == f (repeat #a i f acc0)) + +val repeat_range: + #a:Type + -> min:nat + -> max:nat{min <= max} + -> (s:nat{s >= min /\ s < max} -> a -> Tot a) + -> a + -> Tot a (decreases (max - min)) + +val repeat_range_all_ml: + #a:Type + -> min:nat + -> max:nat{min <= max} + -> (s:nat{s >= min /\ s < max} -> a -> FStar.All.ML a) + -> a + -> FStar.All.ML a + +unfold +type repeatable (#a:Type) (#n:nat) (pred:(i:nat{i <= n} -> a -> Tot Type)) = + i:nat{i < n} -> x:a{pred i x} -> y:a{pred (i+1) y} + +val repeat_range_inductive: + #a:Type + -> min:nat + -> max:nat{min <= max} + -> pred:(i:nat{i <= max} -> a -> Type) + -> f:repeatable #a #max pred + -> x0:a{pred min x0} + -> Tot (res:a{pred max res}) (decreases (max - min)) + +val repeati_inductive: + #a:Type + -> n:nat + -> pred:(i:nat{i <= n} -> a -> Type) + -> f:repeatable #a #n pred + -> x0:a{pred 0 x0} + -> res:a{pred n res} + +val repeati_inductive_repeat_gen: + #a:Type + -> n:nat + -> pred:(i:nat{i <= n} -> a -> Type) + -> f:repeatable #a #n pred + -> x0:a{pred 0 x0} + -> Lemma (repeati_inductive n pred f x0 == repeat_gen n (fun i -> x:a{pred i x}) f x0) + +type preserves_predicate (n:nat) + (a:(i:nat{i <= n} -> Type)) + (f:(i:nat{i < n} -> a i -> a (i + 1))) + (pred:(i:nat{i <= n} -> a i -> Tot Type))= + forall (i:nat{i < n}) (x:a i). pred i x ==> pred (i + 1) (f i x) + +val repeat_gen_inductive: + n:nat + -> a:(i:nat{i <= n} -> Type) + -> pred:(i:nat{i <= n} -> a i -> Type0) + -> f:(i:nat{i < n} -> a i -> a (i + 1)) + -> x0:a 0 + -> Pure (a n) + (requires preserves_predicate n a f pred /\ pred 0 x0) + (ensures fun res -> pred n res /\ res == repeat_gen n a f x0) + +type preserves (#a:Type) + (#n:nat) + (f:(i:nat{i < n} -> a -> a)) + (pred:(i:nat{i <= n} -> a -> Tot Type)) = + forall (i:nat{i < n}) (x:a). pred i x ==> pred (i + 1) (f i x) + +val repeati_inductive': + #a:Type + -> n:nat + -> pred:(i:nat{i <= n} -> a -> Type0) + -> f:(i:nat{i < n} -> a -> a) + -> x0:a + -> Pure a + (requires preserves #a #n f pred /\ pred 0 x0) + (ensures fun res -> pred n res /\ res == repeati n f x0) diff --git a/tests/hacl/Lib.LoopCombinators.fsti.hints b/tests/hacl/Lib.LoopCombinators.fsti.hints new file mode 100644 index 00000000000..cc43f57b89d --- /dev/null +++ b/tests/hacl/Lib.LoopCombinators.fsti.hints @@ -0,0 +1,383 @@ +[ + "!4É'd8Ï\u0013Á\"Ósøž——", + [ + [ + "Lib.LoopCombinators.repeat_left", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "839bd2597c54301db6a267d696592d12" + ], + [ + "Lib.LoopCombinators.repeat_left_all_ml", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "e9d6fa8fe9910d1dafbe524b8a519ec1" + ], + [ + "Lib.LoopCombinators.repeat_right", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "11bfd416bebe9c6ce56462e30ae41258" + ], + [ + "Lib.LoopCombinators.repeat_right_all_ml", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "8537cee7419a0dbff7ba6f201132dcfa" + ], + [ + "Lib.LoopCombinators.repeat_right_plus", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "098023b53fbe0a0cf21f8ca3fe7306a6" + ], + [ + "Lib.LoopCombinators.unfold_repeat_right", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "d1e2e52f5f35a9a5aa35ac8208bf8e85" + ], + [ + "Lib.LoopCombinators.eq_repeat_right", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "7252bda296e1e02ae519ce306f1a0ebe" + ], + [ + "Lib.LoopCombinators.repeat_left_right", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc" + ], + 0, + "a47e1af9d9759cf20b4b047f3ffea541" + ], + [ + "Lib.LoopCombinators.repeat_gen", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "123d7a4ac937bb148a355d571844003e" + ], + [ + "Lib.LoopCombinators.repeat_gen_all_ml", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "f511c47ed6ed0c20c576795e2792a70a" + ], + [ + "Lib.LoopCombinators.unfold_repeat_gen", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "883417d725fe16c26731a38b486d86f7" + ], + [ + "Lib.LoopCombinators.eq_repeat_gen0", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "be59e5fc1c93e424a26b605558b1a3e6" + ], + [ + "Lib.LoopCombinators.repeat_gen_def", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "4c5b07231938249ea16d30e204241399" + ], + [ + "Lib.LoopCombinators.eq_repeati0", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "350a3c637587dc8f780393b815af27a1" + ], + [ + "Lib.LoopCombinators.unfold_repeati", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "4f1bd5a264456699f5188b911672333b" + ], + [ + "Lib.LoopCombinators.repeati_def", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "4a8d037f4cfe1af2737a18b901c8a7e4" + ], + [ + "Lib.LoopCombinators.unfold_repeat", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "fa2326a9d4a46a36e5160e8d0ce94f33" + ], + [ + "Lib.LoopCombinators.repeatable", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "2bd27224e5de7273c18134faa07c620f" + ], + [ + "Lib.LoopCombinators.repeat_range_inductive", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913" + ], + 0, + "f68ddefcab6a7551484d851f055e8c6d" + ], + [ + "Lib.LoopCombinators.repeati_inductive", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "0444734b2a69655606da45bab8ed87cb" + ], + [ + "Lib.LoopCombinators.repeati_inductive_repeat_gen", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "ef93a8bce90c0358013ecc325ed4f1dc" + ], + [ + "Lib.LoopCombinators.preserves_predicate", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "2f547665e150e9bf0def438813b15cfc" + ], + [ + "Lib.LoopCombinators.preserves_predicate", + 2, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "89f57e6701114d7a0ad02a5c5f3ed489" + ], + [ + "Lib.LoopCombinators.repeat_gen_inductive", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "fa5ca35e98a2e19142d640239b3073e4" + ], + [ + "Lib.LoopCombinators.preserves", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "6a5117b0db999ebc66c9c08bac09b900" + ], + [ + "Lib.LoopCombinators.repeati_inductive'", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "e1c6e20ef6264f5706cd72c4cb68f740" + ] + ] +] \ No newline at end of file diff --git a/tests/hacl/Lib.Sequence.Lemmas.fst b/tests/hacl/Lib.Sequence.Lemmas.fst new file mode 100644 index 00000000000..c7941e93f86 --- /dev/null +++ b/tests/hacl/Lib.Sequence.Lemmas.fst @@ -0,0 +1,801 @@ +module Lib.Sequence.Lemmas + +open FStar.Mul +open Lib.IntTypes +open Lib.Sequence + +#set-options "--z3rlimit 30 --max_fuel 0 --max_ifuel 0 \ + --using_facts_from '-* +Prims +FStar.Pervasives +FStar.Math.Lemmas +FStar.Seq \ + +Lib.IntTypes +Lib.Sequence +Lib.Sequence.Lemmas +Lib.LoopCombinators'" + + +let rec repeati_extensionality #a n f g acc0 = + if n = 0 then begin + Loops.eq_repeati0 n f acc0; + Loops.eq_repeati0 n g acc0 end + else begin + Loops.unfold_repeati n f acc0 (n-1); + Loops.unfold_repeati n g acc0 (n-1); + repeati_extensionality #a (n-1) f g acc0 end + + +let rec repeat_right_extensionality n lo a_f a_g f g acc0 = + if n = 0 then begin + Loops.eq_repeat_right lo (lo + n) a_f f acc0; + Loops.eq_repeat_right lo (lo + n) a_g g acc0 end + else begin + Loops.unfold_repeat_right lo (lo + n) a_f f acc0 (lo + n - 1); + Loops.unfold_repeat_right lo (lo + n) a_g g acc0 (lo + n - 1); + repeat_right_extensionality (n - 1) lo a_f a_g f g acc0 end + + +let rec repeat_gen_right_extensionality n lo_g a_f a_g f g acc0 = + if n = 0 then begin + Loops.eq_repeat_right 0 n a_f f acc0; + Loops.eq_repeat_right lo_g (lo_g+n) a_g g acc0 end + else begin + Loops.unfold_repeat_right 0 n a_f f acc0 (n-1); + Loops.unfold_repeat_right lo_g (lo_g+n) a_g g acc0 (lo_g+n-1); + repeat_gen_right_extensionality (n-1) lo_g a_f a_g f g acc0 end + + +let repeati_right_extensionality #a n lo_g f g acc0 = + repeat_gen_right_extensionality n lo_g (Loops.fixed_a a) (Loops.fixed_a a) f g acc0 + + +let repeati_right_shift #a n f g acc0 = + let acc1 = g 0 acc0 in + repeati_right_extensionality n 1 f g acc1; + // Got: + // repeat_right 0 n (fun _ -> a) f acc1 == repeat_right 1 (n + 1) (fun _ -> a) g acc1 + Loops.repeati_def n f acc1; + // Got: + // repeati n f acc1 == repeat_right 0 n (fun _ -> a) f acc1 + Loops.repeat_right_plus 0 1 (n + 1) (Loops.fixed_a a) g acc0; + // Got: + // repeat_right 0 (n + 1) (fixed_a a) g acc0 == + // repeat_right 1 (n + 1) (fixed_a a) g (repeat_right 0 1 (fixed_a a) g acc0) + Loops.unfold_repeat_right 0 (n + 1) (Loops.fixed_a a) g acc0 0; + Loops.eq_repeat_right 0 (n + 1) (Loops.fixed_a a) g acc0; + Loops.repeati_def (n + 1) g acc0 + + +let repeat_gen_blocks_multi #inp_t blocksize mi hi n inp a f acc0 = + Loops.repeat_right mi (mi + n) a (repeat_gen_blocks_f blocksize mi hi n inp a f) acc0 + + +let lemma_repeat_gen_blocks_multi #inp_t blocksize mi hi n inp a f acc0 = () + + +let repeat_gen_blocks #inp_t #c blocksize mi hi inp a f l acc0 = + let len = length inp in + let nb = len / blocksize in + let rem = len % blocksize in + let blocks = Seq.slice inp 0 (nb * blocksize) in + let last = Seq.slice inp (nb * blocksize) len in + Math.Lemmas.cancel_mul_div nb blocksize; + let acc = repeat_gen_blocks_multi #inp_t blocksize mi hi nb blocks a f acc0 in + l (mi + nb) rem last acc + + +let lemma_repeat_gen_blocks #inp_t #c blocksize mi hi inp a f l acc0 = () + + +let repeat_gen_blocks_multi_extensionality_zero #inp_t blocksize mi hi_f hi_g n inp a_f a_g f g acc0 = + let f_rep = repeat_gen_blocks_f blocksize mi hi_f n inp a_f f in + let g_rep = repeat_gen_blocks_f blocksize 0 hi_g n inp a_g g in + repeat_gen_right_extensionality n mi a_g a_f g_rep f_rep acc0 + + +let repeat_gen_blocks_extensionality_zero #inp_t #c blocksize mi hi_f hi_g n inp a_f a_g f l_f g l_g acc0 = + let len = length inp in + let rem = len % blocksize in + Math.Lemmas.cancel_mul_div n blocksize; + Math.Lemmas.cancel_mul_mod n blocksize; + let blocks = Seq.slice inp 0 (n * blocksize) in + let block_l = Seq.slice inp (n * blocksize) len in + let acc_f = repeat_gen_blocks_multi blocksize mi hi_f n blocks a_f f acc0 in + let acc_g = repeat_gen_blocks_multi blocksize 0 hi_g n blocks a_g g acc0 in + + calc (==) { + repeat_gen_blocks blocksize mi hi_f inp a_f f l_f acc0; + (==) { } + l_f (mi + n) rem block_l acc_f; + (==) { repeat_gen_blocks_multi_extensionality_zero #inp_t blocksize mi hi_f hi_g n blocks a_f a_g f g acc0 } + l_f (mi + n) rem block_l acc_g; + (==) { } + l_g n rem block_l acc_g; + (==) { } + repeat_gen_blocks blocksize 0 hi_g inp a_g g l_g acc0; + } + + +let len0_div_bs blocksize len len0 = + let k = len0 / blocksize in + calc (==) { + k + (len - len0) / blocksize; + == { Math.Lemmas.lemma_div_exact len0 blocksize } + k + (len - k * blocksize) / blocksize; + == { Math.Lemmas.division_sub_lemma len blocksize k } + k + len / blocksize - k; + == { } + len / blocksize; + } + +#push-options "--z3rlimit 60" +let split_len_lemma0 blocksize n len0 = + let len = n * blocksize in + let len1 = len - len0 in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + Math.Lemmas.cancel_mul_mod n blocksize; + //assert (len % blocksize = 0); + + Math.Lemmas.lemma_mod_sub_distr len len0 blocksize; + //assert (len1 % blocksize = 0); + + Math.Lemmas.lemma_div_exact len0 blocksize; + //assert (n0 * blocksize = len0); + + Math.Lemmas.lemma_div_exact len1 blocksize; + //assert (n1 * blocksize = len1); + + len0_div_bs blocksize len len0 + //assert (n0 + n1 = n) +#pop-options + +let split_len_lemma blocksize len len0 = + let len1 = len - len0 in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + let n = len / blocksize in + + Math.Lemmas.lemma_mod_sub_distr len len0 blocksize; + //assert (len % blocksize = len1 % blocksize); + + Math.Lemmas.lemma_div_exact len0 blocksize; + //assert (n0 * blocksize = len0); + + len0_div_bs blocksize len len0 + //assert (n0 + n1 = n) + +//////////////////////// +// Start of proof of repeat_gen_blocks_multi_split lemma +//////////////////////// + +val aux_repeat_bf_s0: + #inp_t:Type0 + -> blocksize:size_pos + -> len0:nat{len0 % blocksize == 0} + -> mi:nat + -> hi:nat + -> n:nat{mi + n <= hi} + -> inp:seq inp_t{len0 <= length inp /\ length inp == n * blocksize} + -> a:(i:nat{i <= hi} -> Type) + -> f:(i:nat{i < hi} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> i:nat{mi <= i /\ i < mi + len0 / blocksize /\ i < hi} // i < hi is needed to type-check the definition + -> acc:a i -> + Lemma + (let len = length inp in + let n0 = len0 / blocksize in + split_len_lemma0 blocksize n len0; + + let t0 = Seq.slice inp 0 len0 in + let repeat_bf_s0 = repeat_gen_blocks_f blocksize mi hi n0 t0 a f in + let repeat_bf_t = repeat_gen_blocks_f blocksize mi hi n inp a f in + + repeat_bf_s0 i acc == repeat_bf_t i acc) + +let aux_repeat_bf_s0 #inp_t blocksize len0 mi hi n inp a f i acc = + let len = length inp in + let n0 = len0 / blocksize in + split_len_lemma0 blocksize n len0; + + let t0 = Seq.slice inp 0 len0 in + let repeat_bf_s0 = repeat_gen_blocks_f blocksize mi hi n0 t0 a f in + let repeat_bf_t = repeat_gen_blocks_f blocksize mi hi n inp a f in + + let i_b = i - mi in + Math.Lemmas.lemma_mult_le_right blocksize (i_b + 1) n; + let block = Seq.slice inp (i_b * blocksize) (i_b * blocksize + blocksize) in + assert (repeat_bf_t i acc == f i block acc); + + Math.Lemmas.lemma_mult_le_right blocksize (i_b + 1) n0; + Seq.slice_slice inp 0 len0 (i_b * blocksize) (i_b * blocksize + blocksize); + assert (repeat_bf_s0 i acc == f i block acc) + + +val aux_repeat_bf_s1: + #inp_t:Type0 + -> blocksize:size_pos + -> len0:nat{len0 % blocksize == 0} + -> mi:nat + -> hi:nat + -> n:nat{mi + n <= hi} + -> inp:seq inp_t{len0 <= length inp /\ length inp == n * blocksize} + -> a:(i:nat{i <= hi} -> Type) + -> f:(i:nat{i < hi} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> i:nat{mi + len0 / blocksize <= i /\ i < mi + n} + -> acc:a i -> + Lemma + (let len = length inp in + let len1 = len - len0 in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + split_len_lemma0 blocksize n len0; + + let t1 = Seq.slice inp len0 len in + let repeat_bf_s1 = repeat_gen_blocks_f blocksize (mi + n0) hi n1 t1 a f in + let repeat_bf_t = repeat_gen_blocks_f blocksize mi hi n inp a f in + + repeat_bf_s1 i acc == repeat_bf_t i acc) + +let aux_repeat_bf_s1 #inp_t blocksize len0 mi hi n inp a f i acc = + let len = length inp in + let len1 = len - len0 in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + split_len_lemma0 blocksize n len0; + + let t1 = Seq.slice inp len0 len in + let repeat_bf_s1 = repeat_gen_blocks_f blocksize (mi + n0) hi n1 t1 a f in + let repeat_bf_t = repeat_gen_blocks_f blocksize mi hi n inp a f in + + let i_b = i - mi in + Math.Lemmas.lemma_mult_le_right blocksize (i_b + 1) n; + let block = Seq.slice inp (i_b * blocksize) (i_b * blocksize + blocksize) in + assert (repeat_bf_t i acc == f i block acc); + + let i_b1 = i - mi - n0 in + calc (<=) { + i_b1 * blocksize + blocksize; + (<=) { Math.Lemmas.lemma_mult_le_right blocksize (i_b1 + 1) n1 } + n1 * blocksize; + (==) { Math.Lemmas.div_exact_r len1 blocksize } + len1; + }; + + calc (==) { + len0 + i_b1 * blocksize; + (==) { Math.Lemmas.div_exact_r len0 blocksize } + n0 * blocksize + i_b1 * blocksize; + (==) { Math.Lemmas.distributivity_add_left n0 i_b1 blocksize } + (n0 + i_b1) * blocksize; + }; + + Seq.slice_slice inp len0 len (i_b1 * blocksize) (i_b1 * blocksize + blocksize); + assert (repeat_bf_s1 i acc == f i block acc) + + +let repeat_gen_blocks_multi_split #inp_t blocksize len0 mi hi n inp a f acc0 = + let len = length inp in + let len1 = len - len0 in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + split_len_lemma0 blocksize n len0; + + let t0 = Seq.slice inp 0 len0 in + let t1 = Seq.slice inp len0 len in + + let repeat_bf_s0 = repeat_gen_blocks_f blocksize mi hi n0 t0 a f in + let repeat_bf_s1 = repeat_gen_blocks_f blocksize (mi + n0) hi n1 t1 a f in + let repeat_bf_t = repeat_gen_blocks_f blocksize mi hi n inp a f in + + let acc1 : a (mi + n0) = repeat_gen_blocks_multi blocksize mi hi n0 t0 a f acc0 in + //let acc2 = repeat_gen_blocks_multi blocksize (mi + n0) hi n1 t1 a f acc1 in + + calc (==) { + repeat_gen_blocks_multi blocksize mi hi n0 t0 a f acc0; + (==) { } + Loops.repeat_right mi (mi + n0) a repeat_bf_s0 acc0; + (==) { Classical.forall_intro_2 (aux_repeat_bf_s0 #inp_t blocksize len0 mi hi n inp a f); + repeat_right_extensionality n0 mi a a repeat_bf_s0 repeat_bf_t acc0 } + Loops.repeat_right mi (mi + n0) a repeat_bf_t acc0; + }; + + calc (==) { + repeat_gen_blocks_multi blocksize (mi + n0) hi n1 t1 a f acc1; + (==) { } + Loops.repeat_right (mi + n0) (mi + n) a repeat_bf_s1 acc1; + (==) { Classical.forall_intro_2 (aux_repeat_bf_s1 #inp_t blocksize len0 mi hi n inp a f); + repeat_right_extensionality n1 (mi + n0) a a repeat_bf_s1 repeat_bf_t acc1 } + Loops.repeat_right (mi + n0) (mi + n) a repeat_bf_t acc1; + (==) { Loops.repeat_right_plus mi (mi + n0) (mi + n) a repeat_bf_t acc0 } + Loops.repeat_right mi (mi + n) a repeat_bf_t acc0; + (==) { } + repeat_gen_blocks_multi blocksize mi hi n inp a f acc0; + } + +//////////////////////// +// End of proof of repeat_gen_blocks_multi_split lemma +//////////////////////// + + +val repeat_gen_blocks_multi_split_slice: + #inp_t:Type0 + -> blocksize:size_pos + -> len0:nat{len0 % blocksize == 0} + -> mi:nat + -> hi:nat + -> inp:seq inp_t{len0 <= length inp / blocksize * blocksize /\ mi + length inp / blocksize <= hi} + -> a:(i:nat{i <= hi} -> Type) + -> f:(i:nat{i < hi} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> acc0:a mi -> + Lemma + (let len = length inp in + let len1 = len - len0 in + let n = len / blocksize in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + split_len_lemma blocksize len len0; + split_len_lemma0 blocksize n len0; + + let blocks = Seq.slice inp 0 (n * blocksize) in + let t0 = Seq.slice inp 0 len0 in + let t1 = Seq.slice inp len0 (n * blocksize) in + + let acc1 : a (mi + n0) = repeat_gen_blocks_multi blocksize mi hi n0 t0 a f acc0 in + repeat_gen_blocks_multi blocksize mi hi n blocks a f acc0 == + repeat_gen_blocks_multi blocksize (mi + n0) hi n1 t1 a f acc1) + +let repeat_gen_blocks_multi_split_slice #inp_t blocksize len0 mi hi inp a f acc0 = + let len = length inp in + let n = len / blocksize in + split_len_lemma blocksize len len0; + let blocks = Seq.slice inp 0 (n * blocksize) in + split_len_lemma0 blocksize n len0; + repeat_gen_blocks_multi_split blocksize len0 mi hi n blocks a f acc0 + + +val slice_slice_last: + #inp_t:Type0 + -> blocksize:size_pos + -> len0:nat{len0 % blocksize = 0} + -> inp:seq inp_t{len0 <= length inp} -> + Lemma + (let len = length inp in + let len1 = len - len0 in + let n = len / blocksize in + let n1 = len1 / blocksize in + let t1 = Seq.slice inp len0 len in + Seq.slice t1 (n1 * blocksize) len1 `Seq.equal` + Seq.slice inp (n * blocksize) len) + +let slice_slice_last #inp_t blocksize len0 inp = + let len = length inp in + let len1 = len - len0 in + let n = len / blocksize in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + + calc (==) { + len0 + n1 * blocksize; + (==) { len0_div_bs blocksize len len0 } + len0 + (n - n0) * blocksize; + (==) { Math.Lemmas.distributivity_sub_left n n0 blocksize } + len0 + n * blocksize - n0 * blocksize; + (==) { Math.Lemmas.div_exact_r len0 blocksize } + n * blocksize; + }; + + let t1 = Seq.slice inp len0 len in + Seq.slice_slice inp len0 len (n1 * blocksize) len1 + + +val len0_le_len_fraction: blocksize:pos -> len:nat -> len0:nat -> + Lemma + (requires len0 <= len /\ len0 % blocksize = 0) + (ensures len0 <= len / blocksize * blocksize) + +let len0_le_len_fraction blocksize len len0 = + Math.Lemmas.lemma_div_le len0 len blocksize; + Math.Lemmas.lemma_mult_le_right blocksize (len0 / blocksize) (len / blocksize) + +#push-options "--z3rlimit 100" +let repeat_gen_blocks_split #inp_t #c blocksize len0 hi mi inp a f l acc0 = + let len = length inp in + let len1 = len - len0 in + let n = len / blocksize in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + len0_le_len_fraction blocksize len len0; + split_len_lemma blocksize len len0; + split_len_lemma0 blocksize n len0; + + let t0 = Seq.slice inp 0 len0 in + let t1 = Seq.slice inp len0 len in + + let acc = repeat_gen_blocks_multi blocksize mi hi n0 t0 a f acc0 in + let blocks1 = Seq.slice t1 0 (n1 * blocksize) in + Math.Lemmas.cancel_mul_mod n1 blocksize; + let acc1 = repeat_gen_blocks_multi blocksize (mi + n0) hi n1 blocks1 a f acc in + + calc (==) { + repeat_gen_blocks_multi blocksize (mi + n0) hi n1 blocks1 a f acc; + (==) { repeat_gen_blocks_multi_split_slice #inp_t blocksize len0 mi hi inp a f acc0 } + repeat_gen_blocks_multi blocksize mi hi n (Seq.slice inp 0 (n * blocksize)) a f acc0; + }; + + calc (==) { + repeat_gen_blocks blocksize (mi + n0) hi t1 a f l acc; + (==) { len0_div_bs blocksize len len0 } + l (mi + n) (len1 % blocksize) (Seq.slice t1 (n1 * blocksize) len1) acc1; + (==) { Math.Lemmas.lemma_mod_sub_distr len len0 blocksize } + l (mi + n) (len % blocksize) (Seq.slice t1 (n1 * blocksize) len1) acc1; + (==) { slice_slice_last #inp_t blocksize len0 inp } + l (mi + n) (len % blocksize) (Seq.slice inp (n * blocksize) len) acc1; + } +#pop-options + +//////////////////////// +// Start of repeat_blocks-related properties +//////////////////////// + +let repeat_blocks_extensionality #a #b #c blocksize inp f1 f2 l1 l2 acc0 = + let len = length inp in + let nb = len / blocksize in + + let f_rep1 = repeat_blocks_f blocksize inp f1 nb in + let f_rep2 = repeat_blocks_f blocksize inp f2 nb in + + let acc1 = Loops.repeati nb f_rep1 acc0 in + let acc2 = Loops.repeati nb f_rep2 acc0 in + lemma_repeat_blocks blocksize inp f1 l1 acc0; + lemma_repeat_blocks blocksize inp f2 l2 acc0; + + let aux (i:nat{i < nb}) (acc:b) : Lemma (f_rep1 i acc == f_rep2 i acc) = + Math.Lemmas.lemma_mult_le_right blocksize (i + 1) nb; + Seq.Properties.slice_slice inp 0 (nb * blocksize) (i * blocksize) (i * blocksize + blocksize) in + + Classical.forall_intro_2 aux; + repeati_extensionality nb f_rep1 f_rep2 acc0 + + +let lemma_repeat_blocks_via_multi #a #b #c blocksize inp f l acc0 = + let len = length inp in + let nb = len / blocksize in + + let blocks = Seq.slice inp 0 (nb * blocksize) in + Math.Lemmas.cancel_mul_div nb blocksize; + Math.Lemmas.cancel_mul_mod nb blocksize; + + let f_rep_b = repeat_blocks_f blocksize blocks f nb in + let f_rep = repeat_blocks_f blocksize inp f nb in + + let aux (i:nat{i < nb}) (acc:b) : Lemma (f_rep_b i acc == f_rep i acc) = + Math.Lemmas.lemma_mult_le_right blocksize (i + 1) nb; + Seq.Properties.slice_slice inp 0 (nb * blocksize) (i * blocksize) (i * blocksize + blocksize) in + + lemma_repeat_blocks #a #b #c blocksize inp f l acc0; + calc (==) { + Loops.repeati nb f_rep acc0; + (==) { Classical.forall_intro_2 aux; repeati_extensionality nb f_rep f_rep_b acc0 } + Loops.repeati nb f_rep_b acc0; + (==) { lemma_repeat_blocks_multi blocksize blocks f acc0 } + repeat_blocks_multi blocksize blocks f acc0; + } + + +let repeat_blocks_multi_is_repeat_gen_blocks_multi #a #b hi blocksize inp f acc0 = + let len = length inp in + let n = len / blocksize in + Math.Lemmas.div_exact_r len blocksize; + + let f_rep = repeat_blocks_f blocksize inp f n in + let f_gen = repeat_gen_blocks_f blocksize 0 hi n inp (Loops.fixed_a b) (Loops.fixed_i f) in + + let aux (i:nat{i < n}) (acc:b) : Lemma (f_rep i acc == f_gen i acc) = () in + + calc (==) { + repeat_blocks_multi #a #b blocksize inp f acc0; + (==) { lemma_repeat_blocks_multi #a #b blocksize inp f acc0 } + Loops.repeati n f_rep acc0; + (==) { Loops.repeati_def n (repeat_blocks_f blocksize inp f n) acc0 } + Loops.repeat_right 0 n (Loops.fixed_a b) f_rep acc0; + (==) { Classical.forall_intro_2 aux; + repeat_gen_right_extensionality n 0 (Loops.fixed_a b) (Loops.fixed_a b) f_rep f_gen acc0 } + Loops.repeat_right 0 n (Loops.fixed_a b) f_gen acc0; + } + + +let repeat_blocks_is_repeat_gen_blocks #a #b #c hi blocksize inp f l acc0 = + let len = length inp in + let nb = len / blocksize in + //let rem = len % blocksize in + + Math.Lemmas.cancel_mul_div nb blocksize; + Math.Lemmas.cancel_mul_mod nb blocksize; + + let blocks = Seq.slice inp 0 (nb * blocksize) in + lemma_repeat_blocks_via_multi #a #b #c blocksize inp f l acc0; + calc (==) { + repeat_blocks_multi blocksize blocks f acc0; + (==) { repeat_blocks_multi_is_repeat_gen_blocks_multi #a #b hi blocksize blocks f acc0 } + repeat_gen_blocks_multi blocksize 0 hi nb blocks (Loops.fixed_a b) (Loops.fixed_i f) acc0; + } + + +let repeat_blocks_multi_split #a #b blocksize len0 inp f acc0 = + let len = length inp in + let len1 = len - len0 in + let n = len / blocksize in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + len0_le_len_fraction blocksize len len0; + split_len_lemma0 blocksize n len0; + + let t0 = Seq.slice inp 0 len0 in + let t1 = Seq.slice inp len0 len in + let acc1 = repeat_gen_blocks_multi blocksize 0 n n0 t0 (Loops.fixed_a b) (Loops.fixed_i f) acc0 in + + calc (==) { + repeat_gen_blocks_multi blocksize 0 n n0 t0 (Loops.fixed_a b) (Loops.fixed_i f) acc0; + (==) { repeat_gen_blocks_multi_extensionality_zero blocksize 0 n0 n n0 t0 + (Loops.fixed_a b) (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i f) acc0} + repeat_gen_blocks_multi blocksize 0 n0 n0 t0 (Loops.fixed_a b) (Loops.fixed_i f) acc0; + (==) { repeat_blocks_multi_is_repeat_gen_blocks_multi #a #b n0 blocksize t0 f acc0 } + repeat_blocks_multi blocksize t0 f acc0; + }; + + calc (==) { + repeat_blocks_multi blocksize inp f acc0; + (==) { repeat_blocks_multi_is_repeat_gen_blocks_multi #a #b n blocksize inp f acc0 } + repeat_gen_blocks_multi blocksize 0 n n inp (Loops.fixed_a b) (Loops.fixed_i f) acc0; + (==) { repeat_gen_blocks_multi_split #a blocksize len0 0 n n inp (Loops.fixed_a b) (Loops.fixed_i f) acc0 } + repeat_gen_blocks_multi blocksize n0 n n1 t1 (Loops.fixed_a b) (Loops.fixed_i f) acc1; + (==) { repeat_gen_blocks_multi_extensionality_zero blocksize n0 n n1 n1 t1 + (Loops.fixed_a b) (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i f) acc1 } + repeat_gen_blocks_multi blocksize 0 n1 n1 t1 (Loops.fixed_a b) (Loops.fixed_i f) acc1; + (==) { repeat_blocks_multi_is_repeat_gen_blocks_multi #a #b n1 blocksize t1 f acc1 } + repeat_blocks_multi blocksize t1 f acc1; + } + + +let repeat_blocks_split #a #b #c blocksize len0 inp f l acc0 = + let len = length inp in + let len1 = len - len0 in + let n = len / blocksize in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + len0_le_len_fraction blocksize len len0; + split_len_lemma blocksize len len0; + + let t0 = Seq.slice inp 0 len0 in + let t1 = Seq.slice inp len0 len in + let acc1 = repeat_gen_blocks_multi blocksize 0 n n0 t0 (Loops.fixed_a b) (Loops.fixed_i f) acc0 in + + calc (==) { + repeat_gen_blocks_multi blocksize 0 n n0 t0 (Loops.fixed_a b) (Loops.fixed_i f) acc0; + (==) { repeat_gen_blocks_multi_extensionality_zero blocksize 0 n0 n n0 t0 + (Loops.fixed_a b) (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i f) acc0} + repeat_gen_blocks_multi blocksize 0 n0 n0 t0 (Loops.fixed_a b) (Loops.fixed_i f) acc0; + (==) { repeat_blocks_multi_is_repeat_gen_blocks_multi #a #b n0 blocksize t0 f acc0 } + repeat_blocks_multi blocksize t0 f acc0; + }; + + calc (==) { + repeat_blocks blocksize inp f l acc0; + (==) { repeat_blocks_is_repeat_gen_blocks n blocksize inp f l acc0 } + repeat_gen_blocks blocksize 0 n inp (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i l) acc0; + (==) { repeat_gen_blocks_split #a #c blocksize len0 n 0 inp + (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i l) acc0 } + repeat_gen_blocks blocksize n0 n t1 (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i l) acc1; + (==) { repeat_gen_blocks_extensionality_zero blocksize n0 n n1 n1 t1 + (Loops.fixed_a b) (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i l) + (Loops.fixed_i f) (Loops.fixed_i l) acc1 } + repeat_gen_blocks blocksize 0 n1 t1 (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i l) acc1; + (==) { repeat_blocks_is_repeat_gen_blocks #a #b #c n1 blocksize t1 f l acc1 } + repeat_blocks blocksize t1 f l acc1; + } + +let repeat_blocks_multi_extensionality #a #b blocksize inp f g init = + let len = length inp in + let nb = len / blocksize in + let f_rep = repeat_blocks_f blocksize inp f nb in + let g_rep = repeat_blocks_f blocksize inp g nb in + + lemma_repeat_blocks_multi blocksize inp f init; + lemma_repeat_blocks_multi blocksize inp g init; + + let aux (i:nat{i < nb}) (acc:b) : Lemma (f_rep i acc == g_rep i acc) = + Math.Lemmas.lemma_mult_le_right blocksize (i + 1) nb; + Seq.Properties.slice_slice inp 0 (nb * blocksize) (i * blocksize) (i * blocksize + blocksize) in + + Classical.forall_intro_2 aux; + repeati_extensionality nb f_rep g_rep init + + +//////////////////////// +// End of repeat_blocks-related properties +//////////////////////// + +let map_blocks_multi_extensionality #a blocksize max n inp f g = + let a_map = map_blocks_a a blocksize max in + let acc0 : a_map 0 = Seq.empty #a in + + calc (==) { + map_blocks_multi blocksize max n inp f; + (==) { lemma_map_blocks_multi blocksize max n inp f } + Loops.repeat_gen n a_map (map_blocks_f #a blocksize max inp f) acc0; + (==) { Loops.repeat_gen_def n a_map (map_blocks_f #a blocksize max inp f) acc0 } + Loops.repeat_right 0 n a_map (map_blocks_f #a blocksize max inp f) acc0; + (==) { repeat_right_extensionality n 0 a_map a_map + (map_blocks_f #a blocksize max inp f) (map_blocks_f #a blocksize max inp g) acc0 } + Loops.repeat_right 0 n a_map (map_blocks_f #a blocksize max inp g) acc0; + (==) { Loops.repeat_gen_def n a_map (map_blocks_f #a blocksize max inp g) acc0 } + Loops.repeat_gen n a_map (map_blocks_f #a blocksize max inp g) acc0; + (==) { lemma_map_blocks_multi blocksize max n inp g } + map_blocks_multi blocksize max n inp g; + } + + +let map_blocks_extensionality #a blocksize inp f l_f g l_g = + let len = length inp in + let n = len / blocksize in + let blocks = Seq.slice inp 0 (n * blocksize) in + + lemma_map_blocks blocksize inp f l_f; + lemma_map_blocks blocksize inp g l_g; + map_blocks_multi_extensionality #a blocksize n n blocks f g + + +let repeat_gen_blocks_map_l_length #a blocksize hi l i rem block_l acc = () + + +let map_blocks_multi_acc #a blocksize mi hi n inp f acc0 = + repeat_gen_blocks_multi #a blocksize mi hi n inp + (map_blocks_a a blocksize hi) + (repeat_gen_blocks_map_f blocksize hi f) acc0 + + +let map_blocks_acc #a blocksize mi hi inp f l acc0 = + repeat_gen_blocks #a blocksize mi hi inp + (map_blocks_a a blocksize hi) + (repeat_gen_blocks_map_f blocksize hi f) + (repeat_gen_blocks_map_l blocksize hi l) acc0 + +let map_blocks_acc_length #a blocksize mi hi inp f l acc0 = () + +let map_blocks_multi_acc_is_repeat_gen_blocks_multi #a blocksize mi hi n inp f acc0 = () + +let map_blocks_acc_is_repeat_gen_blocks #a blocksize mi hi inp f l acc0 = () + +#push-options "--z3rlimit 150" +val map_blocks_multi_acc_is_map_blocks_multi_: + #a:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi_f:nat + -> hi_g:nat + -> n:nat{mi + hi_g <= hi_f /\ n <= hi_g} + -> inp:seq a{length inp == hi_g * blocksize} + -> f:(i:nat{i < hi_f} -> lseq a blocksize -> lseq a blocksize) + -> acc0:map_blocks_a a blocksize hi_f mi -> + Lemma + (let a_f = map_blocks_a a blocksize hi_f in + let a_g = map_blocks_a a blocksize hi_g in + let f_gen_map = repeat_gen_blocks_map_f blocksize hi_f f in + let f_gen = repeat_gen_blocks_f blocksize mi hi_f hi_g inp a_f f_gen_map in + + let f_map = map_blocks_f #a blocksize hi_g inp (f_shift blocksize mi hi_f hi_g f) in + + Loops.repeat_right mi (mi + n) a_f f_gen acc0 == + Seq.append acc0 (Loops.repeat_right 0 n a_g f_map (Seq.empty #a))) + +let rec map_blocks_multi_acc_is_map_blocks_multi_ #a blocksize mi hi_f hi_g n inp f acc0 = + let a_f = map_blocks_a a blocksize hi_f in + let a_g = map_blocks_a a blocksize hi_g in + let f_gen_map = repeat_gen_blocks_map_f blocksize hi_f f in + let f_gen = repeat_gen_blocks_f blocksize mi hi_f hi_g inp a_f f_gen_map in + + let f_sh = f_shift blocksize mi hi_f hi_g f in + let f_map = map_blocks_f #a blocksize hi_g inp f_sh in + let lp = Loops.repeat_right mi (mi + n) a_f f_gen acc0 in + let rp = Loops.repeat_right 0 n a_g f_map (Seq.empty #a) in + + if n = 0 then begin + Loops.eq_repeat_right mi (mi + n) a_f f_gen acc0; + Loops.eq_repeat_right 0 n a_g f_map (Seq.empty #a); + Seq.Base.append_empty_r acc0 end + else begin + let lp1 = Loops.repeat_right mi (mi + n - 1) a_f f_gen acc0 in + let rp1 = Loops.repeat_right 0 (n - 1) a_g f_map (Seq.empty #a) in + let block = Seq.slice inp ((n - 1) * blocksize) (n * blocksize) in + Loops.unfold_repeat_right 0 n a_g f_map (Seq.empty #a) (n - 1); + assert (rp == f_map (n - 1) rp1); + assert (rp == Seq.append rp1 (f (mi + n - 1) block)); + + calc (==) { + Loops.repeat_right mi (mi + n) a_f f_gen acc0; + (==) { Loops.unfold_repeat_right mi (mi + n) a_f f_gen acc0 (mi + n - 1) } + Seq.append lp1 (f (mi + n - 1) block); + (==) { map_blocks_multi_acc_is_map_blocks_multi_ #a blocksize mi hi_f hi_g (n - 1) inp f acc0 } + Seq.append (Seq.append acc0 rp1) (f (mi + n - 1) block); + (==) { Seq.Base.append_assoc acc0 rp1 (f (mi + n - 1) block) } + Seq.append acc0 (Seq.append rp1 (f (mi + n - 1) block)); + } end +#pop-options + +let map_blocks_multi_acc_is_map_blocks_multi #a blocksize mi hi n inp f acc0 = + let f_map = repeat_gen_blocks_map_f blocksize hi f in + let a_map = map_blocks_a a blocksize hi in + let f_gen = repeat_gen_blocks_f blocksize mi hi n inp a_map f_map in + + let f_map_s = f_shift blocksize mi hi n f in + let a_map_s = map_blocks_a a blocksize n in + let f_gen_s = map_blocks_f #a blocksize n inp f_map_s in + + calc (==) { + Seq.append acc0 (map_blocks_multi blocksize n n inp f_map_s); + (==) { lemma_map_blocks_multi blocksize n n inp f_map_s } + Seq.append acc0 (Loops.repeat_gen n a_map_s f_gen_s (Seq.empty #a)); + (==) { Loops.repeat_gen_def n a_map_s f_gen_s (Seq.empty #a) } + Seq.append acc0 (Loops.repeat_right 0 n a_map_s f_gen_s (Seq.empty #a)); + (==) { map_blocks_multi_acc_is_map_blocks_multi_ #a blocksize mi hi n n inp f acc0 } + Loops.repeat_right mi (mi + n) a_map f_gen acc0; + (==) { } + map_blocks_multi_acc #a blocksize mi hi n inp f acc0; + } + + +let map_blocks_acc_is_map_blocks #a blocksize mi hi inp f l acc0 = + let len = length inp in + let n = len / blocksize in + Math.Lemmas.cancel_mul_div n blocksize; + let blocks = Seq.slice inp 0 (n * blocksize) in + + let f_sh = f_shift blocksize mi hi n f in + let l_sh = l_shift blocksize mi hi n l in + lemma_map_blocks #a blocksize inp f_sh l_sh; + map_blocks_multi_acc_is_map_blocks_multi #a blocksize mi hi n blocks f acc0 + + +let map_blocks_multi_acc_is_map_blocks_multi0 #a blocksize hi n inp f = + let f_sh = f_shift blocksize 0 hi n f in + let a_map = map_blocks_a a blocksize n in + let acc0 : a_map 0 = Seq.empty #a in + + calc (==) { + map_blocks_multi_acc blocksize 0 hi n inp f Seq.empty; + (==) { map_blocks_multi_acc_is_map_blocks_multi #a blocksize 0 hi n inp f Seq.empty } + Seq.append Seq.empty (map_blocks_multi blocksize n n inp f_sh); + (==) { Seq.Base.append_empty_l (map_blocks_multi blocksize n n inp f_sh) } + map_blocks_multi blocksize n n inp f_sh; + (==) { map_blocks_multi_extensionality blocksize n n inp f_sh f } + map_blocks_multi blocksize n n inp f; + } + + +let map_blocks_acc_is_map_blocks0 #a blocksize hi inp f l = + let len = length inp in + let n = len / blocksize in + let f_sh = f_shift blocksize 0 hi n f in + let l_sh = l_shift blocksize 0 hi n l in + + calc (==) { + map_blocks_acc #a blocksize 0 hi inp f l Seq.empty; + (==) { map_blocks_acc_is_map_blocks blocksize 0 hi inp f l Seq.empty } + Seq.append Seq.empty (map_blocks #a blocksize inp f_sh l_sh); + (==) { Seq.Base.append_empty_l (map_blocks #a blocksize inp f_sh l_sh) } + map_blocks #a blocksize inp f_sh l_sh; + (==) { map_blocks_extensionality #a blocksize inp f l f_sh l_sh } + map_blocks #a blocksize inp f l; + } + + +let map_blocks_is_empty #a blocksize hi inp f l = + let len = length inp in + let nb = len / blocksize in + let rem = len % blocksize in + let blocks = Seq.slice inp 0 (nb * blocksize) in + + assert (rem == 0); + calc (==) { + map_blocks blocksize inp f l; + (==) { lemma_map_blocks blocksize inp f l } + map_blocks_multi #a blocksize nb nb blocks f; + (==) { lemma_map_blocks_multi blocksize nb nb blocks f } + Loops.repeat_gen nb (map_blocks_a a blocksize nb) (map_blocks_f #a blocksize nb inp f) Seq.empty; + (==) { Loops.eq_repeat_gen0 nb (map_blocks_a a blocksize nb) (map_blocks_f #a blocksize nb inp f) Seq.empty } + Seq.empty; + } diff --git a/tests/hacl/Lib.Sequence.Lemmas.fst.hints b/tests/hacl/Lib.Sequence.Lemmas.fst.hints new file mode 100644 index 00000000000..8ce43f7d9d4 --- /dev/null +++ b/tests/hacl/Lib.Sequence.Lemmas.fst.hints @@ -0,0 +1,2818 @@ +[ + "Æ\u0006\u001aæÕF”`5©\u0007\fqé$R", + [ + [ + "Lib.Sequence.Lemmas.get_block_s", + 1, + 8, + 2, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", + "@fuel_irrelevance_Prims.pow2.fuel_instrumented", "@query", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "lemma_FStar.UInt.pow2_values", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3833667c59aecdf581ef615fb6194b08", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_ade7773d9cd7cd1a2abc2fe3f191b9e0", + "refinement_interpretation_Tm_refine_c37230a0b45bfa733513e4ce89ef34d6", + "typing_FStar.Seq.Base.length" + ], + 0, + "7c654633c5d33eff5d047584e6f0cc6d" + ], + [ + "Lib.Sequence.Lemmas.get_block_s", + 2, + 2, + 1, + [ "@query" ], + 0, + "2c77a5ff2bfe7cfbff3266294c732df9" + ], + [ + "Lib.Sequence.Lemmas.get_last_s", + 1, + 2, + 1, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3833667c59aecdf581ef615fb6194b08", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "typing_FStar.Seq.Base.length" + ], + 0, + "3984449af17cab6d28487c4a359f0ee3" + ], + [ + "Lib.Sequence.Lemmas.repeati_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_c3cac0eaa5a8b41e6eb23c42c4532cc2", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_e7e6bda13570450ba98cae3dc5e7dd42", + "Prims_pretyping_ae567c2fb75be05905677af440075565", + "binder_x_6781041e5072f14a03af8b07643f1f30_4", + "binder_x_b3a9ce008df0278184098b1a723bca0c_3", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_1", + "binder_x_fe28d8bcde588226b4e538b35321de05_0", "equation_Prims.nat", + "function_token_typing_Prims.__cache_version_number__", + "int_inversion", "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Equality", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3e839a4d245a3beb00e03b7402cb44c7", + "refinement_interpretation_Tm_refine_49c0ba66edcf02816cc411af6df0f144", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_Lib.LoopCombinators.repeati", "well-founded-ordering-on-nat" + ], + 0, + "eaa3563a15900c044a4a3a189de84eda" + ], + [ + "Lib.Sequence.Lemmas.repeat_right_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_12aaa86fce4296e5ca537def690c90b7", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "refinement_interpretation_Tm_refine_fd19feb5f9ea77c43306cb5b7a87bc36" + ], + 0, + "406edcd644b73494537bf7f4cb39edcf" + ], + [ + "Lib.Sequence.Lemmas.repeat_right_extensionality", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_3c9ffd2296420cd469cf20686505163b", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_bd7c7ab284b6accd96708c0ff3164304", + "Prims_pretyping_ae567c2fb75be05905677af440075565", + "binder_x_03d51f0b26b266821854328111855af2_3", + "binder_x_b730587d8140e227a7f8adbd92d65106_5", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_1", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_2", + "binder_x_d26ec331d6bcfdfd046bf0c1c673bcf9_7", "equation_Prims.nat", + "function_token_typing_Prims.__cache_version_number__", + "int_inversion", "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Equality", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_303b9c87ad41f9e78fc62ab2390b0125", + "refinement_interpretation_Tm_refine_3e9b52cb3027f42e52803d569c244fcb", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_57bc50f9aa6e93b9844a8bd63512cb1c", + "refinement_interpretation_Tm_refine_94dd066518be63a31245723626aaa707", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795", + "typing_Lib.LoopCombinators.repeat_right", + "well-founded-ordering-on-nat" + ], + 0, + "a859644aabe10c0abed6fe28cfa1adf2" + ], + [ + "Lib.Sequence.Lemmas.repeat_right_extensionality", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_12aaa86fce4296e5ca537def690c90b7", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_8329caf005c3be2e24a9ce0a366d6277", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "refinement_interpretation_Tm_refine_fd19feb5f9ea77c43306cb5b7a87bc36" + ], + 0, + "bcaee63886ba6b779a1fda2857521515" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_right_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "int_typing", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c521dec61896a844c454ea9692ebf2e2", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2" + ], + 0, + "c7e3bd31af014960a704180a89418e6b" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_right_extensionality", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_2bf7345966baadb5d8656724dcf7cee8", + "Lib.LoopCombinators_interpretation_Tm_arrow_36dd113ffd3258af3d2f33c53ef8eea6", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_27ab71f0fb6c81f0fa9dbba5ba46be75", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_809f84adfa1ee74319c7b9bd8825d36a", + "Prims_pretyping_ae567c2fb75be05905677af440075565", + "binder_x_759fff43cce3e9ec96895cb58a55ec68_3", + "binder_x_82e1062e5a8fb0849c9f621f85a4d628_5", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_1", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_2", + "binder_x_de4df547607739c850b1e55a67a124fe_7", "equation_Prims.nat", + "function_token_typing_Prims.__cache_version_number__", + "int_inversion", "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Equality", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3e839a4d245a3beb00e03b7402cb44c7", + "refinement_interpretation_Tm_refine_49c0ba66edcf02816cc411af6df0f144", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_571d9f74016be5357787170b42ecf913", + "refinement_interpretation_Tm_refine_5d8689c3031a6af8b5491cc44c84ab43", + "refinement_interpretation_Tm_refine_6536ede8f313b115412245fc854378bd", + "refinement_interpretation_Tm_refine_b61962d44f25224004938818b1c4cd7b", + "refinement_interpretation_Tm_refine_c7f248c50d182c40aac9022fc9a66edc", + "refinement_interpretation_Tm_refine_edccc421660c61e3591d98071500d795", + "typing_Lib.LoopCombinators.repeat_right", + "well-founded-ordering-on-nat" + ], + 0, + "8a395c16a98e5214cefb0be8cadd665f" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_right_extensionality", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "int_typing", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6b17b387345777bc1396aeb424031d6e", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c521dec61896a844c454ea9692ebf2e2", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2" + ], + 0, + "3490ef73f9ad91a6d9fca421f38d126c" + ], + [ + "Lib.Sequence.Lemmas.repeati_right_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "1e5c5e551a8e3a4dc1c373c935e75cce" + ], + [ + "Lib.Sequence.Lemmas.repeati_right_extensionality", + 2, + 0, + 0, + [ "@query", "equation_Lib.LoopCombinators.fixed_a" ], + 0, + "1fe9b5fe8c670decc5633ab2d9d7df9f" + ], + [ + "Lib.Sequence.Lemmas.repeati_right_shift", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "d481cbf3301cd88265c80094526453d3" + ], + [ + "Lib.Sequence.Lemmas.repeati_right_shift", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "17d2ab22da8d5558830bece763178536" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_f", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_bbe86a0a6209b8c07083cd4c9f7f9aa5", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803" + ], + 0, + "a00a7009968eea744c749b3be3065a87" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_f", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "0927629e3ed42ee492a718052daf7730" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "febc0f4599642c93b2a973c844219652" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953" + ], + 0, + "503bf7e8f926950fd78364979e10da14" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "9466afe2e02023fa8e68909f4a6951d5" + ], + [ + "Lib.Sequence.Lemmas.lemma_repeat_gen_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "508f048f7c8ded0d03dc99467c6ad26b" + ], + [ + "Lib.Sequence.Lemmas.lemma_repeat_gen_blocks_multi", + 2, + 0, + 0, + [ "@query", "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_multi" ], + 0, + "eee1506dd52a696caed84f2b79cc883e" + ], + [ + "Lib.Sequence.Lemmas.lemma_repeat_gen_blocks_multi", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "9466afe2e02023fa8e68909f4a6951d5" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_Lib.Sequence.length" + ], + 0, + "6ba7aabe50f5369312457c59568da8a4" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_FStar.Seq.Base.length", "typing_Lib.Sequence.length" + ], + 0, + "eb69b0ece798919f8f172e37b9ff05d5" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_Lib.Sequence.length" + ], + 0, + "7ff7dd8416d02481c9876e77d0237d72" + ], + [ + "Lib.Sequence.Lemmas.lemma_repeat_gen_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_FStar.Seq.Base.length", "typing_Lib.Sequence.length" + ], + 0, + "3b40b44dba58aa6bbb0be2b806699f54" + ], + [ + "Lib.Sequence.Lemmas.lemma_repeat_gen_blocks", + 2, + 0, + 0, + [ "@query", "equation_Lib.Sequence.Lemmas.repeat_gen_blocks" ], + 0, + "0a61b896b9e112ca639ff6cf3d9a4475" + ], + [ + "Lib.Sequence.Lemmas.lemma_repeat_gen_blocks", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_Lib.Sequence.length" + ], + 0, + "76c06152ef69ffe6dee6d36d78231460" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi_extensionality_zero", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_46d0490fc1bcee17b1822abbbaec9be9", + "refinement_interpretation_Tm_refine_4a1f484c8b51af7634bbc9267ad1b558", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "6ffd942f74bc79f31d6465dba340c254" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi_extensionality_zero", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_f", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_multi", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_46d0490fc1bcee17b1822abbbaec9be9", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_ba24c249c2bac9c9652dccf45aee8033", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "typing_FStar.Seq.Base.slice" + ], + 0, + "7e1bf405724dfbfec1b64abc8efca766" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi_extensionality_zero", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_46d0490fc1bcee17b1822abbbaec9be9", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "4a0135838af7d2c2625f2c9e1fea8e4f" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_extensionality_zero", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_46d0490fc1bcee17b1822abbbaec9be9", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_667c0deceb286bd669e5316a684eee1c", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c8d0b9c0d9bab47c0f00a15221dd05c4" + ], + 0, + "b029ce6442f68400e1aff9b601af9351" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_extensionality_zero", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_46d0490fc1bcee17b1822abbbaec9be9", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c8d0b9c0d9bab47c0f00a15221dd05c4", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "typing_Lib.Sequence.length" + ], + 0, + "fbbc91114e9c6e887aaf9dae992f312e" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_extensionality_zero", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_46d0490fc1bcee17b1822abbbaec9be9", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "4db07a86005ae2913812230e0a699ab7" + ], + [ + "Lib.Sequence.Lemmas.len0_div_bs", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "b4e99340719ec572369c358731976f87" + ], + [ + "Lib.Sequence.Lemmas.len0_div_bs", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "648f140407eb9b5cf2cbe68a4335540a" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma0", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "1cc8a6e9d8e9179cc5817d4fb9464b86" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma0", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "4d67f6c4647719e433ec5a8fc8b35c91" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma0", + 4, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "1b4819271ef6ec5a269529dab1a9a246" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma0", + 5, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_4c113fc8b5082d9ae06254757e19cb42" + ], + 0, + "a98863bc6713ba83b34ce00718620ac6" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma0", + 6, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "b2t_def", + "primitive_Prims.op_Equality", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_4c113fc8b5082d9ae06254757e19cb42", + "refinement_interpretation_Tm_refine_4d93f3edc564d0fc940fa1f17194690a" + ], + 0, + "bcc5bd2231781a07a95ce182ed422efc" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma0", + 7, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_4c113fc8b5082d9ae06254757e19cb42", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "9845b33b20d1651b26b71acb4ad1d4ed" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma0", + 8, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_4c113fc8b5082d9ae06254757e19cb42" + ], + 0, + "3b0065871549118ad6674d96e05ec761" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma0", + 9, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_4c113fc8b5082d9ae06254757e19cb42" + ], + 0, + "090c77d113a0902c64fbbdf4b30b548d" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma0", + 10, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "b2t_def", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Equality", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_3dc80b2da0a2c54db945f37042ca080a", + "refinement_interpretation_Tm_refine_4c113fc8b5082d9ae06254757e19cb42", + "refinement_interpretation_Tm_refine_4d93f3edc564d0fc940fa1f17194690a", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_f4357f3bafc6bf7c1dfbd5c602dd3c90", + "unit_inversion" + ], + 0, + "5b0d5ba69c4f8493301c7c2cb36008d9" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "04bd24a0fbf439208b78058fbd99ec27" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "8c30bd2cb791bd48e61bc77ddccf7167" + ], + [ + "Lib.Sequence.Lemmas.aux_repeat_bf_s0", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_24813cd65ccef7cf8c09228ba9bdbf64", + "refinement_interpretation_Tm_refine_3b00410d9ccdeee0a4c7af332e73ce2f", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_9b859045a8681d0937b4cb9681dd787b", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "typing_Lib.Sequence.length" + ], + 0, + "6b7f8948a351ca1a7003c65571b44531" + ], + [ + "Lib.Sequence.Lemmas.aux_repeat_bf_s0", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_f", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_24813cd65ccef7cf8c09228ba9bdbf64", + "refinement_interpretation_Tm_refine_3b00410d9ccdeee0a4c7af332e73ce2f", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_9b859045a8681d0937b4cb9681dd787b", + "refinement_interpretation_Tm_refine_bbe86a0a6209b8c07083cd4c9f7f9aa5", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2" + ], + 0, + "258dff45e3b38a69ab977090ea00c055" + ], + [ + "Lib.Sequence.Lemmas.aux_repeat_bf_s0", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "7c2b2d1d3abb4fcfbc9350e75ef0b7d5" + ], + [ + "Lib.Sequence.Lemmas.aux_repeat_bf_s1", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_24813cd65ccef7cf8c09228ba9bdbf64", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c215e983d7915709bebb4fb7be5bb946", + "refinement_interpretation_Tm_refine_d478cde3e691462712f56114befc57a5", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "typing_Lib.Sequence.length" + ], + 0, + "9d0babf6659f36c2d79b869c30f94b09" + ], + [ + "Lib.Sequence.Lemmas.aux_repeat_bf_s1", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_f", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_24813cd65ccef7cf8c09228ba9bdbf64", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_bbe86a0a6209b8c07083cd4c9f7f9aa5", + "refinement_interpretation_Tm_refine_c215e983d7915709bebb4fb7be5bb946", + "refinement_interpretation_Tm_refine_d478cde3e691462712f56114befc57a5", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "typing_Lib.Sequence.length" + ], + 0, + "15019e1813dd324d06e59423e5955dff" + ], + [ + "Lib.Sequence.Lemmas.aux_repeat_bf_s1", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "ff34d7e53833e9f859be542fcf113c69" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi_split", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_24813cd65ccef7cf8c09228ba9bdbf64", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_Lib.Sequence.length" + ], + 0, + "5be8e8b1c463aa1991b0d5d78a01fa05" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi_split", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_multi", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_24813cd65ccef7cf8c09228ba9bdbf64", + "refinement_interpretation_Tm_refine_3b00410d9ccdeee0a4c7af332e73ce2f", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_9b859045a8681d0937b4cb9681dd787b", + "refinement_interpretation_Tm_refine_c215e983d7915709bebb4fb7be5bb946", + "refinement_interpretation_Tm_refine_d478cde3e691462712f56114befc57a5", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "typing_Lib.Sequence.length" + ], + 0, + "65380ffee5d8f1474c3763b4d77563e6" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi_split", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "75362b97f5739d077b9ebb6632285caf" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi_split_slice", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_784bfde0144e58d81243bc1b47b4f0ec", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c2f575b3d23d23189e5d12bd5a9e4337", + "typing_Lib.Sequence.length" + ], + 0, + "7ff0adcfe7f6769ad79a31d377a33c85" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi_split_slice", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "lemma_FStar.Seq.Properties.slice_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_1ba8fd8bb363097813064c67740b2de5", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_784bfde0144e58d81243bc1b47b4f0ec", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c2f575b3d23d23189e5d12bd5a9e4337", + "refinement_interpretation_Tm_refine_d3d07693cd71377864ef84dc97d10ec1", + "typing_Lib.Sequence.length" + ], + 0, + "2124bbc1a73873053eb5221d44751ce0" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi_split_slice", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_784bfde0144e58d81243bc1b47b4f0ec", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "5d05d735012102769c2be77c99c738c7" + ], + [ + "Lib.Sequence.Lemmas.slice_slice_last", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Division", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_725406258cbec7cb7a61bee1d844d771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "typing_Lib.Sequence.length" + ], + 0, + "7b80da2d3be8b1ad1864bc6693d1ea46" + ], + [ + "Lib.Sequence.Lemmas.slice_slice_last", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_eq_intro", + "lemma_FStar.Seq.Base.lemma_index_slice", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_35a0739c434508f48d0bb1d5cd5df9e8", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_725406258cbec7cb7a61bee1d844d771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_d3d07693cd71377864ef84dc97d10ec1", + "refinement_interpretation_Tm_refine_d83f8da8ef6c1cb9f71d1465c1bb1c55", + "typing_FStar.Seq.Base.length", "typing_FStar.Seq.Base.slice", + "typing_Lib.Sequence.length" + ], + 0, + "7d41b93e14ad5526497d3abb38aa1d8f" + ], + [ + "Lib.Sequence.Lemmas.slice_slice_last", + 3, + 0, + 0, + [ "@query" ], + 0, + "3ed5771c6f7a010dab1b2b08bc63a8a6" + ], + [ + "Lib.Sequence.Lemmas.len0_le_len_fraction", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "828d4ad68b28d887e8fbffc84a29ede7" + ], + [ + "Lib.Sequence.Lemmas.len0_le_len_fraction", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Division", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "bfb194245dda4b86f9a1e6c3f3790c65" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_split", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_fcf14b481b3a84f47b67fc1dd0096ca5", + "typing_Lib.Sequence.length" + ], + 0, + "97be12b972dac0ae7c751951c8dda395" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_split", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "lemma_FStar.Seq.Properties.slice_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_1ba8fd8bb363097813064c67740b2de5", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_75e501c8cccef1c521502f88a4640586", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_d3d07693cd71377864ef84dc97d10ec1", + "refinement_interpretation_Tm_refine_fcf14b481b3a84f47b67fc1dd0096ca5", + "typing_FStar.Seq.Base.length", "typing_Lib.Sequence.length" + ], + 0, + "39618b0945d1f06a36fdcf5928a6833e" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_split", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "dabdaca207d0536138718f221a896d92" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "int_inversion", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "421f8ee245d06012b584aa808ac28f55" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_extensionality", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.repeat_blocks_f", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6ec36165acc8b3b8a1f151af217f53b8", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7af7abfd9fa791df66706ab563886df2", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "typing_FStar.Seq.Base.length", "typing_FStar.Seq.Base.slice", + "typing_Lib.Sequence.length" + ], + 0, + "ffb404b5984d0c9ac437a5c0c6302c30" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_extensionality", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "63d0028fa5427efd2fc741e34c0ca3f6" + ], + [ + "Lib.Sequence.Lemmas.lemma_repeat_blocks_via_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Division", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "typing_FStar.Seq.Base.length", "typing_Lib.Sequence.length" + ], + 0, + "09b3cbc6b05b6f077270c6fbe2010712" + ], + [ + "Lib.Sequence.Lemmas.lemma_repeat_blocks_via_multi", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.repeat_blocks_f", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7af7abfd9fa791df66706ab563886df2", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c2f575b3d23d23189e5d12bd5a9e4337", + "typing_Lib.Sequence.length" + ], + 0, + "383c93d245486a81d22ae5a5a1f3504f" + ], + [ + "Lib.Sequence.Lemmas.lemma_repeat_blocks_via_multi", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "478acc8f2ca5cb76f106a032715171f6" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_multi_is_repeat_gen_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_dc64ef62fd3101207c953516420ca99f", + "typing_Lib.Sequence.length" + ], + 0, + "f83f0fd41740917e110dc57d59847e83" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_multi_is_repeat_gen_blocks_multi", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.LoopCombinators.fixed_a", + "equation_Lib.LoopCombinators.fixed_i", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_f", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_multi", + "equation_Lib.Sequence.length", + "equation_Lib.Sequence.repeat_blocks_f", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7a73c35877b307cf436e11329be9e855", + "refinement_interpretation_Tm_refine_7af7abfd9fa791df66706ab563886df2", + "refinement_interpretation_Tm_refine_dc64ef62fd3101207c953516420ca99f", + "token_correspondence_Lib.LoopCombinators.fixed_i", + "typing_Lib.Sequence.length" + ], + 0, + "1994770f13f0840e7af546b6ceb123a7" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_multi_is_repeat_gen_blocks_multi", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "0900955b4866ce9f200ce6b55735f6d9" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_is_repeat_gen_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_f571f2610f867b24665eec96f119e18c" + ], + 0, + "6073e72ede924dec338910e78811a0c2" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_is_repeat_gen_blocks", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.LoopCombinators.fixed_i", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c2f575b3d23d23189e5d12bd5a9e4337", + "refinement_interpretation_Tm_refine_f571f2610f867b24665eec96f119e18c", + "token_correspondence_Lib.LoopCombinators.fixed_i", + "typing_Lib.Sequence.length" + ], + 0, + "739fd8666a9a903ed9e12c284e11c943" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_is_repeat_gen_blocks", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "b8d3b3cf258d0533d311e39cad611b04" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_multi_split", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Division", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_5e9c3dad358c3890f342f5eeb42bb76e", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "typing_Lib.Sequence.length" + ], + 0, + "c31c75e22efd0941b2b66dd0a69debea" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_multi_split", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.LoopCombinators.fixed_a", + "equation_Lib.LoopCombinators.fixed_i", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_5e9c3dad358c3890f342f5eeb42bb76e", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "token_correspondence_Lib.LoopCombinators.fixed_i", + "typing_Lib.Sequence.length" + ], + 0, + "4df66fe0b1d0e0ee8831e0ac2254c8f8" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_multi_split", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "e14fa65ddcf58954f69fe3878e125dc2" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_split", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_725406258cbec7cb7a61bee1d844d771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647" + ], + 0, + "894f2441bdf52ea1a8f718ea6eaa7eee" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_split", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.LoopCombinators.fixed_a", + "equation_Lib.LoopCombinators.fixed_i", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_725406258cbec7cb7a61bee1d844d771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "token_correspondence_Lib.LoopCombinators.fixed_i", + "typing_Lib.Sequence.length" + ], + 0, + "4122cf2392b3e015198cc6e19ceedcf2" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_split", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "1480db896329c272ad33287803b70fa5" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_multi_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "867519bf6570af19717f8b75181dd674" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_multi_extensionality", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.repeat_blocks_f", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6ec36165acc8b3b8a1f151af217f53b8", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7af7abfd9fa791df66706ab563886df2", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_b14928a18ba707004108386997fed9d6", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "typing_FStar.Seq.Base.length", "typing_FStar.Seq.Base.slice", + "typing_Lib.Sequence.length" + ], + 0, + "e3847c20433eadda194767a4910aa6e4" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_multi_extensionality", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "fb8570aa8fa0661f8663ade903377e5f" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "7f1ae5098f08a3f8961751db419ee888" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_extensionality", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_a203639a647d7d28da9a0faccf0492b8", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.map_blocks_a", + "equation_Lib.Sequence.map_blocks_f", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", + "function_token_typing_Lib.Sequence.map_blocks_f", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_b913a3f691ca99086652e0a655e72f17", + "refinement_interpretation_Tm_refine_ba24c249c2bac9c9652dccf45aee8033", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "typing_FStar.Seq.Base.empty", "typing_FStar.Seq.Base.length", + "typing_FStar.Seq.Base.slice", "typing_Lib.Sequence.length" + ], + 0, + "d86113619d5dfa6964bfc021cc8112e2" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_extensionality", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "a0c73b343c5267daf364aea581810ec3" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Division", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_Lib.Sequence.length" + ], + 0, + "71c748893493cb0121d41f891f188bc0" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_extensionality", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Division", "primitive_Prims.op_GreaterThan", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c2f575b3d23d23189e5d12bd5a9e4337", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "typing_FStar.Seq.Base.slice", "typing_Lib.Sequence.length" + ], + 0, + "b276be0802a3664829ba1c42a66586db" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_extensionality", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "b5556906371c86d0fc49a0a66be2d63a" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_map_f", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.Sequence_interpretation_Tm_arrow_d3b9c37343cabe37d3e11c0a1cafa7da", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_append", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "typing_FStar.Seq.Base.append", "typing_FStar.Seq.Base.length" + ], + 0, + "e8c0ab324bffb96ef7169eed9e4522ea" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_map_f", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "599590beedd4b6cebbc35acd10c72467" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_map_l", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "065f3b8efda7df980bdb0a3993c32b75" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_map_l_length", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "4071eb23d9372cc7cc8fc364275be174" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_map_l_length", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_9dbede814c7e09cf989d879ebca4b33a", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_map_l", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_append", + "primitive_Prims.op_Addition", "primitive_Prims.op_GreaterThan", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803" + ], + 0, + "39a2661d12725cea0bd8e45d81c768cd" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_map_l_length", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "08eceb4997c6059cfdaf24038417dc51" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "79bbdb878e6e793f665cedc320893327" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.Sequence.map_blocks_a", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803" + ], + 0, + "c9251bb5343e24439ee51cb8717b65e8" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "4d708b4d072f4252c5023f5b7c5c8007" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_Lib.Sequence.length" + ], + 0, + "3837a1a5e85d27c54374765b1a9658ee" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc", + 2, + 0, + 0, + [ "@query" ], + 0, + "7040b7fdf98070b6cc9e8a4990ae8bff" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_Lib.Sequence.length" + ], + 0, + "6f65958c8a29c51eac42f3edea36d2e7" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_length", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_Lib.Sequence.length" + ], + 0, + "5e0cb45533615c3637003f5d052eb368" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_length", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_d14b5cd1226e414731f21670beedcc84", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_9b21a1b8a923031d12df037faf12ac8b", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_9dbede814c7e09cf989d879ebca4b33a", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_f0f2eb385217bc59a5339bff3d4fdc88", + "Lib.Sequence_interpretation_Tm_arrow_1197f9e1e382c8da76b7fab929cab890", + "equation_Lib.Sequence.Lemmas.map_blocks_acc", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_map_l", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_multi", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", + "function_token_typing_Lib.Sequence.Lemmas.repeat_gen_blocks_map_f", + "function_token_typing_Lib.Sequence.map_blocks_a", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_append", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_GreaterThan", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "token_correspondence_Lib.Sequence.Lemmas.repeat_gen_blocks_map_l", + "token_correspondence_Lib.Sequence.map_blocks_a", + "typing_FStar.Seq.Base.slice", + "typing_Lib.Sequence.Lemmas.map_blocks_acc", + "typing_Lib.Sequence.Lemmas.repeat_gen_blocks_multi", + "typing_Lib.Sequence.length" + ], + 0, + "e53833026cc4ee0db6a7c0f9c7635b3a" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_length", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_Lib.Sequence.length" + ], + 0, + "6f65958c8a29c51eac42f3edea36d2e7" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_repeat_gen_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "58ed23c62052a769b156f1769d1b6579" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_repeat_gen_blocks_multi", + 2, + 0, + 0, + [ "@query", "equation_Lib.Sequence.Lemmas.map_blocks_multi_acc" ], + 0, + "e138576d433dfc30d3b14cc931d674fd" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_repeat_gen_blocks_multi", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "4d708b4d072f4252c5023f5b7c5c8007" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_is_repeat_gen_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_Lib.Sequence.length" + ], + 0, + "f7f0705d2df658307ec5db8539be40f4" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_is_repeat_gen_blocks", + 2, + 0, + 0, + [ "@query", "equation_Lib.Sequence.Lemmas.map_blocks_acc" ], + 0, + "8668f74640623b721b097db0f370e0ed" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_is_repeat_gen_blocks", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_Lib.Sequence.length" + ], + 0, + "6f65958c8a29c51eac42f3edea36d2e7" + ], + [ + "Lib.Sequence.Lemmas.f_shift", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "8fc4707756373e140abe565e04d6fc4b" + ], + [ + "Lib.Sequence.Lemmas.f_shift", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "a051ac7c04d8839a4d26b38cac32d40f" + ], + [ + "Lib.Sequence.Lemmas.l_shift", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d" + ], + 0, + "d787d49b705dcea1916bcd5777bd9d74" + ], + [ + "Lib.Sequence.Lemmas.l_shift", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213" + ], + 0, + "29265487f3dbfc30d2aae9e4b473b73d" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_map_blocks_multi_", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_append", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_b913a3f691ca99086652e0a655e72f17", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_cedbfc1f9a0199ea1d2d039a83d0b50f", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "typing_FStar.Seq.Base.empty", "typing_Lib.Sequence.length" + ], + 0, + "3a969b0452d738472d73f700e1dfc6e2" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_map_blocks_multi_", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "Prims_pretyping_ae567c2fb75be05905677af440075565", + "binder_x_7eea0d406be960c32731035419902146_1", + "binder_x_80398975436b9f074cafa4c1f371bbf6_8", + "binder_x_9caa9576d4c1ad3b0e97ef91b12afd21_5", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_2", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_3", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_4", + "binder_x_d9bc8e0a60310fd244ff2d1ff9c0be7d_6", + "binder_x_fe28d8bcde588226b4e538b35321de05_0", + "equation_Lib.Sequence.Lemmas.f_shift", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_f", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_map_f", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.map_blocks_a", + "equation_Lib.Sequence.map_blocks_f", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", + "function_token_typing_Lib.Sequence.map_blocks_a", + "function_token_typing_Prims.__cache_version_number__", + "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_append", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Equality", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_8a6506292ccc20eb5c4cf1d8460ddbdb", + "refinement_interpretation_Tm_refine_97a1d43cbd9a511b7df6dadef7f89fb8", + "refinement_interpretation_Tm_refine_a4a397079d7ea76ab85443b1137ac121", + "refinement_interpretation_Tm_refine_aacd5c5013e5b4b181bda5c667bdb087", + "refinement_interpretation_Tm_refine_b913a3f691ca99086652e0a655e72f17", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_db4109dc6119e88b617d40a03dd5557c", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "token_correspondence_Lib.Sequence.Lemmas.f_shift", + "token_correspondence_Lib.Sequence.Lemmas.repeat_gen_blocks_map_f", + "typing_FStar.Seq.Base.empty", "typing_FStar.Seq.Base.length", + "typing_Lib.Sequence.length", "well-founded-ordering-on-nat" + ], + 0, + "b75fcee83e78a8a4611a446d74250a43" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_map_blocks_multi_", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_append", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_b913a3f691ca99086652e0a655e72f17", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_cedbfc1f9a0199ea1d2d039a83d0b50f", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "refinement_interpretation_Tm_refine_fa99d08257545a32939a8ec97d8ccbff", + "typing_FStar.Seq.Base.empty", "typing_Lib.Sequence.length" + ], + 0, + "581a0b5bd4273d1857e841a8930ab8bd" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_map_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "3b5a6ca7f2d72a660bea4f4f9b93f50f" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_map_blocks_multi", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.Sequence.Lemmas.map_blocks_multi_acc", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_multi", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.map_blocks_a", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", + "function_token_typing_Lib.Sequence.map_blocks_a", "int_inversion", + "lemma_FStar.Seq.Base.lemma_eq_refl", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_b913a3f691ca99086652e0a655e72f17", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "typing_FStar.Seq.Base.empty" + ], + 0, + "49082c5ee001850d7acb1b7d8a22b9f8" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_map_blocks_multi", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "4d708b4d072f4252c5023f5b7c5c8007" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_is_map_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_Lib.Sequence.length" + ], + 0, + "b50981bc602abeead21ffb735a6e4dae" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_is_map_blocks", + 2, + 0, + 0, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_1c8e3695441d6e943fd420c55a9c2714", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_2157ab19016ce78d1a8477b3e4a9fd74", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_53c1cff0fc95f4065a8aa916a14dae1d", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_584846cea09f289341a40139c3b43b94", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_707f1100325826b024437354577c9bb0", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_9dbede814c7e09cf989d879ebca4b33a", + "Lib.Sequence_interpretation_Tm_arrow_d3b9c37343cabe37d3e11c0a1cafa7da", + "Lib.Sequence_interpretation_Tm_arrow_efd714987712642bce73b6a439af3d22", + "Lib.Sequence_interpretation_Tm_arrow_f67e6b48b3d5d38ee7701f3b137f9030", + "equation_Lib.Sequence.Lemmas.l_shift", + "equation_Lib.Sequence.Lemmas.map_blocks_acc", + "equation_Lib.Sequence.Lemmas.map_blocks_multi_acc", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_map_l", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", + "function_token_typing_Lib.Sequence.Lemmas.f_shift", + "function_token_typing_Lib.Sequence.Lemmas.l_shift", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_eq_elim", + "lemma_FStar.Seq.Base.lemma_eq_intro", + "lemma_FStar.Seq.Base.lemma_index_app1", + "lemma_FStar.Seq.Base.lemma_index_app2", + "lemma_FStar.Seq.Base.lemma_len_append", + "lemma_FStar.Seq.Base.lemma_len_slice", + "lemma_Lib.Sequence.Lemmas.map_blocks_acc_length", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_GreaterThan", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_1f6c16a51cd4ba3256b95ca590c832c5", + "refinement_interpretation_Tm_refine_25699f4de0c949c68e992e5573c8bf6d", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7af7abfd9fa791df66706ab563886df2", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_8710a3dcbb7aeecb1da33ddf8070b919", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "refinement_interpretation_Tm_refine_ac201cf927190d39c033967b63cb957b", + "refinement_interpretation_Tm_refine_b7cc00be09baf214a201979bf5a5cea0", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c2f575b3d23d23189e5d12bd5a9e4337", + "refinement_interpretation_Tm_refine_d83f8da8ef6c1cb9f71d1465c1bb1c55", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_dee0f34b44c44e6d512c6db0858b92ef", + "refinement_interpretation_Tm_refine_ef88cbfd1f224cec1819e89cfa0f6a00", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "token_correspondence_Lib.Sequence.Lemmas.f_shift", + "token_correspondence_Lib.Sequence.Lemmas.l_shift", + "token_correspondence_Lib.Sequence.Lemmas.repeat_gen_blocks_map_l", + "typing_FStar.Seq.Base.append", "typing_FStar.Seq.Base.slice", + "typing_Lib.Sequence.Lemmas.map_blocks_acc", + "typing_Lib.Sequence.Lemmas.map_blocks_multi_acc", + "typing_Lib.Sequence.length", "typing_Lib.Sequence.map_blocks", + "typing_Lib.Sequence.map_blocks_multi" + ], + 0, + "890694cd2e59ece4d280611b88d15694" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_is_map_blocks", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_Lib.Sequence.length" + ], + 0, + "6f65958c8a29c51eac42f3edea36d2e7" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_map_blocks_multi0", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d" + ], + 0, + "77a205731ace8eccd2bff6b5ff09149e" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_map_blocks_multi0", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.LoopCombinators_interpretation_Tm_arrow_d14b5cd1226e414731f21670beedcc84", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_9b21a1b8a923031d12df037faf12ac8b", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_f0f2eb385217bc59a5339bff3d4fdc88", + "Lib.Sequence_interpretation_Tm_arrow_1197f9e1e382c8da76b7fab929cab890", + "equation_Lib.Sequence.Lemmas.f_shift", + "equation_Lib.Sequence.Lemmas.map_blocks_multi_acc", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.map_blocks_a", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", + "function_token_typing_Lib.Sequence.Lemmas.repeat_gen_blocks_map_f", + "function_token_typing_Lib.Sequence.map_blocks_a", "int_inversion", + "lemma_FStar.Seq.Base.lemma_eq_elim", + "lemma_FStar.Seq.Base.lemma_eq_refl", + "lemma_FStar.Seq.Base.lemma_len_append", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_361ceade980020b5c15ebf36d114dc78", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_b913a3f691ca99086652e0a655e72f17", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "token_correspondence_Lib.Sequence.Lemmas.f_shift", + "token_correspondence_Lib.Sequence.map_blocks_a", + "typing_FStar.Seq.Base.empty", + "typing_Lib.Sequence.Lemmas.repeat_gen_blocks_multi", + "typing_Lib.Sequence.length" + ], + 0, + "83c4012cc03867f3198e27844fa967bb" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_map_blocks_multi0", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "40877c5325e5393546920d1666122dda" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_is_map_blocks0", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_f571f2610f867b24665eec96f119e18c" + ], + 0, + "4e2d13e298df1984a532833137706c04" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_is_map_blocks0", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.Sequence.Lemmas.f_shift", + "equation_Lib.Sequence.Lemmas.l_shift", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.map_blocks_a", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_eq_elim", + "lemma_FStar.Seq.Base.lemma_eq_refl", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7af7abfd9fa791df66706ab563886df2", + "refinement_interpretation_Tm_refine_b913a3f691ca99086652e0a655e72f17", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "refinement_interpretation_Tm_refine_f571f2610f867b24665eec96f119e18c", + "token_correspondence_Lib.Sequence.Lemmas.f_shift", + "token_correspondence_Lib.Sequence.Lemmas.l_shift", + "typing_FStar.Seq.Base.empty", "typing_Lib.Sequence.length" + ], + 0, + "11016614432ef13a6d27d122200c7bce" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_is_map_blocks0", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "22c601c2f6642877c43d1cbc3764fe58" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_is_empty", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7ad90407dad3095183eb4d692b62fd08" + ], + 0, + "9ab3ae00a867717efd488d44c17376ca" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_is_empty", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.Sequence_interpretation_Tm_arrow_d3b9c37343cabe37d3e11c0a1cafa7da", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.map_blocks_a", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Properties.slice_is_empty", + "lemma_FStar.Seq.Properties.slice_length", + "primitive_Prims.op_Division", "primitive_Prims.op_GreaterThan", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7ad90407dad3095183eb4d692b62fd08", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_b361ba8089a6e963921008d537e799a1", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "typing_Lib.Sequence.length", "typing_Lib.Sequence.map_blocks_multi" + ], + 0, + "baea6a63914b51fb81763edb944cd18b" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_is_empty", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "0355a40e31ba55c41033a3106bb52411" + ] + ] +] \ No newline at end of file diff --git a/tests/hacl/Lib.Sequence.Lemmas.fsti b/tests/hacl/Lib.Sequence.Lemmas.fsti new file mode 100644 index 00000000000..220eef1d100 --- /dev/null +++ b/tests/hacl/Lib.Sequence.Lemmas.fsti @@ -0,0 +1,701 @@ +module Lib.Sequence.Lemmas + +open FStar.Mul +open Lib.IntTypes +open Lib.Sequence + +module Loops = Lib.LoopCombinators + +#set-options "--z3rlimit 50 --max_fuel 0 --max_ifuel 0 \ + --using_facts_from '-* +Prims +FStar.Math.Lemmas +FStar.Seq +Lib.IntTypes +Lib.Sequence +Lib.Sequence.Lemmas'" + + +let get_block_s + (#a:Type) + (#len:nat) + (blocksize:size_pos) + (inp:seq a{length inp == len}) + (i:nat{i < len / blocksize * blocksize}) : + lseq a blocksize += + div_mul_lt blocksize i (len / blocksize); + let j = i / blocksize in + let b: lseq a blocksize = Seq.slice inp (j * blocksize) ((j + 1) * blocksize) in + b + + +let get_last_s + (#a:Type) + (#len:nat) + (blocksize:size_pos) + (inp:seq a{length inp == len}) : + lseq a (len % blocksize) += + let rem = len % blocksize in + let b: lseq a rem = Seq.slice inp (len - rem) len in + b + + +val repeati_extensionality: + #a:Type0 + -> n:nat + -> f:(i:nat{i < n} -> a -> a) + -> g:(i:nat{i < n} -> a -> a) + -> acc0:a -> + Lemma + (requires (forall (i:nat{i < n}) (acc:a). f i acc == g i acc)) + (ensures Loops.repeati n f acc0 == Loops.repeati n g acc0) + + +val repeat_right_extensionality: + n:nat + -> lo:nat + -> a_f:(i:nat{lo <= i /\ i <= lo + n} -> Type) + -> a_g:(i:nat{lo <= i /\ i <= lo + n} -> Type) + -> f:(i:nat{lo <= i /\ i < lo + n} -> a_f i -> a_f (i + 1)) + -> g:(i:nat{lo <= i /\ i < lo + n} -> a_g i -> a_g (i + 1)) + -> acc0:a_f lo -> + Lemma + (requires + (forall (i:nat{lo <= i /\ i <= lo + n}). a_f i == a_g i) /\ + (forall (i:nat{lo <= i /\ i < lo + n}) (acc:a_f i). f i acc == g i acc)) + (ensures + Loops.repeat_right lo (lo + n) a_f f acc0 == + Loops.repeat_right lo (lo + n) a_g g acc0) + + +// Loops.repeat_gen n a_f f acc0 == +// Loops.repeat_right lo_g (lo_g + n) a_g g acc0) +val repeat_gen_right_extensionality: + n:nat + -> lo_g:nat + -> a_f:(i:nat{i <= n} -> Type) + -> a_g:(i:nat{lo_g <= i /\ i <= lo_g + n} -> Type) + -> f:(i:nat{i < n} -> a_f i -> a_f (i + 1)) + -> g:(i:nat{lo_g <= i /\ i < lo_g + n} -> a_g i -> a_g (i + 1)) + -> acc0:a_f 0 -> + Lemma + (requires + (forall (i:nat{i <= n}). a_f i == a_g (lo_g + i)) /\ + (forall (i:nat{i < n}) (acc:a_f i). f i acc == g (lo_g + i) acc)) + (ensures + Loops.repeat_right 0 n a_f f acc0 == + Loops.repeat_right lo_g (lo_g + n) a_g g acc0) + + +// Loops.repeati n a f acc0 == +// Loops.repeat_right lo_g (lo_g + n) (Loops.fixed_a a) g acc0 +val repeati_right_extensionality: + #a:Type + -> n:nat + -> lo_g:nat + -> f:(i:nat{i < n} -> a -> a) + -> g:(i:nat{lo_g <= i /\ i < lo_g + n} -> a -> a) + -> acc0:a -> + Lemma + (requires (forall (i:nat{i < n}) (acc:a). f i acc == g (lo_g + i) acc)) + (ensures + Loops.repeat_right 0 n (Loops.fixed_a a) f acc0 == + Loops.repeat_right lo_g (lo_g + n) (Loops.fixed_a a) g acc0) + +/// A specialized version of the lemma above, for only shifting one computation, +/// but specified using repeati instead +val repeati_right_shift: + #a:Type + -> n:nat + -> f:(i:nat{i < n} -> a -> a) + -> g:(i:nat{i < 1 + n} -> a -> a) + -> acc0:a -> + Lemma + (requires (forall (i:nat{i < n}) (acc:a). f i acc == g (i + 1) acc)) + (ensures Loops.repeati n f (g 0 acc0) == Loops.repeati (n + 1) g acc0) + +/// +/// `repeat_gen_blocks` is defined here to prove all the properties +/// needed for `map_blocks` and `repeat_blocks` once +/// + +let repeat_gen_blocks_f + (#inp_t:Type0) + (blocksize:size_pos) + (mi:nat) + (hi:nat) + (n:nat{mi + n <= hi}) + (inp:seq inp_t{length inp == n * blocksize}) + (a:(i:nat{i <= hi} -> Type)) + (f:(i:nat{i < hi} -> lseq inp_t blocksize -> a i -> a (i + 1))) + (i:nat{mi <= i /\ i < mi + n}) + (acc:a i) : a (i + 1) += + let i_b = i - mi in + Math.Lemmas.lemma_mult_le_right blocksize (i_b + 1) n; + let block = Seq.slice inp (i_b * blocksize) (i_b * blocksize + blocksize) in + f i block acc + + +//lo = 0 +val repeat_gen_blocks_multi: + #inp_t:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi:nat + -> n:nat{mi + n <= hi} + -> inp:seq inp_t{length inp == n * blocksize} + -> a:(i:nat{i <= hi} -> Type) + -> f:(i:nat{i < hi} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> acc0:a mi -> + a (mi + n) + + +val lemma_repeat_gen_blocks_multi: + #inp_t:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi:nat + -> n:nat{mi + n <= hi} + -> inp:seq inp_t{length inp == n * blocksize} + -> a:(i:nat{i <= hi} -> Type) + -> f:(i:nat{i < hi} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> acc0:a mi -> + Lemma + (repeat_gen_blocks_multi #inp_t blocksize mi hi n inp a f acc0 == + Loops.repeat_right mi (mi + n) a (repeat_gen_blocks_f blocksize mi hi n inp a f) acc0) + + +val repeat_gen_blocks: + #inp_t:Type0 + -> #c:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi:nat + -> inp:seq inp_t{mi + length inp / blocksize <= hi} + -> a:(i:nat{i <= hi} -> Type) + -> f:(i:nat{i < hi} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> l:(i:nat{i <= hi} -> len:nat{len < blocksize} -> lseq inp_t len -> a i -> c) + -> acci:a mi -> + c + + +val lemma_repeat_gen_blocks: + #inp_t:Type0 + -> #c:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi:nat + -> inp:seq inp_t{mi + length inp / blocksize <= hi} + -> a:(i:nat{i <= hi} -> Type) + -> f:(i:nat{i < hi} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> l:(i:nat{i <= hi} -> len:nat{len < blocksize} -> lseq inp_t len -> a i -> c) + -> acc0:a mi -> + Lemma + (let len = length inp in + let nb = len / blocksize in + let rem = len % blocksize in + let blocks = Seq.slice inp 0 (nb * blocksize) in + let last = Seq.slice inp (nb * blocksize) len in + Math.Lemmas.cancel_mul_div nb blocksize; + Math.Lemmas.cancel_mul_mod nb blocksize; + let acc = repeat_gen_blocks_multi #inp_t blocksize mi hi nb blocks a f acc0 in + repeat_gen_blocks blocksize mi hi inp a f l acc0 == l (mi + nb) rem last acc) + + +val repeat_gen_blocks_multi_extensionality_zero: + #inp_t:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi_f:nat + -> hi_g:nat + -> n:nat{mi + n <= hi_f /\ n <= hi_g} + -> inp:seq inp_t{length inp == n * blocksize} + -> a_f:(i:nat{i <= hi_f} -> Type) + -> a_g:(i:nat{i <= hi_g} -> Type) + -> f:(i:nat{i < hi_f} -> lseq inp_t blocksize -> a_f i -> a_f (i + 1)) + -> g:(i:nat{i < hi_g} -> lseq inp_t blocksize -> a_g i -> a_g (i + 1)) + -> acc0:a_f mi -> + Lemma + (requires + (forall (i:nat{i <= n}). a_f (mi + i) == a_g i) /\ + (forall (i:nat{i < n}) (block:lseq inp_t blocksize) (acc:a_f (mi + i)). + f (mi + i) block acc == g i block acc)) + (ensures + repeat_gen_blocks_multi blocksize mi hi_f n inp a_f f acc0 == + repeat_gen_blocks_multi blocksize 0 hi_g n inp a_g g acc0) + + +val repeat_gen_blocks_extensionality_zero: + #inp_t:Type0 + -> #c:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi_f:nat + -> hi_g:nat + -> n:nat{mi + n <= hi_f /\ n <= hi_g} + -> inp:seq inp_t{n == length inp / blocksize} + -> a_f:(i:nat{i <= hi_f} -> Type) + -> a_g:(i:nat{i <= hi_g} -> Type) + -> f:(i:nat{i < hi_f} -> lseq inp_t blocksize -> a_f i -> a_f (i + 1)) + -> l_f:(i:nat{i <= hi_f} -> len:nat{len < blocksize} -> lseq inp_t len -> a_f i -> c) + -> g:(i:nat{i < hi_g} -> lseq inp_t blocksize -> a_g i -> a_g (i + 1)) + -> l_g:(i:nat{i <= hi_g} -> len:nat{len < blocksize} -> lseq inp_t len -> a_g i -> c) + -> acc0:a_f mi -> + Lemma + (requires + (forall (i:nat{i <= n}). a_f (mi + i) == a_g i) /\ + (forall (i:nat{i < n}) (block:lseq inp_t blocksize) (acc:a_f (mi + i)). + f (mi + i) block acc == g i block acc) /\ + (forall (i:nat{i <= n}) (len:nat{len < blocksize}) (block:lseq inp_t len) (acc:a_f (mi + i)). + l_f (mi + i) len block acc == l_g i len block acc)) + (ensures + repeat_gen_blocks blocksize mi hi_f inp a_f f l_f acc0 == + repeat_gen_blocks blocksize 0 hi_g inp a_g g l_g acc0) + + +val len0_div_bs: blocksize:pos -> len:nat -> len0:nat -> + Lemma + (requires len0 <= len /\ len0 % blocksize == 0) + (ensures len0 / blocksize + (len - len0) / blocksize == len / blocksize) + + +val split_len_lemma0: blocksize:pos -> n:nat -> len0:nat -> + Lemma + (requires len0 <= n * blocksize /\ len0 % blocksize = 0) + (ensures + (let len = n * blocksize in + let len1 = len - len0 in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + len % blocksize = 0 /\ len1 % blocksize = 0 /\ n0 + n1 = n /\ + n0 * blocksize = len0 /\ n1 * blocksize = len1)) + + +val split_len_lemma: blocksize:pos -> len:nat -> len0:nat -> + Lemma + (requires len0 <= len /\ len0 % blocksize = 0) + (ensures + (let len1 = len - len0 in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + let n = len / blocksize in + len % blocksize = len1 % blocksize /\ + n0 * blocksize = len0 /\ n0 + n1 = n)) + + +val repeat_gen_blocks_multi_split: + #inp_t:Type0 + -> blocksize:size_pos + -> len0:nat{len0 % blocksize == 0} + -> mi:nat + -> hi:nat + -> n:nat{mi + n <= hi} + -> inp:seq inp_t{len0 <= length inp /\ length inp == n * blocksize} + -> a:(i:nat{i <= hi} -> Type) + -> f:(i:nat{i < hi} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> acc0:a mi -> + Lemma + (let len = length inp in + let len1 = len - len0 in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + split_len_lemma0 blocksize n len0; + + let t0 = Seq.slice inp 0 len0 in + let t1 = Seq.slice inp len0 len in + + let acc : a (mi + n0) = repeat_gen_blocks_multi blocksize mi hi n0 t0 a f acc0 in + repeat_gen_blocks_multi blocksize mi hi n inp a f acc0 == + repeat_gen_blocks_multi blocksize (mi + n0) hi n1 t1 a f acc) + + +val repeat_gen_blocks_split: + #inp_t:Type0 + -> #c:Type0 + -> blocksize:size_pos + -> len0:nat{len0 % blocksize == 0} + -> hi:nat + -> mi:nat{mi <= hi} + -> inp:seq inp_t{len0 <= length inp /\ mi + length inp / blocksize <= hi} + -> a:(i:nat{i <= hi} -> Type) + -> f:(i:nat{i < hi} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> l:(i:nat{i <= hi} -> len:nat{len < blocksize} -> lseq inp_t len -> a i -> c) + -> acc0:a mi -> + Lemma + (let len = length inp in + let n = len / blocksize in + let n0 = len0 / blocksize in + split_len_lemma blocksize len len0; + + let t0 = Seq.slice inp 0 len0 in + let t1 = Seq.slice inp len0 len in + + let acc : a (mi + n0) = repeat_gen_blocks_multi blocksize mi hi n0 t0 a f acc0 in + repeat_gen_blocks blocksize mi hi inp a f l acc0 == + repeat_gen_blocks blocksize (mi + n0) hi t1 a f l acc) + +/// +/// Properties related to the repeat_blocks combinator +/// + +val repeat_blocks_extensionality: + #a:Type0 + -> #b:Type0 + -> #c:Type0 + -> blocksize:size_pos + -> inp:seq a + -> f1:(lseq a blocksize -> b -> b) + -> f2:(lseq a blocksize -> b -> b) + -> l1:(len:nat{len < blocksize} -> s:lseq a len -> b -> c) + -> l2:(len:nat{len < blocksize} -> s:lseq a len -> b -> c) + -> acc0:b -> + Lemma + (requires + (forall (block:lseq a blocksize) (acc:b). f1 block acc == f2 block acc) /\ + (forall (rem:nat{rem < blocksize}) (last:lseq a rem) (acc:b). l1 rem last acc == l2 rem last acc)) + (ensures + repeat_blocks blocksize inp f1 l1 acc0 == repeat_blocks blocksize inp f2 l2 acc0) + + +val lemma_repeat_blocks_via_multi: + #a:Type0 + -> #b:Type0 + -> #c:Type0 + -> blocksize:size_pos + -> inp:seq a + -> f:(lseq a blocksize -> b -> b) + -> l:(len:nat{len < blocksize} -> s:lseq a len -> b -> c) + -> acc0:b -> + Lemma + (let len = length inp in + let nb = len / blocksize in + let rem = len % blocksize in + let blocks = Seq.slice inp 0 (nb * blocksize) in + let last = Seq.slice inp (nb * blocksize) len in + Math.Lemmas.cancel_mul_mod nb blocksize; + let acc = repeat_blocks_multi blocksize blocks f acc0 in + repeat_blocks #a #b blocksize inp f l acc0 == l rem last acc) + + +val repeat_blocks_multi_is_repeat_gen_blocks_multi: + #a:Type0 + -> #b:Type0 + -> hi:nat + -> blocksize:size_pos + -> inp:seq a{length inp % blocksize = 0 /\ length inp / blocksize <= hi} + -> f:(lseq a blocksize -> b -> b) + -> acc0:b -> + Lemma + (let n = length inp / blocksize in + Math.Lemmas.div_exact_r (length inp) blocksize; + repeat_blocks_multi #a #b blocksize inp f acc0 == + repeat_gen_blocks_multi #a blocksize 0 hi n inp (Loops.fixed_a b) (Loops.fixed_i f) acc0) + + +val repeat_blocks_is_repeat_gen_blocks: + #a:Type0 + -> #b:Type0 + -> #c:Type0 + -> hi:nat + -> blocksize:size_pos + -> inp:seq a{length inp / blocksize <= hi} + -> f:(lseq a blocksize -> b -> b) + -> l:(len:nat{len < blocksize} -> s:lseq a len -> b -> c) + -> acc0:b -> + Lemma + (repeat_blocks #a #b #c blocksize inp f l acc0 == + repeat_gen_blocks #a #c blocksize 0 hi inp + (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i l) acc0) + + +val repeat_blocks_multi_split: + #a:Type0 + -> #b:Type0 + -> blocksize:size_pos + -> len0:nat{len0 % blocksize = 0} + -> inp:seq a{len0 <= length inp /\ length inp % blocksize = 0} + -> f:(lseq a blocksize -> b -> b) + -> acc0:b -> + Lemma + (let len = length inp in + Math.Lemmas.lemma_div_exact len blocksize; + split_len_lemma0 blocksize (len / blocksize) len0; + Math.Lemmas.swap_mul blocksize (len / blocksize); + + repeat_blocks_multi blocksize inp f acc0 == + repeat_blocks_multi blocksize (Seq.slice inp len0 len) f + (repeat_blocks_multi blocksize (Seq.slice inp 0 len0) f acc0)) + + +val repeat_blocks_split: + #a:Type0 + -> #b:Type0 + -> #c:Type0 + -> blocksize:size_pos + -> len0:nat{len0 % blocksize = 0} + -> inp:seq a{len0 <= length inp} + -> f:(lseq a blocksize -> b -> b) + -> l:(len:nat{len < blocksize} -> s:lseq a len -> b -> c) + -> acc0:b -> + Lemma + (let len = length inp in + split_len_lemma blocksize len len0; + + repeat_blocks blocksize inp f l acc0 == + repeat_blocks blocksize (Seq.slice inp len0 len) f l + (repeat_blocks_multi blocksize (Seq.slice inp 0 len0) f acc0)) + +/// +val repeat_blocks_multi_extensionality: + #a:Type0 + -> #b:Type0 + -> blocksize:size_pos + -> inp:seq a{length inp % blocksize = 0} + -> f:(lseq a blocksize -> b -> b) + -> g:(lseq a blocksize -> b -> b) + -> init:b -> + Lemma + (requires + (forall (block:lseq a blocksize) (acc:b). f block acc == g block acc)) + (ensures + repeat_blocks_multi blocksize inp f init == + repeat_blocks_multi blocksize inp g init) + +/// Properties related to the map_blocks combinator +/// + +val map_blocks_multi_extensionality: + #a:Type0 + -> blocksize:size_pos + -> max:nat + -> n:nat{n <= max} + -> inp:seq a{length inp == max * blocksize} + -> f:(i:nat{i < max} -> lseq a blocksize -> lseq a blocksize) + -> g:(i:nat{i < max} -> lseq a blocksize -> lseq a blocksize) -> + Lemma + (requires + (forall (i:nat{i < max}) (b_v:lseq a blocksize). f i b_v == g i b_v)) + (ensures + map_blocks_multi blocksize max n inp f == + map_blocks_multi blocksize max n inp g) + + +val map_blocks_extensionality: + #a:Type0 + -> blocksize:size_pos + -> inp:seq a + -> f:(block (length inp) blocksize -> lseq a blocksize -> lseq a blocksize) + -> l_f:(last (length inp) blocksize -> rem:size_nat{rem < blocksize} -> s:lseq a rem -> lseq a rem) + -> g:(block (length inp) blocksize -> lseq a blocksize -> lseq a blocksize) + -> l_g:(last (length inp) blocksize -> rem:size_nat{rem < blocksize} -> s:lseq a rem -> lseq a rem) -> + Lemma + (requires + (let n = length inp / blocksize in + (forall (i:nat{i < n}) (b_v:lseq a blocksize). f i b_v == g i b_v) /\ + (forall (rem:nat{rem < blocksize}) (b_v:lseq a rem). l_f n rem b_v == l_g n rem b_v))) + (ensures + map_blocks blocksize inp f l_f == map_blocks blocksize inp g l_g) + +/// +/// New definition of `map_blocks` that takes extra parameter `acc`. +/// When `acc` = Seq.empty, map_blocks == map_blocks_acc +/// + +let repeat_gen_blocks_map_f + (#a:Type0) + (blocksize:size_pos) + (hi:nat) + (f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize)) + (i:nat{i < hi}) + (block:lseq a blocksize) + (acc:map_blocks_a a blocksize hi i) : map_blocks_a a blocksize hi (i + 1) + = + Seq.append acc (f i block) + + +let repeat_gen_blocks_map_l + (#a:Type0) + (blocksize:size_pos) + (hi:nat) + (l:(i:nat{i <= hi} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem)) + (i:nat{i <= hi}) + (rem:nat{rem < blocksize}) + (block_l:lseq a rem) + (acc:map_blocks_a a blocksize hi i) : seq a + = + if rem > 0 then Seq.append acc (l i rem block_l) else acc + + +val repeat_gen_blocks_map_l_length: + #a:Type0 + -> blocksize:size_pos + -> hi:nat + -> l:(i:nat{i <= hi} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem) + -> i:nat{i <= hi} + -> rem:nat{rem < blocksize} + -> block_l:lseq a rem + -> acc:map_blocks_a a blocksize hi i -> + Lemma (length (repeat_gen_blocks_map_l blocksize hi l i rem block_l acc) == i * blocksize + rem) + + +val map_blocks_multi_acc: + #a:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi:nat + -> n:nat{mi + n <= hi} + -> inp:seq a{length inp == n * blocksize} + -> f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize) + -> acc0:map_blocks_a a blocksize hi mi -> + out:seq a {length out == length acc0 + length inp} + + +val map_blocks_acc: + #a:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi:nat + -> inp:seq a{mi + length inp / blocksize <= hi} + -> f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize) + -> l:(i:nat{i <= hi} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem) + -> acc0:map_blocks_a a blocksize hi mi -> + seq a + + +val map_blocks_acc_length: + #a:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi:nat + -> inp:seq a{mi + length inp / blocksize <= hi} + -> f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize) + -> l:(i:nat{i <= hi} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem) + -> acc0:map_blocks_a a blocksize hi mi -> + Lemma (length (map_blocks_acc blocksize mi hi inp f l acc0) == length acc0 + length inp) + [SMTPat (map_blocks_acc blocksize mi hi inp f l acc0)] + + +val map_blocks_multi_acc_is_repeat_gen_blocks_multi: + #a:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi:nat + -> n:nat{mi + n <= hi} + -> inp:seq a{length inp == n * blocksize} + -> f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize) + -> acc0:map_blocks_a a blocksize hi mi -> + Lemma + (map_blocks_multi_acc #a blocksize mi hi n inp f acc0 == + repeat_gen_blocks_multi #a blocksize mi hi n inp + (map_blocks_a a blocksize hi) + (repeat_gen_blocks_map_f blocksize hi f) acc0) + + +val map_blocks_acc_is_repeat_gen_blocks: + #a:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi:nat + -> inp:seq a{mi + length inp / blocksize <= hi} + -> f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize) + -> l:(i:nat{i <= hi} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem) + -> acc0:map_blocks_a a blocksize hi mi -> + Lemma + (map_blocks_acc #a blocksize mi hi inp f l acc0 == + repeat_gen_blocks #a blocksize mi hi inp + (map_blocks_a a blocksize hi) + (repeat_gen_blocks_map_f blocksize hi f) + (repeat_gen_blocks_map_l blocksize hi l) acc0) + + +let f_shift (#a:Type0) (blocksize:size_pos) (mi:nat) (hi:nat) (n:nat{mi + n <= hi}) + (f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize)) (i:nat{i < n}) = f (mi + i) + + +let l_shift (#a:Type0) (blocksize:size_pos) (mi:nat) (hi:nat) (n:nat{mi + n <= hi}) + (l:(i:nat{i <= hi} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem)) (i:nat{i <= n}) = l (mi + i) + + +val map_blocks_multi_acc_is_map_blocks_multi: + #a:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi:nat + -> n:nat{mi + n <= hi} + -> inp:seq a{length inp == n * blocksize} + -> f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize) + -> acc0:map_blocks_a a blocksize hi mi -> + Lemma + (map_blocks_multi_acc blocksize mi hi n inp f acc0 `Seq.equal` + Seq.append acc0 (map_blocks_multi blocksize n n inp (f_shift blocksize mi hi n f))) + + +val map_blocks_acc_is_map_blocks: + #a:Type0 + -> blocksize:size_pos + -> mi:nat + -> hi:nat + -> inp:seq a{mi + length inp / blocksize <= hi} + -> f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize) + -> l:(i:nat{i <= hi} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem) + -> acc0:map_blocks_a a blocksize hi mi -> + Lemma + (let n = length inp / blocksize in + map_blocks_acc #a blocksize mi hi inp f l acc0 `Seq.equal` + Seq.append acc0 (map_blocks #a blocksize inp (f_shift blocksize mi hi n f) (l_shift blocksize mi hi n l))) + + +val map_blocks_multi_acc_is_map_blocks_multi0: + #a:Type0 + -> blocksize:size_pos + -> hi:nat + -> n:nat{n <= hi} + -> inp:seq a{length inp == n * blocksize} + -> f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize) -> + Lemma (map_blocks_multi_acc blocksize 0 hi n inp f Seq.empty `Seq.equal` map_blocks_multi blocksize n n inp f) + + +val map_blocks_acc_is_map_blocks0: + #a:Type0 + -> blocksize:size_pos + -> hi:nat + -> inp:seq a{length inp / blocksize <= hi} + -> f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize) + -> l:(i:nat{i <= hi} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem) -> + Lemma (map_blocks_acc #a blocksize 0 hi inp f l Seq.empty `Seq.equal` map_blocks #a blocksize inp f l) + + +val map_blocks_is_empty: + #a:Type0 + -> blocksize:size_pos + -> hi:nat + -> inp:seq a{length inp == 0} + -> f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize) + -> l:(i:nat{i <= hi} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem) -> + Lemma (map_blocks #a blocksize inp f l == Seq.empty) + + +(* +//Now it's possible to prove the following lemma: + +val map_blocks_multi_split: + #a:Type0 + -> blocksize:size_pos + -> len0:nat{len0 % blocksize = 0} + -> hi:nat + -> mi:nat + -> n:nat{mi + n <= hi} + -> inp:seq a{len0 <= length inp /\ length inp == n * blocksize} + -> f:(i:nat{i < hi} -> lseq a blocksize -> lseq a blocksize) + -> acc:map_blocks_a a blocksize hi mi -> + Lemma + (let len = length inp in + let len1 = len - len0 in + let n0 = len0 / blocksize in + let n1 = len1 / blocksize in + split_len_lemma0 blocksize n len0; + + let t0 = Seq.slice inp 0 len0 in + let t1 = Seq.slice inp len0 len in + + map_blocks_multi_acc blocksize mi hi n inp f acc == + map_blocks_multi_acc blocksize (mi + n0) hi n1 t1 f + (map_blocks_multi_acc blocksize mi hi n0 t0 f acc)) +*) diff --git a/tests/hacl/Lib.Sequence.Lemmas.fsti.hints b/tests/hacl/Lib.Sequence.Lemmas.fsti.hints new file mode 100644 index 00000000000..fe2b763cecb --- /dev/null +++ b/tests/hacl/Lib.Sequence.Lemmas.fsti.hints @@ -0,0 +1,860 @@ +[ + "þ#RÇ•Òðr»S¸Ø\u0015}Ø\u0018", + [ + [ + "Lib.Sequence.Lemmas.get_block_s", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3833667c59aecdf581ef615fb6194b08", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_ade7773d9cd7cd1a2abc2fe3f191b9e0", + "refinement_interpretation_Tm_refine_c37230a0b45bfa733513e4ce89ef34d6", + "typing_FStar.Seq.Base.length" + ], + 0, + "13e00680463992ec2698283148a06dbf" + ], + [ + "Lib.Sequence.Lemmas.get_block_s", + 2, + 0, + 0, + [ "@query" ], + 0, + "ae9abfd53e327e1e3f7ad6fc0ae68e10" + ], + [ + "Lib.Sequence.Lemmas.get_last_s", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3833667c59aecdf581ef615fb6194b08", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "typing_FStar.Seq.Base.length" + ], + 0, + "563f38db8e255a24a36e4667f6cb3c8e" + ], + [ + "Lib.Sequence.Lemmas.repeat_right_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_12aaa86fce4296e5ca537def690c90b7", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "refinement_interpretation_Tm_refine_fd19feb5f9ea77c43306cb5b7a87bc36" + ], + 0, + "bb04fc4ae901d31b8cd72c5a0d8f962d" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_right_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "int_typing", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c521dec61896a844c454ea9692ebf2e2", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2" + ], + 0, + "7e40a6d6d1ea10bd2567db62987154a7" + ], + [ + "Lib.Sequence.Lemmas.repeati_right_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "c1aac410cd098b1d9e2e5fac899a6574" + ], + [ + "Lib.Sequence.Lemmas.repeati_right_shift", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "e570a0aa12b95699730ebe6d33338256" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_f", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_bbe86a0a6209b8c07083cd4c9f7f9aa5", + "refinement_interpretation_Tm_refine_e7fccb01210c2efde8affa46b16abcf2", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "typing_FStar.Seq.Base.length" + ], + 0, + "7f9be82ee9ac50a84002cce5cad2d6ea" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_f", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "c1776ed03a0bae560c597f041338e8c2" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "8fe207a80f35c4cdbee51d492220811a" + ], + [ + "Lib.Sequence.Lemmas.lemma_repeat_gen_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "ed72c52d956488c64fca0c52aae0e8e8" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_Lib.Sequence.length" + ], + 0, + "2a92d386bdaa69387631b8507f746b51" + ], + [ + "Lib.Sequence.Lemmas.lemma_repeat_gen_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_FStar.Seq.Base.length", "typing_Lib.Sequence.length" + ], + 0, + "1295131ceedbfaf2db2482ffdab80ba5" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi_extensionality_zero", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "l_quant_interp_e0c135c0d1d2d760fb7f155318d559d0", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_46d0490fc1bcee17b1822abbbaec9be9", + "refinement_interpretation_Tm_refine_4a1f484c8b51af7634bbc9267ad1b558", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "50c5af1f7f1feffa5d4d67ad8ef5f5e6" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_extensionality_zero", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_46d0490fc1bcee17b1822abbbaec9be9", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_667c0deceb286bd669e5316a684eee1c", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c8d0b9c0d9bab47c0f00a15221dd05c4" + ], + 0, + "4e9b039dde0bff212fecf72027a7ba4a" + ], + [ + "Lib.Sequence.Lemmas.len0_div_bs", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "3f1019a2577d09c55e445926eb2ea0bd" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma0", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "8b9be73e42075a05e5aeed05e22f693e" + ], + [ + "Lib.Sequence.Lemmas.split_len_lemma", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "deae0656b4bc40fb1593e45ad0c77138" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_multi_split", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_24813cd65ccef7cf8c09228ba9bdbf64", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_Lib.Sequence.length" + ], + 0, + "8b8a8f75c9ef1a4c485a37d5de0e36ee" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_split", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_fcf14b481b3a84f47b67fc1dd0096ca5", + "typing_Lib.Sequence.length" + ], + 0, + "299bf3092005cf34f257c0b059a1fd7c" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "int_inversion", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "739766b9133dec918e1e579b95473738" + ], + [ + "Lib.Sequence.Lemmas.lemma_repeat_blocks_via_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Division", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "typing_FStar.Seq.Base.length", "typing_Lib.Sequence.length" + ], + 0, + "f317d4255a73206b88bcdea744329f0d" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_multi_is_repeat_gen_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_dc64ef62fd3101207c953516420ca99f", + "typing_Lib.Sequence.length" + ], + 0, + "02633b72191870fd702d768740c9e69e" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_is_repeat_gen_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_f571f2610f867b24665eec96f119e18c" + ], + 0, + "28b963a0b3363e652c1bc07d6377f43c" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_multi_split", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Division", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_5e9c3dad358c3890f342f5eeb42bb76e", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "typing_Lib.Sequence.length" + ], + 0, + "16f8b44d23a9eb3cd9d11a33815485f5" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_split", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6040141db1ba33361776c6b54feae71f", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_725406258cbec7cb7a61bee1d844d771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647" + ], + 0, + "83130f3d208a299b3d000f03920544b4" + ], + [ + "Lib.Sequence.Lemmas.repeat_blocks_multi_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "74a86cf7de72dee199162971bb569382" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "5450b51bf6853c3f0a4be5ab0cb04747" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_extensionality", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Division", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_Lib.Sequence.length" + ], + 0, + "eeddae13bf985c6ba3535c8cf489526c" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_map_f", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.Sequence_interpretation_Tm_arrow_d3b9c37343cabe37d3e11c0a1cafa7da", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_append", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "typing_FStar.Seq.Base.append", "typing_FStar.Seq.Base.length" + ], + 0, + "fbc159dc983edb8474a64b8674b7e0fe" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_map_f", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "b367aa27c4d33121d8f40ca93af8ff62" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_map_l", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "1fd71e464c5faa8be2b1f8e3b2c921a8" + ], + [ + "Lib.Sequence.Lemmas.repeat_gen_blocks_map_l_length", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "d4a831a7f9c60192301c2270afd6243f" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "475573dca129be53e4e0783d6de8e552" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_Lib.Sequence.length" + ], + 0, + "6da6f20a43cf9f77df44981d12b38c3e" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_length", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_Lib.Sequence.length" + ], + 0, + "7f72253583a113c037b8e1db5755bdce" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_repeat_gen_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "eb79dfb9fce1ed0c977f41713b901645" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_is_repeat_gen_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_Lib.Sequence.length" + ], + 0, + "b72a8d8ccb98d10821cf6f7fbe36d21c" + ], + [ + "Lib.Sequence.Lemmas.f_shift", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "1ce873152945e25b2e83bfc05aaee18a" + ], + [ + "Lib.Sequence.Lemmas.f_shift", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "1c2863a0199dc24cbcae8fd9fea96e9e" + ], + [ + "Lib.Sequence.Lemmas.l_shift", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d" + ], + 0, + "41e097cedf3a3ba276090ba736d585a8" + ], + [ + "Lib.Sequence.Lemmas.l_shift", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213" + ], + 0, + "cc0aa97b8eb4d792ddacffa427d5cc14" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_map_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "d5b4e5521102e65ed28ccbab59a44b32" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_is_map_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "typing_Lib.Sequence.length" + ], + 0, + "bbf49aff4b3e76ee88141df6b2e15c05" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_multi_acc_is_map_blocks_multi0", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d" + ], + 0, + "f57047f3e988646fa492d09cc5549306" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_acc_is_map_blocks0", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_f571f2610f867b24665eec96f119e18c" + ], + 0, + "eeff17beba3e966bef49b53eb1a5b399" + ], + [ + "Lib.Sequence.Lemmas.map_blocks_is_empty", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Division", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7ad90407dad3095183eb4d692b62fd08" + ], + 0, + "d26c68bfdca0bbc0c5ccffa9438617cb" + ] + ] +] \ No newline at end of file diff --git a/tests/hacl/Lib.Sequence.fsti b/tests/hacl/Lib.Sequence.fsti new file mode 100644 index 00000000000..d3e0b95d032 --- /dev/null +++ b/tests/hacl/Lib.Sequence.fsti @@ -0,0 +1,612 @@ +module Lib.Sequence + +open FStar.Mul +open Lib.IntTypes + +#set-options "--z3rlimit 30 --max_fuel 0 --max_ifuel 0 --using_facts_from '-* +Prims +FStar.Math.Lemmas +FStar.Seq +Lib.IntTypes +Lib.Sequence'" + +/// Variable length Sequences, derived from FStar.Seq + +(* This is the type of unbounded sequences. + Use this only when dealing with, say, user input whose length is unbounded. + As far as possible use the API for bounded sequences defined later in this file.*) + +(** Definition of a Sequence *) +let seq (a:Type0) = Seq.seq a + +(** Length of a Sequence *) +let length (#a:Type0) (s:seq a) : nat = Seq.length s + +/// Fixed length Sequences + +(* This is the type of bounded sequences. + Use this as much as possible. + It adds additional length checks that you'd have to prove in the implementation otherwise *) + +(** Definition of a fixed-length Sequence *) +let lseq (a:Type0) (len:size_nat) = s:seq a{Seq.length s == len} +let to_seq (#a:Type0) (#len:size_nat) (l:lseq a len) : seq a = l +let to_lseq (#a:Type0) (s:seq a{length s <= max_size_t}) : l:lseq a (length s){l == s} = s + +(* If you want to prove your code with an abstract lseq use the following: *) +// val lseq: a:Type0 -> len:size_nat -> Type0 +// val to_seq: #a:Type0 -> #len:size_nat -> lseq a len -> s:seq a{length s == len} +// val to_lseq: #a:Type0 -> s:seq a{length s <= max_size_t} -> lseq a (length s) + +val index: + #a:Type + -> #len:size_nat + -> s:lseq a len + -> i:size_nat{i < len} -> + Tot (r:a{r == Seq.index (to_seq s) i}) + +(** Creation of a fixed-length Sequence from an initial value *) +val create: + #a:Type + -> len:size_nat + -> init:a -> + Tot (s:lseq a len{to_seq s == Seq.create len init /\ (forall (i:nat). + {:pattern (index s i)} i < len ==> index s i == init)}) + + +(** Concatenate sequences: use with care, may make implementation hard to verify *) +val concat: + #a:Type + -> #len0:size_nat + -> #len1:size_nat{len0 + len1 <= max_size_t} + -> s0:lseq a len0 + -> s1:lseq a len1 -> + Tot (s2:lseq a (len0 + len1){to_seq s2 == Seq.append (to_seq s0) (to_seq s1)}) + +let ( @| ) #a #len0 #len1 s0 s1 = concat #a #len0 #len1 s0 s1 + + +(** Conversion of a Sequence to a list *) +val to_list: + #a:Type + -> s:seq a -> + Tot (l:list a{List.Tot.length l = length s /\ l == Seq.seq_to_list s}) + +(** Creation of a fixed-length Sequence from a list of values *) +val of_list: + #a:Type + -> l:list a{List.Tot.length l <= max_size_t} -> + Tot (s:lseq a (List.Tot.length l){to_seq s == Seq.seq_of_list l}) + +val of_list_index: + #a:Type + -> l:list a{List.Tot.length l <= max_size_t} + -> i:nat{i < List.Tot.length l} -> + Lemma (index (of_list l) i == List.Tot.index l i) + [SMTPat (index (of_list l) i)] + +val equal (#a:Type) (#len:size_nat) (s1:lseq a len) (s2:lseq a len) : Type0 + +val eq_intro: #a:Type -> #len:size_nat -> s1:lseq a len -> s2:lseq a len -> + Lemma + (requires forall i. {:pattern index s1 i; index s2 i} index s1 i == index s2 i) + (ensures equal s1 s2) + [SMTPat (equal s1 s2)] + +val eq_elim: #a:Type -> #len:size_nat -> s1:lseq a len -> s2:lseq a len -> + Lemma + (requires equal s1 s2) + (ensures s1 == s2) + [SMTPat (equal s1 s2)] + +(* Alias for creation from a list *) +unfold let createL #a l = of_list #a l + +(** Updating an element of a fixed-length Sequence *) +val upd: + #a:Type + -> #len:size_nat + -> s:lseq a len + -> n:size_nat{n < len} + -> x:a -> + Tot (o:lseq a len{to_seq o == Seq.upd (to_seq s) n x /\ index o n == x /\ (forall (i:size_nat). + {:pattern (index s i)} (i < len /\ i <> n) ==> index o i == index s i)}) + +(** Membership of an element to a fixed-length Sequence *) +val member: #a:eqtype -> #len: size_nat -> a -> lseq a len -> Tot bool + +(** Operator for accessing an element of a fixed-length Sequence *) +unfold +let op_String_Access #a #len = index #a #len + +(** Operator for updating an element of a fixed-length Sequence *) +unfold +let op_String_Assignment #a #len = upd #a #len + +(** Selecting a subset of a fixed-length Sequence *) +val sub: + #a:Type + -> #len:size_nat + -> s1:lseq a len + -> start:size_nat + -> n:size_nat{start + n <= len} -> + Tot (s2:lseq a n{to_seq s2 == Seq.slice (to_seq s1) start (start + n) /\ + (forall (k:nat{k < n}). {:pattern (index s2 k)} index s2 k == index s1 (start + k))}) + +(** Selecting a subset of a fixed-length Sequence *) +let slice + (#a:Type) + (#len:size_nat) + (s1:lseq a len) + (start:size_nat) + (fin:size_nat{start <= fin /\ fin <= len}) + = + sub #a s1 start (fin - start) + +(** Updating a sub-Sequence from another fixed-length Sequence *) +val update_sub: + #a:Type + -> #len:size_nat + -> i:lseq a len + -> start:size_nat + -> n:size_nat{start + n <= len} + -> x:lseq a n -> + Tot (o:lseq a len{sub o start n == x /\ + (forall (k:nat{(0 <= k /\ k < start) \/ (start + n <= k /\ k < len)}). + {:pattern (index o k)} index o k == index i k)}) + +(** Lemma regarding updating a sub-Sequence with another Sequence *) +val lemma_update_sub: + #a:Type + -> #len:size_nat + -> dst:lseq a len + -> start:size_nat + -> n:size_nat{start + n <= len} + -> src:lseq a n + -> res:lseq a len -> + Lemma + (requires + sub res 0 start == sub dst 0 start /\ + sub res start n == src /\ + sub res (start + n) (len - start - n) == + sub dst (start + n) (len - start - n)) + (ensures + res == update_sub dst start n src) + +val lemma_concat2: + #a:Type0 + -> len0:size_nat + -> s0:lseq a len0 + -> len1:size_nat{len0 + len1 <= max_size_t} + -> s1:lseq a len1 + -> s:lseq a (len0 + len1) -> + Lemma + (requires + sub s 0 len0 == s0 /\ + sub s len0 len1 == s1) + (ensures s == concat s0 s1) + +val lemma_concat3: + #a:Type0 + -> len0:size_nat + -> s0:lseq a len0 + -> len1:size_nat{len0 + len1 <= max_size_t} + -> s1:lseq a len1 + -> len2:size_nat{len0 + len1 + len2 <= max_size_t} + -> s2:lseq a len2 + -> s:lseq a (len0 + len1 + len2) -> + Lemma + (requires + sub s 0 len0 == s0 /\ + sub s len0 len1 == s1 /\ + sub s (len0 + len1) len2 == s2) + (ensures s == concat (concat s0 s1) s2) + +(** Updating a sub-Sequence from another fixed-length Sequence *) +let update_slice + (#a:Type) + (#len:size_nat) + (i:lseq a len) + (start:size_nat) + (fin:size_nat{start <= fin /\ fin <= len}) + (upd:lseq a (fin - start)) + = + update_sub #a i start (fin - start) upd + +(** Creation of a fixed-length Sequence from an initialization function *) +val createi: #a:Type + -> len:size_nat + -> init:(i:nat{i < len} -> a) -> + Tot (s:lseq a len{(forall (i:nat). + {:pattern (index s i)} i < len ==> index s i == init i)}) + +(** Mapi function for fixed-length Sequences *) +val mapi:#a:Type -> #b:Type -> #len:size_nat + -> f:(i:nat{i < len} -> a -> Tot b) + -> s1:lseq a len -> + Tot (s2:lseq b len{(forall (i:nat). + {:pattern (index s2 i)} i < len ==> index s2 i == f i s1.[i])}) + +(** Map function for fixed-length Sequences *) +val map:#a:Type -> #b:Type -> #len:size_nat + -> f:(a -> Tot b) + -> s1:lseq a len -> + Tot (s2:lseq b len{(forall (i:nat). + {:pattern (index s2 i)} i < len ==> index s2 i == f s1.[i])}) + +(** Map2i function for fixed-length Sequences *) +val map2i:#a:Type -> #b:Type -> #c:Type -> #len:size_nat + -> f:(i:nat{i < len} -> a -> b -> Tot c) + -> s1:lseq a len + -> s2:lseq b len -> + Tot (s3:lseq c len{(forall (i:nat). + {:pattern (index s3 i)} i < len ==> index s3 i == f i s1.[i] s2.[i])}) + +(** Map2 function for fixed-length Sequences *) +val map2:#a:Type -> #b:Type -> #c:Type -> #len:size_nat + -> f:(a -> b -> Tot c) + -> s1:lseq a len + -> s2:lseq b len -> + Tot (s3:lseq c len{(forall (i:nat). + {:pattern (index s3 i)} i < len ==> index s3 i == f s1.[i] s2.[i])}) + +(** Forall function for fixed-length Sequences *) +val for_all:#a:Type -> #len:size_nat -> (a -> Tot bool) -> lseq a len -> bool + +(** Forall2 function for fixed-length Sequences *) +val for_all2:#a:Type -> #b:Type -> #len:size_nat + -> (a -> b -> Tot bool) + -> s1:lseq a len + -> s2:lseq b len -> + Tot bool + +val repeati_blocks: + #a:Type0 + -> #b:Type0 + -> blocksize:size_pos + -> inp:seq a + -> f:(i:nat{i < length inp / blocksize} -> lseq a blocksize -> b -> b) + -> l:(i:nat{i == length inp / blocksize} -> len:size_nat{len == length inp % blocksize} -> s:lseq a len -> b -> b) + -> init:b -> + Tot b + +let repeat_blocks_f + (#a:Type0) + (#b:Type0) + (bs:size_nat{bs > 0}) + (inp:seq a) + (f:(lseq a bs -> b -> b)) + (nb:nat{nb == length inp / bs}) + (i:nat{i < nb}) + (acc:b) : b + = + assert ((i+1) * bs <= nb * bs); + let block = Seq.slice inp (i * bs) (i * bs + bs) in + f block acc + +val repeat_blocks: + #a:Type0 + -> #b:Type0 + -> #c:Type0 + -> blocksize:size_pos + -> inp:seq a + -> f:(lseq a blocksize -> b -> b) + -> l:(len:nat{len < blocksize} -> s:lseq a len -> b -> c) + -> init:b -> + Tot c + +val lemma_repeat_blocks: + #a:Type0 + -> #b:Type0 + -> #c:Type0 + -> bs:size_pos + -> inp:seq a + -> f:(lseq a bs -> b -> b) + -> l:(len:nat{len < bs} -> s:lseq a len -> b -> c) + -> init:b -> + Lemma ( + let len = length inp in + let nb = len / bs in + let rem = len % bs in + let acc = Lib.LoopCombinators.repeati nb (repeat_blocks_f bs inp f nb) init in + let last = Seq.slice inp (nb * bs) len in + let acc = l rem last acc in + repeat_blocks #a #b bs inp f l init == acc) + +val repeat_blocks_multi: + #a:Type0 + -> #b:Type0 + -> blocksize:size_pos + -> inp:seq a{length inp % blocksize = 0} + -> f:(lseq a blocksize -> b -> b) + -> init:b -> + Tot b + +val lemma_repeat_blocks_multi: + #a:Type0 + -> #b:Type0 + -> bs:size_pos + -> inp:seq a{length inp % bs = 0} + -> f:(lseq a bs -> b -> b) + -> init:b -> + Lemma ( + let len = length inp in + let nb = len / bs in + repeat_blocks_multi #a #b bs inp f init == + Lib.LoopCombinators.repeati nb (repeat_blocks_f bs inp f nb) init) + +(** Generates `n` blocks of length `len` by iteratively applying a function with an accumulator *) +val generate_blocks: + #t:Type0 + -> len:size_nat + -> max:nat + -> n:nat{n <= max} + -> a:(i:nat{i <= max} -> Type) + -> f:(i:nat{i < max} -> a i -> a (i + 1) & s:seq t{length s == len}) + -> init:a 0 -> + Tot (a n & s:seq t{length s == n * len}) + +(** Generates `n` blocks of length `len` by iteratively applying a function without an accumulator *) + +val generate_blocks_simple: + #a:Type0 + -> blocksize:size_pos + -> max:nat + -> n:nat{n <= max} + -> f:(i:nat{i < max} -> lseq a blocksize) -> + Tot (s:seq a{length s == n * blocksize}) + +(** The following functions allow us to bridge between unbounded and bounded sequences *) + + +val div_interval: b:pos -> n:int -> i:int -> Lemma + (requires n * b <= i /\ i < (n + 1) * b) + (ensures i / b = n) + +val mod_interval_lt: b:pos -> n:int -> i:int -> j:int -> Lemma + (requires n * b <= i /\ i < j /\ j < (n + 1) * b) + (ensures i % b < j % b) + +val div_mul_lt: b:pos -> a:int -> n:int -> Lemma + (requires a < n * b) + (ensures a / b < n) + +val mod_div_lt: b:pos -> i:int -> j:int -> Lemma + (requires (j / b) * b <= i /\ i < j) + (ensures i % b < j % b) + +val div_mul_l: a:int -> b:int -> c:pos -> d:pos -> Lemma + (requires a / d = b / d) + (ensures a / (c * d) = b / (c * d)) + + +let map_blocks_a (a:Type) (bs:size_nat) (max:nat) (i:nat{i <= max}) = s:seq a{length s == i * bs} + +let map_blocks_f + (#a:Type) + (bs:size_nat{bs > 0}) + (max:nat) + (inp:seq a{length inp == max * bs}) + (f:(i:nat{i < max} -> lseq a bs -> lseq a bs)) + (i:nat{i < max}) + (acc:map_blocks_a a bs max i) : map_blocks_a a bs max (i + 1) += + Math.Lemmas.lemma_mult_le_right bs (i+1) max; + let block = Seq.slice inp (i*bs) ((i+1)*bs) in + Seq.append acc (f i block) + + +val map_blocks_multi: + #a:Type0 + -> blocksize:size_pos + -> max:nat + -> n:nat{n <= max} + -> inp:seq a{length inp == max * blocksize} + -> f:(i:nat{i < max} -> lseq a blocksize -> lseq a blocksize) -> + Tot (out:seq a {length out == n * blocksize}) + + +val lemma_map_blocks_multi: + #a:Type0 + -> blocksize:size_pos + -> max:nat + -> n:nat{n <= max} + -> inp:seq a{length inp == max * blocksize} + -> f:(i:nat{i < max} -> lseq a blocksize -> lseq a blocksize) + -> Lemma + (map_blocks_multi #a blocksize max n inp f == + LoopCombinators.repeat_gen n (map_blocks_a a blocksize max) (map_blocks_f #a blocksize max inp f) Seq.empty) + + +#restart-solver +val index_map_blocks_multi: + #a:Type0 + -> bs:size_pos + -> max:pos + -> n:pos{n <= max} + -> inp:seq a{length inp == max * bs} + -> f:(i:nat{i < max} -> lseq a bs -> lseq a bs) + -> i:nat{i < n * bs} + -> Lemma ( + div_mul_lt bs i n; + let j = i / bs in + let block: lseq a bs = Seq.slice inp (j * bs) ((j + 1) * bs) in + Seq.index (map_blocks_multi bs max n inp f) i == Seq.index (f j block) (i % bs)) + +(* A full block index *) +unfold +let block (len:nat) (blocksize:size_pos) = i:nat{i < len / blocksize} + +(* Index of last (incomplete) block *) +unfold +let last (len:nat) (blocksize:size_pos) = i:nat{i = len / blocksize} + +val map_blocks: + #a:Type0 + -> blocksize:size_pos + -> inp:seq a + -> f:(block (length inp) blocksize -> lseq a blocksize -> lseq a blocksize) + -> g:(last (length inp) blocksize -> rem:size_nat{rem < blocksize} -> s:lseq a rem -> lseq a rem) -> + Tot (out:seq a{length out == length inp}) + +val lemma_map_blocks: + #a:Type0 + -> blocksize:size_pos + -> inp:seq a + -> f:(block (length inp) blocksize -> lseq a blocksize -> lseq a blocksize) + -> g:(last (length inp) blocksize -> rem:size_nat{rem < blocksize} -> s:lseq a rem -> lseq a rem) -> + Lemma ( + let len = length inp in + let nb = len / blocksize in + let rem = len % blocksize in + let blocks = Seq.slice inp 0 (nb * blocksize) in + let last = Seq.slice inp (nb * blocksize) len in + Math.Lemmas.cancel_mul_div nb blocksize; + let bs = map_blocks_multi #a blocksize nb nb blocks f in + let res = if (rem > 0) then Seq.append bs (g nb rem last) else bs in + res == map_blocks #a blocksize inp f g) + + +(* Computes the block of the i-th element of (map_blocks blocksize input f g) *) +let get_block + (#a:Type) + (#len:nat) + (blocksize:size_pos) + (inp:seq a{length inp == len}) + (f:(block len blocksize -> lseq a blocksize -> lseq a blocksize)) + (i:nat{i < (len / blocksize) * blocksize}) : + Pure (lseq a blocksize) True (fun _ -> i / blocksize < len / blocksize) += + div_mul_lt blocksize i (len / blocksize); + let j: block len blocksize = i / blocksize in + let b: lseq a blocksize = Seq.slice inp (j * blocksize) ((j + 1) * blocksize) in + f j b + + +(* Computes the last block of (map_blocks blocksize input f g) *) +let get_last + (#a:Type) + (#len:nat) + (blocksize:size_pos) + (inp:seq a{length inp == len}) + (g:(last len blocksize -> rem:size_nat{rem < blocksize} -> lseq a rem -> lseq a rem)) + (i:nat{(len / blocksize) * blocksize <= i /\ i < len}) : + Pure (lseq a (len % blocksize)) True (fun _ -> i % blocksize < len % blocksize) += + mod_div_lt blocksize i len; + let rem = len % blocksize in + let b: lseq a rem = Seq.slice inp (len - rem) len in + g (len / blocksize) rem b + + +val index_map_blocks: + #a:Type + -> blocksize:size_pos + -> inp:seq a + -> f:(block (length inp) blocksize -> lseq a blocksize -> lseq a blocksize) + -> g:(last (length inp) blocksize -> rem:size_nat{rem < blocksize} -> lseq a rem -> lseq a rem) + -> i:nat{i < length inp} -> + Lemma ( + let output = map_blocks blocksize inp f g in + let j = i % blocksize in + if i < (length inp / blocksize) * blocksize + then + let block_i = get_block blocksize inp f i in + Seq.index output i == Seq.index block_i j + else + let block_i = get_last blocksize inp g i in + Seq.index output i == Seq.index block_i j + ) + + +val eq_generate_blocks0: + #t:Type0 + -> len:size_nat + -> n:nat + -> a:(i:nat{i <= n} -> Type) + -> f:(i:nat{i < n} -> a i -> a (i + 1) & s:seq t{length s == len}) + -> init:a 0 -> + Lemma (generate_blocks #t len n 0 a f init == + (init,Seq.empty)) + +val unfold_generate_blocks: + #t:Type0 + -> len:size_nat + -> n:nat + -> a:(i:nat{i <= n} -> Type) + -> f:(i:nat{i < n} -> a i -> a (i + 1) & s:seq t{length s == len}) + -> init:a 0 + -> i:nat{i < n} -> + Lemma (generate_blocks #t len n (i+1) a f init == + (let (acc,s) = generate_blocks #t len n i a f init in + let (acc',s') = f i acc in + (acc',Seq.append s s'))) + +val index_generate_blocks: + #t:Type0 + -> len:size_pos + -> max:nat + -> n:pos{n <= max} + -> f:(i:nat{i < max} -> unit -> unit & s:seq t{length s == len}) + -> i:nat{i < n * len} + -> Lemma (Math.Lemmas.lemma_mult_le_right len n max; + div_mul_lt len i max; + let a_spec (i:nat{i <= max}) = unit in + let _,s1 = generate_blocks len max n a_spec f () in + let _,s2 = f (i / len) () in + Seq.index s1 i == Seq.index s2 (i % len)) + +#push-options "--using_facts_from '+FStar.UInt.pow2_values'" + +val create2: #a:Type -> x0:a -> x1:a -> lseq a 2 + +val create2_lemma: #a:Type -> x0:a -> x1:a -> + Lemma (let s = create2 x0 x1 in + s.[0] == x0 /\ s.[1] == x1) + [SMTPat (create2 #a x0 x1)] + +val create4: #a:Type -> x0:a -> x1:a -> x2:a -> x3:a -> lseq a 4 + +val create4_lemma: #a:Type -> x0:a -> x1:a -> x2:a -> x3:a -> + Lemma (let s = create4 x0 x1 x2 x3 in + s.[0] == x0 /\ s.[1] == x1 /\ s.[2] == x2 /\ s.[3] == x3) + [SMTPat (create4 #a x0 x1 x2 x3)] + +val create8: #a:Type -> x0:a -> x1:a -> x2:a -> x3:a -> x4:a -> x5:a -> x6:a -> x7:a -> lseq a 8 + +val create8_lemma: #a:Type -> x0:a -> x1:a -> x2:a -> x3:a -> x4:a -> x5:a -> x6:a -> x7:a -> + Lemma (let s = create8 x0 x1 x2 x3 x4 x5 x6 x7 in + s.[0] == x0 /\ s.[1] == x1 /\ s.[2] == x2 /\ s.[3] == x3 /\ + s.[4] == x4 /\ s.[5] == x5 /\ s.[6] == x6 /\ s.[7] == x7) + [SMTPat (create8 #a x0 x1 x2 x3 x4 x5 x6 x7)] + +val create16: #a:Type + -> x0:a -> x1:a -> x2:a -> x3:a -> x4:a -> x5:a -> x6:a -> x7:a + -> x8:a -> x9:a -> x10:a -> x11:a -> x12:a -> x13:a -> x14:a -> x15:a -> lseq a 16 + +val create16_lemma: #a:Type + -> x0:a -> x1:a -> x2:a -> x3:a -> x4:a -> x5:a -> x6:a -> x7:a + -> x8:a -> x9:a -> x10:a -> x11:a -> x12:a -> x13:a -> x14:a -> x15:a -> + Lemma (let s = create16 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 in + s.[0] == x0 /\ s.[1] == x1 /\ s.[2] == x2 /\ s.[3] == x3 /\ + s.[4] == x4 /\ s.[5] == x5 /\ s.[6] == x6 /\ s.[7] == x7 /\ + s.[8] == x8 /\ s.[9] == x9 /\ s.[10] == x10 /\ s.[11] == x11 /\ + s.[12] == x12 /\ s.[13] == x13 /\ s.[14] == x14 /\ s.[15] == x15) + [SMTPat (create16 #a x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15)] + +val create32: #a:Type + -> x0:a -> x1:a -> x2:a -> x3:a -> x4:a -> x5:a -> x6:a -> x7:a + -> x8:a -> x9:a -> x10:a -> x11:a -> x12:a -> x13:a -> x14:a -> x15:a + -> x16:a -> x17:a -> x18:a -> x19:a -> x20:a -> x21:a -> x22:a -> x23:a + -> x24:a -> x25:a -> x26:a -> x27:a -> x28:a -> x29:a -> x30:a -> x31:a -> lseq a 32 + +val create32_lemma: #a:Type + -> x0:a -> x1:a -> x2:a -> x3:a -> x4:a -> x5:a -> x6:a -> x7:a + -> x8:a -> x9:a -> x10:a -> x11:a -> x12:a -> x13:a -> x14:a -> x15:a + -> x16:a -> x17:a -> x18:a -> x19:a -> x20:a -> x21:a -> x22:a -> x23:a + -> x24:a -> x25:a -> x26:a -> x27:a -> x28:a -> x29:a -> x30:a -> x31:a -> + Lemma (let s = create32 x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29 x30 x31 in + s.[0] == x0 /\ s.[1] == x1 /\ s.[2] == x2 /\ s.[3] == x3 /\ + s.[4] == x4 /\ s.[5] == x5 /\ s.[6] == x6 /\ s.[7] == x7 /\ + s.[8] == x8 /\ s.[9] == x9 /\ s.[10] == x10 /\ s.[11] == x11 /\ + s.[12] == x12 /\ s.[13] == x13 /\ s.[14] == x14 /\ s.[15] == x15 /\ + s.[16] == x16 /\ s.[17] == x17 /\ s.[18] == x18 /\ s.[19] == x19 /\ + s.[20] == x20 /\ s.[21] == x21 /\ s.[22] == x22 /\ s.[23] == x23 /\ + s.[24] == x24 /\ s.[25] == x25 /\ s.[26] == x26 /\ s.[27] == x27 /\ + s.[28] == x28 /\ s.[29] == x29 /\ s.[30] == x30 /\ s.[31] == x31) + [SMTPat (create32 #a x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29 x30 x31)] diff --git a/tests/hacl/Lib.Sequence.fsti.hints b/tests/hacl/Lib.Sequence.fsti.hints new file mode 100644 index 00000000000..224c84cd3d6 --- /dev/null +++ b/tests/hacl/Lib.Sequence.fsti.hints @@ -0,0 +1,976 @@ +[ + "qÂÑŸQ;ì5´í¿\u0002#\u001c", + [ + [ + "Lib.Sequence.to_lseq", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "refinement_interpretation_Tm_refine_d6b65d48a86d318eee5320e9fc07ce57" + ], + 0, + "2bac857ac5a7372c8405cc1190964648" + ], + [ + "Lib.Sequence.index", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.to_seq", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "442a47789488265e1263b0b076187d40" + ], + [ + "Lib.Sequence.create", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4" + ], + 0, + "a3808336cf0ec7916c8a2f369a07d750" + ], + [ + "Lib.Sequence.concat", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_485bc5b41c309040098b0ab067e4ac2c", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4" + ], + 0, + "4afa2a373a8d742c1bdfd965e390c809" + ], + [ + "Lib.Sequence.to_list", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.eqtype", + "equation_Prims.nat", "function_token_typing_Prims.int", + "haseqTm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f" + ], + 0, + "ca10ad20e7f2b04ea59b7666fc762c7e" + ], + [ + "Lib.Sequence.of_list", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_56609cb097df748006aafa90a98ed73d" + ], + 0, + "904e0c6bb89c5e661005e0889fa0a2f6" + ], + [ + "Lib.Sequence.of_list_index", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_56609cb097df748006aafa90a98ed73d" + ], + 0, + "93354fdbc85d0cf489337f8b0f42e17d" + ], + [ + "Lib.Sequence.eq_intro", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.to_seq", + "refinement_interpretation_Tm_refine_6b8a1e6e39c8fbea3860e8d70e3dfbd5", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "41b4af4c67a9666725ff2eabe6ac300e" + ], + [ + "Lib.Sequence.upd", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.to_seq", "equation_Prims.eqtype", + "equation_Prims.nat", "function_token_typing_Prims.int", + "haseqTm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_414d0a9f578ab0048252f8c8f552b99f", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_dee0f34b44c44e6d512c6db0858b92ef" + ], + 0, + "c7e937ac02dafd7565823fd0fd99ff83" + ], + [ + "Lib.Sequence.sub", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.to_seq", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_LessThanOrEqual", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_b9bf9d0f857340a8d758087374a41c06", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "ff71ff779377c165a95b2a073479e97c" + ], + [ + "Lib.Sequence.slice", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4", + "refinement_interpretation_Tm_refine_e5df7b46d8b4d6787f7fc44dbc0015e5" + ], + 0, + "c3de20185f217385814401ddf46c49ac" + ], + [ + "Lib.Sequence.update_sub", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.to_seq", "equation_Prims.nat", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0b72b617030921a422a8020811c2f320", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_b9bf9d0f857340a8d758087374a41c06", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "0f5bafcd6d8a2b40c0154bd713af0a59" + ], + [ + "Lib.Sequence.lemma_update_sub", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.to_seq", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_03ea481677aa4f241e0fcf866da3eab4", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_b9bf9d0f857340a8d758087374a41c06", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "b40302cf1eb4747e21f2e59f6736273e" + ], + [ + "Lib.Sequence.lemma_concat2", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_485bc5b41c309040098b0ab067e4ac2c", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4" + ], + 0, + "064dbbb03191ec1570eda18f611540d0" + ], + [ + "Lib.Sequence.lemma_concat3", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "primitive_Prims.op_Addition", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_485bc5b41c309040098b0ab067e4ac2c", + "refinement_interpretation_Tm_refine_4e798f335f6b4b1ff5946bd101912e0e", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4" + ], + 0, + "d382f70ae88453b6f33ef3ef884e6bd9" + ], + [ + "Lib.Sequence.update_slice", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4", + "refinement_interpretation_Tm_refine_e5df7b46d8b4d6787f7fc44dbc0015e5" + ], + 0, + "ba39be2fe3f62f2f8cdc05cb0aa24dab" + ], + [ + "Lib.Sequence.update_slice", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4", + "refinement_interpretation_Tm_refine_e5df7b46d8b4d6787f7fc44dbc0015e5" + ], + 0, + "13265bc261ea499fccc434ae9cd35e29" + ], + [ + "Lib.Sequence.createi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4" + ], + 0, + "fb301175cbb2de98c21a530bc3459b3b" + ], + [ + "Lib.Sequence.mapi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4" + ], + 0, + "75dcfef04d396d5a074a3e51524264e5" + ], + [ + "Lib.Sequence.map", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4" + ], + 0, + "fa8ba89969f8a16ccbc10e29674ddb19" + ], + [ + "Lib.Sequence.map2i", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4" + ], + 0, + "14ea14a41a1e4eb25f56120aa0bb734e" + ], + [ + "Lib.Sequence.map2", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4" + ], + 0, + "8281a1eb2962e5ea8e485fb1029dd171" + ], + [ + "Lib.Sequence.repeati_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "cf00864df9bb285ae96c3487bca04888" + ], + [ + "Lib.Sequence.repeat_blocks_f", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_1c325641987cce6783228428bd15a869", + "refinement_interpretation_Tm_refine_1f6c16a51cd4ba3256b95ca590c832c5", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_aee8f5bc805e40f3cc22e281aedfc983", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_FStar.Seq.Base.length" + ], + 0, + "8240b5bc79513992265f1ca258d2917f" + ], + [ + "Lib.Sequence.repeat_blocks_f", + 2, + 0, + 0, + [ "@query" ], + 0, + "f5ded68723583efcb1681acc89e8d782" + ], + [ + "Lib.Sequence.repeat_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "5d8531912b0ddee93b6e4b956b37dcfe" + ], + [ + "Lib.Sequence.lemma_repeat_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Division", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "typing_FStar.Seq.Base.length", "typing_Lib.Sequence.length" + ], + 0, + "763ca86f510e52b9a21822ccb43b6b2f" + ], + [ + "Lib.Sequence.repeat_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "07156fa8f9cc8256e6d95fe08921dc5c" + ], + [ + "Lib.Sequence.lemma_repeat_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Division", "primitive_Prims.op_Modulus", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_b14928a18ba707004108386997fed9d6", + "typing_Lib.Sequence.length" + ], + 0, + "dd8ca49c8e160863520c666a4e6cc20d" + ], + [ + "Lib.Sequence.generate_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "int_inversion", "primitive_Prims.op_Addition", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "b811f68bf7697dcbc05ee9acb05be10a" + ], + [ + "Lib.Sequence.generate_blocks_simple", + 1, + 0, + 0, + [ "@query" ], + 0, + "8a797ed4ec63b4b86f7f60b7ac534f23" + ], + [ + "Lib.Sequence.div_interval", + 1, + 0, + 0, + [ "@query" ], + 0, + "b295a61093bd8d9ee24975e082cb7e34" + ], + [ + "Lib.Sequence.mod_interval_lt", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "bb82a7af665340d7097a74696738b2df" + ], + [ + "Lib.Sequence.div_mul_lt", + 1, + 0, + 0, + [ "@query" ], + 0, + "11a97ab1fb1afb2fdb0e37db44384d98" + ], + [ + "Lib.Sequence.mod_div_lt", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "bc1b5dadd1c2b4e3a4b5dc48259d71e6" + ], + [ + "Lib.Sequence.div_mul_l", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "2565083250134e2fd111dedd7d34867b" + ], + [ + "Lib.Sequence.map_blocks_f", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", "equation_Lib.Sequence.map_blocks_a", + "equation_Lib.Sequence.seq", "equation_Prims.nat", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_append", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_1c325641987cce6783228428bd15a869", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_aee8f5bc805e40f3cc22e281aedfc983", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "typing_FStar.Seq.Base.length", "typing_Lib.Sequence.length" + ], + 0, + "74751c1395cb98e7e54c5ab08ee69ec1" + ], + [ + "Lib.Sequence.map_blocks_f", + 2, + 0, + 0, + [ "@query" ], + 0, + "7a6caf7afaf0c2e62c33ef1e1c0c54c1" + ], + [ + "Lib.Sequence.map_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "d7610110c0d11ed68ba454c8ee50a055" + ], + [ + "Lib.Sequence.lemma_map_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.pos", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d" + ], + 0, + "bdf5d18e13cd3cc105d40283f5721c35" + ], + [ + "Lib.Sequence.index_map_blocks_multi", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_07295705544891065e7a01d318c0ba51", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_ade7773d9cd7cd1a2abc2fe3f191b9e0", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "typing_FStar.Seq.Base.length" + ], + 0, + "b760e7bf50e21b7476ed29c7869dc461" + ], + [ + "Lib.Sequence.block", + 1, + 0, + 0, + [ "@query" ], + 0, + "9f73155752038a24a62521e0f3c4f194" + ], + [ + "Lib.Sequence.last", + 1, + 0, + 0, + [ "@query" ], + 0, + "3fe9338a10fd75d1be2fb7d3f4965d4b" + ], + [ + "Lib.Sequence.map_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "f36ed29a26183b7ec8a1ad687c44fe95" + ], + [ + "Lib.Sequence.lemma_map_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Division", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "typing_FStar.Seq.Base.length", "typing_Lib.Sequence.length" + ], + 0, + "9cc604190b356768e1d262a057b3e5e8" + ], + [ + "Lib.Sequence.get_block", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3833667c59aecdf581ef615fb6194b08", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_ade7773d9cd7cd1a2abc2fe3f191b9e0", + "refinement_interpretation_Tm_refine_c37230a0b45bfa733513e4ce89ef34d6" + ], + 0, + "dfa63ef52a79cfbdc21010bef30c06ba" + ], + [ + "Lib.Sequence.get_block", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "0c046086f3025259ac529b668b74bc67" + ], + [ + "Lib.Sequence.get_last", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Division", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3833667c59aecdf581ef615fb6194b08", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_eeb59caff9a959bab0eef3a399bf14b7" + ], + 0, + "f4d47c2449b05ed672499d25f959a6d1" + ], + [ + "Lib.Sequence.get_last", + 2, + 0, + 0, + [ "@query" ], + 0, + "f28c8b72c7a92ff7d17599ccdda232f4" + ], + [ + "Lib.Sequence.index_map_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_LessThan", + "primitive_Prims.op_Modulus", "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_824da4eabc6ac6d5c984b1ec60534f76", + "refinement_interpretation_Tm_refine_8710a3dcbb7aeecb1da33ddf8070b919", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "typing_Lib.Sequence.map_blocks" + ], + 0, + "02489a82a1b3678b10ee0584c074b265" + ], + [ + "Lib.Sequence.eq_generate_blocks0", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "2067c8e5f38977a94836b1891a591cb9" + ], + [ + "Lib.Sequence.unfold_generate_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_append", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3833667c59aecdf581ef615fb6194b08", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c8dd98bb91cb1ba6963e5299b3babaa4", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "typing_FStar.Seq.Base.append", "typing_FStar.Seq.Base.length" + ], + 0, + "696c3f5df635d6e78d2dba3290ac6a3e" + ], + [ + "Lib.Sequence.index_generate_blocks", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Division", "primitive_Prims.op_Modulus", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_07295705544891065e7a01d318c0ba51", + "refinement_interpretation_Tm_refine_3833667c59aecdf581ef615fb6194b08", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "unit_typing" + ], + 0, + "21d0ea0cec031e9df0cb97cb01f6ebea" + ], + [ + "Lib.Sequence.create2", + 1, + 0, + 0, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Prims.nat", "int_typing", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "89877ecd7602cfc9ae76b2a83402a5f4" + ], + [ + "Lib.Sequence.create2_lemma", + 1, + 0, + 0, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Prims.nat", "int_typing", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "8d532ab8710c1758fe0d13720e195041" + ], + [ + "Lib.Sequence.create4", + 1, + 0, + 0, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Prims.nat", "int_typing", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "3e67a09905e5c5b05c022cdb18904d55" + ], + [ + "Lib.Sequence.create4_lemma", + 1, + 0, + 0, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Prims.nat", "int_typing", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "037e2086b946ae7163bbda9d1fd31429" + ], + [ + "Lib.Sequence.create8", + 1, + 0, + 0, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Prims.nat", "int_typing", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "b1a833dcadf40531370d93645b8cc579" + ], + [ + "Lib.Sequence.create8_lemma", + 1, + 0, + 0, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Prims.nat", "int_typing", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "73e3b2f28d4eb9f6d84c16a8c59bb4e4" + ], + [ + "Lib.Sequence.create16", + 1, + 0, + 0, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Prims.nat", "int_typing", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "7e665e042f0a395b190d0bb621235afd" + ], + [ + "Lib.Sequence.create16_lemma", + 1, + 0, + 0, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Prims.nat", "int_typing", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "ebbe927cbedf762618d923f98667d742" + ], + [ + "Lib.Sequence.create32", + 1, + 0, + 0, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Prims.nat", "int_typing", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "cc72d4fd028084920598d625968c6459" + ], + [ + "Lib.Sequence.create32_lemma", + 1, + 0, + 0, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Prims.nat", "int_typing", "lemma_FStar.UInt.pow2_values", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2" + ], + 0, + "1a8f9fe1039a997faa7871f42cce4349" + ] + ] +] \ No newline at end of file diff --git a/tests/hacl/Lib.Vec.Lemmas.fst b/tests/hacl/Lib.Vec.Lemmas.fst new file mode 100644 index 00000000000..2e458cae49c --- /dev/null +++ b/tests/hacl/Lib.Vec.Lemmas.fst @@ -0,0 +1,741 @@ +module Lib.Vec.Lemmas + +#set-options "" +#push-options "--z3rlimit 30 --max_fuel 0 --max_ifuel 0 \ + --using_facts_from '-* +Prims +FStar.Pervasives +FStar.Math.Lemmas +FStar.Seq -FStar.Seq.Properties.slice_slice \ + +Lib.IntTypes +Lib.Sequence +Lib.Sequence.Lemmas +Lib.LoopCombinators +Lib.Vec.Lemmas'" + + +let rec lemma_repeat_gen_vec w n a a_vec normalize_v f f_v acc_v0 = + if n = 0 then begin + Loops.eq_repeat_right 0 n a_vec f_v acc_v0; + Loops.eq_repeat_right 0 (w * n) a f (normalize_v 0 acc_v0) end + else begin + let next_p = Loops.repeat_right 0 (n - 1) a_vec f_v acc_v0 in + let next_v = Loops.repeat_right 0 (w * (n - 1)) a f (normalize_v 0 acc_v0) in + + calc (==) { + Loops.repeat_right 0 (w * n) a f (normalize_v 0 acc_v0); + (==) { Loops.repeat_right_plus 0 (w * (n - 1)) (w * n) a f (normalize_v 0 acc_v0) } + Loops.repeat_right (w * (n - 1)) (w * n) a f next_v; + (==) { lemma_repeat_gen_vec w (n - 1) a a_vec normalize_v f f_v acc_v0 } + Loops.repeat_right (w * (n - 1)) (w * n) a f (normalize_v (n - 1) next_p); + (==) { } + normalize_v n (f_v (n - 1) next_p); + (==) { Loops.unfold_repeat_right 0 n a_vec f_v acc_v0 (n - 1) } + normalize_v n (Loops.repeat_right 0 n a_vec f_v acc_v0); + } end + + +let lemma_repeati_vec #a #a_vec w n normalize_v f f_v acc_v0 = + lemma_repeat_gen_vec w n (Loops.fixed_a a) (Loops.fixed_a a_vec) (Loops.fixed_i normalize_v) f f_v acc_v0; + Loops.repeati_def n f_v acc_v0; + Loops.repeati_def (w * n) f (normalize_v acc_v0) + + +let len_is_w_n_blocksize w blocksize n = + let len = w * n * blocksize in + Math.Lemmas.cancel_mul_mod (w * n) blocksize; + //assert (len % blocksize = 0); + Math.Lemmas.cancel_mul_div (w * n) blocksize; + //assert (len / blocksize = w * n); + + Math.Lemmas.paren_mul_right n w blocksize; + Math.Lemmas.cancel_mul_mod n (w * blocksize); + Math.Lemmas.cancel_mul_div n (w * blocksize) + + +//////////////////////// +// Start of proof of lemma_repeat_gen_blocks_multi_vec +//////////////////////// + +val get_block_v: + #a:Type0 + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> s:seq a{length s = w * n * blocksize} + -> i:nat{i < n} -> + lseq a (w * blocksize) + +let get_block_v #a w blocksize n s i = + let blocksize_v = w * blocksize in + Math.Lemmas.lemma_mult_le_right blocksize_v (i + 1) n; + Math.Lemmas.paren_mul_right n w blocksize; + let b_v = Seq.slice s (i * blocksize_v) ((i + 1) * blocksize_v) in + b_v + + +val repeat_gen_blocks_slice_k: + #inp_t:Type0 + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> hi_f:nat{w * n <= hi_f} + -> inp:seq inp_t{length inp = w * n * blocksize} + -> a:(i:nat{i <= hi_f} -> Type) + -> f:(i:nat{i < hi_f} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> i:nat{i < n /\ w * i + w <= w * n} + -> k:nat{w * i <= k /\ k < w * i + w} + -> acc:a k -> + Lemma + (let b_v = get_block_v w blocksize n inp i in + let f_rep_s = repeat_gen_blocks_f blocksize (w * i) hi_f w b_v a f in + Math.Lemmas.paren_mul_right w n blocksize; + let f_rep = repeat_gen_blocks_f blocksize 0 (w * n) (w * n) inp a f in + + f_rep_s k acc == f_rep k acc) + +let repeat_gen_blocks_slice_k #inp_t w blocksize n hi_f inp a f i k acc = + // Math.Lemmas.paren_mul_right w n blocksize; + // let f_rep = repeat_gen_blocks_f blocksize 0 (w * n) (w * n) inp a f in + // Math.Lemmas.lemma_mult_le_right blocksize (k + 1) (w * n); + // assert ((k + 1) * blocksize <= w * n * blocksize); + // let block = Seq.slice inp (k * blocksize) (k * blocksize + blocksize) in + // assert (f_rep k acc == f k block acc); + + let b_v = get_block_v w blocksize n inp i in + //let f_rep_s = repeat_gen_blocks_f blocksize (w * i) hi_f w b_v a f in + let i_b = k - w * i in + Math.Lemmas.lemma_mult_le_right blocksize (i_b + 1) w; + let block1 = Seq.slice b_v (i_b * blocksize) (i_b * blocksize + blocksize) in + //assert (f_rep_s k acc == f k block1 acc); + + let blocksize_v = w * blocksize in + calc (<=) { + (i + 1) * blocksize_v; + (<=) { Math.Lemmas.lemma_mult_le_right blocksize_v (i + 1) n } + n * blocksize_v; + (==) { Math.Lemmas.paren_mul_right n w blocksize } + length inp; + }; + + calc (==) { + i * blocksize_v + (k - w * i) * blocksize; + (==) { Math.Lemmas.paren_mul_right i w blocksize } + i * w * blocksize + (k - w * i) * blocksize; + (==) { Math.Lemmas.distributivity_add_left (i * w) (k - w * i) blocksize } + (i * w + (k - w * i)) * blocksize; + (==) { } + (i * w + (k + (- w * i))) * blocksize; + (==) { Math.Lemmas.paren_add_right (i * w) k (- w * i) } + (i * w + k + (- w * i)) * blocksize; + (==) { Math.Lemmas.swap_mul i w } // JP: this was the important one that made the proof brittle + k * blocksize; + }; + + Seq.Properties.slice_slice inp (i * blocksize_v) ((i + 1) * blocksize_v) (i_b * blocksize) (i_b * blocksize + blocksize) + +val repeat_gen_blocks_slice: + #inp_t:Type0 + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> hi_f:nat{w * n <= hi_f} + -> inp:seq inp_t{length inp = w * n * blocksize} + -> a:(i:nat{i <= hi_f} -> Type) + -> f:(i:nat{i < hi_f} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> i:nat{i < n /\ w * i + w <= w * n} + -> acc:a (w * i) -> + Lemma + (let b_v = get_block_v w blocksize n inp i in + let f_rep_s = repeat_gen_blocks_f blocksize (w * i) hi_f w b_v a f in + Math.Lemmas.paren_mul_right w n blocksize; + let f_rep = repeat_gen_blocks_f blocksize 0 (w * n) (w * n) inp a f in + + Loops.repeat_right (w * i) (w * i + w) a f_rep acc == + Loops.repeat_right (w * i) (w * i + w) a f_rep_s acc) + +let repeat_gen_blocks_slice #inp_t w blocksize n hi_f inp a f i acc = + let b_v = get_block_v w blocksize n inp i in + let f_rep_s = repeat_gen_blocks_f blocksize (w * i) hi_f w b_v a f in + Math.Lemmas.paren_mul_right w n blocksize; + let f_rep = repeat_gen_blocks_f blocksize 0 (w * n) (w * n) inp a f in + + Classical.forall_intro_2 (repeat_gen_blocks_slice_k #inp_t w blocksize n hi_f inp a f i); + repeat_right_extensionality w (w * i) a a f_rep f_rep_s acc + + +val repeat_gen_blocks_multi_vec_step: + #inp_t:Type0 + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> hi_f:nat{w * n <= hi_f} + -> inp:seq inp_t{length inp = w * n * blocksize} + -> a:(i:nat{i <= hi_f} -> Type) + -> a_vec:(i:nat{i <= n} -> Type) + -> f:(i:nat{i < hi_f} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> f_v:(i:nat{i < n} -> lseq inp_t (w * blocksize) -> a_vec i -> a_vec (i + 1)) + -> normalize_v:(i:nat{i <= n} -> a_vec i -> a (w * i)) + -> pre:squash(forall (i:nat{i < n}) (b_v:lseq inp_t (w * blocksize)) (acc_v:a_vec i). + repeat_gen_blocks_multi_vec_equiv_pre w blocksize n hi_f a a_vec f f_v normalize_v i b_v acc_v) + -> i:nat{i < n} + -> acc_v:a_vec i -> + Lemma + (let blocksize_v = w * blocksize in + len_is_w_n_blocksize w blocksize n; + + let f_rep_v = repeat_gen_blocks_f blocksize_v 0 n n inp a_vec f_v in + let f_rep = repeat_gen_blocks_f blocksize 0 (w * n) (w * n) inp a f in + Math.Lemmas.lemma_mult_le_right w (i + 1) n; + + normalize_v (i + 1) (f_rep_v i acc_v) == + Loops.repeat_right (w * i) (w * (i + 1)) a f_rep (normalize_v i acc_v)) + +let repeat_gen_blocks_multi_vec_step #inp_t w blocksize n hi_f inp a a_vec f f_v normalize_v pre i acc_v = + let b_v = get_block_v w blocksize n inp i in + + //let f_rep_v = repeat_gen_blocks_f blocksize_v 0 n n inp a_vec f_v in + let f_rep = repeat_gen_blocks_f blocksize 0 (w * n) (w * n) inp a f in + Math.Lemmas.lemma_mult_le_left w (i + 1) n; + let f_rep_s = repeat_gen_blocks_f blocksize (w * i) hi_f w b_v a f in + + let acc0 = normalize_v i acc_v in + calc (==) { + repeat_gen_blocks_multi blocksize (w * i) hi_f w b_v a f acc0; + (==) { lemma_repeat_gen_blocks_multi blocksize (w * i) hi_f w b_v a f acc0 } + Loops.repeat_right (w * i) (w * i + w) a f_rep_s acc0; + (==) { repeat_gen_blocks_slice #inp_t w blocksize n hi_f inp a f i acc0 } + Loops.repeat_right (w * i) (w * i + w) a f_rep acc0; + }; + + assert (repeat_gen_blocks_multi_vec_equiv_pre w blocksize n hi_f a a_vec f f_v normalize_v i b_v acc_v) + +#push-options "--z3rlimit_factor 16 --retry 2" +let lemma_repeat_gen_blocks_multi_vec #inp_t w blocksize n hi_f inp a a_vec f f_v normalize_v acc_v0 = + let len = length inp in + let blocksize_v = w * blocksize in + len_is_w_n_blocksize w blocksize n; + + let f_rep_v = repeat_gen_blocks_f blocksize_v 0 n n inp a_vec f_v in + let f_rep = repeat_gen_blocks_f blocksize 0 (w * n) (w * n) inp a f in + + let acc0 = normalize_v 0 acc_v0 in + + calc (==) { + normalize_v n (repeat_gen_blocks_multi blocksize_v 0 n n inp a_vec f_v acc_v0); + (==) { lemma_repeat_gen_blocks_multi blocksize_v 0 n n inp a_vec f_v acc_v0 } + normalize_v n (Loops.repeat_right 0 n a_vec f_rep_v acc_v0); + (==) { + Classical.forall_intro_2 (repeat_gen_blocks_multi_vec_step w blocksize n hi_f inp a a_vec f f_v normalize_v ()); + lemma_repeat_gen_vec w n a a_vec normalize_v f_rep f_rep_v acc_v0 } + Loops.repeat_right 0 (w * n) a f_rep acc0; + (==) { lemma_repeat_gen_blocks_multi blocksize 0 (w * n) (w * n) inp a f acc0 } + repeat_gen_blocks_multi blocksize 0 (w * n) (w * n) inp a f acc0; + (==) { repeat_gen_blocks_multi_extensionality_zero blocksize 0 (w * n) hi_f (w * n) inp a a f f acc0 } + repeat_gen_blocks_multi blocksize 0 hi_f (w * n) inp a f acc0; + } +#pop-options + +//////////////////////// +// End of proof of lemma_repeat_gen_blocks_multi_vec +//////////////////////// + +#push-options "--z3rlimit 100 --retry 2" +let lemma_repeat_gen_blocks_vec #inp_t #c w blocksize inp n a a_vec f l f_v l_v normalize_v acc_v0 = + let len = length inp in + let blocksize_v = w * blocksize in + let rem_v = len % blocksize_v in + + let res_v = repeat_gen_blocks blocksize_v 0 n inp a_vec f_v l_v acc_v0 in + lemma_repeat_gen_blocks blocksize_v 0 n inp a_vec f_v l_v acc_v0; + + let len0 = w * n * blocksize in + let blocks_v = Seq.slice inp 0 len0 in + let last_v = Seq.slice inp len0 len in + let acc_v = repeat_gen_blocks_multi blocksize_v 0 n n blocks_v a_vec f_v acc_v0 in + assert (res_v == l_v n rem_v last_v acc_v); + + let acc0 = normalize_v 0 acc_v0 in + calc (==) { + l_v n rem_v last_v acc_v; + (==) { assert (repeat_gen_blocks_vec_equiv_pre w blocksize n a a_vec f l l_v normalize_v rem_v last_v acc_v) } + repeat_gen_blocks blocksize (w * n) (w * n + w) last_v a f l (normalize_v n acc_v); + (==) { lemma_repeat_gen_blocks_multi_vec w blocksize n (w * n + w) blocks_v a a_vec f f_v normalize_v acc_v0 } + repeat_gen_blocks blocksize (w * n) (w * n + w) last_v a f l + (repeat_gen_blocks_multi blocksize 0 (w * n + w) (w * n) blocks_v a f acc0); + }; + + len_is_w_n_blocksize w blocksize n; + //assert (len0 % blocksize = 0 /\ len0 / blocksize = w * n); + //Math.Lemmas.paren_mul_right n w blocksize; + //div_mul_lt blocksize rem_v w; + //assert (rem_v / blocksize < w); + repeat_gen_blocks_split blocksize len0 (w * n + w) 0 inp a f l acc0 +#pop-options + + +val lemma_repeat_blocks_multi_vec_equiv_pre: + #a:Type0 + -> #b:Type0 + -> #b_vec:Type0 + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> hi_f:nat{w * n <= hi_f} + -> f:(lseq a blocksize -> b -> b) + -> f_v:(lseq a (w * blocksize) -> b_vec -> b_vec) + -> normalize_v:(b_vec -> b) + -> pre:squash (forall (b_v:lseq a (w * blocksize)) (acc_v:b_vec). + repeat_blocks_multi_vec_equiv_pre w blocksize f f_v normalize_v b_v acc_v) + -> i:nat{i < n} + -> b_v:lseq a (w * blocksize) + -> acc_v:b_vec -> + Lemma + (repeat_gen_blocks_multi_vec_equiv_pre #a w blocksize n hi_f + (Loops.fixed_a b) (Loops.fixed_a b_vec) + (Loops.fixed_i f) (Loops.fixed_i f_v) + (Loops.fixed_i normalize_v) i b_v acc_v) + +let lemma_repeat_blocks_multi_vec_equiv_pre #a #b #b_vec w blocksize n hi_f f f_v normalize_v pre i b_v acc_v = + assert (repeat_blocks_multi_vec_equiv_pre w blocksize f f_v normalize_v b_v acc_v); + Math.Lemmas.cancel_mul_mod w blocksize; + assert (normalize_v (f_v b_v acc_v) == repeat_blocks_multi blocksize b_v f (normalize_v acc_v)); + Math.Lemmas.cancel_mul_div w blocksize; + + Math.Lemmas.lemma_mult_le_right w (i + 1) n; + + calc (==) { + repeat_blocks_multi blocksize b_v f (normalize_v acc_v); + (==) { repeat_blocks_multi_is_repeat_gen_blocks_multi w blocksize b_v f (normalize_v acc_v) } + repeat_gen_blocks_multi blocksize 0 w w b_v (Loops.fixed_a b) (Loops.fixed_i f) (normalize_v acc_v); + (==) { repeat_gen_blocks_multi_extensionality_zero blocksize (w * i) hi_f w w b_v + (Loops.fixed_a b) (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i f) (normalize_v acc_v) } + repeat_gen_blocks_multi blocksize (w * i) hi_f w b_v (Loops.fixed_a b) (Loops.fixed_i f) (normalize_v acc_v); + } + + +let lemma_repeat_blocks_multi_vec #a #b #b_vec w blocksize inp f f_v normalize_v acc_v0 = + let blocksize_v = w * blocksize in + let len = length inp in + let nw = len / blocksize_v in + len_is_w_n_blocksize w blocksize nw; + + let acc0 = normalize_v acc_v0 in + + calc (==) { + normalize_v (repeat_blocks_multi #a #b_vec blocksize_v inp f_v acc_v0); + (==) { repeat_blocks_multi_is_repeat_gen_blocks_multi nw blocksize_v inp f_v acc_v0 } + normalize_v (repeat_gen_blocks_multi blocksize_v 0 nw nw inp (Loops.fixed_a b_vec) (Loops.fixed_i f_v) acc_v0); + (==) { + Classical.forall_intro_3 (lemma_repeat_blocks_multi_vec_equiv_pre w blocksize nw (w * nw) f f_v normalize_v ()); + lemma_repeat_gen_blocks_multi_vec w blocksize nw (w * nw) inp (Loops.fixed_a b) (Loops.fixed_a b_vec) + (Loops.fixed_i f) (Loops.fixed_i f_v) (Loops.fixed_i normalize_v) acc_v0 } + repeat_gen_blocks_multi blocksize 0 (nw * w) (nw * w) inp (Loops.fixed_a b) (Loops.fixed_i f) acc0; + (==) { repeat_blocks_multi_is_repeat_gen_blocks_multi (nw * w) blocksize inp f acc0 } + repeat_blocks_multi blocksize inp f acc0; + } + + +val lemma_repeat_blocks_vec_equiv_pre: + #a:Type0 + -> #b:Type0 + -> #b_vec:Type0 + -> #c:Type0 + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> f:(lseq a blocksize -> b -> b) + -> l:(len:nat{len < blocksize} -> lseq a len -> b -> c) + -> l_v:(len:nat{len < w * blocksize} -> lseq a len -> b_vec -> c) + -> normalize_v:(b_vec -> b) + -> pre:squash (forall (rem:nat{rem < w * blocksize}) (b_v:lseq a rem) (acc_v:b_vec). + repeat_blocks_vec_equiv_pre w blocksize f l l_v normalize_v rem b_v acc_v) + -> rem:nat{rem < w * blocksize} + -> b_v:lseq a rem + -> acc_v:b_vec -> + Lemma + (repeat_gen_blocks_vec_equiv_pre #a #c w blocksize n + (Loops.fixed_a b) (Loops.fixed_a b_vec) + (Loops.fixed_i f) (Loops.fixed_i l) (Loops.fixed_i l_v) + (Loops.fixed_i normalize_v) rem b_v acc_v) + +let lemma_repeat_blocks_vec_equiv_pre #a #b #b_vec #c w blocksize n f l l_v normalize_v pre rem b_v acc_v = + let nb_rem = rem / blocksize in + div_mul_lt blocksize rem w; + assert (nb_rem < w); + + let acc0 = normalize_v acc_v in + + calc (==) { + Loops.fixed_i l_v n rem b_v acc_v; + (==) { } + l_v rem b_v acc_v; + (==) { assert (repeat_blocks_vec_equiv_pre w blocksize f l l_v normalize_v rem b_v acc_v) } + repeat_blocks blocksize b_v f l acc0; + (==) { repeat_blocks_is_repeat_gen_blocks nb_rem blocksize b_v f l acc0 } + repeat_gen_blocks blocksize 0 nb_rem b_v (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i l) acc0; + (==) { repeat_gen_blocks_extensionality_zero blocksize (w * n) (w * n + w) nb_rem nb_rem b_v + (Loops.fixed_a b) (Loops.fixed_a b) + (Loops.fixed_i f) (Loops.fixed_i l) + (Loops.fixed_i f) (Loops.fixed_i l) acc0 } + repeat_gen_blocks blocksize (w * n) (w * n + w) b_v (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i l) acc0; + } + + +let lemma_repeat_blocks_vec #a #b #b_vec #c w blocksize inp f l f_v l_v normalize_v acc_v0 = + let blocksize_v = w * blocksize in + let nb_v = length inp / blocksize_v in + + calc (==) { + repeat_blocks blocksize_v inp f_v l_v acc_v0; + (==) { repeat_blocks_is_repeat_gen_blocks nb_v blocksize_v inp f_v l_v acc_v0 } + repeat_gen_blocks blocksize_v 0 nb_v inp (Loops.fixed_a b_vec) (Loops.fixed_i f_v) (Loops.fixed_i l_v) acc_v0; + (==) { Classical.forall_intro_3 (lemma_repeat_blocks_multi_vec_equiv_pre w blocksize nb_v (w * nb_v + w) f f_v normalize_v ()); + Classical.forall_intro_3 (lemma_repeat_blocks_vec_equiv_pre #a #b #b_vec #c w blocksize nb_v f l l_v normalize_v ()); + lemma_repeat_gen_blocks_vec w blocksize inp nb_v + (Loops.fixed_a b) (Loops.fixed_a b_vec) (Loops.fixed_i f) (Loops.fixed_i l) + (Loops.fixed_i f_v) (Loops.fixed_i l_v) (Loops.fixed_i normalize_v) acc_v0 } + repeat_gen_blocks blocksize 0 (w * nb_v + w) inp (Loops.fixed_a b) (Loops.fixed_i f) (Loops.fixed_i l) (normalize_v acc_v0); + (==) { repeat_blocks_is_repeat_gen_blocks (w * nb_v + w) blocksize inp f l (normalize_v acc_v0) } + repeat_blocks blocksize inp f l (normalize_v acc_v0); + } + + +//////////////////////// +// Start of proof of map_blocks_multi_vec lemma +//////////////////////// + +let lemma_f_map_ind w blocksize n i k = + calc (<) { + w * i + k / blocksize; + (<) { div_mul_lt blocksize k w } + w * i + w; + (==) { Math.Lemmas.distributivity_add_right w i 1 } + w * (i + 1); + (<=) { Math.Lemmas.lemma_mult_le_left w (i + 1) n } + w * n; + } + + +val normalize_v_map: + #a:Type + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> i:nat{i <= n} + -> map_blocks_a a (w * blocksize) n i -> + map_blocks_a a blocksize (w * n) (w * i) + +let normalize_v_map #a w blocksize n i b = + Math.Lemmas.lemma_mult_le_right w i n; + b + + +#push-options "--z3rlimit 75" +let map_blocks_multi_vec_equiv_pre + (#a:Type) + (w:pos) + (blocksize:pos{w * blocksize <= max_size_t}) + (n:nat) + (hi_f:nat{w * n <= hi_f}) + (f:(i:nat{i < hi_f} -> lseq a blocksize -> lseq a blocksize)) + (f_v:(i:nat{i < n} -> lseq a (w * blocksize) -> lseq a (w * blocksize))) + (i:nat{i < n}) + (b_v:lseq a (w * blocksize)) + (acc_v:map_blocks_a a (w * blocksize) n i) + : prop + = + Math.Lemmas.lemma_mult_le_right w (i + 1) n; + repeat_gen_blocks_map_f #a (w * blocksize) n f_v i b_v acc_v `Seq.equal` + map_blocks_multi_acc blocksize (w * i) hi_f w b_v f acc_v +#pop-options + +// It means the following +// Seq.append acc_v (f_v i b_v) == +// map_blocks_multi_acc blocksize (w * i) (w * n) w b_v f acc_v + + +val lemma_map_blocks_multi_vec_equiv_pre_k: + #a:Type + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> hi_f:nat{w * n <= hi_f} + -> f:(i:nat{i < hi_f} -> lseq a blocksize -> lseq a blocksize) + -> f_v:(i:nat{i < n} -> lseq a (w * blocksize) -> lseq a (w * blocksize)) + -> i:nat{i < n} + -> b_v:lseq a (w * blocksize) + -> pre:squash (forall (k:nat{k < w * blocksize}). map_blocks_multi_vec_equiv_pre_k w blocksize n (w * n) f f_v i b_v k) + -> acc_v:map_blocks_a a (w * blocksize) n i -> + Lemma (map_blocks_multi_vec_equiv_pre #a w blocksize n hi_f f f_v i b_v acc_v) + +#push-options "--z3rlimit 150" +let lemma_map_blocks_multi_vec_equiv_pre_k #a w blocksize n hi_f f f_v i b_v pre acc_v = + //let lp = repeat_gen_blocks_map_f #a (w * blocksize) n f_v i b_v acc_v in + //assert (lp == Seq.append acc_v (f_v i b_v)); + + Math.Lemmas.lemma_mult_le_right w (i + 1) n; + let f_sh = f_shift blocksize (w * i) hi_f w f in + + let aux (k:nat{k < w * blocksize}) : Lemma (Seq.index (f_v i b_v) k == Seq.index (map_blocks_multi blocksize w w b_v f_sh) k) = + Math.Lemmas.cancel_mul_div w blocksize; + let block = get_block_s #a #(w * blocksize) blocksize b_v k in + let j = k / blocksize in // j < w + div_mul_lt blocksize k w; + + calc (==) { + Seq.index (map_blocks_multi blocksize w w b_v f_sh) k; + (==) { index_map_blocks_multi blocksize w w b_v f_sh k } + Seq.index (f_sh j block) (k % blocksize); + (==) { assert (map_blocks_multi_vec_equiv_pre_k w blocksize n hi_f f f_v i b_v k) } + Seq.index (f_v i b_v) k; + } in + + calc (==) { + map_blocks_multi_acc blocksize (w * i) hi_f w b_v f acc_v; + (==) { map_blocks_multi_acc_is_map_blocks_multi blocksize (w * i) hi_f w b_v f acc_v } + Seq.append acc_v (map_blocks_multi blocksize w w b_v f_sh); + (==) { Classical.forall_intro aux; Seq.lemma_eq_intro (f_v i b_v) (map_blocks_multi blocksize w w b_v f_sh) } + Seq.append acc_v (f_v i b_v); + (==) { Seq.lemma_eq_intro (Seq.append acc_v (f_v i b_v)) (repeat_gen_blocks_map_f #a (w * blocksize) n f_v i b_v acc_v) } + repeat_gen_blocks_map_f #a (w * blocksize) n f_v i b_v acc_v; + } +#pop-options + +val lemma_map_blocks_multi_vec_equiv_pre: + #a:Type + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> hi_f:nat{w * n <= hi_f} + -> f:(i:nat{i < hi_f} -> lseq a blocksize -> lseq a blocksize) + -> f_v:(i:nat{i < n} -> lseq a (w * blocksize) -> lseq a (w * blocksize)) + -> pre:squash (forall (i:nat{i < n}) (b_v:lseq a (w * blocksize)) (k:nat{k < w * blocksize}). + map_blocks_multi_vec_equiv_pre_k w blocksize n (w * n) f f_v i b_v k) + -> i:nat{i < n} + -> b_v:lseq a (w * blocksize) + -> acc_v:map_blocks_a a (w * blocksize) n i -> + Lemma + (repeat_gen_blocks_multi_vec_equiv_pre #a w blocksize n hi_f + (map_blocks_a a blocksize hi_f) + (map_blocks_a a (w * blocksize) n) + (repeat_gen_blocks_map_f blocksize hi_f f) + (repeat_gen_blocks_map_f (w * blocksize) n f_v) + (normalize_v_map #a w blocksize n) i b_v acc_v) + +#push-options "--z3rlimit 75" +let lemma_map_blocks_multi_vec_equiv_pre #a w blocksize n hi_f f f_v pre i b_v acc_v = + lemma_map_blocks_multi_vec_equiv_pre_k #a w blocksize n hi_f f f_v i b_v pre acc_v; + Math.Lemmas.cancel_mul_div w blocksize; + Math.Lemmas.cancel_mul_mod w blocksize; + Math.Lemmas.lemma_mult_le_right w (i + 1) n; + map_blocks_multi_acc_is_repeat_gen_blocks_multi blocksize (w * i) hi_f w b_v f acc_v +#pop-options + +let lemma_map_blocks_multi_vec #a w blocksize n inp f f_v = + let blocksize_v = w * blocksize in + len_is_w_n_blocksize w blocksize n; + + calc (==) { + map_blocks_multi blocksize_v n n inp f_v; + (==) { map_blocks_multi_acc_is_map_blocks_multi0 blocksize_v n n inp f_v } + map_blocks_multi_acc blocksize_v 0 n n inp f_v Seq.empty; + (==) { map_blocks_multi_acc_is_repeat_gen_blocks_multi blocksize_v 0 n n inp f_v Seq.empty } + repeat_gen_blocks_multi blocksize_v 0 n n inp + (map_blocks_a a blocksize_v n) + (repeat_gen_blocks_map_f blocksize_v n f_v) Seq.empty; + (==) { Classical.forall_intro_3 (lemma_map_blocks_multi_vec_equiv_pre #a w blocksize n (w * n) f f_v ()); + lemma_repeat_gen_blocks_multi_vec w blocksize n (w * n) inp + (map_blocks_a a blocksize (w * n)) (map_blocks_a a blocksize_v n) + (repeat_gen_blocks_map_f blocksize (w * n) f) + (repeat_gen_blocks_map_f blocksize_v n f_v) + (normalize_v_map #a w blocksize n) Seq.empty } + repeat_gen_blocks_multi blocksize 0 (w * n) (w * n) inp + (map_blocks_a a blocksize (w * n)) + (repeat_gen_blocks_map_f blocksize (w * n) f) Seq.empty; + (==) { map_blocks_multi_acc_is_repeat_gen_blocks_multi blocksize 0 (w * n) (w * n) inp f Seq.empty } + map_blocks_multi_acc blocksize 0 (w * n) (w * n) inp f Seq.empty; + (==) { map_blocks_multi_acc_is_map_blocks_multi0 blocksize (w * n) (w * n) inp f } + map_blocks_multi blocksize (w * n) (w * n) inp f; + } + +//////////////////////// +// End of proof of map_blocks_multi_vec lemma +//////////////////////// + +#push-options "--z3rlimit 75" +let map_blocks_vec_equiv_pre + (#a:Type) + (w:pos) + (blocksize:pos{w * blocksize <= max_size_t}) + (n:nat) + (f:(i:nat{i < w * n + w} -> lseq a blocksize -> lseq a blocksize)) + (l:(i:nat{i <= w * n + w} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem)) + (l_v:(i:nat{i <= n} -> rem:nat{rem < w * blocksize} -> lseq a rem -> lseq a rem)) + (rem:nat{rem < w * blocksize}) + (b_v:lseq a rem) + (acc_v:map_blocks_a a (w * blocksize) n n) + : prop + = + //Math.Lemmas.small_mod rem (w * blocksize); + //Math.Lemmas.small_div rem (w * blocksize); + repeat_gen_blocks_map_l_length (w * blocksize) n l_v n rem b_v acc_v; + + repeat_gen_blocks_map_l (w * blocksize) n l_v n rem b_v acc_v `Seq.equal` + map_blocks_acc blocksize (w * n) (w * n + w) b_v f l acc_v +#pop-options + +val lemma_map_blocks_vec_equiv_pre_k_aux: + #a:Type + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> f:(i:nat{i < w * n + w} -> lseq a blocksize -> lseq a blocksize) + -> l:(i:nat{i <= w * n + w} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem) + -> l_v:(i:nat{i <= n} -> rem:nat{rem < w * blocksize} -> lseq a rem -> lseq a rem) + -> rem:nat{rem < w * blocksize} + -> b_v:lseq a rem + -> pre:squash (forall (rem:nat{rem < w * blocksize}) (b_v:lseq a rem) (k:nat{k < rem}). + map_blocks_vec_equiv_pre_k w blocksize n f l l_v rem b_v k) + -> k:nat{k < rem} -> + Lemma + (let nb = rem / blocksize in + let f_sh = f_shift blocksize (w * n) (w * n + w) nb f in + let l_sh = l_shift blocksize (w * n) (w * n + w) nb l in + Seq.index (l_v n rem b_v) k == Seq.index (map_blocks blocksize b_v f_sh l_sh) k) + +let lemma_map_blocks_vec_equiv_pre_k_aux #a w blocksize n f l l_v rem b_v pre k = + let nb = rem / blocksize in + let f_sh = f_shift blocksize (w * n) (w * n + w) nb f in + let l_sh = l_shift blocksize (w * n) (w * n + w) nb l in + + let j = w * n + k / blocksize in + div_mul_lt blocksize k w; + + if k < rem / blocksize * blocksize then begin + let block = get_block_s #a #rem blocksize b_v k in + calc (==) { + Seq.index (map_blocks blocksize b_v f_sh l_sh) k; + (==) { index_map_blocks blocksize b_v f_sh l_sh k } + Seq.index (f j block) (k % blocksize); + (==) { assert (map_blocks_vec_equiv_pre_k w blocksize n f l l_v rem b_v k) } + Seq.index (l_v n rem b_v) k; + } end + else begin + let block_l = get_last_s #_ #rem blocksize b_v in + mod_div_lt blocksize k rem; + calc (==) { + Seq.index (map_blocks blocksize b_v f_sh l_sh) k; + (==) { index_map_blocks blocksize b_v f_sh l_sh k } + Seq.index (l_sh (rem / blocksize) (rem % blocksize) block_l) (k % blocksize); + (==) { div_interval blocksize (rem / blocksize) k } + Seq.index (l j (rem % blocksize) block_l) (k % blocksize); + (==) { assert (map_blocks_vec_equiv_pre_k w blocksize n f l l_v rem b_v k) } + Seq.index (l_v n rem b_v) k; + } end + + +val lemma_map_blocks_vec_equiv_pre_k: + #a:Type + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> f:(i:nat{i < w * n + w} -> lseq a blocksize -> lseq a blocksize) + -> l:(i:nat{i <= w * n + w} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem) + -> l_v:(i:nat{i <= n} -> rem:nat{rem < w * blocksize} -> lseq a rem -> lseq a rem) + -> rem:nat{rem < w * blocksize} + -> b_v:lseq a rem + -> pre:squash (forall (rem:nat{rem < w * blocksize}) (b_v:lseq a rem) (k:nat{k < rem}). + map_blocks_vec_equiv_pre_k w blocksize n f l l_v rem b_v k) + -> acc_v:map_blocks_a a (w * blocksize) n n -> + Lemma (map_blocks_vec_equiv_pre w blocksize n f l l_v rem b_v acc_v) + +let lemma_map_blocks_vec_equiv_pre_k #a w blocksize n f l l_v rem b_v pre acc_v = + let nb = rem / blocksize in + let f_sh = f_shift blocksize (w * n) (w * n + w) nb f in + let l_sh = l_shift blocksize (w * n) (w * n + w) nb l in + + if rem = 0 then begin + calc (==) { + map_blocks_acc blocksize (w * n) (w * n + w) b_v f l acc_v; + (==) { map_blocks_acc_is_map_blocks blocksize (w * n) (w * n + w) b_v f l acc_v} + Seq.append acc_v (map_blocks blocksize b_v f_sh l_sh); + (==) { map_blocks_is_empty blocksize nb b_v f_sh l_sh } + Seq.append acc_v Seq.empty; + (==) { Seq.Base.append_empty_r acc_v } + acc_v; + (==) { } + repeat_gen_blocks_map_l (w * blocksize) n l_v n rem b_v acc_v; + } end + else begin + calc (==) { + map_blocks_acc blocksize (w * n) (w * n + w) b_v f l acc_v; + (==) { map_blocks_acc_is_map_blocks blocksize (w * n) (w * n + w) b_v f l acc_v} + Seq.append acc_v (map_blocks blocksize b_v f_sh l_sh); + (==) { Classical.forall_intro (lemma_map_blocks_vec_equiv_pre_k_aux #a w blocksize n f l l_v rem b_v ()); + Seq.lemma_eq_intro (l_v n rem b_v) (map_blocks blocksize b_v f_sh l_sh) } + Seq.append acc_v (l_v n rem b_v); + (==) { } + repeat_gen_blocks_map_l (w * blocksize) n l_v n rem b_v acc_v; + } end + + +val lemma_map_blocks_vec_equiv_pre: + #a:Type + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> f:(i:nat{i < w * n + w} -> lseq a blocksize -> lseq a blocksize) + -> l:(i:nat{i <= w * n + w} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem) + -> l_v:(i:nat{i <= n} -> rem:nat{rem < w * blocksize} -> lseq a rem -> lseq a rem) + -> pre:squash (forall (rem:nat{rem < w * blocksize}) (b_v:lseq a rem) (k:nat{k < rem}). + map_blocks_vec_equiv_pre_k w blocksize n f l l_v rem b_v k) + -> rem:nat{rem < w * blocksize} + -> b_v:lseq a rem + -> acc_v:map_blocks_a a (w * blocksize) n n -> + Lemma + (repeat_gen_blocks_vec_equiv_pre w blocksize n + (map_blocks_a a blocksize (w * n + w)) + (map_blocks_a a (w * blocksize) n) + (repeat_gen_blocks_map_f blocksize (w * n + w) f) + (repeat_gen_blocks_map_l blocksize (w * n + w) l) + (repeat_gen_blocks_map_l (w * blocksize) n l_v) + (normalize_v_map #a w blocksize n) rem b_v acc_v) + +let lemma_map_blocks_vec_equiv_pre #a w blocksize n f l l_v pre rem b_v acc_v = + lemma_map_blocks_vec_equiv_pre_k #a w blocksize n f l l_v rem b_v pre acc_v; + Math.Lemmas.small_mod rem (w * blocksize); + Math.Lemmas.small_div rem (w * blocksize); + assert (w * n >= 0); + map_blocks_acc_is_repeat_gen_blocks blocksize (w * n) (w * n + w) b_v f l acc_v + + +let lemma_map_blocks_vec #a w blocksize inp n f l f_v l_v = + let len = length inp in + let blocksize_v = w * blocksize in + + calc (==) { + map_blocks_acc blocksize_v 0 n inp f_v l_v Seq.empty; + (==) { map_blocks_acc_is_repeat_gen_blocks blocksize_v 0 n inp f_v l_v Seq.empty } + repeat_gen_blocks blocksize_v 0 n inp + (map_blocks_a a blocksize_v n) + (repeat_gen_blocks_map_f blocksize_v n f_v) + (repeat_gen_blocks_map_l blocksize_v n l_v) + Seq.empty; + + (==) { + Classical.forall_intro_3 (lemma_map_blocks_multi_vec_equiv_pre #a w blocksize n (w * n + w) f f_v ()); + Classical.forall_intro_3 (lemma_map_blocks_vec_equiv_pre #a w blocksize n f l l_v ()); + lemma_repeat_gen_blocks_vec w blocksize inp n + (map_blocks_a a blocksize (w * n + w)) + (map_blocks_a a (w * blocksize) n) + (repeat_gen_blocks_map_f blocksize (w * n + w) f) + (repeat_gen_blocks_map_l blocksize (w * n + w) l) + (repeat_gen_blocks_map_f (w * blocksize) n f_v) + (repeat_gen_blocks_map_l (w * blocksize) n l_v) + (normalize_v_map #a w blocksize n) Seq.empty } + + repeat_gen_blocks blocksize 0 (w * n + w) inp + (map_blocks_a a blocksize (w * n + w)) + (repeat_gen_blocks_map_f blocksize (w * n + w) f) + (repeat_gen_blocks_map_l blocksize (w * n + w) l) + Seq.empty; + + (==) { map_blocks_acc_is_repeat_gen_blocks blocksize 0 (w * n + w) inp f l Seq.empty } + map_blocks_acc blocksize 0 (w * n + w) inp f l Seq.empty; + }; + + map_blocks_acc_is_map_blocks0 blocksize_v n inp f_v l_v; + map_blocks_acc_is_map_blocks0 blocksize (w * n + w) inp f l diff --git a/tests/hacl/Lib.Vec.Lemmas.fst.hints b/tests/hacl/Lib.Vec.Lemmas.fst.hints new file mode 100644 index 00000000000..c3ffaa345a1 --- /dev/null +++ b/tests/hacl/Lib.Vec.Lemmas.fst.hints @@ -0,0 +1,2294 @@ +[ + "ó$×¼±ÞmtQ\r*Çn\u001c¬’", + [ + [ + "Lib.Vec.Lemmas.lemma_repeat_gen_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6f77474ede8199333d3f4de9c694b4b9", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "5a1411901d69495451bed2316b99cc7e" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_gen_vec", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Prims_pretyping_ae567c2fb75be05905677af440075565", + "binder_x_bb4e1c9af0265270f8e7a5f250f730e2_3", + "binder_x_f26957a7e62b271a8736230b1e9c83c1_2", "equation_Prims.nat", + "equation_Prims.pos", + "function_token_typing_Prims.__cache_version_number__", + "int_inversion", "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Equality", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_214521be6835548f2f282adfe2372d8b", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_a3655d6698d33f820804a971c83ae369", + "refinement_interpretation_Tm_refine_aacd5c5013e5b4b181bda5c667bdb087", + "well-founded-ordering-on-nat" + ], + 0, + "26aa968e05cfbd1966c482b37f00e455" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_gen_vec", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6f77474ede8199333d3f4de9c694b4b9", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "8f250d0ada553a77ac3a92eedc8f5014" + ], + [ + "Lib.Vec.Lemmas.lemma_repeati_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "28a410c23c5f5e2173e048f42167a378" + ], + [ + "Lib.Vec.Lemmas.lemma_repeati_vec", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.LoopCombinators.fixed_a", + "equation_Lib.LoopCombinators.fixed_i", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "token_correspondence_Lib.LoopCombinators.fixed_i" + ], + 0, + "8365d442ccdb3c46af2a44e764960aa3" + ], + [ + "Lib.Vec.Lemmas.len_is_w_n_blocksize", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "a69c31cff994a6ad4fe2fd8f8094fe2c" + ], + [ + "Lib.Vec.Lemmas.len_is_w_n_blocksize", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "7a21b21fbd0677a7ed1ddf32c31bfce0" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_multi_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "typing_Prims.pow2" + ], + 0, + "c4df913dab06b77e3a39c21a29055dc5" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_multi_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "c087f34c5dd7c857bdcc125d5fdb0268" + ], + [ + "Lib.Vec.Lemmas.get_block_v", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "8af9da7e87b17b77e11af66405f7f954" + ], + [ + "Lib.Vec.Lemmas.get_block_v", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_34544e76bec95b90d561cc178295d795", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_8d6fa9117891ba071496ffc959fc4d4b", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_FStar.Seq.Base.length" + ], + 0, + "edf8e364c3edc26d28028ae578de0cf2" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_slice_k", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_096438f6bdfa8da57c0b90fb63f06bdb", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_2c0568e51630566768dea977a21880bf", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d6b1a92117d4cdff80313427385685c8", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "1ed848236ef81eb646ef8a6be5d65f37" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_slice_k", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_f", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.seq", "equation_Lib.Vec.Lemmas.get_block_v", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Minus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_2c0568e51630566768dea977a21880bf", + "refinement_interpretation_Tm_refine_34544e76bec95b90d561cc178295d795", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c302f51ce94a5d85770dea0d10e6ef86", + "refinement_interpretation_Tm_refine_d6b1a92117d4cdff80313427385685c8", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "a5fdc5e4c9f8d4949255f562db7d98aa" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_slice_k", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_2c0568e51630566768dea977a21880bf", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d6b1a92117d4cdff80313427385685c8" + ], + 0, + "f60afe613f58bdfe9ac8df5dc31ce3a6" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_slice", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_096438f6bdfa8da57c0b90fb63f06bdb", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_2c0568e51630566768dea977a21880bf", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d6b1a92117d4cdff80313427385685c8", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "52c51b19005d4de45abf1c41efea16ac" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_slice", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_096438f6bdfa8da57c0b90fb63f06bdb", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_2c0568e51630566768dea977a21880bf", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_d6b1a92117d4cdff80313427385685c8", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "d76a932b0ced194f5eedfd0c3ed4b9a7" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_slice", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d6b1a92117d4cdff80313427385685c8" + ], + 0, + "182477006ed232078ef878ba0b711c5c" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_multi_vec_step", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_096438f6bdfa8da57c0b90fb63f06bdb", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_34544e76bec95b90d561cc178295d795", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_ba24c249c2bac9c9652dccf45aee8033", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "ec5b31d38ce0f498a02ec66c33b67e9d" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_multi_vec_step", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "eq2-interp", "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_f", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.seq", "equation_Lib.Vec.Lemmas.get_block_v", + "equation_Lib.Vec.Lemmas.repeat_gen_blocks_multi_vec_equiv_pre", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_LessThanOrEqual", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_096438f6bdfa8da57c0b90fb63f06bdb", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_2c0568e51630566768dea977a21880bf", + "refinement_interpretation_Tm_refine_34544e76bec95b90d561cc178295d795", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6a886eba44118bdd83730df8832311a9", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "typing_Lib.Sequence.length" + ], + 0, + "9ccbe5460cc49aed5ca3a2a531b01390" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_multi_vec_step", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "d2d8db6ebe1fe72e614176579aad88d2" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_gen_blocks_multi_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_34544e76bec95b90d561cc178295d795", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_Lib.Sequence.length" + ], + 0, + "1e5e30b978c3cd02483cf8124ba08c06" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_gen_blocks_multi_vec", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_096438f6bdfa8da57c0b90fb63f06bdb", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_34544e76bec95b90d561cc178295d795", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_5507b02af25b553b133f7efccc558bb5", + "refinement_interpretation_Tm_refine_6f77474ede8199333d3f4de9c694b4b9", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_ba24c249c2bac9c9652dccf45aee8033", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "992c9e22bb93b52650490663e1c2318a" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_gen_blocks_multi_vec", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "9caaa9eb73e27c6d7af50d6172455713" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "f49b08fa0e9b1b7cf01adc574b4f69ee" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_1140254f0add9ac82e3c74c399912e35", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d" + ], + 0, + "2eb867bd66f1669a3b233f864d96d1c7" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_gen_blocks_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_1140254f0add9ac82e3c74c399912e35", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_4e46b18e6de7fd724da2ef45eb7b3ba2", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "276aab274eb68f5f379416487602719c" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_gen_blocks_vec", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "eq2-interp", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", "equation_Lib.Sequence.seq", + "equation_Lib.Vec.Lemmas.repeat_gen_blocks_vec_equiv_pre", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "lemma_FStar.Seq.Base.lemma_len_slice", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThanOrEqual", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_4e46b18e6de7fd724da2ef45eb7b3ba2", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_81407705a0828c2c1b1976675443f647", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29", + "typing_FStar.Seq.Base.slice", "typing_Lib.Sequence.length" + ], + 0, + "47d8d620a5fb98787d2b3ddba3690ac1" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_gen_blocks_vec", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_1140254f0add9ac82e3c74c399912e35", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_4e46b18e6de7fd724da2ef45eb7b3ba2", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "874c7b64061a87d8c8ea80de970d23da" + ], + [ + "Lib.Vec.Lemmas.repeat_blocks_multi_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "6229dccdc0c82f8df117e5f98d6a4d9c" + ], + [ + "Lib.Vec.Lemmas.repeat_blocks_multi_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "6f20ba4aa3670a52c28771e6ba75fd37" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_multi_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "typing_FStar.Seq.Base.length" + ], + 0, + "cd295d03cd0a34287bafebcdc932ec53" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_multi_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "eq2-interp", + "equation_Lib.LoopCombinators.fixed_a", + "equation_Lib.LoopCombinators.fixed_i", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Vec.Lemmas.repeat_blocks_multi_vec_equiv_pre", + "equation_Lib.Vec.Lemmas.repeat_gen_blocks_multi_vec_equiv_pre", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d6e5c35ff3aad90541fc8f7abd9ac6d4", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "token_correspondence_Lib.LoopCombinators.fixed_i" + ], + 0, + "bc12d05fd9021c657c4b5c5040c02e40" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_multi_vec_equiv_pre", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "d25788183a30bca2fb7cbb52c972a387" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_multi_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e90c2c89afe31ba2752cabd31cd7f6e7" + ], + 0, + "40af2355a681ad376ed8dab39471be3c" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_multi_vec", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.LoopCombinators.fixed_a", + "equation_Lib.LoopCombinators.fixed_i", + "equation_Lib.Sequence.length", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e90c2c89afe31ba2752cabd31cd7f6e7", + "token_correspondence_Lib.LoopCombinators.fixed_i", + "typing_Lib.Sequence.length" + ], + 0, + "a5005d08fd00bc230ef8cfce941dc4a9" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_multi_vec", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "int_inversion", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e90c2c89afe31ba2752cabd31cd7f6e7" + ], + 0, + "8273ff4de465a0b49b6e81a3323d6045" + ], + [ + "Lib.Vec.Lemmas.repeat_blocks_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "a62603edb54c59fe49b91cf8d63a07be" + ], + [ + "Lib.Vec.Lemmas.repeat_blocks_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "6733b74c4434a9f017159df4aa16b9b5" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "08075c4b5c49f27231a598d0018aa47b" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "eq2-interp", + "equation_Lib.LoopCombinators.fixed_a", + "equation_Lib.LoopCombinators.fixed_i", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Vec.Lemmas.repeat_blocks_vec_equiv_pre", + "equation_Lib.Vec.Lemmas.repeat_gen_blocks_vec_equiv_pre", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_b2d3f317f91f417bcb8a5847865e4675", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29", + "token_correspondence_Lib.LoopCombinators.fixed_i" + ], + 0, + "b91850b7b96fcc397f6d8db384baaba1" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_vec_equiv_pre", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "5ca834d299de40ed2e994763b5ccc626" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "int_inversion", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "9531d1a024411314681981abc9c7bd7d" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_vec", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "equation_Lib.LoopCombinators.fixed_a", + "equation_Lib.LoopCombinators.fixed_i", + "equation_Lib.Sequence.length", "equation_Prims.nat", + "equation_Prims.pos", + "function_token_typing_Lib.LoopCombinators.fixed_a", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "token_correspondence_Lib.LoopCombinators.fixed_i", + "typing_Lib.Sequence.length" + ], + 0, + "d6b72d6b1201349f5e84debe37396309" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_vec", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "2223afd188e7c6d3d9d9f9e621d9aa7e" + ], + [ + "Lib.Vec.Lemmas.lemma_f_map_ind", + 1, + 0, + 0, + [ "@query" ], + 0, + "94c7bfa95c648d627c1508d1a3c752c9" + ], + [ + "Lib.Vec.Lemmas.lemma_f_map_ind", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "e40a255851d21cabd22e259ca6e8c3d7" + ], + [ + "Lib.Vec.Lemmas.map_blocks_multi_vec_equiv_pre_k", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_6ee4cce4172b405aefb288f98b829040", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "70a26ac0d7ccf01051ad26ba5d3c3717" + ], + [ + "Lib.Vec.Lemmas.map_blocks_multi_vec_equiv_pre_k", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "a33605d68fbd6adc580e16849dfddf72" + ], + [ + "Lib.Vec.Lemmas.normalize_v_map", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d" + ], + 0, + "2d88fb4a31cac2c5b3564d6413bbf4a9" + ], + [ + "Lib.Vec.Lemmas.normalize_v_map", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Prims.pos", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d" + ], + 0, + "3963215ccc9376e4068d9816d8ef9acc" + ], + [ + "Lib.Vec.Lemmas.normalize_v_map", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "976239fcc2a1dad097a3dcb5ac2d242a" + ], + [ + "Lib.Vec.Lemmas.map_blocks_multi_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_6ee4cce4172b405aefb288f98b829040", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_map_f", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_len_append", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803" + ], + 0, + "e40d79c25e776cc5c3c68f846be1edb5" + ], + [ + "Lib.Vec.Lemmas.map_blocks_multi_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "2adf5a9ef78f5da7d494c5ec6dcbe3eb" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_multi_vec_equiv_pre_k", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "dcdfe7fa9b4ddaf415a6eb8cab198f97" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_multi_vec_equiv_pre_k", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_6ee4cce4172b405aefb288f98b829040", + "eq2-interp", "equation_Lib.Sequence.Lemmas.f_shift", + "equation_Lib.Sequence.Lemmas.get_block_s", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_map_f", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Lib.Vec.Lemmas.map_blocks_multi_vec_equiv_pre", + "equation_Lib.Vec.Lemmas.map_blocks_multi_vec_equiv_pre_k", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "lemma_FStar.Seq.Base.lemma_eq_elim", + "lemma_FStar.Seq.Base.lemma_eq_refl", + "lemma_FStar.Seq.Base.lemma_len_append", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_25699f4de0c949c68e992e5573c8bf6d", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_648962b2ae132d6b66f0e1687b18875e", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_9c15d596f5953eb9d8aa8805ac0915cc", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "token_correspondence_Lib.Sequence.Lemmas.f_shift", + "typing_FStar.Seq.Base.length" + ], + 0, + "9c4d8fb4287415af3a42b31d99c645fa" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_multi_vec_equiv_pre_k", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "88986cbcd49267496cff5a82681f8941" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_multi_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.seq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "typing_FStar.Seq.Base.length" + ], + 0, + "08a2efba74abf116222ea02529686b4f" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_multi_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "Lib.Sequence_interpretation_Tm_arrow_d3b9c37343cabe37d3e11c0a1cafa7da", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_2b8b111ba83aebf8b7d238de5c60949e", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_6ee4cce4172b405aefb288f98b829040", + "eq2-interp", "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_map_f", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Lib.Vec.Lemmas.map_blocks_multi_vec_equiv_pre", + "equation_Lib.Vec.Lemmas.normalize_v_map", + "equation_Lib.Vec.Lemmas.repeat_gen_blocks_multi_vec_equiv_pre", + "equation_Prims.nat", "equation_Prims.pos", + "function_token_typing_Lib.Sequence.Lemmas.repeat_gen_blocks_map_f", + "function_token_typing_Lib.Vec.Lemmas.normalize_v_map", + "int_inversion", "int_typing", "lemma_FStar.Seq.Base.lemma_eq_elim", + "lemma_FStar.Seq.Base.lemma_len_append", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_25699f4de0c949c68e992e5573c8bf6d", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_6f684e27d6af9965634108bcfe981953", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_8fb87dad301251f52db6827c1feade3d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "token_correspondence_Lib.Vec.Lemmas.normalize_v_map", + "typing_FStar.Seq.Base.append", + "typing_Lib.Sequence.Lemmas.map_blocks_multi_acc", + "typing_Lib.Sequence.Lemmas.repeat_gen_blocks_map_f" + ], + 0, + "a17b6f5974d5b43a3b7a66cb406ac8d2" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_multi_vec_equiv_pre", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "c8a4d529b29b85d03dfb7a242baab5b9" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_multi_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_34544e76bec95b90d561cc178295d795", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "typing_Lib.Sequence.length" + ], + 0, + "92dc7d196ed6318e8478f1e5bbaffa15" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_multi_vec", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Lib.Vec.Lemmas.normalize_v_map", "equation_Prims.nat", + "equation_Prims.pos", + "function_token_typing_Lib.Sequence.map_blocks_a", "int_inversion", + "lemma_FStar.Seq.Base.lemma_eq_elim", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_34544e76bec95b90d561cc178295d795", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_361ceade980020b5c15ebf36d114dc78", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_b913a3f691ca99086652e0a655e72f17", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "refinement_interpretation_Tm_refine_f91d1a7dd6f8b240a8d009f0cf4aae51", + "typing_FStar.Seq.Base.empty" + ], + 0, + "8200f6ce17fc1f1af854463765cd6a04" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_multi_vec", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "6885ef4baf575c193b2a595ec2f62762" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_d1f13bb72dc761b5dad5d4b8d86cb8fa" + ], + 0, + "43d1117b1837c606f12d6666997795eb" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "8a816aba54c2387eed3a7e5816ae004d" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 4, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_d1f13bb72dc761b5dad5d4b8d86cb8fa" + ], + 0, + "3b71f1375d444e4ea4d6f5502252322a" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 5, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_d1f13bb72dc761b5dad5d4b8d86cb8fa" + ], + 0, + "5401813315e15c3aa43efa49cb1f88a0" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 6, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d1f13bb72dc761b5dad5d4b8d86cb8fa", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "b9d750e9c257f1a36df966dfc4583927" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 7, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "000cdaf83e980669d9c54d15ac2c28e1" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 8, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "refinement_interpretation_Tm_refine_ab6c278100f153565df5228daa4ed476" + ], + 0, + "6fc39bd33bab0528bb0cf272a1625010" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 9, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "b2t_def", + "primitive_Prims.op_LessThan", "primitive_Prims.op_Multiply", + "projection_inverse_BoxBool_proj_0", + "refinement_interpretation_Tm_refine_a785938b699e90fce488019a1aefd3e0", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_dbc690734b1a4717a95b7b47d8b25381" + ], + 0, + "c38af278395043941f328746bbaaf54b" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 10, + 0, + 0, + [ "@query" ], + 0, + "047ef4c0ba4a8c1a823cf09a4f560c64" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 11, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.lseq", + "refinement_interpretation_Tm_refine_9b7f7323a9f8dfb00b51e7329ba0abbe", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "f8151f0c90627b4ff6b2f24ad6cfd5fb" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 12, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6fdcf7302a39aeac615b0eb19b068938", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c1ab57b24250edc055de8723758a2507", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "c8b5d9a0b7166585218efccb9ed7591e" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 13, + 0, + 0, + [ + "@query", "b2t_def", "primitive_Prims.op_Addition", + "primitive_Prims.op_LessThan", "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0" + ], + 0, + "56645d670fc1d17efcc68146852d5451" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 14, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_d1f13bb72dc761b5dad5d4b8d86cb8fa" + ], + 0, + "7c253127502bc4cdc4a0d96f2df6bbf0" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 15, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Modulus", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "a141dce35a15980af5d57516f19e479a" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 16, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.lseq", + "equation_Prims.pos", "primitive_Prims.op_Modulus", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_36069b0a8365444db28aacdd020d9773", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "2ad0879e7b80c277524ea7eba32a874d" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 17, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_d1f13bb72dc761b5dad5d4b8d86cb8fa" + ], + 0, + "ad76bdec689f1caa7673a68c7fbd283d" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 18, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Modulus", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "ed830ecd717cc71e262532e56a27a8fb" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 19, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "e1b02e511005d7247033bd9b8e7c1190" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 20, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "413ceb4379e687ca87b424a26a76473f" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 21, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "refinement_interpretation_Tm_refine_ab6c278100f153565df5228daa4ed476" + ], + 0, + "2c230008712e5a670000c70f8e5a7128" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 22, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "primitive_Prims.op_LessThan", + "primitive_Prims.op_Multiply", + "refinement_interpretation_Tm_refine_0821e24547a8d1dcfc53e49b580fdc23" + ], + 0, + "e6896017f4add71c2fdbae994bf3b05f" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 23, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "1a3e96668c0ce02724bf6cd627c5b636" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 24, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_d1f13bb72dc761b5dad5d4b8d86cb8fa" + ], + 0, + "f2784fad8d0dfc8f93a7748702e0c67d" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 25, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_d1f13bb72dc761b5dad5d4b8d86cb8fa" + ], + 0, + "4e48fa70b66c45bef839b4095a1f9dcb" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 26, + 0, + 0, + [ + "@query", "b2t_def", "primitive_Prims.op_LessThan", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "323ff069a8336e08490be39c0ba768d8" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 27, + 0, + 0, + [ "@query" ], + 0, + "bfbc627413aa9fa71b68bbc8406c3fcc" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 28, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.lseq", + "refinement_interpretation_Tm_refine_9b7f7323a9f8dfb00b51e7329ba0abbe", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "5172b2ee83a81bba20361515fee33b7d" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 29, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "b2t_def", + "equation_Lib.Sequence.lseq", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_LessThan", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0821e24547a8d1dcfc53e49b580fdc23", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6fdcf7302a39aeac615b0eb19b068938", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c1ab57b24250edc055de8723758a2507", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "a3000e8e696412322732237cce758021" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 30, + 0, + 0, + [ + "@query", "b2t_def", "primitive_Prims.op_Addition", + "primitive_Prims.op_LessThan", "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0" + ], + 0, + "986cac0d6c2e2b4ba4eb1e4a2ed0cc5a" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 31, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_d1f13bb72dc761b5dad5d4b8d86cb8fa" + ], + 0, + "dfbfbc59f4629e5a832e4bdcc968de92" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 32, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Modulus", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "8ce8b7f9429fce93d49c1cd13b03207d" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 33, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Modulus", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "37838f12d22ab37692cb41ad1002f088" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 34, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_d1f13bb72dc761b5dad5d4b8d86cb8fa" + ], + 0, + "642cd07fd45f8082c633a9180f55492a" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 35, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "primitive_Prims.op_Modulus", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_611a250d766b5c9d1ddba7e33fccca95", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "75c4405636b36350e4eb80c77892752a" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 36, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "b2t_def", + "equation_Lib.Sequence.lseq", "primitive_Prims.op_LessThan", + "primitive_Prims.op_Modulus", "projection_inverse_BoxBool_proj_0", + "refinement_interpretation_Tm_refine_b013f9d695dd5b8ec28f09b7a3cfcb3c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "0d103bd0e56a0f9bdc6c29d4ced52031" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 37, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "e2a8ae361779f8945313c102a16927f2" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", "equation_Lib.Sequence.map_blocks_a", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803" + ], + 0, + "84066a6cd407aca176545c8a70d67312" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "c512d33eb332f09e03ffdf0492b05fde" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre_k_aux", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8710a3dcbb7aeecb1da33ddf8070b919", + "refinement_interpretation_Tm_refine_bb0b8197bb42e9a1aaebe59e97685233", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "520dbf47b0c1787182a6313f1c9b4d4e" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre_k_aux", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "eq2-interp", "equation_Lib.Sequence.Lemmas.f_shift", + "equation_Lib.Sequence.Lemmas.get_block_s", + "equation_Lib.Sequence.Lemmas.get_last_s", + "equation_Lib.Sequence.Lemmas.l_shift", + "equation_Lib.Sequence.get_block", "equation_Lib.Sequence.get_last", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_LessThan", "primitive_Prims.op_Modulus", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8710a3dcbb7aeecb1da33ddf8070b919", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29", + "refinement_interpretation_Tm_refine_fe0ca3f3b25cc9d377244449d02c257b", + "token_correspondence_Lib.Sequence.Lemmas.f_shift", + "token_correspondence_Lib.Sequence.Lemmas.l_shift" + ], + 0, + "e4ee64e60574501882723ffa00a348dc" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre_k_aux", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "4392e0a88e4760d617b676d59b94a9c7" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre_k", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "02e6c1c4e29cc107c2b9c2d39f0ca767" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre_k", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "Prims_pretyping_ae567c2fb75be05905677af440075565", + "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_map_l", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Lib.Vec.Lemmas.map_blocks_vec_equiv_pre", + "equation_Prims.nat", "equation_Prims.pos", + "function_token_typing_Prims.__cache_version_number__", + "int_inversion", "lemma_FStar.Seq.Base.lemma_eq_elim", + "lemma_FStar.Seq.Base.lemma_eq_refl", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Equality", + "primitive_Prims.op_GreaterThan", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_1e8892e6e831382419ad3b591eb7d098", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_8710a3dcbb7aeecb1da33ddf8070b919", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "refinement_interpretation_Tm_refine_fe0ca3f3b25cc9d377244449d02c257b" + ], + 0, + "0e894a488317cafada75bcf71360d58b" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre_k", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "aca69830d4f8bccfb831c6f147a387b1" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "1a95a0b0c54a12be3d407b437584f7e8" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "f765ad15da6b80bc93cc9389caf47b4f" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 4, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "3e8612b27df199e8288f90a0d80940c8" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 5, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_90b5d2df39645a4835173a203da069e4" + ], + 0, + "3e5f71abe8eddf09ddf5188f6881b22b" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 6, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "03f2e35aa8c03309753610a90adb60c3" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 7, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "5254c4becc34805f2b6f6619d9ce433a" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 8, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "a4767dec603fad69b17341471a52f5ba" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 9, + 0, + 0, + [ + "@query", "b2t_def", "primitive_Prims.op_GreaterThanOrEqual", + "projection_inverse_BoxBool_proj_0" + ], + 0, + "5a803c4ae22d6f6d407d7b104748a693" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 10, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "b2t_def", "equation_Prims.pos", + "primitive_Prims.op_Addition", + "primitive_Prims.op_GreaterThanOrEqual", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "cf517f574a790339ecd1e167d0501081" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 11, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.pos", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_ab6c278100f153565df5228daa4ed476", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "90c41881dcd9265b62d19db2e6c93883" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 12, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_2b8b111ba83aebf8b7d238de5c60949e", + "equation_Lib.Sequence.map_blocks_a", + "equation_Lib.Vec.Lemmas.normalize_v_map", "equation_Prims.nat", + "equation_Prims.pos", + "function_token_typing_Lib.Vec.Lemmas.normalize_v_map", + "int_inversion", "primitive_Prims.op_Multiply", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "token_correspondence_Lib.Vec.Lemmas.normalize_v_map" + ], + 0, + "93ef73ed448ca1f3b73efe140d320cc1" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 13, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_9dbede814c7e09cf989d879ebca4b33a", + "Lib.Sequence_interpretation_Tm_arrow_d3b9c37343cabe37d3e11c0a1cafa7da", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_118c184bc6b09ad53ce4ad8d5a429a26", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_14de8c4f182c06de8d54fe736be97e51", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_2b8b111ba83aebf8b7d238de5c60949e", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_c38a40c75e862a598ad8a42d5d6e0b77", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_e8b984cc954d1a93c0670e47bfd79ffd", + "eq2-interp", "equation_Lib.Sequence.Lemmas.repeat_gen_blocks_map_l", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Lib.Sequence.map_blocks_a", "equation_Lib.Sequence.seq", + "equation_Lib.Vec.Lemmas.map_blocks_vec_equiv_pre", + "equation_Lib.Vec.Lemmas.normalize_v_map", + "equation_Lib.Vec.Lemmas.repeat_gen_blocks_vec_equiv_pre", + "equation_Prims.nat", "equation_Prims.pos", "equation_Prims.prop", + "equation_Prims.subtype_of", + "function_token_typing_Lib.Sequence.Lemmas.repeat_gen_blocks_map_l", + "function_token_typing_Lib.Sequence.map_blocks_a", + "function_token_typing_Lib.Vec.Lemmas.normalize_v_map", + "int_inversion", "lemma_FStar.Seq.Base.lemma_eq_elim", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0dee8cb03258a67c2f7ec66427696212", + "refinement_interpretation_Tm_refine_1140254f0add9ac82e3c74c399912e35", + "refinement_interpretation_Tm_refine_135aa34345be03950a1f68856adc9696", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_468e2c12fe9f35171b9906080ca0a4e2", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_699b49b4417ef75b53fcedc14a52a1b7", + "refinement_interpretation_Tm_refine_73f210ca6e0061ed4a3150f69b8f33bf", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_8dd1dd228be3e5b616c46def4cb5b9b8", + "refinement_interpretation_Tm_refine_90b5d2df39645a4835173a203da069e4", + "refinement_interpretation_Tm_refine_ab10ebde35f525273208b7b927d2f7d9", + "refinement_interpretation_Tm_refine_abadd9912c483da57a30d7d5a8a5f57c", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_c4c06bc9798b4dacf79609445c9d1c09", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "token_correspondence_Lib.Sequence.map_blocks_a", + "token_correspondence_Lib.Vec.Lemmas.normalize_v_map", + "typing_FStar.Seq.Base.append", + "typing_Lib.Sequence.Lemmas.map_blocks_acc", + "typing_Lib.Vec.Lemmas.map_blocks_vec_equiv_pre", "unit_inversion" + ], + 0, + "00aeede63c7deebc17bb967118cfb199" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec_equiv_pre", + 14, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "44136ca1b1fc6387f0b147039f94cbe5" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_4e46b18e6de7fd724da2ef45eb7b3ba2", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "e3c9de38d29ee73b3bb24576997050a4" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec", + 2, + 0, + 0, + [ + "@MaxFuel_assumption", "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "Lib.Sequence.Lemmas_interpretation_Tm_arrow_9dbede814c7e09cf989d879ebca4b33a", + "Lib.Sequence_interpretation_Tm_arrow_d3b9c37343cabe37d3e11c0a1cafa7da", + "Lib.Sequence_interpretation_Tm_arrow_efd714987712642bce73b6a439af3d22", + "Lib.Sequence_interpretation_Tm_arrow_f67e6b48b3d5d38ee7701f3b137f9030", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_118c184bc6b09ad53ce4ad8d5a429a26", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_6ee4cce4172b405aefb288f98b829040", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_c38a40c75e862a598ad8a42d5d6e0b77", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_e8b984cc954d1a93c0670e47bfd79ffd", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.map_blocks_a", + "equation_Lib.Sequence.seq", + "equation_Lib.Vec.Lemmas.normalize_v_map", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "lemma_FStar.Seq.Base.lemma_eq_elim", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_1140254f0add9ac82e3c74c399912e35", + "refinement_interpretation_Tm_refine_135aa34345be03950a1f68856adc9696", + "refinement_interpretation_Tm_refine_1f6c16a51cd4ba3256b95ca590c832c5", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_4e46b18e6de7fd724da2ef45eb7b3ba2", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7af7abfd9fa791df66706ab563886df2", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_8710a3dcbb7aeecb1da33ddf8070b919", + "refinement_interpretation_Tm_refine_b913a3f691ca99086652e0a655e72f17", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_dee0f34b44c44e6d512c6db0858b92ef", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29", + "refinement_interpretation_Tm_refine_f4f040c0afc8e02646bd007fb369c803", + "typing_FStar.Seq.Base.empty", "typing_Lib.Sequence.map_blocks" + ], + 0, + "aef2cbdb6623ff7e91796f4a89ad2b61" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec", + 3, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "582cb23c0d2ffafa5bff4fb2657487df" + ] + ] +] \ No newline at end of file diff --git a/tests/hacl/Lib.Vec.Lemmas.fsti b/tests/hacl/Lib.Vec.Lemmas.fsti new file mode 100644 index 00000000000..ec423584a20 --- /dev/null +++ b/tests/hacl/Lib.Vec.Lemmas.fsti @@ -0,0 +1,331 @@ +module Lib.Vec.Lemmas + +open FStar.Mul +open Lib.IntTypes +open Lib.Sequence +open Lib.Sequence.Lemmas + +module Loops = Lib.LoopCombinators + +#push-options "--z3rlimit 30 --max_fuel 0 --max_ifuel 0 \ + --using_facts_from '-* +Prims +FStar.Pervasives +FStar.Math.Lemmas +FStar.Seq -FStar.Seq.Properties.slice_slice \ + +Lib.IntTypes +Lib.Sequence +Lib.Sequence.Lemmas +Lib.LoopCombinators +Lib.Vec.Lemmas'" + + +val lemma_repeat_gen_vec: + w:pos + -> n:nat + -> a:(i:nat{i <= w * n} -> Type) + -> a_vec:(i:nat{i <= n} -> Type) + -> normalize_v:(i:nat{i <= n} -> a_vec i -> a (w * i)) + -> f:(i:nat{i < w * n} -> a i -> a (i + 1)) + -> f_v:(i:nat{i < n} -> a_vec i -> a_vec (i + 1)) + -> acc_v0:a_vec 0 -> + Lemma + (requires (forall (i:nat{i < n}) (acc_v:a_vec i). + (assert (w * (i + 1) <= w * n); + normalize_v (i + 1) (f_v i acc_v) == + Loops.repeat_right (w * i) (w * (i + 1)) a f (normalize_v i acc_v)))) + (ensures + normalize_v n (Loops.repeat_right 0 n a_vec f_v acc_v0) == + Loops.repeat_right 0 (w * n) a f (normalize_v 0 acc_v0)) + + +val lemma_repeati_vec: + #a:Type0 + -> #a_vec:Type0 + -> w:pos + -> n:nat + -> normalize_v:(a_vec -> a) + -> f:(i:nat{i < w * n} -> a -> a) + -> f_v:(i:nat{i < n} -> a_vec -> a_vec) + -> acc_v0:a_vec -> + Lemma + (requires (forall (i:nat{i < n}) (acc_v:a_vec). + (assert (w * (i + 1) <= w * n); + normalize_v (f_v i acc_v) == + Loops.repeat_right (w * i) (w * (i + 1)) (Loops.fixed_a a) f (normalize_v acc_v)))) + (ensures + normalize_v (Loops.repeati n f_v acc_v0) == + Loops.repeati (w * n) f (normalize_v acc_v0)) + +/// +/// Lemma +/// (repeat_gen_blocks (w * blocksize) 0 n inp a_vec f_v l_v acc_v0 == +/// repeat_gen_blocks blocksize 0 (w * n + w) inp a f l (normalize_v 0 acc_v0)) +/// + +val len_is_w_n_blocksize: w:pos -> blocksize:pos -> n:nat -> Lemma + (let len = w * n * blocksize in + len / blocksize = w * n /\ len / (w * blocksize) = n /\ + len % blocksize = 0 /\ len % (w * blocksize) = 0) + + +let repeat_gen_blocks_multi_vec_equiv_pre + (#inp_t:Type0) + (w:pos) + (blocksize:pos{w * blocksize <= max_size_t}) + (n:nat) + (hi_f:nat{w * n <= hi_f}) + (a:(i:nat{i <= hi_f} -> Type)) + (a_vec:(i:nat{i <= n} -> Type)) + (f:(i:nat{i < hi_f} -> lseq inp_t blocksize -> a i -> a (i + 1))) + (f_v:(i:nat{i < n} -> lseq inp_t (w * blocksize) -> a_vec i -> a_vec (i + 1))) + (normalize_v:(i:nat{i <= n} -> a_vec i -> a (w * i))) + (i:nat{i < n}) + (b_v:lseq inp_t (w * blocksize)) + (acc_v:a_vec i) + : prop += + Math.Lemmas.lemma_mult_le_right w (i + 1) n; + + normalize_v (i + 1) (f_v i b_v acc_v) == + repeat_gen_blocks_multi blocksize (w * i) hi_f w b_v a f (normalize_v i acc_v) + + +val lemma_repeat_gen_blocks_multi_vec: + #inp_t:Type0 + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> hi_f:nat{w * n <= hi_f} + -> inp:seq inp_t{length inp = w * n * blocksize} + -> a:(i:nat{i <= hi_f} -> Type) + -> a_vec:(i:nat{i <= n} -> Type) + -> f:(i:nat{i < hi_f} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> f_v:(i:nat{i < n} -> lseq inp_t (w * blocksize) -> a_vec i -> a_vec (i + 1)) + -> normalize_v:(i:nat{i <= n} -> a_vec i -> a (w * i)) + -> acc_v0:a_vec 0 -> + Lemma + (requires + (forall (i:nat{i < n}) (b_v:lseq inp_t (w * blocksize)) (acc_v:a_vec i). + repeat_gen_blocks_multi_vec_equiv_pre w blocksize n hi_f a a_vec f f_v normalize_v i b_v acc_v)) + (ensures + (len_is_w_n_blocksize w blocksize n; + normalize_v n (repeat_gen_blocks_multi (w * blocksize) 0 n n inp a_vec f_v acc_v0) == + repeat_gen_blocks_multi blocksize 0 hi_f (w * n) inp a f (normalize_v 0 acc_v0))) + + +let repeat_gen_blocks_vec_equiv_pre + (#inp_t:Type0) + (#c:Type0) + (w:pos) + (blocksize:pos{w * blocksize <= max_size_t}) + (n:nat) + (a:(i:nat{i <= w * n + w} -> Type)) + (a_vec:(i:nat{i <= n} -> Type)) + (f:(i:nat{i < w * n + w} -> lseq inp_t blocksize -> a i -> a (i + 1))) + (l:(i:nat{i <= w * n + w} -> len:nat{len < blocksize} -> lseq inp_t len -> a i -> c)) + (l_v:(i:nat{i <= n} -> len:nat{len < w * blocksize} -> lseq inp_t len -> a_vec i -> c)) + (normalize_v:(i:nat{i <= n} -> a_vec i -> a (w * i))) + (rem:nat{rem < w * blocksize}) + (b_v:lseq inp_t rem) + (acc_v:a_vec n) + : prop += + l_v n rem b_v acc_v == + repeat_gen_blocks #inp_t #c blocksize (w * n) (w * n + w) b_v a f l (normalize_v n acc_v) + + +val lemma_repeat_gen_blocks_vec: + #inp_t:Type0 + -> #c:Type0 + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> inp:seq inp_t + -> n:nat{n = length inp / (w * blocksize)} + -> a:(i:nat{i <= w * n + w} -> Type) + -> a_vec:(i:nat{i <= n} -> Type) + -> f:(i:nat{i < w * n + w} -> lseq inp_t blocksize -> a i -> a (i + 1)) + -> l:(i:nat{i <= w * n + w} -> len:nat{len < blocksize} -> lseq inp_t len -> a i -> c) + -> f_v:(i:nat{i < n} -> lseq inp_t (w * blocksize) -> a_vec i -> a_vec (i + 1)) + -> l_v:(i:nat{i <= n} -> len:nat{len < w * blocksize} -> lseq inp_t len -> a_vec i -> c) + -> normalize_v:(i:nat{i <= n} -> a_vec i -> a (w * i)) + -> acc_v0:a_vec 0 -> + Lemma + (requires + (forall (i:nat{i < n}) (b_v:lseq inp_t (w * blocksize)) (acc_v:a_vec i). + repeat_gen_blocks_multi_vec_equiv_pre w blocksize n (w * n + w) a a_vec f f_v normalize_v i b_v acc_v) /\ + (forall (rem:nat{rem < w * blocksize}) (b_v:lseq inp_t rem) (acc_v:a_vec n). + repeat_gen_blocks_vec_equiv_pre w blocksize n a a_vec f l l_v normalize_v rem b_v acc_v)) + (ensures + repeat_gen_blocks (w * blocksize) 0 n inp a_vec f_v l_v acc_v0 == + repeat_gen_blocks blocksize 0 (w * n + w) inp a f l (normalize_v 0 acc_v0)) + +/// +/// Lemma +/// (repeat_blocks (w * blocksize) inp f_v l_v acc_v0 == +/// repeat_blocks blocksize inp f l (normalize_v acc_v0)) +/// + +let repeat_blocks_multi_vec_equiv_pre + (#a:Type0) + (#b:Type0) + (#b_vec:Type0) + (w:pos) + (blocksize:pos{w * blocksize <= max_size_t}) + (f:(lseq a blocksize -> b -> b)) + (f_v:(lseq a (w * blocksize) -> b_vec -> b_vec)) + (normalize_v:(b_vec -> b)) + (b_v:lseq a (w * blocksize)) + (acc_v:b_vec) + : prop += + Math.Lemmas.cancel_mul_mod w blocksize; + normalize_v (f_v b_v acc_v) == repeat_blocks_multi blocksize b_v f (normalize_v acc_v) + + +val lemma_repeat_blocks_multi_vec: + #a:Type0 + -> #b:Type0 + -> #b_vec:Type0 + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> inp:seq a{length inp % (w * blocksize) = 0 /\ length inp % blocksize = 0} + -> f:(lseq a blocksize -> b -> b) + -> f_v:(lseq a (w * blocksize) -> b_vec -> b_vec) + -> normalize_v:(b_vec -> b) + -> acc_v0:b_vec -> + Lemma + (requires + (forall (b_v:lseq a (w * blocksize)) (acc_v:b_vec). + repeat_blocks_multi_vec_equiv_pre w blocksize f f_v normalize_v b_v acc_v)) + (ensures + normalize_v (repeat_blocks_multi #a #b_vec (w * blocksize) inp f_v acc_v0) == + repeat_blocks_multi #a #b blocksize inp f (normalize_v acc_v0)) + + +let repeat_blocks_vec_equiv_pre + (#a:Type0) + (#b:Type0) + (#b_vec:Type0) + (#c:Type0) + (w:pos) + (blocksize:pos{w * blocksize <= max_size_t}) + (f:(lseq a blocksize -> b -> b)) + (l:(len:nat{len < blocksize} -> lseq a len -> b -> c)) + (l_v:(len:nat{len < w * blocksize} -> lseq a len -> b_vec -> c)) + (normalize_v:(b_vec -> b)) + (rem:nat{rem < w * blocksize}) + (b_v:lseq a rem) + (acc_v:b_vec) + : prop += + l_v rem b_v acc_v == + repeat_blocks blocksize b_v f l (normalize_v acc_v) + + +val lemma_repeat_blocks_vec: + #a:Type0 + -> #b:Type0 + -> #b_vec:Type0 + -> #c:Type0 + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> inp:seq a + -> f:(lseq a blocksize -> b -> b) + -> l:(len:nat{len < blocksize} -> lseq a len -> b -> c) + -> f_v:(lseq a (w * blocksize) -> b_vec -> b_vec) + -> l_v:(len:nat{len < w * blocksize} -> lseq a len -> b_vec -> c) + -> normalize_v:(b_vec -> b) + -> acc_v0:b_vec -> + Lemma + (requires + (forall (b_v:lseq a (w * blocksize)) (acc_v:b_vec). + repeat_blocks_multi_vec_equiv_pre w blocksize f f_v normalize_v b_v acc_v) /\ + (forall (rem:nat{rem < w * blocksize}) (b_v:lseq a rem) (acc_v:b_vec). + repeat_blocks_vec_equiv_pre w blocksize f l l_v normalize_v rem b_v acc_v)) + (ensures + repeat_blocks (w * blocksize) inp f_v l_v acc_v0 == + repeat_blocks blocksize inp f l (normalize_v acc_v0)) + +/// +/// Lemma +/// (map_blocks (w * blocksize) inp f_v l_v == map_blocks blocksize inp f l) +/// + +val lemma_f_map_ind: w:pos -> blocksize:pos -> n:nat -> i:nat{i < n} -> k:nat{k < w * blocksize} -> + Lemma (w * i + k / blocksize < w * n) + + +let map_blocks_multi_vec_equiv_pre_k + (#a:Type) + (w:pos) + (blocksize:pos{w * blocksize <= max_size_t}) + (n:nat) + (hi_f:nat{w * n <= hi_f}) + (f:(i:nat{i < hi_f} -> lseq a blocksize -> lseq a blocksize)) + (f_v:(i:nat{i < n} -> lseq a (w * blocksize) -> lseq a (w * blocksize))) + (i:nat{i < n}) + (b_v:lseq a (w * blocksize)) + (k:nat{k < w * blocksize}) + : prop + = + Math.Lemmas.cancel_mul_div w blocksize; + let block = get_block_s #a #(w * blocksize) blocksize b_v k in + lemma_f_map_ind w blocksize n i k; + Seq.index (f_v i b_v) k == Seq.index (f (w * i + k / blocksize) block) (k % blocksize) + + +val lemma_map_blocks_multi_vec: + #a:Type + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> n:nat + -> inp:seq a{length inp = w * n * blocksize} + -> f:(i:nat{i < w * n} -> lseq a blocksize -> lseq a blocksize) + -> f_v:(i:nat{i < n} -> lseq a (w * blocksize) -> lseq a (w * blocksize)) -> + Lemma + (requires + (forall (i:nat{i < n}) (b_v:lseq a (w * blocksize)) (k:nat{k < w * blocksize}). + map_blocks_multi_vec_equiv_pre_k w blocksize n (w * n) f f_v i b_v k)) + (ensures + (len_is_w_n_blocksize w blocksize n; + map_blocks_multi (w * blocksize) n n inp f_v == + map_blocks_multi blocksize (w * n) (w * n) inp f)) + +#push-options "--z3rlimit_factor 2" +let map_blocks_vec_equiv_pre_k + (#a:Type) + (w:pos) + (blocksize:pos{w * blocksize <= max_size_t}) + (n:nat) + (f:(i:nat{i < w * n + w} -> lseq a blocksize -> lseq a blocksize)) + (l:(i:nat{i <= w * n + w} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem)) + (l_v:(i:nat{i <= n} -> rem:nat{rem < w * blocksize} -> lseq a rem -> lseq a rem)) + (rem:nat{rem < w * blocksize}) + (b_v:lseq a rem) + (k:nat{k < rem}) + : prop + = + let j = w * n + k / blocksize in + div_mul_lt blocksize k w; + + if k < rem / blocksize * blocksize then begin + let block = get_block_s #a #rem blocksize b_v k in + Seq.index (l_v n rem b_v) k == Seq.index (f j block) (k % blocksize) end + else begin + let block_l = get_last_s blocksize b_v in + mod_div_lt blocksize k rem; + assert (k % blocksize < rem % blocksize); + Seq.index (l_v n rem b_v) k == Seq.index (l j (rem % blocksize) block_l) (k % blocksize) end +#pop-options + +val lemma_map_blocks_vec: + #a:Type + -> w:pos + -> blocksize:pos{w * blocksize <= max_size_t} + -> inp:seq a + -> n:nat{n == length inp / (w * blocksize)} + -> f:(i:nat{i < w * n + w} -> lseq a blocksize -> lseq a blocksize) + -> l:(i:nat{i <= w * n + w} -> rem:nat{rem < blocksize} -> lseq a rem -> lseq a rem) + -> f_v:(i:nat{i < n} -> lseq a (w * blocksize) -> lseq a (w * blocksize)) + -> l_v:(i:nat{i <= n} -> rem:nat{rem < w * blocksize} -> lseq a rem -> lseq a rem) -> + Lemma + (requires + (forall (i:nat{i < n}) (b_v:lseq a (w * blocksize)) (k:nat{k < w * blocksize}). + map_blocks_multi_vec_equiv_pre_k w blocksize n (w * n) f f_v i b_v k) /\ + (forall (rem:nat{rem < w * blocksize}) (b_v:lseq a rem) (k:nat{k < rem}). + map_blocks_vec_equiv_pre_k w blocksize n f l l_v rem b_v k)) + (ensures + map_blocks (w * blocksize) inp f_v l_v == map_blocks blocksize inp f l) diff --git a/tests/hacl/Lib.Vec.Lemmas.fsti.hints b/tests/hacl/Lib.Vec.Lemmas.fsti.hints new file mode 100644 index 00000000000..4d1fb2f46a2 --- /dev/null +++ b/tests/hacl/Lib.Vec.Lemmas.fsti.hints @@ -0,0 +1,403 @@ +[ + "\u0007]à¼Ü–\u001a!WLÞ¬.MŽ", + [ + [ + "Lib.Vec.Lemmas.lemma_repeat_gen_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "primitive_Prims.op_Addition", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_6f77474ede8199333d3f4de9c694b4b9", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "445e708733ca11524dfee0e0adbb82b9" + ], + [ + "Lib.Vec.Lemmas.lemma_repeati_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "28a410c23c5f5e2173e048f42167a378" + ], + [ + "Lib.Vec.Lemmas.len_is_w_n_blocksize", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "a69c31cff994a6ad4fe2fd8f8094fe2c" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_multi_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "int_typing", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "typing_Prims.pow2" + ], + 0, + "c4df913dab06b77e3a39c21a29055dc5" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_multi_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "c087f34c5dd7c857bdcc125d5fdb0268" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_gen_blocks_multi_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "int_typing", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_34544e76bec95b90d561cc178295d795", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "typing_Lib.Sequence.length" + ], + 0, + "d8e862a82508b4cd497b860cc6a5d2de" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Multiply", "primitive_Prims.op_Subtraction", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "7931720feee169aab00f30a0a0e82b2f" + ], + [ + "Lib.Vec.Lemmas.repeat_gen_blocks_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_1140254f0add9ac82e3c74c399912e35", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d" + ], + 0, + "418b5d570efc45d5dc83ec865dc0f5c5" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_gen_blocks_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Lib.Sequence.length", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_1140254f0add9ac82e3c74c399912e35", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_4e46b18e6de7fd724da2ef45eb7b3ba2", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_7e0b9b2dbca36eab00de093c1b701c6d", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "6947bff9eec930cb0a375da1c1a8e184" + ], + [ + "Lib.Vec.Lemmas.repeat_blocks_multi_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42" + ], + 0, + "a4e97c0a184312b3f4d4a561d9a148d9" + ], + [ + "Lib.Vec.Lemmas.repeat_blocks_multi_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "b234331db7e13c2c90651c03dfd788d4" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_multi_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e90c2c89afe31ba2752cabd31cd7f6e7" + ], + 0, + "228217519cbd846024b8acd1fbf55866" + ], + [ + "Lib.Vec.Lemmas.repeat_blocks_vec_equiv_pre", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "a62603edb54c59fe49b91cf8d63a07be" + ], + [ + "Lib.Vec.Lemmas.repeat_blocks_vec_equiv_pre", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "6733b74c4434a9f017159df4aa16b9b5" + ], + [ + "Lib.Vec.Lemmas.lemma_repeat_blocks_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "int_inversion", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "176e45cc444f952b0bc46f87d30bc841" + ], + [ + "Lib.Vec.Lemmas.lemma_f_map_ind", + 1, + 0, + 0, + [ "@query" ], + 0, + "94c7bfa95c648d627c1508d1a3c752c9" + ], + [ + "Lib.Vec.Lemmas.map_blocks_multi_vec_equiv_pre_k", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", + "Lib.Vec.Lemmas_interpretation_Tm_arrow_6ee4cce4172b405aefb288f98b829040", + "equation_Lib.Sequence.length", "equation_Lib.Sequence.lseq", + "equation_Prims.nat", "equation_Prims.pos", "int_inversion", + "primitive_Prims.op_Addition", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_0d5d3c38400eadf55263b743de2c168b", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "70a26ac0d7ccf01051ad26ba5d3c3717" + ], + [ + "Lib.Vec.Lemmas.map_blocks_multi_vec_equiv_pre_k", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "a33605d68fbd6adc580e16849dfddf72" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_multi_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Division", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_34544e76bec95b90d561cc178295d795", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_609674d96c81c962549b0076055bf213", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "typing_Lib.Sequence.length" + ], + 0, + "f301269a55db053a5c12ca45404513e8" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Lib.Sequence.length", + "equation_Lib.Sequence.lseq", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_LessThan", + "primitive_Prims.op_Modulus", "primitive_Prims.op_Multiply", + "projection_inverse_BoxBool_proj_0", + "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c", + "refinement_interpretation_Tm_refine_d8d83307254a8900dd20598654272e42", + "refinement_interpretation_Tm_refine_e37a8a81b6e72b6dae52414929365d29" + ], + 0, + "bfd3d9e419c0d4ad8127ed518a3ef860" + ], + [ + "Lib.Vec.Lemmas.map_blocks_vec_equiv_pre_k", + 2, + 0, + 0, + [ + "@MaxIFuel_assumption", "@query", "equation_Prims.pos", + "primitive_Prims.op_Multiply", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5" + ], + 0, + "066d5d69fc0cf7311373837e3cf406f1" + ], + [ + "Lib.Vec.Lemmas.lemma_map_blocks_vec", + 1, + 0, + 0, + [ + "@MaxIFuel_assumption", + "@fuel_correspondence_Prims.pow2.fuel_instrumented", "@query", + "equation_Lib.Sequence.length", "equation_Prims.nat", + "equation_Prims.pos", "int_inversion", "primitive_Prims.op_Addition", + "primitive_Prims.op_Division", "primitive_Prims.op_Multiply", + "primitive_Prims.op_Subtraction", "projection_inverse_BoxInt_proj_0", + "refinement_interpretation_Tm_refine_3481cd680b4085d38b991b22047bd771", + "refinement_interpretation_Tm_refine_4e46b18e6de7fd724da2ef45eb7b3ba2", + "refinement_interpretation_Tm_refine_542f9d4f129664613f2483a6c88bc7c2", + "refinement_interpretation_Tm_refine_774ba3f728d91ead8ef40be66c9802e5", + "refinement_interpretation_Tm_refine_c1424615841f28cac7fc34e92b7ff33c" + ], + 0, + "a50f3aa4d65cb01de63187a70ad28f3c" + ] + ] +] \ No newline at end of file diff --git a/tests/hacl/Makefile b/tests/hacl/Makefile new file mode 100644 index 00000000000..d17eb4f6033 --- /dev/null +++ b/tests/hacl/Makefile @@ -0,0 +1,14 @@ +FSTAR_HOME=../.. + +FSTAR_FILES = $(wildcard *.fst *.fsti) + +all: verify-all + +include $(FSTAR_HOME)/examples/Makefile.common + +verify-all: $(CACHE_DIR) $(addsuffix .checked, $(addprefix $(CACHE_DIR)/, $(FSTAR_FILES))) + +clean: + rm -f .depend + rm -rf _cache + rm -rf _output diff --git a/tests/ide/emacs/Harness.selfref.out.expected b/tests/ide/emacs/Harness.selfref.out.expected index 7bb7b9cfd78..08a4b7e237a 100644 --- a/tests/ide/emacs/Harness.selfref.out.expected +++ b/tests/ide/emacs/Harness.selfref.out.expected @@ -1,4 +1,4 @@ {"kind": "protocol-info", "rest": "[...]"} {"kind": "response", "query-id": "1", "response": [], "status": "success"} -{"kind": "response", "query-id": "2", "response": [{"level": "error", "message": " - Could not prove post-condition\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (1,25-1,32)\n", "number": 19, "ranges": [{"beg": [1, 35], "end": [1, 37], "fname": ""}, {"beg": [1, 25], "end": [1, 32], "fname": ""}]}], "status": "failure"} -{"kind": "response", "query-id": "3", "response": [{"level": "error", "message": " - Identifier not found: [Harness.always_foo]\n - Module Harness resolved into Harness, which does not belong to the list of\n modules in scope, namely:\n FStar.Mul, FStar.Classical, FStar.Classical.Sugar, FStar.Pervasives,\n FStar.Pervasives.Native, Prims\n", "number": 72, "ranges": [{"beg": [1, 43], "end": [1, 53], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "2", "response": [{"level": "error", "message": "- Could not prove post-condition\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also (1,25-1,32)\n", "number": 19, "ranges": [{"beg": [1, 35], "end": [1, 37], "fname": ""}, {"beg": [1, 25], "end": [1, 32], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "3", "response": [{"level": "error", "message": "- Identifier not found: [Harness.always_foo]\n- Module Harness resolved into Harness, which does not belong to the list of\n modules in scope, namely:\n FStar.Mul, FStar.Classical, FStar.Classical.Sugar, FStar.Pervasives,\n FStar.Pervasives.Native, Prims\n", "number": 72, "ranges": [{"beg": [1, 43], "end": [1, 53], "fname": ""}]}], "status": "failure"} diff --git a/tests/ide/emacs/backtracking.peek-with-unset-module.out.expected b/tests/ide/emacs/backtracking.peek-with-unset-module.out.expected index 04e1455285d..7ac9ea6b7d3 100644 --- a/tests/ide/emacs/backtracking.peek-with-unset-module.out.expected +++ b/tests/ide/emacs/backtracking.peek-with-unset-module.out.expected @@ -1,5 +1,5 @@ {"kind": "protocol-info", "rest": "[...]"} -{"kind": "response", "query-id": "1", "response": [{"level": "error", "message": " - Syntax error: expected a module name\n", "number": 168, "ranges": [{"beg": [1, 7], "end": [1, 19], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "1", "response": [{"level": "error", "message": "- Syntax error: expected a module name\n", "number": 168, "ranges": [{"beg": [1, 7], "end": [1, 19], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "2", "response": "Current module unset", "status": "failure"} {"kind": "response", "query-id": "3", "response": "Current module unset", "status": "failure"} {"kind": "response", "query-id": "4", "response": "Current module unset", "status": "failure"} diff --git a/tests/ide/emacs/backtracking.refinements.out.expected b/tests/ide/emacs/backtracking.refinements.out.expected index feeab41a808..38bff59abc0 100644 --- a/tests/ide/emacs/backtracking.refinements.out.expected +++ b/tests/ide/emacs/backtracking.refinements.out.expected @@ -1,7 +1,7 @@ {"kind": "protocol-info", "rest": "[...]"} {"kind": "response", "query-id": "1", "response": [], "status": "success"} {"kind": "response", "query-id": "2", "response": [], "status": "success"} -{"kind": "response", "query-id": "3", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [3, 6], "end": [3, 6], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "3", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [3, 6], "end": [3, 6], "fname": ""}]}], "status": "success"} {"kind": "response", "query-id": "4", "response": [], "status": "success"} {"kind": "response", "query-id": "5", "response": [], "status": "success"} {"kind": "response", "query-id": "6", "response": [], "status": "success"} @@ -10,40 +10,40 @@ {"kind": "response", "query-id": "9", "response": [], "status": "success"} {"kind": "response", "query-id": "10", "response": [], "status": "success"} {"kind": "response", "query-id": "11", "response": null, "status": "success"} -{"kind": "response", "query-id": "12", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [3, 14], "end": [3, 14], "fname": ""}]}], "status": "success"} -{"kind": "response", "query-id": "13", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [4, 0], "end": [4, 0], "fname": ""}]}], "status": "success"} -{"kind": "response", "query-id": "14", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [3, 15], "end": [3, 15], "fname": ""}]}], "status": "success"} -{"kind": "response", "query-id": "15", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [3, 15], "end": [3, 15], "fname": ""}]}], "status": "success"} -{"kind": "response", "query-id": "16", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [3, 15], "end": [3, 15], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "12", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [3, 14], "end": [3, 14], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "13", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [4, 0], "end": [4, 0], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "14", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [3, 15], "end": [3, 15], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "15", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [3, 15], "end": [3, 15], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "16", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [3, 15], "end": [3, 15], "fname": ""}]}], "status": "success"} {"kind": "response", "query-id": "17", "response": [], "status": "success"} -{"kind": "response", "query-id": "18", "response": [{"level": "error", "message": " - Subtyping check failed; expected type a: nat{a > 2}; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 24], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "18", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type a: nat{a > 2} got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 24], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "19", "response": [], "status": "success"} {"kind": "response", "query-id": "20", "response": [], "status": "success"} -{"kind": "response", "query-id": "21", "response": [{"level": "error", "message": " - Subtyping check failed; expected type a: nat{a > 1}; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 24], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "21", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type a: nat{a > 1} got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 24], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "22", "response": [], "status": "success"} {"kind": "response", "query-id": "23", "response": [], "status": "success"} {"kind": "response", "query-id": "24", "response": null, "status": "success"} {"kind": "response", "query-id": "25", "response": [], "status": "success"} -{"kind": "response", "query-id": "26", "response": [{"level": "error", "message": " - Subtyping check failed; expected type a: nat{a > 0}; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 25], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "26", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type a: nat{a > 0} got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 25], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "27", "response": [], "status": "success"} {"kind": "response", "query-id": "28", "response": [], "status": "success"} {"kind": "response", "query-id": "29", "response": [], "status": "success"} {"kind": "response", "query-id": "30", "response": [], "status": "success"} -{"kind": "response", "query-id": "31", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [5, 5], "end": [5, 5], "fname": ""}]}], "status": "success"} -{"kind": "response", "query-id": "32", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [5, 8], "end": [5, 8], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "31", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [5, 5], "end": [5, 5], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "32", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [5, 8], "end": [5, 8], "fname": ""}]}], "status": "success"} {"kind": "response", "query-id": "33", "response": [], "status": "success"} {"kind": "response", "query-id": "34", "response": [], "status": "success"} -{"kind": "response", "query-id": "35", "response": [{"level": "error", "message": " - Identifier not found: [b]\n", "number": 72, "ranges": [{"beg": [5, 7], "end": [5, 8], "fname": ""}]}], "status": "success"} -{"kind": "response", "query-id": "36", "response": [{"level": "error", "message": " - Identifier not found: [b]\n", "number": 72, "ranges": [{"beg": [5, 7], "end": [5, 8], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "35", "response": [{"level": "error", "message": "- Identifier not found: [b]\n", "number": 72, "ranges": [{"beg": [5, 7], "end": [5, 8], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "36", "response": [{"level": "error", "message": "- Identifier not found: [b]\n", "number": 72, "ranges": [{"beg": [5, 7], "end": [5, 8], "fname": ""}]}], "status": "success"} {"kind": "response", "query-id": "37", "response": [[3, "Prims", "nat"], [0, "", "nat"]], "status": "success"} {"kind": "response", "query-id": "38", "response": [], "status": "success"} -{"kind": "response", "query-id": "39", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [5, 15], "end": [5, 15], "fname": ""}]}], "status": "success"} -{"kind": "response", "query-id": "40", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [5, 19], "end": [5, 19], "fname": ""}]}], "status": "success"} -{"kind": "response", "query-id": "41", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [5, 26], "end": [5, 26], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "39", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [5, 15], "end": [5, 15], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "40", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [5, 19], "end": [5, 19], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "41", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [5, 26], "end": [5, 26], "fname": ""}]}], "status": "success"} {"kind": "response", "query-id": "42", "response": [], "status": "success"} {"kind": "response", "query-id": "43", "response": [], "status": "success"} {"kind": "response", "query-id": "44", "response": [], "status": "success"} -{"kind": "response", "query-id": "45", "response": [{"level": "error", "message": " - Subtyping check failed; expected type b: nat{b > 1}; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (5,13-5,18)\n", "number": 19, "ranges": [{"beg": [5, 22], "end": [5, 31], "fname": ""}, {"beg": [5, 13], "end": [5, 18], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "45", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type b: nat{b > 1} got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also (5,13-5,18)\n", "number": 19, "ranges": [{"beg": [5, 22], "end": [5, 31], "fname": ""}, {"beg": [5, 13], "end": [5, 18], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "46", "response": [], "status": "success"} {"kind": "response", "query-id": "47", "response": [], "status": "success"} {"kind": "response", "query-id": "48", "response": [], "status": "success"} @@ -53,7 +53,7 @@ {"kind": "response", "query-id": "52", "response": [], "status": "success"} {"kind": "response", "query-id": "53", "response": null, "status": "success"} {"kind": "response", "query-id": "54", "response": [], "status": "success"} -{"kind": "response", "query-id": "55", "response": [{"level": "error", "message": " - Subtyping check failed; expected type b: nat{b > 1}; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (5,13-5,18)\n", "number": 19, "ranges": [{"beg": [5, 22], "end": [5, 31], "fname": ""}, {"beg": [5, 13], "end": [5, 18], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "55", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type b: nat{b > 1} got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also (5,13-5,18)\n", "number": 19, "ranges": [{"beg": [5, 22], "end": [5, 31], "fname": ""}, {"beg": [5, 13], "end": [5, 18], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "56", "response": null, "status": "success"} {"kind": "response", "query-id": "57", "response": [], "status": "success"} {"kind": "response", "query-id": "58", "response": [], "status": "success"} @@ -61,12 +61,12 @@ {"kind": "response", "query-id": "60", "response": null, "status": "success"} {"kind": "response", "query-id": "61", "response": null, "status": "success"} {"kind": "response", "query-id": "62", "response": [], "status": "success"} -{"kind": "response", "query-id": "63", "response": [{"level": "error", "message": " - Subtyping check failed; expected type a: nat{a > 0}; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 25], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "63", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type a: nat{a > 0} got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 25], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "64", "response": [], "status": "success"} -{"kind": "response", "query-id": "65", "response": [{"level": "error", "message": " - Subtyping check failed; expected type a: nat{a > 0}; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 24], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "65", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type a: nat{a > 0} got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also (3,14-3,19)\n", "number": 19, "ranges": [{"beg": [3, 23], "end": [3, 24], "fname": ""}, {"beg": [3, 14], "end": [3, 19], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "66", "response": [], "status": "success"} {"kind": "response", "query-id": "67", "response": [], "status": "success"} -{"kind": "response", "query-id": "68", "response": [{"level": "error", "message": " - Subtyping check failed; expected type b: nat{b > 1}; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (5,13-5,18)\n", "number": 19, "ranges": [{"beg": [5, 22], "end": [5, 31], "fname": ""}, {"beg": [5, 13], "end": [5, 18], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "68", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type b: nat{b > 1} got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also (5,13-5,18)\n", "number": 19, "ranges": [{"beg": [5, 22], "end": [5, 31], "fname": ""}, {"beg": [5, 13], "end": [5, 18], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "69", "response": null, "status": "success"} {"kind": "response", "query-id": "70", "response": [], "status": "success"} {"kind": "response", "query-id": "71", "response": [], "status": "success"} diff --git a/tests/ide/emacs/fstarmode_gh73.out.expected b/tests/ide/emacs/fstarmode_gh73.out.expected index 963edbeb8aa..b8a03924c64 100644 --- a/tests/ide/emacs/fstarmode_gh73.out.expected +++ b/tests/ide/emacs/fstarmode_gh73.out.expected @@ -1,7 +1,7 @@ {"kind": "protocol-info", "rest": "[...]"} -{"kind": "response", "query-id": "1", "response": [{"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(150,0-150,48)\n", "number": 288, "ranges": [{"beg": [135, 17], "end": [135, 24], "fname": "FStar.Reflection.V2.Formula.fst"}, {"beg": [150, 0], "end": [150, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(150,0-150,48)\n", "number": 288, "ranges": [{"beg": [136, 22], "end": [136, 29], "fname": "FStar.Reflection.V2.Formula.fst"}, {"beg": [150, 0], "end": [150, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - Adding an implicit 'assume new' qualifier on document\n", "number": 239, "ranges": [{"beg": [36, 5], "end": [36, 13], "fname": "FStar.Stubs.Pprint.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(150,0-150,48)\n", "number": 288, "ranges": [{"beg": [624, 15], "end": [624, 22], "fname": "FStar.Tactics.V2.Derived.fst"}, {"beg": [150, 0], "end": [150, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n - Use FStar.Reflection.V2.TermEq.term_eq\n - See also FStar.Stubs.Reflection.V2.Builtins.fsti(150,0-150,48)\n", "number": 288, "ranges": [{"beg": [176, 11], "end": [176, 18], "fname": "FStar.Tactics.V2.Logic.fst"}, {"beg": [150, 0], "end": [150, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": " - Pattern uses these theory symbols or terms that should not be in an smt pattern: Prims.op_Subtraction\n", "number": 271, "ranges": [{"beg": [434, 8], "end": [434, 51], "fname": "FStar.UInt.fsti"}]}], "status": "success"} -{"kind": "response", "query-id": "2", "response": [{"level": "error", "message": " - Expected expression of type int got expression \"A\" of type string\n", "number": 189, "ranges": [{"beg": [4, 48], "end": [4, 51], "fname": ""}]}], "status": "success"} -{"kind": "response", "query-id": "3", "response": [{"level": "error", "message": " - Expected expression of type int got expression \"A\" of type string\n", "number": 189, "ranges": [{"beg": [4, 48], "end": [4, 51], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "1", "response": [{"level": "warning", "message": "- FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n- Use FStar.Reflection.V2.TermEq.term_eq\n- See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [135, 17], "end": [135, 24], "fname": "FStar.Reflection.V2.Formula.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": "- FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n- Use FStar.Reflection.V2.TermEq.term_eq\n- See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [136, 22], "end": [136, 29], "fname": "FStar.Reflection.V2.Formula.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": "- Adding an implicit 'assume new' qualifier on document\n", "number": 239, "ranges": [{"beg": [36, 5], "end": [36, 13], "fname": "FStar.Stubs.Pprint.fsti"}]}, {"level": "warning", "message": "- FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n- Use FStar.Reflection.V2.TermEq.term_eq\n- See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [623, 15], "end": [623, 22], "fname": "FStar.Tactics.V2.Derived.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": "- FStar.Stubs.Reflection.V2.Builtins.term_eq is deprecated\n- Use FStar.Reflection.V2.TermEq.term_eq\n- See also FStar.Stubs.Reflection.V2.Builtins.fsti(167,0-167,48)\n", "number": 288, "ranges": [{"beg": [176, 11], "end": [176, 18], "fname": "FStar.Tactics.V2.Logic.fst"}, {"beg": [167, 0], "end": [167, 48], "fname": "FStar.Stubs.Reflection.V2.Builtins.fsti"}]}, {"level": "warning", "message": "- Pattern uses these theory symbols or terms that should not be in an SMT\n pattern:\n Prims.op_Subtraction\n", "number": 271, "ranges": [{"beg": [434, 8], "end": [434, 51], "fname": "FStar.UInt.fsti"}]}], "status": "success"} +{"kind": "response", "query-id": "2", "response": [{"level": "error", "message": "- Expected expression of type int got expression \"A\" of type string\n", "number": 189, "ranges": [{"beg": [4, 48], "end": [4, 51], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "3", "response": [{"level": "error", "message": "- Expected expression of type int got expression \"A\" of type string\n", "number": 189, "ranges": [{"beg": [4, 48], "end": [4, 51], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "4", "response": [], "status": "success"} {"contents": {"depth": 1, "goals": [{"goal": {"label": "", "type": "bool", "witness": "(*?u[...]*) _"}, "hyps": []}], "label": "at the time of failure", "location": {"beg": [109, 12], "end": [109, 16], "fname": "FStar.Tactics.V2.Derived.fst"}, "smt-goals": [], "urgency": 1}, "kind": "message", "level": "proof-state", "query-id": "5"} -{"kind": "response", "query-id": "5", "response": [{"level": "error", "message": " - Tactic failed\n - exact failed\n - 1 : int does not exactly solve the goal bool (witness = (*?u[...]*) _)\n - See also FStar.Tactics.V2.Derived.fst(109,12-109,16)\n", "number": 228, "ranges": [{"beg": [4, 14], "end": [4, 29], "fname": ""}, {"beg": [109, 12], "end": [109, 16], "fname": "FStar.Tactics.V2.Derived.fst"}]}], "status": "failure"} +{"kind": "response", "query-id": "5", "response": [{"level": "error", "message": "- Tactic failed\n- exact failed\n- 1 : int does not exactly solve the goal bool (witness = (*?u[...]*) _)\n- See also FStar.Tactics.V2.Derived.fst(109,12-109,16)\n", "number": 228, "ranges": [{"beg": [4, 14], "end": [4, 29], "fname": ""}, {"beg": [109, 12], "end": [109, 16], "fname": "FStar.Tactics.V2.Derived.fst"}]}], "status": "failure"} diff --git a/tests/ide/emacs/integration.push-pop.out.expected b/tests/ide/emacs/integration.push-pop.out.expected index 0e073ecfc6b..0cdb5d1f56d 100644 --- a/tests/ide/emacs/integration.push-pop.out.expected +++ b/tests/ide/emacs/integration.push-pop.out.expected @@ -76,40 +76,40 @@ {"kind": "response", "query-id": "75", "response": [], "status": "success"} {"kind": "response", "query-id": "79", "response": [], "status": "success"} {"kind": "response", "query-id": "80", "response": [], "status": "success"} -{"kind": "response", "query-id": "91", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [12, 0], "end": [12, 0], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "91", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [12, 0], "end": [12, 0], "fname": ""}]}], "status": "success"} {"kind": "response", "query-id": "98", "response": [], "status": "success"} -{"kind": "response", "query-id": "101", "response": [{"level": "error", "message": " - Subtyping check failed; expected type nat; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also prims.fst(659,18-659,24)\n", "number": 19, "ranges": [{"beg": [11, 15], "end": [11, 17], "fname": ""}, {"beg": [659, 18], "end": [659, 24], "fname": "prims.fst"}]}], "status": "failure"} +{"kind": "response", "query-id": "101", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type nat got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also prims.fst(659,18-659,24)\n", "number": 19, "ranges": [{"beg": [11, 15], "end": [11, 17], "fname": ""}, {"beg": [659, 18], "end": [659, 24], "fname": "prims.fst"}]}], "status": "failure"} {"kind": "response", "query-id": "107", "response": [], "status": "success"} {"kind": "response", "query-id": "108", "response": [], "status": "success"} {"kind": "response", "query-id": "112", "response": null, "status": "success"} {"kind": "response", "query-id": "114", "response": [], "status": "success"} -{"kind": "response", "query-id": "116", "response": [{"level": "error", "message": " - Subtyping check failed; expected type nat; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also prims.fst(659,18-659,24)\n", "number": 19, "ranges": [{"beg": [11, 15], "end": [11, 17], "fname": ""}, {"beg": [659, 18], "end": [659, 24], "fname": "prims.fst"}]}], "status": "failure"} +{"kind": "response", "query-id": "116", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type nat got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also prims.fst(659,18-659,24)\n", "number": 19, "ranges": [{"beg": [11, 15], "end": [11, 17], "fname": ""}, {"beg": [659, 18], "end": [659, 24], "fname": "prims.fst"}]}], "status": "failure"} {"kind": "response", "query-id": "118", "response": [], "status": "success"} {"kind": "response", "query-id": "119", "response": [], "status": "success"} {"kind": "response", "query-id": "122", "response": null, "status": "success"} {"kind": "response", "query-id": "124", "response": [], "status": "success"} -{"kind": "response", "query-id": "126", "response": [{"level": "error", "message": " - Subtyping check failed; expected type nat; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also prims.fst(659,18-659,24)\n", "number": 19, "ranges": [{"beg": [11, 15], "end": [11, 17], "fname": ""}, {"beg": [659, 18], "end": [659, 24], "fname": "prims.fst"}]}], "status": "failure"} +{"kind": "response", "query-id": "126", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type nat got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also prims.fst(659,18-659,24)\n", "number": 19, "ranges": [{"beg": [11, 15], "end": [11, 17], "fname": ""}, {"beg": [659, 18], "end": [659, 24], "fname": "prims.fst"}]}], "status": "failure"} {"kind": "response", "query-id": "128", "response": [], "status": "success"} {"kind": "response", "query-id": "130", "response": [], "status": "success"} {"kind": "response", "query-id": "133", "response": [], "status": "success"} -{"kind": "response", "query-id": "137", "response": [{"level": "error", "message": " - Syntax error\n", "number": 168, "ranges": [{"beg": [13, 4], "end": [13, 4], "fname": ""}]}], "status": "success"} -{"kind": "response", "query-id": "159", "response": [{"level": "error", "message": " - Expected expression of type Type0 got expression xx of type nat\n", "number": 189, "ranges": [{"beg": [13, 15], "end": [13, 20], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "137", "response": [{"level": "error", "message": "- Syntax error\n", "number": 168, "ranges": [{"beg": [13, 4], "end": [13, 4], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "159", "response": [{"level": "error", "message": "- Expected expression of type Type0 got expression xx of type nat\n", "number": 189, "ranges": [{"beg": [13, 15], "end": [13, 20], "fname": ""}]}], "status": "success"} {"kind": "response", "query-id": "163", "response": [], "status": "success"} {"kind": "response", "query-id": "164", "response": [], "status": "success"} -{"kind": "response", "query-id": "165", "response": [{"level": "error", "message": " - Assertion failed\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (13,15-13,23)\n", "number": 19, "ranges": [{"beg": [13, 8], "end": [13, 14], "fname": ""}, {"beg": [13, 15], "end": [13, 23], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "165", "response": [{"level": "error", "message": "- Assertion failed\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also (13,15-13,23)\n", "number": 19, "ranges": [{"beg": [13, 8], "end": [13, 14], "fname": ""}, {"beg": [13, 15], "end": [13, 23], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "170", "response": [], "status": "success"} -{"kind": "response", "query-id": "175", "response": [{"level": "error", "message": " - Unexpected numeric literal. Restart F* to load FStar.UInt8.\n", "number": 201, "ranges": [{"beg": [13, 22], "end": [13, 24], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "175", "response": [{"level": "error", "message": "- Unexpected numeric literal. Restart F* to load FStar.UInt8.\n", "number": 201, "ranges": [{"beg": [13, 22], "end": [13, 24], "fname": ""}]}], "status": "success"} {"kind": "response", "query-id": "179", "response": [], "status": "success"} -{"kind": "response", "query-id": "180", "response": [{"level": "error", "message": " - Assertion failed\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (13,15-13,24)\n", "number": 19, "ranges": [{"beg": [13, 8], "end": [13, 14], "fname": ""}, {"beg": [13, 15], "end": [13, 24], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "180", "response": [{"level": "error", "message": "- Assertion failed\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also (13,15-13,24)\n", "number": 19, "ranges": [{"beg": [13, 8], "end": [13, 14], "fname": ""}, {"beg": [13, 15], "end": [13, 24], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "185", "response": [], "status": "success"} {"kind": "response", "query-id": "186", "response": [], "status": "success"} {"kind": "response", "query-id": "191", "response": null, "status": "success"} {"kind": "response", "query-id": "192", "response": null, "status": "success"} {"kind": "response", "query-id": "194", "response": [], "status": "success"} -{"kind": "response", "query-id": "198", "response": [{"level": "error", "message": " - Subtyping check failed; expected type nat; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also prims.fst(659,18-659,24)\n", "number": 19, "ranges": [{"beg": [11, 15], "end": [11, 17], "fname": ""}, {"beg": [659, 18], "end": [659, 24], "fname": "prims.fst"}]}], "status": "failure"} +{"kind": "response", "query-id": "198", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type nat got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also prims.fst(659,18-659,24)\n", "number": 19, "ranges": [{"beg": [11, 15], "end": [11, 17], "fname": ""}, {"beg": [659, 18], "end": [659, 24], "fname": "prims.fst"}]}], "status": "failure"} {"kind": "response", "query-id": "200", "response": [], "status": "success"} {"kind": "response", "query-id": "204", "response": [], "status": "success"} -{"kind": "response", "query-id": "205", "response": [{"level": "error", "message": " - Assertion failed\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also (13,15-13,23)\n", "number": 19, "ranges": [{"beg": [13, 8], "end": [13, 14], "fname": ""}, {"beg": [13, 15], "end": [13, 23], "fname": ""}]}], "status": "failure"} +{"kind": "response", "query-id": "205", "response": [{"level": "error", "message": "- Assertion failed\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also (13,15-13,23)\n", "number": 19, "ranges": [{"beg": [13, 8], "end": [13, 14], "fname": ""}, {"beg": [13, 15], "end": [13, 23], "fname": ""}]}], "status": "failure"} {"kind": "response", "query-id": "211", "response": [], "status": "success"} {"kind": "response", "query-id": "213", "response": [], "status": "success"} {"kind": "response", "query-id": "214", "response": [], "status": "success"} diff --git a/tests/ide/emacs/number.interface-violation-and-fix.out.expected b/tests/ide/emacs/number.interface-violation-and-fix.out.expected index 939ccd8db80..e2823b698d2 100644 --- a/tests/ide/emacs/number.interface-violation-and-fix.out.expected +++ b/tests/ide/emacs/number.interface-violation-and-fix.out.expected @@ -1,7 +1,7 @@ {"kind": "protocol-info", "rest": "[...]"} {"kind": "response", "query-id": "1", "response": null, "status": "success"} {"kind": "response", "query-id": "2", "response": [], "status": "success"} -{"kind": "response", "query-id": "3", "response": [{"level": "error", "message": " - Subtyping check failed; expected type a: int{a > 0}; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also number.fsti(18,14-18,19)\n", "number": 19, "ranges": [{"beg": [3, 8], "end": [3, 10], "fname": ""}, {"beg": [18, 14], "end": [18, 19], "fname": "number.fsti"}]}], "status": "failure"} +{"kind": "response", "query-id": "3", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type a: int{a > 0} got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also number.fsti(18,14-18,19)\n", "number": 19, "ranges": [{"beg": [3, 8], "end": [3, 10], "fname": ""}, {"beg": [18, 14], "end": [18, 19], "fname": "number.fsti"}]}], "status": "failure"} {"kind": "response", "query-id": "4", "response": null, "status": "success"} {"kind": "response", "query-id": "5", "response": null, "status": "success"} {"kind": "response", "query-id": "6", "response": [], "status": "success"} diff --git a/tests/ide/emacs/number.interface-violation.out.expected b/tests/ide/emacs/number.interface-violation.out.expected index 69bdd3bd2c8..59c46faba85 100644 --- a/tests/ide/emacs/number.interface-violation.out.expected +++ b/tests/ide/emacs/number.interface-violation.out.expected @@ -1,4 +1,4 @@ {"kind": "protocol-info", "rest": "[...]"} {"kind": "response", "query-id": "1", "response": null, "status": "success"} {"kind": "response", "query-id": "2", "response": [], "status": "success"} -{"kind": "response", "query-id": "3", "response": [{"level": "error", "message": " - Subtyping check failed; expected type a: int{a > 0}; got type int\n - The SMT solver could not prove the query. Use --query_stats for more\n details.\n - See also number.fsti(18,14-18,19)\n", "number": 19, "ranges": [{"beg": [3, 8], "end": [3, 10], "fname": ""}, {"beg": [18, 14], "end": [18, 19], "fname": "number.fsti"}]}], "status": "failure"} +{"kind": "response", "query-id": "3", "response": [{"level": "error", "message": "- Subtyping check failed\n- Expected type a: int{a > 0} got type int\n- The SMT solver could not prove the query. Use --query_stats for more details.\n- See also number.fsti(18,14-18,19)\n", "number": 19, "ranges": [{"beg": [3, 8], "end": [3, 10], "fname": ""}, {"beg": [18, 14], "end": [18, 19], "fname": "number.fsti"}]}], "status": "failure"} diff --git a/tests/ide/emacs/tutorial.push.out.expected b/tests/ide/emacs/tutorial.push.out.expected index 871ca3e45b9..600019d8b92 100644 --- a/tests/ide/emacs/tutorial.push.out.expected +++ b/tests/ide/emacs/tutorial.push.out.expected @@ -1,5 +1,5 @@ {"kind": "protocol-info", "rest": "[...]"} -{"kind": "response", "query-id": "1", "response": [{"level": "warning", "message": " - Pattern uses these theory symbols or terms that should not be in an smt pattern: Prims.op_Subtraction\n", "number": 271, "ranges": [{"beg": [434, 8], "end": [434, 51], "fname": "FStar.UInt.fsti"}]}], "status": "success"} +{"kind": "response", "query-id": "1", "response": [{"level": "warning", "message": "- Pattern uses these theory symbols or terms that should not be in an SMT\n pattern:\n Prims.op_Subtraction\n", "number": 271, "ranges": [{"beg": [434, 8], "end": [434, 51], "fname": "FStar.UInt.fsti"}]}], "status": "success"} {"kind": "response", "query-id": "2", "response": [], "status": "success"} {"kind": "response", "query-id": "3", "response": [], "status": "success"} {"kind": "response", "query-id": "4", "response": [], "status": "success"} @@ -9,7 +9,7 @@ {"kind": "response", "query-id": "8", "response": [], "status": "success"} {"kind": "response", "query-id": "9", "response": [], "status": "success"} {"kind": "response", "query-id": "10", "response": [], "status": "success"} -{"kind": "response", "query-id": "11", "response": [{"level": "warning", "message": " - Top-level let-bindings must be total; this term may have effects\n", "number": 272, "ranges": [{"beg": [60, 0], "end": [60, 48], "fname": ""}]}], "status": "success"} +{"kind": "response", "query-id": "11", "response": [{"level": "warning", "message": "- Top-level let-bindings must be total; this term may have effects\n", "number": 272, "ranges": [{"beg": [60, 0], "end": [60, 48], "fname": ""}]}], "status": "success"} {"kind": "response", "query-id": "a1", "response": null, "status": "success"} {"kind": "response", "query-id": "a2", "response": null, "status": "success"} {"kind": "response", "query-id": "a3", "response": null, "status": "success"} diff --git a/tests/micro-benchmarks/CoreEqualityGuard.fst b/tests/micro-benchmarks/CoreEqualityGuard.fst index 5b4cd5bb0f8..fc8a5b8e2f6 100644 --- a/tests/micro-benchmarks/CoreEqualityGuard.fst +++ b/tests/micro-benchmarks/CoreEqualityGuard.fst @@ -11,14 +11,14 @@ val r_b (x:a) (y z:b x) : Type0 let dsnd #a (#b: a -> Type) (x: dtuple2 a b) : b (dfst x) = dsnd x -// #push-options "--debug CoreEqualityGuard --debug_level SMTQuery,Rel" +// #push-options "--debug SMTQuery,Rel" // let test (t1 t2 : dtuple2 a b) // (p: squash (dfst t1 == dfst t2)) // : b (dfst t1) // = dsnd t2 -#push-options "--debug CoreEqualityGuard --debug_level Core" +#push-options "--debug Core" let test (t1 t2 : dtuple2 a b) (p: (dfst t1 == dfst t2 /\ diff --git a/tests/micro-benchmarks/CoreGeneralization.fst b/tests/micro-benchmarks/CoreGeneralization.fst index 53a548158e4..f243f79e3bd 100644 --- a/tests/micro-benchmarks/CoreGeneralization.fst +++ b/tests/micro-benchmarks/CoreGeneralization.fst @@ -2,6 +2,6 @@ module CoreGeneralization let test (x:int) (#a:Type) (y:a) = y -#push-options "--debug CoreGeneralization --debug_level TwoPhases,Gen" +#push-options "--debug TwoPhases,Gen" let gen x = test x diff --git a/tests/micro-benchmarks/CoreUnivs.fst b/tests/micro-benchmarks/CoreUnivs.fst index b336eafeb4e..190af65d2c4 100644 --- a/tests/micro-benchmarks/CoreUnivs.fst +++ b/tests/micro-benchmarks/CoreUnivs.fst @@ -4,6 +4,6 @@ val embedding (a:Type u#a) : Type u#a val e_div_arrow (#a:Type u#a) (#b:Type u#b) (f:a -> Dv b) : embedding u#a (a -> Dv b) -(* #push-options "--debug CoreUnivs --debug_level Extreme,Rel,ExplainRel,Core" *) +(* #push-options "--debug Extreme,Rel,ExplainRel,Core" *) let e_div_arrow (#a:Type u#a) (#b:Type u#b) (f:a -> Dv b) = admit() diff --git a/tests/micro-benchmarks/DeltaDepthUnif.fst b/tests/micro-benchmarks/DeltaDepthUnif.fst new file mode 100644 index 00000000000..fd45b88c74a --- /dev/null +++ b/tests/micro-benchmarks/DeltaDepthUnif.fst @@ -0,0 +1,28 @@ +module DeltaDepthUnif + +(* Misc tests about unification, unfolding, etc *) + +open FStar.Reflection.V2 +open FStar.Reflection.Typing +open FStar.Mul + +assume val tyc : term -> Type0 + +let test (x : tyc bool_ty) + : tyc (binder_sort (mk_binder (Sealed.seal "x") bool_ty Q_Explicit)) + = x + +open FStar.Squash + +assume val p : Type0 + +val test1 : (~p) +let test1 = return_squash (magic ()) + +assume val f : p -> False +val test2 : (~p) +let test2 = return_squash f + +assume +val ty : int -> Type +let test3 (#n:nat) (x : ty 0) : ty (0 * n) = x diff --git a/tests/micro-benchmarks/NegativeTests.ZZImplicitFalse.fst.hints b/tests/micro-benchmarks/NegativeTests.ZZImplicitFalse.fst.hints deleted file mode 100644 index d3004c945c7..00000000000 --- a/tests/micro-benchmarks/NegativeTests.ZZImplicitFalse.fst.hints +++ /dev/null @@ -1 +0,0 @@ -[ "7i¨\u001cË\u0007\u0002Ë\nì*}éwC?", [] ] \ No newline at end of file diff --git a/tests/micro-benchmarks/Test.NBE.fst b/tests/micro-benchmarks/Test.NBE.fst index ca8413b8aa2..19e0c131bb0 100644 --- a/tests/micro-benchmarks/Test.NBE.fst +++ b/tests/micro-benchmarks/Test.NBE.fst @@ -47,4 +47,4 @@ let test3 = assert (norm [primops; delta; zeta; nbe] (List.append [1;2;3;4;5;6;7] [8;9]) = [1;2;3;4;5;6;7;8;9]) -#set-options "--debug_level NBE --debug Test.NBE --max_fuel 0" +// #set-options "--debug NBE --max_fuel 0" diff --git a/tests/micro-benchmarks/Test.QuickCode.fst b/tests/micro-benchmarks/Test.QuickCode.fst index 6b2b8ecaa32..ae9f505ed7c 100644 --- a/tests/micro-benchmarks/Test.QuickCode.fst +++ b/tests/micro-benchmarks/Test.QuickCode.fst @@ -35,7 +35,7 @@ let sel (r:reg_file) (x:int) = r x let upd (r:reg_file) (x:int) (v:int) = fun y -> if x=y then v else sel r y -//#set-options "--debug_level print_normalized_terms --debug_level NBE" +//#set-options "--debug print_normalized_terms,NBE" // let test = // assert (norm_simple (if 0 = 0 then true else false) == true) @@ -50,8 +50,8 @@ let upd (r:reg_file) (x:int) (v:int) = fun y -> if x=y then v else sel r y //////////////////////////////////////////////////////////////////////////////// //#reset-options "--z3rlimit 10 --lax" -#set-options "--debug_level NBE" -//#set-options "--debug_level print_normalized_terms --debug_level NBE" +#set-options "--debug NBE" +//#set-options "--debug print_normalized_terms,NBE" noeq type state = { ok: bool; @@ -95,8 +95,8 @@ let wp_compute_ghash_incremental (x:int) (s0:state) (k:(state -> Type0)) : Type0 let sM = up_xmm 6 x (up_xmm 5 x (up_xmm 4 x sM)) in (k sM) -//#reset-options "--z3rlimit 10 --debug_level NBE --debug_level SMTQuery" -#reset-options "--z3rlimit 10 --admit_smt_queries true --debug_level SMTQuery" +//#reset-options "--z3rlimit 10 --debug NBE --debug SMTQuery" +#reset-options "--z3rlimit 10 --admit_smt_queries true --debug SMTQuery" let lemma_gcm_core (s0:state) (x:int) : Lemma True = let k s = diff --git a/tests/micro-benchmarks/TestQueue.fst b/tests/micro-benchmarks/TestQueue.fst new file mode 100644 index 00000000000..3a6306cea67 --- /dev/null +++ b/tests/micro-benchmarks/TestQueue.fst @@ -0,0 +1,26 @@ +module TestQueue + +module Q = FStar.Queue +open FStar.Queue +open FStar.Seq + +let my_queue = enqueue 3 (enqueue 2 (enqueue 1 Q.empty)) +let my_seq = Seq.cons 1 (Seq.cons 2 (Seq.cons 3 Seq.empty)) + +let _ = assert + (Q.equal my_queue (queue_of_seq my_seq)) +let _ = assert + (Q.equal (enqueue 4 my_queue) + (queue_of_seq (Seq.snoc my_seq 4))) +let _ = assert + (fst (dequeue my_queue) == 1) +let _ = assert + (Q.equal (snd (dequeue my_queue)) + (enqueue 3 (enqueue 2 Q.empty))) +let _ = assert + (Q.equal (snd (dequeue (enqueue 1 Q.empty))) + Q.empty) +let _ = assert + (peek my_queue == 1) +let _ = assert + (peek (snd (dequeue my_queue)) == 2) \ No newline at end of file diff --git a/tests/tactics/CheckEquiv.fst b/tests/tactics/CheckEquiv.fst index 38a378bf72e..59c727778ca 100644 --- a/tests/tactics/CheckEquiv.fst +++ b/tests/tactics/CheckEquiv.fst @@ -36,3 +36,30 @@ let _ = assert True by begin let _ = must <| check_equiv env (`1) (`(reveal u#0 #int (hide u#0 #int 1))) in () end + +[@@expect_failure] // this is fine, as nosmt implies nodelta +let _ = assert True by begin + let env = cur_env () in + let _ = must <| check_equiv_nosmt env (`1) (`(g 1)) in + () +end + +let _ = assert True by begin + let env = cur_env () in + let _ = must <| check_equiv_nosmt env (`1) (`1) in + () +end + +let _ = assert True by begin + let env = cur_env () in + let _ = must <| check_equiv_nosmt env (`(1+1)) (`(3-1)) in + () +end + +let _ = assert True by begin + let env = cur_env () in + let _ = must <| check_equiv_nosmt env (`1) (`(reveal #int (hide #int 1))) in + () +end + +#pop-options diff --git a/tests/tactics/Test.TypeRepr.fst b/tests/tactics/Test.TypeRepr.fst new file mode 100644 index 00000000000..bacceddd284 --- /dev/null +++ b/tests/tactics/Test.TypeRepr.fst @@ -0,0 +1,17 @@ +module Test.TypeRepr + +open FStar.Tactics.V2 +module TypeRepr = FStar.Tactics.TypeRepr + +type test1 (a:Type0) : Type u#123 = + | A of a + | B : bool -> int -> test1 a + | C : int -> string -> list bool -> test1 a + | D : int -> (int & bool) -> test1 a + +%splice[test1_repr; test1_down; test1_up] (TypeRepr.entry (`%test1)) + +let _ = assert (forall a (x:test1 a). test1_up (test1_down x) == x) + +[@@expect_failure] // fuel limitation +let _ = assert (forall a (x:test1_repr a). test1_down (test1_up x) == x) diff --git a/tests/tactics/WeakVsHNF.fst b/tests/tactics/WeakVsHNF.fst index e57e3bbe91a..4e51a31e073 100644 --- a/tests/tactics/WeakVsHNF.fst +++ b/tests/tactics/WeakVsHNF.fst @@ -114,3 +114,26 @@ let _ = assert True debug ("WHNF : " ^ term_to_string t); guard (term_eq t (`(fun () -> W (1 + 1)))) ) + +let b = unit +let _ = assert True + by (let t0 = `(b -> b) in + debug ""; + debug ("Term : " ^ term_to_string t0); + + let t = norm_term [delta] t0 in + debug ("Full : " ^ term_to_string t); + guard (term_eq t (`(unit -> unit))); + + let t = norm_term [delta; weak] t0 in + debug ("Weak : " ^ term_to_string t); + guard (term_eq t (`(b -> b))); + + let t = norm_term [delta; hnf] t0 in + debug ("HNF : " ^ term_to_string t); + guard (term_eq t (`(b -> unit))); + + let t = norm_term [delta; weak; hnf] t0 in + debug ("WHNF : " ^ term_to_string t); + guard (term_eq t (`(b -> b))) + ) \ No newline at end of file diff --git a/tests/typeclasses/Bug3130.fst b/tests/typeclasses/Bug3130.fst index b1680a3ca83..4489041616b 100644 --- a/tests/typeclasses/Bug3130.fst +++ b/tests/typeclasses/Bug3130.fst @@ -22,7 +22,7 @@ assume val truc: open FStar.Tactics.Typeclasses -#set-options "--debug_level Low" +//#set-options "--debug Low" noeq type machin (a:Type) (d : typeclass2 bytes #solve a) (content:a) = { diff --git a/tests/typeclasses/Fundeps.fst b/tests/typeclasses/Fundeps.fst new file mode 100644 index 00000000000..64386b2867b --- /dev/null +++ b/tests/typeclasses/Fundeps.fst @@ -0,0 +1,17 @@ +module Fundeps + +[@@Tactics.Typeclasses.fundeps [0]] +class setlike (e:Type) (s:Type) = { + empty : s; + add : e -> s -> s; + remove : e -> s -> s; + contains : e -> s -> bool; + size : s -> int; +} + +assume val set (a:Type) : Type + +assume +instance val setlike_set (a:Type) : setlike a (set a) + +let test (s : set int) = size s diff --git a/tests/typeclasses/Unit.fst b/tests/typeclasses/Unit.fst new file mode 100644 index 00000000000..8d3ec68915e --- /dev/null +++ b/tests/typeclasses/Unit.fst @@ -0,0 +1,7 @@ +module Unit + +class c (t:Type) = { dummy:unit } + +instance c_int () : c int = { dummy=() } + +let _ : c int = Tactics.Typeclasses.solve diff --git a/tests/vale/X64.Vale.StrongPost_i.fsti b/tests/vale/X64.Vale.StrongPost_i.fsti index 30ad39194b3..70033dea52c 100644 --- a/tests/vale/X64.Vale.StrongPost_i.fsti +++ b/tests/vale/X64.Vale.StrongPost_i.fsti @@ -224,7 +224,7 @@ let va_lemma_weakest_pre_norm_wp (inss:list ins) (s0:state) (sN:state) : pure_wp [@"uninterpreted_by_smt"] val va_lemma_weakest_pre_norm (inss:list ins) (s0:state) (sN:state) : PURE unit (va_lemma_weakest_pre_norm_wp inss s0 sN) -(* #reset-options "--log_queries --debug X64.Vale.StrongPost_i --debug_level print_normalized_terms" *) +(* #reset-options "--log_queries --debug X64.Vale.StrongPost_i --debug print_normalized_terms" *) // let test_lemma (s0:state) (sN:state) = // assume (s0.ok); // // assume (Map.contains s0.mem (s0.regs Rsi)); diff --git a/ulib/FStar.Pervasives.fsti b/ulib/FStar.Pervasives.fsti index 2bdfbf22060..4d7c7101abb 100644 --- a/ulib/FStar.Pervasives.fsti +++ b/ulib/FStar.Pervasives.fsti @@ -167,7 +167,7 @@ val simplify : norm_step (** Weak reduction: Do not reduce under binders *) val weak : norm_step -(** Head normal form *) +(** Head normal form: Do not reduce in function arguments or in binder types *) val hnf : norm_step (** Reduce primitive operators, e.g., [1 + 1 ~> 2] *) diff --git a/ulib/FStar.PtrdiffT.fst b/ulib/FStar.PtrdiffT.fst index 46252ed167c..e589a04bb3a 100644 --- a/ulib/FStar.PtrdiffT.fst +++ b/ulib/FStar.PtrdiffT.fst @@ -41,7 +41,7 @@ let mk x = int_to_t (I16.v x) let ptrdifft_to_sizet x = bounds_lemma (); - Cast.int64_to_uint64 x + SizeT.Sz <| Cast.int64_to_uint64 x let add x y = I64.add x y diff --git a/ulib/FStar.Queue.fst b/ulib/FStar.Queue.fst new file mode 100644 index 00000000000..05aed5d0568 --- /dev/null +++ b/ulib/FStar.Queue.fst @@ -0,0 +1,179 @@ +(* + Copyright 2008-2024 Microsoft Research + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + Author: Megan Frisella +*) +module FStar.Queue + +module L = FStar.List.Tot +open FStar.List.Tot +open FStar.Seq + +(* Functional queues in the style of Okasaki. + +Enqueue and dequeue are amortized constant time operations. The queue is +represented by a pair of lists, the first one being the "front" of the +queue, where elements are popped, and the second being the "back", where +elements are pushed. The lists are in opposite order, so that popping +from the front and pushing to the back is O(1). When we need to dequeue +and the front is empty, we reverse the back of the list into the front +(see dequeue). + +The lemmas exposed in the interface guarantee to clients of this module +that we in fact model a queue, by relating the operations to a Sequence. *) + +type queue a = p:(list a & list a){L.isEmpty (fst p) ==> L.isEmpty (snd p)} + +let empty #a = [], [] + +val queue_to_list (#a:Type) (q:queue a) : list a +let queue_to_list #a q + = match (fst q) with + | [] -> [] + | _ -> (fst q) @ (L.rev (snd q)) + +val queue_of_list (#a:Type) (l:list a) : queue a +let queue_of_list #a l + = match l with + | [] -> empty + | _ -> l, [] + +let queue_to_seq #a q + = seq_of_list (queue_to_list q) + +let queue_of_seq #a s + = queue_of_list (seq_to_list s) + +let equal #a q1 q2 = queue_to_seq q1 == queue_to_seq q2 + +let lemma_eq_intro #_ q1 q2 = () + +let lemma_eq_elim #_ q1 q2 = () + +let lemma_list_queue_bij (#a:Type) (l:list a) + : Lemma (queue_to_list (queue_of_list l) == l) + = match l with + | [] -> () + | _ -> L.append_l_nil l + +let lemma_queue_list_bij (#a:Type) (q:queue a) + : Lemma (equal (queue_of_list (queue_to_list q)) q) + = match fst q with + | [] -> () + | l -> ( + L.append_l_nil (L.append l (L.rev (snd q))) + ) + +let lemma_seq_queue_bij (#a:Type) (s:seq a) + : Lemma (queue_to_seq (queue_of_seq s) == s) + = let l = (seq_to_list s) in + lemma_list_queue_bij l; + lemma_seq_list_bij s + +let lemma_queue_seq_bij (#a:Type) (q:queue a) + : Lemma (equal (queue_of_seq (queue_to_seq q)) q) + = let l = (queue_to_list q) in + lemma_queue_list_bij q; + lemma_list_seq_bij l + +let enqueue (#a:Type) (x:a) (q:queue a) + : queue a + = match fst q with + | [] -> [x], [] + | l -> l, x :: (snd q) + +let dequeue (#a:Type) (q:queue a{not_empty q}) + : a & queue a + = lemma_seq_of_list_induction (queue_to_list q); + let hd :: tl = fst q in + match tl with + | [] -> hd, (L.rev (snd q), []) + | _ -> hd, (tl, (snd q)) + +let peek (#a:Type) (q:queue a{not_empty q}) + : a + = lemma_seq_of_list_induction (queue_to_list q); + L.hd (fst q) + +let lemma_empty_ok (#a:Type) + : Lemma (queue_to_seq #a empty == Seq.empty) + = lemma_seq_list_bij #a Seq.empty + +let lemma_enqueue_ok_list (#a:Type) (x:a) (q:queue a) + : Lemma (queue_to_list (enqueue x q) == L.snoc ((queue_to_list q),x)) + = match fst q with + | [] -> () + | l -> ( + L.append_assoc l (L.rev (snd q)) [x]; + L.rev_append [x] (snd q) + ) + +let rec lemma_append_seq_of_list_dist (#a:Type) (l1 l2:list a) + : Lemma (ensures Seq.equal (seq_of_list (L.append l1 l2)) (Seq.append (seq_of_list l1) (seq_of_list l2))) + = match l1 with + | [] -> L.append_nil_l l2 + | hd :: tl -> + ( + lemma_seq_of_list_induction (hd :: (L.append tl l2)); + lemma_append_seq_of_list_dist tl l2; + Seq.append_cons hd (seq_of_list tl) (seq_of_list l2); + lemma_seq_of_list_induction (hd :: tl) + ) + +let lemma_snoc_list_seq (#a:Type) (x:a) (q:queue a) + : Lemma (seq_of_list (L.snoc ((queue_to_list q),x)) == Seq.snoc (queue_to_seq q) x) += + let l = queue_to_list q in + calc (==) { + seq_of_list (L.snoc (l, x)) <: seq a; + == { () } + seq_of_list (l @ [x]); + == { lemma_append_seq_of_list_dist l [x] } + seq_of_list l `Seq.append` seq_of_list [x]; + == { assert (Seq.equal (seq_of_list [x]) (Seq.create 1 x)) } + seq_of_list l `Seq.append` Seq.create 1 x; + == { admit() } + Seq.snoc (seq_of_list l) x; + } + +let lemma_enqueue_ok (#a:Type) (x:a) (q:queue a) + : Lemma (queue_to_seq (enqueue x q) == Seq.snoc (queue_to_seq q) x) + = lemma_enqueue_ok_list x q; + lemma_snoc_list_seq x q + +let lemma_dequeue_ok_list (#a:Type) (q:queue a{not_empty q}) + : Lemma (fst (dequeue q) :: queue_to_list (snd (dequeue q)) == queue_to_list q) + = lemma_seq_of_list_induction (queue_to_list q); + let hd :: tl = fst q in + match tl with + | [] -> L.append_l_nil (L.rev (snd q)) + | _ -> L.append_assoc [hd] tl (L.rev (snd q)) + +let lemma_cons_list_seq (#a:Type) (x:a) (q:queue a) + : Lemma (seq_of_list (x :: (queue_to_list q)) == Seq.cons x (queue_to_seq q)) += let l = (queue_to_list q) in + lemma_append_seq_of_list_dist [x] l; + lemma_seq_list_bij (Seq.create 1 x) + +let lemma_dequeue_ok (#a:Type) (q:queue a{not_empty q}) + : Lemma (let hd, tl = dequeue q in + hd == Seq.head (queue_to_seq q) /\ + equal tl (queue_of_seq (Seq.tail (queue_to_seq q)))) + = lemma_dequeue_ok_list q; + lemma_cons_list_seq (fst (dequeue q)) (snd (dequeue q)) + +let lemma_peek_ok (#a:Type) (q:queue a{not_empty q}) + : Lemma (peek q == Seq.head (queue_to_seq q)) + = lemma_dequeue_ok_list q diff --git a/ulib/FStar.Queue.fsti b/ulib/FStar.Queue.fsti new file mode 100644 index 00000000000..5962196e8fa --- /dev/null +++ b/ulib/FStar.Queue.fsti @@ -0,0 +1,76 @@ +(* + Copyright 2008-2024 Microsoft Research + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + Author: Megan Frisella +*) +module FStar.Queue + +open FStar.Seq + +val queue (a:Type u#a) : Type u#a + +val empty (#a:Type) : queue a + +val queue_to_seq (#a:Type) (q:queue a) : seq a + +val queue_of_seq (#a:Type) (s:seq a) : queue a + +val equal (#a:Type) (q1 q2:queue a) : prop + +let not_empty (#a:Type) (q:queue a) : prop + = let s = queue_to_seq q in + ~(Seq.equal s Seq.empty) /\ length s > 0 + +val lemma_eq_intro: #a:Type -> q1:queue a -> q2:queue a -> Lemma + (requires Seq.equal (queue_to_seq q1) (queue_to_seq q2)) + (ensures (equal q1 q2)) + [SMTPat (equal q1 q2)] + +val lemma_eq_elim: #a:Type -> q1:queue a -> q2:queue a -> Lemma + (requires (equal q1 q2)) + (ensures queue_to_seq q1 == queue_to_seq q2) + [SMTPat (equal q1 q2)] + +val lemma_seq_queue_bij: #a:Type -> s:seq a -> Lemma + (queue_to_seq (queue_of_seq s) == s) + [SMTPat (queue_of_seq s)] + +val lemma_queue_seq_bij: #a:Type -> q:queue a -> Lemma + (equal (queue_of_seq (queue_to_seq q)) q) + [SMTPat (queue_to_seq q)] + +val enqueue (#a:Type) (x:a) (q:queue a) : queue a + +val dequeue (#a:Type) (q:queue a{not_empty q}) : a & queue a + +val peek (#a:Type) (q:queue a{not_empty q}) : a + +val lemma_empty_ok: #a:Type -> Lemma + (queue_to_seq #a empty == Seq.empty) + [SMTPat (empty #a)] + +val lemma_enqueue_ok: #a:Type -> x:a -> q:queue a -> Lemma + (queue_to_seq (enqueue x q) == Seq.snoc (queue_to_seq q) x) + [SMTPat (enqueue x q)] + +val lemma_dequeue_ok: #a:Type -> q:queue a{not_empty q} -> Lemma + (let hd, tl = dequeue q in + hd == Seq.head (queue_to_seq q) /\ + equal tl (queue_of_seq (Seq.tail (queue_to_seq q)))) + [SMTPat (dequeue q)] + +val lemma_peek_ok: #a:Type -> q:queue a{not_empty q} -> Lemma + (peek q == Seq.head (queue_to_seq q)) + [SMTPat (peek q)] diff --git a/ulib/FStar.Range.fsti b/ulib/FStar.Range.fsti index bf196888d89..c44506b68df 100644 --- a/ulib/FStar.Range.fsti +++ b/ulib/FStar.Range.fsti @@ -32,6 +32,8 @@ val range_0 : range (** Building a range constant *) val mk_range (file: string) (from_line from_col to_line to_col: int) : Tot range +val join_range (r1 r2 : range) : Tot range + (** [labeled] is used internally to the SMT encoding to associate a source-code location with an assertion. *) irreducible diff --git a/ulib/FStar.RefinementExtensionality.fst b/ulib/FStar.RefinementExtensionality.fst new file mode 100644 index 00000000000..6ac69db4317 --- /dev/null +++ b/ulib/FStar.RefinementExtensionality.fst @@ -0,0 +1,33 @@ +module FStar.RefinementExtensionality + +open FStar.FunctionalExtensionality +open FStar.PredicateExtensionality + +let refext0 (t:Type) (r1 : t -> prop) (r2 : t -> prop) : + Lemma (requires (r1 == r2)) + (ensures (x:t{r1 x} == x:t{r2 x})) = () + +let refext_on_domain (t:Type) (r1 : t -> prop) (r2 : t -> prop) : + Lemma (requires (forall x. r1 x <==> r2 x)) + (ensures (x:t{on t r1 x} == x:t{on t r2 x})) = + PredicateExtensionality.predicateExtensionality _ r1 r2; + refext0 t (on t r1) (on t r2) + +let refext (t:Type) (r1 : t -> prop) (r2 : t -> prop) : + Lemma (requires (forall x. r1 x <==> r2 x)) + (ensures (x:t{r1 x} == x:t{r2 x})) = + assert (x:t{on t r1 x} == x:t{r1 x}); + assert (x:t{on t r2 x} == x:t{r2 x}); + refext_on_domain t r1 r2; + () + +(* Small test. Use names to avoid hash-consing mismatches. *) +let ref1 (x:int) : prop = b2t (x >= 0) +let ref2 (x:int) : prop = x >= 0 \/ x >= 1 + +let ty1 = x:int{ref1 x} +let ty2 = x:int{ref2 x} + +let _ = + refext int ref1 ref2; + assert (ty1 == ty2) diff --git a/ulib/FStar.RefinementExtensionality.fsti b/ulib/FStar.RefinementExtensionality.fsti new file mode 100644 index 00000000000..5fb90dd1fee --- /dev/null +++ b/ulib/FStar.RefinementExtensionality.fsti @@ -0,0 +1,5 @@ +module FStar.RefinementExtensionality + +val refext (t:Type) (r1 : t -> prop) (r2 : t -> prop) : + Lemma (requires (forall x. r1 x <==> r2 x)) + (ensures (x:t{r1 x} == x:t{r2 x})) diff --git a/ulib/FStar.SizeT.fst b/ulib/FStar.SizeT.fst index da45639bb15..cdee6e367b4 100644 --- a/ulib/FStar.SizeT.fst +++ b/ulib/FStar.SizeT.fst @@ -10,7 +10,7 @@ module I64 = FStar.Int64 assume val bound : x:erased nat { x >= pow2 16 } -let t = x:U64.t { U64.v x < bound } +type t : eqtype = | Sz : (x:U64.t { U64.v x < bound }) -> t let fits x = FStar.UInt.fits x U64.n == true /\ @@ -19,11 +19,11 @@ let fits x = let fits_at_least_16 _ = () let v x = - U64.v x + U64.v (Sz?.x x) irreducible let uint_to_t x = - U64.uint_to_t x + Sz (U64.uint_to_t x) let size_v_inj (x: t) = () let size_uint_to_t_inj (x: nat) = () @@ -62,22 +62,23 @@ let of_u64 (x: U64.t) let uint16_to_sizet x = uint_to_t (U16.v x) let uint32_to_sizet x = uint_to_t (U32.v x) let uint64_to_sizet x = uint_to_t (U64.v x) -let sizet_to_uint32 x = FStar.Int.Cast.uint64_to_uint32 x +let sizet_to_uint32 x = FStar.Int.Cast.uint64_to_uint32 (Sz?.x x) let fits_lte x y = () #push-options "--z3rlimit 20" -let add x y = U64.add x y -let sub x y = U64.sub x y -let mul x y = U64.mul x y +let add x y = Sz <| U64.add x.x y.x +let sub x y = Sz <| U64.sub x.x y.x +let mul x y = Sz <| U64.mul x.x y.x let div x y = - let res = U64.div x y in - fits_lte (U64.v res) (U64.v x); - FStar.Math.Lib.slash_decr_axiom (U64.v x) (U64.v y); - assert (U64.v x / U64.v y <= U64.v x); + let res = Sz <| U64.div x.x y.x in + fits_lte (U64.v res.x) (U64.v x.x); + FStar.Math.Lib.slash_decr_axiom (U64.v x.x) (U64.v y.x); + assert (U64.v x.x / U64.v y.x <= U64.v x.x); res -let rem x y = U64.rem x y -let gt x y = U64.gt x y -let gte x y = U64.gte x y -let lt x y = U64.lt x y -let lte x y = U64.lte x y + +let rem x y = Sz <| U64.rem x.x y.x +let gt x y = U64.gt x.x y.x +let gte x y = U64.gte x.x y.x +let lt x y = U64.lt x.x y.x +let lte x y = U64.lte x.x y.x diff --git a/ulib/FStar.SizeT.fsti b/ulib/FStar.SizeT.fsti index 6dfb81a44b6..d54f57845ad 100644 --- a/ulib/FStar.SizeT.fsti +++ b/ulib/FStar.SizeT.fsti @@ -6,6 +6,7 @@ module U16 = FStar.UInt16 module U32 = FStar.UInt32 module U64 = FStar.UInt64 +new val t : eqtype val fits (x: nat) : Tot prop diff --git a/ulib/FStar.Stubs.Reflection.V2.Builtins.fsti b/ulib/FStar.Stubs.Reflection.V2.Builtins.fsti index 9ee7cb9bcf0..de9ced3b1f6 100644 --- a/ulib/FStar.Stubs.Reflection.V2.Builtins.fsti +++ b/ulib/FStar.Stubs.Reflection.V2.Builtins.fsti @@ -101,6 +101,13 @@ val inspect_pack_universe (uv:universe_view) : Lemma (inspect_universe (pack_uni val pack_inspect_ident (u:ident) : Lemma (pack_ident (inspect_ident u) == u) val inspect_pack_ident (uv:ident_view) : Lemma (inspect_ident (pack_ident uv) == uv) +val pack_inspect_lb (lb:letbinding) : Lemma (pack_lb (inspect_lb lb) == lb) +val inspect_pack_lb (lbv:lb_view) : Lemma (inspect_lb (pack_lb lbv) == lbv) + +val pack_inspect_sigelt (se:sigelt) : Lemma ((~(Unk? (inspect_sigelt se))) ==> pack_sigelt (inspect_sigelt se) == se) +val inspect_pack_sigelt (sev:sigelt_view { ~ (Unk? sev) }) : Lemma (inspect_sigelt (pack_sigelt sev) == sev) + + val simple_binder_defn (b:binder) : Lemma (binder_is_simple b <==> Q_Explicit? (inspect_binder b).qual /\ Nil? (inspect_binder b).attrs) @@ -134,8 +141,18 @@ val vars_of_env : env -> list binding (** Returns the current module of an environment. *) val moduleof : env -> name -(** Returns all top-level names marked with a given attribute. -Used e.g. to find all typeclass instances. *) +(** Returns all top-level sigelts marked with a given attribute. The +criterion used is that the [attr] attribute MUST be a top-level name +(Tv_FVar) and any sigelt that has an attribute with [attr] (possibly +applied) is returned. The sigelt can then be inspect to find the +arguments to the attribute, if needed. + +Used e.g. to find all typeclass instances, and read their functional +dependencies. *) +val lookup_attr_ses : attr:term -> env -> list sigelt + +(** As [lookup_attr_ses], but just returns the name associated +to the sigelts. *) val lookup_attr : term -> env -> list fv (** Returns all top-level names in an environment. *) diff --git a/ulib/FStar.Stubs.Tactics.Types.fsti b/ulib/FStar.Stubs.Tactics.Types.fsti index 5615e2bbbcd..d3898c04d25 100644 --- a/ulib/FStar.Stubs.Tactics.Types.fsti +++ b/ulib/FStar.Stubs.Tactics.Types.fsti @@ -57,7 +57,8 @@ type guard_policy = | Goal // Add guards as (normal) goals | SMT // Add guards as SMT goals | SMTSync // Send guards to SMT immediately, will *log* errors (not raise) if anything fails - | Force // Force guards without SMT + | Force // Force guards without SMT, immediately. Raises an exception on failure. + | ForceSMT // Force guards with SMT, immediately. Raises an exception on failure. | Drop // Drop guards, clearly unsound! careful! (* Typing reflection *) diff --git a/ulib/FStar.Stubs.Tactics.V1.Builtins.fsti b/ulib/FStar.Stubs.Tactics.V1.Builtins.fsti index 637a09176a4..40a731d1f4d 100644 --- a/ulib/FStar.Stubs.Tactics.V1.Builtins.fsti +++ b/ulib/FStar.Stubs.Tactics.V1.Builtins.fsti @@ -189,7 +189,7 @@ of printing [str] on the compiler's standard output. *) val print : string -> Tac unit (** [debugging ()] returns true if the current module has the debug flag -on, i.e. when [--debug MyModule --debug_level Tac] was passed in. *) +on, i.e. when [--debug Tac] was passed in. *) val debugging : unit -> Tac bool (** Similar to [print], but will dump a text representation of the proofstate diff --git a/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti b/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti index 2c84152aaec..1356f70723b 100644 --- a/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti +++ b/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti @@ -190,7 +190,7 @@ of printing [str] on the compiler's standard output. *) val print : string -> Tac unit (** [debugging ()] returns true if the current module has the debug flag -on, i.e. when [--debug MyModule --debug_level Tac] was passed in. *) +on, i.e. when [--debug Tac] was passed in. *) val debugging : unit -> Tac bool (** Similar to [print], but will dump a text representation of the proofstate @@ -383,6 +383,11 @@ val curms : unit -> Tac int before raising an exception (see e.g. [fail_silently]). *) val set_urgency : int -> TacS unit +(** [set_dump_failure b] controls whether the engine will dump out +the proofstate if a tactic fails during exception. This is true by +default, but can be disabled to get less verbosity. *) +val set_dump_on_failure : bool -> TacS unit + (** [string_to_term e s] runs the F* parser on the string [s] in the environment [e], and produces a term. *) val string_to_term : env -> string -> Tac term @@ -484,7 +489,7 @@ val is_non_informative (g:env) (t:typ) val check_subtyping (g:env) (t0 t1:typ) : Tac (ret_t (subtyping_token g t0 t1)) -val check_equiv (g:env) (t0 t1:typ) +val t_check_equiv (smt_ok:bool) (unfolding_ok:bool) (g:env) (t0 t1:typ) : Tac (ret_t (equiv_token g t0 t1)) // @@ -572,6 +577,16 @@ val maybe_relate_after_unfolding (g:env) (t1 t2:term) val maybe_unfold_head (g:env) (t0:term) : Tac (ret_t (t1:term{equiv_token g t0 t1})) +(** [norm_well_typed_term e steps t] will call the normalizer on the +term [t] using the list of steps [steps], over environment [e]. It +differs from norm_term_env in that it will not attempt to typecheck t +(so there is an implicit well-typing precondition for t, which we are +not strcitly requiring yet in reflection primitives) and it will also +return a token for the equivalence between t and t'. *) +val norm_well_typed_term + (g:env) (steps : list norm_step) (t:term) + : Tac (t':term{equiv_token g t t'}) + val push_open_namespace (g:env) (ns:name) : Tac env diff --git a/ulib/FStar.Tactics.MApply.fst b/ulib/FStar.Tactics.MApply.fst index b0ca0f98606..973b55e9a5f 100644 --- a/ulib/FStar.Tactics.MApply.fst +++ b/ulib/FStar.Tactics.MApply.fst @@ -11,18 +11,8 @@ open FStar.Tactics.V2.Derived open FStar.Tactics.V2.SyntaxCoercions open FStar.Tactics.Typeclasses - -private val push1 : (#p:Type) -> (#q:Type) -> - squash (p ==> q) -> - squash p -> - squash q -private let push1 #p #q f u = () - -private val push1' : (#p:Type) -> (#q:Type) -> - (p ==> q) -> - squash p -> - squash q -private let push1' #p #q f u = () +let push1 #p #q f u = () +let push1' #p #q f u = () (* * Some easier applying, which should prevent frustration @@ -90,22 +80,7 @@ let rec apply_squash_or_lem d t = | _ -> fail "mapply: can't apply (2)" end -class termable (a : Type) = { - to_term : a -> Tac term -} - -instance termable_term : termable term = { - to_term = (fun t -> t); -} - -instance termable_binding : termable binding = { - to_term = (fun b -> binding_to_term b); -} - (* `m` is for `magic` *) +[@@plugin] let mapply0 (t : term) : Tac unit = apply_squash_or_lem 10 t - -let mapply (#ty:Type) {| termable ty |} (x : ty) : Tac unit = - let t = to_term x in - apply_squash_or_lem 10 t diff --git a/ulib/FStar.Tactics.MApply.fsti b/ulib/FStar.Tactics.MApply.fsti new file mode 100644 index 00000000000..ce9e86cdf81 --- /dev/null +++ b/ulib/FStar.Tactics.MApply.fsti @@ -0,0 +1,36 @@ +module FStar.Tactics.MApply + +open FStar.Reflection.V2 +open FStar.Tactics.Effect +open FStar.Tactics.Typeclasses +open FStar.Tactics.V2.SyntaxCoercions + +(* Used by mapply, must be exposed, but not to be used directly *) +private val push1 : (#p:Type) -> (#q:Type) -> + squash (p ==> q) -> + squash p -> + squash q +private val push1' : (#p:Type) -> (#q:Type) -> + (p ==> q) -> + squash p -> + squash q + +class termable (a : Type) = { + to_term : a -> Tac term +} + +instance termable_term : termable term = { + to_term = (fun t -> t); +} + +instance termable_binding : termable binding = { + to_term = (fun b -> binding_to_term b); +} + +(* `m` is for `magic` *) +[@@plugin] +val mapply0 (t : term) : Tac unit + +let mapply (#ty:Type) {| termable ty |} (x : ty) : Tac unit = + let t = to_term x in + mapply0 t diff --git a/ulib/FStar.Tactics.TypeRepr.fst b/ulib/FStar.Tactics.TypeRepr.fst new file mode 100644 index 00000000000..16b6a6395d7 --- /dev/null +++ b/ulib/FStar.Tactics.TypeRepr.fst @@ -0,0 +1,170 @@ +module FStar.Tactics.TypeRepr + +//#set-options "--print_implicits --print_full_names --print_universes" + +open FStar.Tactics.V2 + +let add_suffix (s:string) (nm:name) : name = + explode_qn (implode_qn nm ^ s) + +let unitv_ : term = `() +let unitt_ : term = `(unit) +let empty_ : term = `(empty) +let either_ (a b : term) : term = `(either (`#a) (`#b)) +let tuple2_ (a b : term) : term = `(tuple2 (`#a) (`#b)) +let mktuple2_ (a b : term) : term = `(Mktuple2 (`#a) (`#b)) + +let get_inductive_typ (nm:string) : Tac (se:sigelt_view{Sg_Inductive? se}) = + let e = top_env () in + let se = lookup_typ e (explode_qn nm) in + match se with + | None -> fail "ctors_of_typ: type not found" + | Some se -> + let sev = inspect_sigelt se in + if Sg_Inductive? sev then + sev + else + fail "ctors_of_typ: not an inductive type" + +let alg_ctor (ty : typ) : Tac typ = + let tys, c = collect_arr ty in + Tactics.Util.fold_right (fun ty acc -> tuple2_ ty acc) tys unitt_ + +[@@plugin] +let generate_repr_typ (params : binders) (ctors : list ctor) : Tac typ = + let ctor_typs = Util.map (fun (_, ty) -> alg_ctor ty) ctors in + let alternative_typ = + Util.fold_right (fun ty acc -> either_ ty acc) ctor_typs empty_ in + alternative_typ + +(* Expects a goal of type [t -> t_repr] *) +[@@plugin] +let generate_down () : Tac unit = + let b = intro () in + let cases = t_destruct b in + cases |> Util.iteri #(fv & nat) (fun i (c, n) -> + let bs = repeatn n (fun _ -> intro ()) in + let _b_eq = intro () in + let sol = Util.fold_right (fun (b:binding) acc -> mktuple2_ b acc) bs unitv_ in + let _ = repeatn i (fun _ -> apply (`Inr)) in + apply (`Inl); + exact sol + ) + +let rec get_apply_tuple (b:binding) : Tac (list binding) = + let hd, args = collect_app b.sort in + match inspect hd, args with + | Tv_UInst fv _, [b1; b2] + | Tv_FVar fv, [b1; b2] -> + if inspect_fv fv = explode_qn (`%tuple2) then + let cases = t_destruct b in + guard (List.Tot.length cases = 1 && inspect_fv (fst (List.Tot.hd cases)) = explode_qn (`%Mktuple2) && snd (List.Tot.hd cases) = 2); + let b1 = intro () in + let b2 = intro () in + let _eq = intro () in + b1 :: get_apply_tuple b2 + else + fail ("unexpected term in apply_tuple: " ^ term_to_string b.sort) + | Tv_FVar fv, [] -> + if inspect_fv fv = explode_qn (`%unit) then + [] + else + fail ("unexpected term in apply_tuple: " ^ term_to_string b.sort) + | _ -> + fail ("unexpected term in apply_tuple: " ^ term_to_string b.sort) + +(* Expects a goal of type [t_repr -> t] *) + +let rec generate_up_aux (ctors : list ctor) (b:binding) : Tac unit = + match ctors with + | [] -> + (* b must have type empty, it's the finisher for the cases *) + apply (`empty_elim); + exact b + | c::cs -> + let cases = t_destruct b in + if List.Tot.length cases <> 2 then + fail "generate_up_aux: expected Inl/Inr???"; + focus (fun () -> + let b' = intro () in + let _eq = intro () in + let c_name = fst c in + let args = get_apply_tuple b' in + apply (pack (Tv_FVar (pack_fv c_name))); + Util.iter (fun (b:binding) -> exact b) args; + qed() + ); + let b = intro () in + let _eq = intro () in + generate_up_aux cs b + +(* Expects a goal of type [t_repr -> t] *) +[@@plugin] +let generate_up (nm:string) () : Tac unit = + let Sg_Inductive {ctors} = get_inductive_typ nm in + let b = intro () in + generate_up_aux ctors b + +let make_implicits (bs : binders) : binders = + bs |> List.Tot.map (fun b -> + match b.qual with + | Q_Explicit -> { b with qual = Q_Implicit } + | _ -> b + ) + +let binder_to_argv (b:binder) : argv = + (binder_to_term b, b.qual) + +let generate_all (nm:name) (params:binders) (ctors : list ctor) : Tac decls = + let params_i = make_implicits params in + let t = mk_app (pack (Tv_FVar (pack_fv nm))) (List.Tot.map binder_to_argv params) in + let t_repr = generate_repr_typ params ctors in + let se_repr = pack_sigelt <| Sg_Let { + isrec = false; + lbs = [{ + lb_fv = pack_fv (add_suffix "_repr" nm); + lb_us = []; + lb_typ = mk_arr params <| C_Total (`Type); + lb_def = mk_abs params t_repr; + }] + } + in + + let down_def = + `(_ by (generate_down ())) + in + let down_def = mk_abs params_i down_def in + let se_down = + let b = fresh_binder t in + pack_sigelt <| Sg_Let { + isrec = false; + lbs = [{ + lb_fv = pack_fv (add_suffix "_down" nm); + lb_us = []; + lb_typ = mk_tot_arr params_i <| Tv_Arrow b (C_Total t_repr); + lb_def = down_def; + }] + } + in + let up_def = + `(_ by (generate_up (`#(pack (Tv_Const (C_String (implode_qn nm))))) ())) + in + let up_def = mk_abs params_i up_def in + let se_up = + let b = fresh_binder t_repr in + pack_sigelt <| Sg_Let { + isrec = false; + lbs = [{ + lb_fv = pack_fv (add_suffix "_up" nm); + lb_us = []; + lb_typ = mk_tot_arr params_i <| Tv_Arrow b (C_Total t); + lb_def = up_def; + }] + } + in + [se_repr; se_down; se_up] + +[@@plugin] +let entry (nm : string) : Tac decls = + let Sg_Inductive {params; nm; ctors} = get_inductive_typ nm in + generate_all nm params ctors diff --git a/ulib/FStar.Tactics.TypeRepr.fsti b/ulib/FStar.Tactics.TypeRepr.fsti new file mode 100644 index 00000000000..8b03aa51cb3 --- /dev/null +++ b/ulib/FStar.Tactics.TypeRepr.fsti @@ -0,0 +1,21 @@ +module FStar.Tactics.TypeRepr + +open FStar.Tactics.V2 + +private +let empty_elim (e:empty) (#a:Type) : a = match e with + +(* Do not use directly. *) +[@@plugin] +val generate_repr_typ (params : binders) (ctors : list ctor) : Tac typ + +(* Do not use directly. *) +[@@plugin] +val generate_down () : Tac unit + +(* Do not use directly. *) +[@@plugin] +val generate_up (nm:string) () : Tac unit + +[@@plugin] +val entry (nm : string) : Tac decls diff --git a/ulib/FStar.Tactics.Typeclasses.fst b/ulib/FStar.Tactics.Typeclasses.fst index c417f2462a2..326a2a194a0 100644 --- a/ulib/FStar.Tactics.Typeclasses.fst +++ b/ulib/FStar.Tactics.Typeclasses.fst @@ -16,6 +16,7 @@ module FStar.Tactics.Typeclasses open FStar.Reflection.V2 +module R = FStar.Reflection.V2 open FStar.Stubs.Tactics.Common open FStar.Tactics.Effect open FStar.Stubs.Tactics.V2.Builtins @@ -40,11 +41,39 @@ let tcclass : unit = () irreducible let tcinstance : unit = () +(* Functional dependencies of a class. *) +irreducible +let fundeps (_ : list int) : unit = () + (* The attribute that marks class fields to signal that no method should be generated for them *) irreducible let no_method : unit = () +noeq +type st_t = { + seen : list term; + glb : list (sigelt & fv); + fuel : int; +} + +noeq +type tc_goal = { + g : term; + (* ^ The goal as a term *) + head_fv : fv; + (* ^ Head fv of goal (g), i.e. the class name *) + c_se : option sigelt; + (* ^ Class sigelt *) + fundeps : option (list int); + (* ^ Functional dependendcies of class, if any. *) + args_and_uvars : list (argv & bool); + (* ^ The arguments of the goal, and whether they are + unresolved, even partially. I.e. the boolean is true + when the arg contains uvars. *) +} + + val fv_eq : fv -> fv -> Tot bool let fv_eq fv1 fv2 = let n1 = inspect_fv fv1 in @@ -89,100 +118,193 @@ let rec maybe_intros () : Tac unit = maybe_intros () | _ -> () -(* - tcresolve': the main typeclass instantiation function. +let sigelt_name (se:sigelt) : list fv = + match FStar.Stubs.Reflection.V2.Builtins.inspect_sigelt se with + | Stubs.Reflection.V2.Data.Sg_Let _ lbs -> ( + match lbs with + | [lb] -> [(FStar.Stubs.Reflection.V2.Builtins.inspect_lb lb).lb_fv] + | _ -> [] + ) + | Stubs.Reflection.V2.Data.Sg_Val nm _ _ -> [pack_fv nm] + | _ -> [] + +(* Would be nice to define an unembedding class here.. but it's circular. *) +let unembed_int (t:term) : Tac (option int) = + match inspect_ln t with + | R.Tv_Const (C_Int i) -> Some i + | _ -> None + +let rec unembed_list (#a:Type) (u : term -> Tac (option a)) (t:term) : Tac (option (list a)) = + match hua t with + | Some (fv, _, [(ty, Q_Implicit); (hd, Q_Explicit); (tl, Q_Explicit)]) -> + if implode_qn (inspect_fv fv) = `%Prims.Cons then + match u hd, unembed_list u tl with + | Some hd, Some tl -> Some (hd::tl) + | _ -> None + else + None + | Some (fv, _, [(ty, Q_Implicit)]) -> + if implode_qn (inspect_fv fv) = `%Prims.Nil then + Some [] + else + None + | _ -> + None + +let extract_fundeps (se : sigelt) : Tac (option (list int)) = + let attrs = sigelt_attrs se in + let rec aux (attrs : list term) : Tac (option (list int)) = + match attrs with + | [] -> None + | attr::attrs' -> + match collect_app attr with + | hd, [(a0, Q_Explicit)] -> + if FStar.Reflection.V2.TermEq.term_eq hd (`fundeps) then ( + unembed_list unembed_int a0 + ) else + aux attrs' + | _ -> + aux attrs' + in + aux attrs + +let trywith (st:st_t) (g:tc_goal) (t typ : term) (k : st_t -> Tac unit) : Tac unit = + // print ("head_fv = " ^ fv_to_string g.head_fv); + // print ("fundeps = " ^ Util.string_of_option (Util.string_of_list (fun i -> string_of_int i)) fundeps); + let unresolved_args = g.args_and_uvars |> Util.mapi (fun i (_, b) -> if b then [i <: int] else []) |> List.Tot.flatten in + // print ("unresolved_args = " ^ Util.string_of_list (fun i -> string_of_int i) unresolved_args); + + match head_of (res_typ typ) with + | None -> + debug (fun () -> "no head for typ of this? " ^ term_to_string t ^ " typ=" ^ term_to_string typ); + raise NoInst + | Some fv' -> + if not (fv_eq fv' g.head_fv) then + raise NoInst; // class mismatch, would be better to not even get here + debug (fun () -> "Trying to apply hypothesis/instance: " ^ term_to_string t); + (fun () -> + if Cons? unresolved_args && None? g.fundeps then + fail "Will not continue as there are unresolved args (and no fundeps)" + else if Cons? unresolved_args && Some? g.fundeps then ( + let Some fundeps = g.fundeps in + debug (fun () -> "checking fundeps"); + let all_good = List.Tot.for_all (fun i -> List.Tot.mem i fundeps) unresolved_args in + if all_good then apply t else fail "fundeps" + ) else ( + apply_noinst t + ) + ) `seq` (fun () -> + debug (fun () -> dump "next"; "apply seems to have worked"); + let st = { st with fuel = st.fuel - 1 } in + k st) + +let local (st:st_t) (g:tc_goal) (k : st_t -> Tac unit) () : Tac unit = + debug (fun () -> "local, goal = " ^ term_to_string g.g); + let bs = vars_of_env (cur_env ()) in + first (fun (b:binding) -> + trywith st g (pack (Tv_Var b)) b.sort k) + bs + +let global (st:st_t) (g:tc_goal) (k : st_t -> Tac unit) () : Tac unit = + debug (fun () -> "global, goal = " ^ term_to_string g.g); + first (fun (se, fv) -> + let typ = tc (cur_env()) (pack (Tv_FVar fv)) in // FIXME: a bit slow.. but at least it's a simple fvar + trywith st g (pack (Tv_FVar fv)) typ k) + st.glb + +exception Next +let try_trivial (st:st_t) (g:tc_goal) (k : st_t -> Tac unit) () : Tac unit = + match g.g with + | Tv_FVar fv -> + if implode_qn (inspect_fv fv) = `%unit + then exact (`()) + else raise Next + | _ -> raise Next + +let ( <|> ) (t1 t2 : unit -> Tac 'a) : unit -> Tac 'a = + fun () -> + try t1 () with _ -> t2 () - seen : a list of goals we've seen already in this path of the search, - used to prevent loops - glb : a list of all global instances in scope, for all classes - fuel : amount of steps we allow in this path, we stop if we reach zero - head_fv : the head of the goal we're trying to solve, i.e. the class name +(* + tcresolve': the main typeclass instantiation function. - TODO: some form of memoization + It mostly creates a tc_goal record and calls the functions above. *) -private -let rec tcresolve' (seen : list term) (glb : list fv) (fuel : int) : Tac unit = - if fuel <= 0 then +let rec tcresolve' (st:st_t) : Tac unit = + if st.fuel <= 0 then raise NoInst; - debug (fun () -> "fuel = " ^ string_of_int fuel); + debug (fun () -> "fuel = " ^ string_of_int st.fuel); maybe_intros(); let g = cur_goal () in (* Try to detect loops *) - if L.existsb (Reflection.V2.TermEq.term_eq g) seen then ( + if L.existsb (Reflection.V2.TermEq.term_eq g) st.seen then ( debug (fun () -> "loop"); raise NoInst ); - match head_of g with + match hua g with | None -> - debug (fun () -> "goal does not look like a typeclass"); + debug (fun () -> "Goal does not look like a typeclass"); raise NoInst - | Some head_fv -> + | Some (head_fv, us, args) -> (* ^ Maybe should check is this really is a class too? *) - let seen = g :: seen in - local head_fv seen glb fuel - `or_else` - global head_fv seen glb fuel - -and local (head_fv : fv) (seen : list term) (glb : list fv) (fuel : int) () : Tac unit = - let bs = vars_of_env (cur_env ()) in - first (fun (b:binding) -> - trywith head_fv seen glb fuel (pack (Tv_Var b)) b.sort) - bs + let c_se = lookup_typ (cur_env ()) (inspect_fv head_fv) in + let fundeps = match c_se with + | None -> None + | Some se -> extract_fundeps se + in -and global (head_fv : fv) (seen : list term) (glb : list fv) (fuel : int) () : Tac unit = - first (fun fv -> - let typ = tc (cur_env()) (pack (Tv_FVar fv)) in // FIXME: a bit slow.. but at least it's a simple fvar - trywith head_fv seen glb fuel (pack (Tv_FVar fv)) typ) - glb + let args_and_uvars = args |> Util.map (fun (a, q) -> (a, q), Cons? (free_uvars a )) in + let st = { st with seen = g :: st.seen } in + let g = { g; head_fv; c_se; fundeps; args_and_uvars } in + (try_trivial st g tcresolve' <|> + local st g tcresolve' <|> + global st g tcresolve') () -and trywith (head_fv : fv) (seen:list term) (glb : list fv) (fuel:int) (t typ : term) : Tac unit = - //debug (fun () -> "trywith " ^ term_to_string t); - match head_of (res_typ typ) with - | None -> - debug (fun () -> "no head for typ of this? " ^ term_to_string t ^ " typ=" ^ term_to_string typ); - raise NoInst - | Some fv' -> - if fv_eq fv' head_fv - then ( - debug (fun () -> "Trying to apply hypothesis/instance: " ^ term_to_string t); - (fun () -> apply_noinst t) `seq` (fun () -> - debug (fun () -> dump "next"; "apply seems to have worked"); - tcresolve' seen glb (fuel-1)) - ) else ( - //debug (fun () -> "different class: " ^ fv_to_string fv' ^ " <> " ^ fv_to_string head_fv); - raise NoInst - ) +let rec concatMap (f : 'a -> Tac (list 'b)) (l : list 'a) : Tac (list 'b) = + match l with + | [] -> [] + | x::xs -> f x @ concatMap f xs [@@plugin] let tcresolve () : Tac unit = + let open FStar.Stubs.Pprint in debug (fun () -> dump ""; "tcresolve entry point"); - // We sometimes get goal type as _ -> t - // So intro if that's the case - // Not using intros () directly, since that unfolds aggressively if the term is not an arrow - // TODO: Should we..? Why wouldn't the head always be an FV? let w = cur_witness () in + set_dump_on_failure false; (* We report our own errors *) + + // Not using intros () directly, since that unfolds aggressively if the term is not a literal arrow maybe_intros (); // Fetch a list of all instances in scope right now. // TODO: turn this into a hash map per class, ideally one that can be - // stored. - let glb = lookup_attr (`tcinstance) (cur_env ()) in + // persisted across calss. + let glb = lookup_attr_ses (`tcinstance) (cur_env ()) in + let glb = glb |> concatMap (fun se -> + sigelt_name se |> concatMap (fun fv -> [(se, fv)]) + ) + in + let st0 = { + seen = []; + glb = glb; + fuel = 16; + } in try - tcresolve' [] glb 16; + tcresolve' st0; debug (fun () -> "Solved to:\n\t" ^ term_to_string w) with | NoInst -> let open FStar.Stubs.Pprint in fail_doc [ + text "Typeclass resolution failed."; prefix 2 1 (text "Could not solve constraint") - (arbitrary_string (term_to_string (cur_goal ()))); + (term_to_doc (cur_goal ())); ] | TacticFailure msg -> - fail_doc ([text "Typeclass resolution failed"] @ msg) + fail_doc ([text "Typeclass resolution failed."] @ msg) | e -> raise e (**** Generating methods from a class ****) diff --git a/ulib/FStar.Tactics.Typeclasses.fsti b/ulib/FStar.Tactics.Typeclasses.fsti index 9b41f7ef6a3..eac4b77fc7b 100644 --- a/ulib/FStar.Tactics.Typeclasses.fsti +++ b/ulib/FStar.Tactics.Typeclasses.fsti @@ -24,6 +24,14 @@ val tcclass : unit (* The attribute that marks instances *) val tcinstance : unit +(* Functional dependencies of a class. It takes an int list +representing the arguments of the class (starting from 0, both explicit +and implicit alike) that are dependent on the rest. When trying to apply +an instance, if the fundeps are unresolved (i.e. contain uvars) but the +other arguments do not, we will apply the instance and instantiate the +fundeps. *) +val fundeps : list int -> unit + (* The attribute that marks class fields to signal that no method should be generated for them *) val no_method : unit diff --git a/ulib/FStar.Tactics.Util.fst b/ulib/FStar.Tactics.Util.fst index bc53b7a3ac4..197e63fae27 100644 --- a/ulib/FStar.Tactics.Util.fst +++ b/ulib/FStar.Tactics.Util.fst @@ -120,3 +120,8 @@ let rec string_of_list #a (f : a -> Tac string) (l : list a) : Tac string = match l with | [] -> "" | x::xs -> f x ^ ";" ^ string_of_list f xs + +let string_of_option #a (f : a -> Tac string) (o : option a) : Tac string = + match o with + | Some x -> "Some " ^ f x + | None -> "None" diff --git a/ulib/FStar.Tactics.V1.Derived.fst b/ulib/FStar.Tactics.V1.Derived.fst index bc137ef3353..fb34d51dd8e 100644 --- a/ulib/FStar.Tactics.V1.Derived.fst +++ b/ulib/FStar.Tactics.V1.Derived.fst @@ -137,8 +137,7 @@ let qed () : Tac unit = | _ -> fail "qed: not done!" (** [debug str] is similar to [print str], but will only print the message -if the [--debug] option was given for the current module AND -[--debug_level Tac] is on. *) +if [--debug Tac] is on. *) let debug (m:string) : Tac unit = if debugging () then print m diff --git a/ulib/FStar.Tactics.V2.Derived.fst b/ulib/FStar.Tactics.V2.Derived.fst index ba3f32a7bbe..3d2aa25f38b 100644 --- a/ulib/FStar.Tactics.V2.Derived.fst +++ b/ulib/FStar.Tactics.V2.Derived.fst @@ -156,8 +156,7 @@ let qed () : Tac unit = | _ -> fail "qed: not done!" (** [debug str] is similar to [print str], but will only print the message -if the [--debug] option was given for the current module AND -[--debug_level Tac] is on. *) +if [--debug Tac] is on. *) let debug (m:string) : Tac unit = if debugging () then print m @@ -942,3 +941,7 @@ let smt_sync' (fuel ifuel : nat) : Tac unit = ; initial_ifuel = ifuel; max_ifuel = ifuel } in t_smt_sync vcfg' + +(* t_check_equiv wrappers. *) +let check_equiv g t0 t1 = t_check_equiv true true g t0 t1 +let check_equiv_nosmt g t0 t1 = t_check_equiv false false g t0 t1 diff --git a/ulib/FStar.Tactics.V2.SyntaxHelpers.fst b/ulib/FStar.Tactics.V2.SyntaxHelpers.fst index 9f64775ce79..ebce070cb6d 100644 --- a/ulib/FStar.Tactics.V2.SyntaxHelpers.fst +++ b/ulib/FStar.Tactics.V2.SyntaxHelpers.fst @@ -86,3 +86,11 @@ let rec collect_app' (args : list argv) (t : term) | _ -> (t, args) let collect_app = collect_app' [] + +(* Destruct an application into [h]ead fv, [u]niverses, and [a]rguments. *) +let hua (t:term) : Tac (option (fv & universes & list argv)) = + let hd, args = collect_app t in + match inspect hd with + | Tv_FVar fv -> Some (fv, [], args) + | Tv_UInst fv us -> Some (fv, us, args) + | _ -> None diff --git a/ulib/experimental/FStar.Reflection.Typing.fst b/ulib/experimental/FStar.Reflection.Typing.fst index 84788a5250a..99ffe08fe41 100644 --- a/ulib/experimental/FStar.Reflection.Typing.fst +++ b/ulib/experimental/FStar.Reflection.Typing.fst @@ -53,6 +53,11 @@ let pack_inspect_fv = R.pack_inspect_fv let inspect_pack_universe = R.inspect_pack_universe let pack_inspect_universe = R.pack_inspect_universe +let inspect_pack_lb = R.inspect_pack_lb +let pack_inspect_lb = R.pack_inspect_lb + +let inspect_pack_sigelt = R.inspect_pack_sigelt +let pack_inspect_sigelt = R.pack_inspect_sigelt let lookup_bvar (e:env) (x:int) : option term = magic () diff --git a/ulib/experimental/FStar.Reflection.Typing.fsti b/ulib/experimental/FStar.Reflection.Typing.fsti index 7f6a9a50321..87b0347e0e7 100644 --- a/ulib/experimental/FStar.Reflection.Typing.fsti +++ b/ulib/experimental/FStar.Reflection.Typing.fsti @@ -119,6 +119,23 @@ val pack_inspect_universe (u:R.universe) (ensures R.pack_universe (R.inspect_universe u) == u) [SMTPat (R.pack_universe (R.inspect_universe u))] +val inspect_pack_lb (lb:R.lb_view) + : Lemma (ensures R.inspect_lb (R.pack_lb lb) == lb) + [SMTPat (R.inspect_lb (R.pack_lb lb))] + +val pack_inspect_lb (lb:R.letbinding) + : Lemma (ensures R.pack_lb (R.inspect_lb lb) == lb) + [SMTPat (R.pack_lb (R.inspect_lb lb))] + +val inspect_pack_sigelt (sev:R.sigelt_view { ~ (Unk? sev) }) + : Lemma (ensures R.inspect_sigelt (R.pack_sigelt sev) == sev) + [SMTPat (R.inspect_sigelt (R.pack_sigelt sev))] + +val pack_inspect_sigelt (se:R.sigelt) + : Lemma (requires ~ (Unk? (R.inspect_sigelt se))) + (ensures R.pack_sigelt (R.inspect_sigelt se) == se) + [SMTPat (R.pack_sigelt (R.inspect_sigelt se))] + val lookup_bvar (e:env) (x:int) : option term val lookup_fvar_uinst (e:R.env) (x:R.fv) (us:list R.universe) : option R.term @@ -1747,13 +1764,8 @@ type fstar_top_env = g:fstar_env { } // -// This doesn't allow for universe polymorphic definitions +// No universe polymorphism yet // -// May be we can change it to: -// -// g:fstar_top_env -> T.tac ((us, e, t):(univ_names & term & typ){typing (push g us) e t}) -// - noeq type sigelt_typing : env -> sigelt -> Type0 = | ST_Let : @@ -1774,35 +1786,69 @@ type sigelt_typing : env -> sigelt -> Type0 = (** * The type of the top-level tactic that would splice-in the definitions. - * It returns a list of well typed definitions, via the judgment above. * - * Each definition can have a 'blob' attached with a given name. + * The tactic takes as input as type environment and an optional expected type + * + * It returns (sigelts_before, sigelt, sigelt_after) + * where sigelts_before and sigelt_after are list of sigelts + * + * All the returned sigelts indicate via a boolean flag whether they are well-typed, + * in the judgment above + * + * If the flag is not set, F* typechecker typechecks the returned sigelts + * + * The sigelt in the middle, if well-typed, has the input expected type + * + * In addition, each sigelt can have a 'blob' attached with a given name. * The blob can be used later, e.g., during extraction, and passed back to the * extension to perform additional processing. - *) - -(* - * It returns either: - * - Some tm, blob, typ, with a proof that `typing g tm typ` - * - None, blob, typ), with a proof that `exists tm. typing g tm typ` - * The blob itself is optional and can store some additional metadata that - * constructed by the tactic. If present, it will be stored in the - * sigmeta_extension_data field of the enclosing sigelt. * + * The blob is stored in the sigmeta_extension_data field of the enclosing sigelt. *) + let blob = string & R.term -(* If checked is true, this sigelt is properly typed for the environment. If not, -we don't know and let F* re-typecheck the sigelt. *) -let sigelt_for (g:env) = - tup:(bool & sigelt & option blob) - { + +// +// t is the optional expected type +// +let sigelt_has_type (s:R.sigelt) (t:option R.term) : prop = + let open R in + match t with + | None -> True + | Some t -> + match inspect_sigelt s with + | Sg_Let false [lb] -> begin + let {lb_typ} = inspect_lb lb in + lb_typ == t + end + + | _ -> False + +// +// If checked is true, this sigelt is properly typed for the environment +// If not, we don't know and let F* re-typecheck the sigelt. +// + +let sigelt_for (g:env) (t:option R.typ) = + tup:(bool & sigelt & option blob) { let (checked, se, _) = tup in - checked ==> sigelt_typing g se + checked ==> (sigelt_typing g se /\ sigelt_has_type se t) } -let dsl_tac_result_t (g:env) = list (sigelt_for g) +// +// sigelts_before, sigelt, sigelts_after +// +let dsl_tac_result_t (g:env) (t:option R.typ) = + list (sigelt_for g None) & + (sigelt_for g t) & + list (sigelt_for g None) -type dsl_tac_t = g:fstar_top_env -> T.Tac (dsl_tac_result_t g) +// +// The input option R.typ is the expected type +// +type dsl_tac_t = + gt:(fstar_top_env & option R.typ) -> + T.Tac (dsl_tac_result_t (fst gt) (snd gt)) val if_complete_match (g:env) (t:term) : T.match_complete_token g t bool_ty [ @@ -1829,8 +1875,9 @@ val mkif : typing g (mk_if scrutinee then_ else_) (eff, ty) (* Helper to return a single let definition in a splice_t tactic. *) -let mk_checked_let (g:R.env) (nm:string) (tm:R.term) (ty:R.typ{typing g tm (T.E_Total, ty)}) : T.Tac (sigelt_for g) = - let fv = pack_fv (T.cur_module () @ [nm]) in +let mk_checked_let (g:R.env) (cur_module:name) (nm:string) (tm:R.term) (ty:R.typ{typing g tm (T.E_Total, ty)}) + : sigelt_for g (Some ty) = + let fv = pack_fv (cur_module @ [nm]) in let lb = R.pack_lb ({ lb_fv = fv; lb_us = []; lb_typ = ty; lb_def = tm }) in let se = R.pack_sigelt (R.Sg_Let false [lb]) in let pf : sigelt_typing g se = @@ -1838,8 +1885,9 @@ let mk_checked_let (g:R.env) (nm:string) (tm:R.term) (ty:R.typ{typing g tm (T.E_ in ( true, se, None ) -let mk_unchecked_let (g:R.env) (nm:string) (tm:R.term) (ty:R.typ) : T.Tac (sigelt_for g) = - let fv = pack_fv (T.cur_module () @ [nm]) in +let mk_unchecked_let (g:R.env) (cur_module:name) (nm:string) (tm:R.term) (ty:R.typ) + : bool & sigelt & option blob = + let fv = pack_fv (cur_module @ [nm]) in let lb = R.pack_lb ({ lb_fv = fv; lb_us = []; lb_typ = ty; lb_def = tm }) in let se = R.pack_sigelt (R.Sg_Let false [lb]) in ( false, se, None ) diff --git a/ulib/prims.fst b/ulib/prims.fst index 7aea931e543..18130765343 100644 --- a/ulib/prims.fst +++ b/ulib/prims.fst @@ -708,4 +708,4 @@ val string_of_int: int -> Tot string (** THIS IS MEANT TO BE KEPT IN SYNC WITH FStar.CheckedFiles.fs Incrementing this forces all .checked files to be invalidated *) irreducible -let __cache_version_number__ = 65 +let __cache_version_number__ = 67