From 084480c807b58947b8487eb3a7c6a71bb388a832 Mon Sep 17 00:00:00 2001 From: Escherichia Date: Wed, 3 Apr 2024 17:01:27 +0200 Subject: added Error and EError to expressions and propagated related changes --- compiler/Errors.ml | 5 +++-- compiler/Extract.ml | 8 ++++++++ compiler/ExtractBase.ml | 4 +++- compiler/ExtractTypes.ml | 1 + compiler/Interpreter.ml | 3 ++- compiler/PrintPure.ml | 4 ++++ compiler/Pure.ml | 8 ++++++++ compiler/PureMicroPasses.ml | 4 +++- compiler/PureTypeCheck.ml | 1 + compiler/PureUtils.ml | 3 +++ compiler/SymbolicAst.ml | 1 + compiler/SymbolicToPure.ml | 4 ++++ 12 files changed, 41 insertions(+), 5 deletions(-) diff --git a/compiler/Errors.ml b/compiler/Errors.ml index 53e56c44..30887593 100644 --- a/compiler/Errors.ml +++ b/compiler/Errors.ml @@ -1,6 +1,7 @@ let log = Logging.errors_log -let meta_to_string (span : Meta.span) = +let meta_to_string (meta : Meta.meta) = + let span = meta.span in let file = match span.file with Virtual s | Local s -> s in let loc_to_string (l : Meta.loc) : string = string_of_int l.line ^ ":" ^ string_of_int l.col @@ -10,7 +11,7 @@ let meta_to_string (span : Meta.span) = let format_error_message (meta : Meta.meta option) (msg : string) = let meta = - match meta with None -> "" | Some meta -> "\n" ^ meta_to_string meta.span + match meta with None -> "" | Some meta -> "\n" ^ meta_to_string meta in msg ^ meta diff --git a/compiler/Extract.ml b/compiler/Extract.ml index 1f9c9117..ef5d5dce 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -297,6 +297,13 @@ let lets_require_wrap_in_do (meta : Meta.meta) - application argument: [f (exp)] - match/if scrutinee: [if exp then _ else _]/[match exp | _ -> _] *) + +let extract_errors (fmt : F.formatter) = + match !Config.backend with + | FStar | Coq -> F.pp_print_string fmt "admit" + | Lean -> F.pp_print_string fmt "sorry" + | HOL4 -> F.pp_print_string fmt "(* ERROR: could not generate the code *)" + let rec extract_texpression (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) (inside : bool) (e : texpression) : unit = match e.e with @@ -323,6 +330,7 @@ let rec extract_texpression (meta : Meta.meta) (ctx : extraction_ctx) | Loop _ -> (* The loop nodes should have been eliminated in {!PureMicroPasses} *) craise __FILE__ __LINE__ meta "Unreachable" + | EError (_, _) -> extract_errors fmt (* Extract an application *or* a top-level qualif (function extraction has * to handle top-level qualifiers, so it seemed more natural to merge the diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml index 74ac9e32..faca2bde 100644 --- a/compiler/ExtractBase.ml +++ b/compiler/ExtractBase.ml @@ -1700,7 +1700,9 @@ let ctx_compute_var_basename (meta : Meta.meta) (ctx : extraction_ctx) | TLiteral lty -> ( match lty with TBool -> "b" | TChar -> "c" | TInteger _ -> "i") | TArrow _ -> "f" - | TTraitType (_, name) -> name_from_type_ident name) + | TTraitType (_, name) -> name_from_type_ident name + | Error -> "@Error") +(* TODO : Check*) (** Generates a type variable basename. *) let ctx_compute_type_var_basename (_ctx : extraction_ctx) (basename : string) : diff --git a/compiler/ExtractTypes.ml b/compiler/ExtractTypes.ml index 1f0abf8a..350866e9 100644 --- a/compiler/ExtractTypes.ml +++ b/compiler/ExtractTypes.ml @@ -566,6 +566,7 @@ let rec extract_ty (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) "Trait types are not supported yet when generating code for HOL4"; extract_trait_ref meta ctx fmt no_params_tys false trait_ref; F.pp_print_string fmt ("." ^ add_brackets type_name)) + | Error -> craise __FILE__ __LINE__ meta "TODO: Error message?" and extract_trait_ref (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) (no_params_tys : TypeDeclId.Set.t) (inside : bool) diff --git a/compiler/Interpreter.ml b/compiler/Interpreter.ml index a65e1663..d0a54750 100644 --- a/compiler/Interpreter.ml +++ b/compiler/Interpreter.ml @@ -612,7 +612,8 @@ let evaluate_function_symbolic (synthesize : bool) (ctx : decls_ctx) (* Evaluate the function *) let symbolic = - eval_function_body config (Option.get fdef.body).body cf_finish ctx + try eval_function_body config (Option.get fdef.body).body cf_finish ctx + with CFailure (meta, msg) -> Some (Error (meta, msg)) in (* Return *) diff --git a/compiler/PrintPure.ml b/compiler/PrintPure.ml index d0c243bb..12d554f2 100644 --- a/compiler/PrintPure.ml +++ b/compiler/PrintPure.ml @@ -164,6 +164,7 @@ let rec ty_to_string (env : fmt_env) (inside : bool) (ty : ty) : string = let trait_ref = trait_ref_to_string env false trait_ref in let s = trait_ref ^ "::" ^ type_name in if inside then "(" ^ s ^ ")" else s + | Error -> "@Error" and generic_args_to_strings (env : fmt_env) (inside : bool) (generics : generic_args) : string list = @@ -615,6 +616,9 @@ let rec texpression_to_string ?(metadata : Meta.meta option = None) let e = meta_s ^ "\n" ^ indent ^ e in if inside then "(" ^ e ^ ")" else e | MPlace _ -> "(" ^ meta_s ^ " " ^ e ^ ")") + | EError (meta, msg) -> + if Option.is_none meta then msg + else meta_to_string (Option.get meta) ^ " " ^ msg (* TODO formatting *) and app_to_string ?(meta : Meta.meta option = None) (env : fmt_env) (inside : bool) (indent : string) (indent_incr : string) (app : texpression) diff --git a/compiler/Pure.ml b/compiler/Pure.ml index 7de7e0f4..7366783c 100644 --- a/compiler/Pure.ml +++ b/compiler/Pure.ml @@ -285,6 +285,7 @@ type ty = | TArrow of ty * ty | TTraitType of trait_ref * string (** The string is for the name of the associated type *) + | Error and trait_ref = { trait_id : trait_instance_id; @@ -621,6 +622,7 @@ class ['self] iter_expression_base = method visit_qualif : 'env -> qualif -> unit = fun _ _ -> () method visit_loop_id : 'env -> loop_id -> unit = fun _ _ -> () method visit_field_id : 'env -> field_id -> unit = fun _ _ -> () + method visit_meta : 'env -> Meta.meta -> unit = fun _ _ -> () end (** Ancestor for {!map_expression} visitor *) @@ -632,6 +634,7 @@ class ['self] map_expression_base = method visit_qualif : 'env -> qualif -> qualif = fun _ x -> x method visit_loop_id : 'env -> loop_id -> loop_id = fun _ x -> x method visit_field_id : 'env -> field_id -> field_id = fun _ x -> x + method visit_meta : 'env -> Meta.meta -> Meta.meta = fun _ x -> x end (** Ancestor for {!reduce_expression} visitor *) @@ -643,6 +646,7 @@ class virtual ['self] reduce_expression_base = method visit_qualif : 'env -> qualif -> 'a = fun _ _ -> self#zero method visit_loop_id : 'env -> loop_id -> 'a = fun _ _ -> self#zero method visit_field_id : 'env -> field_id -> 'a = fun _ _ -> self#zero + method visit_meta : 'env -> Meta.meta -> 'a = fun _ _ -> self#zero end (** Ancestor for {!mapreduce_expression} visitor *) @@ -662,6 +666,9 @@ class virtual ['self] mapreduce_expression_base = method visit_field_id : 'env -> field_id -> field_id * 'a = fun _ x -> (x, self#zero) + + method visit_meta : 'env -> Meta.meta -> Meta.meta * 'a = + fun _ x -> (x, self#zero) end (** **Rk.:** here, {!expression} is not at all equivalent to the expressions @@ -726,6 +733,7 @@ type expression = | Loop of loop (** See the comments for {!loop} *) | StructUpdate of struct_update (** See the comments for {!struct_update} *) | Meta of (emeta[@opaque]) * texpression (** Meta-information *) + | EError of Meta.meta option * string and switch_body = If of texpression * texpression | Match of match_branch list and match_branch = { pat : typed_pattern; branch : texpression } diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml index 9fa07029..ebc5c65f 100644 --- a/compiler/PureMicroPasses.ml +++ b/compiler/PureMicroPasses.ml @@ -416,6 +416,7 @@ let compute_pretty_names (def : fun_decl) : fun_decl = | StructUpdate supd -> update_struct_update supd ctx | Lambda (lb, e) -> update_lambda lb e ctx | Meta (meta, e) -> update_emeta meta e ctx + | EError (meta, msg) -> (ctx, EError (meta, msg)) in (ctx, { e; ty }) (* *) @@ -1006,7 +1007,8 @@ let filter_useless (_ctx : trans_ctx) (def : fun_decl) : fun_decl = match e with | Var _ | CVar _ | Const _ | App _ | Qualif _ | Meta (_, _) - | StructUpdate _ | Lambda _ -> + | StructUpdate _ | Lambda _ + | EError (_, _) -> super#visit_expression env e | Switch (scrut, switch) -> ( match switch with diff --git a/compiler/PureTypeCheck.ml b/compiler/PureTypeCheck.ml index 53ff8983..098e2564 100644 --- a/compiler/PureTypeCheck.ml +++ b/compiler/PureTypeCheck.ml @@ -238,3 +238,4 @@ let rec check_texpression (meta : Meta.meta) (ctx : tc_ctx) (e : texpression) : | Meta (_, e_next) -> sanity_check __FILE__ __LINE__ (e_next.ty = e.ty) meta; check_texpression meta ctx e_next + | EError (meta, msg) -> craise_opt_meta __FILE__ __LINE__ meta msg diff --git a/compiler/PureUtils.ml b/compiler/PureUtils.ml index 4bc90872..87f0b5f7 100644 --- a/compiler/PureUtils.ml +++ b/compiler/PureUtils.ml @@ -228,6 +228,9 @@ let rec let_group_requires_parentheses (meta : Meta.meta) (e : texpression) : | Loop _ -> (* Should have been eliminated *) craise __FILE__ __LINE__ meta "Unreachable" + | EError (meta, msg) -> + craise_opt_meta __FILE__ __LINE__ meta + msg (* TODO : check if true should'nt be returned instead ? *) let texpression_requires_parentheses meta e = match !Config.backend with diff --git a/compiler/SymbolicAst.ml b/compiler/SymbolicAst.ml index e164fd49..f15a2c23 100644 --- a/compiler/SymbolicAst.ml +++ b/compiler/SymbolicAst.ml @@ -212,6 +212,7 @@ type expression = TODO: merge this with Return. *) | Meta of emeta * expression (** Meta information *) + | Error of Meta.meta option * string and loop = { loop_id : loop_id; diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 0c30f44c..1701891f 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -1963,6 +1963,9 @@ let eval_ctx_to_symbolic_assignments_info (ctx : bs_ctx) (* Return the computed information *) !info +let translate_meta (meta : Meta.meta option) (msg : string) : texpression = + { e = EError (meta, msg); ty = Error } + let rec translate_expression (e : S.expression) (ctx : bs_ctx) : texpression = match e with | S.Return (ectx, opt_v) -> @@ -1989,6 +1992,7 @@ let rec translate_expression (e : S.expression) (ctx : bs_ctx) : texpression = *) translate_forward_end ectx loop_input_values e back_e ctx | Loop loop -> translate_loop loop ctx + | Error (meta, msg) -> translate_meta meta msg and translate_panic (ctx : bs_ctx) : texpression = (* Here we use the function return type - note that it is ok because -- cgit v1.2.3 From a2a219145587deb0ade9fa7d60171765cd722162 Mon Sep 17 00:00:00 2001 From: Escherichia Date: Wed, 3 Apr 2024 17:36:09 +0200 Subject: added extract_ty_errors and extract_texpression_errors to deal with the error case in their respective types --- compiler/Extract.ml | 4 ++-- compiler/ExtractTypes.ml | 9 ++++++++- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/compiler/Extract.ml b/compiler/Extract.ml index ef5d5dce..af0bf98d 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -298,7 +298,7 @@ let lets_require_wrap_in_do (meta : Meta.meta) - match/if scrutinee: [if exp then _ else _]/[match exp | _ -> _] *) -let extract_errors (fmt : F.formatter) = +let extract_texpression_errors (fmt : F.formatter) = match !Config.backend with | FStar | Coq -> F.pp_print_string fmt "admit" | Lean -> F.pp_print_string fmt "sorry" @@ -330,7 +330,7 @@ let rec extract_texpression (meta : Meta.meta) (ctx : extraction_ctx) | Loop _ -> (* The loop nodes should have been eliminated in {!PureMicroPasses} *) craise __FILE__ __LINE__ meta "Unreachable" - | EError (_, _) -> extract_errors fmt + | EError (_, _) -> extract_texpression_errors fmt (* Extract an application *or* a top-level qualif (function extraction has * to handle top-level qualifiers, so it seemed more natural to merge the diff --git a/compiler/ExtractTypes.ml b/compiler/ExtractTypes.ml index 350866e9..1c3657a3 100644 --- a/compiler/ExtractTypes.ml +++ b/compiler/ExtractTypes.ml @@ -433,6 +433,13 @@ let extract_literal_type (_ctx : extraction_ctx) (fmt : F.formatter) End ]} *) + +let extract_ty_errors (fmt : F.formatter) : unit = + match !Config.backend with + | FStar | Coq -> F.pp_print_string fmt "admit" + | Lean -> F.pp_print_string fmt "sorry" + | HOL4 -> F.pp_print_string fmt "(* ERROR: could not generate the code *)" + let rec extract_ty (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) (no_params_tys : TypeDeclId.Set.t) (inside : bool) (ty : ty) : unit = let extract_rec = extract_ty meta ctx fmt no_params_tys in @@ -566,7 +573,7 @@ let rec extract_ty (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) "Trait types are not supported yet when generating code for HOL4"; extract_trait_ref meta ctx fmt no_params_tys false trait_ref; F.pp_print_string fmt ("." ^ add_brackets type_name)) - | Error -> craise __FILE__ __LINE__ meta "TODO: Error message?" + | Error -> extract_ty_errors fmt and extract_trait_ref (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) (no_params_tys : TypeDeclId.Set.t) (inside : bool) -- cgit v1.2.3 From e9bbac75812ef556585f14b72239133619cf1748 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Wed, 3 Apr 2024 17:49:00 +0200 Subject: Update the initial configuration --- compiler/Config.ml | 2 +- compiler/Main.ml | 3 --- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/compiler/Config.ml b/compiler/Config.ml index 099cdc8b..0b26e2ef 100644 --- a/compiler/Config.ml +++ b/compiler/Config.ml @@ -368,4 +368,4 @@ let backend_has_tuple_projectors () = let use_nested_tuple_projectors = ref false (** Generate name patterns for the external definitions we encounter *) -let extract_external_name_patterns = ref false +let extract_external_name_patterns = ref true diff --git a/compiler/Main.ml b/compiler/Main.ml index 64d8ae2b..db200f37 100644 --- a/compiler/Main.ml +++ b/compiler/Main.ml @@ -120,9 +120,6 @@ let () = Arg.Set use_nested_tuple_projectors, " Use nested projectors for tuples (e.g., (0, 1).snd.fst instead of \ (0, 1).1)." ); - ( "-ext-name-pats", - Arg.Set extract_external_name_patterns, - " Generate name patterns for the external definitions we find." ); ] in -- cgit v1.2.3 From 78cc58e3076ffd61add6d78b64371b6eb36d6ab2 Mon Sep 17 00:00:00 2001 From: Escherichia Date: Wed, 3 Apr 2024 17:52:10 +0200 Subject: resolved requested changes --- compiler/ExtractBase.ml | 2 +- compiler/PrintPure.ml | 4 +--- compiler/SymbolicToPure.ml | 4 ++-- 3 files changed, 4 insertions(+), 6 deletions(-) diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml index faca2bde..e399a89c 100644 --- a/compiler/ExtractBase.ml +++ b/compiler/ExtractBase.ml @@ -1701,7 +1701,7 @@ let ctx_compute_var_basename (meta : Meta.meta) (ctx : extraction_ctx) match lty with TBool -> "b" | TChar -> "c" | TInteger _ -> "i") | TArrow _ -> "f" | TTraitType (_, name) -> name_from_type_ident name - | Error -> "@Error") + | Error -> "x") (* TODO : Check*) (** Generates a type variable basename. *) diff --git a/compiler/PrintPure.ml b/compiler/PrintPure.ml index 12d554f2..97ea6048 100644 --- a/compiler/PrintPure.ml +++ b/compiler/PrintPure.ml @@ -616,9 +616,7 @@ let rec texpression_to_string ?(metadata : Meta.meta option = None) let e = meta_s ^ "\n" ^ indent ^ e in if inside then "(" ^ e ^ ")" else e | MPlace _ -> "(" ^ meta_s ^ " " ^ e ^ ")") - | EError (meta, msg) -> - if Option.is_none meta then msg - else meta_to_string (Option.get meta) ^ " " ^ msg (* TODO formatting *) + | EError (_, _) -> "@Error" and app_to_string ?(meta : Meta.meta option = None) (env : fmt_env) (inside : bool) (indent : string) (indent_incr : string) (app : texpression) diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 1701891f..53ab1c08 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -1963,7 +1963,7 @@ let eval_ctx_to_symbolic_assignments_info (ctx : bs_ctx) (* Return the computed information *) !info -let translate_meta (meta : Meta.meta option) (msg : string) : texpression = +let translate_error (meta : Meta.meta option) (msg : string) : texpression = { e = EError (meta, msg); ty = Error } let rec translate_expression (e : S.expression) (ctx : bs_ctx) : texpression = @@ -1992,7 +1992,7 @@ let rec translate_expression (e : S.expression) (ctx : bs_ctx) : texpression = *) translate_forward_end ectx loop_input_values e back_e ctx | Loop loop -> translate_loop loop ctx - | Error (meta, msg) -> translate_meta meta msg + | Error (meta, msg) -> translate_error meta msg and translate_panic (ctx : bs_ctx) : texpression = (* Here we use the function return type - note that it is ok because -- cgit v1.2.3 From cc0b77e4b75990916e331e9ff5c26c912341b13d Mon Sep 17 00:00:00 2001 From: Escherichia Date: Wed, 3 Apr 2024 17:58:10 +0200 Subject: resolved requested changes --- compiler/ExtractBase.ml | 1 - 1 file changed, 1 deletion(-) diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml index e399a89c..ba75f580 100644 --- a/compiler/ExtractBase.ml +++ b/compiler/ExtractBase.ml @@ -1702,7 +1702,6 @@ let ctx_compute_var_basename (meta : Meta.meta) (ctx : extraction_ctx) | TArrow _ -> "f" | TTraitType (_, name) -> name_from_type_ident name | Error -> "x") -(* TODO : Check*) (** Generates a type variable basename. *) let ctx_compute_type_var_basename (_ctx : extraction_ctx) (basename : string) : -- cgit v1.2.3 From a781ea75c1860c76c5577faa57efcdb0db910612 Mon Sep 17 00:00:00 2001 From: Escherichia Date: Fri, 29 Mar 2024 10:56:52 +0100 Subject: Added meta information to names_map_id field in names_map type --- compiler/ExtractBase.ml | 45 +++++++++++++++++++++++---------------------- 1 file changed, 23 insertions(+), 22 deletions(-) diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml index 74ac9e32..96f816cb 100644 --- a/compiler/ExtractBase.ml +++ b/compiler/ExtractBase.ml @@ -237,7 +237,7 @@ module IdSet = Collections.MakeSet (IdOrderedType) *) type names_map = { id_to_name : string IdMap.t; - name_to_id : id StringMap.t; + name_to_id : (id * Meta.meta option) StringMap.t; (** The name to id map is used to look for name clashes, and generate nice debugging messages: if there is a name clash, it is useful to know precisely which identifiers are mapped to the same name... @@ -253,8 +253,8 @@ let empty_names_map : names_map = } (** Small helper to report name collision *) -let report_name_collision (id_to_string : id -> string) (id1 : id) (id2 : id) - (name : string) : unit = +let report_name_collision (id_to_string : id -> string) + (id1, meta : id * Meta.meta option) (id2 : id) (name : string) : unit = let id1 = "\n- " ^ id_to_string id1 in let id2 = "\n- " ^ id_to_string id2 in let err = @@ -263,9 +263,10 @@ let report_name_collision (id_to_string : id -> string) (id1 : id) (id2 : id) ^ "\nYou may want to rename some of your definitions, or report an issue." in (* If we fail hard on errors, raise an exception *) - save_error __FILE__ __LINE__ None err + save_error __FILE__ __LINE__ meta err -let names_map_get_id_from_name (name : string) (nm : names_map) : id option = +let names_map_get_id_from_name (name : string) (nm : names_map) : + (id * Meta.meta option) option = StringMap.find_opt name nm.name_to_id let names_map_check_collision (id_to_string : id -> string) (id : id) @@ -277,15 +278,15 @@ let names_map_check_collision (id_to_string : id -> string) (id : id) report_name_collision id_to_string clash id name (** Insert bindings in a names map without checking for collisions *) -let names_map_add_unchecked (id : id) (name : string) (nm : names_map) : +let names_map_add_unchecked (id, meta : id * Meta.meta option) (name : string) (nm : names_map) : names_map = (* Insert *) let id_to_name = IdMap.add id name nm.id_to_name in - let name_to_id = StringMap.add name id nm.name_to_id in + let name_to_id= StringMap.add name (id, meta) nm.name_to_id in let names_set = StringSet.add name nm.names_set in { id_to_name; name_to_id; names_set } -let names_map_add (id_to_string : id -> string) (id : id) (name : string) +let names_map_add (id_to_string : id -> string) (id, meta : id * meta option) (name : string) (nm : names_map) : names_map = (* Check if there is a clash *) names_map_check_collision id_to_string id name nm; @@ -296,9 +297,9 @@ let names_map_add (id_to_string : id -> string) (id : id) (name : string) ^ ":\nThe chosen name is already in the names set: " ^ name in (* If we fail hard on errors, raise an exception *) - save_error __FILE__ __LINE__ None err); + save_error __FILE__ __LINE__ meta err); (* Insert *) - names_map_add_unchecked id name nm + names_map_add_unchecked (id, meta) name nm (** The unsafe names map stores mappings from identifiers to names which might collide. For some backends and some names, it might be acceptable to have @@ -384,7 +385,7 @@ let allow_collisions (id : id) : bool = (** The [id_to_string] function to print nice debugging messages if there are collisions *) -let names_maps_add (id_to_string : id -> string) (id : id) (name : string) +let names_maps_add (meta : Meta.meta option) (id_to_string : id -> string) (id : id) (name : string) (nm : names_maps) : names_maps = (* We do not use the same name map if we allow/disallow collisions. We notably use it for field names: some backends like Lean can use the @@ -415,10 +416,10 @@ let names_maps_add (id_to_string : id -> string) (id : id) (name : string) *) let strict_names_map = if strict_collisions id then - names_map_add id_to_string id name nm.strict_names_map + names_map_add id_to_string (id, meta) name nm.strict_names_map else nm.strict_names_map in - let names_map = names_map_add id_to_string id name nm.names_map in + let names_map = names_map_add id_to_string (id, meta) name nm.names_map in { nm with strict_names_map; names_map } (** The [id_to_string] function to print nice debugging messages if there are @@ -468,20 +469,20 @@ type names_map_init = { let names_maps_add_assumed_type (id_to_string : id -> string) (id : assumed_ty) (name : string) (nm : names_maps) : names_maps = - names_maps_add id_to_string (TypeId (TAssumed id)) name nm + names_maps_add None id_to_string (TypeId (TAssumed id)) name nm let names_maps_add_assumed_struct (id_to_string : id -> string) (id : assumed_ty) (name : string) (nm : names_maps) : names_maps = - names_maps_add id_to_string (StructId (TAssumed id)) name nm + names_maps_add None id_to_string (StructId (TAssumed id)) name nm let names_maps_add_assumed_variant (id_to_string : id -> string) (id : assumed_ty) (variant_id : VariantId.id) (name : string) (nm : names_maps) : names_maps = - names_maps_add id_to_string (VariantId (TAssumed id, variant_id)) name nm + names_maps_add None id_to_string (VariantId (TAssumed id, variant_id)) name nm -let names_maps_add_function (id_to_string : id -> string) (fid : fun_id) +let names_maps_add_function (id_to_string : id -> string) (fid, meta : fun_id * meta option) (name : string) (nm : names_maps) : names_maps = - names_maps_add id_to_string (FunId fid) name nm + names_maps_add meta id_to_string (FunId fid) name nm let bool_name () = if !backend = Lean then "Bool" else "bool" let char_name () = if !backend = Lean then "Char" else "char" @@ -659,7 +660,7 @@ let id_to_string (meta : Meta.meta option) (id : id) (ctx : extraction_ctx) : let ctx_add (meta : Meta.meta) (id : id) (name : string) (ctx : extraction_ctx) : extraction_ctx = let id_to_string (id : id) : string = id_to_string (Some meta) id ctx in - let names_maps = names_maps_add id_to_string id name ctx.names_maps in + let names_maps = names_maps_add (Some meta) id_to_string id name ctx.names_maps in { ctx with names_maps } let ctx_get (meta : Meta.meta option) (id : id) (ctx : extraction_ctx) : string @@ -1125,7 +1126,7 @@ let initialize_names_maps () : names_maps = (* There is duplication in the keywords so we don't check the collisions while registering them (what is important is that there are no collisions between keywords and user-defined identifiers) *) - names_map_add_unchecked UnknownId name nm) + names_map_add_unchecked (UnknownId, None) name nm) strict_names_map keywords in let nm = { names_map; unsafe_names_map; strict_names_map } in @@ -1155,9 +1156,9 @@ let initialize_names_maps () : names_maps = in let assumed_functions = List.map - (fun (fid, name) -> (FromLlbc (Pure.FunId (FAssumed fid), None), name)) + (fun (fid, name) -> ((FromLlbc (Pure.FunId (FAssumed fid), None), None), name)) init.assumed_llbc_functions - @ List.map (fun (fid, name) -> (Pure fid, name)) init.assumed_pure_functions + @ List.map (fun (fid, name) -> ((Pure fid, None), name)) init.assumed_pure_functions in let nm = List.fold_left -- cgit v1.2.3 From a25f3bc7fe1dcddc952b4dcbb7b732bdf095197e Mon Sep 17 00:00:00 2001 From: Escherichia Date: Wed, 3 Apr 2024 18:23:46 +0200 Subject: rebased branch --- compiler/ExtractBase.ml | 32 +++++++++++++++++++------------- 1 file changed, 19 insertions(+), 13 deletions(-) diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml index 96f816cb..34b5ad64 100644 --- a/compiler/ExtractBase.ml +++ b/compiler/ExtractBase.ml @@ -254,7 +254,7 @@ let empty_names_map : names_map = (** Small helper to report name collision *) let report_name_collision (id_to_string : id -> string) - (id1, meta : id * Meta.meta option) (id2 : id) (name : string) : unit = + ((id1, meta) : id * Meta.meta option) (id2 : id) (name : string) : unit = let id1 = "\n- " ^ id_to_string id1 in let id2 = "\n- " ^ id_to_string id2 in let err = @@ -278,16 +278,16 @@ let names_map_check_collision (id_to_string : id -> string) (id : id) report_name_collision id_to_string clash id name (** Insert bindings in a names map without checking for collisions *) -let names_map_add_unchecked (id, meta : id * Meta.meta option) (name : string) (nm : names_map) : - names_map = +let names_map_add_unchecked ((id, meta) : id * Meta.meta option) (name : string) + (nm : names_map) : names_map = (* Insert *) let id_to_name = IdMap.add id name nm.id_to_name in - let name_to_id= StringMap.add name (id, meta) nm.name_to_id in + let name_to_id = StringMap.add name (id, meta) nm.name_to_id in let names_set = StringSet.add name nm.names_set in { id_to_name; name_to_id; names_set } -let names_map_add (id_to_string : id -> string) (id, meta : id * meta option) (name : string) - (nm : names_map) : names_map = +let names_map_add (id_to_string : id -> string) ((id, meta) : id * meta option) + (name : string) (nm : names_map) : names_map = (* Check if there is a clash *) names_map_check_collision id_to_string id name nm; (* Sanity check *) @@ -385,8 +385,8 @@ let allow_collisions (id : id) : bool = (** The [id_to_string] function to print nice debugging messages if there are collisions *) -let names_maps_add (meta : Meta.meta option) (id_to_string : id -> string) (id : id) (name : string) - (nm : names_maps) : names_maps = +let names_maps_add (meta : Meta.meta option) (id_to_string : id -> string) + (id : id) (name : string) (nm : names_maps) : names_maps = (* We do not use the same name map if we allow/disallow collisions. We notably use it for field names: some backends like Lean can use the type information to disambiguate field projections. @@ -480,8 +480,9 @@ let names_maps_add_assumed_variant (id_to_string : id -> string) (nm : names_maps) : names_maps = names_maps_add None id_to_string (VariantId (TAssumed id, variant_id)) name nm -let names_maps_add_function (id_to_string : id -> string) (fid, meta : fun_id * meta option) - (name : string) (nm : names_maps) : names_maps = +let names_maps_add_function (id_to_string : id -> string) + ((fid, meta) : fun_id * meta option) (name : string) (nm : names_maps) : + names_maps = names_maps_add meta id_to_string (FunId fid) name nm let bool_name () = if !backend = Lean then "Bool" else "bool" @@ -660,7 +661,9 @@ let id_to_string (meta : Meta.meta option) (id : id) (ctx : extraction_ctx) : let ctx_add (meta : Meta.meta) (id : id) (name : string) (ctx : extraction_ctx) : extraction_ctx = let id_to_string (id : id) : string = id_to_string (Some meta) id ctx in - let names_maps = names_maps_add (Some meta) id_to_string id name ctx.names_maps in + let names_maps = + names_maps_add (Some meta) id_to_string id name ctx.names_maps + in { ctx with names_maps } let ctx_get (meta : Meta.meta option) (id : id) (ctx : extraction_ctx) : string @@ -1156,9 +1159,12 @@ let initialize_names_maps () : names_maps = in let assumed_functions = List.map - (fun (fid, name) -> ((FromLlbc (Pure.FunId (FAssumed fid), None), None), name)) + (fun (fid, name) -> + ((FromLlbc (Pure.FunId (FAssumed fid), None), None), name)) init.assumed_llbc_functions - @ List.map (fun (fid, name) -> ((Pure fid, None), name)) init.assumed_pure_functions + @ List.map + (fun (fid, name) -> ((Pure fid, None), name)) + init.assumed_pure_functions in let nm = List.fold_left -- cgit v1.2.3 From 8a8f3ee2e444542112a3b0ea0b4e6283b1893aaa Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 4 Apr 2024 10:57:01 +0200 Subject: Make minor modifications --- compiler/ExtractBase.ml | 36 +++++++++++++++++++++--------------- 1 file changed, 21 insertions(+), 15 deletions(-) diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml index 34b5ad64..451c2c41 100644 --- a/compiler/ExtractBase.ml +++ b/compiler/ExtractBase.ml @@ -254,28 +254,34 @@ let empty_names_map : names_map = (** Small helper to report name collision *) let report_name_collision (id_to_string : id -> string) - ((id1, meta) : id * Meta.meta option) (id2 : id) (name : string) : unit = - let id1 = "\n- " ^ id_to_string id1 in - let id2 = "\n- " ^ id_to_string id2 in + ((id1, meta1) : id * Meta.meta option) (id2 : id) (meta2 : Meta.meta option) + (name : string) : unit = + let meta_to_string (meta : Meta.meta option) = + match meta with + | None -> "" + | Some meta -> "\n " ^ Errors.meta_to_string meta.span + in + let id1 = "\n- " ^ id_to_string id1 ^ meta_to_string meta1 in + let id2 = "\n- " ^ id_to_string id2 ^ meta_to_string meta2 in let err = "Name clash detected: the following identifiers are bound to the same name \ \"" ^ name ^ "\":" ^ id1 ^ id2 ^ "\nYou may want to rename some of your definitions, or report an issue." in (* If we fail hard on errors, raise an exception *) - save_error __FILE__ __LINE__ meta err + save_error __FILE__ __LINE__ meta1 err let names_map_get_id_from_name (name : string) (nm : names_map) : (id * Meta.meta option) option = StringMap.find_opt name nm.name_to_id let names_map_check_collision (id_to_string : id -> string) (id : id) - (name : string) (nm : names_map) : unit = + (meta : Meta.meta option) (name : string) (nm : names_map) : unit = match names_map_get_id_from_name name nm with | None -> () (* Ok *) | Some clash -> (* There is a clash: print a nice debugging message for the user *) - report_name_collision id_to_string clash id name + report_name_collision id_to_string clash id meta name (** Insert bindings in a names map without checking for collisions *) let names_map_add_unchecked ((id, meta) : id * Meta.meta option) (name : string) @@ -289,7 +295,7 @@ let names_map_add_unchecked ((id, meta) : id * Meta.meta option) (name : string) let names_map_add (id_to_string : id -> string) ((id, meta) : id * meta option) (name : string) (nm : names_map) : names_map = (* Check if there is a clash *) - names_map_check_collision id_to_string id name nm; + names_map_check_collision id_to_string id meta name nm; (* Sanity check *) (if StringSet.mem name nm.names_set then let err = @@ -385,8 +391,8 @@ let allow_collisions (id : id) : bool = (** The [id_to_string] function to print nice debugging messages if there are collisions *) -let names_maps_add (meta : Meta.meta option) (id_to_string : id -> string) - (id : id) (name : string) (nm : names_maps) : names_maps = +let names_maps_add (id_to_string : id -> string) (id : id) + (meta : Meta.meta option) (name : string) (nm : names_maps) : names_maps = (* We do not use the same name map if we allow/disallow collisions. We notably use it for field names: some backends like Lean can use the type information to disambiguate field projections. @@ -401,7 +407,7 @@ let names_maps_add (meta : Meta.meta option) (id_to_string : id -> string) *) if allow_collisions id then ( (* Check with the ids which are considered to be strict on collisions *) - names_map_check_collision id_to_string id name nm.strict_names_map; + names_map_check_collision id_to_string id meta name nm.strict_names_map; { nm with unsafe_names_map = unsafe_names_map_add id name nm.unsafe_names_map; @@ -469,21 +475,21 @@ type names_map_init = { let names_maps_add_assumed_type (id_to_string : id -> string) (id : assumed_ty) (name : string) (nm : names_maps) : names_maps = - names_maps_add None id_to_string (TypeId (TAssumed id)) name nm + names_maps_add id_to_string (TypeId (TAssumed id)) None name nm let names_maps_add_assumed_struct (id_to_string : id -> string) (id : assumed_ty) (name : string) (nm : names_maps) : names_maps = - names_maps_add None id_to_string (StructId (TAssumed id)) name nm + names_maps_add id_to_string (StructId (TAssumed id)) None name nm let names_maps_add_assumed_variant (id_to_string : id -> string) (id : assumed_ty) (variant_id : VariantId.id) (name : string) (nm : names_maps) : names_maps = - names_maps_add None id_to_string (VariantId (TAssumed id, variant_id)) name nm + names_maps_add id_to_string (VariantId (TAssumed id, variant_id)) None name nm let names_maps_add_function (id_to_string : id -> string) ((fid, meta) : fun_id * meta option) (name : string) (nm : names_maps) : names_maps = - names_maps_add meta id_to_string (FunId fid) name nm + names_maps_add id_to_string (FunId fid) meta name nm let bool_name () = if !backend = Lean then "Bool" else "bool" let char_name () = if !backend = Lean then "Char" else "char" @@ -662,7 +668,7 @@ let ctx_add (meta : Meta.meta) (id : id) (name : string) (ctx : extraction_ctx) : extraction_ctx = let id_to_string (id : id) : string = id_to_string (Some meta) id ctx in let names_maps = - names_maps_add (Some meta) id_to_string id name ctx.names_maps + names_maps_add id_to_string id (Some meta) name ctx.names_maps in { ctx with names_maps } -- cgit v1.2.3 From eae7ce912c8bae44f98e1d489aba5618c0029bd2 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 4 Apr 2024 10:59:46 +0200 Subject: Make a minor modification --- compiler/ExtractBase.ml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml index 451c2c41..d760ab1e 100644 --- a/compiler/ExtractBase.ml +++ b/compiler/ExtractBase.ml @@ -268,8 +268,10 @@ let report_name_collision (id_to_string : id -> string) \"" ^ name ^ "\":" ^ id1 ^ id2 ^ "\nYou may want to rename some of your definitions, or report an issue." in - (* If we fail hard on errors, raise an exception *) - save_error __FILE__ __LINE__ meta1 err + (* If we fail hard on errors, raise an exception - we don't link this error + to any meta information because we already put the span information about + the two problematic definitions in the error message above. *) + save_error __FILE__ __LINE__ None err let names_map_get_id_from_name (name : string) (nm : names_map) : (id * Meta.meta option) option = -- cgit v1.2.3 From f58161f23ccb4bff2080a7c63105d80777c33362 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 4 Apr 2024 11:00:23 +0200 Subject: Update a comment --- compiler/ExtractBase.ml | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml index d760ab1e..f8d3cd96 100644 --- a/compiler/ExtractBase.ml +++ b/compiler/ExtractBase.ml @@ -268,9 +268,11 @@ let report_name_collision (id_to_string : id -> string) \"" ^ name ^ "\":" ^ id1 ^ id2 ^ "\nYou may want to rename some of your definitions, or report an issue." in - (* If we fail hard on errors, raise an exception - we don't link this error - to any meta information because we already put the span information about - the two problematic definitions in the error message above. *) + (* Register the error. + + We don't link this error to any meta information because we already put + the span information about the two problematic definitions in the error + message above. *) save_error __FILE__ __LINE__ None err let names_map_get_id_from_name (name : string) (nm : names_map) : -- cgit v1.2.3 From 795e2107e305d425efdf6071b29f186cae83656b Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 4 Apr 2024 11:56:09 +0200 Subject: Update the names of the synthesized backward functions --- compiler/ExtractBase.ml | 6 ++++-- compiler/SymbolicToPure.ml | 9 +++++++++ 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml index 74ac9e32..0a7c8df2 100644 --- a/compiler/ExtractBase.ml +++ b/compiler/ExtractBase.ml @@ -1662,9 +1662,11 @@ let ctx_compute_var_basename (meta : Meta.meta) (ctx : extraction_ctx) in (* If there is a basename, we use it *) match basename with - | Some basename -> + | Some basename -> ( (* This should be a no-op *) - to_snake_case basename + match !Config.backend with + | Lean -> basename + | FStar | Coq | HOL4 -> to_snake_case basename) | None -> ( (* No basename: we use the first letter of the type *) match ty with diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 0c30f44c..7e970029 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -1502,6 +1502,15 @@ let fresh_back_vars_for_current_fun (ctx : bs_ctx) match ty with None -> None | Some ty -> Some (name, ty)) back_vars in + (* If there is one backward function or less, we use the name "back" + (there is no point in using the lifetime name, and it makes the + code generation more stable) *) + let num_back_vars = List.length (List.filter_map (fun x -> x) back_vars) in + let back_vars = + if num_back_vars = 1 then + List.map (Option.map (fun (_, ty) -> (Some "back", ty))) back_vars + else back_vars + in fresh_opt_vars back_vars ctx (** IMPORTANT: do not use this one directly, but rather {!symbolic_value_to_texpression} *) -- cgit v1.2.3 From 975ddb208f18cb4ba46293dd788c46eb1ce43938 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 4 Apr 2024 11:58:44 +0200 Subject: Regenerate the test files --- tests/coq/betree/BetreeMain_Funs.v | 12 ++-- .../coq/betree/BetreeMain_FunsExternal_Template.v | 3 +- tests/coq/demo/Demo.v | 28 ++++---- tests/coq/hashmap/Hashmap_Funs.v | 18 ++--- tests/coq/hashmap_on_disk/HashmapMain_Funs.v | 17 +++-- tests/coq/misc/External_Funs.v | 4 +- tests/coq/misc/External_FunsExternal_Template.v | 9 ++- tests/coq/misc/External_TypesExternal_Template.v | 3 +- tests/coq/misc/Loops.v | 78 ++++++++++---------- tests/coq/misc/NoNestedBorrows.v | 12 ++-- tests/coq/misc/Paper.v | 12 ++-- tests/coq/misc/PoloniusList.v | 4 +- tests/coq/traits/Traits.v | 3 +- tests/fstar/betree/BetreeMain.Funs.fst | 12 ++-- tests/fstar/betree/BetreeMain.FunsExternal.fsti | 3 +- .../fstar/betree_back_stateful/BetreeMain.Funs.fst | 12 ++-- .../BetreeMain.FunsExternal.fsti | 3 +- tests/fstar/demo/Demo.fst | 26 ++++--- tests/fstar/hashmap/Hashmap.Funs.fst | 17 +++-- tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst | 17 +++-- tests/fstar/misc/External.Funs.fst | 4 +- tests/fstar/misc/External.FunsExternal.fsti | 9 ++- tests/fstar/misc/External.TypesExternal.fsti | 3 +- tests/fstar/misc/Loops.Funs.fst | 83 +++++++++++----------- tests/fstar/misc/NoNestedBorrows.fst | 11 ++- tests/fstar/misc/Paper.fst | 11 ++- tests/fstar/misc/PoloniusList.fst | 4 +- tests/fstar/traits/Traits.fst | 3 +- tests/lean/BetreeMain/Funs.lean | 12 ++-- tests/lean/BetreeMain/FunsExternal_Template.lean | 3 +- tests/lean/Demo/Demo.lean | 32 ++++----- tests/lean/External/Funs.lean | 4 +- tests/lean/External/FunsExternal_Template.lean | 9 ++- tests/lean/External/TypesExternal_Template.lean | 3 +- tests/lean/Hashmap/Funs.lean | 16 ++--- tests/lean/HashmapMain/Funs.lean | 16 ++--- tests/lean/Loops.lean | 80 ++++++++++----------- tests/lean/NoNestedBorrows.lean | 16 ++--- tests/lean/Paper.lean | 16 ++--- tests/lean/PoloniusList.lean | 4 +- tests/lean/Traits.lean | 3 +- 41 files changed, 322 insertions(+), 313 deletions(-) diff --git a/tests/coq/betree/BetreeMain_Funs.v b/tests/coq/betree/BetreeMain_Funs.v index c2cca26d..9256b149 100644 --- a/tests/coq/betree/BetreeMain_Funs.v +++ b/tests/coq/betree/BetreeMain_Funs.v @@ -240,11 +240,11 @@ Fixpoint betree_Node_lookup_first_message_for_key else ( p <- betree_Node_lookup_first_message_for_key n1 key next_msgs; let (l, lookup_first_message_for_key_back) := p in - let back_'a := + let back := fun (ret : betree_List_t (u64 * betree_Message_t)) => next_msgs1 <- lookup_first_message_for_key_back ret; Return (Betree_List_Cons (i, m) next_msgs1) in - Return (l, back_'a)) + Return (l, back)) | Betree_List_Nil => Return (Betree_List_Nil, Return) end end @@ -440,11 +440,11 @@ Fixpoint betree_Node_lookup_first_message_after_key then ( p1 <- betree_Node_lookup_first_message_after_key n1 key next_msgs; let (l, lookup_first_message_after_key_back) := p1 in - let back_'a := + let back := fun (ret : betree_List_t (u64 * betree_Message_t)) => next_msgs1 <- lookup_first_message_after_key_back ret; Return (Betree_List_Cons (k, m) next_msgs1) in - Return (l, back_'a)) + Return (l, back)) else Return (Betree_List_Cons (k, m) next_msgs, Return) | Betree_List_Nil => Return (Betree_List_Nil, Return) end @@ -550,11 +550,11 @@ Fixpoint betree_Node_lookup_mut_in_bindings else ( p <- betree_Node_lookup_mut_in_bindings n1 key tl; let (l, lookup_mut_in_bindings_back) := p in - let back_'a := + let back := fun (ret : betree_List_t (u64 * u64)) => tl1 <- lookup_mut_in_bindings_back ret; Return (Betree_List_Cons (i, i1) tl1) in - Return (l, back_'a)) + Return (l, back)) | Betree_List_Nil => Return (Betree_List_Nil, Return) end end diff --git a/tests/coq/betree/BetreeMain_FunsExternal_Template.v b/tests/coq/betree/BetreeMain_FunsExternal_Template.v index a9969448..1367bac2 100644 --- a/tests/coq/betree/BetreeMain_FunsExternal_Template.v +++ b/tests/coq/betree/BetreeMain_FunsExternal_Template.v @@ -38,7 +38,8 @@ Axiom betree_utils_store_leaf_node . (** [core::option::{core::option::Option}::unwrap]: - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 *) + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 + Name pattern: core::option::{core::option::Option<@T>}::unwrap *) Axiom core_option_Option_unwrap : forall(T : Type), option T -> state -> result (state * T) . diff --git a/tests/coq/demo/Demo.v b/tests/coq/demo/Demo.v index d5a6e535..abec8e88 100644 --- a/tests/coq/demo/Demo.v +++ b/tests/coq/demo/Demo.v @@ -13,8 +13,8 @@ Module Demo. Definition choose (T : Type) (b : bool) (x : T) (y : T) : result (T * (T -> result (T * T))) := if b - then let back_'a := fun (ret : T) => Return (ret, y) in Return (x, back_'a) - else let back_'a := fun (ret : T) => Return (x, ret) in Return (y, back_'a) + then let back := fun (ret : T) => Return (ret, y) in Return (x, back) + else let back := fun (ret : T) => Return (x, ret) in Return (y, back) . (** [demo::mul2_add1]: @@ -79,16 +79,16 @@ Fixpoint list_nth_mut | CList_CCons x tl => if i s= 0%u32 then - let back_'a := fun (ret : T) => Return (CList_CCons ret tl) in - Return (x, back_'a) + let back := fun (ret : T) => Return (CList_CCons ret tl) in + Return (x, back) else ( i1 <- u32_sub i 1%u32; p <- list_nth_mut T n1 tl i1; let (t, list_nth_mut_back) := p in - let back_'a := + let back := fun (ret : T) => tl1 <- list_nth_mut_back ret; Return (CList_CCons x tl1) in - Return (t, back_'a)) + Return (t, back)) | CList_CNil => Fail_ Failure end end @@ -107,15 +107,15 @@ Fixpoint list_nth_mut1_loop | CList_CCons x tl => if i s= 0%u32 then - let back_'a := fun (ret : T) => Return (CList_CCons ret tl) in - Return (x, back_'a) + let back := fun (ret : T) => Return (CList_CCons ret tl) in + Return (x, back) else ( i1 <- u32_sub i 1%u32; p <- list_nth_mut1_loop T n1 tl i1; - let (t, back_'a) := p in - let back_'a1 := - fun (ret : T) => tl1 <- back_'a ret; Return (CList_CCons x tl1) in - Return (t, back_'a1)) + let (t, back) := p in + let back1 := + fun (ret : T) => tl1 <- back ret; Return (CList_CCons x tl1) in + Return (t, back1)) | CList_CNil => Fail_ Failure end end @@ -155,10 +155,10 @@ Fixpoint list_tail | CList_CCons t tl => p <- list_tail T n1 tl; let (c, list_tail_back) := p in - let back_'a := + let back := fun (ret : CList_t T) => tl1 <- list_tail_back ret; Return (CList_CCons t tl1) in - Return (c, back_'a) + Return (c, back) | CList_CNil => Return (CList_CNil, Return) end end diff --git a/tests/coq/hashmap/Hashmap_Funs.v b/tests/coq/hashmap/Hashmap_Funs.v index d709a8d5..67543c8e 100644 --- a/tests/coq/hashmap/Hashmap_Funs.v +++ b/tests/coq/hashmap/Hashmap_Funs.v @@ -376,15 +376,15 @@ Fixpoint hashMap_get_mut_in_list_loop | List_Cons ckey cvalue tl => if ckey s= key then - let back_'a := fun (ret : T) => Return (List_Cons ckey ret tl) in - Return (cvalue, back_'a) + let back := fun (ret : T) => Return (List_Cons ckey ret tl) in + Return (cvalue, back) else ( p <- hashMap_get_mut_in_list_loop T n1 tl key; - let (t, back_'a) := p in - let back_'a1 := - fun (ret : T) => - tl1 <- back_'a ret; Return (List_Cons ckey cvalue tl1) in - Return (t, back_'a1)) + let (t, back) := p in + let back1 := + fun (ret : T) => tl1 <- back ret; Return (List_Cons ckey cvalue tl1) + in + Return (t, back1)) | List_Nil => Fail_ Failure end end @@ -415,7 +415,7 @@ Definition hashMap_get_mut let (l, index_mut_back) := p in p1 <- hashMap_get_mut_in_list T n l key; let (t, get_mut_in_list_back) := p1 in - let back_'a := + let back := fun (ret : T) => l1 <- get_mut_in_list_back ret; v <- index_mut_back l1; @@ -426,7 +426,7 @@ Definition hashMap_get_mut hashMap_max_load := self.(hashMap_max_load); hashMap_slots := v |} in - Return (t, back_'a) + Return (t, back) . (** [hashmap::{hashmap::HashMap}::remove_from_list]: loop 0: diff --git a/tests/coq/hashmap_on_disk/HashmapMain_Funs.v b/tests/coq/hashmap_on_disk/HashmapMain_Funs.v index 9fb3c482..a614e52d 100644 --- a/tests/coq/hashmap_on_disk/HashmapMain_Funs.v +++ b/tests/coq/hashmap_on_disk/HashmapMain_Funs.v @@ -398,16 +398,15 @@ Fixpoint hashmap_HashMap_get_mut_in_list_loop | Hashmap_List_Cons ckey cvalue tl => if ckey s= key then - let back_'a := fun (ret : T) => Return (Hashmap_List_Cons ckey ret tl) - in - Return (cvalue, back_'a) + let back := fun (ret : T) => Return (Hashmap_List_Cons ckey ret tl) in + Return (cvalue, back) else ( p <- hashmap_HashMap_get_mut_in_list_loop T n1 tl key; - let (t, back_'a) := p in - let back_'a1 := + let (t, back) := p in + let back1 := fun (ret : T) => - tl1 <- back_'a ret; Return (Hashmap_List_Cons ckey cvalue tl1) in - Return (t, back_'a1)) + tl1 <- back ret; Return (Hashmap_List_Cons ckey cvalue tl1) in + Return (t, back1)) | Hashmap_List_Nil => Fail_ Failure end end @@ -438,7 +437,7 @@ Definition hashmap_HashMap_get_mut let (l, index_mut_back) := p in p1 <- hashmap_HashMap_get_mut_in_list T n l key; let (t, get_mut_in_list_back) := p1 in - let back_'a := + let back := fun (ret : T) => l1 <- get_mut_in_list_back ret; v <- index_mut_back l1; @@ -450,7 +449,7 @@ Definition hashmap_HashMap_get_mut hashmap_HashMap_max_load := self.(hashmap_HashMap_max_load); hashmap_HashMap_slots := v |} in - Return (t, back_'a) + Return (t, back) . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: loop 0: diff --git a/tests/coq/misc/External_Funs.v b/tests/coq/misc/External_Funs.v index faf91fef..a6832854 100644 --- a/tests/coq/misc/External_Funs.v +++ b/tests/coq/misc/External_Funs.v @@ -46,8 +46,8 @@ Definition custom_swap p <- core_mem_swap T x y st; let (st1, p1) := p in let (x1, y1) := p1 in - let back_'a := fun (ret : T) (st2 : state) => Return (st2, (ret, y1)) in - Return (st1, (x1, back_'a)) + let back := fun (ret : T) (st2 : state) => Return (st2, (ret, y1)) in + Return (st1, (x1, back)) . (** [external::test_custom_swap]: diff --git a/tests/coq/misc/External_FunsExternal_Template.v b/tests/coq/misc/External_FunsExternal_Template.v index 6773ac18..24dd2d47 100644 --- a/tests/coq/misc/External_FunsExternal_Template.v +++ b/tests/coq/misc/External_FunsExternal_Template.v @@ -12,19 +12,22 @@ Include External_Types. Module External_FunsExternal_Template. (** [core::mem::swap]: - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *) + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 + Name pattern: core::mem::swap *) Axiom core_mem_swap : forall(T : Type), T -> T -> state -> result (state * (T * T)) . (** [core::num::nonzero::{core::num::nonzero::NonZeroU32#14}::new]: - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 79:16-79:57 *) + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 79:16-79:57 + Name pattern: core::num::nonzero::{core::num::nonzero::NonZeroU32}::new *) Axiom core_num_nonzero_NonZeroU32_new : u32 -> state -> result (state * (option core_num_nonzero_NonZeroU32_t)) . (** [core::option::{core::option::Option}::unwrap]: - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 *) + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 + Name pattern: core::option::{core::option::Option<@T>}::unwrap *) Axiom core_option_Option_unwrap : forall(T : Type), option T -> state -> result (state * T) . diff --git a/tests/coq/misc/External_TypesExternal_Template.v b/tests/coq/misc/External_TypesExternal_Template.v index 7ba79d8e..7d6af202 100644 --- a/tests/coq/misc/External_TypesExternal_Template.v +++ b/tests/coq/misc/External_TypesExternal_Template.v @@ -10,7 +10,8 @@ Local Open Scope Primitives_scope. Module External_TypesExternal_Template. (** [core::num::nonzero::NonZeroU32] - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 50:12-50:33 *) + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 50:12-50:33 + Name pattern: core::num::nonzero::NonZeroU32 *) Axiom core_num_nonzero_NonZeroU32_t : Type. (** The state type used in the state-error monad *) diff --git a/tests/coq/misc/Loops.v b/tests/coq/misc/Loops.v index 7c83a014..ae529cf8 100644 --- a/tests/coq/misc/Loops.v +++ b/tests/coq/misc/Loops.v @@ -375,18 +375,18 @@ Fixpoint list_nth_mut_loop_pair_loop | List_Cons x1 tl1 => if i s= 0%u32 then - let back_'a := fun (ret : T) => Return (List_Cons ret tl0) in - let back_'b := fun (ret : T) => Return (List_Cons ret tl1) in - Return ((x0, x1), back_'a, back_'b) + let back'a := fun (ret : T) => Return (List_Cons ret tl0) in + let back'b := fun (ret : T) => Return (List_Cons ret tl1) in + Return ((x0, x1), back'a, back'b) else ( i1 <- u32_sub i 1%u32; t <- list_nth_mut_loop_pair_loop T n1 tl0 tl1 i1; - let '(p, back_'a, back_'b) := t in - let back_'a1 := - fun (ret : T) => tl01 <- back_'a ret; Return (List_Cons x0 tl01) in - let back_'b1 := - fun (ret : T) => tl11 <- back_'b ret; Return (List_Cons x1 tl11) in - Return (p, back_'a1, back_'b1)) + let '(p, back'a, back'b) := t in + let back'a1 := + fun (ret : T) => tl01 <- back'a ret; Return (List_Cons x0 tl01) in + let back'b1 := + fun (ret : T) => tl11 <- back'b ret; Return (List_Cons x1 tl11) in + Return (p, back'a1, back'b1)) | List_Nil => Fail_ Failure end | List_Nil => Fail_ Failure @@ -451,21 +451,21 @@ Fixpoint list_nth_mut_loop_pair_merge_loop | List_Cons x1 tl1 => if i s= 0%u32 then - let back_'a := + let back := fun (ret : (T * T)) => let (t, t1) := ret in Return (List_Cons t tl0, List_Cons t1 tl1) in - Return ((x0, x1), back_'a) + Return ((x0, x1), back) else ( i1 <- u32_sub i 1%u32; p <- list_nth_mut_loop_pair_merge_loop T n1 tl0 tl1 i1; - let (p1, back_'a) := p in - let back_'a1 := + let (p1, back) := p in + let back1 := fun (ret : (T * T)) => - p2 <- back_'a ret; + p2 <- back ret; let (tl01, tl11) := p2 in Return (List_Cons x0 tl01, List_Cons x1 tl11) in - Return (p1, back_'a1)) + Return (p1, back1)) | List_Nil => Fail_ Failure end | List_Nil => Fail_ Failure @@ -531,15 +531,15 @@ Fixpoint list_nth_mut_shared_loop_pair_loop | List_Cons x1 tl1 => if i s= 0%u32 then - let back_'a := fun (ret : T) => Return (List_Cons ret tl0) in - Return ((x0, x1), back_'a) + let back := fun (ret : T) => Return (List_Cons ret tl0) in + Return ((x0, x1), back) else ( i1 <- u32_sub i 1%u32; p <- list_nth_mut_shared_loop_pair_loop T n1 tl0 tl1 i1; - let (p1, back_'a) := p in - let back_'a1 := - fun (ret : T) => tl01 <- back_'a ret; Return (List_Cons x0 tl01) in - Return (p1, back_'a1)) + let (p1, back) := p in + let back1 := + fun (ret : T) => tl01 <- back ret; Return (List_Cons x0 tl01) in + Return (p1, back1)) | List_Nil => Fail_ Failure end | List_Nil => Fail_ Failure @@ -571,15 +571,15 @@ Fixpoint list_nth_mut_shared_loop_pair_merge_loop | List_Cons x1 tl1 => if i s= 0%u32 then - let back_'a := fun (ret : T) => Return (List_Cons ret tl0) in - Return ((x0, x1), back_'a) + let back := fun (ret : T) => Return (List_Cons ret tl0) in + Return ((x0, x1), back) else ( i1 <- u32_sub i 1%u32; p <- list_nth_mut_shared_loop_pair_merge_loop T n1 tl0 tl1 i1; - let (p1, back_'a) := p in - let back_'a1 := - fun (ret : T) => tl01 <- back_'a ret; Return (List_Cons x0 tl01) in - Return (p1, back_'a1)) + let (p1, back) := p in + let back1 := + fun (ret : T) => tl01 <- back ret; Return (List_Cons x0 tl01) in + Return (p1, back1)) | List_Nil => Fail_ Failure end | List_Nil => Fail_ Failure @@ -611,15 +611,15 @@ Fixpoint list_nth_shared_mut_loop_pair_loop | List_Cons x1 tl1 => if i s= 0%u32 then - let back_'b := fun (ret : T) => Return (List_Cons ret tl1) in - Return ((x0, x1), back_'b) + let back := fun (ret : T) => Return (List_Cons ret tl1) in + Return ((x0, x1), back) else ( i1 <- u32_sub i 1%u32; p <- list_nth_shared_mut_loop_pair_loop T n1 tl0 tl1 i1; - let (p1, back_'b) := p in - let back_'b1 := - fun (ret : T) => tl11 <- back_'b ret; Return (List_Cons x1 tl11) in - Return (p1, back_'b1)) + let (p1, back) := p in + let back1 := + fun (ret : T) => tl11 <- back ret; Return (List_Cons x1 tl11) in + Return (p1, back1)) | List_Nil => Fail_ Failure end | List_Nil => Fail_ Failure @@ -651,15 +651,15 @@ Fixpoint list_nth_shared_mut_loop_pair_merge_loop | List_Cons x1 tl1 => if i s= 0%u32 then - let back_'a := fun (ret : T) => Return (List_Cons ret tl1) in - Return ((x0, x1), back_'a) + let back := fun (ret : T) => Return (List_Cons ret tl1) in + Return ((x0, x1), back) else ( i1 <- u32_sub i 1%u32; p <- list_nth_shared_mut_loop_pair_merge_loop T n1 tl0 tl1 i1; - let (p1, back_'a) := p in - let back_'a1 := - fun (ret : T) => tl11 <- back_'a ret; Return (List_Cons x1 tl11) in - Return (p1, back_'a1)) + let (p1, back) := p in + let back1 := + fun (ret : T) => tl11 <- back ret; Return (List_Cons x1 tl11) in + Return (p1, back1)) | List_Nil => Fail_ Failure end | List_Nil => Fail_ Failure diff --git a/tests/coq/misc/NoNestedBorrows.v b/tests/coq/misc/NoNestedBorrows.v index 76dc4cf6..d4035104 100644 --- a/tests/coq/misc/NoNestedBorrows.v +++ b/tests/coq/misc/NoNestedBorrows.v @@ -321,8 +321,8 @@ Check (test_split_list )%return. Definition choose (T : Type) (b : bool) (x : T) (y : T) : result (T * (T -> result (T * T))) := if b - then let back_'a := fun (ret : T) => Return (ret, y) in Return (x, back_'a) - else let back_'a := fun (ret : T) => Return (x, ret) in Return (y, back_'a) + then let back := fun (ret : T) => Return (ret, y) in Return (x, back) + else let back := fun (ret : T) => Return (x, ret) in Return (y, back) . (** [no_nested_borrows::choose_test]: @@ -399,16 +399,16 @@ Fixpoint list_nth_mut | List_Cons x tl => if i s= 0%u32 then - let back_'a := fun (ret : T) => Return (List_Cons ret tl) in - Return (x, back_'a) + let back := fun (ret : T) => Return (List_Cons ret tl) in + Return (x, back) else ( i1 <- u32_sub i 1%u32; p <- list_nth_mut T tl i1; let (t, list_nth_mut_back) := p in - let back_'a := + let back := fun (ret : T) => tl1 <- list_nth_mut_back ret; Return (List_Cons x tl1) in - Return (t, back_'a)) + Return (t, back)) | List_Nil => Fail_ Failure end . diff --git a/tests/coq/misc/Paper.v b/tests/coq/misc/Paper.v index ad77fa2a..77276223 100644 --- a/tests/coq/misc/Paper.v +++ b/tests/coq/misc/Paper.v @@ -27,8 +27,8 @@ Check (test_incr )%return. Definition choose (T : Type) (b : bool) (x : T) (y : T) : result (T * (T -> result (T * T))) := if b - then let back_'a := fun (ret : T) => Return (ret, y) in Return (x, back_'a) - else let back_'a := fun (ret : T) => Return (x, ret) in Return (y, back_'a) + then let back := fun (ret : T) => Return (ret, y) in Return (x, back) + else let back := fun (ret : T) => Return (x, ret) in Return (y, back) . (** [paper::test_choose]: @@ -70,16 +70,16 @@ Fixpoint list_nth_mut | List_Cons x tl => if i s= 0%u32 then - let back_'a := fun (ret : T) => Return (List_Cons ret tl) in - Return (x, back_'a) + let back := fun (ret : T) => Return (List_Cons ret tl) in + Return (x, back) else ( i1 <- u32_sub i 1%u32; p <- list_nth_mut T tl i1; let (t, list_nth_mut_back) := p in - let back_'a := + let back := fun (ret : T) => tl1 <- list_nth_mut_back ret; Return (List_Cons x tl1) in - Return (t, back_'a)) + Return (t, back)) | List_Nil => Fail_ Failure end . diff --git a/tests/coq/misc/PoloniusList.v b/tests/coq/misc/PoloniusList.v index 8f403a8e..dfa09328 100644 --- a/tests/coq/misc/PoloniusList.v +++ b/tests/coq/misc/PoloniusList.v @@ -31,10 +31,10 @@ Fixpoint get_list_at_x else ( p <- get_list_at_x tl x; let (l, get_list_at_x_back) := p in - let back_'a := + let back := fun (ret : List_t u32) => tl1 <- get_list_at_x_back ret; Return (List_Cons hd tl1) in - Return (l, back_'a)) + Return (l, back)) | List_Nil => Return (List_Nil, Return) end . diff --git a/tests/coq/traits/Traits.v b/tests/coq/traits/Traits.v index a861c114..0e942c7d 100644 --- a/tests/coq/traits/Traits.v +++ b/tests/coq/traits/Traits.v @@ -671,7 +671,8 @@ Arguments foo_x { _ _ }. Arguments foo_y { _ _ }. (** [core::result::Result] - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/result.rs', lines 502:0-502:21 *) + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/result.rs', lines 502:0-502:21 + Name pattern: core::result::Result *) Inductive core_result_Result_t (T E : Type) := | Core_result_Result_Ok : T -> core_result_Result_t T E | Core_result_Result_Err : E -> core_result_Result_t T E diff --git a/tests/fstar/betree/BetreeMain.Funs.fst b/tests/fstar/betree/BetreeMain.Funs.fst index 2469f98c..129e6f7e 100644 --- a/tests/fstar/betree/BetreeMain.Funs.fst +++ b/tests/fstar/betree/BetreeMain.Funs.fst @@ -195,11 +195,11 @@ let rec betree_Node_lookup_first_message_for_key else let* (l, lookup_first_message_for_key_back) = betree_Node_lookup_first_message_for_key key next_msgs in - let back_'a = + let back = fun ret -> let* next_msgs1 = lookup_first_message_for_key_back ret in Return (Betree_List_Cons (i, m) next_msgs1) in - Return (l, back_'a) + Return (l, back) | Betree_List_Nil -> Return (Betree_List_Nil, Return) end @@ -352,11 +352,11 @@ let rec betree_Node_lookup_first_message_after_key then let* (l, lookup_first_message_after_key_back) = betree_Node_lookup_first_message_after_key key next_msgs in - let back_'a = + let back = fun ret -> let* next_msgs1 = lookup_first_message_after_key_back ret in Return (Betree_List_Cons (k, m) next_msgs1) in - Return (l, back_'a) + Return (l, back) else Return (Betree_List_Cons (k, m) next_msgs, Return) | Betree_List_Nil -> Return (Betree_List_Nil, Return) end @@ -453,11 +453,11 @@ let rec betree_Node_lookup_mut_in_bindings else let* (l, lookup_mut_in_bindings_back) = betree_Node_lookup_mut_in_bindings key tl in - let back_'a = + let back = fun ret -> let* tl1 = lookup_mut_in_bindings_back ret in Return (Betree_List_Cons (i, i1) tl1) in - Return (l, back_'a) + Return (l, back) | Betree_List_Nil -> Return (Betree_List_Nil, Return) end diff --git a/tests/fstar/betree/BetreeMain.FunsExternal.fsti b/tests/fstar/betree/BetreeMain.FunsExternal.fsti index de9b96fd..3aad9390 100644 --- a/tests/fstar/betree/BetreeMain.FunsExternal.fsti +++ b/tests/fstar/betree/BetreeMain.FunsExternal.fsti @@ -29,7 +29,8 @@ val betree_utils_store_leaf_node : u64 -> betree_List_t (u64 & u64) -> state -> result (state & unit) (** [core::option::{core::option::Option}::unwrap]: - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 *) + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 + Name pattern: core::option::{core::option::Option<@T>}::unwrap *) val core_option_Option_unwrap (t : Type0) : option t -> state -> result (state & t) diff --git a/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst b/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst index 2469f98c..129e6f7e 100644 --- a/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst +++ b/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst @@ -195,11 +195,11 @@ let rec betree_Node_lookup_first_message_for_key else let* (l, lookup_first_message_for_key_back) = betree_Node_lookup_first_message_for_key key next_msgs in - let back_'a = + let back = fun ret -> let* next_msgs1 = lookup_first_message_for_key_back ret in Return (Betree_List_Cons (i, m) next_msgs1) in - Return (l, back_'a) + Return (l, back) | Betree_List_Nil -> Return (Betree_List_Nil, Return) end @@ -352,11 +352,11 @@ let rec betree_Node_lookup_first_message_after_key then let* (l, lookup_first_message_after_key_back) = betree_Node_lookup_first_message_after_key key next_msgs in - let back_'a = + let back = fun ret -> let* next_msgs1 = lookup_first_message_after_key_back ret in Return (Betree_List_Cons (k, m) next_msgs1) in - Return (l, back_'a) + Return (l, back) else Return (Betree_List_Cons (k, m) next_msgs, Return) | Betree_List_Nil -> Return (Betree_List_Nil, Return) end @@ -453,11 +453,11 @@ let rec betree_Node_lookup_mut_in_bindings else let* (l, lookup_mut_in_bindings_back) = betree_Node_lookup_mut_in_bindings key tl in - let back_'a = + let back = fun ret -> let* tl1 = lookup_mut_in_bindings_back ret in Return (Betree_List_Cons (i, i1) tl1) in - Return (l, back_'a) + Return (l, back) | Betree_List_Nil -> Return (Betree_List_Nil, Return) end diff --git a/tests/fstar/betree_back_stateful/BetreeMain.FunsExternal.fsti b/tests/fstar/betree_back_stateful/BetreeMain.FunsExternal.fsti index de9b96fd..3aad9390 100644 --- a/tests/fstar/betree_back_stateful/BetreeMain.FunsExternal.fsti +++ b/tests/fstar/betree_back_stateful/BetreeMain.FunsExternal.fsti @@ -29,7 +29,8 @@ val betree_utils_store_leaf_node : u64 -> betree_List_t (u64 & u64) -> state -> result (state & unit) (** [core::option::{core::option::Option}::unwrap]: - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 *) + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 + Name pattern: core::option::{core::option::Option<@T>}::unwrap *) val core_option_Option_unwrap (t : Type0) : option t -> state -> result (state & t) diff --git a/tests/fstar/demo/Demo.fst b/tests/fstar/demo/Demo.fst index d93bc847..9c59ab9b 100644 --- a/tests/fstar/demo/Demo.fst +++ b/tests/fstar/demo/Demo.fst @@ -10,8 +10,8 @@ open Primitives let choose (t : Type0) (b : bool) (x : t) (y : t) : result (t & (t -> result (t & t))) = if b - then let back_'a = fun ret -> Return (ret, y) in Return (x, back_'a) - else let back_'a = fun ret -> Return (x, ret) in Return (y, back_'a) + then let back = fun ret -> Return (ret, y) in Return (x, back) + else let back = fun ret -> Return (x, ret) in Return (y, back) (** [demo::mul2_add1]: Source: 'src/demo.rs', lines 13:0-13:31 *) @@ -66,15 +66,14 @@ let rec list_nth_mut | CList_CCons x tl -> if i = 0 then - let back_'a = fun ret -> Return (CList_CCons ret tl) in - Return (x, back_'a) + let back = fun ret -> Return (CList_CCons ret tl) in Return (x, back) else let* i1 = u32_sub i 1 in let* (x1, list_nth_mut_back) = list_nth_mut t n1 tl i1 in - let back_'a = + let back = fun ret -> let* tl1 = list_nth_mut_back ret in Return (CList_CCons x tl1) in - Return (x1, back_'a) + Return (x1, back) | CList_CNil -> Fail Failure end @@ -92,14 +91,13 @@ let rec list_nth_mut1_loop | CList_CCons x tl -> if i = 0 then - let back_'a = fun ret -> Return (CList_CCons ret tl) in - Return (x, back_'a) + let back = fun ret -> Return (CList_CCons ret tl) in Return (x, back) else let* i1 = u32_sub i 1 in - let* (x1, back_'a) = list_nth_mut1_loop t n1 tl i1 in - let back_'a1 = - fun ret -> let* tl1 = back_'a ret in Return (CList_CCons x tl1) in - Return (x1, back_'a1) + let* (x1, back) = list_nth_mut1_loop t n1 tl i1 in + let back1 = + fun ret -> let* tl1 = back ret in Return (CList_CCons x tl1) in + Return (x1, back1) | CList_CNil -> Fail Failure end @@ -135,10 +133,10 @@ let rec list_tail begin match l with | CList_CCons x tl -> let* (c, list_tail_back) = list_tail t n1 tl in - let back_'a = + let back = fun ret -> let* tl1 = list_tail_back ret in Return (CList_CCons x tl1) in - Return (c, back_'a) + Return (c, back) | CList_CNil -> Return (CList_CNil, Return) end diff --git a/tests/fstar/hashmap/Hashmap.Funs.fst b/tests/fstar/hashmap/Hashmap.Funs.fst index fba711f1..0e770ac9 100644 --- a/tests/fstar/hashmap/Hashmap.Funs.fst +++ b/tests/fstar/hashmap/Hashmap.Funs.fst @@ -287,14 +287,13 @@ let rec hashMap_get_mut_in_list_loop | List_Cons ckey cvalue tl -> if ckey = key then - let back_'a = fun ret -> Return (List_Cons ckey ret tl) in - Return (cvalue, back_'a) + let back = fun ret -> Return (List_Cons ckey ret tl) in + Return (cvalue, back) else - let* (x, back_'a) = hashMap_get_mut_in_list_loop t tl key in - let back_'a1 = - fun ret -> let* tl1 = back_'a ret in Return (List_Cons ckey cvalue tl1) - in - Return (x, back_'a1) + let* (x, back) = hashMap_get_mut_in_list_loop t tl key in + let back1 = + fun ret -> let* tl1 = back ret in Return (List_Cons ckey cvalue tl1) in + Return (x, back1) | List_Nil -> Fail Failure end @@ -320,12 +319,12 @@ let hashMap_get_mut (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) self.slots hash_mod in let* (x, get_mut_in_list_back) = hashMap_get_mut_in_list t l key in - let back_'a = + let back = fun ret -> let* l1 = get_mut_in_list_back ret in let* v = index_mut_back l1 in Return { self with slots = v } in - Return (x, back_'a) + Return (x, back) (** [hashmap::{hashmap::HashMap}::remove_from_list]: loop 0: Source: 'src/hashmap.rs', lines 265:4-291:5 *) diff --git a/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst b/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst index 97f4151f..09928620 100644 --- a/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst +++ b/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst @@ -305,15 +305,14 @@ let rec hashmap_HashMap_get_mut_in_list_loop | Hashmap_List_Cons ckey cvalue tl -> if ckey = key then - let back_'a = fun ret -> Return (Hashmap_List_Cons ckey ret tl) in - Return (cvalue, back_'a) + let back = fun ret -> Return (Hashmap_List_Cons ckey ret tl) in + Return (cvalue, back) else - let* (x, back_'a) = hashmap_HashMap_get_mut_in_list_loop t tl key in - let back_'a1 = + let* (x, back) = hashmap_HashMap_get_mut_in_list_loop t tl key in + let back1 = fun ret -> - let* tl1 = back_'a ret in Return (Hashmap_List_Cons ckey cvalue tl1) - in - Return (x, back_'a1) + let* tl1 = back ret in Return (Hashmap_List_Cons ckey cvalue tl1) in + Return (x, back1) | Hashmap_List_Nil -> Fail Failure end @@ -339,12 +338,12 @@ let hashmap_HashMap_get_mut (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) self.slots hash_mod in let* (x, get_mut_in_list_back) = hashmap_HashMap_get_mut_in_list t l key in - let back_'a = + let back = fun ret -> let* l1 = get_mut_in_list_back ret in let* v = index_mut_back l1 in Return { self with slots = v } in - Return (x, back_'a) + Return (x, back) (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: loop 0: Source: 'src/hashmap.rs', lines 265:4-291:5 *) diff --git a/tests/fstar/misc/External.Funs.fst b/tests/fstar/misc/External.Funs.fst index 3ba20022..78960404 100644 --- a/tests/fstar/misc/External.Funs.fst +++ b/tests/fstar/misc/External.Funs.fst @@ -34,8 +34,8 @@ let custom_swap result (state & (t & (t -> state -> result (state & (t & t))))) = let* (st1, (x1, y1)) = core_mem_swap t x y st in - let back_'a = fun ret st2 -> Return (st2, (ret, y1)) in - Return (st1, (x1, back_'a)) + let back = fun ret st2 -> Return (st2, (ret, y1)) in + Return (st1, (x1, back)) (** [external::test_custom_swap]: Source: 'src/external.rs', lines 29:0-29:59 *) diff --git a/tests/fstar/misc/External.FunsExternal.fsti b/tests/fstar/misc/External.FunsExternal.fsti index a412aea9..4c1c58b7 100644 --- a/tests/fstar/misc/External.FunsExternal.fsti +++ b/tests/fstar/misc/External.FunsExternal.fsti @@ -7,16 +7,19 @@ include External.Types #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [core::mem::swap]: - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *) + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 + Name pattern: core::mem::swap *) val core_mem_swap (t : Type0) : t -> t -> state -> result (state & (t & t)) (** [core::num::nonzero::{core::num::nonzero::NonZeroU32#14}::new]: - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 79:16-79:57 *) + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 79:16-79:57 + Name pattern: core::num::nonzero::{core::num::nonzero::NonZeroU32}::new *) val core_num_nonzero_NonZeroU32_new : u32 -> state -> result (state & (option core_num_nonzero_NonZeroU32_t)) (** [core::option::{core::option::Option}::unwrap]: - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 *) + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 + Name pattern: core::option::{core::option::Option<@T>}::unwrap *) val core_option_Option_unwrap (t : Type0) : option t -> state -> result (state & t) diff --git a/tests/fstar/misc/External.TypesExternal.fsti b/tests/fstar/misc/External.TypesExternal.fsti index 4bfbe0c5..45174c7e 100644 --- a/tests/fstar/misc/External.TypesExternal.fsti +++ b/tests/fstar/misc/External.TypesExternal.fsti @@ -6,7 +6,8 @@ open Primitives #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [core::num::nonzero::NonZeroU32] - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 50:12-50:33 *) + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 50:12-50:33 + Name pattern: core::num::nonzero::NonZeroU32 *) val core_num_nonzero_NonZeroU32_t : Type0 (** The state type used in the state-error monad *) diff --git a/tests/fstar/misc/Loops.Funs.fst b/tests/fstar/misc/Loops.Funs.fst index 7c099da2..93683deb 100644 --- a/tests/fstar/misc/Loops.Funs.fst +++ b/tests/fstar/misc/Loops.Funs.fst @@ -289,18 +289,17 @@ let rec list_nth_mut_loop_pair_loop | List_Cons x1 tl1 -> if i = 0 then - let back_'a = fun ret -> Return (List_Cons ret tl0) in - let back_'b = fun ret -> Return (List_Cons ret tl1) in - Return ((x0, x1), back_'a, back_'b) + let back'a = fun ret -> Return (List_Cons ret tl0) in + let back'b = fun ret -> Return (List_Cons ret tl1) in + Return ((x0, x1), back'a, back'b) else let* i1 = u32_sub i 1 in - let* (p, back_'a, back_'b) = list_nth_mut_loop_pair_loop t tl0 tl1 i1 - in - let back_'a1 = - fun ret -> let* tl01 = back_'a ret in Return (List_Cons x0 tl01) in - let back_'b1 = - fun ret -> let* tl11 = back_'b ret in Return (List_Cons x1 tl11) in - Return (p, back_'a1, back_'b1) + let* (p, back'a, back'b) = list_nth_mut_loop_pair_loop t tl0 tl1 i1 in + let back'a1 = + fun ret -> let* tl01 = back'a ret in Return (List_Cons x0 tl01) in + let back'b1 = + fun ret -> let* tl11 = back'b ret in Return (List_Cons x1 tl11) in + Return (p, back'a1, back'b1) | List_Nil -> Fail Failure end | List_Nil -> Fail Failure @@ -352,18 +351,18 @@ let rec list_nth_mut_loop_pair_merge_loop | List_Cons x1 tl1 -> if i = 0 then - let back_'a = + let back = fun ret -> let (x, x2) = ret in Return (List_Cons x tl0, List_Cons x2 tl1) in - Return ((x0, x1), back_'a) + Return ((x0, x1), back) else let* i1 = u32_sub i 1 in - let* (p, back_'a) = list_nth_mut_loop_pair_merge_loop t tl0 tl1 i1 in - let back_'a1 = + let* (p, back) = list_nth_mut_loop_pair_merge_loop t tl0 tl1 i1 in + let back1 = fun ret -> - let* (tl01, tl11) = back_'a ret in + let* (tl01, tl11) = back ret in Return (List_Cons x0 tl01, List_Cons x1 tl11) in - Return (p, back_'a1) + Return (p, back1) | List_Nil -> Fail Failure end | List_Nil -> Fail Failure @@ -417,14 +416,14 @@ let rec list_nth_mut_shared_loop_pair_loop | List_Cons x1 tl1 -> if i = 0 then - let back_'a = fun ret -> Return (List_Cons ret tl0) in - Return ((x0, x1), back_'a) + let back = fun ret -> Return (List_Cons ret tl0) in + Return ((x0, x1), back) else let* i1 = u32_sub i 1 in - let* (p, back_'a) = list_nth_mut_shared_loop_pair_loop t tl0 tl1 i1 in - let back_'a1 = - fun ret -> let* tl01 = back_'a ret in Return (List_Cons x0 tl01) in - Return (p, back_'a1) + let* (p, back) = list_nth_mut_shared_loop_pair_loop t tl0 tl1 i1 in + let back1 = + fun ret -> let* tl01 = back ret in Return (List_Cons x0 tl01) in + Return (p, back1) | List_Nil -> Fail Failure end | List_Nil -> Fail Failure @@ -451,15 +450,15 @@ let rec list_nth_mut_shared_loop_pair_merge_loop | List_Cons x1 tl1 -> if i = 0 then - let back_'a = fun ret -> Return (List_Cons ret tl0) in - Return ((x0, x1), back_'a) + let back = fun ret -> Return (List_Cons ret tl0) in + Return ((x0, x1), back) else let* i1 = u32_sub i 1 in - let* (p, back_'a) = - list_nth_mut_shared_loop_pair_merge_loop t tl0 tl1 i1 in - let back_'a1 = - fun ret -> let* tl01 = back_'a ret in Return (List_Cons x0 tl01) in - Return (p, back_'a1) + let* (p, back) = list_nth_mut_shared_loop_pair_merge_loop t tl0 tl1 i1 + in + let back1 = + fun ret -> let* tl01 = back ret in Return (List_Cons x0 tl01) in + Return (p, back1) | List_Nil -> Fail Failure end | List_Nil -> Fail Failure @@ -486,14 +485,14 @@ let rec list_nth_shared_mut_loop_pair_loop | List_Cons x1 tl1 -> if i = 0 then - let back_'b = fun ret -> Return (List_Cons ret tl1) in - Return ((x0, x1), back_'b) + let back = fun ret -> Return (List_Cons ret tl1) in + Return ((x0, x1), back) else let* i1 = u32_sub i 1 in - let* (p, back_'b) = list_nth_shared_mut_loop_pair_loop t tl0 tl1 i1 in - let back_'b1 = - fun ret -> let* tl11 = back_'b ret in Return (List_Cons x1 tl11) in - Return (p, back_'b1) + let* (p, back) = list_nth_shared_mut_loop_pair_loop t tl0 tl1 i1 in + let back1 = + fun ret -> let* tl11 = back ret in Return (List_Cons x1 tl11) in + Return (p, back1) | List_Nil -> Fail Failure end | List_Nil -> Fail Failure @@ -520,15 +519,15 @@ let rec list_nth_shared_mut_loop_pair_merge_loop | List_Cons x1 tl1 -> if i = 0 then - let back_'a = fun ret -> Return (List_Cons ret tl1) in - Return ((x0, x1), back_'a) + let back = fun ret -> Return (List_Cons ret tl1) in + Return ((x0, x1), back) else let* i1 = u32_sub i 1 in - let* (p, back_'a) = - list_nth_shared_mut_loop_pair_merge_loop t tl0 tl1 i1 in - let back_'a1 = - fun ret -> let* tl11 = back_'a ret in Return (List_Cons x1 tl11) in - Return (p, back_'a1) + let* (p, back) = list_nth_shared_mut_loop_pair_merge_loop t tl0 tl1 i1 + in + let back1 = + fun ret -> let* tl11 = back ret in Return (List_Cons x1 tl11) in + Return (p, back1) | List_Nil -> Fail Failure end | List_Nil -> Fail Failure diff --git a/tests/fstar/misc/NoNestedBorrows.fst b/tests/fstar/misc/NoNestedBorrows.fst index db63eb0d..1a93beaa 100644 --- a/tests/fstar/misc/NoNestedBorrows.fst +++ b/tests/fstar/misc/NoNestedBorrows.fst @@ -291,8 +291,8 @@ let _ = assert_norm (test_split_list = Return ()) let choose (t : Type0) (b : bool) (x : t) (y : t) : result (t & (t -> result (t & t))) = if b - then let back_'a = fun ret -> Return (ret, y) in Return (x, back_'a) - else let back_'a = fun ret -> Return (x, ret) in Return (y, back_'a) + then let back = fun ret -> Return (ret, y) in Return (x, back) + else let back = fun ret -> Return (x, ret) in Return (y, back) (** [no_nested_borrows::choose_test]: Source: 'src/no_nested_borrows.rs', lines 282:0-282:20 *) @@ -355,15 +355,14 @@ let rec list_nth_mut begin match l with | List_Cons x tl -> if i = 0 - then - let back_'a = fun ret -> Return (List_Cons ret tl) in Return (x, back_'a) + then let back = fun ret -> Return (List_Cons ret tl) in Return (x, back) else let* i1 = u32_sub i 1 in let* (x1, list_nth_mut_back) = list_nth_mut t tl i1 in - let back_'a = + let back = fun ret -> let* tl1 = list_nth_mut_back ret in Return (List_Cons x tl1) in - Return (x1, back_'a) + Return (x1, back) | List_Nil -> Fail Failure end diff --git a/tests/fstar/misc/Paper.fst b/tests/fstar/misc/Paper.fst index ddc5e7a8..c2f47ad1 100644 --- a/tests/fstar/misc/Paper.fst +++ b/tests/fstar/misc/Paper.fst @@ -23,8 +23,8 @@ let _ = assert_norm (test_incr = Return ()) let choose (t : Type0) (b : bool) (x : t) (y : t) : result (t & (t -> result (t & t))) = if b - then let back_'a = fun ret -> Return (ret, y) in Return (x, back_'a) - else let back_'a = fun ret -> Return (x, ret) in Return (y, back_'a) + then let back = fun ret -> Return (ret, y) in Return (x, back) + else let back = fun ret -> Return (x, ret) in Return (y, back) (** [paper::test_choose]: Source: 'src/paper.rs', lines 23:0-23:20 *) @@ -57,15 +57,14 @@ let rec list_nth_mut begin match l with | List_Cons x tl -> if i = 0 - then - let back_'a = fun ret -> Return (List_Cons ret tl) in Return (x, back_'a) + then let back = fun ret -> Return (List_Cons ret tl) in Return (x, back) else let* i1 = u32_sub i 1 in let* (x1, list_nth_mut_back) = list_nth_mut t tl i1 in - let back_'a = + let back = fun ret -> let* tl1 = list_nth_mut_back ret in Return (List_Cons x tl1) in - Return (x1, back_'a) + Return (x1, back) | List_Nil -> Fail Failure end diff --git a/tests/fstar/misc/PoloniusList.fst b/tests/fstar/misc/PoloniusList.fst index b477802b..4203247e 100644 --- a/tests/fstar/misc/PoloniusList.fst +++ b/tests/fstar/misc/PoloniusList.fst @@ -23,10 +23,10 @@ let rec get_list_at_x then Return (List_Cons hd tl, Return) else let* (l, get_list_at_x_back) = get_list_at_x tl x in - let back_'a = + let back = fun ret -> let* tl1 = get_list_at_x_back ret in Return (List_Cons hd tl1) in - Return (l, back_'a) + Return (l, back) | List_Nil -> Return (List_Nil, Return) end diff --git a/tests/fstar/traits/Traits.fst b/tests/fstar/traits/Traits.fst index fba564a5..199d49bf 100644 --- a/tests/fstar/traits/Traits.fst +++ b/tests/fstar/traits/Traits.fst @@ -503,7 +503,8 @@ let use_wrapper_len (t : Type0) (traitInst : trait_t t) : result usize = type foo_t (t u : Type0) = { x : t; y : u; } (** [core::result::Result] - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/result.rs', lines 502:0-502:21 *) + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/result.rs', lines 502:0-502:21 + Name pattern: core::result::Result *) type core_result_Result_t (t e : Type0) = | Core_result_Result_Ok : t -> core_result_Result_t t e | Core_result_Result_Err : e -> core_result_Result_t t e diff --git a/tests/lean/BetreeMain/Funs.lean b/tests/lean/BetreeMain/Funs.lean index ca9b48da..2fbcd6a4 100644 --- a/tests/lean/BetreeMain/Funs.lean +++ b/tests/lean/BetreeMain/Funs.lean @@ -192,12 +192,12 @@ divergent def betree.Node.lookup_first_message_for_key do let (l, lookup_first_message_for_key_back) ← betree.Node.lookup_first_message_for_key key next_msgs - let back_'a := + let back := fun ret => do let next_msgs1 ← lookup_first_message_for_key_back ret Result.ret (betree.List.Cons (i, m) next_msgs1) - Result.ret (l, back_'a) + Result.ret (l, back) | betree.List.Nil => Result.ret (betree.List.Nil, Result.ret) /- [betree_main::betree::{betree_main::betree::Node#5}::lookup_in_bindings]: @@ -364,12 +364,12 @@ divergent def betree.Node.lookup_first_message_after_key do let (l, lookup_first_message_after_key_back) ← betree.Node.lookup_first_message_after_key key next_msgs - let back_'a := + let back := fun ret => do let next_msgs1 ← lookup_first_message_after_key_back ret Result.ret (betree.List.Cons (k, m) next_msgs1) - Result.ret (l, back_'a) + Result.ret (l, back) else Result.ret (betree.List.Cons (k, m) next_msgs, Result.ret) | betree.List.Nil => Result.ret (betree.List.Nil, Result.ret) @@ -468,12 +468,12 @@ divergent def betree.Node.lookup_mut_in_bindings do let (l, lookup_mut_in_bindings_back) ← betree.Node.lookup_mut_in_bindings key tl - let back_'a := + let back := fun ret => do let tl1 ← lookup_mut_in_bindings_back ret Result.ret (betree.List.Cons (i, i1) tl1) - Result.ret (l, back_'a) + Result.ret (l, back) | betree.List.Nil => Result.ret (betree.List.Nil, Result.ret) /- [betree_main::betree::{betree_main::betree::Node#5}::apply_to_leaf]: diff --git a/tests/lean/BetreeMain/FunsExternal_Template.lean b/tests/lean/BetreeMain/FunsExternal_Template.lean index eaa4b6c2..0b3e4ef4 100644 --- a/tests/lean/BetreeMain/FunsExternal_Template.lean +++ b/tests/lean/BetreeMain/FunsExternal_Template.lean @@ -29,7 +29,8 @@ axiom betree_utils.store_leaf_node : U64 → betree.List (U64 × U64) → State → Result (State × Unit) /- [core::option::{core::option::Option}::unwrap]: - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 -/ + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 + Name pattern: core::option::{core::option::Option<@T>}::unwrap -/ axiom core.option.Option.unwrap (T : Type) : Option T → State → Result (State × T) diff --git a/tests/lean/Demo/Demo.lean b/tests/lean/Demo/Demo.lean index 4acc69c8..6d9fef8e 100644 --- a/tests/lean/Demo/Demo.lean +++ b/tests/lean/Demo/Demo.lean @@ -12,10 +12,10 @@ def choose Result (T × (T → Result (T × T))) := if b - then let back_'a := fun ret => Result.ret (ret, y) - Result.ret (x, back_'a) - else let back_'a := fun ret => Result.ret (x, ret) - Result.ret (y, back_'a) + then let back := fun ret => Result.ret (ret, y) + Result.ret (x, back) + else let back := fun ret => Result.ret (x, ret) + Result.ret (y, back) /- [demo::mul2_add1]: Source: 'src/demo.rs', lines 13:0-13:31 -/ @@ -73,18 +73,18 @@ divergent def list_nth_mut | CList.CCons x tl => if i = 0#u32 then - let back_'a := fun ret => Result.ret (CList.CCons ret tl) - Result.ret (x, back_'a) + let back := fun ret => Result.ret (CList.CCons ret tl) + Result.ret (x, back) else do let i1 ← i - 1#u32 let (t, list_nth_mut_back) ← list_nth_mut T tl i1 - let back_'a := + let back := fun ret => do let tl1 ← list_nth_mut_back ret Result.ret (CList.CCons x tl1) - Result.ret (t, back_'a) + Result.ret (t, back) | CList.CNil => Result.fail .panic /- [demo::list_nth_mut1]: loop 0: @@ -97,17 +97,17 @@ divergent def list_nth_mut1_loop | CList.CCons x tl => if i = 0#u32 then - let back_'a := fun ret => Result.ret (CList.CCons ret tl) - Result.ret (x, back_'a) + let back := fun ret => Result.ret (CList.CCons ret tl) + Result.ret (x, back) else do let i1 ← i - 1#u32 - let (t, back_'a) ← list_nth_mut1_loop T tl i1 - let back_'a1 := + let (t, back) ← list_nth_mut1_loop T tl i1 + let back1 := fun ret => do - let tl1 ← back_'a ret + let tl1 ← back ret Result.ret (CList.CCons x tl1) - Result.ret (t, back_'a1) + Result.ret (t, back1) | CList.CNil => Result.fail .panic /- [demo::list_nth_mut1]: @@ -138,12 +138,12 @@ divergent def list_tail | CList.CCons t tl => do let (c, list_tail_back) ← list_tail T tl - let back_'a := + let back := fun ret => do let tl1 ← list_tail_back ret Result.ret (CList.CCons t tl1) - Result.ret (c, back_'a) + Result.ret (c, back) | CList.CNil => Result.ret (CList.CNil, Result.ret) /- Trait declaration: [demo::Counter] diff --git a/tests/lean/External/Funs.lean b/tests/lean/External/Funs.lean index 8b645037..cfb2cb3c 100644 --- a/tests/lean/External/Funs.lean +++ b/tests/lean/External/Funs.lean @@ -39,8 +39,8 @@ def custom_swap := do let (st1, (x1, y1)) ← core.mem.swap T x y st - let back_'a := fun ret st2 => Result.ret (st2, (ret, y1)) - Result.ret (st1, (x1, back_'a)) + let back := fun ret st2 => Result.ret (st2, (ret, y1)) + Result.ret (st1, (x1, back)) /- [external::test_custom_swap]: Source: 'src/external.rs', lines 29:0-29:59 -/ diff --git a/tests/lean/External/FunsExternal_Template.lean b/tests/lean/External/FunsExternal_Template.lean index 7e237369..38151dc9 100644 --- a/tests/lean/External/FunsExternal_Template.lean +++ b/tests/lean/External/FunsExternal_Template.lean @@ -7,17 +7,20 @@ open Primitives open external /- [core::mem::swap]: - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 -/ + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 + Name pattern: core::mem::swap -/ axiom core.mem.swap (T : Type) : T → T → State → Result (State × (T × T)) /- [core::num::nonzero::{core::num::nonzero::NonZeroU32#14}::new]: - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 79:16-79:57 -/ + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 79:16-79:57 + Name pattern: core::num::nonzero::{core::num::nonzero::NonZeroU32}::new -/ axiom core.num.nonzero.NonZeroU32.new : U32 → State → Result (State × (Option core.num.nonzero.NonZeroU32)) /- [core::option::{core::option::Option}::unwrap]: - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 -/ + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/option.rs', lines 932:4-932:34 + Name pattern: core::option::{core::option::Option<@T>}::unwrap -/ axiom core.option.Option.unwrap (T : Type) : Option T → State → Result (State × T) diff --git a/tests/lean/External/TypesExternal_Template.lean b/tests/lean/External/TypesExternal_Template.lean index 85fef236..84245531 100644 --- a/tests/lean/External/TypesExternal_Template.lean +++ b/tests/lean/External/TypesExternal_Template.lean @@ -5,7 +5,8 @@ import Base open Primitives /- [core::num::nonzero::NonZeroU32] - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 50:12-50:33 -/ + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/num/nonzero.rs', lines 50:12-50:33 + Name pattern: core::num::nonzero::NonZeroU32 -/ axiom core.num.nonzero.NonZeroU32 : Type /- The state type used in the state-error monad -/ diff --git a/tests/lean/Hashmap/Funs.lean b/tests/lean/Hashmap/Funs.lean index 1c95f7c9..0067538e 100644 --- a/tests/lean/Hashmap/Funs.lean +++ b/tests/lean/Hashmap/Funs.lean @@ -287,17 +287,17 @@ divergent def HashMap.get_mut_in_list_loop | List.Cons ckey cvalue tl => if ckey = key then - let back_'a := fun ret => Result.ret (List.Cons ckey ret tl) - Result.ret (cvalue, back_'a) + let back := fun ret => Result.ret (List.Cons ckey ret tl) + Result.ret (cvalue, back) else do - let (t, back_'a) ← HashMap.get_mut_in_list_loop T tl key - let back_'a1 := + let (t, back) ← HashMap.get_mut_in_list_loop T tl key + let back1 := fun ret => do - let tl1 ← back_'a ret + let tl1 ← back ret Result.ret (List.Cons ckey cvalue tl1) - Result.ret (t, back_'a1) + Result.ret (t, back1) | List.Nil => Result.fail .panic /- [hashmap::{hashmap::HashMap}::get_mut_in_list]: @@ -322,13 +322,13 @@ def HashMap.get_mut alloc.vec.Vec.index_mut (List T) Usize (core.slice.index.SliceIndexUsizeSliceTInst (List T)) self.slots hash_mod let (t, get_mut_in_list_back) ← HashMap.get_mut_in_list T l key - let back_'a := + let back := fun ret => do let l1 ← get_mut_in_list_back ret let v ← index_mut_back l1 Result.ret { self with slots := v } - Result.ret (t, back_'a) + Result.ret (t, back) /- [hashmap::{hashmap::HashMap}::remove_from_list]: loop 0: Source: 'src/hashmap.rs', lines 265:4-291:5 -/ diff --git a/tests/lean/HashmapMain/Funs.lean b/tests/lean/HashmapMain/Funs.lean index 6a6934b8..0bf6c641 100644 --- a/tests/lean/HashmapMain/Funs.lean +++ b/tests/lean/HashmapMain/Funs.lean @@ -302,17 +302,17 @@ divergent def hashmap.HashMap.get_mut_in_list_loop | hashmap.List.Cons ckey cvalue tl => if ckey = key then - let back_'a := fun ret => Result.ret (hashmap.List.Cons ckey ret tl) - Result.ret (cvalue, back_'a) + let back := fun ret => Result.ret (hashmap.List.Cons ckey ret tl) + Result.ret (cvalue, back) else do - let (t, back_'a) ← hashmap.HashMap.get_mut_in_list_loop T tl key - let back_'a1 := + let (t, back) ← hashmap.HashMap.get_mut_in_list_loop T tl key + let back1 := fun ret => do - let tl1 ← back_'a ret + let tl1 ← back ret Result.ret (hashmap.List.Cons ckey cvalue tl1) - Result.ret (t, back_'a1) + Result.ret (t, back1) | hashmap.List.Nil => Result.fail .panic /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut_in_list]: @@ -338,13 +338,13 @@ def hashmap.HashMap.get_mut (core.slice.index.SliceIndexUsizeSliceTInst (hashmap.List T)) self.slots hash_mod let (t, get_mut_in_list_back) ← hashmap.HashMap.get_mut_in_list T l key - let back_'a := + let back := fun ret => do let l1 ← get_mut_in_list_back ret let v ← index_mut_back l1 Result.ret { self with slots := v } - Result.ret (t, back_'a) + Result.ret (t, back) /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: loop 0: Source: 'src/hashmap.rs', lines 265:4-291:5 -/ diff --git a/tests/lean/Loops.lean b/tests/lean/Loops.lean index 0f3d77c2..27434db8 100644 --- a/tests/lean/Loops.lean +++ b/tests/lean/Loops.lean @@ -295,22 +295,22 @@ divergent def list_nth_mut_loop_pair_loop | List.Cons x1 tl1 => if i = 0#u32 then - let back_'a := fun ret => Result.ret (List.Cons ret tl0) - let back_'b := fun ret => Result.ret (List.Cons ret tl1) - Result.ret ((x0, x1), back_'a, back_'b) + let back'a := fun ret => Result.ret (List.Cons ret tl0) + let back'b := fun ret => Result.ret (List.Cons ret tl1) + Result.ret ((x0, x1), back'a, back'b) else do let i1 ← i - 1#u32 - let (p, back_'a, back_'b) ← list_nth_mut_loop_pair_loop T tl0 tl1 i1 - let back_'a1 := + let (p, back'a, back'b) ← list_nth_mut_loop_pair_loop T tl0 tl1 i1 + let back'a1 := fun ret => do - let tl01 ← back_'a ret + let tl01 ← back'a ret Result.ret (List.Cons x0 tl01) - let back_'b1 := + let back'b1 := fun ret => do - let tl11 ← back_'b ret + let tl11 ← back'b ret Result.ret (List.Cons x1 tl11) - Result.ret (p, back_'a1, back_'b1) + Result.ret (p, back'a1, back'b1) | List.Nil => Result.fail .panic | List.Nil => Result.fail .panic @@ -356,21 +356,21 @@ divergent def list_nth_mut_loop_pair_merge_loop | List.Cons x1 tl1 => if i = 0#u32 then - let back_'a := + let back := fun ret => let (t, t1) := ret Result.ret (List.Cons t tl0, List.Cons t1 tl1) - Result.ret ((x0, x1), back_'a) + Result.ret ((x0, x1), back) else do let i1 ← i - 1#u32 - let (p, back_'a) ← list_nth_mut_loop_pair_merge_loop T tl0 tl1 i1 - let back_'a1 := + let (p, back) ← list_nth_mut_loop_pair_merge_loop T tl0 tl1 i1 + let back1 := fun ret => do - let (tl01, tl11) ← back_'a ret + let (tl01, tl11) ← back ret Result.ret (List.Cons x0 tl01, List.Cons x1 tl11) - Result.ret (p, back_'a1) + Result.ret (p, back1) | List.Nil => Result.fail .panic | List.Nil => Result.fail .panic @@ -417,17 +417,17 @@ divergent def list_nth_mut_shared_loop_pair_loop | List.Cons x1 tl1 => if i = 0#u32 then - let back_'a := fun ret => Result.ret (List.Cons ret tl0) - Result.ret ((x0, x1), back_'a) + let back := fun ret => Result.ret (List.Cons ret tl0) + Result.ret ((x0, x1), back) else do let i1 ← i - 1#u32 - let (p, back_'a) ← list_nth_mut_shared_loop_pair_loop T tl0 tl1 i1 - let back_'a1 := + let (p, back) ← list_nth_mut_shared_loop_pair_loop T tl0 tl1 i1 + let back1 := fun ret => do - let tl01 ← back_'a ret + let tl01 ← back ret Result.ret (List.Cons x0 tl01) - Result.ret (p, back_'a1) + Result.ret (p, back1) | List.Nil => Result.fail .panic | List.Nil => Result.fail .panic @@ -451,18 +451,17 @@ divergent def list_nth_mut_shared_loop_pair_merge_loop | List.Cons x1 tl1 => if i = 0#u32 then - let back_'a := fun ret => Result.ret (List.Cons ret tl0) - Result.ret ((x0, x1), back_'a) + let back := fun ret => Result.ret (List.Cons ret tl0) + Result.ret ((x0, x1), back) else do let i1 ← i - 1#u32 - let (p, back_'a) ← - list_nth_mut_shared_loop_pair_merge_loop T tl0 tl1 i1 - let back_'a1 := + let (p, back) ← list_nth_mut_shared_loop_pair_merge_loop T tl0 tl1 i1 + let back1 := fun ret => do - let tl01 ← back_'a ret + let tl01 ← back ret Result.ret (List.Cons x0 tl01) - Result.ret (p, back_'a1) + Result.ret (p, back1) | List.Nil => Result.fail .panic | List.Nil => Result.fail .panic @@ -486,17 +485,17 @@ divergent def list_nth_shared_mut_loop_pair_loop | List.Cons x1 tl1 => if i = 0#u32 then - let back_'b := fun ret => Result.ret (List.Cons ret tl1) - Result.ret ((x0, x1), back_'b) + let back := fun ret => Result.ret (List.Cons ret tl1) + Result.ret ((x0, x1), back) else do let i1 ← i - 1#u32 - let (p, back_'b) ← list_nth_shared_mut_loop_pair_loop T tl0 tl1 i1 - let back_'b1 := + let (p, back) ← list_nth_shared_mut_loop_pair_loop T tl0 tl1 i1 + let back1 := fun ret => do - let tl11 ← back_'b ret + let tl11 ← back ret Result.ret (List.Cons x1 tl11) - Result.ret (p, back_'b1) + Result.ret (p, back1) | List.Nil => Result.fail .panic | List.Nil => Result.fail .panic @@ -520,18 +519,17 @@ divergent def list_nth_shared_mut_loop_pair_merge_loop | List.Cons x1 tl1 => if i = 0#u32 then - let back_'a := fun ret => Result.ret (List.Cons ret tl1) - Result.ret ((x0, x1), back_'a) + let back := fun ret => Result.ret (List.Cons ret tl1) + Result.ret ((x0, x1), back) else do let i1 ← i - 1#u32 - let (p, back_'a) ← - list_nth_shared_mut_loop_pair_merge_loop T tl0 tl1 i1 - let back_'a1 := + let (p, back) ← list_nth_shared_mut_loop_pair_merge_loop T tl0 tl1 i1 + let back1 := fun ret => do - let tl11 ← back_'a ret + let tl11 ← back ret Result.ret (List.Cons x1 tl11) - Result.ret (p, back_'a1) + Result.ret (p, back1) | List.Nil => Result.fail .panic | List.Nil => Result.fail .panic diff --git a/tests/lean/NoNestedBorrows.lean b/tests/lean/NoNestedBorrows.lean index 5f9ec0f2..b90f6aef 100644 --- a/tests/lean/NoNestedBorrows.lean +++ b/tests/lean/NoNestedBorrows.lean @@ -331,10 +331,10 @@ def choose Result (T × (T → Result (T × T))) := if b - then let back_'a := fun ret => Result.ret (ret, y) - Result.ret (x, back_'a) - else let back_'a := fun ret => Result.ret (x, ret) - Result.ret (y, back_'a) + then let back := fun ret => Result.ret (ret, y) + Result.ret (x, back) + else let back := fun ret => Result.ret (x, ret) + Result.ret (y, back) /- [no_nested_borrows::choose_test]: Source: 'src/no_nested_borrows.rs', lines 282:0-282:20 -/ @@ -406,18 +406,18 @@ divergent def list_nth_mut | List.Cons x tl => if i = 0#u32 then - let back_'a := fun ret => Result.ret (List.Cons ret tl) - Result.ret (x, back_'a) + let back := fun ret => Result.ret (List.Cons ret tl) + Result.ret (x, back) else do let i1 ← i - 1#u32 let (t, list_nth_mut_back) ← list_nth_mut T tl i1 - let back_'a := + let back := fun ret => do let tl1 ← list_nth_mut_back ret Result.ret (List.Cons x tl1) - Result.ret (t, back_'a) + Result.ret (t, back) | List.Nil => Result.fail .panic /- [no_nested_borrows::list_rev_aux]: diff --git a/tests/lean/Paper.lean b/tests/lean/Paper.lean index 924ff36c..5b00aa83 100644 --- a/tests/lean/Paper.lean +++ b/tests/lean/Paper.lean @@ -29,10 +29,10 @@ def choose Result (T × (T → Result (T × T))) := if b - then let back_'a := fun ret => Result.ret (ret, y) - Result.ret (x, back_'a) - else let back_'a := fun ret => Result.ret (x, ret) - Result.ret (y, back_'a) + then let back := fun ret => Result.ret (ret, y) + Result.ret (x, back) + else let back := fun ret => Result.ret (x, ret) + Result.ret (y, back) /- [paper::test_choose]: Source: 'src/paper.rs', lines 23:0-23:20 -/ @@ -68,18 +68,18 @@ divergent def list_nth_mut | List.Cons x tl => if i = 0#u32 then - let back_'a := fun ret => Result.ret (List.Cons ret tl) - Result.ret (x, back_'a) + let back := fun ret => Result.ret (List.Cons ret tl) + Result.ret (x, back) else do let i1 ← i - 1#u32 let (t, list_nth_mut_back) ← list_nth_mut T tl i1 - let back_'a := + let back := fun ret => do let tl1 ← list_nth_mut_back ret Result.ret (List.Cons x tl1) - Result.ret (t, back_'a) + Result.ret (t, back) | List.Nil => Result.fail .panic /- [paper::sum]: diff --git a/tests/lean/PoloniusList.lean b/tests/lean/PoloniusList.lean index 59c557a0..c657237f 100644 --- a/tests/lean/PoloniusList.lean +++ b/tests/lean/PoloniusList.lean @@ -24,12 +24,12 @@ divergent def get_list_at_x else do let (l, get_list_at_x_back) ← get_list_at_x tl x - let back_'a := + let back := fun ret => do let tl1 ← get_list_at_x_back ret Result.ret (List.Cons hd tl1) - Result.ret (l, back_'a) + Result.ret (l, back) | List.Nil => Result.ret (List.Nil, Result.ret) end polonius_list diff --git a/tests/lean/Traits.lean b/tests/lean/Traits.lean index acddd1a9..766b109d 100644 --- a/tests/lean/Traits.lean +++ b/tests/lean/Traits.lean @@ -512,7 +512,8 @@ structure Foo (T U : Type) where y : U /- [core::result::Result] - Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/result.rs', lines 502:0-502:21 -/ + Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/result.rs', lines 502:0-502:21 + Name pattern: core::result::Result -/ inductive core.result.Result (T E : Type) := | Ok : T → core.result.Result T E | Err : E → core.result.Result T E -- cgit v1.2.3 From bac38f94aacf4a0d621b0b2d2c423db9e0c6f175 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 4 Apr 2024 13:21:08 +0200 Subject: Improve the name of the backward functions further --- compiler/PureUtils.ml | 11 ++++++++--- compiler/SymbolicToPure.ml | 13 +++++++++++-- 2 files changed, 19 insertions(+), 5 deletions(-) diff --git a/compiler/PureUtils.ml b/compiler/PureUtils.ml index 4bc90872..6f44bb74 100644 --- a/compiler/PureUtils.ml +++ b/compiler/PureUtils.ml @@ -75,10 +75,15 @@ let inputs_info_is_wf (info : inputs_info) : bool = let fun_sig_info_is_wf (info : fun_sig_info) : bool = inputs_info_is_wf info.fwd_info +let opt_dest_arrow_ty (ty : ty) : (ty * ty) option = + match ty with TArrow (arg_ty, ret_ty) -> Some (arg_ty, ret_ty) | _ -> None + +let is_arrow_ty (ty : ty) : bool = Option.is_some (opt_dest_arrow_ty ty) + let dest_arrow_ty (meta : Meta.meta) (ty : ty) : ty * ty = - match ty with - | TArrow (arg_ty, ret_ty) -> (arg_ty, ret_ty) - | _ -> craise __FILE__ __LINE__ meta "Not an arrow type" + match opt_dest_arrow_ty ty with + | Some (arg_ty, ret_ty) -> (arg_ty, ret_ty) + | None -> craise __FILE__ __LINE__ meta "Not an arrow type" let compute_literal_type (cv : literal) : literal_type = match cv with diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 7e970029..67fd2c9b 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -1499,7 +1499,14 @@ let fresh_back_vars_for_current_fun (ctx : bs_ctx) let back_vars = List.map (fun (name, ty) -> - match ty with None -> None | Some ty -> Some (name, ty)) + match ty with + | None -> None + | Some ty -> + (* If the type is not an arrow type, don't use the name "back" + (it is a backward function with no inputs, that is to say a + value) *) + let name = if is_arrow_ty ty then name else None in + Some (name, ty)) back_vars in (* If there is one backward function or less, we use the name "back" @@ -1508,7 +1515,9 @@ let fresh_back_vars_for_current_fun (ctx : bs_ctx) let num_back_vars = List.length (List.filter_map (fun x -> x) back_vars) in let back_vars = if num_back_vars = 1 then - List.map (Option.map (fun (_, ty) -> (Some "back", ty))) back_vars + List.map + (Option.map (fun (name, ty) -> (Option.map (fun _ -> "back") name, ty))) + back_vars else back_vars in fresh_opt_vars back_vars ctx -- cgit v1.2.3 From 46f64c1b9f3bfc2703186b32a74c611e0e43f63f Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 4 Apr 2024 13:21:47 +0200 Subject: Regenerate the test files --- tests/coq/hashmap/Hashmap_Funs.v | 12 ++++++------ tests/coq/hashmap_on_disk/HashmapMain_Funs.v | 12 ++++++------ tests/fstar/hashmap/Hashmap.Funs.fst | 12 ++++++------ tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst | 12 ++++++------ tests/lean/Hashmap/Funs.lean | 12 ++++++------ tests/lean/HashmapMain/Funs.lean | 12 ++++++------ 6 files changed, 36 insertions(+), 36 deletions(-) diff --git a/tests/coq/hashmap/Hashmap_Funs.v b/tests/coq/hashmap/Hashmap_Funs.v index 67543c8e..c0cde78d 100644 --- a/tests/coq/hashmap/Hashmap_Funs.v +++ b/tests/coq/hashmap/Hashmap_Funs.v @@ -94,13 +94,13 @@ Fixpoint hashMap_clear_loop Source: 'src/hashmap.rs', lines 80:4-80:27 *) Definition hashMap_clear (T : Type) (n : nat) (self : HashMap_t T) : result (HashMap_t T) := - back <- hashMap_clear_loop T n self.(hashMap_slots) 0%usize; + hm <- hashMap_clear_loop T n self.(hashMap_slots) 0%usize; Return {| hashMap_num_entries := 0%usize; hashMap_max_load_factor := self.(hashMap_max_load_factor); hashMap_max_load := self.(hashMap_max_load); - hashMap_slots := back + hashMap_slots := hm |} . @@ -125,8 +125,8 @@ Fixpoint hashMap_insert_in_list_loop then Return (false, List_Cons ckey value tl) else ( p <- hashMap_insert_in_list_loop T n1 key value tl; - let (b, back) := p in - Return (b, List_Cons ckey cvalue back)) + let (b, tl1) := p in + Return (b, List_Cons ckey cvalue tl1)) | List_Nil => Return (true, List_Cons key value List_Nil) end end @@ -450,8 +450,8 @@ Fixpoint hashMap_remove_from_list_loop end else ( p <- hashMap_remove_from_list_loop T n1 key tl; - let (o, back) := p in - Return (o, List_Cons ckey t back)) + let (o, tl1) := p in + Return (o, List_Cons ckey t tl1)) | List_Nil => Return (None, List_Nil) end end diff --git a/tests/coq/hashmap_on_disk/HashmapMain_Funs.v b/tests/coq/hashmap_on_disk/HashmapMain_Funs.v index a614e52d..8e299800 100644 --- a/tests/coq/hashmap_on_disk/HashmapMain_Funs.v +++ b/tests/coq/hashmap_on_disk/HashmapMain_Funs.v @@ -104,13 +104,13 @@ Definition hashmap_HashMap_clear (T : Type) (n : nat) (self : hashmap_HashMap_t T) : result (hashmap_HashMap_t T) := - back <- hashmap_HashMap_clear_loop T n self.(hashmap_HashMap_slots) 0%usize; + hm <- hashmap_HashMap_clear_loop T n self.(hashmap_HashMap_slots) 0%usize; Return {| hashmap_HashMap_num_entries := 0%usize; hashmap_HashMap_max_load_factor := self.(hashmap_HashMap_max_load_factor); hashmap_HashMap_max_load := self.(hashmap_HashMap_max_load); - hashmap_HashMap_slots := back + hashmap_HashMap_slots := hm |} . @@ -136,8 +136,8 @@ Fixpoint hashmap_HashMap_insert_in_list_loop then Return (false, Hashmap_List_Cons ckey value tl) else ( p <- hashmap_HashMap_insert_in_list_loop T n1 key value tl; - let (b, back) := p in - Return (b, Hashmap_List_Cons ckey cvalue back)) + let (b, tl1) := p in + Return (b, Hashmap_List_Cons ckey cvalue tl1)) | Hashmap_List_Nil => Return (true, Hashmap_List_Cons key value Hashmap_List_Nil) end @@ -474,8 +474,8 @@ Fixpoint hashmap_HashMap_remove_from_list_loop end else ( p <- hashmap_HashMap_remove_from_list_loop T n1 key tl; - let (o, back) := p in - Return (o, Hashmap_List_Cons ckey t back)) + let (o, tl1) := p in + Return (o, Hashmap_List_Cons ckey t tl1)) | Hashmap_List_Nil => Return (None, Hashmap_List_Nil) end end diff --git a/tests/fstar/hashmap/Hashmap.Funs.fst b/tests/fstar/hashmap/Hashmap.Funs.fst index 0e770ac9..d897933a 100644 --- a/tests/fstar/hashmap/Hashmap.Funs.fst +++ b/tests/fstar/hashmap/Hashmap.Funs.fst @@ -79,8 +79,8 @@ let rec hashMap_clear_loop (** [hashmap::{hashmap::HashMap}::clear]: Source: 'src/hashmap.rs', lines 80:4-80:27 *) let hashMap_clear (t : Type0) (self : hashMap_t t) : result (hashMap_t t) = - let* back = hashMap_clear_loop t self.slots 0 in - Return { self with num_entries = 0; slots = back } + let* hm = hashMap_clear_loop t self.slots 0 in + Return { self with num_entries = 0; slots = hm } (** [hashmap::{hashmap::HashMap}::len]: Source: 'src/hashmap.rs', lines 90:4-90:30 *) @@ -99,8 +99,8 @@ let rec hashMap_insert_in_list_loop if ckey = key then Return (false, List_Cons ckey value tl) else - let* (b, back) = hashMap_insert_in_list_loop t key value tl in - Return (b, List_Cons ckey cvalue back) + let* (b, tl1) = hashMap_insert_in_list_loop t key value tl in + Return (b, List_Cons ckey cvalue tl1) | List_Nil -> Return (true, List_Cons key value List_Nil) end @@ -344,8 +344,8 @@ let rec hashMap_remove_from_list_loop | List_Nil -> Fail Failure end else - let* (o, back) = hashMap_remove_from_list_loop t key tl in - Return (o, List_Cons ckey x back) + let* (o, tl1) = hashMap_remove_from_list_loop t key tl in + Return (o, List_Cons ckey x tl1) | List_Nil -> Return (None, List_Nil) end diff --git a/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst b/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst index 09928620..e0005c81 100644 --- a/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst +++ b/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst @@ -84,8 +84,8 @@ let rec hashmap_HashMap_clear_loop Source: 'src/hashmap.rs', lines 80:4-80:27 *) let hashmap_HashMap_clear (t : Type0) (self : hashmap_HashMap_t t) : result (hashmap_HashMap_t t) = - let* back = hashmap_HashMap_clear_loop t self.slots 0 in - Return { self with num_entries = 0; slots = back } + let* hm = hashmap_HashMap_clear_loop t self.slots 0 in + Return { self with num_entries = 0; slots = hm } (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::len]: Source: 'src/hashmap.rs', lines 90:4-90:30 *) @@ -105,8 +105,8 @@ let rec hashmap_HashMap_insert_in_list_loop if ckey = key then Return (false, Hashmap_List_Cons ckey value tl) else - let* (b, back) = hashmap_HashMap_insert_in_list_loop t key value tl in - Return (b, Hashmap_List_Cons ckey cvalue back) + let* (b, tl1) = hashmap_HashMap_insert_in_list_loop t key value tl in + Return (b, Hashmap_List_Cons ckey cvalue tl1) | Hashmap_List_Nil -> Return (true, Hashmap_List_Cons key value Hashmap_List_Nil) end @@ -364,8 +364,8 @@ let rec hashmap_HashMap_remove_from_list_loop | Hashmap_List_Nil -> Fail Failure end else - let* (o, back) = hashmap_HashMap_remove_from_list_loop t key tl in - Return (o, Hashmap_List_Cons ckey x back) + let* (o, tl1) = hashmap_HashMap_remove_from_list_loop t key tl in + Return (o, Hashmap_List_Cons ckey x tl1) | Hashmap_List_Nil -> Return (None, Hashmap_List_Nil) end diff --git a/tests/lean/Hashmap/Funs.lean b/tests/lean/Hashmap/Funs.lean index 0067538e..363d751a 100644 --- a/tests/lean/Hashmap/Funs.lean +++ b/tests/lean/Hashmap/Funs.lean @@ -79,8 +79,8 @@ divergent def HashMap.clear_loop Source: 'src/hashmap.rs', lines 80:4-80:27 -/ def HashMap.clear (T : Type) (self : HashMap T) : Result (HashMap T) := do - let back ← HashMap.clear_loop T self.slots 0#usize - Result.ret { self with num_entries := 0#usize, slots := back } + let hm ← HashMap.clear_loop T self.slots 0#usize + Result.ret { self with num_entries := 0#usize, slots := hm } /- [hashmap::{hashmap::HashMap}::len]: Source: 'src/hashmap.rs', lines 90:4-90:30 -/ @@ -99,8 +99,8 @@ divergent def HashMap.insert_in_list_loop then Result.ret (false, List.Cons ckey value tl) else do - let (b, back) ← HashMap.insert_in_list_loop T key value tl - Result.ret (b, List.Cons ckey cvalue back) + let (b, tl1) ← HashMap.insert_in_list_loop T key value tl + Result.ret (b, List.Cons ckey cvalue tl1) | List.Nil => Result.ret (true, List.Cons key value List.Nil) /- [hashmap::{hashmap::HashMap}::insert_in_list]: @@ -345,8 +345,8 @@ divergent def HashMap.remove_from_list_loop | List.Nil => Result.fail .panic else do - let (o, back) ← HashMap.remove_from_list_loop T key tl - Result.ret (o, List.Cons ckey t back) + let (o, tl1) ← HashMap.remove_from_list_loop T key tl + Result.ret (o, List.Cons ckey t tl1) | List.Nil => Result.ret (none, List.Nil) /- [hashmap::{hashmap::HashMap}::remove_from_list]: diff --git a/tests/lean/HashmapMain/Funs.lean b/tests/lean/HashmapMain/Funs.lean index 0bf6c641..6fac6940 100644 --- a/tests/lean/HashmapMain/Funs.lean +++ b/tests/lean/HashmapMain/Funs.lean @@ -83,8 +83,8 @@ divergent def hashmap.HashMap.clear_loop def hashmap.HashMap.clear (T : Type) (self : hashmap.HashMap T) : Result (hashmap.HashMap T) := do - let back ← hashmap.HashMap.clear_loop T self.slots 0#usize - Result.ret { self with num_entries := 0#usize, slots := back } + let hm ← hashmap.HashMap.clear_loop T self.slots 0#usize + Result.ret { self with num_entries := 0#usize, slots := hm } /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::len]: Source: 'src/hashmap.rs', lines 90:4-90:30 -/ @@ -103,8 +103,8 @@ divergent def hashmap.HashMap.insert_in_list_loop then Result.ret (false, hashmap.List.Cons ckey value tl) else do - let (b, back) ← hashmap.HashMap.insert_in_list_loop T key value tl - Result.ret (b, hashmap.List.Cons ckey cvalue back) + let (b, tl1) ← hashmap.HashMap.insert_in_list_loop T key value tl + Result.ret (b, hashmap.List.Cons ckey cvalue tl1) | hashmap.List.Nil => Result.ret (true, hashmap.List.Cons key value hashmap.List.Nil) @@ -364,8 +364,8 @@ divergent def hashmap.HashMap.remove_from_list_loop | hashmap.List.Nil => Result.fail .panic else do - let (o, back) ← hashmap.HashMap.remove_from_list_loop T key tl - Result.ret (o, hashmap.List.Cons ckey t back) + let (o, tl1) ← hashmap.HashMap.remove_from_list_loop T key tl + Result.ret (o, hashmap.List.Cons ckey t tl1) | hashmap.List.Nil => Result.ret (none, hashmap.List.Nil) /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: -- cgit v1.2.3 From eaab34bbf040d6b1fa8e4730ef1ea31cc0225c99 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 4 Apr 2024 13:22:40 +0200 Subject: Update the README --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index df7b2bf1..74de4500 100644 --- a/README.md +++ b/README.md @@ -9,9 +9,9 @@ Wall in Pompei, digital image from Michael Lahanis.

-# Aeneas +# Aeneas [Ae-ne-as] -Aeneas is a verification toolchain for Rust programs. It relies on a translation from Rusts's MIR +Aeneas (pronunced [Ae-ne-as]) is a verification toolchain for Rust programs. It relies on a translation from Rusts's MIR internal language to a pure lamdba calculus. It is intended to be used in combination with [Charon](https://github.com/AeneasVerif/charon), which compiles Rust programs to an intermediate representation called LLBC. It currently has backends for [F\*](https://www.fstar-lang.org), -- cgit v1.2.3 From 16ea3ca854a77703487afa8732f247bc26cba695 Mon Sep 17 00:00:00 2001 From: Escherichia Date: Thu, 4 Apr 2024 13:23:50 +0200 Subject: Now prints all errors in the error_list --- compiler/Errors.ml | 6 ++++++ compiler/Main.ml | 8 +++++--- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/compiler/Errors.ml b/compiler/Errors.ml index 30887593..7dfe659a 100644 --- a/compiler/Errors.ml +++ b/compiler/Errors.ml @@ -20,6 +20,12 @@ let format_error_message_with_file_line (file : string) (line : int) "In file " ^ file ^ ", line " ^ string_of_int line ^ ":\n" ^ format_error_message meta msg +let error_list_to_string (error_list : (Meta.meta option * string) list) : + string = + List.fold_left + (fun errors (meta, msg) -> errors ^ "\n" ^ format_error_message meta msg) + "" error_list + exception CFailure of (Meta.meta option * string) let error_list : (Meta.meta option * string) list ref = ref [] diff --git a/compiler/Main.ml b/compiler/Main.ml index db200f37..9e72a21b 100644 --- a/compiler/Main.ml +++ b/compiler/Main.ml @@ -274,12 +274,14 @@ let () = (* Translate the functions *) Aeneas.Translate.translate_crate filename dest_dir m - with Errors.CFailure (meta, msg) -> + with Errors.CFailure (_, _) -> (* In theory it shouldn't happen, but there may be uncaught errors - note that we let the [Failure] exceptions go through (they are send if we use the option [-abort-on-error] *) - log#serror (Errors.format_error_message meta msg); - exit 1); + if not (List.is_empty !Errors.error_list) then ( + let errors = Errors.error_list_to_string !Errors.error_list in + log#serror errors; + exit 1)); (* Print total elapsed time *) log#linfo -- cgit v1.2.3 From ec7a1d3c94846a94481a487dd077efb6ddb108fe Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 4 Apr 2024 13:27:02 +0200 Subject: Make a minor update in SymbolicToPure --- compiler/SymbolicToPure.ml | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 67fd2c9b..5cd13072 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -2258,15 +2258,14 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : (fun ty -> match ty with | None -> None - | Some (back_sg, ty) -> - (* We insert a name for the variable only if the function - can fail: if it can fail, it means the call returns a backward - function. Otherwise, it directly returns the value given - back by the backward function, which means we shouldn't - give it a name like "back..." (it doesn't make sense) *) + | Some (_back_sg, ty) -> + (* We insert a name for the variable only if the type + is an arrow type. If it is not, it means the backward + function is degenerate (it takes no inputs) so it is + not a function anymore but a value: it doesn't make + sense to use a name like "back...". *) let name = - if back_sg.effect_info.can_fail then Some back_fun_name - else None + if is_arrow_ty ty then Some back_fun_name else None in Some (name, ty)) back_tys) -- cgit v1.2.3 From 0c3be2a82205d2737546c7ce8b15b6ad07f34095 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 4 Apr 2024 14:18:32 +0200 Subject: Update the nix flake --- flake.lock | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/flake.lock b/flake.lock index 5f61cb95..27a555ad 100644 --- a/flake.lock +++ b/flake.lock @@ -8,11 +8,11 @@ "rust-overlay": "rust-overlay" }, "locked": { - "lastModified": 1710913200, - "narHash": "sha256-TPkIajgXl7narf/2U16y+EVwrjozQed3yDrg6MJdoXo=", + "lastModified": 1712233083, + "narHash": "sha256-KR4UwlgUzLWObSzQ1LIKITjRrYe4AuZXdvCK78qrip8=", "owner": "aeneasverif", "repo": "charon", - "rev": "827ee91c945717ca19ae9c3d1cdfa591d0d5e0d9", + "rev": "6e31313fdfd4830aa0fc795f6ab8b27600fcbbfb", "type": "github" }, "original": { -- cgit v1.2.3 From 9e7aacc885c067af71d12c8f796f9951dd045261 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 4 Apr 2024 15:06:21 +0200 Subject: Update the nix flake --- flake.lock | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/flake.lock b/flake.lock index 5f61cb95..27a555ad 100644 --- a/flake.lock +++ b/flake.lock @@ -8,11 +8,11 @@ "rust-overlay": "rust-overlay" }, "locked": { - "lastModified": 1710913200, - "narHash": "sha256-TPkIajgXl7narf/2U16y+EVwrjozQed3yDrg6MJdoXo=", + "lastModified": 1712233083, + "narHash": "sha256-KR4UwlgUzLWObSzQ1LIKITjRrYe4AuZXdvCK78qrip8=", "owner": "aeneasverif", "repo": "charon", - "rev": "827ee91c945717ca19ae9c3d1cdfa591d0d5e0d9", + "rev": "6e31313fdfd4830aa0fc795f6ab8b27600fcbbfb", "type": "github" }, "original": { -- cgit v1.2.3 From fc0b39c4fe48fdbab06d5fd32e0a2b7dcae674e6 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 4 Apr 2024 15:29:11 +0200 Subject: Fix the coerce notation for scalars and update some lemmas --- backends/lean/Base/Primitives/Scalar.lean | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/backends/lean/Base/Primitives/Scalar.lean b/backends/lean/Base/Primitives/Scalar.lean index 3d90f1a5..7668bc59 100644 --- a/backends/lean/Base/Primitives/Scalar.lean +++ b/backends/lean/Base/Primitives/Scalar.lean @@ -265,6 +265,14 @@ theorem Scalar.cMax_suffices ty (h : x ≤ Scalar.cMax ty) : x ≤ Scalar.max ty have := Scalar.cMax_bound ty linarith +/-- The scalar type. + + We could use a subtype, but it using a custom structure type allows us + to have more control over the coercions and the simplifications (we tried + using a subtype and it caused issues especially as we had to make the Scalar + type non-reducible, so that we could have more control, but leading to + some natural equalities not being obvious to the simplifier anymore). + -/ structure Scalar (ty : ScalarTy) where val : Int hmin : Scalar.min ty ≤ val @@ -274,6 +282,9 @@ deriving Repr instance (ty : ScalarTy) : CoeOut (Scalar ty) Int where coe := λ v => v.val +/- Activate the ↑ notation -/ +attribute [coe] Scalar.val + theorem Scalar.bound_suffices (ty : ScalarTy) (x : Int) : Scalar.cMin ty ≤ x ∧ x ≤ Scalar.cMax ty -> Scalar.min ty ≤ x ∧ x ≤ Scalar.max ty @@ -1119,19 +1130,19 @@ theorem Scalar.eq_equiv {ty : ScalarTy} (x y : Scalar ty) : -- This is sometimes useful when rewriting the goal with the local assumptions @[simp] theorem Scalar.eq_imp {ty : ScalarTy} (x y : Scalar ty) : - x = y → (↑x : Int) = ↑y := (eq_equiv x y).mp + (↑x : Int) = ↑y → x = y := (eq_equiv x y).mpr theorem Scalar.lt_equiv {ty : ScalarTy} (x y : Scalar ty) : x < y ↔ (↑x : Int) < ↑y := by simp [LT.lt] @[simp] theorem Scalar.lt_imp {ty : ScalarTy} (x y : Scalar ty) : - x < y → (↑x : Int) < ↑y := (lt_equiv x y).mp + (↑x : Int) < (↑y) → x < y := (lt_equiv x y).mpr theorem Scalar.le_equiv {ty : ScalarTy} (x y : Scalar ty) : x ≤ y ↔ (↑x : Int) ≤ ↑y := by simp [LE.le] @[simp] theorem Scalar.le_imp {ty : ScalarTy} (x y : Scalar ty) : - x ≤ y → (↑x : Int) ≤ ↑y := (le_equiv x y).mp + (↑x : Int) ≤ ↑y → x ≤ y := (le_equiv x y).mpr 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 .. @@ -1152,6 +1163,6 @@ instance (ty : ScalarTy) : DecidableEq (Scalar ty) := | isFalse h => isFalse (Scalar.ne_of_val_ne h) @[simp] theorem Scalar.neq_to_neq_val {ty} : ∀ {i j : Scalar ty}, (¬ i = j) ↔ ¬ i.val = j.val := by - intro i j; cases i; cases j; simp + simp [eq_equiv] end Primitives -- cgit v1.2.3 From 1f3ce79023d902d0145da38e878d991a6ba29236 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 4 Apr 2024 15:47:54 +0200 Subject: Update the way errors are reported --- compiler/Errors.ml | 6 ------ compiler/Main.ml | 11 +++++++---- 2 files changed, 7 insertions(+), 10 deletions(-) diff --git a/compiler/Errors.ml b/compiler/Errors.ml index 7dfe659a..30887593 100644 --- a/compiler/Errors.ml +++ b/compiler/Errors.ml @@ -20,12 +20,6 @@ let format_error_message_with_file_line (file : string) (line : int) "In file " ^ file ^ ", line " ^ string_of_int line ^ ":\n" ^ format_error_message meta msg -let error_list_to_string (error_list : (Meta.meta option * string) list) : - string = - List.fold_left - (fun errors (meta, msg) -> errors ^ "\n" ^ format_error_message meta msg) - "" error_list - exception CFailure of (Meta.meta option * string) let error_list : (Meta.meta option * string) list ref = ref [] diff --git a/compiler/Main.ml b/compiler/Main.ml index 9e72a21b..416f3a07 100644 --- a/compiler/Main.ml +++ b/compiler/Main.ml @@ -278,10 +278,13 @@ let () = (* In theory it shouldn't happen, but there may be uncaught errors - note that we let the [Failure] exceptions go through (they are send if we use the option [-abort-on-error] *) - if not (List.is_empty !Errors.error_list) then ( - let errors = Errors.error_list_to_string !Errors.error_list in - log#serror errors; - exit 1)); + ()); + + if !Errors.error_list <> [] then ( + List.iter + (fun (meta, msg) -> log#serror (Errors.format_error_message meta msg)) + !Errors.error_list; + exit 1); (* Print total elapsed time *) log#linfo -- cgit v1.2.3 From 77208249c717579d1014f27592566069b8cd0eb2 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 4 Apr 2024 15:57:12 +0200 Subject: Fix a minor issue --- compiler/ExtractBase.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml index 6130528c..47b613c2 100644 --- a/compiler/ExtractBase.ml +++ b/compiler/ExtractBase.ml @@ -259,7 +259,7 @@ let report_name_collision (id_to_string : id -> string) let meta_to_string (meta : Meta.meta option) = match meta with | None -> "" - | Some meta -> "\n " ^ Errors.meta_to_string meta.span + | Some meta -> "\n " ^ Errors.meta_to_string meta in let id1 = "\n- " ^ id_to_string id1 ^ meta_to_string meta1 in let id2 = "\n- " ^ id_to_string id2 ^ meta_to_string meta2 in -- cgit v1.2.3 From 4828b77847ee981f5c6a1bbad7f8e6ed0e58eb0f Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 4 Apr 2024 16:08:32 +0200 Subject: Rename Result.ret as Result.ok in the backends --- backends/coq/Primitives.v | 46 ++++---- backends/fstar/Primitives.fst | 56 +++++----- backends/lean/Base/Diverge/Base.lean | 102 +++++++++--------- backends/lean/Base/Diverge/Elab.lean | 50 ++++----- backends/lean/Base/Primitives/Alloc.lean | 4 +- backends/lean/Base/Primitives/ArraySlice.lean | 54 +++++----- backends/lean/Base/Primitives/Base.lean | 30 +++--- backends/lean/Base/Primitives/Scalar.lean | 144 +++++++++++++------------- backends/lean/Base/Primitives/Vec.lean | 26 ++--- backends/lean/Base/Progress/Progress.lean | 22 ++-- 10 files changed, 266 insertions(+), 268 deletions(-) diff --git a/backends/coq/Primitives.v b/backends/coq/Primitives.v index 990e27e4..e84d65ce 100644 --- a/backends/coq/Primitives.v +++ b/backends/coq/Primitives.v @@ -19,19 +19,19 @@ Inductive error := | OutOfFuel. Inductive result A := - | Return : A -> result A + | Ok : A -> result A | Fail_ : error -> result A. -Arguments Return {_} a. +Arguments Ok {_} a. Arguments Fail_ {_}. Definition bind {A B} (m: result A) (f: A -> result B) : result B := match m with | Fail_ e => Fail_ e - | Return x => f x + | Ok x => f x end. -Definition return_ {A: Type} (x: A) : result A := Return x. +Definition return_ {A: Type} (x: A) : result A := Ok x. Definition fail_ {A: Type} (e: error) : result A := Fail_ e. Notation "x <- c1 ; c2" := (bind c1 (fun x => c2)) @@ -39,27 +39,27 @@ Notation "x <- c1 ; c2" := (bind c1 (fun x => c2)) (** Monadic assert *) Definition massert (b: bool) : result unit := - if b then Return tt else Fail_ Failure. + if b then Ok tt else Fail_ Failure. (** Normalize and unwrap a successful result (used for globals) *) -Definition eval_result_refl {A} {x} (a: result A) (p: a = Return x) : A := - match a as r return (r = Return x -> A) with - | Return a' => fun _ => a' +Definition eval_result_refl {A} {x} (a: result A) (p: a = Ok x) : A := + match a as r return (r = Ok x -> A) with + | Ok a' => fun _ => a' | Fail_ e => fun p' => False_rect _ (eq_ind (Fail_ e) (fun e : result A => match e with - | Return _ => False + | Ok _ => False | Fail_ e => True end) - I (Return x) p') + I (Ok x) p') end p. Notation "x %global" := (eval_result_refl x eq_refl) (at level 40). Notation "x %return" := (eval_result_refl x eq_refl) (at level 40). (* Sanity check *) -Check (if true then Return (1 + 2) else Fail_ Failure)%global = 3. +Check (if true then Ok (1 + 2) else Fail_ Failure)%global = 3. (*** Misc *) @@ -236,7 +236,7 @@ Import Sumbool. Definition mk_scalar (ty: scalar_ty) (x: Z) : result (scalar ty) := match sumbool_of_bool (scalar_in_bounds ty x) with - | left H => Return (exist _ x (scalar_in_bounds_valid _ _ H)) + | left H => Ok (exist _ x (scalar_in_bounds_valid _ _ H)) | right _ => Fail_ Failure end. @@ -544,9 +544,9 @@ Arguments core_ops_range_Range_end_ {_}. (*** [alloc] *) -Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Ok x. Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result (T * (T -> result T)) := - Return (x, fun x => Return x). + Ok (x, fun x => Ok x). (* Trait instance *) Definition alloc_boxed_Box_coreopsDerefInst (Self : Type) : core_ops_deref_Deref Self := {| @@ -589,7 +589,7 @@ Definition array_index_mut_usize (T : Type) (n : usize) (a : array T n) (i : usi result (T * (T -> result (array T n))) := match array_index_usize T n a i with | Fail_ e => Fail_ e - | Return x => Return (x, array_update_usize T n a i) + | Ok x => Ok (x, array_update_usize T n a i) end. (*** Slice *) @@ -603,7 +603,7 @@ Definition slice_index_mut_usize (T : Type) (s : slice T) (i : usize) : result (T * (T -> result (slice T))) := match slice_index_usize T s i with | Fail_ e => Fail_ e - | Return x => Return (x, slice_update_usize T s i) + | Ok x => Ok (x, slice_update_usize T s i) end. (*** Subslices *) @@ -615,7 +615,7 @@ Definition array_to_slice_mut (T : Type) (n : usize) (a : array T n) : result (slice T * (slice T -> result (array T n))) := match array_to_slice T n a with | Fail_ e => Fail_ e - | Return x => Return (x, array_from_slice T n a) + | Ok x => Ok (x, array_from_slice T n a) end. Axiom array_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize), result (slice T). @@ -657,17 +657,17 @@ end end. Definition alloc_vec_Vec_bind {A B} (v: alloc_vec_Vec A) (f: list A -> result (list B)) : result (alloc_vec_Vec B) := l <- f (alloc_vec_Vec_to_list v) ; match sumbool_of_bool (scalar_le_max Usize (Z.of_nat (length l))) with - | left H => Return (exist _ l (scalar_le_max_valid _ _ H)) + | left H => Ok (exist _ l (scalar_le_max_valid _ _ H)) | right _ => Fail_ Failure end. Definition alloc_vec_Vec_push (T: Type) (v: alloc_vec_Vec T) (x: T) : result (alloc_vec_Vec T) := - alloc_vec_Vec_bind v (fun l => Return (l ++ [x])). + alloc_vec_Vec_bind v (fun l => Ok (l ++ [x])). Definition alloc_vec_Vec_insert (T: Type) (v: alloc_vec_Vec T) (i: usize) (x: T) : result (alloc_vec_Vec T) := alloc_vec_Vec_bind v (fun l => if to_Z i result (alloc_vec_Vec T))) := match alloc_vec_Vec_index_usize v i with - | Return x => - Return (x, alloc_vec_Vec_update_usize v i) + | Ok x => + Ok (x, alloc_vec_Vec_update_usize v i) | Fail_ e => Fail_ e end. @@ -717,7 +717,7 @@ Definition core_slice_index_Slice_index x <- inst.(core_slice_index_SliceIndex_get) i s; match x with | None => Fail_ Failure - | Some x => Return x + | Some x => Ok x end. (* [core::slice::index::Range:::get]: forward function *) diff --git a/backends/fstar/Primitives.fst b/backends/fstar/Primitives.fst index fca80829..acdb09dc 100644 --- a/backends/fstar/Primitives.fst +++ b/backends/fstar/Primitives.fst @@ -23,11 +23,11 @@ type error : Type0 = | OutOfFuel type result (a : Type0) : Type0 = -| Return : v:a -> result a +| Ok : v:a -> result a | Fail : e:error -> result a // Monadic return operator -unfold let return (#a : Type0) (x : a) : result a = Return x +unfold let return (#a : Type0) (x : a) : result a = Ok x // Monadic bind operator. // Allows to use the notation: @@ -36,17 +36,17 @@ unfold let return (#a : Type0) (x : a) : result a = Return x // ... // ``` unfold let (let*) (#a #b : Type0) (m: result a) - (f: (x:a) -> Pure (result b) (requires (m == Return x)) (ensures fun _ -> True)) : + (f: (x:a) -> Pure (result b) (requires (m == Ok x)) (ensures fun _ -> True)) : result b = match m with - | Return x -> f x + | Ok x -> f x | Fail e -> Fail e // Monadic assert(...) -let massert (b:bool) : result unit = if b then Return () else Fail Failure +let massert (b:bool) : result unit = if b then Ok () else Fail Failure // Normalize and unwrap a successful result (used for globals). -let eval_global (#a : Type0) (x : result a{Return? (normalize_term x)}) : a = Return?.v x +let eval_global (#a : Type0) (x : result a{Ok? (normalize_term x)}) : a = Ok?.v x (*** Misc *) type char = FStar.Char.char @@ -144,7 +144,7 @@ let scalar_max (ty : scalar_ty) : int = type scalar (ty : scalar_ty) : eqtype = x:int{scalar_min ty <= x && x <= scalar_max ty} let mk_scalar (ty : scalar_ty) (x : int) : result (scalar ty) = - if scalar_min ty <= x && scalar_max ty >= x then Return x else Fail Failure + if scalar_min ty <= x && scalar_max ty >= x then Ok x else Fail Failure let scalar_neg (#ty : scalar_ty) (x : scalar ty) : result (scalar ty) = mk_scalar ty (-x) @@ -498,9 +498,9 @@ type core_ops_range_Range (a : Type0) = { (*** [alloc] *) -let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Ok x let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result (t & (t -> result t)) = - Return (x, (fun x -> Return x)) + Ok (x, (fun x -> Ok x)) // Trait instance let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { @@ -528,20 +528,20 @@ let mk_array (a : Type0) (n : usize) l let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = - if i < length x then Return (index x i) + if i < length x then Ok (index x i) else Fail Failure let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = - if i < length x then Return (list_update x i nx) + if i < length x then Ok (list_update x i nx) else Fail Failure let array_index_mut_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result (a & (a -> result (array a n))) = match array_index_usize a n x i with | Fail e -> Fail e - | Return v -> - Return (v, array_update_usize a n x i) + | Ok v -> + Ok (v, array_update_usize a n x i) (*** Slice *) type slice (a : Type0) = s:list a{length s <= usize_max} @@ -549,30 +549,30 @@ type slice (a : Type0) = s:list a{length s <= usize_max} let slice_len (a : Type0) (s : slice a) : usize = length s let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = - if i < length x then Return (index x i) + if i < length x then Ok (index x i) else Fail Failure let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = - if i < length x then Return (list_update x i nx) + if i < length x then Ok (list_update x i nx) else Fail Failure let slice_index_mut_usize (a : Type0) (s : slice a) (i : usize) : result (a & (a -> result (slice a))) = match slice_index_usize a s i with | Fail e -> Fail e - | Return x -> - Return (x, slice_update_usize a s i) + | Ok x -> + Ok (x, slice_update_usize a s i) (*** Subslices *) -let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Ok x let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = - if length s = n then Return s + if length s = n then Ok s else Fail Failure let array_to_slice_mut (a : Type0) (n : usize) (x : array a n) : result (slice a & (slice a -> result (array a n))) = - Return (x, array_from_slice a n x) + Ok (x, array_from_slice a n x) // TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = @@ -598,16 +598,16 @@ let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v // Helper let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = - if i < length v then Return (index v i) else Fail Failure + if i < length v then Ok (index v i) else Fail Failure // Helper let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = - if i < length v then Return (list_update v i x) else Fail Failure + if i < length v then Ok (list_update v i x) else Fail Failure let alloc_vec_Vec_index_mut_usize (#a : Type0) (v: alloc_vec_Vec a) (i: usize) : result (a & (a → result (alloc_vec_Vec a))) = match alloc_vec_Vec_index_usize v i with - | Return x -> - Return (x, alloc_vec_Vec_update_usize v i) + | Ok x -> + Ok (x, alloc_vec_Vec_update_usize v i) | Fail e -> Fail e let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : @@ -616,17 +616,17 @@ let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : (ensures (fun res -> match res with | Fail e -> e == Failure - | Return v' -> length v' = length v + 1)) = + | Ok v' -> length v' = length v + 1)) = if length v < usize_max then begin (**) assert_norm(length [x] == 1); (**) append_length v [x]; (**) assert(length (append v [x]) = length v + 1); - Return (append v [x]) + Ok (append v [x]) end else Fail Failure let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = - if i < length v then Return (list_update v i x) else Fail Failure + if i < length v then Ok (list_update v i x) else Fail Failure // Trait declaration: [core::slice::index::private_slice_index::Sealed] type core_slice_index_private_slice_index_Sealed (self : Type0) = unit @@ -650,7 +650,7 @@ let core_slice_index_Slice_index let* x = inst.get i s in match x with | None -> Fail Failure - | Some x -> Return x + | Some x -> Ok x // [core::slice::index::Range:::get]: forward function let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : diff --git a/backends/lean/Base/Diverge/Base.lean b/backends/lean/Base/Diverge/Base.lean index e40432bd..717a3e64 100644 --- a/backends/lean/Base/Diverge/Base.lean +++ b/backends/lean/Base/Diverge/Base.lean @@ -169,7 +169,7 @@ namespace Fix match x1 with | div => True | fail _ => x2 = x1 - | ret _ => x2 = x1 -- TODO: generalize + | ok _ => x2 = x1 -- TODO: generalize -- Monotonicity relation over monadic arrows (i.e., Kleisli arrows) def karrow_rel (k1 k2 : (x:a) → Result (b x)) : Prop := @@ -388,7 +388,7 @@ namespace Fix have Hgeq := Hgmono Hffmono simp [result_rel] at Hgeq cases Heq: g (fix_fuel n k) <;> rename_i y <;> simp_all - -- Remains the .ret case + -- Remains the .ok case -- Use Hdiv to prove that: ∀ n, h y (fix_fuel n f) = div -- We do this in two steps: first we prove it for m ≥ n have Hhdiv: ∀ m, h y (fix_fuel m k) = .div := by @@ -509,7 +509,7 @@ namespace FixI specific case. Remark: the index designates the function in the mutually recursive group - (it should be a finite type). We make the return type depend on the input + (it should be a finite type). We make the output type depend on the input type because we group the type parameters in the input type. -/ open Primitives Fix @@ -945,7 +945,7 @@ namespace Ex1 match ls with | [] => .fail .panic | hd :: tl => - if i = 0 then .ret hd + if i = 0 then .ok hd else k (tl, i - 1) theorem list_nth_body_is_valid: ∀ k x, is_valid_p k (λ k => @list_nth_body a k x) := by @@ -962,7 +962,7 @@ namespace Ex1 match ls with | [] => .fail .panic | hd :: tl => - if i = 0 then .ret hd + if i = 0 then .ok hd else list_nth tl (i - 1) := by have Heq := is_valid_fix_fixed_eq (@list_nth_body_is_valid a) @@ -983,11 +983,11 @@ namespace Ex2 match ls with | [] => .fail .panic | hd :: tl => - if i = 0 then .ret hd + if i = 0 then .ok hd else do let y ← k (tl, i - 1) - .ret y + .ok y theorem list_nth_body_is_valid: ∀ k x, is_valid_p k (λ k => @list_nth_body a k x) := by intro k x @@ -1004,11 +1004,11 @@ namespace Ex2 match ls with | [] => .fail .panic | hd :: tl => - if i = 0 then .ret hd + if i = 0 then .ok hd else do let y ← list_nth tl (i - 1) - .ret y) + .ok y) := by have Heq := is_valid_fix_fixed_eq (@list_nth_body_is_valid a) simp [list_nth] @@ -1025,9 +1025,9 @@ namespace Ex3 - inputs: the sum allows to select the function to call in the recursive calls (and the functions may not have the same input types) - outputs: this case is degenerate because `even` and `odd` have the same - return type `Bool`, but generally speaking we need a sum type because + output type `Bool`, but generally speaking we need a sum type because the functions in the mutually recursive group may have different - return types. + output types. -/ variable (k : (Int ⊕ Int) → Result (Bool ⊕ Bool)) @@ -1036,7 +1036,7 @@ namespace Ex3 | .inl i => -- Body of `is_even` if i = 0 - then .ret (.inl true) -- We use .inl because this is `is_even` + then .ok (.inl true) -- We use .inl because this is `is_even` else do let b ← @@ -1046,13 +1046,13 @@ namespace Ex3 let r ← k (.inr (i- 1)) match r with | .inl _ => .fail .panic -- Invalid output - | .inr b => .ret b - -- Wrap the return value - .ret (.inl b) + | .inr b => .ok b + -- Wrap the output value + .ok (.inl b) | .inr i => -- Body of `is_odd` if i = 0 - then .ret (.inr false) -- We use .inr because this is `is_odd` + then .ok (.inr false) -- We use .inr because this is `is_odd` else do let b ← @@ -1061,10 +1061,10 @@ namespace Ex3 -- extract the output value let r ← k (.inl (i- 1)) match r with - | .inl b => .ret b + | .inl b => .ok b | .inr _ => .fail .panic -- Invalid output - -- Wrap the return value - .ret (.inr b) + -- Wrap the output value + .ok (.inr b) theorem is_even_is_odd_body_is_valid: ∀ k x, is_valid_p k (λ k => is_even_is_odd_body k x) := by @@ -1080,7 +1080,7 @@ namespace Ex3 do let r ← fix is_even_is_odd_body (.inl i) match r with - | .inl b => .ret b + | .inl b => .ok b | .inr _ => .fail .panic def is_odd (i : Int): Result Bool := @@ -1088,11 +1088,11 @@ namespace Ex3 let r ← fix is_even_is_odd_body (.inr i) match r with | .inl _ => .fail .panic - | .inr b => .ret b + | .inr b => .ok b -- The unfolding equation for `is_even` - diverges if `i < 0` theorem is_even_eq (i : Int) : - is_even i = (if i = 0 then .ret true else is_odd (i - 1)) + is_even i = (if i = 0 then .ok true else is_odd (i - 1)) := by have Heq := is_valid_fix_fixed_eq is_even_is_odd_body_is_valid simp [is_even, is_odd] @@ -1110,7 +1110,7 @@ namespace Ex3 -- The unfolding equation for `is_odd` - diverges if `i < 0` theorem is_odd_eq (i : Int) : - is_odd i = (if i = 0 then .ret false else is_even (i - 1)) + is_odd i = (if i = 0 then .ok false else is_even (i - 1)) := by have Heq := is_valid_fix_fixed_eq is_even_is_odd_body_is_valid simp [is_even, is_odd] @@ -1136,17 +1136,17 @@ namespace Ex4 /- The bodies are more natural -/ def is_even_body (k : (i : Fin 2) → (x : input_ty i) → Result (output_ty i x)) (i : Int) : Result Bool := if i = 0 - then .ret true + then .ok true else do let b ← k 1 (i - 1) - .ret b + .ok b def is_odd_body (k : (i : Fin 2) → (x : input_ty i) → Result (output_ty i x)) (i : Int) : Result Bool := if i = 0 - then .ret false + then .ok false else do let b ← k 0 (i - 1) - .ret b + .ok b @[simp] def bodies : Funs (Fin 2) input_ty output_ty @@ -1179,19 +1179,19 @@ namespace Ex4 theorem is_even_eq (i : Int) : is_even i = (if i = 0 - then .ret true + then .ok true else do let b ← is_odd (i - 1) - .ret b) := by + .ok b) := by simp [is_even, is_odd]; conv => lhs; rw [body_fix_eq] theorem is_odd_eq (i : Int) : is_odd i = (if i = 0 - then .ret false + then .ok false else do let b ← is_even (i - 1) - .ret b) := by + .ok b) := by simp [is_even, is_odd]; conv => lhs; rw [body_fix_eq] end Ex4 @@ -1205,12 +1205,12 @@ namespace Ex5 /- An auxiliary function, which doesn't require the fixed-point -/ def map (f : a → Result b) (ls : List a) : Result (List b) := match ls with - | [] => .ret [] + | [] => .ok [] | hd :: tl => do let hd ← f hd let tl ← map f tl - .ret (hd :: tl) + .ok (hd :: tl) /- The validity theorem for `map`, generic in `f` -/ theorem map_is_valid @@ -1231,11 +1231,11 @@ namespace Ex5 def id_body (k : Tree a → Result (Tree a)) (t : Tree a) : Result (Tree a) := match t with - | .leaf x => .ret (.leaf x) + | .leaf x => .ok (.leaf x) | .node tl => do let tl ← map k tl - .ret (.node tl) + .ok (.node tl) theorem id_body_is_valid : ∀ k x, is_valid_p k (λ k => @id_body a k x) := by @@ -1256,11 +1256,11 @@ namespace Ex5 theorem id_eq (t : Tree a) : (id t = match t with - | .leaf x => .ret (.leaf x) + | .leaf x => .ok (.leaf x) | .node tl => do let tl ← map id tl - .ret (.node tl)) + .ok (.node tl)) := by have Heq := is_valid_fix_fixed_eq (@id_body_is_valid a) simp [id] @@ -1285,7 +1285,7 @@ namespace Ex6 match ls with | [] => .fail .panic | hd :: tl => - if i = 0 then .ret hd + if i = 0 then .ok hd else k 0 ⟨ a, tl, i - 1 ⟩ @[simp] def bodies : @@ -1316,7 +1316,7 @@ namespace Ex6 match ls with | [] => is_valid_p_same k (.fail .panic) | hd :: tl => - is_valid_p_ite k (Eq i 0) (is_valid_p_same k (.ret hd)) (is_valid_p_rec k 0 ⟨a, tl, i-1⟩) + is_valid_p_ite k (Eq i 0) (is_valid_p_same k (.ok hd)) (is_valid_p_rec k 0 ⟨a, tl, i-1⟩) theorem body_is_valid' : is_valid body := fun k => @@ -1332,7 +1332,7 @@ namespace Ex6 match ls with | [] => .fail .panic | hd :: tl => - if i = 0 then .ret hd + if i = 0 then .ok hd else list_nth tl (i - 1) := by have Heq := is_valid_fix_fixed_eq body_is_valid @@ -1347,7 +1347,7 @@ namespace Ex6 match ls with | [] => .fail .panic | hd :: tl => - if i = 0 then .ret hd + if i = 0 then .ok hd else list_nth tl (i - 1) := -- Use the fixed-point equation @@ -1378,7 +1378,7 @@ namespace Ex7 match ls with | [] => .fail .panic | hd :: tl => - if i = 0 then .ret hd + if i = 0 then .ok hd else k 0 a ⟨ tl, i - 1 ⟩ @[simp] def bodies : @@ -1409,7 +1409,7 @@ namespace Ex7 match ls with | [] => is_valid_p_same k (.fail .panic) | hd :: tl => - is_valid_p_ite k (Eq i 0) (is_valid_p_same k (.ret hd)) (is_valid_p_rec k 0 a ⟨tl, i-1⟩) + is_valid_p_ite k (Eq i 0) (is_valid_p_same k (.ok hd)) (is_valid_p_rec k 0 a ⟨tl, i-1⟩) theorem body_is_valid' : is_valid body := fun k => @@ -1425,7 +1425,7 @@ namespace Ex7 match ls with | [] => .fail .panic | hd :: tl => - if i = 0 then .ret hd + if i = 0 then .ok hd else list_nth tl (i - 1) := by have Heq := is_valid_fix_fixed_eq body_is_valid @@ -1440,7 +1440,7 @@ namespace Ex7 match ls with | [] => .fail .panic | hd :: tl => - if i = 0 then .ret hd + if i = 0 then .ok hd else list_nth tl (i - 1) := -- Use the fixed-point equation @@ -1466,12 +1466,12 @@ namespace Ex8 /- An auxiliary function, which doesn't require the fixed-point -/ def map {a : Type y} {b : Type z} (f : a → Result b) (ls : List a) : Result (List b) := match ls with - | [] => .ret [] + | [] => .ok [] | hd :: tl => do let hd ← f hd let tl ← map f tl - .ret (hd :: tl) + .ok (hd :: tl) /- The validity theorems for `map`, generic in `f` -/ @@ -1520,11 +1520,11 @@ namespace Ex9 def id_body.{u} (k : (i:Fin 1) → (t:ty i) → input_ty i t → Result (output_ty i t)) (a : Type u) (t : Tree a) : Result (Tree a) := match t with - | .leaf x => .ret (.leaf x) + | .leaf x => .ok (.leaf x) | .node tl => do let tl ← map (k 0 a) tl - .ret (.node tl) + .ok (.node tl) @[simp] def bodies : Funs (Fin 1) ty input_ty output_ty tys := @@ -1558,11 +1558,11 @@ namespace Ex9 theorem id_eq' {a : Type u} (t : Tree a) : id t = (match t with - | .leaf x => .ret (.leaf x) + | .leaf x => .ok (.leaf x) | .node tl => do let tl ← map id tl - .ret (.node tl)) + .ok (.node tl)) := -- The unfolding equation have Heq := is_valid_fix_fixed_eq body_is_valid.{u} diff --git a/backends/lean/Base/Diverge/Elab.lean b/backends/lean/Base/Diverge/Elab.lean index f30148dc..d2dc3922 100644 --- a/backends/lean/Base/Diverge/Elab.lean +++ b/backends/lean/Base/Diverge/Elab.lean @@ -36,7 +36,7 @@ def mkProd (x y : Expr) : MetaM Expr := def mkInOutTy (x y z : Expr) : MetaM Expr := do mkAppM ``FixII.mk_in_out_ty #[x, y, z] --- Return the `a` in `Return a` +-- Return the `a` in `Result a` def getResultTy (ty : Expr) : MetaM Expr := ty.withApp fun f args => do if ¬ f.isConstOf ``Result ∨ args.size ≠ 1 then @@ -412,7 +412,7 @@ structure TypeInfo where For `list_nth`: `λ a => List a × Int` -/ in_ty : Expr - /- The output type, without the `Return`. This is a function taking + /- The output type, without the `Result`. This is a function taking as input a value of type `params_ty`. For `list_nth`: `λ a => a` @@ -1480,9 +1480,9 @@ namespace Tests divergent def list_nth {a: Type u} (ls : List a) (i : Int) : Result a := match ls with | [] => .fail .panic - | x :: ls => - if i = 0 then return x - else return (← list_nth ls (i - 1)) + | x :: ls => do + if i = 0 then pure x + else pure (← list_nth ls (i - 1)) --set_option trace.Diverge false @@ -1491,7 +1491,7 @@ namespace Tests example {a: Type} (ls : List a) : ∀ (i : Int), 0 ≤ i → i < ls.length → - ∃ x, list_nth ls i = .ret x := by + ∃ x, list_nth ls i = .ok x := by induction ls . intro i hpos h; simp at h; linarith . rename_i hd tl ih @@ -1539,7 +1539,7 @@ namespace Tests if i > 10 then return (← foo (i / 10)) + (← bar i) else bar 10 divergent def bar (i : Int) : Result Nat := - if i > 20 then foo (i / 20) else .ret 42 + if i > 20 then foo (i / 20) else .ok 42 end #check foo.unfold @@ -1558,8 +1558,8 @@ namespace Tests divergent def iInBounds {a : Type} (ls : List a) (i : Int) : Result Bool := let i0 := ls.length if i < i0 - then Result.ret True - else Result.ret False + then Result.ok True + else Result.ok False #check iInBounds.unfold @@ -1567,8 +1567,8 @@ namespace Tests {a : Type} (ls : List a) : Result Bool := let ls1 := ls match ls1 with - | [] => Result.ret False - | _ :: _ => Result.ret True + | [] => Result.ok False + | _ :: _ => Result.ok True #check isCons.unfold @@ -1585,7 +1585,7 @@ namespace Tests divergent def infinite_loop : Result Unit := do let _ ← infinite_loop - Result.ret () + Result.ok () #check infinite_loop.unfold @@ -1605,51 +1605,51 @@ namespace Tests divergent def id {a : Type u} (t : Tree a) : Result (Tree a) := match t with - | .leaf x => .ret (.leaf x) + | .leaf x => .ok (.leaf x) | .node tl => do let tl ← map id tl - .ret (.node tl) + .ok (.node tl) #check id.unfold divergent def id1 {a : Type u} (t : Tree a) : Result (Tree a) := match t with - | .leaf x => .ret (.leaf x) + | .leaf x => .ok (.leaf x) | .node tl => do let tl ← map (fun x => id1 x) tl - .ret (.node tl) + .ok (.node tl) #check id1.unfold divergent def id2 {a : Type u} (t : Tree a) : Result (Tree a) := match t with - | .leaf x => .ret (.leaf x) + | .leaf x => .ok (.leaf x) | .node tl => do let tl ← map (fun x => do let _ ← id2 x; id2 x) tl - .ret (.node tl) + .ok (.node tl) #check id2.unfold divergent def incr (t : Tree Nat) : Result (Tree Nat) := match t with - | .leaf x => .ret (.leaf (x + 1)) + | .leaf x => .ok (.leaf (x + 1)) | .node tl => do let tl ← map incr tl - .ret (.node tl) + .ok (.node tl) -- We handle this by inlining the let-binding divergent def id3 (t : Tree Nat) : Result (Tree Nat) := match t with - | .leaf x => .ret (.leaf (x + 1)) + | .leaf x => .ok (.leaf (x + 1)) | .node tl => do let f := id3 let tl ← map f tl - .ret (.node tl) + .ok (.node tl) #check id3.unfold @@ -1659,12 +1659,12 @@ namespace Tests -- be parameterized by something). divergent def id4 (t : Tree Nat) : Result (Tree Nat) := match t with - | .leaf x => .ret (.leaf (x + 1)) + | .leaf x => .ok (.leaf (x + 1)) | .node tl => do - let f ← .ret id4 + let f ← .ok id4 let tl ← map f tl - .ret (.node tl) + .ok (.node tl) #check id4.unfold -/ diff --git a/backends/lean/Base/Primitives/Alloc.lean b/backends/lean/Base/Primitives/Alloc.lean index 1f470fe1..15fe1ff9 100644 --- a/backends/lean/Base/Primitives/Alloc.lean +++ b/backends/lean/Base/Primitives/Alloc.lean @@ -11,8 +11,8 @@ namespace boxed -- alloc.boxed namespace Box -- alloc.boxed.Box -def deref (T : Type) (x : T) : Result T := ret x -def deref_mut (T : Type) (x : T) : Result (T × (T → Result T)) := ret (x, λ x => ret x) +def deref (T : Type) (x : T) : Result T := ok x +def deref_mut (T : Type) (x : T) : Result (T × (T → Result T)) := ok (x, λ x => ok x) /-- Trait instance -/ def coreopsDerefInst (Self : Type) : diff --git a/backends/lean/Base/Primitives/ArraySlice.lean b/backends/lean/Base/Primitives/ArraySlice.lean index e1a39d40..ef658e1b 100644 --- a/backends/lean/Base/Primitives/ArraySlice.lean +++ b/backends/lean/Base/Primitives/ArraySlice.lean @@ -50,7 +50,7 @@ abbrev Array.slice {α : Type u} {n : Usize} [Inhabited α] (v : Array α n) (i def Array.index_usize (α : Type u) (n : Usize) (v: Array α n) (i: Usize) : Result α := match v.val.indexOpt i.val with | none => fail .arrayOutOfBounds - | some x => ret x + | some x => ok x -- For initialization def Array.repeat (α : Type u) (n : Usize) (x : α) : Array α n := @@ -69,7 +69,7 @@ theorem Array.repeat_spec {α : Type u} (n : Usize) (x : α) : @[pspec] theorem Array.index_usize_spec {α : Type u} {n : Usize} [Inhabited α] (v: Array α n) (i: Usize) (hbound : i.val < v.length) : - ∃ x, v.index_usize α n i = ret x ∧ x = v.val.index i.val := by + ∃ x, v.index_usize α n i = ok x ∧ x = v.val.index i.val := by simp only [index_usize] -- TODO: dependent rewrite have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*]) @@ -79,12 +79,12 @@ def Array.update_usize (α : Type u) (n : Usize) (v: Array α n) (i: Usize) (x: match v.val.indexOpt i.val with | none => fail .arrayOutOfBounds | some _ => - .ret ⟨ v.val.update i.val x, by have := v.property; simp [*] ⟩ + ok ⟨ v.val.update i.val x, by have := v.property; simp [*] ⟩ @[pspec] theorem Array.update_usize_spec {α : Type u} {n : Usize} (v: Array α n) (i: Usize) (x : α) (hbound : i.val < v.length) : - ∃ nv, v.update_usize α n i x = ret nv ∧ + ∃ nv, v.update_usize α n i x = ok nv ∧ nv.val = v.val.update i.val x := by simp only [update_usize] @@ -96,12 +96,12 @@ theorem Array.update_usize_spec {α : Type u} {n : Usize} (v: Array α n) (i: Us def Array.index_mut_usize (α : Type u) (n : Usize) (v: Array α n) (i: Usize) : Result (α × (α -> Result (Array α n))) := do let x ← index_usize α n v i - ret (x, update_usize α n v i) + ok (x, update_usize α n v i) @[pspec] theorem Array.index_mut_usize_spec {α : Type u} {n : Usize} [Inhabited α] (v: Array α n) (i: Usize) (hbound : i.val < v.length) : - ∃ x back, v.index_mut_usize α n i = ret (x, back) ∧ + ∃ x back, v.index_mut_usize α n i = ok (x, back) ∧ x = v.val.index i.val ∧ back = update_usize α n v i := by simp only [index_mut_usize, Bind.bind, bind] @@ -148,7 +148,7 @@ abbrev Slice.slice {α : Type u} [Inhabited α] (s : Slice α) (i j : Int) : Lis def Slice.index_usize (α : Type u) (v: Slice α) (i: Usize) : Result α := match v.val.indexOpt i.val with | none => fail .arrayOutOfBounds - | some x => ret x + | some x => ok x /- In the theorems below: we don't always need the `∃ ..`, but we use one so that `progress` introduces an opaque variable and an equality. This @@ -158,7 +158,7 @@ def Slice.index_usize (α : Type u) (v: Slice α) (i: Usize) : Result α := @[pspec] theorem Slice.index_usize_spec {α : Type u} [Inhabited α] (v: Slice α) (i: Usize) (hbound : i.val < v.length) : - ∃ x, v.index_usize α i = ret x ∧ x = v.val.index i.val := by + ∃ x, v.index_usize α i = ok x ∧ x = v.val.index i.val := by simp only [index_usize] -- TODO: dependent rewrite have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*]) @@ -168,12 +168,12 @@ def Slice.update_usize (α : Type u) (v: Slice α) (i: Usize) (x: α) : Result ( match v.val.indexOpt i.val with | none => fail .arrayOutOfBounds | some _ => - .ret ⟨ v.val.update i.val x, by have := v.property; simp [*] ⟩ + ok ⟨ v.val.update i.val x, by have := v.property; simp [*] ⟩ @[pspec] theorem Slice.update_usize_spec {α : Type u} (v: Slice α) (i: Usize) (x : α) (hbound : i.val < v.length) : - ∃ nv, v.update_usize α i x = ret nv ∧ + ∃ nv, v.update_usize α i x = ok nv ∧ nv.val = v.val.update i.val x := by simp only [update_usize] @@ -185,12 +185,12 @@ theorem Slice.update_usize_spec {α : Type u} (v: Slice α) (i: Usize) (x : α) def Slice.index_mut_usize (α : Type u) (v: Slice α) (i: Usize) : Result (α × (α → Result (Slice α))) := do let x ← Slice.index_usize α v i - ret (x, Slice.update_usize α v i) + ok (x, Slice.update_usize α v i) @[pspec] theorem Slice.index_mut_usize_spec {α : Type u} [Inhabited α] (v: Slice α) (i: Usize) (hbound : i.val < v.length) : - ∃ x back, v.index_mut_usize α i = ret (x, back) ∧ + ∃ x back, v.index_mut_usize α i = ok (x, back) ∧ x = v.val.index i.val ∧ back = Slice.update_usize α v i := by simp only [index_mut_usize, Bind.bind, bind] @@ -204,30 +204,30 @@ theorem Slice.index_mut_usize_spec {α : Type u} [Inhabited α] (v: Slice α) (i `progress` tactic), meaning `Array.to_slice` should be considered as opaque. All what the spec theorem reveals is that the "representative" lists are the same. -/ def Array.to_slice (α : Type u) (n : Usize) (v : Array α n) : Result (Slice α) := - ret ⟨ v.val, by simp [← List.len_eq_length]; scalar_tac ⟩ + ok ⟨ v.val, by simp [← List.len_eq_length]; scalar_tac ⟩ @[pspec] theorem Array.to_slice_spec {α : Type u} {n : Usize} (v : Array α n) : - ∃ s, to_slice α n v = ret s ∧ v.val = s.val := by simp [to_slice] + ∃ s, to_slice α n v = ok s ∧ v.val = s.val := by simp [to_slice] def Array.from_slice (α : Type u) (n : Usize) (_ : Array α n) (s : Slice α) : Result (Array α n) := if h: s.val.len = n.val then - ret ⟨ s.val, by simp [← List.len_eq_length, *] ⟩ + ok ⟨ s.val, by simp [← List.len_eq_length, *] ⟩ else fail panic @[pspec] theorem Array.from_slice_spec {α : Type u} {n : Usize} (a : Array α n) (ns : Slice α) (h : ns.val.len = n.val) : - ∃ na, from_slice α n a ns = ret na ∧ na.val = ns.val + ∃ na, from_slice α n a ns = ok na ∧ na.val = ns.val := by simp [from_slice, *] def Array.to_slice_mut (α : Type u) (n : Usize) (a : Array α n) : Result (Slice α × (Slice α → Result (Array α n))) := do let s ← Array.to_slice α n a - ret (s, Array.from_slice α n a) + ok (s, Array.from_slice α n a) @[pspec] theorem Array.to_slice_mut_spec {α : Type u} {n : Usize} (v : Array α n) : - ∃ s back, to_slice_mut α n v = ret (s, back) ∧ + ∃ s back, to_slice_mut α n v = ok (s, back) ∧ v.val = s.val ∧ back = Array.from_slice α n v := by simp [to_slice_mut, to_slice] @@ -235,7 +235,7 @@ theorem Array.to_slice_mut_spec {α : Type u} {n : Usize} (v : Array α n) : def Array.subslice (α : Type u) (n : Usize) (a : Array α n) (r : Range Usize) : Result (Slice α) := -- TODO: not completely sure here if r.start.val < r.end_.val ∧ r.end_.val ≤ a.val.len then - ret ⟨ a.val.slice r.start.val r.end_.val, + ok ⟨ a.val.slice r.start.val r.end_.val, by simp [← List.len_eq_length] have := a.val.slice_len_le r.start.val r.end_.val @@ -246,7 +246,7 @@ def Array.subslice (α : Type u) (n : Usize) (a : Array α n) (r : Range Usize) @[pspec] theorem Array.subslice_spec {α : Type u} {n : Usize} [Inhabited α] (a : Array α n) (r : Range Usize) (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ a.val.len) : - ∃ s, subslice α n a r = ret s ∧ + ∃ s, subslice α n a r = ok s ∧ s.val = a.val.slice r.start.val r.end_.val ∧ (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → s.val.index i = a.val.index (r.start.val + i)) := by @@ -270,7 +270,7 @@ def Array.update_subslice (α : Type u) (n : Usize) (a : Array α n) (r : Range . scalar_tac let na := s_beg.append (s.val.append s_end) have : na.len = a.val.len := by simp [*] - ret ⟨ na, by simp_all [← List.len_eq_length]; scalar_tac ⟩ + ok ⟨ na, by simp_all [← List.len_eq_length]; scalar_tac ⟩ else fail panic @@ -282,7 +282,7 @@ def Array.update_subslice (α : Type u) (n : Usize) (a : Array α n) (r : Range @[pspec] theorem Array.update_subslice_spec {α : Type u} {n : Usize} [Inhabited α] (a : Array α n) (r : Range Usize) (s : Slice α) (_ : r.start.val < r.end_.val) (_ : r.end_.val ≤ a.length) (_ : s.length = r.end_.val - r.start.val) : - ∃ na, update_subslice α n a r s = ret na ∧ + ∃ na, update_subslice α n a r s = ok na ∧ (∀ i, 0 ≤ i → i < r.start.val → na.index_s i = a.index_s i) ∧ (∀ i, r.start.val ≤ i → i < r.end_.val → na.index_s i = s.index_s (i - r.start.val)) ∧ (∀ i, r.end_.val ≤ i → i < n.val → na.index_s i = a.index_s i) := by @@ -306,7 +306,7 @@ theorem Array.update_subslice_spec {α : Type u} {n : Usize} [Inhabited α] (a : def Slice.subslice (α : Type u) (s : Slice α) (r : Range Usize) : Result (Slice α) := -- TODO: not completely sure here if r.start.val < r.end_.val ∧ r.end_.val ≤ s.length then - ret ⟨ s.val.slice r.start.val r.end_.val, + ok ⟨ s.val.slice r.start.val r.end_.val, by simp [← List.len_eq_length] have := s.val.slice_len_le r.start.val r.end_.val @@ -317,7 +317,7 @@ def Slice.subslice (α : Type u) (s : Slice α) (r : Range Usize) : Result (Slic @[pspec] theorem Slice.subslice_spec {α : Type u} [Inhabited α] (s : Slice α) (r : Range Usize) (h0 : r.start.val < r.end_.val) (h1 : r.end_.val ≤ s.val.len) : - ∃ ns, subslice α s r = ret ns ∧ + ∃ ns, subslice α s r = ok ns ∧ ns.val = s.slice r.start.val r.end_.val ∧ (∀ i, 0 ≤ i → i + r.start.val < r.end_.val → ns.index_s i = s.index_s (r.start.val + i)) := by @@ -344,14 +344,14 @@ def Slice.update_subslice (α : Type u) (s : Slice α) (r : Range Usize) (ss : S . scalar_tac let ns := s_beg.append (ss.val.append s_end) have : ns.len = s.val.len := by simp [*] - ret ⟨ ns, by simp_all [← List.len_eq_length]; scalar_tac ⟩ + ok ⟨ ns, by simp_all [← List.len_eq_length]; scalar_tac ⟩ else fail panic @[pspec] theorem Slice.update_subslice_spec {α : Type u} [Inhabited α] (a : Slice α) (r : Range Usize) (ss : Slice α) (_ : r.start.val < r.end_.val) (_ : r.end_.val ≤ a.length) (_ : ss.length = r.end_.val - r.start.val) : - ∃ na, update_subslice α a r ss = ret na ∧ + ∃ na, update_subslice α a r ss = ok na ∧ (∀ i, 0 ≤ i → i < r.start.val → na.index_s i = a.index_s i) ∧ (∀ i, r.start.val ≤ i → i < r.end_.val → na.index_s i = ss.index_s (i - r.start.val)) ∧ (∀ i, r.end_.val ≤ i → i < a.length → na.index_s i = a.index_s i) := by @@ -393,7 +393,7 @@ def core.slice.index.Slice.index let x ← inst.get i slice match x with | none => fail panic - | some x => ret x + | some x => ok x /- [core::slice::index::Range:::get]: forward function -/ def core.slice.index.RangeUsize.get (T : Type) (i : Range Usize) (slice : Slice T) : diff --git a/backends/lean/Base/Primitives/Base.lean b/backends/lean/Base/Primitives/Base.lean index 0c64eca1..4c5b2795 100644 --- a/backends/lean/Base/Primitives/Base.lean +++ b/backends/lean/Base/Primitives/Base.lean @@ -41,7 +41,7 @@ deriving Repr, BEq open Error inductive Result (α : Type u) where - | ret (v: α): Result α + | ok (v: α): Result α | fail (e: Error): Result α | div deriving Repr, BEq @@ -56,31 +56,31 @@ instance Result_Nonempty (α : Type u) : Nonempty (Result α) := /- HELPERS -/ -def ret? {α: Type u} (r: Result α): Bool := +def ok? {α: Type u} (r: Result α): Bool := match r with - | ret _ => true + | ok _ => true | fail _ | div => false def div? {α: Type u} (r: Result α): Bool := match r with | div => true - | ret _ | fail _ => false + | ok _ | fail _ => false def massert (b:Bool) : Result Unit := - if b then ret () else fail assertionFailure + if b then ok () else fail assertionFailure macro "prove_eval_global" : tactic => `(tactic| first | apply Eq.refl | decide) -def eval_global {α: Type u} (x: Result α) (_: ret? x := by prove_eval_global) : α := +def eval_global {α: Type u} (x: Result α) (_: ok? x := by prove_eval_global) : α := match x with | fail _ | div => by contradiction - | ret x => x + | ok x => x /- DO-DSL SUPPORT -/ def bind {α : Type u} {β : Type v} (x: Result α) (f: α → Result β) : Result β := match x with - | ret v => f v + | ok v => f v | fail v => fail v | div => div @@ -88,11 +88,11 @@ def bind {α : Type u} {β : Type v} (x: Result α) (f: α → Result β) : Resu instance : Bind Result where bind := bind --- Allows using return x in do-blocks +-- Allows using pure x in do-blocks instance : Pure Result where - pure := fun x => ret x + pure := fun x => ok x -@[simp] theorem bind_ret (x : α) (f : α → Result β) : bind (.ret x) f = f x := by simp [bind] +@[simp] theorem bind_ok (x : α) (f : α → Result β) : bind (.ok x) f = f x := by simp [bind] @[simp] theorem bind_fail (x : Error) (f : α → Result β) : bind (.fail x) f = .fail x := by simp [bind] @[simp] theorem bind_div (f : α → Result β) : bind .div f = .div := by simp [bind] @@ -103,14 +103,14 @@ instance : Pure Result where -- 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 } := +def Result.attach {α: Type} (o : Result α): Result { x : α // o = ok x } := match o with - | ret x => ret ⟨x, rfl⟩ + | ok x => ok ⟨x, rfl⟩ | fail e => fail e | div => div -@[simp] theorem bind_tc_ret (x : α) (f : α → Result β) : - (do let y ← .ret x; f y) = f x := by simp [Bind.bind, bind] +@[simp] theorem bind_tc_ok (x : α) (f : α → Result β) : + (do let y ← .ok x; f y) = f x := by simp [Bind.bind, bind] @[simp] theorem bind_tc_fail (x : Error) (f : α → Result β) : (do let y ← fail x; f y) = fail x := by simp [Bind.bind, bind] diff --git a/backends/lean/Base/Primitives/Scalar.lean b/backends/lean/Base/Primitives/Scalar.lean index 3d90f1a5..c298ba92 100644 --- a/backends/lean/Base/Primitives/Scalar.lean +++ b/backends/lean/Base/Primitives/Scalar.lean @@ -339,7 +339,7 @@ def Scalar.tryMk (ty : ScalarTy) (x : Int) : Result (Scalar ty) := -- ``` -- then normalization blocks (for instance, some proofs which use reflexivity fail). -- However, the version below doesn't block reduction (TODO: investigate): - return Scalar.ofIntCore x (Scalar.check_bounds_prop h) + ok (Scalar.ofIntCore x (Scalar.check_bounds_prop h)) else fail integerOverflow def Scalar.neg {ty : ScalarTy} (x : Scalar ty) : Result (Scalar ty) := Scalar.tryMk ty (- x.val) @@ -573,7 +573,7 @@ instance {ty} : HAnd (Scalar ty) (Scalar ty) (Scalar ty) where theorem Scalar.add_spec {ty} {x y : Scalar ty} (hmin : Scalar.min ty ≤ ↑x + y.val) (hmax : ↑x + ↑y ≤ Scalar.max ty) : - (∃ z, x + y = ret z ∧ (↑z : Int) = ↑x + ↑y) := by + (∃ z, x + y = ok z ∧ (↑z : Int) = ↑x + ↑y) := by -- Applying the unfoldings only on the left conv => congr; ext; lhs; unfold HAdd.hAdd instHAddScalarResult; simp [add, tryMk] split @@ -582,7 +582,7 @@ theorem Scalar.add_spec {ty} {x y : Scalar ty} theorem Scalar.add_unsigned_spec {ty} (s: ¬ ty.isSigned) {x y : Scalar ty} (hmax : ↑x + ↑y ≤ Scalar.max ty) : - ∃ z, x + y = ret z ∧ (↑z : Int) = ↑x + ↑y := by + ∃ z, x + y = ok z ∧ (↑z : Int) = ↑x + ↑y := by have hmin : Scalar.min ty ≤ ↑x + ↑y := by have hx := x.hmin have hy := y.hmin @@ -591,57 +591,57 @@ theorem Scalar.add_unsigned_spec {ty} (s: ¬ ty.isSigned) {x y : Scalar ty} /- Fine-grained theorems -/ @[pspec] theorem Usize.add_spec {x y : Usize} (hmax : ↑x + ↑y ≤ Usize.max) : - ∃ z, x + y = ret z ∧ (↑z : Int) = ↑x + ↑y := by + ∃ z, x + y = ok z ∧ (↑z : Int) = ↑x + ↑y := by apply Scalar.add_unsigned_spec <;> simp [ScalarTy.isSigned, Scalar.max, *] @[pspec] theorem U8.add_spec {x y : U8} (hmax : ↑x + ↑y ≤ U8.max) : - ∃ z, x + y = ret z ∧ (↑z : Int) = ↑x + ↑y := by + ∃ z, x + y = ok z ∧ (↑z : Int) = ↑x + ↑y := by apply Scalar.add_unsigned_spec <;> simp [ScalarTy.isSigned, Scalar.max, *] @[pspec] theorem U16.add_spec {x y : U16} (hmax : ↑x + ↑y ≤ U16.max) : - ∃ z, x + y = ret z ∧ (↑z : Int) = ↑x + ↑y := by + ∃ z, x + y = ok z ∧ (↑z : Int) = ↑x + ↑y := by apply Scalar.add_unsigned_spec <;> simp [ScalarTy.isSigned, Scalar.max, *] @[pspec] theorem U32.add_spec {x y : U32} (hmax : ↑x + ↑y ≤ U32.max) : - ∃ z, x + y = ret z ∧ (↑z : Int) = ↑x + ↑y := by + ∃ z, x + y = ok z ∧ (↑z : Int) = ↑x + ↑y := by apply Scalar.add_unsigned_spec <;> simp [ScalarTy.isSigned, Scalar.max, *] @[pspec] theorem U64.add_spec {x y : U64} (hmax : ↑x + ↑y ≤ U64.max) : - ∃ z, x + y = ret z ∧ (↑z : Int) = ↑x + ↑y := by + ∃ z, x + y = ok z ∧ (↑z : Int) = ↑x + ↑y := by apply Scalar.add_unsigned_spec <;> simp [ScalarTy.isSigned, Scalar.max, *] @[pspec] theorem U128.add_spec {x y : U128} (hmax : ↑x + ↑y ≤ U128.max) : - ∃ z, x + y = ret z ∧ (↑z : Int) = ↑x + ↑y := by + ∃ z, x + y = ok z ∧ (↑z : Int) = ↑x + ↑y := by apply Scalar.add_unsigned_spec <;> simp [ScalarTy.isSigned, Scalar.max, *] @[pspec] theorem Isize.add_spec {x y : Isize} (hmin : Isize.min ≤ ↑x + ↑y) (hmax : ↑x + ↑y ≤ Isize.max) : - ∃ z, x + y = ret z ∧ (↑z : Int) = ↑x + ↑y := + ∃ z, x + y = ok z ∧ (↑z : Int) = ↑x + ↑y := Scalar.add_spec hmin hmax @[pspec] theorem I8.add_spec {x y : I8} (hmin : I8.min ≤ ↑x + ↑y) (hmax : ↑x + ↑y ≤ I8.max) : - ∃ z, x + y = ret z ∧ (↑z : Int) = ↑x + ↑y := + ∃ z, x + y = ok z ∧ (↑z : Int) = ↑x + ↑y := Scalar.add_spec hmin hmax @[pspec] theorem I16.add_spec {x y : I16} (hmin : I16.min ≤ ↑x + ↑y) (hmax : ↑x + ↑y ≤ I16.max) : - ∃ z, x + y = ret z ∧ (↑z : Int) = ↑x + ↑y := + ∃ z, x + y = ok z ∧ (↑z : Int) = ↑x + ↑y := Scalar.add_spec hmin hmax @[pspec] theorem I32.add_spec {x y : I32} (hmin : I32.min ≤ ↑x + ↑y) (hmax : ↑x + ↑y ≤ I32.max) : - ∃ z, x + y = ret z ∧ (↑z : Int) = ↑x + ↑y := + ∃ z, x + y = ok z ∧ (↑z : Int) = ↑x + ↑y := Scalar.add_spec hmin hmax @[pspec] theorem I64.add_spec {x y : I64} (hmin : I64.min ≤ ↑x + ↑y) (hmax : ↑x + ↑y ≤ I64.max) : - ∃ z, x + y = ret z ∧ (↑z : Int) = ↑x + ↑y := + ∃ z, x + y = ok z ∧ (↑z : Int) = ↑x + ↑y := Scalar.add_spec hmin hmax @[pspec] theorem I128.add_spec {x y : I128} (hmin : I128.min ≤ ↑x + ↑y) (hmax : ↑x + ↑y ≤ I128.max) : - ∃ z, x + y = ret z ∧ (↑z : Int) = ↑x + ↑y := + ∃ z, x + y = ok z ∧ (↑z : Int) = ↑x + ↑y := Scalar.add_spec hmin hmax -- Generic theorem - shouldn't be used much @@ -649,7 +649,7 @@ theorem Scalar.add_unsigned_spec {ty} (s: ¬ ty.isSigned) {x y : Scalar ty} theorem Scalar.sub_spec {ty} {x y : Scalar ty} (hmin : Scalar.min ty ≤ ↑x - ↑y) (hmax : ↑x - ↑y ≤ Scalar.max ty) : - ∃ z, x - y = ret z ∧ (↑z : Int) = ↑x - ↑y := by + ∃ z, x - y = ok z ∧ (↑z : Int) = ↑x - ↑y := by conv => congr; ext; lhs; simp [HSub.hSub, sub, tryMk, Sub.sub] split . simp [pure] @@ -658,7 +658,7 @@ theorem Scalar.sub_spec {ty} {x y : Scalar ty} theorem Scalar.sub_unsigned_spec {ty : ScalarTy} (s : ¬ ty.isSigned) {x y : Scalar ty} (hmin : Scalar.min ty ≤ ↑x - ↑y) : - ∃ z, x - y = ret z ∧ (↑z : Int) = ↑x - ↑y := by + ∃ z, x - y = ok z ∧ (↑z : Int) = ↑x - ↑y := by have : ↑x - ↑y ≤ Scalar.max ty := by have hx := x.hmin have hxm := x.hmax @@ -669,64 +669,64 @@ theorem Scalar.sub_unsigned_spec {ty : ScalarTy} (s : ¬ ty.isSigned) /- Fine-grained theorems -/ @[pspec] theorem Usize.sub_spec {x y : Usize} (hmin : Usize.min ≤ ↑x - ↑y) : - ∃ z, x - y = ret z ∧ (↑z : Int) = ↑x - ↑y := by + ∃ z, x - y = ok z ∧ (↑z : Int) = ↑x - ↑y := by apply Scalar.sub_unsigned_spec <;> simp_all [Scalar.min, ScalarTy.isSigned] @[pspec] theorem U8.sub_spec {x y : U8} (hmin : U8.min ≤ ↑x - ↑y) : - ∃ z, x - y = ret z ∧ (↑z : Int) = ↑x - ↑y := by + ∃ z, x - y = ok z ∧ (↑z : Int) = ↑x - ↑y := by apply Scalar.sub_unsigned_spec <;> simp_all [Scalar.min, ScalarTy.isSigned] @[pspec] theorem U16.sub_spec {x y : U16} (hmin : U16.min ≤ ↑x - ↑y) : - ∃ z, x - y = ret z ∧ (↑z : Int) = ↑x - ↑y := by + ∃ z, x - y = ok z ∧ (↑z : Int) = ↑x - ↑y := by apply Scalar.sub_unsigned_spec <;> simp_all [Scalar.min, ScalarTy.isSigned] @[pspec] theorem U32.sub_spec {x y : U32} (hmin : U32.min ≤ ↑x - ↑y) : - ∃ z, x - y = ret z ∧ (↑z : Int) = ↑x - ↑y := by + ∃ z, x - y = ok z ∧ (↑z : Int) = ↑x - ↑y := by apply Scalar.sub_unsigned_spec <;> simp_all [Scalar.min, ScalarTy.isSigned] @[pspec] theorem U64.sub_spec {x y : U64} (hmin : U64.min ≤ ↑x - ↑y) : - ∃ z, x - y = ret z ∧ (↑z : Int) = ↑x - ↑y := by + ∃ z, x - y = ok z ∧ (↑z : Int) = ↑x - ↑y := by apply Scalar.sub_unsigned_spec <;> simp_all [Scalar.min, ScalarTy.isSigned] @[pspec] theorem U128.sub_spec {x y : U128} (hmin : U128.min ≤ ↑x - ↑y) : - ∃ z, x - y = ret z ∧ (↑z : Int) = ↑x - ↑y := by + ∃ z, x - y = ok z ∧ (↑z : Int) = ↑x - ↑y := by apply Scalar.sub_unsigned_spec <;> simp_all [Scalar.min, ScalarTy.isSigned] @[pspec] theorem Isize.sub_spec {x y : Isize} (hmin : Isize.min ≤ ↑x - ↑y) (hmax : ↑x - ↑y ≤ Isize.max) : - ∃ z, x - y = ret z ∧ (↑z : Int) = ↑x - ↑y := + ∃ z, x - y = ok z ∧ (↑z : Int) = ↑x - ↑y := Scalar.sub_spec hmin hmax @[pspec] theorem I8.sub_spec {x y : I8} (hmin : I8.min ≤ ↑x - ↑y) (hmax : ↑x - ↑y ≤ I8.max) : - ∃ z, x - y = ret z ∧ (↑z : Int) = ↑x - ↑y := + ∃ z, x - y = ok z ∧ (↑z : Int) = ↑x - ↑y := Scalar.sub_spec hmin hmax @[pspec] theorem I16.sub_spec {x y : I16} (hmin : I16.min ≤ ↑x - ↑y) (hmax : ↑x - ↑y ≤ I16.max) : - ∃ z, x - y = ret z ∧ (↑z : Int) = ↑x - ↑y := + ∃ z, x - y = ok z ∧ (↑z : Int) = ↑x - ↑y := Scalar.sub_spec hmin hmax @[pspec] theorem I32.sub_spec {x y : I32} (hmin : I32.min ≤ ↑x - ↑y) (hmax : ↑x - ↑y ≤ I32.max) : - ∃ z, x - y = ret z ∧ (↑z : Int) = ↑x - ↑y := + ∃ z, x - y = ok z ∧ (↑z : Int) = ↑x - ↑y := Scalar.sub_spec hmin hmax @[pspec] theorem I64.sub_spec {x y : I64} (hmin : I64.min ≤ ↑x - ↑y) (hmax : ↑x - ↑y ≤ I64.max) : - ∃ z, x - y = ret z ∧ (↑z : Int) = ↑x - ↑y := + ∃ z, x - y = ok z ∧ (↑z : Int) = ↑x - ↑y := Scalar.sub_spec hmin hmax @[pspec] theorem I128.sub_spec {x y : I128} (hmin : I128.min ≤ ↑x - ↑y) (hmax : ↑x - ↑y ≤ I128.max) : - ∃ z, x - y = ret z ∧ (↑z : Int) = ↑x - ↑y := + ∃ z, x - y = ok z ∧ (↑z : Int) = ↑x - ↑y := Scalar.sub_spec hmin hmax -- Generic theorem - shouldn't be used much theorem Scalar.mul_spec {ty} {x y : Scalar ty} (hmin : Scalar.min ty ≤ ↑x * ↑y) (hmax : ↑x * ↑y ≤ Scalar.max ty) : - ∃ z, x * y = ret z ∧ (↑z : Int) = ↑x * ↑y := by + ∃ z, x * y = ok z ∧ (↑z : Int) = ↑x * ↑y := by conv => congr; ext; lhs; simp [HMul.hMul] simp [mul, tryMk] split @@ -736,7 +736,7 @@ theorem Scalar.mul_spec {ty} {x y : Scalar ty} theorem Scalar.mul_unsigned_spec {ty} (s: ¬ ty.isSigned) {x y : Scalar ty} (hmax : ↑x * ↑y ≤ Scalar.max ty) : - ∃ z, x * y = ret z ∧ (↑z : Int) = ↑x * ↑y := by + ∃ z, x * y = ok z ∧ (↑z : Int) = ↑x * ↑y := by have : Scalar.min ty ≤ ↑x * ↑y := by have hx := x.hmin have hy := y.hmin @@ -745,57 +745,57 @@ theorem Scalar.mul_unsigned_spec {ty} (s: ¬ ty.isSigned) {x y : Scalar ty} /- Fine-grained theorems -/ @[pspec] theorem Usize.mul_spec {x y : Usize} (hmax : ↑x * ↑y ≤ Usize.max) : - ∃ z, x * y = ret z ∧ (↑z : Int) = ↑x * ↑y := by + ∃ z, x * y = ok z ∧ (↑z : Int) = ↑x * ↑y := by apply Scalar.mul_unsigned_spec <;> simp_all [Scalar.max, ScalarTy.isSigned] @[pspec] theorem U8.mul_spec {x y : U8} (hmax : ↑x * ↑y ≤ U8.max) : - ∃ z, x * y = ret z ∧ (↑z : Int) = ↑x * ↑y := by + ∃ z, x * y = ok z ∧ (↑z : Int) = ↑x * ↑y := by apply Scalar.mul_unsigned_spec <;> simp_all [Scalar.max, ScalarTy.isSigned] @[pspec] theorem U16.mul_spec {x y : U16} (hmax : ↑x * ↑y ≤ U16.max) : - ∃ z, x * y = ret z ∧ (↑z : Int) = ↑x * ↑y := by + ∃ z, x * y = ok z ∧ (↑z : Int) = ↑x * ↑y := by apply Scalar.mul_unsigned_spec <;> simp_all [Scalar.max, ScalarTy.isSigned] @[pspec] theorem U32.mul_spec {x y : U32} (hmax : ↑x * ↑y ≤ U32.max) : - ∃ z, x * y = ret z ∧ (↑z : Int) = ↑x * ↑y := by + ∃ z, x * y = ok z ∧ (↑z : Int) = ↑x * ↑y := by apply Scalar.mul_unsigned_spec <;> simp_all [Scalar.max, ScalarTy.isSigned] @[pspec] theorem U64.mul_spec {x y : U64} (hmax : ↑x * ↑y ≤ U64.max) : - ∃ z, x * y = ret z ∧ (↑z : Int) = ↑x * ↑y := by + ∃ z, x * y = ok z ∧ (↑z : Int) = ↑x * ↑y := by apply Scalar.mul_unsigned_spec <;> simp_all [Scalar.max, ScalarTy.isSigned] @[pspec] theorem U128.mul_spec {x y : U128} (hmax : ↑x * ↑y ≤ U128.max) : - ∃ z, x * y = ret z ∧ (↑z : Int) = ↑x * ↑y := by + ∃ z, x * y = ok z ∧ (↑z : Int) = ↑x * ↑y := by apply Scalar.mul_unsigned_spec <;> simp_all [Scalar.max, ScalarTy.isSigned] @[pspec] theorem Isize.mul_spec {x y : Isize} (hmin : Isize.min ≤ ↑x * ↑y) (hmax : ↑x * ↑y ≤ Isize.max) : - ∃ z, x * y = ret z ∧ (↑z : Int) = ↑x * ↑y := + ∃ z, x * y = ok z ∧ (↑z : Int) = ↑x * ↑y := Scalar.mul_spec hmin hmax @[pspec] theorem I8.mul_spec {x y : I8} (hmin : I8.min ≤ ↑x * ↑y) (hmax : ↑x * ↑y ≤ I8.max) : - ∃ z, x * y = ret z ∧ (↑z : Int) = ↑x * ↑y := + ∃ z, x * y = ok z ∧ (↑z : Int) = ↑x * ↑y := Scalar.mul_spec hmin hmax @[pspec] theorem I16.mul_spec {x y : I16} (hmin : I16.min ≤ ↑x * ↑y) (hmax : ↑x * ↑y ≤ I16.max) : - ∃ z, x * y = ret z ∧ (↑z : Int) = ↑x * ↑y := + ∃ z, x * y = ok z ∧ (↑z : Int) = ↑x * ↑y := Scalar.mul_spec hmin hmax @[pspec] theorem I32.mul_spec {x y : I32} (hmin : I32.min ≤ ↑x * ↑y) (hmax : ↑x * ↑y ≤ I32.max) : - ∃ z, x * y = ret z ∧ (↑z : Int) = ↑x * ↑y := + ∃ z, x * y = ok z ∧ (↑z : Int) = ↑x * ↑y := Scalar.mul_spec hmin hmax @[pspec] theorem I64.mul_spec {x y : I64} (hmin : I64.min ≤ ↑x * ↑y) (hmax : ↑x * ↑y ≤ I64.max) : - ∃ z, x * y = ret z ∧ (↑z : Int) = ↑x * ↑y := + ∃ z, x * y = ok z ∧ (↑z : Int) = ↑x * ↑y := Scalar.mul_spec hmin hmax @[pspec] theorem I128.mul_spec {x y : I128} (hmin : I128.min ≤ ↑x * ↑y) (hmax : ↑x * ↑y ≤ I128.max) : - ∃ z, x * y = ret z ∧ (↑z : Int) = ↑x * ↑y := + ∃ z, x * y = ok z ∧ (↑z : Int) = ↑x * ↑y := Scalar.mul_spec hmin hmax -- Generic theorem - shouldn't be used much @@ -804,15 +804,14 @@ theorem Scalar.div_spec {ty} {x y : Scalar ty} (hnz : ↑y ≠ (0 : Int)) (hmin : Scalar.min ty ≤ scalar_div ↑x ↑y) (hmax : scalar_div ↑x ↑y ≤ Scalar.max ty) : - ∃ z, x / y = ret z ∧ (↑z : Int) = scalar_div ↑x ↑y := by + ∃ z, x / y = ok z ∧ (↑z : Int) = scalar_div ↑x ↑y := by simp [HDiv.hDiv, div, Div.div] simp [tryMk, *] - simp [pure] rfl theorem Scalar.div_unsigned_spec {ty} (s: ¬ ty.isSigned) (x : Scalar ty) {y : Scalar ty} (hnz : ↑y ≠ (0 : Int)) : - ∃ z, x / y = ret z ∧ (↑z : Int) = ↑x / ↑y := by + ∃ z, x / y = ok z ∧ (↑z : Int) = ↑x / ↑y := by have h : Scalar.min ty = 0 := by cases ty <;> simp [ScalarTy.isSigned, min] at * have hx := x.hmin have hy := y.hmin @@ -828,69 +827,69 @@ theorem Scalar.div_unsigned_spec {ty} (s: ¬ ty.isSigned) (x : Scalar ty) {y : S /- Fine-grained theorems -/ @[pspec] theorem Usize.div_spec (x : Usize) {y : Usize} (hnz : ↑y ≠ (0 : Int)) : - ∃ z, x / y = ret z ∧ (↑z : Int) = ↑x / ↑y := by + ∃ z, x / y = ok z ∧ (↑z : Int) = ↑x / ↑y := by apply Scalar.div_unsigned_spec <;> simp [ScalarTy.isSigned, *] @[pspec] theorem U8.div_spec (x : U8) {y : U8} (hnz : ↑y ≠ (0 : Int)) : - ∃ z, x / y = ret z ∧ (↑z : Int) = ↑x / ↑y := by + ∃ z, x / y = ok z ∧ (↑z : Int) = ↑x / ↑y := by apply Scalar.div_unsigned_spec <;> simp [ScalarTy.isSigned, *] @[pspec] theorem U16.div_spec (x : U16) {y : U16} (hnz : ↑y ≠ (0 : Int)) : - ∃ z, x / y = ret z ∧ (↑z : Int) = ↑x / ↑y := by + ∃ z, x / y = ok z ∧ (↑z : Int) = ↑x / ↑y := by apply Scalar.div_unsigned_spec <;> simp [ScalarTy.isSigned, *] @[pspec] theorem U32.div_spec (x : U32) {y : U32} (hnz : ↑y ≠ (0 : Int)) : - ∃ z, x / y = ret z ∧ (↑z : Int) = ↑x / ↑y := by + ∃ z, x / y = ok z ∧ (↑z : Int) = ↑x / ↑y := by apply Scalar.div_unsigned_spec <;> simp [ScalarTy.isSigned, *] @[pspec] theorem U64.div_spec (x : U64) {y : U64} (hnz : ↑y ≠ (0 : Int)) : - ∃ z, x / y = ret z ∧ (↑z : Int) = ↑x / ↑y := by + ∃ z, x / y = ok z ∧ (↑z : Int) = ↑x / ↑y := by apply Scalar.div_unsigned_spec <;> simp [ScalarTy.isSigned, *] @[pspec] theorem U128.div_spec (x : U128) {y : U128} (hnz : ↑y ≠ (0 : Int)) : - ∃ z, x / y = ret z ∧ (↑z : Int) = ↑x / ↑y := by + ∃ z, x / y = ok z ∧ (↑z : Int) = ↑x / ↑y := by apply Scalar.div_unsigned_spec <;> simp [ScalarTy.isSigned, *] @[pspec] theorem Isize.div_spec (x : Isize) {y : Isize} (hnz : ↑y ≠ (0 : Int)) (hmin : Isize.min ≤ scalar_div ↑x ↑y) (hmax : scalar_div ↑x ↑y ≤ Isize.max): - ∃ z, x / y = ret z ∧ (↑z : Int) = scalar_div ↑x ↑y := + ∃ z, x / y = ok z ∧ (↑z : Int) = scalar_div ↑x ↑y := Scalar.div_spec hnz hmin hmax @[pspec] theorem I8.div_spec (x : I8) {y : I8} (hnz : ↑y ≠ (0 : Int)) (hmin : I8.min ≤ scalar_div ↑x ↑y) (hmax : scalar_div ↑x ↑y ≤ I8.max): - ∃ z, x / y = ret z ∧ (↑z : Int) = scalar_div ↑x ↑y := + ∃ z, x / y = ok z ∧ (↑z : Int) = scalar_div ↑x ↑y := Scalar.div_spec hnz hmin hmax @[pspec] theorem I16.div_spec (x : I16) {y : I16} (hnz : ↑y ≠ (0 : Int)) (hmin : I16.min ≤ scalar_div ↑x ↑y) (hmax : scalar_div ↑x ↑y ≤ I16.max): - ∃ z, x / y = ret z ∧ (↑z : Int) = scalar_div ↑x ↑y := + ∃ z, x / y = ok z ∧ (↑z : Int) = scalar_div ↑x ↑y := Scalar.div_spec hnz hmin hmax @[pspec] theorem I32.div_spec (x : I32) {y : I32} (hnz : ↑y ≠ (0 : Int)) (hmin : I32.min ≤ scalar_div ↑x ↑y) (hmax : scalar_div ↑x ↑y ≤ I32.max): - ∃ z, x / y = ret z ∧ (↑z : Int) = scalar_div ↑x ↑y := + ∃ z, x / y = ok z ∧ (↑z : Int) = scalar_div ↑x ↑y := Scalar.div_spec hnz hmin hmax @[pspec] theorem I64.div_spec (x : I64) {y : I64} (hnz : ↑y ≠ (0 : Int)) (hmin : I64.min ≤ scalar_div ↑x ↑y) (hmax : scalar_div ↑x ↑y ≤ I64.max): - ∃ z, x / y = ret z ∧ (↑z : Int) = scalar_div ↑x ↑y := + ∃ z, x / y = ok z ∧ (↑z : Int) = scalar_div ↑x ↑y := Scalar.div_spec hnz hmin hmax @[pspec] theorem I128.div_spec (x : I128) {y : I128} (hnz : ↑y ≠ (0 : Int)) (hmin : I128.min ≤ scalar_div ↑x ↑y) (hmax : scalar_div ↑x ↑y ≤ I128.max): - ∃ z, x / y = ret z ∧ (↑z : Int) = scalar_div ↑x ↑y := + ∃ z, x / y = ok z ∧ (↑z : Int) = scalar_div ↑x ↑y := Scalar.div_spec hnz hmin hmax -- Generic theorem - shouldn't be used much @@ -899,15 +898,14 @@ theorem Scalar.rem_spec {ty} {x y : Scalar ty} (hnz : ↑y ≠ (0 : Int)) (hmin : Scalar.min ty ≤ scalar_rem ↑x ↑y) (hmax : scalar_rem ↑x ↑y ≤ Scalar.max ty) : - ∃ z, x % y = ret z ∧ (↑z : Int) = scalar_rem ↑x ↑y := by + ∃ z, x % y = ok z ∧ (↑z : Int) = scalar_rem ↑x ↑y := by simp [HMod.hMod, rem] simp [tryMk, *] - simp [pure] rfl theorem Scalar.rem_unsigned_spec {ty} (s: ¬ ty.isSigned) (x : Scalar ty) {y : Scalar ty} (hnz : ↑y ≠ (0 : Int)) : - ∃ z, x % y = ret z ∧ (↑z : Int) = ↑x % ↑y := by + ∃ z, x % y = ok z ∧ (↑z : Int) = ↑x % ↑y := by have h : Scalar.min ty = 0 := by cases ty <;> simp [ScalarTy.isSigned, min] at * have hx := x.hmin have hy := y.hmin @@ -923,62 +921,62 @@ theorem Scalar.rem_unsigned_spec {ty} (s: ¬ ty.isSigned) (x : Scalar ty) {y : S simp [*] @[pspec] theorem Usize.rem_spec (x : Usize) {y : Usize} (hnz : ↑y ≠ (0 : Int)) : - ∃ z, x % y = ret z ∧ (↑z : Int) = ↑x % ↑y := by + ∃ z, x % y = ok z ∧ (↑z : Int) = ↑x % ↑y := by apply Scalar.rem_unsigned_spec <;> simp [ScalarTy.isSigned, *] @[pspec] theorem U8.rem_spec (x : U8) {y : U8} (hnz : ↑y ≠ (0 : Int)) : - ∃ z, x % y = ret z ∧ (↑z : Int) = ↑x % ↑y := by + ∃ z, x % y = ok z ∧ (↑z : Int) = ↑x % ↑y := by apply Scalar.rem_unsigned_spec <;> simp [ScalarTy.isSigned, *] @[pspec] theorem U16.rem_spec (x : U16) {y : U16} (hnz : ↑y ≠ (0 : Int)) : - ∃ z, x % y = ret z ∧ (↑z : Int) = ↑x % ↑y := by + ∃ z, x % y = ok z ∧ (↑z : Int) = ↑x % ↑y := by apply Scalar.rem_unsigned_spec <;> simp [ScalarTy.isSigned, *] @[pspec] theorem U32.rem_spec (x : U32) {y : U32} (hnz : ↑y ≠ (0 : Int)) : - ∃ z, x % y = ret z ∧ (↑z : Int) = ↑x % ↑y := by + ∃ z, x % y = ok z ∧ (↑z : Int) = ↑x % ↑y := by apply Scalar.rem_unsigned_spec <;> simp [ScalarTy.isSigned, *] @[pspec] theorem U64.rem_spec (x : U64) {y : U64} (hnz : ↑y ≠ (0 : Int)) : - ∃ z, x % y = ret z ∧ (↑z : Int) = ↑x % ↑y := by + ∃ z, x % y = ok z ∧ (↑z : Int) = ↑x % ↑y := by apply Scalar.rem_unsigned_spec <;> simp [ScalarTy.isSigned, *] @[pspec] theorem U128.rem_spec (x : U128) {y : U128} (hnz : ↑y ≠ (0 : Int)) : - ∃ z, x % y = ret z ∧ (↑z : Int) = ↑x % ↑y := by + ∃ z, x % y = ok z ∧ (↑z : Int) = ↑x % ↑y := by apply Scalar.rem_unsigned_spec <;> simp [ScalarTy.isSigned, *] @[pspec] theorem I8.rem_spec (x : I8) {y : I8} (hnz : ↑y ≠ (0 : Int)) (hmin : I8.min ≤ scalar_rem ↑x ↑y) (hmax : scalar_rem ↑x ↑y ≤ I8.max): - ∃ z, x % y = ret z ∧ (↑z : Int) = scalar_rem ↑x ↑y := + ∃ z, x % y = ok z ∧ (↑z : Int) = scalar_rem ↑x ↑y := Scalar.rem_spec hnz hmin hmax @[pspec] theorem I16.rem_spec (x : I16) {y : I16} (hnz : ↑y ≠ (0 : Int)) (hmin : I16.min ≤ scalar_rem ↑x ↑y) (hmax : scalar_rem ↑x ↑y ≤ I16.max): - ∃ z, x % y = ret z ∧ (↑z : Int) = scalar_rem ↑x ↑y := + ∃ z, x % y = ok z ∧ (↑z : Int) = scalar_rem ↑x ↑y := Scalar.rem_spec hnz hmin hmax @[pspec] theorem I32.rem_spec (x : I32) {y : I32} (hnz : ↑y ≠ (0 : Int)) (hmin : I32.min ≤ scalar_rem ↑x ↑y) (hmax : scalar_rem ↑x ↑y ≤ I32.max): - ∃ z, x % y = ret z ∧ (↑z : Int) = scalar_rem ↑x ↑y := + ∃ z, x % y = ok z ∧ (↑z : Int) = scalar_rem ↑x ↑y := Scalar.rem_spec hnz hmin hmax @[pspec] theorem I64.rem_spec (x : I64) {y : I64} (hnz : ↑y ≠ (0 : Int)) (hmin : I64.min ≤ scalar_rem ↑x ↑y) (hmax : scalar_rem ↑x ↑y ≤ I64.max): - ∃ z, x % y = ret z ∧ (↑z : Int) = scalar_rem ↑x ↑y := + ∃ z, x % y = ok z ∧ (↑z : Int) = scalar_rem ↑x ↑y := Scalar.rem_spec hnz hmin hmax @[pspec] theorem I128.rem_spec (x : I128) {y : I128} (hnz : ↑y ≠ (0 : Int)) (hmin : I128.min ≤ scalar_rem ↑x ↑y) (hmax : scalar_rem ↑x ↑y ≤ I128.max): - ∃ z, x % y = ret z ∧ (↑z : Int) = scalar_rem ↑x ↑y := + ∃ z, x % y = ok z ∧ (↑z : Int) = scalar_rem ↑x ↑y := Scalar.rem_spec hnz hmin hmax -- ofIntCore @@ -1152,6 +1150,6 @@ instance (ty : ScalarTy) : DecidableEq (Scalar ty) := | isFalse h => isFalse (Scalar.ne_of_val_ne h) @[simp] theorem Scalar.neq_to_neq_val {ty} : ∀ {i j : Scalar ty}, (¬ i = j) ↔ ¬ i.val = j.val := by - intro i j; cases i; cases j; simp + simp [eq_equiv] end Primitives diff --git a/backends/lean/Base/Primitives/Vec.lean b/backends/lean/Base/Primitives/Vec.lean index 65249c12..dbe5c8dd 100644 --- a/backends/lean/Base/Primitives/Vec.lean +++ b/backends/lean/Base/Primitives/Vec.lean @@ -61,34 +61,34 @@ def Vec.push (α : Type u) (v : Vec α) (x : α) : Result (Vec α) simp [Usize.max] at * have hm := Usize.refined_max.property cases h <;> cases hm <;> simp [U32.max, U64.max] at * <;> try linarith - return ⟨ List.concat v.val x, by simp at *; assumption ⟩ + ok ⟨ List.concat v.val x, by simp at *; assumption ⟩ else fail maximumSizeExceeded -- This shouldn't be used def Vec.insert_fwd (α : Type u) (v: Vec α) (i: Usize) (_: α) : Result Unit := if i.val < v.length then - .ret () + ok () else - .fail arrayOutOfBounds + fail arrayOutOfBounds -- This is actually the backward function def Vec.insert (α : Type u) (v: Vec α) (i: Usize) (x: α) : Result (Vec α) := if i.val < v.length then - .ret ⟨ v.val.update i.val x, by have := v.property; simp [*] ⟩ + ok ⟨ v.val.update i.val x, by have := v.property; simp [*] ⟩ else - .fail arrayOutOfBounds + fail arrayOutOfBounds @[pspec] theorem Vec.insert_spec {α : Type u} (v: Vec α) (i: Usize) (x: α) (hbound : i.val < v.length) : - ∃ nv, v.insert α i x = ret nv ∧ nv.val = v.val.update i.val x := by + ∃ nv, v.insert α i x = ok nv ∧ nv.val = v.val.update i.val x := by simp [insert, *] def Vec.index_usize {α : Type u} (v: Vec α) (i: Usize) : Result α := match v.val.indexOpt i.val with | none => fail .arrayOutOfBounds - | some x => ret x + | some x => ok x /- In the theorems below: we don't always need the `∃ ..`, but we use one so that `progress` introduces an opaque variable and an equality. This @@ -98,7 +98,7 @@ def Vec.index_usize {α : Type u} (v: Vec α) (i: Usize) : Result α := @[pspec] theorem Vec.index_usize_spec {α : Type u} [Inhabited α] (v: Vec α) (i: Usize) (hbound : i.val < v.length) : - ∃ x, v.index_usize i = ret x ∧ x = v.val.index i.val := by + ∃ x, v.index_usize i = ok x ∧ x = v.val.index i.val := by simp only [index_usize] -- TODO: dependent rewrite have h := List.indexOpt_eq_index v.val i.val (by scalar_tac) (by simp [*]) @@ -108,12 +108,12 @@ def Vec.update_usize {α : Type u} (v: Vec α) (i: Usize) (x: α) : Result (Vec match v.val.indexOpt i.val with | none => fail .arrayOutOfBounds | some _ => - .ret ⟨ v.val.update i.val x, by have := v.property; simp [*] ⟩ + ok ⟨ v.val.update i.val x, by have := v.property; simp [*] ⟩ @[pspec] theorem Vec.update_usize_spec {α : Type u} (v: Vec α) (i: Usize) (x : α) (hbound : i.val < v.length) : - ∃ nv, v.update_usize i x = ret nv ∧ + ∃ nv, v.update_usize i x = ok nv ∧ nv.val = v.val.update i.val x := by simp only [update_usize] @@ -125,15 +125,15 @@ theorem Vec.update_usize_spec {α : Type u} (v: Vec α) (i: Usize) (x : α) def Vec.index_mut_usize {α : Type u} (v: Vec α) (i: Usize) : Result (α × (α → Result (Vec α))) := match Vec.index_usize v i with - | ret x => - ret (x, Vec.update_usize v i) + | ok x => + ok (x, Vec.update_usize v i) | fail e => fail e | div => div @[pspec] theorem Vec.index_mut_usize_spec {α : Type u} [Inhabited α] (v: Vec α) (i: Usize) (hbound : i.val < v.length) : - ∃ x back, v.index_mut_usize i = ret (x, back) ∧ + ∃ x back, v.index_mut_usize i = ok (x, back) ∧ x = v.val.index i.val ∧ -- Backward function back = v.update_usize i diff --git a/backends/lean/Base/Progress/Progress.lean b/backends/lean/Base/Progress/Progress.lean index dc30c441..ea38c630 100644 --- a/backends/lean/Base/Progress/Progress.lean +++ b/backends/lean/Base/Progress/Progress.lean @@ -136,7 +136,7 @@ def progressWith (fExpr : Expr) (th : TheoremOrLocal) let _ ← tryTac (simpAt true [] - [``Primitives.bind_tc_ret, ``Primitives.bind_tc_fail, ``Primitives.bind_tc_div] + [``Primitives.bind_tc_ok, ``Primitives.bind_tc_fail, ``Primitives.bind_tc_div] [hEq.fvarId!] (.targets #[] true)) -- It may happen that at this point the goal is already solved (though this is rare) -- TODO: not sure this is the best way of checking it @@ -397,33 +397,33 @@ namespace Test example {ty} {x y : Scalar ty} (hmin : Scalar.min ty ≤ x.val + y.val) (hmax : x.val + y.val ≤ Scalar.max ty) : - ∃ z, x + y = ret z ∧ z.val = x.val + y.val := by + ∃ z, x + y = ok z ∧ z.val = x.val + y.val := by progress keep _ as ⟨ z, h1 .. ⟩ simp [*, h1] example {ty} {x y : Scalar ty} (hmin : Scalar.min ty ≤ x.val + y.val) (hmax : x.val + y.val ≤ Scalar.max ty) : - ∃ z, x + y = ret z ∧ z.val = x.val + y.val := by + ∃ z, x + y = ok z ∧ z.val = x.val + y.val := by progress keep h with Scalar.add_spec as ⟨ z ⟩ simp [*, h] example {x y : U32} (hmax : x.val + y.val ≤ U32.max) : - ∃ z, x + y = ret z ∧ z.val = x.val + y.val := by + ∃ z, x + y = ok z ∧ z.val = x.val + y.val := by -- This spec theorem is suboptimal, but it is good to check that it works progress with Scalar.add_spec as ⟨ z, h1 .. ⟩ simp [*, h1] example {x y : U32} (hmax : x.val + y.val ≤ U32.max) : - ∃ z, x + y = ret z ∧ z.val = x.val + y.val := by + ∃ z, x + y = ok z ∧ z.val = x.val + y.val := by progress with U32.add_spec as ⟨ z, h1 .. ⟩ simp [*, h1] example {x y : U32} (hmax : x.val + y.val ≤ U32.max) : - ∃ z, x + y = ret z ∧ z.val = x.val + y.val := by + ∃ z, x + y = ok z ∧ z.val = x.val + y.val := by progress keep _ as ⟨ z, h1 .. ⟩ simp [*, h1] @@ -431,7 +431,7 @@ namespace Test `α : Type u` where u is quantified, while here we use `α : Type 0` -/ example {α : Type} (v: Vec α) (i: Usize) (x : α) (hbounds : i.val < v.length) : - ∃ nv, v.update_usize i x = ret nv ∧ + ∃ nv, v.update_usize i x = ok nv ∧ nv.val = v.val.update i.val x := by progress simp [*] @@ -443,8 +443,8 @@ namespace Test (do (do let _ ← v.update_usize i x - .ret ()) - .ret ()) = ret nv + .ok ()) + .ok ()) = ok nv := by progress simp [*] @@ -454,8 +454,8 @@ namespace Test not a constant. We also test the case where the function under scrutinee is not a constant. -/ example {x : U32} - (f : U32 → Result Unit) (h : ∀ x, f x = .ret ()) : - f x = ret () := by + (f : U32 → Result Unit) (h : ∀ x, f x = .ok ()) : + f x = ok () := by progress end Test -- cgit v1.2.3 From 57b71cb1bfde1832097163c7169aaf97cf8c7583 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 4 Apr 2024 16:19:08 +0200 Subject: Update the extraction --- compiler/Extract.ml | 6 +++--- compiler/ExtractBase.ml | 8 ++++---- compiler/PrintPure.ml | 4 ++-- compiler/Pure.ml | 2 +- compiler/PureMicroPasses.ml | 21 ++++++++++----------- compiler/PureTypeCheck.ml | 2 +- compiler/PureUtils.ml | 14 ++++++-------- compiler/SymbolicToPure.ml | 7 +++---- 8 files changed, 30 insertions(+), 34 deletions(-) diff --git a/compiler/Extract.ml b/compiler/Extract.ml index 1f9c9117..27e9a62c 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -2853,7 +2853,7 @@ let extract_unit_test_if_unit_fun (ctx : extraction_ctx) (fmt : F.formatter) F.pp_print_string fmt "="; F.pp_print_space fmt (); let success = - ctx_get_variant def.meta (TAssumed TResult) result_return_id ctx + ctx_get_variant def.meta (TAssumed TResult) result_ok_id ctx in F.pp_print_string fmt (success ^ " ())") | Coq -> @@ -2884,11 +2884,11 @@ let extract_unit_test_if_unit_fun (ctx : extraction_ctx) (fmt : F.formatter) F.pp_print_string fmt "=="; F.pp_print_space fmt (); let success = - ctx_get_variant def.meta (TAssumed TResult) result_return_id ctx + ctx_get_variant def.meta (TAssumed TResult) result_ok_id ctx in F.pp_print_string fmt (success ^ " ())") | HOL4 -> - F.pp_print_string fmt "val _ = assert_return ("; + F.pp_print_string fmt "val _ = assert_ok ("; F.pp_print_string fmt "“"; let fun_name = ctx_get_local_function def.meta def.def_id def.loop_id ctx diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml index ce8c38ba..8b17591e 100644 --- a/compiler/ExtractBase.ml +++ b/compiler/ExtractBase.ml @@ -1020,7 +1020,7 @@ let assumed_variants () : (assumed_ty * VariantId.id * string) list = match !backend with | FStar -> [ - (TResult, result_return_id, "Return"); + (TResult, result_ok_id, "Ok"); (TResult, result_fail_id, "Fail"); (TError, error_failure_id, "Failure"); (TError, error_out_of_fuel_id, "OutOfFuel"); @@ -1029,7 +1029,7 @@ let assumed_variants () : (assumed_ty * VariantId.id * string) list = ] | Coq -> [ - (TResult, result_return_id, "Return"); + (TResult, result_ok_id, "Ok"); (TResult, result_fail_id, "Fail_"); (TError, error_failure_id, "Failure"); (TError, error_out_of_fuel_id, "OutOfFuel"); @@ -1038,7 +1038,7 @@ let assumed_variants () : (assumed_ty * VariantId.id * string) list = ] | Lean -> [ - (TResult, result_return_id, "Result.ret"); + (TResult, result_ok_id, "Result.ok"); (TResult, result_fail_id, "Result.fail"); (* For panic: we omit the prefix "Error." because the type is always clear from the context. Also, "Error" is often used by user-defined @@ -1049,7 +1049,7 @@ let assumed_variants () : (assumed_ty * VariantId.id * string) list = ] | HOL4 -> [ - (TResult, result_return_id, "Return"); + (TResult, result_ok_id, "Ok"); (TResult, result_fail_id, "Fail"); (TError, error_failure_id, "Failure"); (* No Fuel::Zero on purpose *) diff --git a/compiler/PrintPure.ml b/compiler/PrintPure.ml index d0c243bb..43ec083e 100644 --- a/compiler/PrintPure.ml +++ b/compiler/PrintPure.ml @@ -311,7 +311,7 @@ let adt_variant_to_string ?(meta = None) (env : fmt_env) (adt_id : type_id) craise_opt_meta __FILE__ __LINE__ meta "Unreachable" | TResult -> let variant_id = Option.get variant_id in - if variant_id = result_return_id then "@Result::Return" + if variant_id = result_ok_id then "@Result::Return" else if variant_id = result_fail_id then "@Result::Fail" else craise_opt_meta __FILE__ __LINE__ meta @@ -394,7 +394,7 @@ let adt_g_value_to_string ?(meta : Meta.meta option = None) (env : fmt_env) craise_opt_meta __FILE__ __LINE__ meta "Unreachable" | TResult -> let variant_id = Option.get variant_id in - if variant_id = result_return_id then + if variant_id = result_ok_id then match field_values with | [ v ] -> "@Result::Return " ^ v | _ -> diff --git a/compiler/Pure.ml b/compiler/Pure.ml index 7de7e0f4..daf213cf 100644 --- a/compiler/Pure.ml +++ b/compiler/Pure.ml @@ -92,7 +92,7 @@ type assumed_ty = (* TODO: we should never directly manipulate [Return] and [Fail], but rather * the monadic functions [return] and [fail] (makes treatment of error and * state-error monads more uniform) *) -let result_return_id = VariantId.of_int 0 +let result_ok_id = VariantId.of_int 0 let result_fail_id = VariantId.of_int 1 let option_some_id = T.option_some_id let option_none_id = T.option_none_id diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml index 9fa07029..b1c85d61 100644 --- a/compiler/PureMicroPasses.ml +++ b/compiler/PureMicroPasses.ml @@ -751,7 +751,7 @@ let simplify_let_bindings (_ctx : trans_ctx) (def : fun_decl) : fun_decl = }, x ) -> (* return/fail case *) - if variant_id = result_return_id then + if variant_id = result_ok_id then (* Return case - note that the simplification we just perform might have unlocked the tuple simplification below *) self#visit_Let env false lv x next @@ -1082,19 +1082,19 @@ let filter_useless (_ctx : trans_ctx) (def : fun_decl) : fun_decl = let body = { body with body = body_exp; inputs_lvs } in { def with body = Some body } -(** Simplify the lets immediately followed by a return. +(** Simplify the lets immediately followed by an ok. Ex.: {[ x <-- f y; - Return x + Ok x ~~> f y ]} *) -let simplify_let_then_return _ctx (def : fun_decl) = +let simplify_let_then_ok _ctx (def : fun_decl) = (* Match a pattern and an expression: evaluates to [true] if the expression is actually exactly the pattern *) let rec match_pattern_and_expr (pat : typed_pattern) (e : texpression) : bool @@ -1150,7 +1150,7 @@ let simplify_let_then_return _ctx (def : fun_decl) = | Some e -> if match_pattern_and_expr lv e then (* We need to wrap the right-value in a ret *) - (mk_result_return_texpression def.meta rv).e + (mk_result_ok_texpression def.meta rv).e else not_simpl_e | None -> if match_pattern_and_expr lv next_e then rv.e else not_simpl_e @@ -1789,7 +1789,7 @@ let unfold_monadic_let_bindings (_ctx : trans_ctx) (def : fun_decl) : fun_decl = let err_v = mk_texpression_from_var err_var in let fail_value = mk_result_fail_texpression def.meta err_v e.ty in let fail_branch = { pat = fail_pat; branch = fail_value } in - let success_pat = mk_result_return_pattern lv in + let success_pat = mk_result_ok_pattern lv in let success_branch = { pat = success_pat; branch = e } in let switch_body = Match [ fail_branch; success_branch ] in let e = Switch (re, switch_body) in @@ -1852,9 +1852,9 @@ let apply_end_passes_to_def (ctx : trans_ctx) (def : fun_decl) : fun_decl = f y ]} *) - let def = simplify_let_then_return ctx def in + let def = simplify_let_then_ok ctx def in log#ldebug - (lazy ("simplify_let_then_return:\n\n" ^ fun_decl_to_string ctx def ^ "\n")); + (lazy ("simplify_let_then_ok:\n\n" ^ fun_decl_to_string ctx def ^ "\n")); (* Simplify the aggregated ADTs. @@ -1890,11 +1890,10 @@ let apply_end_passes_to_def (ctx : trans_ctx) (def : fun_decl) : fun_decl = (* Simplify the let-then return again (the lambda simplification may have unlocked more simplifications here) *) - let def = simplify_let_then_return ctx def in + let def = simplify_let_then_ok ctx def in log#ldebug (lazy - ("simplify_let_then_return (pass 2):\n\n" ^ fun_decl_to_string ctx def - ^ "\n")); + ("simplify_let_then_ok (pass 2):\n\n" ^ fun_decl_to_string ctx def ^ "\n")); (* Decompose the monadic let-bindings - used by Coq *) let def = diff --git a/compiler/PureTypeCheck.ml b/compiler/PureTypeCheck.ml index 53ff8983..9eed76b2 100644 --- a/compiler/PureTypeCheck.ml +++ b/compiler/PureTypeCheck.ml @@ -32,7 +32,7 @@ let get_adt_field_types (meta : Meta.meta) | TResult -> let ty = Collections.List.to_cons_nil generics.types in let variant_id = Option.get variant_id in - if variant_id = result_return_id then [ ty ] + if variant_id = result_ok_id then [ ty ] else if variant_id = result_fail_id then [ mk_error_ty ] else craise __FILE__ __LINE__ meta diff --git a/compiler/PureUtils.ml b/compiler/PureUtils.ml index 6f44bb74..e8f2d95e 100644 --- a/compiler/PureUtils.ml +++ b/compiler/PureUtils.ml @@ -583,12 +583,12 @@ let mk_result_fail_texpression_with_error_id (meta : Meta.meta) let error = mk_error error in mk_result_fail_texpression meta error ty -let mk_result_return_texpression (meta : Meta.meta) (v : texpression) : - texpression = +let mk_result_ok_texpression (meta : Meta.meta) (v : texpression) : texpression + = let type_args = [ v.ty ] in let ty = TAdt (TAssumed TResult, mk_generic_args_from_types type_args) in let id = - AdtCons { adt_id = TAssumed TResult; variant_id = Some result_return_id } + AdtCons { adt_id = TAssumed TResult; variant_id = Some result_ok_id } in let qualif = { id; generics = mk_generic_args_from_types type_args } in let cons_e = Qualif qualif in @@ -610,11 +610,9 @@ let mk_result_fail_pattern_ignore_error (ty : ty) : typed_pattern = let error_pat : pattern = PatDummy in mk_result_fail_pattern error_pat ty -let mk_result_return_pattern (v : typed_pattern) : typed_pattern = +let mk_result_ok_pattern (v : typed_pattern) : typed_pattern = let ty = TAdt (TAssumed TResult, mk_generic_args_from_types [ v.ty ]) in - let value = - PatAdt { variant_id = Some result_return_id; field_values = [ v ] } - in + let value = PatAdt { variant_id = Some result_ok_id; field_values = [ v ] } in { value; ty } let opt_unmeta_mplace (e : texpression) : mplace option * texpression = @@ -788,6 +786,6 @@ let opt_destruct_ret (e : texpression) : texpression option = ty = _; }, arg ) - when variant_id = Some result_return_id -> + when variant_id = Some result_ok_id -> Some arg | _ -> None diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 5cd13072..38ee5df1 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -2102,7 +2102,7 @@ and translate_return (ectx : C.eval_ctx) (opt_v : V.typed_value option) else output in (* Wrap in a result - TODO: check effect_info.can_fail to not always wrap *) - mk_result_return_texpression ctx.meta output + mk_result_ok_texpression ctx.meta output and translate_return_with_loop (loop_id : V.LoopId.id) (is_continue : bool) (ctx : bs_ctx) : texpression = @@ -2150,8 +2150,7 @@ and translate_return_with_loop (loop_id : V.LoopId.id) (is_continue : bool) else output in (* Wrap in a result - TODO: check effect_info.can_fail to not always wrap *) - mk_emeta (Tag "return_with_loop") - (mk_result_return_texpression ctx.meta output) + mk_emeta (Tag "return_with_loop") (mk_result_ok_texpression ctx.meta output) and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : texpression = @@ -3226,7 +3225,7 @@ and translate_forward_end (ectx : C.eval_ctx) let state_var = List.map mk_texpression_from_var state_var in let ret = mk_simpl_tuple_texpression ctx.meta (state_var @ [ ret ]) in - let ret = mk_result_return_texpression ctx.meta ret in + let ret = mk_result_ok_texpression ctx.meta ret in (* Introduce all the let-bindings *) -- cgit v1.2.3 From b455f94c841b2423898f39bc9b6a4c35a3db56e3 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 4 Apr 2024 16:20:20 +0200 Subject: Regenerate the test files --- tests/coq/arrays/Arrays.v | 67 +++++----- tests/coq/arrays/Primitives.v | 46 +++---- tests/coq/betree/BetreeMain_Funs.v | 124 +++++++++--------- tests/coq/betree/Primitives.v | 46 +++---- tests/coq/demo/Demo.v | 40 +++--- tests/coq/demo/Primitives.v | 46 +++---- tests/coq/hashmap/Hashmap_Funs.v | 65 +++++----- tests/coq/hashmap/Primitives.v | 46 +++---- tests/coq/hashmap_on_disk/HashmapMain_Funs.v | 64 +++++----- tests/coq/hashmap_on_disk/Primitives.v | 46 +++---- tests/coq/misc/Bitwise.v | 6 +- tests/coq/misc/Constants.v | 35 +++--- tests/coq/misc/External_Funs.v | 10 +- tests/coq/misc/Loops.v | 120 ++++++++---------- tests/coq/misc/NoNestedBorrows.v | 102 +++++++-------- tests/coq/misc/Paper.v | 23 ++-- tests/coq/misc/PoloniusList.v | 8 +- tests/coq/misc/Primitives.v | 46 +++---- tests/coq/traits/Primitives.v | 46 +++---- tests/coq/traits/Traits.v | 50 ++++---- tests/fstar/arrays/Arrays.Funs.fst | 66 +++++----- tests/fstar/arrays/Primitives.fst | 56 ++++----- tests/fstar/betree/BetreeMain.Funs.fst | 120 +++++++++--------- tests/fstar/betree/Primitives.fst | 56 ++++----- .../fstar/betree_back_stateful/BetreeMain.Funs.fst | 120 +++++++++--------- tests/fstar/betree_back_stateful/Primitives.fst | 56 ++++----- tests/fstar/demo/Demo.fst | 36 +++--- tests/fstar/demo/Primitives.fst | 56 ++++----- tests/fstar/hashmap/Hashmap.Funs.fst | 65 +++++----- tests/fstar/hashmap/Primitives.fst | 56 ++++----- tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst | 70 +++++------ tests/fstar/hashmap_on_disk/Primitives.fst | 56 ++++----- tests/fstar/misc/Bitwise.fst | 6 +- tests/fstar/misc/Constants.fst | 34 ++--- tests/fstar/misc/External.Funs.fst | 12 +- tests/fstar/misc/Loops.Funs.fst | 116 ++++++++--------- tests/fstar/misc/NoNestedBorrows.fst | 130 +++++++++---------- tests/fstar/misc/Paper.fst | 27 ++-- tests/fstar/misc/PoloniusList.fst | 10 +- tests/fstar/misc/Primitives.fst | 56 ++++----- tests/fstar/traits/Primitives.fst | 56 ++++----- tests/fstar/traits/Traits.fst | 48 +++---- tests/lean/Arrays.lean | 66 +++++----- tests/lean/BetreeMain/Funs.lean | 122 +++++++++--------- tests/lean/Bitwise.lean | 6 +- tests/lean/Constants.lean | 34 ++--- tests/lean/Demo/Demo.lean | 38 +++--- tests/lean/External/Funs.lean | 12 +- tests/lean/Hashmap/Funs.lean | 62 ++++----- tests/lean/HashmapMain/Funs.lean | 64 +++++----- tests/lean/Loops.lean | 114 ++++++++--------- tests/lean/NoNestedBorrows.lean | 138 ++++++++++----------- tests/lean/Paper.lean | 32 ++--- tests/lean/PoloniusList.lean | 8 +- tests/lean/Traits.lean | 50 ++++---- 55 files changed, 1513 insertions(+), 1577 deletions(-) diff --git a/tests/coq/arrays/Arrays.v b/tests/coq/arrays/Arrays.v index 049d63cb..c9696147 100644 --- a/tests/coq/arrays/Arrays.v +++ b/tests/coq/arrays/Arrays.v @@ -36,19 +36,19 @@ Definition array_to_mut_slice_ (** [arrays::array_len]: Source: 'src/arrays.rs', lines 25:0-25:40 *) Definition array_len (T : Type) (s : array T 32%usize) : result usize := - s1 <- array_to_slice T 32%usize s; Return (slice_len T s1) + s1 <- array_to_slice T 32%usize s; Ok (slice_len T s1) . (** [arrays::shared_array_len]: Source: 'src/arrays.rs', lines 29:0-29:48 *) Definition shared_array_len (T : Type) (s : array T 32%usize) : result usize := - s1 <- array_to_slice T 32%usize s; Return (slice_len T s1) + s1 <- array_to_slice T 32%usize s; Ok (slice_len T s1) . (** [arrays::shared_slice_len]: Source: 'src/arrays.rs', lines 33:0-33:44 *) Definition shared_slice_len (T : Type) (s : slice T) : result usize := - Return (slice_len T s) + Ok (slice_len T s) . (** [arrays::index_array_shared]: @@ -114,7 +114,7 @@ Definition slice_subslice_mut_ (core_slice_index_SliceIndexRangeUsizeSliceTInst u32) x {| core_ops_range_Range_start := y; core_ops_range_Range_end_ := z |}; let (s, index_mut_back) := p in - Return (s, index_mut_back) + Ok (s, index_mut_back) . (** [arrays::array_to_slice_shared_]: @@ -155,7 +155,7 @@ Definition array_subslice_mut_ (core_slice_index_SliceIndexRangeUsizeSliceTInst u32)) x {| core_ops_range_Range_start := y; core_ops_range_Range_end_ := z |}; let (s, index_mut_back) := p in - Return (s, index_mut_back) + Ok (s, index_mut_back) . (** [arrays::index_slice_0]: @@ -192,47 +192,46 @@ Definition update_update_array let (_, index_mut_back1) := p1 in a1 <- index_mut_back1 0%u32; _ <- index_mut_back a1; - Return tt + Ok tt . (** [arrays::array_local_deep_copy]: Source: 'src/arrays.rs', lines 118:0-118:43 *) Definition array_local_deep_copy (x : array u32 32%usize) : result unit := - Return tt + Ok tt . (** [arrays::take_array]: Source: 'src/arrays.rs', lines 122:0-122:30 *) Definition take_array (a : array u32 2%usize) : result unit := - Return tt. + Ok tt. (** [arrays::take_array_borrow]: Source: 'src/arrays.rs', lines 123:0-123:38 *) Definition take_array_borrow (a : array u32 2%usize) : result unit := - Return tt -. + Ok tt. (** [arrays::take_slice]: Source: 'src/arrays.rs', lines 124:0-124:28 *) Definition take_slice (s : slice u32) : result unit := - Return tt. + Ok tt. (** [arrays::take_mut_slice]: Source: 'src/arrays.rs', lines 125:0-125:36 *) Definition take_mut_slice (s : slice u32) : result (slice u32) := - Return s. + Ok s. (** [arrays::const_array]: Source: 'src/arrays.rs', lines 127:0-127:32 *) Definition const_array : result (array u32 2%usize) := - Return (mk_array u32 2%usize [ 0%u32; 0%u32 ]) + Ok (mk_array u32 2%usize [ 0%u32; 0%u32 ]) . (** [arrays::const_slice]: Source: 'src/arrays.rs', lines 131:0-131:20 *) Definition const_slice : result unit := _ <- array_to_slice u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); - Return tt + Ok tt . (** [arrays::take_all]: @@ -247,7 +246,7 @@ Definition take_all : result unit := let (s1, to_slice_mut_back) := p in s2 <- take_mut_slice s1; _ <- to_slice_mut_back s2; - Return tt + Ok tt . (** [arrays::index_array]: @@ -272,7 +271,7 @@ Definition index_slice_u32_0 (x : slice u32) : result u32 := Source: 'src/arrays.rs', lines 166:0-166:50 *) Definition index_mut_slice_u32_0 (x : slice u32) : result (u32 * (slice u32)) := - i <- slice_index_usize u32 x 0%usize; Return (i, x) + i <- slice_index_usize u32 x 0%usize; Ok (i, x) . (** [arrays::index_all]: @@ -292,7 +291,7 @@ Definition index_all : result u32 := let (i7, s2) := p1 in i8 <- u32_add i6 i7; _ <- to_slice_mut_back s2; - Return i8 + Ok i8 . (** [arrays::update_array]: @@ -301,7 +300,7 @@ Definition update_array (x : array u32 2%usize) : result unit := p <- array_index_mut_usize u32 2%usize x 0%usize; let (_, index_mut_back) := p in _ <- index_mut_back 1%u32; - Return tt + Ok tt . (** [arrays::update_array_mut_borrow]: @@ -331,7 +330,7 @@ Definition update_all : result unit := let (s, to_slice_mut_back) := p in s1 <- update_mut_slice s; _ <- to_slice_mut_back s1; - Return tt + Ok tt . (** [arrays::range_all]: @@ -349,7 +348,7 @@ Definition range_all : result unit := let (s, index_mut_back) := p in s1 <- update_mut_slice s; _ <- index_mut_back s1; - Return tt + Ok tt . (** [arrays::deref_array_borrow]: @@ -362,13 +361,13 @@ Definition deref_array_borrow (x : array u32 2%usize) : result u32 := Source: 'src/arrays.rs', lines 219:0-219:54 *) Definition deref_array_mut_borrow (x : array u32 2%usize) : result (u32 * (array u32 2%usize)) := - i <- array_index_usize u32 2%usize x 0%usize; Return (i, x) + i <- array_index_usize u32 2%usize x 0%usize; Ok (i, x) . (** [arrays::take_array_t]: Source: 'src/arrays.rs', lines 227:0-227:31 *) Definition take_array_t (a : array AB_t 2%usize) : result unit := - Return tt. + Ok tt. (** [arrays::non_copyable_array]: Source: 'src/arrays.rs', lines 229:0-229:27 *) @@ -390,7 +389,7 @@ Fixpoint sum_loop sum3 <- u32_add sum1 i2; i3 <- usize_add i 1%usize; sum_loop n1 s sum3 i3) - else Return sum1 + else Ok sum1 end . @@ -418,7 +417,7 @@ Fixpoint sum2_loop sum3 <- u32_add sum1 i4; i5 <- usize_add i 1%usize; sum2_loop n1 s s2 sum3 i5) - else Return sum1 + else Ok sum1 end . @@ -439,7 +438,7 @@ Definition f0 : result unit := let (_, index_mut_back) := p1 in s1 <- index_mut_back 1%u32; _ <- to_slice_mut_back s1; - Return tt + Ok tt . (** [arrays::f1]: @@ -450,13 +449,13 @@ Definition f1 : result unit := 0%usize; let (_, index_mut_back) := p in _ <- index_mut_back 1%u32; - Return tt + Ok tt . (** [arrays::f2]: Source: 'src/arrays.rs', lines 273:0-273:17 *) Definition f2 (i : u32) : result unit := - Return tt. + Ok tt. (** [arrays::f4]: Source: 'src/arrays.rs', lines 282:0-282:54 *) @@ -483,7 +482,7 @@ Definition f3 (n : nat) : result u32 := (** [arrays::SZ] Source: 'src/arrays.rs', lines 286:0-286:19 *) -Definition sz_body : result usize := Return 32%usize. +Definition sz_body : result usize := Ok 32%usize. Definition sz : usize := sz_body%global. (** [arrays::f5]: @@ -505,7 +504,7 @@ Definition ite : result unit := let (_, s3) := p3 in _ <- to_slice_mut_back1 s3; _ <- to_slice_mut_back s1; - Return tt + Ok tt . (** [arrays::zero_slice]: loop 0: @@ -522,7 +521,7 @@ Fixpoint zero_slice_loop i1 <- usize_add i 1%usize; a1 <- index_mut_back 0%u8; zero_slice_loop n1 a1 i1 len) - else Return a + else Ok a end . @@ -541,14 +540,14 @@ Fixpoint iter_mut_slice_loop | S n1 => if i s< len then (i1 <- usize_add i 1%usize; iter_mut_slice_loop n1 len i1) - else Return tt + else Ok tt end . (** [arrays::iter_mut_slice]: Source: 'src/arrays.rs', lines 312:0-312:35 *) Definition iter_mut_slice (n : nat) (a : slice u8) : result (slice u8) := - let len := slice_len u8 a in _ <- iter_mut_slice_loop n len 0%usize; Return a + let len := slice_len u8 a in _ <- iter_mut_slice_loop n len 0%usize; Ok a . (** [arrays::sum_mut_slice]: loop 0: @@ -565,7 +564,7 @@ Fixpoint sum_mut_slice_loop s1 <- u32_add s i2; i3 <- usize_add i 1%usize; sum_mut_slice_loop n1 a i3 s1) - else Return s + else Ok s end . @@ -573,7 +572,7 @@ Fixpoint sum_mut_slice_loop Source: 'src/arrays.rs', lines 320:0-320:42 *) Definition sum_mut_slice (n : nat) (a : slice u32) : result (u32 * (slice u32)) := - i <- sum_mut_slice_loop n a 0%usize 0%u32; Return (i, a) + i <- sum_mut_slice_loop n a 0%usize 0%u32; Ok (i, a) . End Arrays. diff --git a/tests/coq/arrays/Primitives.v b/tests/coq/arrays/Primitives.v index 990e27e4..e84d65ce 100644 --- a/tests/coq/arrays/Primitives.v +++ b/tests/coq/arrays/Primitives.v @@ -19,19 +19,19 @@ Inductive error := | OutOfFuel. Inductive result A := - | Return : A -> result A + | Ok : A -> result A | Fail_ : error -> result A. -Arguments Return {_} a. +Arguments Ok {_} a. Arguments Fail_ {_}. Definition bind {A B} (m: result A) (f: A -> result B) : result B := match m with | Fail_ e => Fail_ e - | Return x => f x + | Ok x => f x end. -Definition return_ {A: Type} (x: A) : result A := Return x. +Definition return_ {A: Type} (x: A) : result A := Ok x. Definition fail_ {A: Type} (e: error) : result A := Fail_ e. Notation "x <- c1 ; c2" := (bind c1 (fun x => c2)) @@ -39,27 +39,27 @@ Notation "x <- c1 ; c2" := (bind c1 (fun x => c2)) (** Monadic assert *) Definition massert (b: bool) : result unit := - if b then Return tt else Fail_ Failure. + if b then Ok tt else Fail_ Failure. (** Normalize and unwrap a successful result (used for globals) *) -Definition eval_result_refl {A} {x} (a: result A) (p: a = Return x) : A := - match a as r return (r = Return x -> A) with - | Return a' => fun _ => a' +Definition eval_result_refl {A} {x} (a: result A) (p: a = Ok x) : A := + match a as r return (r = Ok x -> A) with + | Ok a' => fun _ => a' | Fail_ e => fun p' => False_rect _ (eq_ind (Fail_ e) (fun e : result A => match e with - | Return _ => False + | Ok _ => False | Fail_ e => True end) - I (Return x) p') + I (Ok x) p') end p. Notation "x %global" := (eval_result_refl x eq_refl) (at level 40). Notation "x %return" := (eval_result_refl x eq_refl) (at level 40). (* Sanity check *) -Check (if true then Return (1 + 2) else Fail_ Failure)%global = 3. +Check (if true then Ok (1 + 2) else Fail_ Failure)%global = 3. (*** Misc *) @@ -236,7 +236,7 @@ Import Sumbool. Definition mk_scalar (ty: scalar_ty) (x: Z) : result (scalar ty) := match sumbool_of_bool (scalar_in_bounds ty x) with - | left H => Return (exist _ x (scalar_in_bounds_valid _ _ H)) + | left H => Ok (exist _ x (scalar_in_bounds_valid _ _ H)) | right _ => Fail_ Failure end. @@ -544,9 +544,9 @@ Arguments core_ops_range_Range_end_ {_}. (*** [alloc] *) -Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Ok x. Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result (T * (T -> result T)) := - Return (x, fun x => Return x). + Ok (x, fun x => Ok x). (* Trait instance *) Definition alloc_boxed_Box_coreopsDerefInst (Self : Type) : core_ops_deref_Deref Self := {| @@ -589,7 +589,7 @@ Definition array_index_mut_usize (T : Type) (n : usize) (a : array T n) (i : usi result (T * (T -> result (array T n))) := match array_index_usize T n a i with | Fail_ e => Fail_ e - | Return x => Return (x, array_update_usize T n a i) + | Ok x => Ok (x, array_update_usize T n a i) end. (*** Slice *) @@ -603,7 +603,7 @@ Definition slice_index_mut_usize (T : Type) (s : slice T) (i : usize) : result (T * (T -> result (slice T))) := match slice_index_usize T s i with | Fail_ e => Fail_ e - | Return x => Return (x, slice_update_usize T s i) + | Ok x => Ok (x, slice_update_usize T s i) end. (*** Subslices *) @@ -615,7 +615,7 @@ Definition array_to_slice_mut (T : Type) (n : usize) (a : array T n) : result (slice T * (slice T -> result (array T n))) := match array_to_slice T n a with | Fail_ e => Fail_ e - | Return x => Return (x, array_from_slice T n a) + | Ok x => Ok (x, array_from_slice T n a) end. Axiom array_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize), result (slice T). @@ -657,17 +657,17 @@ end end. Definition alloc_vec_Vec_bind {A B} (v: alloc_vec_Vec A) (f: list A -> result (list B)) : result (alloc_vec_Vec B) := l <- f (alloc_vec_Vec_to_list v) ; match sumbool_of_bool (scalar_le_max Usize (Z.of_nat (length l))) with - | left H => Return (exist _ l (scalar_le_max_valid _ _ H)) + | left H => Ok (exist _ l (scalar_le_max_valid _ _ H)) | right _ => Fail_ Failure end. Definition alloc_vec_Vec_push (T: Type) (v: alloc_vec_Vec T) (x: T) : result (alloc_vec_Vec T) := - alloc_vec_Vec_bind v (fun l => Return (l ++ [x])). + alloc_vec_Vec_bind v (fun l => Ok (l ++ [x])). Definition alloc_vec_Vec_insert (T: Type) (v: alloc_vec_Vec T) (i: usize) (x: T) : result (alloc_vec_Vec T) := alloc_vec_Vec_bind v (fun l => if to_Z i result (alloc_vec_Vec T))) := match alloc_vec_Vec_index_usize v i with - | Return x => - Return (x, alloc_vec_Vec_update_usize v i) + | Ok x => + Ok (x, alloc_vec_Vec_update_usize v i) | Fail_ e => Fail_ e end. @@ -717,7 +717,7 @@ Definition core_slice_index_Slice_index x <- inst.(core_slice_index_SliceIndex_get) i s; match x with | None => Fail_ Failure - | Some x => Return x + | Some x => Ok x end. (* [core::slice::index::Range:::get]: forward function *) diff --git a/tests/coq/betree/BetreeMain_Funs.v b/tests/coq/betree/BetreeMain_Funs.v index 9256b149..80518eab 100644 --- a/tests/coq/betree/BetreeMain_Funs.v +++ b/tests/coq/betree/BetreeMain_Funs.v @@ -49,13 +49,13 @@ Definition betree_store_leaf_node (** [betree_main::betree::fresh_node_id]: Source: 'src/betree.rs', lines 55:0-55:48 *) Definition betree_fresh_node_id (counter : u64) : result (u64 * u64) := - counter1 <- u64_add counter 1%u64; Return (counter, counter1) + counter1 <- u64_add counter 1%u64; Ok (counter, counter1) . (** [betree_main::betree::{betree_main::betree::NodeIdCounter}::new]: Source: 'src/betree.rs', lines 206:4-206:20 *) Definition betree_NodeIdCounter_new : result betree_NodeIdCounter_t := - Return {| betree_NodeIdCounter_next_node_id := 0%u64 |} + Ok {| betree_NodeIdCounter_next_node_id := 0%u64 |} . (** [betree_main::betree::{betree_main::betree::NodeIdCounter}::fresh_id]: @@ -63,7 +63,7 @@ Definition betree_NodeIdCounter_new : result betree_NodeIdCounter_t := Definition betree_NodeIdCounter_fresh_id (self : betree_NodeIdCounter_t) : result (u64 * betree_NodeIdCounter_t) := i <- u64_add self.(betree_NodeIdCounter_next_node_id) 1%u64; - Return (self.(betree_NodeIdCounter_next_node_id), + Ok (self.(betree_NodeIdCounter_next_node_id), {| betree_NodeIdCounter_next_node_id := i |}) . @@ -74,16 +74,16 @@ Definition betree_upsert_update match prev with | None => match st with - | Betree_UpsertFunState_Add v => Return v - | Betree_UpsertFunState_Sub _ => Return 0%u64 + | Betree_UpsertFunState_Add v => Ok v + | Betree_UpsertFunState_Sub _ => Ok 0%u64 end | Some prev1 => match st with | Betree_UpsertFunState_Add v => margin <- u64_sub core_u64_max prev1; - if margin s>= v then u64_add prev1 v else Return core_u64_max + if margin s>= v then u64_add prev1 v else Ok core_u64_max | Betree_UpsertFunState_Sub v => - if prev1 s>= v then u64_sub prev1 v else Return 0%u64 + if prev1 s>= v then u64_sub prev1 v else Ok 0%u64 end end . @@ -97,7 +97,7 @@ Fixpoint betree_List_len | S n1 => match self with | Betree_List_Cons _ tl => i <- betree_List_len T n1 tl; u64_add 1%u64 i - | Betree_List_Nil => Return 0%u64 + | Betree_List_Nil => Ok 0%u64 end end . @@ -112,14 +112,14 @@ Fixpoint betree_List_split_at | O => Fail_ OutOfFuel | S n2 => if n1 s= 0%u64 - then Return (Betree_List_Nil, self) + then Ok (Betree_List_Nil, self) else match self with | Betree_List_Cons hd tl => i <- u64_sub n1 1%u64; p <- betree_List_split_at T n2 tl i; let (ls0, ls1) := p in - Return (Betree_List_Cons hd ls0, ls1) + Ok (Betree_List_Cons hd ls0, ls1) | Betree_List_Nil => Fail_ Failure end end @@ -130,7 +130,7 @@ Fixpoint betree_List_split_at Definition betree_List_push_front (T : Type) (self : betree_List_t T) (x : T) : result (betree_List_t T) := let (tl, _) := core_mem_replace (betree_List_t T) self Betree_List_Nil in - Return (Betree_List_Cons x tl) + Ok (Betree_List_Cons x tl) . (** [betree_main::betree::{betree_main::betree::List#1}::pop_front]: @@ -139,7 +139,7 @@ Definition betree_List_pop_front (T : Type) (self : betree_List_t T) : result (T * (betree_List_t T)) := let (ls, _) := core_mem_replace (betree_List_t T) self Betree_List_Nil in match ls with - | Betree_List_Cons x tl => Return (x, tl) + | Betree_List_Cons x tl => Ok (x, tl) | Betree_List_Nil => Fail_ Failure end . @@ -148,7 +148,7 @@ Definition betree_List_pop_front Source: 'src/betree.rs', lines 318:4-318:22 *) Definition betree_List_hd (T : Type) (self : betree_List_t T) : result T := match self with - | Betree_List_Cons hd _ => Return hd + | Betree_List_Cons hd _ => Ok hd | Betree_List_Nil => Fail_ Failure end . @@ -158,8 +158,8 @@ Definition betree_List_hd (T : Type) (self : betree_List_t T) : result T := Definition betree_ListPairU64T_head_has_key (T : Type) (self : betree_List_t (u64 * T)) (key : u64) : result bool := match self with - | Betree_List_Cons hd _ => let (i, _) := hd in Return (i s= key) - | Betree_List_Nil => Return false + | Betree_List_Cons hd _ => let (i, _) := hd in Ok (i s= key) + | Betree_List_Nil => Ok false end . @@ -176,12 +176,12 @@ Fixpoint betree_ListPairU64T_partition_at_pivot | Betree_List_Cons hd tl => let (i, t) := hd in if i s>= pivot - then Return (Betree_List_Nil, Betree_List_Cons (i, t) tl) + then Ok (Betree_List_Nil, Betree_List_Cons (i, t) tl) else ( p <- betree_ListPairU64T_partition_at_pivot T n1 tl pivot; let (ls0, ls1) := p in - Return (Betree_List_Cons (i, t) ls0, ls1)) - | Betree_List_Nil => Return (Betree_List_Nil, Betree_List_Nil) + Ok (Betree_List_Cons (i, t) ls0, ls1)) + | Betree_List_Nil => Ok (Betree_List_Nil, Betree_List_Nil) end end . @@ -218,7 +218,7 @@ Definition betree_Leaf_split betree_Leaf_id := id1; betree_Leaf_size := params.(betree_Params_split_size) |} in - Return (st2, (mkbetree_Internal_t self.(betree_Leaf_id) pivot n1 n2, + Ok (st2, (mkbetree_Internal_t self.(betree_Leaf_id) pivot n1 n2, node_id_cnt2)) . @@ -236,16 +236,16 @@ Fixpoint betree_Node_lookup_first_message_for_key | Betree_List_Cons x next_msgs => let (i, m) := x in if i s>= key - then Return (Betree_List_Cons (i, m) next_msgs, Return) + then Ok (Betree_List_Cons (i, m) next_msgs, Ok) else ( p <- betree_Node_lookup_first_message_for_key n1 key next_msgs; let (l, lookup_first_message_for_key_back) := p in let back := fun (ret : betree_List_t (u64 * betree_Message_t)) => next_msgs1 <- lookup_first_message_for_key_back ret; - Return (Betree_List_Cons (i, m) next_msgs1) in - Return (l, back)) - | Betree_List_Nil => Return (Betree_List_Nil, Return) + Ok (Betree_List_Cons (i, m) next_msgs1) in + Ok (l, back)) + | Betree_List_Nil => Ok (Betree_List_Nil, Ok) end end . @@ -263,12 +263,10 @@ Fixpoint betree_Node_lookup_in_bindings | Betree_List_Cons hd tl => let (i, i1) := hd in if i s= key - then Return (Some i1) + then Ok (Some i1) else - if i s> key - then Return None - else betree_Node_lookup_in_bindings n1 key tl - | Betree_List_Nil => Return None + if i s> key then Ok None else betree_Node_lookup_in_bindings n1 key tl + | Betree_List_Nil => Ok None end end . @@ -302,7 +300,7 @@ Fixpoint betree_Node_apply_upserts msgs1 <- betree_List_push_front (u64 * betree_Message_t) msgs (key, Betree_Message_Insert v); - Return (st1, (v, msgs1))) + Ok (st1, (v, msgs1))) end . @@ -320,13 +318,13 @@ Fixpoint betree_Internal_lookup_in_children p <- betree_Node_lookup n1 self.(betree_Internal_left) key st; let (st1, p1) := p in let (o, n2) := p1 in - Return (st1, (o, mkbetree_Internal_t self.(betree_Internal_id) + Ok (st1, (o, mkbetree_Internal_t self.(betree_Internal_id) self.(betree_Internal_pivot) n2 self.(betree_Internal_right)))) else ( p <- betree_Node_lookup n1 self.(betree_Internal_right) key st; let (st1, p1) := p in let (o, n2) := p1 in - Return (st1, (o, mkbetree_Internal_t self.(betree_Internal_id) + Ok (st1, (o, mkbetree_Internal_t self.(betree_Internal_id) self.(betree_Internal_pivot) self.(betree_Internal_left) n2))) end @@ -354,19 +352,19 @@ with betree_Node_lookup let (st2, p4) := p3 in let (o, node1) := p4 in _ <- lookup_first_message_for_key_back (Betree_List_Cons (k, msg) l); - Return (st2, (o, Betree_Node_Internal node1))) + Ok (st2, (o, Betree_Node_Internal node1))) else match msg with | Betree_Message_Insert v => _ <- lookup_first_message_for_key_back (Betree_List_Cons (k, Betree_Message_Insert v) l); - Return (st1, (Some v, Betree_Node_Internal node)) + Ok (st1, (Some v, Betree_Node_Internal node)) | Betree_Message_Delete => _ <- lookup_first_message_for_key_back (Betree_List_Cons (k, Betree_Message_Delete) l); - Return (st1, (None, Betree_Node_Internal node)) + Ok (st1, (None, Betree_Node_Internal node)) | Betree_Message_Upsert ufs => p3 <- betree_Internal_lookup_in_children n1 node key st1; let (st2, p4) := p3 in @@ -380,20 +378,20 @@ with betree_Node_lookup p7 <- betree_store_internal_node node1.(betree_Internal_id) msgs1 st3; let (st4, _) := p7 in - Return (st4, (Some v1, Betree_Node_Internal node1)) + Ok (st4, (Some v1, Betree_Node_Internal node1)) end | Betree_List_Nil => p2 <- betree_Internal_lookup_in_children n1 node key st1; let (st2, p3) := p2 in let (o, node1) := p3 in _ <- lookup_first_message_for_key_back Betree_List_Nil; - Return (st2, (o, Betree_Node_Internal node1)) + Ok (st2, (o, Betree_Node_Internal node1)) end | Betree_Node_Leaf node => p <- betree_load_leaf_node node.(betree_Leaf_id) st; let (st1, bindings) := p in o <- betree_Node_lookup_in_bindings n1 key bindings; - Return (st1, (o, Betree_Node_Leaf node)) + Ok (st1, (o, Betree_Node_Leaf node)) end end . @@ -417,8 +415,8 @@ Fixpoint betree_Node_filter_messages_for_key m) l); let (_, msgs1) := p1 in betree_Node_filter_messages_for_key n1 key msgs1) - else Return (Betree_List_Cons (k, m) l) - | Betree_List_Nil => Return Betree_List_Nil + else Ok (Betree_List_Cons (k, m) l) + | Betree_List_Nil => Ok Betree_List_Nil end end . @@ -443,10 +441,10 @@ Fixpoint betree_Node_lookup_first_message_after_key let back := fun (ret : betree_List_t (u64 * betree_Message_t)) => next_msgs1 <- lookup_first_message_after_key_back ret; - Return (Betree_List_Cons (k, m) next_msgs1) in - Return (l, back)) - else Return (Betree_List_Cons (k, m) next_msgs, Return) - | Betree_List_Nil => Return (Betree_List_Nil, Return) + Ok (Betree_List_Cons (k, m) next_msgs1) in + Ok (l, back)) + else Ok (Betree_List_Cons (k, m) next_msgs, Ok) + | Betree_List_Nil => Ok (Betree_List_Nil, Ok) end end . @@ -527,7 +525,7 @@ Fixpoint betree_Node_apply_messages_to_internal let (i, m) := new_msg in msgs1 <- betree_Node_apply_to_internal n1 msgs i m; betree_Node_apply_messages_to_internal n1 msgs1 new_msgs_tl - | Betree_List_Nil => Return msgs + | Betree_List_Nil => Ok msgs end end . @@ -546,16 +544,16 @@ Fixpoint betree_Node_lookup_mut_in_bindings | Betree_List_Cons hd tl => let (i, i1) := hd in if i s>= key - then Return (Betree_List_Cons (i, i1) tl, Return) + then Ok (Betree_List_Cons (i, i1) tl, Ok) else ( p <- betree_Node_lookup_mut_in_bindings n1 key tl; let (l, lookup_mut_in_bindings_back) := p in let back := fun (ret : betree_List_t (u64 * u64)) => tl1 <- lookup_mut_in_bindings_back ret; - Return (Betree_List_Cons (i, i1) tl1) in - Return (l, back)) - | Betree_List_Nil => Return (Betree_List_Nil, Return) + Ok (Betree_List_Cons (i, i1) tl1) in + Ok (l, back)) + | Betree_List_Nil => Ok (Betree_List_Nil, Ok) end end . @@ -613,7 +611,7 @@ Fixpoint betree_Node_apply_messages_to_leaf let (i, m) := new_msg in bindings1 <- betree_Node_apply_to_leaf n1 bindings i m; betree_Node_apply_messages_to_leaf n1 bindings1 new_msgs_tl - | Betree_List_Nil => Return bindings + | Betree_List_Nil => Ok bindings end end . @@ -650,20 +648,20 @@ Fixpoint betree_Internal_flush node_id_cnt1 msgs_right st1; let (st2, p4) := p3 in let (n3, node_id_cnt2) := p4 in - Return (st2, (Betree_List_Nil, (mkbetree_Internal_t + Ok (st2, (Betree_List_Nil, (mkbetree_Internal_t self.(betree_Internal_id) self.(betree_Internal_pivot) n2 n3, node_id_cnt2)))) else - Return (st1, (msgs_right, (mkbetree_Internal_t - self.(betree_Internal_id) self.(betree_Internal_pivot) n2 - self.(betree_Internal_right), node_id_cnt1)))) + Ok (st1, (msgs_right, (mkbetree_Internal_t self.(betree_Internal_id) + self.(betree_Internal_pivot) n2 self.(betree_Internal_right), + node_id_cnt1)))) else ( p1 <- betree_Node_apply_messages n1 self.(betree_Internal_right) params node_id_cnt msgs_right st; let (st1, p2) := p1 in let (n2, node_id_cnt1) := p2 in - Return (st1, (msgs_left, (mkbetree_Internal_t self.(betree_Internal_id) + Ok (st1, (msgs_left, (mkbetree_Internal_t self.(betree_Internal_id) self.(betree_Internal_pivot) self.(betree_Internal_left) n2, node_id_cnt1)))) end @@ -694,12 +692,12 @@ with betree_Node_apply_messages p4 <- betree_store_internal_node node1.(betree_Internal_id) content2 st2; let (st3, _) := p4 in - Return (st3, (Betree_Node_Internal node1, node_id_cnt1))) + Ok (st3, (Betree_Node_Internal node1, node_id_cnt1))) else ( p1 <- betree_store_internal_node node.(betree_Internal_id) content1 st1; let (st2, _) := p1 in - Return (st2, (Betree_Node_Internal node, node_id_cnt))) + Ok (st2, (Betree_Node_Internal node, node_id_cnt))) | Betree_Node_Leaf node => p <- betree_load_leaf_node node.(betree_Leaf_id) st; let (st1, content) := p in @@ -713,11 +711,11 @@ with betree_Node_apply_messages let (new_node, node_id_cnt1) := p2 in p3 <- betree_store_leaf_node node.(betree_Leaf_id) Betree_List_Nil st2; let (st3, _) := p3 in - Return (st3, (Betree_Node_Internal new_node, node_id_cnt1))) + Ok (st3, (Betree_Node_Internal new_node, node_id_cnt1))) else ( p1 <- betree_store_leaf_node node.(betree_Leaf_id) content1 st1; let (st2, _) := p1 in - Return (st2, (Betree_Node_Leaf + Ok (st2, (Betree_Node_Leaf {| betree_Leaf_id := node.(betree_Leaf_id); betree_Leaf_size := len |}, node_id_cnt))) end @@ -737,7 +735,7 @@ Definition betree_Node_apply (key, new_msg) Betree_List_Nil) st; let (st1, p1) := p in let (self1, node_id_cnt1) := p1 in - Return (st1, (self1, node_id_cnt1)) + Ok (st1, (self1, node_id_cnt1)) . (** [betree_main::betree::{betree_main::betree::BeTree#6}::new]: @@ -751,7 +749,7 @@ Definition betree_BeTree_new let (id, node_id_cnt1) := p in p1 <- betree_store_leaf_node id Betree_List_Nil st; let (st1, _) := p1 in - Return (st1, + Ok (st1, {| betree_BeTree_params := {| @@ -777,7 +775,7 @@ Definition betree_BeTree_apply self.(betree_BeTree_node_id_cnt) key msg st; let (st1, p1) := p in let (n1, nic) := p1 in - Return (st1, + Ok (st1, {| betree_BeTree_params := self.(betree_BeTree_params); betree_BeTree_node_id_cnt := nic; @@ -822,7 +820,7 @@ Definition betree_BeTree_lookup p <- betree_Node_lookup n self.(betree_BeTree_root) key st; let (st1, p1) := p in let (o, n1) := p1 in - Return (st1, (o, + Ok (st1, (o, {| betree_BeTree_params := self.(betree_BeTree_params); betree_BeTree_node_id_cnt := self.(betree_BeTree_node_id_cnt); @@ -833,7 +831,7 @@ Definition betree_BeTree_lookup (** [betree_main::main]: Source: 'src/betree_main.rs', lines 5:0-5:9 *) Definition main : result unit := - Return tt. + Ok tt. (** Unit test for [betree_main::main] *) Check (main )%return. diff --git a/tests/coq/betree/Primitives.v b/tests/coq/betree/Primitives.v index 990e27e4..e84d65ce 100644 --- a/tests/coq/betree/Primitives.v +++ b/tests/coq/betree/Primitives.v @@ -19,19 +19,19 @@ Inductive error := | OutOfFuel. Inductive result A := - | Return : A -> result A + | Ok : A -> result A | Fail_ : error -> result A. -Arguments Return {_} a. +Arguments Ok {_} a. Arguments Fail_ {_}. Definition bind {A B} (m: result A) (f: A -> result B) : result B := match m with | Fail_ e => Fail_ e - | Return x => f x + | Ok x => f x end. -Definition return_ {A: Type} (x: A) : result A := Return x. +Definition return_ {A: Type} (x: A) : result A := Ok x. Definition fail_ {A: Type} (e: error) : result A := Fail_ e. Notation "x <- c1 ; c2" := (bind c1 (fun x => c2)) @@ -39,27 +39,27 @@ Notation "x <- c1 ; c2" := (bind c1 (fun x => c2)) (** Monadic assert *) Definition massert (b: bool) : result unit := - if b then Return tt else Fail_ Failure. + if b then Ok tt else Fail_ Failure. (** Normalize and unwrap a successful result (used for globals) *) -Definition eval_result_refl {A} {x} (a: result A) (p: a = Return x) : A := - match a as r return (r = Return x -> A) with - | Return a' => fun _ => a' +Definition eval_result_refl {A} {x} (a: result A) (p: a = Ok x) : A := + match a as r return (r = Ok x -> A) with + | Ok a' => fun _ => a' | Fail_ e => fun p' => False_rect _ (eq_ind (Fail_ e) (fun e : result A => match e with - | Return _ => False + | Ok _ => False | Fail_ e => True end) - I (Return x) p') + I (Ok x) p') end p. Notation "x %global" := (eval_result_refl x eq_refl) (at level 40). Notation "x %return" := (eval_result_refl x eq_refl) (at level 40). (* Sanity check *) -Check (if true then Return (1 + 2) else Fail_ Failure)%global = 3. +Check (if true then Ok (1 + 2) else Fail_ Failure)%global = 3. (*** Misc *) @@ -236,7 +236,7 @@ Import Sumbool. Definition mk_scalar (ty: scalar_ty) (x: Z) : result (scalar ty) := match sumbool_of_bool (scalar_in_bounds ty x) with - | left H => Return (exist _ x (scalar_in_bounds_valid _ _ H)) + | left H => Ok (exist _ x (scalar_in_bounds_valid _ _ H)) | right _ => Fail_ Failure end. @@ -544,9 +544,9 @@ Arguments core_ops_range_Range_end_ {_}. (*** [alloc] *) -Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Ok x. Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result (T * (T -> result T)) := - Return (x, fun x => Return x). + Ok (x, fun x => Ok x). (* Trait instance *) Definition alloc_boxed_Box_coreopsDerefInst (Self : Type) : core_ops_deref_Deref Self := {| @@ -589,7 +589,7 @@ Definition array_index_mut_usize (T : Type) (n : usize) (a : array T n) (i : usi result (T * (T -> result (array T n))) := match array_index_usize T n a i with | Fail_ e => Fail_ e - | Return x => Return (x, array_update_usize T n a i) + | Ok x => Ok (x, array_update_usize T n a i) end. (*** Slice *) @@ -603,7 +603,7 @@ Definition slice_index_mut_usize (T : Type) (s : slice T) (i : usize) : result (T * (T -> result (slice T))) := match slice_index_usize T s i with | Fail_ e => Fail_ e - | Return x => Return (x, slice_update_usize T s i) + | Ok x => Ok (x, slice_update_usize T s i) end. (*** Subslices *) @@ -615,7 +615,7 @@ Definition array_to_slice_mut (T : Type) (n : usize) (a : array T n) : result (slice T * (slice T -> result (array T n))) := match array_to_slice T n a with | Fail_ e => Fail_ e - | Return x => Return (x, array_from_slice T n a) + | Ok x => Ok (x, array_from_slice T n a) end. Axiom array_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize), result (slice T). @@ -657,17 +657,17 @@ end end. Definition alloc_vec_Vec_bind {A B} (v: alloc_vec_Vec A) (f: list A -> result (list B)) : result (alloc_vec_Vec B) := l <- f (alloc_vec_Vec_to_list v) ; match sumbool_of_bool (scalar_le_max Usize (Z.of_nat (length l))) with - | left H => Return (exist _ l (scalar_le_max_valid _ _ H)) + | left H => Ok (exist _ l (scalar_le_max_valid _ _ H)) | right _ => Fail_ Failure end. Definition alloc_vec_Vec_push (T: Type) (v: alloc_vec_Vec T) (x: T) : result (alloc_vec_Vec T) := - alloc_vec_Vec_bind v (fun l => Return (l ++ [x])). + alloc_vec_Vec_bind v (fun l => Ok (l ++ [x])). Definition alloc_vec_Vec_insert (T: Type) (v: alloc_vec_Vec T) (i: usize) (x: T) : result (alloc_vec_Vec T) := alloc_vec_Vec_bind v (fun l => if to_Z i result (alloc_vec_Vec T))) := match alloc_vec_Vec_index_usize v i with - | Return x => - Return (x, alloc_vec_Vec_update_usize v i) + | Ok x => + Ok (x, alloc_vec_Vec_update_usize v i) | Fail_ e => Fail_ e end. @@ -717,7 +717,7 @@ Definition core_slice_index_Slice_index x <- inst.(core_slice_index_SliceIndex_get) i s; match x with | None => Fail_ Failure - | Some x => Return x + | Some x => Ok x end. (* [core::slice::index::Range:::get]: forward function *) diff --git a/tests/coq/demo/Demo.v b/tests/coq/demo/Demo.v index abec8e88..00b9b889 100644 --- a/tests/coq/demo/Demo.v +++ b/tests/coq/demo/Demo.v @@ -13,8 +13,8 @@ Module Demo. Definition choose (T : Type) (b : bool) (x : T) (y : T) : result (T * (T -> result (T * T))) := if b - then let back := fun (ret : T) => Return (ret, y) in Return (x, back) - else let back := fun (ret : T) => Return (x, ret) in Return (y, back) + then let back := fun (ret : T) => Ok (ret, y) in Ok (x, back) + else let back := fun (ret : T) => Ok (x, ret) in Ok (y, back) . (** [demo::mul2_add1]: @@ -37,7 +37,7 @@ Definition incr (x : u32) : result u32 := (** [demo::use_incr]: Source: 'src/demo.rs', lines 25:0-25:17 *) Definition use_incr : result unit := - x <- incr 0%u32; x1 <- incr x; _ <- incr x1; Return tt + x <- incr 0%u32; x1 <- incr x; _ <- incr x1; Ok tt . (** [demo::CList] @@ -58,9 +58,7 @@ Fixpoint list_nth (T : Type) (n : nat) (l : CList_t T) (i : u32) : result T := | S n1 => match l with | CList_CCons x tl => - if i s= 0%u32 - then Return x - else (i1 <- u32_sub i 1%u32; list_nth T n1 tl i1) + if i s= 0%u32 then Ok x else (i1 <- u32_sub i 1%u32; list_nth T n1 tl i1) | CList_CNil => Fail_ Failure end end @@ -78,17 +76,15 @@ Fixpoint list_nth_mut match l with | CList_CCons x tl => if i s= 0%u32 - then - let back := fun (ret : T) => Return (CList_CCons ret tl) in - Return (x, back) + then let back := fun (ret : T) => Ok (CList_CCons ret tl) in Ok (x, back) else ( i1 <- u32_sub i 1%u32; p <- list_nth_mut T n1 tl i1; let (t, list_nth_mut_back) := p in let back := - fun (ret : T) => - tl1 <- list_nth_mut_back ret; Return (CList_CCons x tl1) in - Return (t, back)) + fun (ret : T) => tl1 <- list_nth_mut_back ret; Ok (CList_CCons x tl1) + in + Ok (t, back)) | CList_CNil => Fail_ Failure end end @@ -106,16 +102,14 @@ Fixpoint list_nth_mut1_loop match l with | CList_CCons x tl => if i s= 0%u32 - then - let back := fun (ret : T) => Return (CList_CCons ret tl) in - Return (x, back) + then let back := fun (ret : T) => Ok (CList_CCons ret tl) in Ok (x, back) else ( i1 <- u32_sub i 1%u32; p <- list_nth_mut1_loop T n1 tl i1; let (t, back) := p in - let back1 := - fun (ret : T) => tl1 <- back ret; Return (CList_CCons x tl1) in - Return (t, back1)) + let back1 := fun (ret : T) => tl1 <- back ret; Ok (CList_CCons x tl1) + in + Ok (t, back1)) | CList_CNil => Fail_ Failure end end @@ -137,7 +131,7 @@ Fixpoint i32_id (n : nat) (i : i32) : result i32 := | O => Fail_ OutOfFuel | S n1 => if i s= 0%i32 - then Return 0%i32 + then Ok 0%i32 else (i1 <- i32_sub i 1%i32; i2 <- i32_id n1 i1; i32_add i2 1%i32) end . @@ -157,9 +151,9 @@ Fixpoint list_tail let (c, list_tail_back) := p in let back := fun (ret : CList_t T) => - tl1 <- list_tail_back ret; Return (CList_CCons t tl1) in - Return (c, back) - | CList_CNil => Return (CList_CNil, Return) + tl1 <- list_tail_back ret; Ok (CList_CCons t tl1) in + Ok (c, back) + | CList_CNil => Ok (CList_CNil, Ok) end end . @@ -176,7 +170,7 @@ Arguments Counter_t_incr { _ }. (** [demo::{(demo::Counter for usize)}::incr]: Source: 'src/demo.rs', lines 102:4-102:31 *) Definition counterUsize_incr (self : usize) : result (usize * usize) := - self1 <- usize_add self 1%usize; Return (self, self1) + self1 <- usize_add self 1%usize; Ok (self, self1) . (** Trait implementation: [demo::{(demo::Counter for usize)}] diff --git a/tests/coq/demo/Primitives.v b/tests/coq/demo/Primitives.v index 990e27e4..e84d65ce 100644 --- a/tests/coq/demo/Primitives.v +++ b/tests/coq/demo/Primitives.v @@ -19,19 +19,19 @@ Inductive error := | OutOfFuel. Inductive result A := - | Return : A -> result A + | Ok : A -> result A | Fail_ : error -> result A. -Arguments Return {_} a. +Arguments Ok {_} a. Arguments Fail_ {_}. Definition bind {A B} (m: result A) (f: A -> result B) : result B := match m with | Fail_ e => Fail_ e - | Return x => f x + | Ok x => f x end. -Definition return_ {A: Type} (x: A) : result A := Return x. +Definition return_ {A: Type} (x: A) : result A := Ok x. Definition fail_ {A: Type} (e: error) : result A := Fail_ e. Notation "x <- c1 ; c2" := (bind c1 (fun x => c2)) @@ -39,27 +39,27 @@ Notation "x <- c1 ; c2" := (bind c1 (fun x => c2)) (** Monadic assert *) Definition massert (b: bool) : result unit := - if b then Return tt else Fail_ Failure. + if b then Ok tt else Fail_ Failure. (** Normalize and unwrap a successful result (used for globals) *) -Definition eval_result_refl {A} {x} (a: result A) (p: a = Return x) : A := - match a as r return (r = Return x -> A) with - | Return a' => fun _ => a' +Definition eval_result_refl {A} {x} (a: result A) (p: a = Ok x) : A := + match a as r return (r = Ok x -> A) with + | Ok a' => fun _ => a' | Fail_ e => fun p' => False_rect _ (eq_ind (Fail_ e) (fun e : result A => match e with - | Return _ => False + | Ok _ => False | Fail_ e => True end) - I (Return x) p') + I (Ok x) p') end p. Notation "x %global" := (eval_result_refl x eq_refl) (at level 40). Notation "x %return" := (eval_result_refl x eq_refl) (at level 40). (* Sanity check *) -Check (if true then Return (1 + 2) else Fail_ Failure)%global = 3. +Check (if true then Ok (1 + 2) else Fail_ Failure)%global = 3. (*** Misc *) @@ -236,7 +236,7 @@ Import Sumbool. Definition mk_scalar (ty: scalar_ty) (x: Z) : result (scalar ty) := match sumbool_of_bool (scalar_in_bounds ty x) with - | left H => Return (exist _ x (scalar_in_bounds_valid _ _ H)) + | left H => Ok (exist _ x (scalar_in_bounds_valid _ _ H)) | right _ => Fail_ Failure end. @@ -544,9 +544,9 @@ Arguments core_ops_range_Range_end_ {_}. (*** [alloc] *) -Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Ok x. Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result (T * (T -> result T)) := - Return (x, fun x => Return x). + Ok (x, fun x => Ok x). (* Trait instance *) Definition alloc_boxed_Box_coreopsDerefInst (Self : Type) : core_ops_deref_Deref Self := {| @@ -589,7 +589,7 @@ Definition array_index_mut_usize (T : Type) (n : usize) (a : array T n) (i : usi result (T * (T -> result (array T n))) := match array_index_usize T n a i with | Fail_ e => Fail_ e - | Return x => Return (x, array_update_usize T n a i) + | Ok x => Ok (x, array_update_usize T n a i) end. (*** Slice *) @@ -603,7 +603,7 @@ Definition slice_index_mut_usize (T : Type) (s : slice T) (i : usize) : result (T * (T -> result (slice T))) := match slice_index_usize T s i with | Fail_ e => Fail_ e - | Return x => Return (x, slice_update_usize T s i) + | Ok x => Ok (x, slice_update_usize T s i) end. (*** Subslices *) @@ -615,7 +615,7 @@ Definition array_to_slice_mut (T : Type) (n : usize) (a : array T n) : result (slice T * (slice T -> result (array T n))) := match array_to_slice T n a with | Fail_ e => Fail_ e - | Return x => Return (x, array_from_slice T n a) + | Ok x => Ok (x, array_from_slice T n a) end. Axiom array_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize), result (slice T). @@ -657,17 +657,17 @@ end end. Definition alloc_vec_Vec_bind {A B} (v: alloc_vec_Vec A) (f: list A -> result (list B)) : result (alloc_vec_Vec B) := l <- f (alloc_vec_Vec_to_list v) ; match sumbool_of_bool (scalar_le_max Usize (Z.of_nat (length l))) with - | left H => Return (exist _ l (scalar_le_max_valid _ _ H)) + | left H => Ok (exist _ l (scalar_le_max_valid _ _ H)) | right _ => Fail_ Failure end. Definition alloc_vec_Vec_push (T: Type) (v: alloc_vec_Vec T) (x: T) : result (alloc_vec_Vec T) := - alloc_vec_Vec_bind v (fun l => Return (l ++ [x])). + alloc_vec_Vec_bind v (fun l => Ok (l ++ [x])). Definition alloc_vec_Vec_insert (T: Type) (v: alloc_vec_Vec T) (i: usize) (x: T) : result (alloc_vec_Vec T) := alloc_vec_Vec_bind v (fun l => if to_Z i result (alloc_vec_Vec T))) := match alloc_vec_Vec_index_usize v i with - | Return x => - Return (x, alloc_vec_Vec_update_usize v i) + | Ok x => + Ok (x, alloc_vec_Vec_update_usize v i) | Fail_ e => Fail_ e end. @@ -717,7 +717,7 @@ Definition core_slice_index_Slice_index x <- inst.(core_slice_index_SliceIndex_get) i s; match x with | None => Fail_ Failure - | Some x => Return x + | Some x => Ok x end. (* [core::slice::index::Range:::get]: forward function *) diff --git a/tests/coq/hashmap/Hashmap_Funs.v b/tests/coq/hashmap/Hashmap_Funs.v index c0cde78d..ebb7897d 100644 --- a/tests/coq/hashmap/Hashmap_Funs.v +++ b/tests/coq/hashmap/Hashmap_Funs.v @@ -13,7 +13,7 @@ Module Hashmap_Funs. (** [hashmap::hash_key]: Source: 'src/hashmap.rs', lines 27:0-27:32 *) Definition hash_key (k : usize) : result usize := - Return k. + Ok k. (** [hashmap::{hashmap::HashMap}::allocate_slots]: loop 0: Source: 'src/hashmap.rs', lines 50:4-56:5 *) @@ -29,7 +29,7 @@ Fixpoint hashMap_allocate_slots_loop slots1 <- alloc_vec_Vec_push (List_t T) slots List_Nil; n3 <- usize_sub n1 1%usize; hashMap_allocate_slots_loop T n2 slots1 n3) - else Return slots + else Ok slots end . @@ -52,7 +52,7 @@ Definition hashMap_new_with_capacity slots <- hashMap_allocate_slots T n (alloc_vec_Vec_new (List_t T)) capacity; i <- usize_mul capacity max_load_dividend; i1 <- usize_div i max_load_divisor; - Return + Ok {| hashMap_num_entries := 0%usize; hashMap_max_load_factor := (max_load_dividend, max_load_divisor); @@ -86,7 +86,7 @@ Fixpoint hashMap_clear_loop i2 <- usize_add i 1%usize; slots1 <- index_mut_back List_Nil; hashMap_clear_loop T n1 slots1 i2) - else Return slots + else Ok slots end . @@ -95,7 +95,7 @@ Fixpoint hashMap_clear_loop Definition hashMap_clear (T : Type) (n : nat) (self : HashMap_t T) : result (HashMap_t T) := hm <- hashMap_clear_loop T n self.(hashMap_slots) 0%usize; - Return + Ok {| hashMap_num_entries := 0%usize; hashMap_max_load_factor := self.(hashMap_max_load_factor); @@ -107,7 +107,7 @@ Definition hashMap_clear (** [hashmap::{hashmap::HashMap}::len]: Source: 'src/hashmap.rs', lines 90:4-90:30 *) Definition hashMap_len (T : Type) (self : HashMap_t T) : result usize := - Return self.(hashMap_num_entries) + Ok self.(hashMap_num_entries) . (** [hashmap::{hashmap::HashMap}::insert_in_list]: loop 0: @@ -122,12 +122,12 @@ Fixpoint hashMap_insert_in_list_loop match ls with | List_Cons ckey cvalue tl => if ckey s= key - then Return (false, List_Cons ckey value tl) + then Ok (false, List_Cons ckey value tl) else ( p <- hashMap_insert_in_list_loop T n1 key value tl; let (b, tl1) := p in - Return (b, List_Cons ckey cvalue tl1)) - | List_Nil => Return (true, List_Cons key value List_Nil) + Ok (b, List_Cons ckey cvalue tl1)) + | List_Nil => Ok (true, List_Cons key value List_Nil) end end . @@ -161,7 +161,7 @@ Definition hashMap_insert_no_resize then ( i1 <- usize_add self.(hashMap_num_entries) 1%usize; v <- index_mut_back l1; - Return + Ok {| hashMap_num_entries := i1; hashMap_max_load_factor := self.(hashMap_max_load_factor); @@ -170,7 +170,7 @@ Definition hashMap_insert_no_resize |}) else ( v <- index_mut_back l1; - Return + Ok {| hashMap_num_entries := self.(hashMap_num_entries); hashMap_max_load_factor := self.(hashMap_max_load_factor); @@ -192,7 +192,7 @@ Fixpoint hashMap_move_elements_from_list_loop | List_Cons k v tl => ntable1 <- hashMap_insert_no_resize T n1 ntable k v; hashMap_move_elements_from_list_loop T n1 ntable1 tl - | List_Nil => Return ntable + | List_Nil => Ok ntable end end . @@ -228,7 +228,7 @@ Fixpoint hashMap_move_elements_loop i2 <- usize_add i 1%usize; slots1 <- index_mut_back l1; hashMap_move_elements_loop T n1 ntable1 slots1 i2) - else Return (ntable, slots) + else Ok (ntable, slots) end . @@ -257,7 +257,7 @@ Definition hashMap_try_resize ntable <- hashMap_new_with_capacity T n i3 i i1; p <- hashMap_move_elements T n ntable self.(hashMap_slots) 0%usize; let (ntable1, _) := p in - Return + Ok {| hashMap_num_entries := self.(hashMap_num_entries); hashMap_max_load_factor := (i, i1); @@ -265,7 +265,7 @@ Definition hashMap_try_resize hashMap_slots := ntable1.(hashMap_slots) |}) else - Return + Ok {| hashMap_num_entries := self.(hashMap_num_entries); hashMap_max_load_factor := (i, i1); @@ -284,7 +284,7 @@ Definition hashMap_insert i <- hashMap_len T self1; if i s> self1.(hashMap_max_load) then hashMap_try_resize T n self1 - else Return self1 + else Ok self1 . (** [hashmap::{hashmap::HashMap}::contains_key_in_list]: loop 0: @@ -297,9 +297,9 @@ Fixpoint hashMap_contains_key_in_list_loop match ls with | List_Cons ckey _ tl => if ckey s= key - then Return true + then Ok true else hashMap_contains_key_in_list_loop T n1 key tl - | List_Nil => Return false + | List_Nil => Ok false end end . @@ -334,9 +334,7 @@ Fixpoint hashMap_get_in_list_loop | S n1 => match ls with | List_Cons ckey cvalue tl => - if ckey s= key - then Return cvalue - else hashMap_get_in_list_loop T n1 key tl + if ckey s= key then Ok cvalue else hashMap_get_in_list_loop T n1 key tl | List_Nil => Fail_ Failure end end @@ -376,15 +374,14 @@ Fixpoint hashMap_get_mut_in_list_loop | List_Cons ckey cvalue tl => if ckey s= key then - let back := fun (ret : T) => Return (List_Cons ckey ret tl) in - Return (cvalue, back) + let back := fun (ret : T) => Ok (List_Cons ckey ret tl) in + Ok (cvalue, back) else ( p <- hashMap_get_mut_in_list_loop T n1 tl key; let (t, back) := p in let back1 := - fun (ret : T) => tl1 <- back ret; Return (List_Cons ckey cvalue tl1) - in - Return (t, back1)) + fun (ret : T) => tl1 <- back ret; Ok (List_Cons ckey cvalue tl1) in + Ok (t, back1)) | List_Nil => Fail_ Failure end end @@ -419,14 +416,14 @@ Definition hashMap_get_mut fun (ret : T) => l1 <- get_mut_in_list_back ret; v <- index_mut_back l1; - Return + Ok {| hashMap_num_entries := self.(hashMap_num_entries); hashMap_max_load_factor := self.(hashMap_max_load_factor); hashMap_max_load := self.(hashMap_max_load); hashMap_slots := v |} in - Return (t, back) + Ok (t, back) . (** [hashmap::{hashmap::HashMap}::remove_from_list]: loop 0: @@ -445,14 +442,14 @@ Fixpoint hashMap_remove_from_list_loop let (mv_ls, _) := core_mem_replace (List_t T) (List_Cons ckey t tl) List_Nil in match mv_ls with - | List_Cons _ cvalue tl1 => Return (Some cvalue, tl1) + | List_Cons _ cvalue tl1 => Ok (Some cvalue, tl1) | List_Nil => Fail_ Failure end else ( p <- hashMap_remove_from_list_loop T n1 key tl; let (o, tl1) := p in - Return (o, List_Cons ckey t tl1)) - | List_Nil => Return (None, List_Nil) + Ok (o, List_Cons ckey t tl1)) + | List_Nil => Ok (None, List_Nil) end end . @@ -485,7 +482,7 @@ Definition hashMap_remove match x with | None => v <- index_mut_back l1; - Return (None, + Ok (None, {| hashMap_num_entries := self.(hashMap_num_entries); hashMap_max_load_factor := self.(hashMap_max_load_factor); @@ -495,7 +492,7 @@ Definition hashMap_remove | Some x1 => i1 <- usize_sub self.(hashMap_num_entries) 1%usize; v <- index_mut_back l1; - Return (Some x1, + Ok (Some x1, {| hashMap_num_entries := i1; hashMap_max_load_factor := self.(hashMap_max_load_factor); @@ -541,7 +538,7 @@ Definition test1 (n : nat) : result unit := then Fail_ Failure else ( i4 <- hashMap_get u64 n hm6 1056%usize; - if negb (i4 s= 256%u64) then Fail_ Failure else Return tt))) + if negb (i4 s= 256%u64) then Fail_ Failure else Ok tt))) end)) . diff --git a/tests/coq/hashmap/Primitives.v b/tests/coq/hashmap/Primitives.v index 990e27e4..e84d65ce 100644 --- a/tests/coq/hashmap/Primitives.v +++ b/tests/coq/hashmap/Primitives.v @@ -19,19 +19,19 @@ Inductive error := | OutOfFuel. Inductive result A := - | Return : A -> result A + | Ok : A -> result A | Fail_ : error -> result A. -Arguments Return {_} a. +Arguments Ok {_} a. Arguments Fail_ {_}. Definition bind {A B} (m: result A) (f: A -> result B) : result B := match m with | Fail_ e => Fail_ e - | Return x => f x + | Ok x => f x end. -Definition return_ {A: Type} (x: A) : result A := Return x. +Definition return_ {A: Type} (x: A) : result A := Ok x. Definition fail_ {A: Type} (e: error) : result A := Fail_ e. Notation "x <- c1 ; c2" := (bind c1 (fun x => c2)) @@ -39,27 +39,27 @@ Notation "x <- c1 ; c2" := (bind c1 (fun x => c2)) (** Monadic assert *) Definition massert (b: bool) : result unit := - if b then Return tt else Fail_ Failure. + if b then Ok tt else Fail_ Failure. (** Normalize and unwrap a successful result (used for globals) *) -Definition eval_result_refl {A} {x} (a: result A) (p: a = Return x) : A := - match a as r return (r = Return x -> A) with - | Return a' => fun _ => a' +Definition eval_result_refl {A} {x} (a: result A) (p: a = Ok x) : A := + match a as r return (r = Ok x -> A) with + | Ok a' => fun _ => a' | Fail_ e => fun p' => False_rect _ (eq_ind (Fail_ e) (fun e : result A => match e with - | Return _ => False + | Ok _ => False | Fail_ e => True end) - I (Return x) p') + I (Ok x) p') end p. Notation "x %global" := (eval_result_refl x eq_refl) (at level 40). Notation "x %return" := (eval_result_refl x eq_refl) (at level 40). (* Sanity check *) -Check (if true then Return (1 + 2) else Fail_ Failure)%global = 3. +Check (if true then Ok (1 + 2) else Fail_ Failure)%global = 3. (*** Misc *) @@ -236,7 +236,7 @@ Import Sumbool. Definition mk_scalar (ty: scalar_ty) (x: Z) : result (scalar ty) := match sumbool_of_bool (scalar_in_bounds ty x) with - | left H => Return (exist _ x (scalar_in_bounds_valid _ _ H)) + | left H => Ok (exist _ x (scalar_in_bounds_valid _ _ H)) | right _ => Fail_ Failure end. @@ -544,9 +544,9 @@ Arguments core_ops_range_Range_end_ {_}. (*** [alloc] *) -Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Ok x. Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result (T * (T -> result T)) := - Return (x, fun x => Return x). + Ok (x, fun x => Ok x). (* Trait instance *) Definition alloc_boxed_Box_coreopsDerefInst (Self : Type) : core_ops_deref_Deref Self := {| @@ -589,7 +589,7 @@ Definition array_index_mut_usize (T : Type) (n : usize) (a : array T n) (i : usi result (T * (T -> result (array T n))) := match array_index_usize T n a i with | Fail_ e => Fail_ e - | Return x => Return (x, array_update_usize T n a i) + | Ok x => Ok (x, array_update_usize T n a i) end. (*** Slice *) @@ -603,7 +603,7 @@ Definition slice_index_mut_usize (T : Type) (s : slice T) (i : usize) : result (T * (T -> result (slice T))) := match slice_index_usize T s i with | Fail_ e => Fail_ e - | Return x => Return (x, slice_update_usize T s i) + | Ok x => Ok (x, slice_update_usize T s i) end. (*** Subslices *) @@ -615,7 +615,7 @@ Definition array_to_slice_mut (T : Type) (n : usize) (a : array T n) : result (slice T * (slice T -> result (array T n))) := match array_to_slice T n a with | Fail_ e => Fail_ e - | Return x => Return (x, array_from_slice T n a) + | Ok x => Ok (x, array_from_slice T n a) end. Axiom array_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize), result (slice T). @@ -657,17 +657,17 @@ end end. Definition alloc_vec_Vec_bind {A B} (v: alloc_vec_Vec A) (f: list A -> result (list B)) : result (alloc_vec_Vec B) := l <- f (alloc_vec_Vec_to_list v) ; match sumbool_of_bool (scalar_le_max Usize (Z.of_nat (length l))) with - | left H => Return (exist _ l (scalar_le_max_valid _ _ H)) + | left H => Ok (exist _ l (scalar_le_max_valid _ _ H)) | right _ => Fail_ Failure end. Definition alloc_vec_Vec_push (T: Type) (v: alloc_vec_Vec T) (x: T) : result (alloc_vec_Vec T) := - alloc_vec_Vec_bind v (fun l => Return (l ++ [x])). + alloc_vec_Vec_bind v (fun l => Ok (l ++ [x])). Definition alloc_vec_Vec_insert (T: Type) (v: alloc_vec_Vec T) (i: usize) (x: T) : result (alloc_vec_Vec T) := alloc_vec_Vec_bind v (fun l => if to_Z i result (alloc_vec_Vec T))) := match alloc_vec_Vec_index_usize v i with - | Return x => - Return (x, alloc_vec_Vec_update_usize v i) + | Ok x => + Ok (x, alloc_vec_Vec_update_usize v i) | Fail_ e => Fail_ e end. @@ -717,7 +717,7 @@ Definition core_slice_index_Slice_index x <- inst.(core_slice_index_SliceIndex_get) i s; match x with | None => Fail_ Failure - | Some x => Return x + | Some x => Ok x end. (* [core::slice::index::Range:::get]: forward function *) diff --git a/tests/coq/hashmap_on_disk/HashmapMain_Funs.v b/tests/coq/hashmap_on_disk/HashmapMain_Funs.v index 8e299800..79da6e80 100644 --- a/tests/coq/hashmap_on_disk/HashmapMain_Funs.v +++ b/tests/coq/hashmap_on_disk/HashmapMain_Funs.v @@ -15,7 +15,7 @@ Module HashmapMain_Funs. (** [hashmap_main::hashmap::hash_key]: Source: 'src/hashmap.rs', lines 27:0-27:32 *) Definition hashmap_hash_key (k : usize) : result usize := - Return k. + Ok k. (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::allocate_slots]: loop 0: Source: 'src/hashmap.rs', lines 50:4-56:5 *) @@ -32,7 +32,7 @@ Fixpoint hashmap_HashMap_allocate_slots_loop slots1 <- alloc_vec_Vec_push (hashmap_List_t T) slots Hashmap_List_Nil; n3 <- usize_sub n1 1%usize; hashmap_HashMap_allocate_slots_loop T n2 slots1 n3) - else Return slots + else Ok slots end . @@ -58,7 +58,7 @@ Definition hashmap_HashMap_new_with_capacity capacity; i <- usize_mul capacity max_load_dividend; i1 <- usize_div i max_load_divisor; - Return + Ok {| hashmap_HashMap_num_entries := 0%usize; hashmap_HashMap_max_load_factor := (max_load_dividend, max_load_divisor); @@ -94,7 +94,7 @@ Fixpoint hashmap_HashMap_clear_loop i2 <- usize_add i 1%usize; slots1 <- index_mut_back Hashmap_List_Nil; hashmap_HashMap_clear_loop T n1 slots1 i2) - else Return slots + else Ok slots end . @@ -105,7 +105,7 @@ Definition hashmap_HashMap_clear result (hashmap_HashMap_t T) := hm <- hashmap_HashMap_clear_loop T n self.(hashmap_HashMap_slots) 0%usize; - Return + Ok {| hashmap_HashMap_num_entries := 0%usize; hashmap_HashMap_max_load_factor := self.(hashmap_HashMap_max_load_factor); @@ -118,7 +118,7 @@ Definition hashmap_HashMap_clear Source: 'src/hashmap.rs', lines 90:4-90:30 *) Definition hashmap_HashMap_len (T : Type) (self : hashmap_HashMap_t T) : result usize := - Return self.(hashmap_HashMap_num_entries) + Ok self.(hashmap_HashMap_num_entries) . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: loop 0: @@ -133,13 +133,13 @@ Fixpoint hashmap_HashMap_insert_in_list_loop match ls with | Hashmap_List_Cons ckey cvalue tl => if ckey s= key - then Return (false, Hashmap_List_Cons ckey value tl) + then Ok (false, Hashmap_List_Cons ckey value tl) else ( p <- hashmap_HashMap_insert_in_list_loop T n1 key value tl; let (b, tl1) := p in - Return (b, Hashmap_List_Cons ckey cvalue tl1)) + Ok (b, Hashmap_List_Cons ckey cvalue tl1)) | Hashmap_List_Nil => - Return (true, Hashmap_List_Cons key value Hashmap_List_Nil) + Ok (true, Hashmap_List_Cons key value Hashmap_List_Nil) end end . @@ -173,7 +173,7 @@ Definition hashmap_HashMap_insert_no_resize then ( i1 <- usize_add self.(hashmap_HashMap_num_entries) 1%usize; v <- index_mut_back l1; - Return + Ok {| hashmap_HashMap_num_entries := i1; hashmap_HashMap_max_load_factor := @@ -183,7 +183,7 @@ Definition hashmap_HashMap_insert_no_resize |}) else ( v <- index_mut_back l1; - Return + Ok {| hashmap_HashMap_num_entries := self.(hashmap_HashMap_num_entries); hashmap_HashMap_max_load_factor := @@ -206,7 +206,7 @@ Fixpoint hashmap_HashMap_move_elements_from_list_loop | Hashmap_List_Cons k v tl => ntable1 <- hashmap_HashMap_insert_no_resize T n1 ntable k v; hashmap_HashMap_move_elements_from_list_loop T n1 ntable1 tl - | Hashmap_List_Nil => Return ntable + | Hashmap_List_Nil => Ok ntable end end . @@ -243,7 +243,7 @@ Fixpoint hashmap_HashMap_move_elements_loop i2 <- usize_add i 1%usize; slots1 <- index_mut_back l1; hashmap_HashMap_move_elements_loop T n1 ntable1 slots1 i2) - else Return (ntable, slots) + else Ok (ntable, slots) end . @@ -277,7 +277,7 @@ Definition hashmap_HashMap_try_resize hashmap_HashMap_move_elements T n ntable self.(hashmap_HashMap_slots) 0%usize; let (ntable1, _) := p in - Return + Ok {| hashmap_HashMap_num_entries := self.(hashmap_HashMap_num_entries); hashmap_HashMap_max_load_factor := (i, i1); @@ -285,7 +285,7 @@ Definition hashmap_HashMap_try_resize hashmap_HashMap_slots := ntable1.(hashmap_HashMap_slots) |}) else - Return + Ok {| hashmap_HashMap_num_entries := self.(hashmap_HashMap_num_entries); hashmap_HashMap_max_load_factor := (i, i1); @@ -304,7 +304,7 @@ Definition hashmap_HashMap_insert i <- hashmap_HashMap_len T self1; if i s> self1.(hashmap_HashMap_max_load) then hashmap_HashMap_try_resize T n self1 - else Return self1 + else Ok self1 . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key_in_list]: loop 0: @@ -317,9 +317,9 @@ Fixpoint hashmap_HashMap_contains_key_in_list_loop match ls with | Hashmap_List_Cons ckey _ tl => if ckey s= key - then Return true + then Ok true else hashmap_HashMap_contains_key_in_list_loop T n1 key tl - | Hashmap_List_Nil => Return false + | Hashmap_List_Nil => Ok false end end . @@ -357,7 +357,7 @@ Fixpoint hashmap_HashMap_get_in_list_loop match ls with | Hashmap_List_Cons ckey cvalue tl => if ckey s= key - then Return cvalue + then Ok cvalue else hashmap_HashMap_get_in_list_loop T n1 key tl | Hashmap_List_Nil => Fail_ Failure end @@ -398,15 +398,15 @@ Fixpoint hashmap_HashMap_get_mut_in_list_loop | Hashmap_List_Cons ckey cvalue tl => if ckey s= key then - let back := fun (ret : T) => Return (Hashmap_List_Cons ckey ret tl) in - Return (cvalue, back) + let back := fun (ret : T) => Ok (Hashmap_List_Cons ckey ret tl) in + Ok (cvalue, back) else ( p <- hashmap_HashMap_get_mut_in_list_loop T n1 tl key; let (t, back) := p in let back1 := fun (ret : T) => - tl1 <- back ret; Return (Hashmap_List_Cons ckey cvalue tl1) in - Return (t, back1)) + tl1 <- back ret; Ok (Hashmap_List_Cons ckey cvalue tl1) in + Ok (t, back1)) | Hashmap_List_Nil => Fail_ Failure end end @@ -441,7 +441,7 @@ Definition hashmap_HashMap_get_mut fun (ret : T) => l1 <- get_mut_in_list_back ret; v <- index_mut_back l1; - Return + Ok {| hashmap_HashMap_num_entries := self.(hashmap_HashMap_num_entries); hashmap_HashMap_max_load_factor := @@ -449,7 +449,7 @@ Definition hashmap_HashMap_get_mut hashmap_HashMap_max_load := self.(hashmap_HashMap_max_load); hashmap_HashMap_slots := v |} in - Return (t, back) + Ok (t, back) . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: loop 0: @@ -469,14 +469,14 @@ Fixpoint hashmap_HashMap_remove_from_list_loop core_mem_replace (hashmap_List_t T) (Hashmap_List_Cons ckey t tl) Hashmap_List_Nil in match mv_ls with - | Hashmap_List_Cons _ cvalue tl1 => Return (Some cvalue, tl1) + | Hashmap_List_Cons _ cvalue tl1 => Ok (Some cvalue, tl1) | Hashmap_List_Nil => Fail_ Failure end else ( p <- hashmap_HashMap_remove_from_list_loop T n1 key tl; let (o, tl1) := p in - Return (o, Hashmap_List_Cons ckey t tl1)) - | Hashmap_List_Nil => Return (None, Hashmap_List_Nil) + Ok (o, Hashmap_List_Cons ckey t tl1)) + | Hashmap_List_Nil => Ok (None, Hashmap_List_Nil) end end . @@ -509,7 +509,7 @@ Definition hashmap_HashMap_remove match x with | None => v <- index_mut_back l1; - Return (None, + Ok (None, {| hashmap_HashMap_num_entries := self.(hashmap_HashMap_num_entries); hashmap_HashMap_max_load_factor := @@ -520,7 +520,7 @@ Definition hashmap_HashMap_remove | Some x1 => i1 <- usize_sub self.(hashmap_HashMap_num_entries) 1%usize; v <- index_mut_back l1; - Return (Some x1, + Ok (Some x1, {| hashmap_HashMap_num_entries := i1; hashmap_HashMap_max_load_factor := @@ -567,7 +567,7 @@ Definition hashmap_test1 (n : nat) : result unit := then Fail_ Failure else ( i4 <- hashmap_HashMap_get u64 n hm6 1056%usize; - if negb (i4 s= 256%u64) then Fail_ Failure else Return tt))) + if negb (i4 s= 256%u64) then Fail_ Failure else Ok tt))) end)) . @@ -584,6 +584,6 @@ Definition insert_on_disk (** [hashmap_main::main]: Source: 'src/hashmap_main.rs', lines 16:0-16:13 *) Definition main : result unit := - Return tt. + Ok tt. End HashmapMain_Funs. diff --git a/tests/coq/hashmap_on_disk/Primitives.v b/tests/coq/hashmap_on_disk/Primitives.v index 990e27e4..e84d65ce 100644 --- a/tests/coq/hashmap_on_disk/Primitives.v +++ b/tests/coq/hashmap_on_disk/Primitives.v @@ -19,19 +19,19 @@ Inductive error := | OutOfFuel. Inductive result A := - | Return : A -> result A + | Ok : A -> result A | Fail_ : error -> result A. -Arguments Return {_} a. +Arguments Ok {_} a. Arguments Fail_ {_}. Definition bind {A B} (m: result A) (f: A -> result B) : result B := match m with | Fail_ e => Fail_ e - | Return x => f x + | Ok x => f x end. -Definition return_ {A: Type} (x: A) : result A := Return x. +Definition return_ {A: Type} (x: A) : result A := Ok x. Definition fail_ {A: Type} (e: error) : result A := Fail_ e. Notation "x <- c1 ; c2" := (bind c1 (fun x => c2)) @@ -39,27 +39,27 @@ Notation "x <- c1 ; c2" := (bind c1 (fun x => c2)) (** Monadic assert *) Definition massert (b: bool) : result unit := - if b then Return tt else Fail_ Failure. + if b then Ok tt else Fail_ Failure. (** Normalize and unwrap a successful result (used for globals) *) -Definition eval_result_refl {A} {x} (a: result A) (p: a = Return x) : A := - match a as r return (r = Return x -> A) with - | Return a' => fun _ => a' +Definition eval_result_refl {A} {x} (a: result A) (p: a = Ok x) : A := + match a as r return (r = Ok x -> A) with + | Ok a' => fun _ => a' | Fail_ e => fun p' => False_rect _ (eq_ind (Fail_ e) (fun e : result A => match e with - | Return _ => False + | Ok _ => False | Fail_ e => True end) - I (Return x) p') + I (Ok x) p') end p. Notation "x %global" := (eval_result_refl x eq_refl) (at level 40). Notation "x %return" := (eval_result_refl x eq_refl) (at level 40). (* Sanity check *) -Check (if true then Return (1 + 2) else Fail_ Failure)%global = 3. +Check (if true then Ok (1 + 2) else Fail_ Failure)%global = 3. (*** Misc *) @@ -236,7 +236,7 @@ Import Sumbool. Definition mk_scalar (ty: scalar_ty) (x: Z) : result (scalar ty) := match sumbool_of_bool (scalar_in_bounds ty x) with - | left H => Return (exist _ x (scalar_in_bounds_valid _ _ H)) + | left H => Ok (exist _ x (scalar_in_bounds_valid _ _ H)) | right _ => Fail_ Failure end. @@ -544,9 +544,9 @@ Arguments core_ops_range_Range_end_ {_}. (*** [alloc] *) -Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Ok x. Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result (T * (T -> result T)) := - Return (x, fun x => Return x). + Ok (x, fun x => Ok x). (* Trait instance *) Definition alloc_boxed_Box_coreopsDerefInst (Self : Type) : core_ops_deref_Deref Self := {| @@ -589,7 +589,7 @@ Definition array_index_mut_usize (T : Type) (n : usize) (a : array T n) (i : usi result (T * (T -> result (array T n))) := match array_index_usize T n a i with | Fail_ e => Fail_ e - | Return x => Return (x, array_update_usize T n a i) + | Ok x => Ok (x, array_update_usize T n a i) end. (*** Slice *) @@ -603,7 +603,7 @@ Definition slice_index_mut_usize (T : Type) (s : slice T) (i : usize) : result (T * (T -> result (slice T))) := match slice_index_usize T s i with | Fail_ e => Fail_ e - | Return x => Return (x, slice_update_usize T s i) + | Ok x => Ok (x, slice_update_usize T s i) end. (*** Subslices *) @@ -615,7 +615,7 @@ Definition array_to_slice_mut (T : Type) (n : usize) (a : array T n) : result (slice T * (slice T -> result (array T n))) := match array_to_slice T n a with | Fail_ e => Fail_ e - | Return x => Return (x, array_from_slice T n a) + | Ok x => Ok (x, array_from_slice T n a) end. Axiom array_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize), result (slice T). @@ -657,17 +657,17 @@ end end. Definition alloc_vec_Vec_bind {A B} (v: alloc_vec_Vec A) (f: list A -> result (list B)) : result (alloc_vec_Vec B) := l <- f (alloc_vec_Vec_to_list v) ; match sumbool_of_bool (scalar_le_max Usize (Z.of_nat (length l))) with - | left H => Return (exist _ l (scalar_le_max_valid _ _ H)) + | left H => Ok (exist _ l (scalar_le_max_valid _ _ H)) | right _ => Fail_ Failure end. Definition alloc_vec_Vec_push (T: Type) (v: alloc_vec_Vec T) (x: T) : result (alloc_vec_Vec T) := - alloc_vec_Vec_bind v (fun l => Return (l ++ [x])). + alloc_vec_Vec_bind v (fun l => Ok (l ++ [x])). Definition alloc_vec_Vec_insert (T: Type) (v: alloc_vec_Vec T) (i: usize) (x: T) : result (alloc_vec_Vec T) := alloc_vec_Vec_bind v (fun l => if to_Z i result (alloc_vec_Vec T))) := match alloc_vec_Vec_index_usize v i with - | Return x => - Return (x, alloc_vec_Vec_update_usize v i) + | Ok x => + Ok (x, alloc_vec_Vec_update_usize v i) | Fail_ e => Fail_ e end. @@ -717,7 +717,7 @@ Definition core_slice_index_Slice_index x <- inst.(core_slice_index_SliceIndex_get) i s; match x with | None => Fail_ Failure - | Some x => Return x + | Some x => Ok x end. (* [core::slice::index::Range:::get]: forward function *) diff --git a/tests/coq/misc/Bitwise.v b/tests/coq/misc/Bitwise.v index b04c95f2..b2339c58 100644 --- a/tests/coq/misc/Bitwise.v +++ b/tests/coq/misc/Bitwise.v @@ -23,16 +23,16 @@ Definition shift_i32 (a : i32) : result i32 := (** [bitwise::xor_u32]: Source: 'src/bitwise.rs', lines 17:0-17:37 *) Definition xor_u32 (a : u32) (b : u32) : result u32 := - Return (u32_xor a b). + Ok (u32_xor a b). (** [bitwise::or_u32]: Source: 'src/bitwise.rs', lines 21:0-21:36 *) Definition or_u32 (a : u32) (b : u32) : result u32 := - Return (u32_or a b). + Ok (u32_or a b). (** [bitwise::and_u32]: Source: 'src/bitwise.rs', lines 25:0-25:37 *) Definition and_u32 (a : u32) (b : u32) : result u32 := - Return (u32_and a b). + Ok (u32_and a b). End Bitwise. diff --git a/tests/coq/misc/Constants.v b/tests/coq/misc/Constants.v index fcafed53..71185975 100644 --- a/tests/coq/misc/Constants.v +++ b/tests/coq/misc/Constants.v @@ -10,17 +10,17 @@ Module Constants. (** [constants::X0] Source: 'src/constants.rs', lines 5:0-5:17 *) -Definition x0_body : result u32 := Return 0%u32. +Definition x0_body : result u32 := Ok 0%u32. Definition x0 : u32 := x0_body%global. (** [constants::X1] Source: 'src/constants.rs', lines 7:0-7:17 *) -Definition x1_body : result u32 := Return core_u32_max. +Definition x1_body : result u32 := Ok core_u32_max. Definition x1 : u32 := x1_body%global. (** [constants::X2] Source: 'src/constants.rs', lines 10:0-10:17 *) -Definition x2_body : result u32 := Return 3%u32. +Definition x2_body : result u32 := Ok 3%u32. Definition x2 : u32 := x2_body%global. (** [constants::incr]: @@ -36,8 +36,7 @@ Definition x3 : u32 := x3_body%global. (** [constants::mk_pair0]: Source: 'src/constants.rs', lines 23:0-23:51 *) Definition mk_pair0 (x : u32) (y1 : u32) : result (u32 * u32) := - Return (x, y1) -. + Ok (x, y1). (** [constants::Pair] Source: 'src/constants.rs', lines 36:0-36:23 *) @@ -50,7 +49,7 @@ Arguments pair_y { _ _ }. (** [constants::mk_pair1]: Source: 'src/constants.rs', lines 27:0-27:55 *) Definition mk_pair1 (x : u32) (y1 : u32) : result (Pair_t u32 u32) := - Return {| pair_x := x; pair_y := y1 |} + Ok {| pair_x := x; pair_y := y1 |} . (** [constants::P0] @@ -65,13 +64,13 @@ Definition p1 : Pair_t u32 u32 := p1_body%global. (** [constants::P2] Source: 'src/constants.rs', lines 33:0-33:24 *) -Definition p2_body : result (u32 * u32) := Return (0%u32, 1%u32). +Definition p2_body : result (u32 * u32) := Ok (0%u32, 1%u32). Definition p2 : (u32 * u32) := p2_body%global. (** [constants::P3] Source: 'src/constants.rs', lines 34:0-34:28 *) Definition p3_body : result (Pair_t u32 u32) := - Return {| pair_x := 0%u32; pair_y := 1%u32 |} + Ok {| pair_x := 0%u32; pair_y := 1%u32 |} . Definition p3 : Pair_t u32 u32 := p3_body%global. @@ -85,7 +84,7 @@ Arguments wrap_value { _ }. (** [constants::{constants::Wrap}::new]: Source: 'src/constants.rs', lines 54:4-54:41 *) Definition wrap_new (T : Type) (value : T) : result (Wrap_t T) := - Return {| wrap_value := value |} + Ok {| wrap_value := value |} . (** [constants::Y] @@ -96,7 +95,7 @@ Definition y : Wrap_t i32 := y_body%global. (** [constants::unwrap_y]: Source: 'src/constants.rs', lines 43:0-43:30 *) Definition unwrap_y : result i32 := - Return y.(wrap_value). + Ok y.(wrap_value). (** [constants::YVAL] Source: 'src/constants.rs', lines 47:0-47:19 *) @@ -105,13 +104,13 @@ Definition yval : i32 := yval_body%global. (** [constants::get_z1::Z1] Source: 'src/constants.rs', lines 62:4-62:17 *) -Definition get_z1_z1_body : result i32 := Return 3%i32. +Definition get_z1_z1_body : result i32 := Ok 3%i32. Definition get_z1_z1 : i32 := get_z1_z1_body%global. (** [constants::get_z1]: Source: 'src/constants.rs', lines 61:0-61:28 *) Definition get_z1 : result i32 := - Return get_z1_z1. + Ok get_z1_z1. (** [constants::add]: Source: 'src/constants.rs', lines 66:0-66:39 *) @@ -120,12 +119,12 @@ Definition add (a : i32) (b : i32) : result i32 := (** [constants::Q1] Source: 'src/constants.rs', lines 74:0-74:17 *) -Definition q1_body : result i32 := Return 5%i32. +Definition q1_body : result i32 := Ok 5%i32. Definition q1 : i32 := q1_body%global. (** [constants::Q2] Source: 'src/constants.rs', lines 75:0-75:17 *) -Definition q2_body : result i32 := Return q1. +Definition q2_body : result i32 := Ok q1. Definition q2 : i32 := q2_body%global. (** [constants::Q3] @@ -140,7 +139,7 @@ Definition get_z2 : result i32 := (** [constants::S1] Source: 'src/constants.rs', lines 80:0-80:18 *) -Definition s1_body : result u32 := Return 6%u32. +Definition s1_body : result u32 := Ok 6%u32. Definition s1 : u32 := s1_body%global. (** [constants::S2] @@ -150,7 +149,7 @@ Definition s2 : u32 := s2_body%global. (** [constants::S3] Source: 'src/constants.rs', lines 82:0-82:29 *) -Definition s3_body : result (Pair_t u32 u32) := Return p3. +Definition s3_body : result (Pair_t u32 u32) := Ok p3. Definition s3 : Pair_t u32 u32 := s3_body%global. (** [constants::S4] @@ -167,12 +166,12 @@ Arguments v_x { _ _ }. (** [constants::{constants::V#1}::LEN] Source: 'src/constants.rs', lines 91:4-91:24 *) -Definition v_len_body (T : Type) (N : usize) : result usize := Return N. +Definition v_len_body (T : Type) (N : usize) : result usize := Ok N. Definition v_len (T : Type) (N : usize) : usize := (v_len_body T N)%global. (** [constants::use_v]: Source: 'src/constants.rs', lines 94:0-94:42 *) Definition use_v (T : Type) (N : usize) : result usize := - Return (v_len T N). + Ok (v_len T N). End Constants. diff --git a/tests/coq/misc/External_Funs.v b/tests/coq/misc/External_Funs.v index a6832854..41d4a7bd 100644 --- a/tests/coq/misc/External_Funs.v +++ b/tests/coq/misc/External_Funs.v @@ -31,7 +31,7 @@ Definition test_new_non_zero_u32 (** [external::test_vec]: Source: 'src/external.rs', lines 17:0-17:17 *) Definition test_vec : result unit := - _ <- alloc_vec_Vec_push u32 (alloc_vec_Vec_new u32) 0%u32; Return tt + _ <- alloc_vec_Vec_push u32 (alloc_vec_Vec_new u32) 0%u32; Ok tt . (** Unit test for [external::test_vec] *) @@ -46,8 +46,8 @@ Definition custom_swap p <- core_mem_swap T x y st; let (st1, p1) := p in let (x1, y1) := p1 in - let back := fun (ret : T) (st2 : state) => Return (st2, (ret, y1)) in - Return (st1, (x1, back)) + let back := fun (ret : T) (st2 : state) => Ok (st2, (ret, y1)) in + Ok (st1, (x1, back)) . (** [external::test_custom_swap]: @@ -60,7 +60,7 @@ Definition test_custom_swap p2 <- custom_swap_back 1%u32 st1; let (_, p3) := p2 in let (x1, y1) := p3 in - Return (st1, (x1, y1)) + Ok (st1, (x1, y1)) . (** [external::test_swap_non_zero]: @@ -69,7 +69,7 @@ Definition test_swap_non_zero (x : u32) (st : state) : result (state * u32) := p <- swap u32 x 0%u32 st; let (st1, p1) := p in let (x1, _) := p1 in - if x1 s= 0%u32 then Fail_ Failure else Return (st1, x1) + if x1 s= 0%u32 then Fail_ Failure else Ok (st1, x1) . End External_Funs. diff --git a/tests/coq/misc/Loops.v b/tests/coq/misc/Loops.v index ae529cf8..f396f16f 100644 --- a/tests/coq/misc/Loops.v +++ b/tests/coq/misc/Loops.v @@ -83,7 +83,7 @@ Fixpoint sum_array_loop s1 <- u32_add s i1; i2 <- usize_add i 1%usize; sum_array_loop N n1 a i2 s1) - else Return s + else Ok s end . @@ -110,7 +110,7 @@ Fixpoint clear_loop i2 <- usize_add i 1%usize; v1 <- index_mut_back 0%u32; clear_loop n1 v1 i2) - else Return v + else Ok v end . @@ -138,8 +138,8 @@ Fixpoint list_mem_loop (n : nat) (x : u32) (ls : List_t u32) : result bool := | O => Fail_ OutOfFuel | S n1 => match ls with - | List_Cons y tl => if y s= x then Return true else list_mem_loop n1 x tl - | List_Nil => Return false + | List_Cons y tl => if y s= x then Ok true else list_mem_loop n1 x tl + | List_Nil => Ok false end end . @@ -162,16 +162,13 @@ Fixpoint list_nth_mut_loop_loop match ls with | List_Cons x tl => if i s= 0%u32 - then - let back := fun (ret : T) => Return (List_Cons ret tl) in - Return (x, back) + then let back := fun (ret : T) => Ok (List_Cons ret tl) in Ok (x, back) else ( i1 <- u32_sub i 1%u32; p <- list_nth_mut_loop_loop T n1 tl i1; let (t, back) := p in - let back1 := fun (ret : T) => tl1 <- back ret; Return (List_Cons x tl1) - in - Return (t, back1)) + let back1 := fun (ret : T) => tl1 <- back ret; Ok (List_Cons x tl1) in + Ok (t, back1)) | List_Nil => Fail_ Failure end end @@ -196,7 +193,7 @@ Fixpoint list_nth_shared_loop_loop match ls with | List_Cons x tl => if i s= 0%u32 - then Return x + then Ok x else (i1 <- u32_sub i 1%u32; list_nth_shared_loop_loop T n1 tl i1) | List_Nil => Fail_ Failure end @@ -223,14 +220,13 @@ Fixpoint get_elem_mut_loop | List_Cons y tl => if y s= x then - let back := fun (ret : usize) => Return (List_Cons ret tl) in - Return (y, back) + let back := fun (ret : usize) => Ok (List_Cons ret tl) in Ok (y, back) else ( p <- get_elem_mut_loop n1 x tl; let (i, back) := p in - let back1 := - fun (ret : usize) => tl1 <- back ret; Return (List_Cons y tl1) in - Return (i, back1)) + let back1 := fun (ret : usize) => tl1 <- back ret; Ok (List_Cons y tl1) + in + Ok (i, back1)) | List_Nil => Fail_ Failure end end @@ -249,7 +245,7 @@ Definition get_elem_mut p1 <- get_elem_mut_loop n x ls; let (i, back) := p1 in let back1 := fun (ret : usize) => l <- back ret; index_mut_back l in - Return (i, back1) + Ok (i, back1) . (** [loops::get_elem_shared]: loop 0: @@ -260,8 +256,7 @@ Fixpoint get_elem_shared_loop | O => Fail_ OutOfFuel | S n1 => match ls with - | List_Cons y tl => - if y s= x then Return y else get_elem_shared_loop n1 x tl + | List_Cons y tl => if y s= x then Ok y else get_elem_shared_loop n1 x tl | List_Nil => Fail_ Failure end end @@ -285,14 +280,13 @@ Definition id_mut (T : Type) (ls : List_t T) : result ((List_t T) * (List_t T -> result (List_t T))) := - Return (ls, Return) + Ok (ls, Ok) . (** [loops::id_shared]: Source: 'src/loops.rs', lines 149:0-149:45 *) Definition id_shared (T : Type) (ls : List_t T) : result (List_t T) := - Return ls -. + Ok ls. (** [loops::list_nth_mut_loop_with_id]: loop 0: Source: 'src/loops.rs', lines 154:0-165:1 *) @@ -306,16 +300,13 @@ Fixpoint list_nth_mut_loop_with_id_loop match ls with | List_Cons x tl => if i s= 0%u32 - then - let back := fun (ret : T) => Return (List_Cons ret tl) in - Return (x, back) + then let back := fun (ret : T) => Ok (List_Cons ret tl) in Ok (x, back) else ( i1 <- u32_sub i 1%u32; p <- list_nth_mut_loop_with_id_loop T n1 i1 tl; let (t, back) := p in - let back1 := fun (ret : T) => tl1 <- back ret; Return (List_Cons x tl1) - in - Return (t, back1)) + let back1 := fun (ret : T) => tl1 <- back ret; Ok (List_Cons x tl1) in + Ok (t, back1)) | List_Nil => Fail_ Failure end end @@ -332,7 +323,7 @@ Definition list_nth_mut_loop_with_id p1 <- list_nth_mut_loop_with_id_loop T n i ls1; let (t, back) := p1 in let back1 := fun (ret : T) => l <- back ret; id_mut_back l in - Return (t, back1) + Ok (t, back1) . (** [loops::list_nth_shared_loop_with_id]: loop 0: @@ -345,7 +336,7 @@ Fixpoint list_nth_shared_loop_with_id_loop match ls with | List_Cons x tl => if i s= 0%u32 - then Return x + then Ok x else ( i1 <- u32_sub i 1%u32; list_nth_shared_loop_with_id_loop T n1 i1 tl) | List_Nil => Fail_ Failure @@ -375,18 +366,18 @@ Fixpoint list_nth_mut_loop_pair_loop | List_Cons x1 tl1 => if i s= 0%u32 then - let back'a := fun (ret : T) => Return (List_Cons ret tl0) in - let back'b := fun (ret : T) => Return (List_Cons ret tl1) in - Return ((x0, x1), back'a, back'b) + let back'a := fun (ret : T) => Ok (List_Cons ret tl0) in + let back'b := fun (ret : T) => Ok (List_Cons ret tl1) in + Ok ((x0, x1), back'a, back'b) else ( i1 <- u32_sub i 1%u32; t <- list_nth_mut_loop_pair_loop T n1 tl0 tl1 i1; let '(p, back'a, back'b) := t in let back'a1 := - fun (ret : T) => tl01 <- back'a ret; Return (List_Cons x0 tl01) in + fun (ret : T) => tl01 <- back'a ret; Ok (List_Cons x0 tl01) in let back'b1 := - fun (ret : T) => tl11 <- back'b ret; Return (List_Cons x1 tl11) in - Return (p, back'a1, back'b1)) + fun (ret : T) => tl11 <- back'b ret; Ok (List_Cons x1 tl11) in + Ok (p, back'a1, back'b1)) | List_Nil => Fail_ Failure end | List_Nil => Fail_ Failure @@ -417,7 +408,7 @@ Fixpoint list_nth_shared_loop_pair_loop match ls1 with | List_Cons x1 tl1 => if i s= 0%u32 - then Return (x0, x1) + then Ok (x0, x1) else ( i1 <- u32_sub i 1%u32; list_nth_shared_loop_pair_loop T n1 tl0 tl1 i1) | List_Nil => Fail_ Failure @@ -453,9 +444,8 @@ Fixpoint list_nth_mut_loop_pair_merge_loop then let back := fun (ret : (T * T)) => - let (t, t1) := ret in Return (List_Cons t tl0, List_Cons t1 tl1) - in - Return ((x0, x1), back) + let (t, t1) := ret in Ok (List_Cons t tl0, List_Cons t1 tl1) in + Ok ((x0, x1), back) else ( i1 <- u32_sub i 1%u32; p <- list_nth_mut_loop_pair_merge_loop T n1 tl0 tl1 i1; @@ -464,8 +454,8 @@ Fixpoint list_nth_mut_loop_pair_merge_loop fun (ret : (T * T)) => p2 <- back ret; let (tl01, tl11) := p2 in - Return (List_Cons x0 tl01, List_Cons x1 tl11) in - Return (p1, back1)) + Ok (List_Cons x0 tl01, List_Cons x1 tl11) in + Ok (p1, back1)) | List_Nil => Fail_ Failure end | List_Nil => Fail_ Failure @@ -496,7 +486,7 @@ Fixpoint list_nth_shared_loop_pair_merge_loop match ls1 with | List_Cons x1 tl1 => if i s= 0%u32 - then Return (x0, x1) + then Ok (x0, x1) else ( i1 <- u32_sub i 1%u32; list_nth_shared_loop_pair_merge_loop T n1 tl0 tl1 i1) @@ -531,15 +521,15 @@ Fixpoint list_nth_mut_shared_loop_pair_loop | List_Cons x1 tl1 => if i s= 0%u32 then - let back := fun (ret : T) => Return (List_Cons ret tl0) in - Return ((x0, x1), back) + let back := fun (ret : T) => Ok (List_Cons ret tl0) in + Ok ((x0, x1), back) else ( i1 <- u32_sub i 1%u32; p <- list_nth_mut_shared_loop_pair_loop T n1 tl0 tl1 i1; let (p1, back) := p in let back1 := - fun (ret : T) => tl01 <- back ret; Return (List_Cons x0 tl01) in - Return (p1, back1)) + fun (ret : T) => tl01 <- back ret; Ok (List_Cons x0 tl01) in + Ok (p1, back1)) | List_Nil => Fail_ Failure end | List_Nil => Fail_ Failure @@ -571,15 +561,15 @@ Fixpoint list_nth_mut_shared_loop_pair_merge_loop | List_Cons x1 tl1 => if i s= 0%u32 then - let back := fun (ret : T) => Return (List_Cons ret tl0) in - Return ((x0, x1), back) + let back := fun (ret : T) => Ok (List_Cons ret tl0) in + Ok ((x0, x1), back) else ( i1 <- u32_sub i 1%u32; p <- list_nth_mut_shared_loop_pair_merge_loop T n1 tl0 tl1 i1; let (p1, back) := p in let back1 := - fun (ret : T) => tl01 <- back ret; Return (List_Cons x0 tl01) in - Return (p1, back1)) + fun (ret : T) => tl01 <- back ret; Ok (List_Cons x0 tl01) in + Ok (p1, back1)) | List_Nil => Fail_ Failure end | List_Nil => Fail_ Failure @@ -611,15 +601,15 @@ Fixpoint list_nth_shared_mut_loop_pair_loop | List_Cons x1 tl1 => if i s= 0%u32 then - let back := fun (ret : T) => Return (List_Cons ret tl1) in - Return ((x0, x1), back) + let back := fun (ret : T) => Ok (List_Cons ret tl1) in + Ok ((x0, x1), back) else ( i1 <- u32_sub i 1%u32; p <- list_nth_shared_mut_loop_pair_loop T n1 tl0 tl1 i1; let (p1, back) := p in let back1 := - fun (ret : T) => tl11 <- back ret; Return (List_Cons x1 tl11) in - Return (p1, back1)) + fun (ret : T) => tl11 <- back ret; Ok (List_Cons x1 tl11) in + Ok (p1, back1)) | List_Nil => Fail_ Failure end | List_Nil => Fail_ Failure @@ -651,15 +641,15 @@ Fixpoint list_nth_shared_mut_loop_pair_merge_loop | List_Cons x1 tl1 => if i s= 0%u32 then - let back := fun (ret : T) => Return (List_Cons ret tl1) in - Return ((x0, x1), back) + let back := fun (ret : T) => Ok (List_Cons ret tl1) in + Ok ((x0, x1), back) else ( i1 <- u32_sub i 1%u32; p <- list_nth_shared_mut_loop_pair_merge_loop T n1 tl0 tl1 i1; let (p1, back) := p in let back1 := - fun (ret : T) => tl11 <- back ret; Return (List_Cons x1 tl11) in - Return (p1, back1)) + fun (ret : T) => tl11 <- back ret; Ok (List_Cons x1 tl11) in + Ok (p1, back1)) | List_Nil => Fail_ Failure end | List_Nil => Fail_ Failure @@ -684,7 +674,7 @@ Fixpoint ignore_input_mut_borrow_loop (n : nat) (i : u32) : result unit := | S n1 => if i s> 0%u32 then (i1 <- u32_sub i 1%u32; ignore_input_mut_borrow_loop n1 i1) - else Return tt + else Ok tt end . @@ -692,7 +682,7 @@ Fixpoint ignore_input_mut_borrow_loop (n : nat) (i : u32) : result unit := Source: 'src/loops.rs', lines 345:0-345:56 *) Definition ignore_input_mut_borrow (n : nat) (_a : u32) (i : u32) : result u32 := - _ <- ignore_input_mut_borrow_loop n i; Return _a + _ <- ignore_input_mut_borrow_loop n i; Ok _a . (** [loops::incr_ignore_input_mut_borrow]: loop 0: @@ -703,7 +693,7 @@ Fixpoint incr_ignore_input_mut_borrow_loop (n : nat) (i : u32) : result unit := | S n1 => if i s> 0%u32 then (i1 <- u32_sub i 1%u32; incr_ignore_input_mut_borrow_loop n1 i1) - else Return tt + else Ok tt end . @@ -711,7 +701,7 @@ Fixpoint incr_ignore_input_mut_borrow_loop (n : nat) (i : u32) : result unit := Source: 'src/loops.rs', lines 353:0-353:60 *) Definition incr_ignore_input_mut_borrow (n : nat) (a : u32) (i : u32) : result u32 := - a1 <- u32_add a 1%u32; _ <- incr_ignore_input_mut_borrow_loop n i; Return a1 + a1 <- u32_add a 1%u32; _ <- incr_ignore_input_mut_borrow_loop n i; Ok a1 . (** [loops::ignore_input_shared_borrow]: loop 0: @@ -722,7 +712,7 @@ Fixpoint ignore_input_shared_borrow_loop (n : nat) (i : u32) : result unit := | S n1 => if i s> 0%u32 then (i1 <- u32_sub i 1%u32; ignore_input_shared_borrow_loop n1 i1) - else Return tt + else Ok tt end . @@ -730,7 +720,7 @@ Fixpoint ignore_input_shared_borrow_loop (n : nat) (i : u32) : result unit := Source: 'src/loops.rs', lines 362:0-362:59 *) Definition ignore_input_shared_borrow (n : nat) (_a : u32) (i : u32) : result u32 := - _ <- ignore_input_shared_borrow_loop n i; Return _a + _ <- ignore_input_shared_borrow_loop n i; Ok _a . End Loops. diff --git a/tests/coq/misc/NoNestedBorrows.v b/tests/coq/misc/NoNestedBorrows.v index d4035104..ecdfb281 100644 --- a/tests/coq/misc/NoNestedBorrows.v +++ b/tests/coq/misc/NoNestedBorrows.v @@ -170,12 +170,12 @@ Definition cast_bool_to_i32 (x : bool) : result i32 := (** [no_nested_borrows::cast_bool_to_bool]: Source: 'src/no_nested_borrows.rs', lines 137:0-137:41 *) Definition cast_bool_to_bool (x : bool) : result bool := - Return x. + Ok x. (** [no_nested_borrows::test2]: Source: 'src/no_nested_borrows.rs', lines 142:0-142:14 *) Definition test2 : result unit := - _ <- u32_add 23%u32 44%u32; Return tt. + _ <- u32_add 23%u32 44%u32; Ok tt. (** Unit test for [no_nested_borrows::test2] *) Check (test2 )%return. @@ -183,7 +183,7 @@ Check (test2 )%return. (** [no_nested_borrows::get_max]: Source: 'src/no_nested_borrows.rs', lines 154:0-154:37 *) Definition get_max (x : u32) (y : u32) : result u32 := - if x s>= y then Return x else Return y + if x s>= y then Ok x else Ok y . (** [no_nested_borrows::test3]: @@ -192,7 +192,7 @@ Definition test3 : result unit := x <- get_max 4%u32 3%u32; y <- get_max 10%u32 11%u32; z <- u32_add x y; - if negb (z s= 15%u32) then Fail_ Failure else Return tt + if negb (z s= 15%u32) then Fail_ Failure else Ok tt . (** Unit test for [no_nested_borrows::test3] *) @@ -201,7 +201,7 @@ Check (test3 )%return. (** [no_nested_borrows::test_neg1]: Source: 'src/no_nested_borrows.rs', lines 169:0-169:18 *) Definition test_neg1 : result unit := - y <- i32_neg 3%i32; if negb (y s= (-3)%i32) then Fail_ Failure else Return tt + y <- i32_neg 3%i32; if negb (y s= (-3)%i32) then Fail_ Failure else Ok tt . (** Unit test for [no_nested_borrows::test_neg1] *) @@ -210,7 +210,7 @@ Check (test_neg1 )%return. (** [no_nested_borrows::refs_test1]: Source: 'src/no_nested_borrows.rs', lines 176:0-176:19 *) Definition refs_test1 : result unit := - if negb (1%i32 s= 1%i32) then Fail_ Failure else Return tt + if negb (1%i32 s= 1%i32) then Fail_ Failure else Ok tt . (** Unit test for [no_nested_borrows::refs_test1] *) @@ -227,7 +227,7 @@ Definition refs_test2 : result unit := else if negb (2%i32 s= 2%i32) then Fail_ Failure - else if negb (2%i32 s= 2%i32) then Fail_ Failure else Return tt + else if negb (2%i32 s= 2%i32) then Fail_ Failure else Ok tt . (** Unit test for [no_nested_borrows::refs_test2] *) @@ -236,7 +236,7 @@ Check (refs_test2 )%return. (** [no_nested_borrows::test_list1]: Source: 'src/no_nested_borrows.rs', lines 203:0-203:19 *) Definition test_list1 : result unit := - Return tt. + Ok tt. (** Unit test for [no_nested_borrows::test_list1] *) Check (test_list1 )%return. @@ -248,7 +248,7 @@ Definition test_box1 : result unit := let (_, deref_mut_back) := p in b <- deref_mut_back 1%i32; x <- alloc_boxed_Box_deref i32 b; - if negb (x s= 1%i32) then Fail_ Failure else Return tt + if negb (x s= 1%i32) then Fail_ Failure else Ok tt . (** Unit test for [no_nested_borrows::test_box1] *) @@ -257,24 +257,24 @@ Check (test_box1 )%return. (** [no_nested_borrows::copy_int]: Source: 'src/no_nested_borrows.rs', lines 218:0-218:30 *) Definition copy_int (x : i32) : result i32 := - Return x. + Ok x. (** [no_nested_borrows::test_unreachable]: Source: 'src/no_nested_borrows.rs', lines 224:0-224:32 *) Definition test_unreachable (b : bool) : result unit := - if b then Fail_ Failure else Return tt + if b then Fail_ Failure else Ok tt . (** [no_nested_borrows::test_panic]: Source: 'src/no_nested_borrows.rs', lines 232:0-232:26 *) Definition test_panic (b : bool) : result unit := - if b then Fail_ Failure else Return tt + if b then Fail_ Failure else Ok tt . (** [no_nested_borrows::test_copy_int]: Source: 'src/no_nested_borrows.rs', lines 239:0-239:22 *) Definition test_copy_int : result unit := - y <- copy_int 0%i32; if negb (0%i32 s= y) then Fail_ Failure else Return tt + y <- copy_int 0%i32; if negb (0%i32 s= y) then Fail_ Failure else Ok tt . (** Unit test for [no_nested_borrows::test_copy_int] *) @@ -283,14 +283,14 @@ Check (test_copy_int )%return. (** [no_nested_borrows::is_cons]: Source: 'src/no_nested_borrows.rs', lines 246:0-246:38 *) Definition is_cons (T : Type) (l : List_t T) : result bool := - match l with | List_Cons _ _ => Return true | List_Nil => Return false end + match l with | List_Cons _ _ => Ok true | List_Nil => Ok false end . (** [no_nested_borrows::test_is_cons]: Source: 'src/no_nested_borrows.rs', lines 253:0-253:21 *) Definition test_is_cons : result unit := b <- is_cons i32 (List_Cons 0%i32 List_Nil); - if negb b then Fail_ Failure else Return tt + if negb b then Fail_ Failure else Ok tt . (** Unit test for [no_nested_borrows::test_is_cons] *) @@ -299,10 +299,7 @@ Check (test_is_cons )%return. (** [no_nested_borrows::split_list]: Source: 'src/no_nested_borrows.rs', lines 259:0-259:48 *) Definition split_list (T : Type) (l : List_t T) : result (T * (List_t T)) := - match l with - | List_Cons hd tl => Return (hd, tl) - | List_Nil => Fail_ Failure - end + match l with | List_Cons hd tl => Ok (hd, tl) | List_Nil => Fail_ Failure end . (** [no_nested_borrows::test_split_list]: @@ -310,7 +307,7 @@ Definition split_list (T : Type) (l : List_t T) : result (T * (List_t T)) := Definition test_split_list : result unit := p <- split_list i32 (List_Cons 0%i32 List_Nil); let (hd, _) := p in - if negb (hd s= 0%i32) then Fail_ Failure else Return tt + if negb (hd s= 0%i32) then Fail_ Failure else Ok tt . (** Unit test for [no_nested_borrows::test_split_list] *) @@ -321,8 +318,8 @@ Check (test_split_list )%return. Definition choose (T : Type) (b : bool) (x : T) (y : T) : result (T * (T -> result (T * T))) := if b - then let back := fun (ret : T) => Return (ret, y) in Return (x, back) - else let back := fun (ret : T) => Return (x, ret) in Return (y, back) + then let back := fun (ret : T) => Ok (ret, y) in Ok (x, back) + else let back := fun (ret : T) => Ok (x, ret) in Ok (y, back) . (** [no_nested_borrows::choose_test]: @@ -338,7 +335,7 @@ Definition choose_test : result unit := let (x, y) := p1 in if negb (x s= 1%i32) then Fail_ Failure - else if negb (y s= 0%i32) then Fail_ Failure else Return tt) + else if negb (y s= 0%i32) then Fail_ Failure else Ok tt) . (** Unit test for [no_nested_borrows::choose_test] *) @@ -347,7 +344,7 @@ Check (choose_test )%return. (** [no_nested_borrows::test_char]: Source: 'src/no_nested_borrows.rs', lines 294:0-294:26 *) Definition test_char : result char := - Return (char_of_byte Coq.Init.Byte.x61). + Ok (char_of_byte Coq.Init.Byte.x61). (** [no_nested_borrows::Tree] Source: 'src/no_nested_borrows.rs', lines 299:0-299:16 *) @@ -373,7 +370,7 @@ Arguments NodeElem_Nil { _ }. Fixpoint list_length (T : Type) (l : List_t T) : result u32 := match l with | List_Cons _ l1 => i <- list_length T l1; u32_add 1%u32 i - | List_Nil => Return 0%u32 + | List_Nil => Ok 0%u32 end . @@ -383,7 +380,7 @@ Fixpoint list_nth_shared (T : Type) (l : List_t T) (i : u32) : result T := match l with | List_Cons x tl => if i s= 0%u32 - then Return x + then Ok x else (i1 <- u32_sub i 1%u32; list_nth_shared T tl i1) | List_Nil => Fail_ Failure end @@ -398,17 +395,14 @@ Fixpoint list_nth_mut match l with | List_Cons x tl => if i s= 0%u32 - then - let back := fun (ret : T) => Return (List_Cons ret tl) in - Return (x, back) + then let back := fun (ret : T) => Ok (List_Cons ret tl) in Ok (x, back) else ( i1 <- u32_sub i 1%u32; p <- list_nth_mut T tl i1; let (t, list_nth_mut_back) := p in let back := - fun (ret : T) => tl1 <- list_nth_mut_back ret; Return (List_Cons x tl1) - in - Return (t, back)) + fun (ret : T) => tl1 <- list_nth_mut_back ret; Ok (List_Cons x tl1) in + Ok (t, back)) | List_Nil => Fail_ Failure end . @@ -419,7 +413,7 @@ Fixpoint list_rev_aux (T : Type) (li : List_t T) (lo : List_t T) : result (List_t T) := match li with | List_Cons hd tl => list_rev_aux T tl (List_Cons hd lo) - | List_Nil => Return lo + | List_Nil => Ok lo end . @@ -463,7 +457,7 @@ Definition test_list_functions : result unit := then Fail_ Failure else ( i6 <- list_nth_shared i32 ls 2%u32; - if negb (i6 s= 2%i32) then Fail_ Failure else Return tt)))))) + if negb (i6 s= 2%i32) then Fail_ Failure else Ok tt)))))) . (** Unit test for [no_nested_borrows::test_list_functions] *) @@ -475,7 +469,7 @@ Definition id_mut_pair1 (T1 T2 : Type) (x : T1) (y : T2) : result ((T1 * T2) * ((T1 * T2) -> result (T1 * T2))) := - Return ((x, y), Return) + Ok ((x, y), Ok) . (** [no_nested_borrows::id_mut_pair2]: @@ -484,7 +478,7 @@ Definition id_mut_pair2 (T1 T2 : Type) (p : (T1 * T2)) : result ((T1 * T2) * ((T1 * T2) -> result (T1 * T2))) := - let (t, t1) := p in Return ((t, t1), Return) + let (t, t1) := p in Ok ((t, t1), Ok) . (** [no_nested_borrows::id_mut_pair3]: @@ -493,7 +487,7 @@ Definition id_mut_pair3 (T1 T2 : Type) (x : T1) (y : T2) : result ((T1 * T2) * (T1 -> result T1) * (T2 -> result T2)) := - Return ((x, y), Return, Return) + Ok ((x, y), Ok, Ok) . (** [no_nested_borrows::id_mut_pair4]: @@ -502,7 +496,7 @@ Definition id_mut_pair4 (T1 T2 : Type) (p : (T1 * T2)) : result ((T1 * T2) * (T1 -> result T1) * (T2 -> result T2)) := - let (t, t1) := p in Return ((t, t1), Return, Return) + let (t, t1) := p in Ok ((t, t1), Ok, Ok) . (** [no_nested_borrows::StructWithTuple] @@ -519,19 +513,19 @@ Arguments structWithTuple_p { _ _ }. (** [no_nested_borrows::new_tuple1]: Source: 'src/no_nested_borrows.rs', lines 437:0-437:48 *) Definition new_tuple1 : result (StructWithTuple_t u32 u32) := - Return {| structWithTuple_p := (1%u32, 2%u32) |} + Ok {| structWithTuple_p := (1%u32, 2%u32) |} . (** [no_nested_borrows::new_tuple2]: Source: 'src/no_nested_borrows.rs', lines 441:0-441:48 *) Definition new_tuple2 : result (StructWithTuple_t i16 i16) := - Return {| structWithTuple_p := (1%i16, 2%i16) |} + Ok {| structWithTuple_p := (1%i16, 2%i16) |} . (** [no_nested_borrows::new_tuple3]: Source: 'src/no_nested_borrows.rs', lines 445:0-445:48 *) Definition new_tuple3 : result (StructWithTuple_t u64 i64) := - Return {| structWithTuple_p := (1%u64, 2%i64) |} + Ok {| structWithTuple_p := (1%u64, 2%i64) |} . (** [no_nested_borrows::StructWithPair] @@ -548,7 +542,7 @@ Arguments structWithPair_p { _ _ }. (** [no_nested_borrows::new_pair1]: Source: 'src/no_nested_borrows.rs', lines 454:0-454:46 *) Definition new_pair1 : result (StructWithPair_t u32 u32) := - Return {| structWithPair_p := {| pair_x := 1%u32; pair_y := 2%u32 |} |} + Ok {| structWithPair_p := {| pair_x := 1%u32; pair_y := 2%u32 |} |} . (** [no_nested_borrows::test_constants]: @@ -572,7 +566,7 @@ Definition test_constants : result unit := swp <- new_pair1; if negb (swp.(structWithPair_p).(pair_x) s= 1%u32) then Fail_ Failure - else Return tt))) + else Ok tt))) . (** Unit test for [no_nested_borrows::test_constants] *) @@ -581,7 +575,7 @@ Check (test_constants )%return. (** [no_nested_borrows::test_weird_borrows1]: Source: 'src/no_nested_borrows.rs', lines 471:0-471:28 *) Definition test_weird_borrows1 : result unit := - Return tt. + Ok tt. (** Unit test for [no_nested_borrows::test_weird_borrows1] *) Check (test_weird_borrows1 )%return. @@ -590,30 +584,30 @@ Check (test_weird_borrows1 )%return. Source: 'src/no_nested_borrows.rs', lines 481:0-481:37 *) Definition test_mem_replace (px : u32) : result u32 := let (y, _) := core_mem_replace u32 px 1%u32 in - if negb (y s= 0%u32) then Fail_ Failure else Return 2%u32 + if negb (y s= 0%u32) then Fail_ Failure else Ok 2%u32 . (** [no_nested_borrows::test_shared_borrow_bool1]: Source: 'src/no_nested_borrows.rs', lines 488:0-488:47 *) Definition test_shared_borrow_bool1 (b : bool) : result u32 := - if b then Return 0%u32 else Return 1%u32 + if b then Ok 0%u32 else Ok 1%u32 . (** [no_nested_borrows::test_shared_borrow_bool2]: Source: 'src/no_nested_borrows.rs', lines 501:0-501:40 *) Definition test_shared_borrow_bool2 : result u32 := - Return 0%u32. + Ok 0%u32. (** [no_nested_borrows::test_shared_borrow_enum1]: Source: 'src/no_nested_borrows.rs', lines 516:0-516:52 *) Definition test_shared_borrow_enum1 (l : List_t u32) : result u32 := - match l with | List_Cons _ _ => Return 1%u32 | List_Nil => Return 0%u32 end + match l with | List_Cons _ _ => Ok 1%u32 | List_Nil => Ok 0%u32 end . (** [no_nested_borrows::test_shared_borrow_enum2]: Source: 'src/no_nested_borrows.rs', lines 528:0-528:40 *) Definition test_shared_borrow_enum2 : result u32 := - Return 0%u32. + Ok 0%u32. (** [no_nested_borrows::incr]: Source: 'src/no_nested_borrows.rs', lines 539:0-539:24 *) @@ -628,7 +622,7 @@ Definition call_incr (x : u32) : result u32 := (** [no_nested_borrows::read_then_incr]: Source: 'src/no_nested_borrows.rs', lines 548:0-548:41 *) Definition read_then_incr (x : u32) : result (u32 * u32) := - x1 <- u32_add x 1%u32; Return (x, x1) + x1 <- u32_add x 1%u32; Ok (x, x1) . (** [no_nested_borrows::Tuple] @@ -638,14 +632,14 @@ Definition Tuple_t (T1 T2 : Type) : Type := T1 * T2. (** [no_nested_borrows::use_tuple_struct]: Source: 'src/no_nested_borrows.rs', lines 556:0-556:48 *) Definition use_tuple_struct (x : Tuple_t u32 u32) : result (Tuple_t u32 u32) := - let (_, i) := x in Return (1%u32, i) + let (_, i) := x in Ok (1%u32, i) . (** [no_nested_borrows::create_tuple_struct]: Source: 'src/no_nested_borrows.rs', lines 560:0-560:61 *) Definition create_tuple_struct (x : u32) (y : u64) : result (Tuple_t u32 u64) := - Return (x, y) + Ok (x, y) . (** [no_nested_borrows::IdType] @@ -655,11 +649,11 @@ Definition IdType_t (T : Type) : Type := T. (** [no_nested_borrows::use_id_type]: Source: 'src/no_nested_borrows.rs', lines 567:0-567:40 *) Definition use_id_type (T : Type) (x : IdType_t T) : result T := - Return x. + Ok x. (** [no_nested_borrows::create_id_type]: Source: 'src/no_nested_borrows.rs', lines 571:0-571:43 *) Definition create_id_type (T : Type) (x : T) : result (IdType_t T) := - Return x. + Ok x. End NoNestedBorrows. diff --git a/tests/coq/misc/Paper.v b/tests/coq/misc/Paper.v index 77276223..5995de15 100644 --- a/tests/coq/misc/Paper.v +++ b/tests/coq/misc/Paper.v @@ -16,7 +16,7 @@ Definition ref_incr (x : i32) : result i32 := (** [paper::test_incr]: Source: 'src/paper.rs', lines 8:0-8:18 *) Definition test_incr : result unit := - x <- ref_incr 0%i32; if negb (x s= 1%i32) then Fail_ Failure else Return tt + x <- ref_incr 0%i32; if negb (x s= 1%i32) then Fail_ Failure else Ok tt . (** Unit test for [paper::test_incr] *) @@ -27,8 +27,8 @@ Check (test_incr )%return. Definition choose (T : Type) (b : bool) (x : T) (y : T) : result (T * (T -> result (T * T))) := if b - then let back := fun (ret : T) => Return (ret, y) in Return (x, back) - else let back := fun (ret : T) => Return (x, ret) in Return (y, back) + then let back := fun (ret : T) => Ok (ret, y) in Ok (x, back) + else let back := fun (ret : T) => Ok (x, ret) in Ok (y, back) . (** [paper::test_choose]: @@ -44,7 +44,7 @@ Definition test_choose : result unit := let (x, y) := p1 in if negb (x s= 1%i32) then Fail_ Failure - else if negb (y s= 0%i32) then Fail_ Failure else Return tt) + else if negb (y s= 0%i32) then Fail_ Failure else Ok tt) . (** Unit test for [paper::test_choose] *) @@ -69,17 +69,14 @@ Fixpoint list_nth_mut match l with | List_Cons x tl => if i s= 0%u32 - then - let back := fun (ret : T) => Return (List_Cons ret tl) in - Return (x, back) + then let back := fun (ret : T) => Ok (List_Cons ret tl) in Ok (x, back) else ( i1 <- u32_sub i 1%u32; p <- list_nth_mut T tl i1; let (t, list_nth_mut_back) := p in let back := - fun (ret : T) => tl1 <- list_nth_mut_back ret; Return (List_Cons x tl1) - in - Return (t, back)) + fun (ret : T) => tl1 <- list_nth_mut_back ret; Ok (List_Cons x tl1) in + Ok (t, back)) | List_Nil => Fail_ Failure end . @@ -89,7 +86,7 @@ Fixpoint list_nth_mut Fixpoint sum (l : List_t i32) : result i32 := match l with | List_Cons x tl => i <- sum tl; i32_add x i - | List_Nil => Return 0%i32 + | List_Nil => Ok 0%i32 end . @@ -103,7 +100,7 @@ Definition test_nth : result unit := x1 <- i32_add x 1%i32; l2 <- list_nth_mut_back x1; i <- sum l2; - if negb (i s= 7%i32) then Fail_ Failure else Return tt + if negb (i s= 7%i32) then Fail_ Failure else Ok tt . (** Unit test for [paper::test_nth] *) @@ -118,7 +115,7 @@ Definition call_choose (p : (u32 * u32)) : result u32 := pz1 <- u32_add pz 1%u32; p2 <- choose_back pz1; let (px1, _) := p2 in - Return px1 + Ok px1 . End Paper. diff --git a/tests/coq/misc/PoloniusList.v b/tests/coq/misc/PoloniusList.v index dfa09328..8af7f69c 100644 --- a/tests/coq/misc/PoloniusList.v +++ b/tests/coq/misc/PoloniusList.v @@ -27,15 +27,15 @@ Fixpoint get_list_at_x match ls with | List_Cons hd tl => if hd s= x - then Return (List_Cons hd tl, Return) + then Ok (List_Cons hd tl, Ok) else ( p <- get_list_at_x tl x; let (l, get_list_at_x_back) := p in let back := fun (ret : List_t u32) => - tl1 <- get_list_at_x_back ret; Return (List_Cons hd tl1) in - Return (l, back)) - | List_Nil => Return (List_Nil, Return) + tl1 <- get_list_at_x_back ret; Ok (List_Cons hd tl1) in + Ok (l, back)) + | List_Nil => Ok (List_Nil, Ok) end . diff --git a/tests/coq/misc/Primitives.v b/tests/coq/misc/Primitives.v index 990e27e4..e84d65ce 100644 --- a/tests/coq/misc/Primitives.v +++ b/tests/coq/misc/Primitives.v @@ -19,19 +19,19 @@ Inductive error := | OutOfFuel. Inductive result A := - | Return : A -> result A + | Ok : A -> result A | Fail_ : error -> result A. -Arguments Return {_} a. +Arguments Ok {_} a. Arguments Fail_ {_}. Definition bind {A B} (m: result A) (f: A -> result B) : result B := match m with | Fail_ e => Fail_ e - | Return x => f x + | Ok x => f x end. -Definition return_ {A: Type} (x: A) : result A := Return x. +Definition return_ {A: Type} (x: A) : result A := Ok x. Definition fail_ {A: Type} (e: error) : result A := Fail_ e. Notation "x <- c1 ; c2" := (bind c1 (fun x => c2)) @@ -39,27 +39,27 @@ Notation "x <- c1 ; c2" := (bind c1 (fun x => c2)) (** Monadic assert *) Definition massert (b: bool) : result unit := - if b then Return tt else Fail_ Failure. + if b then Ok tt else Fail_ Failure. (** Normalize and unwrap a successful result (used for globals) *) -Definition eval_result_refl {A} {x} (a: result A) (p: a = Return x) : A := - match a as r return (r = Return x -> A) with - | Return a' => fun _ => a' +Definition eval_result_refl {A} {x} (a: result A) (p: a = Ok x) : A := + match a as r return (r = Ok x -> A) with + | Ok a' => fun _ => a' | Fail_ e => fun p' => False_rect _ (eq_ind (Fail_ e) (fun e : result A => match e with - | Return _ => False + | Ok _ => False | Fail_ e => True end) - I (Return x) p') + I (Ok x) p') end p. Notation "x %global" := (eval_result_refl x eq_refl) (at level 40). Notation "x %return" := (eval_result_refl x eq_refl) (at level 40). (* Sanity check *) -Check (if true then Return (1 + 2) else Fail_ Failure)%global = 3. +Check (if true then Ok (1 + 2) else Fail_ Failure)%global = 3. (*** Misc *) @@ -236,7 +236,7 @@ Import Sumbool. Definition mk_scalar (ty: scalar_ty) (x: Z) : result (scalar ty) := match sumbool_of_bool (scalar_in_bounds ty x) with - | left H => Return (exist _ x (scalar_in_bounds_valid _ _ H)) + | left H => Ok (exist _ x (scalar_in_bounds_valid _ _ H)) | right _ => Fail_ Failure end. @@ -544,9 +544,9 @@ Arguments core_ops_range_Range_end_ {_}. (*** [alloc] *) -Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Ok x. Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result (T * (T -> result T)) := - Return (x, fun x => Return x). + Ok (x, fun x => Ok x). (* Trait instance *) Definition alloc_boxed_Box_coreopsDerefInst (Self : Type) : core_ops_deref_Deref Self := {| @@ -589,7 +589,7 @@ Definition array_index_mut_usize (T : Type) (n : usize) (a : array T n) (i : usi result (T * (T -> result (array T n))) := match array_index_usize T n a i with | Fail_ e => Fail_ e - | Return x => Return (x, array_update_usize T n a i) + | Ok x => Ok (x, array_update_usize T n a i) end. (*** Slice *) @@ -603,7 +603,7 @@ Definition slice_index_mut_usize (T : Type) (s : slice T) (i : usize) : result (T * (T -> result (slice T))) := match slice_index_usize T s i with | Fail_ e => Fail_ e - | Return x => Return (x, slice_update_usize T s i) + | Ok x => Ok (x, slice_update_usize T s i) end. (*** Subslices *) @@ -615,7 +615,7 @@ Definition array_to_slice_mut (T : Type) (n : usize) (a : array T n) : result (slice T * (slice T -> result (array T n))) := match array_to_slice T n a with | Fail_ e => Fail_ e - | Return x => Return (x, array_from_slice T n a) + | Ok x => Ok (x, array_from_slice T n a) end. Axiom array_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize), result (slice T). @@ -657,17 +657,17 @@ end end. Definition alloc_vec_Vec_bind {A B} (v: alloc_vec_Vec A) (f: list A -> result (list B)) : result (alloc_vec_Vec B) := l <- f (alloc_vec_Vec_to_list v) ; match sumbool_of_bool (scalar_le_max Usize (Z.of_nat (length l))) with - | left H => Return (exist _ l (scalar_le_max_valid _ _ H)) + | left H => Ok (exist _ l (scalar_le_max_valid _ _ H)) | right _ => Fail_ Failure end. Definition alloc_vec_Vec_push (T: Type) (v: alloc_vec_Vec T) (x: T) : result (alloc_vec_Vec T) := - alloc_vec_Vec_bind v (fun l => Return (l ++ [x])). + alloc_vec_Vec_bind v (fun l => Ok (l ++ [x])). Definition alloc_vec_Vec_insert (T: Type) (v: alloc_vec_Vec T) (i: usize) (x: T) : result (alloc_vec_Vec T) := alloc_vec_Vec_bind v (fun l => if to_Z i result (alloc_vec_Vec T))) := match alloc_vec_Vec_index_usize v i with - | Return x => - Return (x, alloc_vec_Vec_update_usize v i) + | Ok x => + Ok (x, alloc_vec_Vec_update_usize v i) | Fail_ e => Fail_ e end. @@ -717,7 +717,7 @@ Definition core_slice_index_Slice_index x <- inst.(core_slice_index_SliceIndex_get) i s; match x with | None => Fail_ Failure - | Some x => Return x + | Some x => Ok x end. (* [core::slice::index::Range:::get]: forward function *) diff --git a/tests/coq/traits/Primitives.v b/tests/coq/traits/Primitives.v index 990e27e4..e84d65ce 100644 --- a/tests/coq/traits/Primitives.v +++ b/tests/coq/traits/Primitives.v @@ -19,19 +19,19 @@ Inductive error := | OutOfFuel. Inductive result A := - | Return : A -> result A + | Ok : A -> result A | Fail_ : error -> result A. -Arguments Return {_} a. +Arguments Ok {_} a. Arguments Fail_ {_}. Definition bind {A B} (m: result A) (f: A -> result B) : result B := match m with | Fail_ e => Fail_ e - | Return x => f x + | Ok x => f x end. -Definition return_ {A: Type} (x: A) : result A := Return x. +Definition return_ {A: Type} (x: A) : result A := Ok x. Definition fail_ {A: Type} (e: error) : result A := Fail_ e. Notation "x <- c1 ; c2" := (bind c1 (fun x => c2)) @@ -39,27 +39,27 @@ Notation "x <- c1 ; c2" := (bind c1 (fun x => c2)) (** Monadic assert *) Definition massert (b: bool) : result unit := - if b then Return tt else Fail_ Failure. + if b then Ok tt else Fail_ Failure. (** Normalize and unwrap a successful result (used for globals) *) -Definition eval_result_refl {A} {x} (a: result A) (p: a = Return x) : A := - match a as r return (r = Return x -> A) with - | Return a' => fun _ => a' +Definition eval_result_refl {A} {x} (a: result A) (p: a = Ok x) : A := + match a as r return (r = Ok x -> A) with + | Ok a' => fun _ => a' | Fail_ e => fun p' => False_rect _ (eq_ind (Fail_ e) (fun e : result A => match e with - | Return _ => False + | Ok _ => False | Fail_ e => True end) - I (Return x) p') + I (Ok x) p') end p. Notation "x %global" := (eval_result_refl x eq_refl) (at level 40). Notation "x %return" := (eval_result_refl x eq_refl) (at level 40). (* Sanity check *) -Check (if true then Return (1 + 2) else Fail_ Failure)%global = 3. +Check (if true then Ok (1 + 2) else Fail_ Failure)%global = 3. (*** Misc *) @@ -236,7 +236,7 @@ Import Sumbool. Definition mk_scalar (ty: scalar_ty) (x: Z) : result (scalar ty) := match sumbool_of_bool (scalar_in_bounds ty x) with - | left H => Return (exist _ x (scalar_in_bounds_valid _ _ H)) + | left H => Ok (exist _ x (scalar_in_bounds_valid _ _ H)) | right _ => Fail_ Failure end. @@ -544,9 +544,9 @@ Arguments core_ops_range_Range_end_ {_}. (*** [alloc] *) -Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Return x. +Definition alloc_boxed_Box_deref (T : Type) (x : T) : result T := Ok x. Definition alloc_boxed_Box_deref_mut (T : Type) (x : T) : result (T * (T -> result T)) := - Return (x, fun x => Return x). + Ok (x, fun x => Ok x). (* Trait instance *) Definition alloc_boxed_Box_coreopsDerefInst (Self : Type) : core_ops_deref_Deref Self := {| @@ -589,7 +589,7 @@ Definition array_index_mut_usize (T : Type) (n : usize) (a : array T n) (i : usi result (T * (T -> result (array T n))) := match array_index_usize T n a i with | Fail_ e => Fail_ e - | Return x => Return (x, array_update_usize T n a i) + | Ok x => Ok (x, array_update_usize T n a i) end. (*** Slice *) @@ -603,7 +603,7 @@ Definition slice_index_mut_usize (T : Type) (s : slice T) (i : usize) : result (T * (T -> result (slice T))) := match slice_index_usize T s i with | Fail_ e => Fail_ e - | Return x => Return (x, slice_update_usize T s i) + | Ok x => Ok (x, slice_update_usize T s i) end. (*** Subslices *) @@ -615,7 +615,7 @@ Definition array_to_slice_mut (T : Type) (n : usize) (a : array T n) : result (slice T * (slice T -> result (array T n))) := match array_to_slice T n a with | Fail_ e => Fail_ e - | Return x => Return (x, array_from_slice T n a) + | Ok x => Ok (x, array_from_slice T n a) end. Axiom array_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize), result (slice T). @@ -657,17 +657,17 @@ end end. Definition alloc_vec_Vec_bind {A B} (v: alloc_vec_Vec A) (f: list A -> result (list B)) : result (alloc_vec_Vec B) := l <- f (alloc_vec_Vec_to_list v) ; match sumbool_of_bool (scalar_le_max Usize (Z.of_nat (length l))) with - | left H => Return (exist _ l (scalar_le_max_valid _ _ H)) + | left H => Ok (exist _ l (scalar_le_max_valid _ _ H)) | right _ => Fail_ Failure end. Definition alloc_vec_Vec_push (T: Type) (v: alloc_vec_Vec T) (x: T) : result (alloc_vec_Vec T) := - alloc_vec_Vec_bind v (fun l => Return (l ++ [x])). + alloc_vec_Vec_bind v (fun l => Ok (l ++ [x])). Definition alloc_vec_Vec_insert (T: Type) (v: alloc_vec_Vec T) (i: usize) (x: T) : result (alloc_vec_Vec T) := alloc_vec_Vec_bind v (fun l => if to_Z i result (alloc_vec_Vec T))) := match alloc_vec_Vec_index_usize v i with - | Return x => - Return (x, alloc_vec_Vec_update_usize v i) + | Ok x => + Ok (x, alloc_vec_Vec_update_usize v i) | Fail_ e => Fail_ e end. @@ -717,7 +717,7 @@ Definition core_slice_index_Slice_index x <- inst.(core_slice_index_SliceIndex_get) i s; match x with | None => Fail_ Failure - | Some x => Return x + | Some x => Ok x end. (* [core::slice::index::Range:::get]: forward function *) diff --git a/tests/coq/traits/Traits.v b/tests/coq/traits/Traits.v index 0e942c7d..fb37a507 100644 --- a/tests/coq/traits/Traits.v +++ b/tests/coq/traits/Traits.v @@ -20,7 +20,7 @@ Arguments BoolTrait_t_get_bool { _ }. (** [traits::{(traits::BoolTrait for bool)}::get_bool]: Source: 'src/traits.rs', lines 12:4-12:30 *) Definition boolTraitBool_get_bool (self : bool) : result bool := - Return self. + Ok self. (** Trait implementation: [traits::{(traits::BoolTrait for bool)}] Source: 'src/traits.rs', lines 11:0-11:23 *) @@ -32,21 +32,21 @@ Definition BoolTraitBool : BoolTrait_t bool := {| Source: 'src/traits.rs', lines 6:4-6:30 *) Definition boolTrait_ret_true {Self : Type} (self_clause : BoolTrait_t Self) (self : Self) : result bool := - Return true + Ok true . (** [traits::test_bool_trait_bool]: Source: 'src/traits.rs', lines 17:0-17:44 *) Definition test_bool_trait_bool (x : bool) : result bool := b <- boolTraitBool_get_bool x; - if b then boolTrait_ret_true BoolTraitBool x else Return false + if b then boolTrait_ret_true BoolTraitBool x else Ok false . (** [traits::{(traits::BoolTrait for core::option::Option)#1}::get_bool]: Source: 'src/traits.rs', lines 23:4-23:30 *) Definition boolTraitOption_get_bool (T : Type) (self : option T) : result bool := - match self with | None => Return false | Some _ => Return true end + match self with | None => Ok false | Some _ => Ok true end . (** Trait implementation: [traits::{(traits::BoolTrait for core::option::Option)#1}] @@ -59,7 +59,7 @@ Definition BoolTraitOption (T : Type) : BoolTrait_t (option T) := {| Source: 'src/traits.rs', lines 31:0-31:54 *) Definition test_bool_trait_option (T : Type) (x : option T) : result bool := b <- boolTraitOption_get_bool T x; - if b then boolTrait_ret_true (BoolTraitOption T) x else Return false + if b then boolTrait_ret_true (BoolTraitOption T) x else Ok false . (** [traits::test_bool_trait]: @@ -81,7 +81,7 @@ Arguments ToU64_t_to_u64 { _ }. (** [traits::{(traits::ToU64 for u64)#2}::to_u64]: Source: 'src/traits.rs', lines 44:4-44:26 *) Definition toU64U64_to_u64 (self : u64) : result u64 := - Return self. + Ok self. (** Trait implementation: [traits::{(traits::ToU64 for u64)#2}] Source: 'src/traits.rs', lines 43:0-43:18 *) @@ -167,7 +167,7 @@ Arguments ToType_t_to_type { _ _ }. (** [traits::{(traits::ToType for u64)#5}::to_type]: Source: 'src/traits.rs', lines 93:4-93:28 *) Definition toTypeU64Bool_to_type (self : u64) : result bool := - Return (self s> 0%u64) + Ok (self s> 0%u64) . (** Trait implementation: [traits::{(traits::ToType for u64)#5}] @@ -238,7 +238,7 @@ Arguments TestType_test_TestTrait_t_test { _ }. Source: 'src/traits.rs', lines 139:12-139:34 *) Definition testType_test_TestTraittraitsTestTypetestTestType1_test (self : TestType_test_TestType1_t) : result bool := - Return (self s> 1%u64) + Ok (self s> 1%u64) . (** Trait implementation: [traits::{traits::TestType#6}::test::{(traits::{traits::TestType#6}::test::TestTrait for traits::{traits::TestType#6}::test::TestType1)}] @@ -258,7 +258,7 @@ Definition testType_test x1 <- toU64Inst.(ToU64_t_to_u64) x; if x1 s> 0%u64 then testType_test_TestTraittraitsTestTypetestTestType1_test 0%u64 - else Return false + else Ok false . (** [traits::BoolWrapper] @@ -285,7 +285,7 @@ Definition ToTypetraitsBoolWrapperT (T : Type) (toTypeBoolTInst : ToType_t bool Source: 'src/traits.rs', lines 164:4-164:21 *) Definition with_const_ty_len2_default_body (Self : Type) (LEN : usize) : result usize := - Return 32%usize + Ok 32%usize . Definition with_const_ty_len2_default (Self : Type) (LEN : usize) : usize := (with_const_ty_len2_default_body Self LEN)%global @@ -313,7 +313,7 @@ Arguments WithConstTy_t_f { _ _ }. (** [traits::{(traits::WithConstTy<32: usize> for bool)#8}::LEN1] Source: 'src/traits.rs', lines 175:4-175:21 *) -Definition with_const_ty_bool32_len1_body : result usize := Return 12%usize. +Definition with_const_ty_bool32_len1_body : result usize := Ok 12%usize. Definition with_const_ty_bool32_len1 : usize := with_const_ty_bool32_len1_body%global . @@ -322,7 +322,7 @@ Definition with_const_ty_bool32_len1 : usize := Source: 'src/traits.rs', lines 180:4-180:39 *) Definition withConstTyBool32_f (i : u64) (a : array u8 32%usize) : result u64 := - Return i + Ok i . (** Trait implementation: [traits::{(traits::WithConstTy<32: usize> for bool)#8}] @@ -342,7 +342,7 @@ Definition use_with_const_ty1 (H : Type) (LEN : usize) (withConstTyInst : WithConstTy_t H LEN) : result usize := - Return withConstTyInst.(WithConstTy_tWithConstTy_t_LEN1) + Ok withConstTyInst.(WithConstTy_tWithConstTy_t_LEN1) . (** [traits::use_with_const_ty2]: @@ -352,7 +352,7 @@ Definition use_with_const_ty2 (w : withConstTyInst.(WithConstTy_tWithConstTy_t_W)) : result unit := - Return tt + Ok tt . (** [traits::use_with_const_ty3]: @@ -368,7 +368,7 @@ Definition use_with_const_ty3 (** [traits::test_where1]: Source: 'src/traits.rs', lines 193:0-193:40 *) Definition test_where1 (T : Type) (_x : T) : result unit := - Return tt. + Ok tt. (** [traits::test_where2]: Source: 'src/traits.rs', lines 194:0-194:57 *) @@ -376,7 +376,7 @@ Definition test_where2 (T : Type) (withConstTyT32Inst : WithConstTy_t T 32%usize) (_x : u32) : result unit := - Return tt + Ok tt . (** Trait declaration: [traits::ParentTrait0] @@ -435,7 +435,7 @@ Definition order1 ParentTrait0_t U) : result unit := - Return tt + Ok tt . (** Trait declaration: [traits::ChildTrait1] @@ -552,7 +552,7 @@ Definition ParentTrait2U32 : ParentTrait2_t u32 := {| (** [traits::{(traits::ChildTrait2 for u32)#13}::convert]: Source: 'src/traits.rs', lines 273:4-273:29 *) Definition childTrait2U32_convert (x : u32) : result u32 := - Return x. + Ok x. (** Trait implementation: [traits::{(traits::ChildTrait2 for u32)#13}] Source: 'src/traits.rs', lines 272:0-272:24 *) @@ -625,9 +625,7 @@ Arguments Trait_tTrait_t_LEN { _ }. (** [traits::{(traits::Trait for @Array)#14}::LEN] Source: 'src/traits.rs', lines 315:4-315:20 *) -Definition trait_array_len_body (T : Type) (N : usize) : result usize := - Return N -. +Definition trait_array_len_body (T : Type) (N : usize) : result usize := Ok N. Definition trait_array_len (T : Type) (N : usize) : usize := (trait_array_len_body T N)%global . @@ -642,7 +640,7 @@ Definition TraitArray (T : Type) (N : usize) : Trait_t (array T N) := {| Source: 'src/traits.rs', lines 319:4-319:20 *) Definition traittraits_wrapper_len_body (T : Type) (traitInst : Trait_t T) : result usize := - Return 0%usize + Ok 0%usize . Definition traittraits_wrapper_len (T : Type) (traitInst : Trait_t T) : usize := @@ -659,7 +657,7 @@ Definition TraittraitsWrapper (T : Type) (traitInst : Trait_t T) : Trait_t (** [traits::use_wrapper_len]: Source: 'src/traits.rs', lines 322:0-322:43 *) Definition use_wrapper_len (T : Type) (traitInst : Trait_t T) : result usize := - Return (TraittraitsWrapper T traitInst).(Trait_tTrait_t_LEN) + Ok (TraittraitsWrapper T traitInst).(Trait_tTrait_t_LEN) . (** [traits::Foo] @@ -685,7 +683,7 @@ Arguments Core_result_Result_Err { _ _ }. Source: 'src/traits.rs', lines 332:4-332:33 *) Definition foo_foo_body (T U : Type) (traitInst : Trait_t T) : result (core_result_Result_t T i32) := - Return (Core_result_Result_Err 0%i32) + Ok (Core_result_Result_Err 0%i32) . Definition foo_foo (T U : Type) (traitInst : Trait_t T) : core_result_Result_t T i32 := @@ -696,14 +694,14 @@ Definition foo_foo (T U : Type) (traitInst : Trait_t T) Source: 'src/traits.rs', lines 335:0-335:48 *) Definition use_foo1 (T U : Type) (traitInst : Trait_t T) : result (core_result_Result_t T i32) := - Return (foo_foo T U traitInst) + Ok (foo_foo T U traitInst) . (** [traits::use_foo2]: Source: 'src/traits.rs', lines 339:0-339:48 *) Definition use_foo2 (T U : Type) (traitInst : Trait_t U) : result (core_result_Result_t U i32) := - Return (foo_foo U T traitInst) + Ok (foo_foo U T traitInst) . End Traits. diff --git a/tests/fstar/arrays/Arrays.Funs.fst b/tests/fstar/arrays/Arrays.Funs.fst index 731c7290..983b3761 100644 --- a/tests/fstar/arrays/Arrays.Funs.fst +++ b/tests/fstar/arrays/Arrays.Funs.fst @@ -28,17 +28,17 @@ let array_to_mut_slice_ (** [arrays::array_len]: Source: 'src/arrays.rs', lines 25:0-25:40 *) let array_len (t : Type0) (s : array t 32) : result usize = - let* s1 = array_to_slice t 32 s in Return (slice_len t s1) + let* s1 = array_to_slice t 32 s in Ok (slice_len t s1) (** [arrays::shared_array_len]: Source: 'src/arrays.rs', lines 29:0-29:48 *) let shared_array_len (t : Type0) (s : array t 32) : result usize = - let* s1 = array_to_slice t 32 s in Return (slice_len t s1) + let* s1 = array_to_slice t 32 s in Ok (slice_len t s1) (** [arrays::shared_slice_len]: Source: 'src/arrays.rs', lines 33:0-33:44 *) let shared_slice_len (t : Type0) (s : slice t) : result usize = - Return (slice_len t s) + Ok (slice_len t s) (** [arrays::index_array_shared]: Source: 'src/arrays.rs', lines 37:0-37:57 *) @@ -94,7 +94,7 @@ let slice_subslice_mut_ core_slice_index_Slice_index_mut u32 (core_ops_range_Range usize) (core_slice_index_SliceIndexRangeUsizeSliceTInst u32) x { start = y; end_ = z } in - Return (s, index_mut_back) + Ok (s, index_mut_back) (** [arrays::array_to_slice_shared_]: Source: 'src/arrays.rs', lines 72:0-72:54 *) @@ -129,7 +129,7 @@ let array_subslice_mut_ (core_ops_index_IndexMutSliceTIInst u32 (core_ops_range_Range usize) (core_slice_index_SliceIndexRangeUsizeSliceTInst u32)) x { start = y; end_ = z } in - Return (s, index_mut_back) + Ok (s, index_mut_back) (** [arrays::index_slice_0]: Source: 'src/arrays.rs', lines 88:0-88:38 *) @@ -156,42 +156,42 @@ let update_update_array let* (_, index_mut_back1) = array_index_mut_usize u32 32 a j in let* a1 = index_mut_back1 0 in let* _ = index_mut_back a1 in - Return () + Ok () (** [arrays::array_local_deep_copy]: Source: 'src/arrays.rs', lines 118:0-118:43 *) let array_local_deep_copy (x : array u32 32) : result unit = - Return () + Ok () (** [arrays::take_array]: Source: 'src/arrays.rs', lines 122:0-122:30 *) let take_array (a : array u32 2) : result unit = - Return () + Ok () (** [arrays::take_array_borrow]: Source: 'src/arrays.rs', lines 123:0-123:38 *) let take_array_borrow (a : array u32 2) : result unit = - Return () + Ok () (** [arrays::take_slice]: Source: 'src/arrays.rs', lines 124:0-124:28 *) let take_slice (s : slice u32) : result unit = - Return () + Ok () (** [arrays::take_mut_slice]: Source: 'src/arrays.rs', lines 125:0-125:36 *) let take_mut_slice (s : slice u32) : result (slice u32) = - Return s + Ok s (** [arrays::const_array]: Source: 'src/arrays.rs', lines 127:0-127:32 *) let const_array : result (array u32 2) = - Return (mk_array u32 2 [ 0; 0 ]) + Ok (mk_array u32 2 [ 0; 0 ]) (** [arrays::const_slice]: Source: 'src/arrays.rs', lines 131:0-131:20 *) let const_slice : result unit = - let* _ = array_to_slice u32 2 (mk_array u32 2 [ 0; 0 ]) in Return () + let* _ = array_to_slice u32 2 (mk_array u32 2 [ 0; 0 ]) in Ok () (** [arrays::take_all]: Source: 'src/arrays.rs', lines 141:0-141:17 *) @@ -205,7 +205,7 @@ let take_all : result unit = array_to_slice_mut u32 2 (mk_array u32 2 [ 0; 0 ]) in let* s2 = take_mut_slice s1 in let* _ = to_slice_mut_back s2 in - Return () + Ok () (** [arrays::index_array]: Source: 'src/arrays.rs', lines 155:0-155:38 *) @@ -225,7 +225,7 @@ let index_slice_u32_0 (x : slice u32) : result u32 = (** [arrays::index_mut_slice_u32_0]: Source: 'src/arrays.rs', lines 166:0-166:50 *) let index_mut_slice_u32_0 (x : slice u32) : result (u32 & (slice u32)) = - let* i = slice_index_usize u32 x 0 in Return (i, x) + let* i = slice_index_usize u32 x 0 in Ok (i, x) (** [arrays::index_all]: Source: 'src/arrays.rs', lines 170:0-170:25 *) @@ -243,14 +243,14 @@ let index_all : result u32 = let* (i7, s2) = index_mut_slice_u32_0 s1 in let* i8 = u32_add i6 i7 in let* _ = to_slice_mut_back s2 in - Return i8 + Ok i8 (** [arrays::update_array]: Source: 'src/arrays.rs', lines 184:0-184:36 *) let update_array (x : array u32 2) : result unit = let* (_, index_mut_back) = array_index_mut_usize u32 2 x 0 in let* _ = index_mut_back 1 in - Return () + Ok () (** [arrays::update_array_mut_borrow]: Source: 'src/arrays.rs', lines 187:0-187:48 *) @@ -272,7 +272,7 @@ let update_all : result unit = let* (s, to_slice_mut_back) = array_to_slice_mut u32 2 x in let* s1 = update_mut_slice s in let* _ = to_slice_mut_back s1 in - Return () + Ok () (** [arrays::range_all]: Source: 'src/arrays.rs', lines 205:0-205:18 *) @@ -284,7 +284,7 @@ let range_all : result unit = (mk_array u32 4 [ 0; 0; 0; 0 ]) { start = 1; end_ = 3 } in let* s1 = update_mut_slice s in let* _ = index_mut_back s1 in - Return () + Ok () (** [arrays::deref_array_borrow]: Source: 'src/arrays.rs', lines 214:0-214:46 *) @@ -294,12 +294,12 @@ let deref_array_borrow (x : array u32 2) : result u32 = (** [arrays::deref_array_mut_borrow]: Source: 'src/arrays.rs', lines 219:0-219:54 *) let deref_array_mut_borrow (x : array u32 2) : result (u32 & (array u32 2)) = - let* i = array_index_usize u32 2 x 0 in Return (i, x) + let* i = array_index_usize u32 2 x 0 in Ok (i, x) (** [arrays::take_array_t]: Source: 'src/arrays.rs', lines 227:0-227:31 *) let take_array_t (a : array aB_t 2) : result unit = - Return () + Ok () (** [arrays::non_copyable_array]: Source: 'src/arrays.rs', lines 229:0-229:27 *) @@ -319,7 +319,7 @@ let rec sum_loop let* sum3 = u32_add sum1 i2 in let* i3 = usize_add i 1 in sum_loop s sum3 i3 - else Return sum1 + else Ok sum1 (** [arrays::sum]: Source: 'src/arrays.rs', lines 242:0-242:28 *) @@ -341,7 +341,7 @@ let rec sum2_loop let* sum3 = u32_add sum1 i4 in let* i5 = usize_add i 1 in sum2_loop s s2 sum3 i5 - else Return sum1 + else Ok sum1 (** [arrays::sum2]: Source: 'src/arrays.rs', lines 252:0-252:41 *) @@ -358,7 +358,7 @@ let f0 : result unit = let* (_, index_mut_back) = slice_index_mut_usize u32 s 0 in let* s1 = index_mut_back 1 in let* _ = to_slice_mut_back s1 in - Return () + Ok () (** [arrays::f1]: Source: 'src/arrays.rs', lines 268:0-268:11 *) @@ -366,12 +366,12 @@ let f1 : result unit = let* (_, index_mut_back) = array_index_mut_usize u32 2 (mk_array u32 2 [ 1; 2 ]) 0 in let* _ = index_mut_back 1 in - Return () + Ok () (** [arrays::f2]: Source: 'src/arrays.rs', lines 273:0-273:17 *) let f2 (i : u32) : result unit = - Return () + Ok () (** [arrays::f4]: Source: 'src/arrays.rs', lines 282:0-282:54 *) @@ -393,7 +393,7 @@ let f3 : result u32 = (** [arrays::SZ] Source: 'src/arrays.rs', lines 286:0-286:19 *) -let sz_body : result usize = Return 32 +let sz_body : result usize = Ok 32 let sz : usize = eval_global sz_body (** [arrays::f5]: @@ -412,7 +412,7 @@ let ite : result unit = let* (_, s3) = index_mut_slice_u32_0 s2 in let* _ = to_slice_mut_back1 s3 in let* _ = to_slice_mut_back s1 in - Return () + Ok () (** [arrays::zero_slice]: loop 0: Source: 'src/arrays.rs', lines 303:0-310:1 *) @@ -426,7 +426,7 @@ let rec zero_slice_loop let* i1 = usize_add i 1 in let* a1 = index_mut_back 0 in zero_slice_loop a1 i1 len - else Return a + else Ok a (** [arrays::zero_slice]: Source: 'src/arrays.rs', lines 303:0-303:31 *) @@ -441,12 +441,12 @@ let rec iter_mut_slice_loop = if i < len then let* i1 = usize_add i 1 in iter_mut_slice_loop len i1 - else Return () + else Ok () (** [arrays::iter_mut_slice]: Source: 'src/arrays.rs', lines 312:0-312:35 *) let iter_mut_slice (a : slice u8) : result (slice u8) = - let len = slice_len u8 a in let* _ = iter_mut_slice_loop len 0 in Return a + let len = slice_len u8 a in let* _ = iter_mut_slice_loop len 0 in Ok a (** [arrays::sum_mut_slice]: loop 0: Source: 'src/arrays.rs', lines 320:0-328:1 *) @@ -461,10 +461,10 @@ let rec sum_mut_slice_loop let* s1 = u32_add s i2 in let* i3 = usize_add i 1 in sum_mut_slice_loop a i3 s1 - else Return s + else Ok s (** [arrays::sum_mut_slice]: Source: 'src/arrays.rs', lines 320:0-320:42 *) let sum_mut_slice (a : slice u32) : result (u32 & (slice u32)) = - let* i = sum_mut_slice_loop a 0 0 in Return (i, a) + let* i = sum_mut_slice_loop a 0 0 in Ok (i, a) diff --git a/tests/fstar/arrays/Primitives.fst b/tests/fstar/arrays/Primitives.fst index fca80829..acdb09dc 100644 --- a/tests/fstar/arrays/Primitives.fst +++ b/tests/fstar/arrays/Primitives.fst @@ -23,11 +23,11 @@ type error : Type0 = | OutOfFuel type result (a : Type0) : Type0 = -| Return : v:a -> result a +| Ok : v:a -> result a | Fail : e:error -> result a // Monadic return operator -unfold let return (#a : Type0) (x : a) : result a = Return x +unfold let return (#a : Type0) (x : a) : result a = Ok x // Monadic bind operator. // Allows to use the notation: @@ -36,17 +36,17 @@ unfold let return (#a : Type0) (x : a) : result a = Return x // ... // ``` unfold let (let*) (#a #b : Type0) (m: result a) - (f: (x:a) -> Pure (result b) (requires (m == Return x)) (ensures fun _ -> True)) : + (f: (x:a) -> Pure (result b) (requires (m == Ok x)) (ensures fun _ -> True)) : result b = match m with - | Return x -> f x + | Ok x -> f x | Fail e -> Fail e // Monadic assert(...) -let massert (b:bool) : result unit = if b then Return () else Fail Failure +let massert (b:bool) : result unit = if b then Ok () else Fail Failure // Normalize and unwrap a successful result (used for globals). -let eval_global (#a : Type0) (x : result a{Return? (normalize_term x)}) : a = Return?.v x +let eval_global (#a : Type0) (x : result a{Ok? (normalize_term x)}) : a = Ok?.v x (*** Misc *) type char = FStar.Char.char @@ -144,7 +144,7 @@ let scalar_max (ty : scalar_ty) : int = type scalar (ty : scalar_ty) : eqtype = x:int{scalar_min ty <= x && x <= scalar_max ty} let mk_scalar (ty : scalar_ty) (x : int) : result (scalar ty) = - if scalar_min ty <= x && scalar_max ty >= x then Return x else Fail Failure + if scalar_min ty <= x && scalar_max ty >= x then Ok x else Fail Failure let scalar_neg (#ty : scalar_ty) (x : scalar ty) : result (scalar ty) = mk_scalar ty (-x) @@ -498,9 +498,9 @@ type core_ops_range_Range (a : Type0) = { (*** [alloc] *) -let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Ok x let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result (t & (t -> result t)) = - Return (x, (fun x -> Return x)) + Ok (x, (fun x -> Ok x)) // Trait instance let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { @@ -528,20 +528,20 @@ let mk_array (a : Type0) (n : usize) l let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = - if i < length x then Return (index x i) + if i < length x then Ok (index x i) else Fail Failure let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = - if i < length x then Return (list_update x i nx) + if i < length x then Ok (list_update x i nx) else Fail Failure let array_index_mut_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result (a & (a -> result (array a n))) = match array_index_usize a n x i with | Fail e -> Fail e - | Return v -> - Return (v, array_update_usize a n x i) + | Ok v -> + Ok (v, array_update_usize a n x i) (*** Slice *) type slice (a : Type0) = s:list a{length s <= usize_max} @@ -549,30 +549,30 @@ type slice (a : Type0) = s:list a{length s <= usize_max} let slice_len (a : Type0) (s : slice a) : usize = length s let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = - if i < length x then Return (index x i) + if i < length x then Ok (index x i) else Fail Failure let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = - if i < length x then Return (list_update x i nx) + if i < length x then Ok (list_update x i nx) else Fail Failure let slice_index_mut_usize (a : Type0) (s : slice a) (i : usize) : result (a & (a -> result (slice a))) = match slice_index_usize a s i with | Fail e -> Fail e - | Return x -> - Return (x, slice_update_usize a s i) + | Ok x -> + Ok (x, slice_update_usize a s i) (*** Subslices *) -let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Ok x let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = - if length s = n then Return s + if length s = n then Ok s else Fail Failure let array_to_slice_mut (a : Type0) (n : usize) (x : array a n) : result (slice a & (slice a -> result (array a n))) = - Return (x, array_from_slice a n x) + Ok (x, array_from_slice a n x) // TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = @@ -598,16 +598,16 @@ let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v // Helper let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = - if i < length v then Return (index v i) else Fail Failure + if i < length v then Ok (index v i) else Fail Failure // Helper let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = - if i < length v then Return (list_update v i x) else Fail Failure + if i < length v then Ok (list_update v i x) else Fail Failure let alloc_vec_Vec_index_mut_usize (#a : Type0) (v: alloc_vec_Vec a) (i: usize) : result (a & (a → result (alloc_vec_Vec a))) = match alloc_vec_Vec_index_usize v i with - | Return x -> - Return (x, alloc_vec_Vec_update_usize v i) + | Ok x -> + Ok (x, alloc_vec_Vec_update_usize v i) | Fail e -> Fail e let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : @@ -616,17 +616,17 @@ let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : (ensures (fun res -> match res with | Fail e -> e == Failure - | Return v' -> length v' = length v + 1)) = + | Ok v' -> length v' = length v + 1)) = if length v < usize_max then begin (**) assert_norm(length [x] == 1); (**) append_length v [x]; (**) assert(length (append v [x]) = length v + 1); - Return (append v [x]) + Ok (append v [x]) end else Fail Failure let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = - if i < length v then Return (list_update v i x) else Fail Failure + if i < length v then Ok (list_update v i x) else Fail Failure // Trait declaration: [core::slice::index::private_slice_index::Sealed] type core_slice_index_private_slice_index_Sealed (self : Type0) = unit @@ -650,7 +650,7 @@ let core_slice_index_Slice_index let* x = inst.get i s in match x with | None -> Fail Failure - | Some x -> Return x + | Some x -> Ok x // [core::slice::index::Range:::get]: forward function let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : diff --git a/tests/fstar/betree/BetreeMain.Funs.fst b/tests/fstar/betree/BetreeMain.Funs.fst index 129e6f7e..8e64f43f 100644 --- a/tests/fstar/betree/BetreeMain.Funs.fst +++ b/tests/fstar/betree/BetreeMain.Funs.fst @@ -41,19 +41,19 @@ let betree_store_leaf_node (** [betree_main::betree::fresh_node_id]: Source: 'src/betree.rs', lines 55:0-55:48 *) let betree_fresh_node_id (counter : u64) : result (u64 & u64) = - let* counter1 = u64_add counter 1 in Return (counter, counter1) + let* counter1 = u64_add counter 1 in Ok (counter, counter1) (** [betree_main::betree::{betree_main::betree::NodeIdCounter}::new]: Source: 'src/betree.rs', lines 206:4-206:20 *) let betree_NodeIdCounter_new : result betree_NodeIdCounter_t = - Return { next_node_id = 0 } + Ok { next_node_id = 0 } (** [betree_main::betree::{betree_main::betree::NodeIdCounter}::fresh_id]: Source: 'src/betree.rs', lines 210:4-210:36 *) let betree_NodeIdCounter_fresh_id (self : betree_NodeIdCounter_t) : result (u64 & betree_NodeIdCounter_t) = let* i = u64_add self.next_node_id 1 in - Return (self.next_node_id, { next_node_id = i }) + Ok (self.next_node_id, { next_node_id = i }) (** [betree_main::betree::upsert_update]: Source: 'src/betree.rs', lines 234:0-234:70 *) @@ -62,16 +62,16 @@ let betree_upsert_update begin match prev with | None -> begin match st with - | Betree_UpsertFunState_Add v -> Return v - | Betree_UpsertFunState_Sub _ -> Return 0 + | Betree_UpsertFunState_Add v -> Ok v + | Betree_UpsertFunState_Sub _ -> Ok 0 end | Some prev1 -> begin match st with | Betree_UpsertFunState_Add v -> let* margin = u64_sub core_u64_max prev1 in - if margin >= v then u64_add prev1 v else Return core_u64_max + if margin >= v then u64_add prev1 v else Ok core_u64_max | Betree_UpsertFunState_Sub v -> - if prev1 >= v then u64_sub prev1 v else Return 0 + if prev1 >= v then u64_sub prev1 v else Ok 0 end end @@ -83,7 +83,7 @@ let rec betree_List_len = begin match self with | Betree_List_Cons _ tl -> let* i = betree_List_len t tl in u64_add 1 i - | Betree_List_Nil -> Return 0 + | Betree_List_Nil -> Ok 0 end (** [betree_main::betree::{betree_main::betree::List#1}::split_at]: @@ -94,14 +94,14 @@ let rec betree_List_split_at (decreases (betree_List_split_at_decreases t self n)) = if n = 0 - then Return (Betree_List_Nil, self) + then Ok (Betree_List_Nil, self) else begin match self with | Betree_List_Cons hd tl -> let* i = u64_sub n 1 in let* p = betree_List_split_at t tl i in let (ls0, ls1) = p in - Return (Betree_List_Cons hd ls0, ls1) + Ok (Betree_List_Cons hd ls0, ls1) | Betree_List_Nil -> Fail Failure end @@ -110,7 +110,7 @@ let rec betree_List_split_at let betree_List_push_front (t : Type0) (self : betree_List_t t) (x : t) : result (betree_List_t t) = let (tl, _) = core_mem_replace (betree_List_t t) self Betree_List_Nil in - Return (Betree_List_Cons x tl) + Ok (Betree_List_Cons x tl) (** [betree_main::betree::{betree_main::betree::List#1}::pop_front]: Source: 'src/betree.rs', lines 306:4-306:32 *) @@ -118,7 +118,7 @@ let betree_List_pop_front (t : Type0) (self : betree_List_t t) : result (t & (betree_List_t t)) = let (ls, _) = core_mem_replace (betree_List_t t) self Betree_List_Nil in begin match ls with - | Betree_List_Cons x tl -> Return (x, tl) + | Betree_List_Cons x tl -> Ok (x, tl) | Betree_List_Nil -> Fail Failure end @@ -126,7 +126,7 @@ let betree_List_pop_front Source: 'src/betree.rs', lines 318:4-318:22 *) let betree_List_hd (t : Type0) (self : betree_List_t t) : result t = begin match self with - | Betree_List_Cons hd _ -> Return hd + | Betree_List_Cons hd _ -> Ok hd | Betree_List_Nil -> Fail Failure end @@ -135,8 +135,8 @@ let betree_List_hd (t : Type0) (self : betree_List_t t) : result t = let betree_ListPairU64T_head_has_key (t : Type0) (self : betree_List_t (u64 & t)) (key : u64) : result bool = begin match self with - | Betree_List_Cons hd _ -> let (i, _) = hd in Return (i = key) - | Betree_List_Nil -> Return false + | Betree_List_Cons hd _ -> let (i, _) = hd in Ok (i = key) + | Betree_List_Nil -> Ok false end (** [betree_main::betree::{betree_main::betree::List<(u64, T)>#2}::partition_at_pivot]: @@ -150,12 +150,12 @@ let rec betree_ListPairU64T_partition_at_pivot | Betree_List_Cons hd tl -> let (i, x) = hd in if i >= pivot - then Return (Betree_List_Nil, Betree_List_Cons (i, x) tl) + then Ok (Betree_List_Nil, Betree_List_Cons (i, x) tl) else let* p = betree_ListPairU64T_partition_at_pivot t tl pivot in let (ls0, ls1) = p in - Return (Betree_List_Cons (i, x) ls0, ls1) - | Betree_List_Nil -> Return (Betree_List_Nil, Betree_List_Nil) + Ok (Betree_List_Cons (i, x) ls0, ls1) + | Betree_List_Nil -> Ok (Betree_List_Nil, Betree_List_Nil) end (** [betree_main::betree::{betree_main::betree::Leaf#3}::split]: @@ -176,7 +176,7 @@ let betree_Leaf_split let* (st2, _) = betree_store_leaf_node id1 content1 st1 in let n = Betree_Node_Leaf { id = id0; size = params.split_size } in let n1 = Betree_Node_Leaf { id = id1; size = params.split_size } in - Return (st2, ({ id = self.id; pivot = pivot; left = n; right = n1 }, + Ok (st2, ({ id = self.id; pivot = pivot; left = n; right = n1 }, node_id_cnt2)) (** [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_for_key]: @@ -191,16 +191,16 @@ let rec betree_Node_lookup_first_message_for_key | Betree_List_Cons x next_msgs -> let (i, m) = x in if i >= key - then Return (Betree_List_Cons (i, m) next_msgs, Return) + then Ok (Betree_List_Cons (i, m) next_msgs, Ok) else let* (l, lookup_first_message_for_key_back) = betree_Node_lookup_first_message_for_key key next_msgs in let back = fun ret -> let* next_msgs1 = lookup_first_message_for_key_back ret in - Return (Betree_List_Cons (i, m) next_msgs1) in - Return (l, back) - | Betree_List_Nil -> Return (Betree_List_Nil, Return) + Ok (Betree_List_Cons (i, m) next_msgs1) in + Ok (l, back) + | Betree_List_Nil -> Ok (Betree_List_Nil, Ok) end (** [betree_main::betree::{betree_main::betree::Node#5}::lookup_in_bindings]: @@ -214,9 +214,9 @@ let rec betree_Node_lookup_in_bindings | Betree_List_Cons hd tl -> let (i, i1) = hd in if i = key - then Return (Some i1) - else if i > key then Return None else betree_Node_lookup_in_bindings key tl - | Betree_List_Nil -> Return None + then Ok (Some i1) + else if i > key then Ok None else betree_Node_lookup_in_bindings key tl + | Betree_List_Nil -> Ok None end (** [betree_main::betree::{betree_main::betree::Node#5}::apply_upserts]: @@ -244,7 +244,7 @@ let rec betree_Node_apply_upserts let* msgs1 = betree_List_push_front (u64 & betree_Message_t) msgs (key, Betree_Message_Insert v) in - Return (st1, (v, msgs1)) + Ok (st1, (v, msgs1)) (** [betree_main::betree::{betree_main::betree::Internal#4}::lookup_in_children]: Source: 'src/betree.rs', lines 395:4-395:63 *) @@ -256,10 +256,10 @@ let rec betree_Internal_lookup_in_children if key < self.pivot then let* (st1, (o, n)) = betree_Node_lookup self.left key st in - Return (st1, (o, { self with left = n })) + Ok (st1, (o, { self with left = n })) else let* (st1, (o, n)) = betree_Node_lookup self.right key st in - Return (st1, (o, { self with right = n })) + Ok (st1, (o, { self with right = n })) (** [betree_main::betree::{betree_main::betree::Node#5}::lookup]: Source: 'src/betree.rs', lines 709:4-709:58 *) @@ -282,19 +282,19 @@ and betree_Node_lookup betree_Internal_lookup_in_children node key st1 in let* _ = lookup_first_message_for_key_back (Betree_List_Cons (k, msg) l) in - Return (st2, (o, Betree_Node_Internal node1)) + Ok (st2, (o, Betree_Node_Internal node1)) else begin match msg with | Betree_Message_Insert v -> let* _ = lookup_first_message_for_key_back (Betree_List_Cons (k, Betree_Message_Insert v) l) in - Return (st1, (Some v, Betree_Node_Internal node)) + Ok (st1, (Some v, Betree_Node_Internal node)) | Betree_Message_Delete -> let* _ = lookup_first_message_for_key_back (Betree_List_Cons (k, Betree_Message_Delete) l) in - Return (st1, (None, Betree_Node_Internal node)) + Ok (st1, (None, Betree_Node_Internal node)) | Betree_Message_Upsert ufs -> let* (st2, (v, node1)) = betree_Internal_lookup_in_children node key st1 in @@ -303,18 +303,18 @@ and betree_Node_lookup Betree_Message_Upsert ufs) l) v key st2 in let* msgs1 = lookup_first_message_for_key_back pending1 in let* (st4, _) = betree_store_internal_node node1.id msgs1 st3 in - Return (st4, (Some v1, Betree_Node_Internal node1)) + Ok (st4, (Some v1, Betree_Node_Internal node1)) end | Betree_List_Nil -> let* (st2, (o, node1)) = betree_Internal_lookup_in_children node key st1 in let* _ = lookup_first_message_for_key_back Betree_List_Nil in - Return (st2, (o, Betree_Node_Internal node1)) + Ok (st2, (o, Betree_Node_Internal node1)) end | Betree_Node_Leaf node -> let* (st1, bindings) = betree_load_leaf_node node.id st in let* o = betree_Node_lookup_in_bindings key bindings in - Return (st1, (o, Betree_Node_Leaf node)) + Ok (st1, (o, Betree_Node_Leaf node)) end (** [betree_main::betree::{betree_main::betree::Node#5}::filter_messages_for_key]: @@ -333,8 +333,8 @@ let rec betree_Node_filter_messages_for_key betree_List_pop_front (u64 & betree_Message_t) (Betree_List_Cons (k, m) l) in betree_Node_filter_messages_for_key key msgs1 - else Return (Betree_List_Cons (k, m) l) - | Betree_List_Nil -> Return Betree_List_Nil + else Ok (Betree_List_Cons (k, m) l) + | Betree_List_Nil -> Ok Betree_List_Nil end (** [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_after_key]: @@ -355,10 +355,10 @@ let rec betree_Node_lookup_first_message_after_key let back = fun ret -> let* next_msgs1 = lookup_first_message_after_key_back ret in - Return (Betree_List_Cons (k, m) next_msgs1) in - Return (l, back) - else Return (Betree_List_Cons (k, m) next_msgs, Return) - | Betree_List_Nil -> Return (Betree_List_Nil, Return) + Ok (Betree_List_Cons (k, m) next_msgs1) in + Ok (l, back) + else Ok (Betree_List_Cons (k, m) next_msgs, Ok) + | Betree_List_Nil -> Ok (Betree_List_Nil, Ok) end (** [betree_main::betree::{betree_main::betree::Node#5}::apply_to_internal]: @@ -434,7 +434,7 @@ let rec betree_Node_apply_messages_to_internal let (i, m) = new_msg in let* msgs1 = betree_Node_apply_to_internal msgs i m in betree_Node_apply_messages_to_internal msgs1 new_msgs_tl - | Betree_List_Nil -> Return msgs + | Betree_List_Nil -> Ok msgs end (** [betree_main::betree::{betree_main::betree::Node#5}::lookup_mut_in_bindings]: @@ -449,16 +449,16 @@ let rec betree_Node_lookup_mut_in_bindings | Betree_List_Cons hd tl -> let (i, i1) = hd in if i >= key - then Return (Betree_List_Cons (i, i1) tl, Return) + then Ok (Betree_List_Cons (i, i1) tl, Ok) else let* (l, lookup_mut_in_bindings_back) = betree_Node_lookup_mut_in_bindings key tl in let back = fun ret -> let* tl1 = lookup_mut_in_bindings_back ret in - Return (Betree_List_Cons (i, i1) tl1) in - Return (l, back) - | Betree_List_Nil -> Return (Betree_List_Nil, Return) + Ok (Betree_List_Cons (i, i1) tl1) in + Ok (l, back) + | Betree_List_Nil -> Ok (Betree_List_Nil, Ok) end (** [betree_main::betree::{betree_main::betree::Node#5}::apply_to_leaf]: @@ -510,7 +510,7 @@ let rec betree_Node_apply_messages_to_leaf let (i, m) = new_msg in let* bindings1 = betree_Node_apply_to_leaf bindings i m in betree_Node_apply_messages_to_leaf bindings1 new_msgs_tl - | Betree_List_Nil -> Return bindings + | Betree_List_Nil -> Ok bindings end (** [betree_main::betree::{betree_main::betree::Internal#4}::flush]: @@ -541,14 +541,14 @@ let rec betree_Internal_flush betree_Node_apply_messages self.right params node_id_cnt1 msgs_right st1 in let (n1, node_id_cnt2) = p2 in - Return (st2, (Betree_List_Nil, ({ self with left = n; right = n1 }, + Ok (st2, (Betree_List_Nil, ({ self with left = n; right = n1 }, node_id_cnt2))) - else Return (st1, (msgs_right, ({ self with left = n }, node_id_cnt1))) + else Ok (st1, (msgs_right, ({ self with left = n }, node_id_cnt1))) else let* (st1, p1) = betree_Node_apply_messages self.right params node_id_cnt msgs_right st in let (n, node_id_cnt1) = p1 in - Return (st1, (msgs_left, ({ self with right = n }, node_id_cnt1))) + Ok (st1, (msgs_left, ({ self with right = n }, node_id_cnt1))) (** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages]: Source: 'src/betree.rs', lines 588:4-593:5 *) @@ -571,10 +571,10 @@ and betree_Node_apply_messages betree_Internal_flush node params node_id_cnt content1 st1 in let (node1, node_id_cnt1) = p in let* (st3, _) = betree_store_internal_node node1.id content2 st2 in - Return (st3, (Betree_Node_Internal node1, node_id_cnt1)) + Ok (st3, (Betree_Node_Internal node1, node_id_cnt1)) else let* (st2, _) = betree_store_internal_node node.id content1 st1 in - Return (st2, (Betree_Node_Internal node, node_id_cnt)) + Ok (st2, (Betree_Node_Internal node, node_id_cnt)) | Betree_Node_Leaf node -> let* (st1, content) = betree_load_leaf_node node.id st in let* content1 = betree_Node_apply_messages_to_leaf content msgs in @@ -585,10 +585,10 @@ and betree_Node_apply_messages let* (st2, (new_node, node_id_cnt1)) = betree_Leaf_split node content1 params node_id_cnt st1 in let* (st3, _) = betree_store_leaf_node node.id Betree_List_Nil st2 in - Return (st3, (Betree_Node_Internal new_node, node_id_cnt1)) + Ok (st3, (Betree_Node_Internal new_node, node_id_cnt1)) else let* (st2, _) = betree_store_leaf_node node.id content1 st1 in - Return (st2, (Betree_Node_Leaf { node with size = len }, node_id_cnt)) + Ok (st2, (Betree_Node_Leaf { node with size = len }, node_id_cnt)) end (** [betree_main::betree::{betree_main::betree::Node#5}::apply]: @@ -603,7 +603,7 @@ let betree_Node_apply betree_Node_apply_messages self params node_id_cnt (Betree_List_Cons (key, new_msg) Betree_List_Nil) st in let (self1, node_id_cnt1) = p in - Return (st1, (self1, node_id_cnt1)) + Ok (st1, (self1, node_id_cnt1)) (** [betree_main::betree::{betree_main::betree::BeTree#6}::new]: Source: 'src/betree.rs', lines 849:4-849:60 *) @@ -614,7 +614,7 @@ let betree_BeTree_new let* node_id_cnt = betree_NodeIdCounter_new in let* (id, node_id_cnt1) = betree_NodeIdCounter_fresh_id node_id_cnt in let* (st1, _) = betree_store_leaf_node id Betree_List_Nil st in - Return (st1, + Ok (st1, { params = { min_flush_size = min_flush_size; split_size = split_size }; node_id_cnt = node_id_cnt1; @@ -630,7 +630,7 @@ let betree_BeTree_apply let* (st1, p) = betree_Node_apply self.root self.params self.node_id_cnt key msg st in let (n, nic) = p in - Return (st1, { self with node_id_cnt = nic; root = n }) + Ok (st1, { self with node_id_cnt = nic; root = n }) (** [betree_main::betree::{betree_main::betree::BeTree#6}::insert]: Source: 'src/betree.rs', lines 874:4-874:52 *) @@ -664,13 +664,13 @@ let betree_BeTree_lookup result (state & ((option u64) & betree_BeTree_t)) = let* (st1, (o, n)) = betree_Node_lookup self.root key st in - Return (st1, (o, { self with root = n })) + Ok (st1, (o, { self with root = n })) (** [betree_main::main]: Source: 'src/betree_main.rs', lines 5:0-5:9 *) let main : result unit = - Return () + Ok () (** Unit test for [betree_main::main] *) -let _ = assert_norm (main = Return ()) +let _ = assert_norm (main = Ok ()) diff --git a/tests/fstar/betree/Primitives.fst b/tests/fstar/betree/Primitives.fst index fca80829..acdb09dc 100644 --- a/tests/fstar/betree/Primitives.fst +++ b/tests/fstar/betree/Primitives.fst @@ -23,11 +23,11 @@ type error : Type0 = | OutOfFuel type result (a : Type0) : Type0 = -| Return : v:a -> result a +| Ok : v:a -> result a | Fail : e:error -> result a // Monadic return operator -unfold let return (#a : Type0) (x : a) : result a = Return x +unfold let return (#a : Type0) (x : a) : result a = Ok x // Monadic bind operator. // Allows to use the notation: @@ -36,17 +36,17 @@ unfold let return (#a : Type0) (x : a) : result a = Return x // ... // ``` unfold let (let*) (#a #b : Type0) (m: result a) - (f: (x:a) -> Pure (result b) (requires (m == Return x)) (ensures fun _ -> True)) : + (f: (x:a) -> Pure (result b) (requires (m == Ok x)) (ensures fun _ -> True)) : result b = match m with - | Return x -> f x + | Ok x -> f x | Fail e -> Fail e // Monadic assert(...) -let massert (b:bool) : result unit = if b then Return () else Fail Failure +let massert (b:bool) : result unit = if b then Ok () else Fail Failure // Normalize and unwrap a successful result (used for globals). -let eval_global (#a : Type0) (x : result a{Return? (normalize_term x)}) : a = Return?.v x +let eval_global (#a : Type0) (x : result a{Ok? (normalize_term x)}) : a = Ok?.v x (*** Misc *) type char = FStar.Char.char @@ -144,7 +144,7 @@ let scalar_max (ty : scalar_ty) : int = type scalar (ty : scalar_ty) : eqtype = x:int{scalar_min ty <= x && x <= scalar_max ty} let mk_scalar (ty : scalar_ty) (x : int) : result (scalar ty) = - if scalar_min ty <= x && scalar_max ty >= x then Return x else Fail Failure + if scalar_min ty <= x && scalar_max ty >= x then Ok x else Fail Failure let scalar_neg (#ty : scalar_ty) (x : scalar ty) : result (scalar ty) = mk_scalar ty (-x) @@ -498,9 +498,9 @@ type core_ops_range_Range (a : Type0) = { (*** [alloc] *) -let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Ok x let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result (t & (t -> result t)) = - Return (x, (fun x -> Return x)) + Ok (x, (fun x -> Ok x)) // Trait instance let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { @@ -528,20 +528,20 @@ let mk_array (a : Type0) (n : usize) l let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = - if i < length x then Return (index x i) + if i < length x then Ok (index x i) else Fail Failure let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = - if i < length x then Return (list_update x i nx) + if i < length x then Ok (list_update x i nx) else Fail Failure let array_index_mut_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result (a & (a -> result (array a n))) = match array_index_usize a n x i with | Fail e -> Fail e - | Return v -> - Return (v, array_update_usize a n x i) + | Ok v -> + Ok (v, array_update_usize a n x i) (*** Slice *) type slice (a : Type0) = s:list a{length s <= usize_max} @@ -549,30 +549,30 @@ type slice (a : Type0) = s:list a{length s <= usize_max} let slice_len (a : Type0) (s : slice a) : usize = length s let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = - if i < length x then Return (index x i) + if i < length x then Ok (index x i) else Fail Failure let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = - if i < length x then Return (list_update x i nx) + if i < length x then Ok (list_update x i nx) else Fail Failure let slice_index_mut_usize (a : Type0) (s : slice a) (i : usize) : result (a & (a -> result (slice a))) = match slice_index_usize a s i with | Fail e -> Fail e - | Return x -> - Return (x, slice_update_usize a s i) + | Ok x -> + Ok (x, slice_update_usize a s i) (*** Subslices *) -let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Ok x let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = - if length s = n then Return s + if length s = n then Ok s else Fail Failure let array_to_slice_mut (a : Type0) (n : usize) (x : array a n) : result (slice a & (slice a -> result (array a n))) = - Return (x, array_from_slice a n x) + Ok (x, array_from_slice a n x) // TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = @@ -598,16 +598,16 @@ let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v // Helper let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = - if i < length v then Return (index v i) else Fail Failure + if i < length v then Ok (index v i) else Fail Failure // Helper let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = - if i < length v then Return (list_update v i x) else Fail Failure + if i < length v then Ok (list_update v i x) else Fail Failure let alloc_vec_Vec_index_mut_usize (#a : Type0) (v: alloc_vec_Vec a) (i: usize) : result (a & (a → result (alloc_vec_Vec a))) = match alloc_vec_Vec_index_usize v i with - | Return x -> - Return (x, alloc_vec_Vec_update_usize v i) + | Ok x -> + Ok (x, alloc_vec_Vec_update_usize v i) | Fail e -> Fail e let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : @@ -616,17 +616,17 @@ let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : (ensures (fun res -> match res with | Fail e -> e == Failure - | Return v' -> length v' = length v + 1)) = + | Ok v' -> length v' = length v + 1)) = if length v < usize_max then begin (**) assert_norm(length [x] == 1); (**) append_length v [x]; (**) assert(length (append v [x]) = length v + 1); - Return (append v [x]) + Ok (append v [x]) end else Fail Failure let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = - if i < length v then Return (list_update v i x) else Fail Failure + if i < length v then Ok (list_update v i x) else Fail Failure // Trait declaration: [core::slice::index::private_slice_index::Sealed] type core_slice_index_private_slice_index_Sealed (self : Type0) = unit @@ -650,7 +650,7 @@ let core_slice_index_Slice_index let* x = inst.get i s in match x with | None -> Fail Failure - | Some x -> Return x + | Some x -> Ok x // [core::slice::index::Range:::get]: forward function let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : diff --git a/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst b/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst index 129e6f7e..8e64f43f 100644 --- a/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst +++ b/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst @@ -41,19 +41,19 @@ let betree_store_leaf_node (** [betree_main::betree::fresh_node_id]: Source: 'src/betree.rs', lines 55:0-55:48 *) let betree_fresh_node_id (counter : u64) : result (u64 & u64) = - let* counter1 = u64_add counter 1 in Return (counter, counter1) + let* counter1 = u64_add counter 1 in Ok (counter, counter1) (** [betree_main::betree::{betree_main::betree::NodeIdCounter}::new]: Source: 'src/betree.rs', lines 206:4-206:20 *) let betree_NodeIdCounter_new : result betree_NodeIdCounter_t = - Return { next_node_id = 0 } + Ok { next_node_id = 0 } (** [betree_main::betree::{betree_main::betree::NodeIdCounter}::fresh_id]: Source: 'src/betree.rs', lines 210:4-210:36 *) let betree_NodeIdCounter_fresh_id (self : betree_NodeIdCounter_t) : result (u64 & betree_NodeIdCounter_t) = let* i = u64_add self.next_node_id 1 in - Return (self.next_node_id, { next_node_id = i }) + Ok (self.next_node_id, { next_node_id = i }) (** [betree_main::betree::upsert_update]: Source: 'src/betree.rs', lines 234:0-234:70 *) @@ -62,16 +62,16 @@ let betree_upsert_update begin match prev with | None -> begin match st with - | Betree_UpsertFunState_Add v -> Return v - | Betree_UpsertFunState_Sub _ -> Return 0 + | Betree_UpsertFunState_Add v -> Ok v + | Betree_UpsertFunState_Sub _ -> Ok 0 end | Some prev1 -> begin match st with | Betree_UpsertFunState_Add v -> let* margin = u64_sub core_u64_max prev1 in - if margin >= v then u64_add prev1 v else Return core_u64_max + if margin >= v then u64_add prev1 v else Ok core_u64_max | Betree_UpsertFunState_Sub v -> - if prev1 >= v then u64_sub prev1 v else Return 0 + if prev1 >= v then u64_sub prev1 v else Ok 0 end end @@ -83,7 +83,7 @@ let rec betree_List_len = begin match self with | Betree_List_Cons _ tl -> let* i = betree_List_len t tl in u64_add 1 i - | Betree_List_Nil -> Return 0 + | Betree_List_Nil -> Ok 0 end (** [betree_main::betree::{betree_main::betree::List#1}::split_at]: @@ -94,14 +94,14 @@ let rec betree_List_split_at (decreases (betree_List_split_at_decreases t self n)) = if n = 0 - then Return (Betree_List_Nil, self) + then Ok (Betree_List_Nil, self) else begin match self with | Betree_List_Cons hd tl -> let* i = u64_sub n 1 in let* p = betree_List_split_at t tl i in let (ls0, ls1) = p in - Return (Betree_List_Cons hd ls0, ls1) + Ok (Betree_List_Cons hd ls0, ls1) | Betree_List_Nil -> Fail Failure end @@ -110,7 +110,7 @@ let rec betree_List_split_at let betree_List_push_front (t : Type0) (self : betree_List_t t) (x : t) : result (betree_List_t t) = let (tl, _) = core_mem_replace (betree_List_t t) self Betree_List_Nil in - Return (Betree_List_Cons x tl) + Ok (Betree_List_Cons x tl) (** [betree_main::betree::{betree_main::betree::List#1}::pop_front]: Source: 'src/betree.rs', lines 306:4-306:32 *) @@ -118,7 +118,7 @@ let betree_List_pop_front (t : Type0) (self : betree_List_t t) : result (t & (betree_List_t t)) = let (ls, _) = core_mem_replace (betree_List_t t) self Betree_List_Nil in begin match ls with - | Betree_List_Cons x tl -> Return (x, tl) + | Betree_List_Cons x tl -> Ok (x, tl) | Betree_List_Nil -> Fail Failure end @@ -126,7 +126,7 @@ let betree_List_pop_front Source: 'src/betree.rs', lines 318:4-318:22 *) let betree_List_hd (t : Type0) (self : betree_List_t t) : result t = begin match self with - | Betree_List_Cons hd _ -> Return hd + | Betree_List_Cons hd _ -> Ok hd | Betree_List_Nil -> Fail Failure end @@ -135,8 +135,8 @@ let betree_List_hd (t : Type0) (self : betree_List_t t) : result t = let betree_ListPairU64T_head_has_key (t : Type0) (self : betree_List_t (u64 & t)) (key : u64) : result bool = begin match self with - | Betree_List_Cons hd _ -> let (i, _) = hd in Return (i = key) - | Betree_List_Nil -> Return false + | Betree_List_Cons hd _ -> let (i, _) = hd in Ok (i = key) + | Betree_List_Nil -> Ok false end (** [betree_main::betree::{betree_main::betree::List<(u64, T)>#2}::partition_at_pivot]: @@ -150,12 +150,12 @@ let rec betree_ListPairU64T_partition_at_pivot | Betree_List_Cons hd tl -> let (i, x) = hd in if i >= pivot - then Return (Betree_List_Nil, Betree_List_Cons (i, x) tl) + then Ok (Betree_List_Nil, Betree_List_Cons (i, x) tl) else let* p = betree_ListPairU64T_partition_at_pivot t tl pivot in let (ls0, ls1) = p in - Return (Betree_List_Cons (i, x) ls0, ls1) - | Betree_List_Nil -> Return (Betree_List_Nil, Betree_List_Nil) + Ok (Betree_List_Cons (i, x) ls0, ls1) + | Betree_List_Nil -> Ok (Betree_List_Nil, Betree_List_Nil) end (** [betree_main::betree::{betree_main::betree::Leaf#3}::split]: @@ -176,7 +176,7 @@ let betree_Leaf_split let* (st2, _) = betree_store_leaf_node id1 content1 st1 in let n = Betree_Node_Leaf { id = id0; size = params.split_size } in let n1 = Betree_Node_Leaf { id = id1; size = params.split_size } in - Return (st2, ({ id = self.id; pivot = pivot; left = n; right = n1 }, + Ok (st2, ({ id = self.id; pivot = pivot; left = n; right = n1 }, node_id_cnt2)) (** [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_for_key]: @@ -191,16 +191,16 @@ let rec betree_Node_lookup_first_message_for_key | Betree_List_Cons x next_msgs -> let (i, m) = x in if i >= key - then Return (Betree_List_Cons (i, m) next_msgs, Return) + then Ok (Betree_List_Cons (i, m) next_msgs, Ok) else let* (l, lookup_first_message_for_key_back) = betree_Node_lookup_first_message_for_key key next_msgs in let back = fun ret -> let* next_msgs1 = lookup_first_message_for_key_back ret in - Return (Betree_List_Cons (i, m) next_msgs1) in - Return (l, back) - | Betree_List_Nil -> Return (Betree_List_Nil, Return) + Ok (Betree_List_Cons (i, m) next_msgs1) in + Ok (l, back) + | Betree_List_Nil -> Ok (Betree_List_Nil, Ok) end (** [betree_main::betree::{betree_main::betree::Node#5}::lookup_in_bindings]: @@ -214,9 +214,9 @@ let rec betree_Node_lookup_in_bindings | Betree_List_Cons hd tl -> let (i, i1) = hd in if i = key - then Return (Some i1) - else if i > key then Return None else betree_Node_lookup_in_bindings key tl - | Betree_List_Nil -> Return None + then Ok (Some i1) + else if i > key then Ok None else betree_Node_lookup_in_bindings key tl + | Betree_List_Nil -> Ok None end (** [betree_main::betree::{betree_main::betree::Node#5}::apply_upserts]: @@ -244,7 +244,7 @@ let rec betree_Node_apply_upserts let* msgs1 = betree_List_push_front (u64 & betree_Message_t) msgs (key, Betree_Message_Insert v) in - Return (st1, (v, msgs1)) + Ok (st1, (v, msgs1)) (** [betree_main::betree::{betree_main::betree::Internal#4}::lookup_in_children]: Source: 'src/betree.rs', lines 395:4-395:63 *) @@ -256,10 +256,10 @@ let rec betree_Internal_lookup_in_children if key < self.pivot then let* (st1, (o, n)) = betree_Node_lookup self.left key st in - Return (st1, (o, { self with left = n })) + Ok (st1, (o, { self with left = n })) else let* (st1, (o, n)) = betree_Node_lookup self.right key st in - Return (st1, (o, { self with right = n })) + Ok (st1, (o, { self with right = n })) (** [betree_main::betree::{betree_main::betree::Node#5}::lookup]: Source: 'src/betree.rs', lines 709:4-709:58 *) @@ -282,19 +282,19 @@ and betree_Node_lookup betree_Internal_lookup_in_children node key st1 in let* _ = lookup_first_message_for_key_back (Betree_List_Cons (k, msg) l) in - Return (st2, (o, Betree_Node_Internal node1)) + Ok (st2, (o, Betree_Node_Internal node1)) else begin match msg with | Betree_Message_Insert v -> let* _ = lookup_first_message_for_key_back (Betree_List_Cons (k, Betree_Message_Insert v) l) in - Return (st1, (Some v, Betree_Node_Internal node)) + Ok (st1, (Some v, Betree_Node_Internal node)) | Betree_Message_Delete -> let* _ = lookup_first_message_for_key_back (Betree_List_Cons (k, Betree_Message_Delete) l) in - Return (st1, (None, Betree_Node_Internal node)) + Ok (st1, (None, Betree_Node_Internal node)) | Betree_Message_Upsert ufs -> let* (st2, (v, node1)) = betree_Internal_lookup_in_children node key st1 in @@ -303,18 +303,18 @@ and betree_Node_lookup Betree_Message_Upsert ufs) l) v key st2 in let* msgs1 = lookup_first_message_for_key_back pending1 in let* (st4, _) = betree_store_internal_node node1.id msgs1 st3 in - Return (st4, (Some v1, Betree_Node_Internal node1)) + Ok (st4, (Some v1, Betree_Node_Internal node1)) end | Betree_List_Nil -> let* (st2, (o, node1)) = betree_Internal_lookup_in_children node key st1 in let* _ = lookup_first_message_for_key_back Betree_List_Nil in - Return (st2, (o, Betree_Node_Internal node1)) + Ok (st2, (o, Betree_Node_Internal node1)) end | Betree_Node_Leaf node -> let* (st1, bindings) = betree_load_leaf_node node.id st in let* o = betree_Node_lookup_in_bindings key bindings in - Return (st1, (o, Betree_Node_Leaf node)) + Ok (st1, (o, Betree_Node_Leaf node)) end (** [betree_main::betree::{betree_main::betree::Node#5}::filter_messages_for_key]: @@ -333,8 +333,8 @@ let rec betree_Node_filter_messages_for_key betree_List_pop_front (u64 & betree_Message_t) (Betree_List_Cons (k, m) l) in betree_Node_filter_messages_for_key key msgs1 - else Return (Betree_List_Cons (k, m) l) - | Betree_List_Nil -> Return Betree_List_Nil + else Ok (Betree_List_Cons (k, m) l) + | Betree_List_Nil -> Ok Betree_List_Nil end (** [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_after_key]: @@ -355,10 +355,10 @@ let rec betree_Node_lookup_first_message_after_key let back = fun ret -> let* next_msgs1 = lookup_first_message_after_key_back ret in - Return (Betree_List_Cons (k, m) next_msgs1) in - Return (l, back) - else Return (Betree_List_Cons (k, m) next_msgs, Return) - | Betree_List_Nil -> Return (Betree_List_Nil, Return) + Ok (Betree_List_Cons (k, m) next_msgs1) in + Ok (l, back) + else Ok (Betree_List_Cons (k, m) next_msgs, Ok) + | Betree_List_Nil -> Ok (Betree_List_Nil, Ok) end (** [betree_main::betree::{betree_main::betree::Node#5}::apply_to_internal]: @@ -434,7 +434,7 @@ let rec betree_Node_apply_messages_to_internal let (i, m) = new_msg in let* msgs1 = betree_Node_apply_to_internal msgs i m in betree_Node_apply_messages_to_internal msgs1 new_msgs_tl - | Betree_List_Nil -> Return msgs + | Betree_List_Nil -> Ok msgs end (** [betree_main::betree::{betree_main::betree::Node#5}::lookup_mut_in_bindings]: @@ -449,16 +449,16 @@ let rec betree_Node_lookup_mut_in_bindings | Betree_List_Cons hd tl -> let (i, i1) = hd in if i >= key - then Return (Betree_List_Cons (i, i1) tl, Return) + then Ok (Betree_List_Cons (i, i1) tl, Ok) else let* (l, lookup_mut_in_bindings_back) = betree_Node_lookup_mut_in_bindings key tl in let back = fun ret -> let* tl1 = lookup_mut_in_bindings_back ret in - Return (Betree_List_Cons (i, i1) tl1) in - Return (l, back) - | Betree_List_Nil -> Return (Betree_List_Nil, Return) + Ok (Betree_List_Cons (i, i1) tl1) in + Ok (l, back) + | Betree_List_Nil -> Ok (Betree_List_Nil, Ok) end (** [betree_main::betree::{betree_main::betree::Node#5}::apply_to_leaf]: @@ -510,7 +510,7 @@ let rec betree_Node_apply_messages_to_leaf let (i, m) = new_msg in let* bindings1 = betree_Node_apply_to_leaf bindings i m in betree_Node_apply_messages_to_leaf bindings1 new_msgs_tl - | Betree_List_Nil -> Return bindings + | Betree_List_Nil -> Ok bindings end (** [betree_main::betree::{betree_main::betree::Internal#4}::flush]: @@ -541,14 +541,14 @@ let rec betree_Internal_flush betree_Node_apply_messages self.right params node_id_cnt1 msgs_right st1 in let (n1, node_id_cnt2) = p2 in - Return (st2, (Betree_List_Nil, ({ self with left = n; right = n1 }, + Ok (st2, (Betree_List_Nil, ({ self with left = n; right = n1 }, node_id_cnt2))) - else Return (st1, (msgs_right, ({ self with left = n }, node_id_cnt1))) + else Ok (st1, (msgs_right, ({ self with left = n }, node_id_cnt1))) else let* (st1, p1) = betree_Node_apply_messages self.right params node_id_cnt msgs_right st in let (n, node_id_cnt1) = p1 in - Return (st1, (msgs_left, ({ self with right = n }, node_id_cnt1))) + Ok (st1, (msgs_left, ({ self with right = n }, node_id_cnt1))) (** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages]: Source: 'src/betree.rs', lines 588:4-593:5 *) @@ -571,10 +571,10 @@ and betree_Node_apply_messages betree_Internal_flush node params node_id_cnt content1 st1 in let (node1, node_id_cnt1) = p in let* (st3, _) = betree_store_internal_node node1.id content2 st2 in - Return (st3, (Betree_Node_Internal node1, node_id_cnt1)) + Ok (st3, (Betree_Node_Internal node1, node_id_cnt1)) else let* (st2, _) = betree_store_internal_node node.id content1 st1 in - Return (st2, (Betree_Node_Internal node, node_id_cnt)) + Ok (st2, (Betree_Node_Internal node, node_id_cnt)) | Betree_Node_Leaf node -> let* (st1, content) = betree_load_leaf_node node.id st in let* content1 = betree_Node_apply_messages_to_leaf content msgs in @@ -585,10 +585,10 @@ and betree_Node_apply_messages let* (st2, (new_node, node_id_cnt1)) = betree_Leaf_split node content1 params node_id_cnt st1 in let* (st3, _) = betree_store_leaf_node node.id Betree_List_Nil st2 in - Return (st3, (Betree_Node_Internal new_node, node_id_cnt1)) + Ok (st3, (Betree_Node_Internal new_node, node_id_cnt1)) else let* (st2, _) = betree_store_leaf_node node.id content1 st1 in - Return (st2, (Betree_Node_Leaf { node with size = len }, node_id_cnt)) + Ok (st2, (Betree_Node_Leaf { node with size = len }, node_id_cnt)) end (** [betree_main::betree::{betree_main::betree::Node#5}::apply]: @@ -603,7 +603,7 @@ let betree_Node_apply betree_Node_apply_messages self params node_id_cnt (Betree_List_Cons (key, new_msg) Betree_List_Nil) st in let (self1, node_id_cnt1) = p in - Return (st1, (self1, node_id_cnt1)) + Ok (st1, (self1, node_id_cnt1)) (** [betree_main::betree::{betree_main::betree::BeTree#6}::new]: Source: 'src/betree.rs', lines 849:4-849:60 *) @@ -614,7 +614,7 @@ let betree_BeTree_new let* node_id_cnt = betree_NodeIdCounter_new in let* (id, node_id_cnt1) = betree_NodeIdCounter_fresh_id node_id_cnt in let* (st1, _) = betree_store_leaf_node id Betree_List_Nil st in - Return (st1, + Ok (st1, { params = { min_flush_size = min_flush_size; split_size = split_size }; node_id_cnt = node_id_cnt1; @@ -630,7 +630,7 @@ let betree_BeTree_apply let* (st1, p) = betree_Node_apply self.root self.params self.node_id_cnt key msg st in let (n, nic) = p in - Return (st1, { self with node_id_cnt = nic; root = n }) + Ok (st1, { self with node_id_cnt = nic; root = n }) (** [betree_main::betree::{betree_main::betree::BeTree#6}::insert]: Source: 'src/betree.rs', lines 874:4-874:52 *) @@ -664,13 +664,13 @@ let betree_BeTree_lookup result (state & ((option u64) & betree_BeTree_t)) = let* (st1, (o, n)) = betree_Node_lookup self.root key st in - Return (st1, (o, { self with root = n })) + Ok (st1, (o, { self with root = n })) (** [betree_main::main]: Source: 'src/betree_main.rs', lines 5:0-5:9 *) let main : result unit = - Return () + Ok () (** Unit test for [betree_main::main] *) -let _ = assert_norm (main = Return ()) +let _ = assert_norm (main = Ok ()) diff --git a/tests/fstar/betree_back_stateful/Primitives.fst b/tests/fstar/betree_back_stateful/Primitives.fst index fca80829..acdb09dc 100644 --- a/tests/fstar/betree_back_stateful/Primitives.fst +++ b/tests/fstar/betree_back_stateful/Primitives.fst @@ -23,11 +23,11 @@ type error : Type0 = | OutOfFuel type result (a : Type0) : Type0 = -| Return : v:a -> result a +| Ok : v:a -> result a | Fail : e:error -> result a // Monadic return operator -unfold let return (#a : Type0) (x : a) : result a = Return x +unfold let return (#a : Type0) (x : a) : result a = Ok x // Monadic bind operator. // Allows to use the notation: @@ -36,17 +36,17 @@ unfold let return (#a : Type0) (x : a) : result a = Return x // ... // ``` unfold let (let*) (#a #b : Type0) (m: result a) - (f: (x:a) -> Pure (result b) (requires (m == Return x)) (ensures fun _ -> True)) : + (f: (x:a) -> Pure (result b) (requires (m == Ok x)) (ensures fun _ -> True)) : result b = match m with - | Return x -> f x + | Ok x -> f x | Fail e -> Fail e // Monadic assert(...) -let massert (b:bool) : result unit = if b then Return () else Fail Failure +let massert (b:bool) : result unit = if b then Ok () else Fail Failure // Normalize and unwrap a successful result (used for globals). -let eval_global (#a : Type0) (x : result a{Return? (normalize_term x)}) : a = Return?.v x +let eval_global (#a : Type0) (x : result a{Ok? (normalize_term x)}) : a = Ok?.v x (*** Misc *) type char = FStar.Char.char @@ -144,7 +144,7 @@ let scalar_max (ty : scalar_ty) : int = type scalar (ty : scalar_ty) : eqtype = x:int{scalar_min ty <= x && x <= scalar_max ty} let mk_scalar (ty : scalar_ty) (x : int) : result (scalar ty) = - if scalar_min ty <= x && scalar_max ty >= x then Return x else Fail Failure + if scalar_min ty <= x && scalar_max ty >= x then Ok x else Fail Failure let scalar_neg (#ty : scalar_ty) (x : scalar ty) : result (scalar ty) = mk_scalar ty (-x) @@ -498,9 +498,9 @@ type core_ops_range_Range (a : Type0) = { (*** [alloc] *) -let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Ok x let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result (t & (t -> result t)) = - Return (x, (fun x -> Return x)) + Ok (x, (fun x -> Ok x)) // Trait instance let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { @@ -528,20 +528,20 @@ let mk_array (a : Type0) (n : usize) l let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = - if i < length x then Return (index x i) + if i < length x then Ok (index x i) else Fail Failure let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = - if i < length x then Return (list_update x i nx) + if i < length x then Ok (list_update x i nx) else Fail Failure let array_index_mut_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result (a & (a -> result (array a n))) = match array_index_usize a n x i with | Fail e -> Fail e - | Return v -> - Return (v, array_update_usize a n x i) + | Ok v -> + Ok (v, array_update_usize a n x i) (*** Slice *) type slice (a : Type0) = s:list a{length s <= usize_max} @@ -549,30 +549,30 @@ type slice (a : Type0) = s:list a{length s <= usize_max} let slice_len (a : Type0) (s : slice a) : usize = length s let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = - if i < length x then Return (index x i) + if i < length x then Ok (index x i) else Fail Failure let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = - if i < length x then Return (list_update x i nx) + if i < length x then Ok (list_update x i nx) else Fail Failure let slice_index_mut_usize (a : Type0) (s : slice a) (i : usize) : result (a & (a -> result (slice a))) = match slice_index_usize a s i with | Fail e -> Fail e - | Return x -> - Return (x, slice_update_usize a s i) + | Ok x -> + Ok (x, slice_update_usize a s i) (*** Subslices *) -let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Ok x let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = - if length s = n then Return s + if length s = n then Ok s else Fail Failure let array_to_slice_mut (a : Type0) (n : usize) (x : array a n) : result (slice a & (slice a -> result (array a n))) = - Return (x, array_from_slice a n x) + Ok (x, array_from_slice a n x) // TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = @@ -598,16 +598,16 @@ let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v // Helper let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = - if i < length v then Return (index v i) else Fail Failure + if i < length v then Ok (index v i) else Fail Failure // Helper let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = - if i < length v then Return (list_update v i x) else Fail Failure + if i < length v then Ok (list_update v i x) else Fail Failure let alloc_vec_Vec_index_mut_usize (#a : Type0) (v: alloc_vec_Vec a) (i: usize) : result (a & (a → result (alloc_vec_Vec a))) = match alloc_vec_Vec_index_usize v i with - | Return x -> - Return (x, alloc_vec_Vec_update_usize v i) + | Ok x -> + Ok (x, alloc_vec_Vec_update_usize v i) | Fail e -> Fail e let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : @@ -616,17 +616,17 @@ let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : (ensures (fun res -> match res with | Fail e -> e == Failure - | Return v' -> length v' = length v + 1)) = + | Ok v' -> length v' = length v + 1)) = if length v < usize_max then begin (**) assert_norm(length [x] == 1); (**) append_length v [x]; (**) assert(length (append v [x]) = length v + 1); - Return (append v [x]) + Ok (append v [x]) end else Fail Failure let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = - if i < length v then Return (list_update v i x) else Fail Failure + if i < length v then Ok (list_update v i x) else Fail Failure // Trait declaration: [core::slice::index::private_slice_index::Sealed] type core_slice_index_private_slice_index_Sealed (self : Type0) = unit @@ -650,7 +650,7 @@ let core_slice_index_Slice_index let* x = inst.get i s in match x with | None -> Fail Failure - | Some x -> Return x + | Some x -> Ok x // [core::slice::index::Range:::get]: forward function let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : diff --git a/tests/fstar/demo/Demo.fst b/tests/fstar/demo/Demo.fst index 9c59ab9b..b210662f 100644 --- a/tests/fstar/demo/Demo.fst +++ b/tests/fstar/demo/Demo.fst @@ -10,8 +10,8 @@ open Primitives let choose (t : Type0) (b : bool) (x : t) (y : t) : result (t & (t -> result (t & t))) = if b - then let back = fun ret -> Return (ret, y) in Return (x, back) - else let back = fun ret -> Return (x, ret) in Return (y, back) + then let back = fun ret -> Ok (ret, y) in Ok (x, back) + else let back = fun ret -> Ok (x, ret) in Ok (y, back) (** [demo::mul2_add1]: Source: 'src/demo.rs', lines 13:0-13:31 *) @@ -31,7 +31,7 @@ let incr (x : u32) : result u32 = (** [demo::use_incr]: Source: 'src/demo.rs', lines 25:0-25:17 *) let use_incr : result unit = - let* x = incr 0 in let* x1 = incr x in let* _ = incr x1 in Return () + let* x = incr 0 in let* x1 = incr x in let* _ = incr x1 in Ok () (** [demo::CList] Source: 'src/demo.rs', lines 34:0-34:17 *) @@ -48,7 +48,7 @@ let rec list_nth (t : Type0) (n : nat) (l : cList_t t) (i : u32) : result t = let n1 = decrease n in begin match l with | CList_CCons x tl -> - if i = 0 then Return x else let* i1 = u32_sub i 1 in list_nth t n1 tl i1 + if i = 0 then Ok x else let* i1 = u32_sub i 1 in list_nth t n1 tl i1 | CList_CNil -> Fail Failure end @@ -65,15 +65,14 @@ let rec list_nth_mut begin match l with | CList_CCons x tl -> if i = 0 - then - let back = fun ret -> Return (CList_CCons ret tl) in Return (x, back) + then let back = fun ret -> Ok (CList_CCons ret tl) in Ok (x, back) else let* i1 = u32_sub i 1 in let* (x1, list_nth_mut_back) = list_nth_mut t n1 tl i1 in let back = - fun ret -> - let* tl1 = list_nth_mut_back ret in Return (CList_CCons x tl1) in - Return (x1, back) + fun ret -> let* tl1 = list_nth_mut_back ret in Ok (CList_CCons x tl1) + in + Ok (x1, back) | CList_CNil -> Fail Failure end @@ -90,14 +89,12 @@ let rec list_nth_mut1_loop begin match l with | CList_CCons x tl -> if i = 0 - then - let back = fun ret -> Return (CList_CCons ret tl) in Return (x, back) + then let back = fun ret -> Ok (CList_CCons ret tl) in Ok (x, back) else let* i1 = u32_sub i 1 in let* (x1, back) = list_nth_mut1_loop t n1 tl i1 in - let back1 = - fun ret -> let* tl1 = back ret in Return (CList_CCons x tl1) in - Return (x1, back1) + let back1 = fun ret -> let* tl1 = back ret in Ok (CList_CCons x tl1) in + Ok (x1, back1) | CList_CNil -> Fail Failure end @@ -117,7 +114,7 @@ let rec i32_id (n : nat) (i : i32) : result i32 = else let n1 = decrease n in if i = 0 - then Return 0 + then Ok 0 else let* i1 = i32_sub i 1 in let* i2 = i32_id n1 i1 in i32_add i2 1 (** [demo::list_tail]: @@ -134,10 +131,9 @@ let rec list_tail | CList_CCons x tl -> let* (c, list_tail_back) = list_tail t n1 tl in let back = - fun ret -> let* tl1 = list_tail_back ret in Return (CList_CCons x tl1) - in - Return (c, back) - | CList_CNil -> Return (CList_CNil, Return) + fun ret -> let* tl1 = list_tail_back ret in Ok (CList_CCons x tl1) in + Ok (c, back) + | CList_CNil -> Ok (CList_CNil, Ok) end (** Trait declaration: [demo::Counter] @@ -147,7 +143,7 @@ noeq type counter_t (self : Type0) = { incr : self -> result (usize & self); } (** [demo::{(demo::Counter for usize)}::incr]: Source: 'src/demo.rs', lines 102:4-102:31 *) let counterUsize_incr (self : usize) : result (usize & usize) = - let* self1 = usize_add self 1 in Return (self, self1) + let* self1 = usize_add self 1 in Ok (self, self1) (** Trait implementation: [demo::{(demo::Counter for usize)}] Source: 'src/demo.rs', lines 101:0-101:22 *) diff --git a/tests/fstar/demo/Primitives.fst b/tests/fstar/demo/Primitives.fst index fca80829..acdb09dc 100644 --- a/tests/fstar/demo/Primitives.fst +++ b/tests/fstar/demo/Primitives.fst @@ -23,11 +23,11 @@ type error : Type0 = | OutOfFuel type result (a : Type0) : Type0 = -| Return : v:a -> result a +| Ok : v:a -> result a | Fail : e:error -> result a // Monadic return operator -unfold let return (#a : Type0) (x : a) : result a = Return x +unfold let return (#a : Type0) (x : a) : result a = Ok x // Monadic bind operator. // Allows to use the notation: @@ -36,17 +36,17 @@ unfold let return (#a : Type0) (x : a) : result a = Return x // ... // ``` unfold let (let*) (#a #b : Type0) (m: result a) - (f: (x:a) -> Pure (result b) (requires (m == Return x)) (ensures fun _ -> True)) : + (f: (x:a) -> Pure (result b) (requires (m == Ok x)) (ensures fun _ -> True)) : result b = match m with - | Return x -> f x + | Ok x -> f x | Fail e -> Fail e // Monadic assert(...) -let massert (b:bool) : result unit = if b then Return () else Fail Failure +let massert (b:bool) : result unit = if b then Ok () else Fail Failure // Normalize and unwrap a successful result (used for globals). -let eval_global (#a : Type0) (x : result a{Return? (normalize_term x)}) : a = Return?.v x +let eval_global (#a : Type0) (x : result a{Ok? (normalize_term x)}) : a = Ok?.v x (*** Misc *) type char = FStar.Char.char @@ -144,7 +144,7 @@ let scalar_max (ty : scalar_ty) : int = type scalar (ty : scalar_ty) : eqtype = x:int{scalar_min ty <= x && x <= scalar_max ty} let mk_scalar (ty : scalar_ty) (x : int) : result (scalar ty) = - if scalar_min ty <= x && scalar_max ty >= x then Return x else Fail Failure + if scalar_min ty <= x && scalar_max ty >= x then Ok x else Fail Failure let scalar_neg (#ty : scalar_ty) (x : scalar ty) : result (scalar ty) = mk_scalar ty (-x) @@ -498,9 +498,9 @@ type core_ops_range_Range (a : Type0) = { (*** [alloc] *) -let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Ok x let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result (t & (t -> result t)) = - Return (x, (fun x -> Return x)) + Ok (x, (fun x -> Ok x)) // Trait instance let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { @@ -528,20 +528,20 @@ let mk_array (a : Type0) (n : usize) l let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = - if i < length x then Return (index x i) + if i < length x then Ok (index x i) else Fail Failure let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = - if i < length x then Return (list_update x i nx) + if i < length x then Ok (list_update x i nx) else Fail Failure let array_index_mut_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result (a & (a -> result (array a n))) = match array_index_usize a n x i with | Fail e -> Fail e - | Return v -> - Return (v, array_update_usize a n x i) + | Ok v -> + Ok (v, array_update_usize a n x i) (*** Slice *) type slice (a : Type0) = s:list a{length s <= usize_max} @@ -549,30 +549,30 @@ type slice (a : Type0) = s:list a{length s <= usize_max} let slice_len (a : Type0) (s : slice a) : usize = length s let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = - if i < length x then Return (index x i) + if i < length x then Ok (index x i) else Fail Failure let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = - if i < length x then Return (list_update x i nx) + if i < length x then Ok (list_update x i nx) else Fail Failure let slice_index_mut_usize (a : Type0) (s : slice a) (i : usize) : result (a & (a -> result (slice a))) = match slice_index_usize a s i with | Fail e -> Fail e - | Return x -> - Return (x, slice_update_usize a s i) + | Ok x -> + Ok (x, slice_update_usize a s i) (*** Subslices *) -let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Ok x let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = - if length s = n then Return s + if length s = n then Ok s else Fail Failure let array_to_slice_mut (a : Type0) (n : usize) (x : array a n) : result (slice a & (slice a -> result (array a n))) = - Return (x, array_from_slice a n x) + Ok (x, array_from_slice a n x) // TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = @@ -598,16 +598,16 @@ let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v // Helper let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = - if i < length v then Return (index v i) else Fail Failure + if i < length v then Ok (index v i) else Fail Failure // Helper let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = - if i < length v then Return (list_update v i x) else Fail Failure + if i < length v then Ok (list_update v i x) else Fail Failure let alloc_vec_Vec_index_mut_usize (#a : Type0) (v: alloc_vec_Vec a) (i: usize) : result (a & (a → result (alloc_vec_Vec a))) = match alloc_vec_Vec_index_usize v i with - | Return x -> - Return (x, alloc_vec_Vec_update_usize v i) + | Ok x -> + Ok (x, alloc_vec_Vec_update_usize v i) | Fail e -> Fail e let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : @@ -616,17 +616,17 @@ let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : (ensures (fun res -> match res with | Fail e -> e == Failure - | Return v' -> length v' = length v + 1)) = + | Ok v' -> length v' = length v + 1)) = if length v < usize_max then begin (**) assert_norm(length [x] == 1); (**) append_length v [x]; (**) assert(length (append v [x]) = length v + 1); - Return (append v [x]) + Ok (append v [x]) end else Fail Failure let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = - if i < length v then Return (list_update v i x) else Fail Failure + if i < length v then Ok (list_update v i x) else Fail Failure // Trait declaration: [core::slice::index::private_slice_index::Sealed] type core_slice_index_private_slice_index_Sealed (self : Type0) = unit @@ -650,7 +650,7 @@ let core_slice_index_Slice_index let* x = inst.get i s in match x with | None -> Fail Failure - | Some x -> Return x + | Some x -> Ok x // [core::slice::index::Range:::get]: forward function let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : diff --git a/tests/fstar/hashmap/Hashmap.Funs.fst b/tests/fstar/hashmap/Hashmap.Funs.fst index d897933a..2be587af 100644 --- a/tests/fstar/hashmap/Hashmap.Funs.fst +++ b/tests/fstar/hashmap/Hashmap.Funs.fst @@ -10,7 +10,7 @@ include Hashmap.Clauses (** [hashmap::hash_key]: Source: 'src/hashmap.rs', lines 27:0-27:32 *) let hash_key (k : usize) : result usize = - Return k + Ok k (** [hashmap::{hashmap::HashMap}::allocate_slots]: loop 0: Source: 'src/hashmap.rs', lines 50:4-56:5 *) @@ -24,7 +24,7 @@ let rec hashMap_allocate_slots_loop let* slots1 = alloc_vec_Vec_push (list_t t) slots List_Nil in let* n1 = usize_sub n 1 in hashMap_allocate_slots_loop t slots1 n1 - else Return slots + else Ok slots (** [hashmap::{hashmap::HashMap}::allocate_slots]: Source: 'src/hashmap.rs', lines 50:4-50:76 *) @@ -45,7 +45,7 @@ let hashMap_new_with_capacity in let* i = usize_mul capacity max_load_dividend in let* i1 = usize_div i max_load_divisor in - Return + Ok { num_entries = 0; max_load_factor = (max_load_dividend, max_load_divisor); @@ -74,18 +74,18 @@ let rec hashMap_clear_loop let* i2 = usize_add i 1 in let* slots1 = index_mut_back List_Nil in hashMap_clear_loop t slots1 i2 - else Return slots + else Ok slots (** [hashmap::{hashmap::HashMap}::clear]: Source: 'src/hashmap.rs', lines 80:4-80:27 *) let hashMap_clear (t : Type0) (self : hashMap_t t) : result (hashMap_t t) = let* hm = hashMap_clear_loop t self.slots 0 in - Return { self with num_entries = 0; slots = hm } + Ok { self with num_entries = 0; slots = hm } (** [hashmap::{hashmap::HashMap}::len]: Source: 'src/hashmap.rs', lines 90:4-90:30 *) let hashMap_len (t : Type0) (self : hashMap_t t) : result usize = - Return self.num_entries + Ok self.num_entries (** [hashmap::{hashmap::HashMap}::insert_in_list]: loop 0: Source: 'src/hashmap.rs', lines 97:4-114:5 *) @@ -97,11 +97,11 @@ let rec hashMap_insert_in_list_loop begin match ls with | List_Cons ckey cvalue tl -> if ckey = key - then Return (false, List_Cons ckey value tl) + then Ok (false, List_Cons ckey value tl) else let* (b, tl1) = hashMap_insert_in_list_loop t key value tl in - Return (b, List_Cons ckey cvalue tl1) - | List_Nil -> Return (true, List_Cons key value List_Nil) + Ok (b, List_Cons ckey cvalue tl1) + | List_Nil -> Ok (true, List_Cons key value List_Nil) end (** [hashmap::{hashmap::HashMap}::insert_in_list]: @@ -130,8 +130,8 @@ let hashMap_insert_no_resize then let* i1 = usize_add self.num_entries 1 in let* v = index_mut_back l1 in - Return { self with num_entries = i1; slots = v } - else let* v = index_mut_back l1 in Return { self with slots = v } + Ok { self with num_entries = i1; slots = v } + else let* v = index_mut_back l1 in Ok { self with slots = v } (** [hashmap::{hashmap::HashMap}::move_elements_from_list]: loop 0: Source: 'src/hashmap.rs', lines 183:4-196:5 *) @@ -144,7 +144,7 @@ let rec hashMap_move_elements_from_list_loop | List_Cons k v tl -> let* ntable1 = hashMap_insert_no_resize t ntable k v in hashMap_move_elements_from_list_loop t ntable1 tl - | List_Nil -> Return ntable + | List_Nil -> Ok ntable end (** [hashmap::{hashmap::HashMap}::move_elements_from_list]: @@ -172,7 +172,7 @@ let rec hashMap_move_elements_loop let* i2 = usize_add i 1 in let* slots1 = index_mut_back l1 in hashMap_move_elements_loop t ntable1 slots1 i2 - else Return (ntable, slots) + else Ok (ntable, slots) (** [hashmap::{hashmap::HashMap}::move_elements]: Source: 'src/hashmap.rs', lines 171:4-171:95 *) @@ -198,10 +198,10 @@ let hashMap_try_resize let* ntable = hashMap_new_with_capacity t i3 i i1 in let* p = hashMap_move_elements t ntable self.slots 0 in let (ntable1, _) = p in - Return + Ok { ntable1 with num_entries = self.num_entries; max_load_factor = (i, i1) } - else Return { self with max_load_factor = (i, i1) } + else Ok { self with max_load_factor = (i, i1) } (** [hashmap::{hashmap::HashMap}::insert]: Source: 'src/hashmap.rs', lines 129:4-129:48 *) @@ -211,7 +211,7 @@ let hashMap_insert = let* self1 = hashMap_insert_no_resize t self key value in let* i = hashMap_len t self1 in - if i > self1.max_load then hashMap_try_resize t self1 else Return self1 + if i > self1.max_load then hashMap_try_resize t self1 else Ok self1 (** [hashmap::{hashmap::HashMap}::contains_key_in_list]: loop 0: Source: 'src/hashmap.rs', lines 206:4-219:5 *) @@ -222,10 +222,8 @@ let rec hashMap_contains_key_in_list_loop = begin match ls with | List_Cons ckey _ tl -> - if ckey = key - then Return true - else hashMap_contains_key_in_list_loop t key tl - | List_Nil -> Return false + if ckey = key then Ok true else hashMap_contains_key_in_list_loop t key tl + | List_Nil -> Ok false end (** [hashmap::{hashmap::HashMap}::contains_key_in_list]: @@ -255,7 +253,7 @@ let rec hashMap_get_in_list_loop = begin match ls with | List_Cons ckey cvalue tl -> - if ckey = key then Return cvalue else hashMap_get_in_list_loop t key tl + if ckey = key then Ok cvalue else hashMap_get_in_list_loop t key tl | List_Nil -> Fail Failure end @@ -286,14 +284,12 @@ let rec hashMap_get_mut_in_list_loop begin match ls with | List_Cons ckey cvalue tl -> if ckey = key - then - let back = fun ret -> Return (List_Cons ckey ret tl) in - Return (cvalue, back) + then let back = fun ret -> Ok (List_Cons ckey ret tl) in Ok (cvalue, back) else let* (x, back) = hashMap_get_mut_in_list_loop t tl key in let back1 = - fun ret -> let* tl1 = back ret in Return (List_Cons ckey cvalue tl1) in - Return (x, back1) + fun ret -> let* tl1 = back ret in Ok (List_Cons ckey cvalue tl1) in + Ok (x, back1) | List_Nil -> Fail Failure end @@ -323,8 +319,8 @@ let hashMap_get_mut fun ret -> let* l1 = get_mut_in_list_back ret in let* v = index_mut_back l1 in - Return { self with slots = v } in - Return (x, back) + Ok { self with slots = v } in + Ok (x, back) (** [hashmap::{hashmap::HashMap}::remove_from_list]: loop 0: Source: 'src/hashmap.rs', lines 265:4-291:5 *) @@ -340,13 +336,13 @@ let rec hashMap_remove_from_list_loop let (mv_ls, _) = core_mem_replace (list_t t) (List_Cons ckey x tl) List_Nil in begin match mv_ls with - | List_Cons _ cvalue tl1 -> Return (Some cvalue, tl1) + | List_Cons _ cvalue tl1 -> Ok (Some cvalue, tl1) | List_Nil -> Fail Failure end else let* (o, tl1) = hashMap_remove_from_list_loop t key tl in - Return (o, List_Cons ckey x tl1) - | List_Nil -> Return (None, List_Nil) + Ok (o, List_Cons ckey x tl1) + | List_Nil -> Ok (None, List_Nil) end (** [hashmap::{hashmap::HashMap}::remove_from_list]: @@ -372,12 +368,11 @@ let hashMap_remove hash_mod in let* (x, l1) = hashMap_remove_from_list t key l in begin match x with - | None -> - let* v = index_mut_back l1 in Return (None, { self with slots = v }) + | None -> let* v = index_mut_back l1 in Ok (None, { self with slots = v }) | Some x1 -> let* i1 = usize_sub self.num_entries 1 in let* v = index_mut_back l1 in - Return (Some x1, { self with num_entries = i1; slots = v }) + Ok (Some x1, { self with num_entries = i1; slots = v }) end (** [hashmap::test1]: @@ -414,6 +409,6 @@ let test1 : result unit = then Fail Failure else let* i4 = hashMap_get u64 hm6 1056 in - if not (i4 = 256) then Fail Failure else Return () + if not (i4 = 256) then Fail Failure else Ok () end diff --git a/tests/fstar/hashmap/Primitives.fst b/tests/fstar/hashmap/Primitives.fst index fca80829..acdb09dc 100644 --- a/tests/fstar/hashmap/Primitives.fst +++ b/tests/fstar/hashmap/Primitives.fst @@ -23,11 +23,11 @@ type error : Type0 = | OutOfFuel type result (a : Type0) : Type0 = -| Return : v:a -> result a +| Ok : v:a -> result a | Fail : e:error -> result a // Monadic return operator -unfold let return (#a : Type0) (x : a) : result a = Return x +unfold let return (#a : Type0) (x : a) : result a = Ok x // Monadic bind operator. // Allows to use the notation: @@ -36,17 +36,17 @@ unfold let return (#a : Type0) (x : a) : result a = Return x // ... // ``` unfold let (let*) (#a #b : Type0) (m: result a) - (f: (x:a) -> Pure (result b) (requires (m == Return x)) (ensures fun _ -> True)) : + (f: (x:a) -> Pure (result b) (requires (m == Ok x)) (ensures fun _ -> True)) : result b = match m with - | Return x -> f x + | Ok x -> f x | Fail e -> Fail e // Monadic assert(...) -let massert (b:bool) : result unit = if b then Return () else Fail Failure +let massert (b:bool) : result unit = if b then Ok () else Fail Failure // Normalize and unwrap a successful result (used for globals). -let eval_global (#a : Type0) (x : result a{Return? (normalize_term x)}) : a = Return?.v x +let eval_global (#a : Type0) (x : result a{Ok? (normalize_term x)}) : a = Ok?.v x (*** Misc *) type char = FStar.Char.char @@ -144,7 +144,7 @@ let scalar_max (ty : scalar_ty) : int = type scalar (ty : scalar_ty) : eqtype = x:int{scalar_min ty <= x && x <= scalar_max ty} let mk_scalar (ty : scalar_ty) (x : int) : result (scalar ty) = - if scalar_min ty <= x && scalar_max ty >= x then Return x else Fail Failure + if scalar_min ty <= x && scalar_max ty >= x then Ok x else Fail Failure let scalar_neg (#ty : scalar_ty) (x : scalar ty) : result (scalar ty) = mk_scalar ty (-x) @@ -498,9 +498,9 @@ type core_ops_range_Range (a : Type0) = { (*** [alloc] *) -let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Ok x let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result (t & (t -> result t)) = - Return (x, (fun x -> Return x)) + Ok (x, (fun x -> Ok x)) // Trait instance let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { @@ -528,20 +528,20 @@ let mk_array (a : Type0) (n : usize) l let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = - if i < length x then Return (index x i) + if i < length x then Ok (index x i) else Fail Failure let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = - if i < length x then Return (list_update x i nx) + if i < length x then Ok (list_update x i nx) else Fail Failure let array_index_mut_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result (a & (a -> result (array a n))) = match array_index_usize a n x i with | Fail e -> Fail e - | Return v -> - Return (v, array_update_usize a n x i) + | Ok v -> + Ok (v, array_update_usize a n x i) (*** Slice *) type slice (a : Type0) = s:list a{length s <= usize_max} @@ -549,30 +549,30 @@ type slice (a : Type0) = s:list a{length s <= usize_max} let slice_len (a : Type0) (s : slice a) : usize = length s let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = - if i < length x then Return (index x i) + if i < length x then Ok (index x i) else Fail Failure let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = - if i < length x then Return (list_update x i nx) + if i < length x then Ok (list_update x i nx) else Fail Failure let slice_index_mut_usize (a : Type0) (s : slice a) (i : usize) : result (a & (a -> result (slice a))) = match slice_index_usize a s i with | Fail e -> Fail e - | Return x -> - Return (x, slice_update_usize a s i) + | Ok x -> + Ok (x, slice_update_usize a s i) (*** Subslices *) -let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Ok x let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = - if length s = n then Return s + if length s = n then Ok s else Fail Failure let array_to_slice_mut (a : Type0) (n : usize) (x : array a n) : result (slice a & (slice a -> result (array a n))) = - Return (x, array_from_slice a n x) + Ok (x, array_from_slice a n x) // TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = @@ -598,16 +598,16 @@ let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v // Helper let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = - if i < length v then Return (index v i) else Fail Failure + if i < length v then Ok (index v i) else Fail Failure // Helper let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = - if i < length v then Return (list_update v i x) else Fail Failure + if i < length v then Ok (list_update v i x) else Fail Failure let alloc_vec_Vec_index_mut_usize (#a : Type0) (v: alloc_vec_Vec a) (i: usize) : result (a & (a → result (alloc_vec_Vec a))) = match alloc_vec_Vec_index_usize v i with - | Return x -> - Return (x, alloc_vec_Vec_update_usize v i) + | Ok x -> + Ok (x, alloc_vec_Vec_update_usize v i) | Fail e -> Fail e let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : @@ -616,17 +616,17 @@ let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : (ensures (fun res -> match res with | Fail e -> e == Failure - | Return v' -> length v' = length v + 1)) = + | Ok v' -> length v' = length v + 1)) = if length v < usize_max then begin (**) assert_norm(length [x] == 1); (**) append_length v [x]; (**) assert(length (append v [x]) = length v + 1); - Return (append v [x]) + Ok (append v [x]) end else Fail Failure let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = - if i < length v then Return (list_update v i x) else Fail Failure + if i < length v then Ok (list_update v i x) else Fail Failure // Trait declaration: [core::slice::index::private_slice_index::Sealed] type core_slice_index_private_slice_index_Sealed (self : Type0) = unit @@ -650,7 +650,7 @@ let core_slice_index_Slice_index let* x = inst.get i s in match x with | None -> Fail Failure - | Some x -> Return x + | Some x -> Ok x // [core::slice::index::Range:::get]: forward function let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : diff --git a/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst b/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst index e0005c81..ff86e087 100644 --- a/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst +++ b/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst @@ -11,7 +11,7 @@ include HashmapMain.Clauses (** [hashmap_main::hashmap::hash_key]: Source: 'src/hashmap.rs', lines 27:0-27:32 *) let hashmap_hash_key (k : usize) : result usize = - Return k + Ok k (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::allocate_slots]: loop 0: Source: 'src/hashmap.rs', lines 50:4-56:5 *) @@ -26,7 +26,7 @@ let rec hashmap_HashMap_allocate_slots_loop in let* n1 = usize_sub n 1 in hashmap_HashMap_allocate_slots_loop t slots1 n1 - else Return slots + else Ok slots (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::allocate_slots]: Source: 'src/hashmap.rs', lines 50:4-50:76 *) @@ -48,7 +48,7 @@ let hashmap_HashMap_new_with_capacity capacity in let* i = usize_mul capacity max_load_dividend in let* i1 = usize_div i max_load_divisor in - Return + Ok { num_entries = 0; max_load_factor = (max_load_dividend, max_load_divisor); @@ -78,20 +78,20 @@ let rec hashmap_HashMap_clear_loop let* i2 = usize_add i 1 in let* slots1 = index_mut_back Hashmap_List_Nil in hashmap_HashMap_clear_loop t slots1 i2 - else Return slots + else Ok slots (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::clear]: Source: 'src/hashmap.rs', lines 80:4-80:27 *) let hashmap_HashMap_clear (t : Type0) (self : hashmap_HashMap_t t) : result (hashmap_HashMap_t t) = let* hm = hashmap_HashMap_clear_loop t self.slots 0 in - Return { self with num_entries = 0; slots = hm } + Ok { self with num_entries = 0; slots = hm } (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::len]: Source: 'src/hashmap.rs', lines 90:4-90:30 *) let hashmap_HashMap_len (t : Type0) (self : hashmap_HashMap_t t) : result usize = - Return self.num_entries + Ok self.num_entries (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: loop 0: Source: 'src/hashmap.rs', lines 97:4-114:5 *) @@ -103,12 +103,11 @@ let rec hashmap_HashMap_insert_in_list_loop begin match ls with | Hashmap_List_Cons ckey cvalue tl -> if ckey = key - then Return (false, Hashmap_List_Cons ckey value tl) + then Ok (false, Hashmap_List_Cons ckey value tl) else let* (b, tl1) = hashmap_HashMap_insert_in_list_loop t key value tl in - Return (b, Hashmap_List_Cons ckey cvalue tl1) - | Hashmap_List_Nil -> - Return (true, Hashmap_List_Cons key value Hashmap_List_Nil) + Ok (b, Hashmap_List_Cons ckey cvalue tl1) + | Hashmap_List_Nil -> Ok (true, Hashmap_List_Cons key value Hashmap_List_Nil) end (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: @@ -137,8 +136,8 @@ let hashmap_HashMap_insert_no_resize then let* i1 = usize_add self.num_entries 1 in let* v = index_mut_back l1 in - Return { self with num_entries = i1; slots = v } - else let* v = index_mut_back l1 in Return { self with slots = v } + Ok { self with num_entries = i1; slots = v } + else let* v = index_mut_back l1 in Ok { self with slots = v } (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements_from_list]: loop 0: Source: 'src/hashmap.rs', lines 183:4-196:5 *) @@ -152,7 +151,7 @@ let rec hashmap_HashMap_move_elements_from_list_loop | Hashmap_List_Cons k v tl -> let* ntable1 = hashmap_HashMap_insert_no_resize t ntable k v in hashmap_HashMap_move_elements_from_list_loop t ntable1 tl - | Hashmap_List_Nil -> Return ntable + | Hashmap_List_Nil -> Ok ntable end (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements_from_list]: @@ -183,7 +182,7 @@ let rec hashmap_HashMap_move_elements_loop let* i2 = usize_add i 1 in let* slots1 = index_mut_back l1 in hashmap_HashMap_move_elements_loop t ntable1 slots1 i2 - else Return (ntable, slots) + else Ok (ntable, slots) (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements]: Source: 'src/hashmap.rs', lines 171:4-171:95 *) @@ -209,10 +208,10 @@ let hashmap_HashMap_try_resize let* ntable = hashmap_HashMap_new_with_capacity t i3 i i1 in let* p = hashmap_HashMap_move_elements t ntable self.slots 0 in let (ntable1, _) = p in - Return + Ok { ntable1 with num_entries = self.num_entries; max_load_factor = (i, i1) } - else Return { self with max_load_factor = (i, i1) } + else Ok { self with max_load_factor = (i, i1) } (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert]: Source: 'src/hashmap.rs', lines 129:4-129:48 *) @@ -222,9 +221,7 @@ let hashmap_HashMap_insert = let* self1 = hashmap_HashMap_insert_no_resize t self key value in let* i = hashmap_HashMap_len t self1 in - if i > self1.max_load - then hashmap_HashMap_try_resize t self1 - else Return self1 + if i > self1.max_load then hashmap_HashMap_try_resize t self1 else Ok self1 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key_in_list]: loop 0: Source: 'src/hashmap.rs', lines 206:4-219:5 *) @@ -236,9 +233,9 @@ let rec hashmap_HashMap_contains_key_in_list_loop begin match ls with | Hashmap_List_Cons ckey _ tl -> if ckey = key - then Return true + then Ok true else hashmap_HashMap_contains_key_in_list_loop t key tl - | Hashmap_List_Nil -> Return false + | Hashmap_List_Nil -> Ok false end (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key_in_list]: @@ -269,9 +266,7 @@ let rec hashmap_HashMap_get_in_list_loop = begin match ls with | Hashmap_List_Cons ckey cvalue tl -> - if ckey = key - then Return cvalue - else hashmap_HashMap_get_in_list_loop t key tl + if ckey = key then Ok cvalue else hashmap_HashMap_get_in_list_loop t key tl | Hashmap_List_Nil -> Fail Failure end @@ -305,14 +300,14 @@ let rec hashmap_HashMap_get_mut_in_list_loop | Hashmap_List_Cons ckey cvalue tl -> if ckey = key then - let back = fun ret -> Return (Hashmap_List_Cons ckey ret tl) in - Return (cvalue, back) + let back = fun ret -> Ok (Hashmap_List_Cons ckey ret tl) in + Ok (cvalue, back) else let* (x, back) = hashmap_HashMap_get_mut_in_list_loop t tl key in let back1 = fun ret -> - let* tl1 = back ret in Return (Hashmap_List_Cons ckey cvalue tl1) in - Return (x, back1) + let* tl1 = back ret in Ok (Hashmap_List_Cons ckey cvalue tl1) in + Ok (x, back1) | Hashmap_List_Nil -> Fail Failure end @@ -342,8 +337,8 @@ let hashmap_HashMap_get_mut fun ret -> let* l1 = get_mut_in_list_back ret in let* v = index_mut_back l1 in - Return { self with slots = v } in - Return (x, back) + Ok { self with slots = v } in + Ok (x, back) (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: loop 0: Source: 'src/hashmap.rs', lines 265:4-291:5 *) @@ -360,13 +355,13 @@ let rec hashmap_HashMap_remove_from_list_loop core_mem_replace (hashmap_List_t t) (Hashmap_List_Cons ckey x tl) Hashmap_List_Nil in begin match mv_ls with - | Hashmap_List_Cons _ cvalue tl1 -> Return (Some cvalue, tl1) + | Hashmap_List_Cons _ cvalue tl1 -> Ok (Some cvalue, tl1) | Hashmap_List_Nil -> Fail Failure end else let* (o, tl1) = hashmap_HashMap_remove_from_list_loop t key tl in - Return (o, Hashmap_List_Cons ckey x tl1) - | Hashmap_List_Nil -> Return (None, Hashmap_List_Nil) + Ok (o, Hashmap_List_Cons ckey x tl1) + | Hashmap_List_Nil -> Ok (None, Hashmap_List_Nil) end (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: @@ -392,12 +387,11 @@ let hashmap_HashMap_remove self.slots hash_mod in let* (x, l1) = hashmap_HashMap_remove_from_list t key l in begin match x with - | None -> - let* v = index_mut_back l1 in Return (None, { self with slots = v }) + | None -> let* v = index_mut_back l1 in Ok (None, { self with slots = v }) | Some x1 -> let* i1 = usize_sub self.num_entries 1 in let* v = index_mut_back l1 in - Return (Some x1, { self with num_entries = i1; slots = v }) + Ok (Some x1, { self with num_entries = i1; slots = v }) end (** [hashmap_main::hashmap::test1]: @@ -434,7 +428,7 @@ let hashmap_test1 : result unit = then Fail Failure else let* i4 = hashmap_HashMap_get u64 hm6 1056 in - if not (i4 = 256) then Fail Failure else Return () + if not (i4 = 256) then Fail Failure else Ok () end (** [hashmap_main::insert_on_disk]: @@ -448,5 +442,5 @@ let insert_on_disk (** [hashmap_main::main]: Source: 'src/hashmap_main.rs', lines 16:0-16:13 *) let main : result unit = - Return () + Ok () diff --git a/tests/fstar/hashmap_on_disk/Primitives.fst b/tests/fstar/hashmap_on_disk/Primitives.fst index fca80829..acdb09dc 100644 --- a/tests/fstar/hashmap_on_disk/Primitives.fst +++ b/tests/fstar/hashmap_on_disk/Primitives.fst @@ -23,11 +23,11 @@ type error : Type0 = | OutOfFuel type result (a : Type0) : Type0 = -| Return : v:a -> result a +| Ok : v:a -> result a | Fail : e:error -> result a // Monadic return operator -unfold let return (#a : Type0) (x : a) : result a = Return x +unfold let return (#a : Type0) (x : a) : result a = Ok x // Monadic bind operator. // Allows to use the notation: @@ -36,17 +36,17 @@ unfold let return (#a : Type0) (x : a) : result a = Return x // ... // ``` unfold let (let*) (#a #b : Type0) (m: result a) - (f: (x:a) -> Pure (result b) (requires (m == Return x)) (ensures fun _ -> True)) : + (f: (x:a) -> Pure (result b) (requires (m == Ok x)) (ensures fun _ -> True)) : result b = match m with - | Return x -> f x + | Ok x -> f x | Fail e -> Fail e // Monadic assert(...) -let massert (b:bool) : result unit = if b then Return () else Fail Failure +let massert (b:bool) : result unit = if b then Ok () else Fail Failure // Normalize and unwrap a successful result (used for globals). -let eval_global (#a : Type0) (x : result a{Return? (normalize_term x)}) : a = Return?.v x +let eval_global (#a : Type0) (x : result a{Ok? (normalize_term x)}) : a = Ok?.v x (*** Misc *) type char = FStar.Char.char @@ -144,7 +144,7 @@ let scalar_max (ty : scalar_ty) : int = type scalar (ty : scalar_ty) : eqtype = x:int{scalar_min ty <= x && x <= scalar_max ty} let mk_scalar (ty : scalar_ty) (x : int) : result (scalar ty) = - if scalar_min ty <= x && scalar_max ty >= x then Return x else Fail Failure + if scalar_min ty <= x && scalar_max ty >= x then Ok x else Fail Failure let scalar_neg (#ty : scalar_ty) (x : scalar ty) : result (scalar ty) = mk_scalar ty (-x) @@ -498,9 +498,9 @@ type core_ops_range_Range (a : Type0) = { (*** [alloc] *) -let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Ok x let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result (t & (t -> result t)) = - Return (x, (fun x -> Return x)) + Ok (x, (fun x -> Ok x)) // Trait instance let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { @@ -528,20 +528,20 @@ let mk_array (a : Type0) (n : usize) l let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = - if i < length x then Return (index x i) + if i < length x then Ok (index x i) else Fail Failure let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = - if i < length x then Return (list_update x i nx) + if i < length x then Ok (list_update x i nx) else Fail Failure let array_index_mut_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result (a & (a -> result (array a n))) = match array_index_usize a n x i with | Fail e -> Fail e - | Return v -> - Return (v, array_update_usize a n x i) + | Ok v -> + Ok (v, array_update_usize a n x i) (*** Slice *) type slice (a : Type0) = s:list a{length s <= usize_max} @@ -549,30 +549,30 @@ type slice (a : Type0) = s:list a{length s <= usize_max} let slice_len (a : Type0) (s : slice a) : usize = length s let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = - if i < length x then Return (index x i) + if i < length x then Ok (index x i) else Fail Failure let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = - if i < length x then Return (list_update x i nx) + if i < length x then Ok (list_update x i nx) else Fail Failure let slice_index_mut_usize (a : Type0) (s : slice a) (i : usize) : result (a & (a -> result (slice a))) = match slice_index_usize a s i with | Fail e -> Fail e - | Return x -> - Return (x, slice_update_usize a s i) + | Ok x -> + Ok (x, slice_update_usize a s i) (*** Subslices *) -let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Ok x let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = - if length s = n then Return s + if length s = n then Ok s else Fail Failure let array_to_slice_mut (a : Type0) (n : usize) (x : array a n) : result (slice a & (slice a -> result (array a n))) = - Return (x, array_from_slice a n x) + Ok (x, array_from_slice a n x) // TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = @@ -598,16 +598,16 @@ let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v // Helper let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = - if i < length v then Return (index v i) else Fail Failure + if i < length v then Ok (index v i) else Fail Failure // Helper let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = - if i < length v then Return (list_update v i x) else Fail Failure + if i < length v then Ok (list_update v i x) else Fail Failure let alloc_vec_Vec_index_mut_usize (#a : Type0) (v: alloc_vec_Vec a) (i: usize) : result (a & (a → result (alloc_vec_Vec a))) = match alloc_vec_Vec_index_usize v i with - | Return x -> - Return (x, alloc_vec_Vec_update_usize v i) + | Ok x -> + Ok (x, alloc_vec_Vec_update_usize v i) | Fail e -> Fail e let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : @@ -616,17 +616,17 @@ let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : (ensures (fun res -> match res with | Fail e -> e == Failure - | Return v' -> length v' = length v + 1)) = + | Ok v' -> length v' = length v + 1)) = if length v < usize_max then begin (**) assert_norm(length [x] == 1); (**) append_length v [x]; (**) assert(length (append v [x]) = length v + 1); - Return (append v [x]) + Ok (append v [x]) end else Fail Failure let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = - if i < length v then Return (list_update v i x) else Fail Failure + if i < length v then Ok (list_update v i x) else Fail Failure // Trait declaration: [core::slice::index::private_slice_index::Sealed] type core_slice_index_private_slice_index_Sealed (self : Type0) = unit @@ -650,7 +650,7 @@ let core_slice_index_Slice_index let* x = inst.get i s in match x with | None -> Fail Failure - | Some x -> Return x + | Some x -> Ok x // [core::slice::index::Range:::get]: forward function let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : diff --git a/tests/fstar/misc/Bitwise.fst b/tests/fstar/misc/Bitwise.fst index 7330f07a..11ef6861 100644 --- a/tests/fstar/misc/Bitwise.fst +++ b/tests/fstar/misc/Bitwise.fst @@ -18,15 +18,15 @@ let shift_i32 (a : i32) : result i32 = (** [bitwise::xor_u32]: Source: 'src/bitwise.rs', lines 17:0-17:37 *) let xor_u32 (a : u32) (b : u32) : result u32 = - Return (u32_xor a b) + Ok (u32_xor a b) (** [bitwise::or_u32]: Source: 'src/bitwise.rs', lines 21:0-21:36 *) let or_u32 (a : u32) (b : u32) : result u32 = - Return (u32_or a b) + Ok (u32_or a b) (** [bitwise::and_u32]: Source: 'src/bitwise.rs', lines 25:0-25:37 *) let and_u32 (a : u32) (b : u32) : result u32 = - Return (u32_and a b) + Ok (u32_and a b) diff --git a/tests/fstar/misc/Constants.fst b/tests/fstar/misc/Constants.fst index 8d1cf3ce..4fbafb83 100644 --- a/tests/fstar/misc/Constants.fst +++ b/tests/fstar/misc/Constants.fst @@ -7,17 +7,17 @@ open Primitives (** [constants::X0] Source: 'src/constants.rs', lines 5:0-5:17 *) -let x0_body : result u32 = Return 0 +let x0_body : result u32 = Ok 0 let x0 : u32 = eval_global x0_body (** [constants::X1] Source: 'src/constants.rs', lines 7:0-7:17 *) -let x1_body : result u32 = Return core_u32_max +let x1_body : result u32 = Ok core_u32_max let x1 : u32 = eval_global x1_body (** [constants::X2] Source: 'src/constants.rs', lines 10:0-10:17 *) -let x2_body : result u32 = Return 3 +let x2_body : result u32 = Ok 3 let x2 : u32 = eval_global x2_body (** [constants::incr]: @@ -33,7 +33,7 @@ let x3 : u32 = eval_global x3_body (** [constants::mk_pair0]: Source: 'src/constants.rs', lines 23:0-23:51 *) let mk_pair0 (x : u32) (y1 : u32) : result (u32 & u32) = - Return (x, y1) + Ok (x, y1) (** [constants::Pair] Source: 'src/constants.rs', lines 36:0-36:23 *) @@ -42,7 +42,7 @@ type pair_t (t1 t2 : Type0) = { x : t1; y : t2; } (** [constants::mk_pair1]: Source: 'src/constants.rs', lines 27:0-27:55 *) let mk_pair1 (x : u32) (y1 : u32) : result (pair_t u32 u32) = - Return { x = x; y = y1 } + Ok { x = x; y = y1 } (** [constants::P0] Source: 'src/constants.rs', lines 31:0-31:24 *) @@ -56,12 +56,12 @@ let p1 : pair_t u32 u32 = eval_global p1_body (** [constants::P2] Source: 'src/constants.rs', lines 33:0-33:24 *) -let p2_body : result (u32 & u32) = Return (0, 1) +let p2_body : result (u32 & u32) = Ok (0, 1) let p2 : (u32 & u32) = eval_global p2_body (** [constants::P3] Source: 'src/constants.rs', lines 34:0-34:28 *) -let p3_body : result (pair_t u32 u32) = Return { x = 0; y = 1 } +let p3_body : result (pair_t u32 u32) = Ok { x = 0; y = 1 } let p3 : pair_t u32 u32 = eval_global p3_body (** [constants::Wrap] @@ -71,7 +71,7 @@ type wrap_t (t : Type0) = { value : t; } (** [constants::{constants::Wrap}::new]: Source: 'src/constants.rs', lines 54:4-54:41 *) let wrap_new (t : Type0) (value : t) : result (wrap_t t) = - Return { value = value } + Ok { value = value } (** [constants::Y] Source: 'src/constants.rs', lines 41:0-41:22 *) @@ -81,7 +81,7 @@ let y : wrap_t i32 = eval_global y_body (** [constants::unwrap_y]: Source: 'src/constants.rs', lines 43:0-43:30 *) let unwrap_y : result i32 = - Return y.value + Ok y.value (** [constants::YVAL] Source: 'src/constants.rs', lines 47:0-47:19 *) @@ -90,13 +90,13 @@ let yval : i32 = eval_global yval_body (** [constants::get_z1::Z1] Source: 'src/constants.rs', lines 62:4-62:17 *) -let get_z1_z1_body : result i32 = Return 3 +let get_z1_z1_body : result i32 = Ok 3 let get_z1_z1 : i32 = eval_global get_z1_z1_body (** [constants::get_z1]: Source: 'src/constants.rs', lines 61:0-61:28 *) let get_z1 : result i32 = - Return get_z1_z1 + Ok get_z1_z1 (** [constants::add]: Source: 'src/constants.rs', lines 66:0-66:39 *) @@ -105,12 +105,12 @@ let add (a : i32) (b : i32) : result i32 = (** [constants::Q1] Source: 'src/constants.rs', lines 74:0-74:17 *) -let q1_body : result i32 = Return 5 +let q1_body : result i32 = Ok 5 let q1 : i32 = eval_global q1_body (** [constants::Q2] Source: 'src/constants.rs', lines 75:0-75:17 *) -let q2_body : result i32 = Return q1 +let q2_body : result i32 = Ok q1 let q2 : i32 = eval_global q2_body (** [constants::Q3] @@ -125,7 +125,7 @@ let get_z2 : result i32 = (** [constants::S1] Source: 'src/constants.rs', lines 80:0-80:18 *) -let s1_body : result u32 = Return 6 +let s1_body : result u32 = Ok 6 let s1 : u32 = eval_global s1_body (** [constants::S2] @@ -135,7 +135,7 @@ let s2 : u32 = eval_global s2_body (** [constants::S3] Source: 'src/constants.rs', lines 82:0-82:29 *) -let s3_body : result (pair_t u32 u32) = Return p3 +let s3_body : result (pair_t u32 u32) = Ok p3 let s3 : pair_t u32 u32 = eval_global s3_body (** [constants::S4] @@ -149,11 +149,11 @@ type v_t (t : Type0) (n : usize) = { x : array t n; } (** [constants::{constants::V#1}::LEN] Source: 'src/constants.rs', lines 91:4-91:24 *) -let v_len_body (t : Type0) (n : usize) : result usize = Return n +let v_len_body (t : Type0) (n : usize) : result usize = Ok n let v_len (t : Type0) (n : usize) : usize = eval_global (v_len_body t n) (** [constants::use_v]: Source: 'src/constants.rs', lines 94:0-94:42 *) let use_v (t : Type0) (n : usize) : result usize = - Return (v_len t n) + Ok (v_len t n) diff --git a/tests/fstar/misc/External.Funs.fst b/tests/fstar/misc/External.Funs.fst index 78960404..d4247b8f 100644 --- a/tests/fstar/misc/External.Funs.fst +++ b/tests/fstar/misc/External.Funs.fst @@ -22,10 +22,10 @@ let test_new_non_zero_u32 (** [external::test_vec]: Source: 'src/external.rs', lines 17:0-17:17 *) let test_vec : result unit = - let* _ = alloc_vec_Vec_push u32 (alloc_vec_Vec_new u32) 0 in Return () + let* _ = alloc_vec_Vec_push u32 (alloc_vec_Vec_new u32) 0 in Ok () (** Unit test for [external::test_vec] *) -let _ = assert_norm (test_vec = Return ()) +let _ = assert_norm (test_vec = Ok ()) (** [external::custom_swap]: Source: 'src/external.rs', lines 24:0-24:66 *) @@ -34,8 +34,8 @@ let custom_swap result (state & (t & (t -> state -> result (state & (t & t))))) = let* (st1, (x1, y1)) = core_mem_swap t x y st in - let back = fun ret st2 -> Return (st2, (ret, y1)) in - Return (st1, (x1, back)) + let back = fun ret st2 -> Ok (st2, (ret, y1)) in + Ok (st1, (x1, back)) (** [external::test_custom_swap]: Source: 'src/external.rs', lines 29:0-29:59 *) @@ -43,12 +43,12 @@ let test_custom_swap (x : u32) (y : u32) (st : state) : result (state & (u32 & u32)) = let* (st1, (_, custom_swap_back)) = custom_swap u32 x y st in let* (_, (x1, y1)) = custom_swap_back 1 st1 in - Return (st1, (x1, y1)) + Ok (st1, (x1, y1)) (** [external::test_swap_non_zero]: Source: 'src/external.rs', lines 35:0-35:44 *) let test_swap_non_zero (x : u32) (st : state) : result (state & u32) = let* (st1, p) = swap u32 x 0 st in let (x1, _) = p in - if x1 = 0 then Fail Failure else Return (st1, x1) + if x1 = 0 then Fail Failure else Ok (st1, x1) diff --git a/tests/fstar/misc/Loops.Funs.fst b/tests/fstar/misc/Loops.Funs.fst index 93683deb..26cb91d2 100644 --- a/tests/fstar/misc/Loops.Funs.fst +++ b/tests/fstar/misc/Loops.Funs.fst @@ -70,7 +70,7 @@ let rec sum_array_loop let* s1 = u32_add s i1 in let* i2 = usize_add i 1 in sum_array_loop n a i2 s1 - else Return s + else Ok s (** [loops::sum_array]: Source: 'src/loops.rs', lines 50:0-50:52 *) @@ -92,7 +92,7 @@ let rec clear_loop let* i2 = usize_add i 1 in let* v1 = index_mut_back 0 in clear_loop v1 i2 - else Return v + else Ok v (** [loops::clear]: Source: 'src/loops.rs', lines 62:0-62:30 *) @@ -106,8 +106,8 @@ let rec list_mem_loop Tot (result bool) (decreases (list_mem_loop_decreases x ls)) = begin match ls with - | List_Cons y tl -> if y = x then Return true else list_mem_loop x tl - | List_Nil -> Return false + | List_Cons y tl -> if y = x then Ok true else list_mem_loop x tl + | List_Nil -> Ok false end (** [loops::list_mem]: @@ -125,12 +125,12 @@ let rec list_nth_mut_loop_loop begin match ls with | List_Cons x tl -> if i = 0 - then let back = fun ret -> Return (List_Cons ret tl) in Return (x, back) + then let back = fun ret -> Ok (List_Cons ret tl) in Ok (x, back) else let* i1 = u32_sub i 1 in let* (x1, back) = list_nth_mut_loop_loop t tl i1 in - let back1 = fun ret -> let* tl1 = back ret in Return (List_Cons x tl1) in - Return (x1, back1) + let back1 = fun ret -> let* tl1 = back ret in Ok (List_Cons x tl1) in + Ok (x1, back1) | List_Nil -> Fail Failure end @@ -151,7 +151,7 @@ let rec list_nth_shared_loop_loop begin match ls with | List_Cons x tl -> if i = 0 - then Return x + then Ok x else let* i1 = u32_sub i 1 in list_nth_shared_loop_loop t tl i1 | List_Nil -> Fail Failure end @@ -171,11 +171,11 @@ let rec get_elem_mut_loop begin match ls with | List_Cons y tl -> if y = x - then let back = fun ret -> Return (List_Cons ret tl) in Return (y, back) + then let back = fun ret -> Ok (List_Cons ret tl) in Ok (y, back) else let* (i, back) = get_elem_mut_loop x tl in - let back1 = fun ret -> let* tl1 = back ret in Return (List_Cons y tl1) in - Return (i, back1) + let back1 = fun ret -> let* tl1 = back ret in Ok (List_Cons y tl1) in + Ok (i, back1) | List_Nil -> Fail Failure end @@ -190,7 +190,7 @@ let get_elem_mut (core_slice_index_SliceIndexUsizeSliceTInst (list_t usize)) slots 0 in let* (i, back) = get_elem_mut_loop x ls in let back1 = fun ret -> let* l = back ret in index_mut_back l in - Return (i, back1) + Ok (i, back1) (** [loops::get_elem_shared]: loop 0: Source: 'src/loops.rs', lines 129:0-143:1 *) @@ -199,7 +199,7 @@ let rec get_elem_shared_loop Tot (result usize) (decreases (get_elem_shared_loop_decreases x ls)) = begin match ls with - | List_Cons y tl -> if y = x then Return y else get_elem_shared_loop x tl + | List_Cons y tl -> if y = x then Ok y else get_elem_shared_loop x tl | List_Nil -> Fail Failure end @@ -218,12 +218,12 @@ let id_mut (t : Type0) (ls : list_t t) : result ((list_t t) & (list_t t -> result (list_t t))) = - Return (ls, Return) + Ok (ls, Ok) (** [loops::id_shared]: Source: 'src/loops.rs', lines 149:0-149:45 *) let id_shared (t : Type0) (ls : list_t t) : result (list_t t) = - Return ls + Ok ls (** [loops::list_nth_mut_loop_with_id]: loop 0: Source: 'src/loops.rs', lines 154:0-165:1 *) @@ -235,12 +235,12 @@ let rec list_nth_mut_loop_with_id_loop begin match ls with | List_Cons x tl -> if i = 0 - then let back = fun ret -> Return (List_Cons ret tl) in Return (x, back) + then let back = fun ret -> Ok (List_Cons ret tl) in Ok (x, back) else let* i1 = u32_sub i 1 in let* (x1, back) = list_nth_mut_loop_with_id_loop t i1 tl in - let back1 = fun ret -> let* tl1 = back ret in Return (List_Cons x tl1) in - Return (x1, back1) + let back1 = fun ret -> let* tl1 = back ret in Ok (List_Cons x tl1) in + Ok (x1, back1) | List_Nil -> Fail Failure end @@ -253,7 +253,7 @@ let list_nth_mut_loop_with_id let* (ls1, id_mut_back) = id_mut t ls in let* (x, back) = list_nth_mut_loop_with_id_loop t i ls1 in let back1 = fun ret -> let* l = back ret in id_mut_back l in - Return (x, back1) + Ok (x, back1) (** [loops::list_nth_shared_loop_with_id]: loop 0: Source: 'src/loops.rs', lines 168:0-179:1 *) @@ -265,7 +265,7 @@ let rec list_nth_shared_loop_with_id_loop begin match ls with | List_Cons x tl -> if i = 0 - then Return x + then Ok x else let* i1 = u32_sub i 1 in list_nth_shared_loop_with_id_loop t i1 tl | List_Nil -> Fail Failure end @@ -289,17 +289,17 @@ let rec list_nth_mut_loop_pair_loop | List_Cons x1 tl1 -> if i = 0 then - let back'a = fun ret -> Return (List_Cons ret tl0) in - let back'b = fun ret -> Return (List_Cons ret tl1) in - Return ((x0, x1), back'a, back'b) + let back'a = fun ret -> Ok (List_Cons ret tl0) in + let back'b = fun ret -> Ok (List_Cons ret tl1) in + Ok ((x0, x1), back'a, back'b) else let* i1 = u32_sub i 1 in let* (p, back'a, back'b) = list_nth_mut_loop_pair_loop t tl0 tl1 i1 in let back'a1 = - fun ret -> let* tl01 = back'a ret in Return (List_Cons x0 tl01) in + fun ret -> let* tl01 = back'a ret in Ok (List_Cons x0 tl01) in let back'b1 = - fun ret -> let* tl11 = back'b ret in Return (List_Cons x1 tl11) in - Return (p, back'a1, back'b1) + fun ret -> let* tl11 = back'b ret in Ok (List_Cons x1 tl11) in + Ok (p, back'a1, back'b1) | List_Nil -> Fail Failure end | List_Nil -> Fail Failure @@ -325,7 +325,7 @@ let rec list_nth_shared_loop_pair_loop begin match ls1 with | List_Cons x1 tl1 -> if i = 0 - then Return (x0, x1) + then Ok (x0, x1) else let* i1 = u32_sub i 1 in list_nth_shared_loop_pair_loop t tl0 tl1 i1 | List_Nil -> Fail Failure end @@ -353,16 +353,16 @@ let rec list_nth_mut_loop_pair_merge_loop then let back = fun ret -> - let (x, x2) = ret in Return (List_Cons x tl0, List_Cons x2 tl1) in - Return ((x0, x1), back) + let (x, x2) = ret in Ok (List_Cons x tl0, List_Cons x2 tl1) in + Ok ((x0, x1), back) else let* i1 = u32_sub i 1 in let* (p, back) = list_nth_mut_loop_pair_merge_loop t tl0 tl1 i1 in let back1 = fun ret -> let* (tl01, tl11) = back ret in - Return (List_Cons x0 tl01, List_Cons x1 tl11) in - Return (p, back1) + Ok (List_Cons x0 tl01, List_Cons x1 tl11) in + Ok (p, back1) | List_Nil -> Fail Failure end | List_Nil -> Fail Failure @@ -388,7 +388,7 @@ let rec list_nth_shared_loop_pair_merge_loop begin match ls1 with | List_Cons x1 tl1 -> if i = 0 - then Return (x0, x1) + then Ok (x0, x1) else let* i1 = u32_sub i 1 in list_nth_shared_loop_pair_merge_loop t tl0 tl1 i1 @@ -415,15 +415,13 @@ let rec list_nth_mut_shared_loop_pair_loop begin match ls1 with | List_Cons x1 tl1 -> if i = 0 - then - let back = fun ret -> Return (List_Cons ret tl0) in - Return ((x0, x1), back) + then let back = fun ret -> Ok (List_Cons ret tl0) in Ok ((x0, x1), back) else let* i1 = u32_sub i 1 in let* (p, back) = list_nth_mut_shared_loop_pair_loop t tl0 tl1 i1 in - let back1 = - fun ret -> let* tl01 = back ret in Return (List_Cons x0 tl01) in - Return (p, back1) + let back1 = fun ret -> let* tl01 = back ret in Ok (List_Cons x0 tl01) + in + Ok (p, back1) | List_Nil -> Fail Failure end | List_Nil -> Fail Failure @@ -449,16 +447,14 @@ let rec list_nth_mut_shared_loop_pair_merge_loop begin match ls1 with | List_Cons x1 tl1 -> if i = 0 - then - let back = fun ret -> Return (List_Cons ret tl0) in - Return ((x0, x1), back) + then let back = fun ret -> Ok (List_Cons ret tl0) in Ok ((x0, x1), back) else let* i1 = u32_sub i 1 in let* (p, back) = list_nth_mut_shared_loop_pair_merge_loop t tl0 tl1 i1 in - let back1 = - fun ret -> let* tl01 = back ret in Return (List_Cons x0 tl01) in - Return (p, back1) + let back1 = fun ret -> let* tl01 = back ret in Ok (List_Cons x0 tl01) + in + Ok (p, back1) | List_Nil -> Fail Failure end | List_Nil -> Fail Failure @@ -484,15 +480,13 @@ let rec list_nth_shared_mut_loop_pair_loop begin match ls1 with | List_Cons x1 tl1 -> if i = 0 - then - let back = fun ret -> Return (List_Cons ret tl1) in - Return ((x0, x1), back) + then let back = fun ret -> Ok (List_Cons ret tl1) in Ok ((x0, x1), back) else let* i1 = u32_sub i 1 in let* (p, back) = list_nth_shared_mut_loop_pair_loop t tl0 tl1 i1 in - let back1 = - fun ret -> let* tl11 = back ret in Return (List_Cons x1 tl11) in - Return (p, back1) + let back1 = fun ret -> let* tl11 = back ret in Ok (List_Cons x1 tl11) + in + Ok (p, back1) | List_Nil -> Fail Failure end | List_Nil -> Fail Failure @@ -518,16 +512,14 @@ let rec list_nth_shared_mut_loop_pair_merge_loop begin match ls1 with | List_Cons x1 tl1 -> if i = 0 - then - let back = fun ret -> Return (List_Cons ret tl1) in - Return ((x0, x1), back) + then let back = fun ret -> Ok (List_Cons ret tl1) in Ok ((x0, x1), back) else let* i1 = u32_sub i 1 in let* (p, back) = list_nth_shared_mut_loop_pair_merge_loop t tl0 tl1 i1 in - let back1 = - fun ret -> let* tl11 = back ret in Return (List_Cons x1 tl11) in - Return (p, back1) + let back1 = fun ret -> let* tl11 = back ret in Ok (List_Cons x1 tl11) + in + Ok (p, back1) | List_Nil -> Fail Failure end | List_Nil -> Fail Failure @@ -549,12 +541,12 @@ let rec ignore_input_mut_borrow_loop = if i > 0 then let* i1 = u32_sub i 1 in ignore_input_mut_borrow_loop i1 - else Return () + else Ok () (** [loops::ignore_input_mut_borrow]: Source: 'src/loops.rs', lines 345:0-345:56 *) let ignore_input_mut_borrow (_a : u32) (i : u32) : result u32 = - let* _ = ignore_input_mut_borrow_loop i in Return _a + let* _ = ignore_input_mut_borrow_loop i in Ok _a (** [loops::incr_ignore_input_mut_borrow]: loop 0: Source: 'src/loops.rs', lines 353:0-358:1 *) @@ -564,14 +556,14 @@ let rec incr_ignore_input_mut_borrow_loop = if i > 0 then let* i1 = u32_sub i 1 in incr_ignore_input_mut_borrow_loop i1 - else Return () + else Ok () (** [loops::incr_ignore_input_mut_borrow]: Source: 'src/loops.rs', lines 353:0-353:60 *) let incr_ignore_input_mut_borrow (a : u32) (i : u32) : result u32 = let* a1 = u32_add a 1 in let* _ = incr_ignore_input_mut_borrow_loop i in - Return a1 + Ok a1 (** [loops::ignore_input_shared_borrow]: loop 0: Source: 'src/loops.rs', lines 362:0-366:1 *) @@ -581,10 +573,10 @@ let rec ignore_input_shared_borrow_loop = if i > 0 then let* i1 = u32_sub i 1 in ignore_input_shared_borrow_loop i1 - else Return () + else Ok () (** [loops::ignore_input_shared_borrow]: Source: 'src/loops.rs', lines 362:0-362:59 *) let ignore_input_shared_borrow (_a : u32) (i : u32) : result u32 = - let* _ = ignore_input_shared_borrow_loop i in Return _a + let* _ = ignore_input_shared_borrow_loop i in Ok _a diff --git a/tests/fstar/misc/NoNestedBorrows.fst b/tests/fstar/misc/NoNestedBorrows.fst index 1a93beaa..ac443a99 100644 --- a/tests/fstar/misc/NoNestedBorrows.fst +++ b/tests/fstar/misc/NoNestedBorrows.fst @@ -151,20 +151,20 @@ let cast_bool_to_i32 (x : bool) : result i32 = (** [no_nested_borrows::cast_bool_to_bool]: Source: 'src/no_nested_borrows.rs', lines 137:0-137:41 *) let cast_bool_to_bool (x : bool) : result bool = - Return x + Ok x (** [no_nested_borrows::test2]: Source: 'src/no_nested_borrows.rs', lines 142:0-142:14 *) let test2 : result unit = - let* _ = u32_add 23 44 in Return () + let* _ = u32_add 23 44 in Ok () (** Unit test for [no_nested_borrows::test2] *) -let _ = assert_norm (test2 = Return ()) +let _ = assert_norm (test2 = Ok ()) (** [no_nested_borrows::get_max]: Source: 'src/no_nested_borrows.rs', lines 154:0-154:37 *) let get_max (x : u32) (y : u32) : result u32 = - if x >= y then Return x else Return y + if x >= y then Ok x else Ok y (** [no_nested_borrows::test3]: Source: 'src/no_nested_borrows.rs', lines 162:0-162:14 *) @@ -172,26 +172,26 @@ let test3 : result unit = let* x = get_max 4 3 in let* y = get_max 10 11 in let* z = u32_add x y in - if not (z = 15) then Fail Failure else Return () + if not (z = 15) then Fail Failure else Ok () (** Unit test for [no_nested_borrows::test3] *) -let _ = assert_norm (test3 = Return ()) +let _ = assert_norm (test3 = Ok ()) (** [no_nested_borrows::test_neg1]: Source: 'src/no_nested_borrows.rs', lines 169:0-169:18 *) let test_neg1 : result unit = - let* y = i32_neg 3 in if not (y = -3) then Fail Failure else Return () + let* y = i32_neg 3 in if not (y = -3) then Fail Failure else Ok () (** Unit test for [no_nested_borrows::test_neg1] *) -let _ = assert_norm (test_neg1 = Return ()) +let _ = assert_norm (test_neg1 = Ok ()) (** [no_nested_borrows::refs_test1]: Source: 'src/no_nested_borrows.rs', lines 176:0-176:19 *) let refs_test1 : result unit = - if not (1 = 1) then Fail Failure else Return () + if not (1 = 1) then Fail Failure else Ok () (** Unit test for [no_nested_borrows::refs_test1] *) -let _ = assert_norm (refs_test1 = Return ()) +let _ = assert_norm (refs_test1 = Ok ()) (** [no_nested_borrows::refs_test2]: Source: 'src/no_nested_borrows.rs', lines 187:0-187:19 *) @@ -204,18 +204,18 @@ let refs_test2 : result unit = else if not (2 = 2) then Fail Failure - else if not (2 = 2) then Fail Failure else Return () + else if not (2 = 2) then Fail Failure else Ok () (** Unit test for [no_nested_borrows::refs_test2] *) -let _ = assert_norm (refs_test2 = Return ()) +let _ = assert_norm (refs_test2 = Ok ()) (** [no_nested_borrows::test_list1]: Source: 'src/no_nested_borrows.rs', lines 203:0-203:19 *) let test_list1 : result unit = - Return () + Ok () (** Unit test for [no_nested_borrows::test_list1] *) -let _ = assert_norm (test_list1 = Return ()) +let _ = assert_norm (test_list1 = Ok ()) (** [no_nested_borrows::test_box1]: Source: 'src/no_nested_borrows.rs', lines 208:0-208:18 *) @@ -223,56 +223,53 @@ let test_box1 : result unit = let* (_, deref_mut_back) = alloc_boxed_Box_deref_mut i32 0 in let* b = deref_mut_back 1 in let* x = alloc_boxed_Box_deref i32 b in - if not (x = 1) then Fail Failure else Return () + if not (x = 1) then Fail Failure else Ok () (** Unit test for [no_nested_borrows::test_box1] *) -let _ = assert_norm (test_box1 = Return ()) +let _ = assert_norm (test_box1 = Ok ()) (** [no_nested_borrows::copy_int]: Source: 'src/no_nested_borrows.rs', lines 218:0-218:30 *) let copy_int (x : i32) : result i32 = - Return x + Ok x (** [no_nested_borrows::test_unreachable]: Source: 'src/no_nested_borrows.rs', lines 224:0-224:32 *) let test_unreachable (b : bool) : result unit = - if b then Fail Failure else Return () + if b then Fail Failure else Ok () (** [no_nested_borrows::test_panic]: Source: 'src/no_nested_borrows.rs', lines 232:0-232:26 *) let test_panic (b : bool) : result unit = - if b then Fail Failure else Return () + if b then Fail Failure else Ok () (** [no_nested_borrows::test_copy_int]: Source: 'src/no_nested_borrows.rs', lines 239:0-239:22 *) let test_copy_int : result unit = - let* y = copy_int 0 in if not (0 = y) then Fail Failure else Return () + let* y = copy_int 0 in if not (0 = y) then Fail Failure else Ok () (** Unit test for [no_nested_borrows::test_copy_int] *) -let _ = assert_norm (test_copy_int = Return ()) +let _ = assert_norm (test_copy_int = Ok ()) (** [no_nested_borrows::is_cons]: Source: 'src/no_nested_borrows.rs', lines 246:0-246:38 *) let is_cons (t : Type0) (l : list_t t) : result bool = - begin match l with - | List_Cons _ _ -> Return true - | List_Nil -> Return false - end + begin match l with | List_Cons _ _ -> Ok true | List_Nil -> Ok false end (** [no_nested_borrows::test_is_cons]: Source: 'src/no_nested_borrows.rs', lines 253:0-253:21 *) let test_is_cons : result unit = let* b = is_cons i32 (List_Cons 0 List_Nil) in - if not b then Fail Failure else Return () + if not b then Fail Failure else Ok () (** Unit test for [no_nested_borrows::test_is_cons] *) -let _ = assert_norm (test_is_cons = Return ()) +let _ = assert_norm (test_is_cons = Ok ()) (** [no_nested_borrows::split_list]: Source: 'src/no_nested_borrows.rs', lines 259:0-259:48 *) let split_list (t : Type0) (l : list_t t) : result (t & (list_t t)) = begin match l with - | List_Cons hd tl -> Return (hd, tl) + | List_Cons hd tl -> Ok (hd, tl) | List_Nil -> Fail Failure end @@ -281,18 +278,18 @@ let split_list (t : Type0) (l : list_t t) : result (t & (list_t t)) = let test_split_list : result unit = let* p = split_list i32 (List_Cons 0 List_Nil) in let (hd, _) = p in - if not (hd = 0) then Fail Failure else Return () + if not (hd = 0) then Fail Failure else Ok () (** Unit test for [no_nested_borrows::test_split_list] *) -let _ = assert_norm (test_split_list = Return ()) +let _ = assert_norm (test_split_list = Ok ()) (** [no_nested_borrows::choose]: Source: 'src/no_nested_borrows.rs', lines 274:0-274:70 *) let choose (t : Type0) (b : bool) (x : t) (y : t) : result (t & (t -> result (t & t))) = if b - then let back = fun ret -> Return (ret, y) in Return (x, back) - else let back = fun ret -> Return (x, ret) in Return (y, back) + then let back = fun ret -> Ok (ret, y) in Ok (x, back) + else let back = fun ret -> Ok (x, ret) in Ok (y, back) (** [no_nested_borrows::choose_test]: Source: 'src/no_nested_borrows.rs', lines 282:0-282:20 *) @@ -305,15 +302,15 @@ let choose_test : result unit = let* (x, y) = choose_back z1 in if not (x = 1) then Fail Failure - else if not (y = 0) then Fail Failure else Return () + else if not (y = 0) then Fail Failure else Ok () (** Unit test for [no_nested_borrows::choose_test] *) -let _ = assert_norm (choose_test = Return ()) +let _ = assert_norm (choose_test = Ok ()) (** [no_nested_borrows::test_char]: Source: 'src/no_nested_borrows.rs', lines 294:0-294:26 *) let test_char : result char = - Return 'a' + Ok 'a' (** [no_nested_borrows::Tree] Source: 'src/no_nested_borrows.rs', lines 299:0-299:16 *) @@ -332,7 +329,7 @@ and nodeElem_t (t : Type0) = let rec list_length (t : Type0) (l : list_t t) : result u32 = begin match l with | List_Cons _ l1 -> let* i = list_length t l1 in u32_add 1 i - | List_Nil -> Return 0 + | List_Nil -> Ok 0 end (** [no_nested_borrows::list_nth_shared]: @@ -340,9 +337,7 @@ let rec list_length (t : Type0) (l : list_t t) : result u32 = let rec list_nth_shared (t : Type0) (l : list_t t) (i : u32) : result t = begin match l with | List_Cons x tl -> - if i = 0 - then Return x - else let* i1 = u32_sub i 1 in list_nth_shared t tl i1 + if i = 0 then Ok x else let* i1 = u32_sub i 1 in list_nth_shared t tl i1 | List_Nil -> Fail Failure end @@ -355,14 +350,13 @@ let rec list_nth_mut begin match l with | List_Cons x tl -> if i = 0 - then let back = fun ret -> Return (List_Cons ret tl) in Return (x, back) + then let back = fun ret -> Ok (List_Cons ret tl) in Ok (x, back) else let* i1 = u32_sub i 1 in let* (x1, list_nth_mut_back) = list_nth_mut t tl i1 in let back = - fun ret -> let* tl1 = list_nth_mut_back ret in Return (List_Cons x tl1) - in - Return (x1, back) + fun ret -> let* tl1 = list_nth_mut_back ret in Ok (List_Cons x tl1) in + Ok (x1, back) | List_Nil -> Fail Failure end @@ -372,7 +366,7 @@ let rec list_rev_aux (t : Type0) (li : list_t t) (lo : list_t t) : result (list_t t) = begin match li with | List_Cons hd tl -> list_rev_aux t tl (List_Cons hd lo) - | List_Nil -> Return lo + | List_Nil -> Ok lo end (** [no_nested_borrows::list_rev]: @@ -413,10 +407,10 @@ let test_list_functions : result unit = then Fail Failure else let* i6 = list_nth_shared i32 ls 2 in - if not (i6 = 2) then Fail Failure else Return () + if not (i6 = 2) then Fail Failure else Ok () (** Unit test for [no_nested_borrows::test_list_functions] *) -let _ = assert_norm (test_list_functions = Return ()) +let _ = assert_norm (test_list_functions = Ok ()) (** [no_nested_borrows::id_mut_pair1]: Source: 'src/no_nested_borrows.rs', lines 414:0-414:89 *) @@ -424,7 +418,7 @@ let id_mut_pair1 (t1 t2 : Type0) (x : t1) (y : t2) : result ((t1 & t2) & ((t1 & t2) -> result (t1 & t2))) = - Return ((x, y), Return) + Ok ((x, y), Ok) (** [no_nested_borrows::id_mut_pair2]: Source: 'src/no_nested_borrows.rs', lines 418:0-418:88 *) @@ -432,7 +426,7 @@ let id_mut_pair2 (t1 t2 : Type0) (p : (t1 & t2)) : result ((t1 & t2) & ((t1 & t2) -> result (t1 & t2))) = - let (x, x1) = p in Return ((x, x1), Return) + let (x, x1) = p in Ok ((x, x1), Ok) (** [no_nested_borrows::id_mut_pair3]: Source: 'src/no_nested_borrows.rs', lines 422:0-422:93 *) @@ -440,7 +434,7 @@ let id_mut_pair3 (t1 t2 : Type0) (x : t1) (y : t2) : result ((t1 & t2) & (t1 -> result t1) & (t2 -> result t2)) = - Return ((x, y), Return, Return) + Ok ((x, y), Ok, Ok) (** [no_nested_borrows::id_mut_pair4]: Source: 'src/no_nested_borrows.rs', lines 426:0-426:92 *) @@ -448,7 +442,7 @@ let id_mut_pair4 (t1 t2 : Type0) (p : (t1 & t2)) : result ((t1 & t2) & (t1 -> result t1) & (t2 -> result t2)) = - let (x, x1) = p in Return ((x, x1), Return, Return) + let (x, x1) = p in Ok ((x, x1), Ok, Ok) (** [no_nested_borrows::StructWithTuple] Source: 'src/no_nested_borrows.rs', lines 433:0-433:34 *) @@ -457,17 +451,17 @@ type structWithTuple_t (t1 t2 : Type0) = { p : (t1 & t2); } (** [no_nested_borrows::new_tuple1]: Source: 'src/no_nested_borrows.rs', lines 437:0-437:48 *) let new_tuple1 : result (structWithTuple_t u32 u32) = - Return { p = (1, 2) } + Ok { p = (1, 2) } (** [no_nested_borrows::new_tuple2]: Source: 'src/no_nested_borrows.rs', lines 441:0-441:48 *) let new_tuple2 : result (structWithTuple_t i16 i16) = - Return { p = (1, 2) } + Ok { p = (1, 2) } (** [no_nested_borrows::new_tuple3]: Source: 'src/no_nested_borrows.rs', lines 445:0-445:48 *) let new_tuple3 : result (structWithTuple_t u64 i64) = - Return { p = (1, 2) } + Ok { p = (1, 2) } (** [no_nested_borrows::StructWithPair] Source: 'src/no_nested_borrows.rs', lines 450:0-450:33 *) @@ -476,7 +470,7 @@ type structWithPair_t (t1 t2 : Type0) = { p : pair_t t1 t2; } (** [no_nested_borrows::new_pair1]: Source: 'src/no_nested_borrows.rs', lines 454:0-454:46 *) let new_pair1 : result (structWithPair_t u32 u32) = - Return { p = { x = 1; y = 2 } } + Ok { p = { x = 1; y = 2 } } (** [no_nested_borrows::test_constants]: Source: 'src/no_nested_borrows.rs', lines 462:0-462:23 *) @@ -497,44 +491,44 @@ let test_constants : result unit = then Fail Failure else let* swp = new_pair1 in - if not (swp.p.x = 1) then Fail Failure else Return () + if not (swp.p.x = 1) then Fail Failure else Ok () (** Unit test for [no_nested_borrows::test_constants] *) -let _ = assert_norm (test_constants = Return ()) +let _ = assert_norm (test_constants = Ok ()) (** [no_nested_borrows::test_weird_borrows1]: Source: 'src/no_nested_borrows.rs', lines 471:0-471:28 *) let test_weird_borrows1 : result unit = - Return () + Ok () (** Unit test for [no_nested_borrows::test_weird_borrows1] *) -let _ = assert_norm (test_weird_borrows1 = Return ()) +let _ = assert_norm (test_weird_borrows1 = Ok ()) (** [no_nested_borrows::test_mem_replace]: Source: 'src/no_nested_borrows.rs', lines 481:0-481:37 *) let test_mem_replace (px : u32) : result u32 = let (y, _) = core_mem_replace u32 px 1 in - if not (y = 0) then Fail Failure else Return 2 + if not (y = 0) then Fail Failure else Ok 2 (** [no_nested_borrows::test_shared_borrow_bool1]: Source: 'src/no_nested_borrows.rs', lines 488:0-488:47 *) let test_shared_borrow_bool1 (b : bool) : result u32 = - if b then Return 0 else Return 1 + if b then Ok 0 else Ok 1 (** [no_nested_borrows::test_shared_borrow_bool2]: Source: 'src/no_nested_borrows.rs', lines 501:0-501:40 *) let test_shared_borrow_bool2 : result u32 = - Return 0 + Ok 0 (** [no_nested_borrows::test_shared_borrow_enum1]: Source: 'src/no_nested_borrows.rs', lines 516:0-516:52 *) let test_shared_borrow_enum1 (l : list_t u32) : result u32 = - begin match l with | List_Cons _ _ -> Return 1 | List_Nil -> Return 0 end + begin match l with | List_Cons _ _ -> Ok 1 | List_Nil -> Ok 0 end (** [no_nested_borrows::test_shared_borrow_enum2]: Source: 'src/no_nested_borrows.rs', lines 528:0-528:40 *) let test_shared_borrow_enum2 : result u32 = - Return 0 + Ok 0 (** [no_nested_borrows::incr]: Source: 'src/no_nested_borrows.rs', lines 539:0-539:24 *) @@ -549,7 +543,7 @@ let call_incr (x : u32) : result u32 = (** [no_nested_borrows::read_then_incr]: Source: 'src/no_nested_borrows.rs', lines 548:0-548:41 *) let read_then_incr (x : u32) : result (u32 & u32) = - let* x1 = u32_add x 1 in Return (x, x1) + let* x1 = u32_add x 1 in Ok (x, x1) (** [no_nested_borrows::Tuple] Source: 'src/no_nested_borrows.rs', lines 554:0-554:24 *) @@ -558,12 +552,12 @@ type tuple_t (t1 t2 : Type0) = t1 * t2 (** [no_nested_borrows::use_tuple_struct]: Source: 'src/no_nested_borrows.rs', lines 556:0-556:48 *) let use_tuple_struct (x : tuple_t u32 u32) : result (tuple_t u32 u32) = - let (_, i) = x in Return (1, i) + let (_, i) = x in Ok (1, i) (** [no_nested_borrows::create_tuple_struct]: Source: 'src/no_nested_borrows.rs', lines 560:0-560:61 *) let create_tuple_struct (x : u32) (y : u64) : result (tuple_t u32 u64) = - Return (x, y) + Ok (x, y) (** [no_nested_borrows::IdType] Source: 'src/no_nested_borrows.rs', lines 565:0-565:20 *) @@ -572,10 +566,10 @@ type idType_t (t : Type0) = t (** [no_nested_borrows::use_id_type]: Source: 'src/no_nested_borrows.rs', lines 567:0-567:40 *) let use_id_type (t : Type0) (x : idType_t t) : result t = - Return x + Ok x (** [no_nested_borrows::create_id_type]: Source: 'src/no_nested_borrows.rs', lines 571:0-571:43 *) let create_id_type (t : Type0) (x : t) : result (idType_t t) = - Return x + Ok x diff --git a/tests/fstar/misc/Paper.fst b/tests/fstar/misc/Paper.fst index c2f47ad1..e6b4eb25 100644 --- a/tests/fstar/misc/Paper.fst +++ b/tests/fstar/misc/Paper.fst @@ -13,18 +13,18 @@ let ref_incr (x : i32) : result i32 = (** [paper::test_incr]: Source: 'src/paper.rs', lines 8:0-8:18 *) let test_incr : result unit = - let* x = ref_incr 0 in if not (x = 1) then Fail Failure else Return () + let* x = ref_incr 0 in if not (x = 1) then Fail Failure else Ok () (** Unit test for [paper::test_incr] *) -let _ = assert_norm (test_incr = Return ()) +let _ = assert_norm (test_incr = Ok ()) (** [paper::choose]: Source: 'src/paper.rs', lines 15:0-15:70 *) let choose (t : Type0) (b : bool) (x : t) (y : t) : result (t & (t -> result (t & t))) = if b - then let back = fun ret -> Return (ret, y) in Return (x, back) - else let back = fun ret -> Return (x, ret) in Return (y, back) + then let back = fun ret -> Ok (ret, y) in Ok (x, back) + else let back = fun ret -> Ok (x, ret) in Ok (y, back) (** [paper::test_choose]: Source: 'src/paper.rs', lines 23:0-23:20 *) @@ -37,10 +37,10 @@ let test_choose : result unit = let* (x, y) = choose_back z1 in if not (x = 1) then Fail Failure - else if not (y = 0) then Fail Failure else Return () + else if not (y = 0) then Fail Failure else Ok () (** Unit test for [paper::test_choose] *) -let _ = assert_norm (test_choose = Return ()) +let _ = assert_norm (test_choose = Ok ()) (** [paper::List] Source: 'src/paper.rs', lines 35:0-35:16 *) @@ -57,14 +57,13 @@ let rec list_nth_mut begin match l with | List_Cons x tl -> if i = 0 - then let back = fun ret -> Return (List_Cons ret tl) in Return (x, back) + then let back = fun ret -> Ok (List_Cons ret tl) in Ok (x, back) else let* i1 = u32_sub i 1 in let* (x1, list_nth_mut_back) = list_nth_mut t tl i1 in let back = - fun ret -> let* tl1 = list_nth_mut_back ret in Return (List_Cons x tl1) - in - Return (x1, back) + fun ret -> let* tl1 = list_nth_mut_back ret in Ok (List_Cons x tl1) in + Ok (x1, back) | List_Nil -> Fail Failure end @@ -73,7 +72,7 @@ let rec list_nth_mut let rec sum (l : list_t i32) : result i32 = begin match l with | List_Cons x tl -> let* i = sum tl in i32_add x i - | List_Nil -> Return 0 + | List_Nil -> Ok 0 end (** [paper::test_nth]: @@ -85,10 +84,10 @@ let test_nth : result unit = let* x1 = i32_add x 1 in let* l2 = list_nth_mut_back x1 in let* i = sum l2 in - if not (i = 7) then Fail Failure else Return () + if not (i = 7) then Fail Failure else Ok () (** Unit test for [paper::test_nth] *) -let _ = assert_norm (test_nth = Return ()) +let _ = assert_norm (test_nth = Ok ()) (** [paper::call_choose]: Source: 'src/paper.rs', lines 76:0-76:44 *) @@ -97,5 +96,5 @@ let call_choose (p : (u32 & u32)) : result u32 = let* (pz, choose_back) = choose u32 true px py in let* pz1 = u32_add pz 1 in let* (px1, _) = choose_back pz1 in - Return px1 + Ok px1 diff --git a/tests/fstar/misc/PoloniusList.fst b/tests/fstar/misc/PoloniusList.fst index 4203247e..c0bc592e 100644 --- a/tests/fstar/misc/PoloniusList.fst +++ b/tests/fstar/misc/PoloniusList.fst @@ -20,13 +20,13 @@ let rec get_list_at_x begin match ls with | List_Cons hd tl -> if hd = x - then Return (List_Cons hd tl, Return) + then Ok (List_Cons hd tl, Ok) else let* (l, get_list_at_x_back) = get_list_at_x tl x in let back = - fun ret -> - let* tl1 = get_list_at_x_back ret in Return (List_Cons hd tl1) in - Return (l, back) - | List_Nil -> Return (List_Nil, Return) + fun ret -> let* tl1 = get_list_at_x_back ret in Ok (List_Cons hd tl1) + in + Ok (l, back) + | List_Nil -> Ok (List_Nil, Ok) end diff --git a/tests/fstar/misc/Primitives.fst b/tests/fstar/misc/Primitives.fst index fca80829..acdb09dc 100644 --- a/tests/fstar/misc/Primitives.fst +++ b/tests/fstar/misc/Primitives.fst @@ -23,11 +23,11 @@ type error : Type0 = | OutOfFuel type result (a : Type0) : Type0 = -| Return : v:a -> result a +| Ok : v:a -> result a | Fail : e:error -> result a // Monadic return operator -unfold let return (#a : Type0) (x : a) : result a = Return x +unfold let return (#a : Type0) (x : a) : result a = Ok x // Monadic bind operator. // Allows to use the notation: @@ -36,17 +36,17 @@ unfold let return (#a : Type0) (x : a) : result a = Return x // ... // ``` unfold let (let*) (#a #b : Type0) (m: result a) - (f: (x:a) -> Pure (result b) (requires (m == Return x)) (ensures fun _ -> True)) : + (f: (x:a) -> Pure (result b) (requires (m == Ok x)) (ensures fun _ -> True)) : result b = match m with - | Return x -> f x + | Ok x -> f x | Fail e -> Fail e // Monadic assert(...) -let massert (b:bool) : result unit = if b then Return () else Fail Failure +let massert (b:bool) : result unit = if b then Ok () else Fail Failure // Normalize and unwrap a successful result (used for globals). -let eval_global (#a : Type0) (x : result a{Return? (normalize_term x)}) : a = Return?.v x +let eval_global (#a : Type0) (x : result a{Ok? (normalize_term x)}) : a = Ok?.v x (*** Misc *) type char = FStar.Char.char @@ -144,7 +144,7 @@ let scalar_max (ty : scalar_ty) : int = type scalar (ty : scalar_ty) : eqtype = x:int{scalar_min ty <= x && x <= scalar_max ty} let mk_scalar (ty : scalar_ty) (x : int) : result (scalar ty) = - if scalar_min ty <= x && scalar_max ty >= x then Return x else Fail Failure + if scalar_min ty <= x && scalar_max ty >= x then Ok x else Fail Failure let scalar_neg (#ty : scalar_ty) (x : scalar ty) : result (scalar ty) = mk_scalar ty (-x) @@ -498,9 +498,9 @@ type core_ops_range_Range (a : Type0) = { (*** [alloc] *) -let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Ok x let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result (t & (t -> result t)) = - Return (x, (fun x -> Return x)) + Ok (x, (fun x -> Ok x)) // Trait instance let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { @@ -528,20 +528,20 @@ let mk_array (a : Type0) (n : usize) l let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = - if i < length x then Return (index x i) + if i < length x then Ok (index x i) else Fail Failure let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = - if i < length x then Return (list_update x i nx) + if i < length x then Ok (list_update x i nx) else Fail Failure let array_index_mut_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result (a & (a -> result (array a n))) = match array_index_usize a n x i with | Fail e -> Fail e - | Return v -> - Return (v, array_update_usize a n x i) + | Ok v -> + Ok (v, array_update_usize a n x i) (*** Slice *) type slice (a : Type0) = s:list a{length s <= usize_max} @@ -549,30 +549,30 @@ type slice (a : Type0) = s:list a{length s <= usize_max} let slice_len (a : Type0) (s : slice a) : usize = length s let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = - if i < length x then Return (index x i) + if i < length x then Ok (index x i) else Fail Failure let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = - if i < length x then Return (list_update x i nx) + if i < length x then Ok (list_update x i nx) else Fail Failure let slice_index_mut_usize (a : Type0) (s : slice a) (i : usize) : result (a & (a -> result (slice a))) = match slice_index_usize a s i with | Fail e -> Fail e - | Return x -> - Return (x, slice_update_usize a s i) + | Ok x -> + Ok (x, slice_update_usize a s i) (*** Subslices *) -let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Ok x let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = - if length s = n then Return s + if length s = n then Ok s else Fail Failure let array_to_slice_mut (a : Type0) (n : usize) (x : array a n) : result (slice a & (slice a -> result (array a n))) = - Return (x, array_from_slice a n x) + Ok (x, array_from_slice a n x) // TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = @@ -598,16 +598,16 @@ let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v // Helper let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = - if i < length v then Return (index v i) else Fail Failure + if i < length v then Ok (index v i) else Fail Failure // Helper let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = - if i < length v then Return (list_update v i x) else Fail Failure + if i < length v then Ok (list_update v i x) else Fail Failure let alloc_vec_Vec_index_mut_usize (#a : Type0) (v: alloc_vec_Vec a) (i: usize) : result (a & (a → result (alloc_vec_Vec a))) = match alloc_vec_Vec_index_usize v i with - | Return x -> - Return (x, alloc_vec_Vec_update_usize v i) + | Ok x -> + Ok (x, alloc_vec_Vec_update_usize v i) | Fail e -> Fail e let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : @@ -616,17 +616,17 @@ let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : (ensures (fun res -> match res with | Fail e -> e == Failure - | Return v' -> length v' = length v + 1)) = + | Ok v' -> length v' = length v + 1)) = if length v < usize_max then begin (**) assert_norm(length [x] == 1); (**) append_length v [x]; (**) assert(length (append v [x]) = length v + 1); - Return (append v [x]) + Ok (append v [x]) end else Fail Failure let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = - if i < length v then Return (list_update v i x) else Fail Failure + if i < length v then Ok (list_update v i x) else Fail Failure // Trait declaration: [core::slice::index::private_slice_index::Sealed] type core_slice_index_private_slice_index_Sealed (self : Type0) = unit @@ -650,7 +650,7 @@ let core_slice_index_Slice_index let* x = inst.get i s in match x with | None -> Fail Failure - | Some x -> Return x + | Some x -> Ok x // [core::slice::index::Range:::get]: forward function let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : diff --git a/tests/fstar/traits/Primitives.fst b/tests/fstar/traits/Primitives.fst index fca80829..acdb09dc 100644 --- a/tests/fstar/traits/Primitives.fst +++ b/tests/fstar/traits/Primitives.fst @@ -23,11 +23,11 @@ type error : Type0 = | OutOfFuel type result (a : Type0) : Type0 = -| Return : v:a -> result a +| Ok : v:a -> result a | Fail : e:error -> result a // Monadic return operator -unfold let return (#a : Type0) (x : a) : result a = Return x +unfold let return (#a : Type0) (x : a) : result a = Ok x // Monadic bind operator. // Allows to use the notation: @@ -36,17 +36,17 @@ unfold let return (#a : Type0) (x : a) : result a = Return x // ... // ``` unfold let (let*) (#a #b : Type0) (m: result a) - (f: (x:a) -> Pure (result b) (requires (m == Return x)) (ensures fun _ -> True)) : + (f: (x:a) -> Pure (result b) (requires (m == Ok x)) (ensures fun _ -> True)) : result b = match m with - | Return x -> f x + | Ok x -> f x | Fail e -> Fail e // Monadic assert(...) -let massert (b:bool) : result unit = if b then Return () else Fail Failure +let massert (b:bool) : result unit = if b then Ok () else Fail Failure // Normalize and unwrap a successful result (used for globals). -let eval_global (#a : Type0) (x : result a{Return? (normalize_term x)}) : a = Return?.v x +let eval_global (#a : Type0) (x : result a{Ok? (normalize_term x)}) : a = Ok?.v x (*** Misc *) type char = FStar.Char.char @@ -144,7 +144,7 @@ let scalar_max (ty : scalar_ty) : int = type scalar (ty : scalar_ty) : eqtype = x:int{scalar_min ty <= x && x <= scalar_max ty} let mk_scalar (ty : scalar_ty) (x : int) : result (scalar ty) = - if scalar_min ty <= x && scalar_max ty >= x then Return x else Fail Failure + if scalar_min ty <= x && scalar_max ty >= x then Ok x else Fail Failure let scalar_neg (#ty : scalar_ty) (x : scalar ty) : result (scalar ty) = mk_scalar ty (-x) @@ -498,9 +498,9 @@ type core_ops_range_Range (a : Type0) = { (*** [alloc] *) -let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Return x +let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Ok x let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result (t & (t -> result t)) = - Return (x, (fun x -> Return x)) + Ok (x, (fun x -> Ok x)) // Trait instance let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { @@ -528,20 +528,20 @@ let mk_array (a : Type0) (n : usize) l let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = - if i < length x then Return (index x i) + if i < length x then Ok (index x i) else Fail Failure let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : result (array a n) = - if i < length x then Return (list_update x i nx) + if i < length x then Ok (list_update x i nx) else Fail Failure let array_index_mut_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result (a & (a -> result (array a n))) = match array_index_usize a n x i with | Fail e -> Fail e - | Return v -> - Return (v, array_update_usize a n x i) + | Ok v -> + Ok (v, array_update_usize a n x i) (*** Slice *) type slice (a : Type0) = s:list a{length s <= usize_max} @@ -549,30 +549,30 @@ type slice (a : Type0) = s:list a{length s <= usize_max} let slice_len (a : Type0) (s : slice a) : usize = length s let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = - if i < length x then Return (index x i) + if i < length x then Ok (index x i) else Fail Failure let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = - if i < length x then Return (list_update x i nx) + if i < length x then Ok (list_update x i nx) else Fail Failure let slice_index_mut_usize (a : Type0) (s : slice a) (i : usize) : result (a & (a -> result (slice a))) = match slice_index_usize a s i with | Fail e -> Fail e - | Return x -> - Return (x, slice_update_usize a s i) + | Ok x -> + Ok (x, slice_update_usize a s i) (*** Subslices *) -let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Return x +let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Ok x let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = - if length s = n then Return s + if length s = n then Ok s else Fail Failure let array_to_slice_mut (a : Type0) (n : usize) (x : array a n) : result (slice a & (slice a -> result (array a n))) = - Return (x, array_from_slice a n x) + Ok (x, array_from_slice a n x) // TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = @@ -598,16 +598,16 @@ let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v // Helper let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = - if i < length v then Return (index v i) else Fail Failure + if i < length v then Ok (index v i) else Fail Failure // Helper let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = - if i < length v then Return (list_update v i x) else Fail Failure + if i < length v then Ok (list_update v i x) else Fail Failure let alloc_vec_Vec_index_mut_usize (#a : Type0) (v: alloc_vec_Vec a) (i: usize) : result (a & (a → result (alloc_vec_Vec a))) = match alloc_vec_Vec_index_usize v i with - | Return x -> - Return (x, alloc_vec_Vec_update_usize v i) + | Ok x -> + Ok (x, alloc_vec_Vec_update_usize v i) | Fail e -> Fail e let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : @@ -616,17 +616,17 @@ let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : (ensures (fun res -> match res with | Fail e -> e == Failure - | Return v' -> length v' = length v + 1)) = + | Ok v' -> length v' = length v + 1)) = if length v < usize_max then begin (**) assert_norm(length [x] == 1); (**) append_length v [x]; (**) assert(length (append v [x]) = length v + 1); - Return (append v [x]) + Ok (append v [x]) end else Fail Failure let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = - if i < length v then Return (list_update v i x) else Fail Failure + if i < length v then Ok (list_update v i x) else Fail Failure // Trait declaration: [core::slice::index::private_slice_index::Sealed] type core_slice_index_private_slice_index_Sealed (self : Type0) = unit @@ -650,7 +650,7 @@ let core_slice_index_Slice_index let* x = inst.get i s in match x with | None -> Fail Failure - | Some x -> Return x + | Some x -> Ok x // [core::slice::index::Range:::get]: forward function let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : diff --git a/tests/fstar/traits/Traits.fst b/tests/fstar/traits/Traits.fst index 199d49bf..1f0293a0 100644 --- a/tests/fstar/traits/Traits.fst +++ b/tests/fstar/traits/Traits.fst @@ -12,7 +12,7 @@ noeq type boolTrait_t (self : Type0) = { get_bool : self -> result bool; } (** [traits::{(traits::BoolTrait for bool)}::get_bool]: Source: 'src/traits.rs', lines 12:4-12:30 *) let boolTraitBool_get_bool (self : bool) : result bool = - Return self + Ok self (** Trait implementation: [traits::{(traits::BoolTrait for bool)}] Source: 'src/traits.rs', lines 11:0-11:23 *) @@ -24,18 +24,18 @@ let boolTrait_ret_true (#self : Type0) (self_clause : boolTrait_t self) (self1 : self) : result bool = - Return true + Ok true (** [traits::test_bool_trait_bool]: Source: 'src/traits.rs', lines 17:0-17:44 *) let test_bool_trait_bool (x : bool) : result bool = let* b = boolTraitBool_get_bool x in - if b then boolTrait_ret_true boolTraitBool x else Return false + if b then boolTrait_ret_true boolTraitBool x else Ok false (** [traits::{(traits::BoolTrait for core::option::Option)#1}::get_bool]: Source: 'src/traits.rs', lines 23:4-23:30 *) let boolTraitOption_get_bool (t : Type0) (self : option t) : result bool = - begin match self with | None -> Return false | Some _ -> Return true end + begin match self with | None -> Ok false | Some _ -> Ok true end (** Trait implementation: [traits::{(traits::BoolTrait for core::option::Option)#1}] Source: 'src/traits.rs', lines 22:0-22:31 *) @@ -47,7 +47,7 @@ let boolTraitOption (t : Type0) : boolTrait_t (option t) = { Source: 'src/traits.rs', lines 31:0-31:54 *) let test_bool_trait_option (t : Type0) (x : option t) : result bool = let* b = boolTraitOption_get_bool t x in - if b then boolTrait_ret_true (boolTraitOption t) x else Return false + if b then boolTrait_ret_true (boolTraitOption t) x else Ok false (** [traits::test_bool_trait]: Source: 'src/traits.rs', lines 35:0-35:50 *) @@ -62,7 +62,7 @@ noeq type toU64_t (self : Type0) = { to_u64 : self -> result u64; } (** [traits::{(traits::ToU64 for u64)#2}::to_u64]: Source: 'src/traits.rs', lines 44:4-44:26 *) let toU64U64_to_u64 (self : u64) : result u64 = - Return self + Ok self (** Trait implementation: [traits::{(traits::ToU64 for u64)#2}] Source: 'src/traits.rs', lines 43:0-43:18 *) @@ -133,7 +133,7 @@ noeq type toType_t (self t : Type0) = { to_type : self -> result t; } (** [traits::{(traits::ToType for u64)#5}::to_type]: Source: 'src/traits.rs', lines 93:4-93:28 *) let toTypeU64Bool_to_type (self : u64) : result bool = - Return (self > 0) + Ok (self > 0) (** Trait implementation: [traits::{(traits::ToType for u64)#5}] Source: 'src/traits.rs', lines 92:0-92:25 *) @@ -188,7 +188,7 @@ noeq type testType_test_TestTrait_t (self : Type0) = { Source: 'src/traits.rs', lines 139:12-139:34 *) let testType_test_TestTraittraitsTestTypetestTestType1_test (self : testType_test_TestType1_t) : result bool = - Return (self > 1) + Ok (self > 1) (** Trait implementation: [traits::{traits::TestType#6}::test::{(traits::{traits::TestType#6}::test::TestTrait for traits::{traits::TestType#6}::test::TestType1)}] Source: 'src/traits.rs', lines 138:8-138:36 *) @@ -206,7 +206,7 @@ let testType_test let* x1 = toU64Inst.to_u64 x in if x1 > 0 then testType_test_TestTraittraitsTestTypetestTestType1_test 0 - else Return false + else Ok false (** [traits::BoolWrapper] Source: 'src/traits.rs', lines 150:0-150:22 *) @@ -231,7 +231,7 @@ let toTypetraitsBoolWrapperT (t : Type0) (toTypeBoolTInst : toType_t bool t) : Source: 'src/traits.rs', lines 164:4-164:21 *) let with_const_ty_len2_default_body (self : Type0) (len : usize) : result usize = - Return 32 + Ok 32 let with_const_ty_len2_default (self : Type0) (len : usize) : usize = eval_global (with_const_ty_len2_default_body self len) @@ -248,14 +248,14 @@ noeq type withConstTy_t (self : Type0) (len : usize) = { (** [traits::{(traits::WithConstTy<32: usize> for bool)#8}::LEN1] Source: 'src/traits.rs', lines 175:4-175:21 *) -let with_const_ty_bool32_len1_body : result usize = Return 12 +let with_const_ty_bool32_len1_body : result usize = Ok 12 let with_const_ty_bool32_len1 : usize = eval_global with_const_ty_bool32_len1_body (** [traits::{(traits::WithConstTy<32: usize> for bool)#8}::f]: Source: 'src/traits.rs', lines 180:4-180:39 *) let withConstTyBool32_f (i : u64) (a : array u8 32) : result u64 = - Return i + Ok i (** Trait implementation: [traits::{(traits::WithConstTy<32: usize> for bool)#8}] Source: 'src/traits.rs', lines 174:0-174:29 *) @@ -274,7 +274,7 @@ let use_with_const_ty1 (h : Type0) (len : usize) (withConstTyInst : withConstTy_t h len) : result usize = - Return withConstTyInst.cLEN1 + Ok withConstTyInst.cLEN1 (** [traits::use_with_const_ty2]: Source: 'src/traits.rs', lines 187:0-187:73 *) @@ -283,7 +283,7 @@ let use_with_const_ty2 (w : withConstTyInst.tW) : result unit = - Return () + Ok () (** [traits::use_with_const_ty3]: Source: 'src/traits.rs', lines 189:0-189:80 *) @@ -297,7 +297,7 @@ let use_with_const_ty3 (** [traits::test_where1]: Source: 'src/traits.rs', lines 193:0-193:40 *) let test_where1 (t : Type0) (_x : t) : result unit = - Return () + Ok () (** [traits::test_where2]: Source: 'src/traits.rs', lines 194:0-194:57 *) @@ -305,7 +305,7 @@ let test_where2 (t : Type0) (withConstTyT32Inst : withConstTy_t t 32) (_x : u32) : result unit = - Return () + Ok () (** Trait declaration: [traits::ParentTrait0] Source: 'src/traits.rs', lines 200:0-200:22 *) @@ -347,7 +347,7 @@ let order1 parentTrait0_t u) : result unit = - Return () + Ok () (** Trait declaration: [traits::ChildTrait1] Source: 'src/traits.rs', lines 222:0-222:35 *) @@ -421,7 +421,7 @@ let parentTrait2U32 : parentTrait2_t u32 = { (** [traits::{(traits::ChildTrait2 for u32)#13}::convert]: Source: 'src/traits.rs', lines 273:4-273:29 *) let childTrait2U32_convert (x : u32) : result u32 = - Return x + Ok x (** Trait implementation: [traits::{(traits::ChildTrait2 for u32)#13}] Source: 'src/traits.rs', lines 272:0-272:24 *) @@ -468,7 +468,7 @@ noeq type trait_t (self : Type0) = { cLEN : usize; } (** [traits::{(traits::Trait for @Array)#14}::LEN] Source: 'src/traits.rs', lines 315:4-315:20 *) -let trait_array_len_body (t : Type0) (n : usize) : result usize = Return n +let trait_array_len_body (t : Type0) (n : usize) : result usize = Ok n let trait_array_len (t : Type0) (n : usize) : usize = eval_global (trait_array_len_body t n) @@ -482,7 +482,7 @@ let traitArray (t : Type0) (n : usize) : trait_t (array t n) = { Source: 'src/traits.rs', lines 319:4-319:20 *) let traittraits_wrapper_len_body (t : Type0) (traitInst : trait_t t) : result usize = - Return 0 + Ok 0 let traittraits_wrapper_len (t : Type0) (traitInst : trait_t t) : usize = eval_global (traittraits_wrapper_len_body t traitInst) @@ -496,7 +496,7 @@ let traittraitsWrapper (t : Type0) (traitInst : trait_t t) : trait_t (wrapper_t (** [traits::use_wrapper_len]: Source: 'src/traits.rs', lines 322:0-322:43 *) let use_wrapper_len (t : Type0) (traitInst : trait_t t) : result usize = - Return (traittraitsWrapper t traitInst).cLEN + Ok (traittraitsWrapper t traitInst).cLEN (** [traits::Foo] Source: 'src/traits.rs', lines 326:0-326:20 *) @@ -513,7 +513,7 @@ type core_result_Result_t (t e : Type0) = Source: 'src/traits.rs', lines 332:4-332:33 *) let foo_foo_body (t u : Type0) (traitInst : trait_t t) : result (core_result_Result_t t i32) = - Return (Core_result_Result_Err 0) + Ok (Core_result_Result_Err 0) let foo_foo (t u : Type0) (traitInst : trait_t t) : core_result_Result_t t i32 = eval_global (foo_foo_body t u traitInst) @@ -522,11 +522,11 @@ let foo_foo (t u : Type0) (traitInst : trait_t t) Source: 'src/traits.rs', lines 335:0-335:48 *) let use_foo1 (t u : Type0) (traitInst : trait_t t) : result (core_result_Result_t t i32) = - Return (foo_foo t u traitInst) + Ok (foo_foo t u traitInst) (** [traits::use_foo2]: Source: 'src/traits.rs', lines 339:0-339:48 *) let use_foo2 (t u : Type0) (traitInst : trait_t u) : result (core_result_Result_t u i32) = - Return (foo_foo u t traitInst) + Ok (foo_foo u t traitInst) diff --git a/tests/lean/Arrays.lean b/tests/lean/Arrays.lean index 207f31b9..d606640a 100644 --- a/tests/lean/Arrays.lean +++ b/tests/lean/Arrays.lean @@ -35,19 +35,19 @@ def array_to_mut_slice_ def array_len (T : Type) (s : Array T 32#usize) : Result Usize := do let s1 ← Array.to_slice T 32#usize s - Result.ret (Slice.len T s1) + Result.ok (Slice.len T s1) /- [arrays::shared_array_len]: Source: 'src/arrays.rs', lines 29:0-29:48 -/ def shared_array_len (T : Type) (s : Array T 32#usize) : Result Usize := do let s1 ← Array.to_slice T 32#usize s - Result.ret (Slice.len T s1) + Result.ok (Slice.len T s1) /- [arrays::shared_slice_len]: Source: 'src/arrays.rs', lines 33:0-33:44 -/ def shared_slice_len (T : Type) (s : Slice T) : Result Usize := - Result.ret (Slice.len T s) + Result.ok (Slice.len T s) /- [arrays::index_array_shared]: Source: 'src/arrays.rs', lines 37:0-37:57 -/ @@ -105,7 +105,7 @@ def slice_subslice_mut_ core.slice.index.Slice.index_mut U32 (core.ops.range.Range Usize) (core.slice.index.SliceIndexRangeUsizeSliceTInst U32) x { start := y, end_ := z } - Result.ret (s, index_mut_back) + Result.ok (s, index_mut_back) /- [arrays::array_to_slice_shared_]: Source: 'src/arrays.rs', lines 72:0-72:54 -/ @@ -141,7 +141,7 @@ def array_subslice_mut_ (core.ops.index.IndexMutSliceTIInst U32 (core.ops.range.Range Usize) (core.slice.index.SliceIndexRangeUsizeSliceTInst U32)) x { start := y, end_ := z } - Result.ret (s, index_mut_back) + Result.ok (s, index_mut_back) /- [arrays::index_slice_0]: Source: 'src/arrays.rs', lines 88:0-88:38 -/ @@ -175,37 +175,37 @@ def update_update_array let (_, index_mut_back1) ← Array.index_mut_usize U32 32#usize a j let a1 ← index_mut_back1 0#u32 let _ ← index_mut_back a1 - Result.ret () + Result.ok () /- [arrays::array_local_deep_copy]: Source: 'src/arrays.rs', lines 118:0-118:43 -/ def array_local_deep_copy (x : Array U32 32#usize) : Result Unit := - Result.ret () + Result.ok () /- [arrays::take_array]: Source: 'src/arrays.rs', lines 122:0-122:30 -/ def take_array (a : Array U32 2#usize) : Result Unit := - Result.ret () + Result.ok () /- [arrays::take_array_borrow]: Source: 'src/arrays.rs', lines 123:0-123:38 -/ def take_array_borrow (a : Array U32 2#usize) : Result Unit := - Result.ret () + Result.ok () /- [arrays::take_slice]: Source: 'src/arrays.rs', lines 124:0-124:28 -/ def take_slice (s : Slice U32) : Result Unit := - Result.ret () + Result.ok () /- [arrays::take_mut_slice]: Source: 'src/arrays.rs', lines 125:0-125:36 -/ def take_mut_slice (s : Slice U32) : Result (Slice U32) := - Result.ret s + Result.ok s /- [arrays::const_array]: Source: 'src/arrays.rs', lines 127:0-127:32 -/ def const_array : Result (Array U32 2#usize) := - Result.ret (Array.make U32 2#usize [ 0#u32, 0#u32 ]) + Result.ok (Array.make U32 2#usize [ 0#u32, 0#u32 ]) /- [arrays::const_slice]: Source: 'src/arrays.rs', lines 131:0-131:20 -/ @@ -213,7 +213,7 @@ def const_slice : Result Unit := do let _ ← Array.to_slice U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) - Result.ret () + Result.ok () /- [arrays::take_all]: Source: 'src/arrays.rs', lines 141:0-141:17 -/ @@ -229,7 +229,7 @@ def take_all : Result Unit := Array.to_slice_mut U32 2#usize (Array.make U32 2#usize [ 0#u32, 0#u32 ]) let s2 ← take_mut_slice s1 let _ ← to_slice_mut_back s2 - Result.ret () + Result.ok () /- [arrays::index_array]: Source: 'src/arrays.rs', lines 155:0-155:38 -/ @@ -251,7 +251,7 @@ def index_slice_u32_0 (x : Slice U32) : Result U32 := def index_mut_slice_u32_0 (x : Slice U32) : Result (U32 × (Slice U32)) := do let i ← Slice.index_usize U32 x 0#usize - Result.ret (i, x) + Result.ok (i, x) /- [arrays::index_all]: Source: 'src/arrays.rs', lines 170:0-170:25 -/ @@ -271,7 +271,7 @@ def index_all : Result U32 := let (i7, s2) ← index_mut_slice_u32_0 s1 let i8 ← i6 + i7 let _ ← to_slice_mut_back s2 - Result.ret i8 + Result.ok i8 /- [arrays::update_array]: Source: 'src/arrays.rs', lines 184:0-184:36 -/ @@ -279,7 +279,7 @@ def update_array (x : Array U32 2#usize) : Result Unit := do let (_, index_mut_back) ← Array.index_mut_usize U32 2#usize x 0#usize let _ ← index_mut_back 1#u32 - Result.ret () + Result.ok () /- [arrays::update_array_mut_borrow]: Source: 'src/arrays.rs', lines 187:0-187:48 -/ @@ -306,7 +306,7 @@ def update_all : Result Unit := let (s, to_slice_mut_back) ← Array.to_slice_mut U32 2#usize x let s1 ← update_mut_slice s let _ ← to_slice_mut_back s1 - Result.ret () + Result.ok () /- [arrays::range_all]: Source: 'src/arrays.rs', lines 205:0-205:18 -/ @@ -320,7 +320,7 @@ def range_all : Result Unit := { start := 1#usize, end_ := 3#usize } let s1 ← update_mut_slice s let _ ← index_mut_back s1 - Result.ret () + Result.ok () /- [arrays::deref_array_borrow]: Source: 'src/arrays.rs', lines 214:0-214:46 -/ @@ -333,12 +333,12 @@ def deref_array_mut_borrow (x : Array U32 2#usize) : Result (U32 × (Array U32 2#usize)) := do let i ← Array.index_usize U32 2#usize x 0#usize - Result.ret (i, x) + Result.ok (i, x) /- [arrays::take_array_t]: Source: 'src/arrays.rs', lines 227:0-227:31 -/ def take_array_t (a : Array AB 2#usize) : Result Unit := - Result.ret () + Result.ok () /- [arrays::non_copyable_array]: Source: 'src/arrays.rs', lines 229:0-229:27 -/ @@ -356,7 +356,7 @@ divergent def sum_loop (s : Slice U32) (sum1 : U32) (i : Usize) : Result U32 := let sum3 ← sum1 + i2 let i3 ← i + 1#usize sum_loop s sum3 i3 - else Result.ret sum1 + else Result.ok sum1 /- [arrays::sum]: Source: 'src/arrays.rs', lines 242:0-242:28 -/ @@ -377,7 +377,7 @@ divergent def sum2_loop let sum3 ← sum1 + i4 let i5 ← i + 1#usize sum2_loop s s2 sum3 i5 - else Result.ret sum1 + else Result.ok sum1 /- [arrays::sum2]: Source: 'src/arrays.rs', lines 252:0-252:41 -/ @@ -397,7 +397,7 @@ def f0 : Result Unit := let (_, index_mut_back) ← Slice.index_mut_usize U32 s 0#usize let s1 ← index_mut_back 1#u32 let _ ← to_slice_mut_back s1 - Result.ret () + Result.ok () /- [arrays::f1]: Source: 'src/arrays.rs', lines 268:0-268:11 -/ @@ -407,12 +407,12 @@ def f1 : Result Unit := Array.index_mut_usize U32 2#usize (Array.make U32 2#usize [ 1#u32, 2#u32 ]) 0#usize let _ ← index_mut_back 1#u32 - Result.ret () + Result.ok () /- [arrays::f2]: Source: 'src/arrays.rs', lines 273:0-273:17 -/ def f2 (i : U32) : Result Unit := - Result.ret () + Result.ok () /- [arrays::f4]: Source: 'src/arrays.rs', lines 282:0-282:54 -/ @@ -438,7 +438,7 @@ def f3 : Result U32 := /- [arrays::SZ] Source: 'src/arrays.rs', lines 286:0-286:19 -/ -def SZ_body : Result Usize := Result.ret 32#usize +def SZ_body : Result Usize := Result.ok 32#usize def SZ : Usize := eval_global SZ_body /- [arrays::f5]: @@ -458,7 +458,7 @@ def ite : Result Unit := let (_, s3) ← index_mut_slice_u32_0 s2 let _ ← to_slice_mut_back1 s3 let _ ← to_slice_mut_back s1 - Result.ret () + Result.ok () /- [arrays::zero_slice]: loop 0: Source: 'src/arrays.rs', lines 303:0-310:1 -/ @@ -471,7 +471,7 @@ divergent def zero_slice_loop let i1 ← i + 1#usize let a1 ← index_mut_back 0#u8 zero_slice_loop a1 i1 len - else Result.ret a + else Result.ok a /- [arrays::zero_slice]: Source: 'src/arrays.rs', lines 303:0-303:31 -/ @@ -486,7 +486,7 @@ divergent def iter_mut_slice_loop (len : Usize) (i : Usize) : Result Unit := then do let i1 ← i + 1#usize iter_mut_slice_loop len i1 - else Result.ret () + else Result.ok () /- [arrays::iter_mut_slice]: Source: 'src/arrays.rs', lines 312:0-312:35 -/ @@ -494,7 +494,7 @@ def iter_mut_slice (a : Slice U8) : Result (Slice U8) := do let len := Slice.len U8 a let _ ← iter_mut_slice_loop len 0#usize - Result.ret a + Result.ok a /- [arrays::sum_mut_slice]: loop 0: Source: 'src/arrays.rs', lines 320:0-328:1 -/ @@ -508,13 +508,13 @@ divergent def sum_mut_slice_loop let s1 ← s + i2 let i3 ← i + 1#usize sum_mut_slice_loop a i3 s1 - else Result.ret s + else Result.ok s /- [arrays::sum_mut_slice]: Source: 'src/arrays.rs', lines 320:0-320:42 -/ def sum_mut_slice (a : Slice U32) : Result (U32 × (Slice U32)) := do let i ← sum_mut_slice_loop a 0#usize 0#u32 - Result.ret (i, a) + Result.ok (i, a) end arrays diff --git a/tests/lean/BetreeMain/Funs.lean b/tests/lean/BetreeMain/Funs.lean index 2fbcd6a4..0c31b9bc 100644 --- a/tests/lean/BetreeMain/Funs.lean +++ b/tests/lean/BetreeMain/Funs.lean @@ -42,12 +42,12 @@ def betree.store_leaf_node def betree.fresh_node_id (counter : U64) : Result (U64 × U64) := do let counter1 ← counter + 1#u64 - Result.ret (counter, counter1) + Result.ok (counter, counter1) /- [betree_main::betree::{betree_main::betree::NodeIdCounter}::new]: Source: 'src/betree.rs', lines 206:4-206:20 -/ def betree.NodeIdCounter.new : Result betree.NodeIdCounter := - Result.ret { next_node_id := 0#u64 } + Result.ok { next_node_id := 0#u64 } /- [betree_main::betree::{betree_main::betree::NodeIdCounter}::fresh_id]: Source: 'src/betree.rs', lines 210:4-210:36 -/ @@ -55,7 +55,7 @@ def betree.NodeIdCounter.fresh_id (self : betree.NodeIdCounter) : Result (U64 × betree.NodeIdCounter) := do let i ← self.next_node_id + 1#u64 - Result.ret (self.next_node_id, { next_node_id := i }) + Result.ok (self.next_node_id, { next_node_id := i }) /- [betree_main::betree::upsert_update]: Source: 'src/betree.rs', lines 234:0-234:70 -/ @@ -64,8 +64,8 @@ def betree.upsert_update match prev with | none => match st with - | betree.UpsertFunState.Add v => Result.ret v - | betree.UpsertFunState.Sub _ => Result.ret 0#u64 + | betree.UpsertFunState.Add v => Result.ok v + | betree.UpsertFunState.Sub _ => Result.ok 0#u64 | some prev1 => match st with | betree.UpsertFunState.Add v => @@ -73,11 +73,11 @@ def betree.upsert_update let margin ← core_u64_max - prev1 if margin >= v then prev1 + v - else Result.ret core_u64_max + else Result.ok core_u64_max | betree.UpsertFunState.Sub v => if prev1 >= v then prev1 - v - else Result.ret 0#u64 + else Result.ok 0#u64 /- [betree_main::betree::{betree_main::betree::List#1}::len]: Source: 'src/betree.rs', lines 276:4-276:24 -/ @@ -86,7 +86,7 @@ divergent def betree.List.len (T : Type) (self : betree.List T) : Result U64 := | betree.List.Cons _ tl => do let i ← betree.List.len T tl 1#u64 + i - | betree.List.Nil => Result.ret 0#u64 + | betree.List.Nil => Result.ok 0#u64 /- [betree_main::betree::{betree_main::betree::List#1}::split_at]: Source: 'src/betree.rs', lines 284:4-284:51 -/ @@ -95,7 +95,7 @@ divergent def betree.List.split_at Result ((betree.List T) × (betree.List T)) := if n = 0#u64 - then Result.ret (betree.List.Nil, self) + then Result.ok (betree.List.Nil, self) else match self with | betree.List.Cons hd tl => @@ -103,7 +103,7 @@ divergent def betree.List.split_at let i ← n - 1#u64 let p ← betree.List.split_at T tl i let (ls0, ls1) := p - Result.ret (betree.List.Cons hd ls0, ls1) + Result.ok (betree.List.Cons hd ls0, ls1) | betree.List.Nil => Result.fail .panic /- [betree_main::betree::{betree_main::betree::List#1}::push_front]: @@ -111,7 +111,7 @@ divergent def betree.List.split_at def betree.List.push_front (T : Type) (self : betree.List T) (x : T) : Result (betree.List T) := let (tl, _) := core.mem.replace (betree.List T) self betree.List.Nil - Result.ret (betree.List.Cons x tl) + Result.ok (betree.List.Cons x tl) /- [betree_main::betree::{betree_main::betree::List#1}::pop_front]: Source: 'src/betree.rs', lines 306:4-306:32 -/ @@ -119,14 +119,14 @@ def betree.List.pop_front (T : Type) (self : betree.List T) : Result (T × (betree.List T)) := let (ls, _) := core.mem.replace (betree.List T) self betree.List.Nil match ls with - | betree.List.Cons x tl => Result.ret (x, tl) + | betree.List.Cons x tl => Result.ok (x, tl) | betree.List.Nil => Result.fail .panic /- [betree_main::betree::{betree_main::betree::List#1}::hd]: Source: 'src/betree.rs', lines 318:4-318:22 -/ def betree.List.hd (T : Type) (self : betree.List T) : Result T := match self with - | betree.List.Cons hd _ => Result.ret hd + | betree.List.Cons hd _ => Result.ok hd | betree.List.Nil => Result.fail .panic /- [betree_main::betree::{betree_main::betree::List<(u64, T)>#2}::head_has_key]: @@ -135,8 +135,8 @@ def betree.ListPairU64T.head_has_key (T : Type) (self : betree.List (U64 × T)) (key : U64) : Result Bool := match self with | betree.List.Cons hd _ => let (i, _) := hd - Result.ret (i = key) - | betree.List.Nil => Result.ret false + Result.ok (i = key) + | betree.List.Nil => Result.ok false /- [betree_main::betree::{betree_main::betree::List<(u64, T)>#2}::partition_at_pivot]: Source: 'src/betree.rs', lines 339:4-339:73 -/ @@ -148,13 +148,13 @@ divergent def betree.ListPairU64T.partition_at_pivot | betree.List.Cons hd tl => let (i, t) := hd if i >= pivot - then Result.ret (betree.List.Nil, betree.List.Cons (i, t) tl) + then Result.ok (betree.List.Nil, betree.List.Cons (i, t) tl) else do let p ← betree.ListPairU64T.partition_at_pivot T tl pivot let (ls0, ls1) := p - Result.ret (betree.List.Cons (i, t) ls0, ls1) - | betree.List.Nil => Result.ret (betree.List.Nil, betree.List.Nil) + Result.ok (betree.List.Cons (i, t) ls0, ls1) + | betree.List.Nil => Result.ok (betree.List.Nil, betree.List.Nil) /- [betree_main::betree::{betree_main::betree::Leaf#3}::split]: Source: 'src/betree.rs', lines 359:4-364:17 -/ @@ -174,7 +174,7 @@ def betree.Leaf.split let (st2, _) ← betree.store_leaf_node id1 content1 st1 let n := betree.Node.Leaf { id := id0, size := params.split_size } let n1 := betree.Node.Leaf { id := id1, size := params.split_size } - Result.ret (st2, (betree.Internal.mk self.id pivot n n1, node_id_cnt2)) + Result.ok (st2, (betree.Internal.mk self.id pivot n n1, node_id_cnt2)) /- [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_for_key]: Source: 'src/betree.rs', lines 789:4-792:34 -/ @@ -187,7 +187,7 @@ divergent def betree.Node.lookup_first_message_for_key | betree.List.Cons x next_msgs => let (i, m) := x if i >= key - then Result.ret (betree.List.Cons (i, m) next_msgs, Result.ret) + then Result.ok (betree.List.Cons (i, m) next_msgs, Result.ok) else do let (l, lookup_first_message_for_key_back) ← @@ -196,9 +196,9 @@ divergent def betree.Node.lookup_first_message_for_key fun ret => do let next_msgs1 ← lookup_first_message_for_key_back ret - Result.ret (betree.List.Cons (i, m) next_msgs1) - Result.ret (l, back) - | betree.List.Nil => Result.ret (betree.List.Nil, Result.ret) + Result.ok (betree.List.Cons (i, m) next_msgs1) + Result.ok (l, back) + | betree.List.Nil => Result.ok (betree.List.Nil, Result.ok) /- [betree_main::betree::{betree_main::betree::Node#5}::lookup_in_bindings]: Source: 'src/betree.rs', lines 636:4-636:80 -/ @@ -208,12 +208,12 @@ divergent def betree.Node.lookup_in_bindings | betree.List.Cons hd tl => let (i, i1) := hd if i = key - then Result.ret (some i1) + then Result.ok (some i1) else if i > key - then Result.ret none + then Result.ok none else betree.Node.lookup_in_bindings key tl - | betree.List.Nil => Result.ret none + | betree.List.Nil => Result.ok none /- [betree_main::betree::{betree_main::betree::Node#5}::apply_upserts]: Source: 'src/betree.rs', lines 819:4-819:90 -/ @@ -242,7 +242,7 @@ divergent def betree.Node.apply_upserts let msgs1 ← betree.List.push_front (U64 × betree.Message) msgs (key, betree.Message.Insert v) - Result.ret (st1, (v, msgs1)) + Result.ok (st1, (v, msgs1)) /- [betree_main::betree::{betree_main::betree::Internal#4}::lookup_in_children]: Source: 'src/betree.rs', lines 395:4-395:63 -/ @@ -255,11 +255,11 @@ mutual divergent def betree.Internal.lookup_in_children then do let (st1, (o, n2)) ← betree.Node.lookup n key st - Result.ret (st1, (o, betree.Internal.mk i i1 n2 n1)) + Result.ok (st1, (o, betree.Internal.mk i i1 n2 n1)) else do let (st1, (o, n2)) ← betree.Node.lookup n1 key st - Result.ret (st1, (o, betree.Internal.mk i i1 n n2)) + Result.ok (st1, (o, betree.Internal.mk i i1 n n2)) /- [betree_main::betree::{betree_main::betree::Node#5}::lookup]: Source: 'src/betree.rs', lines 709:4-709:58 -/ @@ -285,7 +285,7 @@ divergent def betree.Node.lookup st1 let _ ← lookup_first_message_for_key_back (betree.List.Cons (k, msg) l) - Result.ret (st2, (o, betree.Node.Internal node1)) + Result.ok (st2, (o, betree.Node.Internal node1)) else match msg with | betree.Message.Insert v => @@ -293,14 +293,14 @@ divergent def betree.Node.lookup let _ ← lookup_first_message_for_key_back (betree.List.Cons (k, betree.Message.Insert v) l) - Result.ret (st1, (some v, betree.Node.Internal (betree.Internal.mk i + Result.ok (st1, (some v, betree.Node.Internal (betree.Internal.mk i i1 n n1))) | betree.Message.Delete => do let _ ← lookup_first_message_for_key_back (betree.List.Cons (k, betree.Message.Delete) l) - Result.ret (st1, (none, betree.Node.Internal (betree.Internal.mk i i1 + Result.ok (st1, (none, betree.Node.Internal (betree.Internal.mk i i1 n n1))) | betree.Message.Upsert ufs => do @@ -313,20 +313,20 @@ divergent def betree.Node.lookup let ⟨ i2, i3, n2, n3 ⟩ := node1 let msgs1 ← lookup_first_message_for_key_back pending1 let (st4, _) ← betree.store_internal_node i2 msgs1 st3 - Result.ret (st4, (some v1, betree.Node.Internal (betree.Internal.mk - i2 i3 n2 n3))) + Result.ok (st4, (some v1, betree.Node.Internal (betree.Internal.mk i2 + i3 n2 n3))) | betree.List.Nil => do let (st2, (o, node1)) ← betree.Internal.lookup_in_children (betree.Internal.mk i i1 n n1) key st1 let _ ← lookup_first_message_for_key_back betree.List.Nil - Result.ret (st2, (o, betree.Node.Internal node1)) + Result.ok (st2, (o, betree.Node.Internal node1)) | betree.Node.Leaf node => do let (st1, bindings) ← betree.load_leaf_node node.id st let o ← betree.Node.lookup_in_bindings key bindings - Result.ret (st1, (o, betree.Node.Leaf node)) + Result.ok (st1, (o, betree.Node.Leaf node)) end @@ -346,8 +346,8 @@ divergent def betree.Node.filter_messages_for_key betree.List.pop_front (U64 × betree.Message) (betree.List.Cons (k, m) l) betree.Node.filter_messages_for_key key msgs1 - else Result.ret (betree.List.Cons (k, m) l) - | betree.List.Nil => Result.ret betree.List.Nil + else Result.ok (betree.List.Cons (k, m) l) + | betree.List.Nil => Result.ok betree.List.Nil /- [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_after_key]: Source: 'src/betree.rs', lines 689:4-692:34 -/ @@ -368,10 +368,10 @@ divergent def betree.Node.lookup_first_message_after_key fun ret => do let next_msgs1 ← lookup_first_message_after_key_back ret - Result.ret (betree.List.Cons (k, m) next_msgs1) - Result.ret (l, back) - else Result.ret (betree.List.Cons (k, m) next_msgs, Result.ret) - | betree.List.Nil => Result.ret (betree.List.Nil, Result.ret) + Result.ok (betree.List.Cons (k, m) next_msgs1) + Result.ok (l, back) + else Result.ok (betree.List.Cons (k, m) next_msgs, Result.ok) + | betree.List.Nil => Result.ok (betree.List.Nil, Result.ok) /- [betree_main::betree::{betree_main::betree::Node#5}::apply_to_internal]: Source: 'src/betree.rs', lines 521:4-521:89 -/ @@ -450,7 +450,7 @@ divergent def betree.Node.apply_messages_to_internal let (i, m) := new_msg let msgs1 ← betree.Node.apply_to_internal msgs i m betree.Node.apply_messages_to_internal msgs1 new_msgs_tl - | betree.List.Nil => Result.ret msgs + | betree.List.Nil => Result.ok msgs /- [betree_main::betree::{betree_main::betree::Node#5}::lookup_mut_in_bindings]: Source: 'src/betree.rs', lines 653:4-656:32 -/ @@ -463,7 +463,7 @@ divergent def betree.Node.lookup_mut_in_bindings | betree.List.Cons hd tl => let (i, i1) := hd if i >= key - then Result.ret (betree.List.Cons (i, i1) tl, Result.ret) + then Result.ok (betree.List.Cons (i, i1) tl, Result.ok) else do let (l, lookup_mut_in_bindings_back) ← @@ -472,9 +472,9 @@ divergent def betree.Node.lookup_mut_in_bindings fun ret => do let tl1 ← lookup_mut_in_bindings_back ret - Result.ret (betree.List.Cons (i, i1) tl1) - Result.ret (l, back) - | betree.List.Nil => Result.ret (betree.List.Nil, Result.ret) + Result.ok (betree.List.Cons (i, i1) tl1) + Result.ok (l, back) + | betree.List.Nil => Result.ok (betree.List.Nil, Result.ok) /- [betree_main::betree::{betree_main::betree::Node#5}::apply_to_leaf]: Source: 'src/betree.rs', lines 460:4-460:87 -/ @@ -529,7 +529,7 @@ divergent def betree.Node.apply_messages_to_leaf let (i, m) := new_msg let bindings1 ← betree.Node.apply_to_leaf bindings i m betree.Node.apply_messages_to_leaf bindings1 new_msgs_tl - | betree.List.Nil => Result.ret bindings + | betree.List.Nil => Result.ok bindings /- [betree_main::betree::{betree_main::betree::Internal#4}::flush]: Source: 'src/betree.rs', lines 410:4-415:26 -/ @@ -558,17 +558,17 @@ mutual divergent def betree.Internal.flush let (st2, p2) ← betree.Node.apply_messages n1 params node_id_cnt1 msgs_right st1 let (n3, node_id_cnt2) := p2 - Result.ret (st2, (betree.List.Nil, (betree.Internal.mk i i1 n2 n3, + Result.ok (st2, (betree.List.Nil, (betree.Internal.mk i i1 n2 n3, node_id_cnt2))) else - Result.ret (st1, (msgs_right, (betree.Internal.mk i i1 n2 n1, + Result.ok (st1, (msgs_right, (betree.Internal.mk i i1 n2 n1, node_id_cnt1))) else do let (st1, p1) ← betree.Node.apply_messages n1 params node_id_cnt msgs_right st let (n2, node_id_cnt1) := p1 - Result.ret (st1, (msgs_left, (betree.Internal.mk i i1 n n2, node_id_cnt1))) + Result.ok (st1, (msgs_left, (betree.Internal.mk i i1 n n2, node_id_cnt1))) /- [betree_main::betree::{betree_main::betree::Node#5}::apply_messages]: Source: 'src/betree.rs', lines 588:4-593:5 -/ @@ -594,12 +594,12 @@ divergent def betree.Node.apply_messages let (node1, node_id_cnt1) := p let ⟨ i2, i3, n2, n3 ⟩ := node1 let (st3, _) ← betree.store_internal_node i2 content2 st2 - Result.ret (st3, (betree.Node.Internal (betree.Internal.mk i2 i3 n2 n3), + Result.ok (st3, (betree.Node.Internal (betree.Internal.mk i2 i3 n2 n3), node_id_cnt1)) else do let (st2, _) ← betree.store_internal_node i content1 st1 - Result.ret (st2, (betree.Node.Internal (betree.Internal.mk i i1 n n1), + Result.ok (st2, (betree.Node.Internal (betree.Internal.mk i i1 n n1), node_id_cnt)) | betree.Node.Leaf node => do @@ -613,11 +613,11 @@ divergent def betree.Node.apply_messages let (st2, (new_node, node_id_cnt1)) ← betree.Leaf.split node content1 params node_id_cnt st1 let (st3, _) ← betree.store_leaf_node node.id betree.List.Nil st2 - Result.ret (st3, (betree.Node.Internal new_node, node_id_cnt1)) + Result.ok (st3, (betree.Node.Internal new_node, node_id_cnt1)) else do let (st2, _) ← betree.store_leaf_node node.id content1 st1 - Result.ret (st2, (betree.Node.Leaf { node with size := len }, + Result.ok (st2, (betree.Node.Leaf { node with size := len }, node_id_cnt)) end @@ -635,7 +635,7 @@ def betree.Node.apply betree.Node.apply_messages self params node_id_cnt (betree.List.Cons (key, new_msg) betree.List.Nil) st let (self1, node_id_cnt1) := p - Result.ret (st1, (self1, node_id_cnt1)) + Result.ok (st1, (self1, node_id_cnt1)) /- [betree_main::betree::{betree_main::betree::BeTree#6}::new]: Source: 'src/betree.rs', lines 849:4-849:60 -/ @@ -647,7 +647,7 @@ def betree.BeTree.new let node_id_cnt ← betree.NodeIdCounter.new let (id, node_id_cnt1) ← betree.NodeIdCounter.fresh_id node_id_cnt let (st1, _) ← betree.store_leaf_node id betree.List.Nil st - Result.ret (st1, + Result.ok (st1, { params := { min_flush_size := min_flush_size, split_size := split_size }, node_id_cnt := node_id_cnt1, @@ -664,7 +664,7 @@ def betree.BeTree.apply let (st1, p) ← betree.Node.apply self.root self.params self.node_id_cnt key msg st let (n, nic) := p - Result.ret (st1, { self with node_id_cnt := nic, root := n }) + Result.ok (st1, { self with node_id_cnt := nic, root := n }) /- [betree_main::betree::{betree_main::betree::BeTree#6}::insert]: Source: 'src/betree.rs', lines 874:4-874:52 -/ @@ -699,14 +699,14 @@ def betree.BeTree.lookup := do let (st1, (o, n)) ← betree.Node.lookup self.root key st - Result.ret (st1, (o, { self with root := n })) + Result.ok (st1, (o, { self with root := n })) /- [betree_main::main]: Source: 'src/betree_main.rs', lines 5:0-5:9 -/ def main : Result Unit := - Result.ret () + Result.ok () /- Unit test for [betree_main::main] -/ -#assert (main == Result.ret ()) +#assert (main == Result.ok ()) end betree_main diff --git a/tests/lean/Bitwise.lean b/tests/lean/Bitwise.lean index 7c47e3dd..c13129f1 100644 --- a/tests/lean/Bitwise.lean +++ b/tests/lean/Bitwise.lean @@ -22,16 +22,16 @@ def shift_i32 (a : I32) : Result I32 := /- [bitwise::xor_u32]: Source: 'src/bitwise.rs', lines 17:0-17:37 -/ def xor_u32 (a : U32) (b : U32) : Result U32 := - Result.ret (a ^^^ b) + Result.ok (a ^^^ b) /- [bitwise::or_u32]: Source: 'src/bitwise.rs', lines 21:0-21:36 -/ def or_u32 (a : U32) (b : U32) : Result U32 := - Result.ret (a ||| b) + Result.ok (a ||| b) /- [bitwise::and_u32]: Source: 'src/bitwise.rs', lines 25:0-25:37 -/ def and_u32 (a : U32) (b : U32) : Result U32 := - Result.ret (a &&& b) + Result.ok (a &&& b) end bitwise diff --git a/tests/lean/Constants.lean b/tests/lean/Constants.lean index 40f590d4..3cc3ca40 100644 --- a/tests/lean/Constants.lean +++ b/tests/lean/Constants.lean @@ -7,17 +7,17 @@ namespace constants /- [constants::X0] Source: 'src/constants.rs', lines 5:0-5:17 -/ -def X0_body : Result U32 := Result.ret 0#u32 +def X0_body : Result U32 := Result.ok 0#u32 def X0 : U32 := eval_global X0_body /- [constants::X1] Source: 'src/constants.rs', lines 7:0-7:17 -/ -def X1_body : Result U32 := Result.ret core_u32_max +def X1_body : Result U32 := Result.ok core_u32_max def X1 : U32 := eval_global X1_body /- [constants::X2] Source: 'src/constants.rs', lines 10:0-10:17 -/ -def X2_body : Result U32 := Result.ret 3#u32 +def X2_body : Result U32 := Result.ok 3#u32 def X2 : U32 := eval_global X2_body /- [constants::incr]: @@ -33,7 +33,7 @@ def X3 : U32 := eval_global X3_body /- [constants::mk_pair0]: Source: 'src/constants.rs', lines 23:0-23:51 -/ def mk_pair0 (x : U32) (y : U32) : Result (U32 × U32) := - Result.ret (x, y) + Result.ok (x, y) /- [constants::Pair] Source: 'src/constants.rs', lines 36:0-36:23 -/ @@ -44,7 +44,7 @@ structure Pair (T1 T2 : Type) where /- [constants::mk_pair1]: Source: 'src/constants.rs', lines 27:0-27:55 -/ def mk_pair1 (x : U32) (y : U32) : Result (Pair U32 U32) := - Result.ret { x := x, y := y } + Result.ok { x := x, y := y } /- [constants::P0] Source: 'src/constants.rs', lines 31:0-31:24 -/ @@ -58,12 +58,12 @@ def P1 : Pair U32 U32 := eval_global P1_body /- [constants::P2] Source: 'src/constants.rs', lines 33:0-33:24 -/ -def P2_body : Result (U32 × U32) := Result.ret (0#u32, 1#u32) +def P2_body : Result (U32 × U32) := Result.ok (0#u32, 1#u32) def P2 : (U32 × U32) := eval_global P2_body /- [constants::P3] Source: 'src/constants.rs', lines 34:0-34:28 -/ -def P3_body : Result (Pair U32 U32) := Result.ret { x := 0#u32, y := 1#u32 } +def P3_body : Result (Pair U32 U32) := Result.ok { x := 0#u32, y := 1#u32 } def P3 : Pair U32 U32 := eval_global P3_body /- [constants::Wrap] @@ -74,7 +74,7 @@ structure Wrap (T : Type) where /- [constants::{constants::Wrap}::new]: Source: 'src/constants.rs', lines 54:4-54:41 -/ def Wrap.new (T : Type) (value : T) : Result (Wrap T) := - Result.ret { value := value } + Result.ok { value := value } /- [constants::Y] Source: 'src/constants.rs', lines 41:0-41:22 -/ @@ -84,7 +84,7 @@ def Y : Wrap I32 := eval_global Y_body /- [constants::unwrap_y]: Source: 'src/constants.rs', lines 43:0-43:30 -/ def unwrap_y : Result I32 := - Result.ret Y.value + Result.ok Y.value /- [constants::YVAL] Source: 'src/constants.rs', lines 47:0-47:19 -/ @@ -93,13 +93,13 @@ def YVAL : I32 := eval_global YVAL_body /- [constants::get_z1::Z1] Source: 'src/constants.rs', lines 62:4-62:17 -/ -def get_z1.Z1_body : Result I32 := Result.ret 3#i32 +def get_z1.Z1_body : Result I32 := Result.ok 3#i32 def get_z1.Z1 : I32 := eval_global get_z1.Z1_body /- [constants::get_z1]: Source: 'src/constants.rs', lines 61:0-61:28 -/ def get_z1 : Result I32 := - Result.ret get_z1.Z1 + Result.ok get_z1.Z1 /- [constants::add]: Source: 'src/constants.rs', lines 66:0-66:39 -/ @@ -108,12 +108,12 @@ def add (a : I32) (b : I32) : Result I32 := /- [constants::Q1] Source: 'src/constants.rs', lines 74:0-74:17 -/ -def Q1_body : Result I32 := Result.ret 5#i32 +def Q1_body : Result I32 := Result.ok 5#i32 def Q1 : I32 := eval_global Q1_body /- [constants::Q2] Source: 'src/constants.rs', lines 75:0-75:17 -/ -def Q2_body : Result I32 := Result.ret Q1 +def Q2_body : Result I32 := Result.ok Q1 def Q2 : I32 := eval_global Q2_body /- [constants::Q3] @@ -131,7 +131,7 @@ def get_z2 : Result I32 := /- [constants::S1] Source: 'src/constants.rs', lines 80:0-80:18 -/ -def S1_body : Result U32 := Result.ret 6#u32 +def S1_body : Result U32 := Result.ok 6#u32 def S1 : U32 := eval_global S1_body /- [constants::S2] @@ -141,7 +141,7 @@ def S2 : U32 := eval_global S2_body /- [constants::S3] Source: 'src/constants.rs', lines 82:0-82:29 -/ -def S3_body : Result (Pair U32 U32) := Result.ret P3 +def S3_body : Result (Pair U32 U32) := Result.ok P3 def S3 : Pair U32 U32 := eval_global S3_body /- [constants::S4] @@ -156,12 +156,12 @@ structure V (T : Type) (N : Usize) where /- [constants::{constants::V#1}::LEN] Source: 'src/constants.rs', lines 91:4-91:24 -/ -def V.LEN_body (T : Type) (N : Usize) : Result Usize := Result.ret N +def V.LEN_body (T : Type) (N : Usize) : Result Usize := Result.ok N def V.LEN (T : Type) (N : Usize) : Usize := eval_global (V.LEN_body T N) /- [constants::use_v]: Source: 'src/constants.rs', lines 94:0-94:42 -/ def use_v (T : Type) (N : Usize) : Result Usize := - Result.ret (V.LEN T N) + Result.ok (V.LEN T N) end constants diff --git a/tests/lean/Demo/Demo.lean b/tests/lean/Demo/Demo.lean index 6d9fef8e..3a3aeb96 100644 --- a/tests/lean/Demo/Demo.lean +++ b/tests/lean/Demo/Demo.lean @@ -12,10 +12,10 @@ def choose Result (T × (T → Result (T × T))) := if b - then let back := fun ret => Result.ret (ret, y) - Result.ret (x, back) - else let back := fun ret => Result.ret (x, ret) - Result.ret (y, back) + then let back := fun ret => Result.ok (ret, y) + Result.ok (x, back) + else let back := fun ret => Result.ok (x, ret) + Result.ok (y, back) /- [demo::mul2_add1]: Source: 'src/demo.rs', lines 13:0-13:31 -/ @@ -43,7 +43,7 @@ def use_incr : Result Unit := let x ← incr 0#u32 let x1 ← incr x let _ ← incr x1 - Result.ret () + Result.ok () /- [demo::CList] Source: 'src/demo.rs', lines 34:0-34:17 -/ @@ -57,7 +57,7 @@ divergent def list_nth (T : Type) (l : CList T) (i : U32) : Result T := match l with | CList.CCons x tl => if i = 0#u32 - then Result.ret x + then Result.ok x else do let i1 ← i - 1#u32 list_nth T tl i1 @@ -73,8 +73,8 @@ divergent def list_nth_mut | CList.CCons x tl => if i = 0#u32 then - let back := fun ret => Result.ret (CList.CCons ret tl) - Result.ret (x, back) + let back := fun ret => Result.ok (CList.CCons ret tl) + Result.ok (x, back) else do let i1 ← i - 1#u32 @@ -83,8 +83,8 @@ divergent def list_nth_mut fun ret => do let tl1 ← list_nth_mut_back ret - Result.ret (CList.CCons x tl1) - Result.ret (t, back) + Result.ok (CList.CCons x tl1) + Result.ok (t, back) | CList.CNil => Result.fail .panic /- [demo::list_nth_mut1]: loop 0: @@ -97,8 +97,8 @@ divergent def list_nth_mut1_loop | CList.CCons x tl => if i = 0#u32 then - let back := fun ret => Result.ret (CList.CCons ret tl) - Result.ret (x, back) + let back := fun ret => Result.ok (CList.CCons ret tl) + Result.ok (x, back) else do let i1 ← i - 1#u32 @@ -106,8 +106,8 @@ divergent def list_nth_mut1_loop let back1 := fun ret => do let tl1 ← back ret - Result.ret (CList.CCons x tl1) - Result.ret (t, back1) + Result.ok (CList.CCons x tl1) + Result.ok (t, back1) | CList.CNil => Result.fail .panic /- [demo::list_nth_mut1]: @@ -122,7 +122,7 @@ def list_nth_mut1 Source: 'src/demo.rs', lines 80:0-80:28 -/ divergent def i32_id (i : I32) : Result I32 := if i = 0#i32 - then Result.ret 0#i32 + then Result.ok 0#i32 else do let i1 ← i - 1#i32 let i2 ← i32_id i1 @@ -142,9 +142,9 @@ divergent def list_tail fun ret => do let tl1 ← list_tail_back ret - Result.ret (CList.CCons t tl1) - Result.ret (c, back) - | CList.CNil => Result.ret (CList.CNil, Result.ret) + Result.ok (CList.CCons t tl1) + Result.ok (c, back) + | CList.CNil => Result.ok (CList.CNil, Result.ok) /- Trait declaration: [demo::Counter] Source: 'src/demo.rs', lines 97:0-97:17 -/ @@ -156,7 +156,7 @@ structure Counter (Self : Type) where def CounterUsize.incr (self : Usize) : Result (Usize × Usize) := do let self1 ← self + 1#usize - Result.ret (self, self1) + Result.ok (self, self1) /- Trait implementation: [demo::{(demo::Counter for usize)}] Source: 'src/demo.rs', lines 101:0-101:22 -/ diff --git a/tests/lean/External/Funs.lean b/tests/lean/External/Funs.lean index cfb2cb3c..78e0f95c 100644 --- a/tests/lean/External/Funs.lean +++ b/tests/lean/External/Funs.lean @@ -26,10 +26,10 @@ def test_new_non_zero_u32 def test_vec : Result Unit := do let _ ← alloc.vec.Vec.push U32 (alloc.vec.Vec.new U32) 0#u32 - Result.ret () + Result.ok () /- Unit test for [external::test_vec] -/ -#assert (test_vec == Result.ret ()) +#assert (test_vec == Result.ok ()) /- [external::custom_swap]: Source: 'src/external.rs', lines 24:0-24:66 -/ @@ -39,8 +39,8 @@ def custom_swap := do let (st1, (x1, y1)) ← core.mem.swap T x y st - let back := fun ret st2 => Result.ret (st2, (ret, y1)) - Result.ret (st1, (x1, back)) + let back := fun ret st2 => Result.ok (st2, (ret, y1)) + Result.ok (st1, (x1, back)) /- [external::test_custom_swap]: Source: 'src/external.rs', lines 29:0-29:59 -/ @@ -49,7 +49,7 @@ def test_custom_swap do let (st1, (_, custom_swap_back)) ← custom_swap U32 x y st let (_, (x1, y1)) ← custom_swap_back 1#u32 st1 - Result.ret (st1, (x1, y1)) + Result.ok (st1, (x1, y1)) /- [external::test_swap_non_zero]: Source: 'src/external.rs', lines 35:0-35:44 -/ @@ -59,6 +59,6 @@ def test_swap_non_zero (x : U32) (st : State) : Result (State × U32) := let (x1, _) := p if x1 = 0#u32 then Result.fail .panic - else Result.ret (st1, x1) + else Result.ok (st1, x1) end external diff --git a/tests/lean/Hashmap/Funs.lean b/tests/lean/Hashmap/Funs.lean index 363d751a..9cbd958c 100644 --- a/tests/lean/Hashmap/Funs.lean +++ b/tests/lean/Hashmap/Funs.lean @@ -9,7 +9,7 @@ namespace hashmap /- [hashmap::hash_key]: Source: 'src/hashmap.rs', lines 27:0-27:32 -/ def hash_key (k : Usize) : Result Usize := - Result.ret k + Result.ok k /- [hashmap::{hashmap::HashMap}::allocate_slots]: loop 0: Source: 'src/hashmap.rs', lines 50:4-56:5 -/ @@ -23,7 +23,7 @@ divergent def HashMap.allocate_slots_loop let slots1 ← alloc.vec.Vec.push (List T) slots List.Nil let n1 ← n - 1#usize HashMap.allocate_slots_loop T slots1 n1 - else Result.ret slots + else Result.ok slots /- [hashmap::{hashmap::HashMap}::allocate_slots]: Source: 'src/hashmap.rs', lines 50:4-50:76 -/ @@ -44,7 +44,7 @@ def HashMap.new_with_capacity let slots ← HashMap.allocate_slots T (alloc.vec.Vec.new (List T)) capacity let i ← capacity * max_load_dividend let i1 ← i / max_load_divisor - Result.ret + Result.ok { num_entries := 0#usize, max_load_factor := (max_load_dividend, max_load_divisor), @@ -73,19 +73,19 @@ divergent def HashMap.clear_loop let i2 ← i + 1#usize let slots1 ← index_mut_back List.Nil HashMap.clear_loop T slots1 i2 - else Result.ret slots + else Result.ok slots /- [hashmap::{hashmap::HashMap}::clear]: Source: 'src/hashmap.rs', lines 80:4-80:27 -/ def HashMap.clear (T : Type) (self : HashMap T) : Result (HashMap T) := do let hm ← HashMap.clear_loop T self.slots 0#usize - Result.ret { self with num_entries := 0#usize, slots := hm } + Result.ok { self with num_entries := 0#usize, slots := hm } /- [hashmap::{hashmap::HashMap}::len]: Source: 'src/hashmap.rs', lines 90:4-90:30 -/ def HashMap.len (T : Type) (self : HashMap T) : Result Usize := - Result.ret self.num_entries + Result.ok self.num_entries /- [hashmap::{hashmap::HashMap}::insert_in_list]: loop 0: Source: 'src/hashmap.rs', lines 97:4-114:5 -/ @@ -96,12 +96,12 @@ divergent def HashMap.insert_in_list_loop match ls with | List.Cons ckey cvalue tl => if ckey = key - then Result.ret (false, List.Cons ckey value tl) + then Result.ok (false, List.Cons ckey value tl) else do let (b, tl1) ← HashMap.insert_in_list_loop T key value tl - Result.ret (b, List.Cons ckey cvalue tl1) - | List.Nil => Result.ret (true, List.Cons key value List.Nil) + Result.ok (b, List.Cons ckey cvalue tl1) + | List.Nil => Result.ok (true, List.Cons key value List.Nil) /- [hashmap::{hashmap::HashMap}::insert_in_list]: Source: 'src/hashmap.rs', lines 97:4-97:71 -/ @@ -130,10 +130,10 @@ def HashMap.insert_no_resize do let i1 ← self.num_entries + 1#usize let v ← index_mut_back l1 - Result.ret { self with num_entries := i1, slots := v } + Result.ok { self with num_entries := i1, slots := v } else do let v ← index_mut_back l1 - Result.ret { self with slots := v } + Result.ok { self with slots := v } /- [hashmap::{hashmap::HashMap}::move_elements_from_list]: loop 0: Source: 'src/hashmap.rs', lines 183:4-196:5 -/ @@ -144,7 +144,7 @@ divergent def HashMap.move_elements_from_list_loop do let ntable1 ← HashMap.insert_no_resize T ntable k v HashMap.move_elements_from_list_loop T ntable1 tl - | List.Nil => Result.ret ntable + | List.Nil => Result.ok ntable /- [hashmap::{hashmap::HashMap}::move_elements_from_list]: Source: 'src/hashmap.rs', lines 183:4-183:72 -/ @@ -171,7 +171,7 @@ divergent def HashMap.move_elements_loop let i2 ← i + 1#usize let slots1 ← index_mut_back l1 HashMap.move_elements_loop T ntable1 slots1 i2 - else Result.ret (ntable, slots) + else Result.ok (ntable, slots) /- [hashmap::{hashmap::HashMap}::move_elements]: Source: 'src/hashmap.rs', lines 171:4-171:95 -/ @@ -198,13 +198,13 @@ def HashMap.try_resize (T : Type) (self : HashMap T) : Result (HashMap T) := let ntable ← HashMap.new_with_capacity T i3 i i1 let p ← HashMap.move_elements T ntable self.slots 0#usize let (ntable1, _) := p - Result.ret + Result.ok { ntable1 with num_entries := self.num_entries, max_load_factor := (i, i1) } - else Result.ret { self with max_load_factor := (i, i1) } + else Result.ok { self with max_load_factor := (i, i1) } /- [hashmap::{hashmap::HashMap}::insert]: Source: 'src/hashmap.rs', lines 129:4-129:48 -/ @@ -217,7 +217,7 @@ def HashMap.insert let i ← HashMap.len T self1 if i > self1.max_load then HashMap.try_resize T self1 - else Result.ret self1 + else Result.ok self1 /- [hashmap::{hashmap::HashMap}::contains_key_in_list]: loop 0: Source: 'src/hashmap.rs', lines 206:4-219:5 -/ @@ -226,9 +226,9 @@ divergent def HashMap.contains_key_in_list_loop match ls with | List.Cons ckey _ tl => if ckey = key - then Result.ret true + then Result.ok true else HashMap.contains_key_in_list_loop T key tl - | List.Nil => Result.ret false + | List.Nil => Result.ok false /- [hashmap::{hashmap::HashMap}::contains_key_in_list]: Source: 'src/hashmap.rs', lines 206:4-206:68 -/ @@ -256,7 +256,7 @@ divergent def HashMap.get_in_list_loop match ls with | List.Cons ckey cvalue tl => if ckey = key - then Result.ret cvalue + then Result.ok cvalue else HashMap.get_in_list_loop T key tl | List.Nil => Result.fail .panic @@ -287,8 +287,8 @@ divergent def HashMap.get_mut_in_list_loop | List.Cons ckey cvalue tl => if ckey = key then - let back := fun ret => Result.ret (List.Cons ckey ret tl) - Result.ret (cvalue, back) + let back := fun ret => Result.ok (List.Cons ckey ret tl) + Result.ok (cvalue, back) else do let (t, back) ← HashMap.get_mut_in_list_loop T tl key @@ -296,8 +296,8 @@ divergent def HashMap.get_mut_in_list_loop fun ret => do let tl1 ← back ret - Result.ret (List.Cons ckey cvalue tl1) - Result.ret (t, back1) + Result.ok (List.Cons ckey cvalue tl1) + Result.ok (t, back1) | List.Nil => Result.fail .panic /- [hashmap::{hashmap::HashMap}::get_mut_in_list]: @@ -327,8 +327,8 @@ def HashMap.get_mut do let l1 ← get_mut_in_list_back ret let v ← index_mut_back l1 - Result.ret { self with slots := v } - Result.ret (t, back) + Result.ok { self with slots := v } + Result.ok (t, back) /- [hashmap::{hashmap::HashMap}::remove_from_list]: loop 0: Source: 'src/hashmap.rs', lines 265:4-291:5 -/ @@ -341,13 +341,13 @@ divergent def HashMap.remove_from_list_loop let (mv_ls, _) := core.mem.replace (List T) (List.Cons ckey t tl) List.Nil match mv_ls with - | List.Cons _ cvalue tl1 => Result.ret (some cvalue, tl1) + | List.Cons _ cvalue tl1 => Result.ok (some cvalue, tl1) | List.Nil => Result.fail .panic else do let (o, tl1) ← HashMap.remove_from_list_loop T key tl - Result.ret (o, List.Cons ckey t tl1) - | List.Nil => Result.ret (none, List.Nil) + Result.ok (o, List.Cons ckey t tl1) + | List.Nil => Result.ok (none, List.Nil) /- [hashmap::{hashmap::HashMap}::remove_from_list]: Source: 'src/hashmap.rs', lines 265:4-265:69 -/ @@ -373,12 +373,12 @@ def HashMap.remove | none => do let v ← index_mut_back l1 - Result.ret (none, { self with slots := v }) + Result.ok (none, { self with slots := v }) | some x1 => do let i1 ← self.num_entries - 1#usize let v ← index_mut_back l1 - Result.ret (some x1, { self with num_entries := i1, slots := v }) + Result.ok (some x1, { self with num_entries := i1, slots := v }) /- [hashmap::test1]: Source: 'src/hashmap.rs', lines 315:0-315:10 -/ @@ -422,6 +422,6 @@ def test1 : Result Unit := let i4 ← HashMap.get U64 hm6 1056#usize if ¬ (i4 = 256#u64) then Result.fail .panic - else Result.ret () + else Result.ok () end hashmap diff --git a/tests/lean/HashmapMain/Funs.lean b/tests/lean/HashmapMain/Funs.lean index 6fac6940..e985ec6a 100644 --- a/tests/lean/HashmapMain/Funs.lean +++ b/tests/lean/HashmapMain/Funs.lean @@ -10,7 +10,7 @@ namespace hashmap_main /- [hashmap_main::hashmap::hash_key]: Source: 'src/hashmap.rs', lines 27:0-27:32 -/ def hashmap.hash_key (k : Usize) : Result Usize := - Result.ret k + Result.ok k /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::allocate_slots]: loop 0: Source: 'src/hashmap.rs', lines 50:4-56:5 -/ @@ -24,7 +24,7 @@ divergent def hashmap.HashMap.allocate_slots_loop let slots1 ← alloc.vec.Vec.push (hashmap.List T) slots hashmap.List.Nil let n1 ← n - 1#usize hashmap.HashMap.allocate_slots_loop T slots1 n1 - else Result.ret slots + else Result.ok slots /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::allocate_slots]: Source: 'src/hashmap.rs', lines 50:4-50:76 -/ @@ -47,7 +47,7 @@ def hashmap.HashMap.new_with_capacity capacity let i ← capacity * max_load_dividend let i1 ← i / max_load_divisor - Result.ret + Result.ok { num_entries := 0#usize, max_load_factor := (max_load_dividend, max_load_divisor), @@ -76,7 +76,7 @@ divergent def hashmap.HashMap.clear_loop let i2 ← i + 1#usize let slots1 ← index_mut_back hashmap.List.Nil hashmap.HashMap.clear_loop T slots1 i2 - else Result.ret slots + else Result.ok slots /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::clear]: Source: 'src/hashmap.rs', lines 80:4-80:27 -/ @@ -84,12 +84,12 @@ def hashmap.HashMap.clear (T : Type) (self : hashmap.HashMap T) : Result (hashmap.HashMap T) := do let hm ← hashmap.HashMap.clear_loop T self.slots 0#usize - Result.ret { self with num_entries := 0#usize, slots := hm } + Result.ok { self with num_entries := 0#usize, slots := hm } /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::len]: Source: 'src/hashmap.rs', lines 90:4-90:30 -/ def hashmap.HashMap.len (T : Type) (self : hashmap.HashMap T) : Result Usize := - Result.ret self.num_entries + Result.ok self.num_entries /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: loop 0: Source: 'src/hashmap.rs', lines 97:4-114:5 -/ @@ -100,13 +100,13 @@ divergent def hashmap.HashMap.insert_in_list_loop match ls with | hashmap.List.Cons ckey cvalue tl => if ckey = key - then Result.ret (false, hashmap.List.Cons ckey value tl) + then Result.ok (false, hashmap.List.Cons ckey value tl) else do let (b, tl1) ← hashmap.HashMap.insert_in_list_loop T key value tl - Result.ret (b, hashmap.List.Cons ckey cvalue tl1) + Result.ok (b, hashmap.List.Cons ckey cvalue tl1) | hashmap.List.Nil => - Result.ret (true, hashmap.List.Cons key value hashmap.List.Nil) + Result.ok (true, hashmap.List.Cons key value hashmap.List.Nil) /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert_in_list]: Source: 'src/hashmap.rs', lines 97:4-97:71 -/ @@ -136,10 +136,10 @@ def hashmap.HashMap.insert_no_resize do let i1 ← self.num_entries + 1#usize let v ← index_mut_back l1 - Result.ret { self with num_entries := i1, slots := v } + Result.ok { self with num_entries := i1, slots := v } else do let v ← index_mut_back l1 - Result.ret { self with slots := v } + Result.ok { self with slots := v } /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements_from_list]: loop 0: Source: 'src/hashmap.rs', lines 183:4-196:5 -/ @@ -152,7 +152,7 @@ divergent def hashmap.HashMap.move_elements_from_list_loop do let ntable1 ← hashmap.HashMap.insert_no_resize T ntable k v hashmap.HashMap.move_elements_from_list_loop T ntable1 tl - | hashmap.List.Nil => Result.ret ntable + | hashmap.List.Nil => Result.ok ntable /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements_from_list]: Source: 'src/hashmap.rs', lines 183:4-183:72 -/ @@ -181,7 +181,7 @@ divergent def hashmap.HashMap.move_elements_loop let i2 ← i + 1#usize let slots1 ← index_mut_back l1 hashmap.HashMap.move_elements_loop T ntable1 slots1 i2 - else Result.ret (ntable, slots) + else Result.ok (ntable, slots) /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::move_elements]: Source: 'src/hashmap.rs', lines 171:4-171:95 -/ @@ -209,13 +209,13 @@ def hashmap.HashMap.try_resize let ntable ← hashmap.HashMap.new_with_capacity T i3 i i1 let p ← hashmap.HashMap.move_elements T ntable self.slots 0#usize let (ntable1, _) := p - Result.ret + Result.ok { ntable1 with num_entries := self.num_entries, max_load_factor := (i, i1) } - else Result.ret { self with max_load_factor := (i, i1) } + else Result.ok { self with max_load_factor := (i, i1) } /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::insert]: Source: 'src/hashmap.rs', lines 129:4-129:48 -/ @@ -228,7 +228,7 @@ def hashmap.HashMap.insert let i ← hashmap.HashMap.len T self1 if i > self1.max_load then hashmap.HashMap.try_resize T self1 - else Result.ret self1 + else Result.ok self1 /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key_in_list]: loop 0: Source: 'src/hashmap.rs', lines 206:4-219:5 -/ @@ -237,9 +237,9 @@ divergent def hashmap.HashMap.contains_key_in_list_loop match ls with | hashmap.List.Cons ckey _ tl => if ckey = key - then Result.ret true + then Result.ok true else hashmap.HashMap.contains_key_in_list_loop T key tl - | hashmap.List.Nil => Result.ret false + | hashmap.List.Nil => Result.ok false /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::contains_key_in_list]: Source: 'src/hashmap.rs', lines 206:4-206:68 -/ @@ -268,7 +268,7 @@ divergent def hashmap.HashMap.get_in_list_loop match ls with | hashmap.List.Cons ckey cvalue tl => if ckey = key - then Result.ret cvalue + then Result.ok cvalue else hashmap.HashMap.get_in_list_loop T key tl | hashmap.List.Nil => Result.fail .panic @@ -302,8 +302,8 @@ divergent def hashmap.HashMap.get_mut_in_list_loop | hashmap.List.Cons ckey cvalue tl => if ckey = key then - let back := fun ret => Result.ret (hashmap.List.Cons ckey ret tl) - Result.ret (cvalue, back) + let back := fun ret => Result.ok (hashmap.List.Cons ckey ret tl) + Result.ok (cvalue, back) else do let (t, back) ← hashmap.HashMap.get_mut_in_list_loop T tl key @@ -311,8 +311,8 @@ divergent def hashmap.HashMap.get_mut_in_list_loop fun ret => do let tl1 ← back ret - Result.ret (hashmap.List.Cons ckey cvalue tl1) - Result.ret (t, back1) + Result.ok (hashmap.List.Cons ckey cvalue tl1) + Result.ok (t, back1) | hashmap.List.Nil => Result.fail .panic /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::get_mut_in_list]: @@ -343,8 +343,8 @@ def hashmap.HashMap.get_mut do let l1 ← get_mut_in_list_back ret let v ← index_mut_back l1 - Result.ret { self with slots := v } - Result.ret (t, back) + Result.ok { self with slots := v } + Result.ok (t, back) /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: loop 0: Source: 'src/hashmap.rs', lines 265:4-291:5 -/ @@ -360,13 +360,13 @@ divergent def hashmap.HashMap.remove_from_list_loop core.mem.replace (hashmap.List T) (hashmap.List.Cons ckey t tl) hashmap.List.Nil match mv_ls with - | hashmap.List.Cons _ cvalue tl1 => Result.ret (some cvalue, tl1) + | hashmap.List.Cons _ cvalue tl1 => Result.ok (some cvalue, tl1) | hashmap.List.Nil => Result.fail .panic else do let (o, tl1) ← hashmap.HashMap.remove_from_list_loop T key tl - Result.ret (o, hashmap.List.Cons ckey t tl1) - | hashmap.List.Nil => Result.ret (none, hashmap.List.Nil) + Result.ok (o, hashmap.List.Cons ckey t tl1) + | hashmap.List.Nil => Result.ok (none, hashmap.List.Nil) /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap}::remove_from_list]: Source: 'src/hashmap.rs', lines 265:4-265:69 -/ @@ -395,12 +395,12 @@ def hashmap.HashMap.remove | none => do let v ← index_mut_back l1 - Result.ret (none, { self with slots := v }) + Result.ok (none, { self with slots := v }) | some x1 => do let i1 ← self.num_entries - 1#usize let v ← index_mut_back l1 - Result.ret (some x1, { self with num_entries := i1, slots := v }) + Result.ok (some x1, { self with num_entries := i1, slots := v }) /- [hashmap_main::hashmap::test1]: Source: 'src/hashmap.rs', lines 315:0-315:10 -/ @@ -444,7 +444,7 @@ def hashmap.test1 : Result Unit := let i4 ← hashmap.HashMap.get U64 hm6 1056#usize if ¬ (i4 = 256#u64) then Result.fail .panic - else Result.ret () + else Result.ok () /- [hashmap_main::insert_on_disk]: Source: 'src/hashmap_main.rs', lines 7:0-7:43 -/ @@ -458,6 +458,6 @@ def insert_on_disk /- [hashmap_main::main]: Source: 'src/hashmap_main.rs', lines 16:0-16:13 -/ def main : Result Unit := - Result.ret () + Result.ok () end hashmap_main diff --git a/tests/lean/Loops.lean b/tests/lean/Loops.lean index 27434db8..eeba1add 100644 --- a/tests/lean/Loops.lean +++ b/tests/lean/Loops.lean @@ -65,7 +65,7 @@ divergent def sum_array_loop let s1 ← s + i1 let i2 ← i + 1#usize sum_array_loop N a i2 s1 - else Result.ret s + else Result.ok s /- [loops::sum_array]: Source: 'src/loops.rs', lines 50:0-50:52 -/ @@ -86,7 +86,7 @@ divergent def clear_loop let i2 ← i + 1#usize let v1 ← index_mut_back 0#u32 clear_loop v1 i2 - else Result.ret v + else Result.ok v /- [loops::clear]: Source: 'src/loops.rs', lines 62:0-62:30 -/ @@ -104,9 +104,9 @@ inductive List (T : Type) := divergent def list_mem_loop (x : U32) (ls : List U32) : Result Bool := match ls with | List.Cons y tl => if y = x - then Result.ret true + then Result.ok true else list_mem_loop x tl - | List.Nil => Result.ret false + | List.Nil => Result.ok false /- [loops::list_mem]: Source: 'src/loops.rs', lines 76:0-76:52 -/ @@ -121,8 +121,8 @@ divergent def list_nth_mut_loop_loop | List.Cons x tl => if i = 0#u32 then - let back := fun ret => Result.ret (List.Cons ret tl) - Result.ret (x, back) + let back := fun ret => Result.ok (List.Cons ret tl) + Result.ok (x, back) else do let i1 ← i - 1#u32 @@ -130,8 +130,8 @@ divergent def list_nth_mut_loop_loop let back1 := fun ret => do let tl1 ← back ret - Result.ret (List.Cons x tl1) - Result.ret (t, back1) + Result.ok (List.Cons x tl1) + Result.ok (t, back1) | List.Nil => Result.fail .panic /- [loops::list_nth_mut_loop]: @@ -147,7 +147,7 @@ divergent def list_nth_shared_loop_loop match ls with | List.Cons x tl => if i = 0#u32 - then Result.ret x + then Result.ok x else do let i1 ← i - 1#u32 list_nth_shared_loop_loop T tl i1 @@ -168,16 +168,16 @@ divergent def get_elem_mut_loop | List.Cons y tl => if y = x then - let back := fun ret => Result.ret (List.Cons ret tl) - Result.ret (y, back) + let back := fun ret => Result.ok (List.Cons ret tl) + Result.ok (y, back) else do let (i, back) ← get_elem_mut_loop x tl let back1 := fun ret => do let tl1 ← back ret - Result.ret (List.Cons y tl1) - Result.ret (i, back1) + Result.ok (List.Cons y tl1) + Result.ok (i, back1) | List.Nil => Result.fail .panic /- [loops::get_elem_mut]: @@ -194,7 +194,7 @@ def get_elem_mut let back1 := fun ret => do let l ← back ret index_mut_back l - Result.ret (i, back1) + Result.ok (i, back1) /- [loops::get_elem_shared]: loop 0: Source: 'src/loops.rs', lines 129:0-143:1 -/ @@ -202,7 +202,7 @@ divergent def get_elem_shared_loop (x : Usize) (ls : List Usize) : Result Usize := match ls with | List.Cons y tl => if y = x - then Result.ret y + then Result.ok y else get_elem_shared_loop x tl | List.Nil => Result.fail .panic @@ -222,12 +222,12 @@ def id_mut (T : Type) (ls : List T) : Result ((List T) × (List T → Result (List T))) := - Result.ret (ls, Result.ret) + Result.ok (ls, Result.ok) /- [loops::id_shared]: Source: 'src/loops.rs', lines 149:0-149:45 -/ def id_shared (T : Type) (ls : List T) : Result (List T) := - Result.ret ls + Result.ok ls /- [loops::list_nth_mut_loop_with_id]: loop 0: Source: 'src/loops.rs', lines 154:0-165:1 -/ @@ -237,8 +237,8 @@ divergent def list_nth_mut_loop_with_id_loop | List.Cons x tl => if i = 0#u32 then - let back := fun ret => Result.ret (List.Cons ret tl) - Result.ret (x, back) + let back := fun ret => Result.ok (List.Cons ret tl) + Result.ok (x, back) else do let i1 ← i - 1#u32 @@ -246,8 +246,8 @@ divergent def list_nth_mut_loop_with_id_loop let back1 := fun ret => do let tl1 ← back ret - Result.ret (List.Cons x tl1) - Result.ret (t, back1) + Result.ok (List.Cons x tl1) + Result.ok (t, back1) | List.Nil => Result.fail .panic /- [loops::list_nth_mut_loop_with_id]: @@ -260,7 +260,7 @@ def list_nth_mut_loop_with_id let back1 := fun ret => do let l ← back ret id_mut_back l - Result.ret (t, back1) + Result.ok (t, back1) /- [loops::list_nth_shared_loop_with_id]: loop 0: Source: 'src/loops.rs', lines 168:0-179:1 -/ @@ -269,7 +269,7 @@ divergent def list_nth_shared_loop_with_id_loop match ls with | List.Cons x tl => if i = 0#u32 - then Result.ret x + then Result.ok x else do let i1 ← i - 1#u32 list_nth_shared_loop_with_id_loop T i1 tl @@ -295,9 +295,9 @@ divergent def list_nth_mut_loop_pair_loop | List.Cons x1 tl1 => if i = 0#u32 then - let back'a := fun ret => Result.ret (List.Cons ret tl0) - let back'b := fun ret => Result.ret (List.Cons ret tl1) - Result.ret ((x0, x1), back'a, back'b) + let back'a := fun ret => Result.ok (List.Cons ret tl0) + let back'b := fun ret => Result.ok (List.Cons ret tl1) + Result.ok ((x0, x1), back'a, back'b) else do let i1 ← i - 1#u32 @@ -305,12 +305,12 @@ divergent def list_nth_mut_loop_pair_loop let back'a1 := fun ret => do let tl01 ← back'a ret - Result.ret (List.Cons x0 tl01) + Result.ok (List.Cons x0 tl01) let back'b1 := fun ret => do let tl11 ← back'b ret - Result.ret (List.Cons x1 tl11) - Result.ret (p, back'a1, back'b1) + Result.ok (List.Cons x1 tl11) + Result.ok (p, back'a1, back'b1) | List.Nil => Result.fail .panic | List.Nil => Result.fail .panic @@ -331,7 +331,7 @@ divergent def list_nth_shared_loop_pair_loop match ls1 with | List.Cons x1 tl1 => if i = 0#u32 - then Result.ret (x0, x1) + then Result.ok (x0, x1) else do let i1 ← i - 1#u32 list_nth_shared_loop_pair_loop T tl0 tl1 i1 @@ -359,8 +359,8 @@ divergent def list_nth_mut_loop_pair_merge_loop let back := fun ret => let (t, t1) := ret - Result.ret (List.Cons t tl0, List.Cons t1 tl1) - Result.ret ((x0, x1), back) + Result.ok (List.Cons t tl0, List.Cons t1 tl1) + Result.ok ((x0, x1), back) else do let i1 ← i - 1#u32 @@ -369,8 +369,8 @@ divergent def list_nth_mut_loop_pair_merge_loop fun ret => do let (tl01, tl11) ← back ret - Result.ret (List.Cons x0 tl01, List.Cons x1 tl11) - Result.ret (p, back1) + Result.ok (List.Cons x0 tl01, List.Cons x1 tl11) + Result.ok (p, back1) | List.Nil => Result.fail .panic | List.Nil => Result.fail .panic @@ -391,7 +391,7 @@ divergent def list_nth_shared_loop_pair_merge_loop match ls1 with | List.Cons x1 tl1 => if i = 0#u32 - then Result.ret (x0, x1) + then Result.ok (x0, x1) else do let i1 ← i - 1#u32 @@ -417,8 +417,8 @@ divergent def list_nth_mut_shared_loop_pair_loop | List.Cons x1 tl1 => if i = 0#u32 then - let back := fun ret => Result.ret (List.Cons ret tl0) - Result.ret ((x0, x1), back) + let back := fun ret => Result.ok (List.Cons ret tl0) + Result.ok ((x0, x1), back) else do let i1 ← i - 1#u32 @@ -426,8 +426,8 @@ divergent def list_nth_mut_shared_loop_pair_loop let back1 := fun ret => do let tl01 ← back ret - Result.ret (List.Cons x0 tl01) - Result.ret (p, back1) + Result.ok (List.Cons x0 tl01) + Result.ok (p, back1) | List.Nil => Result.fail .panic | List.Nil => Result.fail .panic @@ -451,8 +451,8 @@ divergent def list_nth_mut_shared_loop_pair_merge_loop | List.Cons x1 tl1 => if i = 0#u32 then - let back := fun ret => Result.ret (List.Cons ret tl0) - Result.ret ((x0, x1), back) + let back := fun ret => Result.ok (List.Cons ret tl0) + Result.ok ((x0, x1), back) else do let i1 ← i - 1#u32 @@ -460,8 +460,8 @@ divergent def list_nth_mut_shared_loop_pair_merge_loop let back1 := fun ret => do let tl01 ← back ret - Result.ret (List.Cons x0 tl01) - Result.ret (p, back1) + Result.ok (List.Cons x0 tl01) + Result.ok (p, back1) | List.Nil => Result.fail .panic | List.Nil => Result.fail .panic @@ -485,8 +485,8 @@ divergent def list_nth_shared_mut_loop_pair_loop | List.Cons x1 tl1 => if i = 0#u32 then - let back := fun ret => Result.ret (List.Cons ret tl1) - Result.ret ((x0, x1), back) + let back := fun ret => Result.ok (List.Cons ret tl1) + Result.ok ((x0, x1), back) else do let i1 ← i - 1#u32 @@ -494,8 +494,8 @@ divergent def list_nth_shared_mut_loop_pair_loop let back1 := fun ret => do let tl11 ← back ret - Result.ret (List.Cons x1 tl11) - Result.ret (p, back1) + Result.ok (List.Cons x1 tl11) + Result.ok (p, back1) | List.Nil => Result.fail .panic | List.Nil => Result.fail .panic @@ -519,8 +519,8 @@ divergent def list_nth_shared_mut_loop_pair_merge_loop | List.Cons x1 tl1 => if i = 0#u32 then - let back := fun ret => Result.ret (List.Cons ret tl1) - Result.ret ((x0, x1), back) + let back := fun ret => Result.ok (List.Cons ret tl1) + Result.ok ((x0, x1), back) else do let i1 ← i - 1#u32 @@ -528,8 +528,8 @@ divergent def list_nth_shared_mut_loop_pair_merge_loop let back1 := fun ret => do let tl11 ← back ret - Result.ret (List.Cons x1 tl11) - Result.ret (p, back1) + Result.ok (List.Cons x1 tl11) + Result.ok (p, back1) | List.Nil => Result.fail .panic | List.Nil => Result.fail .panic @@ -548,14 +548,14 @@ divergent def ignore_input_mut_borrow_loop (i : U32) : Result Unit := then do let i1 ← i - 1#u32 ignore_input_mut_borrow_loop i1 - else Result.ret () + else Result.ok () /- [loops::ignore_input_mut_borrow]: Source: 'src/loops.rs', lines 345:0-345:56 -/ def ignore_input_mut_borrow (_a : U32) (i : U32) : Result U32 := do let _ ← ignore_input_mut_borrow_loop i - Result.ret _a + Result.ok _a /- [loops::incr_ignore_input_mut_borrow]: loop 0: Source: 'src/loops.rs', lines 353:0-358:1 -/ @@ -564,7 +564,7 @@ divergent def incr_ignore_input_mut_borrow_loop (i : U32) : Result Unit := then do let i1 ← i - 1#u32 incr_ignore_input_mut_borrow_loop i1 - else Result.ret () + else Result.ok () /- [loops::incr_ignore_input_mut_borrow]: Source: 'src/loops.rs', lines 353:0-353:60 -/ @@ -572,7 +572,7 @@ def incr_ignore_input_mut_borrow (a : U32) (i : U32) : Result U32 := do let a1 ← a + 1#u32 let _ ← incr_ignore_input_mut_borrow_loop i - Result.ret a1 + Result.ok a1 /- [loops::ignore_input_shared_borrow]: loop 0: Source: 'src/loops.rs', lines 362:0-366:1 -/ @@ -581,13 +581,13 @@ divergent def ignore_input_shared_borrow_loop (i : U32) : Result Unit := then do let i1 ← i - 1#u32 ignore_input_shared_borrow_loop i1 - else Result.ret () + else Result.ok () /- [loops::ignore_input_shared_borrow]: Source: 'src/loops.rs', lines 362:0-362:59 -/ def ignore_input_shared_borrow (_a : U32) (i : U32) : Result U32 := do let _ ← ignore_input_shared_borrow_loop i - Result.ret _a + Result.ok _a end loops diff --git a/tests/lean/NoNestedBorrows.lean b/tests/lean/NoNestedBorrows.lean index b90f6aef..7d28f7f9 100644 --- a/tests/lean/NoNestedBorrows.lean +++ b/tests/lean/NoNestedBorrows.lean @@ -159,24 +159,24 @@ def cast_bool_to_i32 (x : Bool) : Result I32 := /- [no_nested_borrows::cast_bool_to_bool]: Source: 'src/no_nested_borrows.rs', lines 137:0-137:41 -/ def cast_bool_to_bool (x : Bool) : Result Bool := - Result.ret x + Result.ok x /- [no_nested_borrows::test2]: Source: 'src/no_nested_borrows.rs', lines 142:0-142:14 -/ def test2 : Result Unit := do let _ ← 23#u32 + 44#u32 - Result.ret () + Result.ok () /- Unit test for [no_nested_borrows::test2] -/ -#assert (test2 == Result.ret ()) +#assert (test2 == Result.ok ()) /- [no_nested_borrows::get_max]: Source: 'src/no_nested_borrows.rs', lines 154:0-154:37 -/ def get_max (x : U32) (y : U32) : Result U32 := if x >= y - then Result.ret x - else Result.ret y + then Result.ok x + else Result.ok y /- [no_nested_borrows::test3]: Source: 'src/no_nested_borrows.rs', lines 162:0-162:14 -/ @@ -187,10 +187,10 @@ def test3 : Result Unit := let z ← x + y if ¬ (z = 15#u32) then Result.fail .panic - else Result.ret () + else Result.ok () /- Unit test for [no_nested_borrows::test3] -/ -#assert (test3 == Result.ret ()) +#assert (test3 == Result.ok ()) /- [no_nested_borrows::test_neg1]: Source: 'src/no_nested_borrows.rs', lines 169:0-169:18 -/ @@ -199,20 +199,20 @@ def test_neg1 : Result Unit := let y ← -. 3#i32 if ¬ (y = (-3)#i32) then Result.fail .panic - else Result.ret () + else Result.ok () /- Unit test for [no_nested_borrows::test_neg1] -/ -#assert (test_neg1 == Result.ret ()) +#assert (test_neg1 == Result.ok ()) /- [no_nested_borrows::refs_test1]: Source: 'src/no_nested_borrows.rs', lines 176:0-176:19 -/ def refs_test1 : Result Unit := if ¬ (1#i32 = 1#i32) then Result.fail .panic - else Result.ret () + else Result.ok () /- Unit test for [no_nested_borrows::refs_test1] -/ -#assert (refs_test1 == Result.ret ()) +#assert (refs_test1 == Result.ok ()) /- [no_nested_borrows::refs_test2]: Source: 'src/no_nested_borrows.rs', lines 187:0-187:19 -/ @@ -227,18 +227,18 @@ def refs_test2 : Result Unit := then Result.fail .panic else if ¬ (2#i32 = 2#i32) then Result.fail .panic - else Result.ret () + else Result.ok () /- Unit test for [no_nested_borrows::refs_test2] -/ -#assert (refs_test2 == Result.ret ()) +#assert (refs_test2 == Result.ok ()) /- [no_nested_borrows::test_list1]: Source: 'src/no_nested_borrows.rs', lines 203:0-203:19 -/ def test_list1 : Result Unit := - Result.ret () + Result.ok () /- Unit test for [no_nested_borrows::test_list1] -/ -#assert (test_list1 == Result.ret ()) +#assert (test_list1 == Result.ok ()) /- [no_nested_borrows::test_box1]: Source: 'src/no_nested_borrows.rs', lines 208:0-208:18 -/ @@ -249,29 +249,29 @@ def test_box1 : Result Unit := let x ← alloc.boxed.Box.deref I32 b if ¬ (x = 1#i32) then Result.fail .panic - else Result.ret () + else Result.ok () /- Unit test for [no_nested_borrows::test_box1] -/ -#assert (test_box1 == Result.ret ()) +#assert (test_box1 == Result.ok ()) /- [no_nested_borrows::copy_int]: Source: 'src/no_nested_borrows.rs', lines 218:0-218:30 -/ def copy_int (x : I32) : Result I32 := - Result.ret x + Result.ok x /- [no_nested_borrows::test_unreachable]: Source: 'src/no_nested_borrows.rs', lines 224:0-224:32 -/ def test_unreachable (b : Bool) : Result Unit := if b then Result.fail .panic - else Result.ret () + else Result.ok () /- [no_nested_borrows::test_panic]: Source: 'src/no_nested_borrows.rs', lines 232:0-232:26 -/ def test_panic (b : Bool) : Result Unit := if b then Result.fail .panic - else Result.ret () + else Result.ok () /- [no_nested_borrows::test_copy_int]: Source: 'src/no_nested_borrows.rs', lines 239:0-239:22 -/ @@ -280,17 +280,17 @@ def test_copy_int : Result Unit := let y ← copy_int 0#i32 if ¬ (0#i32 = y) then Result.fail .panic - else Result.ret () + else Result.ok () /- Unit test for [no_nested_borrows::test_copy_int] -/ -#assert (test_copy_int == Result.ret ()) +#assert (test_copy_int == Result.ok ()) /- [no_nested_borrows::is_cons]: Source: 'src/no_nested_borrows.rs', lines 246:0-246:38 -/ def is_cons (T : Type) (l : List T) : Result Bool := match l with - | List.Cons _ _ => Result.ret true - | List.Nil => Result.ret false + | List.Cons _ _ => Result.ok true + | List.Nil => Result.ok false /- [no_nested_borrows::test_is_cons]: Source: 'src/no_nested_borrows.rs', lines 253:0-253:21 -/ @@ -299,16 +299,16 @@ def test_is_cons : Result Unit := let b ← is_cons I32 (List.Cons 0#i32 List.Nil) if ¬ b then Result.fail .panic - else Result.ret () + else Result.ok () /- Unit test for [no_nested_borrows::test_is_cons] -/ -#assert (test_is_cons == Result.ret ()) +#assert (test_is_cons == Result.ok ()) /- [no_nested_borrows::split_list]: Source: 'src/no_nested_borrows.rs', lines 259:0-259:48 -/ def split_list (T : Type) (l : List T) : Result (T × (List T)) := match l with - | List.Cons hd tl => Result.ret (hd, tl) + | List.Cons hd tl => Result.ok (hd, tl) | List.Nil => Result.fail .panic /- [no_nested_borrows::test_split_list]: @@ -319,10 +319,10 @@ def test_split_list : Result Unit := let (hd, _) := p if ¬ (hd = 0#i32) then Result.fail .panic - else Result.ret () + else Result.ok () /- Unit test for [no_nested_borrows::test_split_list] -/ -#assert (test_split_list == Result.ret ()) +#assert (test_split_list == Result.ok ()) /- [no_nested_borrows::choose]: Source: 'src/no_nested_borrows.rs', lines 274:0-274:70 -/ @@ -331,10 +331,10 @@ def choose Result (T × (T → Result (T × T))) := if b - then let back := fun ret => Result.ret (ret, y) - Result.ret (x, back) - else let back := fun ret => Result.ret (x, ret) - Result.ret (y, back) + then let back := fun ret => Result.ok (ret, y) + Result.ok (x, back) + else let back := fun ret => Result.ok (x, ret) + Result.ok (y, back) /- [no_nested_borrows::choose_test]: Source: 'src/no_nested_borrows.rs', lines 282:0-282:20 -/ @@ -351,15 +351,15 @@ def choose_test : Result Unit := then Result.fail .panic else if ¬ (y = 0#i32) then Result.fail .panic - else Result.ret () + else Result.ok () /- Unit test for [no_nested_borrows::choose_test] -/ -#assert (choose_test == Result.ret ()) +#assert (choose_test == Result.ok ()) /- [no_nested_borrows::test_char]: Source: 'src/no_nested_borrows.rs', lines 294:0-294:26 -/ def test_char : Result Char := - Result.ret 'a' + Result.ok 'a' mutual @@ -384,7 +384,7 @@ divergent def list_length (T : Type) (l : List T) : Result U32 := | List.Cons _ l1 => do let i ← list_length T l1 1#u32 + i - | List.Nil => Result.ret 0#u32 + | List.Nil => Result.ok 0#u32 /- [no_nested_borrows::list_nth_shared]: Source: 'src/no_nested_borrows.rs', lines 347:0-347:62 -/ @@ -392,7 +392,7 @@ divergent def list_nth_shared (T : Type) (l : List T) (i : U32) : Result T := match l with | List.Cons x tl => if i = 0#u32 - then Result.ret x + then Result.ok x else do let i1 ← i - 1#u32 list_nth_shared T tl i1 @@ -406,8 +406,8 @@ divergent def list_nth_mut | List.Cons x tl => if i = 0#u32 then - let back := fun ret => Result.ret (List.Cons ret tl) - Result.ret (x, back) + let back := fun ret => Result.ok (List.Cons ret tl) + Result.ok (x, back) else do let i1 ← i - 1#u32 @@ -416,8 +416,8 @@ divergent def list_nth_mut fun ret => do let tl1 ← list_nth_mut_back ret - Result.ret (List.Cons x tl1) - Result.ret (t, back) + Result.ok (List.Cons x tl1) + Result.ok (t, back) | List.Nil => Result.fail .panic /- [no_nested_borrows::list_rev_aux]: @@ -426,7 +426,7 @@ divergent def list_rev_aux (T : Type) (li : List T) (lo : List T) : Result (List T) := match li with | List.Cons hd tl => list_rev_aux T tl (List.Cons hd lo) - | List.Nil => Result.ret lo + | List.Nil => Result.ok lo /- [no_nested_borrows::list_rev]: Source: 'src/no_nested_borrows.rs', lines 393:0-393:42 -/ @@ -476,10 +476,10 @@ def test_list_functions : Result Unit := let i6 ← list_nth_shared I32 ls 2#u32 if ¬ (i6 = 2#i32) then Result.fail .panic - else Result.ret () + else Result.ok () /- Unit test for [no_nested_borrows::test_list_functions] -/ -#assert (test_list_functions == Result.ret ()) +#assert (test_list_functions == Result.ok ()) /- [no_nested_borrows::id_mut_pair1]: Source: 'src/no_nested_borrows.rs', lines 414:0-414:89 -/ @@ -487,7 +487,7 @@ def id_mut_pair1 (T1 T2 : Type) (x : T1) (y : T2) : Result ((T1 × T2) × ((T1 × T2) → Result (T1 × T2))) := - Result.ret ((x, y), Result.ret) + Result.ok ((x, y), Result.ok) /- [no_nested_borrows::id_mut_pair2]: Source: 'src/no_nested_borrows.rs', lines 418:0-418:88 -/ @@ -496,7 +496,7 @@ def id_mut_pair2 Result ((T1 × T2) × ((T1 × T2) → Result (T1 × T2))) := let (t, t1) := p - Result.ret ((t, t1), Result.ret) + Result.ok ((t, t1), Result.ok) /- [no_nested_borrows::id_mut_pair3]: Source: 'src/no_nested_borrows.rs', lines 422:0-422:93 -/ @@ -504,7 +504,7 @@ def id_mut_pair3 (T1 T2 : Type) (x : T1) (y : T2) : Result ((T1 × T2) × (T1 → Result T1) × (T2 → Result T2)) := - Result.ret ((x, y), Result.ret, Result.ret) + Result.ok ((x, y), Result.ok, Result.ok) /- [no_nested_borrows::id_mut_pair4]: Source: 'src/no_nested_borrows.rs', lines 426:0-426:92 -/ @@ -513,7 +513,7 @@ def id_mut_pair4 Result ((T1 × T2) × (T1 → Result T1) × (T2 → Result T2)) := let (t, t1) := p - Result.ret ((t, t1), Result.ret, Result.ret) + Result.ok ((t, t1), Result.ok, Result.ok) /- [no_nested_borrows::StructWithTuple] Source: 'src/no_nested_borrows.rs', lines 433:0-433:34 -/ @@ -523,17 +523,17 @@ structure StructWithTuple (T1 T2 : Type) where /- [no_nested_borrows::new_tuple1]: Source: 'src/no_nested_borrows.rs', lines 437:0-437:48 -/ def new_tuple1 : Result (StructWithTuple U32 U32) := - Result.ret { p := (1#u32, 2#u32) } + Result.ok { p := (1#u32, 2#u32) } /- [no_nested_borrows::new_tuple2]: Source: 'src/no_nested_borrows.rs', lines 441:0-441:48 -/ def new_tuple2 : Result (StructWithTuple I16 I16) := - Result.ret { p := (1#i16, 2#i16) } + Result.ok { p := (1#i16, 2#i16) } /- [no_nested_borrows::new_tuple3]: Source: 'src/no_nested_borrows.rs', lines 445:0-445:48 -/ def new_tuple3 : Result (StructWithTuple U64 I64) := - Result.ret { p := (1#u64, 2#i64) } + Result.ok { p := (1#u64, 2#i64) } /- [no_nested_borrows::StructWithPair] Source: 'src/no_nested_borrows.rs', lines 450:0-450:33 -/ @@ -543,7 +543,7 @@ structure StructWithPair (T1 T2 : Type) where /- [no_nested_borrows::new_pair1]: Source: 'src/no_nested_borrows.rs', lines 454:0-454:46 -/ def new_pair1 : Result (StructWithPair U32 U32) := - Result.ret { p := { x := 1#u32, y := 2#u32 } } + Result.ok { p := { x := 1#u32, y := 2#u32 } } /- [no_nested_borrows::test_constants]: Source: 'src/no_nested_borrows.rs', lines 462:0-462:23 -/ @@ -570,18 +570,18 @@ def test_constants : Result Unit := let swp ← new_pair1 if ¬ (swp.p.x = 1#u32) then Result.fail .panic - else Result.ret () + else Result.ok () /- Unit test for [no_nested_borrows::test_constants] -/ -#assert (test_constants == Result.ret ()) +#assert (test_constants == Result.ok ()) /- [no_nested_borrows::test_weird_borrows1]: Source: 'src/no_nested_borrows.rs', lines 471:0-471:28 -/ def test_weird_borrows1 : Result Unit := - Result.ret () + Result.ok () /- Unit test for [no_nested_borrows::test_weird_borrows1] -/ -#assert (test_weird_borrows1 == Result.ret ()) +#assert (test_weird_borrows1 == Result.ok ()) /- [no_nested_borrows::test_mem_replace]: Source: 'src/no_nested_borrows.rs', lines 481:0-481:37 -/ @@ -589,31 +589,31 @@ def test_mem_replace (px : U32) : Result U32 := let (y, _) := core.mem.replace U32 px 1#u32 if ¬ (y = 0#u32) then Result.fail .panic - else Result.ret 2#u32 + else Result.ok 2#u32 /- [no_nested_borrows::test_shared_borrow_bool1]: Source: 'src/no_nested_borrows.rs', lines 488:0-488:47 -/ def test_shared_borrow_bool1 (b : Bool) : Result U32 := if b - then Result.ret 0#u32 - else Result.ret 1#u32 + then Result.ok 0#u32 + else Result.ok 1#u32 /- [no_nested_borrows::test_shared_borrow_bool2]: Source: 'src/no_nested_borrows.rs', lines 501:0-501:40 -/ def test_shared_borrow_bool2 : Result U32 := - Result.ret 0#u32 + Result.ok 0#u32 /- [no_nested_borrows::test_shared_borrow_enum1]: Source: 'src/no_nested_borrows.rs', lines 516:0-516:52 -/ def test_shared_borrow_enum1 (l : List U32) : Result U32 := match l with - | List.Cons _ _ => Result.ret 1#u32 - | List.Nil => Result.ret 0#u32 + | List.Cons _ _ => Result.ok 1#u32 + | List.Nil => Result.ok 0#u32 /- [no_nested_borrows::test_shared_borrow_enum2]: Source: 'src/no_nested_borrows.rs', lines 528:0-528:40 -/ def test_shared_borrow_enum2 : Result U32 := - Result.ret 0#u32 + Result.ok 0#u32 /- [no_nested_borrows::incr]: Source: 'src/no_nested_borrows.rs', lines 539:0-539:24 -/ @@ -630,7 +630,7 @@ def call_incr (x : U32) : Result U32 := def read_then_incr (x : U32) : Result (U32 × U32) := do let x1 ← x + 1#u32 - Result.ret (x, x1) + Result.ok (x, x1) /- [no_nested_borrows::Tuple] Source: 'src/no_nested_borrows.rs', lines 554:0-554:24 -/ @@ -639,12 +639,12 @@ def Tuple (T1 T2 : Type) := T1 × T2 /- [no_nested_borrows::use_tuple_struct]: Source: 'src/no_nested_borrows.rs', lines 556:0-556:48 -/ def use_tuple_struct (x : Tuple U32 U32) : Result (Tuple U32 U32) := - Result.ret (1#u32, x.#1) + Result.ok (1#u32, x.#1) /- [no_nested_borrows::create_tuple_struct]: Source: 'src/no_nested_borrows.rs', lines 560:0-560:61 -/ def create_tuple_struct (x : U32) (y : U64) : Result (Tuple U32 U64) := - Result.ret (x, y) + Result.ok (x, y) /- [no_nested_borrows::IdType] Source: 'src/no_nested_borrows.rs', lines 565:0-565:20 -/ @@ -653,11 +653,11 @@ def create_tuple_struct (x : U32) (y : U64) : Result (Tuple U32 U64) := /- [no_nested_borrows::use_id_type]: Source: 'src/no_nested_borrows.rs', lines 567:0-567:40 -/ def use_id_type (T : Type) (x : IdType T) : Result T := - Result.ret x + Result.ok x /- [no_nested_borrows::create_id_type]: Source: 'src/no_nested_borrows.rs', lines 571:0-571:43 -/ def create_id_type (T : Type) (x : T) : Result (IdType T) := - Result.ret x + Result.ok x end no_nested_borrows diff --git a/tests/lean/Paper.lean b/tests/lean/Paper.lean index 5b00aa83..32203eca 100644 --- a/tests/lean/Paper.lean +++ b/tests/lean/Paper.lean @@ -17,10 +17,10 @@ def test_incr : Result Unit := let x ← ref_incr 0#i32 if ¬ (x = 1#i32) then Result.fail .panic - else Result.ret () + else Result.ok () /- Unit test for [paper::test_incr] -/ -#assert (test_incr == Result.ret ()) +#assert (test_incr == Result.ok ()) /- [paper::choose]: Source: 'src/paper.rs', lines 15:0-15:70 -/ @@ -29,10 +29,10 @@ def choose Result (T × (T → Result (T × T))) := if b - then let back := fun ret => Result.ret (ret, y) - Result.ret (x, back) - else let back := fun ret => Result.ret (x, ret) - Result.ret (y, back) + then let back := fun ret => Result.ok (ret, y) + Result.ok (x, back) + else let back := fun ret => Result.ok (x, ret) + Result.ok (y, back) /- [paper::test_choose]: Source: 'src/paper.rs', lines 23:0-23:20 -/ @@ -49,10 +49,10 @@ def test_choose : Result Unit := then Result.fail .panic else if ¬ (y = 0#i32) then Result.fail .panic - else Result.ret () + else Result.ok () /- Unit test for [paper::test_choose] -/ -#assert (test_choose == Result.ret ()) +#assert (test_choose == Result.ok ()) /- [paper::List] Source: 'src/paper.rs', lines 35:0-35:16 -/ @@ -68,8 +68,8 @@ divergent def list_nth_mut | List.Cons x tl => if i = 0#u32 then - let back := fun ret => Result.ret (List.Cons ret tl) - Result.ret (x, back) + let back := fun ret => Result.ok (List.Cons ret tl) + Result.ok (x, back) else do let i1 ← i - 1#u32 @@ -78,8 +78,8 @@ divergent def list_nth_mut fun ret => do let tl1 ← list_nth_mut_back ret - Result.ret (List.Cons x tl1) - Result.ret (t, back) + Result.ok (List.Cons x tl1) + Result.ok (t, back) | List.Nil => Result.fail .panic /- [paper::sum]: @@ -89,7 +89,7 @@ divergent def sum (l : List I32) : Result I32 := | List.Cons x tl => do let i ← sum tl x + i - | List.Nil => Result.ret 0#i32 + | List.Nil => Result.ok 0#i32 /- [paper::test_nth]: Source: 'src/paper.rs', lines 68:0-68:17 -/ @@ -103,10 +103,10 @@ def test_nth : Result Unit := let i ← sum l2 if ¬ (i = 7#i32) then Result.fail .panic - else Result.ret () + else Result.ok () /- Unit test for [paper::test_nth] -/ -#assert (test_nth == Result.ret ()) +#assert (test_nth == Result.ok ()) /- [paper::call_choose]: Source: 'src/paper.rs', lines 76:0-76:44 -/ @@ -116,6 +116,6 @@ def call_choose (p : (U32 × U32)) : Result U32 := let (pz, choose_back) ← choose U32 true px py let pz1 ← pz + 1#u32 let (px1, _) ← choose_back pz1 - Result.ret px1 + Result.ok px1 end paper diff --git a/tests/lean/PoloniusList.lean b/tests/lean/PoloniusList.lean index c657237f..09f41056 100644 --- a/tests/lean/PoloniusList.lean +++ b/tests/lean/PoloniusList.lean @@ -20,7 +20,7 @@ divergent def get_list_at_x match ls with | List.Cons hd tl => if hd = x - then Result.ret (List.Cons hd tl, Result.ret) + then Result.ok (List.Cons hd tl, Result.ok) else do let (l, get_list_at_x_back) ← get_list_at_x tl x @@ -28,8 +28,8 @@ divergent def get_list_at_x fun ret => do let tl1 ← get_list_at_x_back ret - Result.ret (List.Cons hd tl1) - Result.ret (l, back) - | List.Nil => Result.ret (List.Nil, Result.ret) + Result.ok (List.Cons hd tl1) + Result.ok (l, back) + | List.Nil => Result.ok (List.Nil, Result.ok) end polonius_list diff --git a/tests/lean/Traits.lean b/tests/lean/Traits.lean index 766b109d..0076e6f6 100644 --- a/tests/lean/Traits.lean +++ b/tests/lean/Traits.lean @@ -13,7 +13,7 @@ structure BoolTrait (Self : Type) where /- [traits::{(traits::BoolTrait for bool)}::get_bool]: Source: 'src/traits.rs', lines 12:4-12:30 -/ def BoolTraitBool.get_bool (self : Bool) : Result Bool := - Result.ret self + Result.ok self /- Trait implementation: [traits::{(traits::BoolTrait for bool)}] Source: 'src/traits.rs', lines 11:0-11:23 -/ @@ -25,7 +25,7 @@ def BoolTraitBool : BoolTrait Bool := { Source: 'src/traits.rs', lines 6:4-6:30 -/ def BoolTrait.ret_true {Self : Type} (self_clause : BoolTrait Self) (self : Self) : Result Bool := - Result.ret true + Result.ok true /- [traits::test_bool_trait_bool]: Source: 'src/traits.rs', lines 17:0-17:44 -/ @@ -34,14 +34,14 @@ def test_bool_trait_bool (x : Bool) : Result Bool := let b ← BoolTraitBool.get_bool x if b then BoolTrait.ret_true BoolTraitBool x - else Result.ret false + else Result.ok false /- [traits::{(traits::BoolTrait for core::option::Option)#1}::get_bool]: Source: 'src/traits.rs', lines 23:4-23:30 -/ def BoolTraitOption.get_bool (T : Type) (self : Option T) : Result Bool := match self with - | none => Result.ret false - | some _ => Result.ret true + | none => Result.ok false + | some _ => Result.ok true /- Trait implementation: [traits::{(traits::BoolTrait for core::option::Option)#1}] Source: 'src/traits.rs', lines 22:0-22:31 -/ @@ -56,7 +56,7 @@ def test_bool_trait_option (T : Type) (x : Option T) : Result Bool := let b ← BoolTraitOption.get_bool T x if b then BoolTrait.ret_true (BoolTraitOption T) x - else Result.ret false + else Result.ok false /- [traits::test_bool_trait]: Source: 'src/traits.rs', lines 35:0-35:50 -/ @@ -72,7 +72,7 @@ structure ToU64 (Self : Type) where /- [traits::{(traits::ToU64 for u64)#2}::to_u64]: Source: 'src/traits.rs', lines 44:4-44:26 -/ def ToU64U64.to_u64 (self : U64) : Result U64 := - Result.ret self + Result.ok self /- Trait implementation: [traits::{(traits::ToU64 for u64)#2}] Source: 'src/traits.rs', lines 43:0-43:18 -/ @@ -148,7 +148,7 @@ structure ToType (Self T : Type) where /- [traits::{(traits::ToType for u64)#5}::to_type]: Source: 'src/traits.rs', lines 93:4-93:28 -/ def ToTypeU64Bool.to_type (self : U64) : Result Bool := - Result.ret (self > 0#u64) + Result.ok (self > 0#u64) /- Trait implementation: [traits::{(traits::ToType for u64)#5}] Source: 'src/traits.rs', lines 92:0-92:25 -/ @@ -202,7 +202,7 @@ structure TestType.test.TestTrait (Self : Type) where Source: 'src/traits.rs', lines 139:12-139:34 -/ def TestType.test.TestTraittraitsTestTypetestTestType1.test (self : TestType.test.TestType1) : Result Bool := - Result.ret (self > 1#u64) + Result.ok (self > 1#u64) /- Trait implementation: [traits::{traits::TestType#6}::test::{(traits::{traits::TestType#6}::test::TestTrait for traits::{traits::TestType#6}::test::TestType1)}] Source: 'src/traits.rs', lines 138:8-138:36 -/ @@ -219,7 +219,7 @@ def TestType.test let x1 ← ToU64Inst.to_u64 x if x1 > 0#u64 then TestType.test.TestTraittraitsTestTypetestTestType1.test 0#u64 - else Result.ret false + else Result.ok false /- [traits::BoolWrapper] Source: 'src/traits.rs', lines 150:0-150:22 -/ @@ -243,7 +243,7 @@ def ToTypetraitsBoolWrapperT (T : Type) (ToTypeBoolTInst : ToType Bool T) : /- [traits::WithConstTy::LEN2] Source: 'src/traits.rs', lines 164:4-164:21 -/ def WithConstTy.LEN2_default_body (Self : Type) (LEN : Usize) : Result Usize := - Result.ret 32#usize + Result.ok 32#usize def WithConstTy.LEN2_default (Self : Type) (LEN : Usize) : Usize := eval_global (WithConstTy.LEN2_default_body Self LEN) @@ -259,13 +259,13 @@ structure WithConstTy (Self : Type) (LEN : Usize) where /- [traits::{(traits::WithConstTy<32: usize> for bool)#8}::LEN1] Source: 'src/traits.rs', lines 175:4-175:21 -/ -def WithConstTyBool32.LEN1_body : Result Usize := Result.ret 12#usize +def WithConstTyBool32.LEN1_body : Result Usize := Result.ok 12#usize def WithConstTyBool32.LEN1 : Usize := eval_global WithConstTyBool32.LEN1_body /- [traits::{(traits::WithConstTy<32: usize> for bool)#8}::f]: Source: 'src/traits.rs', lines 180:4-180:39 -/ def WithConstTyBool32.f (i : U64) (a : Array U8 32#usize) : Result U64 := - Result.ret i + Result.ok i /- Trait implementation: [traits::{(traits::WithConstTy<32: usize> for bool)#8}] Source: 'src/traits.rs', lines 174:0-174:29 -/ @@ -284,7 +284,7 @@ def use_with_const_ty1 (H : Type) (LEN : Usize) (WithConstTyInst : WithConstTy H LEN) : Result Usize := - Result.ret WithConstTyInst.LEN1 + Result.ok WithConstTyInst.LEN1 /- [traits::use_with_const_ty2]: Source: 'src/traits.rs', lines 187:0-187:73 -/ @@ -293,7 +293,7 @@ def use_with_const_ty2 (w : WithConstTyInst.W) : Result Unit := - Result.ret () + Result.ok () /- [traits::use_with_const_ty3]: Source: 'src/traits.rs', lines 189:0-189:80 -/ @@ -307,7 +307,7 @@ def use_with_const_ty3 /- [traits::test_where1]: Source: 'src/traits.rs', lines 193:0-193:40 -/ def test_where1 (T : Type) (_x : T) : Result Unit := - Result.ret () + Result.ok () /- [traits::test_where2]: Source: 'src/traits.rs', lines 194:0-194:57 -/ @@ -315,7 +315,7 @@ def test_where2 (T : Type) (WithConstTyT32Inst : WithConstTy T 32#usize) (_x : U32) : Result Unit := - Result.ret () + Result.ok () /- Trait declaration: [traits::ParentTrait0] Source: 'src/traits.rs', lines 200:0-200:22 -/ @@ -355,7 +355,7 @@ def order1 ParentTrait0 U) : Result Unit := - Result.ret () + Result.ok () /- Trait declaration: [traits::ChildTrait1] Source: 'src/traits.rs', lines 222:0-222:35 -/ @@ -429,7 +429,7 @@ def ParentTrait2U32 : ParentTrait2 U32 := { /- [traits::{(traits::ChildTrait2 for u32)#13}::convert]: Source: 'src/traits.rs', lines 273:4-273:29 -/ def ChildTrait2U32.convert (x : U32) : Result U32 := - Result.ret x + Result.ok x /- Trait implementation: [traits::{(traits::ChildTrait2 for u32)#13}] Source: 'src/traits.rs', lines 272:0-272:24 -/ @@ -475,7 +475,7 @@ structure Trait (Self : Type) where /- [traits::{(traits::Trait for @Array)#14}::LEN] Source: 'src/traits.rs', lines 315:4-315:20 -/ -def TraitArray.LEN_body (T : Type) (N : Usize) : Result Usize := Result.ret N +def TraitArray.LEN_body (T : Type) (N : Usize) : Result Usize := Result.ok N def TraitArray.LEN (T : Type) (N : Usize) : Usize := eval_global (TraitArray.LEN_body T N) @@ -489,7 +489,7 @@ def TraitArray (T : Type) (N : Usize) : Trait (Array T N) := { Source: 'src/traits.rs', lines 319:4-319:20 -/ def TraittraitsWrapper.LEN_body (T : Type) (TraitInst : Trait T) : Result Usize := - Result.ret 0#usize + Result.ok 0#usize def TraittraitsWrapper.LEN (T : Type) (TraitInst : Trait T) : Usize := eval_global (TraittraitsWrapper.LEN_body T TraitInst) @@ -503,7 +503,7 @@ def TraittraitsWrapper (T : Type) (TraitInst : Trait T) : Trait (Wrapper T) /- [traits::use_wrapper_len]: Source: 'src/traits.rs', lines 322:0-322:43 -/ def use_wrapper_len (T : Type) (TraitInst : Trait T) : Result Usize := - Result.ret (TraittraitsWrapper T TraitInst).LEN + Result.ok (TraittraitsWrapper T TraitInst).LEN /- [traits::Foo] Source: 'src/traits.rs', lines 326:0-326:20 -/ @@ -522,7 +522,7 @@ inductive core.result.Result (T E : Type) := Source: 'src/traits.rs', lines 332:4-332:33 -/ def Foo.FOO_body (T U : Type) (TraitInst : Trait T) : Result (core.result.Result T I32) := - Result.ret (core.result.Result.Err 0#i32) + Result.ok (core.result.Result.Err 0#i32) def Foo.FOO (T U : Type) (TraitInst : Trait T) : core.result.Result T I32 := eval_global (Foo.FOO_body T U TraitInst) @@ -530,12 +530,12 @@ def Foo.FOO (T U : Type) (TraitInst : Trait T) : core.result.Result T I32 := Source: 'src/traits.rs', lines 335:0-335:48 -/ def use_foo1 (T U : Type) (TraitInst : Trait T) : Result (core.result.Result T I32) := - Result.ret (Foo.FOO T U TraitInst) + Result.ok (Foo.FOO T U TraitInst) /- [traits::use_foo2]: Source: 'src/traits.rs', lines 339:0-339:48 -/ def use_foo2 (T U : Type) (TraitInst : Trait U) : Result (core.result.Result U I32) := - Result.ret (Foo.FOO U T TraitInst) + Result.ok (Foo.FOO U T TraitInst) end traits -- cgit v1.2.3 From 9c1773530a7056c161e69471b36eaa3603f6ed26 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 4 Apr 2024 17:58:32 +0200 Subject: Add field mk_return, mk_panic in SymbolicToPure.bs_ctx --- compiler/SymbolicToPure.ml | 240 ++++++++++++++++++++++++++++----------------- compiler/Translate.ml | 2 + 2 files changed, 152 insertions(+), 90 deletions(-) diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 38ee5df1..482ebf3a 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -268,6 +268,22 @@ type bs_ctx = { Note that when a function contains a loop, we group the function symbolic AST and the loop symbolic AST in a single function. *) + mk_return : (bs_ctx -> texpression option -> texpression) option; + (** Small helper: translate a [return] expression, given a value to "return". + The translation of [return] depends on the context, and in particular depends on + whether we are inside a subexpression like a loop or not. + + Note that the function consumes an optional expression, which is: + - [Some] for a forward computation + - [None] for a backward computation + + We initialize this at [None]. + *) + mk_panic : texpression option; + (** Small helper: translate a [fail] expression. + + We initialize this at [None]. + *) } [@@deriving show] @@ -2008,54 +2024,7 @@ let rec translate_expression (e : S.expression) (ctx : bs_ctx) : texpression = translate_forward_end ectx loop_input_values e back_e ctx | Loop loop -> translate_loop loop ctx -and translate_panic (ctx : bs_ctx) : texpression = - (* Here we use the function return type - note that it is ok because - * we don't match on panics which happen inside the function body - - * but it won't be true anymore once we translate individual blocks *) - (* If we use a state monad, we need to add a lambda for the state variable *) - (* Note that only forward functions return a state *) - let effect_info = ctx_get_effect_info ctx in - (* TODO: we should use a [Fail] function *) - let mk_output output_ty = - if effect_info.stateful then - (* Create the [Fail] value *) - let ret_ty = mk_simpl_tuple_ty [ mk_state_ty; output_ty ] in - let ret_v = - mk_result_fail_texpression_with_error_id ctx.meta error_failure_id - ret_ty - in - ret_v - else - mk_result_fail_texpression_with_error_id ctx.meta error_failure_id - output_ty - in - if ctx.inside_loop && Option.is_some ctx.bid then - (* We are synthesizing the backward function of a loop body *) - let bid = Option.get ctx.bid in - let loop_id = Option.get ctx.loop_id in - let loop = LoopId.Map.find loop_id ctx.loops in - let tys = RegionGroupId.Map.find bid loop.back_outputs in - let output = mk_simpl_tuple_ty tys in - mk_output output - else - (* Regular function, or forward function (the forward translation for - a loop has the same return type as the parent function) - *) - match ctx.bid with - | None -> - let back_tys = compute_back_tys ctx.sg None in - let back_tys = List.filter_map (fun x -> x) back_tys in - let tys = - if ctx.sg.fwd_info.ignore_output then back_tys - else ctx.sg.fwd_output :: back_tys - in - let output = mk_simpl_tuple_ty tys in - mk_output output - | Some bid -> - let output = - mk_simpl_tuple_ty (RegionGroupId.Map.find bid ctx.sg.back_sg).outputs - in - mk_output output +and translate_panic (ctx : bs_ctx) : texpression = Option.get ctx.mk_panic (** [opt_v]: the value to return, in case we translate a forward body. @@ -2067,42 +2036,8 @@ and translate_panic (ctx : bs_ctx) : texpression = *) and translate_return (ectx : C.eval_ctx) (opt_v : V.typed_value option) (ctx : bs_ctx) : texpression = - (* There are two cases: - - either we reach the return of a forward function or a forward loop body, - in which case the optional value should be [Some] (it is the returned value) - - or we are translating a backward function, in which case it should be [None] - *) - (* Compute the values that we should return *without the state and the result - wrapper* *) - let output = - match ctx.bid with - | None -> - (* Forward function *) - let v = Option.get opt_v in - typed_value_to_texpression ctx ectx v - | Some _ -> - (* Backward function *) - (* Sanity check *) - sanity_check __FILE__ __LINE__ (opt_v = None) ctx.meta; - (* Group the variables in which we stored the values we need to give back. - See the explanations for the [SynthInput] case in [translate_end_abstraction] *) - let backward_outputs = Option.get ctx.backward_outputs in - let field_values = List.map mk_texpression_from_var backward_outputs in - mk_simpl_tuple_texpression ctx.meta field_values - in - (* We may need to return a state - * - error-monad: Return x - * - state-error: Return (state, x) - * *) - let effect_info = ctx_get_effect_info ctx in - let output = - if effect_info.stateful then - let state_rvalue = mk_state_texpression ctx.state_var in - mk_simpl_tuple_texpression ctx.meta [ state_rvalue; output ] - else output - in - (* Wrap in a result - TODO: check effect_info.can_fail to not always wrap *) - mk_result_ok_texpression ctx.meta output + let opt_v = Option.map (typed_value_to_texpression ctx ectx) opt_v in + (Option.get ctx.mk_return) ctx opt_v and translate_return_with_loop (loop_id : V.LoopId.id) (is_continue : bool) (ctx : bs_ctx) : texpression = @@ -3118,6 +3053,49 @@ and translate_forward_end (ectx : C.eval_ctx) (ctx, backward_inputs_no_state @ [ var ]) else (ctx, backward_inputs_no_state) in + (* Update the functions mk_return and mk_panic *) + let effect_info = back_sg.effect_info in + let mk_return ctx v = + assert (v = None); + let output = + (* Group the variables in which we stored the values we need to give back. + See the explanations for the [SynthInput] case in [translate_end_abstraction] *) + let backward_outputs = Option.get ctx.backward_outputs in + let field_values = + List.map mk_texpression_from_var backward_outputs + in + mk_simpl_tuple_texpression ctx.meta field_values + in + let output = + if effect_info.stateful then + let state_rvalue = mk_state_texpression ctx.state_var in + mk_simpl_tuple_texpression ctx.meta [ state_rvalue; output ] + else output + in + (* Wrap in a result - TODO: check effect_info.can_fail to not always wrap *) + mk_result_ok_texpression ctx.meta output + in + let mk_panic = + (* TODO: we should use a [Fail] function *) + let mk_output output_ty = + if effect_info.stateful then + (* Create the [Fail] value *) + let ret_ty = mk_simpl_tuple_ty [ mk_state_ty; output_ty ] in + let ret_v = + mk_result_fail_texpression_with_error_id ctx.meta + error_failure_id ret_ty + in + ret_v + else + mk_result_fail_texpression_with_error_id ctx.meta + error_failure_id output_ty + in + let output = + mk_simpl_tuple_ty + (RegionGroupId.Map.find bid ctx.sg.back_sg).outputs + in + mk_output output + in { ctx with backward_inputs_no_state = @@ -3126,6 +3104,8 @@ and translate_forward_end (ectx : C.eval_ctx) backward_inputs_with_state = RegionGroupId.Map.add bid backward_inputs_with_state ctx.backward_inputs_with_state; + mk_return = Some mk_return; + mk_panic = Some mk_panic; } in @@ -3470,7 +3450,6 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = in (* Compute the backward outputs *) - let ctx = ref ctx in let rg_to_given_back_tys = RegionGroupId.Map.map (fun tys -> @@ -3478,13 +3457,12 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = List.map (fun ty -> cassert __FILE__ __LINE__ - (not (TypesUtils.ty_has_borrows !ctx.type_ctx.type_infos ty)) - !ctx.meta "The types shouldn't contain borrows"; - ctx_translate_fwd_ty !ctx ty) + (not (TypesUtils.ty_has_borrows ctx.type_ctx.type_infos ty)) + ctx.meta "The types shouldn't contain borrows"; + ctx_translate_fwd_ty ctx ty) tys) loop.rg_to_given_back_tys in - let ctx = !ctx in (* The output type of the loop function *) let fwd_effect_info = { ctx.sg.fwd_info.effect_info with is_rec = true } in @@ -3589,6 +3567,44 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = { types; const_generics; trait_refs } in + (* Update the helpers to translate the fail and return expressions *) + let mk_panic = + (* Note that we reuse the effect information from the parent function *) + let effect_info = ctx_get_effect_info ctx in + let back_tys = compute_back_tys ctx.sg None in + let back_tys = List.filter_map (fun x -> x) back_tys in + let tys = + if ctx.sg.fwd_info.ignore_output then back_tys + else ctx.sg.fwd_output :: back_tys + in + let output_ty = mk_simpl_tuple_ty tys in + if effect_info.stateful then + (* Create the [Fail] value *) + let ret_ty = mk_simpl_tuple_ty [ mk_state_ty; output_ty ] in + let ret_v = + mk_result_fail_texpression_with_error_id ctx.meta error_failure_id + ret_ty + in + ret_v + else + mk_result_fail_texpression_with_error_id ctx.meta error_failure_id + output_ty + in + let mk_return ctx v = + match v with + | None -> raise (Failure "Unexpected") + | Some output -> + let effect_info = ctx_get_effect_info ctx in + let output = + if effect_info.stateful then + let state_rvalue = mk_state_texpression ctx.state_var in + mk_simpl_tuple_texpression ctx.meta [ state_rvalue; output ] + else output + in + (* Wrap in a result - TODO: check effect_info.can_fail to not always wrap *) + mk_result_ok_texpression ctx.meta output + in + let loop_info = { loop_id; @@ -3604,7 +3620,7 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = } in let loops = LoopId.Map.add loop_id loop_info ctx.loops in - { ctx with loops } + { ctx with loops; mk_return = Some mk_return; mk_panic = Some mk_panic } in (* Update the context to translate the function end *) @@ -3771,6 +3787,50 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl = let effect_info = get_fun_effect_info ctx (FunId (FRegular def_id)) None None in + let mk_return ctx v = + match v with + | None -> + raise + (Failure + "Unexpected: reached a return expression without value in a \ + function forward expression") + | Some output -> + let output = + if effect_info.stateful then + let state_rvalue = mk_state_texpression ctx.state_var in + mk_simpl_tuple_texpression ctx.meta [ state_rvalue; output ] + else output + in + (* Wrap in a result - TODO: check effect_info.can_fail to not always wrap *) + mk_result_ok_texpression ctx.meta output + in + let mk_panic = + (* TODO: we should use a [Fail] function *) + let mk_output output_ty = + if effect_info.stateful then + (* Create the [Fail] value *) + let ret_ty = mk_simpl_tuple_ty [ mk_state_ty; output_ty ] in + let ret_v = + mk_result_fail_texpression_with_error_id ctx.meta + error_failure_id ret_ty + in + ret_v + else + mk_result_fail_texpression_with_error_id ctx.meta error_failure_id + output_ty + in + let back_tys = compute_back_tys ctx.sg None in + let back_tys = List.filter_map (fun x -> x) back_tys in + let tys = + if ctx.sg.fwd_info.ignore_output then back_tys + else ctx.sg.fwd_output :: back_tys + in + let output = mk_simpl_tuple_ty tys in + mk_output output + in + let ctx = + { ctx with mk_return = Some mk_return; mk_panic = Some mk_panic } + in let body = translate_expression body ctx in (* Add a match over the fuel, if necessary *) let body = diff --git a/compiler/Translate.ml b/compiler/Translate.ml index 348183c5..22288fe2 100644 --- a/compiler/Translate.ml +++ b/compiler/Translate.ml @@ -158,6 +158,8 @@ let translate_function_to_pure (trans_ctx : trans_ctx) inside_loop = false; loop_ids_map; loops = Pure.LoopId.Map.empty; + mk_return = None; + mk_panic = None; } in -- cgit v1.2.3 From fc51bfd88076a66000dbfe76e832d3fdd72aee76 Mon Sep 17 00:00:00 2001 From: Escherichia Date: Fri, 5 Apr 2024 10:36:40 +0200 Subject: error catching should now be able to tell when code couldn't be generated --- compiler/Extract.ml | 181 +++++++++++++++++++++++---------------------- compiler/SymbolicToPure.ml | 7 +- compiler/Translate.ml | 57 +++++++++++--- 3 files changed, 144 insertions(+), 101 deletions(-) diff --git a/compiler/Extract.ml b/compiler/Extract.ml index af0bf98d..1fc8a97f 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -1880,99 +1880,102 @@ let extract_global_decl_hol4_opaque (meta : Meta.meta) (ctx : extraction_ctx) and {!extract_fun_decl}. *) let extract_global_decl (ctx : extraction_ctx) (fmt : F.formatter) - (global : global_decl) (body : fun_decl) (interface : bool) : unit = + (global : global_decl option) (body : fun_decl) (interface : bool) : unit = let meta = body.meta in sanity_check __FILE__ __LINE__ body.is_global_decl_body meta; sanity_check __FILE__ __LINE__ (body.signature.inputs = []) meta; - - (* Add a break then the name of the corresponding LLBC declaration *) - F.pp_print_break fmt 0 0; - let name = - if !Config.extract_external_name_patterns && not global.is_local then - Some global.llbc_name - else None - in - extract_comment_with_span ctx fmt - [ "[" ^ name_to_string ctx global.llbc_name ^ "]" ] - name global.meta.span; - F.pp_print_space fmt (); - - let decl_name = ctx_get_global meta global.def_id ctx in - let body_name = - ctx_get_function meta - (FromLlbc (Pure.FunId (FRegular global.body_id), None)) - ctx - in - let decl_ty, body_ty = - let ty = body.signature.output in - if body.signature.fwd_info.effect_info.can_fail then - (unwrap_result_ty meta ty, ty) - else (ty, mk_result_ty ty) - in - (* Add the type parameters *) - let ctx, type_params, cg_params, trait_clauses = - ctx_add_generic_params meta global.llbc_name global.llbc_generics - global.generics ctx - in - match body.body with - | None -> - (* No body: only generate a [val x_c : u32] declaration *) - let kind = if interface then Declared else Assumed in - if !backend = HOL4 then - extract_global_decl_hol4_opaque meta ctx fmt decl_name global.generics - decl_ty - else - extract_global_decl_body_gen meta ctx fmt kind decl_name global.generics - type_params cg_params trait_clauses decl_ty None - | Some body -> - (* There is a body *) - (* Generate: [let x_body : result u32 = Return 3] *) - extract_global_decl_body_gen meta ctx fmt SingleNonRec body_name - global.generics type_params cg_params trait_clauses body_ty - (Some (fun fmt -> extract_texpression meta ctx fmt false body.body)); + match global with + | Some global -> ( + (* Add a break then the name of the corresponding LLBC declaration *) F.pp_print_break fmt 0 0; - (* Generate: [let x_c : u32 = eval_global x_body] *) - extract_global_decl_body_gen meta ctx fmt SingleNonRec decl_name - global.generics type_params cg_params trait_clauses decl_ty - (Some - (fun fmt -> - let all_params = - List.concat [ type_params; cg_params; trait_clauses ] - in - let extract_params () = - List.iter - (fun p -> - F.pp_print_space fmt (); - F.pp_print_string fmt p) - all_params - in - let use_brackets = all_params <> [] in - (* Extract the name *) - let before, after = - match !backend with - | FStar | Lean -> - ( (fun () -> - F.pp_print_string fmt "eval_global"; - F.pp_print_space fmt ()), - fun () -> () ) - | Coq -> - ((fun () -> ()), fun () -> F.pp_print_string fmt "%global") - | HOL4 -> - ( (fun () -> - F.pp_print_string fmt "get_return_value"; - F.pp_print_space fmt ()), - fun () -> () ) - in - before (); - if use_brackets then F.pp_print_string fmt "("; - F.pp_print_string fmt body_name; - (* Extract the generic params *) - extract_params (); - if use_brackets then F.pp_print_string fmt ")"; - (* *) - after ())); - (* Add a break to insert lines between declarations *) - F.pp_print_break fmt 0 0 + let name = + if !Config.extract_external_name_patterns && not global.is_local then + Some global.llbc_name + else None + in + extract_comment_with_span ctx fmt + [ "[" ^ name_to_string ctx global.llbc_name ^ "]" ] + name global.meta.span; + F.pp_print_space fmt (); + + let decl_name = ctx_get_global meta global.def_id ctx in + let body_name = + ctx_get_function meta + (FromLlbc (Pure.FunId (FRegular global.body_id), None)) + ctx + in + let decl_ty, body_ty = + let ty = body.signature.output in + if body.signature.fwd_info.effect_info.can_fail then + (unwrap_result_ty meta ty, ty) + else (ty, mk_result_ty ty) + in + (* Add the type parameters *) + let ctx, type_params, cg_params, trait_clauses = + ctx_add_generic_params meta global.llbc_name global.llbc_generics + global.generics ctx + in + match body.body with + | None -> + (* No body: only generate a [val x_c : u32] declaration *) + let kind = if interface then Declared else Assumed in + if !backend = HOL4 then + extract_global_decl_hol4_opaque meta ctx fmt decl_name + global.generics decl_ty + else + extract_global_decl_body_gen meta ctx fmt kind decl_name + global.generics type_params cg_params trait_clauses decl_ty None + | Some body -> + (* There is a body *) + (* Generate: [let x_body : result u32 = Return 3] *) + extract_global_decl_body_gen meta ctx fmt SingleNonRec body_name + global.generics type_params cg_params trait_clauses body_ty + (Some (fun fmt -> extract_texpression meta ctx fmt false body.body)); + F.pp_print_break fmt 0 0; + (* Generate: [let x_c : u32 = eval_global x_body] *) + extract_global_decl_body_gen meta ctx fmt SingleNonRec decl_name + global.generics type_params cg_params trait_clauses decl_ty + (Some + (fun fmt -> + let all_params = + List.concat [ type_params; cg_params; trait_clauses ] + in + let extract_params () = + List.iter + (fun p -> + F.pp_print_space fmt (); + F.pp_print_string fmt p) + all_params + in + let use_brackets = all_params <> [] in + (* Extract the name *) + let before, after = + match !backend with + | FStar | Lean -> + ( (fun () -> + F.pp_print_string fmt "eval_global"; + F.pp_print_space fmt ()), + fun () -> () ) + | Coq -> + ( (fun () -> ()), + fun () -> F.pp_print_string fmt "%global" ) + | HOL4 -> + ( (fun () -> + F.pp_print_string fmt "get_return_value"; + F.pp_print_space fmt ()), + fun () -> () ) + in + before (); + if use_brackets then F.pp_print_string fmt "("; + F.pp_print_string fmt body_name; + (* Extract the generic params *) + extract_params (); + if use_brackets then F.pp_print_string fmt ")"; + (* *) + after ())); + (* Add a break to insert lines between declarations *) + F.pp_print_break fmt 0 0) + | None -> () (** Similar to {!extract_trait_decl_register_names} *) let extract_trait_decl_register_parent_clause_names (ctx : extraction_ctx) diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index f036cc37..b4c55d80 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -3861,7 +3861,12 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl = def let translate_type_decls (ctx : Contexts.decls_ctx) : type_decl list = - List.map (translate_type_decl ctx) + List.filter_map + (fun a -> + try Some (translate_type_decl ctx a) + with CFailure (meta, _) -> + let () = save_error __FILE__ __LINE__ meta "Could not generate code, see previous error" in + None) (TypeDeclId.Map.values ctx.type_ctx.type_decls) let translate_trait_decl (ctx : Contexts.decls_ctx) (trait_decl : A.trait_decl) diff --git a/compiler/Translate.ml b/compiler/Translate.ml index 348183c5..28e5531d 100644 --- a/compiler/Translate.ml +++ b/compiler/Translate.ml @@ -41,7 +41,7 @@ let translate_function_to_symbolics (trans_ctx : trans_ctx) (fdef : fun_decl) : of backward functions, we also provide names for the outputs. TODO: maybe we should introduce a record for this. *) -let translate_function_to_pure (trans_ctx : trans_ctx) +let translate_function_to_pure_hook (trans_ctx : trans_ctx) (pure_type_decls : Pure.type_decl Pure.TypeDeclId.Map.t) (fun_dsigs : Pure.decomposed_fun_sig FunDeclId.Map.t) (fdef : fun_decl) : pure_fun_translation_no_loops = @@ -195,6 +195,17 @@ let translate_function_to_pure (trans_ctx : trans_ctx) | None -> SymbolicToPure.translate_fun_decl ctx None | Some (_, ast) -> SymbolicToPure.translate_fun_decl ctx (Some ast) +let translate_function_to_pure (trans_ctx : trans_ctx) + (pure_type_decls : Pure.type_decl Pure.TypeDeclId.Map.t) + (fun_dsigs : Pure.decomposed_fun_sig FunDeclId.Map.t) (fdef : fun_decl) : + pure_fun_translation_no_loops option = + try + Some + (translate_function_to_pure_hook trans_ctx pure_type_decls fun_dsigs fdef) + with CFailure (meta, _) -> + let () = save_error __FILE__ __LINE__ meta "Could not generate code, see previous error" in + None + (* TODO: factor out the return type *) let translate_crate_to_pure (crate : crate) : trans_ctx @@ -220,32 +231,51 @@ let translate_crate_to_pure (crate : crate) : (* Compute the decomposed fun sigs for the whole crate *) let fun_dsigs = FunDeclId.Map.of_list - (List.map + (List.filter_map (fun (fdef : LlbcAst.fun_decl) -> - ( fdef.def_id, - SymbolicToPure.translate_fun_sig_from_decl_to_decomposed trans_ctx - fdef )) + try + Some + ( fdef.def_id, + SymbolicToPure.translate_fun_sig_from_decl_to_decomposed + trans_ctx fdef ) + with CFailure (meta, _) -> + let () = + save_error __FILE__ __LINE__ meta "Could not generate code, see previous error" + in + None) (FunDeclId.Map.values crate.fun_decls)) in (* Translate all the *transparent* functions *) let pure_translations = - List.map + List.filter_map (translate_function_to_pure trans_ctx type_decls_map fun_dsigs) (FunDeclId.Map.values crate.fun_decls) in (* Translate the trait declarations *) let trait_decls = - List.map - (SymbolicToPure.translate_trait_decl trans_ctx) + List.filter_map + (fun a -> + try Some (SymbolicToPure.translate_trait_decl trans_ctx a) + with CFailure (meta, _) -> + let () = + save_error __FILE__ __LINE__ meta "Could not generate code, see previous error" + in + None) (TraitDeclId.Map.values trans_ctx.trait_decls_ctx.trait_decls) in (* Translate the trait implementations *) let trait_impls = - List.map - (SymbolicToPure.translate_trait_impl trans_ctx) + List.filter_map + (fun a -> + try Some (SymbolicToPure.translate_trait_impl trans_ctx a) + with CFailure (meta, _) -> + let () = + save_error __FILE__ __LINE__ meta "Could not generate code, see previous error" + in + None) (TraitImplId.Map.values trans_ctx.trait_impls_ctx.trait_impls) in @@ -471,7 +501,12 @@ let export_global (fmt : Format.formatter) (config : gen_config) (ctx : gen_ctx) groups are always singletons, so the [extract_global_decl] function takes care of generating the delimiters. *) - let global = SymbolicToPure.translate_global ctx.trans_ctx global in + let global = + try Some (SymbolicToPure.translate_global ctx.trans_ctx global) + with CFailure (meta, _) -> + let () = save_error __FILE__ __LINE__ meta "Could not generate code, see previous error" in + None + in Extract.extract_global_decl ctx fmt global body config.interface (** Utility. -- cgit v1.2.3 From 760e8374533bd7e13059e18c223428baab4535ea Mon Sep 17 00:00:00 2001 From: Escherichia Date: Fri, 5 Apr 2024 12:29:33 +0200 Subject: resolved comments --- compiler/Extract.ml | 184 +++++++++++++++++++++++---------------------- compiler/SymbolicToPure.ml | 5 +- compiler/Translate.ml | 23 ++++-- 3 files changed, 113 insertions(+), 99 deletions(-) diff --git a/compiler/Extract.ml b/compiler/Extract.ml index 1fc8a97f..f7d08fdb 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -1879,102 +1879,104 @@ let extract_global_decl_hol4_opaque (meta : Meta.meta) (ctx : extraction_ctx) [{start,end}_gloabl_decl_group], contrary to {!extract_type_decl} and {!extract_fun_decl}. *) -let extract_global_decl (ctx : extraction_ctx) (fmt : F.formatter) - (global : global_decl option) (body : fun_decl) (interface : bool) : unit = +let extract_global_decl_aux (ctx : extraction_ctx) (fmt : F.formatter) + (global : global_decl) (body : fun_decl) (interface : bool) : unit = let meta = body.meta in sanity_check __FILE__ __LINE__ body.is_global_decl_body meta; sanity_check __FILE__ __LINE__ (body.signature.inputs = []) meta; - match global with - | Some global -> ( - (* Add a break then the name of the corresponding LLBC declaration *) + (* Add a break then the name of the corresponding LLBC declaration *) + F.pp_print_break fmt 0 0; + let name = + if !Config.extract_external_name_patterns && not global.is_local then + Some global.llbc_name + else None + in + extract_comment_with_span ctx fmt + [ "[" ^ name_to_string ctx global.llbc_name ^ "]" ] + name global.meta.span; + F.pp_print_space fmt (); + + let decl_name = ctx_get_global meta global.def_id ctx in + let body_name = + ctx_get_function meta + (FromLlbc (Pure.FunId (FRegular global.body_id), None)) + ctx + in + let decl_ty, body_ty = + let ty = body.signature.output in + if body.signature.fwd_info.effect_info.can_fail then + (unwrap_result_ty meta ty, ty) + else (ty, mk_result_ty ty) + in + (* Add the type parameters *) + let ctx, type_params, cg_params, trait_clauses = + ctx_add_generic_params meta global.llbc_name global.llbc_generics + global.generics ctx + in + match body.body with + | None -> + (* No body: only generate a [val x_c : u32] declaration *) + let kind = if interface then Declared else Assumed in + if !backend = HOL4 then + extract_global_decl_hol4_opaque meta ctx fmt decl_name global.generics + decl_ty + else + extract_global_decl_body_gen meta ctx fmt kind decl_name global.generics + type_params cg_params trait_clauses decl_ty None + | Some body -> + (* There is a body *) + (* Generate: [let x_body : result u32 = Return 3] *) + extract_global_decl_body_gen meta ctx fmt SingleNonRec body_name + global.generics type_params cg_params trait_clauses body_ty + (Some (fun fmt -> extract_texpression meta ctx fmt false body.body)); F.pp_print_break fmt 0 0; - let name = - if !Config.extract_external_name_patterns && not global.is_local then - Some global.llbc_name - else None - in - extract_comment_with_span ctx fmt - [ "[" ^ name_to_string ctx global.llbc_name ^ "]" ] - name global.meta.span; - F.pp_print_space fmt (); + (* Generate: [let x_c : u32 = eval_global x_body] *) + extract_global_decl_body_gen meta ctx fmt SingleNonRec decl_name + global.generics type_params cg_params trait_clauses decl_ty + (Some + (fun fmt -> + let all_params = + List.concat [ type_params; cg_params; trait_clauses ] + in + let extract_params () = + List.iter + (fun p -> + F.pp_print_space fmt (); + F.pp_print_string fmt p) + all_params + in + let use_brackets = all_params <> [] in + (* Extract the name *) + let before, after = + match !backend with + | FStar | Lean -> + ( (fun () -> + F.pp_print_string fmt "eval_global"; + F.pp_print_space fmt ()), + fun () -> () ) + | Coq -> + ((fun () -> ()), fun () -> F.pp_print_string fmt "%global") + | HOL4 -> + ( (fun () -> + F.pp_print_string fmt "get_return_value"; + F.pp_print_space fmt ()), + fun () -> () ) + in + before (); + if use_brackets then F.pp_print_string fmt "("; + F.pp_print_string fmt body_name; + (* Extract the generic params *) + extract_params (); + if use_brackets then F.pp_print_string fmt ")"; + (* *) + after ())); + (* Add a break to insert lines between declarations *) + F.pp_print_break fmt 0 0 - let decl_name = ctx_get_global meta global.def_id ctx in - let body_name = - ctx_get_function meta - (FromLlbc (Pure.FunId (FRegular global.body_id), None)) - ctx - in - let decl_ty, body_ty = - let ty = body.signature.output in - if body.signature.fwd_info.effect_info.can_fail then - (unwrap_result_ty meta ty, ty) - else (ty, mk_result_ty ty) - in - (* Add the type parameters *) - let ctx, type_params, cg_params, trait_clauses = - ctx_add_generic_params meta global.llbc_name global.llbc_generics - global.generics ctx - in - match body.body with - | None -> - (* No body: only generate a [val x_c : u32] declaration *) - let kind = if interface then Declared else Assumed in - if !backend = HOL4 then - extract_global_decl_hol4_opaque meta ctx fmt decl_name - global.generics decl_ty - else - extract_global_decl_body_gen meta ctx fmt kind decl_name - global.generics type_params cg_params trait_clauses decl_ty None - | Some body -> - (* There is a body *) - (* Generate: [let x_body : result u32 = Return 3] *) - extract_global_decl_body_gen meta ctx fmt SingleNonRec body_name - global.generics type_params cg_params trait_clauses body_ty - (Some (fun fmt -> extract_texpression meta ctx fmt false body.body)); - F.pp_print_break fmt 0 0; - (* Generate: [let x_c : u32 = eval_global x_body] *) - extract_global_decl_body_gen meta ctx fmt SingleNonRec decl_name - global.generics type_params cg_params trait_clauses decl_ty - (Some - (fun fmt -> - let all_params = - List.concat [ type_params; cg_params; trait_clauses ] - in - let extract_params () = - List.iter - (fun p -> - F.pp_print_space fmt (); - F.pp_print_string fmt p) - all_params - in - let use_brackets = all_params <> [] in - (* Extract the name *) - let before, after = - match !backend with - | FStar | Lean -> - ( (fun () -> - F.pp_print_string fmt "eval_global"; - F.pp_print_space fmt ()), - fun () -> () ) - | Coq -> - ( (fun () -> ()), - fun () -> F.pp_print_string fmt "%global" ) - | HOL4 -> - ( (fun () -> - F.pp_print_string fmt "get_return_value"; - F.pp_print_space fmt ()), - fun () -> () ) - in - before (); - if use_brackets then F.pp_print_string fmt "("; - F.pp_print_string fmt body_name; - (* Extract the generic params *) - extract_params (); - if use_brackets then F.pp_print_string fmt ")"; - (* *) - after ())); - (* Add a break to insert lines between declarations *) - F.pp_print_break fmt 0 0) +let extract_global_decl (ctx : extraction_ctx) (fmt : F.formatter) + (global : global_decl option) (body : fun_decl) (interface : bool) : unit = + match global with + | Some global -> extract_global_decl_aux ctx fmt global body interface | None -> () (** Similar to {!extract_trait_decl_register_names} *) diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index b4c55d80..eac4adb9 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -3865,7 +3865,10 @@ let translate_type_decls (ctx : Contexts.decls_ctx) : type_decl list = (fun a -> try Some (translate_type_decl ctx a) with CFailure (meta, _) -> - let () = save_error __FILE__ __LINE__ meta "Could not generate code, see previous error" in + let () = + save_error __FILE__ __LINE__ meta + "Could not generate code, see previous error" + in None) (TypeDeclId.Map.values ctx.type_ctx.type_decls) diff --git a/compiler/Translate.ml b/compiler/Translate.ml index 28e5531d..c23b2a47 100644 --- a/compiler/Translate.ml +++ b/compiler/Translate.ml @@ -41,7 +41,7 @@ let translate_function_to_symbolics (trans_ctx : trans_ctx) (fdef : fun_decl) : of backward functions, we also provide names for the outputs. TODO: maybe we should introduce a record for this. *) -let translate_function_to_pure_hook (trans_ctx : trans_ctx) +let translate_function_to_pure_aux (trans_ctx : trans_ctx) (pure_type_decls : Pure.type_decl Pure.TypeDeclId.Map.t) (fun_dsigs : Pure.decomposed_fun_sig FunDeclId.Map.t) (fdef : fun_decl) : pure_fun_translation_no_loops = @@ -201,9 +201,12 @@ let translate_function_to_pure (trans_ctx : trans_ctx) pure_fun_translation_no_loops option = try Some - (translate_function_to_pure_hook trans_ctx pure_type_decls fun_dsigs fdef) + (translate_function_to_pure_aux trans_ctx pure_type_decls fun_dsigs fdef) with CFailure (meta, _) -> - let () = save_error __FILE__ __LINE__ meta "Could not generate code, see previous error" in + let () = + save_error __FILE__ __LINE__ meta + "Could not translate function because of previous error" + in None (* TODO: factor out the return type *) @@ -240,7 +243,8 @@ let translate_crate_to_pure (crate : crate) : trans_ctx fdef ) with CFailure (meta, _) -> let () = - save_error __FILE__ __LINE__ meta "Could not generate code, see previous error" + save_error __FILE__ __LINE__ meta + "Could not translate function because of previous error" in None) (FunDeclId.Map.values crate.fun_decls)) @@ -260,7 +264,8 @@ let translate_crate_to_pure (crate : crate) : try Some (SymbolicToPure.translate_trait_decl trans_ctx a) with CFailure (meta, _) -> let () = - save_error __FILE__ __LINE__ meta "Could not generate code, see previous error" + save_error __FILE__ __LINE__ meta + "Could not translate trait decl because of previous error" in None) (TraitDeclId.Map.values trans_ctx.trait_decls_ctx.trait_decls) @@ -273,7 +278,8 @@ let translate_crate_to_pure (crate : crate) : try Some (SymbolicToPure.translate_trait_impl trans_ctx a) with CFailure (meta, _) -> let () = - save_error __FILE__ __LINE__ meta "Could not generate code, see previous error" + save_error __FILE__ __LINE__ meta + "Could not translate trait impl because of previous error" in None) (TraitImplId.Map.values trans_ctx.trait_impls_ctx.trait_impls) @@ -504,7 +510,10 @@ let export_global (fmt : Format.formatter) (config : gen_config) (ctx : gen_ctx) let global = try Some (SymbolicToPure.translate_global ctx.trans_ctx global) with CFailure (meta, _) -> - let () = save_error __FILE__ __LINE__ meta "Could not generate code, see previous error" in + let () = + save_error __FILE__ __LINE__ meta + "Could not translate global because of previous error" + in None in Extract.extract_global_decl ctx fmt global body config.interface -- cgit v1.2.3 From 65a77968d0abc2d01da92aa8982256855e7519a6 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Fri, 5 Apr 2024 14:04:25 +0200 Subject: Update the lean toolchain and fix the proofs --- backends/lean/Base/Arith/Int.lean | 1 - backends/lean/Base/Diverge.lean | 1 - backends/lean/Base/Diverge/Base.lean | 4 +--- backends/lean/Base/Diverge/Elab.lean | 1 - backends/lean/Base/Primitives/ArraySlice.lean | 5 ++--- backends/lean/Base/Primitives/Range.lean | 1 - backends/lean/Base/Primitives/Vec.lean | 1 - backends/lean/lake-manifest.json | 16 ++++++++-------- backends/lean/lean-toolchain | 2 +- tests/lean/Hashmap/Properties.lean | 20 ++++++++++++++------ tests/lean/lake-manifest.json | 18 +++++++++--------- tests/lean/lean-toolchain | 2 +- 12 files changed, 36 insertions(+), 36 deletions(-) diff --git a/backends/lean/Base/Arith/Int.lean b/backends/lean/Base/Arith/Int.lean index a57f8bb1..5a85dff0 100644 --- a/backends/lean/Base/Arith/Int.lean +++ b/backends/lean/Base/Arith/Int.lean @@ -3,7 +3,6 @@ import Lean import Lean.Meta.Tactic.Simp import Init.Data.List.Basic -import Mathlib.Tactic.RunCmd import Mathlib.Tactic.Linarith -- TODO: there is no Omega tactic for now - it seems it hasn't been ported yet --import Mathlib.Tactic.Omega diff --git a/backends/lean/Base/Diverge.lean b/backends/lean/Base/Diverge.lean index c9a2eec2..92ffd3cd 100644 --- a/backends/lean/Base/Diverge.lean +++ b/backends/lean/Base/Diverge.lean @@ -1,7 +1,6 @@ import Lean import Lean.Meta.Tactic.Simp import Init.Data.List.Basic -import Mathlib.Tactic.RunCmd import Mathlib.Tactic.Linarith import Base.Diverge.Base import Base.Diverge.Elab diff --git a/backends/lean/Base/Diverge/Base.lean b/backends/lean/Base/Diverge/Base.lean index e40432bd..7521eecc 100644 --- a/backends/lean/Base/Diverge/Base.lean +++ b/backends/lean/Base/Diverge/Base.lean @@ -1,7 +1,6 @@ import Lean import Lean.Meta.Tactic.Simp import Init.Data.List.Basic -import Mathlib.Tactic.RunCmd import Mathlib.Tactic.Linarith import Base.Primitives.Base import Base.Arith.Base @@ -39,8 +38,7 @@ namespace Lemmas case zero => simp_all intro m h1 h2 - have h: n = m := by - linarith + have h: n = m := by omega unfold for_all_fin_aux; simp_all simp_all -- There is no i s.t. m ≤ i diff --git a/backends/lean/Base/Diverge/Elab.lean b/backends/lean/Base/Diverge/Elab.lean index f30148dc..71eaba10 100644 --- a/backends/lean/Base/Diverge/Elab.lean +++ b/backends/lean/Base/Diverge/Elab.lean @@ -1,7 +1,6 @@ import Lean import Lean.Meta.Tactic.Simp import Init.Data.List.Basic -import Mathlib.Tactic.RunCmd import Base.Utils import Base.Diverge.Base import Base.Diverge.ElabBase diff --git a/backends/lean/Base/Primitives/ArraySlice.lean b/backends/lean/Base/Primitives/ArraySlice.lean index e1a39d40..3bd2aebb 100644 --- a/backends/lean/Base/Primitives/ArraySlice.lean +++ b/backends/lean/Base/Primitives/ArraySlice.lean @@ -2,7 +2,6 @@ import Lean import Lean.Meta.Tactic.Simp import Init.Data.List.Basic -import Mathlib.Tactic.RunCmd import Mathlib.Tactic.Linarith import Base.IList import Base.Primitives.Scalar @@ -269,7 +268,7 @@ def Array.update_subslice (α : Type u) (n : Usize) (a : Array α n) (r : Range . scalar_tac . scalar_tac let na := s_beg.append (s.val.append s_end) - have : na.len = a.val.len := by simp [*] + have : na.len = a.val.len := by simp [na, *] ret ⟨ na, by simp_all [← List.len_eq_length]; scalar_tac ⟩ else fail panic @@ -343,7 +342,7 @@ def Slice.update_subslice (α : Type u) (s : Slice α) (r : Range Usize) (ss : S . scalar_tac . scalar_tac let ns := s_beg.append (ss.val.append s_end) - have : ns.len = s.val.len := by simp [*] + have : ns.len = s.val.len := by simp [ns, *] ret ⟨ ns, by simp_all [← List.len_eq_length]; scalar_tac ⟩ else fail panic diff --git a/backends/lean/Base/Primitives/Range.lean b/backends/lean/Base/Primitives/Range.lean index a268bcba..416cd201 100644 --- a/backends/lean/Base/Primitives/Range.lean +++ b/backends/lean/Base/Primitives/Range.lean @@ -2,7 +2,6 @@ import Lean import Lean.Meta.Tactic.Simp import Init.Data.List.Basic -import Mathlib.Tactic.RunCmd import Mathlib.Tactic.Linarith import Base.IList import Base.Primitives.Scalar diff --git a/backends/lean/Base/Primitives/Vec.lean b/backends/lean/Base/Primitives/Vec.lean index 65249c12..2b8425d8 100644 --- a/backends/lean/Base/Primitives/Vec.lean +++ b/backends/lean/Base/Primitives/Vec.lean @@ -2,7 +2,6 @@ import Lean import Lean.Meta.Tactic.Simp import Init.Data.List.Basic -import Mathlib.Tactic.RunCmd import Mathlib.Tactic.Linarith import Base.IList import Base.Primitives.Scalar diff --git a/backends/lean/lake-manifest.json b/backends/lean/lake-manifest.json index 3a18466f..99ec856e 100644 --- a/backends/lean/lake-manifest.json +++ b/backends/lean/lake-manifest.json @@ -4,7 +4,7 @@ [{"url": "https://github.com/leanprover/std4", "type": "git", "subDir": null, - "rev": "276953b13323ca151939eafaaec9129bf7970306", + "rev": "32983874c1b897d78f20d620fe92fc8fd3f06c3a", "name": "std", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -13,7 +13,7 @@ {"url": "https://github.com/leanprover-community/quote4", "type": "git", "subDir": null, - "rev": "1c88406514a636d241903e2e288d21dc6d861e01", + "rev": "64365c656d5e1bffa127d2a1795f471529ee0178", "name": "Qq", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -22,7 +22,7 @@ {"url": "https://github.com/leanprover-community/aesop", "type": "git", "subDir": null, - "rev": "6beed82dcfbb7731d173cd517675df27d62ad0f4", + "rev": "5fefb40a7c9038a7150e7edd92e43b1b94c49e79", "name": "aesop", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -31,16 +31,16 @@ {"url": "https://github.com/leanprover-community/ProofWidgets4", "type": "git", "subDir": null, - "rev": "af1e86cf7a37389632a02f4a111e6b501b2b818f", + "rev": "fb65c476595a453a9b8ffc4a1cea2db3a89b9cd8", "name": "proofwidgets", "manifestFile": "lake-manifest.json", - "inputRev": "v0.0.27", + "inputRev": "v0.0.30", "inherited": true, "configFile": "lakefile.lean"}, {"url": "https://github.com/leanprover/lean4-cli", "type": "git", "subDir": null, - "rev": "a751d21d4b68c999accb6fc5d960538af26ad5ec", + "rev": "be8fa79a28b8b6897dce0713ef50e89c4a0f6ef5", "name": "Cli", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -49,7 +49,7 @@ {"url": "https://github.com/leanprover-community/import-graph.git", "type": "git", "subDir": null, - "rev": "8079d2d1d0e073bde42eab159c24f4c2d0d3a871", + "rev": "61a79185b6582573d23bf7e17f2137cd49e7e662", "name": "importGraph", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -58,7 +58,7 @@ {"url": "https://github.com/leanprover-community/mathlib4.git", "type": "git", "subDir": null, - "rev": "056cc4b21e25e8d1daaeef3a6e3416872c9fc12c", + "rev": "3e99b48baf21ffdd202d5c2e39990fc23f4c6d32", "name": "mathlib", "manifestFile": "lake-manifest.json", "inputRev": null, diff --git a/backends/lean/lean-toolchain b/backends/lean/lean-toolchain index f96d662e..9ad30404 100644 --- a/backends/lean/lean-toolchain +++ b/backends/lean/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:v4.6.1 +leanprover/lean4:v4.7.0 diff --git a/tests/lean/Hashmap/Properties.lean b/tests/lean/Hashmap/Properties.lean index 7215e286..4e0ca509 100644 --- a/tests/lean/Hashmap/Properties.lean +++ b/tests/lean/Hashmap/Properties.lean @@ -113,6 +113,10 @@ def inv (hm : HashMap α) : Prop := -- This rewriting lemma is problematic below attribute [-simp] Bool.exists_bool +-- The proof below is a bit expensive, so we need to increase the maximum number +-- of heart beats +set_option maxHeartbeats 1000000 + theorem insert_in_list_spec_aux {α : Type} (l : Int) (key: Usize) (value: α) (l0: List α) (hinv : slot_s_inv_hash l (hash_mod_key key l) l0.v) (hdk : distinct_keys l0.v) : @@ -232,7 +236,7 @@ set_option pp.coercions false -- do not print coercions with ↑ (this doesn't p -- The proof below is a bit expensive, so we need to increase the maximum number -- of heart beats -set_option maxHeartbeats 1000000 +set_option maxHeartbeats 2000000 theorem insert_no_resize_spec {α : Type} (hm : HashMap α) (key : Usize) (value : α) (hinv : hm.inv) (hnsat : hm.lookup key = none → hm.len_s < Usize.max) : @@ -318,17 +322,21 @@ theorem insert_no_resize_spec {α : Type} (hm : HashMap α) (key : Usize) (value simp_all have _ : 0 ≤ k_hash_mod := by -- TODO: we want to automate this - simp + simp only [k_hash_mod] apply Int.emod_nonneg k.val hvnz have _ : k_hash_mod < alloc.vec.Vec.length hm.slots := by -- TODO: we want to automate this - simp + simp only [k_hash_mod] have h := Int.emod_lt_of_pos k.val hvpos - simp_all + simp_all only [ret.injEq, exists_eq_left', List.len_update, gt_iff_lt, + List.index_update_eq, ne_eq, not_false_eq_true, neq_imp] if h_hm : k_hash_mod = hash_mod.val then - simp_all + simp_all only [k_hash_mod, List.len_update, gt_iff_lt, List.index_update_eq, + ne_eq, not_false_eq_true, neq_imp, alloc.vec.Vec.length] else - simp_all + simp_all only [k_hash_mod, List.len_update, gt_iff_lt, List.index_update_eq, + ne_eq, not_false_eq_true, neq_imp, ge_iff_le, + alloc.vec.Vec.length, List.index_update_ne] have _ : match hm.lookup key with | none => nhm.len_s = hm.len_s + 1 diff --git a/tests/lean/lake-manifest.json b/tests/lean/lake-manifest.json index e167e841..404d3dab 100644 --- a/tests/lean/lake-manifest.json +++ b/tests/lean/lake-manifest.json @@ -4,7 +4,7 @@ [{"url": "https://github.com/leanprover/std4", "type": "git", "subDir": null, - "rev": "276953b13323ca151939eafaaec9129bf7970306", + "rev": "32983874c1b897d78f20d620fe92fc8fd3f06c3a", "name": "std", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -13,7 +13,7 @@ {"url": "https://github.com/leanprover-community/quote4", "type": "git", "subDir": null, - "rev": "1c88406514a636d241903e2e288d21dc6d861e01", + "rev": "64365c656d5e1bffa127d2a1795f471529ee0178", "name": "Qq", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -22,7 +22,7 @@ {"url": "https://github.com/leanprover-community/aesop", "type": "git", "subDir": null, - "rev": "6beed82dcfbb7731d173cd517675df27d62ad0f4", + "rev": "5fefb40a7c9038a7150e7edd92e43b1b94c49e79", "name": "aesop", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -31,16 +31,16 @@ {"url": "https://github.com/leanprover-community/ProofWidgets4", "type": "git", "subDir": null, - "rev": "af1e86cf7a37389632a02f4a111e6b501b2b818f", + "rev": "fb65c476595a453a9b8ffc4a1cea2db3a89b9cd8", "name": "proofwidgets", "manifestFile": "lake-manifest.json", - "inputRev": "v0.0.27", + "inputRev": "v0.0.30", "inherited": true, "configFile": "lakefile.lean"}, {"url": "https://github.com/leanprover/lean4-cli", "type": "git", "subDir": null, - "rev": "a751d21d4b68c999accb6fc5d960538af26ad5ec", + "rev": "be8fa79a28b8b6897dce0713ef50e89c4a0f6ef5", "name": "Cli", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -49,7 +49,7 @@ {"url": "https://github.com/leanprover-community/import-graph.git", "type": "git", "subDir": null, - "rev": "8079d2d1d0e073bde42eab159c24f4c2d0d3a871", + "rev": "61a79185b6582573d23bf7e17f2137cd49e7e662", "name": "importGraph", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -58,7 +58,7 @@ {"url": "https://github.com/leanprover-community/mathlib4.git", "type": "git", "subDir": null, - "rev": "d04f8d39c0e47a0d73450b49f6c0665897cdcaf7", + "rev": "d9c412b8103b5098bf8b66cbb981b81a57375925", "name": "mathlib", "manifestFile": "lake-manifest.json", "inputRev": null, @@ -70,5 +70,5 @@ "inherited": false, "dir": "./../../backends/lean", "configFile": "lakefile.lean"}], - "name": "Tests", + "name": "tests", "lakeDir": ".lake"} diff --git a/tests/lean/lean-toolchain b/tests/lean/lean-toolchain index f96d662e..9ad30404 100644 --- a/tests/lean/lean-toolchain +++ b/tests/lean/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:v4.6.1 +leanprover/lean4:v4.7.0 -- cgit v1.2.3 From 3a470ec6661a494631a12594989126804aeb044d Mon Sep 17 00:00:00 2001 From: Escherichia Date: Fri, 5 Apr 2024 14:44:17 +0200 Subject: Resolved comments and added the name of the not translated element --- compiler/SymbolicToPure.ml | 5 ++++- compiler/Translate.ml | 20 ++++++++++++++------ 2 files changed, 18 insertions(+), 7 deletions(-) diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index eac4adb9..607da445 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -3865,9 +3865,12 @@ let translate_type_decls (ctx : Contexts.decls_ctx) : type_decl list = (fun a -> try Some (translate_type_decl ctx a) with CFailure (meta, _) -> + let env = PrintPure.decls_ctx_to_fmt_env ctx in + let name = PrintPure.name_to_string env a.name in let () = save_error __FILE__ __LINE__ meta - "Could not generate code, see previous error" + ("Could not translate type decl '" ^ name + ^ "' because of previous error") in None) (TypeDeclId.Map.values ctx.type_ctx.type_decls) diff --git a/compiler/Translate.ml b/compiler/Translate.ml index c23b2a47..2fcf5b43 100644 --- a/compiler/Translate.ml +++ b/compiler/Translate.ml @@ -203,9 +203,10 @@ let translate_function_to_pure (trans_ctx : trans_ctx) Some (translate_function_to_pure_aux trans_ctx pure_type_decls fun_dsigs fdef) with CFailure (meta, _) -> + let name = name_to_string trans_ctx fdef.name in let () = save_error __FILE__ __LINE__ meta - "Could not translate function because of previous error" + ("Could not translate function '" ^ name ^ "' because of previous error") in None @@ -230,7 +231,6 @@ let translate_crate_to_pure (crate : crate) : Pure.TypeDeclId.Map.of_list (List.map (fun (def : Pure.type_decl) -> (def.def_id, def)) type_decls) in - (* Compute the decomposed fun sigs for the whole crate *) let fun_dsigs = FunDeclId.Map.of_list @@ -242,9 +242,11 @@ let translate_crate_to_pure (crate : crate) : SymbolicToPure.translate_fun_sig_from_decl_to_decomposed trans_ctx fdef ) with CFailure (meta, _) -> + let name = name_to_string trans_ctx fdef.name in let () = save_error __FILE__ __LINE__ meta - "Could not translate function because of previous error" + ("Could not translate function signature '" ^ name + ^ "' because of previous error") in None) (FunDeclId.Map.values crate.fun_decls)) @@ -263,9 +265,11 @@ let translate_crate_to_pure (crate : crate) : (fun a -> try Some (SymbolicToPure.translate_trait_decl trans_ctx a) with CFailure (meta, _) -> + let name = name_to_string trans_ctx a.name in let () = save_error __FILE__ __LINE__ meta - "Could not translate trait decl because of previous error" + ("Could not translate trait decl '" ^ name + ^ "' because of previous error") in None) (TraitDeclId.Map.values trans_ctx.trait_decls_ctx.trait_decls) @@ -277,9 +281,11 @@ let translate_crate_to_pure (crate : crate) : (fun a -> try Some (SymbolicToPure.translate_trait_impl trans_ctx a) with CFailure (meta, _) -> + let name = name_to_string trans_ctx a.name in let () = save_error __FILE__ __LINE__ meta - "Could not translate trait impl because of previous error" + ("Could not translate trait impl '" ^ name + ^ "' because of previous error") in None) (TraitImplId.Map.values trans_ctx.trait_impls_ctx.trait_impls) @@ -511,8 +517,10 @@ let export_global (fmt : Format.formatter) (config : gen_config) (ctx : gen_ctx) try Some (SymbolicToPure.translate_global ctx.trans_ctx global) with CFailure (meta, _) -> let () = + let name = name_to_string ctx.trans_ctx global.name in save_error __FILE__ __LINE__ meta - "Could not translate global because of previous error" + ("Could not translate global '" ^ name + ^ "' because of previous error") in None in -- cgit v1.2.3 From 581d5c0cb8e618382fa41e5a42175560283ff0a1 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Sun, 7 Apr 2024 14:27:14 +0200 Subject: Cleanup a bit and improve the error messages --- compiler/Extract.ml | 3 +- compiler/InterpreterBorrows.ml | 26 ++++++-------- compiler/InterpreterBorrowsCore.ml | 4 +-- compiler/InterpreterPaths.ml | 21 ++++++------ compiler/InterpreterProjectors.ml | 4 +-- compiler/Invariants.ml | 5 ++- compiler/Main.ml | 4 ++- compiler/PrePasses.ml | 19 +++++++++-- compiler/Print.ml | 1 + compiler/PureTypeCheck.ml | 9 +++-- compiler/SymbolicToPure.ml | 8 ++--- compiler/Translate.ml | 69 +++++++++++++++++++------------------- 12 files changed, 91 insertions(+), 82 deletions(-) diff --git a/compiler/Extract.ml b/compiler/Extract.ml index f7d08fdb..985fb470 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -219,7 +219,7 @@ let fun_builtin_filter_types (id : FunDeclId.id) (types : 'a list) ^ string_of_int (List.length types) ^ " type arguments" in - log#serror err; + save_error __FILE__ __LINE__ None err; Result.Error (types, err)) else let types = List.combine filter types in @@ -1884,6 +1884,7 @@ let extract_global_decl_aux (ctx : extraction_ctx) (fmt : F.formatter) let meta = body.meta in sanity_check __FILE__ __LINE__ body.is_global_decl_body meta; sanity_check __FILE__ __LINE__ (body.signature.inputs = []) meta; + (* Add a break then the name of the corresponding LLBC declaration *) F.pp_print_break fmt 0 0; let name = diff --git a/compiler/InterpreterBorrows.ml b/compiler/InterpreterBorrows.ml index e593ae75..a158ed9a 100644 --- a/compiler/InterpreterBorrows.ml +++ b/compiler/InterpreterBorrows.ml @@ -303,13 +303,11 @@ let give_back_value (config : config) (meta : Meta.meta) (bid : BorrowId.id) if bid' = bid then ( (* Sanity check *) let expected_ty = ty in - if nv.ty <> expected_ty then ( - log#serror - ("give_back_value: improper type:\n- expected: " - ^ ty_to_string ctx ty ^ "\n- received: " - ^ ty_to_string ctx nv.ty); + if nv.ty <> expected_ty then craise __FILE__ __LINE__ meta - "Value given back doesn't have the proper type"); + ("Value given back doesn't have the proper type:\n\ + - expected: " ^ ty_to_string ctx ty ^ "\n- received: " + ^ ty_to_string ctx nv.ty); (* Replace *) set_replaced (); nv.value) @@ -540,13 +538,11 @@ let give_back_avalue_to_same_abstraction (_config : config) (meta : Meta.meta) * see the comment at the level of the definition of * {!typed_avalue} *) let _, expected_ty, _ = ty_get_ref ty in - if nv.ty <> expected_ty then ( - log#serror - ("give_back_avalue_to_same_abstraction: improper type:\n\ + if nv.ty <> expected_ty then + craise __FILE__ __LINE__ meta + ("Value given back doesn't have the proper type:\n\ - expected: " ^ ty_to_string ctx ty ^ "\n- received: " ^ ty_to_string ctx nv.ty); - craise __FILE__ __LINE__ meta - "Value given back doesn't have the proper type"); (* This is the loan we are looking for: apply the projection to * the value we give back and replaced this mutable loan with * an ended loan *) @@ -836,26 +832,26 @@ let check_borrow_disappeared (meta : Meta.meta) (fun_name : string) match lookup_borrow_opt ek_all l ctx with | None -> () (* Ok *) | Some _ -> - log#lerror + log#ltrace (lazy (fun_name ^ ": " ^ BorrowId.to_string l ^ ": borrow didn't disappear:\n- original context:\n" ^ eval_ctx_to_string ~meta:(Some meta) ctx0 ^ "\n\n- new context:\n" ^ eval_ctx_to_string ~meta:(Some meta) ctx)); - craise __FILE__ __LINE__ meta "Borrow not eliminated" + internal_error __FILE__ __LINE__ meta in match lookup_loan_opt meta ek_all l ctx with | None -> () (* Ok *) | Some _ -> - log#lerror + log#ltrace (lazy (fun_name ^ ": " ^ BorrowId.to_string l ^ ": loan didn't disappear:\n- original context:\n" ^ eval_ctx_to_string ~meta:(Some meta) ctx0 ^ "\n\n- new context:\n" ^ eval_ctx_to_string ~meta:(Some meta) ctx)); - craise __FILE__ __LINE__ meta "Loan not eliminated" + internal_error __FILE__ __LINE__ meta in unit_to_cm_fun check_disappeared diff --git a/compiler/InterpreterBorrowsCore.ml b/compiler/InterpreterBorrowsCore.ml index 6e65b11d..a01be046 100644 --- a/compiler/InterpreterBorrowsCore.ml +++ b/compiler/InterpreterBorrowsCore.ml @@ -162,11 +162,11 @@ let rec compare_rtys (meta : Meta.meta) (default : bool) sanity_check __FILE__ __LINE__ (ty1 = ty2) meta; default | _ -> - log#lerror + log#ltrace (lazy ("compare_rtys: unexpected inputs:" ^ "\n- ty1: " ^ show_ty ty1 ^ "\n- ty2: " ^ show_ty ty2)); - craise __FILE__ __LINE__ meta "Unreachable" + internal_error __FILE__ __LINE__ meta (** Check if two different projections intersect. This is necessary when giving a symbolic value to an abstraction: we need to check that diff --git a/compiler/InterpreterPaths.ml b/compiler/InterpreterPaths.ml index f2c0bcb1..ab3daa72 100644 --- a/compiler/InterpreterPaths.ml +++ b/compiler/InterpreterPaths.ml @@ -83,7 +83,7 @@ let rec access_projection (meta : Meta.meta) (access : projection_access) let nv = update v in (* Type checking *) if nv.ty <> v.ty then ( - log#lerror + log#ltrace (lazy ("Not the same type:\n- nv.ty: " ^ show_ety nv.ty ^ "\n- v.ty: " ^ show_ety v.ty)); @@ -252,8 +252,8 @@ let rec access_projection (meta : Meta.meta) (access : projection_access) let pe = "- pe: " ^ show_projection_elem pe in let v = "- v:\n" ^ show_value v in let ty = "- ty:\n" ^ show_ety ty in - log#serror ("Inconsistent projection:\n" ^ pe ^ "\n" ^ v ^ "\n" ^ ty); - craise __FILE__ __LINE__ meta "Inconsistent projection") + craise __FILE__ __LINE__ meta + ("Inconsistent projection:\n" ^ pe ^ "\n" ^ v ^ "\n" ^ ty)) (** Generic function to access (read/write) the value at a given place. @@ -319,14 +319,13 @@ let try_read_place (meta : Meta.meta) (access : access_kind) (p : place) (* Note that we ignore the new environment: it should be the same as the original one. *) - if !Config.sanity_checks then - if ctx1 <> ctx then ( - let msg = - "Unexpected environment update:\nNew environment:\n" - ^ show_env ctx1.env ^ "\n\nOld environment:\n" ^ show_env ctx.env - in - log#serror msg; - craise __FILE__ __LINE__ meta "Unexpected environment update"); + (if !Config.sanity_checks then + if ctx1 <> ctx then + let msg = + "Unexpected environment update:\nNew environment:\n" + ^ show_env ctx1.env ^ "\n\nOld environment:\n" ^ show_env ctx.env + in + craise __FILE__ __LINE__ meta msg); Ok read_value let read_place (meta : Meta.meta) (access : access_kind) (p : place) diff --git a/compiler/InterpreterProjectors.ml b/compiler/InterpreterProjectors.ml index 6e86e6a4..3993d845 100644 --- a/compiler/InterpreterProjectors.ml +++ b/compiler/InterpreterProjectors.ml @@ -217,12 +217,12 @@ let rec apply_proj_borrows (meta : Meta.meta) (check_symbolic_no_ended : bool) meta); ASymbolic (AProjBorrows (s, ty)) | _ -> - log#lerror + log#ltrace (lazy ("apply_proj_borrows: unexpected inputs:\n- input value: " ^ typed_value_to_string ~meta:(Some meta) ctx v ^ "\n- proj rty: " ^ ty_to_string ctx ty)); - craise __FILE__ __LINE__ meta "Unreachable" + internal_error __FILE__ __LINE__ meta in { value; ty } diff --git a/compiler/Invariants.ml b/compiler/Invariants.ml index 642d7a37..2ccf3ad4 100644 --- a/compiler/Invariants.ml +++ b/compiler/Invariants.ml @@ -185,7 +185,6 @@ let check_loans_borrows_relation_invariant (meta : Meta.meta) (ctx : eval_ctx) : "find_info: could not find the representant of borrow " ^ BorrowId.to_string bid ^ ":\nContext:\n" ^ context_to_string () in - log#serror err; craise __FILE__ __LINE__ meta err in @@ -706,13 +705,13 @@ let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = | AEndedProjBorrows _ | AIgnoredProjBorrows -> ()) | AIgnored, _ -> () | _ -> - log#lerror + log#ltrace (lazy ("Erroneous typing:" ^ "\n- raw value: " ^ show_typed_avalue atv ^ "\n- value: " ^ typed_avalue_to_string ~meta:(Some meta) ctx atv ^ "\n- type: " ^ ty_to_string ctx atv.ty)); - craise __FILE__ __LINE__ meta "Erroneous typing"); + internal_error __FILE__ __LINE__ meta); (* Continue exploring to inspect the subterms *) super#visit_typed_avalue info atv end diff --git a/compiler/Main.ml b/compiler/Main.ml index 416f3a07..6161f2f2 100644 --- a/compiler/Main.ml +++ b/compiler/Main.ml @@ -283,7 +283,9 @@ let () = if !Errors.error_list <> [] then ( List.iter (fun (meta, msg) -> log#serror (Errors.format_error_message meta msg)) - !Errors.error_list; + (* Reverse the list of error messages so that we print them from the + earliest to the latest. *) + (List.rev !Errors.error_list); exit 1); (* Print total elapsed time *) diff --git a/compiler/PrePasses.ml b/compiler/PrePasses.ml index 0b39f64a..a46ef79c 100644 --- a/compiler/PrePasses.ml +++ b/compiler/PrePasses.ml @@ -238,9 +238,9 @@ let remove_loop_breaks (crate : crate) (f : fun_decl) : fun_decl = method! visit_Sequence env st1 st2 = match st1.content with | Loop _ -> - sanity_check __FILE__ __LINE__ + cassert __FILE__ __LINE__ (statement_has_no_loop_break_continue st2) - st2.meta; + st2.meta "Sequences of loops are not supported yet"; (replace_breaks_with st1 st2).content | _ -> super#visit_Sequence env st1 st2 end @@ -437,9 +437,22 @@ let remove_shallow_borrows (crate : crate) (f : fun_decl) : fun_decl = let apply_passes (crate : crate) : crate = let passes = [ remove_loop_breaks crate; remove_shallow_borrows crate ] in + (* Attempt to apply a pass: if it fails we replace the body by [None] *) + let apply_pass (pass : fun_decl -> fun_decl) (f : fun_decl) = + try pass f + with CFailure (_, _) -> + (* The error was already registered, we don't need to register it twice. + However, we replace the body of the function, and save an error to + report to the user the fact that we will ignore the function body *) + let fmt = Print.Crate.crate_to_fmt_env crate in + let name = Print.name_to_string fmt f.name in + save_error __FILE__ __LINE__ (Some f.meta) + ("Ignoring the body of '" ^ name ^ "' because of previous error"); + { f with body = None } + in let fun_decls = List.fold_left - (fun fl pass -> FunDeclId.Map.map pass fl) + (fun fl pass -> FunDeclId.Map.map (apply_pass pass) fl) crate.fun_decls passes in let crate = { crate with fun_decls } in diff --git a/compiler/Print.ml b/compiler/Print.ml index dad1aea3..51286553 100644 --- a/compiler/Print.ml +++ b/compiler/Print.ml @@ -1,4 +1,5 @@ include Charon.PrintUtils +include Charon.PrintTypes include Charon.PrintLlbcAst open Charon.PrintTypes open Charon.PrintExpressions diff --git a/compiler/PureTypeCheck.ml b/compiler/PureTypeCheck.ml index 098e2564..27044c27 100644 --- a/compiler/PureTypeCheck.ml +++ b/compiler/PureTypeCheck.ml @@ -93,12 +93,11 @@ let rec check_typed_pattern (meta : Meta.meta) (ctx : tc_ctx) get_adt_field_types meta ctx.type_decls type_id av.variant_id generics in let check_value (ctx : tc_ctx) (ty : ty) (v : typed_pattern) : tc_ctx = - if ty <> v.ty then ( + if ty <> v.ty then (* TODO: we need to normalize the types *) - log#serror - ("check_typed_pattern: not the same types:" ^ "\n- ty: " - ^ show_ty ty ^ "\n- v.ty: " ^ show_ty v.ty); - craise __FILE__ __LINE__ meta "Inconsistent types"); + craise __FILE__ __LINE__ meta + ("Inconsistent types:" ^ "\n- ty: " ^ show_ty ty ^ "\n- v.ty: " + ^ show_ty v.ty); check_typed_pattern meta ctx v in (* Check the field types: check that the field patterns have the expected diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 607da445..93f9ef75 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -3867,11 +3867,9 @@ let translate_type_decls (ctx : Contexts.decls_ctx) : type_decl list = with CFailure (meta, _) -> let env = PrintPure.decls_ctx_to_fmt_env ctx in let name = PrintPure.name_to_string env a.name in - let () = - save_error __FILE__ __LINE__ meta - ("Could not translate type decl '" ^ name - ^ "' because of previous error") - in + save_error __FILE__ __LINE__ meta + ("Could not translate type decl '" ^ name + ^ "' because of previous error"); None) (TypeDeclId.Map.values ctx.type_ctx.type_decls) diff --git a/compiler/Translate.ml b/compiler/Translate.ml index 2fcf5b43..870f8a22 100644 --- a/compiler/Translate.ml +++ b/compiler/Translate.ml @@ -204,10 +204,9 @@ let translate_function_to_pure (trans_ctx : trans_ctx) (translate_function_to_pure_aux trans_ctx pure_type_decls fun_dsigs fdef) with CFailure (meta, _) -> let name = name_to_string trans_ctx fdef.name in - let () = - save_error __FILE__ __LINE__ meta - ("Could not translate function '" ^ name ^ "' because of previous error") - in + save_error __FILE__ __LINE__ meta + ("Could not translate the function '" ^ name + ^ "' because of previous error"); None (* TODO: factor out the return type *) @@ -231,6 +230,7 @@ let translate_crate_to_pure (crate : crate) : Pure.TypeDeclId.Map.of_list (List.map (fun (def : Pure.type_decl) -> (def.def_id, def)) type_decls) in + (* Compute the decomposed fun sigs for the whole crate *) let fun_dsigs = FunDeclId.Map.of_list @@ -243,11 +243,9 @@ let translate_crate_to_pure (crate : crate) : trans_ctx fdef ) with CFailure (meta, _) -> let name = name_to_string trans_ctx fdef.name in - let () = - save_error __FILE__ __LINE__ meta - ("Could not translate function signature '" ^ name - ^ "' because of previous error") - in + save_error __FILE__ __LINE__ meta + ("Could not translate the function signature of '" ^ name + ^ "' because of previous error"); None) (FunDeclId.Map.values crate.fun_decls)) in @@ -266,11 +264,9 @@ let translate_crate_to_pure (crate : crate) : try Some (SymbolicToPure.translate_trait_decl trans_ctx a) with CFailure (meta, _) -> let name = name_to_string trans_ctx a.name in - let () = - save_error __FILE__ __LINE__ meta - ("Could not translate trait decl '" ^ name - ^ "' because of previous error") - in + save_error __FILE__ __LINE__ meta + ("Could not translate the trait declaration '" ^ name + ^ "' because of previous error"); None) (TraitDeclId.Map.values trans_ctx.trait_decls_ctx.trait_decls) in @@ -282,11 +278,9 @@ let translate_crate_to_pure (crate : crate) : try Some (SymbolicToPure.translate_trait_impl trans_ctx a) with CFailure (meta, _) -> let name = name_to_string trans_ctx a.name in - let () = - save_error __FILE__ __LINE__ meta - ("Could not translate trait impl '" ^ name - ^ "' because of previous error") - in + save_error __FILE__ __LINE__ meta + ("Could not translate the trait instance '" ^ name + ^ "' because of previous error"); None) (TraitImplId.Map.values trans_ctx.trait_impls_ctx.trait_impls) in @@ -516,12 +510,10 @@ let export_global (fmt : Format.formatter) (config : gen_config) (ctx : gen_ctx) let global = try Some (SymbolicToPure.translate_global ctx.trans_ctx global) with CFailure (meta, _) -> - let () = - let name = name_to_string ctx.trans_ctx global.name in - save_error __FILE__ __LINE__ meta - ("Could not translate global '" ^ name - ^ "' because of previous error") - in + let name = name_to_string ctx.trans_ctx global.name in + save_error __FILE__ __LINE__ meta + ("Could not translate the global declaration '" ^ name + ^ "' because of previous error"); None in Extract.extract_global_decl ctx fmt global body config.interface @@ -778,22 +770,28 @@ let extract_definitions (fmt : Format.formatter) (config : gen_config) | TypeGroup (RecGroup ids) -> if config.extract_types then export_types_group true ids | FunGroup (NonRecGroup id) -> ( - (* Lookup *) - let pure_fun = FunDeclId.Map.find id ctx.trans_funs in + (* Lookup - the translated function may not be in the map if we had + to ignore it because of errors *) + let pure_fun = FunDeclId.Map.find_opt id ctx.trans_funs in (* Special case: we skip trait method *declarations* (we will extract their type directly in the records we generate for the trait declarations themselves, there is no point in having separate type definitions) *) - match pure_fun.f.Pure.kind with - | TraitItemDecl _ -> () - | _ -> - (* Translate *) - export_functions_group [ pure_fun ]) + match pure_fun with + | Some pure_fun -> ( + match pure_fun.f.Pure.kind with + | TraitItemDecl _ -> () + | _ -> + (* Translate *) + export_functions_group [ pure_fun ]) + | None -> ()) | FunGroup (RecGroup ids) -> (* General case of mutually recursive functions *) (* Lookup *) let pure_funs = - List.map (fun id -> FunDeclId.Map.find id ctx.trans_funs) ids + List.filter_map + (fun id -> FunDeclId.Map.find_opt id ctx.trans_funs) + ids in (* Translate *) export_functions_group pure_funs @@ -951,7 +949,10 @@ let extract_file (config : gen_config) (ctx : gen_ctx) (fi : extract_file_info) | Coq -> Printf.fprintf out "End %s.\n" fi.module_name); (* Some logging *) - log#linfo (lazy ("Generated: " ^ fi.filename)); + if !Errors.error_list <> [] then + log#linfo + (lazy ("Generated the partial file (because of errors): " ^ fi.filename)) + else log#linfo (lazy ("Generated: " ^ fi.filename)); (* Flush and close the file *) close_out out -- cgit v1.2.3 From a9a2f81e365eeef4fd157fb56cd5107f95c91163 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Sun, 7 Apr 2024 14:47:36 +0200 Subject: Improve the error messages further --- compiler/Interpreter.ml | 12 ++++++++++++ compiler/InterpreterStatements.ml | 13 ++++++++++++- compiler/TypesUtils.ml | 20 ++++++++++++++++++++ 3 files changed, 44 insertions(+), 1 deletion(-) diff --git a/compiler/Interpreter.ml b/compiler/Interpreter.ml index d0a54750..769e3144 100644 --- a/compiler/Interpreter.ml +++ b/compiler/Interpreter.ml @@ -191,6 +191,18 @@ let initialize_symbolic_context_for_fun (ctx : decls_ctx) (fdef : fun_decl) : * do it, and because it gives a bit of sanity. * *) let sg = fdef.signature in + (* Sanity check: no nested borrows, borrows in ADTs, etc. *) + cassert __FILE__ __LINE__ + (List.for_all + (fun ty -> not (ty_has_nested_borrows ctx.type_ctx.type_infos ty)) + (sg.output :: sg.inputs)) + fdef.meta "Nested borrows are not supported yet"; + cassert __FILE__ __LINE__ + (List.for_all + (fun ty -> not (ty_has_adt_with_borrows ctx.type_ctx.type_infos ty)) + (sg.output :: sg.inputs)) + fdef.meta "ADTs containing borrows are not supported yet"; + (* Create the context *) let regions_hierarchy = FunIdMap.find (FRegular fdef.def_id) ctx.fun_ctx.regions_hierarchies diff --git a/compiler/InterpreterStatements.ml b/compiler/InterpreterStatements.ml index 1cf1c5ef..de89f316 100644 --- a/compiler/InterpreterStatements.ml +++ b/compiler/InterpreterStatements.ml @@ -1365,10 +1365,21 @@ and eval_transparent_function_call_symbolic (config : config) (meta : Meta.meta) let func, generics, trait_method_generics, def, regions_hierarchy, inst_sg = eval_transparent_function_call_symbolic_inst meta call ctx in - (* Sanity check *) + (* Sanity check: same number of inputs *) sanity_check __FILE__ __LINE__ (List.length call.args = List.length def.signature.inputs) def.meta; + (* Sanity check: no nested borrows, borrows in ADTs, etc. *) + cassert __FILE__ __LINE__ + (List.for_all + (fun ty -> not (ty_has_nested_borrows ctx.type_ctx.type_infos ty)) + (inst_sg.output :: inst_sg.inputs)) + meta "Nested borrows are not supported yet"; + cassert __FILE__ __LINE__ + (List.for_all + (fun ty -> not (ty_has_adt_with_borrows ctx.type_ctx.type_infos ty)) + (inst_sg.output :: inst_sg.inputs)) + meta "ADTs containing borrows are not supported yet"; (* Evaluate the function call *) eval_function_call_symbolic_from_inst_sig config def.meta func def.signature regions_hierarchy inst_sg generics trait_method_generics call.args call.dest diff --git a/compiler/TypesUtils.ml b/compiler/TypesUtils.ml index f5dd7df4..b2c60cc6 100644 --- a/compiler/TypesUtils.ml +++ b/compiler/TypesUtils.ml @@ -12,6 +12,26 @@ let ty_has_borrows (infos : TypesAnalysis.type_infos) (ty : ty) : bool = let info = TypesAnalysis.analyze_ty infos ty in info.TypesAnalysis.contains_borrow +let ty_has_adt_with_borrows (infos : TypesAnalysis.type_infos) (ty : ty) : bool + = + let visitor = + object + inherit [_] iter_ty as super + + method! visit_ty env ty = + match ty with + | TAdt (type_id, _) when type_id <> TTuple -> + let info = TypesAnalysis.analyze_ty infos ty in + if info.TypesAnalysis.contains_borrow then raise Found + else super#visit_ty env ty + | _ -> super#visit_ty env ty + end + in + try + visitor#visit_ty () ty; + false + with Found -> true + (** Retuns true if the type contains nested borrows. Note that we can't simply explore the type and look for regions: sometimes -- cgit v1.2.3 From 56633cc7325e3b6b0462f97f39bf3d535b58044d Mon Sep 17 00:00:00 2001 From: Nadrieril Date: Mon, 8 Apr 2024 15:22:38 +0200 Subject: Update flake.nix It was missing some dependencies, and while we're at it we can disable sanity checks in tests. --- flake.nix | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/flake.nix b/flake.nix index 72c4fd99..36910f45 100644 --- a/flake.nix +++ b/flake.nix @@ -153,7 +153,14 @@ default = aeneas; }; devShells.default = pkgs.mkShell { + # By default, tests run some sanity checks which are pretty slow. + # This disables these checks when developping locally. + OPTIONS = ""; + packages = [ + pkgs.ocamlPackages.ocaml + pkgs.ocamlPackages.ocamlformat + pkgs.ocamlPackages.menhir pkgs.ocamlPackages.odoc ]; -- cgit v1.2.3 From 143a68b2c43c4302abbbd39c28cac3f9c5f52f4a Mon Sep 17 00:00:00 2001 From: Nadrieril Date: Wed, 10 Apr 2024 16:46:24 +0200 Subject: Trust rustc regarding `Copy` bounds --- compiler/InterpreterExpressions.ml | 10 +++++----- compiler/Invariants.ml | 2 +- compiler/ValuesUtils.ml | 2 +- flake.lock | 7 ++++--- flake.nix | 2 +- 5 files changed, 12 insertions(+), 11 deletions(-) diff --git a/compiler/InterpreterExpressions.ml b/compiler/InterpreterExpressions.ml index 48a1cce6..444e5788 100644 --- a/compiler/InterpreterExpressions.ml +++ b/compiler/InterpreterExpressions.ml @@ -146,7 +146,7 @@ let rec copy_value (meta : Meta.meta) (allow_adt_copy : bool) (config : config) "Can't copy an assumed value other than Option" | TAdt (TAdtId _, _) as ty -> sanity_check __FILE__ __LINE__ - (allow_adt_copy || ty_is_primitively_copyable ty) + (allow_adt_copy || ty_is_copyable ty) meta | TAdt (TTuple, _) -> () (* Ok *) | TAdt @@ -158,7 +158,7 @@ let rec copy_value (meta : Meta.meta) (allow_adt_copy : bool) (config : config) trait_refs = []; } ) -> exec_assert __FILE__ __LINE__ - (ty_is_primitively_copyable ty) + (ty_is_copyable ty) meta "The type is not primitively copyable" | _ -> exec_raise __FILE__ __LINE__ meta "Unreachable"); let ctx, fields = @@ -195,7 +195,7 @@ let rec copy_value (meta : Meta.meta) (allow_adt_copy : bool) (config : config) * thus requires calling the proper function. Here, we copy values * for very simple types such as integers, shared borrows, etc. *) cassert __FILE__ __LINE__ - (ty_is_primitively_copyable (Substitute.erase_regions sp.sv_ty)) + (ty_is_copyable (Substitute.erase_regions sp.sv_ty)) meta "Not primitively copyable"; (* If the type is copyable, we simply return the current value. Side * remark: what is important to look at when copying symbolic values @@ -529,7 +529,7 @@ let eval_binary_op_concrete_compute (meta : Meta.meta) (binop : binop) "The arguments given to the binop don't have the same type"; (* Equality/inequality check is primitive only for a subset of types *) exec_assert __FILE__ __LINE__ - (ty_is_primitively_copyable v1.ty) + (ty_is_copyable v1.ty) meta "Type is not primitively copyable"; let b = v1 = v2 in Ok { value = VLiteral (VBool b); ty = TLiteral TBool }) @@ -622,7 +622,7 @@ let eval_binary_op_symbolic (config : config) (meta : Meta.meta) (binop : binop) sanity_check __FILE__ __LINE__ (v1.ty = v2.ty) meta; (* Equality/inequality check is primitive only for a subset of types *) exec_assert __FILE__ __LINE__ - (ty_is_primitively_copyable v1.ty) + (ty_is_copyable v1.ty) meta "The type is not primitively copyable"; TLiteral TBool) else diff --git a/compiler/Invariants.ml b/compiler/Invariants.ml index 2ccf3ad4..6e448cc4 100644 --- a/compiler/Invariants.ml +++ b/compiler/Invariants.ml @@ -827,7 +827,7 @@ let check_symbolic_values (meta : Meta.meta) (ctx : eval_ctx) : unit = sanity_check __FILE__ __LINE__ (info.env_count <= 1) meta; (* A duplicated symbolic value is necessarily primitively copyable *) sanity_check __FILE__ __LINE__ - (info.env_count <= 1 || ty_is_primitively_copyable info.ty) + (info.env_count <= 1 || ty_is_copyable info.ty) meta; sanity_check __FILE__ __LINE__ diff --git a/compiler/ValuesUtils.ml b/compiler/ValuesUtils.ml index 91010e07..b6ee66f5 100644 --- a/compiler/ValuesUtils.ml +++ b/compiler/ValuesUtils.ml @@ -160,7 +160,7 @@ let find_first_primitively_copyable_sv_with_borrows method! visit_VSymbolic _ sv = let ty = sv.sv_ty in - if ty_is_primitively_copyable ty && ty_has_borrows type_infos ty then + if ty_is_copyable ty && ty_has_borrows type_infos ty then raise (FoundSymbolicValue sv) else () end diff --git a/flake.lock b/flake.lock index 27a555ad..f35ddf2e 100644 --- a/flake.lock +++ b/flake.lock @@ -8,15 +8,16 @@ "rust-overlay": "rust-overlay" }, "locked": { - "lastModified": 1712233083, - "narHash": "sha256-KR4UwlgUzLWObSzQ1LIKITjRrYe4AuZXdvCK78qrip8=", + "lastModified": 1712760963, + "narHash": "sha256-KV8ZSHfnAn9bx1JA4k7Vj8yntfxMjjqIH05yHV9IDH0=", "owner": "aeneasverif", "repo": "charon", - "rev": "6e31313fdfd4830aa0fc795f6ab8b27600fcbbfb", + "rev": "763aa8c3d308be619829939170af93624e4561f4", "type": "github" }, "original": { "owner": "aeneasverif", + "ref": "generic-copy", "repo": "charon", "type": "github" } diff --git a/flake.nix b/flake.nix index 36910f45..e1bafc6b 100644 --- a/flake.nix +++ b/flake.nix @@ -4,7 +4,7 @@ inputs = { # Remark: when adding inputs here, don't forget to also add them in the list # of outputs below! - charon.url = "github:aeneasverif/charon"; + charon.url = "github:aeneasverif/charon/generic-copy"; flake-utils.follows = "charon/flake-utils"; nixpkgs.follows = "charon/nixpkgs"; hacl-nix.url = "github:hacl-star/hacl-nix"; -- cgit v1.2.3 From c63284e3f9d7723b24f2d226355747e91ebb06aa Mon Sep 17 00:00:00 2001 From: Son HO Date: Thu, 11 Apr 2024 10:54:12 +0200 Subject: Update a comment --- compiler/Invariants.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compiler/Invariants.ml b/compiler/Invariants.ml index 6e448cc4..689db0c4 100644 --- a/compiler/Invariants.ml +++ b/compiler/Invariants.ml @@ -825,7 +825,7 @@ let check_symbolic_values (meta : Meta.meta) (ctx : eval_ctx) : unit = * it must be expanded first *) if ty_has_borrows ctx.type_ctx.type_infos info.ty then sanity_check __FILE__ __LINE__ (info.env_count <= 1) meta; - (* A duplicated symbolic value is necessarily primitively copyable *) + (* A duplicated symbolic value is necessarily copyable *) sanity_check __FILE__ __LINE__ (info.env_count <= 1 || ty_is_copyable info.ty) meta; -- cgit v1.2.3 From 2f43c95253de73fce3207a7e6895f257b857f566 Mon Sep 17 00:00:00 2001 From: Nadrieril Date: Thu, 11 Apr 2024 11:00:35 +0200 Subject: Use charon main --- flake.lock | 7 +++---- flake.nix | 2 +- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/flake.lock b/flake.lock index f35ddf2e..1eaf1375 100644 --- a/flake.lock +++ b/flake.lock @@ -8,16 +8,15 @@ "rust-overlay": "rust-overlay" }, "locked": { - "lastModified": 1712760963, - "narHash": "sha256-KV8ZSHfnAn9bx1JA4k7Vj8yntfxMjjqIH05yHV9IDH0=", + "lastModified": 1712825631, + "narHash": "sha256-YC0QArtso4Z9iBgd63FXHsSopMtWof0kC7ZrYpE6yzg=", "owner": "aeneasverif", "repo": "charon", - "rev": "763aa8c3d308be619829939170af93624e4561f4", + "rev": "657de2521c285401d706ec69d588bb5778b18109", "type": "github" }, "original": { "owner": "aeneasverif", - "ref": "generic-copy", "repo": "charon", "type": "github" } diff --git a/flake.nix b/flake.nix index e1bafc6b..36910f45 100644 --- a/flake.nix +++ b/flake.nix @@ -4,7 +4,7 @@ inputs = { # Remark: when adding inputs here, don't forget to also add them in the list # of outputs below! - charon.url = "github:aeneasverif/charon/generic-copy"; + charon.url = "github:aeneasverif/charon"; flake-utils.follows = "charon/flake-utils"; nixpkgs.follows = "charon/nixpkgs"; hacl-nix.url = "github:hacl-star/hacl-nix"; -- cgit v1.2.3 From 8894c310cd995f2f1f2abb1ca5232f98aa046274 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 11 Apr 2024 19:05:12 +0200 Subject: Reformat the code --- compiler/InterpreterExpressions.ml | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/compiler/InterpreterExpressions.ml b/compiler/InterpreterExpressions.ml index 444e5788..5f849230 100644 --- a/compiler/InterpreterExpressions.ml +++ b/compiler/InterpreterExpressions.ml @@ -157,9 +157,8 @@ let rec copy_value (meta : Meta.meta) (allow_adt_copy : bool) (config : config) const_generics = []; trait_refs = []; } ) -> - exec_assert __FILE__ __LINE__ - (ty_is_copyable ty) - meta "The type is not primitively copyable" + exec_assert __FILE__ __LINE__ (ty_is_copyable ty) meta + "The type is not primitively copyable" | _ -> exec_raise __FILE__ __LINE__ meta "Unreachable"); let ctx, fields = List.fold_left_map @@ -528,9 +527,8 @@ let eval_binary_op_concrete_compute (meta : Meta.meta) (binop : binop) exec_assert __FILE__ __LINE__ (v1.ty = v2.ty) meta "The arguments given to the binop don't have the same type"; (* Equality/inequality check is primitive only for a subset of types *) - exec_assert __FILE__ __LINE__ - (ty_is_copyable v1.ty) - meta "Type is not primitively copyable"; + exec_assert __FILE__ __LINE__ (ty_is_copyable v1.ty) meta + "Type is not primitively copyable"; let b = v1 = v2 in Ok { value = VLiteral (VBool b); ty = TLiteral TBool }) else @@ -621,9 +619,8 @@ let eval_binary_op_symbolic (config : config) (meta : Meta.meta) (binop : binop) (* Equality operations *) sanity_check __FILE__ __LINE__ (v1.ty = v2.ty) meta; (* Equality/inequality check is primitive only for a subset of types *) - exec_assert __FILE__ __LINE__ - (ty_is_copyable v1.ty) - meta "The type is not primitively copyable"; + exec_assert __FILE__ __LINE__ (ty_is_copyable v1.ty) meta + "The type is not primitively copyable"; TLiteral TBool) else (* Other operations: input types are integers *) -- cgit v1.2.3 From 9882fc2f9ac5ce0b265de9f771319a6045704abc Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 11 Apr 2024 19:51:08 +0200 Subject: Fix some F* proofs --- tests/fstar/hashmap_on_disk/HashmapMain.Properties.fst | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/fstar/hashmap_on_disk/HashmapMain.Properties.fst b/tests/fstar/hashmap_on_disk/HashmapMain.Properties.fst index 358df29e..beb3dc2c 100644 --- a/tests/fstar/hashmap_on_disk/HashmapMain.Properties.fst +++ b/tests/fstar/hashmap_on_disk/HashmapMain.Properties.fst @@ -20,7 +20,7 @@ assume val serialize_lem (hm : hashmap_HashMap_t u64) (st : state) : Lemma ( match hashmap_utils_serialize hm st with | Fail _ -> True - | Return (st', ()) -> state_v st' == hm) + | Ok (st', ()) -> state_v st' == hm) [SMTPat (hashmap_utils_serialize hm st)] /// [deserialize] gives us the hash map stored on disk, without updating it @@ -28,7 +28,7 @@ assume val deserialize_lem (st : state) : Lemma ( match hashmap_utils_deserialize st with | Fail _ -> True - | Return (st', hm) -> hm == state_v st /\ st' == st) + | Ok (st', hm) -> hm == state_v st /\ st' == st) [SMTPat (hashmap_utils_deserialize st)] (*** Lemmas *) @@ -39,10 +39,10 @@ val deserialize_lem (st : state) : Lemma ( val insert_on_disk_lem (key : usize) (value : u64) (st : state) : Lemma ( match insert_on_disk key value st with | Fail _ -> True - | Return (st', ()) -> + | Ok (st', ()) -> let hm = state_v st in match hashmap_HashMap_insert u64 hm key value with | Fail _ -> False - | Return hm' -> hm' == state_v st') + | Ok hm' -> hm' == state_v st') let insert_on_disk_lem key value st = () -- cgit v1.2.3 From f591aa7fe618838641767d835616867bbf3ec4ee Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 11 Apr 2024 19:57:47 +0200 Subject: Fix a Coq file --- tests/coq/misc/External_FunsExternal.v | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/coq/misc/External_FunsExternal.v b/tests/coq/misc/External_FunsExternal.v index e9655f57..130b48a2 100644 --- a/tests/coq/misc/External_FunsExternal.v +++ b/tests/coq/misc/External_FunsExternal.v @@ -13,7 +13,7 @@ Module External_FunsExternal. (** [core::mem::swap]: Source: '/rustc/d59363ad0b6391b7fc5bbb02c9ccf9300eef3753/library/core/src/mem/mod.rs', lines 726:0-726:42 *) Definition core_mem_swap (T : Type) (x : T) (y : T) (s : state) := - Return (s, (y, x)) + Ok (s, (y, x)) . (** [core::num::nonzero::{core::num::nonzero::NonZeroU32#14}::new]: forward function -- cgit v1.2.3 From 46567dcdab21b85d20a317a37265b037f36ad737 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 11 Apr 2024 20:08:40 +0200 Subject: Update a comment --- compiler/SymbolicToPure.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index cf03fddf..15b52237 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -282,8 +282,8 @@ type bs_ctx = { mk_panic : texpression option; (** Small helper: translate a [fail] expression. - We initialize this at [None]. - *) + We initialize this at [None]. + *) } [@@deriving show] -- cgit v1.2.3 From 8cb83fd3bd1585f2a68a47580a55dfeee01d9f0a Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 11 Apr 2024 20:10:21 +0200 Subject: Update some Lean proofs --- tests/lean/Demo/Properties.lean | 12 ++++++------ tests/lean/Hashmap/Properties.lean | 14 +++++++------- tests/lean/Tutorial.lean | 22 +++++++++++----------- 3 files changed, 24 insertions(+), 24 deletions(-) diff --git a/tests/lean/Demo/Properties.lean b/tests/lean/Demo/Properties.lean index e514ac3e..abdc2985 100644 --- a/tests/lean/Demo/Properties.lean +++ b/tests/lean/Demo/Properties.lean @@ -9,7 +9,7 @@ namespace demo -- @[pspec] theorem mul2_add1_spec (x : U32) (h : 2 * ↑x + 1 ≤ U32.max) - : ∃ y, mul2_add1 x = ret y ∧ + : ∃ y, mul2_add1 x = ok y ∧ ↑y = 2 * ↑x + (1 : Int) := by rw [mul2_add1] @@ -18,7 +18,7 @@ theorem mul2_add1_spec (x : U32) (h : 2 * ↑x + 1 ≤ U32.max) simp; scalar_tac theorem use_mul2_add1_spec (x : U32) (y : U32) (h : 2 * ↑x + 1 + ↑y ≤ U32.max) : - ∃ z, use_mul2_add1 x y = ret z ∧ + ∃ z, use_mul2_add1 x y = ok z ∧ ↑z = 2 * ↑x + (1 : Int) + ↑y := by rw [use_mul2_add1] progress with mul2_add1_spec as ⟨ i ⟩ @@ -34,7 +34,7 @@ open CList theorem list_nth_spec {T : Type} [Inhabited T] (l : CList T) (i : U32) (h : ↑i < l.to_list.len) : - ∃ x, list_nth T l i = ret x ∧ + ∃ x, list_nth T l i = ok x ∧ x = l.to_list.index ↑i := by rw [list_nth] @@ -52,7 +52,7 @@ theorem list_nth_spec {T : Type} [Inhabited T] (l : CList T) (i : U32) simp_all theorem i32_id_spec (x : I32) (h : 0 ≤ x.val) : - ∃ y, i32_id x = ret y ∧ x.val = y.val := by + ∃ y, i32_id x = ok y ∧ x.val = y.val := by rw [i32_id] if hx : x = 0#i32 then simp_all @@ -66,8 +66,8 @@ termination_by x.val.toNat decreasing_by scalar_decr_tac theorem list_tail_spec {T : Type} [Inhabited T] (l : CList T) : - ∃ back, list_tail T l = ret (CList.CNil, back) ∧ - ∀ tl', ∃ l', back tl' = ret l' ∧ l'.to_list = l.to_list ++ tl'.to_list := by + ∃ back, list_tail T l = ok (CList.CNil, back) ∧ + ∀ tl', ∃ l', back tl' = ok l' ∧ l'.to_list = l.to_list ++ tl'.to_list := by rw [list_tail] match l with | CNil => diff --git a/tests/lean/Hashmap/Properties.lean b/tests/lean/Hashmap/Properties.lean index 4e0ca509..fcaf5806 100644 --- a/tests/lean/Hashmap/Properties.lean +++ b/tests/lean/Hashmap/Properties.lean @@ -59,7 +59,7 @@ def distinct_keys (ls : Core.List (Usize × α)) := ls.pairwise_rel (λ x y => x def hash_mod_key (k : Usize) (l : Int) : Int := match hash_key k with - | .ret k => k.val % l + | .ok k => k.val % l | _ => 0 @[simp] @@ -121,7 +121,7 @@ theorem insert_in_list_spec_aux {α : Type} (l : Int) (key: Usize) (value: α) ( (hinv : slot_s_inv_hash l (hash_mod_key key l) l0.v) (hdk : distinct_keys l0.v) : ∃ b l1, - insert_in_list α key value l0 = ret (b, l1) ∧ + insert_in_list α key value l0 = ok (b, l1) ∧ -- The boolean is true ↔ we inserted a new binding (b ↔ (l0.lookup key = none)) ∧ -- We update the binding @@ -183,7 +183,7 @@ theorem insert_in_list_spec {α : Type} (l : Int) (key: Usize) (value: α) (l0: (hinv : slot_s_inv_hash l (hash_mod_key key l) l0.v) (hdk : distinct_keys l0.v) : ∃ b l1, - insert_in_list α key value l0 = ret (b, l1) ∧ + insert_in_list α key value l0 = ok (b, l1) ∧ (b ↔ (l0.lookup key = none)) ∧ -- We update the binding l1.lookup key = value ∧ @@ -240,7 +240,7 @@ set_option maxHeartbeats 2000000 theorem insert_no_resize_spec {α : Type} (hm : HashMap α) (key : Usize) (value : α) (hinv : hm.inv) (hnsat : hm.lookup key = none → hm.len_s < Usize.max) : - ∃ nhm, hm.insert_no_resize α key value = ret nhm ∧ + ∃ nhm, hm.insert_no_resize α key value = ok nhm ∧ -- We preserve the invariant nhm.inv ∧ -- We updated the binding for key @@ -253,7 +253,7 @@ theorem insert_no_resize_spec {α : Type} (hm : HashMap α) (key : Usize) (value | some _ => nhm.len_s = hm.len_s) := by rw [insert_no_resize] -- Simplify. Note that this also simplifies some function calls, like array index - simp [hash_key, bind_tc_ret] + simp [hash_key, bind_tc_ok] have _ : (alloc.vec.Vec.len (List α) hm.slots).val ≠ 0 := by intro simp_all [inv] @@ -281,7 +281,7 @@ theorem insert_no_resize_spec {α : Type} (hm : HashMap α) (key : Usize) (value rw [if_update_eq] -- TODO: necessary because we don't have a join -- TODO: progress to ... have hipost : - ∃ i0, (if inserted = true then hm.num_entries + Usize.ofInt 1 else pure hm.num_entries) = ret i0 ∧ + ∃ i0, (if inserted = true then hm.num_entries + Usize.ofInt 1 else pure hm.num_entries) = ok i0 ∧ i0.val = if inserted then hm.num_entries.val + 1 else hm.num_entries.val := by if inserted then @@ -328,7 +328,7 @@ theorem insert_no_resize_spec {α : Type} (hm : HashMap α) (key : Usize) (value -- TODO: we want to automate this simp only [k_hash_mod] have h := Int.emod_lt_of_pos k.val hvpos - simp_all only [ret.injEq, exists_eq_left', List.len_update, gt_iff_lt, + simp_all only [ok.injEq, exists_eq_left', List.len_update, gt_iff_lt, List.index_update_eq, ne_eq, not_false_eq_true, neq_imp] if h_hm : k_hash_mod = hash_mod.val then simp_all only [k_hash_mod, List.len_update, gt_iff_lt, List.index_update_eq, diff --git a/tests/lean/Tutorial.lean b/tests/lean/Tutorial.lean index d92b2dd7..94b70991 100644 --- a/tests/lean/Tutorial.lean +++ b/tests/lean/Tutorial.lean @@ -18,7 +18,7 @@ namespace Tutorial def mul2_add1 (x : U32) : Result U32 := do let x1 ← x + x let x2 ← x1 + 1#u32 - ret x2 + ok x2 /- There are several things to note. @@ -75,9 +75,9 @@ def mul2_add1 (x : U32) : Result U32 := do -/ def mul2_add1_desugared (x : U32) : Result U32 := match Scalar.add x x with - | ret x1 => -- Success case + | ok x1 => -- Success case match Scalar.add x1 (U32.ofInt 1) with - | ret x2 => ret x2 + | ok x2 => ok x2 | error => error | error => error -- Propagating the errors @@ -105,7 +105,7 @@ theorem mul2_add1_spec -/ (h : 2 * ↑x + 1 ≤ U32.max) /- The postcondition -/ - : ∃ y, mul2_add1 x = ret y ∧ -- The call succeeds + : ∃ y, mul2_add1 x = ok y ∧ -- The call succeeds ↑ y = 2 * ↑x + (1 : Int) -- The output has the expected value := by /- The proof -/ @@ -154,7 +154,7 @@ theorem mul2_add1_spec -/ @[pspec] -- the [pspec] attribute saves the theorem in a database, for [progress] to use it theorem mul2_add1_spec2 (x : U32) (h : 2 * ↑x + 1 ≤ U32.max) - : ∃ y, mul2_add1 x = ret y ∧ + : ∃ y, mul2_add1 x = ok y ∧ ↑ y = 2 * ↑x + (1 : Int) := by rw [mul2_add1] @@ -172,7 +172,7 @@ def use_mul2_add1 (x : U32) (y : U32) : Result U32 := do @[pspec] theorem use_mul2_add1_spec (x : U32) (y : U32) (h : 2 * ↑x + 1 + ↑y ≤ U32.max) : - ∃ z, use_mul2_add1 x y = ret z ∧ + ∃ z, use_mul2_add1 x y = ok z ∧ ↑z = 2 * ↑x + (1 : Int) + ↑y := by rw [use_mul2_add1] -- Here we use [progress] on [mul2_add1] @@ -230,7 +230,7 @@ divergent def list_nth (T : Type) (l : CList T) (i : U32) : Result T := match l with | CCons x tl => if i = 0#u32 - then ret x + then ok x else do let i1 ← i - 1#u32 list_nth T tl i1 @@ -263,7 +263,7 @@ theorem list_nth_spec {T : Type} [Inhabited T] (l : CList T) (i : U32) -- Precondition: the index is in bounds (h : ↑i < l.to_list.len) -- Postcondition - : ∃ x, list_nth T l i = ret x ∧ + : ∃ x, list_nth T l i = ok x ∧ -- [x] is the ith element of [l] after conversion to [List] x = l.to_list.index ↑i := by @@ -340,7 +340,7 @@ theorem list_nth_spec {T : Type} [Inhabited T] (l : CList T) (i : U32) If in a theorem we state and prove that: ``` - ∃ y, i32_id x = ret x + ∃ y, i32_id x = ok x ``` we not only prove that the function doesn't fail, but also that it terminates. @@ -348,7 +348,7 @@ theorem list_nth_spec {T : Type} [Inhabited T] (l : CList T) (i : U32) annotates it with the [divergent] keyword. -/ divergent def i32_id (x : I32) : Result I32 := - if x = 0#i32 then ret 0#i32 + if x = 0#i32 then ok 0#i32 else do let x1 ← x - 1#i32 let x2 ← i32_id x1 @@ -356,7 +356,7 @@ divergent def i32_id (x : I32) : Result I32 := /- We can easily prove that [i32_id] behaves like the identity on positive inputs -/ theorem i32_id_spec (x : I32) (h : 0 ≤ x.val) : - ∃ y, i32_id x = ret y ∧ x.val = y.val := by + ∃ y, i32_id x = ok y ∧ x.val = y.val := by rw [i32_id] if hx : x = 0#i32 then simp_all -- cgit v1.2.3 From 2f8aa9b47acb5c98aed91c29b04f71099452e781 Mon Sep 17 00:00:00 2001 From: Son Ho Date: Thu, 11 Apr 2024 20:22:26 +0200 Subject: Update a Lean file --- tests/lean/External/FunsExternal.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/lean/External/FunsExternal.lean b/tests/lean/External/FunsExternal.lean index 63830abc..b6efc65f 100644 --- a/tests/lean/External/FunsExternal.lean +++ b/tests/lean/External/FunsExternal.lean @@ -9,7 +9,7 @@ open external /- [core::mem::swap] -/ def core.mem.swap (T : Type) : T → T → State → Result (State × (T × T)) := - fun x y s => .ret (s, (y, x)) + fun x y s => .ok (s, (y, x)) /- [core::num::nonzero::NonZeroU32::{14}::new] -/ def core.num.nonzero.NonZeroU32.new : -- cgit v1.2.3