diff options
Diffstat (limited to '')
76 files changed, 1565 insertions, 6311 deletions
@@ -117,8 +117,8 @@ trans-no_nested_borrows trans-paper: \ OPTIONS += -test-units -test-trans-units -no-split-files -no-state trans-no_nested_borrows trans-paper: SUBDIR := misc tfstar-no_nested_borrows tfstar-paper: -tlean-no_nested_borrows: SUBDIR := misc-no_nested_borrows -tlean-paper: SUBDIR := misc-paper +tlean-no_nested_borrows: SUBDIR := +tlean-paper: SUBDIR := thol4-no_nested_borrows: SUBDIR := misc-no_nested_borrows thol4-paper: SUBDIR := misc-paper @@ -126,29 +126,29 @@ trans-loops: OPTIONS += -no-state trans-loops: SUBDIR := misc tfstar-loops: OPTIONS += -decreases-clauses -template-clauses tcoq-loops: OPTIONS += -use-fuel -no-split-files -tlean-loops: SUBDIR := misc-loops -tlean-loops: OPTIONS += -decreases-clauses -template-clauses +tlean-loops: SUBDIR := thol4-loops: SUBDIR := misc-loops trans-hashmap: OPTIONS += -no-state trans-hashmap: SUBDIR := hashmap tfstar-hashmap: OPTIONS += -decreases-clauses -template-clauses tcoq-hashmap: OPTIONS += -use-fuel -tlean-hashmap: OPTIONS += -decreases-clauses -template-clauses +tlean-hashmap: SUBDIR := +tlean-hashmap: OPTIONS += thol4-hashmap: OPTIONS += trans-hashmap_main: OPTIONS += trans-hashmap_main: SUBDIR := hashmap_on_disk tfstar-hashmap_main: OPTIONS += -decreases-clauses -template-clauses tcoq-hashmap_main: OPTIONS += -use-fuel -tlean-hashmap_main: OPTIONS += -decreases-clauses -template-clauses +tlean-hashmap_main: SUBDIR := thol4-hashmap_main: OPTIONS += transp-polonius_list: OPTIONS += -test-units -test-trans-units -no-split-files -no-state transp-polonius_list: SUBDIR := misc tfstarp-polonius_list: OPTIONS += tcoqp-polonius_list: OPTIONS += -tleanp-polonius_list: SUBDIR := misc-polonius_list +tleanp-polonius_list: SUBDIR := tleanp-polonius_list: OPTIONS += thol4p-polonius_list: SUBDIR := misc-polonius_list thol4p-polonius_list: OPTIONS += @@ -157,7 +157,7 @@ trans-constants: OPTIONS += -test-units -test-trans-units -no-split-files -no-st trans-constants: SUBDIR := misc tfstar-constants: OPTIONS += tcoq-constants: OPTIONS += -tlean-constants: SUBDIR := misc-constants +tlean-constants: SUBDIR := tlean-constants: OPTIONS += thol4-constants: SUBDIR := misc-constants thol4-constants: OPTIONS += @@ -166,7 +166,7 @@ trans-external: OPTIONS += trans-external: SUBDIR := misc tfstar-external: OPTIONS += tcoq-external: OPTIONS += -tlean-external: SUBDIR := misc-external +tlean-external: SUBDIR := tlean-external: OPTIONS += thol4-external: SUBDIR := misc-external thol4-external: OPTIONS += @@ -176,7 +176,8 @@ transp-betree_main: OPTIONS += -backward-no-state-update transp-betree_main: SUBDIR:=betree tfstarp-betree_main: OPTIONS += $(BETREE_FSTAR_OPTIONS) tcoqp-betree_main: OPTIONS += -use-fuel -tleanp-betree_main: OPTIONS += $(BETREE_FSTAR_OPTIONS) +tleanp-betree_main: SUBDIR := +tleanp-betree_main: OPTIONS += thol4-betree_main: OPTIONS += # Additional test on the betree: translate it without `-backward-no-state-update`. @@ -249,8 +250,7 @@ tcoqp-%: $(AENEAS_CMD) .PHONY: tlean-% -# TODO: add -test-trans-units once we remove all the sorry from Primitives.lean -tlean-%: OPTIONS += -backend lean +tlean-%: OPTIONS += -backend lean -test-trans-units tlean-%: BACKEND_SUBDIR := lean tlean-%: $(AENEAS_CMD) @@ -258,13 +258,7 @@ tlean-%: # "p" stands for "Polonius" .PHONY: tleanp-% -# TODO: for now we don't extract the betree for Lean because we need to implement -# proper support for the proofs of termination for the mutually recursive functions. -tleanp-betree_main: - echo "Ignoring Lean betree" - -# TODO: add -test-trans-units once we remove all the sorry from Primitives.lean -tleanp-%: OPTIONS += -backend lean +tleanp-%: OPTIONS += -backend lean -test-trans-units tleanp-%: BACKEND_SUBDIR := lean tleanp-%: $(AENEAS_CMD) diff --git a/backends/lean/Base.lean b/backends/lean/Base.lean index 6e9ff873..1f8cbc8e 100644 --- a/backends/lean/Base.lean +++ b/backends/lean/Base.lean @@ -1,4 +1,3 @@ import Base.Primitives import Base.Diverge -import Base.TestTactics import Base.Arith diff --git a/backends/lean/lake-manifest.json b/backends/lean/lake-manifest.json index e5d362fc..40eb1682 100644 --- a/backends/lean/lake-manifest.json +++ b/backends/lean/lake-manifest.json @@ -2,9 +2,15 @@ "packagesDir": "lake-packages", "packages": [{"git": + {"url": "https://github.com/EdAyers/ProofWidgets4", + "subDir?": null, + "rev": "c43db94a8f495dad37829e9d7ad65483d68c86b8", + "name": "proofwidgets", + "inputRev?": "v0.0.11"}}, + {"git": {"url": "https://github.com/leanprover-community/mathlib4.git", "subDir?": null, - "rev": "cdb1b898e4317567699181f27533182046ebc544", + "rev": "4f103b3696795c62e76fb89d177efb91c29afdf5", "name": "mathlib", "inputRev?": null}}, {"git": @@ -22,6 +28,6 @@ {"git": {"url": "https://github.com/leanprover/std4", "subDir?": null, - "rev": "6932c4ea52914dc6b0488944e367459ddc4d01a6", + "rev": "e68aa8f5fe47aad78987df45f99094afbcb5e936", "name": "std", "inputRev?": "main"}}]} diff --git a/backends/lean/lean-toolchain b/backends/lean/lean-toolchain index 1211e372..42e7d786 100644 --- a/backends/lean/lean-toolchain +++ b/backends/lean/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2023-05-31
\ No newline at end of file +leanprover/lean4:nightly-2023-06-20
\ No newline at end of file diff --git a/compiler/Config.ml b/compiler/Config.ml index ce9b0e0c..bfb9d161 100644 --- a/compiler/Config.ml +++ b/compiler/Config.ml @@ -162,6 +162,11 @@ let backward_no_state_update = ref false *) let split_files = ref true +(** For Lean, controls whether we generate a lakefile or not. + + *) +let lean_gen_lakefile = ref false + (** If true, treat the unit functions (function taking no inputs and returning no outputs) as unit tests: evaluate them with the interpreter and check that they don't panic. diff --git a/compiler/Driver.ml b/compiler/Driver.ml index 2ff9e295..f935a717 100644 --- a/compiler/Driver.ml +++ b/compiler/Driver.ml @@ -107,6 +107,9 @@ let () = Arg.Clear check_invariants, " Deactivate the invariant sanity checks performed at every evaluation \ step. Dramatically increases speed." ); + ( "-lean-default-lakefile", + Arg.Clear lean_gen_lakefile, + " Generate a default lakefile.lean (Lean only)" ); ] in @@ -130,6 +133,9 @@ let () = (not !use_fuel) || (not !extract_decreases_clauses) && not !extract_template_decreases_clauses); + if !lean_gen_lakefile && not (!backend = Lean) then + log#error + "The -lean-default-lakefile option is valid only for the Lean backend"; (* Check that the user specified a backend *) let _ = diff --git a/compiler/Extract.ml b/compiler/Extract.ml index d624d9ca..a54a2299 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -505,10 +505,10 @@ let fun_decl_kind_to_qualif (kind : decl_kind) : string option = | Lean -> ( match kind with | SingleNonRec -> Some "def" - | SingleRec -> Some "def" - | MutRecFirst -> Some "mutual def" - | MutRecInner -> Some "def" - | MutRecLast -> Some "def" + | SingleRec -> Some "divergent def" + | MutRecFirst -> Some "mutual divergent def" + | MutRecInner -> Some "divergent def" + | MutRecLast -> Some "divergent def" | Assumed -> Some "axiom" | Declared -> Some "axiom") | HOL4 -> None @@ -2327,9 +2327,7 @@ and extract_lets (ctx : extraction_ctx) (fmt : F.formatter) (inside : bool) match !backend with | FStar -> "=" | Coq -> ":=" - | Lean -> - (* TODO: switch to ⟵ once issues are fixed *) - if monadic then "←" else ":=" + | Lean -> if monadic then "←" else ":=" | HOL4 -> if monadic then "<-" else "=" in F.pp_print_string fmt eq; @@ -2409,7 +2407,7 @@ and extract_Switch (ctx : extraction_ctx) (fmt : F.formatter) (_inside : bool) (* Open a box for the [if e] *) F.pp_open_hovbox fmt ctx.indent_incr; F.pp_print_string fmt "if"; - if !backend = Lean then F.pp_print_string fmt " h:"; + if !backend = Lean && ctx.use_dep_ite then F.pp_print_string fmt " h:"; F.pp_print_space fmt (); let scrut_inside = PureUtils.texpression_requires_parentheses scrut in extract_texpression ctx fmt scrut_inside scrut; diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml index 0a5d7df2..14ce4119 100644 --- a/compiler/ExtractBase.ml +++ b/compiler/ExtractBase.ml @@ -539,6 +539,16 @@ type extraction_ctx = { use it. Also see {!names_map.opaque_ids}. *) + use_dep_ite : bool; + (** For Lean: do we use dependent-if then else expressions? + + Example: + {[ + if h: b then ... else ... + -- ^^ + -- makes the if then else dependent + ]} + *) } (** Debugging function, used when communicating name collisions to the user, diff --git a/compiler/Translate.ml b/compiler/Translate.ml index 75fc7fe9..39b169c9 100644 --- a/compiler/Translate.ml +++ b/compiler/Translate.ml @@ -834,11 +834,13 @@ let extract_file (config : gen_config) (ctx : gen_ctx) (filename : string) custom_includes; Printf.fprintf out "Module %s.\n" module_name | Lean -> - Printf.fprintf out "import Base.Primitives\n"; + Printf.fprintf out "import Base\n"; (* Add the custom imports *) List.iter (fun m -> Printf.fprintf out "import %s\n" m) custom_imports; (* Add the custom includes *) - List.iter (fun m -> Printf.fprintf out "import %s\n" m) custom_includes + List.iter (fun m -> Printf.fprintf out "import %s\n" m) custom_includes; + (* Always open the Primitives namespace *) + Printf.fprintf out "open Primitives\n" | HOL4 -> Printf.fprintf out "open primitivesLib divDefLib\n"; (* Add the custom imports and includes *) @@ -903,6 +905,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) : fmt; indent_incr = 2; use_opaque_pre = !Config.split_files; + use_dep_ite = !Config.backend = Lean && !Config.extract_decreases_clauses; } in @@ -1019,7 +1022,6 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) : create more directories *) if !Config.backend = Lean then ( let ( ^^ ) = Filename.concat in - mkdir_if (dest_dir ^^ "Base"); if !Config.split_files then mkdir_if (dest_dir ^^ module_name); if needs_clauses_module then ( assert !Config.split_files; @@ -1033,7 +1035,7 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) : match !Config.backend with | FStar -> Some ("/backends/fstar/Primitives.fst", "Primitives.fst") | Coq -> Some ("/backends/coq/Primitives.v", "Primitives.v") - | Lean -> Some ("/backends/lean/Primitives.lean", "Base/Primitives.lean") + | Lean -> None | HOL4 -> None in match primitives_src_dest with @@ -1265,38 +1267,36 @@ let translate_crate (filename : string) (dest_dir : string) (crate : A.crate) : log#linfo (lazy ("Generated: " ^ filename))); (* - * Generate the lakefile.lean file + * Generate the lakefile.lean file, if the user asks for it *) + if !Config.lean_gen_lakefile then ( + (* Open the file *) + let filename = Filename.concat dest_dir "lakefile.lean" in + let out = open_out filename in - (* Open the file *) - let filename = Filename.concat dest_dir "lakefile.lean" in - let out = open_out filename in - - (* Generate the content *) - Printf.fprintf out "import Lake\nopen Lake DSL\n\n"; - Printf.fprintf out "require mathlib from git\n"; - Printf.fprintf out - " \"https://github.com/leanprover-community/mathlib4.git\"\n\n"; - - let package_name = StringUtils.to_snake_case module_name in - Printf.fprintf out "package «%s» {}\n\n" package_name; - - Printf.fprintf out "lean_lib «Base» {}\n\n"; - - Printf.fprintf out "@[default_target]\nlean_lib «%s» {}\n" module_name; - - (* No default target for now. - Format would be: - {[ - @[default_target] - lean_exe «package_name» { - root := `Main - } - ]} - *) + (* Generate the content *) + Printf.fprintf out "import Lake\nopen Lake DSL\n\n"; + Printf.fprintf out "require mathlib from git\n"; + Printf.fprintf out + " \"https://github.com/leanprover-community/mathlib4.git\"\n\n"; + + let package_name = StringUtils.to_snake_case module_name in + Printf.fprintf out "package «%s» {}\n\n" package_name; + + Printf.fprintf out "@[default_target]\nlean_lib «%s» {}\n" module_name; + + (* No default target for now. + Format would be: + {[ + @[default_target] + lean_exe «package_name» { + root := `Main + } + ]} + *) - (* Flush and close the file *) - close_out out; + (* Flush and close the file *) + close_out out; - (* Logging *) - log#linfo (lazy ("Generated: " ^ filename)) + (* Logging *) + log#linfo (lazy ("Generated: " ^ filename))) diff --git a/tests/lean/.gitignore b/tests/lean/.gitignore index e74f9899..4d1c5853 100644 --- a/tests/lean/.gitignore +++ b/tests/lean/.gitignore @@ -1,2 +1,2 @@ -*/lake-packages/ -*/build/
\ No newline at end of file +lake-packages +build
\ No newline at end of file diff --git a/tests/lean/BetreeMain.lean b/tests/lean/BetreeMain.lean new file mode 100644 index 00000000..5f307877 --- /dev/null +++ b/tests/lean/BetreeMain.lean @@ -0,0 +1 @@ +import BetreeMain.Funs diff --git a/tests/lean/BetreeMain/Funs.lean b/tests/lean/BetreeMain/Funs.lean new file mode 100644 index 00000000..fb48b3a6 --- /dev/null +++ b/tests/lean/BetreeMain/Funs.lean @@ -0,0 +1,1071 @@ +-- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS +-- [betree_main]: function definitions +import Base +import BetreeMain.Types +import BetreeMain.ExternalFuns +open Primitives + +/- [betree_main::betree::load_internal_node] -/ +def betree_load_internal_node_fwd + (id : U64) (st : State) : + Result (State × (betree_list_t (U64 × betree_message_t))) + := + opaque_defs.betree_utils_load_internal_node_fwd id st + +/- [betree_main::betree::store_internal_node] -/ +def betree_store_internal_node_fwd + (id : U64) (content : betree_list_t (U64 × betree_message_t)) (st : State) : + Result (State × Unit) + := + do + let (st0, _) ← + opaque_defs.betree_utils_store_internal_node_fwd id content st + Result.ret (st0, ()) + +/- [betree_main::betree::load_leaf_node] -/ +def betree_load_leaf_node_fwd + (id : U64) (st : State) : Result (State × (betree_list_t (U64 × U64))) := + opaque_defs.betree_utils_load_leaf_node_fwd id st + +/- [betree_main::betree::store_leaf_node] -/ +def betree_store_leaf_node_fwd + (id : U64) (content : betree_list_t (U64 × U64)) (st : State) : + Result (State × Unit) + := + do + let (st0, _) ← opaque_defs.betree_utils_store_leaf_node_fwd id content st + Result.ret (st0, ()) + +/- [betree_main::betree::fresh_node_id] -/ +def betree_fresh_node_id_fwd (counter : U64) : Result U64 := + do + let _ ← counter + (U64.ofInt 1 (by intlit)) + Result.ret counter + +/- [betree_main::betree::fresh_node_id] -/ +def betree_fresh_node_id_back (counter : U64) : Result U64 := + counter + (U64.ofInt 1 (by intlit)) + +/- [betree_main::betree::NodeIdCounter::{0}::new] -/ +def betree_node_id_counter_new_fwd : Result betree_node_id_counter_t := + Result.ret + { betree_node_id_counter_next_node_id := (U64.ofInt 0 (by intlit)) } + +/- [betree_main::betree::NodeIdCounter::{0}::fresh_id] -/ +def betree_node_id_counter_fresh_id_fwd + (self : betree_node_id_counter_t) : Result U64 := + do + let _ ← self.betree_node_id_counter_next_node_id + + (U64.ofInt 1 (by intlit)) + Result.ret self.betree_node_id_counter_next_node_id + +/- [betree_main::betree::NodeIdCounter::{0}::fresh_id] -/ +def betree_node_id_counter_fresh_id_back + (self : betree_node_id_counter_t) : Result betree_node_id_counter_t := + do + let i ← self.betree_node_id_counter_next_node_id + + (U64.ofInt 1 (by intlit)) + Result.ret { betree_node_id_counter_next_node_id := i } + +/- [core::num::u64::{10}::MAX] -/ +def core_num_u64_max_body : Result U64 := + Result.ret (U64.ofInt 18446744073709551615 (by intlit)) +def core_num_u64_max_c : U64 := eval_global core_num_u64_max_body (by simp) + +/- [betree_main::betree::upsert_update] -/ +def betree_upsert_update_fwd + (prev : Option U64) (st : betree_upsert_fun_state_t) : Result U64 := + match h: prev with + | Option.none => + match h: st with + | betree_upsert_fun_state_t.Add v => Result.ret v + | betree_upsert_fun_state_t.Sub i => Result.ret (U64.ofInt 0 (by intlit)) + | Option.some prev0 => + match h: st with + | betree_upsert_fun_state_t.Add v => + do + let margin ← core_num_u64_max_c - prev0 + if margin >= v + then prev0 + v + else Result.ret core_num_u64_max_c + | betree_upsert_fun_state_t.Sub v => + if prev0 >= v + then prev0 - v + else Result.ret (U64.ofInt 0 (by intlit)) + +/- [betree_main::betree::List::{1}::len] -/ +divergent def betree_list_len_fwd + (T : Type) (self : betree_list_t T) : Result U64 := + match h: self with + | betree_list_t.Cons t tl => + do + let i ← betree_list_len_fwd T tl + (U64.ofInt 1 (by intlit)) + i + | betree_list_t.Nil => Result.ret (U64.ofInt 0 (by intlit)) + +/- [betree_main::betree::List::{1}::split_at] -/ +divergent def betree_list_split_at_fwd + (T : Type) (self : betree_list_t T) (n : U64) : + Result ((betree_list_t T) × (betree_list_t T)) + := + if n = (U64.ofInt 0 (by intlit)) + then Result.ret (betree_list_t.Nil, self) + else + match h: self with + | betree_list_t.Cons hd tl => + do + let i ← n - (U64.ofInt 1 (by intlit)) + let p ← betree_list_split_at_fwd T tl i + let (ls0, ls1) := p + let l := ls0 + Result.ret (betree_list_t.Cons hd l, ls1) + | betree_list_t.Nil => Result.fail Error.panic + +/- [betree_main::betree::List::{1}::push_front] -/ +def betree_list_push_front_fwd_back + (T : Type) (self : betree_list_t T) (x : T) : Result (betree_list_t T) := + let tl := mem_replace_fwd (betree_list_t T) self betree_list_t.Nil + let l := tl + Result.ret (betree_list_t.Cons x l) + +/- [betree_main::betree::List::{1}::pop_front] -/ +def betree_list_pop_front_fwd (T : Type) (self : betree_list_t T) : Result T := + let ls := mem_replace_fwd (betree_list_t T) self betree_list_t.Nil + match h: ls with + | betree_list_t.Cons x tl => Result.ret x + | betree_list_t.Nil => Result.fail Error.panic + +/- [betree_main::betree::List::{1}::pop_front] -/ +def betree_list_pop_front_back + (T : Type) (self : betree_list_t T) : Result (betree_list_t T) := + let ls := mem_replace_fwd (betree_list_t T) self betree_list_t.Nil + match h: ls with + | betree_list_t.Cons x tl => Result.ret tl + | betree_list_t.Nil => Result.fail Error.panic + +/- [betree_main::betree::List::{1}::hd] -/ +def betree_list_hd_fwd (T : Type) (self : betree_list_t T) : Result T := + match h: self with + | betree_list_t.Cons hd l => Result.ret hd + | betree_list_t.Nil => Result.fail Error.panic + +/- [betree_main::betree::List::{2}::head_has_key] -/ +def betree_list_head_has_key_fwd + (T : Type) (self : betree_list_t (U64 × T)) (key : U64) : Result Bool := + match h: self with + | betree_list_t.Cons hd l => let (i, _) := hd + Result.ret (i = key) + | betree_list_t.Nil => Result.ret false + +/- [betree_main::betree::List::{2}::partition_at_pivot] -/ +divergent def betree_list_partition_at_pivot_fwd + (T : Type) (self : betree_list_t (U64 × T)) (pivot : U64) : + Result ((betree_list_t (U64 × T)) × (betree_list_t (U64 × T))) + := + match h: self with + | betree_list_t.Cons hd tl => + let (i, t) := hd + if i >= pivot + then Result.ret (betree_list_t.Nil, betree_list_t.Cons (i, t) tl) + else + do + let p ← betree_list_partition_at_pivot_fwd T tl pivot + let (ls0, ls1) := p + let l := ls0 + Result.ret (betree_list_t.Cons (i, t) l, ls1) + | betree_list_t.Nil => Result.ret (betree_list_t.Nil, betree_list_t.Nil) + +/- [betree_main::betree::Leaf::{3}::split] -/ +def betree_leaf_split_fwd + (self : betree_leaf_t) (content : betree_list_t (U64 × U64)) + (params : betree_params_t) (node_id_cnt : betree_node_id_counter_t) + (st : State) : + Result (State × betree_internal_t) + := + do + let p ← + betree_list_split_at_fwd (U64 × U64) content + params.betree_params_split_size + let (content0, content1) := p + let p0 ← betree_list_hd_fwd (U64 × U64) content1 + let (pivot, _) := p0 + let id0 ← betree_node_id_counter_fresh_id_fwd node_id_cnt + let node_id_cnt0 ← betree_node_id_counter_fresh_id_back node_id_cnt + let id1 ← betree_node_id_counter_fresh_id_fwd node_id_cnt0 + let (st0, _) ← betree_store_leaf_node_fwd id0 content0 st + let (st1, _) ← betree_store_leaf_node_fwd id1 content1 st0 + let n := betree_node_t.Leaf + { + betree_leaf_id := id0, + betree_leaf_size := params.betree_params_split_size + } + let n0 := betree_node_t.Leaf + { + betree_leaf_id := id1, + betree_leaf_size := params.betree_params_split_size + } + Result.ret (st1, mkbetree_internal_t self.betree_leaf_id pivot n n0) + +/- [betree_main::betree::Leaf::{3}::split] -/ +def betree_leaf_split_back + (self : betree_leaf_t) (content : betree_list_t (U64 × U64)) + (params : betree_params_t) (node_id_cnt : betree_node_id_counter_t) + (st : State) : + Result betree_node_id_counter_t + := + do + let p ← + betree_list_split_at_fwd (U64 × U64) content + params.betree_params_split_size + let (content0, content1) := p + let _ ← betree_list_hd_fwd (U64 × U64) content1 + let id0 ← betree_node_id_counter_fresh_id_fwd node_id_cnt + let node_id_cnt0 ← betree_node_id_counter_fresh_id_back node_id_cnt + let id1 ← betree_node_id_counter_fresh_id_fwd node_id_cnt0 + let (st0, _) ← betree_store_leaf_node_fwd id0 content0 st + let _ ← betree_store_leaf_node_fwd id1 content1 st0 + betree_node_id_counter_fresh_id_back node_id_cnt0 + +/- [betree_main::betree::Node::{5}::lookup_in_bindings] -/ +divergent def betree_node_lookup_in_bindings_fwd + (key : U64) (bindings : betree_list_t (U64 × U64)) : Result (Option U64) := + match h: bindings with + | betree_list_t.Cons hd tl => + let (i, i0) := hd + if i = key + then Result.ret (Option.some i0) + else + if i > key + then Result.ret Option.none + else betree_node_lookup_in_bindings_fwd key tl + | betree_list_t.Nil => Result.ret Option.none + +/- [betree_main::betree::Node::{5}::lookup_first_message_for_key] -/ +divergent def betree_node_lookup_first_message_for_key_fwd + (key : U64) (msgs : betree_list_t (U64 × betree_message_t)) : + Result (betree_list_t (U64 × betree_message_t)) + := + match h: msgs with + | betree_list_t.Cons x next_msgs => + let (i, m) := x + if i >= key + then Result.ret (betree_list_t.Cons (i, m) next_msgs) + else betree_node_lookup_first_message_for_key_fwd key next_msgs + | betree_list_t.Nil => Result.ret betree_list_t.Nil + +/- [betree_main::betree::Node::{5}::lookup_first_message_for_key] -/ +divergent def betree_node_lookup_first_message_for_key_back + (key : U64) (msgs : betree_list_t (U64 × betree_message_t)) + (ret0 : betree_list_t (U64 × betree_message_t)) : + Result (betree_list_t (U64 × betree_message_t)) + := + match h: msgs with + | betree_list_t.Cons x next_msgs => + let (i, m) := x + if i >= key + then Result.ret ret0 + else + do + let next_msgs0 ← + betree_node_lookup_first_message_for_key_back key next_msgs ret0 + Result.ret (betree_list_t.Cons (i, m) next_msgs0) + | betree_list_t.Nil => Result.ret ret0 + +/- [betree_main::betree::Node::{5}::apply_upserts] -/ +divergent def betree_node_apply_upserts_fwd + (msgs : betree_list_t (U64 × betree_message_t)) (prev : Option U64) + (key : U64) (st : State) : + Result (State × U64) + := + do + let b ← betree_list_head_has_key_fwd betree_message_t msgs key + if b + then + do + let msg ← betree_list_pop_front_fwd (U64 × betree_message_t) msgs + let (_, m) := msg + match h: m with + | betree_message_t.Insert i => Result.fail Error.panic + | betree_message_t.Delete => Result.fail Error.panic + | betree_message_t.Upsert s => + do + let v ← betree_upsert_update_fwd prev s + let msgs0 ← + betree_list_pop_front_back (U64 × betree_message_t) msgs + betree_node_apply_upserts_fwd msgs0 (Option.some v) key st + else + do + let (st0, v) ← opaque_defs.core_option_option_unwrap_fwd U64 prev st + let _ ← + betree_list_push_front_fwd_back (U64 × betree_message_t) msgs (key, + betree_message_t.Insert v) + Result.ret (st0, v) + +/- [betree_main::betree::Node::{5}::apply_upserts] -/ +divergent def betree_node_apply_upserts_back + (msgs : betree_list_t (U64 × betree_message_t)) (prev : Option U64) + (key : U64) (st : State) : + Result (betree_list_t (U64 × betree_message_t)) + := + do + let b ← betree_list_head_has_key_fwd betree_message_t msgs key + if b + then + do + let msg ← betree_list_pop_front_fwd (U64 × betree_message_t) msgs + let (_, m) := msg + match h: m with + | betree_message_t.Insert i => Result.fail Error.panic + | betree_message_t.Delete => Result.fail Error.panic + | betree_message_t.Upsert s => + do + let v ← betree_upsert_update_fwd prev s + let msgs0 ← + betree_list_pop_front_back (U64 × betree_message_t) msgs + betree_node_apply_upserts_back msgs0 (Option.some v) key st + else + do + let (_, v) ← opaque_defs.core_option_option_unwrap_fwd U64 prev st + betree_list_push_front_fwd_back (U64 × betree_message_t) msgs (key, + betree_message_t.Insert v) + +/- [betree_main::betree::Node::{5}::lookup] -/ +mutual divergent def betree_node_lookup_fwd + (self : betree_node_t) (key : U64) (st : State) : + Result (State × (Option U64)) + := + match h: self with + | betree_node_t.Internal node => + do + let (mkbetree_internal_t i i0 n n0) := node + let (st0, msgs) ← betree_load_internal_node_fwd i st + let pending ← betree_node_lookup_first_message_for_key_fwd key msgs + match h: pending with + | betree_list_t.Cons p l => + let (k, msg) := p + if k != key + then + do + let (st1, opt) ← + betree_internal_lookup_in_children_fwd (mkbetree_internal_t i i0 + n n0) key st0 + let _ ← + betree_node_lookup_first_message_for_key_back key msgs + (betree_list_t.Cons (k, msg) l) + Result.ret (st1, opt) + else + match h: msg with + | betree_message_t.Insert v => + do + let _ ← + betree_node_lookup_first_message_for_key_back key msgs + (betree_list_t.Cons (k, betree_message_t.Insert v) l) + Result.ret (st0, Option.some v) + | betree_message_t.Delete => + do + let _ ← + betree_node_lookup_first_message_for_key_back key msgs + (betree_list_t.Cons (k, betree_message_t.Delete) l) + Result.ret (st0, Option.none) + | betree_message_t.Upsert ufs => + do + let (st1, v) ← + betree_internal_lookup_in_children_fwd (mkbetree_internal_t i + i0 n n0) key st0 + let (st2, v0) ← + betree_node_apply_upserts_fwd (betree_list_t.Cons (k, + betree_message_t.Upsert ufs) l) v key st1 + let node0 ← + betree_internal_lookup_in_children_back (mkbetree_internal_t i + i0 n n0) key st0 + let (mkbetree_internal_t i1 _ _ _) := node0 + let pending0 ← + betree_node_apply_upserts_back (betree_list_t.Cons (k, + betree_message_t.Upsert ufs) l) v key st1 + let msgs0 ← + betree_node_lookup_first_message_for_key_back key msgs pending0 + let (st3, _) ← betree_store_internal_node_fwd i1 msgs0 st2 + Result.ret (st3, Option.some v0) + | betree_list_t.Nil => + do + let (st1, opt) ← + betree_internal_lookup_in_children_fwd (mkbetree_internal_t i i0 n + n0) key st0 + let _ ← + betree_node_lookup_first_message_for_key_back key msgs + betree_list_t.Nil + Result.ret (st1, opt) + | betree_node_t.Leaf node => + do + let (st0, bindings) ← betree_load_leaf_node_fwd node.betree_leaf_id st + let opt ← betree_node_lookup_in_bindings_fwd key bindings + Result.ret (st0, opt) + +/- [betree_main::betree::Node::{5}::lookup] -/ +divergent def betree_node_lookup_back + (self : betree_node_t) (key : U64) (st : State) : Result betree_node_t := + match h: self with + | betree_node_t.Internal node => + do + let (mkbetree_internal_t i i0 n n0) := node + let (st0, msgs) ← betree_load_internal_node_fwd i st + let pending ← betree_node_lookup_first_message_for_key_fwd key msgs + match h: pending with + | betree_list_t.Cons p l => + let (k, msg) := p + if k != key + then + do + let _ ← + betree_node_lookup_first_message_for_key_back key msgs + (betree_list_t.Cons (k, msg) l) + let node0 ← + betree_internal_lookup_in_children_back (mkbetree_internal_t i i0 + n n0) key st0 + Result.ret (betree_node_t.Internal node0) + else + match h: msg with + | betree_message_t.Insert v => + do + let _ ← + betree_node_lookup_first_message_for_key_back key msgs + (betree_list_t.Cons (k, betree_message_t.Insert v) l) + Result.ret (betree_node_t.Internal (mkbetree_internal_t i i0 n + n0)) + | betree_message_t.Delete => + do + let _ ← + betree_node_lookup_first_message_for_key_back key msgs + (betree_list_t.Cons (k, betree_message_t.Delete) l) + Result.ret (betree_node_t.Internal (mkbetree_internal_t i i0 n + n0)) + | betree_message_t.Upsert ufs => + do + let (st1, v) ← + betree_internal_lookup_in_children_fwd (mkbetree_internal_t i + i0 n n0) key st0 + let (st2, _) ← + betree_node_apply_upserts_fwd (betree_list_t.Cons (k, + betree_message_t.Upsert ufs) l) v key st1 + let node0 ← + betree_internal_lookup_in_children_back (mkbetree_internal_t i + i0 n n0) key st0 + let (mkbetree_internal_t i1 i2 n1 n2) := node0 + let pending0 ← + betree_node_apply_upserts_back (betree_list_t.Cons (k, + betree_message_t.Upsert ufs) l) v key st1 + let msgs0 ← + betree_node_lookup_first_message_for_key_back key msgs pending0 + let _ ← betree_store_internal_node_fwd i1 msgs0 st2 + Result.ret (betree_node_t.Internal (mkbetree_internal_t i1 i2 n1 + n2)) + | betree_list_t.Nil => + do + let _ ← + betree_node_lookup_first_message_for_key_back key msgs + betree_list_t.Nil + let node0 ← + betree_internal_lookup_in_children_back (mkbetree_internal_t i i0 n + n0) key st0 + Result.ret (betree_node_t.Internal node0) + | betree_node_t.Leaf node => + do + let (_, bindings) ← betree_load_leaf_node_fwd node.betree_leaf_id st + let _ ← betree_node_lookup_in_bindings_fwd key bindings + Result.ret (betree_node_t.Leaf node) + +/- [betree_main::betree::Internal::{4}::lookup_in_children] -/ +divergent def betree_internal_lookup_in_children_fwd + (self : betree_internal_t) (key : U64) (st : State) : + Result (State × (Option U64)) + := + let (mkbetree_internal_t _ i n n0) := self + if key < i + then betree_node_lookup_fwd n key st + else betree_node_lookup_fwd n0 key st + +/- [betree_main::betree::Internal::{4}::lookup_in_children] -/ +divergent def betree_internal_lookup_in_children_back + (self : betree_internal_t) (key : U64) (st : State) : + Result betree_internal_t + := + let (mkbetree_internal_t i i0 n n0) := self + if key < i0 + then + do + let n1 ← betree_node_lookup_back n key st + Result.ret (mkbetree_internal_t i i0 n1 n0) + else + do + let n1 ← betree_node_lookup_back n0 key st + Result.ret (mkbetree_internal_t i i0 n n1) + +end + +/- [betree_main::betree::Node::{5}::lookup_mut_in_bindings] -/ +divergent def betree_node_lookup_mut_in_bindings_fwd + (key : U64) (bindings : betree_list_t (U64 × U64)) : + Result (betree_list_t (U64 × U64)) + := + match h: bindings with + | betree_list_t.Cons hd tl => + let (i, i0) := hd + if i >= key + then Result.ret (betree_list_t.Cons (i, i0) tl) + else betree_node_lookup_mut_in_bindings_fwd key tl + | betree_list_t.Nil => Result.ret betree_list_t.Nil + +/- [betree_main::betree::Node::{5}::lookup_mut_in_bindings] -/ +divergent def betree_node_lookup_mut_in_bindings_back + (key : U64) (bindings : betree_list_t (U64 × U64)) + (ret0 : betree_list_t (U64 × U64)) : + Result (betree_list_t (U64 × U64)) + := + match h: bindings with + | betree_list_t.Cons hd tl => + let (i, i0) := hd + if i >= key + then Result.ret ret0 + else + do + let tl0 ← betree_node_lookup_mut_in_bindings_back key tl ret0 + Result.ret (betree_list_t.Cons (i, i0) tl0) + | betree_list_t.Nil => Result.ret ret0 + +/- [betree_main::betree::Node::{5}::apply_to_leaf] -/ +def betree_node_apply_to_leaf_fwd_back + (bindings : betree_list_t (U64 × U64)) (key : U64) + (new_msg : betree_message_t) : + Result (betree_list_t (U64 × U64)) + := + do + let bindings0 ← betree_node_lookup_mut_in_bindings_fwd key bindings + let b ← betree_list_head_has_key_fwd U64 bindings0 key + if b + then + do + let hd ← betree_list_pop_front_fwd (U64 × U64) bindings0 + match h: new_msg with + | betree_message_t.Insert v => + do + let bindings1 ← betree_list_pop_front_back (U64 × U64) bindings0 + let bindings2 ← + betree_list_push_front_fwd_back (U64 × U64) bindings1 (key, v) + betree_node_lookup_mut_in_bindings_back key bindings bindings2 + | betree_message_t.Delete => + do + let bindings1 ← betree_list_pop_front_back (U64 × U64) bindings0 + betree_node_lookup_mut_in_bindings_back key bindings bindings1 + | betree_message_t.Upsert s => + do + let (_, i) := hd + let v ← betree_upsert_update_fwd (Option.some i) s + let bindings1 ← betree_list_pop_front_back (U64 × U64) bindings0 + let bindings2 ← + betree_list_push_front_fwd_back (U64 × U64) bindings1 (key, v) + betree_node_lookup_mut_in_bindings_back key bindings bindings2 + else + match h: new_msg with + | betree_message_t.Insert v => + do + let bindings1 ← + betree_list_push_front_fwd_back (U64 × U64) bindings0 (key, v) + betree_node_lookup_mut_in_bindings_back key bindings bindings1 + | betree_message_t.Delete => + betree_node_lookup_mut_in_bindings_back key bindings bindings0 + | betree_message_t.Upsert s => + do + let v ← betree_upsert_update_fwd Option.none s + let bindings1 ← + betree_list_push_front_fwd_back (U64 × U64) bindings0 (key, v) + betree_node_lookup_mut_in_bindings_back key bindings bindings1 + +/- [betree_main::betree::Node::{5}::apply_messages_to_leaf] -/ +divergent def betree_node_apply_messages_to_leaf_fwd_back + (bindings : betree_list_t (U64 × U64)) + (new_msgs : betree_list_t (U64 × betree_message_t)) : + Result (betree_list_t (U64 × U64)) + := + match h: new_msgs with + | betree_list_t.Cons new_msg new_msgs_tl => + do + let (i, m) := new_msg + let bindings0 ← betree_node_apply_to_leaf_fwd_back bindings i m + betree_node_apply_messages_to_leaf_fwd_back bindings0 new_msgs_tl + | betree_list_t.Nil => Result.ret bindings + +/- [betree_main::betree::Node::{5}::filter_messages_for_key] -/ +divergent def betree_node_filter_messages_for_key_fwd_back + (key : U64) (msgs : betree_list_t (U64 × betree_message_t)) : + Result (betree_list_t (U64 × betree_message_t)) + := + match h: msgs with + | betree_list_t.Cons p l => + let (k, m) := p + if k = key + then + do + let msgs0 ← + betree_list_pop_front_back (U64 × betree_message_t) + (betree_list_t.Cons (k, m) l) + betree_node_filter_messages_for_key_fwd_back key msgs0 + else Result.ret (betree_list_t.Cons (k, m) l) + | betree_list_t.Nil => Result.ret betree_list_t.Nil + +/- [betree_main::betree::Node::{5}::lookup_first_message_after_key] -/ +divergent def betree_node_lookup_first_message_after_key_fwd + (key : U64) (msgs : betree_list_t (U64 × betree_message_t)) : + Result (betree_list_t (U64 × betree_message_t)) + := + match h: msgs with + | betree_list_t.Cons p next_msgs => + let (k, m) := p + if k = key + then betree_node_lookup_first_message_after_key_fwd key next_msgs + else Result.ret (betree_list_t.Cons (k, m) next_msgs) + | betree_list_t.Nil => Result.ret betree_list_t.Nil + +/- [betree_main::betree::Node::{5}::lookup_first_message_after_key] -/ +divergent def betree_node_lookup_first_message_after_key_back + (key : U64) (msgs : betree_list_t (U64 × betree_message_t)) + (ret0 : betree_list_t (U64 × betree_message_t)) : + Result (betree_list_t (U64 × betree_message_t)) + := + match h: msgs with + | betree_list_t.Cons p next_msgs => + let (k, m) := p + if k = key + then + do + let next_msgs0 ← + betree_node_lookup_first_message_after_key_back key next_msgs ret0 + Result.ret (betree_list_t.Cons (k, m) next_msgs0) + else Result.ret ret0 + | betree_list_t.Nil => Result.ret ret0 + +/- [betree_main::betree::Node::{5}::apply_to_internal] -/ +def betree_node_apply_to_internal_fwd_back + (msgs : betree_list_t (U64 × betree_message_t)) (key : U64) + (new_msg : betree_message_t) : + Result (betree_list_t (U64 × betree_message_t)) + := + do + let msgs0 ← betree_node_lookup_first_message_for_key_fwd key msgs + let b ← betree_list_head_has_key_fwd betree_message_t msgs0 key + if b + then + match h: new_msg with + | betree_message_t.Insert i => + do + let msgs1 ← betree_node_filter_messages_for_key_fwd_back key msgs0 + let msgs2 ← + betree_list_push_front_fwd_back (U64 × betree_message_t) msgs1 + (key, betree_message_t.Insert i) + betree_node_lookup_first_message_for_key_back key msgs msgs2 + | betree_message_t.Delete => + do + let msgs1 ← betree_node_filter_messages_for_key_fwd_back key msgs0 + let msgs2 ← + betree_list_push_front_fwd_back (U64 × betree_message_t) msgs1 + (key, betree_message_t.Delete) + betree_node_lookup_first_message_for_key_back key msgs msgs2 + | betree_message_t.Upsert s => + do + let p ← betree_list_hd_fwd (U64 × betree_message_t) msgs0 + let (_, m) := p + match h: m with + | betree_message_t.Insert prev => + do + let v ← betree_upsert_update_fwd (Option.some prev) s + let msgs1 ← + betree_list_pop_front_back (U64 × betree_message_t) msgs0 + let msgs2 ← + betree_list_push_front_fwd_back (U64 × betree_message_t) msgs1 + (key, betree_message_t.Insert v) + betree_node_lookup_first_message_for_key_back key msgs msgs2 + | betree_message_t.Delete => + do + let v ← betree_upsert_update_fwd Option.none s + let msgs1 ← + betree_list_pop_front_back (U64 × betree_message_t) msgs0 + let msgs2 ← + betree_list_push_front_fwd_back (U64 × betree_message_t) msgs1 + (key, betree_message_t.Insert v) + betree_node_lookup_first_message_for_key_back key msgs msgs2 + | betree_message_t.Upsert ufs => + do + let msgs1 ← + betree_node_lookup_first_message_after_key_fwd key msgs0 + let msgs2 ← + betree_list_push_front_fwd_back (U64 × betree_message_t) msgs1 + (key, betree_message_t.Upsert s) + let msgs3 ← + betree_node_lookup_first_message_after_key_back key msgs0 msgs2 + betree_node_lookup_first_message_for_key_back key msgs msgs3 + else + do + let msgs1 ← + betree_list_push_front_fwd_back (U64 × betree_message_t) msgs0 (key, + new_msg) + betree_node_lookup_first_message_for_key_back key msgs msgs1 + +/- [betree_main::betree::Node::{5}::apply_messages_to_internal] -/ +divergent def betree_node_apply_messages_to_internal_fwd_back + (msgs : betree_list_t (U64 × betree_message_t)) + (new_msgs : betree_list_t (U64 × betree_message_t)) : + Result (betree_list_t (U64 × betree_message_t)) + := + match h: new_msgs with + | betree_list_t.Cons new_msg new_msgs_tl => + do + let (i, m) := new_msg + let msgs0 ← betree_node_apply_to_internal_fwd_back msgs i m + betree_node_apply_messages_to_internal_fwd_back msgs0 new_msgs_tl + | betree_list_t.Nil => Result.ret msgs + +/- [betree_main::betree::Node::{5}::apply_messages] -/ +mutual divergent def betree_node_apply_messages_fwd + (self : betree_node_t) (params : betree_params_t) + (node_id_cnt : betree_node_id_counter_t) + (msgs : betree_list_t (U64 × betree_message_t)) (st : State) : + Result (State × Unit) + := + match h: self with + | betree_node_t.Internal node => + do + let (mkbetree_internal_t i i0 n n0) := node + let (st0, content) ← betree_load_internal_node_fwd i st + let content0 ← + betree_node_apply_messages_to_internal_fwd_back content msgs + let num_msgs ← betree_list_len_fwd (U64 × betree_message_t) content0 + if num_msgs >= params.betree_params_min_flush_size + then + do + let (st1, content1) ← + betree_internal_flush_fwd (mkbetree_internal_t i i0 n n0) params + node_id_cnt content0 st0 + let (node0, _) ← + betree_internal_flush_back (mkbetree_internal_t i i0 n n0) params + node_id_cnt content0 st0 + let (mkbetree_internal_t i1 _ _ _) := node0 + let (st2, _) ← betree_store_internal_node_fwd i1 content1 st1 + Result.ret (st2, ()) + else + do + let (st1, _) ← betree_store_internal_node_fwd i content0 st0 + Result.ret (st1, ()) + | betree_node_t.Leaf node => + do + let (st0, content) ← betree_load_leaf_node_fwd node.betree_leaf_id st + let content0 ← betree_node_apply_messages_to_leaf_fwd_back content msgs + let len ← betree_list_len_fwd (U64 × U64) content0 + let i ← (U64.ofInt 2 (by intlit)) * params.betree_params_split_size + if len >= i + then + do + let (st1, _) ← + betree_leaf_split_fwd node content0 params node_id_cnt st0 + let (st2, _) ← + betree_store_leaf_node_fwd node.betree_leaf_id betree_list_t.Nil + st1 + Result.ret (st2, ()) + else + do + let (st1, _) ← + betree_store_leaf_node_fwd node.betree_leaf_id content0 st0 + Result.ret (st1, ()) + +/- [betree_main::betree::Node::{5}::apply_messages] -/ +divergent def betree_node_apply_messages_back + (self : betree_node_t) (params : betree_params_t) + (node_id_cnt : betree_node_id_counter_t) + (msgs : betree_list_t (U64 × betree_message_t)) (st : State) : + Result (betree_node_t × betree_node_id_counter_t) + := + match h: self with + | betree_node_t.Internal node => + do + let (mkbetree_internal_t i i0 n n0) := node + let (st0, content) ← betree_load_internal_node_fwd i st + let content0 ← + betree_node_apply_messages_to_internal_fwd_back content msgs + let num_msgs ← betree_list_len_fwd (U64 × betree_message_t) content0 + if num_msgs >= params.betree_params_min_flush_size + then + do + let (st1, content1) ← + betree_internal_flush_fwd (mkbetree_internal_t i i0 n n0) params + node_id_cnt content0 st0 + let (node0, node_id_cnt0) ← + betree_internal_flush_back (mkbetree_internal_t i i0 n n0) params + node_id_cnt content0 st0 + let (mkbetree_internal_t i1 i2 n1 n2) := node0 + let _ ← betree_store_internal_node_fwd i1 content1 st1 + Result.ret (betree_node_t.Internal (mkbetree_internal_t i1 i2 n1 n2), + node_id_cnt0) + else + do + let _ ← betree_store_internal_node_fwd i content0 st0 + Result.ret (betree_node_t.Internal (mkbetree_internal_t i i0 n n0), + node_id_cnt) + | betree_node_t.Leaf node => + do + let (st0, content) ← betree_load_leaf_node_fwd node.betree_leaf_id st + let content0 ← betree_node_apply_messages_to_leaf_fwd_back content msgs + let len ← betree_list_len_fwd (U64 × U64) content0 + let i ← (U64.ofInt 2 (by intlit)) * params.betree_params_split_size + if len >= i + then + do + let (st1, new_node) ← + betree_leaf_split_fwd node content0 params node_id_cnt st0 + let _ ← + betree_store_leaf_node_fwd node.betree_leaf_id betree_list_t.Nil + st1 + let node_id_cnt0 ← + betree_leaf_split_back node content0 params node_id_cnt st0 + Result.ret (betree_node_t.Internal new_node, node_id_cnt0) + else + do + let _ ← betree_store_leaf_node_fwd node.betree_leaf_id content0 st0 + Result.ret (betree_node_t.Leaf { node with betree_leaf_size := len }, + node_id_cnt) + +/- [betree_main::betree::Internal::{4}::flush] -/ +divergent def betree_internal_flush_fwd + (self : betree_internal_t) (params : betree_params_t) + (node_id_cnt : betree_node_id_counter_t) + (content : betree_list_t (U64 × betree_message_t)) (st : State) : + Result (State × (betree_list_t (U64 × betree_message_t))) + := + do + let (mkbetree_internal_t _ i n n0) := self + let p ← betree_list_partition_at_pivot_fwd betree_message_t content i + let (msgs_left, msgs_right) := p + let len_left ← betree_list_len_fwd (U64 × betree_message_t) msgs_left + if len_left >= params.betree_params_min_flush_size + then + do + let (st0, _) ← + betree_node_apply_messages_fwd n params node_id_cnt msgs_left st + let (_, node_id_cnt0) ← + betree_node_apply_messages_back n params node_id_cnt msgs_left st + let len_right ← + betree_list_len_fwd (U64 × betree_message_t) msgs_right + if len_right >= params.betree_params_min_flush_size + then + do + let (st1, _) ← + betree_node_apply_messages_fwd n0 params node_id_cnt0 msgs_right + st0 + let _ ← + betree_node_apply_messages_back n0 params node_id_cnt0 msgs_right + st0 + Result.ret (st1, betree_list_t.Nil) + else Result.ret (st0, msgs_right) + else + do + let (st0, _) ← + betree_node_apply_messages_fwd n0 params node_id_cnt msgs_right st + let _ ← + betree_node_apply_messages_back n0 params node_id_cnt msgs_right st + Result.ret (st0, msgs_left) + +/- [betree_main::betree::Internal::{4}::flush] -/ +divergent def betree_internal_flush_back + (self : betree_internal_t) (params : betree_params_t) + (node_id_cnt : betree_node_id_counter_t) + (content : betree_list_t (U64 × betree_message_t)) (st : State) : + Result (betree_internal_t × betree_node_id_counter_t) + := + do + let (mkbetree_internal_t i i0 n n0) := self + let p ← betree_list_partition_at_pivot_fwd betree_message_t content i0 + let (msgs_left, msgs_right) := p + let len_left ← betree_list_len_fwd (U64 × betree_message_t) msgs_left + if len_left >= params.betree_params_min_flush_size + then + do + let (st0, _) ← + betree_node_apply_messages_fwd n params node_id_cnt msgs_left st + let (n1, node_id_cnt0) ← + betree_node_apply_messages_back n params node_id_cnt msgs_left st + let len_right ← + betree_list_len_fwd (U64 × betree_message_t) msgs_right + if len_right >= params.betree_params_min_flush_size + then + do + let (n2, node_id_cnt1) ← + betree_node_apply_messages_back n0 params node_id_cnt0 msgs_right + st0 + Result.ret (mkbetree_internal_t i i0 n1 n2, node_id_cnt1) + else Result.ret (mkbetree_internal_t i i0 n1 n0, node_id_cnt0) + else + do + let (n1, node_id_cnt0) ← + betree_node_apply_messages_back n0 params node_id_cnt msgs_right st + Result.ret (mkbetree_internal_t i i0 n n1, node_id_cnt0) + +end + +/- [betree_main::betree::Node::{5}::apply] -/ +def betree_node_apply_fwd + (self : betree_node_t) (params : betree_params_t) + (node_id_cnt : betree_node_id_counter_t) (key : U64) + (new_msg : betree_message_t) (st : State) : + Result (State × Unit) + := + do + let l := betree_list_t.Nil + let (st0, _) ← + betree_node_apply_messages_fwd self params node_id_cnt + (betree_list_t.Cons (key, new_msg) l) st + let _ ← + betree_node_apply_messages_back self params node_id_cnt + (betree_list_t.Cons (key, new_msg) l) st + Result.ret (st0, ()) + +/- [betree_main::betree::Node::{5}::apply] -/ +def betree_node_apply_back + (self : betree_node_t) (params : betree_params_t) + (node_id_cnt : betree_node_id_counter_t) (key : U64) + (new_msg : betree_message_t) (st : State) : + Result (betree_node_t × betree_node_id_counter_t) + := + let l := betree_list_t.Nil + betree_node_apply_messages_back self params node_id_cnt (betree_list_t.Cons + (key, new_msg) l) st + +/- [betree_main::betree::BeTree::{6}::new] -/ +def betree_be_tree_new_fwd + (min_flush_size : U64) (split_size : U64) (st : State) : + Result (State × betree_be_tree_t) + := + do + let node_id_cnt ← betree_node_id_counter_new_fwd + let id ← betree_node_id_counter_fresh_id_fwd node_id_cnt + let (st0, _) ← betree_store_leaf_node_fwd id betree_list_t.Nil st + let node_id_cnt0 ← betree_node_id_counter_fresh_id_back node_id_cnt + Result.ret (st0, + { + betree_be_tree_params := + { + betree_params_min_flush_size := min_flush_size, + betree_params_split_size := split_size + }, + betree_be_tree_node_id_cnt := node_id_cnt0, + betree_be_tree_root := + (betree_node_t.Leaf + { + betree_leaf_id := id, + betree_leaf_size := (U64.ofInt 0 (by intlit)) + }) + }) + +/- [betree_main::betree::BeTree::{6}::apply] -/ +def betree_be_tree_apply_fwd + (self : betree_be_tree_t) (key : U64) (msg : betree_message_t) (st : State) : + Result (State × Unit) + := + do + let (st0, _) ← + betree_node_apply_fwd self.betree_be_tree_root self.betree_be_tree_params + self.betree_be_tree_node_id_cnt key msg st + let _ ← + betree_node_apply_back self.betree_be_tree_root + self.betree_be_tree_params self.betree_be_tree_node_id_cnt key msg st + Result.ret (st0, ()) + +/- [betree_main::betree::BeTree::{6}::apply] -/ +def betree_be_tree_apply_back + (self : betree_be_tree_t) (key : U64) (msg : betree_message_t) (st : State) : + Result betree_be_tree_t + := + do + let (n, nic) ← + betree_node_apply_back self.betree_be_tree_root + self.betree_be_tree_params self.betree_be_tree_node_id_cnt key msg st + Result.ret + { self with betree_be_tree_node_id_cnt := nic, betree_be_tree_root := n } + +/- [betree_main::betree::BeTree::{6}::insert] -/ +def betree_be_tree_insert_fwd + (self : betree_be_tree_t) (key : U64) (value : U64) (st : State) : + Result (State × Unit) + := + do + let (st0, _) ← + betree_be_tree_apply_fwd self key (betree_message_t.Insert value) st + let _ ← + betree_be_tree_apply_back self key (betree_message_t.Insert value) st + Result.ret (st0, ()) + +/- [betree_main::betree::BeTree::{6}::insert] -/ +def betree_be_tree_insert_back + (self : betree_be_tree_t) (key : U64) (value : U64) (st : State) : + Result betree_be_tree_t + := + betree_be_tree_apply_back self key (betree_message_t.Insert value) st + +/- [betree_main::betree::BeTree::{6}::delete] -/ +def betree_be_tree_delete_fwd + (self : betree_be_tree_t) (key : U64) (st : State) : + Result (State × Unit) + := + do + let (st0, _) ← + betree_be_tree_apply_fwd self key betree_message_t.Delete st + let _ ← betree_be_tree_apply_back self key betree_message_t.Delete st + Result.ret (st0, ()) + +/- [betree_main::betree::BeTree::{6}::delete] -/ +def betree_be_tree_delete_back + (self : betree_be_tree_t) (key : U64) (st : State) : + Result betree_be_tree_t + := + betree_be_tree_apply_back self key betree_message_t.Delete st + +/- [betree_main::betree::BeTree::{6}::upsert] -/ +def betree_be_tree_upsert_fwd + (self : betree_be_tree_t) (key : U64) (upd : betree_upsert_fun_state_t) + (st : State) : + Result (State × Unit) + := + do + let (st0, _) ← + betree_be_tree_apply_fwd self key (betree_message_t.Upsert upd) st + let _ ← + betree_be_tree_apply_back self key (betree_message_t.Upsert upd) st + Result.ret (st0, ()) + +/- [betree_main::betree::BeTree::{6}::upsert] -/ +def betree_be_tree_upsert_back + (self : betree_be_tree_t) (key : U64) (upd : betree_upsert_fun_state_t) + (st : State) : + Result betree_be_tree_t + := + betree_be_tree_apply_back self key (betree_message_t.Upsert upd) st + +/- [betree_main::betree::BeTree::{6}::lookup] -/ +def betree_be_tree_lookup_fwd + (self : betree_be_tree_t) (key : U64) (st : State) : + Result (State × (Option U64)) + := + betree_node_lookup_fwd self.betree_be_tree_root key st + +/- [betree_main::betree::BeTree::{6}::lookup] -/ +def betree_be_tree_lookup_back + (self : betree_be_tree_t) (key : U64) (st : State) : + Result betree_be_tree_t + := + do + let n ← betree_node_lookup_back self.betree_be_tree_root key st + Result.ret { self with betree_be_tree_root := n } + +/- [betree_main::main] -/ +def main_fwd : Result Unit := + Result.ret () + +/- Unit test for [betree_main::main] -/ +#assert (main_fwd == .ret ()) + diff --git a/tests/lean/BetreeMain/Opaque.lean b/tests/lean/BetreeMain/Opaque.lean new file mode 100644 index 00000000..c8226d4e --- /dev/null +++ b/tests/lean/BetreeMain/Opaque.lean @@ -0,0 +1,31 @@ +-- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS +-- [betree_main]: opaque function definitions +import Base +import BetreeMain.Types +open Primitives + +structure OpaqueDefs where + + /- [betree_main::betree_utils::load_internal_node] -/ + betree_utils_load_internal_node_fwd + : + U64 -> State -> Result (State × (betree_list_t (U64 × betree_message_t))) + + /- [betree_main::betree_utils::store_internal_node] -/ + betree_utils_store_internal_node_fwd + : + U64 -> betree_list_t (U64 × betree_message_t) -> State -> Result (State × + Unit) + + /- [betree_main::betree_utils::load_leaf_node] -/ + betree_utils_load_leaf_node_fwd + : U64 -> State -> Result (State × (betree_list_t (U64 × U64))) + + /- [betree_main::betree_utils::store_leaf_node] -/ + betree_utils_store_leaf_node_fwd + : U64 -> betree_list_t (U64 × U64) -> State -> Result (State × Unit) + + /- [core::option::Option::{0}::unwrap] -/ + core_option_option_unwrap_fwd + (T : Type) : Option T -> State -> Result (State × T) + diff --git a/tests/lean/BetreeMain/Types.lean b/tests/lean/BetreeMain/Types.lean new file mode 100644 index 00000000..4875a8ba --- /dev/null +++ b/tests/lean/BetreeMain/Types.lean @@ -0,0 +1,62 @@ +-- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS +-- [betree_main]: type definitions +import Base +open Primitives + +/- [betree_main::betree::List] -/ +inductive betree_list_t (T : Type) := +| Cons : T -> betree_list_t T -> betree_list_t T +| Nil : betree_list_t T + +/- [betree_main::betree::UpsertFunState] -/ +inductive betree_upsert_fun_state_t := +| Add : U64 -> betree_upsert_fun_state_t +| Sub : U64 -> betree_upsert_fun_state_t + +/- [betree_main::betree::Message] -/ +inductive betree_message_t := +| Insert : U64 -> betree_message_t +| Delete : betree_message_t +| Upsert : betree_upsert_fun_state_t -> betree_message_t + +/- [betree_main::betree::Leaf] -/ +structure betree_leaf_t where + betree_leaf_id : U64 + betree_leaf_size : U64 + +mutual + +/- [betree_main::betree::Node] -/ +inductive betree_node_t := +| Internal : betree_internal_t -> betree_node_t +| Leaf : betree_leaf_t -> betree_node_t + +/- [betree_main::betree::Internal] -/ +inductive betree_internal_t := +| mkbetree_internal_t : + U64 -> + U64 -> + betree_node_t -> + betree_node_t -> + betree_internal_t + +end + +/- [betree_main::betree::Params] -/ +structure betree_params_t where + betree_params_min_flush_size : U64 + betree_params_split_size : U64 + +/- [betree_main::betree::NodeIdCounter] -/ +structure betree_node_id_counter_t where + betree_node_id_counter_next_node_id : U64 + +/- [betree_main::betree::BeTree] -/ +structure betree_be_tree_t where + betree_be_tree_params : betree_params_t + betree_be_tree_node_id_cnt : betree_node_id_counter_t + betree_be_tree_root : betree_node_t + +/- The state type used in the state-error monad -/ +axiom State : Type + diff --git a/tests/lean/misc-constants/Constants.lean b/tests/lean/Constants.lean index 8306ed85..cd2f88f5 100644 --- a/tests/lean/misc-constants/Constants.lean +++ b/tests/lean/Constants.lean @@ -1,6 +1,7 @@ -- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS -- [constants] -import Base.Primitives +import Base +open Primitives /- [constants::X0] -/ def x0_body : Result U32 := Result.ret (U32.ofInt 0 (by intlit)) diff --git a/tests/lean/misc-external/External.lean b/tests/lean/External.lean index b95db309..b95db309 100644 --- a/tests/lean/misc-external/External.lean +++ b/tests/lean/External.lean diff --git a/tests/lean/misc-external/External/Funs.lean b/tests/lean/External/Funs.lean index eeb83989..73e45938 100644 --- a/tests/lean/misc-external/External/Funs.lean +++ b/tests/lean/External/Funs.lean @@ -1,8 +1,9 @@ -- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS -- [external]: function definitions -import Base.Primitives +import Base import External.Types import External.ExternalFuns +open Primitives /- [external::swap] -/ def swap_fwd @@ -39,6 +40,9 @@ def test_vec_fwd : Result Unit := let _ ← vec_push_back U32 v (U32.ofInt 0 (by intlit)) Result.ret () +/- Unit test for [external::test_vec] -/ +#assert (test_vec_fwd == .ret ()) + /- [external::custom_swap] -/ def custom_swap_fwd (T : Type) (x : T) (y : T) (st : State) : Result (State × T) := @@ -78,7 +82,7 @@ def test_swap_non_zero_fwd (x : U32) (st : State) : Result (State × U32) := do let (st0, _) ← swap_fwd U32 x (U32.ofInt 0 (by intlit)) st let (st1, (x0, _)) ← swap_back U32 x (U32.ofInt 0 (by intlit)) st st0 - if h: x0 = (U32.ofInt 0 (by intlit)) + if x0 = (U32.ofInt 0 (by intlit)) then Result.fail Error.panic else Result.ret (st1, x0) diff --git a/tests/lean/misc-external/External/Opaque.lean b/tests/lean/External/Opaque.lean index d641912b..5483c3a9 100644 --- a/tests/lean/misc-external/External/Opaque.lean +++ b/tests/lean/External/Opaque.lean @@ -1,7 +1,8 @@ -- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS -- [external]: opaque function definitions -import Base.Primitives +import Base import External.Types +open Primitives structure OpaqueDefs where diff --git a/tests/lean/misc-external/External/Types.lean b/tests/lean/External/Types.lean index ed1842be..25907da2 100644 --- a/tests/lean/misc-external/External/Types.lean +++ b/tests/lean/External/Types.lean @@ -1,6 +1,7 @@ -- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS -- [external]: type definitions -import Base.Primitives +import Base +open Primitives /- [core::num::nonzero::NonZeroU32] -/ axiom core_num_nonzero_non_zero_u32_t : Type diff --git a/tests/lean/hashmap/Hashmap.lean b/tests/lean/Hashmap.lean index 41630205..41630205 100644 --- a/tests/lean/hashmap/Hashmap.lean +++ b/tests/lean/Hashmap.lean diff --git a/tests/lean/hashmap/Hashmap/Funs.lean b/tests/lean/Hashmap/Funs.lean index 77b1a157..26742d5d 100644 --- a/tests/lean/hashmap/Hashmap/Funs.lean +++ b/tests/lean/Hashmap/Funs.lean @@ -1,28 +1,23 @@ -- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS -- [hashmap]: function definitions -import Base.Primitives +import Base import Hashmap.Types -import Hashmap.Clauses.Clauses +open Primitives /- [hashmap::hash_key] -/ def hash_key_fwd (k : Usize) : Result Usize := Result.ret k /- [hashmap::HashMap::{0}::allocate_slots] -/ -def hash_map_allocate_slots_loop_fwd - (T : Type) (slots : Vec (list_t T)) (n : Usize) : - (Result (Vec (list_t T))) - := - if h: n > (Usize.ofInt 0 (by intlit)) +divergent def hash_map_allocate_slots_loop_fwd + (T : Type) (slots : Vec (list_t T)) (n : Usize) : Result (Vec (list_t T)) := + if n > (Usize.ofInt 0 (by intlit)) then do let slots0 ← vec_push_back (list_t T) slots list_t.Nil let n0 ← n - (Usize.ofInt 1 (by intlit)) hash_map_allocate_slots_loop_fwd T slots0 n0 else Result.ret slots -termination_by hash_map_allocate_slots_loop_fwd slots n => - hash_map_allocate_slots_loop_terminates T slots n -decreasing_by hash_map_allocate_slots_loop_decreases slots n /- [hashmap::HashMap::{0}::allocate_slots] -/ def hash_map_allocate_slots_fwd @@ -54,21 +49,16 @@ def hash_map_new_fwd (T : Type) : Result (hash_map_t T) := (Usize.ofInt 4 (by intlit)) (Usize.ofInt 5 (by intlit)) /- [hashmap::HashMap::{0}::clear] -/ -def hash_map_clear_loop_fwd_back - (T : Type) (slots : Vec (list_t T)) (i : Usize) : - (Result (Vec (list_t T))) - := +divergent def hash_map_clear_loop_fwd_back + (T : Type) (slots : Vec (list_t T)) (i : Usize) : Result (Vec (list_t T)) := let i0 := vec_len (list_t T) slots - if h: i < i0 + if i < i0 then do let i1 ← i + (Usize.ofInt 1 (by intlit)) let slots0 ← vec_index_mut_back (list_t T) slots i list_t.Nil hash_map_clear_loop_fwd_back T slots0 i1 else Result.ret slots -termination_by hash_map_clear_loop_fwd_back slots i => - hash_map_clear_loop_terminates T slots i -decreasing_by hash_map_clear_loop_decreases slots i /- [hashmap::HashMap::{0}::clear] -/ def hash_map_clear_fwd_back @@ -90,17 +80,14 @@ def hash_map_len_fwd (T : Type) (self : hash_map_t T) : Result Usize := Result.ret self.hash_map_num_entries /- [hashmap::HashMap::{0}::insert_in_list] -/ -def hash_map_insert_in_list_loop_fwd - (T : Type) (key : Usize) (value : T) (ls : list_t T) : (Result Bool) := +divergent def hash_map_insert_in_list_loop_fwd + (T : Type) (key : Usize) (value : T) (ls : list_t T) : Result Bool := match h: ls with | list_t.Cons ckey cvalue tl => - if h: ckey = key + if ckey = key then Result.ret false else hash_map_insert_in_list_loop_fwd T key value tl | list_t.Nil => Result.ret true -termination_by hash_map_insert_in_list_loop_fwd key value ls => - hash_map_insert_in_list_loop_terminates T key value ls -decreasing_by hash_map_insert_in_list_loop_decreases key value ls /- [hashmap::HashMap::{0}::insert_in_list] -/ def hash_map_insert_in_list_fwd @@ -108,11 +95,11 @@ def hash_map_insert_in_list_fwd hash_map_insert_in_list_loop_fwd T key value ls /- [hashmap::HashMap::{0}::insert_in_list] -/ -def hash_map_insert_in_list_loop_back - (T : Type) (key : Usize) (value : T) (ls : list_t T) : (Result (list_t T)) := +divergent def hash_map_insert_in_list_loop_back + (T : Type) (key : Usize) (value : T) (ls : list_t T) : Result (list_t T) := match h: ls with | list_t.Cons ckey cvalue tl => - if h: ckey = key + if ckey = key then Result.ret (list_t.Cons ckey value tl) else do @@ -120,9 +107,6 @@ def hash_map_insert_in_list_loop_back Result.ret (list_t.Cons ckey cvalue tl0) | list_t.Nil => let l := list_t.Nil Result.ret (list_t.Cons key value l) -termination_by hash_map_insert_in_list_loop_back key value ls => - hash_map_insert_in_list_loop_terminates T key value ls -decreasing_by hash_map_insert_in_list_loop_decreases key value ls /- [hashmap::HashMap::{0}::insert_in_list] -/ def hash_map_insert_in_list_back @@ -140,7 +124,7 @@ def hash_map_insert_no_resize_fwd_back let hash_mod ← hash % i let l ← vec_index_mut_fwd (list_t T) self.hash_map_slots hash_mod let inserted ← hash_map_insert_in_list_fwd T key value l - if h: inserted + if inserted then do let i0 ← self.hash_map_num_entries + (Usize.ofInt 1 (by intlit)) @@ -160,19 +144,14 @@ def core_num_u32_max_body : Result U32 := def core_num_u32_max_c : U32 := eval_global core_num_u32_max_body (by simp) /- [hashmap::HashMap::{0}::move_elements_from_list] -/ -def hash_map_move_elements_from_list_loop_fwd_back - (T : Type) (ntable : hash_map_t T) (ls : list_t T) : - (Result (hash_map_t T)) - := +divergent def hash_map_move_elements_from_list_loop_fwd_back + (T : Type) (ntable : hash_map_t T) (ls : list_t T) : Result (hash_map_t T) := match h: ls with | list_t.Cons k v tl => do let ntable0 ← hash_map_insert_no_resize_fwd_back T ntable k v hash_map_move_elements_from_list_loop_fwd_back T ntable0 tl | list_t.Nil => Result.ret ntable -termination_by hash_map_move_elements_from_list_loop_fwd_back ntable ls => - hash_map_move_elements_from_list_loop_terminates T ntable ls -decreasing_by hash_map_move_elements_from_list_loop_decreases ntable ls /- [hashmap::HashMap::{0}::move_elements_from_list] -/ def hash_map_move_elements_from_list_fwd_back @@ -180,12 +159,12 @@ def hash_map_move_elements_from_list_fwd_back hash_map_move_elements_from_list_loop_fwd_back T ntable ls /- [hashmap::HashMap::{0}::move_elements] -/ -def hash_map_move_elements_loop_fwd_back +divergent def hash_map_move_elements_loop_fwd_back (T : Type) (ntable : hash_map_t T) (slots : Vec (list_t T)) (i : Usize) : - (Result ((hash_map_t T) × (Vec (list_t T)))) + Result ((hash_map_t T) × (Vec (list_t T))) := let i0 := vec_len (list_t T) slots - if h: i < i0 + if i < i0 then do let l ← vec_index_mut_fwd (list_t T) slots i @@ -196,9 +175,6 @@ def hash_map_move_elements_loop_fwd_back let slots0 ← vec_index_mut_back (list_t T) slots i l0 hash_map_move_elements_loop_fwd_back T ntable0 slots0 i1 else Result.ret (ntable, slots) -termination_by hash_map_move_elements_loop_fwd_back ntable slots i => - hash_map_move_elements_loop_terminates T ntable slots i -decreasing_by hash_map_move_elements_loop_decreases ntable slots i /- [hashmap::HashMap::{0}::move_elements] -/ def hash_map_move_elements_fwd_back @@ -216,7 +192,7 @@ def hash_map_try_resize_fwd_back let n1 ← max_usize / (Usize.ofInt 2 (by intlit)) let (i, i0) := self.hash_map_max_load_factor let i1 ← n1 / i - if h: capacity <= i1 + if capacity <= i1 then do let i2 ← capacity * (Usize.ofInt 2 (by intlit)) @@ -241,22 +217,19 @@ def hash_map_insert_fwd_back do let self0 ← hash_map_insert_no_resize_fwd_back T self key value let i ← hash_map_len_fwd T self0 - if h: i > self0.hash_map_max_load + if i > self0.hash_map_max_load then hash_map_try_resize_fwd_back T self0 else Result.ret self0 /- [hashmap::HashMap::{0}::contains_key_in_list] -/ -def hash_map_contains_key_in_list_loop_fwd - (T : Type) (key : Usize) (ls : list_t T) : (Result Bool) := +divergent def hash_map_contains_key_in_list_loop_fwd + (T : Type) (key : Usize) (ls : list_t T) : Result Bool := match h: ls with | list_t.Cons ckey t tl => - if h: ckey = key + if ckey = key then Result.ret true else hash_map_contains_key_in_list_loop_fwd T key tl | list_t.Nil => Result.ret false -termination_by hash_map_contains_key_in_list_loop_fwd key ls => - hash_map_contains_key_in_list_loop_terminates T key ls -decreasing_by hash_map_contains_key_in_list_loop_decreases key ls /- [hashmap::HashMap::{0}::contains_key_in_list] -/ def hash_map_contains_key_in_list_fwd @@ -274,17 +247,14 @@ def hash_map_contains_key_fwd hash_map_contains_key_in_list_fwd T key l /- [hashmap::HashMap::{0}::get_in_list] -/ -def hash_map_get_in_list_loop_fwd - (T : Type) (key : Usize) (ls : list_t T) : (Result T) := +divergent def hash_map_get_in_list_loop_fwd + (T : Type) (key : Usize) (ls : list_t T) : Result T := match h: ls with | list_t.Cons ckey cvalue tl => - if h: ckey = key + if ckey = key then Result.ret cvalue else hash_map_get_in_list_loop_fwd T key tl | list_t.Nil => Result.fail Error.panic -termination_by hash_map_get_in_list_loop_fwd key ls => - hash_map_get_in_list_loop_terminates T key ls -decreasing_by hash_map_get_in_list_loop_decreases key ls /- [hashmap::HashMap::{0}::get_in_list] -/ def hash_map_get_in_list_fwd @@ -302,17 +272,14 @@ def hash_map_get_fwd hash_map_get_in_list_fwd T key l /- [hashmap::HashMap::{0}::get_mut_in_list] -/ -def hash_map_get_mut_in_list_loop_fwd - (T : Type) (ls : list_t T) (key : Usize) : (Result T) := +divergent def hash_map_get_mut_in_list_loop_fwd + (T : Type) (ls : list_t T) (key : Usize) : Result T := match h: ls with | list_t.Cons ckey cvalue tl => - if h: ckey = key + if ckey = key then Result.ret cvalue else hash_map_get_mut_in_list_loop_fwd T tl key | list_t.Nil => Result.fail Error.panic -termination_by hash_map_get_mut_in_list_loop_fwd ls key => - hash_map_get_mut_in_list_loop_terminates T ls key -decreasing_by hash_map_get_mut_in_list_loop_decreases ls key /- [hashmap::HashMap::{0}::get_mut_in_list] -/ def hash_map_get_mut_in_list_fwd @@ -320,20 +287,17 @@ def hash_map_get_mut_in_list_fwd hash_map_get_mut_in_list_loop_fwd T ls key /- [hashmap::HashMap::{0}::get_mut_in_list] -/ -def hash_map_get_mut_in_list_loop_back - (T : Type) (ls : list_t T) (key : Usize) (ret0 : T) : (Result (list_t T)) := +divergent def hash_map_get_mut_in_list_loop_back + (T : Type) (ls : list_t T) (key : Usize) (ret0 : T) : Result (list_t T) := match h: ls with | list_t.Cons ckey cvalue tl => - if h: ckey = key + if ckey = key then Result.ret (list_t.Cons ckey ret0 tl) else do let tl0 ← hash_map_get_mut_in_list_loop_back T tl key ret0 Result.ret (list_t.Cons ckey cvalue tl0) | list_t.Nil => Result.fail Error.panic -termination_by hash_map_get_mut_in_list_loop_back ls key ret0 => - hash_map_get_mut_in_list_loop_terminates T ls key -decreasing_by hash_map_get_mut_in_list_loop_decreases ls key /- [hashmap::HashMap::{0}::get_mut_in_list] -/ def hash_map_get_mut_in_list_back @@ -365,11 +329,11 @@ def hash_map_get_mut_back Result.ret { self with hash_map_slots := v } /- [hashmap::HashMap::{0}::remove_from_list] -/ -def hash_map_remove_from_list_loop_fwd - (T : Type) (key : Usize) (ls : list_t T) : (Result (Option T)) := +divergent def hash_map_remove_from_list_loop_fwd + (T : Type) (key : Usize) (ls : list_t T) : Result (Option T) := match h: ls with | list_t.Cons ckey t tl => - if h: ckey = key + if ckey = key then let mv_ls := mem_replace_fwd (list_t T) (list_t.Cons ckey t tl) list_t.Nil @@ -378,9 +342,6 @@ def hash_map_remove_from_list_loop_fwd | list_t.Nil => Result.fail Error.panic else hash_map_remove_from_list_loop_fwd T key tl | list_t.Nil => Result.ret Option.none -termination_by hash_map_remove_from_list_loop_fwd key ls => - hash_map_remove_from_list_loop_terminates T key ls -decreasing_by hash_map_remove_from_list_loop_decreases key ls /- [hashmap::HashMap::{0}::remove_from_list] -/ def hash_map_remove_from_list_fwd @@ -388,11 +349,11 @@ def hash_map_remove_from_list_fwd hash_map_remove_from_list_loop_fwd T key ls /- [hashmap::HashMap::{0}::remove_from_list] -/ -def hash_map_remove_from_list_loop_back - (T : Type) (key : Usize) (ls : list_t T) : (Result (list_t T)) := +divergent def hash_map_remove_from_list_loop_back + (T : Type) (key : Usize) (ls : list_t T) : Result (list_t T) := match h: ls with | list_t.Cons ckey t tl => - if h: ckey = key + if ckey = key then let mv_ls := mem_replace_fwd (list_t T) (list_t.Cons ckey t tl) list_t.Nil @@ -404,9 +365,6 @@ def hash_map_remove_from_list_loop_back let tl0 ← hash_map_remove_from_list_loop_back T key tl Result.ret (list_t.Cons ckey t tl0) | list_t.Nil => Result.ret list_t.Nil -termination_by hash_map_remove_from_list_loop_back key ls => - hash_map_remove_from_list_loop_terminates T key ls -decreasing_by hash_map_remove_from_list_loop_decreases key ls /- [hashmap::HashMap::{0}::remove_from_list] -/ def hash_map_remove_from_list_back @@ -469,7 +427,7 @@ def test1_fwd : Result Unit := hash_map_insert_fwd_back U64 hm2 (Usize.ofInt 1056 (by intlit)) (U64.ofInt 256 (by intlit)) let i ← hash_map_get_fwd U64 hm3 (Usize.ofInt 128 (by intlit)) - if h: not (i = (U64.ofInt 18 (by intlit))) + if not (i = (U64.ofInt 18 (by intlit))) then Result.fail Error.panic else do @@ -477,7 +435,7 @@ def test1_fwd : Result Unit := hash_map_get_mut_back U64 hm3 (Usize.ofInt 1024 (by intlit)) (U64.ofInt 56 (by intlit)) let i0 ← hash_map_get_fwd U64 hm4 (Usize.ofInt 1024 (by intlit)) - if h: not (i0 = (U64.ofInt 56 (by intlit))) + if not (i0 = (U64.ofInt 56 (by intlit))) then Result.fail Error.panic else do @@ -486,7 +444,7 @@ def test1_fwd : Result Unit := match h: x with | Option.none => Result.fail Error.panic | Option.some x0 => - if h: not (x0 = (U64.ofInt 56 (by intlit))) + if not (x0 = (U64.ofInt 56 (by intlit))) then Result.fail Error.panic else do @@ -494,20 +452,23 @@ def test1_fwd : Result Unit := hash_map_remove_back U64 hm4 (Usize.ofInt 1024 (by intlit)) let i1 ← hash_map_get_fwd U64 hm5 (Usize.ofInt 0 (by intlit)) - if h: not (i1 = (U64.ofInt 42 (by intlit))) + if not (i1 = (U64.ofInt 42 (by intlit))) then Result.fail Error.panic else do let i2 ← hash_map_get_fwd U64 hm5 (Usize.ofInt 128 (by intlit)) - if h: not (i2 = (U64.ofInt 18 (by intlit))) + if not (i2 = (U64.ofInt 18 (by intlit))) then Result.fail Error.panic else do let i3 ← hash_map_get_fwd U64 hm5 (Usize.ofInt 1056 (by intlit)) - if h: not (i3 = (U64.ofInt 256 (by intlit))) + if not (i3 = (U64.ofInt 256 (by intlit))) then Result.fail Error.panic else Result.ret () +/- Unit test for [hashmap::test1] -/ +#assert (test1_fwd == .ret ()) + diff --git a/tests/lean/hashmap/Hashmap/Types.lean b/tests/lean/Hashmap/Types.lean index 6eabf7da..af26f363 100644 --- a/tests/lean/hashmap/Hashmap/Types.lean +++ b/tests/lean/Hashmap/Types.lean @@ -1,6 +1,7 @@ -- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS -- [hashmap]: type definitions -import Base.Primitives +import Base +open Primitives /- [hashmap::List] -/ inductive list_t (T : Type) := diff --git a/tests/lean/hashmap_on_disk/HashmapMain.lean b/tests/lean/HashmapMain.lean index 1a4e7f82..1a4e7f82 100644 --- a/tests/lean/hashmap_on_disk/HashmapMain.lean +++ b/tests/lean/HashmapMain.lean diff --git a/tests/lean/hashmap_on_disk/HashmapMain/Funs.lean b/tests/lean/HashmapMain/Funs.lean index 342c3833..a59a9f26 100644 --- a/tests/lean/hashmap_on_disk/HashmapMain/Funs.lean +++ b/tests/lean/HashmapMain/Funs.lean @@ -1,29 +1,26 @@ -- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS -- [hashmap_main]: function definitions -import Base.Primitives +import Base import HashmapMain.Types import HashmapMain.ExternalFuns -import HashmapMain.Clauses.Clauses +open Primitives /- [hashmap_main::hashmap::hash_key] -/ def hashmap_hash_key_fwd (k : Usize) : Result Usize := Result.ret k /- [hashmap_main::hashmap::HashMap::{0}::allocate_slots] -/ -def hashmap_hash_map_allocate_slots_loop_fwd +divergent def hashmap_hash_map_allocate_slots_loop_fwd (T : Type) (slots : Vec (hashmap_list_t T)) (n : Usize) : - (Result (Vec (hashmap_list_t T))) + Result (Vec (hashmap_list_t T)) := - if h: n > (Usize.ofInt 0 (by intlit)) + if n > (Usize.ofInt 0 (by intlit)) then do let slots0 ← vec_push_back (hashmap_list_t T) slots hashmap_list_t.Nil let n0 ← n - (Usize.ofInt 1 (by intlit)) hashmap_hash_map_allocate_slots_loop_fwd T slots0 n0 else Result.ret slots -termination_by hashmap_hash_map_allocate_slots_loop_fwd slots n => - hashmap_hash_map_allocate_slots_loop_terminates T slots n -decreasing_by hashmap_hash_map_allocate_slots_loop_decreases slots n /- [hashmap_main::hashmap::HashMap::{0}::allocate_slots] -/ def hashmap_hash_map_allocate_slots_fwd @@ -58,12 +55,12 @@ def hashmap_hash_map_new_fwd (T : Type) : Result (hashmap_hash_map_t T) := (Usize.ofInt 4 (by intlit)) (Usize.ofInt 5 (by intlit)) /- [hashmap_main::hashmap::HashMap::{0}::clear] -/ -def hashmap_hash_map_clear_loop_fwd_back +divergent def hashmap_hash_map_clear_loop_fwd_back (T : Type) (slots : Vec (hashmap_list_t T)) (i : Usize) : - (Result (Vec (hashmap_list_t T))) + Result (Vec (hashmap_list_t T)) := let i0 := vec_len (hashmap_list_t T) slots - if h: i < i0 + if i < i0 then do let i1 ← i + (Usize.ofInt 1 (by intlit)) @@ -71,9 +68,6 @@ def hashmap_hash_map_clear_loop_fwd_back vec_index_mut_back (hashmap_list_t T) slots i hashmap_list_t.Nil hashmap_hash_map_clear_loop_fwd_back T slots0 i1 else Result.ret slots -termination_by hashmap_hash_map_clear_loop_fwd_back slots i => - hashmap_hash_map_clear_loop_terminates T slots i -decreasing_by hashmap_hash_map_clear_loop_decreases slots i /- [hashmap_main::hashmap::HashMap::{0}::clear] -/ def hashmap_hash_map_clear_fwd_back @@ -96,19 +90,14 @@ def hashmap_hash_map_len_fwd Result.ret self.hashmap_hash_map_num_entries /- [hashmap_main::hashmap::HashMap::{0}::insert_in_list] -/ -def hashmap_hash_map_insert_in_list_loop_fwd - (T : Type) (key : Usize) (value : T) (ls : hashmap_list_t T) : - (Result Bool) - := +divergent def hashmap_hash_map_insert_in_list_loop_fwd + (T : Type) (key : Usize) (value : T) (ls : hashmap_list_t T) : Result Bool := match h: ls with | hashmap_list_t.Cons ckey cvalue tl => - if h: ckey = key + if ckey = key then Result.ret false else hashmap_hash_map_insert_in_list_loop_fwd T key value tl | hashmap_list_t.Nil => Result.ret true -termination_by hashmap_hash_map_insert_in_list_loop_fwd key value ls => - hashmap_hash_map_insert_in_list_loop_terminates T key value ls -decreasing_by hashmap_hash_map_insert_in_list_loop_decreases key value ls /- [hashmap_main::hashmap::HashMap::{0}::insert_in_list] -/ def hashmap_hash_map_insert_in_list_fwd @@ -116,13 +105,13 @@ def hashmap_hash_map_insert_in_list_fwd hashmap_hash_map_insert_in_list_loop_fwd T key value ls /- [hashmap_main::hashmap::HashMap::{0}::insert_in_list] -/ -def hashmap_hash_map_insert_in_list_loop_back +divergent def hashmap_hash_map_insert_in_list_loop_back (T : Type) (key : Usize) (value : T) (ls : hashmap_list_t T) : - (Result (hashmap_list_t T)) + Result (hashmap_list_t T) := match h: ls with | hashmap_list_t.Cons ckey cvalue tl => - if h: ckey = key + if ckey = key then Result.ret (hashmap_list_t.Cons ckey value tl) else do @@ -131,9 +120,6 @@ def hashmap_hash_map_insert_in_list_loop_back | hashmap_list_t.Nil => let l := hashmap_list_t.Nil Result.ret (hashmap_list_t.Cons key value l) -termination_by hashmap_hash_map_insert_in_list_loop_back key value ls => - hashmap_hash_map_insert_in_list_loop_terminates T key value ls -decreasing_by hashmap_hash_map_insert_in_list_loop_decreases key value ls /- [hashmap_main::hashmap::HashMap::{0}::insert_in_list] -/ def hashmap_hash_map_insert_in_list_back @@ -154,7 +140,7 @@ def hashmap_hash_map_insert_no_resize_fwd_back let l ← vec_index_mut_fwd (hashmap_list_t T) self.hashmap_hash_map_slots hash_mod let inserted ← hashmap_hash_map_insert_in_list_fwd T key value l - if h: inserted + if inserted then do let i0 ← self.hashmap_hash_map_num_entries + @@ -183,9 +169,9 @@ def core_num_u32_max_body : Result U32 := def core_num_u32_max_c : U32 := eval_global core_num_u32_max_body (by simp) /- [hashmap_main::hashmap::HashMap::{0}::move_elements_from_list] -/ -def hashmap_hash_map_move_elements_from_list_loop_fwd_back +divergent def hashmap_hash_map_move_elements_from_list_loop_fwd_back (T : Type) (ntable : hashmap_hash_map_t T) (ls : hashmap_list_t T) : - (Result (hashmap_hash_map_t T)) + Result (hashmap_hash_map_t T) := match h: ls with | hashmap_list_t.Cons k v tl => @@ -193,10 +179,6 @@ def hashmap_hash_map_move_elements_from_list_loop_fwd_back let ntable0 ← hashmap_hash_map_insert_no_resize_fwd_back T ntable k v hashmap_hash_map_move_elements_from_list_loop_fwd_back T ntable0 tl | hashmap_list_t.Nil => Result.ret ntable -termination_by hashmap_hash_map_move_elements_from_list_loop_fwd_back ntable ls - => - hashmap_hash_map_move_elements_from_list_loop_terminates T ntable ls -decreasing_by hashmap_hash_map_move_elements_from_list_loop_decreases ntable ls /- [hashmap_main::hashmap::HashMap::{0}::move_elements_from_list] -/ def hashmap_hash_map_move_elements_from_list_fwd_back @@ -206,13 +188,13 @@ def hashmap_hash_map_move_elements_from_list_fwd_back hashmap_hash_map_move_elements_from_list_loop_fwd_back T ntable ls /- [hashmap_main::hashmap::HashMap::{0}::move_elements] -/ -def hashmap_hash_map_move_elements_loop_fwd_back +divergent def hashmap_hash_map_move_elements_loop_fwd_back (T : Type) (ntable : hashmap_hash_map_t T) (slots : Vec (hashmap_list_t T)) (i : Usize) : - (Result ((hashmap_hash_map_t T) × (Vec (hashmap_list_t T)))) + Result ((hashmap_hash_map_t T) × (Vec (hashmap_list_t T))) := let i0 := vec_len (hashmap_list_t T) slots - if h: i < i0 + if i < i0 then do let l ← vec_index_mut_fwd (hashmap_list_t T) slots i @@ -224,9 +206,6 @@ def hashmap_hash_map_move_elements_loop_fwd_back let slots0 ← vec_index_mut_back (hashmap_list_t T) slots i l0 hashmap_hash_map_move_elements_loop_fwd_back T ntable0 slots0 i1 else Result.ret (ntable, slots) -termination_by hashmap_hash_map_move_elements_loop_fwd_back ntable slots i => - hashmap_hash_map_move_elements_loop_terminates T ntable slots i -decreasing_by hashmap_hash_map_move_elements_loop_decreases ntable slots i /- [hashmap_main::hashmap::HashMap::{0}::move_elements] -/ def hashmap_hash_map_move_elements_fwd_back @@ -245,7 +224,7 @@ def hashmap_hash_map_try_resize_fwd_back let n1 ← max_usize / (Usize.ofInt 2 (by intlit)) let (i, i0) := self.hashmap_hash_map_max_load_factor let i1 ← n1 / i - if h: capacity <= i1 + if capacity <= i1 then do let i2 ← capacity * (Usize.ofInt 2 (by intlit)) @@ -270,22 +249,19 @@ def hashmap_hash_map_insert_fwd_back do let self0 ← hashmap_hash_map_insert_no_resize_fwd_back T self key value let i ← hashmap_hash_map_len_fwd T self0 - if h: i > self0.hashmap_hash_map_max_load + if i > self0.hashmap_hash_map_max_load then hashmap_hash_map_try_resize_fwd_back T self0 else Result.ret self0 /- [hashmap_main::hashmap::HashMap::{0}::contains_key_in_list] -/ -def hashmap_hash_map_contains_key_in_list_loop_fwd - (T : Type) (key : Usize) (ls : hashmap_list_t T) : (Result Bool) := +divergent def hashmap_hash_map_contains_key_in_list_loop_fwd + (T : Type) (key : Usize) (ls : hashmap_list_t T) : Result Bool := match h: ls with | hashmap_list_t.Cons ckey t tl => - if h: ckey = key + if ckey = key then Result.ret true else hashmap_hash_map_contains_key_in_list_loop_fwd T key tl | hashmap_list_t.Nil => Result.ret false -termination_by hashmap_hash_map_contains_key_in_list_loop_fwd key ls => - hashmap_hash_map_contains_key_in_list_loop_terminates T key ls -decreasing_by hashmap_hash_map_contains_key_in_list_loop_decreases key ls /- [hashmap_main::hashmap::HashMap::{0}::contains_key_in_list] -/ def hashmap_hash_map_contains_key_in_list_fwd @@ -304,17 +280,14 @@ def hashmap_hash_map_contains_key_fwd hashmap_hash_map_contains_key_in_list_fwd T key l /- [hashmap_main::hashmap::HashMap::{0}::get_in_list] -/ -def hashmap_hash_map_get_in_list_loop_fwd - (T : Type) (key : Usize) (ls : hashmap_list_t T) : (Result T) := +divergent def hashmap_hash_map_get_in_list_loop_fwd + (T : Type) (key : Usize) (ls : hashmap_list_t T) : Result T := match h: ls with | hashmap_list_t.Cons ckey cvalue tl => - if h: ckey = key + if ckey = key then Result.ret cvalue else hashmap_hash_map_get_in_list_loop_fwd T key tl | hashmap_list_t.Nil => Result.fail Error.panic -termination_by hashmap_hash_map_get_in_list_loop_fwd key ls => - hashmap_hash_map_get_in_list_loop_terminates T key ls -decreasing_by hashmap_hash_map_get_in_list_loop_decreases key ls /- [hashmap_main::hashmap::HashMap::{0}::get_in_list] -/ def hashmap_hash_map_get_in_list_fwd @@ -333,17 +306,14 @@ def hashmap_hash_map_get_fwd hashmap_hash_map_get_in_list_fwd T key l /- [hashmap_main::hashmap::HashMap::{0}::get_mut_in_list] -/ -def hashmap_hash_map_get_mut_in_list_loop_fwd - (T : Type) (ls : hashmap_list_t T) (key : Usize) : (Result T) := +divergent def hashmap_hash_map_get_mut_in_list_loop_fwd + (T : Type) (ls : hashmap_list_t T) (key : Usize) : Result T := match h: ls with | hashmap_list_t.Cons ckey cvalue tl => - if h: ckey = key + if ckey = key then Result.ret cvalue else hashmap_hash_map_get_mut_in_list_loop_fwd T tl key | hashmap_list_t.Nil => Result.fail Error.panic -termination_by hashmap_hash_map_get_mut_in_list_loop_fwd ls key => - hashmap_hash_map_get_mut_in_list_loop_terminates T ls key -decreasing_by hashmap_hash_map_get_mut_in_list_loop_decreases ls key /- [hashmap_main::hashmap::HashMap::{0}::get_mut_in_list] -/ def hashmap_hash_map_get_mut_in_list_fwd @@ -351,22 +321,19 @@ def hashmap_hash_map_get_mut_in_list_fwd hashmap_hash_map_get_mut_in_list_loop_fwd T ls key /- [hashmap_main::hashmap::HashMap::{0}::get_mut_in_list] -/ -def hashmap_hash_map_get_mut_in_list_loop_back +divergent def hashmap_hash_map_get_mut_in_list_loop_back (T : Type) (ls : hashmap_list_t T) (key : Usize) (ret0 : T) : - (Result (hashmap_list_t T)) + Result (hashmap_list_t T) := match h: ls with | hashmap_list_t.Cons ckey cvalue tl => - if h: ckey = key + if ckey = key then Result.ret (hashmap_list_t.Cons ckey ret0 tl) else do let tl0 ← hashmap_hash_map_get_mut_in_list_loop_back T tl key ret0 Result.ret (hashmap_list_t.Cons ckey cvalue tl0) | hashmap_list_t.Nil => Result.fail Error.panic -termination_by hashmap_hash_map_get_mut_in_list_loop_back ls key ret0 => - hashmap_hash_map_get_mut_in_list_loop_terminates T ls key -decreasing_by hashmap_hash_map_get_mut_in_list_loop_decreases ls key /- [hashmap_main::hashmap::HashMap::{0}::get_mut_in_list] -/ def hashmap_hash_map_get_mut_in_list_back @@ -404,11 +371,11 @@ def hashmap_hash_map_get_mut_back Result.ret { self with hashmap_hash_map_slots := v } /- [hashmap_main::hashmap::HashMap::{0}::remove_from_list] -/ -def hashmap_hash_map_remove_from_list_loop_fwd - (T : Type) (key : Usize) (ls : hashmap_list_t T) : (Result (Option T)) := +divergent def hashmap_hash_map_remove_from_list_loop_fwd + (T : Type) (key : Usize) (ls : hashmap_list_t T) : Result (Option T) := match h: ls with | hashmap_list_t.Cons ckey t tl => - if h: ckey = key + if ckey = key then let mv_ls := mem_replace_fwd (hashmap_list_t T) (hashmap_list_t.Cons ckey t tl) @@ -418,9 +385,6 @@ def hashmap_hash_map_remove_from_list_loop_fwd | hashmap_list_t.Nil => Result.fail Error.panic else hashmap_hash_map_remove_from_list_loop_fwd T key tl | hashmap_list_t.Nil => Result.ret Option.none -termination_by hashmap_hash_map_remove_from_list_loop_fwd key ls => - hashmap_hash_map_remove_from_list_loop_terminates T key ls -decreasing_by hashmap_hash_map_remove_from_list_loop_decreases key ls /- [hashmap_main::hashmap::HashMap::{0}::remove_from_list] -/ def hashmap_hash_map_remove_from_list_fwd @@ -428,13 +392,13 @@ def hashmap_hash_map_remove_from_list_fwd hashmap_hash_map_remove_from_list_loop_fwd T key ls /- [hashmap_main::hashmap::HashMap::{0}::remove_from_list] -/ -def hashmap_hash_map_remove_from_list_loop_back +divergent def hashmap_hash_map_remove_from_list_loop_back (T : Type) (key : Usize) (ls : hashmap_list_t T) : - (Result (hashmap_list_t T)) + Result (hashmap_list_t T) := match h: ls with | hashmap_list_t.Cons ckey t tl => - if h: ckey = key + if ckey = key then let mv_ls := mem_replace_fwd (hashmap_list_t T) (hashmap_list_t.Cons ckey t tl) @@ -447,9 +411,6 @@ def hashmap_hash_map_remove_from_list_loop_back let tl0 ← hashmap_hash_map_remove_from_list_loop_back T key tl Result.ret (hashmap_list_t.Cons ckey t tl0) | hashmap_list_t.Nil => Result.ret hashmap_list_t.Nil -termination_by hashmap_hash_map_remove_from_list_loop_back key ls => - hashmap_hash_map_remove_from_list_loop_terminates T key ls -decreasing_by hashmap_hash_map_remove_from_list_loop_decreases key ls /- [hashmap_main::hashmap::HashMap::{0}::remove_from_list] -/ def hashmap_hash_map_remove_from_list_back @@ -528,7 +489,7 @@ def hashmap_test1_fwd : Result Unit := hashmap_hash_map_insert_fwd_back U64 hm2 (Usize.ofInt 1056 (by intlit)) (U64.ofInt 256 (by intlit)) let i ← hashmap_hash_map_get_fwd U64 hm3 (Usize.ofInt 128 (by intlit)) - if h: not (i = (U64.ofInt 18 (by intlit))) + if not (i = (U64.ofInt 18 (by intlit))) then Result.fail Error.panic else do @@ -537,7 +498,7 @@ def hashmap_test1_fwd : Result Unit := (U64.ofInt 56 (by intlit)) let i0 ← hashmap_hash_map_get_fwd U64 hm4 (Usize.ofInt 1024 (by intlit)) - if h: not (i0 = (U64.ofInt 56 (by intlit))) + if not (i0 = (U64.ofInt 56 (by intlit))) then Result.fail Error.panic else do @@ -547,7 +508,7 @@ def hashmap_test1_fwd : Result Unit := match h: x with | Option.none => Result.fail Error.panic | Option.some x0 => - if h: not (x0 = (U64.ofInt 56 (by intlit))) + if not (x0 = (U64.ofInt 56 (by intlit))) then Result.fail Error.panic else do @@ -557,24 +518,27 @@ def hashmap_test1_fwd : Result Unit := let i1 ← hashmap_hash_map_get_fwd U64 hm5 (Usize.ofInt 0 (by intlit)) - if h: not (i1 = (U64.ofInt 42 (by intlit))) + if not (i1 = (U64.ofInt 42 (by intlit))) then Result.fail Error.panic else do let i2 ← hashmap_hash_map_get_fwd U64 hm5 (Usize.ofInt 128 (by intlit)) - if h: not (i2 = (U64.ofInt 18 (by intlit))) + if not (i2 = (U64.ofInt 18 (by intlit))) then Result.fail Error.panic else do let i3 ← hashmap_hash_map_get_fwd U64 hm5 (Usize.ofInt 1056 (by intlit)) - if h: not (i3 = (U64.ofInt 256 (by intlit))) + if not (i3 = (U64.ofInt 256 (by intlit))) then Result.fail Error.panic else Result.ret () +/- Unit test for [hashmap_main::hashmap::test1] -/ +#assert (hashmap_test1_fwd == .ret ()) + /- [hashmap_main::insert_on_disk] -/ def insert_on_disk_fwd (key : Usize) (value : U64) (st : State) : Result (State × Unit) := @@ -588,3 +552,6 @@ def insert_on_disk_fwd def main_fwd : Result Unit := Result.ret () +/- Unit test for [hashmap_main::main] -/ +#assert (main_fwd == .ret ()) + diff --git a/tests/lean/hashmap_on_disk/HashmapMain/Opaque.lean b/tests/lean/HashmapMain/Opaque.lean index d98f431a..bef4f3fb 100644 --- a/tests/lean/hashmap_on_disk/HashmapMain/Opaque.lean +++ b/tests/lean/HashmapMain/Opaque.lean @@ -1,7 +1,8 @@ -- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS -- [hashmap_main]: opaque function definitions -import Base.Primitives +import Base import HashmapMain.Types +open Primitives structure OpaqueDefs where diff --git a/tests/lean/hashmap_on_disk/HashmapMain/Types.lean b/tests/lean/HashmapMain/Types.lean index 0509fbbd..858e1c51 100644 --- a/tests/lean/hashmap_on_disk/HashmapMain/Types.lean +++ b/tests/lean/HashmapMain/Types.lean @@ -1,6 +1,7 @@ -- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS -- [hashmap_main]: type definitions -import Base.Primitives +import Base +open Primitives /- [hashmap_main::hashmap::List] -/ inductive hashmap_list_t (T : Type) := diff --git a/tests/lean/misc-loops/Loops.lean b/tests/lean/Loops.lean index 60c73776..60c73776 100644 --- a/tests/lean/misc-loops/Loops.lean +++ b/tests/lean/Loops.lean diff --git a/tests/lean/misc-loops/Loops/Funs.lean b/tests/lean/Loops/Funs.lean index fd8d62d7..7d5f7595 100644 --- a/tests/lean/misc-loops/Loops/Funs.lean +++ b/tests/lean/Loops/Funs.lean @@ -1,38 +1,33 @@ -- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS -- [loops]: function definitions -import Base.Primitives +import Base import Loops.Types -import Loops.Clauses.Clauses +open Primitives /- [loops::sum] -/ -def sum_loop_fwd (max : U32) (i : U32) (s : U32) : (Result U32) := - if h: i < max +divergent def sum_loop_fwd (max : U32) (i : U32) (s : U32) : Result U32 := + if i < max then do let s0 ← s + i let i0 ← i + (U32.ofInt 1 (by intlit)) sum_loop_fwd max i0 s0 else s * (U32.ofInt 2 (by intlit)) -termination_by sum_loop_fwd max i s => sum_loop_terminates max i s -decreasing_by sum_loop_decreases max i s /- [loops::sum] -/ def sum_fwd (max : U32) : Result U32 := sum_loop_fwd max (U32.ofInt 0 (by intlit)) (U32.ofInt 0 (by intlit)) /- [loops::sum_with_mut_borrows] -/ -def sum_with_mut_borrows_loop_fwd - (max : U32) (mi : U32) (ms : U32) : (Result U32) := - if h: mi < max +divergent def sum_with_mut_borrows_loop_fwd + (max : U32) (mi : U32) (ms : U32) : Result U32 := + if mi < max then do let ms0 ← ms + mi let mi0 ← mi + (U32.ofInt 1 (by intlit)) sum_with_mut_borrows_loop_fwd max mi0 ms0 else ms * (U32.ofInt 2 (by intlit)) -termination_by sum_with_mut_borrows_loop_fwd max mi ms => - sum_with_mut_borrows_loop_terminates max mi ms -decreasing_by sum_with_mut_borrows_loop_decreases max mi ms /- [loops::sum_with_mut_borrows] -/ def sum_with_mut_borrows_fwd (max : U32) : Result U32 := @@ -40,18 +35,15 @@ def sum_with_mut_borrows_fwd (max : U32) : Result U32 := (U32.ofInt 0 (by intlit)) /- [loops::sum_with_shared_borrows] -/ -def sum_with_shared_borrows_loop_fwd - (max : U32) (i : U32) (s : U32) : (Result U32) := - if h: i < max +divergent def sum_with_shared_borrows_loop_fwd + (max : U32) (i : U32) (s : U32) : Result U32 := + if i < max then do let i0 ← i + (U32.ofInt 1 (by intlit)) let s0 ← s + i0 sum_with_shared_borrows_loop_fwd max i0 s0 else s * (U32.ofInt 2 (by intlit)) -termination_by sum_with_shared_borrows_loop_fwd max i s => - sum_with_shared_borrows_loop_terminates max i s -decreasing_by sum_with_shared_borrows_loop_decreases max i s /- [loops::sum_with_shared_borrows] -/ def sum_with_shared_borrows_fwd (max : U32) : Result U32 := @@ -59,63 +51,57 @@ def sum_with_shared_borrows_fwd (max : U32) : Result U32 := (U32.ofInt 0 (by intlit)) /- [loops::clear] -/ -def clear_loop_fwd_back (v : Vec U32) (i : Usize) : (Result (Vec U32)) := +divergent def clear_loop_fwd_back + (v : Vec U32) (i : Usize) : Result (Vec U32) := let i0 := vec_len U32 v - if h: i < i0 + if i < i0 then do let i1 ← i + (Usize.ofInt 1 (by intlit)) let v0 ← vec_index_mut_back U32 v i (U32.ofInt 0 (by intlit)) clear_loop_fwd_back v0 i1 else Result.ret v -termination_by clear_loop_fwd_back v i => clear_loop_terminates v i -decreasing_by clear_loop_decreases v i /- [loops::clear] -/ def clear_fwd_back (v : Vec U32) : Result (Vec U32) := clear_loop_fwd_back v (Usize.ofInt 0 (by intlit)) /- [loops::list_mem] -/ -def list_mem_loop_fwd (x : U32) (ls : list_t U32) : (Result Bool) := +divergent def list_mem_loop_fwd (x : U32) (ls : list_t U32) : Result Bool := match h: ls with | list_t.Cons y tl => - if h: y = x + if y = x then Result.ret true else list_mem_loop_fwd x tl | list_t.Nil => Result.ret false -termination_by list_mem_loop_fwd x ls => list_mem_loop_terminates x ls -decreasing_by list_mem_loop_decreases x ls /- [loops::list_mem] -/ def list_mem_fwd (x : U32) (ls : list_t U32) : Result Bool := list_mem_loop_fwd x ls /- [loops::list_nth_mut_loop] -/ -def list_nth_mut_loop_loop_fwd - (T : Type) (ls : list_t T) (i : U32) : (Result T) := +divergent def list_nth_mut_loop_loop_fwd + (T : Type) (ls : list_t T) (i : U32) : Result T := match h: ls with | list_t.Cons x tl => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then Result.ret x else do let i0 ← i - (U32.ofInt 1 (by intlit)) list_nth_mut_loop_loop_fwd T tl i0 | list_t.Nil => Result.fail Error.panic -termination_by list_nth_mut_loop_loop_fwd ls i => - list_nth_mut_loop_loop_terminates T ls i -decreasing_by list_nth_mut_loop_loop_decreases ls i /- [loops::list_nth_mut_loop] -/ def list_nth_mut_loop_fwd (T : Type) (ls : list_t T) (i : U32) : Result T := list_nth_mut_loop_loop_fwd T ls i /- [loops::list_nth_mut_loop] -/ -def list_nth_mut_loop_loop_back - (T : Type) (ls : list_t T) (i : U32) (ret0 : T) : (Result (list_t T)) := +divergent def list_nth_mut_loop_loop_back + (T : Type) (ls : list_t T) (i : U32) (ret0 : T) : Result (list_t T) := match h: ls with | list_t.Cons x tl => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then Result.ret (list_t.Cons ret0 tl) else do @@ -123,9 +109,6 @@ def list_nth_mut_loop_loop_back let tl0 ← list_nth_mut_loop_loop_back T tl i0 ret0 Result.ret (list_t.Cons x tl0) | list_t.Nil => Result.fail Error.panic -termination_by list_nth_mut_loop_loop_back ls i ret0 => - list_nth_mut_loop_loop_terminates T ls i -decreasing_by list_nth_mut_loop_loop_decreases ls i /- [loops::list_nth_mut_loop] -/ def list_nth_mut_loop_back @@ -133,35 +116,31 @@ def list_nth_mut_loop_back list_nth_mut_loop_loop_back T ls i ret0 /- [loops::list_nth_shared_loop] -/ -def list_nth_shared_loop_loop_fwd - (T : Type) (ls : list_t T) (i : U32) : (Result T) := +divergent def list_nth_shared_loop_loop_fwd + (T : Type) (ls : list_t T) (i : U32) : Result T := match h: ls with | list_t.Cons x tl => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then Result.ret x else do let i0 ← i - (U32.ofInt 1 (by intlit)) list_nth_shared_loop_loop_fwd T tl i0 | list_t.Nil => Result.fail Error.panic -termination_by list_nth_shared_loop_loop_fwd ls i => - list_nth_shared_loop_loop_terminates T ls i -decreasing_by list_nth_shared_loop_loop_decreases ls i /- [loops::list_nth_shared_loop] -/ def list_nth_shared_loop_fwd (T : Type) (ls : list_t T) (i : U32) : Result T := list_nth_shared_loop_loop_fwd T ls i /- [loops::get_elem_mut] -/ -def get_elem_mut_loop_fwd (x : Usize) (ls : list_t Usize) : (Result Usize) := +divergent def get_elem_mut_loop_fwd + (x : Usize) (ls : list_t Usize) : Result Usize := match h: ls with | list_t.Cons y tl => - if h: y = x + if y = x then Result.ret y else get_elem_mut_loop_fwd x tl | list_t.Nil => Result.fail Error.panic -termination_by get_elem_mut_loop_fwd x ls => get_elem_mut_loop_terminates x ls -decreasing_by get_elem_mut_loop_decreases x ls /- [loops::get_elem_mut] -/ def get_elem_mut_fwd (slots : Vec (list_t Usize)) (x : Usize) : Result Usize := @@ -171,20 +150,17 @@ def get_elem_mut_fwd (slots : Vec (list_t Usize)) (x : Usize) : Result Usize := get_elem_mut_loop_fwd x l /- [loops::get_elem_mut] -/ -def get_elem_mut_loop_back - (x : Usize) (ls : list_t Usize) (ret0 : Usize) : (Result (list_t Usize)) := +divergent def get_elem_mut_loop_back + (x : Usize) (ls : list_t Usize) (ret0 : Usize) : Result (list_t Usize) := match h: ls with | list_t.Cons y tl => - if h: y = x + if y = x then Result.ret (list_t.Cons ret0 tl) else do let tl0 ← get_elem_mut_loop_back x tl ret0 Result.ret (list_t.Cons y tl0) | list_t.Nil => Result.fail Error.panic -termination_by get_elem_mut_loop_back x ls ret0 => - get_elem_mut_loop_terminates x ls -decreasing_by get_elem_mut_loop_decreases x ls /- [loops::get_elem_mut] -/ def get_elem_mut_back @@ -198,17 +174,14 @@ def get_elem_mut_back vec_index_mut_back (list_t Usize) slots (Usize.ofInt 0 (by intlit)) l0 /- [loops::get_elem_shared] -/ -def get_elem_shared_loop_fwd - (x : Usize) (ls : list_t Usize) : (Result Usize) := +divergent def get_elem_shared_loop_fwd + (x : Usize) (ls : list_t Usize) : Result Usize := match h: ls with | list_t.Cons y tl => - if h: y = x + if y = x then Result.ret y else get_elem_shared_loop_fwd x tl | list_t.Nil => Result.fail Error.panic -termination_by get_elem_shared_loop_fwd x ls => - get_elem_shared_loop_terminates x ls -decreasing_by get_elem_shared_loop_decreases x ls /- [loops::get_elem_shared] -/ def get_elem_shared_fwd @@ -231,20 +204,17 @@ def id_shared_fwd (T : Type) (ls : list_t T) : Result (list_t T) := Result.ret ls /- [loops::list_nth_mut_loop_with_id] -/ -def list_nth_mut_loop_with_id_loop_fwd - (T : Type) (i : U32) (ls : list_t T) : (Result T) := +divergent def list_nth_mut_loop_with_id_loop_fwd + (T : Type) (i : U32) (ls : list_t T) : Result T := match h: ls with | list_t.Cons x tl => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then Result.ret x else do let i0 ← i - (U32.ofInt 1 (by intlit)) list_nth_mut_loop_with_id_loop_fwd T i0 tl | list_t.Nil => Result.fail Error.panic -termination_by list_nth_mut_loop_with_id_loop_fwd i ls => - list_nth_mut_loop_with_id_loop_terminates T i ls -decreasing_by list_nth_mut_loop_with_id_loop_decreases i ls /- [loops::list_nth_mut_loop_with_id] -/ def list_nth_mut_loop_with_id_fwd @@ -254,11 +224,11 @@ def list_nth_mut_loop_with_id_fwd list_nth_mut_loop_with_id_loop_fwd T i ls0 /- [loops::list_nth_mut_loop_with_id] -/ -def list_nth_mut_loop_with_id_loop_back - (T : Type) (i : U32) (ls : list_t T) (ret0 : T) : (Result (list_t T)) := +divergent def list_nth_mut_loop_with_id_loop_back + (T : Type) (i : U32) (ls : list_t T) (ret0 : T) : Result (list_t T) := match h: ls with | list_t.Cons x tl => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then Result.ret (list_t.Cons ret0 tl) else do @@ -266,9 +236,6 @@ def list_nth_mut_loop_with_id_loop_back let tl0 ← list_nth_mut_loop_with_id_loop_back T i0 tl ret0 Result.ret (list_t.Cons x tl0) | list_t.Nil => Result.fail Error.panic -termination_by list_nth_mut_loop_with_id_loop_back i ls ret0 => - list_nth_mut_loop_with_id_loop_terminates T i ls -decreasing_by list_nth_mut_loop_with_id_loop_decreases i ls /- [loops::list_nth_mut_loop_with_id] -/ def list_nth_mut_loop_with_id_back @@ -279,20 +246,17 @@ def list_nth_mut_loop_with_id_back id_mut_back T ls l /- [loops::list_nth_shared_loop_with_id] -/ -def list_nth_shared_loop_with_id_loop_fwd - (T : Type) (i : U32) (ls : list_t T) : (Result T) := +divergent def list_nth_shared_loop_with_id_loop_fwd + (T : Type) (i : U32) (ls : list_t T) : Result T := match h: ls with | list_t.Cons x tl => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then Result.ret x else do let i0 ← i - (U32.ofInt 1 (by intlit)) list_nth_shared_loop_with_id_loop_fwd T i0 tl | list_t.Nil => Result.fail Error.panic -termination_by list_nth_shared_loop_with_id_loop_fwd i ls => - list_nth_shared_loop_with_id_loop_terminates T i ls -decreasing_by list_nth_shared_loop_with_id_loop_decreases i ls /- [loops::list_nth_shared_loop_with_id] -/ def list_nth_shared_loop_with_id_fwd @@ -302,13 +266,13 @@ def list_nth_shared_loop_with_id_fwd list_nth_shared_loop_with_id_loop_fwd T i ls0 /- [loops::list_nth_mut_loop_pair] -/ -def list_nth_mut_loop_pair_loop_fwd - (T : Type) (ls0 : list_t T) (ls1 : list_t T) (i : U32) : (Result (T × T)) := +divergent def list_nth_mut_loop_pair_loop_fwd + (T : Type) (ls0 : list_t T) (ls1 : list_t T) (i : U32) : Result (T × T) := match h: ls0 with | list_t.Cons x0 tl0 => match h: ls1 with | list_t.Cons x1 tl1 => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then Result.ret (x0, x1) else do @@ -316,9 +280,6 @@ def list_nth_mut_loop_pair_loop_fwd list_nth_mut_loop_pair_loop_fwd T tl0 tl1 i0 | list_t.Nil => Result.fail Error.panic | list_t.Nil => Result.fail Error.panic -termination_by list_nth_mut_loop_pair_loop_fwd ls0 ls1 i => - list_nth_mut_loop_pair_loop_terminates T ls0 ls1 i -decreasing_by list_nth_mut_loop_pair_loop_decreases ls0 ls1 i /- [loops::list_nth_mut_loop_pair] -/ def list_nth_mut_loop_pair_fwd @@ -326,15 +287,15 @@ def list_nth_mut_loop_pair_fwd list_nth_mut_loop_pair_loop_fwd T ls0 ls1 i /- [loops::list_nth_mut_loop_pair] -/ -def list_nth_mut_loop_pair_loop_back'a +divergent def list_nth_mut_loop_pair_loop_back'a (T : Type) (ls0 : list_t T) (ls1 : list_t T) (i : U32) (ret0 : T) : - (Result (list_t T)) + Result (list_t T) := match h: ls0 with | list_t.Cons x0 tl0 => match h: ls1 with | list_t.Cons x1 tl1 => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then Result.ret (list_t.Cons ret0 tl0) else do @@ -343,9 +304,6 @@ def list_nth_mut_loop_pair_loop_back'a Result.ret (list_t.Cons x0 tl00) | list_t.Nil => Result.fail Error.panic | list_t.Nil => Result.fail Error.panic -termination_by list_nth_mut_loop_pair_loop_back'a ls0 ls1 i ret0 => - list_nth_mut_loop_pair_loop_terminates T ls0 ls1 i -decreasing_by list_nth_mut_loop_pair_loop_decreases ls0 ls1 i /- [loops::list_nth_mut_loop_pair] -/ def list_nth_mut_loop_pair_back'a @@ -355,15 +313,15 @@ def list_nth_mut_loop_pair_back'a list_nth_mut_loop_pair_loop_back'a T ls0 ls1 i ret0 /- [loops::list_nth_mut_loop_pair] -/ -def list_nth_mut_loop_pair_loop_back'b +divergent def list_nth_mut_loop_pair_loop_back'b (T : Type) (ls0 : list_t T) (ls1 : list_t T) (i : U32) (ret0 : T) : - (Result (list_t T)) + Result (list_t T) := match h: ls0 with | list_t.Cons x0 tl0 => match h: ls1 with | list_t.Cons x1 tl1 => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then Result.ret (list_t.Cons ret0 tl1) else do @@ -372,9 +330,6 @@ def list_nth_mut_loop_pair_loop_back'b Result.ret (list_t.Cons x1 tl10) | list_t.Nil => Result.fail Error.panic | list_t.Nil => Result.fail Error.panic -termination_by list_nth_mut_loop_pair_loop_back'b ls0 ls1 i ret0 => - list_nth_mut_loop_pair_loop_terminates T ls0 ls1 i -decreasing_by list_nth_mut_loop_pair_loop_decreases ls0 ls1 i /- [loops::list_nth_mut_loop_pair] -/ def list_nth_mut_loop_pair_back'b @@ -384,13 +339,13 @@ def list_nth_mut_loop_pair_back'b list_nth_mut_loop_pair_loop_back'b T ls0 ls1 i ret0 /- [loops::list_nth_shared_loop_pair] -/ -def list_nth_shared_loop_pair_loop_fwd - (T : Type) (ls0 : list_t T) (ls1 : list_t T) (i : U32) : (Result (T × T)) := +divergent def list_nth_shared_loop_pair_loop_fwd + (T : Type) (ls0 : list_t T) (ls1 : list_t T) (i : U32) : Result (T × T) := match h: ls0 with | list_t.Cons x0 tl0 => match h: ls1 with | list_t.Cons x1 tl1 => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then Result.ret (x0, x1) else do @@ -398,9 +353,6 @@ def list_nth_shared_loop_pair_loop_fwd list_nth_shared_loop_pair_loop_fwd T tl0 tl1 i0 | list_t.Nil => Result.fail Error.panic | list_t.Nil => Result.fail Error.panic -termination_by list_nth_shared_loop_pair_loop_fwd ls0 ls1 i => - list_nth_shared_loop_pair_loop_terminates T ls0 ls1 i -decreasing_by list_nth_shared_loop_pair_loop_decreases ls0 ls1 i /- [loops::list_nth_shared_loop_pair] -/ def list_nth_shared_loop_pair_fwd @@ -408,13 +360,13 @@ def list_nth_shared_loop_pair_fwd list_nth_shared_loop_pair_loop_fwd T ls0 ls1 i /- [loops::list_nth_mut_loop_pair_merge] -/ -def list_nth_mut_loop_pair_merge_loop_fwd - (T : Type) (ls0 : list_t T) (ls1 : list_t T) (i : U32) : (Result (T × T)) := +divergent def list_nth_mut_loop_pair_merge_loop_fwd + (T : Type) (ls0 : list_t T) (ls1 : list_t T) (i : U32) : Result (T × T) := match h: ls0 with | list_t.Cons x0 tl0 => match h: ls1 with | list_t.Cons x1 tl1 => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then Result.ret (x0, x1) else do @@ -422,9 +374,6 @@ def list_nth_mut_loop_pair_merge_loop_fwd list_nth_mut_loop_pair_merge_loop_fwd T tl0 tl1 i0 | list_t.Nil => Result.fail Error.panic | list_t.Nil => Result.fail Error.panic -termination_by list_nth_mut_loop_pair_merge_loop_fwd ls0 ls1 i => - list_nth_mut_loop_pair_merge_loop_terminates T ls0 ls1 i -decreasing_by list_nth_mut_loop_pair_merge_loop_decreases ls0 ls1 i /- [loops::list_nth_mut_loop_pair_merge] -/ def list_nth_mut_loop_pair_merge_fwd @@ -432,15 +381,15 @@ def list_nth_mut_loop_pair_merge_fwd list_nth_mut_loop_pair_merge_loop_fwd T ls0 ls1 i /- [loops::list_nth_mut_loop_pair_merge] -/ -def list_nth_mut_loop_pair_merge_loop_back +divergent def list_nth_mut_loop_pair_merge_loop_back (T : Type) (ls0 : list_t T) (ls1 : list_t T) (i : U32) (ret0 : (T × T)) : - (Result ((list_t T) × (list_t T))) + Result ((list_t T) × (list_t T)) := match h: ls0 with | list_t.Cons x0 tl0 => match h: ls1 with | list_t.Cons x1 tl1 => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then let (t, t0) := ret0 Result.ret (list_t.Cons t tl0, list_t.Cons t0 tl1) @@ -452,9 +401,6 @@ def list_nth_mut_loop_pair_merge_loop_back Result.ret (list_t.Cons x0 tl00, list_t.Cons x1 tl10) | list_t.Nil => Result.fail Error.panic | list_t.Nil => Result.fail Error.panic -termination_by list_nth_mut_loop_pair_merge_loop_back ls0 ls1 i ret0 => - list_nth_mut_loop_pair_merge_loop_terminates T ls0 ls1 i -decreasing_by list_nth_mut_loop_pair_merge_loop_decreases ls0 ls1 i /- [loops::list_nth_mut_loop_pair_merge] -/ def list_nth_mut_loop_pair_merge_back @@ -464,13 +410,13 @@ def list_nth_mut_loop_pair_merge_back list_nth_mut_loop_pair_merge_loop_back T ls0 ls1 i ret0 /- [loops::list_nth_shared_loop_pair_merge] -/ -def list_nth_shared_loop_pair_merge_loop_fwd - (T : Type) (ls0 : list_t T) (ls1 : list_t T) (i : U32) : (Result (T × T)) := +divergent def list_nth_shared_loop_pair_merge_loop_fwd + (T : Type) (ls0 : list_t T) (ls1 : list_t T) (i : U32) : Result (T × T) := match h: ls0 with | list_t.Cons x0 tl0 => match h: ls1 with | list_t.Cons x1 tl1 => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then Result.ret (x0, x1) else do @@ -478,9 +424,6 @@ def list_nth_shared_loop_pair_merge_loop_fwd list_nth_shared_loop_pair_merge_loop_fwd T tl0 tl1 i0 | list_t.Nil => Result.fail Error.panic | list_t.Nil => Result.fail Error.panic -termination_by list_nth_shared_loop_pair_merge_loop_fwd ls0 ls1 i => - list_nth_shared_loop_pair_merge_loop_terminates T ls0 ls1 i -decreasing_by list_nth_shared_loop_pair_merge_loop_decreases ls0 ls1 i /- [loops::list_nth_shared_loop_pair_merge] -/ def list_nth_shared_loop_pair_merge_fwd @@ -488,13 +431,13 @@ def list_nth_shared_loop_pair_merge_fwd list_nth_shared_loop_pair_merge_loop_fwd T ls0 ls1 i /- [loops::list_nth_mut_shared_loop_pair] -/ -def list_nth_mut_shared_loop_pair_loop_fwd - (T : Type) (ls0 : list_t T) (ls1 : list_t T) (i : U32) : (Result (T × T)) := +divergent def list_nth_mut_shared_loop_pair_loop_fwd + (T : Type) (ls0 : list_t T) (ls1 : list_t T) (i : U32) : Result (T × T) := match h: ls0 with | list_t.Cons x0 tl0 => match h: ls1 with | list_t.Cons x1 tl1 => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then Result.ret (x0, x1) else do @@ -502,9 +445,6 @@ def list_nth_mut_shared_loop_pair_loop_fwd list_nth_mut_shared_loop_pair_loop_fwd T tl0 tl1 i0 | list_t.Nil => Result.fail Error.panic | list_t.Nil => Result.fail Error.panic -termination_by list_nth_mut_shared_loop_pair_loop_fwd ls0 ls1 i => - list_nth_mut_shared_loop_pair_loop_terminates T ls0 ls1 i -decreasing_by list_nth_mut_shared_loop_pair_loop_decreases ls0 ls1 i /- [loops::list_nth_mut_shared_loop_pair] -/ def list_nth_mut_shared_loop_pair_fwd @@ -512,15 +452,15 @@ def list_nth_mut_shared_loop_pair_fwd list_nth_mut_shared_loop_pair_loop_fwd T ls0 ls1 i /- [loops::list_nth_mut_shared_loop_pair] -/ -def list_nth_mut_shared_loop_pair_loop_back +divergent def list_nth_mut_shared_loop_pair_loop_back (T : Type) (ls0 : list_t T) (ls1 : list_t T) (i : U32) (ret0 : T) : - (Result (list_t T)) + Result (list_t T) := match h: ls0 with | list_t.Cons x0 tl0 => match h: ls1 with | list_t.Cons x1 tl1 => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then Result.ret (list_t.Cons ret0 tl0) else do @@ -530,9 +470,6 @@ def list_nth_mut_shared_loop_pair_loop_back Result.ret (list_t.Cons x0 tl00) | list_t.Nil => Result.fail Error.panic | list_t.Nil => Result.fail Error.panic -termination_by list_nth_mut_shared_loop_pair_loop_back ls0 ls1 i ret0 => - list_nth_mut_shared_loop_pair_loop_terminates T ls0 ls1 i -decreasing_by list_nth_mut_shared_loop_pair_loop_decreases ls0 ls1 i /- [loops::list_nth_mut_shared_loop_pair] -/ def list_nth_mut_shared_loop_pair_back @@ -542,13 +479,13 @@ def list_nth_mut_shared_loop_pair_back list_nth_mut_shared_loop_pair_loop_back T ls0 ls1 i ret0 /- [loops::list_nth_mut_shared_loop_pair_merge] -/ -def list_nth_mut_shared_loop_pair_merge_loop_fwd - (T : Type) (ls0 : list_t T) (ls1 : list_t T) (i : U32) : (Result (T × T)) := +divergent def list_nth_mut_shared_loop_pair_merge_loop_fwd + (T : Type) (ls0 : list_t T) (ls1 : list_t T) (i : U32) : Result (T × T) := match h: ls0 with | list_t.Cons x0 tl0 => match h: ls1 with | list_t.Cons x1 tl1 => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then Result.ret (x0, x1) else do @@ -556,9 +493,6 @@ def list_nth_mut_shared_loop_pair_merge_loop_fwd list_nth_mut_shared_loop_pair_merge_loop_fwd T tl0 tl1 i0 | list_t.Nil => Result.fail Error.panic | list_t.Nil => Result.fail Error.panic -termination_by list_nth_mut_shared_loop_pair_merge_loop_fwd ls0 ls1 i => - list_nth_mut_shared_loop_pair_merge_loop_terminates T ls0 ls1 i -decreasing_by list_nth_mut_shared_loop_pair_merge_loop_decreases ls0 ls1 i /- [loops::list_nth_mut_shared_loop_pair_merge] -/ def list_nth_mut_shared_loop_pair_merge_fwd @@ -566,15 +500,15 @@ def list_nth_mut_shared_loop_pair_merge_fwd list_nth_mut_shared_loop_pair_merge_loop_fwd T ls0 ls1 i /- [loops::list_nth_mut_shared_loop_pair_merge] -/ -def list_nth_mut_shared_loop_pair_merge_loop_back +divergent def list_nth_mut_shared_loop_pair_merge_loop_back (T : Type) (ls0 : list_t T) (ls1 : list_t T) (i : U32) (ret0 : T) : - (Result (list_t T)) + Result (list_t T) := match h: ls0 with | list_t.Cons x0 tl0 => match h: ls1 with | list_t.Cons x1 tl1 => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then Result.ret (list_t.Cons ret0 tl0) else do @@ -584,9 +518,6 @@ def list_nth_mut_shared_loop_pair_merge_loop_back Result.ret (list_t.Cons x0 tl00) | list_t.Nil => Result.fail Error.panic | list_t.Nil => Result.fail Error.panic -termination_by list_nth_mut_shared_loop_pair_merge_loop_back ls0 ls1 i ret0 => - list_nth_mut_shared_loop_pair_merge_loop_terminates T ls0 ls1 i -decreasing_by list_nth_mut_shared_loop_pair_merge_loop_decreases ls0 ls1 i /- [loops::list_nth_mut_shared_loop_pair_merge] -/ def list_nth_mut_shared_loop_pair_merge_back @@ -596,13 +527,13 @@ def list_nth_mut_shared_loop_pair_merge_back list_nth_mut_shared_loop_pair_merge_loop_back T ls0 ls1 i ret0 /- [loops::list_nth_shared_mut_loop_pair] -/ -def list_nth_shared_mut_loop_pair_loop_fwd - (T : Type) (ls0 : list_t T) (ls1 : list_t T) (i : U32) : (Result (T × T)) := +divergent def list_nth_shared_mut_loop_pair_loop_fwd + (T : Type) (ls0 : list_t T) (ls1 : list_t T) (i : U32) : Result (T × T) := match h: ls0 with | list_t.Cons x0 tl0 => match h: ls1 with | list_t.Cons x1 tl1 => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then Result.ret (x0, x1) else do @@ -610,9 +541,6 @@ def list_nth_shared_mut_loop_pair_loop_fwd list_nth_shared_mut_loop_pair_loop_fwd T tl0 tl1 i0 | list_t.Nil => Result.fail Error.panic | list_t.Nil => Result.fail Error.panic -termination_by list_nth_shared_mut_loop_pair_loop_fwd ls0 ls1 i => - list_nth_shared_mut_loop_pair_loop_terminates T ls0 ls1 i -decreasing_by list_nth_shared_mut_loop_pair_loop_decreases ls0 ls1 i /- [loops::list_nth_shared_mut_loop_pair] -/ def list_nth_shared_mut_loop_pair_fwd @@ -620,15 +548,15 @@ def list_nth_shared_mut_loop_pair_fwd list_nth_shared_mut_loop_pair_loop_fwd T ls0 ls1 i /- [loops::list_nth_shared_mut_loop_pair] -/ -def list_nth_shared_mut_loop_pair_loop_back +divergent def list_nth_shared_mut_loop_pair_loop_back (T : Type) (ls0 : list_t T) (ls1 : list_t T) (i : U32) (ret0 : T) : - (Result (list_t T)) + Result (list_t T) := match h: ls0 with | list_t.Cons x0 tl0 => match h: ls1 with | list_t.Cons x1 tl1 => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then Result.ret (list_t.Cons ret0 tl1) else do @@ -638,9 +566,6 @@ def list_nth_shared_mut_loop_pair_loop_back Result.ret (list_t.Cons x1 tl10) | list_t.Nil => Result.fail Error.panic | list_t.Nil => Result.fail Error.panic -termination_by list_nth_shared_mut_loop_pair_loop_back ls0 ls1 i ret0 => - list_nth_shared_mut_loop_pair_loop_terminates T ls0 ls1 i -decreasing_by list_nth_shared_mut_loop_pair_loop_decreases ls0 ls1 i /- [loops::list_nth_shared_mut_loop_pair] -/ def list_nth_shared_mut_loop_pair_back @@ -650,13 +575,13 @@ def list_nth_shared_mut_loop_pair_back list_nth_shared_mut_loop_pair_loop_back T ls0 ls1 i ret0 /- [loops::list_nth_shared_mut_loop_pair_merge] -/ -def list_nth_shared_mut_loop_pair_merge_loop_fwd - (T : Type) (ls0 : list_t T) (ls1 : list_t T) (i : U32) : (Result (T × T)) := +divergent def list_nth_shared_mut_loop_pair_merge_loop_fwd + (T : Type) (ls0 : list_t T) (ls1 : list_t T) (i : U32) : Result (T × T) := match h: ls0 with | list_t.Cons x0 tl0 => match h: ls1 with | list_t.Cons x1 tl1 => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then Result.ret (x0, x1) else do @@ -664,9 +589,6 @@ def list_nth_shared_mut_loop_pair_merge_loop_fwd list_nth_shared_mut_loop_pair_merge_loop_fwd T tl0 tl1 i0 | list_t.Nil => Result.fail Error.panic | list_t.Nil => Result.fail Error.panic -termination_by list_nth_shared_mut_loop_pair_merge_loop_fwd ls0 ls1 i => - list_nth_shared_mut_loop_pair_merge_loop_terminates T ls0 ls1 i -decreasing_by list_nth_shared_mut_loop_pair_merge_loop_decreases ls0 ls1 i /- [loops::list_nth_shared_mut_loop_pair_merge] -/ def list_nth_shared_mut_loop_pair_merge_fwd @@ -674,15 +596,15 @@ def list_nth_shared_mut_loop_pair_merge_fwd list_nth_shared_mut_loop_pair_merge_loop_fwd T ls0 ls1 i /- [loops::list_nth_shared_mut_loop_pair_merge] -/ -def list_nth_shared_mut_loop_pair_merge_loop_back +divergent def list_nth_shared_mut_loop_pair_merge_loop_back (T : Type) (ls0 : list_t T) (ls1 : list_t T) (i : U32) (ret0 : T) : - (Result (list_t T)) + Result (list_t T) := match h: ls0 with | list_t.Cons x0 tl0 => match h: ls1 with | list_t.Cons x1 tl1 => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then Result.ret (list_t.Cons ret0 tl1) else do @@ -692,9 +614,6 @@ def list_nth_shared_mut_loop_pair_merge_loop_back Result.ret (list_t.Cons x1 tl10) | list_t.Nil => Result.fail Error.panic | list_t.Nil => Result.fail Error.panic -termination_by list_nth_shared_mut_loop_pair_merge_loop_back ls0 ls1 i ret0 => - list_nth_shared_mut_loop_pair_merge_loop_terminates T ls0 ls1 i -decreasing_by list_nth_shared_mut_loop_pair_merge_loop_decreases ls0 ls1 i /- [loops::list_nth_shared_mut_loop_pair_merge] -/ def list_nth_shared_mut_loop_pair_merge_back diff --git a/tests/lean/misc-loops/Loops/Types.lean b/tests/lean/Loops/Types.lean index ca43f4c8..e14f9766 100644 --- a/tests/lean/misc-loops/Loops/Types.lean +++ b/tests/lean/Loops/Types.lean @@ -1,6 +1,7 @@ -- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS -- [loops]: type definitions -import Base.Primitives +import Base +open Primitives /- [loops::List] -/ inductive list_t (T : Type) := diff --git a/tests/lean/Makefile b/tests/lean/Makefile index ed3b3e3b..3ccfbec2 100644 --- a/tests/lean/Makefile +++ b/tests/lean/Makefile @@ -1,40 +1,35 @@ ALL_DIRS ?= $(filter-out %~ lean-toolchain% Makefile%, $(wildcard *)) +# TODO: remove UPDATE_DIRS = $(addprefix update-,$(ALL_DIRS)) +# TODO: remove VERIFY_DIRS = $(addprefix verif-,$(ALL_DIRS)) +# TODO: remove CLEAN_DIRS = $(addprefix clean-,$(ALL_DIRS)) +# TODO: remove COPY_LEAN_TOOLCHAIN = $(addprefix copy-lean-toolchain-,$(ALL_DIRS)) .PHONY: all all: prepare-projects verify .PHONY: prepare-projects -prepare-projects: $(COPY_LEAN_TOOLCHAIN) +prepare-projects: copy-lean-toolchain .PHONY: prepare-projects -copy-lean-toolchain-%: - cp lean-toolchain $* +copy-lean-toolchain: + cp ../../backends/lean/lean-toolchain . .PHONY: update -update: $(UPDATE_DIRS) - -.PHONY: update-% -update-%: - cd $* && lake update +update: + lake update .PHONY: verify -verify: $(VERIFY_DIRS) - -.PHONY: verif-% -verif-%: - cd $* && lake build +verify: + lake build .PHONY: clean -clean: $(CLEAN_DIRS) - -.PHONY: clean-% -clean-%: - cd $* && lake clean +clean: + lake clean diff --git a/tests/lean/misc-no_nested_borrows/NoNestedBorrows.lean b/tests/lean/NoNestedBorrows.lean index 12c7d8f7..67ef4b20 100644 --- a/tests/lean/misc-no_nested_borrows/NoNestedBorrows.lean +++ b/tests/lean/NoNestedBorrows.lean @@ -1,6 +1,7 @@ -- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS -- [no_nested_borrows] -import Base.Primitives +import Base +open Primitives /- [no_nested_borrows::Pair] -/ structure pair_t (T1 T2 : Type) where @@ -72,7 +73,7 @@ def test2_fwd : Result Unit := /- [no_nested_borrows::get_max] -/ def get_max_fwd (x : U32) (y : U32) : Result U32 := - if h: x >= y + if x >= y then Result.ret x else Result.ret y @@ -82,7 +83,7 @@ def test3_fwd : Result Unit := let x ← get_max_fwd (U32.ofInt 4 (by intlit)) (U32.ofInt 3 (by intlit)) let y ← get_max_fwd (U32.ofInt 10 (by intlit)) (U32.ofInt 11 (by intlit)) let z ← x + y - if h: not (z = (U32.ofInt 15 (by intlit))) + if not (z = (U32.ofInt 15 (by intlit))) then Result.fail Error.panic else Result.ret () @@ -93,7 +94,7 @@ def test3_fwd : Result Unit := def test_neg1_fwd : Result Unit := do let y ← - (I32.ofInt 3 (by intlit)) - if h: not (y = (I32.ofInt (-(3:Int)) (by intlit))) + if not (y = (I32.ofInt (-(3:Int)) (by intlit))) then Result.fail Error.panic else Result.ret () @@ -102,7 +103,7 @@ def test_neg1_fwd : Result Unit := /- [no_nested_borrows::refs_test1] -/ def refs_test1_fwd : Result Unit := - if h: not ((I32.ofInt 1 (by intlit)) = (I32.ofInt 1 (by intlit))) + if not ((I32.ofInt 1 (by intlit)) = (I32.ofInt 1 (by intlit))) then Result.fail Error.panic else Result.ret () @@ -111,16 +112,16 @@ def refs_test1_fwd : Result Unit := /- [no_nested_borrows::refs_test2] -/ def refs_test2_fwd : Result Unit := - if h: not ((I32.ofInt 2 (by intlit)) = (I32.ofInt 2 (by intlit))) + if not ((I32.ofInt 2 (by intlit)) = (I32.ofInt 2 (by intlit))) then Result.fail Error.panic else - if h: not ((I32.ofInt 0 (by intlit)) = (I32.ofInt 0 (by intlit))) + if not ((I32.ofInt 0 (by intlit)) = (I32.ofInt 0 (by intlit))) then Result.fail Error.panic else - if h: not ((I32.ofInt 2 (by intlit)) = (I32.ofInt 2 (by intlit))) + if not ((I32.ofInt 2 (by intlit)) = (I32.ofInt 2 (by intlit))) then Result.fail Error.panic else - if h: not ((I32.ofInt 2 (by intlit)) = (I32.ofInt 2 (by intlit))) + if not ((I32.ofInt 2 (by intlit)) = (I32.ofInt 2 (by intlit))) then Result.fail Error.panic else Result.ret () @@ -138,7 +139,7 @@ def test_list1_fwd : Result Unit := def test_box1_fwd : Result Unit := let b := (I32.ofInt 1 (by intlit)) let x := b - if h: not (x = (I32.ofInt 1 (by intlit))) + if not (x = (I32.ofInt 1 (by intlit))) then Result.fail Error.panic else Result.ret () @@ -151,13 +152,13 @@ def copy_int_fwd (x : I32) : Result I32 := /- [no_nested_borrows::test_unreachable] -/ def test_unreachable_fwd (b : Bool) : Result Unit := - if h: b + if b then Result.fail Error.panic else Result.ret () /- [no_nested_borrows::test_panic] -/ def test_panic_fwd (b : Bool) : Result Unit := - if h: b + if b then Result.fail Error.panic else Result.ret () @@ -165,7 +166,7 @@ def test_panic_fwd (b : Bool) : Result Unit := def test_copy_int_fwd : Result Unit := do let y ← copy_int_fwd (I32.ofInt 0 (by intlit)) - if h: not ((I32.ofInt 0 (by intlit)) = y) + if not ((I32.ofInt 0 (by intlit)) = y) then Result.fail Error.panic else Result.ret () @@ -183,7 +184,7 @@ def test_is_cons_fwd : Result Unit := do let l := list_t.Nil let b ← is_cons_fwd I32 (list_t.Cons (I32.ofInt 0 (by intlit)) l) - if h: not b + if not b then Result.fail Error.panic else Result.ret () @@ -202,7 +203,7 @@ def test_split_list_fwd : Result Unit := let l := list_t.Nil let p ← split_list_fwd I32 (list_t.Cons (I32.ofInt 0 (by intlit)) l) let (hd, _) := p - if h: not (hd = (I32.ofInt 0 (by intlit))) + if not (hd = (I32.ofInt 0 (by intlit))) then Result.fail Error.panic else Result.ret () @@ -211,14 +212,14 @@ def test_split_list_fwd : Result Unit := /- [no_nested_borrows::choose] -/ def choose_fwd (T : Type) (b : Bool) (x : T) (y : T) : Result T := - if h: b + if b then Result.ret x else Result.ret y /- [no_nested_borrows::choose] -/ def choose_back (T : Type) (b : Bool) (x : T) (y : T) (ret0 : T) : Result (T × T) := - if h: b + if b then Result.ret (ret0, y) else Result.ret (x, ret0) @@ -228,17 +229,17 @@ def choose_test_fwd : Result Unit := let z ← choose_fwd I32 true (I32.ofInt 0 (by intlit)) (I32.ofInt 0 (by intlit)) let z0 ← z + (I32.ofInt 1 (by intlit)) - if h: not (z0 = (I32.ofInt 1 (by intlit))) + if not (z0 = (I32.ofInt 1 (by intlit))) then Result.fail Error.panic else do let (x, y) ← choose_back I32 true (I32.ofInt 0 (by intlit)) (I32.ofInt 0 (by intlit)) z0 - if h: not (x = (I32.ofInt 1 (by intlit))) + if not (x = (I32.ofInt 1 (by intlit))) then Result.fail Error.panic else - if h: not (y = (I32.ofInt 0 (by intlit))) + if not (y = (I32.ofInt 0 (by intlit))) then Result.fail Error.panic else Result.ret () @@ -264,7 +265,7 @@ inductive tree_t (T : Type) := end /- [no_nested_borrows::list_length] -/ -def list_length_fwd (T : Type) (l : list_t T) : Result U32 := +divergent def list_length_fwd (T : Type) (l : list_t T) : Result U32 := match h: l with | list_t.Cons t l1 => do @@ -273,10 +274,11 @@ def list_length_fwd (T : Type) (l : list_t T) : Result U32 := | list_t.Nil => Result.ret (U32.ofInt 0 (by intlit)) /- [no_nested_borrows::list_nth_shared] -/ -def list_nth_shared_fwd (T : Type) (l : list_t T) (i : U32) : Result T := +divergent def list_nth_shared_fwd + (T : Type) (l : list_t T) (i : U32) : Result T := match h: l with | list_t.Cons x tl => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then Result.ret x else do @@ -285,10 +287,11 @@ def list_nth_shared_fwd (T : Type) (l : list_t T) (i : U32) : Result T := | list_t.Nil => Result.fail Error.panic /- [no_nested_borrows::list_nth_mut] -/ -def list_nth_mut_fwd (T : Type) (l : list_t T) (i : U32) : Result T := +divergent def list_nth_mut_fwd + (T : Type) (l : list_t T) (i : U32) : Result T := match h: l with | list_t.Cons x tl => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then Result.ret x else do let i0 ← i - (U32.ofInt 1 (by intlit)) @@ -296,11 +299,11 @@ def list_nth_mut_fwd (T : Type) (l : list_t T) (i : U32) : Result T := | list_t.Nil => Result.fail Error.panic /- [no_nested_borrows::list_nth_mut] -/ -def list_nth_mut_back +divergent def list_nth_mut_back (T : Type) (l : list_t T) (i : U32) (ret0 : T) : Result (list_t T) := match h: l with | list_t.Cons x tl => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then Result.ret (list_t.Cons ret0 tl) else do @@ -310,7 +313,7 @@ def list_nth_mut_back | list_t.Nil => Result.fail Error.panic /- [no_nested_borrows::list_rev_aux] -/ -def list_rev_aux_fwd +divergent def list_rev_aux_fwd (T : Type) (li : list_t T) (lo : list_t T) : Result (list_t T) := match h: li with | list_t.Cons hd tl => list_rev_aux_fwd T tl (list_t.Cons hd lo) @@ -328,28 +331,28 @@ def test_list_functions_fwd : Result Unit := let l0 := list_t.Cons (I32.ofInt 2 (by intlit)) l let l1 := list_t.Cons (I32.ofInt 1 (by intlit)) l0 let i ← list_length_fwd I32 (list_t.Cons (I32.ofInt 0 (by intlit)) l1) - if h: not (i = (U32.ofInt 3 (by intlit))) + if not (i = (U32.ofInt 3 (by intlit))) then Result.fail Error.panic else do let i0 ← list_nth_shared_fwd I32 (list_t.Cons (I32.ofInt 0 (by intlit)) l1) (U32.ofInt 0 (by intlit)) - if h: not (i0 = (I32.ofInt 0 (by intlit))) + if not (i0 = (I32.ofInt 0 (by intlit))) then Result.fail Error.panic else do let i1 ← list_nth_shared_fwd I32 (list_t.Cons (I32.ofInt 0 (by intlit)) l1) (U32.ofInt 1 (by intlit)) - if h: not (i1 = (I32.ofInt 1 (by intlit))) + if not (i1 = (I32.ofInt 1 (by intlit))) then Result.fail Error.panic else do let i2 ← list_nth_shared_fwd I32 (list_t.Cons (I32.ofInt 0 (by intlit)) l1) (U32.ofInt 2 (by intlit)) - if h: not (i2 = (I32.ofInt 2 (by intlit))) + if not (i2 = (I32.ofInt 2 (by intlit))) then Result.fail Error.panic else do @@ -359,20 +362,20 @@ def test_list_functions_fwd : Result Unit := (I32.ofInt 3 (by intlit)) let i3 ← list_nth_shared_fwd I32 ls (U32.ofInt 0 (by intlit)) - if h: not (i3 = (I32.ofInt 0 (by intlit))) + if not (i3 = (I32.ofInt 0 (by intlit))) then Result.fail Error.panic else do let i4 ← list_nth_shared_fwd I32 ls (U32.ofInt 1 (by intlit)) - if h: not (i4 = (I32.ofInt 3 (by intlit))) + if not (i4 = (I32.ofInt 3 (by intlit))) then Result.fail Error.panic else do let i5 ← list_nth_shared_fwd I32 ls (U32.ofInt 2 (by intlit)) - if h: not (i5 = (I32.ofInt 2 (by intlit))) + if not (i5 = (I32.ofInt 2 (by intlit))) then Result.fail Error.panic else Result.ret () @@ -477,24 +480,24 @@ def test_constants_fwd : Result Unit := do let swt ← new_tuple1_fwd let (i, _) := swt.struct_with_tuple_p - if h: not (i = (U32.ofInt 1 (by intlit))) + if not (i = (U32.ofInt 1 (by intlit))) then Result.fail Error.panic else do let swt0 ← new_tuple2_fwd let (i0, _) := swt0.struct_with_tuple_p - if h: not (i0 = (I16.ofInt 1 (by intlit))) + if not (i0 = (I16.ofInt 1 (by intlit))) then Result.fail Error.panic else do let swt1 ← new_tuple3_fwd let (i1, _) := swt1.struct_with_tuple_p - if h: not (i1 = (U64.ofInt 1 (by intlit))) + if not (i1 = (U64.ofInt 1 (by intlit))) then Result.fail Error.panic else do let swp ← new_pair1_fwd - if h: not (swp.struct_with_pair_p.pair_x = + if not (swp.struct_with_pair_p.pair_x = (U32.ofInt 1 (by intlit))) then Result.fail Error.panic else Result.ret () @@ -512,13 +515,13 @@ def test_weird_borrows1_fwd : Result Unit := /- [no_nested_borrows::test_mem_replace] -/ def test_mem_replace_fwd_back (px : U32) : Result U32 := let y := mem_replace_fwd U32 px (U32.ofInt 1 (by intlit)) - if h: not (y = (U32.ofInt 0 (by intlit))) + if not (y = (U32.ofInt 0 (by intlit))) then Result.fail Error.panic else Result.ret (U32.ofInt 2 (by intlit)) /- [no_nested_borrows::test_shared_borrow_bool1] -/ def test_shared_borrow_bool1_fwd (b : Bool) : Result U32 := - if h: b + if b then Result.ret (U32.ofInt 0 (by intlit)) else Result.ret (U32.ofInt 1 (by intlit)) diff --git a/tests/lean/misc-paper/Paper.lean b/tests/lean/Paper.lean index 0b16fb8e..9019b694 100644 --- a/tests/lean/misc-paper/Paper.lean +++ b/tests/lean/Paper.lean @@ -1,6 +1,7 @@ -- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS -- [paper] -import Base.Primitives +import Base +open Primitives /- [paper::ref_incr] -/ def ref_incr_fwd_back (x : I32) : Result I32 := @@ -10,7 +11,7 @@ def ref_incr_fwd_back (x : I32) : Result I32 := def test_incr_fwd : Result Unit := do let x ← ref_incr_fwd_back (I32.ofInt 0 (by intlit)) - if h: not (x = (I32.ofInt 1 (by intlit))) + if not (x = (I32.ofInt 1 (by intlit))) then Result.fail Error.panic else Result.ret () @@ -19,14 +20,14 @@ def test_incr_fwd : Result Unit := /- [paper::choose] -/ def choose_fwd (T : Type) (b : Bool) (x : T) (y : T) : Result T := - if h: b + if b then Result.ret x else Result.ret y /- [paper::choose] -/ def choose_back (T : Type) (b : Bool) (x : T) (y : T) (ret0 : T) : Result (T × T) := - if h: b + if b then Result.ret (ret0, y) else Result.ret (x, ret0) @@ -36,17 +37,17 @@ def test_choose_fwd : Result Unit := let z ← choose_fwd I32 true (I32.ofInt 0 (by intlit)) (I32.ofInt 0 (by intlit)) let z0 ← z + (I32.ofInt 1 (by intlit)) - if h: not (z0 = (I32.ofInt 1 (by intlit))) + if not (z0 = (I32.ofInt 1 (by intlit))) then Result.fail Error.panic else do let (x, y) ← choose_back I32 true (I32.ofInt 0 (by intlit)) (I32.ofInt 0 (by intlit)) z0 - if h: not (x = (I32.ofInt 1 (by intlit))) + if not (x = (I32.ofInt 1 (by intlit))) then Result.fail Error.panic else - if h: not (y = (I32.ofInt 0 (by intlit))) + if not (y = (I32.ofInt 0 (by intlit))) then Result.fail Error.panic else Result.ret () @@ -59,10 +60,11 @@ inductive list_t (T : Type) := | Nil : list_t T /- [paper::list_nth_mut] -/ -def list_nth_mut_fwd (T : Type) (l : list_t T) (i : U32) : Result T := +divergent def list_nth_mut_fwd + (T : Type) (l : list_t T) (i : U32) : Result T := match h: l with | list_t.Cons x tl => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then Result.ret x else do let i0 ← i - (U32.ofInt 1 (by intlit)) @@ -70,11 +72,11 @@ def list_nth_mut_fwd (T : Type) (l : list_t T) (i : U32) : Result T := | list_t.Nil => Result.fail Error.panic /- [paper::list_nth_mut] -/ -def list_nth_mut_back +divergent def list_nth_mut_back (T : Type) (l : list_t T) (i : U32) (ret0 : T) : Result (list_t T) := match h: l with | list_t.Cons x tl => - if h: i = (U32.ofInt 0 (by intlit)) + if i = (U32.ofInt 0 (by intlit)) then Result.ret (list_t.Cons ret0 tl) else do @@ -84,7 +86,7 @@ def list_nth_mut_back | list_t.Nil => Result.fail Error.panic /- [paper::sum] -/ -def sum_fwd (l : list_t I32) : Result I32 := +divergent def sum_fwd (l : list_t I32) : Result I32 := match h: l with | list_t.Cons x tl => do let i ← sum_fwd tl @@ -105,7 +107,7 @@ def test_nth_fwd : Result Unit := list_nth_mut_back I32 (list_t.Cons (I32.ofInt 1 (by intlit)) l1) (U32.ofInt 2 (by intlit)) x0 let i ← sum_fwd l2 - if h: not (i = (I32.ofInt 7 (by intlit))) + if not (i = (I32.ofInt 7 (by intlit))) then Result.fail Error.panic else Result.ret () diff --git a/tests/lean/misc-polonius_list/PoloniusList.lean b/tests/lean/PoloniusList.lean index 79696996..671f54ea 100644 --- a/tests/lean/misc-polonius_list/PoloniusList.lean +++ b/tests/lean/PoloniusList.lean @@ -1,6 +1,7 @@ -- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS -- [polonius_list] -import Base.Primitives +import Base +open Primitives /- [polonius_list::List] -/ inductive list_t (T : Type) := @@ -8,20 +9,21 @@ inductive list_t (T : Type) := | Nil : list_t T /- [polonius_list::get_list_at_x] -/ -def get_list_at_x_fwd (ls : list_t U32) (x : U32) : Result (list_t U32) := +divergent def get_list_at_x_fwd + (ls : list_t U32) (x : U32) : Result (list_t U32) := match h: ls with | list_t.Cons hd tl => - if h: hd = x + if hd = x then Result.ret (list_t.Cons hd tl) else get_list_at_x_fwd tl x | list_t.Nil => Result.ret list_t.Nil /- [polonius_list::get_list_at_x] -/ -def get_list_at_x_back +divergent def get_list_at_x_back (ls : list_t U32) (x : U32) (ret0 : list_t U32) : Result (list_t U32) := match h: ls with | list_t.Cons hd tl => - if h: hd = x + if hd = x then Result.ret ret0 else do diff --git a/tests/lean/Tests.lean b/tests/lean/Tests.lean new file mode 100644 index 00000000..9b12270e --- /dev/null +++ b/tests/lean/Tests.lean @@ -0,0 +1,9 @@ +import BetreeMain +import Constants +import External +import Hashmap +import HashmapMain +import Loops +import NoNestedBorrows +import Paper +import PoloniusList diff --git a/tests/lean/hashmap/Base/Primitives.lean b/tests/lean/hashmap/Base/Primitives.lean deleted file mode 100644 index 4a66a453..00000000 --- a/tests/lean/hashmap/Base/Primitives.lean +++ /dev/null @@ -1,583 +0,0 @@ -import Lean -import Lean.Meta.Tactic.Simp -import Init.Data.List.Basic -import Mathlib.Tactic.RunCmd - --------------------- --- ASSERT COMMAND -- --------------------- - -open Lean Elab Command Term Meta - -syntax (name := assert) "#assert" term: command - -@[command_elab assert] -unsafe -def assertImpl : CommandElab := fun (_stx: Syntax) => do - runTermElabM (fun _ => do - let r ← evalTerm Bool (mkConst ``Bool) _stx[1] - if not r then - logInfo "Assertion failed for: " - logInfo _stx[1] - logError "Expression reduced to false" - pure ()) - -#eval 2 == 2 -#assert (2 == 2) - -------------- --- PRELUDE -- -------------- - --- Results & monadic combinators - -inductive Error where - | assertionFailure: Error - | integerOverflow: Error - | divisionByZero: Error - | arrayOutOfBounds: Error - | maximumSizeExceeded: Error - | panic: Error -deriving Repr, BEq - -open Error - -inductive Result (α : Type u) where - | ret (v: α): Result α - | fail (e: Error): Result α -deriving Repr, BEq - -open Result - -instance Result_Inhabited (α : Type u) : Inhabited (Result α) := - Inhabited.mk (fail panic) - -/- HELPERS -/ - -def ret? {α: Type} (r: Result α): Bool := - match r with - | Result.ret _ => true - | Result.fail _ => false - -def massert (b:Bool) : Result Unit := - if b then .ret () else fail assertionFailure - -def eval_global {α: Type} (x: Result α) (_: ret? x): α := - match x with - | Result.fail _ => by contradiction - | Result.ret x => x - -/- DO-DSL SUPPORT -/ - -def bind (x: Result α) (f: α -> Result β) : Result β := - match x with - | ret v => f v - | fail v => fail v - --- Allows using Result in do-blocks -instance : Bind Result where - bind := bind - --- Allows using return x in do-blocks -instance : Pure Result where - pure := fun x => ret x - -/- CUSTOM-DSL SUPPORT -/ - --- Let-binding the Result of a monadic operation is oftentimes not sufficient, --- because we may need a hypothesis for equational reasoning in the scope. We --- rely on subtype, and a custom let-binding operator, in effect recreating our --- own variant of the do-dsl - -def Result.attach {α: Type} (o : Result α): Result { x : α // o = ret x } := - match o with - | .ret x => .ret ⟨x, rfl⟩ - | .fail e => .fail e - -macro "let" e:term " ⟵ " f:term : doElem => - `(doElem| let ⟨$e, h⟩ ← Result.attach $f) - --- TODO: any way to factorize both definitions? -macro "let" e:term " <-- " f:term : doElem => - `(doElem| let ⟨$e, h⟩ ← Result.attach $f) - --- We call the hypothesis `h`, in effect making it unavailable to the user --- (because too much shadowing). But in practice, once can use the French single --- quote notation (input with f< and f>), where `‹ h ›` finds a suitable --- hypothesis in the context, this is equivalent to `have x: h := by assumption in x` -#eval do - let y <-- .ret (0: Nat) - let _: y = 0 := by cases ‹ ret 0 = ret y › ; decide - let r: { x: Nat // x = 0 } := ⟨ y, by assumption ⟩ - .ret r - ----------------------- --- MACHINE INTEGERS -- ----------------------- - --- We redefine our machine integers types. - --- For Isize/Usize, we reuse `getNumBits` from `USize`. You cannot reduce `getNumBits` --- using the simplifier, meaning that proofs do not depend on the compile-time value of --- USize.size. (Lean assumes 32 or 64-bit platforms, and Rust doesn't really support, at --- least officially, 16-bit microcontrollers, so this seems like a fine design decision --- for now.) - --- Note from Chris Bailey: "If there's more than one salient property of your --- definition then the subtyping strategy might get messy, and the property part --- of a subtype is less discoverable by the simplifier or tactics like --- library_search." So, we will not add refinements on the return values of the --- operations defined on Primitives, but will rather rely on custom lemmas to --- invert on possible return values of the primitive operations. - --- Machine integer constants, done via `ofNatCore`, which requires a proof that --- the `Nat` fits within the desired integer type. We provide a custom tactic. - -open System.Platform.getNumBits - --- TODO: is there a way of only importing System.Platform.getNumBits? --- -@[simp] def size_num_bits : Nat := (System.Platform.getNumBits ()).val - --- Remark: Lean seems to use < for the comparisons with the upper bounds by convention. --- We keep the F* convention for now. -@[simp] def Isize.min : Int := - (HPow.hPow 2 (size_num_bits - 1)) -@[simp] def Isize.max : Int := (HPow.hPow 2 (size_num_bits - 1)) - 1 -@[simp] def I8.min : Int := - (HPow.hPow 2 7) -@[simp] def I8.max : Int := HPow.hPow 2 7 - 1 -@[simp] def I16.min : Int := - (HPow.hPow 2 15) -@[simp] def I16.max : Int := HPow.hPow 2 15 - 1 -@[simp] def I32.min : Int := -(HPow.hPow 2 31) -@[simp] def I32.max : Int := HPow.hPow 2 31 - 1 -@[simp] def I64.min : Int := -(HPow.hPow 2 63) -@[simp] def I64.max : Int := HPow.hPow 2 63 - 1 -@[simp] def I128.min : Int := -(HPow.hPow 2 127) -@[simp] def I128.max : Int := HPow.hPow 2 127 - 1 -@[simp] def Usize.min : Int := 0 -@[simp] def Usize.max : Int := HPow.hPow 2 size_num_bits - 1 -@[simp] def U8.min : Int := 0 -@[simp] def U8.max : Int := HPow.hPow 2 8 - 1 -@[simp] def U16.min : Int := 0 -@[simp] def U16.max : Int := HPow.hPow 2 16 - 1 -@[simp] def U32.min : Int := 0 -@[simp] def U32.max : Int := HPow.hPow 2 32 - 1 -@[simp] def U64.min : Int := 0 -@[simp] def U64.max : Int := HPow.hPow 2 64 - 1 -@[simp] def U128.min : Int := 0 -@[simp] def U128.max : Int := HPow.hPow 2 128 - 1 - -#assert (I8.min == -128) -#assert (I8.max == 127) -#assert (I16.min == -32768) -#assert (I16.max == 32767) -#assert (I32.min == -2147483648) -#assert (I32.max == 2147483647) -#assert (I64.min == -9223372036854775808) -#assert (I64.max == 9223372036854775807) -#assert (I128.min == -170141183460469231731687303715884105728) -#assert (I128.max == 170141183460469231731687303715884105727) -#assert (U8.min == 0) -#assert (U8.max == 255) -#assert (U16.min == 0) -#assert (U16.max == 65535) -#assert (U32.min == 0) -#assert (U32.max == 4294967295) -#assert (U64.min == 0) -#assert (U64.max == 18446744073709551615) -#assert (U128.min == 0) -#assert (U128.max == 340282366920938463463374607431768211455) - -inductive ScalarTy := -| Isize -| I8 -| I16 -| I32 -| I64 -| I128 -| Usize -| U8 -| U16 -| U32 -| U64 -| U128 - -def Scalar.min (ty : ScalarTy) : Int := - match ty with - | .Isize => Isize.min - | .I8 => I8.min - | .I16 => I16.min - | .I32 => I32.min - | .I64 => I64.min - | .I128 => I128.min - | .Usize => Usize.min - | .U8 => U8.min - | .U16 => U16.min - | .U32 => U32.min - | .U64 => U64.min - | .U128 => U128.min - -def Scalar.max (ty : ScalarTy) : Int := - match ty with - | .Isize => Isize.max - | .I8 => I8.max - | .I16 => I16.max - | .I32 => I32.max - | .I64 => I64.max - | .I128 => I128.max - | .Usize => Usize.max - | .U8 => U8.max - | .U16 => U16.max - | .U32 => U32.max - | .U64 => U64.max - | .U128 => U128.max - --- "Conservative" bounds --- We use those because we can't compare to the isize bounds (which can't --- reduce at compile-time). Whenever we perform an arithmetic operation like --- addition we need to check that the result is in bounds: we first compare --- to the conservative bounds, which reduce, then compare to the real bounds. --- This is useful for the various #asserts that we want to reduce at --- type-checking time. -def Scalar.cMin (ty : ScalarTy) : Int := - match ty with - | .Isize => I32.min - | _ => Scalar.min ty - -def Scalar.cMax (ty : ScalarTy) : Int := - match ty with - | .Isize => I32.max - | .Usize => U32.max - | _ => Scalar.max ty - -theorem Scalar.cMin_bound ty : Scalar.min ty <= Scalar.cMin ty := by sorry -theorem Scalar.cMax_bound ty : Scalar.min ty <= Scalar.cMin ty := by sorry - -structure Scalar (ty : ScalarTy) where - val : Int - hmin : Scalar.min ty <= val - hmax : val <= Scalar.max ty - -theorem Scalar.bound_suffices (ty : ScalarTy) (x : Int) : - Scalar.cMin ty <= x && x <= Scalar.cMax ty -> - (decide (Scalar.min ty ≤ x) && decide (x ≤ Scalar.max ty)) = true - := by sorry - -def Scalar.ofIntCore {ty : ScalarTy} (x : Int) - (hmin : Scalar.min ty <= x) (hmax : x <= Scalar.max ty) : Scalar ty := - { val := x, hmin := hmin, hmax := hmax } - -def Scalar.ofInt {ty : ScalarTy} (x : Int) - (h : Scalar.min ty <= x && x <= Scalar.max ty) : Scalar ty := - let hmin: Scalar.min ty <= x := by sorry - let hmax: x <= Scalar.max ty := by sorry - Scalar.ofIntCore x hmin hmax - --- Further thoughts: look at what has been done here: --- https://github.com/leanprover-community/mathlib4/blob/master/Mathlib/Data/Fin/Basic.lean --- and --- https://github.com/leanprover-community/mathlib4/blob/master/Mathlib/Data/UInt.lean --- which both contain a fair amount of reasoning already! -def Scalar.tryMk (ty : ScalarTy) (x : Int) : Result (Scalar ty) := - -- TODO: write this with only one if then else - if hmin_cons: Scalar.cMin ty <= x || Scalar.min ty <= x then - if hmax_cons: x <= Scalar.cMax ty || x <= Scalar.max ty then - let hmin: Scalar.min ty <= x := by sorry - let hmax: x <= Scalar.max ty := by sorry - return Scalar.ofIntCore x hmin hmax - else fail integerOverflow - else fail integerOverflow - -def Scalar.neg {ty : ScalarTy} (x : Scalar ty) : Result (Scalar ty) := Scalar.tryMk ty (- x.val) - -def Scalar.div {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - if y.val != 0 then Scalar.tryMk ty (x.val / y.val) else fail divisionByZero - --- Checking that the % operation in Lean computes the same as the remainder operation in Rust -#assert 1 % 2 = (1:Int) -#assert (-1) % 2 = -1 -#assert 1 % (-2) = 1 -#assert (-1) % (-2) = -1 - -def Scalar.rem {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - if y.val != 0 then Scalar.tryMk ty (x.val % y.val) else fail divisionByZero - -def Scalar.add {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - Scalar.tryMk ty (x.val + y.val) - -def Scalar.sub {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - Scalar.tryMk ty (x.val - y.val) - -def Scalar.mul {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - Scalar.tryMk ty (x.val * y.val) - --- TODO: instances of +, -, * etc. for scalars - --- Cast an integer from a [src_ty] to a [tgt_ty] --- TODO: check the semantics of casts in Rust -def Scalar.cast {src_ty : ScalarTy} (tgt_ty : ScalarTy) (x : Scalar src_ty) : Result (Scalar tgt_ty) := - Scalar.tryMk tgt_ty x.val - --- The scalar types --- We declare the definitions as reducible so that Lean can unfold them (useful --- for type class resolution for instance). -@[reducible] def Isize := Scalar .Isize -@[reducible] def I8 := Scalar .I8 -@[reducible] def I16 := Scalar .I16 -@[reducible] def I32 := Scalar .I32 -@[reducible] def I64 := Scalar .I64 -@[reducible] def I128 := Scalar .I128 -@[reducible] def Usize := Scalar .Usize -@[reducible] def U8 := Scalar .U8 -@[reducible] def U16 := Scalar .U16 -@[reducible] def U32 := Scalar .U32 -@[reducible] def U64 := Scalar .U64 -@[reducible] def U128 := Scalar .U128 - --- TODO: below: not sure this is the best way. --- Should we rather overload operations like +, -, etc.? --- Also, it is possible to automate the generation of those definitions --- with macros (but would it be a good idea? It would be less easy to --- read the file, which is not supposed to change a lot) - --- Negation - -/-- -Remark: there is no heterogeneous negation in the Lean prelude: we thus introduce -one here. - -The notation typeclass for heterogeneous addition. -This enables the notation `- a : β` where `a : α`. --/ -class HNeg (α : Type u) (β : outParam (Type v)) where - /-- `- a` computes the negation of `a`. - The meaning of this notation is type-dependent. -/ - hNeg : α → β - -prefix:75 "-" => HNeg.hNeg - -instance : HNeg Isize (Result Isize) where hNeg x := Scalar.neg x -instance : HNeg I8 (Result I8) where hNeg x := Scalar.neg x -instance : HNeg I16 (Result I16) where hNeg x := Scalar.neg x -instance : HNeg I32 (Result I32) where hNeg x := Scalar.neg x -instance : HNeg I64 (Result I64) where hNeg x := Scalar.neg x -instance : HNeg I128 (Result I128) where hNeg x := Scalar.neg x - --- Addition -instance {ty} : HAdd (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hAdd x y := Scalar.add x y - --- Substraction -instance {ty} : HSub (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hSub x y := Scalar.sub x y - --- Multiplication -instance {ty} : HMul (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hMul x y := Scalar.mul x y - --- Division -instance {ty} : HDiv (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hDiv x y := Scalar.div x y - --- Remainder -instance {ty} : HMod (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hMod x y := Scalar.rem x y - --- ofIntCore --- TODO: typeclass? -def Isize.ofIntCore := @Scalar.ofIntCore .Isize -def I8.ofIntCore := @Scalar.ofIntCore .I8 -def I16.ofIntCore := @Scalar.ofIntCore .I16 -def I32.ofIntCore := @Scalar.ofIntCore .I32 -def I64.ofIntCore := @Scalar.ofIntCore .I64 -def I128.ofIntCore := @Scalar.ofIntCore .I128 -def Usize.ofIntCore := @Scalar.ofIntCore .Usize -def U8.ofIntCore := @Scalar.ofIntCore .U8 -def U16.ofIntCore := @Scalar.ofIntCore .U16 -def U32.ofIntCore := @Scalar.ofIntCore .U32 -def U64.ofIntCore := @Scalar.ofIntCore .U64 -def U128.ofIntCore := @Scalar.ofIntCore .U128 - --- ofInt --- TODO: typeclass? -def Isize.ofInt := @Scalar.ofInt .Isize -def I8.ofInt := @Scalar.ofInt .I8 -def I16.ofInt := @Scalar.ofInt .I16 -def I32.ofInt := @Scalar.ofInt .I32 -def I64.ofInt := @Scalar.ofInt .I64 -def I128.ofInt := @Scalar.ofInt .I128 -def Usize.ofInt := @Scalar.ofInt .Usize -def U8.ofInt := @Scalar.ofInt .U8 -def U16.ofInt := @Scalar.ofInt .U16 -def U32.ofInt := @Scalar.ofInt .U32 -def U64.ofInt := @Scalar.ofInt .U64 -def U128.ofInt := @Scalar.ofInt .U128 - --- Comparisons -instance {ty} : LT (Scalar ty) where - lt a b := LT.lt a.val b.val - -instance {ty} : LE (Scalar ty) where le a b := LE.le a.val b.val - -instance Scalar.decLt {ty} (a b : Scalar ty) : Decidable (LT.lt a b) := Int.decLt .. -instance Scalar.decLe {ty} (a b : Scalar ty) : Decidable (LE.le a b) := Int.decLe .. - -theorem Scalar.eq_of_val_eq {ty} : ∀ {i j : Scalar ty}, Eq i.val j.val → Eq i j - | ⟨_, _, _⟩, ⟨_, _, _⟩, rfl => rfl - -theorem Scalar.val_eq_of_eq {ty} {i j : Scalar ty} (h : Eq i j) : Eq i.val j.val := - h ▸ rfl - -theorem Scalar.ne_of_val_ne {ty} {i j : Scalar ty} (h : Not (Eq i.val j.val)) : Not (Eq i j) := - fun h' => absurd (val_eq_of_eq h') h - -instance (ty : ScalarTy) : DecidableEq (Scalar ty) := - fun i j => - match decEq i.val j.val with - | isTrue h => isTrue (Scalar.eq_of_val_eq h) - | isFalse h => isFalse (Scalar.ne_of_val_ne h) - -def Scalar.toInt {ty} (n : Scalar ty) : Int := n.val - --- Tactic to prove that integers are in bounds -syntax "intlit" : tactic - -macro_rules - | `(tactic| intlit) => `(tactic| apply Scalar.bound_suffices ; decide) - --- -- We now define a type class that subsumes the various machine integer types, so --- -- as to write a concise definition for scalar_cast, rather than exhaustively --- -- enumerating all of the possible pairs. We remark that Rust has sane semantics --- -- and fails if a cast operation would involve a truncation or modulo. - --- class MachineInteger (t: Type) where --- size: Nat --- val: t -> Fin size --- ofNatCore: (n:Nat) -> LT.lt n size -> t - --- set_option hygiene false in --- run_cmd --- for typeName in [`UInt8, `UInt16, `UInt32, `UInt64, `USize].map Lean.mkIdent do --- Lean.Elab.Command.elabCommand (← `( --- namespace $typeName --- instance: MachineInteger $typeName where --- size := size --- val := val --- ofNatCore := ofNatCore --- end $typeName --- )) - --- -- Aeneas only instantiates the destination type (`src` is implicit). We rely on --- -- Lean to infer `src`. - --- def scalar_cast { src: Type } (dst: Type) [ MachineInteger src ] [ MachineInteger dst ] (x: src): Result dst := --- if h: MachineInteger.val x < MachineInteger.size dst then --- .ret (MachineInteger.ofNatCore (MachineInteger.val x).val h) --- else --- .fail integerOverflow - -------------- --- VECTORS -- -------------- - -def Vec (α : Type u) := { l : List α // List.length l <= Usize.max } - -def vec_new (α : Type u): Vec α := ⟨ [], by sorry ⟩ - -def vec_len (α : Type u) (v : Vec α) : Usize := - let ⟨ v, l ⟩ := v - Usize.ofIntCore (List.length v) (by sorry) l - -def vec_push_fwd (α : Type u) (_ : Vec α) (_ : α) : Unit := () - -def vec_push_back (α : Type u) (v : Vec α) (x : α) : Result (Vec α) - := - if h : List.length v.val <= U32.max || List.length v.val <= Usize.max then - return ⟨ List.concat v.val x, by sorry ⟩ - else - fail maximumSizeExceeded - -def vec_insert_fwd (α : Type u) (v: Vec α) (i: Usize) (_: α): Result Unit := - if i.val < List.length v.val then - .ret () - else - .fail arrayOutOfBounds - -def vec_insert_back (α : Type u) (v: Vec α) (i: Usize) (x: α): Result (Vec α) := - if i.val < List.length v.val then - -- TODO: maybe we should redefine a list library which uses integers - -- (instead of natural numbers) - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - .ret ⟨ List.set v.val i.val x, by - have h: List.length v.val <= Usize.max := v.property - rewrite [ List.length_set v.val i.val x ] - assumption - ⟩ - else - .fail arrayOutOfBounds - -def vec_index_fwd (α : Type u) (v: Vec α) (i: Usize): Result α := - if i.val < List.length v.val then - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - let h: i < List.length v.val := by sorry - .ret (List.get v.val ⟨i.val, h⟩) - else - .fail arrayOutOfBounds - -def vec_index_back (α : Type u) (v: Vec α) (i: Usize) (_: α): Result Unit := - if i.val < List.length v.val then - .ret () - else - .fail arrayOutOfBounds - -def vec_index_mut_fwd (α : Type u) (v: Vec α) (i: Usize): Result α := - if i.val < List.length v.val then - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - let h: i < List.length v.val := by sorry - .ret (List.get v.val ⟨i.val, h⟩) - else - .fail arrayOutOfBounds - -def vec_index_mut_back (α : Type u) (v: Vec α) (i: Usize) (x: α): Result (Vec α) := - if i.val < List.length v.val then - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - .ret ⟨ List.set v.val i.val x, by - have h: List.length v.val <= Usize.max := v.property - rewrite [ List.length_set v.val i.val x ] - assumption - ⟩ - else - .fail arrayOutOfBounds - ----------- --- MISC -- ----------- - -def mem_replace_fwd (a : Type) (x : a) (_ : a) : a := - x - -def mem_replace_back (a : Type) (_ : a) (y : a) : a := - y - -/-- Aeneas-translated function -- useful to reduce non-recursive definitions. - Use with `simp [ aeneas ]` -/ -register_simp_attr aeneas diff --git a/tests/lean/hashmap/Hashmap/Clauses/Clauses.lean b/tests/lean/hashmap/Hashmap/Clauses/Clauses.lean deleted file mode 100644 index 197b0a6a..00000000 --- a/tests/lean/hashmap/Hashmap/Clauses/Clauses.lean +++ /dev/null @@ -1,107 +0,0 @@ --- [hashmap]: templates for the decreases clauses -import Base.Primitives -import Hashmap.Types - -/- [hashmap::HashMap::{0}::allocate_slots]: termination measure -/ -@[simp] -def hash_map_allocate_slots_loop_terminates (T : Type) (slots : Vec (list_t T)) - (n : Usize) := - (slots, n) - -/- [hashmap::HashMap::{0}::allocate_slots]: decreases_by tactic -/ -syntax "hash_map_allocate_slots_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hash_map_allocate_slots_loop_decreases $slots $n) =>`(tactic| sorry) - -/- [hashmap::HashMap::{0}::clear]: termination measure -/ -@[simp] -def hash_map_clear_loop_terminates (T : Type) (slots : Vec (list_t T)) - (i : Usize) := - (slots, i) - -/- [hashmap::HashMap::{0}::clear]: decreases_by tactic -/ -syntax "hash_map_clear_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hash_map_clear_loop_decreases $slots $i) =>`(tactic| sorry) - -/- [hashmap::HashMap::{0}::insert_in_list]: termination measure -/ -@[simp] -def hash_map_insert_in_list_loop_terminates (T : Type) (key : Usize) - (value : T) (ls : list_t T) := - (key, value, ls) - -/- [hashmap::HashMap::{0}::insert_in_list]: decreases_by tactic -/ -syntax "hash_map_insert_in_list_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hash_map_insert_in_list_loop_decreases $key $value $ls) => - `(tactic| sorry) - -/- [hashmap::HashMap::{0}::move_elements_from_list]: termination measure -/ -@[simp] -def hash_map_move_elements_from_list_loop_terminates (T : Type) - (ntable : hash_map_t T) (ls : list_t T) := - (ntable, ls) - -/- [hashmap::HashMap::{0}::move_elements_from_list]: decreases_by tactic -/ -syntax "hash_map_move_elements_from_list_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hash_map_move_elements_from_list_loop_decreases $ntable $ls) => - `(tactic| sorry) - -/- [hashmap::HashMap::{0}::move_elements]: termination measure -/ -@[simp] -def hash_map_move_elements_loop_terminates (T : Type) (ntable : hash_map_t T) - (slots : Vec (list_t T)) (i : Usize) := - (ntable, slots, i) - -/- [hashmap::HashMap::{0}::move_elements]: decreases_by tactic -/ -syntax "hash_map_move_elements_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hash_map_move_elements_loop_decreases $ntable $slots $i) => - `(tactic| sorry) - -/- [hashmap::HashMap::{0}::contains_key_in_list]: termination measure -/ -@[simp] -def hash_map_contains_key_in_list_loop_terminates (T : Type) (key : Usize) - (ls : list_t T) := - (key, ls) - -/- [hashmap::HashMap::{0}::contains_key_in_list]: decreases_by tactic -/ -syntax "hash_map_contains_key_in_list_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hash_map_contains_key_in_list_loop_decreases $key $ls) => - `(tactic| sorry) - -/- [hashmap::HashMap::{0}::get_in_list]: termination measure -/ -@[simp] -def hash_map_get_in_list_loop_terminates (T : Type) (key : Usize) - (ls : list_t T) := - (key, ls) - -/- [hashmap::HashMap::{0}::get_in_list]: decreases_by tactic -/ -syntax "hash_map_get_in_list_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hash_map_get_in_list_loop_decreases $key $ls) =>`(tactic| sorry) - -/- [hashmap::HashMap::{0}::get_mut_in_list]: termination measure -/ -@[simp] -def hash_map_get_mut_in_list_loop_terminates (T : Type) (ls : list_t T) - (key : Usize) := - (ls, key) - -/- [hashmap::HashMap::{0}::get_mut_in_list]: decreases_by tactic -/ -syntax "hash_map_get_mut_in_list_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hash_map_get_mut_in_list_loop_decreases $ls $key) =>`(tactic| sorry) - -/- [hashmap::HashMap::{0}::remove_from_list]: termination measure -/ -@[simp] -def hash_map_remove_from_list_loop_terminates (T : Type) (key : Usize) - (ls : list_t T) := - (key, ls) - -/- [hashmap::HashMap::{0}::remove_from_list]: decreases_by tactic -/ -syntax "hash_map_remove_from_list_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hash_map_remove_from_list_loop_decreases $key $ls) =>`(tactic| sorry) - diff --git a/tests/lean/hashmap/Hashmap/Clauses/Template.lean b/tests/lean/hashmap/Hashmap/Clauses/Template.lean deleted file mode 100644 index 560592c8..00000000 --- a/tests/lean/hashmap/Hashmap/Clauses/Template.lean +++ /dev/null @@ -1,108 +0,0 @@ --- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS --- [hashmap]: templates for the decreases clauses -import Base.Primitives -import Hashmap.Types - -/- [hashmap::HashMap::{0}::allocate_slots]: termination measure -/ -@[simp] -def hash_map_allocate_slots_loop_terminates (T : Type) (slots : Vec (list_t T)) - (n : Usize) := - (slots, n) - -/- [hashmap::HashMap::{0}::allocate_slots]: decreases_by tactic -/ -syntax "hash_map_allocate_slots_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hash_map_allocate_slots_loop_decreases $slots $n) =>`(tactic| sorry) - -/- [hashmap::HashMap::{0}::clear]: termination measure -/ -@[simp] -def hash_map_clear_loop_terminates (T : Type) (slots : Vec (list_t T)) - (i : Usize) := - (slots, i) - -/- [hashmap::HashMap::{0}::clear]: decreases_by tactic -/ -syntax "hash_map_clear_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hash_map_clear_loop_decreases $slots $i) =>`(tactic| sorry) - -/- [hashmap::HashMap::{0}::insert_in_list]: termination measure -/ -@[simp] -def hash_map_insert_in_list_loop_terminates (T : Type) (key : Usize) - (value : T) (ls : list_t T) := - (key, value, ls) - -/- [hashmap::HashMap::{0}::insert_in_list]: decreases_by tactic -/ -syntax "hash_map_insert_in_list_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hash_map_insert_in_list_loop_decreases $key $value $ls) => - `(tactic| sorry) - -/- [hashmap::HashMap::{0}::move_elements_from_list]: termination measure -/ -@[simp] -def hash_map_move_elements_from_list_loop_terminates (T : Type) - (ntable : hash_map_t T) (ls : list_t T) := - (ntable, ls) - -/- [hashmap::HashMap::{0}::move_elements_from_list]: decreases_by tactic -/ -syntax "hash_map_move_elements_from_list_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hash_map_move_elements_from_list_loop_decreases $ntable $ls) => - `(tactic| sorry) - -/- [hashmap::HashMap::{0}::move_elements]: termination measure -/ -@[simp] -def hash_map_move_elements_loop_terminates (T : Type) (ntable : hash_map_t T) - (slots : Vec (list_t T)) (i : Usize) := - (ntable, slots, i) - -/- [hashmap::HashMap::{0}::move_elements]: decreases_by tactic -/ -syntax "hash_map_move_elements_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hash_map_move_elements_loop_decreases $ntable $slots $i) => - `(tactic| sorry) - -/- [hashmap::HashMap::{0}::contains_key_in_list]: termination measure -/ -@[simp] -def hash_map_contains_key_in_list_loop_terminates (T : Type) (key : Usize) - (ls : list_t T) := - (key, ls) - -/- [hashmap::HashMap::{0}::contains_key_in_list]: decreases_by tactic -/ -syntax "hash_map_contains_key_in_list_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hash_map_contains_key_in_list_loop_decreases $key $ls) => - `(tactic| sorry) - -/- [hashmap::HashMap::{0}::get_in_list]: termination measure -/ -@[simp] -def hash_map_get_in_list_loop_terminates (T : Type) (key : Usize) - (ls : list_t T) := - (key, ls) - -/- [hashmap::HashMap::{0}::get_in_list]: decreases_by tactic -/ -syntax "hash_map_get_in_list_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hash_map_get_in_list_loop_decreases $key $ls) =>`(tactic| sorry) - -/- [hashmap::HashMap::{0}::get_mut_in_list]: termination measure -/ -@[simp] -def hash_map_get_mut_in_list_loop_terminates (T : Type) (ls : list_t T) - (key : Usize) := - (ls, key) - -/- [hashmap::HashMap::{0}::get_mut_in_list]: decreases_by tactic -/ -syntax "hash_map_get_mut_in_list_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hash_map_get_mut_in_list_loop_decreases $ls $key) =>`(tactic| sorry) - -/- [hashmap::HashMap::{0}::remove_from_list]: termination measure -/ -@[simp] -def hash_map_remove_from_list_loop_terminates (T : Type) (key : Usize) - (ls : list_t T) := - (key, ls) - -/- [hashmap::HashMap::{0}::remove_from_list]: decreases_by tactic -/ -syntax "hash_map_remove_from_list_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hash_map_remove_from_list_loop_decreases $key $ls) =>`(tactic| sorry) - diff --git a/tests/lean/hashmap/lakefile.lean b/tests/lean/hashmap/lakefile.lean deleted file mode 100644 index 713785f6..00000000 --- a/tests/lean/hashmap/lakefile.lean +++ /dev/null @@ -1,12 +0,0 @@ -import Lake -open Lake DSL - -require mathlib from git - "https://github.com/leanprover-community/mathlib4.git" - -package «hashmap» {} - -lean_lib «Base» {} - -@[default_target] -lean_lib «Hashmap» {} diff --git a/tests/lean/hashmap/lean-toolchain b/tests/lean/hashmap/lean-toolchain deleted file mode 100644 index bbf57f10..00000000 --- a/tests/lean/hashmap/lean-toolchain +++ /dev/null @@ -1 +0,0 @@ -leanprover/lean4:nightly-2023-01-21 diff --git a/tests/lean/hashmap_on_disk/.gitignore b/tests/lean/hashmap_on_disk/.gitignore deleted file mode 100644 index a1735e7c..00000000 --- a/tests/lean/hashmap_on_disk/.gitignore +++ /dev/null @@ -1,5 +0,0 @@ -/build -/lean_packages/* -!/lean_packages/manifest.json -/build -/lake-packages/* diff --git a/tests/lean/hashmap_on_disk/Base/Primitives.lean b/tests/lean/hashmap_on_disk/Base/Primitives.lean deleted file mode 100644 index 4a66a453..00000000 --- a/tests/lean/hashmap_on_disk/Base/Primitives.lean +++ /dev/null @@ -1,583 +0,0 @@ -import Lean -import Lean.Meta.Tactic.Simp -import Init.Data.List.Basic -import Mathlib.Tactic.RunCmd - --------------------- --- ASSERT COMMAND -- --------------------- - -open Lean Elab Command Term Meta - -syntax (name := assert) "#assert" term: command - -@[command_elab assert] -unsafe -def assertImpl : CommandElab := fun (_stx: Syntax) => do - runTermElabM (fun _ => do - let r ← evalTerm Bool (mkConst ``Bool) _stx[1] - if not r then - logInfo "Assertion failed for: " - logInfo _stx[1] - logError "Expression reduced to false" - pure ()) - -#eval 2 == 2 -#assert (2 == 2) - -------------- --- PRELUDE -- -------------- - --- Results & monadic combinators - -inductive Error where - | assertionFailure: Error - | integerOverflow: Error - | divisionByZero: Error - | arrayOutOfBounds: Error - | maximumSizeExceeded: Error - | panic: Error -deriving Repr, BEq - -open Error - -inductive Result (α : Type u) where - | ret (v: α): Result α - | fail (e: Error): Result α -deriving Repr, BEq - -open Result - -instance Result_Inhabited (α : Type u) : Inhabited (Result α) := - Inhabited.mk (fail panic) - -/- HELPERS -/ - -def ret? {α: Type} (r: Result α): Bool := - match r with - | Result.ret _ => true - | Result.fail _ => false - -def massert (b:Bool) : Result Unit := - if b then .ret () else fail assertionFailure - -def eval_global {α: Type} (x: Result α) (_: ret? x): α := - match x with - | Result.fail _ => by contradiction - | Result.ret x => x - -/- DO-DSL SUPPORT -/ - -def bind (x: Result α) (f: α -> Result β) : Result β := - match x with - | ret v => f v - | fail v => fail v - --- Allows using Result in do-blocks -instance : Bind Result where - bind := bind - --- Allows using return x in do-blocks -instance : Pure Result where - pure := fun x => ret x - -/- CUSTOM-DSL SUPPORT -/ - --- Let-binding the Result of a monadic operation is oftentimes not sufficient, --- because we may need a hypothesis for equational reasoning in the scope. We --- rely on subtype, and a custom let-binding operator, in effect recreating our --- own variant of the do-dsl - -def Result.attach {α: Type} (o : Result α): Result { x : α // o = ret x } := - match o with - | .ret x => .ret ⟨x, rfl⟩ - | .fail e => .fail e - -macro "let" e:term " ⟵ " f:term : doElem => - `(doElem| let ⟨$e, h⟩ ← Result.attach $f) - --- TODO: any way to factorize both definitions? -macro "let" e:term " <-- " f:term : doElem => - `(doElem| let ⟨$e, h⟩ ← Result.attach $f) - --- We call the hypothesis `h`, in effect making it unavailable to the user --- (because too much shadowing). But in practice, once can use the French single --- quote notation (input with f< and f>), where `‹ h ›` finds a suitable --- hypothesis in the context, this is equivalent to `have x: h := by assumption in x` -#eval do - let y <-- .ret (0: Nat) - let _: y = 0 := by cases ‹ ret 0 = ret y › ; decide - let r: { x: Nat // x = 0 } := ⟨ y, by assumption ⟩ - .ret r - ----------------------- --- MACHINE INTEGERS -- ----------------------- - --- We redefine our machine integers types. - --- For Isize/Usize, we reuse `getNumBits` from `USize`. You cannot reduce `getNumBits` --- using the simplifier, meaning that proofs do not depend on the compile-time value of --- USize.size. (Lean assumes 32 or 64-bit platforms, and Rust doesn't really support, at --- least officially, 16-bit microcontrollers, so this seems like a fine design decision --- for now.) - --- Note from Chris Bailey: "If there's more than one salient property of your --- definition then the subtyping strategy might get messy, and the property part --- of a subtype is less discoverable by the simplifier or tactics like --- library_search." So, we will not add refinements on the return values of the --- operations defined on Primitives, but will rather rely on custom lemmas to --- invert on possible return values of the primitive operations. - --- Machine integer constants, done via `ofNatCore`, which requires a proof that --- the `Nat` fits within the desired integer type. We provide a custom tactic. - -open System.Platform.getNumBits - --- TODO: is there a way of only importing System.Platform.getNumBits? --- -@[simp] def size_num_bits : Nat := (System.Platform.getNumBits ()).val - --- Remark: Lean seems to use < for the comparisons with the upper bounds by convention. --- We keep the F* convention for now. -@[simp] def Isize.min : Int := - (HPow.hPow 2 (size_num_bits - 1)) -@[simp] def Isize.max : Int := (HPow.hPow 2 (size_num_bits - 1)) - 1 -@[simp] def I8.min : Int := - (HPow.hPow 2 7) -@[simp] def I8.max : Int := HPow.hPow 2 7 - 1 -@[simp] def I16.min : Int := - (HPow.hPow 2 15) -@[simp] def I16.max : Int := HPow.hPow 2 15 - 1 -@[simp] def I32.min : Int := -(HPow.hPow 2 31) -@[simp] def I32.max : Int := HPow.hPow 2 31 - 1 -@[simp] def I64.min : Int := -(HPow.hPow 2 63) -@[simp] def I64.max : Int := HPow.hPow 2 63 - 1 -@[simp] def I128.min : Int := -(HPow.hPow 2 127) -@[simp] def I128.max : Int := HPow.hPow 2 127 - 1 -@[simp] def Usize.min : Int := 0 -@[simp] def Usize.max : Int := HPow.hPow 2 size_num_bits - 1 -@[simp] def U8.min : Int := 0 -@[simp] def U8.max : Int := HPow.hPow 2 8 - 1 -@[simp] def U16.min : Int := 0 -@[simp] def U16.max : Int := HPow.hPow 2 16 - 1 -@[simp] def U32.min : Int := 0 -@[simp] def U32.max : Int := HPow.hPow 2 32 - 1 -@[simp] def U64.min : Int := 0 -@[simp] def U64.max : Int := HPow.hPow 2 64 - 1 -@[simp] def U128.min : Int := 0 -@[simp] def U128.max : Int := HPow.hPow 2 128 - 1 - -#assert (I8.min == -128) -#assert (I8.max == 127) -#assert (I16.min == -32768) -#assert (I16.max == 32767) -#assert (I32.min == -2147483648) -#assert (I32.max == 2147483647) -#assert (I64.min == -9223372036854775808) -#assert (I64.max == 9223372036854775807) -#assert (I128.min == -170141183460469231731687303715884105728) -#assert (I128.max == 170141183460469231731687303715884105727) -#assert (U8.min == 0) -#assert (U8.max == 255) -#assert (U16.min == 0) -#assert (U16.max == 65535) -#assert (U32.min == 0) -#assert (U32.max == 4294967295) -#assert (U64.min == 0) -#assert (U64.max == 18446744073709551615) -#assert (U128.min == 0) -#assert (U128.max == 340282366920938463463374607431768211455) - -inductive ScalarTy := -| Isize -| I8 -| I16 -| I32 -| I64 -| I128 -| Usize -| U8 -| U16 -| U32 -| U64 -| U128 - -def Scalar.min (ty : ScalarTy) : Int := - match ty with - | .Isize => Isize.min - | .I8 => I8.min - | .I16 => I16.min - | .I32 => I32.min - | .I64 => I64.min - | .I128 => I128.min - | .Usize => Usize.min - | .U8 => U8.min - | .U16 => U16.min - | .U32 => U32.min - | .U64 => U64.min - | .U128 => U128.min - -def Scalar.max (ty : ScalarTy) : Int := - match ty with - | .Isize => Isize.max - | .I8 => I8.max - | .I16 => I16.max - | .I32 => I32.max - | .I64 => I64.max - | .I128 => I128.max - | .Usize => Usize.max - | .U8 => U8.max - | .U16 => U16.max - | .U32 => U32.max - | .U64 => U64.max - | .U128 => U128.max - --- "Conservative" bounds --- We use those because we can't compare to the isize bounds (which can't --- reduce at compile-time). Whenever we perform an arithmetic operation like --- addition we need to check that the result is in bounds: we first compare --- to the conservative bounds, which reduce, then compare to the real bounds. --- This is useful for the various #asserts that we want to reduce at --- type-checking time. -def Scalar.cMin (ty : ScalarTy) : Int := - match ty with - | .Isize => I32.min - | _ => Scalar.min ty - -def Scalar.cMax (ty : ScalarTy) : Int := - match ty with - | .Isize => I32.max - | .Usize => U32.max - | _ => Scalar.max ty - -theorem Scalar.cMin_bound ty : Scalar.min ty <= Scalar.cMin ty := by sorry -theorem Scalar.cMax_bound ty : Scalar.min ty <= Scalar.cMin ty := by sorry - -structure Scalar (ty : ScalarTy) where - val : Int - hmin : Scalar.min ty <= val - hmax : val <= Scalar.max ty - -theorem Scalar.bound_suffices (ty : ScalarTy) (x : Int) : - Scalar.cMin ty <= x && x <= Scalar.cMax ty -> - (decide (Scalar.min ty ≤ x) && decide (x ≤ Scalar.max ty)) = true - := by sorry - -def Scalar.ofIntCore {ty : ScalarTy} (x : Int) - (hmin : Scalar.min ty <= x) (hmax : x <= Scalar.max ty) : Scalar ty := - { val := x, hmin := hmin, hmax := hmax } - -def Scalar.ofInt {ty : ScalarTy} (x : Int) - (h : Scalar.min ty <= x && x <= Scalar.max ty) : Scalar ty := - let hmin: Scalar.min ty <= x := by sorry - let hmax: x <= Scalar.max ty := by sorry - Scalar.ofIntCore x hmin hmax - --- Further thoughts: look at what has been done here: --- https://github.com/leanprover-community/mathlib4/blob/master/Mathlib/Data/Fin/Basic.lean --- and --- https://github.com/leanprover-community/mathlib4/blob/master/Mathlib/Data/UInt.lean --- which both contain a fair amount of reasoning already! -def Scalar.tryMk (ty : ScalarTy) (x : Int) : Result (Scalar ty) := - -- TODO: write this with only one if then else - if hmin_cons: Scalar.cMin ty <= x || Scalar.min ty <= x then - if hmax_cons: x <= Scalar.cMax ty || x <= Scalar.max ty then - let hmin: Scalar.min ty <= x := by sorry - let hmax: x <= Scalar.max ty := by sorry - return Scalar.ofIntCore x hmin hmax - else fail integerOverflow - else fail integerOverflow - -def Scalar.neg {ty : ScalarTy} (x : Scalar ty) : Result (Scalar ty) := Scalar.tryMk ty (- x.val) - -def Scalar.div {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - if y.val != 0 then Scalar.tryMk ty (x.val / y.val) else fail divisionByZero - --- Checking that the % operation in Lean computes the same as the remainder operation in Rust -#assert 1 % 2 = (1:Int) -#assert (-1) % 2 = -1 -#assert 1 % (-2) = 1 -#assert (-1) % (-2) = -1 - -def Scalar.rem {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - if y.val != 0 then Scalar.tryMk ty (x.val % y.val) else fail divisionByZero - -def Scalar.add {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - Scalar.tryMk ty (x.val + y.val) - -def Scalar.sub {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - Scalar.tryMk ty (x.val - y.val) - -def Scalar.mul {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - Scalar.tryMk ty (x.val * y.val) - --- TODO: instances of +, -, * etc. for scalars - --- Cast an integer from a [src_ty] to a [tgt_ty] --- TODO: check the semantics of casts in Rust -def Scalar.cast {src_ty : ScalarTy} (tgt_ty : ScalarTy) (x : Scalar src_ty) : Result (Scalar tgt_ty) := - Scalar.tryMk tgt_ty x.val - --- The scalar types --- We declare the definitions as reducible so that Lean can unfold them (useful --- for type class resolution for instance). -@[reducible] def Isize := Scalar .Isize -@[reducible] def I8 := Scalar .I8 -@[reducible] def I16 := Scalar .I16 -@[reducible] def I32 := Scalar .I32 -@[reducible] def I64 := Scalar .I64 -@[reducible] def I128 := Scalar .I128 -@[reducible] def Usize := Scalar .Usize -@[reducible] def U8 := Scalar .U8 -@[reducible] def U16 := Scalar .U16 -@[reducible] def U32 := Scalar .U32 -@[reducible] def U64 := Scalar .U64 -@[reducible] def U128 := Scalar .U128 - --- TODO: below: not sure this is the best way. --- Should we rather overload operations like +, -, etc.? --- Also, it is possible to automate the generation of those definitions --- with macros (but would it be a good idea? It would be less easy to --- read the file, which is not supposed to change a lot) - --- Negation - -/-- -Remark: there is no heterogeneous negation in the Lean prelude: we thus introduce -one here. - -The notation typeclass for heterogeneous addition. -This enables the notation `- a : β` where `a : α`. --/ -class HNeg (α : Type u) (β : outParam (Type v)) where - /-- `- a` computes the negation of `a`. - The meaning of this notation is type-dependent. -/ - hNeg : α → β - -prefix:75 "-" => HNeg.hNeg - -instance : HNeg Isize (Result Isize) where hNeg x := Scalar.neg x -instance : HNeg I8 (Result I8) where hNeg x := Scalar.neg x -instance : HNeg I16 (Result I16) where hNeg x := Scalar.neg x -instance : HNeg I32 (Result I32) where hNeg x := Scalar.neg x -instance : HNeg I64 (Result I64) where hNeg x := Scalar.neg x -instance : HNeg I128 (Result I128) where hNeg x := Scalar.neg x - --- Addition -instance {ty} : HAdd (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hAdd x y := Scalar.add x y - --- Substraction -instance {ty} : HSub (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hSub x y := Scalar.sub x y - --- Multiplication -instance {ty} : HMul (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hMul x y := Scalar.mul x y - --- Division -instance {ty} : HDiv (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hDiv x y := Scalar.div x y - --- Remainder -instance {ty} : HMod (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hMod x y := Scalar.rem x y - --- ofIntCore --- TODO: typeclass? -def Isize.ofIntCore := @Scalar.ofIntCore .Isize -def I8.ofIntCore := @Scalar.ofIntCore .I8 -def I16.ofIntCore := @Scalar.ofIntCore .I16 -def I32.ofIntCore := @Scalar.ofIntCore .I32 -def I64.ofIntCore := @Scalar.ofIntCore .I64 -def I128.ofIntCore := @Scalar.ofIntCore .I128 -def Usize.ofIntCore := @Scalar.ofIntCore .Usize -def U8.ofIntCore := @Scalar.ofIntCore .U8 -def U16.ofIntCore := @Scalar.ofIntCore .U16 -def U32.ofIntCore := @Scalar.ofIntCore .U32 -def U64.ofIntCore := @Scalar.ofIntCore .U64 -def U128.ofIntCore := @Scalar.ofIntCore .U128 - --- ofInt --- TODO: typeclass? -def Isize.ofInt := @Scalar.ofInt .Isize -def I8.ofInt := @Scalar.ofInt .I8 -def I16.ofInt := @Scalar.ofInt .I16 -def I32.ofInt := @Scalar.ofInt .I32 -def I64.ofInt := @Scalar.ofInt .I64 -def I128.ofInt := @Scalar.ofInt .I128 -def Usize.ofInt := @Scalar.ofInt .Usize -def U8.ofInt := @Scalar.ofInt .U8 -def U16.ofInt := @Scalar.ofInt .U16 -def U32.ofInt := @Scalar.ofInt .U32 -def U64.ofInt := @Scalar.ofInt .U64 -def U128.ofInt := @Scalar.ofInt .U128 - --- Comparisons -instance {ty} : LT (Scalar ty) where - lt a b := LT.lt a.val b.val - -instance {ty} : LE (Scalar ty) where le a b := LE.le a.val b.val - -instance Scalar.decLt {ty} (a b : Scalar ty) : Decidable (LT.lt a b) := Int.decLt .. -instance Scalar.decLe {ty} (a b : Scalar ty) : Decidable (LE.le a b) := Int.decLe .. - -theorem Scalar.eq_of_val_eq {ty} : ∀ {i j : Scalar ty}, Eq i.val j.val → Eq i j - | ⟨_, _, _⟩, ⟨_, _, _⟩, rfl => rfl - -theorem Scalar.val_eq_of_eq {ty} {i j : Scalar ty} (h : Eq i j) : Eq i.val j.val := - h ▸ rfl - -theorem Scalar.ne_of_val_ne {ty} {i j : Scalar ty} (h : Not (Eq i.val j.val)) : Not (Eq i j) := - fun h' => absurd (val_eq_of_eq h') h - -instance (ty : ScalarTy) : DecidableEq (Scalar ty) := - fun i j => - match decEq i.val j.val with - | isTrue h => isTrue (Scalar.eq_of_val_eq h) - | isFalse h => isFalse (Scalar.ne_of_val_ne h) - -def Scalar.toInt {ty} (n : Scalar ty) : Int := n.val - --- Tactic to prove that integers are in bounds -syntax "intlit" : tactic - -macro_rules - | `(tactic| intlit) => `(tactic| apply Scalar.bound_suffices ; decide) - --- -- We now define a type class that subsumes the various machine integer types, so --- -- as to write a concise definition for scalar_cast, rather than exhaustively --- -- enumerating all of the possible pairs. We remark that Rust has sane semantics --- -- and fails if a cast operation would involve a truncation or modulo. - --- class MachineInteger (t: Type) where --- size: Nat --- val: t -> Fin size --- ofNatCore: (n:Nat) -> LT.lt n size -> t - --- set_option hygiene false in --- run_cmd --- for typeName in [`UInt8, `UInt16, `UInt32, `UInt64, `USize].map Lean.mkIdent do --- Lean.Elab.Command.elabCommand (← `( --- namespace $typeName --- instance: MachineInteger $typeName where --- size := size --- val := val --- ofNatCore := ofNatCore --- end $typeName --- )) - --- -- Aeneas only instantiates the destination type (`src` is implicit). We rely on --- -- Lean to infer `src`. - --- def scalar_cast { src: Type } (dst: Type) [ MachineInteger src ] [ MachineInteger dst ] (x: src): Result dst := --- if h: MachineInteger.val x < MachineInteger.size dst then --- .ret (MachineInteger.ofNatCore (MachineInteger.val x).val h) --- else --- .fail integerOverflow - -------------- --- VECTORS -- -------------- - -def Vec (α : Type u) := { l : List α // List.length l <= Usize.max } - -def vec_new (α : Type u): Vec α := ⟨ [], by sorry ⟩ - -def vec_len (α : Type u) (v : Vec α) : Usize := - let ⟨ v, l ⟩ := v - Usize.ofIntCore (List.length v) (by sorry) l - -def vec_push_fwd (α : Type u) (_ : Vec α) (_ : α) : Unit := () - -def vec_push_back (α : Type u) (v : Vec α) (x : α) : Result (Vec α) - := - if h : List.length v.val <= U32.max || List.length v.val <= Usize.max then - return ⟨ List.concat v.val x, by sorry ⟩ - else - fail maximumSizeExceeded - -def vec_insert_fwd (α : Type u) (v: Vec α) (i: Usize) (_: α): Result Unit := - if i.val < List.length v.val then - .ret () - else - .fail arrayOutOfBounds - -def vec_insert_back (α : Type u) (v: Vec α) (i: Usize) (x: α): Result (Vec α) := - if i.val < List.length v.val then - -- TODO: maybe we should redefine a list library which uses integers - -- (instead of natural numbers) - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - .ret ⟨ List.set v.val i.val x, by - have h: List.length v.val <= Usize.max := v.property - rewrite [ List.length_set v.val i.val x ] - assumption - ⟩ - else - .fail arrayOutOfBounds - -def vec_index_fwd (α : Type u) (v: Vec α) (i: Usize): Result α := - if i.val < List.length v.val then - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - let h: i < List.length v.val := by sorry - .ret (List.get v.val ⟨i.val, h⟩) - else - .fail arrayOutOfBounds - -def vec_index_back (α : Type u) (v: Vec α) (i: Usize) (_: α): Result Unit := - if i.val < List.length v.val then - .ret () - else - .fail arrayOutOfBounds - -def vec_index_mut_fwd (α : Type u) (v: Vec α) (i: Usize): Result α := - if i.val < List.length v.val then - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - let h: i < List.length v.val := by sorry - .ret (List.get v.val ⟨i.val, h⟩) - else - .fail arrayOutOfBounds - -def vec_index_mut_back (α : Type u) (v: Vec α) (i: Usize) (x: α): Result (Vec α) := - if i.val < List.length v.val then - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - .ret ⟨ List.set v.val i.val x, by - have h: List.length v.val <= Usize.max := v.property - rewrite [ List.length_set v.val i.val x ] - assumption - ⟩ - else - .fail arrayOutOfBounds - ----------- --- MISC -- ----------- - -def mem_replace_fwd (a : Type) (x : a) (_ : a) : a := - x - -def mem_replace_back (a : Type) (_ : a) (y : a) : a := - y - -/-- Aeneas-translated function -- useful to reduce non-recursive definitions. - Use with `simp [ aeneas ]` -/ -register_simp_attr aeneas diff --git a/tests/lean/hashmap_on_disk/HashmapMain/Clauses/Clauses.lean b/tests/lean/hashmap_on_disk/HashmapMain/Clauses/Clauses.lean deleted file mode 100644 index a4dc996a..00000000 --- a/tests/lean/hashmap_on_disk/HashmapMain/Clauses/Clauses.lean +++ /dev/null @@ -1,110 +0,0 @@ -import Base.Primitives -import HashmapMain.Types - -/- [hashmap_main::hashmap::HashMap::{0}::allocate_slots]: termination measure -/ -@[simp] -def hashmap_hash_map_allocate_slots_loop_terminates (T : Type) - (slots : Vec (hashmap_list_t T)) (n : Usize) := - (slots, n) - -/- [hashmap_main::hashmap::HashMap::{0}::allocate_slots]: decreases_by tactic -/ -syntax "hashmap_hash_map_allocate_slots_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hashmap_hash_map_allocate_slots_loop_decreases $slots $n) => - `(tactic| sorry) - -/- [hashmap_main::hashmap::HashMap::{0}::clear]: termination measure -/ -@[simp] -def hashmap_hash_map_clear_loop_terminates (T : Type) - (slots : Vec (hashmap_list_t T)) (i : Usize) := - (slots, i) - -/- [hashmap_main::hashmap::HashMap::{0}::clear]: decreases_by tactic -/ -syntax "hashmap_hash_map_clear_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hashmap_hash_map_clear_loop_decreases $slots $i) =>`(tactic| sorry) - -/- [hashmap_main::hashmap::HashMap::{0}::insert_in_list]: termination measure -/ -@[simp] -def hashmap_hash_map_insert_in_list_loop_terminates (T : Type) (key : Usize) - (value : T) (ls : hashmap_list_t T) := - (key, value, ls) - -/- [hashmap_main::hashmap::HashMap::{0}::insert_in_list]: decreases_by tactic -/ -syntax "hashmap_hash_map_insert_in_list_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hashmap_hash_map_insert_in_list_loop_decreases $key $value $ls) => - `(tactic| sorry) - -/- [hashmap_main::hashmap::HashMap::{0}::move_elements_from_list]: termination measure -/ -@[simp] -def hashmap_hash_map_move_elements_from_list_loop_terminates (T : Type) - (ntable : hashmap_hash_map_t T) (ls : hashmap_list_t T) := - (ntable, ls) - -/- [hashmap_main::hashmap::HashMap::{0}::move_elements_from_list]: decreases_by tactic -/ -syntax "hashmap_hash_map_move_elements_from_list_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hashmap_hash_map_move_elements_from_list_loop_decreases $ntable -$ls) =>`(tactic| sorry) - -/- [hashmap_main::hashmap::HashMap::{0}::move_elements]: termination measure -/ -@[simp] -def hashmap_hash_map_move_elements_loop_terminates (T : Type) - (ntable : hashmap_hash_map_t T) (slots : Vec (hashmap_list_t T)) (i : Usize) - := - (ntable, slots, i) - -/- [hashmap_main::hashmap::HashMap::{0}::move_elements]: decreases_by tactic -/ -syntax "hashmap_hash_map_move_elements_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hashmap_hash_map_move_elements_loop_decreases $ntable $slots $i) => - `(tactic| sorry) - -/- [hashmap_main::hashmap::HashMap::{0}::contains_key_in_list]: termination measure -/ -@[simp] -def hashmap_hash_map_contains_key_in_list_loop_terminates (T : Type) - (key : Usize) (ls : hashmap_list_t T) := - (key, ls) - -/- [hashmap_main::hashmap::HashMap::{0}::contains_key_in_list]: decreases_by tactic -/ -syntax "hashmap_hash_map_contains_key_in_list_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hashmap_hash_map_contains_key_in_list_loop_decreases $key $ls) => - `(tactic| sorry) - -/- [hashmap_main::hashmap::HashMap::{0}::get_in_list]: termination measure -/ -@[simp] -def hashmap_hash_map_get_in_list_loop_terminates (T : Type) (key : Usize) - (ls : hashmap_list_t T) := - (key, ls) - -/- [hashmap_main::hashmap::HashMap::{0}::get_in_list]: decreases_by tactic -/ -syntax "hashmap_hash_map_get_in_list_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hashmap_hash_map_get_in_list_loop_decreases $key $ls) =>`(tactic| sorry) - -/- [hashmap_main::hashmap::HashMap::{0}::get_mut_in_list]: termination measure -/ -@[simp] -def hashmap_hash_map_get_mut_in_list_loop_terminates (T : Type) - (ls : hashmap_list_t T) (key : Usize) := - (ls, key) - -/- [hashmap_main::hashmap::HashMap::{0}::get_mut_in_list]: decreases_by tactic -/ -syntax "hashmap_hash_map_get_mut_in_list_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hashmap_hash_map_get_mut_in_list_loop_decreases $ls $key) => - `(tactic| sorry) - -/- [hashmap_main::hashmap::HashMap::{0}::remove_from_list]: termination measure -/ -@[simp] -def hashmap_hash_map_remove_from_list_loop_terminates (T : Type) (key : Usize) - (ls : hashmap_list_t T) := - (key, ls) - -/- [hashmap_main::hashmap::HashMap::{0}::remove_from_list]: decreases_by tactic -/ -syntax "hashmap_hash_map_remove_from_list_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hashmap_hash_map_remove_from_list_loop_decreases $key $ls) => - `(tactic| sorry) - diff --git a/tests/lean/hashmap_on_disk/HashmapMain/Clauses/Template.lean b/tests/lean/hashmap_on_disk/HashmapMain/Clauses/Template.lean deleted file mode 100644 index 33802597..00000000 --- a/tests/lean/hashmap_on_disk/HashmapMain/Clauses/Template.lean +++ /dev/null @@ -1,112 +0,0 @@ --- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS --- [hashmap_main]: templates for the decreases clauses -import Base.Primitives -import HashmapMain.Types - -/- [hashmap_main::hashmap::HashMap::{0}::allocate_slots]: termination measure -/ -@[simp] -def hashmap_hash_map_allocate_slots_loop_terminates (T : Type) - (slots : Vec (hashmap_list_t T)) (n : Usize) := - (slots, n) - -/- [hashmap_main::hashmap::HashMap::{0}::allocate_slots]: decreases_by tactic -/ -syntax "hashmap_hash_map_allocate_slots_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hashmap_hash_map_allocate_slots_loop_decreases $slots $n) => - `(tactic| sorry) - -/- [hashmap_main::hashmap::HashMap::{0}::clear]: termination measure -/ -@[simp] -def hashmap_hash_map_clear_loop_terminates (T : Type) - (slots : Vec (hashmap_list_t T)) (i : Usize) := - (slots, i) - -/- [hashmap_main::hashmap::HashMap::{0}::clear]: decreases_by tactic -/ -syntax "hashmap_hash_map_clear_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hashmap_hash_map_clear_loop_decreases $slots $i) =>`(tactic| sorry) - -/- [hashmap_main::hashmap::HashMap::{0}::insert_in_list]: termination measure -/ -@[simp] -def hashmap_hash_map_insert_in_list_loop_terminates (T : Type) (key : Usize) - (value : T) (ls : hashmap_list_t T) := - (key, value, ls) - -/- [hashmap_main::hashmap::HashMap::{0}::insert_in_list]: decreases_by tactic -/ -syntax "hashmap_hash_map_insert_in_list_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hashmap_hash_map_insert_in_list_loop_decreases $key $value $ls) => - `(tactic| sorry) - -/- [hashmap_main::hashmap::HashMap::{0}::move_elements_from_list]: termination measure -/ -@[simp] -def hashmap_hash_map_move_elements_from_list_loop_terminates (T : Type) - (ntable : hashmap_hash_map_t T) (ls : hashmap_list_t T) := - (ntable, ls) - -/- [hashmap_main::hashmap::HashMap::{0}::move_elements_from_list]: decreases_by tactic -/ -syntax "hashmap_hash_map_move_elements_from_list_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hashmap_hash_map_move_elements_from_list_loop_decreases $ntable -$ls) =>`(tactic| sorry) - -/- [hashmap_main::hashmap::HashMap::{0}::move_elements]: termination measure -/ -@[simp] -def hashmap_hash_map_move_elements_loop_terminates (T : Type) - (ntable : hashmap_hash_map_t T) (slots : Vec (hashmap_list_t T)) (i : Usize) - := - (ntable, slots, i) - -/- [hashmap_main::hashmap::HashMap::{0}::move_elements]: decreases_by tactic -/ -syntax "hashmap_hash_map_move_elements_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hashmap_hash_map_move_elements_loop_decreases $ntable $slots $i) => - `(tactic| sorry) - -/- [hashmap_main::hashmap::HashMap::{0}::contains_key_in_list]: termination measure -/ -@[simp] -def hashmap_hash_map_contains_key_in_list_loop_terminates (T : Type) - (key : Usize) (ls : hashmap_list_t T) := - (key, ls) - -/- [hashmap_main::hashmap::HashMap::{0}::contains_key_in_list]: decreases_by tactic -/ -syntax "hashmap_hash_map_contains_key_in_list_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hashmap_hash_map_contains_key_in_list_loop_decreases $key $ls) => - `(tactic| sorry) - -/- [hashmap_main::hashmap::HashMap::{0}::get_in_list]: termination measure -/ -@[simp] -def hashmap_hash_map_get_in_list_loop_terminates (T : Type) (key : Usize) - (ls : hashmap_list_t T) := - (key, ls) - -/- [hashmap_main::hashmap::HashMap::{0}::get_in_list]: decreases_by tactic -/ -syntax "hashmap_hash_map_get_in_list_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hashmap_hash_map_get_in_list_loop_decreases $key $ls) =>`(tactic| sorry) - -/- [hashmap_main::hashmap::HashMap::{0}::get_mut_in_list]: termination measure -/ -@[simp] -def hashmap_hash_map_get_mut_in_list_loop_terminates (T : Type) - (ls : hashmap_list_t T) (key : Usize) := - (ls, key) - -/- [hashmap_main::hashmap::HashMap::{0}::get_mut_in_list]: decreases_by tactic -/ -syntax "hashmap_hash_map_get_mut_in_list_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hashmap_hash_map_get_mut_in_list_loop_decreases $ls $key) => - `(tactic| sorry) - -/- [hashmap_main::hashmap::HashMap::{0}::remove_from_list]: termination measure -/ -@[simp] -def hashmap_hash_map_remove_from_list_loop_terminates (T : Type) (key : Usize) - (ls : hashmap_list_t T) := - (key, ls) - -/- [hashmap_main::hashmap::HashMap::{0}::remove_from_list]: decreases_by tactic -/ -syntax "hashmap_hash_map_remove_from_list_loop_decreases" term+ : tactic -macro_rules -| `(tactic| hashmap_hash_map_remove_from_list_loop_decreases $key $ls) => - `(tactic| sorry) - diff --git a/tests/lean/hashmap_on_disk/HashmapMain/ExternalFuns.lean b/tests/lean/hashmap_on_disk/HashmapMain/ExternalFuns.lean deleted file mode 100644 index a5103acc..00000000 --- a/tests/lean/hashmap_on_disk/HashmapMain/ExternalFuns.lean +++ /dev/null @@ -1,5 +0,0 @@ -import Base.Primitives -import HashmapMain.Types -import HashmapMain.Opaque - -def opaque_defs : OpaqueDefs := by sorry diff --git a/tests/lean/hashmap_on_disk/lake-manifest.json b/tests/lean/hashmap_on_disk/lake-manifest.json deleted file mode 100644 index 57b071ca..00000000 --- a/tests/lean/hashmap_on_disk/lake-manifest.json +++ /dev/null @@ -1,27 +0,0 @@ -{"version": 4, - "packagesDir": "./lake-packages", - "packages": - [{"git": - {"url": "https://github.com/leanprover-community/mathlib4.git", - "subDir?": null, - "rev": "4037792ead804d7bfa8868e2c4684d4223c15ece", - "name": "mathlib", - "inputRev?": null}}, - {"git": - {"url": "https://github.com/gebner/quote4", - "subDir?": null, - "rev": "2412c4fdf4a8b689f4467618e5e7b371ae5014aa", - "name": "Qq", - "inputRev?": "master"}}, - {"git": - {"url": "https://github.com/JLimperg/aesop", - "subDir?": null, - "rev": "7fe9ecd9339b0e1796e89d243b776849c305c690", - "name": "aesop", - "inputRev?": "master"}}, - {"git": - {"url": "https://github.com/leanprover/std4", - "subDir?": null, - "rev": "24897887905b3a1254b244369f5dd2cf6174b0ee", - "name": "std", - "inputRev?": "main"}}]} diff --git a/tests/lean/hashmap_on_disk/lakefile.lean b/tests/lean/hashmap_on_disk/lakefile.lean deleted file mode 100644 index 70daf427..00000000 --- a/tests/lean/hashmap_on_disk/lakefile.lean +++ /dev/null @@ -1,12 +0,0 @@ -import Lake -open Lake DSL - -require mathlib from git - "https://github.com/leanprover-community/mathlib4.git" - -package «hashmap_main» {} - -lean_lib «Base» {} - -@[default_target] -lean_lib «HashmapMain» {} diff --git a/tests/lean/hashmap_on_disk/lean-toolchain b/tests/lean/hashmap_on_disk/lean-toolchain deleted file mode 100644 index bbf57f10..00000000 --- a/tests/lean/hashmap_on_disk/lean-toolchain +++ /dev/null @@ -1 +0,0 @@ -leanprover/lean4:nightly-2023-01-21 diff --git a/tests/lean/hashmap/lake-manifest.json b/tests/lean/lake-manifest.json index 88e446e5..1397c6f0 100644 --- a/tests/lean/hashmap/lake-manifest.json +++ b/tests/lean/lake-manifest.json @@ -1,27 +1,34 @@ {"version": 4, - "packagesDir": "./lake-packages", + "packagesDir": "lake-packages", "packages": [{"git": + {"url": "https://github.com/EdAyers/ProofWidgets4", + "subDir?": null, + "rev": "c43db94a8f495dad37829e9d7ad65483d68c86b8", + "name": "proofwidgets", + "inputRev?": "v0.0.11"}}, + {"path": {"name": "Base", "dir": "./../../backends/lean"}}, + {"git": {"url": "https://github.com/leanprover-community/mathlib4.git", "subDir?": null, - "rev": "1c5ed7840906e29e1f8ca7dbf088cf155e5397e9", + "rev": "cb02d09e1d5611d22efc2b406e7893f246b2f51e", "name": "mathlib", "inputRev?": null}}, {"git": {"url": "https://github.com/gebner/quote4", "subDir?": null, - "rev": "2412c4fdf4a8b689f4467618e5e7b371ae5014aa", + "rev": "c71f94e34c1cda52eef5c93dc9da409ab2727420", "name": "Qq", "inputRev?": "master"}}, {"git": {"url": "https://github.com/JLimperg/aesop", "subDir?": null, - "rev": "7fe9ecd9339b0e1796e89d243b776849c305c690", + "rev": "ca73109cc40837bc61df8024c9016da4b4f99d4c", "name": "aesop", "inputRev?": "master"}}, {"git": {"url": "https://github.com/leanprover/std4", "subDir?": null, - "rev": "24897887905b3a1254b244369f5dd2cf6174b0ee", + "rev": "e68aa8f5fe47aad78987df45f99094afbcb5e936", "name": "std", "inputRev?": "main"}}]} diff --git a/tests/lean/misc-external/lakefile.lean b/tests/lean/lakefile.lean index 6cc4aae4..da4293dd 100644 --- a/tests/lean/misc-external/lakefile.lean +++ b/tests/lean/lakefile.lean @@ -4,9 +4,11 @@ open Lake DSL require mathlib from git "https://github.com/leanprover-community/mathlib4.git" -package «external» {} +require Base from "../../backends/lean" -lean_lib «Base» {} +package «tests» {} @[default_target] -lean_lib «External» {} +lean_lib «Tests» {} + +lean_lib hashmap diff --git a/tests/lean/lean-toolchain b/tests/lean/lean-toolchain index bbf57f10..42e7d786 100644 --- a/tests/lean/lean-toolchain +++ b/tests/lean/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:nightly-2023-01-21 +leanprover/lean4:nightly-2023-06-20
\ No newline at end of file diff --git a/tests/lean/misc-constants/Base/Primitives.lean b/tests/lean/misc-constants/Base/Primitives.lean deleted file mode 100644 index 4a66a453..00000000 --- a/tests/lean/misc-constants/Base/Primitives.lean +++ /dev/null @@ -1,583 +0,0 @@ -import Lean -import Lean.Meta.Tactic.Simp -import Init.Data.List.Basic -import Mathlib.Tactic.RunCmd - --------------------- --- ASSERT COMMAND -- --------------------- - -open Lean Elab Command Term Meta - -syntax (name := assert) "#assert" term: command - -@[command_elab assert] -unsafe -def assertImpl : CommandElab := fun (_stx: Syntax) => do - runTermElabM (fun _ => do - let r ← evalTerm Bool (mkConst ``Bool) _stx[1] - if not r then - logInfo "Assertion failed for: " - logInfo _stx[1] - logError "Expression reduced to false" - pure ()) - -#eval 2 == 2 -#assert (2 == 2) - -------------- --- PRELUDE -- -------------- - --- Results & monadic combinators - -inductive Error where - | assertionFailure: Error - | integerOverflow: Error - | divisionByZero: Error - | arrayOutOfBounds: Error - | maximumSizeExceeded: Error - | panic: Error -deriving Repr, BEq - -open Error - -inductive Result (α : Type u) where - | ret (v: α): Result α - | fail (e: Error): Result α -deriving Repr, BEq - -open Result - -instance Result_Inhabited (α : Type u) : Inhabited (Result α) := - Inhabited.mk (fail panic) - -/- HELPERS -/ - -def ret? {α: Type} (r: Result α): Bool := - match r with - | Result.ret _ => true - | Result.fail _ => false - -def massert (b:Bool) : Result Unit := - if b then .ret () else fail assertionFailure - -def eval_global {α: Type} (x: Result α) (_: ret? x): α := - match x with - | Result.fail _ => by contradiction - | Result.ret x => x - -/- DO-DSL SUPPORT -/ - -def bind (x: Result α) (f: α -> Result β) : Result β := - match x with - | ret v => f v - | fail v => fail v - --- Allows using Result in do-blocks -instance : Bind Result where - bind := bind - --- Allows using return x in do-blocks -instance : Pure Result where - pure := fun x => ret x - -/- CUSTOM-DSL SUPPORT -/ - --- Let-binding the Result of a monadic operation is oftentimes not sufficient, --- because we may need a hypothesis for equational reasoning in the scope. We --- rely on subtype, and a custom let-binding operator, in effect recreating our --- own variant of the do-dsl - -def Result.attach {α: Type} (o : Result α): Result { x : α // o = ret x } := - match o with - | .ret x => .ret ⟨x, rfl⟩ - | .fail e => .fail e - -macro "let" e:term " ⟵ " f:term : doElem => - `(doElem| let ⟨$e, h⟩ ← Result.attach $f) - --- TODO: any way to factorize both definitions? -macro "let" e:term " <-- " f:term : doElem => - `(doElem| let ⟨$e, h⟩ ← Result.attach $f) - --- We call the hypothesis `h`, in effect making it unavailable to the user --- (because too much shadowing). But in practice, once can use the French single --- quote notation (input with f< and f>), where `‹ h ›` finds a suitable --- hypothesis in the context, this is equivalent to `have x: h := by assumption in x` -#eval do - let y <-- .ret (0: Nat) - let _: y = 0 := by cases ‹ ret 0 = ret y › ; decide - let r: { x: Nat // x = 0 } := ⟨ y, by assumption ⟩ - .ret r - ----------------------- --- MACHINE INTEGERS -- ----------------------- - --- We redefine our machine integers types. - --- For Isize/Usize, we reuse `getNumBits` from `USize`. You cannot reduce `getNumBits` --- using the simplifier, meaning that proofs do not depend on the compile-time value of --- USize.size. (Lean assumes 32 or 64-bit platforms, and Rust doesn't really support, at --- least officially, 16-bit microcontrollers, so this seems like a fine design decision --- for now.) - --- Note from Chris Bailey: "If there's more than one salient property of your --- definition then the subtyping strategy might get messy, and the property part --- of a subtype is less discoverable by the simplifier or tactics like --- library_search." So, we will not add refinements on the return values of the --- operations defined on Primitives, but will rather rely on custom lemmas to --- invert on possible return values of the primitive operations. - --- Machine integer constants, done via `ofNatCore`, which requires a proof that --- the `Nat` fits within the desired integer type. We provide a custom tactic. - -open System.Platform.getNumBits - --- TODO: is there a way of only importing System.Platform.getNumBits? --- -@[simp] def size_num_bits : Nat := (System.Platform.getNumBits ()).val - --- Remark: Lean seems to use < for the comparisons with the upper bounds by convention. --- We keep the F* convention for now. -@[simp] def Isize.min : Int := - (HPow.hPow 2 (size_num_bits - 1)) -@[simp] def Isize.max : Int := (HPow.hPow 2 (size_num_bits - 1)) - 1 -@[simp] def I8.min : Int := - (HPow.hPow 2 7) -@[simp] def I8.max : Int := HPow.hPow 2 7 - 1 -@[simp] def I16.min : Int := - (HPow.hPow 2 15) -@[simp] def I16.max : Int := HPow.hPow 2 15 - 1 -@[simp] def I32.min : Int := -(HPow.hPow 2 31) -@[simp] def I32.max : Int := HPow.hPow 2 31 - 1 -@[simp] def I64.min : Int := -(HPow.hPow 2 63) -@[simp] def I64.max : Int := HPow.hPow 2 63 - 1 -@[simp] def I128.min : Int := -(HPow.hPow 2 127) -@[simp] def I128.max : Int := HPow.hPow 2 127 - 1 -@[simp] def Usize.min : Int := 0 -@[simp] def Usize.max : Int := HPow.hPow 2 size_num_bits - 1 -@[simp] def U8.min : Int := 0 -@[simp] def U8.max : Int := HPow.hPow 2 8 - 1 -@[simp] def U16.min : Int := 0 -@[simp] def U16.max : Int := HPow.hPow 2 16 - 1 -@[simp] def U32.min : Int := 0 -@[simp] def U32.max : Int := HPow.hPow 2 32 - 1 -@[simp] def U64.min : Int := 0 -@[simp] def U64.max : Int := HPow.hPow 2 64 - 1 -@[simp] def U128.min : Int := 0 -@[simp] def U128.max : Int := HPow.hPow 2 128 - 1 - -#assert (I8.min == -128) -#assert (I8.max == 127) -#assert (I16.min == -32768) -#assert (I16.max == 32767) -#assert (I32.min == -2147483648) -#assert (I32.max == 2147483647) -#assert (I64.min == -9223372036854775808) -#assert (I64.max == 9223372036854775807) -#assert (I128.min == -170141183460469231731687303715884105728) -#assert (I128.max == 170141183460469231731687303715884105727) -#assert (U8.min == 0) -#assert (U8.max == 255) -#assert (U16.min == 0) -#assert (U16.max == 65535) -#assert (U32.min == 0) -#assert (U32.max == 4294967295) -#assert (U64.min == 0) -#assert (U64.max == 18446744073709551615) -#assert (U128.min == 0) -#assert (U128.max == 340282366920938463463374607431768211455) - -inductive ScalarTy := -| Isize -| I8 -| I16 -| I32 -| I64 -| I128 -| Usize -| U8 -| U16 -| U32 -| U64 -| U128 - -def Scalar.min (ty : ScalarTy) : Int := - match ty with - | .Isize => Isize.min - | .I8 => I8.min - | .I16 => I16.min - | .I32 => I32.min - | .I64 => I64.min - | .I128 => I128.min - | .Usize => Usize.min - | .U8 => U8.min - | .U16 => U16.min - | .U32 => U32.min - | .U64 => U64.min - | .U128 => U128.min - -def Scalar.max (ty : ScalarTy) : Int := - match ty with - | .Isize => Isize.max - | .I8 => I8.max - | .I16 => I16.max - | .I32 => I32.max - | .I64 => I64.max - | .I128 => I128.max - | .Usize => Usize.max - | .U8 => U8.max - | .U16 => U16.max - | .U32 => U32.max - | .U64 => U64.max - | .U128 => U128.max - --- "Conservative" bounds --- We use those because we can't compare to the isize bounds (which can't --- reduce at compile-time). Whenever we perform an arithmetic operation like --- addition we need to check that the result is in bounds: we first compare --- to the conservative bounds, which reduce, then compare to the real bounds. --- This is useful for the various #asserts that we want to reduce at --- type-checking time. -def Scalar.cMin (ty : ScalarTy) : Int := - match ty with - | .Isize => I32.min - | _ => Scalar.min ty - -def Scalar.cMax (ty : ScalarTy) : Int := - match ty with - | .Isize => I32.max - | .Usize => U32.max - | _ => Scalar.max ty - -theorem Scalar.cMin_bound ty : Scalar.min ty <= Scalar.cMin ty := by sorry -theorem Scalar.cMax_bound ty : Scalar.min ty <= Scalar.cMin ty := by sorry - -structure Scalar (ty : ScalarTy) where - val : Int - hmin : Scalar.min ty <= val - hmax : val <= Scalar.max ty - -theorem Scalar.bound_suffices (ty : ScalarTy) (x : Int) : - Scalar.cMin ty <= x && x <= Scalar.cMax ty -> - (decide (Scalar.min ty ≤ x) && decide (x ≤ Scalar.max ty)) = true - := by sorry - -def Scalar.ofIntCore {ty : ScalarTy} (x : Int) - (hmin : Scalar.min ty <= x) (hmax : x <= Scalar.max ty) : Scalar ty := - { val := x, hmin := hmin, hmax := hmax } - -def Scalar.ofInt {ty : ScalarTy} (x : Int) - (h : Scalar.min ty <= x && x <= Scalar.max ty) : Scalar ty := - let hmin: Scalar.min ty <= x := by sorry - let hmax: x <= Scalar.max ty := by sorry - Scalar.ofIntCore x hmin hmax - --- Further thoughts: look at what has been done here: --- https://github.com/leanprover-community/mathlib4/blob/master/Mathlib/Data/Fin/Basic.lean --- and --- https://github.com/leanprover-community/mathlib4/blob/master/Mathlib/Data/UInt.lean --- which both contain a fair amount of reasoning already! -def Scalar.tryMk (ty : ScalarTy) (x : Int) : Result (Scalar ty) := - -- TODO: write this with only one if then else - if hmin_cons: Scalar.cMin ty <= x || Scalar.min ty <= x then - if hmax_cons: x <= Scalar.cMax ty || x <= Scalar.max ty then - let hmin: Scalar.min ty <= x := by sorry - let hmax: x <= Scalar.max ty := by sorry - return Scalar.ofIntCore x hmin hmax - else fail integerOverflow - else fail integerOverflow - -def Scalar.neg {ty : ScalarTy} (x : Scalar ty) : Result (Scalar ty) := Scalar.tryMk ty (- x.val) - -def Scalar.div {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - if y.val != 0 then Scalar.tryMk ty (x.val / y.val) else fail divisionByZero - --- Checking that the % operation in Lean computes the same as the remainder operation in Rust -#assert 1 % 2 = (1:Int) -#assert (-1) % 2 = -1 -#assert 1 % (-2) = 1 -#assert (-1) % (-2) = -1 - -def Scalar.rem {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - if y.val != 0 then Scalar.tryMk ty (x.val % y.val) else fail divisionByZero - -def Scalar.add {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - Scalar.tryMk ty (x.val + y.val) - -def Scalar.sub {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - Scalar.tryMk ty (x.val - y.val) - -def Scalar.mul {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - Scalar.tryMk ty (x.val * y.val) - --- TODO: instances of +, -, * etc. for scalars - --- Cast an integer from a [src_ty] to a [tgt_ty] --- TODO: check the semantics of casts in Rust -def Scalar.cast {src_ty : ScalarTy} (tgt_ty : ScalarTy) (x : Scalar src_ty) : Result (Scalar tgt_ty) := - Scalar.tryMk tgt_ty x.val - --- The scalar types --- We declare the definitions as reducible so that Lean can unfold them (useful --- for type class resolution for instance). -@[reducible] def Isize := Scalar .Isize -@[reducible] def I8 := Scalar .I8 -@[reducible] def I16 := Scalar .I16 -@[reducible] def I32 := Scalar .I32 -@[reducible] def I64 := Scalar .I64 -@[reducible] def I128 := Scalar .I128 -@[reducible] def Usize := Scalar .Usize -@[reducible] def U8 := Scalar .U8 -@[reducible] def U16 := Scalar .U16 -@[reducible] def U32 := Scalar .U32 -@[reducible] def U64 := Scalar .U64 -@[reducible] def U128 := Scalar .U128 - --- TODO: below: not sure this is the best way. --- Should we rather overload operations like +, -, etc.? --- Also, it is possible to automate the generation of those definitions --- with macros (but would it be a good idea? It would be less easy to --- read the file, which is not supposed to change a lot) - --- Negation - -/-- -Remark: there is no heterogeneous negation in the Lean prelude: we thus introduce -one here. - -The notation typeclass for heterogeneous addition. -This enables the notation `- a : β` where `a : α`. --/ -class HNeg (α : Type u) (β : outParam (Type v)) where - /-- `- a` computes the negation of `a`. - The meaning of this notation is type-dependent. -/ - hNeg : α → β - -prefix:75 "-" => HNeg.hNeg - -instance : HNeg Isize (Result Isize) where hNeg x := Scalar.neg x -instance : HNeg I8 (Result I8) where hNeg x := Scalar.neg x -instance : HNeg I16 (Result I16) where hNeg x := Scalar.neg x -instance : HNeg I32 (Result I32) where hNeg x := Scalar.neg x -instance : HNeg I64 (Result I64) where hNeg x := Scalar.neg x -instance : HNeg I128 (Result I128) where hNeg x := Scalar.neg x - --- Addition -instance {ty} : HAdd (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hAdd x y := Scalar.add x y - --- Substraction -instance {ty} : HSub (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hSub x y := Scalar.sub x y - --- Multiplication -instance {ty} : HMul (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hMul x y := Scalar.mul x y - --- Division -instance {ty} : HDiv (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hDiv x y := Scalar.div x y - --- Remainder -instance {ty} : HMod (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hMod x y := Scalar.rem x y - --- ofIntCore --- TODO: typeclass? -def Isize.ofIntCore := @Scalar.ofIntCore .Isize -def I8.ofIntCore := @Scalar.ofIntCore .I8 -def I16.ofIntCore := @Scalar.ofIntCore .I16 -def I32.ofIntCore := @Scalar.ofIntCore .I32 -def I64.ofIntCore := @Scalar.ofIntCore .I64 -def I128.ofIntCore := @Scalar.ofIntCore .I128 -def Usize.ofIntCore := @Scalar.ofIntCore .Usize -def U8.ofIntCore := @Scalar.ofIntCore .U8 -def U16.ofIntCore := @Scalar.ofIntCore .U16 -def U32.ofIntCore := @Scalar.ofIntCore .U32 -def U64.ofIntCore := @Scalar.ofIntCore .U64 -def U128.ofIntCore := @Scalar.ofIntCore .U128 - --- ofInt --- TODO: typeclass? -def Isize.ofInt := @Scalar.ofInt .Isize -def I8.ofInt := @Scalar.ofInt .I8 -def I16.ofInt := @Scalar.ofInt .I16 -def I32.ofInt := @Scalar.ofInt .I32 -def I64.ofInt := @Scalar.ofInt .I64 -def I128.ofInt := @Scalar.ofInt .I128 -def Usize.ofInt := @Scalar.ofInt .Usize -def U8.ofInt := @Scalar.ofInt .U8 -def U16.ofInt := @Scalar.ofInt .U16 -def U32.ofInt := @Scalar.ofInt .U32 -def U64.ofInt := @Scalar.ofInt .U64 -def U128.ofInt := @Scalar.ofInt .U128 - --- Comparisons -instance {ty} : LT (Scalar ty) where - lt a b := LT.lt a.val b.val - -instance {ty} : LE (Scalar ty) where le a b := LE.le a.val b.val - -instance Scalar.decLt {ty} (a b : Scalar ty) : Decidable (LT.lt a b) := Int.decLt .. -instance Scalar.decLe {ty} (a b : Scalar ty) : Decidable (LE.le a b) := Int.decLe .. - -theorem Scalar.eq_of_val_eq {ty} : ∀ {i j : Scalar ty}, Eq i.val j.val → Eq i j - | ⟨_, _, _⟩, ⟨_, _, _⟩, rfl => rfl - -theorem Scalar.val_eq_of_eq {ty} {i j : Scalar ty} (h : Eq i j) : Eq i.val j.val := - h ▸ rfl - -theorem Scalar.ne_of_val_ne {ty} {i j : Scalar ty} (h : Not (Eq i.val j.val)) : Not (Eq i j) := - fun h' => absurd (val_eq_of_eq h') h - -instance (ty : ScalarTy) : DecidableEq (Scalar ty) := - fun i j => - match decEq i.val j.val with - | isTrue h => isTrue (Scalar.eq_of_val_eq h) - | isFalse h => isFalse (Scalar.ne_of_val_ne h) - -def Scalar.toInt {ty} (n : Scalar ty) : Int := n.val - --- Tactic to prove that integers are in bounds -syntax "intlit" : tactic - -macro_rules - | `(tactic| intlit) => `(tactic| apply Scalar.bound_suffices ; decide) - --- -- We now define a type class that subsumes the various machine integer types, so --- -- as to write a concise definition for scalar_cast, rather than exhaustively --- -- enumerating all of the possible pairs. We remark that Rust has sane semantics --- -- and fails if a cast operation would involve a truncation or modulo. - --- class MachineInteger (t: Type) where --- size: Nat --- val: t -> Fin size --- ofNatCore: (n:Nat) -> LT.lt n size -> t - --- set_option hygiene false in --- run_cmd --- for typeName in [`UInt8, `UInt16, `UInt32, `UInt64, `USize].map Lean.mkIdent do --- Lean.Elab.Command.elabCommand (← `( --- namespace $typeName --- instance: MachineInteger $typeName where --- size := size --- val := val --- ofNatCore := ofNatCore --- end $typeName --- )) - --- -- Aeneas only instantiates the destination type (`src` is implicit). We rely on --- -- Lean to infer `src`. - --- def scalar_cast { src: Type } (dst: Type) [ MachineInteger src ] [ MachineInteger dst ] (x: src): Result dst := --- if h: MachineInteger.val x < MachineInteger.size dst then --- .ret (MachineInteger.ofNatCore (MachineInteger.val x).val h) --- else --- .fail integerOverflow - -------------- --- VECTORS -- -------------- - -def Vec (α : Type u) := { l : List α // List.length l <= Usize.max } - -def vec_new (α : Type u): Vec α := ⟨ [], by sorry ⟩ - -def vec_len (α : Type u) (v : Vec α) : Usize := - let ⟨ v, l ⟩ := v - Usize.ofIntCore (List.length v) (by sorry) l - -def vec_push_fwd (α : Type u) (_ : Vec α) (_ : α) : Unit := () - -def vec_push_back (α : Type u) (v : Vec α) (x : α) : Result (Vec α) - := - if h : List.length v.val <= U32.max || List.length v.val <= Usize.max then - return ⟨ List.concat v.val x, by sorry ⟩ - else - fail maximumSizeExceeded - -def vec_insert_fwd (α : Type u) (v: Vec α) (i: Usize) (_: α): Result Unit := - if i.val < List.length v.val then - .ret () - else - .fail arrayOutOfBounds - -def vec_insert_back (α : Type u) (v: Vec α) (i: Usize) (x: α): Result (Vec α) := - if i.val < List.length v.val then - -- TODO: maybe we should redefine a list library which uses integers - -- (instead of natural numbers) - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - .ret ⟨ List.set v.val i.val x, by - have h: List.length v.val <= Usize.max := v.property - rewrite [ List.length_set v.val i.val x ] - assumption - ⟩ - else - .fail arrayOutOfBounds - -def vec_index_fwd (α : Type u) (v: Vec α) (i: Usize): Result α := - if i.val < List.length v.val then - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - let h: i < List.length v.val := by sorry - .ret (List.get v.val ⟨i.val, h⟩) - else - .fail arrayOutOfBounds - -def vec_index_back (α : Type u) (v: Vec α) (i: Usize) (_: α): Result Unit := - if i.val < List.length v.val then - .ret () - else - .fail arrayOutOfBounds - -def vec_index_mut_fwd (α : Type u) (v: Vec α) (i: Usize): Result α := - if i.val < List.length v.val then - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - let h: i < List.length v.val := by sorry - .ret (List.get v.val ⟨i.val, h⟩) - else - .fail arrayOutOfBounds - -def vec_index_mut_back (α : Type u) (v: Vec α) (i: Usize) (x: α): Result (Vec α) := - if i.val < List.length v.val then - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - .ret ⟨ List.set v.val i.val x, by - have h: List.length v.val <= Usize.max := v.property - rewrite [ List.length_set v.val i.val x ] - assumption - ⟩ - else - .fail arrayOutOfBounds - ----------- --- MISC -- ----------- - -def mem_replace_fwd (a : Type) (x : a) (_ : a) : a := - x - -def mem_replace_back (a : Type) (_ : a) (y : a) : a := - y - -/-- Aeneas-translated function -- useful to reduce non-recursive definitions. - Use with `simp [ aeneas ]` -/ -register_simp_attr aeneas diff --git a/tests/lean/misc-constants/lake-manifest.json b/tests/lean/misc-constants/lake-manifest.json deleted file mode 100644 index 57b071ca..00000000 --- a/tests/lean/misc-constants/lake-manifest.json +++ /dev/null @@ -1,27 +0,0 @@ -{"version": 4, - "packagesDir": "./lake-packages", - "packages": - [{"git": - {"url": "https://github.com/leanprover-community/mathlib4.git", - "subDir?": null, - "rev": "4037792ead804d7bfa8868e2c4684d4223c15ece", - "name": "mathlib", - "inputRev?": null}}, - {"git": - {"url": "https://github.com/gebner/quote4", - "subDir?": null, - "rev": "2412c4fdf4a8b689f4467618e5e7b371ae5014aa", - "name": "Qq", - "inputRev?": "master"}}, - {"git": - {"url": "https://github.com/JLimperg/aesop", - "subDir?": null, - "rev": "7fe9ecd9339b0e1796e89d243b776849c305c690", - "name": "aesop", - "inputRev?": "master"}}, - {"git": - {"url": "https://github.com/leanprover/std4", - "subDir?": null, - "rev": "24897887905b3a1254b244369f5dd2cf6174b0ee", - "name": "std", - "inputRev?": "main"}}]} diff --git a/tests/lean/misc-constants/lakefile.lean b/tests/lean/misc-constants/lakefile.lean deleted file mode 100644 index 01aacb90..00000000 --- a/tests/lean/misc-constants/lakefile.lean +++ /dev/null @@ -1,12 +0,0 @@ -import Lake -open Lake DSL - -require mathlib from git - "https://github.com/leanprover-community/mathlib4.git" - -package «constants» {} - -lean_lib «Base» {} - -@[default_target] -lean_lib «Constants» {} diff --git a/tests/lean/misc-constants/lean-toolchain b/tests/lean/misc-constants/lean-toolchain deleted file mode 100644 index bbf57f10..00000000 --- a/tests/lean/misc-constants/lean-toolchain +++ /dev/null @@ -1 +0,0 @@ -leanprover/lean4:nightly-2023-01-21 diff --git a/tests/lean/misc-external/Base/Primitives.lean b/tests/lean/misc-external/Base/Primitives.lean deleted file mode 100644 index 4a66a453..00000000 --- a/tests/lean/misc-external/Base/Primitives.lean +++ /dev/null @@ -1,583 +0,0 @@ -import Lean -import Lean.Meta.Tactic.Simp -import Init.Data.List.Basic -import Mathlib.Tactic.RunCmd - --------------------- --- ASSERT COMMAND -- --------------------- - -open Lean Elab Command Term Meta - -syntax (name := assert) "#assert" term: command - -@[command_elab assert] -unsafe -def assertImpl : CommandElab := fun (_stx: Syntax) => do - runTermElabM (fun _ => do - let r ← evalTerm Bool (mkConst ``Bool) _stx[1] - if not r then - logInfo "Assertion failed for: " - logInfo _stx[1] - logError "Expression reduced to false" - pure ()) - -#eval 2 == 2 -#assert (2 == 2) - -------------- --- PRELUDE -- -------------- - --- Results & monadic combinators - -inductive Error where - | assertionFailure: Error - | integerOverflow: Error - | divisionByZero: Error - | arrayOutOfBounds: Error - | maximumSizeExceeded: Error - | panic: Error -deriving Repr, BEq - -open Error - -inductive Result (α : Type u) where - | ret (v: α): Result α - | fail (e: Error): Result α -deriving Repr, BEq - -open Result - -instance Result_Inhabited (α : Type u) : Inhabited (Result α) := - Inhabited.mk (fail panic) - -/- HELPERS -/ - -def ret? {α: Type} (r: Result α): Bool := - match r with - | Result.ret _ => true - | Result.fail _ => false - -def massert (b:Bool) : Result Unit := - if b then .ret () else fail assertionFailure - -def eval_global {α: Type} (x: Result α) (_: ret? x): α := - match x with - | Result.fail _ => by contradiction - | Result.ret x => x - -/- DO-DSL SUPPORT -/ - -def bind (x: Result α) (f: α -> Result β) : Result β := - match x with - | ret v => f v - | fail v => fail v - --- Allows using Result in do-blocks -instance : Bind Result where - bind := bind - --- Allows using return x in do-blocks -instance : Pure Result where - pure := fun x => ret x - -/- CUSTOM-DSL SUPPORT -/ - --- Let-binding the Result of a monadic operation is oftentimes not sufficient, --- because we may need a hypothesis for equational reasoning in the scope. We --- rely on subtype, and a custom let-binding operator, in effect recreating our --- own variant of the do-dsl - -def Result.attach {α: Type} (o : Result α): Result { x : α // o = ret x } := - match o with - | .ret x => .ret ⟨x, rfl⟩ - | .fail e => .fail e - -macro "let" e:term " ⟵ " f:term : doElem => - `(doElem| let ⟨$e, h⟩ ← Result.attach $f) - --- TODO: any way to factorize both definitions? -macro "let" e:term " <-- " f:term : doElem => - `(doElem| let ⟨$e, h⟩ ← Result.attach $f) - --- We call the hypothesis `h`, in effect making it unavailable to the user --- (because too much shadowing). But in practice, once can use the French single --- quote notation (input with f< and f>), where `‹ h ›` finds a suitable --- hypothesis in the context, this is equivalent to `have x: h := by assumption in x` -#eval do - let y <-- .ret (0: Nat) - let _: y = 0 := by cases ‹ ret 0 = ret y › ; decide - let r: { x: Nat // x = 0 } := ⟨ y, by assumption ⟩ - .ret r - ----------------------- --- MACHINE INTEGERS -- ----------------------- - --- We redefine our machine integers types. - --- For Isize/Usize, we reuse `getNumBits` from `USize`. You cannot reduce `getNumBits` --- using the simplifier, meaning that proofs do not depend on the compile-time value of --- USize.size. (Lean assumes 32 or 64-bit platforms, and Rust doesn't really support, at --- least officially, 16-bit microcontrollers, so this seems like a fine design decision --- for now.) - --- Note from Chris Bailey: "If there's more than one salient property of your --- definition then the subtyping strategy might get messy, and the property part --- of a subtype is less discoverable by the simplifier or tactics like --- library_search." So, we will not add refinements on the return values of the --- operations defined on Primitives, but will rather rely on custom lemmas to --- invert on possible return values of the primitive operations. - --- Machine integer constants, done via `ofNatCore`, which requires a proof that --- the `Nat` fits within the desired integer type. We provide a custom tactic. - -open System.Platform.getNumBits - --- TODO: is there a way of only importing System.Platform.getNumBits? --- -@[simp] def size_num_bits : Nat := (System.Platform.getNumBits ()).val - --- Remark: Lean seems to use < for the comparisons with the upper bounds by convention. --- We keep the F* convention for now. -@[simp] def Isize.min : Int := - (HPow.hPow 2 (size_num_bits - 1)) -@[simp] def Isize.max : Int := (HPow.hPow 2 (size_num_bits - 1)) - 1 -@[simp] def I8.min : Int := - (HPow.hPow 2 7) -@[simp] def I8.max : Int := HPow.hPow 2 7 - 1 -@[simp] def I16.min : Int := - (HPow.hPow 2 15) -@[simp] def I16.max : Int := HPow.hPow 2 15 - 1 -@[simp] def I32.min : Int := -(HPow.hPow 2 31) -@[simp] def I32.max : Int := HPow.hPow 2 31 - 1 -@[simp] def I64.min : Int := -(HPow.hPow 2 63) -@[simp] def I64.max : Int := HPow.hPow 2 63 - 1 -@[simp] def I128.min : Int := -(HPow.hPow 2 127) -@[simp] def I128.max : Int := HPow.hPow 2 127 - 1 -@[simp] def Usize.min : Int := 0 -@[simp] def Usize.max : Int := HPow.hPow 2 size_num_bits - 1 -@[simp] def U8.min : Int := 0 -@[simp] def U8.max : Int := HPow.hPow 2 8 - 1 -@[simp] def U16.min : Int := 0 -@[simp] def U16.max : Int := HPow.hPow 2 16 - 1 -@[simp] def U32.min : Int := 0 -@[simp] def U32.max : Int := HPow.hPow 2 32 - 1 -@[simp] def U64.min : Int := 0 -@[simp] def U64.max : Int := HPow.hPow 2 64 - 1 -@[simp] def U128.min : Int := 0 -@[simp] def U128.max : Int := HPow.hPow 2 128 - 1 - -#assert (I8.min == -128) -#assert (I8.max == 127) -#assert (I16.min == -32768) -#assert (I16.max == 32767) -#assert (I32.min == -2147483648) -#assert (I32.max == 2147483647) -#assert (I64.min == -9223372036854775808) -#assert (I64.max == 9223372036854775807) -#assert (I128.min == -170141183460469231731687303715884105728) -#assert (I128.max == 170141183460469231731687303715884105727) -#assert (U8.min == 0) -#assert (U8.max == 255) -#assert (U16.min == 0) -#assert (U16.max == 65535) -#assert (U32.min == 0) -#assert (U32.max == 4294967295) -#assert (U64.min == 0) -#assert (U64.max == 18446744073709551615) -#assert (U128.min == 0) -#assert (U128.max == 340282366920938463463374607431768211455) - -inductive ScalarTy := -| Isize -| I8 -| I16 -| I32 -| I64 -| I128 -| Usize -| U8 -| U16 -| U32 -| U64 -| U128 - -def Scalar.min (ty : ScalarTy) : Int := - match ty with - | .Isize => Isize.min - | .I8 => I8.min - | .I16 => I16.min - | .I32 => I32.min - | .I64 => I64.min - | .I128 => I128.min - | .Usize => Usize.min - | .U8 => U8.min - | .U16 => U16.min - | .U32 => U32.min - | .U64 => U64.min - | .U128 => U128.min - -def Scalar.max (ty : ScalarTy) : Int := - match ty with - | .Isize => Isize.max - | .I8 => I8.max - | .I16 => I16.max - | .I32 => I32.max - | .I64 => I64.max - | .I128 => I128.max - | .Usize => Usize.max - | .U8 => U8.max - | .U16 => U16.max - | .U32 => U32.max - | .U64 => U64.max - | .U128 => U128.max - --- "Conservative" bounds --- We use those because we can't compare to the isize bounds (which can't --- reduce at compile-time). Whenever we perform an arithmetic operation like --- addition we need to check that the result is in bounds: we first compare --- to the conservative bounds, which reduce, then compare to the real bounds. --- This is useful for the various #asserts that we want to reduce at --- type-checking time. -def Scalar.cMin (ty : ScalarTy) : Int := - match ty with - | .Isize => I32.min - | _ => Scalar.min ty - -def Scalar.cMax (ty : ScalarTy) : Int := - match ty with - | .Isize => I32.max - | .Usize => U32.max - | _ => Scalar.max ty - -theorem Scalar.cMin_bound ty : Scalar.min ty <= Scalar.cMin ty := by sorry -theorem Scalar.cMax_bound ty : Scalar.min ty <= Scalar.cMin ty := by sorry - -structure Scalar (ty : ScalarTy) where - val : Int - hmin : Scalar.min ty <= val - hmax : val <= Scalar.max ty - -theorem Scalar.bound_suffices (ty : ScalarTy) (x : Int) : - Scalar.cMin ty <= x && x <= Scalar.cMax ty -> - (decide (Scalar.min ty ≤ x) && decide (x ≤ Scalar.max ty)) = true - := by sorry - -def Scalar.ofIntCore {ty : ScalarTy} (x : Int) - (hmin : Scalar.min ty <= x) (hmax : x <= Scalar.max ty) : Scalar ty := - { val := x, hmin := hmin, hmax := hmax } - -def Scalar.ofInt {ty : ScalarTy} (x : Int) - (h : Scalar.min ty <= x && x <= Scalar.max ty) : Scalar ty := - let hmin: Scalar.min ty <= x := by sorry - let hmax: x <= Scalar.max ty := by sorry - Scalar.ofIntCore x hmin hmax - --- Further thoughts: look at what has been done here: --- https://github.com/leanprover-community/mathlib4/blob/master/Mathlib/Data/Fin/Basic.lean --- and --- https://github.com/leanprover-community/mathlib4/blob/master/Mathlib/Data/UInt.lean --- which both contain a fair amount of reasoning already! -def Scalar.tryMk (ty : ScalarTy) (x : Int) : Result (Scalar ty) := - -- TODO: write this with only one if then else - if hmin_cons: Scalar.cMin ty <= x || Scalar.min ty <= x then - if hmax_cons: x <= Scalar.cMax ty || x <= Scalar.max ty then - let hmin: Scalar.min ty <= x := by sorry - let hmax: x <= Scalar.max ty := by sorry - return Scalar.ofIntCore x hmin hmax - else fail integerOverflow - else fail integerOverflow - -def Scalar.neg {ty : ScalarTy} (x : Scalar ty) : Result (Scalar ty) := Scalar.tryMk ty (- x.val) - -def Scalar.div {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - if y.val != 0 then Scalar.tryMk ty (x.val / y.val) else fail divisionByZero - --- Checking that the % operation in Lean computes the same as the remainder operation in Rust -#assert 1 % 2 = (1:Int) -#assert (-1) % 2 = -1 -#assert 1 % (-2) = 1 -#assert (-1) % (-2) = -1 - -def Scalar.rem {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - if y.val != 0 then Scalar.tryMk ty (x.val % y.val) else fail divisionByZero - -def Scalar.add {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - Scalar.tryMk ty (x.val + y.val) - -def Scalar.sub {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - Scalar.tryMk ty (x.val - y.val) - -def Scalar.mul {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - Scalar.tryMk ty (x.val * y.val) - --- TODO: instances of +, -, * etc. for scalars - --- Cast an integer from a [src_ty] to a [tgt_ty] --- TODO: check the semantics of casts in Rust -def Scalar.cast {src_ty : ScalarTy} (tgt_ty : ScalarTy) (x : Scalar src_ty) : Result (Scalar tgt_ty) := - Scalar.tryMk tgt_ty x.val - --- The scalar types --- We declare the definitions as reducible so that Lean can unfold them (useful --- for type class resolution for instance). -@[reducible] def Isize := Scalar .Isize -@[reducible] def I8 := Scalar .I8 -@[reducible] def I16 := Scalar .I16 -@[reducible] def I32 := Scalar .I32 -@[reducible] def I64 := Scalar .I64 -@[reducible] def I128 := Scalar .I128 -@[reducible] def Usize := Scalar .Usize -@[reducible] def U8 := Scalar .U8 -@[reducible] def U16 := Scalar .U16 -@[reducible] def U32 := Scalar .U32 -@[reducible] def U64 := Scalar .U64 -@[reducible] def U128 := Scalar .U128 - --- TODO: below: not sure this is the best way. --- Should we rather overload operations like +, -, etc.? --- Also, it is possible to automate the generation of those definitions --- with macros (but would it be a good idea? It would be less easy to --- read the file, which is not supposed to change a lot) - --- Negation - -/-- -Remark: there is no heterogeneous negation in the Lean prelude: we thus introduce -one here. - -The notation typeclass for heterogeneous addition. -This enables the notation `- a : β` where `a : α`. --/ -class HNeg (α : Type u) (β : outParam (Type v)) where - /-- `- a` computes the negation of `a`. - The meaning of this notation is type-dependent. -/ - hNeg : α → β - -prefix:75 "-" => HNeg.hNeg - -instance : HNeg Isize (Result Isize) where hNeg x := Scalar.neg x -instance : HNeg I8 (Result I8) where hNeg x := Scalar.neg x -instance : HNeg I16 (Result I16) where hNeg x := Scalar.neg x -instance : HNeg I32 (Result I32) where hNeg x := Scalar.neg x -instance : HNeg I64 (Result I64) where hNeg x := Scalar.neg x -instance : HNeg I128 (Result I128) where hNeg x := Scalar.neg x - --- Addition -instance {ty} : HAdd (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hAdd x y := Scalar.add x y - --- Substraction -instance {ty} : HSub (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hSub x y := Scalar.sub x y - --- Multiplication -instance {ty} : HMul (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hMul x y := Scalar.mul x y - --- Division -instance {ty} : HDiv (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hDiv x y := Scalar.div x y - --- Remainder -instance {ty} : HMod (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hMod x y := Scalar.rem x y - --- ofIntCore --- TODO: typeclass? -def Isize.ofIntCore := @Scalar.ofIntCore .Isize -def I8.ofIntCore := @Scalar.ofIntCore .I8 -def I16.ofIntCore := @Scalar.ofIntCore .I16 -def I32.ofIntCore := @Scalar.ofIntCore .I32 -def I64.ofIntCore := @Scalar.ofIntCore .I64 -def I128.ofIntCore := @Scalar.ofIntCore .I128 -def Usize.ofIntCore := @Scalar.ofIntCore .Usize -def U8.ofIntCore := @Scalar.ofIntCore .U8 -def U16.ofIntCore := @Scalar.ofIntCore .U16 -def U32.ofIntCore := @Scalar.ofIntCore .U32 -def U64.ofIntCore := @Scalar.ofIntCore .U64 -def U128.ofIntCore := @Scalar.ofIntCore .U128 - --- ofInt --- TODO: typeclass? -def Isize.ofInt := @Scalar.ofInt .Isize -def I8.ofInt := @Scalar.ofInt .I8 -def I16.ofInt := @Scalar.ofInt .I16 -def I32.ofInt := @Scalar.ofInt .I32 -def I64.ofInt := @Scalar.ofInt .I64 -def I128.ofInt := @Scalar.ofInt .I128 -def Usize.ofInt := @Scalar.ofInt .Usize -def U8.ofInt := @Scalar.ofInt .U8 -def U16.ofInt := @Scalar.ofInt .U16 -def U32.ofInt := @Scalar.ofInt .U32 -def U64.ofInt := @Scalar.ofInt .U64 -def U128.ofInt := @Scalar.ofInt .U128 - --- Comparisons -instance {ty} : LT (Scalar ty) where - lt a b := LT.lt a.val b.val - -instance {ty} : LE (Scalar ty) where le a b := LE.le a.val b.val - -instance Scalar.decLt {ty} (a b : Scalar ty) : Decidable (LT.lt a b) := Int.decLt .. -instance Scalar.decLe {ty} (a b : Scalar ty) : Decidable (LE.le a b) := Int.decLe .. - -theorem Scalar.eq_of_val_eq {ty} : ∀ {i j : Scalar ty}, Eq i.val j.val → Eq i j - | ⟨_, _, _⟩, ⟨_, _, _⟩, rfl => rfl - -theorem Scalar.val_eq_of_eq {ty} {i j : Scalar ty} (h : Eq i j) : Eq i.val j.val := - h ▸ rfl - -theorem Scalar.ne_of_val_ne {ty} {i j : Scalar ty} (h : Not (Eq i.val j.val)) : Not (Eq i j) := - fun h' => absurd (val_eq_of_eq h') h - -instance (ty : ScalarTy) : DecidableEq (Scalar ty) := - fun i j => - match decEq i.val j.val with - | isTrue h => isTrue (Scalar.eq_of_val_eq h) - | isFalse h => isFalse (Scalar.ne_of_val_ne h) - -def Scalar.toInt {ty} (n : Scalar ty) : Int := n.val - --- Tactic to prove that integers are in bounds -syntax "intlit" : tactic - -macro_rules - | `(tactic| intlit) => `(tactic| apply Scalar.bound_suffices ; decide) - --- -- We now define a type class that subsumes the various machine integer types, so --- -- as to write a concise definition for scalar_cast, rather than exhaustively --- -- enumerating all of the possible pairs. We remark that Rust has sane semantics --- -- and fails if a cast operation would involve a truncation or modulo. - --- class MachineInteger (t: Type) where --- size: Nat --- val: t -> Fin size --- ofNatCore: (n:Nat) -> LT.lt n size -> t - --- set_option hygiene false in --- run_cmd --- for typeName in [`UInt8, `UInt16, `UInt32, `UInt64, `USize].map Lean.mkIdent do --- Lean.Elab.Command.elabCommand (← `( --- namespace $typeName --- instance: MachineInteger $typeName where --- size := size --- val := val --- ofNatCore := ofNatCore --- end $typeName --- )) - --- -- Aeneas only instantiates the destination type (`src` is implicit). We rely on --- -- Lean to infer `src`. - --- def scalar_cast { src: Type } (dst: Type) [ MachineInteger src ] [ MachineInteger dst ] (x: src): Result dst := --- if h: MachineInteger.val x < MachineInteger.size dst then --- .ret (MachineInteger.ofNatCore (MachineInteger.val x).val h) --- else --- .fail integerOverflow - -------------- --- VECTORS -- -------------- - -def Vec (α : Type u) := { l : List α // List.length l <= Usize.max } - -def vec_new (α : Type u): Vec α := ⟨ [], by sorry ⟩ - -def vec_len (α : Type u) (v : Vec α) : Usize := - let ⟨ v, l ⟩ := v - Usize.ofIntCore (List.length v) (by sorry) l - -def vec_push_fwd (α : Type u) (_ : Vec α) (_ : α) : Unit := () - -def vec_push_back (α : Type u) (v : Vec α) (x : α) : Result (Vec α) - := - if h : List.length v.val <= U32.max || List.length v.val <= Usize.max then - return ⟨ List.concat v.val x, by sorry ⟩ - else - fail maximumSizeExceeded - -def vec_insert_fwd (α : Type u) (v: Vec α) (i: Usize) (_: α): Result Unit := - if i.val < List.length v.val then - .ret () - else - .fail arrayOutOfBounds - -def vec_insert_back (α : Type u) (v: Vec α) (i: Usize) (x: α): Result (Vec α) := - if i.val < List.length v.val then - -- TODO: maybe we should redefine a list library which uses integers - -- (instead of natural numbers) - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - .ret ⟨ List.set v.val i.val x, by - have h: List.length v.val <= Usize.max := v.property - rewrite [ List.length_set v.val i.val x ] - assumption - ⟩ - else - .fail arrayOutOfBounds - -def vec_index_fwd (α : Type u) (v: Vec α) (i: Usize): Result α := - if i.val < List.length v.val then - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - let h: i < List.length v.val := by sorry - .ret (List.get v.val ⟨i.val, h⟩) - else - .fail arrayOutOfBounds - -def vec_index_back (α : Type u) (v: Vec α) (i: Usize) (_: α): Result Unit := - if i.val < List.length v.val then - .ret () - else - .fail arrayOutOfBounds - -def vec_index_mut_fwd (α : Type u) (v: Vec α) (i: Usize): Result α := - if i.val < List.length v.val then - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - let h: i < List.length v.val := by sorry - .ret (List.get v.val ⟨i.val, h⟩) - else - .fail arrayOutOfBounds - -def vec_index_mut_back (α : Type u) (v: Vec α) (i: Usize) (x: α): Result (Vec α) := - if i.val < List.length v.val then - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - .ret ⟨ List.set v.val i.val x, by - have h: List.length v.val <= Usize.max := v.property - rewrite [ List.length_set v.val i.val x ] - assumption - ⟩ - else - .fail arrayOutOfBounds - ----------- --- MISC -- ----------- - -def mem_replace_fwd (a : Type) (x : a) (_ : a) : a := - x - -def mem_replace_back (a : Type) (_ : a) (y : a) : a := - y - -/-- Aeneas-translated function -- useful to reduce non-recursive definitions. - Use with `simp [ aeneas ]` -/ -register_simp_attr aeneas diff --git a/tests/lean/misc-external/External/ExternalFuns.lean b/tests/lean/misc-external/External/ExternalFuns.lean deleted file mode 100644 index 6bd4f4a9..00000000 --- a/tests/lean/misc-external/External/ExternalFuns.lean +++ /dev/null @@ -1,5 +0,0 @@ -import Base.Primitives -import External.Types -import External.Opaque - -def opaque_defs : OpaqueDefs := sorry diff --git a/tests/lean/misc-external/lake-manifest.json b/tests/lean/misc-external/lake-manifest.json deleted file mode 100644 index 57b071ca..00000000 --- a/tests/lean/misc-external/lake-manifest.json +++ /dev/null @@ -1,27 +0,0 @@ -{"version": 4, - "packagesDir": "./lake-packages", - "packages": - [{"git": - {"url": "https://github.com/leanprover-community/mathlib4.git", - "subDir?": null, - "rev": "4037792ead804d7bfa8868e2c4684d4223c15ece", - "name": "mathlib", - "inputRev?": null}}, - {"git": - {"url": "https://github.com/gebner/quote4", - "subDir?": null, - "rev": "2412c4fdf4a8b689f4467618e5e7b371ae5014aa", - "name": "Qq", - "inputRev?": "master"}}, - {"git": - {"url": "https://github.com/JLimperg/aesop", - "subDir?": null, - "rev": "7fe9ecd9339b0e1796e89d243b776849c305c690", - "name": "aesop", - "inputRev?": "master"}}, - {"git": - {"url": "https://github.com/leanprover/std4", - "subDir?": null, - "rev": "24897887905b3a1254b244369f5dd2cf6174b0ee", - "name": "std", - "inputRev?": "main"}}]} diff --git a/tests/lean/misc-external/lean-toolchain b/tests/lean/misc-external/lean-toolchain deleted file mode 100644 index bbf57f10..00000000 --- a/tests/lean/misc-external/lean-toolchain +++ /dev/null @@ -1 +0,0 @@ -leanprover/lean4:nightly-2023-01-21 diff --git a/tests/lean/misc-loops/Base/Primitives.lean b/tests/lean/misc-loops/Base/Primitives.lean deleted file mode 100644 index 4a66a453..00000000 --- a/tests/lean/misc-loops/Base/Primitives.lean +++ /dev/null @@ -1,583 +0,0 @@ -import Lean -import Lean.Meta.Tactic.Simp -import Init.Data.List.Basic -import Mathlib.Tactic.RunCmd - --------------------- --- ASSERT COMMAND -- --------------------- - -open Lean Elab Command Term Meta - -syntax (name := assert) "#assert" term: command - -@[command_elab assert] -unsafe -def assertImpl : CommandElab := fun (_stx: Syntax) => do - runTermElabM (fun _ => do - let r ← evalTerm Bool (mkConst ``Bool) _stx[1] - if not r then - logInfo "Assertion failed for: " - logInfo _stx[1] - logError "Expression reduced to false" - pure ()) - -#eval 2 == 2 -#assert (2 == 2) - -------------- --- PRELUDE -- -------------- - --- Results & monadic combinators - -inductive Error where - | assertionFailure: Error - | integerOverflow: Error - | divisionByZero: Error - | arrayOutOfBounds: Error - | maximumSizeExceeded: Error - | panic: Error -deriving Repr, BEq - -open Error - -inductive Result (α : Type u) where - | ret (v: α): Result α - | fail (e: Error): Result α -deriving Repr, BEq - -open Result - -instance Result_Inhabited (α : Type u) : Inhabited (Result α) := - Inhabited.mk (fail panic) - -/- HELPERS -/ - -def ret? {α: Type} (r: Result α): Bool := - match r with - | Result.ret _ => true - | Result.fail _ => false - -def massert (b:Bool) : Result Unit := - if b then .ret () else fail assertionFailure - -def eval_global {α: Type} (x: Result α) (_: ret? x): α := - match x with - | Result.fail _ => by contradiction - | Result.ret x => x - -/- DO-DSL SUPPORT -/ - -def bind (x: Result α) (f: α -> Result β) : Result β := - match x with - | ret v => f v - | fail v => fail v - --- Allows using Result in do-blocks -instance : Bind Result where - bind := bind - --- Allows using return x in do-blocks -instance : Pure Result where - pure := fun x => ret x - -/- CUSTOM-DSL SUPPORT -/ - --- Let-binding the Result of a monadic operation is oftentimes not sufficient, --- because we may need a hypothesis for equational reasoning in the scope. We --- rely on subtype, and a custom let-binding operator, in effect recreating our --- own variant of the do-dsl - -def Result.attach {α: Type} (o : Result α): Result { x : α // o = ret x } := - match o with - | .ret x => .ret ⟨x, rfl⟩ - | .fail e => .fail e - -macro "let" e:term " ⟵ " f:term : doElem => - `(doElem| let ⟨$e, h⟩ ← Result.attach $f) - --- TODO: any way to factorize both definitions? -macro "let" e:term " <-- " f:term : doElem => - `(doElem| let ⟨$e, h⟩ ← Result.attach $f) - --- We call the hypothesis `h`, in effect making it unavailable to the user --- (because too much shadowing). But in practice, once can use the French single --- quote notation (input with f< and f>), where `‹ h ›` finds a suitable --- hypothesis in the context, this is equivalent to `have x: h := by assumption in x` -#eval do - let y <-- .ret (0: Nat) - let _: y = 0 := by cases ‹ ret 0 = ret y › ; decide - let r: { x: Nat // x = 0 } := ⟨ y, by assumption ⟩ - .ret r - ----------------------- --- MACHINE INTEGERS -- ----------------------- - --- We redefine our machine integers types. - --- For Isize/Usize, we reuse `getNumBits` from `USize`. You cannot reduce `getNumBits` --- using the simplifier, meaning that proofs do not depend on the compile-time value of --- USize.size. (Lean assumes 32 or 64-bit platforms, and Rust doesn't really support, at --- least officially, 16-bit microcontrollers, so this seems like a fine design decision --- for now.) - --- Note from Chris Bailey: "If there's more than one salient property of your --- definition then the subtyping strategy might get messy, and the property part --- of a subtype is less discoverable by the simplifier or tactics like --- library_search." So, we will not add refinements on the return values of the --- operations defined on Primitives, but will rather rely on custom lemmas to --- invert on possible return values of the primitive operations. - --- Machine integer constants, done via `ofNatCore`, which requires a proof that --- the `Nat` fits within the desired integer type. We provide a custom tactic. - -open System.Platform.getNumBits - --- TODO: is there a way of only importing System.Platform.getNumBits? --- -@[simp] def size_num_bits : Nat := (System.Platform.getNumBits ()).val - --- Remark: Lean seems to use < for the comparisons with the upper bounds by convention. --- We keep the F* convention for now. -@[simp] def Isize.min : Int := - (HPow.hPow 2 (size_num_bits - 1)) -@[simp] def Isize.max : Int := (HPow.hPow 2 (size_num_bits - 1)) - 1 -@[simp] def I8.min : Int := - (HPow.hPow 2 7) -@[simp] def I8.max : Int := HPow.hPow 2 7 - 1 -@[simp] def I16.min : Int := - (HPow.hPow 2 15) -@[simp] def I16.max : Int := HPow.hPow 2 15 - 1 -@[simp] def I32.min : Int := -(HPow.hPow 2 31) -@[simp] def I32.max : Int := HPow.hPow 2 31 - 1 -@[simp] def I64.min : Int := -(HPow.hPow 2 63) -@[simp] def I64.max : Int := HPow.hPow 2 63 - 1 -@[simp] def I128.min : Int := -(HPow.hPow 2 127) -@[simp] def I128.max : Int := HPow.hPow 2 127 - 1 -@[simp] def Usize.min : Int := 0 -@[simp] def Usize.max : Int := HPow.hPow 2 size_num_bits - 1 -@[simp] def U8.min : Int := 0 -@[simp] def U8.max : Int := HPow.hPow 2 8 - 1 -@[simp] def U16.min : Int := 0 -@[simp] def U16.max : Int := HPow.hPow 2 16 - 1 -@[simp] def U32.min : Int := 0 -@[simp] def U32.max : Int := HPow.hPow 2 32 - 1 -@[simp] def U64.min : Int := 0 -@[simp] def U64.max : Int := HPow.hPow 2 64 - 1 -@[simp] def U128.min : Int := 0 -@[simp] def U128.max : Int := HPow.hPow 2 128 - 1 - -#assert (I8.min == -128) -#assert (I8.max == 127) -#assert (I16.min == -32768) -#assert (I16.max == 32767) -#assert (I32.min == -2147483648) -#assert (I32.max == 2147483647) -#assert (I64.min == -9223372036854775808) -#assert (I64.max == 9223372036854775807) -#assert (I128.min == -170141183460469231731687303715884105728) -#assert (I128.max == 170141183460469231731687303715884105727) -#assert (U8.min == 0) -#assert (U8.max == 255) -#assert (U16.min == 0) -#assert (U16.max == 65535) -#assert (U32.min == 0) -#assert (U32.max == 4294967295) -#assert (U64.min == 0) -#assert (U64.max == 18446744073709551615) -#assert (U128.min == 0) -#assert (U128.max == 340282366920938463463374607431768211455) - -inductive ScalarTy := -| Isize -| I8 -| I16 -| I32 -| I64 -| I128 -| Usize -| U8 -| U16 -| U32 -| U64 -| U128 - -def Scalar.min (ty : ScalarTy) : Int := - match ty with - | .Isize => Isize.min - | .I8 => I8.min - | .I16 => I16.min - | .I32 => I32.min - | .I64 => I64.min - | .I128 => I128.min - | .Usize => Usize.min - | .U8 => U8.min - | .U16 => U16.min - | .U32 => U32.min - | .U64 => U64.min - | .U128 => U128.min - -def Scalar.max (ty : ScalarTy) : Int := - match ty with - | .Isize => Isize.max - | .I8 => I8.max - | .I16 => I16.max - | .I32 => I32.max - | .I64 => I64.max - | .I128 => I128.max - | .Usize => Usize.max - | .U8 => U8.max - | .U16 => U16.max - | .U32 => U32.max - | .U64 => U64.max - | .U128 => U128.max - --- "Conservative" bounds --- We use those because we can't compare to the isize bounds (which can't --- reduce at compile-time). Whenever we perform an arithmetic operation like --- addition we need to check that the result is in bounds: we first compare --- to the conservative bounds, which reduce, then compare to the real bounds. --- This is useful for the various #asserts that we want to reduce at --- type-checking time. -def Scalar.cMin (ty : ScalarTy) : Int := - match ty with - | .Isize => I32.min - | _ => Scalar.min ty - -def Scalar.cMax (ty : ScalarTy) : Int := - match ty with - | .Isize => I32.max - | .Usize => U32.max - | _ => Scalar.max ty - -theorem Scalar.cMin_bound ty : Scalar.min ty <= Scalar.cMin ty := by sorry -theorem Scalar.cMax_bound ty : Scalar.min ty <= Scalar.cMin ty := by sorry - -structure Scalar (ty : ScalarTy) where - val : Int - hmin : Scalar.min ty <= val - hmax : val <= Scalar.max ty - -theorem Scalar.bound_suffices (ty : ScalarTy) (x : Int) : - Scalar.cMin ty <= x && x <= Scalar.cMax ty -> - (decide (Scalar.min ty ≤ x) && decide (x ≤ Scalar.max ty)) = true - := by sorry - -def Scalar.ofIntCore {ty : ScalarTy} (x : Int) - (hmin : Scalar.min ty <= x) (hmax : x <= Scalar.max ty) : Scalar ty := - { val := x, hmin := hmin, hmax := hmax } - -def Scalar.ofInt {ty : ScalarTy} (x : Int) - (h : Scalar.min ty <= x && x <= Scalar.max ty) : Scalar ty := - let hmin: Scalar.min ty <= x := by sorry - let hmax: x <= Scalar.max ty := by sorry - Scalar.ofIntCore x hmin hmax - --- Further thoughts: look at what has been done here: --- https://github.com/leanprover-community/mathlib4/blob/master/Mathlib/Data/Fin/Basic.lean --- and --- https://github.com/leanprover-community/mathlib4/blob/master/Mathlib/Data/UInt.lean --- which both contain a fair amount of reasoning already! -def Scalar.tryMk (ty : ScalarTy) (x : Int) : Result (Scalar ty) := - -- TODO: write this with only one if then else - if hmin_cons: Scalar.cMin ty <= x || Scalar.min ty <= x then - if hmax_cons: x <= Scalar.cMax ty || x <= Scalar.max ty then - let hmin: Scalar.min ty <= x := by sorry - let hmax: x <= Scalar.max ty := by sorry - return Scalar.ofIntCore x hmin hmax - else fail integerOverflow - else fail integerOverflow - -def Scalar.neg {ty : ScalarTy} (x : Scalar ty) : Result (Scalar ty) := Scalar.tryMk ty (- x.val) - -def Scalar.div {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - if y.val != 0 then Scalar.tryMk ty (x.val / y.val) else fail divisionByZero - --- Checking that the % operation in Lean computes the same as the remainder operation in Rust -#assert 1 % 2 = (1:Int) -#assert (-1) % 2 = -1 -#assert 1 % (-2) = 1 -#assert (-1) % (-2) = -1 - -def Scalar.rem {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - if y.val != 0 then Scalar.tryMk ty (x.val % y.val) else fail divisionByZero - -def Scalar.add {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - Scalar.tryMk ty (x.val + y.val) - -def Scalar.sub {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - Scalar.tryMk ty (x.val - y.val) - -def Scalar.mul {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - Scalar.tryMk ty (x.val * y.val) - --- TODO: instances of +, -, * etc. for scalars - --- Cast an integer from a [src_ty] to a [tgt_ty] --- TODO: check the semantics of casts in Rust -def Scalar.cast {src_ty : ScalarTy} (tgt_ty : ScalarTy) (x : Scalar src_ty) : Result (Scalar tgt_ty) := - Scalar.tryMk tgt_ty x.val - --- The scalar types --- We declare the definitions as reducible so that Lean can unfold them (useful --- for type class resolution for instance). -@[reducible] def Isize := Scalar .Isize -@[reducible] def I8 := Scalar .I8 -@[reducible] def I16 := Scalar .I16 -@[reducible] def I32 := Scalar .I32 -@[reducible] def I64 := Scalar .I64 -@[reducible] def I128 := Scalar .I128 -@[reducible] def Usize := Scalar .Usize -@[reducible] def U8 := Scalar .U8 -@[reducible] def U16 := Scalar .U16 -@[reducible] def U32 := Scalar .U32 -@[reducible] def U64 := Scalar .U64 -@[reducible] def U128 := Scalar .U128 - --- TODO: below: not sure this is the best way. --- Should we rather overload operations like +, -, etc.? --- Also, it is possible to automate the generation of those definitions --- with macros (but would it be a good idea? It would be less easy to --- read the file, which is not supposed to change a lot) - --- Negation - -/-- -Remark: there is no heterogeneous negation in the Lean prelude: we thus introduce -one here. - -The notation typeclass for heterogeneous addition. -This enables the notation `- a : β` where `a : α`. --/ -class HNeg (α : Type u) (β : outParam (Type v)) where - /-- `- a` computes the negation of `a`. - The meaning of this notation is type-dependent. -/ - hNeg : α → β - -prefix:75 "-" => HNeg.hNeg - -instance : HNeg Isize (Result Isize) where hNeg x := Scalar.neg x -instance : HNeg I8 (Result I8) where hNeg x := Scalar.neg x -instance : HNeg I16 (Result I16) where hNeg x := Scalar.neg x -instance : HNeg I32 (Result I32) where hNeg x := Scalar.neg x -instance : HNeg I64 (Result I64) where hNeg x := Scalar.neg x -instance : HNeg I128 (Result I128) where hNeg x := Scalar.neg x - --- Addition -instance {ty} : HAdd (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hAdd x y := Scalar.add x y - --- Substraction -instance {ty} : HSub (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hSub x y := Scalar.sub x y - --- Multiplication -instance {ty} : HMul (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hMul x y := Scalar.mul x y - --- Division -instance {ty} : HDiv (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hDiv x y := Scalar.div x y - --- Remainder -instance {ty} : HMod (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hMod x y := Scalar.rem x y - --- ofIntCore --- TODO: typeclass? -def Isize.ofIntCore := @Scalar.ofIntCore .Isize -def I8.ofIntCore := @Scalar.ofIntCore .I8 -def I16.ofIntCore := @Scalar.ofIntCore .I16 -def I32.ofIntCore := @Scalar.ofIntCore .I32 -def I64.ofIntCore := @Scalar.ofIntCore .I64 -def I128.ofIntCore := @Scalar.ofIntCore .I128 -def Usize.ofIntCore := @Scalar.ofIntCore .Usize -def U8.ofIntCore := @Scalar.ofIntCore .U8 -def U16.ofIntCore := @Scalar.ofIntCore .U16 -def U32.ofIntCore := @Scalar.ofIntCore .U32 -def U64.ofIntCore := @Scalar.ofIntCore .U64 -def U128.ofIntCore := @Scalar.ofIntCore .U128 - --- ofInt --- TODO: typeclass? -def Isize.ofInt := @Scalar.ofInt .Isize -def I8.ofInt := @Scalar.ofInt .I8 -def I16.ofInt := @Scalar.ofInt .I16 -def I32.ofInt := @Scalar.ofInt .I32 -def I64.ofInt := @Scalar.ofInt .I64 -def I128.ofInt := @Scalar.ofInt .I128 -def Usize.ofInt := @Scalar.ofInt .Usize -def U8.ofInt := @Scalar.ofInt .U8 -def U16.ofInt := @Scalar.ofInt .U16 -def U32.ofInt := @Scalar.ofInt .U32 -def U64.ofInt := @Scalar.ofInt .U64 -def U128.ofInt := @Scalar.ofInt .U128 - --- Comparisons -instance {ty} : LT (Scalar ty) where - lt a b := LT.lt a.val b.val - -instance {ty} : LE (Scalar ty) where le a b := LE.le a.val b.val - -instance Scalar.decLt {ty} (a b : Scalar ty) : Decidable (LT.lt a b) := Int.decLt .. -instance Scalar.decLe {ty} (a b : Scalar ty) : Decidable (LE.le a b) := Int.decLe .. - -theorem Scalar.eq_of_val_eq {ty} : ∀ {i j : Scalar ty}, Eq i.val j.val → Eq i j - | ⟨_, _, _⟩, ⟨_, _, _⟩, rfl => rfl - -theorem Scalar.val_eq_of_eq {ty} {i j : Scalar ty} (h : Eq i j) : Eq i.val j.val := - h ▸ rfl - -theorem Scalar.ne_of_val_ne {ty} {i j : Scalar ty} (h : Not (Eq i.val j.val)) : Not (Eq i j) := - fun h' => absurd (val_eq_of_eq h') h - -instance (ty : ScalarTy) : DecidableEq (Scalar ty) := - fun i j => - match decEq i.val j.val with - | isTrue h => isTrue (Scalar.eq_of_val_eq h) - | isFalse h => isFalse (Scalar.ne_of_val_ne h) - -def Scalar.toInt {ty} (n : Scalar ty) : Int := n.val - --- Tactic to prove that integers are in bounds -syntax "intlit" : tactic - -macro_rules - | `(tactic| intlit) => `(tactic| apply Scalar.bound_suffices ; decide) - --- -- We now define a type class that subsumes the various machine integer types, so --- -- as to write a concise definition for scalar_cast, rather than exhaustively --- -- enumerating all of the possible pairs. We remark that Rust has sane semantics --- -- and fails if a cast operation would involve a truncation or modulo. - --- class MachineInteger (t: Type) where --- size: Nat --- val: t -> Fin size --- ofNatCore: (n:Nat) -> LT.lt n size -> t - --- set_option hygiene false in --- run_cmd --- for typeName in [`UInt8, `UInt16, `UInt32, `UInt64, `USize].map Lean.mkIdent do --- Lean.Elab.Command.elabCommand (← `( --- namespace $typeName --- instance: MachineInteger $typeName where --- size := size --- val := val --- ofNatCore := ofNatCore --- end $typeName --- )) - --- -- Aeneas only instantiates the destination type (`src` is implicit). We rely on --- -- Lean to infer `src`. - --- def scalar_cast { src: Type } (dst: Type) [ MachineInteger src ] [ MachineInteger dst ] (x: src): Result dst := --- if h: MachineInteger.val x < MachineInteger.size dst then --- .ret (MachineInteger.ofNatCore (MachineInteger.val x).val h) --- else --- .fail integerOverflow - -------------- --- VECTORS -- -------------- - -def Vec (α : Type u) := { l : List α // List.length l <= Usize.max } - -def vec_new (α : Type u): Vec α := ⟨ [], by sorry ⟩ - -def vec_len (α : Type u) (v : Vec α) : Usize := - let ⟨ v, l ⟩ := v - Usize.ofIntCore (List.length v) (by sorry) l - -def vec_push_fwd (α : Type u) (_ : Vec α) (_ : α) : Unit := () - -def vec_push_back (α : Type u) (v : Vec α) (x : α) : Result (Vec α) - := - if h : List.length v.val <= U32.max || List.length v.val <= Usize.max then - return ⟨ List.concat v.val x, by sorry ⟩ - else - fail maximumSizeExceeded - -def vec_insert_fwd (α : Type u) (v: Vec α) (i: Usize) (_: α): Result Unit := - if i.val < List.length v.val then - .ret () - else - .fail arrayOutOfBounds - -def vec_insert_back (α : Type u) (v: Vec α) (i: Usize) (x: α): Result (Vec α) := - if i.val < List.length v.val then - -- TODO: maybe we should redefine a list library which uses integers - -- (instead of natural numbers) - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - .ret ⟨ List.set v.val i.val x, by - have h: List.length v.val <= Usize.max := v.property - rewrite [ List.length_set v.val i.val x ] - assumption - ⟩ - else - .fail arrayOutOfBounds - -def vec_index_fwd (α : Type u) (v: Vec α) (i: Usize): Result α := - if i.val < List.length v.val then - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - let h: i < List.length v.val := by sorry - .ret (List.get v.val ⟨i.val, h⟩) - else - .fail arrayOutOfBounds - -def vec_index_back (α : Type u) (v: Vec α) (i: Usize) (_: α): Result Unit := - if i.val < List.length v.val then - .ret () - else - .fail arrayOutOfBounds - -def vec_index_mut_fwd (α : Type u) (v: Vec α) (i: Usize): Result α := - if i.val < List.length v.val then - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - let h: i < List.length v.val := by sorry - .ret (List.get v.val ⟨i.val, h⟩) - else - .fail arrayOutOfBounds - -def vec_index_mut_back (α : Type u) (v: Vec α) (i: Usize) (x: α): Result (Vec α) := - if i.val < List.length v.val then - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - .ret ⟨ List.set v.val i.val x, by - have h: List.length v.val <= Usize.max := v.property - rewrite [ List.length_set v.val i.val x ] - assumption - ⟩ - else - .fail arrayOutOfBounds - ----------- --- MISC -- ----------- - -def mem_replace_fwd (a : Type) (x : a) (_ : a) : a := - x - -def mem_replace_back (a : Type) (_ : a) (y : a) : a := - y - -/-- Aeneas-translated function -- useful to reduce non-recursive definitions. - Use with `simp [ aeneas ]` -/ -register_simp_attr aeneas diff --git a/tests/lean/misc-loops/Loops/Clauses/Clauses.lean b/tests/lean/misc-loops/Loops/Clauses/Clauses.lean deleted file mode 100644 index 89a7ce34..00000000 --- a/tests/lean/misc-loops/Loops/Clauses/Clauses.lean +++ /dev/null @@ -1,205 +0,0 @@ --- [loops]: decreases clauses -import Base.Primitives -import Loops.Types - -/- [loops::sum]: termination measure -/ -@[simp] -def sum_loop_terminates (max : U32) (i : U32) (s : U32) := (max, i, s) - -syntax "sum_loop_decreases" term+ : tactic - -macro_rules -| `(tactic| sum_loop_decreases $max $i $s) =>`(tactic| sorry) - -/- [loops::sum_with_mut_borrows]: termination measure -/ -@[simp] -def sum_with_mut_borrows_loop_terminates (max : U32) (mi : U32) (ms : U32) := - (max, mi, ms) - -syntax "sum_with_mut_borrows_loop_decreases" term+ : tactic - -macro_rules -| `(tactic| sum_with_mut_borrows_loop_decreases $max $mi $ms) =>`(tactic| sorry) - -/- [loops::sum_with_shared_borrows]: termination measure -/ -@[simp] -def sum_with_shared_borrows_loop_terminates (max : U32) (i : U32) (s : U32) := - (max, i, s) - -syntax "sum_with_shared_borrows_loop_decreases" term+ : tactic - -macro_rules -| `(tactic| sum_with_shared_borrows_loop_decreases $max $i $s) =>`(tactic| sorry) - -/- [loops::clear]: termination measure -/ -@[simp] def clear_loop_terminates (v : Vec U32) (i : Usize) := (v, i) - -syntax "clear_loop_decreases" term+ : tactic - -macro_rules -| `(tactic| clear_loop_decreases $v $i) =>`(tactic| sorry) - -/- [loops::list_mem]: termination measure -/ -@[simp] -def list_mem_loop_terminates (x : U32) (ls : list_t U32) := (x, ls) - -syntax "list_mem_loop_decreases" term+ : tactic - -macro_rules -| `(tactic| list_mem_loop_decreases $x $ls) =>`(tactic| sorry) - -/- [loops::list_nth_mut_loop]: termination measure -/ -@[simp] -def list_nth_mut_loop_loop_terminates (T : Type) (ls : list_t T) (i : U32) := - (ls, i) - -syntax "list_nth_mut_loop_loop_decreases" term+ : tactic - -macro_rules -| `(tactic| list_nth_mut_loop_loop_decreases $ls $i) =>`(tactic| sorry) - -/- [loops::list_nth_shared_loop]: termination measure -/ -@[simp] -def list_nth_shared_loop_loop_terminates (T : Type) (ls : list_t T) (i : U32) := - (ls, i) - -syntax "list_nth_shared_loop_loop_decreases" term+ : tactic - -macro_rules -| `(tactic| list_nth_shared_loop_loop_decreases $ls $i) =>`(tactic| sorry) - -/- [loops::get_elem_mut]: termination measure -/ -@[simp] -def get_elem_mut_loop_terminates (x : Usize) (ls : list_t Usize) := (x, ls) - -syntax "get_elem_mut_loop_decreases" term+ : tactic - -macro_rules -| `(tactic| get_elem_mut_loop_decreases $x $ls) =>`(tactic| sorry) - -/- [loops::get_elem_shared]: termination measure -/ -@[simp] -def get_elem_shared_loop_terminates (x : Usize) (ls : list_t Usize) := (x, ls) - -syntax "get_elem_shared_loop_decreases" term+ : tactic - -macro_rules -| `(tactic| get_elem_shared_loop_decreases $x $ls) =>`(tactic| sorry) - -/- [loops::list_nth_mut_loop_with_id]: termination measure -/ -@[simp] -def list_nth_mut_loop_with_id_loop_terminates (T : Type) (i : U32) - (ls : list_t T) := - (i, ls) - -syntax "list_nth_mut_loop_with_id_loop_decreases" term+ : tactic - -macro_rules -| `(tactic| list_nth_mut_loop_with_id_loop_decreases $i $ls) =>`(tactic| sorry) - -/- [loops::list_nth_shared_loop_with_id]: termination measure -/ -@[simp] -def list_nth_shared_loop_with_id_loop_terminates (T : Type) (i : U32) - (ls : list_t T) := - (i, ls) - -syntax "list_nth_shared_loop_with_id_loop_decreases" term+ : tactic - -macro_rules -| `(tactic| list_nth_shared_loop_with_id_loop_decreases $i $ls) =>`(tactic| sorry) - -/- [loops::list_nth_mut_loop_pair]: termination measure -/ -@[simp] -def list_nth_mut_loop_pair_loop_terminates (T : Type) (ls0 : list_t T) - (ls1 : list_t T) (i : U32) := - (ls0, ls1, i) - -syntax "list_nth_mut_loop_pair_loop_decreases" term+ : tactic - -macro_rules -| `(tactic| list_nth_mut_loop_pair_loop_decreases $ls0 $ls1 $i) =>`(tactic| sorry) - -/- [loops::list_nth_shared_loop_pair]: termination measure -/ -@[simp] -def list_nth_shared_loop_pair_loop_terminates (T : Type) (ls0 : list_t T) - (ls1 : list_t T) (i : U32) := - (ls0, ls1, i) - -syntax "list_nth_shared_loop_pair_loop_decreases" term+ : tactic - -macro_rules -| `(tactic| list_nth_shared_loop_pair_loop_decreases $ls0 $ls1 $i) => - `(tactic| sorry) - -/- [loops::list_nth_mut_loop_pair_merge]: termination measure -/ -@[simp] -def list_nth_mut_loop_pair_merge_loop_terminates (T : Type) (ls0 : list_t T) - (ls1 : list_t T) (i : U32) := - (ls0, ls1, i) - -syntax "list_nth_mut_loop_pair_merge_loop_decreases" term+ : tactic - -macro_rules -| `(tactic| list_nth_mut_loop_pair_merge_loop_decreases $ls0 $ls1 $i) => - `(tactic| sorry) - -/- [loops::list_nth_shared_loop_pair_merge]: termination measure -/ -@[simp] -def list_nth_shared_loop_pair_merge_loop_terminates (T : Type) (ls0 : list_t T) - (ls1 : list_t T) (i : U32) := - (ls0, ls1, i) - -syntax "list_nth_shared_loop_pair_merge_loop_decreases" term+ : tactic - -macro_rules -| `(tactic| list_nth_shared_loop_pair_merge_loop_decreases $ls0 $ls1 $i) => - `(tactic| sorry) - -/- [loops::list_nth_mut_shared_loop_pair]: termination measure -/ -@[simp] -def list_nth_mut_shared_loop_pair_loop_terminates (T : Type) (ls0 : list_t T) - (ls1 : list_t T) (i : U32) := - (ls0, ls1, i) - -syntax "list_nth_mut_shared_loop_pair_loop_decreases" term+ : tactic - -macro_rules -| `(tactic| list_nth_mut_shared_loop_pair_loop_decreases $ls0 $ls1 $i) => - `(tactic| sorry) - -/- [loops::list_nth_mut_shared_loop_pair_merge]: termination measure -/ -@[simp] -def list_nth_mut_shared_loop_pair_merge_loop_terminates (T : Type) - (ls0 : list_t T) (ls1 : list_t T) (i : U32) := - (ls0, ls1, i) - -syntax "list_nth_mut_shared_loop_pair_merge_loop_decreases" term+ : tactic - -macro_rules -| `(tactic| list_nth_mut_shared_loop_pair_merge_loop_decreases $ls0 $ls1 $i) => - `(tactic| sorry) - -/- [loops::list_nth_shared_mut_loop_pair]: termination measure -/ -@[simp] -def list_nth_shared_mut_loop_pair_loop_terminates (T : Type) (ls0 : list_t T) - (ls1 : list_t T) (i : U32) := - (ls0, ls1, i) - -syntax "list_nth_shared_mut_loop_pair_loop_decreases" term+ : tactic - -macro_rules -| `(tactic| list_nth_shared_mut_loop_pair_loop_decreases $ls0 $ls1 $i) => - `(tactic| sorry) - -/- [loops::list_nth_shared_mut_loop_pair_merge]: termination measure -/ -@[simp] -def list_nth_shared_mut_loop_pair_merge_loop_terminates (T : Type) - (ls0 : list_t T) (ls1 : list_t T) (i : U32) := - (ls0, ls1, i) - -syntax "list_nth_shared_mut_loop_pair_merge_loop_decreases" term+ : tactic - -macro_rules -| `(tactic| list_nth_shared_mut_loop_pair_merge_loop_decreases $ls0 $ls1 $i) => - `(tactic| sorry) - diff --git a/tests/lean/misc-loops/Loops/Clauses/Template.lean b/tests/lean/misc-loops/Loops/Clauses/Template.lean deleted file mode 100644 index 2e28a6c0..00000000 --- a/tests/lean/misc-loops/Loops/Clauses/Template.lean +++ /dev/null @@ -1,205 +0,0 @@ --- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS --- [loops]: templates for the decreases clauses -import Base.Primitives -import Loops.Types - -/- [loops::sum]: termination measure -/ -@[simp] def sum_loop_terminates (max : U32) (i : U32) (s : U32) := (max, i, s) - -/- [loops::sum]: decreases_by tactic -/ -syntax "sum_loop_decreases" term+ : tactic -macro_rules -| `(tactic| sum_loop_decreases $max $i $s) =>`(tactic| sorry) - -/- [loops::sum_with_mut_borrows]: termination measure -/ -@[simp] -def sum_with_mut_borrows_loop_terminates (max : U32) (mi : U32) (ms : U32) := - (max, mi, ms) - -/- [loops::sum_with_mut_borrows]: decreases_by tactic -/ -syntax "sum_with_mut_borrows_loop_decreases" term+ : tactic -macro_rules -| `(tactic| sum_with_mut_borrows_loop_decreases $max $mi $ms) =>`(tactic| sorry) - -/- [loops::sum_with_shared_borrows]: termination measure -/ -@[simp] -def sum_with_shared_borrows_loop_terminates (max : U32) (i : U32) (s : U32) := - (max, i, s) - -/- [loops::sum_with_shared_borrows]: decreases_by tactic -/ -syntax "sum_with_shared_borrows_loop_decreases" term+ : tactic -macro_rules -| `(tactic| sum_with_shared_borrows_loop_decreases $max $i $s) =>`(tactic| sorry) - -/- [loops::clear]: termination measure -/ -@[simp] def clear_loop_terminates (v : Vec U32) (i : Usize) := (v, i) - -/- [loops::clear]: decreases_by tactic -/ -syntax "clear_loop_decreases" term+ : tactic -macro_rules -| `(tactic| clear_loop_decreases $v $i) =>`(tactic| sorry) - -/- [loops::list_mem]: termination measure -/ -@[simp] def list_mem_loop_terminates (x : U32) (ls : list_t U32) := (x, ls) - -/- [loops::list_mem]: decreases_by tactic -/ -syntax "list_mem_loop_decreases" term+ : tactic -macro_rules -| `(tactic| list_mem_loop_decreases $x $ls) =>`(tactic| sorry) - -/- [loops::list_nth_mut_loop]: termination measure -/ -@[simp] -def list_nth_mut_loop_loop_terminates (T : Type) (ls : list_t T) (i : U32) := - (ls, i) - -/- [loops::list_nth_mut_loop]: decreases_by tactic -/ -syntax "list_nth_mut_loop_loop_decreases" term+ : tactic -macro_rules -| `(tactic| list_nth_mut_loop_loop_decreases $ls $i) =>`(tactic| sorry) - -/- [loops::list_nth_shared_loop]: termination measure -/ -@[simp] -def list_nth_shared_loop_loop_terminates (T : Type) (ls : list_t T) (i : U32) - := - (ls, i) - -/- [loops::list_nth_shared_loop]: decreases_by tactic -/ -syntax "list_nth_shared_loop_loop_decreases" term+ : tactic -macro_rules -| `(tactic| list_nth_shared_loop_loop_decreases $ls $i) =>`(tactic| sorry) - -/- [loops::get_elem_mut]: termination measure -/ -@[simp] -def get_elem_mut_loop_terminates (x : Usize) (ls : list_t Usize) := (x, ls) - -/- [loops::get_elem_mut]: decreases_by tactic -/ -syntax "get_elem_mut_loop_decreases" term+ : tactic -macro_rules -| `(tactic| get_elem_mut_loop_decreases $x $ls) =>`(tactic| sorry) - -/- [loops::get_elem_shared]: termination measure -/ -@[simp] -def get_elem_shared_loop_terminates (x : Usize) (ls : list_t Usize) := (x, ls) - -/- [loops::get_elem_shared]: decreases_by tactic -/ -syntax "get_elem_shared_loop_decreases" term+ : tactic -macro_rules -| `(tactic| get_elem_shared_loop_decreases $x $ls) =>`(tactic| sorry) - -/- [loops::list_nth_mut_loop_with_id]: termination measure -/ -@[simp] -def list_nth_mut_loop_with_id_loop_terminates (T : Type) (i : U32) - (ls : list_t T) := - (i, ls) - -/- [loops::list_nth_mut_loop_with_id]: decreases_by tactic -/ -syntax "list_nth_mut_loop_with_id_loop_decreases" term+ : tactic -macro_rules -| `(tactic| list_nth_mut_loop_with_id_loop_decreases $i $ls) =>`(tactic| sorry) - -/- [loops::list_nth_shared_loop_with_id]: termination measure -/ -@[simp] -def list_nth_shared_loop_with_id_loop_terminates (T : Type) (i : U32) - (ls : list_t T) := - (i, ls) - -/- [loops::list_nth_shared_loop_with_id]: decreases_by tactic -/ -syntax "list_nth_shared_loop_with_id_loop_decreases" term+ : tactic -macro_rules -| `(tactic| list_nth_shared_loop_with_id_loop_decreases $i $ls) =>`(tactic| sorry) - -/- [loops::list_nth_mut_loop_pair]: termination measure -/ -@[simp] -def list_nth_mut_loop_pair_loop_terminates (T : Type) (ls0 : list_t T) - (ls1 : list_t T) (i : U32) := - (ls0, ls1, i) - -/- [loops::list_nth_mut_loop_pair]: decreases_by tactic -/ -syntax "list_nth_mut_loop_pair_loop_decreases" term+ : tactic -macro_rules -| `(tactic| list_nth_mut_loop_pair_loop_decreases $ls0 $ls1 $i) =>`(tactic| sorry) - -/- [loops::list_nth_shared_loop_pair]: termination measure -/ -@[simp] -def list_nth_shared_loop_pair_loop_terminates (T : Type) (ls0 : list_t T) - (ls1 : list_t T) (i : U32) := - (ls0, ls1, i) - -/- [loops::list_nth_shared_loop_pair]: decreases_by tactic -/ -syntax "list_nth_shared_loop_pair_loop_decreases" term+ : tactic -macro_rules -| `(tactic| list_nth_shared_loop_pair_loop_decreases $ls0 $ls1 $i) => - `(tactic| sorry) - -/- [loops::list_nth_mut_loop_pair_merge]: termination measure -/ -@[simp] -def list_nth_mut_loop_pair_merge_loop_terminates (T : Type) (ls0 : list_t T) - (ls1 : list_t T) (i : U32) := - (ls0, ls1, i) - -/- [loops::list_nth_mut_loop_pair_merge]: decreases_by tactic -/ -syntax "list_nth_mut_loop_pair_merge_loop_decreases" term+ : tactic -macro_rules -| `(tactic| list_nth_mut_loop_pair_merge_loop_decreases $ls0 $ls1 $i) => - `(tactic| sorry) - -/- [loops::list_nth_shared_loop_pair_merge]: termination measure -/ -@[simp] -def list_nth_shared_loop_pair_merge_loop_terminates (T : Type) (ls0 : list_t T) - (ls1 : list_t T) (i : U32) := - (ls0, ls1, i) - -/- [loops::list_nth_shared_loop_pair_merge]: decreases_by tactic -/ -syntax "list_nth_shared_loop_pair_merge_loop_decreases" term+ : tactic -macro_rules -| `(tactic| list_nth_shared_loop_pair_merge_loop_decreases $ls0 $ls1 $i) => - `(tactic| sorry) - -/- [loops::list_nth_mut_shared_loop_pair]: termination measure -/ -@[simp] -def list_nth_mut_shared_loop_pair_loop_terminates (T : Type) (ls0 : list_t T) - (ls1 : list_t T) (i : U32) := - (ls0, ls1, i) - -/- [loops::list_nth_mut_shared_loop_pair]: decreases_by tactic -/ -syntax "list_nth_mut_shared_loop_pair_loop_decreases" term+ : tactic -macro_rules -| `(tactic| list_nth_mut_shared_loop_pair_loop_decreases $ls0 $ls1 $i) => - `(tactic| sorry) - -/- [loops::list_nth_mut_shared_loop_pair_merge]: termination measure -/ -@[simp] -def list_nth_mut_shared_loop_pair_merge_loop_terminates (T : Type) - (ls0 : list_t T) (ls1 : list_t T) (i : U32) := - (ls0, ls1, i) - -/- [loops::list_nth_mut_shared_loop_pair_merge]: decreases_by tactic -/ -syntax "list_nth_mut_shared_loop_pair_merge_loop_decreases" term+ : tactic -macro_rules -| `(tactic| list_nth_mut_shared_loop_pair_merge_loop_decreases $ls0 $ls1 $i) => - `(tactic| sorry) - -/- [loops::list_nth_shared_mut_loop_pair]: termination measure -/ -@[simp] -def list_nth_shared_mut_loop_pair_loop_terminates (T : Type) (ls0 : list_t T) - (ls1 : list_t T) (i : U32) := - (ls0, ls1, i) - -/- [loops::list_nth_shared_mut_loop_pair]: decreases_by tactic -/ -syntax "list_nth_shared_mut_loop_pair_loop_decreases" term+ : tactic -macro_rules -| `(tactic| list_nth_shared_mut_loop_pair_loop_decreases $ls0 $ls1 $i) => - `(tactic| sorry) - -/- [loops::list_nth_shared_mut_loop_pair_merge]: termination measure -/ -@[simp] -def list_nth_shared_mut_loop_pair_merge_loop_terminates (T : Type) - (ls0 : list_t T) (ls1 : list_t T) (i : U32) := - (ls0, ls1, i) - -/- [loops::list_nth_shared_mut_loop_pair_merge]: decreases_by tactic -/ -syntax "list_nth_shared_mut_loop_pair_merge_loop_decreases" term+ : tactic -macro_rules -| `(tactic| list_nth_shared_mut_loop_pair_merge_loop_decreases $ls0 $ls1 $i) => - `(tactic| sorry) - diff --git a/tests/lean/misc-loops/lake-manifest.json b/tests/lean/misc-loops/lake-manifest.json deleted file mode 100644 index 57b071ca..00000000 --- a/tests/lean/misc-loops/lake-manifest.json +++ /dev/null @@ -1,27 +0,0 @@ -{"version": 4, - "packagesDir": "./lake-packages", - "packages": - [{"git": - {"url": "https://github.com/leanprover-community/mathlib4.git", - "subDir?": null, - "rev": "4037792ead804d7bfa8868e2c4684d4223c15ece", - "name": "mathlib", - "inputRev?": null}}, - {"git": - {"url": "https://github.com/gebner/quote4", - "subDir?": null, - "rev": "2412c4fdf4a8b689f4467618e5e7b371ae5014aa", - "name": "Qq", - "inputRev?": "master"}}, - {"git": - {"url": "https://github.com/JLimperg/aesop", - "subDir?": null, - "rev": "7fe9ecd9339b0e1796e89d243b776849c305c690", - "name": "aesop", - "inputRev?": "master"}}, - {"git": - {"url": "https://github.com/leanprover/std4", - "subDir?": null, - "rev": "24897887905b3a1254b244369f5dd2cf6174b0ee", - "name": "std", - "inputRev?": "main"}}]} diff --git a/tests/lean/misc-loops/lakefile.lean b/tests/lean/misc-loops/lakefile.lean deleted file mode 100644 index 097c0a7d..00000000 --- a/tests/lean/misc-loops/lakefile.lean +++ /dev/null @@ -1,12 +0,0 @@ -import Lake -open Lake DSL - -require mathlib from git - "https://github.com/leanprover-community/mathlib4.git" - -package «loops» {} - -lean_lib «Base» {} - -@[default_target] -lean_lib «Loops» {} diff --git a/tests/lean/misc-loops/lean-toolchain b/tests/lean/misc-loops/lean-toolchain deleted file mode 100644 index bbf57f10..00000000 --- a/tests/lean/misc-loops/lean-toolchain +++ /dev/null @@ -1 +0,0 @@ -leanprover/lean4:nightly-2023-01-21 diff --git a/tests/lean/misc-no_nested_borrows/Base/Primitives.lean b/tests/lean/misc-no_nested_borrows/Base/Primitives.lean deleted file mode 100644 index 4a66a453..00000000 --- a/tests/lean/misc-no_nested_borrows/Base/Primitives.lean +++ /dev/null @@ -1,583 +0,0 @@ -import Lean -import Lean.Meta.Tactic.Simp -import Init.Data.List.Basic -import Mathlib.Tactic.RunCmd - --------------------- --- ASSERT COMMAND -- --------------------- - -open Lean Elab Command Term Meta - -syntax (name := assert) "#assert" term: command - -@[command_elab assert] -unsafe -def assertImpl : CommandElab := fun (_stx: Syntax) => do - runTermElabM (fun _ => do - let r ← evalTerm Bool (mkConst ``Bool) _stx[1] - if not r then - logInfo "Assertion failed for: " - logInfo _stx[1] - logError "Expression reduced to false" - pure ()) - -#eval 2 == 2 -#assert (2 == 2) - -------------- --- PRELUDE -- -------------- - --- Results & monadic combinators - -inductive Error where - | assertionFailure: Error - | integerOverflow: Error - | divisionByZero: Error - | arrayOutOfBounds: Error - | maximumSizeExceeded: Error - | panic: Error -deriving Repr, BEq - -open Error - -inductive Result (α : Type u) where - | ret (v: α): Result α - | fail (e: Error): Result α -deriving Repr, BEq - -open Result - -instance Result_Inhabited (α : Type u) : Inhabited (Result α) := - Inhabited.mk (fail panic) - -/- HELPERS -/ - -def ret? {α: Type} (r: Result α): Bool := - match r with - | Result.ret _ => true - | Result.fail _ => false - -def massert (b:Bool) : Result Unit := - if b then .ret () else fail assertionFailure - -def eval_global {α: Type} (x: Result α) (_: ret? x): α := - match x with - | Result.fail _ => by contradiction - | Result.ret x => x - -/- DO-DSL SUPPORT -/ - -def bind (x: Result α) (f: α -> Result β) : Result β := - match x with - | ret v => f v - | fail v => fail v - --- Allows using Result in do-blocks -instance : Bind Result where - bind := bind - --- Allows using return x in do-blocks -instance : Pure Result where - pure := fun x => ret x - -/- CUSTOM-DSL SUPPORT -/ - --- Let-binding the Result of a monadic operation is oftentimes not sufficient, --- because we may need a hypothesis for equational reasoning in the scope. We --- rely on subtype, and a custom let-binding operator, in effect recreating our --- own variant of the do-dsl - -def Result.attach {α: Type} (o : Result α): Result { x : α // o = ret x } := - match o with - | .ret x => .ret ⟨x, rfl⟩ - | .fail e => .fail e - -macro "let" e:term " ⟵ " f:term : doElem => - `(doElem| let ⟨$e, h⟩ ← Result.attach $f) - --- TODO: any way to factorize both definitions? -macro "let" e:term " <-- " f:term : doElem => - `(doElem| let ⟨$e, h⟩ ← Result.attach $f) - --- We call the hypothesis `h`, in effect making it unavailable to the user --- (because too much shadowing). But in practice, once can use the French single --- quote notation (input with f< and f>), where `‹ h ›` finds a suitable --- hypothesis in the context, this is equivalent to `have x: h := by assumption in x` -#eval do - let y <-- .ret (0: Nat) - let _: y = 0 := by cases ‹ ret 0 = ret y › ; decide - let r: { x: Nat // x = 0 } := ⟨ y, by assumption ⟩ - .ret r - ----------------------- --- MACHINE INTEGERS -- ----------------------- - --- We redefine our machine integers types. - --- For Isize/Usize, we reuse `getNumBits` from `USize`. You cannot reduce `getNumBits` --- using the simplifier, meaning that proofs do not depend on the compile-time value of --- USize.size. (Lean assumes 32 or 64-bit platforms, and Rust doesn't really support, at --- least officially, 16-bit microcontrollers, so this seems like a fine design decision --- for now.) - --- Note from Chris Bailey: "If there's more than one salient property of your --- definition then the subtyping strategy might get messy, and the property part --- of a subtype is less discoverable by the simplifier or tactics like --- library_search." So, we will not add refinements on the return values of the --- operations defined on Primitives, but will rather rely on custom lemmas to --- invert on possible return values of the primitive operations. - --- Machine integer constants, done via `ofNatCore`, which requires a proof that --- the `Nat` fits within the desired integer type. We provide a custom tactic. - -open System.Platform.getNumBits - --- TODO: is there a way of only importing System.Platform.getNumBits? --- -@[simp] def size_num_bits : Nat := (System.Platform.getNumBits ()).val - --- Remark: Lean seems to use < for the comparisons with the upper bounds by convention. --- We keep the F* convention for now. -@[simp] def Isize.min : Int := - (HPow.hPow 2 (size_num_bits - 1)) -@[simp] def Isize.max : Int := (HPow.hPow 2 (size_num_bits - 1)) - 1 -@[simp] def I8.min : Int := - (HPow.hPow 2 7) -@[simp] def I8.max : Int := HPow.hPow 2 7 - 1 -@[simp] def I16.min : Int := - (HPow.hPow 2 15) -@[simp] def I16.max : Int := HPow.hPow 2 15 - 1 -@[simp] def I32.min : Int := -(HPow.hPow 2 31) -@[simp] def I32.max : Int := HPow.hPow 2 31 - 1 -@[simp] def I64.min : Int := -(HPow.hPow 2 63) -@[simp] def I64.max : Int := HPow.hPow 2 63 - 1 -@[simp] def I128.min : Int := -(HPow.hPow 2 127) -@[simp] def I128.max : Int := HPow.hPow 2 127 - 1 -@[simp] def Usize.min : Int := 0 -@[simp] def Usize.max : Int := HPow.hPow 2 size_num_bits - 1 -@[simp] def U8.min : Int := 0 -@[simp] def U8.max : Int := HPow.hPow 2 8 - 1 -@[simp] def U16.min : Int := 0 -@[simp] def U16.max : Int := HPow.hPow 2 16 - 1 -@[simp] def U32.min : Int := 0 -@[simp] def U32.max : Int := HPow.hPow 2 32 - 1 -@[simp] def U64.min : Int := 0 -@[simp] def U64.max : Int := HPow.hPow 2 64 - 1 -@[simp] def U128.min : Int := 0 -@[simp] def U128.max : Int := HPow.hPow 2 128 - 1 - -#assert (I8.min == -128) -#assert (I8.max == 127) -#assert (I16.min == -32768) -#assert (I16.max == 32767) -#assert (I32.min == -2147483648) -#assert (I32.max == 2147483647) -#assert (I64.min == -9223372036854775808) -#assert (I64.max == 9223372036854775807) -#assert (I128.min == -170141183460469231731687303715884105728) -#assert (I128.max == 170141183460469231731687303715884105727) -#assert (U8.min == 0) -#assert (U8.max == 255) -#assert (U16.min == 0) -#assert (U16.max == 65535) -#assert (U32.min == 0) -#assert (U32.max == 4294967295) -#assert (U64.min == 0) -#assert (U64.max == 18446744073709551615) -#assert (U128.min == 0) -#assert (U128.max == 340282366920938463463374607431768211455) - -inductive ScalarTy := -| Isize -| I8 -| I16 -| I32 -| I64 -| I128 -| Usize -| U8 -| U16 -| U32 -| U64 -| U128 - -def Scalar.min (ty : ScalarTy) : Int := - match ty with - | .Isize => Isize.min - | .I8 => I8.min - | .I16 => I16.min - | .I32 => I32.min - | .I64 => I64.min - | .I128 => I128.min - | .Usize => Usize.min - | .U8 => U8.min - | .U16 => U16.min - | .U32 => U32.min - | .U64 => U64.min - | .U128 => U128.min - -def Scalar.max (ty : ScalarTy) : Int := - match ty with - | .Isize => Isize.max - | .I8 => I8.max - | .I16 => I16.max - | .I32 => I32.max - | .I64 => I64.max - | .I128 => I128.max - | .Usize => Usize.max - | .U8 => U8.max - | .U16 => U16.max - | .U32 => U32.max - | .U64 => U64.max - | .U128 => U128.max - --- "Conservative" bounds --- We use those because we can't compare to the isize bounds (which can't --- reduce at compile-time). Whenever we perform an arithmetic operation like --- addition we need to check that the result is in bounds: we first compare --- to the conservative bounds, which reduce, then compare to the real bounds. --- This is useful for the various #asserts that we want to reduce at --- type-checking time. -def Scalar.cMin (ty : ScalarTy) : Int := - match ty with - | .Isize => I32.min - | _ => Scalar.min ty - -def Scalar.cMax (ty : ScalarTy) : Int := - match ty with - | .Isize => I32.max - | .Usize => U32.max - | _ => Scalar.max ty - -theorem Scalar.cMin_bound ty : Scalar.min ty <= Scalar.cMin ty := by sorry -theorem Scalar.cMax_bound ty : Scalar.min ty <= Scalar.cMin ty := by sorry - -structure Scalar (ty : ScalarTy) where - val : Int - hmin : Scalar.min ty <= val - hmax : val <= Scalar.max ty - -theorem Scalar.bound_suffices (ty : ScalarTy) (x : Int) : - Scalar.cMin ty <= x && x <= Scalar.cMax ty -> - (decide (Scalar.min ty ≤ x) && decide (x ≤ Scalar.max ty)) = true - := by sorry - -def Scalar.ofIntCore {ty : ScalarTy} (x : Int) - (hmin : Scalar.min ty <= x) (hmax : x <= Scalar.max ty) : Scalar ty := - { val := x, hmin := hmin, hmax := hmax } - -def Scalar.ofInt {ty : ScalarTy} (x : Int) - (h : Scalar.min ty <= x && x <= Scalar.max ty) : Scalar ty := - let hmin: Scalar.min ty <= x := by sorry - let hmax: x <= Scalar.max ty := by sorry - Scalar.ofIntCore x hmin hmax - --- Further thoughts: look at what has been done here: --- https://github.com/leanprover-community/mathlib4/blob/master/Mathlib/Data/Fin/Basic.lean --- and --- https://github.com/leanprover-community/mathlib4/blob/master/Mathlib/Data/UInt.lean --- which both contain a fair amount of reasoning already! -def Scalar.tryMk (ty : ScalarTy) (x : Int) : Result (Scalar ty) := - -- TODO: write this with only one if then else - if hmin_cons: Scalar.cMin ty <= x || Scalar.min ty <= x then - if hmax_cons: x <= Scalar.cMax ty || x <= Scalar.max ty then - let hmin: Scalar.min ty <= x := by sorry - let hmax: x <= Scalar.max ty := by sorry - return Scalar.ofIntCore x hmin hmax - else fail integerOverflow - else fail integerOverflow - -def Scalar.neg {ty : ScalarTy} (x : Scalar ty) : Result (Scalar ty) := Scalar.tryMk ty (- x.val) - -def Scalar.div {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - if y.val != 0 then Scalar.tryMk ty (x.val / y.val) else fail divisionByZero - --- Checking that the % operation in Lean computes the same as the remainder operation in Rust -#assert 1 % 2 = (1:Int) -#assert (-1) % 2 = -1 -#assert 1 % (-2) = 1 -#assert (-1) % (-2) = -1 - -def Scalar.rem {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - if y.val != 0 then Scalar.tryMk ty (x.val % y.val) else fail divisionByZero - -def Scalar.add {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - Scalar.tryMk ty (x.val + y.val) - -def Scalar.sub {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - Scalar.tryMk ty (x.val - y.val) - -def Scalar.mul {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - Scalar.tryMk ty (x.val * y.val) - --- TODO: instances of +, -, * etc. for scalars - --- Cast an integer from a [src_ty] to a [tgt_ty] --- TODO: check the semantics of casts in Rust -def Scalar.cast {src_ty : ScalarTy} (tgt_ty : ScalarTy) (x : Scalar src_ty) : Result (Scalar tgt_ty) := - Scalar.tryMk tgt_ty x.val - --- The scalar types --- We declare the definitions as reducible so that Lean can unfold them (useful --- for type class resolution for instance). -@[reducible] def Isize := Scalar .Isize -@[reducible] def I8 := Scalar .I8 -@[reducible] def I16 := Scalar .I16 -@[reducible] def I32 := Scalar .I32 -@[reducible] def I64 := Scalar .I64 -@[reducible] def I128 := Scalar .I128 -@[reducible] def Usize := Scalar .Usize -@[reducible] def U8 := Scalar .U8 -@[reducible] def U16 := Scalar .U16 -@[reducible] def U32 := Scalar .U32 -@[reducible] def U64 := Scalar .U64 -@[reducible] def U128 := Scalar .U128 - --- TODO: below: not sure this is the best way. --- Should we rather overload operations like +, -, etc.? --- Also, it is possible to automate the generation of those definitions --- with macros (but would it be a good idea? It would be less easy to --- read the file, which is not supposed to change a lot) - --- Negation - -/-- -Remark: there is no heterogeneous negation in the Lean prelude: we thus introduce -one here. - -The notation typeclass for heterogeneous addition. -This enables the notation `- a : β` where `a : α`. --/ -class HNeg (α : Type u) (β : outParam (Type v)) where - /-- `- a` computes the negation of `a`. - The meaning of this notation is type-dependent. -/ - hNeg : α → β - -prefix:75 "-" => HNeg.hNeg - -instance : HNeg Isize (Result Isize) where hNeg x := Scalar.neg x -instance : HNeg I8 (Result I8) where hNeg x := Scalar.neg x -instance : HNeg I16 (Result I16) where hNeg x := Scalar.neg x -instance : HNeg I32 (Result I32) where hNeg x := Scalar.neg x -instance : HNeg I64 (Result I64) where hNeg x := Scalar.neg x -instance : HNeg I128 (Result I128) where hNeg x := Scalar.neg x - --- Addition -instance {ty} : HAdd (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hAdd x y := Scalar.add x y - --- Substraction -instance {ty} : HSub (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hSub x y := Scalar.sub x y - --- Multiplication -instance {ty} : HMul (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hMul x y := Scalar.mul x y - --- Division -instance {ty} : HDiv (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hDiv x y := Scalar.div x y - --- Remainder -instance {ty} : HMod (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hMod x y := Scalar.rem x y - --- ofIntCore --- TODO: typeclass? -def Isize.ofIntCore := @Scalar.ofIntCore .Isize -def I8.ofIntCore := @Scalar.ofIntCore .I8 -def I16.ofIntCore := @Scalar.ofIntCore .I16 -def I32.ofIntCore := @Scalar.ofIntCore .I32 -def I64.ofIntCore := @Scalar.ofIntCore .I64 -def I128.ofIntCore := @Scalar.ofIntCore .I128 -def Usize.ofIntCore := @Scalar.ofIntCore .Usize -def U8.ofIntCore := @Scalar.ofIntCore .U8 -def U16.ofIntCore := @Scalar.ofIntCore .U16 -def U32.ofIntCore := @Scalar.ofIntCore .U32 -def U64.ofIntCore := @Scalar.ofIntCore .U64 -def U128.ofIntCore := @Scalar.ofIntCore .U128 - --- ofInt --- TODO: typeclass? -def Isize.ofInt := @Scalar.ofInt .Isize -def I8.ofInt := @Scalar.ofInt .I8 -def I16.ofInt := @Scalar.ofInt .I16 -def I32.ofInt := @Scalar.ofInt .I32 -def I64.ofInt := @Scalar.ofInt .I64 -def I128.ofInt := @Scalar.ofInt .I128 -def Usize.ofInt := @Scalar.ofInt .Usize -def U8.ofInt := @Scalar.ofInt .U8 -def U16.ofInt := @Scalar.ofInt .U16 -def U32.ofInt := @Scalar.ofInt .U32 -def U64.ofInt := @Scalar.ofInt .U64 -def U128.ofInt := @Scalar.ofInt .U128 - --- Comparisons -instance {ty} : LT (Scalar ty) where - lt a b := LT.lt a.val b.val - -instance {ty} : LE (Scalar ty) where le a b := LE.le a.val b.val - -instance Scalar.decLt {ty} (a b : Scalar ty) : Decidable (LT.lt a b) := Int.decLt .. -instance Scalar.decLe {ty} (a b : Scalar ty) : Decidable (LE.le a b) := Int.decLe .. - -theorem Scalar.eq_of_val_eq {ty} : ∀ {i j : Scalar ty}, Eq i.val j.val → Eq i j - | ⟨_, _, _⟩, ⟨_, _, _⟩, rfl => rfl - -theorem Scalar.val_eq_of_eq {ty} {i j : Scalar ty} (h : Eq i j) : Eq i.val j.val := - h ▸ rfl - -theorem Scalar.ne_of_val_ne {ty} {i j : Scalar ty} (h : Not (Eq i.val j.val)) : Not (Eq i j) := - fun h' => absurd (val_eq_of_eq h') h - -instance (ty : ScalarTy) : DecidableEq (Scalar ty) := - fun i j => - match decEq i.val j.val with - | isTrue h => isTrue (Scalar.eq_of_val_eq h) - | isFalse h => isFalse (Scalar.ne_of_val_ne h) - -def Scalar.toInt {ty} (n : Scalar ty) : Int := n.val - --- Tactic to prove that integers are in bounds -syntax "intlit" : tactic - -macro_rules - | `(tactic| intlit) => `(tactic| apply Scalar.bound_suffices ; decide) - --- -- We now define a type class that subsumes the various machine integer types, so --- -- as to write a concise definition for scalar_cast, rather than exhaustively --- -- enumerating all of the possible pairs. We remark that Rust has sane semantics --- -- and fails if a cast operation would involve a truncation or modulo. - --- class MachineInteger (t: Type) where --- size: Nat --- val: t -> Fin size --- ofNatCore: (n:Nat) -> LT.lt n size -> t - --- set_option hygiene false in --- run_cmd --- for typeName in [`UInt8, `UInt16, `UInt32, `UInt64, `USize].map Lean.mkIdent do --- Lean.Elab.Command.elabCommand (← `( --- namespace $typeName --- instance: MachineInteger $typeName where --- size := size --- val := val --- ofNatCore := ofNatCore --- end $typeName --- )) - --- -- Aeneas only instantiates the destination type (`src` is implicit). We rely on --- -- Lean to infer `src`. - --- def scalar_cast { src: Type } (dst: Type) [ MachineInteger src ] [ MachineInteger dst ] (x: src): Result dst := --- if h: MachineInteger.val x < MachineInteger.size dst then --- .ret (MachineInteger.ofNatCore (MachineInteger.val x).val h) --- else --- .fail integerOverflow - -------------- --- VECTORS -- -------------- - -def Vec (α : Type u) := { l : List α // List.length l <= Usize.max } - -def vec_new (α : Type u): Vec α := ⟨ [], by sorry ⟩ - -def vec_len (α : Type u) (v : Vec α) : Usize := - let ⟨ v, l ⟩ := v - Usize.ofIntCore (List.length v) (by sorry) l - -def vec_push_fwd (α : Type u) (_ : Vec α) (_ : α) : Unit := () - -def vec_push_back (α : Type u) (v : Vec α) (x : α) : Result (Vec α) - := - if h : List.length v.val <= U32.max || List.length v.val <= Usize.max then - return ⟨ List.concat v.val x, by sorry ⟩ - else - fail maximumSizeExceeded - -def vec_insert_fwd (α : Type u) (v: Vec α) (i: Usize) (_: α): Result Unit := - if i.val < List.length v.val then - .ret () - else - .fail arrayOutOfBounds - -def vec_insert_back (α : Type u) (v: Vec α) (i: Usize) (x: α): Result (Vec α) := - if i.val < List.length v.val then - -- TODO: maybe we should redefine a list library which uses integers - -- (instead of natural numbers) - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - .ret ⟨ List.set v.val i.val x, by - have h: List.length v.val <= Usize.max := v.property - rewrite [ List.length_set v.val i.val x ] - assumption - ⟩ - else - .fail arrayOutOfBounds - -def vec_index_fwd (α : Type u) (v: Vec α) (i: Usize): Result α := - if i.val < List.length v.val then - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - let h: i < List.length v.val := by sorry - .ret (List.get v.val ⟨i.val, h⟩) - else - .fail arrayOutOfBounds - -def vec_index_back (α : Type u) (v: Vec α) (i: Usize) (_: α): Result Unit := - if i.val < List.length v.val then - .ret () - else - .fail arrayOutOfBounds - -def vec_index_mut_fwd (α : Type u) (v: Vec α) (i: Usize): Result α := - if i.val < List.length v.val then - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - let h: i < List.length v.val := by sorry - .ret (List.get v.val ⟨i.val, h⟩) - else - .fail arrayOutOfBounds - -def vec_index_mut_back (α : Type u) (v: Vec α) (i: Usize) (x: α): Result (Vec α) := - if i.val < List.length v.val then - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - .ret ⟨ List.set v.val i.val x, by - have h: List.length v.val <= Usize.max := v.property - rewrite [ List.length_set v.val i.val x ] - assumption - ⟩ - else - .fail arrayOutOfBounds - ----------- --- MISC -- ----------- - -def mem_replace_fwd (a : Type) (x : a) (_ : a) : a := - x - -def mem_replace_back (a : Type) (_ : a) (y : a) : a := - y - -/-- Aeneas-translated function -- useful to reduce non-recursive definitions. - Use with `simp [ aeneas ]` -/ -register_simp_attr aeneas diff --git a/tests/lean/misc-no_nested_borrows/lake-manifest.json b/tests/lean/misc-no_nested_borrows/lake-manifest.json deleted file mode 100644 index 57b071ca..00000000 --- a/tests/lean/misc-no_nested_borrows/lake-manifest.json +++ /dev/null @@ -1,27 +0,0 @@ -{"version": 4, - "packagesDir": "./lake-packages", - "packages": - [{"git": - {"url": "https://github.com/leanprover-community/mathlib4.git", - "subDir?": null, - "rev": "4037792ead804d7bfa8868e2c4684d4223c15ece", - "name": "mathlib", - "inputRev?": null}}, - {"git": - {"url": "https://github.com/gebner/quote4", - "subDir?": null, - "rev": "2412c4fdf4a8b689f4467618e5e7b371ae5014aa", - "name": "Qq", - "inputRev?": "master"}}, - {"git": - {"url": "https://github.com/JLimperg/aesop", - "subDir?": null, - "rev": "7fe9ecd9339b0e1796e89d243b776849c305c690", - "name": "aesop", - "inputRev?": "master"}}, - {"git": - {"url": "https://github.com/leanprover/std4", - "subDir?": null, - "rev": "24897887905b3a1254b244369f5dd2cf6174b0ee", - "name": "std", - "inputRev?": "main"}}]} diff --git a/tests/lean/misc-no_nested_borrows/lakefile.lean b/tests/lean/misc-no_nested_borrows/lakefile.lean deleted file mode 100644 index 58619110..00000000 --- a/tests/lean/misc-no_nested_borrows/lakefile.lean +++ /dev/null @@ -1,12 +0,0 @@ -import Lake -open Lake DSL - -require mathlib from git - "https://github.com/leanprover-community/mathlib4.git" - -package «no_nested_borrows» {} - -lean_lib «Base» {} - -@[default_target] -lean_lib «NoNestedBorrows» {} diff --git a/tests/lean/misc-no_nested_borrows/lean-toolchain b/tests/lean/misc-no_nested_borrows/lean-toolchain deleted file mode 100644 index bbf57f10..00000000 --- a/tests/lean/misc-no_nested_borrows/lean-toolchain +++ /dev/null @@ -1 +0,0 @@ -leanprover/lean4:nightly-2023-01-21 diff --git a/tests/lean/misc-paper/Base/Primitives.lean b/tests/lean/misc-paper/Base/Primitives.lean deleted file mode 100644 index 4a66a453..00000000 --- a/tests/lean/misc-paper/Base/Primitives.lean +++ /dev/null @@ -1,583 +0,0 @@ -import Lean -import Lean.Meta.Tactic.Simp -import Init.Data.List.Basic -import Mathlib.Tactic.RunCmd - --------------------- --- ASSERT COMMAND -- --------------------- - -open Lean Elab Command Term Meta - -syntax (name := assert) "#assert" term: command - -@[command_elab assert] -unsafe -def assertImpl : CommandElab := fun (_stx: Syntax) => do - runTermElabM (fun _ => do - let r ← evalTerm Bool (mkConst ``Bool) _stx[1] - if not r then - logInfo "Assertion failed for: " - logInfo _stx[1] - logError "Expression reduced to false" - pure ()) - -#eval 2 == 2 -#assert (2 == 2) - -------------- --- PRELUDE -- -------------- - --- Results & monadic combinators - -inductive Error where - | assertionFailure: Error - | integerOverflow: Error - | divisionByZero: Error - | arrayOutOfBounds: Error - | maximumSizeExceeded: Error - | panic: Error -deriving Repr, BEq - -open Error - -inductive Result (α : Type u) where - | ret (v: α): Result α - | fail (e: Error): Result α -deriving Repr, BEq - -open Result - -instance Result_Inhabited (α : Type u) : Inhabited (Result α) := - Inhabited.mk (fail panic) - -/- HELPERS -/ - -def ret? {α: Type} (r: Result α): Bool := - match r with - | Result.ret _ => true - | Result.fail _ => false - -def massert (b:Bool) : Result Unit := - if b then .ret () else fail assertionFailure - -def eval_global {α: Type} (x: Result α) (_: ret? x): α := - match x with - | Result.fail _ => by contradiction - | Result.ret x => x - -/- DO-DSL SUPPORT -/ - -def bind (x: Result α) (f: α -> Result β) : Result β := - match x with - | ret v => f v - | fail v => fail v - --- Allows using Result in do-blocks -instance : Bind Result where - bind := bind - --- Allows using return x in do-blocks -instance : Pure Result where - pure := fun x => ret x - -/- CUSTOM-DSL SUPPORT -/ - --- Let-binding the Result of a monadic operation is oftentimes not sufficient, --- because we may need a hypothesis for equational reasoning in the scope. We --- rely on subtype, and a custom let-binding operator, in effect recreating our --- own variant of the do-dsl - -def Result.attach {α: Type} (o : Result α): Result { x : α // o = ret x } := - match o with - | .ret x => .ret ⟨x, rfl⟩ - | .fail e => .fail e - -macro "let" e:term " ⟵ " f:term : doElem => - `(doElem| let ⟨$e, h⟩ ← Result.attach $f) - --- TODO: any way to factorize both definitions? -macro "let" e:term " <-- " f:term : doElem => - `(doElem| let ⟨$e, h⟩ ← Result.attach $f) - --- We call the hypothesis `h`, in effect making it unavailable to the user --- (because too much shadowing). But in practice, once can use the French single --- quote notation (input with f< and f>), where `‹ h ›` finds a suitable --- hypothesis in the context, this is equivalent to `have x: h := by assumption in x` -#eval do - let y <-- .ret (0: Nat) - let _: y = 0 := by cases ‹ ret 0 = ret y › ; decide - let r: { x: Nat // x = 0 } := ⟨ y, by assumption ⟩ - .ret r - ----------------------- --- MACHINE INTEGERS -- ----------------------- - --- We redefine our machine integers types. - --- For Isize/Usize, we reuse `getNumBits` from `USize`. You cannot reduce `getNumBits` --- using the simplifier, meaning that proofs do not depend on the compile-time value of --- USize.size. (Lean assumes 32 or 64-bit platforms, and Rust doesn't really support, at --- least officially, 16-bit microcontrollers, so this seems like a fine design decision --- for now.) - --- Note from Chris Bailey: "If there's more than one salient property of your --- definition then the subtyping strategy might get messy, and the property part --- of a subtype is less discoverable by the simplifier or tactics like --- library_search." So, we will not add refinements on the return values of the --- operations defined on Primitives, but will rather rely on custom lemmas to --- invert on possible return values of the primitive operations. - --- Machine integer constants, done via `ofNatCore`, which requires a proof that --- the `Nat` fits within the desired integer type. We provide a custom tactic. - -open System.Platform.getNumBits - --- TODO: is there a way of only importing System.Platform.getNumBits? --- -@[simp] def size_num_bits : Nat := (System.Platform.getNumBits ()).val - --- Remark: Lean seems to use < for the comparisons with the upper bounds by convention. --- We keep the F* convention for now. -@[simp] def Isize.min : Int := - (HPow.hPow 2 (size_num_bits - 1)) -@[simp] def Isize.max : Int := (HPow.hPow 2 (size_num_bits - 1)) - 1 -@[simp] def I8.min : Int := - (HPow.hPow 2 7) -@[simp] def I8.max : Int := HPow.hPow 2 7 - 1 -@[simp] def I16.min : Int := - (HPow.hPow 2 15) -@[simp] def I16.max : Int := HPow.hPow 2 15 - 1 -@[simp] def I32.min : Int := -(HPow.hPow 2 31) -@[simp] def I32.max : Int := HPow.hPow 2 31 - 1 -@[simp] def I64.min : Int := -(HPow.hPow 2 63) -@[simp] def I64.max : Int := HPow.hPow 2 63 - 1 -@[simp] def I128.min : Int := -(HPow.hPow 2 127) -@[simp] def I128.max : Int := HPow.hPow 2 127 - 1 -@[simp] def Usize.min : Int := 0 -@[simp] def Usize.max : Int := HPow.hPow 2 size_num_bits - 1 -@[simp] def U8.min : Int := 0 -@[simp] def U8.max : Int := HPow.hPow 2 8 - 1 -@[simp] def U16.min : Int := 0 -@[simp] def U16.max : Int := HPow.hPow 2 16 - 1 -@[simp] def U32.min : Int := 0 -@[simp] def U32.max : Int := HPow.hPow 2 32 - 1 -@[simp] def U64.min : Int := 0 -@[simp] def U64.max : Int := HPow.hPow 2 64 - 1 -@[simp] def U128.min : Int := 0 -@[simp] def U128.max : Int := HPow.hPow 2 128 - 1 - -#assert (I8.min == -128) -#assert (I8.max == 127) -#assert (I16.min == -32768) -#assert (I16.max == 32767) -#assert (I32.min == -2147483648) -#assert (I32.max == 2147483647) -#assert (I64.min == -9223372036854775808) -#assert (I64.max == 9223372036854775807) -#assert (I128.min == -170141183460469231731687303715884105728) -#assert (I128.max == 170141183460469231731687303715884105727) -#assert (U8.min == 0) -#assert (U8.max == 255) -#assert (U16.min == 0) -#assert (U16.max == 65535) -#assert (U32.min == 0) -#assert (U32.max == 4294967295) -#assert (U64.min == 0) -#assert (U64.max == 18446744073709551615) -#assert (U128.min == 0) -#assert (U128.max == 340282366920938463463374607431768211455) - -inductive ScalarTy := -| Isize -| I8 -| I16 -| I32 -| I64 -| I128 -| Usize -| U8 -| U16 -| U32 -| U64 -| U128 - -def Scalar.min (ty : ScalarTy) : Int := - match ty with - | .Isize => Isize.min - | .I8 => I8.min - | .I16 => I16.min - | .I32 => I32.min - | .I64 => I64.min - | .I128 => I128.min - | .Usize => Usize.min - | .U8 => U8.min - | .U16 => U16.min - | .U32 => U32.min - | .U64 => U64.min - | .U128 => U128.min - -def Scalar.max (ty : ScalarTy) : Int := - match ty with - | .Isize => Isize.max - | .I8 => I8.max - | .I16 => I16.max - | .I32 => I32.max - | .I64 => I64.max - | .I128 => I128.max - | .Usize => Usize.max - | .U8 => U8.max - | .U16 => U16.max - | .U32 => U32.max - | .U64 => U64.max - | .U128 => U128.max - --- "Conservative" bounds --- We use those because we can't compare to the isize bounds (which can't --- reduce at compile-time). Whenever we perform an arithmetic operation like --- addition we need to check that the result is in bounds: we first compare --- to the conservative bounds, which reduce, then compare to the real bounds. --- This is useful for the various #asserts that we want to reduce at --- type-checking time. -def Scalar.cMin (ty : ScalarTy) : Int := - match ty with - | .Isize => I32.min - | _ => Scalar.min ty - -def Scalar.cMax (ty : ScalarTy) : Int := - match ty with - | .Isize => I32.max - | .Usize => U32.max - | _ => Scalar.max ty - -theorem Scalar.cMin_bound ty : Scalar.min ty <= Scalar.cMin ty := by sorry -theorem Scalar.cMax_bound ty : Scalar.min ty <= Scalar.cMin ty := by sorry - -structure Scalar (ty : ScalarTy) where - val : Int - hmin : Scalar.min ty <= val - hmax : val <= Scalar.max ty - -theorem Scalar.bound_suffices (ty : ScalarTy) (x : Int) : - Scalar.cMin ty <= x && x <= Scalar.cMax ty -> - (decide (Scalar.min ty ≤ x) && decide (x ≤ Scalar.max ty)) = true - := by sorry - -def Scalar.ofIntCore {ty : ScalarTy} (x : Int) - (hmin : Scalar.min ty <= x) (hmax : x <= Scalar.max ty) : Scalar ty := - { val := x, hmin := hmin, hmax := hmax } - -def Scalar.ofInt {ty : ScalarTy} (x : Int) - (h : Scalar.min ty <= x && x <= Scalar.max ty) : Scalar ty := - let hmin: Scalar.min ty <= x := by sorry - let hmax: x <= Scalar.max ty := by sorry - Scalar.ofIntCore x hmin hmax - --- Further thoughts: look at what has been done here: --- https://github.com/leanprover-community/mathlib4/blob/master/Mathlib/Data/Fin/Basic.lean --- and --- https://github.com/leanprover-community/mathlib4/blob/master/Mathlib/Data/UInt.lean --- which both contain a fair amount of reasoning already! -def Scalar.tryMk (ty : ScalarTy) (x : Int) : Result (Scalar ty) := - -- TODO: write this with only one if then else - if hmin_cons: Scalar.cMin ty <= x || Scalar.min ty <= x then - if hmax_cons: x <= Scalar.cMax ty || x <= Scalar.max ty then - let hmin: Scalar.min ty <= x := by sorry - let hmax: x <= Scalar.max ty := by sorry - return Scalar.ofIntCore x hmin hmax - else fail integerOverflow - else fail integerOverflow - -def Scalar.neg {ty : ScalarTy} (x : Scalar ty) : Result (Scalar ty) := Scalar.tryMk ty (- x.val) - -def Scalar.div {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - if y.val != 0 then Scalar.tryMk ty (x.val / y.val) else fail divisionByZero - --- Checking that the % operation in Lean computes the same as the remainder operation in Rust -#assert 1 % 2 = (1:Int) -#assert (-1) % 2 = -1 -#assert 1 % (-2) = 1 -#assert (-1) % (-2) = -1 - -def Scalar.rem {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - if y.val != 0 then Scalar.tryMk ty (x.val % y.val) else fail divisionByZero - -def Scalar.add {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - Scalar.tryMk ty (x.val + y.val) - -def Scalar.sub {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - Scalar.tryMk ty (x.val - y.val) - -def Scalar.mul {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - Scalar.tryMk ty (x.val * y.val) - --- TODO: instances of +, -, * etc. for scalars - --- Cast an integer from a [src_ty] to a [tgt_ty] --- TODO: check the semantics of casts in Rust -def Scalar.cast {src_ty : ScalarTy} (tgt_ty : ScalarTy) (x : Scalar src_ty) : Result (Scalar tgt_ty) := - Scalar.tryMk tgt_ty x.val - --- The scalar types --- We declare the definitions as reducible so that Lean can unfold them (useful --- for type class resolution for instance). -@[reducible] def Isize := Scalar .Isize -@[reducible] def I8 := Scalar .I8 -@[reducible] def I16 := Scalar .I16 -@[reducible] def I32 := Scalar .I32 -@[reducible] def I64 := Scalar .I64 -@[reducible] def I128 := Scalar .I128 -@[reducible] def Usize := Scalar .Usize -@[reducible] def U8 := Scalar .U8 -@[reducible] def U16 := Scalar .U16 -@[reducible] def U32 := Scalar .U32 -@[reducible] def U64 := Scalar .U64 -@[reducible] def U128 := Scalar .U128 - --- TODO: below: not sure this is the best way. --- Should we rather overload operations like +, -, etc.? --- Also, it is possible to automate the generation of those definitions --- with macros (but would it be a good idea? It would be less easy to --- read the file, which is not supposed to change a lot) - --- Negation - -/-- -Remark: there is no heterogeneous negation in the Lean prelude: we thus introduce -one here. - -The notation typeclass for heterogeneous addition. -This enables the notation `- a : β` where `a : α`. --/ -class HNeg (α : Type u) (β : outParam (Type v)) where - /-- `- a` computes the negation of `a`. - The meaning of this notation is type-dependent. -/ - hNeg : α → β - -prefix:75 "-" => HNeg.hNeg - -instance : HNeg Isize (Result Isize) where hNeg x := Scalar.neg x -instance : HNeg I8 (Result I8) where hNeg x := Scalar.neg x -instance : HNeg I16 (Result I16) where hNeg x := Scalar.neg x -instance : HNeg I32 (Result I32) where hNeg x := Scalar.neg x -instance : HNeg I64 (Result I64) where hNeg x := Scalar.neg x -instance : HNeg I128 (Result I128) where hNeg x := Scalar.neg x - --- Addition -instance {ty} : HAdd (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hAdd x y := Scalar.add x y - --- Substraction -instance {ty} : HSub (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hSub x y := Scalar.sub x y - --- Multiplication -instance {ty} : HMul (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hMul x y := Scalar.mul x y - --- Division -instance {ty} : HDiv (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hDiv x y := Scalar.div x y - --- Remainder -instance {ty} : HMod (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hMod x y := Scalar.rem x y - --- ofIntCore --- TODO: typeclass? -def Isize.ofIntCore := @Scalar.ofIntCore .Isize -def I8.ofIntCore := @Scalar.ofIntCore .I8 -def I16.ofIntCore := @Scalar.ofIntCore .I16 -def I32.ofIntCore := @Scalar.ofIntCore .I32 -def I64.ofIntCore := @Scalar.ofIntCore .I64 -def I128.ofIntCore := @Scalar.ofIntCore .I128 -def Usize.ofIntCore := @Scalar.ofIntCore .Usize -def U8.ofIntCore := @Scalar.ofIntCore .U8 -def U16.ofIntCore := @Scalar.ofIntCore .U16 -def U32.ofIntCore := @Scalar.ofIntCore .U32 -def U64.ofIntCore := @Scalar.ofIntCore .U64 -def U128.ofIntCore := @Scalar.ofIntCore .U128 - --- ofInt --- TODO: typeclass? -def Isize.ofInt := @Scalar.ofInt .Isize -def I8.ofInt := @Scalar.ofInt .I8 -def I16.ofInt := @Scalar.ofInt .I16 -def I32.ofInt := @Scalar.ofInt .I32 -def I64.ofInt := @Scalar.ofInt .I64 -def I128.ofInt := @Scalar.ofInt .I128 -def Usize.ofInt := @Scalar.ofInt .Usize -def U8.ofInt := @Scalar.ofInt .U8 -def U16.ofInt := @Scalar.ofInt .U16 -def U32.ofInt := @Scalar.ofInt .U32 -def U64.ofInt := @Scalar.ofInt .U64 -def U128.ofInt := @Scalar.ofInt .U128 - --- Comparisons -instance {ty} : LT (Scalar ty) where - lt a b := LT.lt a.val b.val - -instance {ty} : LE (Scalar ty) where le a b := LE.le a.val b.val - -instance Scalar.decLt {ty} (a b : Scalar ty) : Decidable (LT.lt a b) := Int.decLt .. -instance Scalar.decLe {ty} (a b : Scalar ty) : Decidable (LE.le a b) := Int.decLe .. - -theorem Scalar.eq_of_val_eq {ty} : ∀ {i j : Scalar ty}, Eq i.val j.val → Eq i j - | ⟨_, _, _⟩, ⟨_, _, _⟩, rfl => rfl - -theorem Scalar.val_eq_of_eq {ty} {i j : Scalar ty} (h : Eq i j) : Eq i.val j.val := - h ▸ rfl - -theorem Scalar.ne_of_val_ne {ty} {i j : Scalar ty} (h : Not (Eq i.val j.val)) : Not (Eq i j) := - fun h' => absurd (val_eq_of_eq h') h - -instance (ty : ScalarTy) : DecidableEq (Scalar ty) := - fun i j => - match decEq i.val j.val with - | isTrue h => isTrue (Scalar.eq_of_val_eq h) - | isFalse h => isFalse (Scalar.ne_of_val_ne h) - -def Scalar.toInt {ty} (n : Scalar ty) : Int := n.val - --- Tactic to prove that integers are in bounds -syntax "intlit" : tactic - -macro_rules - | `(tactic| intlit) => `(tactic| apply Scalar.bound_suffices ; decide) - --- -- We now define a type class that subsumes the various machine integer types, so --- -- as to write a concise definition for scalar_cast, rather than exhaustively --- -- enumerating all of the possible pairs. We remark that Rust has sane semantics --- -- and fails if a cast operation would involve a truncation or modulo. - --- class MachineInteger (t: Type) where --- size: Nat --- val: t -> Fin size --- ofNatCore: (n:Nat) -> LT.lt n size -> t - --- set_option hygiene false in --- run_cmd --- for typeName in [`UInt8, `UInt16, `UInt32, `UInt64, `USize].map Lean.mkIdent do --- Lean.Elab.Command.elabCommand (← `( --- namespace $typeName --- instance: MachineInteger $typeName where --- size := size --- val := val --- ofNatCore := ofNatCore --- end $typeName --- )) - --- -- Aeneas only instantiates the destination type (`src` is implicit). We rely on --- -- Lean to infer `src`. - --- def scalar_cast { src: Type } (dst: Type) [ MachineInteger src ] [ MachineInteger dst ] (x: src): Result dst := --- if h: MachineInteger.val x < MachineInteger.size dst then --- .ret (MachineInteger.ofNatCore (MachineInteger.val x).val h) --- else --- .fail integerOverflow - -------------- --- VECTORS -- -------------- - -def Vec (α : Type u) := { l : List α // List.length l <= Usize.max } - -def vec_new (α : Type u): Vec α := ⟨ [], by sorry ⟩ - -def vec_len (α : Type u) (v : Vec α) : Usize := - let ⟨ v, l ⟩ := v - Usize.ofIntCore (List.length v) (by sorry) l - -def vec_push_fwd (α : Type u) (_ : Vec α) (_ : α) : Unit := () - -def vec_push_back (α : Type u) (v : Vec α) (x : α) : Result (Vec α) - := - if h : List.length v.val <= U32.max || List.length v.val <= Usize.max then - return ⟨ List.concat v.val x, by sorry ⟩ - else - fail maximumSizeExceeded - -def vec_insert_fwd (α : Type u) (v: Vec α) (i: Usize) (_: α): Result Unit := - if i.val < List.length v.val then - .ret () - else - .fail arrayOutOfBounds - -def vec_insert_back (α : Type u) (v: Vec α) (i: Usize) (x: α): Result (Vec α) := - if i.val < List.length v.val then - -- TODO: maybe we should redefine a list library which uses integers - -- (instead of natural numbers) - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - .ret ⟨ List.set v.val i.val x, by - have h: List.length v.val <= Usize.max := v.property - rewrite [ List.length_set v.val i.val x ] - assumption - ⟩ - else - .fail arrayOutOfBounds - -def vec_index_fwd (α : Type u) (v: Vec α) (i: Usize): Result α := - if i.val < List.length v.val then - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - let h: i < List.length v.val := by sorry - .ret (List.get v.val ⟨i.val, h⟩) - else - .fail arrayOutOfBounds - -def vec_index_back (α : Type u) (v: Vec α) (i: Usize) (_: α): Result Unit := - if i.val < List.length v.val then - .ret () - else - .fail arrayOutOfBounds - -def vec_index_mut_fwd (α : Type u) (v: Vec α) (i: Usize): Result α := - if i.val < List.length v.val then - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - let h: i < List.length v.val := by sorry - .ret (List.get v.val ⟨i.val, h⟩) - else - .fail arrayOutOfBounds - -def vec_index_mut_back (α : Type u) (v: Vec α) (i: Usize) (x: α): Result (Vec α) := - if i.val < List.length v.val then - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - .ret ⟨ List.set v.val i.val x, by - have h: List.length v.val <= Usize.max := v.property - rewrite [ List.length_set v.val i.val x ] - assumption - ⟩ - else - .fail arrayOutOfBounds - ----------- --- MISC -- ----------- - -def mem_replace_fwd (a : Type) (x : a) (_ : a) : a := - x - -def mem_replace_back (a : Type) (_ : a) (y : a) : a := - y - -/-- Aeneas-translated function -- useful to reduce non-recursive definitions. - Use with `simp [ aeneas ]` -/ -register_simp_attr aeneas diff --git a/tests/lean/misc-paper/lake-manifest.json b/tests/lean/misc-paper/lake-manifest.json deleted file mode 100644 index 57b071ca..00000000 --- a/tests/lean/misc-paper/lake-manifest.json +++ /dev/null @@ -1,27 +0,0 @@ -{"version": 4, - "packagesDir": "./lake-packages", - "packages": - [{"git": - {"url": "https://github.com/leanprover-community/mathlib4.git", - "subDir?": null, - "rev": "4037792ead804d7bfa8868e2c4684d4223c15ece", - "name": "mathlib", - "inputRev?": null}}, - {"git": - {"url": "https://github.com/gebner/quote4", - "subDir?": null, - "rev": "2412c4fdf4a8b689f4467618e5e7b371ae5014aa", - "name": "Qq", - "inputRev?": "master"}}, - {"git": - {"url": "https://github.com/JLimperg/aesop", - "subDir?": null, - "rev": "7fe9ecd9339b0e1796e89d243b776849c305c690", - "name": "aesop", - "inputRev?": "master"}}, - {"git": - {"url": "https://github.com/leanprover/std4", - "subDir?": null, - "rev": "24897887905b3a1254b244369f5dd2cf6174b0ee", - "name": "std", - "inputRev?": "main"}}]} diff --git a/tests/lean/misc-paper/lakefile.lean b/tests/lean/misc-paper/lakefile.lean deleted file mode 100644 index 75d7208e..00000000 --- a/tests/lean/misc-paper/lakefile.lean +++ /dev/null @@ -1,12 +0,0 @@ -import Lake -open Lake DSL - -require mathlib from git - "https://github.com/leanprover-community/mathlib4.git" - -package «paper» {} - -lean_lib «Base» {} - -@[default_target] -lean_lib «Paper» {} diff --git a/tests/lean/misc-paper/lean-toolchain b/tests/lean/misc-paper/lean-toolchain deleted file mode 100644 index bbf57f10..00000000 --- a/tests/lean/misc-paper/lean-toolchain +++ /dev/null @@ -1 +0,0 @@ -leanprover/lean4:nightly-2023-01-21 diff --git a/tests/lean/misc-polonius_list/Base/Primitives.lean b/tests/lean/misc-polonius_list/Base/Primitives.lean deleted file mode 100644 index 4a66a453..00000000 --- a/tests/lean/misc-polonius_list/Base/Primitives.lean +++ /dev/null @@ -1,583 +0,0 @@ -import Lean -import Lean.Meta.Tactic.Simp -import Init.Data.List.Basic -import Mathlib.Tactic.RunCmd - --------------------- --- ASSERT COMMAND -- --------------------- - -open Lean Elab Command Term Meta - -syntax (name := assert) "#assert" term: command - -@[command_elab assert] -unsafe -def assertImpl : CommandElab := fun (_stx: Syntax) => do - runTermElabM (fun _ => do - let r ← evalTerm Bool (mkConst ``Bool) _stx[1] - if not r then - logInfo "Assertion failed for: " - logInfo _stx[1] - logError "Expression reduced to false" - pure ()) - -#eval 2 == 2 -#assert (2 == 2) - -------------- --- PRELUDE -- -------------- - --- Results & monadic combinators - -inductive Error where - | assertionFailure: Error - | integerOverflow: Error - | divisionByZero: Error - | arrayOutOfBounds: Error - | maximumSizeExceeded: Error - | panic: Error -deriving Repr, BEq - -open Error - -inductive Result (α : Type u) where - | ret (v: α): Result α - | fail (e: Error): Result α -deriving Repr, BEq - -open Result - -instance Result_Inhabited (α : Type u) : Inhabited (Result α) := - Inhabited.mk (fail panic) - -/- HELPERS -/ - -def ret? {α: Type} (r: Result α): Bool := - match r with - | Result.ret _ => true - | Result.fail _ => false - -def massert (b:Bool) : Result Unit := - if b then .ret () else fail assertionFailure - -def eval_global {α: Type} (x: Result α) (_: ret? x): α := - match x with - | Result.fail _ => by contradiction - | Result.ret x => x - -/- DO-DSL SUPPORT -/ - -def bind (x: Result α) (f: α -> Result β) : Result β := - match x with - | ret v => f v - | fail v => fail v - --- Allows using Result in do-blocks -instance : Bind Result where - bind := bind - --- Allows using return x in do-blocks -instance : Pure Result where - pure := fun x => ret x - -/- CUSTOM-DSL SUPPORT -/ - --- Let-binding the Result of a monadic operation is oftentimes not sufficient, --- because we may need a hypothesis for equational reasoning in the scope. We --- rely on subtype, and a custom let-binding operator, in effect recreating our --- own variant of the do-dsl - -def Result.attach {α: Type} (o : Result α): Result { x : α // o = ret x } := - match o with - | .ret x => .ret ⟨x, rfl⟩ - | .fail e => .fail e - -macro "let" e:term " ⟵ " f:term : doElem => - `(doElem| let ⟨$e, h⟩ ← Result.attach $f) - --- TODO: any way to factorize both definitions? -macro "let" e:term " <-- " f:term : doElem => - `(doElem| let ⟨$e, h⟩ ← Result.attach $f) - --- We call the hypothesis `h`, in effect making it unavailable to the user --- (because too much shadowing). But in practice, once can use the French single --- quote notation (input with f< and f>), where `‹ h ›` finds a suitable --- hypothesis in the context, this is equivalent to `have x: h := by assumption in x` -#eval do - let y <-- .ret (0: Nat) - let _: y = 0 := by cases ‹ ret 0 = ret y › ; decide - let r: { x: Nat // x = 0 } := ⟨ y, by assumption ⟩ - .ret r - ----------------------- --- MACHINE INTEGERS -- ----------------------- - --- We redefine our machine integers types. - --- For Isize/Usize, we reuse `getNumBits` from `USize`. You cannot reduce `getNumBits` --- using the simplifier, meaning that proofs do not depend on the compile-time value of --- USize.size. (Lean assumes 32 or 64-bit platforms, and Rust doesn't really support, at --- least officially, 16-bit microcontrollers, so this seems like a fine design decision --- for now.) - --- Note from Chris Bailey: "If there's more than one salient property of your --- definition then the subtyping strategy might get messy, and the property part --- of a subtype is less discoverable by the simplifier or tactics like --- library_search." So, we will not add refinements on the return values of the --- operations defined on Primitives, but will rather rely on custom lemmas to --- invert on possible return values of the primitive operations. - --- Machine integer constants, done via `ofNatCore`, which requires a proof that --- the `Nat` fits within the desired integer type. We provide a custom tactic. - -open System.Platform.getNumBits - --- TODO: is there a way of only importing System.Platform.getNumBits? --- -@[simp] def size_num_bits : Nat := (System.Platform.getNumBits ()).val - --- Remark: Lean seems to use < for the comparisons with the upper bounds by convention. --- We keep the F* convention for now. -@[simp] def Isize.min : Int := - (HPow.hPow 2 (size_num_bits - 1)) -@[simp] def Isize.max : Int := (HPow.hPow 2 (size_num_bits - 1)) - 1 -@[simp] def I8.min : Int := - (HPow.hPow 2 7) -@[simp] def I8.max : Int := HPow.hPow 2 7 - 1 -@[simp] def I16.min : Int := - (HPow.hPow 2 15) -@[simp] def I16.max : Int := HPow.hPow 2 15 - 1 -@[simp] def I32.min : Int := -(HPow.hPow 2 31) -@[simp] def I32.max : Int := HPow.hPow 2 31 - 1 -@[simp] def I64.min : Int := -(HPow.hPow 2 63) -@[simp] def I64.max : Int := HPow.hPow 2 63 - 1 -@[simp] def I128.min : Int := -(HPow.hPow 2 127) -@[simp] def I128.max : Int := HPow.hPow 2 127 - 1 -@[simp] def Usize.min : Int := 0 -@[simp] def Usize.max : Int := HPow.hPow 2 size_num_bits - 1 -@[simp] def U8.min : Int := 0 -@[simp] def U8.max : Int := HPow.hPow 2 8 - 1 -@[simp] def U16.min : Int := 0 -@[simp] def U16.max : Int := HPow.hPow 2 16 - 1 -@[simp] def U32.min : Int := 0 -@[simp] def U32.max : Int := HPow.hPow 2 32 - 1 -@[simp] def U64.min : Int := 0 -@[simp] def U64.max : Int := HPow.hPow 2 64 - 1 -@[simp] def U128.min : Int := 0 -@[simp] def U128.max : Int := HPow.hPow 2 128 - 1 - -#assert (I8.min == -128) -#assert (I8.max == 127) -#assert (I16.min == -32768) -#assert (I16.max == 32767) -#assert (I32.min == -2147483648) -#assert (I32.max == 2147483647) -#assert (I64.min == -9223372036854775808) -#assert (I64.max == 9223372036854775807) -#assert (I128.min == -170141183460469231731687303715884105728) -#assert (I128.max == 170141183460469231731687303715884105727) -#assert (U8.min == 0) -#assert (U8.max == 255) -#assert (U16.min == 0) -#assert (U16.max == 65535) -#assert (U32.min == 0) -#assert (U32.max == 4294967295) -#assert (U64.min == 0) -#assert (U64.max == 18446744073709551615) -#assert (U128.min == 0) -#assert (U128.max == 340282366920938463463374607431768211455) - -inductive ScalarTy := -| Isize -| I8 -| I16 -| I32 -| I64 -| I128 -| Usize -| U8 -| U16 -| U32 -| U64 -| U128 - -def Scalar.min (ty : ScalarTy) : Int := - match ty with - | .Isize => Isize.min - | .I8 => I8.min - | .I16 => I16.min - | .I32 => I32.min - | .I64 => I64.min - | .I128 => I128.min - | .Usize => Usize.min - | .U8 => U8.min - | .U16 => U16.min - | .U32 => U32.min - | .U64 => U64.min - | .U128 => U128.min - -def Scalar.max (ty : ScalarTy) : Int := - match ty with - | .Isize => Isize.max - | .I8 => I8.max - | .I16 => I16.max - | .I32 => I32.max - | .I64 => I64.max - | .I128 => I128.max - | .Usize => Usize.max - | .U8 => U8.max - | .U16 => U16.max - | .U32 => U32.max - | .U64 => U64.max - | .U128 => U128.max - --- "Conservative" bounds --- We use those because we can't compare to the isize bounds (which can't --- reduce at compile-time). Whenever we perform an arithmetic operation like --- addition we need to check that the result is in bounds: we first compare --- to the conservative bounds, which reduce, then compare to the real bounds. --- This is useful for the various #asserts that we want to reduce at --- type-checking time. -def Scalar.cMin (ty : ScalarTy) : Int := - match ty with - | .Isize => I32.min - | _ => Scalar.min ty - -def Scalar.cMax (ty : ScalarTy) : Int := - match ty with - | .Isize => I32.max - | .Usize => U32.max - | _ => Scalar.max ty - -theorem Scalar.cMin_bound ty : Scalar.min ty <= Scalar.cMin ty := by sorry -theorem Scalar.cMax_bound ty : Scalar.min ty <= Scalar.cMin ty := by sorry - -structure Scalar (ty : ScalarTy) where - val : Int - hmin : Scalar.min ty <= val - hmax : val <= Scalar.max ty - -theorem Scalar.bound_suffices (ty : ScalarTy) (x : Int) : - Scalar.cMin ty <= x && x <= Scalar.cMax ty -> - (decide (Scalar.min ty ≤ x) && decide (x ≤ Scalar.max ty)) = true - := by sorry - -def Scalar.ofIntCore {ty : ScalarTy} (x : Int) - (hmin : Scalar.min ty <= x) (hmax : x <= Scalar.max ty) : Scalar ty := - { val := x, hmin := hmin, hmax := hmax } - -def Scalar.ofInt {ty : ScalarTy} (x : Int) - (h : Scalar.min ty <= x && x <= Scalar.max ty) : Scalar ty := - let hmin: Scalar.min ty <= x := by sorry - let hmax: x <= Scalar.max ty := by sorry - Scalar.ofIntCore x hmin hmax - --- Further thoughts: look at what has been done here: --- https://github.com/leanprover-community/mathlib4/blob/master/Mathlib/Data/Fin/Basic.lean --- and --- https://github.com/leanprover-community/mathlib4/blob/master/Mathlib/Data/UInt.lean --- which both contain a fair amount of reasoning already! -def Scalar.tryMk (ty : ScalarTy) (x : Int) : Result (Scalar ty) := - -- TODO: write this with only one if then else - if hmin_cons: Scalar.cMin ty <= x || Scalar.min ty <= x then - if hmax_cons: x <= Scalar.cMax ty || x <= Scalar.max ty then - let hmin: Scalar.min ty <= x := by sorry - let hmax: x <= Scalar.max ty := by sorry - return Scalar.ofIntCore x hmin hmax - else fail integerOverflow - else fail integerOverflow - -def Scalar.neg {ty : ScalarTy} (x : Scalar ty) : Result (Scalar ty) := Scalar.tryMk ty (- x.val) - -def Scalar.div {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - if y.val != 0 then Scalar.tryMk ty (x.val / y.val) else fail divisionByZero - --- Checking that the % operation in Lean computes the same as the remainder operation in Rust -#assert 1 % 2 = (1:Int) -#assert (-1) % 2 = -1 -#assert 1 % (-2) = 1 -#assert (-1) % (-2) = -1 - -def Scalar.rem {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - if y.val != 0 then Scalar.tryMk ty (x.val % y.val) else fail divisionByZero - -def Scalar.add {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - Scalar.tryMk ty (x.val + y.val) - -def Scalar.sub {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - Scalar.tryMk ty (x.val - y.val) - -def Scalar.mul {ty : ScalarTy} (x : Scalar ty) (y : Scalar ty) : Result (Scalar ty) := - Scalar.tryMk ty (x.val * y.val) - --- TODO: instances of +, -, * etc. for scalars - --- Cast an integer from a [src_ty] to a [tgt_ty] --- TODO: check the semantics of casts in Rust -def Scalar.cast {src_ty : ScalarTy} (tgt_ty : ScalarTy) (x : Scalar src_ty) : Result (Scalar tgt_ty) := - Scalar.tryMk tgt_ty x.val - --- The scalar types --- We declare the definitions as reducible so that Lean can unfold them (useful --- for type class resolution for instance). -@[reducible] def Isize := Scalar .Isize -@[reducible] def I8 := Scalar .I8 -@[reducible] def I16 := Scalar .I16 -@[reducible] def I32 := Scalar .I32 -@[reducible] def I64 := Scalar .I64 -@[reducible] def I128 := Scalar .I128 -@[reducible] def Usize := Scalar .Usize -@[reducible] def U8 := Scalar .U8 -@[reducible] def U16 := Scalar .U16 -@[reducible] def U32 := Scalar .U32 -@[reducible] def U64 := Scalar .U64 -@[reducible] def U128 := Scalar .U128 - --- TODO: below: not sure this is the best way. --- Should we rather overload operations like +, -, etc.? --- Also, it is possible to automate the generation of those definitions --- with macros (but would it be a good idea? It would be less easy to --- read the file, which is not supposed to change a lot) - --- Negation - -/-- -Remark: there is no heterogeneous negation in the Lean prelude: we thus introduce -one here. - -The notation typeclass for heterogeneous addition. -This enables the notation `- a : β` where `a : α`. --/ -class HNeg (α : Type u) (β : outParam (Type v)) where - /-- `- a` computes the negation of `a`. - The meaning of this notation is type-dependent. -/ - hNeg : α → β - -prefix:75 "-" => HNeg.hNeg - -instance : HNeg Isize (Result Isize) where hNeg x := Scalar.neg x -instance : HNeg I8 (Result I8) where hNeg x := Scalar.neg x -instance : HNeg I16 (Result I16) where hNeg x := Scalar.neg x -instance : HNeg I32 (Result I32) where hNeg x := Scalar.neg x -instance : HNeg I64 (Result I64) where hNeg x := Scalar.neg x -instance : HNeg I128 (Result I128) where hNeg x := Scalar.neg x - --- Addition -instance {ty} : HAdd (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hAdd x y := Scalar.add x y - --- Substraction -instance {ty} : HSub (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hSub x y := Scalar.sub x y - --- Multiplication -instance {ty} : HMul (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hMul x y := Scalar.mul x y - --- Division -instance {ty} : HDiv (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hDiv x y := Scalar.div x y - --- Remainder -instance {ty} : HMod (Scalar ty) (Scalar ty) (Result (Scalar ty)) where - hMod x y := Scalar.rem x y - --- ofIntCore --- TODO: typeclass? -def Isize.ofIntCore := @Scalar.ofIntCore .Isize -def I8.ofIntCore := @Scalar.ofIntCore .I8 -def I16.ofIntCore := @Scalar.ofIntCore .I16 -def I32.ofIntCore := @Scalar.ofIntCore .I32 -def I64.ofIntCore := @Scalar.ofIntCore .I64 -def I128.ofIntCore := @Scalar.ofIntCore .I128 -def Usize.ofIntCore := @Scalar.ofIntCore .Usize -def U8.ofIntCore := @Scalar.ofIntCore .U8 -def U16.ofIntCore := @Scalar.ofIntCore .U16 -def U32.ofIntCore := @Scalar.ofIntCore .U32 -def U64.ofIntCore := @Scalar.ofIntCore .U64 -def U128.ofIntCore := @Scalar.ofIntCore .U128 - --- ofInt --- TODO: typeclass? -def Isize.ofInt := @Scalar.ofInt .Isize -def I8.ofInt := @Scalar.ofInt .I8 -def I16.ofInt := @Scalar.ofInt .I16 -def I32.ofInt := @Scalar.ofInt .I32 -def I64.ofInt := @Scalar.ofInt .I64 -def I128.ofInt := @Scalar.ofInt .I128 -def Usize.ofInt := @Scalar.ofInt .Usize -def U8.ofInt := @Scalar.ofInt .U8 -def U16.ofInt := @Scalar.ofInt .U16 -def U32.ofInt := @Scalar.ofInt .U32 -def U64.ofInt := @Scalar.ofInt .U64 -def U128.ofInt := @Scalar.ofInt .U128 - --- Comparisons -instance {ty} : LT (Scalar ty) where - lt a b := LT.lt a.val b.val - -instance {ty} : LE (Scalar ty) where le a b := LE.le a.val b.val - -instance Scalar.decLt {ty} (a b : Scalar ty) : Decidable (LT.lt a b) := Int.decLt .. -instance Scalar.decLe {ty} (a b : Scalar ty) : Decidable (LE.le a b) := Int.decLe .. - -theorem Scalar.eq_of_val_eq {ty} : ∀ {i j : Scalar ty}, Eq i.val j.val → Eq i j - | ⟨_, _, _⟩, ⟨_, _, _⟩, rfl => rfl - -theorem Scalar.val_eq_of_eq {ty} {i j : Scalar ty} (h : Eq i j) : Eq i.val j.val := - h ▸ rfl - -theorem Scalar.ne_of_val_ne {ty} {i j : Scalar ty} (h : Not (Eq i.val j.val)) : Not (Eq i j) := - fun h' => absurd (val_eq_of_eq h') h - -instance (ty : ScalarTy) : DecidableEq (Scalar ty) := - fun i j => - match decEq i.val j.val with - | isTrue h => isTrue (Scalar.eq_of_val_eq h) - | isFalse h => isFalse (Scalar.ne_of_val_ne h) - -def Scalar.toInt {ty} (n : Scalar ty) : Int := n.val - --- Tactic to prove that integers are in bounds -syntax "intlit" : tactic - -macro_rules - | `(tactic| intlit) => `(tactic| apply Scalar.bound_suffices ; decide) - --- -- We now define a type class that subsumes the various machine integer types, so --- -- as to write a concise definition for scalar_cast, rather than exhaustively --- -- enumerating all of the possible pairs. We remark that Rust has sane semantics --- -- and fails if a cast operation would involve a truncation or modulo. - --- class MachineInteger (t: Type) where --- size: Nat --- val: t -> Fin size --- ofNatCore: (n:Nat) -> LT.lt n size -> t - --- set_option hygiene false in --- run_cmd --- for typeName in [`UInt8, `UInt16, `UInt32, `UInt64, `USize].map Lean.mkIdent do --- Lean.Elab.Command.elabCommand (← `( --- namespace $typeName --- instance: MachineInteger $typeName where --- size := size --- val := val --- ofNatCore := ofNatCore --- end $typeName --- )) - --- -- Aeneas only instantiates the destination type (`src` is implicit). We rely on --- -- Lean to infer `src`. - --- def scalar_cast { src: Type } (dst: Type) [ MachineInteger src ] [ MachineInteger dst ] (x: src): Result dst := --- if h: MachineInteger.val x < MachineInteger.size dst then --- .ret (MachineInteger.ofNatCore (MachineInteger.val x).val h) --- else --- .fail integerOverflow - -------------- --- VECTORS -- -------------- - -def Vec (α : Type u) := { l : List α // List.length l <= Usize.max } - -def vec_new (α : Type u): Vec α := ⟨ [], by sorry ⟩ - -def vec_len (α : Type u) (v : Vec α) : Usize := - let ⟨ v, l ⟩ := v - Usize.ofIntCore (List.length v) (by sorry) l - -def vec_push_fwd (α : Type u) (_ : Vec α) (_ : α) : Unit := () - -def vec_push_back (α : Type u) (v : Vec α) (x : α) : Result (Vec α) - := - if h : List.length v.val <= U32.max || List.length v.val <= Usize.max then - return ⟨ List.concat v.val x, by sorry ⟩ - else - fail maximumSizeExceeded - -def vec_insert_fwd (α : Type u) (v: Vec α) (i: Usize) (_: α): Result Unit := - if i.val < List.length v.val then - .ret () - else - .fail arrayOutOfBounds - -def vec_insert_back (α : Type u) (v: Vec α) (i: Usize) (x: α): Result (Vec α) := - if i.val < List.length v.val then - -- TODO: maybe we should redefine a list library which uses integers - -- (instead of natural numbers) - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - .ret ⟨ List.set v.val i.val x, by - have h: List.length v.val <= Usize.max := v.property - rewrite [ List.length_set v.val i.val x ] - assumption - ⟩ - else - .fail arrayOutOfBounds - -def vec_index_fwd (α : Type u) (v: Vec α) (i: Usize): Result α := - if i.val < List.length v.val then - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - let h: i < List.length v.val := by sorry - .ret (List.get v.val ⟨i.val, h⟩) - else - .fail arrayOutOfBounds - -def vec_index_back (α : Type u) (v: Vec α) (i: Usize) (_: α): Result Unit := - if i.val < List.length v.val then - .ret () - else - .fail arrayOutOfBounds - -def vec_index_mut_fwd (α : Type u) (v: Vec α) (i: Usize): Result α := - if i.val < List.length v.val then - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - let h: i < List.length v.val := by sorry - .ret (List.get v.val ⟨i.val, h⟩) - else - .fail arrayOutOfBounds - -def vec_index_mut_back (α : Type u) (v: Vec α) (i: Usize) (x: α): Result (Vec α) := - if i.val < List.length v.val then - let i : Nat := - match i.val with - | .ofNat n => n - | .negSucc n => by sorry -- TODO: we can't get here - let isLt: i < USize.size := by sorry - let i : Fin USize.size := { val := i, isLt := isLt } - .ret ⟨ List.set v.val i.val x, by - have h: List.length v.val <= Usize.max := v.property - rewrite [ List.length_set v.val i.val x ] - assumption - ⟩ - else - .fail arrayOutOfBounds - ----------- --- MISC -- ----------- - -def mem_replace_fwd (a : Type) (x : a) (_ : a) : a := - x - -def mem_replace_back (a : Type) (_ : a) (y : a) : a := - y - -/-- Aeneas-translated function -- useful to reduce non-recursive definitions. - Use with `simp [ aeneas ]` -/ -register_simp_attr aeneas diff --git a/tests/lean/misc-polonius_list/lake-manifest.json b/tests/lean/misc-polonius_list/lake-manifest.json deleted file mode 100644 index 57b071ca..00000000 --- a/tests/lean/misc-polonius_list/lake-manifest.json +++ /dev/null @@ -1,27 +0,0 @@ -{"version": 4, - "packagesDir": "./lake-packages", - "packages": - [{"git": - {"url": "https://github.com/leanprover-community/mathlib4.git", - "subDir?": null, - "rev": "4037792ead804d7bfa8868e2c4684d4223c15ece", - "name": "mathlib", - "inputRev?": null}}, - {"git": - {"url": "https://github.com/gebner/quote4", - "subDir?": null, - "rev": "2412c4fdf4a8b689f4467618e5e7b371ae5014aa", - "name": "Qq", - "inputRev?": "master"}}, - {"git": - {"url": "https://github.com/JLimperg/aesop", - "subDir?": null, - "rev": "7fe9ecd9339b0e1796e89d243b776849c305c690", - "name": "aesop", - "inputRev?": "master"}}, - {"git": - {"url": "https://github.com/leanprover/std4", - "subDir?": null, - "rev": "24897887905b3a1254b244369f5dd2cf6174b0ee", - "name": "std", - "inputRev?": "main"}}]} diff --git a/tests/lean/misc-polonius_list/lakefile.lean b/tests/lean/misc-polonius_list/lakefile.lean deleted file mode 100644 index e89d4259..00000000 --- a/tests/lean/misc-polonius_list/lakefile.lean +++ /dev/null @@ -1,12 +0,0 @@ -import Lake -open Lake DSL - -require mathlib from git - "https://github.com/leanprover-community/mathlib4.git" - -package «polonius_list» {} - -lean_lib «Base» {} - -@[default_target] -lean_lib «PoloniusList» {} diff --git a/tests/lean/misc-polonius_list/lean-toolchain b/tests/lean/misc-polonius_list/lean-toolchain deleted file mode 100644 index bbf57f10..00000000 --- a/tests/lean/misc-polonius_list/lean-toolchain +++ /dev/null @@ -1 +0,0 @@ -leanprover/lean4:nightly-2023-01-21 |