diff options
| author | Escherichia | 2024-06-18 22:47:35 +0200 |
|---|---|---|
| committer | GitHub | 2024-06-18 22:47:35 +0200 |
| commit | aa8e74197687ecc6d8f925babc8ba3cd6c739990 (patch) | |
| tree | f9975ae9f6276e8bd9db866621497a53485007d1 | |
| parent | 370f2668f0a36fb31ed9abb4ba613dad333cf406 (diff) | |
Support for renaming using the rename attribute in charon (#239)
* support for renaming using the rename attribute in charon
* support for global decl
* add support for renaming field
* applied suggested changes and began adding support for variant
* finished support for renaming variant
* applied suggested changes
* add tests
* fixed variant and field renaming
* update charon-pin
* update flake.lock
* Update the charon pin
* Fix an issue with renaming trait method implementations
* Fix an issue with the renaming of trait implementations
* Fix an issue when renaming enumerations
* Update the Charon pin
* Fix the F* tests
* Fix an issue with the spans for the loops
* Fix the tests
* Update a comment
* Use fuel in the coq tests
* Generate the template decreases clauses by default
---------
Co-authored-by: Escherichia <escherichia@charlotte>
Co-authored-by: Son Ho <hosonmarc@gmail.com>
Diffstat (limited to '')
27 files changed, 2797 insertions, 301 deletions
@@ -1,2 +1,2 @@ # This is the commit from https://github.com/AeneasVerif/charon that should be used with this version of aeneas. -a350f1e4795d57fb7b23c4c2d24003cf5e16315f +28dc4f9b826031754fcd32c82355f6d0be05faca diff --git a/compiler/Config.ml b/compiler/Config.ml index 584635bc..98a5eea1 100644 --- a/compiler/Config.ml +++ b/compiler/Config.ml @@ -214,10 +214,13 @@ let test_trans_unit_functions = ref false let extract_decreases_clauses = ref false (** In order to help the user, we can generate "template" decrease clauses/ termination - measures (i.e., definitions with proper signatures but dummy bodies) in a dedicated - file. + measures (i.e., definitions with proper signatures but dummy bodies) in a dedicated + file. + + We initialize it to [true], then deactivate it depending on the CL options + given by the user. *) -let extract_template_decreases_clauses = ref false +let extract_template_decreases_clauses = ref true (** {1 Micro passes} *) diff --git a/compiler/Extract.ml b/compiler/Extract.ml index b1adb936..6c6b7f0e 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -46,7 +46,8 @@ let extract_fun_decl_register_names (ctx : extraction_ctx) let f = def.f in let open ExtractBuiltin in let fun_id = (Pure.FunId (FRegular f.def_id), f.loop_id) in - ctx_add f.span (FunId (FromLlbc fun_id)) fun_info.extract_name ctx + ctx_add f.item_meta.span (FunId (FromLlbc fun_id)) + fun_info.extract_name ctx | None -> (* Not builtin *) (* If this is a trait method implementation, we prefix the name with the @@ -60,7 +61,7 @@ let extract_fun_decl_register_names (ctx : extraction_ctx) (* Add the decreases proof for Lean only *) match backend () with | Coq | FStar -> ctx - | HOL4 -> craise __FILE__ __LINE__ def.span "Unexpected" + | HOL4 -> craise __FILE__ __LINE__ def.item_meta.span "Unexpected" | Lean -> ctx_add_decreases_proof def ctx else ctx in @@ -467,9 +468,10 @@ and extract_function_call (span : Meta.span) (ctx : extraction_ctx) if not method_id.is_provided then ( (* Required method *) - sanity_check __FILE__ __LINE__ (lp_id = None) trait_decl.span; - extract_trait_ref trait_decl.span ctx fmt TypeDeclId.Set.empty true - trait_ref; + sanity_check __FILE__ __LINE__ (lp_id = None) + trait_decl.item_meta.span; + extract_trait_ref trait_decl.item_meta.span ctx fmt + TypeDeclId.Set.empty true trait_ref; let fun_name = ctx_get_trait_method span trait_ref.trait_decl_ref.trait_decl_id method_name ctx @@ -482,7 +484,9 @@ and extract_function_call (span : Meta.span) (ctx : extraction_ctx) (* Provided method: we see it as a regular function call, and use the function name *) let fun_id = FromLlbc (FunId (FRegular method_id.id), lp_id) in - let fun_name = ctx_get_function trait_decl.span fun_id ctx in + let fun_name = + ctx_get_function trait_decl.item_meta.span fun_id ctx + in F.pp_print_string fmt fun_name; (* Note that we do not need to print the generics for the trait @@ -491,8 +495,8 @@ and extract_function_call (span : Meta.span) (ctx : extraction_ctx) Print the trait ref (to instantate the self clause) *) F.pp_print_space fmt (); - extract_trait_ref trait_decl.span ctx fmt TypeDeclId.Set.empty true - trait_ref + extract_trait_ref trait_decl.item_meta.span ctx fmt + TypeDeclId.Set.empty true trait_ref | _ -> let fun_name = ctx_get_function span fun_id ctx in F.pp_print_string fmt fun_name); @@ -1146,7 +1150,7 @@ let extract_fun_parameters (space : bool ref) (ctx : extraction_ctx) match def.kind with | TraitItemProvided (decl_id, _) -> let trait_decl = T.TraitDeclId.Map.find decl_id ctx.trans_trait_decls in - let ctx, _ = ctx_add_trait_self_clause def.span ctx in + let ctx, _ = ctx_add_trait_self_clause def.item_meta.span ctx in let ctx = { ctx with is_provided_method = true } in (ctx, Some trait_decl) | _ -> (ctx, None) @@ -1154,14 +1158,14 @@ let extract_fun_parameters (space : bool ref) (ctx : extraction_ctx) (* Add the type parameters - note that we need those bindings only for the * body translation (they are not top-level) *) let ctx, type_params, cg_params, trait_clauses = - ctx_add_generic_params def.span def.llbc_name def.signature.llbc_generics - def.signature.generics ctx + ctx_add_generic_params def.item_meta.span def.llbc_name + def.signature.llbc_generics def.signature.generics ctx in (* Print the generics *) (* Open a box for the generics *) F.pp_open_hovbox fmt 0; (let space = Some space in - extract_generic_params def.span ctx fmt TypeDeclId.Set.empty ~space + extract_generic_params def.item_meta.span ctx fmt TypeDeclId.Set.empty ~space ~trait_decl def.signature.generics type_params cg_params trait_clauses); (* Close the box for the generics *) F.pp_close_box fmt (); @@ -1176,11 +1180,14 @@ let extract_fun_parameters (space : bool ref) (ctx : extraction_ctx) (* Open a box for the input parameter *) F.pp_open_hovbox fmt 0; F.pp_print_string fmt "("; - let ctx = extract_typed_pattern def.span ctx fmt true false lv in + let ctx = + extract_typed_pattern def.item_meta.span ctx fmt true false lv + in F.pp_print_space fmt (); F.pp_print_string fmt ":"; F.pp_print_space fmt (); - extract_ty def.span ctx fmt TypeDeclId.Set.empty false lv.ty; + extract_ty def.item_meta.span ctx fmt TypeDeclId.Set.empty false + lv.ty; F.pp_print_string fmt ")"; (* Close the box for the input parameters *) F.pp_close_box fmt (); @@ -1199,7 +1206,7 @@ let extract_fun_input_parameters_types (ctx : extraction_ctx) (fmt : F.formatter) (def : fun_decl) : unit = let extract_param (ty : ty) : unit = let inside = false in - extract_ty def.span ctx fmt TypeDeclId.Set.empty inside ty; + extract_ty def.item_meta.span ctx fmt TypeDeclId.Set.empty inside ty; F.pp_print_space fmt (); extract_arrow fmt (); F.pp_print_space fmt () @@ -1209,7 +1216,8 @@ let extract_fun_input_parameters_types (ctx : extraction_ctx) let extract_fun_inputs_output_parameters_types (ctx : extraction_ctx) (fmt : F.formatter) (def : fun_decl) : unit = extract_fun_input_parameters_types ctx fmt def; - extract_ty def.span ctx fmt TypeDeclId.Set.empty false def.signature.output + extract_ty def.item_meta.span ctx fmt TypeDeclId.Set.empty false + def.signature.output let assert_backend_supports_decreases_clauses (span : Meta.span) = match backend () with @@ -1238,13 +1246,13 @@ let extract_template_fstar_decreases_clause (ctx : extraction_ctx) (fmt : F.formatter) (def : fun_decl) : unit = cassert __FILE__ __LINE__ (backend () = FStar) - def.span + def.item_meta.span "The generation of template decrease clauses is only supported for the F* \ backend"; (* Retrieve the function name *) let def_name = - ctx_get_termination_measure def.span def.def_id def.loop_id ctx + ctx_get_termination_measure def.item_meta.span def.def_id def.loop_id ctx in (* Add a break before *) F.pp_print_break fmt 0 0; @@ -1256,7 +1264,7 @@ let extract_template_fstar_decreases_clause (ctx : extraction_ctx) in extract_comment_with_raw_span ctx fmt [ "[" ^ name_to_string ctx def.llbc_name ^ "]: decreases clause" ] - name def.span.span); + name def.item_meta.span.span); F.pp_print_space fmt (); (* Open a box for the definition, so that whenever possible it gets printed on * one line *) @@ -1309,7 +1317,7 @@ let extract_template_lean_termination_and_decreasing (ctx : extraction_ctx) (fmt : F.formatter) (def : fun_decl) : unit = cassert __FILE__ __LINE__ (backend () = Lean) - def.span + def.item_meta.span "The generation of template termination and decreasing clauses is only \ supported for the Lean backend"; (* @@ -1317,7 +1325,7 @@ let extract_template_lean_termination_and_decreasing (ctx : extraction_ctx) *) (* Retrieve the function name *) let def_name = - ctx_get_termination_measure def.span def.def_id def.loop_id ctx + ctx_get_termination_measure def.item_meta.span def.def_id def.loop_id ctx in let def_body = Option.get def.body in (* Add a break before *) @@ -1325,7 +1333,7 @@ let extract_template_lean_termination_and_decreasing (ctx : extraction_ctx) (* Print a comment to link the extracted type to its original rust definition *) extract_comment_with_raw_span ctx fmt [ "[" ^ name_to_string ctx def.llbc_name ^ "]: termination measure" ] - None def.span.span; + None def.item_meta.span.span; F.pp_print_space fmt (); (* Open a box for the definition, so that whenever possible it gets printed on * one line *) @@ -1353,7 +1361,8 @@ let extract_template_lean_termination_and_decreasing (ctx : extraction_ctx) let vars = List.map (fun (v : var) -> v.id) def_body.inputs in if List.length vars = 1 then - F.pp_print_string fmt (ctx_get_var def.span (List.hd vars) ctx_body) + F.pp_print_string fmt + (ctx_get_var def.item_meta.span (List.hd vars) ctx_body) else ( F.pp_open_hovbox fmt 0; F.pp_print_string fmt "("; @@ -1361,7 +1370,8 @@ let extract_template_lean_termination_and_decreasing (ctx : extraction_ctx) (fun () -> F.pp_print_string fmt ","; F.pp_print_space fmt ()) - (fun v -> F.pp_print_string fmt (ctx_get_var def.span v ctx_body)) + (fun v -> + F.pp_print_string fmt (ctx_get_var def.item_meta.span v ctx_body)) vars; F.pp_print_string fmt ")"; F.pp_close_box fmt ()); @@ -1375,12 +1385,14 @@ let extract_template_lean_termination_and_decreasing (ctx : extraction_ctx) (* * Extract a template for the decreases proof *) - let def_name = ctx_get_decreases_proof def.span def.def_id def.loop_id ctx in + let def_name = + ctx_get_decreases_proof def.item_meta.span def.def_id def.loop_id ctx + in (* syntax <def_name> term ... term : tactic *) F.pp_print_break fmt 0 0; extract_comment_with_raw_span ctx fmt [ "[" ^ name_to_string ctx def.llbc_name ^ "]: decreases_by tactic" ] - None def.span.span; + None def.item_meta.span.span; F.pp_print_space fmt (); F.pp_open_hvbox fmt 0; F.pp_print_string fmt "syntax \""; @@ -1398,7 +1410,7 @@ let extract_template_lean_termination_and_decreasing (ctx : extraction_ctx) (fun v -> F.pp_print_space fmt (); F.pp_print_string fmt "$"; - F.pp_print_string fmt (ctx_get_var def.span v ctx_body)) + F.pp_print_string fmt (ctx_get_var def.item_meta.span v ctx_body)) vars; F.pp_print_string fmt ") =>"; F.pp_close_box fmt (); @@ -1425,7 +1437,7 @@ let extract_fun_comment (ctx : extraction_ctx) (fmt : F.formatter) Some def.llbc_name else None in - extract_comment_with_raw_span ctx fmt comment name def.span.span + extract_comment_with_raw_span ctx fmt comment name def.item_meta.span.span (** Extract a function declaration. @@ -1436,9 +1448,13 @@ let extract_fun_comment (ctx : extraction_ctx) (fmt : F.formatter) *) let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) (kind : decl_kind) (has_decreases_clause : bool) (def : fun_decl) : unit = - sanity_check __FILE__ __LINE__ (not def.is_global_decl_body) def.span; + sanity_check __FILE__ __LINE__ + (not def.is_global_decl_body) + def.item_meta.span; (* Retrieve the function name *) - let def_name = ctx_get_local_function def.span def.def_id def.loop_id ctx in + let def_name = + ctx_get_local_function def.item_meta.span def.def_id def.loop_id ctx + in (* Add a break before *) if backend () <> HOL4 || not (decl_is_first_from_group kind) then F.pp_print_break fmt 0 0; @@ -1512,18 +1528,18 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) if is_opaque then extract_fun_input_parameters_types ctx fmt def; (* [Tot] *) if has_decreases_clause then ( - assert_backend_supports_decreases_clauses def.span; + assert_backend_supports_decreases_clauses def.item_meta.span; if backend () = FStar then ( F.pp_print_string fmt "Tot"; F.pp_print_space fmt ())); - extract_ty def.span ctx fmt TypeDeclId.Set.empty has_decreases_clause - def.signature.output; + extract_ty def.item_meta.span ctx fmt TypeDeclId.Set.empty + has_decreases_clause def.signature.output; (* Close the box for the return type *) F.pp_close_box fmt (); (* Print the decrease clause - rk.: a function with a decreases clause * is necessarily a transparent function *) if has_decreases_clause && backend () = FStar then ( - assert_backend_supports_decreases_clauses def.span; + assert_backend_supports_decreases_clauses def.item_meta.span; F.pp_print_space fmt (); (* Open a box for the decreases clause *) F.pp_open_hovbox fmt ctx.indent_incr; @@ -1534,7 +1550,8 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) F.pp_open_hovbox fmt ctx.indent_incr; (* The name of the decrease clause *) let decr_name = - ctx_get_termination_measure def.span def.def_id def.loop_id ctx + ctx_get_termination_measure def.item_meta.span def.def_id def.loop_id + ctx in F.pp_print_string fmt decr_name; (* Print the generic parameters - TODO: we do this many @@ -1565,7 +1582,9 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) List.fold_left (fun ctx (lv : typed_pattern) -> F.pp_print_space fmt (); - let ctx = extract_typed_pattern def.span ctx fmt true false lv in + let ctx = + extract_typed_pattern def.item_meta.span ctx fmt true false lv + in ctx) ctx inputs_lvs in @@ -1592,7 +1611,8 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) F.pp_open_hvbox fmt 0; (* Extract the body *) let _ = - extract_texpression def.span ctx_body fmt false (Option.get def.body).body + extract_texpression def.item_meta.span ctx_body fmt false + (Option.get def.body).body in (* Close the box for the body *) F.pp_close_box fmt ()); @@ -1609,7 +1629,7 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) (* termination_by *) let terminates_name = - ctx_get_termination_measure def.span def.def_id def.loop_id ctx + ctx_get_termination_measure def.item_meta.span def.def_id def.loop_id ctx in F.pp_print_break fmt 0 0; (* Open a box for the whole [termination_by CALL => DECREASES] *) @@ -1622,7 +1642,7 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) List.iter (fun v -> F.pp_print_space fmt (); - F.pp_print_string fmt (ctx_get_var def.span v ctx_body)) + F.pp_print_string fmt (ctx_get_var def.item_meta.span v ctx_body)) all_vars; F.pp_print_space fmt (); F.pp_print_string fmt "=>"; @@ -1642,7 +1662,7 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) List.iter (fun v -> F.pp_print_space fmt (); - F.pp_print_string fmt (ctx_get_var def.span v ctx_body)) + F.pp_print_string fmt (ctx_get_var def.item_meta.span v ctx_body)) vars; (* Close the box for [DECREASES] *) F.pp_close_box fmt (); @@ -1653,7 +1673,7 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) (* Open a box for the [decreasing by ...] *) F.pp_open_hvbox fmt ctx.indent_incr; let decreases_name = - ctx_get_decreases_proof def.span def.def_id def.loop_id ctx + ctx_get_decreases_proof def.item_meta.span def.def_id def.loop_id ctx in F.pp_print_string fmt "decreasing_by"; F.pp_print_space fmt (); @@ -1662,7 +1682,7 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) List.iter (fun v -> F.pp_print_space fmt (); - F.pp_print_string fmt (ctx_get_var def.span v ctx_body)) + F.pp_print_string fmt (ctx_get_var def.item_meta.span v ctx_body)) vars; F.pp_close_box fmt (); (* Close the box for the [decreasing by ...] *) @@ -1692,16 +1712,18 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) let extract_fun_decl_hol4_opaque (ctx : extraction_ctx) (fmt : F.formatter) (def : fun_decl) : unit = (* Retrieve the definition name *) - let def_name = ctx_get_local_function def.span def.def_id def.loop_id ctx in + let def_name = + ctx_get_local_function def.item_meta.span def.def_id def.loop_id ctx + in cassert __FILE__ __LINE__ (def.signature.generics.const_generics = []) - def.span + def.item_meta.span "Constant generics are not supported yet when generating code for HOL4"; (* Add the type/const gen parameters - note that we need those bindings only for the generation of the type (they are not top-level) *) let ctx, _, _, _ = - ctx_add_generic_params def.span def.llbc_name def.signature.llbc_generics - def.signature.generics ctx + ctx_add_generic_params def.item_meta.span def.llbc_name + def.signature.llbc_generics def.signature.generics ctx in (* Add breaks to insert new lines between definitions *) F.pp_print_break fmt 0 0; @@ -1717,7 +1739,8 @@ let extract_fun_decl_hol4_opaque (ctx : extraction_ctx) (fmt : F.formatter) F.pp_print_string fmt "“:"; (* Generate the type *) extract_fun_input_parameters_types ctx fmt def; - extract_ty def.span ctx fmt TypeDeclId.Set.empty false def.signature.output; + extract_ty def.item_meta.span ctx fmt TypeDeclId.Set.empty false + def.signature.output; (* Close the box for the type *) F.pp_print_string fmt "”"; F.pp_close_box fmt (); @@ -1742,7 +1765,9 @@ let extract_fun_decl_hol4_opaque (ctx : extraction_ctx) (fmt : F.formatter) *) let extract_fun_decl (ctx : extraction_ctx) (fmt : F.formatter) (kind : decl_kind) (has_decreases_clause : bool) (def : fun_decl) : unit = - sanity_check __FILE__ __LINE__ (not def.is_global_decl_body) def.span; + sanity_check __FILE__ __LINE__ + (not def.is_global_decl_body) + def.item_meta.span; (* We treat HOL4 opaque functions in a specific manner *) if backend () = HOL4 && Option.is_none def.body then extract_fun_decl_hol4_opaque ctx fmt def @@ -1892,7 +1917,7 @@ let extract_global_decl_hol4_opaque (span : Meta.span) (ctx : extraction_ctx) *) let extract_global_decl_aux (ctx : extraction_ctx) (fmt : F.formatter) (global : global_decl) (body : fun_decl) (interface : bool) : unit = - let span = body.span in + let span = body.item_meta.span in sanity_check __FILE__ __LINE__ body.is_global_decl_body span; sanity_check __FILE__ __LINE__ (body.signature.inputs = []) span; @@ -2018,7 +2043,7 @@ let extract_trait_decl_register_parent_clause_names (ctx : extraction_ctx) (* Register the names *) List.fold_left (fun ctx (cid, cname) -> - ctx_add trait_decl.span + ctx_add trait_decl.item_meta.span (TraitParentClauseId (trait_decl.def_id, cid)) cname ctx) ctx clause_names @@ -2053,7 +2078,7 @@ let extract_trait_decl_register_constant_names (ctx : extraction_ctx) (* Register the names *) List.fold_left (fun ctx (item_name, name) -> - ctx_add trait_decl.span + ctx_add trait_decl.item_meta.span (TraitItemId (trait_decl.def_id, item_name)) name ctx) ctx constant_names @@ -2114,13 +2139,13 @@ let extract_trait_decl_type_names (ctx : extraction_ctx) List.fold_left (fun ctx (item_name, (type_name, clauses)) -> let ctx = - ctx_add trait_decl.span + ctx_add trait_decl.item_meta.span (TraitItemId (trait_decl.def_id, item_name)) type_name ctx in List.fold_left (fun ctx (clause_id, clause_name) -> - ctx_add trait_decl.span + ctx_add trait_decl.item_meta.span (TraitItemClauseId (trait_decl.def_id, item_name, clause_id)) clause_name ctx) ctx clauses) @@ -2172,7 +2197,7 @@ let extract_trait_decl_method_names (ctx : extraction_ctx) (* Register the names *) List.fold_left (fun ctx (item_name, fun_name) -> - ctx_add trait_decl.span + ctx_add trait_decl.item_meta.span (TraitMethodId (trait_decl.def_id, item_name)) fun_name ctx) ctx method_names @@ -2195,9 +2220,10 @@ let extract_trait_decl_register_names (ctx : extraction_ctx) | Some info -> (info.extract_name, info.constructor) in let ctx = - ctx_add trait_decl.span (TraitDeclId trait_decl.def_id) trait_name ctx + ctx_add trait_decl.item_meta.span (TraitDeclId trait_decl.def_id) + trait_name ctx in - ctx_add trait_decl.span (TraitDeclConstructorId trait_decl.def_id) + ctx_add trait_decl.item_meta.span (TraitDeclConstructorId trait_decl.def_id) trait_constructor ctx in (* Parent clauses *) @@ -2254,7 +2280,7 @@ let extract_trait_impl_register_names (ctx : extraction_ctx) (* For now we do not support overriding provided methods *) cassert __FILE__ __LINE__ (trait_impl.provided_methods = []) - trait_impl.span + trait_impl.item_meta.span ("Overriding trait provided methods in trait implementations is not \ supported yet (overriden methods: " ^ String.concat ", " (List.map fst trait_impl.provided_methods) @@ -2267,7 +2293,7 @@ let extract_trait_impl_register_names (ctx : extraction_ctx) | None -> ctx_compute_trait_impl_name ctx trait_decl trait_impl | Some name -> name in - ctx_add trait_decl.span (TraitImplId trait_impl.def_id) name ctx + ctx_add trait_decl.item_meta.span (TraitImplId trait_impl.def_id) name ctx (** Small helper. @@ -2316,7 +2342,9 @@ let extract_trait_decl_method_items (ctx : extraction_ctx) (fmt : F.formatter) let trans = A.FunDeclId.Map.find id ctx.trans_funs in (* Extract the items *) let f = trans.f in - let fun_name = ctx_get_trait_method decl.span decl.def_id item_name ctx in + let fun_name = + ctx_get_trait_method decl.item_meta.span decl.def_id item_name ctx + in let ty () = (* Extract the generics *) (* We need to add the generics specific to the method, by removing those @@ -2332,8 +2360,8 @@ let extract_trait_decl_method_items (ctx : extraction_ctx) (fmt : F.formatter) - we only generate trait clauses for the clauses we find in the pure generics *) let ctx, type_params, cg_params, trait_clauses = - ctx_add_generic_params decl.span f.llbc_name f.signature.llbc_generics - generics ctx + ctx_add_generic_params decl.item_meta.span f.llbc_name + f.signature.llbc_generics generics ctx in let backend_uses_forall = match backend () with Coq | Lean -> true | FStar | HOL4 -> false @@ -2342,8 +2370,8 @@ let extract_trait_decl_method_items (ctx : extraction_ctx) (fmt : F.formatter) let use_forall = generics_not_empty && backend_uses_forall in let use_arrows = generics_not_empty && not backend_uses_forall in let use_forall_use_sep = false in - extract_generic_params decl.span ctx fmt TypeDeclId.Set.empty ~use_forall - ~use_forall_use_sep ~use_arrows generics type_params cg_params + extract_generic_params decl.item_meta.span ctx fmt TypeDeclId.Set.empty + ~use_forall ~use_forall_use_sep ~use_arrows generics type_params cg_params trait_clauses; if use_forall then F.pp_print_string fmt ","; (* Extract the inputs and output *) @@ -2356,7 +2384,7 @@ let extract_trait_decl_method_items (ctx : extraction_ctx) (fmt : F.formatter) let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter) (decl : trait_decl) : unit = (* Retrieve the trait name *) - let decl_name = ctx_get_trait_decl decl.span decl.def_id ctx in + let decl_name = ctx_get_trait_decl decl.item_meta.span decl.def_id ctx in (* Add a break before *) F.pp_print_break fmt 0 0; (* Print a comment to link the extracted type to its original rust definition *) @@ -2367,7 +2395,7 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter) in extract_comment_with_raw_span ctx fmt [ "Trait declaration: [" ^ name_to_string ctx decl.llbc_name ^ "]" ] - name decl.span.span); + name decl.item_meta.span.span); F.pp_print_break fmt 0 0; (* Open two outer boxes for the definition, so that whenever possible it gets printed on one line and indents are correct. @@ -2384,7 +2412,8 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter) (* Open the box for the name + generics *) F.pp_open_hovbox fmt ctx.indent_incr; let qualif = - Option.get (type_decl_kind_to_qualif decl.span SingleNonRec (Some Struct)) + Option.get + (type_decl_kind_to_qualif decl.item_meta.span SingleNonRec (Some Struct)) in (* When checking if the trait declaration is empty: we ignore the provided methods, because for now they are extracted separately *) @@ -2400,11 +2429,11 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter) (* Add the type and const generic params - note that we need those bindings only for the * body translation (they are not top-level) *) let ctx, type_params, cg_params, trait_clauses = - ctx_add_generic_params decl.span decl.llbc_name decl.llbc_generics generics - ctx + ctx_add_generic_params decl.item_meta.span decl.llbc_name decl.llbc_generics + generics ctx in - extract_generic_params decl.span ctx fmt TypeDeclId.Set.empty generics - type_params cg_params trait_clauses; + extract_generic_params decl.item_meta.span ctx fmt TypeDeclId.Set.empty + generics type_params cg_params trait_clauses; F.pp_print_space fmt (); if is_empty && backend () = FStar then ( @@ -2413,7 +2442,7 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter) F.pp_close_box fmt ()) else if is_empty && backend () = Coq then ( (* Coq is not very good at infering constructors *) - let cons = ctx_get_trait_constructor decl.span decl.def_id ctx in + let cons = ctx_get_trait_constructor decl.item_meta.span decl.def_id ctx in F.pp_print_string fmt (":= " ^ cons ^ "{}."); (* Outer box *) F.pp_close_box fmt ()) @@ -2422,7 +2451,9 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter) | Lean -> F.pp_print_string fmt "where" | FStar -> F.pp_print_string fmt "= {" | Coq -> - let cons = ctx_get_trait_constructor decl.span decl.def_id ctx in + let cons = + ctx_get_trait_constructor decl.item_meta.span decl.def_id ctx + in F.pp_print_string fmt (":= " ^ cons ^ " {") | _ -> F.pp_print_string fmt "{"); @@ -2436,11 +2467,13 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter) (* The constants *) List.iter (fun (name, (ty, _)) -> - let item_name = ctx_get_trait_const decl.span decl.def_id name ctx in + let item_name = + ctx_get_trait_const decl.item_meta.span decl.def_id name ctx + in let ty () = let inside = false in F.pp_print_space fmt (); - extract_ty decl.span ctx fmt TypeDeclId.Set.empty inside ty + extract_ty decl.item_meta.span ctx fmt TypeDeclId.Set.empty inside ty in extract_trait_decl_item ctx fmt item_name ty) decl.consts; @@ -2449,23 +2482,25 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter) List.iter (fun (name, (clauses, _)) -> (* Extract the type *) - let item_name = ctx_get_trait_type decl.span decl.def_id name ctx in + let item_name = + ctx_get_trait_type decl.item_meta.span decl.def_id name ctx + in let ty () = F.pp_print_space fmt (); - F.pp_print_string fmt (type_keyword decl.span) + F.pp_print_string fmt (type_keyword decl.item_meta.span) in extract_trait_decl_item ctx fmt item_name ty; (* Extract the clauses *) List.iter (fun clause -> let item_name = - ctx_get_trait_item_clause decl.span decl.def_id name + ctx_get_trait_item_clause decl.item_meta.span decl.def_id name clause.clause_id ctx in let ty () = F.pp_print_space fmt (); - extract_trait_clause_type decl.span ctx fmt TypeDeclId.Set.empty - clause + extract_trait_clause_type decl.item_meta.span ctx fmt + TypeDeclId.Set.empty clause in extract_trait_decl_item ctx fmt item_name ty) clauses) @@ -2476,12 +2511,13 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter) List.iter (fun clause -> let item_name = - ctx_get_trait_parent_clause decl.span decl.def_id clause.clause_id ctx + ctx_get_trait_parent_clause decl.item_meta.span decl.def_id + clause.clause_id ctx in let ty () = F.pp_print_space fmt (); - extract_trait_clause_type decl.span ctx fmt TypeDeclId.Set.empty - clause + extract_trait_clause_type decl.item_meta.span ctx fmt + TypeDeclId.Set.empty clause in extract_trait_decl_item ctx fmt item_name ty) decl.parent_clauses; @@ -2518,25 +2554,31 @@ let extract_trait_decl_coq_arguments (ctx : extraction_ctx) (fmt : F.formatter) in if num_params > 0 then ( (* The constructor *) - let cons_name = ctx_get_trait_constructor decl.span decl.def_id ctx in + let cons_name = + ctx_get_trait_constructor decl.item_meta.span decl.def_id ctx + in extract_coq_arguments_instruction ctx fmt cons_name num_params; (* The constants *) List.iter (fun (name, _) -> - let item_name = ctx_get_trait_const decl.span decl.def_id name ctx in + let item_name = + ctx_get_trait_const decl.item_meta.span decl.def_id name ctx + in extract_coq_arguments_instruction ctx fmt item_name num_params) decl.consts; (* The types *) List.iter (fun (name, (clauses, _)) -> (* The type *) - let item_name = ctx_get_trait_type decl.span decl.def_id name ctx in + let item_name = + ctx_get_trait_type decl.item_meta.span decl.def_id name ctx + in extract_coq_arguments_instruction ctx fmt item_name num_params; (* The type clauses *) List.iter (fun clause -> let item_name = - ctx_get_trait_item_clause decl.span decl.def_id name + ctx_get_trait_item_clause decl.item_meta.span decl.def_id name clause.clause_id ctx in extract_coq_arguments_instruction ctx fmt item_name num_params) @@ -2546,7 +2588,8 @@ let extract_trait_decl_coq_arguments (ctx : extraction_ctx) (fmt : F.formatter) List.iter (fun clause -> let item_name = - ctx_get_trait_parent_clause decl.span decl.def_id clause.clause_id ctx + ctx_get_trait_parent_clause decl.item_meta.span decl.def_id + clause.clause_id ctx in extract_coq_arguments_instruction ctx fmt item_name num_params) decl.parent_clauses; @@ -2555,7 +2598,7 @@ let extract_trait_decl_coq_arguments (ctx : extraction_ctx) (fmt : F.formatter) (fun (item_name, _) -> (* Extract the items *) let item_name = - ctx_get_trait_method decl.span decl.def_id item_name ctx + ctx_get_trait_method decl.item_meta.span decl.def_id item_name ctx in extract_coq_arguments_instruction ctx fmt item_name num_params) decl.required_methods; @@ -2581,7 +2624,9 @@ let extract_trait_impl_method_items (ctx : extraction_ctx) (fmt : F.formatter) let trans = A.FunDeclId.Map.find id ctx.trans_funs in (* Extract the items *) let f = trans.f in - let fun_name = ctx_get_trait_method impl.span trait_decl_id item_name ctx in + let fun_name = + ctx_get_trait_method impl.item_meta.span trait_decl_id item_name ctx + in let ty () = (* Filter the generics if the method is a builtin *) let i_tys, _, _ = impl_generics in @@ -2621,16 +2666,18 @@ let extract_trait_impl_method_items (ctx : extraction_ctx) (fmt : F.formatter) - we only generate trait clauses for the clauses we find in the pure generics *) let ctx, f_tys, f_cgs, f_tcs = - ctx_add_generic_params impl.span f.llbc_name f.signature.llbc_generics - f_generics ctx + ctx_add_generic_params impl.item_meta.span f.llbc_name + f.signature.llbc_generics f_generics ctx in let use_forall = f_generics <> empty_generic_params in - extract_generic_params impl.span ctx fmt TypeDeclId.Set.empty ~use_forall - f_generics f_tys f_cgs f_tcs; + extract_generic_params impl.item_meta.span ctx fmt TypeDeclId.Set.empty + ~use_forall f_generics f_tys f_cgs f_tcs; if use_forall then F.pp_print_string fmt ","; (* Extract the function call *) F.pp_print_space fmt (); - let fun_name = ctx_get_local_function impl.span f.def_id None ctx in + let fun_name = + ctx_get_local_function impl.item_meta.span f.def_id None ctx + in F.pp_print_string fmt fun_name; let all_generics = let _, i_cgs, i_tcs = impl_generics in @@ -2651,7 +2698,7 @@ let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter) (impl : trait_impl) : unit = log#ldebug (lazy ("extract_trait_impl: " ^ name_to_string ctx impl.llbc_name)); (* Retrieve the impl name *) - let impl_name = ctx_get_trait_impl impl.span impl.def_id ctx in + let impl_name = ctx_get_trait_impl impl.item_meta.span impl.def_id ctx in (* Add a break before *) F.pp_print_break fmt 0 0; (* Print a comment to link the extracted type to its original rust definition *) @@ -2667,7 +2714,7 @@ let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter) extract_comment_with_raw_span ctx fmt [ "Trait implementation: [" ^ name_to_string ctx impl.llbc_name ^ "]" ] (* TODO: why option option for the generics? Looks like a bug in OCaml!? *) - name ?generics:(Some generics) impl.span.span); + name ?generics:(Some generics) impl.item_meta.span.span); F.pp_print_break fmt 0 0; (* Open two outer boxes for the definition, so that whenever possible it gets printed on @@ -2697,18 +2744,18 @@ let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter) (* Add the type and const generic params - note that we need those bindings only for the * body translation (they are not top-level) *) let ctx, type_params, cg_params, trait_clauses = - ctx_add_generic_params impl.span impl.llbc_name impl.llbc_generics + ctx_add_generic_params impl.item_meta.span impl.llbc_name impl.llbc_generics impl.generics ctx in let all_generics = (type_params, cg_params, trait_clauses) in - extract_generic_params impl.span ctx fmt TypeDeclId.Set.empty impl.generics - type_params cg_params trait_clauses; + extract_generic_params impl.item_meta.span ctx fmt TypeDeclId.Set.empty + impl.generics type_params cg_params trait_clauses; (* Print the type *) F.pp_print_space fmt (); F.pp_print_string fmt ":"; F.pp_print_space fmt (); - extract_trait_decl_ref impl.span ctx fmt TypeDeclId.Set.empty false + extract_trait_decl_ref impl.item_meta.span ctx fmt TypeDeclId.Set.empty false impl.impl_trait; (* When checking if the trait impl is empty: we ignore the provided @@ -2723,7 +2770,8 @@ let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter) else if is_empty && backend () = Coq then ( (* Coq is not very good at infering constructors *) let cons = - ctx_get_trait_constructor impl.span impl.impl_trait.trait_decl_id ctx + ctx_get_trait_constructor impl.item_meta.span + impl.impl_trait.trait_decl_id ctx in F.pp_print_string fmt (":= " ^ cons ^ "."); (* Outer box *) @@ -2748,13 +2796,15 @@ let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter) (* The constants *) List.iter (fun (provided_id, (name, (_, id))) -> - let item_name = ctx_get_trait_const impl.span trait_decl_id name ctx in + let item_name = + ctx_get_trait_const impl.item_meta.span trait_decl_id name ctx + in (* The parameters are not the same depending on whether the constant is a provided constant or not *) let print_params () = if provided_id = Some id then - extract_generic_args impl.span ctx fmt TypeDeclId.Set.empty - impl.impl_trait.decl_generics + extract_generic_args impl.item_meta.span ctx fmt + TypeDeclId.Set.empty impl.impl_trait.decl_generics else let all_params = List.concat [ type_params; cg_params; trait_clauses ] @@ -2767,7 +2817,7 @@ let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter) in let ty () = F.pp_print_space fmt (); - F.pp_print_string fmt (ctx_get_global impl.span id ctx); + F.pp_print_string fmt (ctx_get_global impl.item_meta.span id ctx); print_params () in @@ -2778,23 +2828,25 @@ let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter) List.iter (fun (name, (trait_refs, ty)) -> (* Extract the type *) - let item_name = ctx_get_trait_type impl.span trait_decl_id name ctx in + let item_name = + ctx_get_trait_type impl.item_meta.span trait_decl_id name ctx + in let ty () = F.pp_print_space fmt (); - extract_ty impl.span ctx fmt TypeDeclId.Set.empty false ty + extract_ty impl.item_meta.span ctx fmt TypeDeclId.Set.empty false ty in extract_trait_impl_item ctx fmt item_name ty; (* Extract the clauses *) TraitClauseId.iteri (fun clause_id trait_ref -> let item_name = - ctx_get_trait_item_clause impl.span trait_decl_id name clause_id - ctx + ctx_get_trait_item_clause impl.item_meta.span trait_decl_id name + clause_id ctx in let ty () = F.pp_print_space fmt (); - extract_trait_ref impl.span ctx fmt TypeDeclId.Set.empty false - trait_ref + extract_trait_ref impl.item_meta.span ctx fmt TypeDeclId.Set.empty + false trait_ref in extract_trait_impl_item ctx fmt item_name ty) trait_refs) @@ -2804,12 +2856,13 @@ let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter) TraitClauseId.iteri (fun clause_id trait_ref -> let item_name = - ctx_get_trait_parent_clause impl.span trait_decl_id clause_id ctx + ctx_get_trait_parent_clause impl.item_meta.span trait_decl_id + clause_id ctx in let ty () = F.pp_print_space fmt (); - extract_trait_ref impl.span ctx fmt TypeDeclId.Set.empty false - trait_ref + extract_trait_ref impl.item_meta.span ctx fmt TypeDeclId.Set.empty + false trait_ref in extract_trait_impl_item ctx fmt item_name ty) impl.parent_trait_refs; @@ -2873,7 +2926,7 @@ let extract_unit_test_if_unit_fun (ctx : extraction_ctx) (fmt : F.formatter) F.pp_print_space fmt (); F.pp_print_string fmt "("; let fun_name = - ctx_get_local_function def.span def.def_id def.loop_id ctx + ctx_get_local_function def.item_meta.span def.def_id def.loop_id ctx in F.pp_print_string fmt fun_name; if sg.inputs <> [] then ( @@ -2883,7 +2936,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.span (TAssumed TResult) result_ok_id ctx + ctx_get_variant def.item_meta.span (TAssumed TResult) result_ok_id ctx in F.pp_print_string fmt (success ^ " ())") | Coq -> @@ -2891,7 +2944,7 @@ let extract_unit_test_if_unit_fun (ctx : extraction_ctx) (fmt : F.formatter) F.pp_print_space fmt (); F.pp_print_string fmt "("; let fun_name = - ctx_get_local_function def.span def.def_id def.loop_id ctx + ctx_get_local_function def.item_meta.span def.def_id def.loop_id ctx in F.pp_print_string fmt fun_name; if sg.inputs <> [] then ( @@ -2904,7 +2957,7 @@ let extract_unit_test_if_unit_fun (ctx : extraction_ctx) (fmt : F.formatter) F.pp_print_space fmt (); F.pp_print_string fmt "("; let fun_name = - ctx_get_local_function def.span def.def_id def.loop_id ctx + ctx_get_local_function def.item_meta.span def.def_id def.loop_id ctx in F.pp_print_string fmt fun_name; if sg.inputs <> [] then ( @@ -2914,14 +2967,14 @@ 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.span (TAssumed TResult) result_ok_id ctx + ctx_get_variant def.item_meta.span (TAssumed TResult) result_ok_id ctx in F.pp_print_string fmt (success ^ " ())") | HOL4 -> F.pp_print_string fmt "val _ = assert_ok ("; F.pp_print_string fmt "“"; let fun_name = - ctx_get_local_function def.span def.def_id def.loop_id ctx + ctx_get_local_function def.item_meta.span def.def_id def.loop_id ctx in F.pp_print_string fmt fun_name; if sg.inputs <> [] then ( diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml index 4aac270f..fb65bd5e 100644 --- a/compiler/ExtractBase.ml +++ b/compiler/ExtractBase.ml @@ -252,6 +252,14 @@ let empty_names_map : names_map = names_set = StringSet.empty; } +(** Small helper to update an LLBC name if the rename attribute has been set *) +let rename_llbc_name (item_meta : Meta.item_meta) (llbc_name : llbc_name) = + match item_meta.rename with + | Some rename -> + let name_prefix = List.tl (List.rev llbc_name) in + List.rev (T.PeIdent (rename, Disambiguator.zero) :: name_prefix) + | None -> llbc_name + (** Small helper to report name collision *) let report_name_collision (id_to_string : id -> string) ((id1, span1) : id * Meta.span option) (id2 : id) (span2 : Meta.span option) @@ -1384,15 +1392,20 @@ let ctx_compute_simple_name (span : Meta.span) (ctx : extraction_ctx) let ctx_compute_simple_type_name = ctx_compute_simple_name (** Helper *) +let ctx_compute_type_name_no_suffix (ctx : extraction_ctx) + (item_meta : Meta.item_meta) (name : llbc_name) : string = + let name = rename_llbc_name item_meta name in + flatten_name (ctx_compute_simple_type_name item_meta.span ctx name) -let ctx_compute_type_name_no_suffix (span : Meta.span) (ctx : extraction_ctx) - (name : llbc_name) : string = - flatten_name (ctx_compute_simple_type_name span ctx name) +(** Provided a basename, compute a type name. -(** Provided a basename, compute a type name. *) -let ctx_compute_type_name (span : Meta.span) (ctx : extraction_ctx) + This is an auxiliary helper that we use to compute type declaration names, but also + for instance field and variant names when we need to add the name of the type as a + prefix. + *) +let ctx_compute_type_name (item_meta : Meta.item_meta) (ctx : extraction_ctx) (name : llbc_name) = - let name = ctx_compute_type_name_no_suffix span ctx name in + let name = ctx_compute_type_name_no_suffix ctx item_meta name in match backend () with | FStar -> StringUtils.lowercase_first_letter (name ^ "_t") | Coq | HOL4 -> name ^ "_t" @@ -1404,45 +1417,57 @@ let ctx_compute_type_name (span : Meta.span) (ctx : extraction_ctx) - field name Note that fields don't always have names, but we still need to - generate some names if we want to extract the structures to records... - We might want to extract such structures to tuples, later, but field - access then causes trouble because not all provers accept syntax like - [x.3] where [x] is a tuple. + generate some names if we want to extract the structures to records. + For nameless fields, we generate a name based on the index. + + Note that in most situations we extract structures with nameless fields + to tuples, meaning generating names by using indices shouldn't be too + much of a problem. *) -let ctx_compute_field_name (span : Meta.span) (ctx : extraction_ctx) - (def_name : llbc_name) (field_id : FieldId.id) (field_name : string option) - : string = +let ctx_compute_field_name (def : type_decl) (field_meta : Meta.item_meta) + (ctx : extraction_ctx) (def_name : llbc_name) (field_id : FieldId.id) + (field_name : string option) : string = + (* If the user did not provide a name, use the field index. *) let field_name_s = - match field_name with - | Some field_name -> field_name - | None -> - (* TODO: extract structs with no field names to tuples *) - FieldId.to_string field_id + Option.value field_name ~default:(FieldId.to_string field_id) in - if !Config.record_fields_short_names then - if field_name = None then (* TODO: this is a bit ugly *) - "_" ^ field_name_s - else field_name_s - else - let def_name = - ctx_compute_type_name_no_suffix span ctx def_name ^ "_" ^ field_name_s - in - match backend () with - | Lean | HOL4 -> def_name - | Coq | FStar -> StringUtils.lowercase_first_letter def_name + (* Replace the name of the field if the user annotated it with the [rename] attribute. *) + let field_name_s = Option.value field_meta.rename ~default:field_name_s in + (* Prefix the name with the name of the type, if necessary (some backends don't + support field name collisions) *) + let def_name = rename_llbc_name def.item_meta def_name in + let name = + if !Config.record_fields_short_names then + if field_name = None then (* TODO: this is a bit ugly *) + "_" ^ field_name_s + else field_name_s + else + ctx_compute_type_name_no_suffix ctx def.item_meta def_name + ^ "_" ^ field_name_s + in + match backend () with + | Lean | HOL4 -> name + | Coq | FStar -> StringUtils.lowercase_first_letter name (** Inputs: - type name - variant name *) -let ctx_compute_variant_name (span : Meta.span) (ctx : extraction_ctx) - (def_name : llbc_name) (variant : string) : string = +let ctx_compute_variant_name (ctx : extraction_ctx) (def : type_decl) + (variant : variant) : string = + (* Replace the name of the variant if the user annotated it with the [rename] attribute. *) + let variant = + Option.value variant.item_meta.rename ~default:variant.variant_name + in match backend () with | FStar | Coq | HOL4 -> let variant = to_camel_case variant in + (* Prefix the name of the variant with the name of the type, if necessary + (some backends don't support collision of variant names) *) if !variant_concatenate_type_name then StringUtils.capitalize_first_letter - (ctx_compute_type_name_no_suffix span ctx def_name ^ "_" ^ variant) + (ctx_compute_type_name_no_suffix ctx def.item_meta def.llbc_name + ^ "_" ^ variant) else variant | Lean -> variant @@ -1457,9 +1482,9 @@ let ctx_compute_variant_name (span : Meta.span) (ctx : extraction_ctx) Inputs: - type name *) -let ctx_compute_struct_constructor (span : Meta.span) (ctx : extraction_ctx) +let ctx_compute_struct_constructor (def : type_decl) (ctx : extraction_ctx) (basename : llbc_name) : string = - let tname = ctx_compute_type_name span ctx basename in + let tname = ctx_compute_type_name def.item_meta ctx basename in ExtractBuiltin.mk_struct_constructor tname let ctx_compute_fun_name_no_suffix (span : Meta.span) (ctx : extraction_ctx) @@ -1522,7 +1547,8 @@ let ctx_compute_fun_name (span : Meta.span) (ctx : extraction_ctx) let ctx_compute_trait_decl_name (ctx : extraction_ctx) (trait_decl : trait_decl) : string = - ctx_compute_type_name trait_decl.span ctx trait_decl.llbc_name + let llbc_name = rename_llbc_name trait_decl.item_meta trait_decl.llbc_name in + ctx_compute_type_name trait_decl.item_meta ctx llbc_name let ctx_compute_trait_impl_name (ctx : extraction_ctx) (trait_decl : trait_decl) (trait_impl : trait_impl) : string = @@ -1531,14 +1557,25 @@ let ctx_compute_trait_impl_name (ctx : extraction_ctx) (trait_decl : trait_decl) for `<foo::Foo, u32>`, we generate the name: "trait.TraitFooFooU32Inst". Importantly, it is to be noted that the name is independent of the place where the instance has been defined (it is indepedent of the file, etc.). + + Note that if the user provided a [rename] attribute, we simply use that. *) let name = - let params = trait_impl.llbc_generics in - let args = trait_impl.llbc_impl_trait.decl_generics in - let name = ctx_prepare_name trait_impl.span ctx trait_decl.llbc_name in - trait_name_with_generics_to_simple_name ctx.trans_ctx name params args + match trait_impl.item_meta.rename with + | None -> + let name = + let params = trait_impl.llbc_generics in + let args = trait_impl.llbc_impl_trait.decl_generics in + let name = + ctx_prepare_name trait_impl.item_meta.span ctx trait_decl.llbc_name + in + let name = rename_llbc_name trait_impl.item_meta name in + trait_name_with_generics_to_simple_name ctx.trans_ctx name params args + in + flatten_name name + | Some name -> name in - let name = flatten_name name in + (* Additional modifications to make sure we comply with the backends restrictions *) match backend () with | FStar -> StringUtils.lowercase_first_letter name | Coq | HOL4 | Lean -> name @@ -1969,21 +2006,23 @@ let ctx_add_generic_params (span : Meta.span) (current_def_name : Types.name) let ctx_add_decreases_proof (def : fun_decl) (ctx : extraction_ctx) : extraction_ctx = + let name = rename_llbc_name def.item_meta def.llbc_name in let name = - ctx_compute_decreases_proof_name def.span ctx def.def_id def.llbc_name + ctx_compute_decreases_proof_name def.item_meta.span ctx def.def_id name def.num_loops def.loop_id in - ctx_add def.span + ctx_add def.item_meta.span (DecreasesProofId (FRegular def.def_id, def.loop_id)) name ctx let ctx_add_termination_measure (def : fun_decl) (ctx : extraction_ctx) : extraction_ctx = + let name = rename_llbc_name def.item_meta def.llbc_name in let name = - ctx_compute_termination_measure_name def.span ctx def.def_id def.llbc_name + ctx_compute_termination_measure_name def.item_meta.span ctx def.def_id name def.num_loops def.loop_id in - ctx_add def.span + ctx_add def.item_meta.span (TerminationMeasureId (FRegular def.def_id, def.loop_id)) name ctx @@ -2001,7 +2040,8 @@ let ctx_add_global_decl_and_body (def : A.global_decl) (ctx : extraction_ctx) : ctx_add def.item_meta.span decl name ctx | None -> (* Not the case: "standard" registration *) - let name = ctx_compute_global_name def.item_meta.span ctx def.name in + let name = rename_llbc_name def.item_meta def.name in + let name = ctx_compute_global_name def.item_meta.span ctx name in let body = FunId (FromLlbc (FunId (FRegular def.body), None)) in (* If this is a provided constant (i.e., the default value for a constant @@ -2016,21 +2056,66 @@ let ctx_add_global_decl_and_body (def : A.global_decl) (ctx : extraction_ctx) : ctx let ctx_compute_fun_name (def : fun_decl) (ctx : extraction_ctx) : string = - (* Add the function name *) - ctx_compute_fun_name def.span ctx def.llbc_name def.num_loops def.loop_id + (* Rename the function, if the user added a [rename] attribute. + + We have to do something peculiar for the implementation of trait + methods, by looking up the meta information of the method *declaration* + because this is where the attribute is. + + Note that if the user also added an attribute for the *implementation*, + we keep this one. + *) + let item_meta = + match def.kind with + | TraitItemImpl (_, trait_decl_id, item_name, _) -> ( + if Option.is_some def.item_meta.rename then def.item_meta + else + (* Lookup the declaration. TODO: the trait item impl info + should directly give us the id of the method declaration. *) + match + TraitDeclId.Map.find_opt trait_decl_id ctx.trans_trait_decls + with + | None -> def.item_meta + | Some trait_decl -> ( + let methods = + trait_decl.required_methods + @ List.filter_map + (fun (name, opt_id) -> + match opt_id with + | None -> None + | Some id -> Some (name, id)) + trait_decl.provided_methods + in + match + List.find_opt (fun (name, _) -> name = item_name) methods + with + | None -> def.item_meta + | Some (_, id) -> + Option.value + (Option.map + (fun (def : A.fun_decl) -> def.item_meta) + (FunDeclId.Map.find_opt id + ctx.trans_ctx.fun_ctx.fun_decls)) + ~default:def.item_meta)) + | _ -> def.item_meta + in + let llbc_name = rename_llbc_name item_meta def.llbc_name in + ctx_compute_fun_name def.item_meta.span ctx llbc_name def.num_loops + def.loop_id (* TODO: move to Extract *) let ctx_add_fun_decl (def : fun_decl) (ctx : extraction_ctx) : extraction_ctx = (* Sanity check: the function should not be a global body - those are handled * separately *) - sanity_check __FILE__ __LINE__ (not def.is_global_decl_body) def.span; - (* Lookup the LLBC def to compute the region group information *) + sanity_check __FILE__ __LINE__ + (not def.is_global_decl_body) + def.item_meta.span; let def_id = def.def_id in (* Add the function name *) let def_name = ctx_compute_fun_name def ctx in let fun_id = (Pure.FunId (FRegular def_id), def.loop_id) in - ctx_add def.span (FunId (FromLlbc fun_id)) def_name ctx + ctx_add def.item_meta.span (FunId (FromLlbc fun_id)) def_name ctx let ctx_compute_type_decl_name (ctx : extraction_ctx) (def : type_decl) : string = - ctx_compute_type_name def.span ctx def.llbc_name + ctx_compute_type_name def.item_meta ctx def.llbc_name diff --git a/compiler/ExtractTypes.ml b/compiler/ExtractTypes.ml index edd9d58e..a242e950 100644 --- a/compiler/ExtractTypes.ml +++ b/compiler/ExtractTypes.ml @@ -6,6 +6,7 @@ open TranslateCore open Config open Errors include ExtractBase +module T = Types (** Format a constant value. @@ -288,7 +289,8 @@ let start_fun_decl_group (ctx : extraction_ctx) (fmt : F.formatter) if is_single_opaque_fun_decl_group dg then () else let compute_fun_def_name (def : Pure.fun_decl) : string = - ctx_get_local_function def.span def.def_id def.loop_id ctx ^ "_def" + ctx_get_local_function def.item_meta.span def.def_id def.loop_id ctx + ^ "_def" in let names = List.map compute_fun_def_name dg in (* Add a break before *) @@ -750,13 +752,15 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) : } | _ -> ctx in - (* Compute and register the type def name *) + (* Compute and register the type decl name *) let def_name = match info with - | None -> ctx_compute_type_name def.span ctx def.llbc_name + | None -> ctx_compute_type_decl_name ctx def | Some info -> info.extract_name in - let ctx = ctx_add def.span (TypeId (TAdtId def.def_id)) def_name ctx in + let ctx = + ctx_add def.item_meta.span (TypeId (TAdtId def.def_id)) def_name ctx + in (* Compute and register: * - the variant names, if this is an enumeration * - the field names, if this is a structure @@ -778,12 +782,12 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) : FieldId.mapi (fun fid (field : field) -> ( fid, - ctx_compute_field_name def.span ctx def.llbc_name fid - field.field_name )) + ctx_compute_field_name def field.item_meta ctx + def.llbc_name fid field.field_name )) fields in let cons_name = - ctx_compute_struct_constructor def.span ctx def.llbc_name + ctx_compute_struct_constructor def ctx def.llbc_name in (field_names, cons_name) | Some { body_info = Some (Struct (cons_name, field_names)); _ } -> @@ -800,34 +804,32 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) : in (field_names, cons_name) | Some info -> - craise __FILE__ __LINE__ def.span + craise __FILE__ __LINE__ def.item_meta.span ("Invalid builtin information: " ^ show_builtin_type_info info) in (* Add the fields *) let ctx = List.fold_left (fun ctx (fid, name) -> - ctx_add def.span (FieldId (TAdtId def.def_id, fid)) name ctx) + ctx_add def.item_meta.span + (FieldId (TAdtId def.def_id, fid)) + name ctx) ctx field_names in (* Add the constructor name *) - ctx_add def.span (StructId (TAdtId def.def_id)) cons_name ctx + ctx_add def.item_meta.span (StructId (TAdtId def.def_id)) cons_name + ctx | Enum variants -> let variant_names = match info with | None -> VariantId.mapi (fun variant_id (variant : variant) -> - let name = - ctx_compute_variant_name def.span ctx def.llbc_name - variant.variant_name - in + let name = ctx_compute_variant_name ctx def variant in (* Add the type name prefix for Lean *) let name = if Config.backend () = Lean then - let type_name = - ctx_compute_type_name def.span ctx def.llbc_name - in + let type_name = ctx_compute_type_decl_name ctx def in type_name ^ "." ^ name else name in @@ -847,11 +849,14 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) : (variant_id, StringMap.find variant.variant_name variant_map)) variants | _ -> - craise __FILE__ __LINE__ def.span "Invalid builtin information" + craise __FILE__ __LINE__ def.item_meta.span + "Invalid builtin information" in List.fold_left (fun ctx (vid, vname) -> - ctx_add def.span (VariantId (TAdtId def.def_id, vid)) vname ctx) + ctx_add def.item_meta.span + (VariantId (TAdtId def.def_id, vid)) + vname ctx) ctx variant_names | Opaque -> (* Nothing to do *) @@ -971,12 +976,10 @@ let extract_type_decl_enum_body (ctx : extraction_ctx) (fmt : F.formatter) let print_variant _variant_id (v : variant) = (* We don't lookup the name, because it may have a prefix for the type id (in the case of Lean) *) - let cons_name = - ctx_compute_variant_name def.span ctx def.llbc_name v.variant_name - in + let cons_name = ctx_compute_variant_name ctx def v in let fields = v.fields in - extract_type_decl_variant def.span ctx fmt type_decl_group def_name - type_params cg_params cons_name fields + extract_type_decl_variant def.item_meta.span ctx fmt type_decl_group + def_name type_params cg_params cons_name fields in (* Print the variants *) let variants = VariantId.mapi (fun vid v -> (vid, v)) variants in @@ -1073,7 +1076,8 @@ let extract_type_decl_struct_body (ctx : extraction_ctx) (fmt : F.formatter) (* If Coq: print the constructor name *) (* TODO: remove superfluous test not is_rec below *) if backend () = Coq && not is_rec then ( - F.pp_print_string fmt (ctx_get_struct def.span (TAdtId def.def_id) ctx); + F.pp_print_string fmt + (ctx_get_struct def.item_meta.span (TAdtId def.def_id) ctx); F.pp_print_string fmt " "); (match backend () with | Lean -> () @@ -1088,7 +1092,7 @@ let extract_type_decl_struct_body (ctx : extraction_ctx) (fmt : F.formatter) (* Print the fields *) let print_field (field_id : FieldId.id) (f : field) : unit = let field_name = - ctx_get_field def.span (TAdtId def.def_id) field_id ctx + ctx_get_field def.item_meta.span (TAdtId def.def_id) field_id ctx in (* Open a box for the field *) F.pp_open_box fmt ctx.indent_incr; @@ -1096,7 +1100,7 @@ let extract_type_decl_struct_body (ctx : extraction_ctx) (fmt : F.formatter) F.pp_print_space fmt (); F.pp_print_string fmt ":"; F.pp_print_space fmt (); - extract_ty def.span ctx fmt type_decl_group false f.field_ty; + extract_ty def.item_meta.span ctx fmt type_decl_group false f.field_ty; if backend () <> Lean then F.pp_print_string fmt ";"; (* Close the box for the field *) F.pp_close_box fmt () @@ -1120,7 +1124,7 @@ let extract_type_decl_struct_body (ctx : extraction_ctx) (fmt : F.formatter) a group of mutually recursive types: we extract it as an inductive type *) cassert __FILE__ __LINE__ (is_rec && (backend () = Coq || backend () = Lean)) - def.span + def.item_meta.span "Constant generics are not supported yet when generating code for HOL4"; (* Small trick: in Lean we use namespaces, meaning we don't need to prefix the constructor name with the name of the type at definition site, @@ -1128,11 +1132,11 @@ let extract_type_decl_struct_body (ctx : extraction_ctx) (fmt : F.formatter) we generate `inductive Foo := | mk ... *) let cons_name = if backend () = Lean then "mk" - else ctx_get_struct def.span (TAdtId def.def_id) ctx + else ctx_get_struct def.item_meta.span (TAdtId def.def_id) ctx in - let def_name = ctx_get_local_type def.span def.def_id ctx in - extract_type_decl_variant def.span ctx fmt type_decl_group def_name - type_params cg_params cons_name fields) + let def_name = ctx_get_local_type def.item_meta.span def.def_id ctx in + extract_type_decl_variant def.item_meta.span ctx fmt type_decl_group + def_name type_params cg_params cons_name fields) in () @@ -1198,12 +1202,14 @@ let extract_trait_self_clause (insert_req_space : unit -> unit) (params : string list) : unit = insert_req_space (); F.pp_print_string fmt "("; - let self_clause = ctx_get_trait_self_clause trait_decl.span ctx in + let self_clause = ctx_get_trait_self_clause trait_decl.item_meta.span ctx in F.pp_print_string fmt self_clause; F.pp_print_space fmt (); F.pp_print_string fmt ":"; F.pp_print_space fmt (); - let trait_id = ctx_get_trait_decl trait_decl.span trait_decl.def_id ctx in + let trait_id = + ctx_get_trait_decl trait_decl.item_meta.span trait_decl.def_id ctx + in F.pp_print_string fmt trait_id; List.iter (fun p -> @@ -1352,11 +1358,13 @@ let extract_generic_params (span : Meta.span) (ctx : extraction_ctx) dtype_params; map (fun (cg : const_generic_var) -> - ctx_get_const_generic_var trait_decl.span cg.index ctx) + ctx_get_const_generic_var trait_decl.item_meta.span cg.index + ctx) dcgs; map (fun c -> - ctx_get_local_trait_clause trait_decl.span c.clause_id ctx) + ctx_get_local_trait_clause trait_decl.item_meta.span + c.clause_id ctx) dtrait_clauses; ] in @@ -1375,7 +1383,9 @@ let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) (type_decl_group : TypeDeclId.Set.t) (kind : decl_kind) (def : type_decl) (extract_body : bool) : unit = (* Sanity check *) - sanity_check __FILE__ __LINE__ (extract_body || backend () <> HOL4) def.span; + sanity_check __FILE__ __LINE__ + (extract_body || backend () <> HOL4) + def.item_meta.span; let is_tuple_struct = TypesUtils.type_decl_from_decl_id_is_tuple_struct ctx.trans_ctx.type_ctx.type_infos def.def_id @@ -1403,12 +1413,12 @@ let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) let is_opaque_coq = backend () = Coq && is_opaque in let use_forall = is_opaque_coq && def.generics <> empty_generic_params in (* Retrieve the definition name *) - let def_name = ctx_get_local_type def.span def.def_id ctx in + let def_name = ctx_get_local_type def.item_meta.span def.def_id ctx in (* Add the type and const generic params - note that we need those bindings only for the * body translation (they are not top-level) *) let ctx_body, type_params, cg_params, trait_clauses = - ctx_add_generic_params def.span def.llbc_name def.llbc_generics def.generics - ctx + ctx_add_generic_params def.item_meta.span def.llbc_name def.llbc_generics + def.generics ctx in (* Add a break before *) if backend () <> HOL4 || not (decl_is_first_from_group kind) then @@ -1421,7 +1431,7 @@ let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) in extract_comment_with_raw_span ctx fmt [ "[" ^ name_to_string ctx def.llbc_name ^ "]" ] - name def.span.span); + name def.item_meta.span.span); F.pp_print_break fmt 0 0; (* Open a box for the definition, so that whenever possible it gets printed on * one line. Note however that in the case of Lean line breaks are important @@ -1441,7 +1451,7 @@ let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) F.pp_print_space fmt ()) else (); (* > "type TYPE_NAME" *) - let qualif = type_decl_kind_to_qualif def.span kind type_kind in + let qualif = type_decl_kind_to_qualif def.item_meta.span kind type_kind in (match qualif with | Some qualif -> F.pp_print_string fmt (qualif ^ " " ^ def_name) | None -> F.pp_print_string fmt def_name); @@ -1449,12 +1459,12 @@ let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) support trait clauses *) cassert __FILE__ __LINE__ ((cg_params = [] && trait_clauses = []) || backend () <> HOL4) - def.span + def.item_meta.span "Constant generics and type definitions with trait clauses are not \ supported yet when generating code for HOL4"; (* Print the generic parameters *) - extract_generic_params def.span ctx_body fmt type_decl_group ~use_forall - def.generics type_params cg_params trait_clauses; + extract_generic_params def.item_meta.span ctx_body fmt type_decl_group + ~use_forall def.generics type_params cg_params trait_clauses; (* Print the "=" if we extract the body*) if extract_body then ( F.pp_print_space fmt (); @@ -1480,21 +1490,22 @@ let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) F.pp_print_space fmt (); F.pp_print_string fmt ":"); F.pp_print_space fmt (); - F.pp_print_string fmt (type_keyword def.span)); + F.pp_print_string fmt (type_keyword def.item_meta.span)); (* Close the box for "type TYPE_NAME (TYPE_PARAMS) =" *) F.pp_close_box fmt (); (if extract_body then match def.kind with | Struct fields -> if is_tuple_struct then - extract_type_decl_tuple_struct_body def.span ctx_body fmt fields + extract_type_decl_tuple_struct_body def.item_meta.span ctx_body fmt + fields else extract_type_decl_struct_body ctx_body fmt type_decl_group kind def type_params cg_params fields | Enum variants -> extract_type_decl_enum_body ctx_body fmt type_decl_group def def_name type_params cg_params variants - | Opaque -> craise __FILE__ __LINE__ def.span "Unreachable"); + | Opaque -> craise __FILE__ __LINE__ def.item_meta.span "Unreachable"); (* Add the definition end delimiter *) if backend () = HOL4 && decl_is_not_last_from_group kind then ( F.pp_print_space fmt (); @@ -1518,16 +1529,16 @@ let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) let extract_type_decl_hol4_opaque (ctx : extraction_ctx) (fmt : F.formatter) (def : type_decl) : unit = (* Retrieve the definition name *) - let def_name = ctx_get_local_type def.span def.def_id ctx in + let def_name = ctx_get_local_type def.item_meta.span def.def_id ctx in (* Generic parameters are unsupported *) cassert __FILE__ __LINE__ (def.generics.const_generics = []) - def.span + def.item_meta.span "Constant generics are not supported yet when generating code for HOL4"; (* Trait clauses on type definitions are unsupported *) cassert __FILE__ __LINE__ (def.generics.trait_clauses = []) - def.span + def.item_meta.span "Types with trait clauses are not supported yet when generating code for \ HOL4"; (* Types *) @@ -1550,9 +1561,11 @@ let extract_type_decl_hol4_opaque (ctx : extraction_ctx) (fmt : F.formatter) let extract_type_decl_hol4_empty_record (ctx : extraction_ctx) (fmt : F.formatter) (def : type_decl) : unit = (* Retrieve the definition name *) - let def_name = ctx_get_local_type def.span def.def_id ctx in + let def_name = ctx_get_local_type def.item_meta.span def.def_id ctx in (* Sanity check *) - sanity_check __FILE__ __LINE__ (def.generics = empty_generic_params) def.span; + sanity_check __FILE__ __LINE__ + (def.generics = empty_generic_params) + def.item_meta.span; (* Generate the declaration *) F.pp_print_space fmt (); F.pp_print_string fmt ("Type " ^ def_name ^ " = “: unit”"); @@ -1628,7 +1641,7 @@ let extract_coq_arguments_instruction (ctx : extraction_ctx) (fmt : F.formatter) *) let extract_type_decl_coq_arguments (ctx : extraction_ctx) (fmt : F.formatter) (kind : decl_kind) (decl : type_decl) : unit = - sanity_check __FILE__ __LINE__ (backend () = Coq) decl.span; + sanity_check __FILE__ __LINE__ (backend () = Coq) decl.item_meta.span; (* Generating the [Arguments] instructions is useful only if there are parameters *) let num_params = List.length decl.generics.types @@ -1643,14 +1656,16 @@ let extract_type_decl_coq_arguments (ctx : extraction_ctx) (fmt : F.formatter) | Struct fields -> let adt_id = TAdtId decl.def_id in (* Generate the instruction for the record constructor *) - let cons_name = ctx_get_struct decl.span adt_id ctx in + let cons_name = ctx_get_struct decl.item_meta.span adt_id ctx in extract_coq_arguments_instruction ctx fmt cons_name num_params; (* Generate the instruction for the record projectors, if there are *) let is_rec = decl_is_from_rec_group kind in if not is_rec then FieldId.iteri (fun fid _ -> - let cons_name = ctx_get_field decl.span adt_id fid ctx in + let cons_name = + ctx_get_field decl.item_meta.span adt_id fid ctx + in extract_coq_arguments_instruction ctx fmt cons_name num_params) fields; (* Add breaks to insert new lines between definitions *) @@ -1660,7 +1675,7 @@ let extract_type_decl_coq_arguments (ctx : extraction_ctx) (fmt : F.formatter) VariantId.iteri (fun vid (_ : variant) -> let cons_name = - ctx_get_variant decl.span (TAdtId decl.def_id) vid ctx + ctx_get_variant decl.item_meta.span (TAdtId decl.def_id) vid ctx in extract_coq_arguments_instruction ctx fmt cons_name num_params) variants; @@ -1679,7 +1694,7 @@ let extract_type_decl_record_field_projectors (ctx : extraction_ctx) (fmt : F.formatter) (kind : decl_kind) (decl : type_decl) : unit = sanity_check __FILE__ __LINE__ (backend () = Coq || backend () = Lean) - decl.span; + decl.item_meta.span; match decl.kind with | Opaque | Enum _ -> () | Struct fields -> @@ -1688,18 +1703,24 @@ let extract_type_decl_record_field_projectors (ctx : extraction_ctx) if is_rec then (* Add the type params *) let ctx, type_params, cg_params, trait_clauses = - ctx_add_generic_params decl.span decl.llbc_name decl.llbc_generics - decl.generics ctx + ctx_add_generic_params decl.item_meta.span decl.llbc_name + decl.llbc_generics decl.generics ctx in (* Record_var will be the ADT argument to the projector *) - let ctx, record_var = ctx_add_var decl.span "x" (VarId.of_int 0) ctx in + let ctx, record_var = + ctx_add_var decl.item_meta.span "x" (VarId.of_int 0) ctx + in (* Field_var will be the variable in the constructor that is returned by the projector *) - let ctx, field_var = ctx_add_var decl.span "x" (VarId.of_int 1) ctx in + let ctx, field_var = + ctx_add_var decl.item_meta.span "x" (VarId.of_int 1) ctx + in (* Name of the ADT *) - let def_name = ctx_get_local_type decl.span decl.def_id ctx in + let def_name = ctx_get_local_type decl.item_meta.span decl.def_id ctx in (* Name of the ADT constructor. As we are in the struct case, we only have one constructor *) - let cons_name = ctx_get_struct decl.span (TAdtId decl.def_id) ctx in + let cons_name = + ctx_get_struct decl.item_meta.span (TAdtId decl.def_id) ctx + in let extract_field_proj (field_id : FieldId.id) (_ : field) : unit = F.pp_print_space fmt (); @@ -1725,14 +1746,14 @@ let extract_type_decl_record_field_projectors (ctx : extraction_ctx) (match backend () with | Lean -> F.pp_print_string fmt "def" | Coq -> F.pp_print_string fmt "Definition" - | _ -> internal_error __FILE__ __LINE__ decl.span); + | _ -> internal_error __FILE__ __LINE__ decl.item_meta.span); F.pp_print_space fmt (); (* Print the function name. In Lean, the syntax ADT.proj will allow us to call x.proj for any x of type ADT. In Coq, we will have to introduce a notation for the projector. *) let field_name = - ctx_get_field decl.span (TAdtId decl.def_id) field_id ctx + ctx_get_field decl.item_meta.span (TAdtId decl.def_id) field_id ctx in if backend () = Lean then ( F.pp_print_string fmt def_name; @@ -1741,8 +1762,9 @@ let extract_type_decl_record_field_projectors (ctx : extraction_ctx) (* Print the generics *) let as_implicits = true in - extract_generic_params decl.span ctx fmt TypeDeclId.Set.empty - ~as_implicits decl.generics type_params cg_params trait_clauses; + extract_generic_params decl.item_meta.span ctx fmt + TypeDeclId.Set.empty ~as_implicits decl.generics type_params + cg_params trait_clauses; (* Print the record parameter as "(x : ADT)" *) F.pp_print_space fmt (); @@ -1826,12 +1848,12 @@ let extract_type_decl_record_field_projectors (ctx : extraction_ctx) (* Inner box for the projector definition *) F.pp_open_hovbox fmt ctx.indent_incr; let ctx, record_var = - ctx_add_var decl.span "x" (VarId.of_int 0) ctx + ctx_add_var decl.item_meta.span "x" (VarId.of_int 0) ctx in F.pp_print_string fmt "Notation"; F.pp_print_space fmt (); let field_name = - ctx_get_field decl.span (TAdtId decl.def_id) field_id ctx + ctx_get_field decl.item_meta.span (TAdtId decl.def_id) field_id ctx in F.pp_print_string fmt ("\"" ^ record_var ^ " .(" ^ field_name ^ ")\""); F.pp_print_space fmt (); diff --git a/compiler/Main.ml b/compiler/Main.ml index 1bf9196a..d78b9081 100644 --- a/compiler/Main.ml +++ b/compiler/Main.ml @@ -97,10 +97,11 @@ let () = ( "-backward-no-state-update", Arg.Set backward_no_state_update, " Forbid backward functions from updating the state" ); - ( "-template-clauses", - Arg.Set extract_template_decreases_clauses, - " Generate templates for the required decreases clauses/termination \ - measures, in a dedicated file. Implies -decreases-clauses" ); + ( "-no-template-clauses", + Arg.Clear extract_template_decreases_clauses, + " Do not generate templates for the required decreases \ + clauses/termination measures, in a dedicated file, if you also put \ + the option -decreases-clauses" ); ( "-split-files", Arg.Set split_files, " Split the definitions between different files for types, functions, \ @@ -180,10 +181,12 @@ let () = if !print_llbc then main_log#set_level EL.Debug; - (* Sanity check (now that the arguments are parsed!): -template-clauses ==> decrease-clauses *) + (* Sanity check (now that the arguments are parsed!) *) check_arg_implies - !extract_template_decreases_clauses - "-template-clauses" !extract_decreases_clauses "-decreases-clauses"; + (not !extract_template_decreases_clauses) + "-no-template-clauses" !extract_decreases_clauses "-decreases-clauses"; + if not !extract_decreases_clauses then + extract_template_decreases_clauses := false; (* Sanity check: -backward-no-state-update ==> -state *) check_arg_implies !backward_no_state_update "-backward-no-state-update" !use_state "-state"; diff --git a/compiler/PrintPure.ml b/compiler/PrintPure.ml index b1b42207..fe7c1234 100644 --- a/compiler/PrintPure.ml +++ b/compiler/PrintPure.ml @@ -798,7 +798,7 @@ let fun_decl_to_string (env : fmt_env) (def : fun_decl) : string = else " fun " ^ String.concat " " inputs ^ " ->\n" ^ indent in let body = - texpression_to_string ~spandata:(Some def.span) env inside indent indent - body.body + texpression_to_string ~spandata:(Some def.item_meta.span) env inside + indent indent body.body in "let " ^ name ^ " :\n " ^ signature ^ " =\n" ^ inputs ^ body diff --git a/compiler/Pure.ml b/compiler/Pure.ml index f7445575..2ff8c272 100644 --- a/compiler/Pure.ml +++ b/compiler/Pure.ml @@ -1,4 +1,5 @@ open Identifiers +open Meta module T = Types module V = Values module E = Expressions @@ -351,8 +352,19 @@ and trait_instance_id = polymorphic = false; }] -type field = { field_name : string option; field_ty : ty } [@@deriving show] -type variant = { variant_name : string; fields : field list } [@@deriving show] +type field = { + field_name : string option; + field_ty : ty; + item_meta : item_meta; +} +[@@deriving show] + +type variant = { + variant_name : string; + fields : field list; + item_meta : item_meta; +} +[@@deriving show] type type_decl_kind = Struct of field list | Enum of variant list | Opaque [@@deriving show] @@ -393,7 +405,7 @@ type type_decl = { the name used at extraction time will be derived from the llbc_name. *) - span : span; + item_meta : item_meta; generics : generic_params; llbc_generics : Types.generic_params; (** We use the LLBC generics to generate "pretty" names, for instance @@ -1086,7 +1098,7 @@ type backend_attributes = { type fun_decl = { def_id : FunDeclId.id; is_local : bool; - span : span; + item_meta : item_meta; kind : item_kind; backend_attributes : backend_attributes; num_loops : int; @@ -1133,7 +1145,7 @@ type trait_decl = { is_local : bool; llbc_name : llbc_name; name : string; - span : span; + item_meta : item_meta; generics : generic_params; llbc_generics : Types.generic_params; (** We use the LLBC generics to generate "pretty" names, for instance @@ -1156,7 +1168,7 @@ type trait_impl = { is_local : bool; llbc_name : llbc_name; name : string; - span : span; + item_meta : item_meta; impl_trait : trait_decl_ref; llbc_impl_trait : Types.trait_decl_ref; (** Same remark as for {!field:llbc_generics}. *) diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml index 8b95f729..543b2bee 100644 --- a/compiler/PureMicroPasses.ml +++ b/compiler/PureMicroPasses.ml @@ -224,7 +224,7 @@ let compute_pretty_names (def : fun_decl) : fun_decl = let register_var (ctx : pn_ctx) (v : var) : pn_ctx = sanity_check __FILE__ __LINE__ (not (VarId.Map.mem v.id ctx.pure_vars)) - def.span; + def.item_meta.span; match v.basename with | None -> ctx | Some name -> @@ -614,7 +614,7 @@ let intro_struct_updates (ctx : trans_ctx) (def : fun_decl) : fun_decl = | App _ -> ( let app, args = destruct_apps e in let ignore () = - mk_apps def.span + mk_apps def.item_meta.span (self#visit_texpression env app) (List.map (self#visit_texpression env) args) in @@ -759,7 +759,7 @@ let simplify_let_bindings (_ctx : trans_ctx) (def : fun_decl) : fun_decl = else if variant_id = result_fail_id then (* Fail case *) self#visit_expression env rv.e - else craise __FILE__ __LINE__ def.span "Unexpected" + else craise __FILE__ __LINE__ def.item_meta.span "Unexpected" | App _ -> (* This might be the tuple case *) if not monadic then @@ -914,7 +914,7 @@ let inline_useless_var_reassignments (ctx : trans_ctx) ~(inline_named : bool) } ) -> (* Second case: we deconstruct a structure with one field that we will extract as tuple. *) - let adt_id, _ = PureUtils.ty_as_adt def.span re.ty in + let adt_id, _ = PureUtils.ty_as_adt def.item_meta.span re.ty in (* Update the rhs (we may perform substitutions inside, and it is * better to do them *before* we inline it *) let re = self#visit_texpression env re in @@ -1152,7 +1152,7 @@ let simplify_let_then_ok _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_ok_texpression def.span rv).e + (mk_result_ok_texpression def.item_meta.span rv).e else not_simpl_e | None -> if match_pattern_and_expr lv next_e then rv.e else not_simpl_e @@ -1203,13 +1203,14 @@ let simplify_aggregates (ctx : trans_ctx) (def : fun_decl) : fun_decl = let fields = match adt_decl.kind with | Enum _ | Alias _ | Opaque -> - craise __FILE__ __LINE__ def.span "Unreachable" + craise __FILE__ __LINE__ def.item_meta.span "Unreachable" | Struct fields -> fields in let num_fields = List.length fields in (* In order to simplify, there must be as many arguments as * there are fields *) - sanity_check __FILE__ __LINE__ (num_fields > 0) def.span; + sanity_check __FILE__ __LINE__ (num_fields > 0) + def.item_meta.span; if num_fields = List.length args then (* We now need to check that all the arguments are of the form: * [x.field] for some variable [x], and where the projection @@ -1249,7 +1250,7 @@ let simplify_aggregates (ctx : trans_ctx) (def : fun_decl) : fun_decl = (List.for_all (fun (generics1, _) -> generics1 = generics) args) - def.span; + def.item_meta.span; { e with e = Var x }) else super#visit_texpression env e else super#visit_texpression env e @@ -1406,7 +1407,7 @@ let decompose_loops (_ctx : trans_ctx) (def : fun_decl) : in sanity_check __FILE__ __LINE__ (fun_sig_info_is_wf loop_fwd_sig_info) - def.span; + def.item_meta.span; let inputs_tys = let fuel = if !Config.use_fuel then [ mk_fuel_ty ] else [] in @@ -1449,7 +1450,7 @@ let decompose_loops (_ctx : trans_ctx) (def : fun_decl) : sanity_check __FILE__ __LINE__ (loop_fwd_effect_info.stateful = Option.is_some loop.input_state) - def.span; + def.item_meta.span; match loop.input_state with | None -> ([], []) | Some input_state -> @@ -1486,17 +1487,20 @@ let decompose_loops (_ctx : trans_ctx) (def : fun_decl) : match fuel_vars with | None -> loop.loop_body | Some (fuel0, fuel) -> - SymbolicToPure.wrap_in_match_fuel def.span fuel0 fuel - loop.loop_body + SymbolicToPure.wrap_in_match_fuel def.item_meta.span fuel0 + fuel loop.loop_body in let loop_body = { inputs; inputs_lvs; body = loop_body } in + (* We retrieve the meta information from the parent function + *but* replace its span with the span of the loop *) + let item_meta = { def.item_meta with span = loop.span } in let loop_def : fun_decl = { def_id = def.def_id; is_local = def.is_local; - span = loop.span; + item_meta; kind = def.kind; backend_attributes = def.backend_attributes; num_loops; @@ -1581,9 +1585,10 @@ let eliminate_box_functions (_ctx : trans_ctx) (def : fun_decl) : fun_decl = match aid with | BoxNew -> let arg, args = Collections.List.pop args in - mk_apps def.span arg args + mk_apps def.item_meta.span arg args | BoxFree -> - sanity_check __FILE__ __LINE__ (args = []) def.span; + sanity_check __FILE__ __LINE__ (args = []) + def.item_meta.span; mk_unit_rvalue | SliceIndexShared | SliceIndexMut | ArrayIndexShared | ArrayIndexMut | ArrayToSliceShared | ArrayToSliceMut @@ -1777,8 +1782,10 @@ let unfold_monadic_let_bindings (_ctx : trans_ctx) (def : fun_decl) : fun_decl = *) (* TODO: this information should be computed in SymbolicToPure and * store in an enum ("monadic" should be an enum, not a bool). *) - let re_ty = Option.get (opt_destruct_result def.span re.ty) in - sanity_check __FILE__ __LINE__ (lv.ty = re_ty) def.span; + let re_ty = + Option.get (opt_destruct_result def.item_meta.span re.ty) + in + sanity_check __FILE__ __LINE__ (lv.ty = re_ty) def.item_meta.span; let err_vid = fresh_id () in let err_var : var = { @@ -1790,7 +1797,9 @@ let unfold_monadic_let_bindings (_ctx : trans_ctx) (def : fun_decl) : fun_decl = let err_pat = mk_typed_pattern_from_var err_var None in let fail_pat = mk_result_fail_pattern err_pat.value lv.ty in let err_v = mk_texpression_from_var err_var in - let fail_value = mk_result_fail_texpression def.span err_v e.ty in + let fail_value = + mk_result_fail_texpression def.item_meta.span err_v e.ty + in let fail_branch = { pat = fail_pat; branch = fail_value } in let success_pat = mk_result_ok_pattern lv in let success_branch = { pat = success_pat; branch = e } in @@ -2031,7 +2040,9 @@ let filter_loop_inputs (ctx : trans_ctx) (transl : pure_fun_translation list) : ^ String.concat ", " (List.map (var_to_string ctx) inputs_prefix) ^ "\n")); let inputs_set = VarId.Set.of_list (List.map var_get_id inputs_prefix) in - sanity_check __FILE__ __LINE__ (Option.is_some decl.loop_id) decl.span; + sanity_check __FILE__ __LINE__ + (Option.is_some decl.loop_id) + decl.item_meta.span; let fun_id = (E.FRegular decl.def_id, decl.loop_id) in @@ -2183,7 +2194,9 @@ let filter_loop_inputs (ctx : trans_ctx) (transl : pure_fun_translation list) : in let fwd_info = { fwd_info; effect_info; ignore_output } in - sanity_check __FILE__ __LINE__ (fun_sig_info_is_wf fwd_info) decl.span; + sanity_check __FILE__ __LINE__ + (fun_sig_info_is_wf fwd_info) + decl.item_meta.span; let signature = { generics; @@ -2249,17 +2262,17 @@ let filter_loop_inputs (ctx : trans_ctx) (transl : pure_fun_translation list) : in (* Rebuild *) - mk_apps decl.span e_app args) + mk_apps decl.item_meta.span e_app args) | _ -> let e_app = self#visit_texpression env e_app in let args = List.map (self#visit_texpression env) args in - mk_apps decl.span e_app args) + mk_apps decl.item_meta.span e_app args) | _ -> let e_app = self#visit_texpression env e_app in let args = List.map (self#visit_texpression env) args in - mk_apps decl.span e_app args) + mk_apps decl.item_meta.span e_app args) | _ -> super#visit_texpression env e end in diff --git a/compiler/PureUtils.ml b/compiler/PureUtils.ml index fe5d3414..5a85628c 100644 --- a/compiler/PureUtils.ml +++ b/compiler/PureUtils.ml @@ -692,7 +692,7 @@ let trait_decl_is_empty (trait_decl : trait_decl) : bool = is_local = _; name = _; llbc_name = _; - span = _; + item_meta = _; generics = _; llbc_generics = _; preds = _; @@ -714,7 +714,7 @@ let trait_impl_is_empty (trait_impl : trait_impl) : bool = is_local = _; name = _; llbc_name = _; - span = _; + item_meta = _; impl_trait = _; llbc_impl_trait = _; generics = _; diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index ad61ddd1..1b5da858 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -545,7 +545,8 @@ let translate_generic_params (span : Meta.span) (generics : T.generic_params) : let translate_field (span : Meta.span) (f : T.field) : field = let field_name = f.field_name in let field_ty = translate_sty span f.field_ty in - { field_name; field_ty } + let item_meta = f.item_meta in + { field_name; field_ty; item_meta } let translate_fields (span : Meta.span) (fl : T.field list) : field list = List.map (translate_field span) fl @@ -553,7 +554,8 @@ let translate_fields (span : Meta.span) (fl : T.field list) : field list = let translate_variant (span : Meta.span) (v : T.variant) : variant = let variant_name = v.variant_name in let fields = translate_fields span v.fields in - { variant_name; fields } + let item_meta = v.item_meta in + { variant_name; fields; item_meta } let translate_variants (span : Meta.span) (vl : T.variant list) : variant list = List.map (translate_variant span) vl @@ -597,13 +599,13 @@ let translate_type_decl (ctx : Contexts.decls_ctx) (def : T.type_decl) : let kind = translate_type_decl_kind def.item_meta.span def.T.kind in let preds = translate_predicates def.item_meta.span def.preds in let is_local = def.is_local in - let span = def.item_meta.span in + let item_meta = def.item_meta in { def_id; is_local; llbc_name; name; - span; + item_meta; generics; llbc_generics = def.generics; kind; @@ -3899,7 +3901,7 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl = { def_id; is_local = def.is_local; - span = def.item_meta.span; + item_meta = def.item_meta; kind = def.kind; backend_attributes; num_loops; @@ -3988,7 +3990,7 @@ let translate_trait_decl (ctx : Contexts.decls_ctx) (trait_decl : A.trait_decl) is_local; llbc_name; name; - span = item_meta.span; + item_meta; generics; llbc_generics; preds; @@ -4057,7 +4059,7 @@ let translate_trait_impl (ctx : Contexts.decls_ctx) (trait_impl : A.trait_impl) is_local; llbc_name; name; - span = item_meta.span; + item_meta; impl_trait; llbc_impl_trait; generics; @@ -9,11 +9,11 @@ "rust-overlay": "rust-overlay" }, "locked": { - "lastModified": 1718705446, - "narHash": "sha256-1IAwhNbHkgtZRgkq9Fq+E5yOuszhTPO2J/88gyyg7jQ=", + "lastModified": 1718717065, + "narHash": "sha256-ZkoUvx9HMBKTKDh7MnMEEocAGZaLkQqVApB0IlfxRYk=", "owner": "aeneasverif", "repo": "charon", - "rev": "a350f1e4795d57fb7b23c4c2d24003cf5e16315f", + "rev": "28dc4f9b826031754fcd32c82355f6d0be05faca", "type": "github" }, "original": { diff --git a/tests/coq/rename_attribute/Primitives.v b/tests/coq/rename_attribute/Primitives.v new file mode 100644 index 00000000..b29fce43 --- /dev/null +++ b/tests/coq/rename_attribute/Primitives.v @@ -0,0 +1,981 @@ +Require Import Lia. +Require Coq.Strings.Ascii. +Require Coq.Strings.String. +Require Import Coq.Program.Equality. +Require Import Coq.ZArith.ZArith. +Require Import Coq.ZArith.Znat. +Require Import List. +Import ListNotations. + +Module Primitives. + + (* TODO: use more *) +Declare Scope Primitives_scope. + +(*** Result *) + +Inductive error := + | Failure + | OutOfFuel. + +Inductive result A := + | Ok : A -> result A + | Fail_ : error -> result 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 + | Ok x => f x + end. + +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)) + (at level 61, c1 at next level, right associativity). + +(** Monadic assert *) +Definition massert (b: bool) : result unit := + 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 = 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 + | Ok _ => False + | Fail_ e => True + end) + 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 Ok (1 + 2) else Fail_ Failure)%global = 3. + +(*** Misc *) + +Definition string := Coq.Strings.String.string. +Definition char := Coq.Strings.Ascii.ascii. +Definition char_of_byte := Coq.Strings.Ascii.ascii_of_byte. + +Definition core_mem_replace (a : Type) (x : a) (y : a) : a * a := (x, x) . + +Record mut_raw_ptr (T : Type) := { mut_raw_ptr_v : T }. +Record const_raw_ptr (T : Type) := { const_raw_ptr_v : T }. + +(*** Scalars *) + +Definition i8_min : Z := -128%Z. +Definition i8_max : Z := 127%Z. +Definition i16_min : Z := -32768%Z. +Definition i16_max : Z := 32767%Z. +Definition i32_min : Z := -2147483648%Z. +Definition i32_max : Z := 2147483647%Z. +Definition i64_min : Z := -9223372036854775808%Z. +Definition i64_max : Z := 9223372036854775807%Z. +Definition i128_min : Z := -170141183460469231731687303715884105728%Z. +Definition i128_max : Z := 170141183460469231731687303715884105727%Z. +Definition u8_min : Z := 0%Z. +Definition u8_max : Z := 255%Z. +Definition u16_min : Z := 0%Z. +Definition u16_max : Z := 65535%Z. +Definition u32_min : Z := 0%Z. +Definition u32_max : Z := 4294967295%Z. +Definition u64_min : Z := 0%Z. +Definition u64_max : Z := 18446744073709551615%Z. +Definition u128_min : Z := 0%Z. +Definition u128_max : Z := 340282366920938463463374607431768211455%Z. + +(** The bounds of [isize] and [usize] vary with the architecture. *) +Axiom isize_min : Z. +Axiom isize_max : Z. +Definition usize_min : Z := 0%Z. +Axiom usize_max : Z. + +Open Scope Z_scope. + +(** We provide those lemmas to reason about the bounds of [isize] and [usize] *) +Axiom isize_min_bound : isize_min <= i32_min. +Axiom isize_max_bound : i32_max <= isize_max. +Axiom usize_max_bound : u32_max <= usize_max. + +Inductive scalar_ty := + | Isize + | I8 + | I16 + | I32 + | I64 + | I128 + | Usize + | U8 + | U16 + | U32 + | U64 + | U128 +. + +Definition scalar_min (ty: scalar_ty) : Z := + match ty with + | Isize => isize_min + | I8 => i8_min + | I16 => i16_min + | I32 => i32_min + | I64 => i64_min + | I128 => i128_min + | Usize => usize_min + | U8 => u8_min + | U16 => u16_min + | U32 => u32_min + | U64 => u64_min + | U128 => u128_min +end. + +Definition scalar_max (ty: scalar_ty) : Z := + match ty with + | Isize => isize_max + | I8 => i8_max + | I16 => i16_max + | I32 => i32_max + | I64 => i64_max + | I128 => i128_max + | Usize => usize_max + | U8 => u8_max + | U16 => u16_max + | U32 => u32_max + | U64 => u64_max + | U128 => u128_max +end. + +(** We use the following conservative bounds to make sure we can compute bound + checks in most situations *) +Definition scalar_min_cons (ty: scalar_ty) : Z := + match ty with + | Isize => i32_min + | Usize => u32_min + | _ => scalar_min ty +end. + +Definition scalar_max_cons (ty: scalar_ty) : Z := + match ty with + | Isize => i32_max + | Usize => u32_max + | _ => scalar_max ty +end. + +Lemma scalar_min_cons_valid : forall ty, scalar_min ty <= scalar_min_cons ty . +Proof. + destruct ty; unfold scalar_min_cons, scalar_min; try lia. + - pose isize_min_bound; lia. + - apply Z.le_refl. +Qed. + +Lemma scalar_max_cons_valid : forall ty, scalar_max ty >= scalar_max_cons ty . +Proof. + destruct ty; unfold scalar_max_cons, scalar_max; try lia. + - pose isize_max_bound; lia. + - pose usize_max_bound. lia. +Qed. + +Definition scalar (ty: scalar_ty) : Type := + { x: Z | scalar_min ty <= x <= scalar_max ty }. + +Definition to_Z {ty} (x: scalar ty) : Z := proj1_sig x. + +(** Bounds checks: we start by using the conservative bounds, to make sure we + can compute in most situations, then we use the real bounds (for [isize] + and [usize]). *) +Definition scalar_ge_min (ty: scalar_ty) (x: Z) : bool := + Z.leb (scalar_min_cons ty) x || Z.leb (scalar_min ty) x. + +Definition scalar_le_max (ty: scalar_ty) (x: Z) : bool := + Z.leb x (scalar_max_cons ty) || Z.leb x (scalar_max ty). + +Lemma scalar_ge_min_valid (ty: scalar_ty) (x: Z) : + scalar_ge_min ty x = true -> scalar_min ty <= x . +Proof. + unfold scalar_ge_min. + pose (scalar_min_cons_valid ty). + lia. +Qed. + +Lemma scalar_le_max_valid (ty: scalar_ty) (x: Z) : + scalar_le_max ty x = true -> x <= scalar_max ty . +Proof. + unfold scalar_le_max. + pose (scalar_max_cons_valid ty). + lia. +Qed. + +Definition scalar_in_bounds (ty: scalar_ty) (x: Z) : bool := + scalar_ge_min ty x && scalar_le_max ty x . + +Lemma scalar_in_bounds_valid (ty: scalar_ty) (x: Z) : + scalar_in_bounds ty x = true -> scalar_min ty <= x <= scalar_max ty . +Proof. + unfold scalar_in_bounds. + intros H. + destruct (scalar_ge_min ty x) eqn:Hmin. + - destruct (scalar_le_max ty x) eqn:Hmax. + + pose (scalar_ge_min_valid ty x Hmin). + pose (scalar_le_max_valid ty x Hmax). + lia. + + inversion H. + - inversion H. +Qed. + +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 => Ok (exist _ x (scalar_in_bounds_valid _ _ H)) + | right _ => Fail_ Failure + end. + +Definition scalar_add {ty} (x y: scalar ty) : result (scalar ty) := mk_scalar ty (to_Z x + to_Z y). + +Definition scalar_sub {ty} (x y: scalar ty) : result (scalar ty) := mk_scalar ty (to_Z x - to_Z y). + +Definition scalar_mul {ty} (x y: scalar ty) : result (scalar ty) := mk_scalar ty (to_Z x * to_Z y). + +Definition scalar_div {ty} (x y: scalar ty) : result (scalar ty) := + if to_Z y =? 0 then Fail_ Failure else + mk_scalar ty (to_Z x / to_Z y). + +Definition scalar_rem {ty} (x y: scalar ty) : result (scalar ty) := mk_scalar ty (Z.rem (to_Z x) (to_Z y)). + +Definition scalar_neg {ty} (x: scalar ty) : result (scalar ty) := mk_scalar ty (-(to_Z x)). + +Axiom scalar_xor : forall ty, scalar ty -> scalar ty -> scalar ty. (* TODO *) +Axiom scalar_or : forall ty, scalar ty -> scalar ty -> scalar ty. (* TODO *) +Axiom scalar_and : forall ty, scalar ty -> scalar ty -> scalar ty. (* TODO *) +Axiom scalar_shl : forall ty0 ty1, scalar ty0 -> scalar ty1 -> result (scalar ty0). (* TODO *) +Axiom scalar_shr : forall ty0 ty1, scalar ty0 -> scalar ty1 -> result (scalar ty0). (* TODO *) + +(** Cast an integer from a [src_ty] to a [tgt_ty] *) +(* TODO: check the semantics of casts in Rust *) +Definition scalar_cast (src_ty tgt_ty : scalar_ty) (x : scalar src_ty) : result (scalar tgt_ty) := + mk_scalar tgt_ty (to_Z x). + +(* This can't fail, but for now we make all casts faillible (easier for the translation) *) +Definition scalar_cast_bool (tgt_ty : scalar_ty) (x : bool) : result (scalar tgt_ty) := + mk_scalar tgt_ty (if x then 1 else 0). + +(** Comparisons *) +Definition scalar_leb {ty : scalar_ty} (x : scalar ty) (y : scalar ty) : bool := + Z.leb (to_Z x) (to_Z y) . + +Definition scalar_ltb {ty : scalar_ty} (x : scalar ty) (y : scalar ty) : bool := + Z.ltb (to_Z x) (to_Z y) . + +Definition scalar_geb {ty : scalar_ty} (x : scalar ty) (y : scalar ty) : bool := + Z.geb (to_Z x) (to_Z y) . + +Definition scalar_gtb {ty : scalar_ty} (x : scalar ty) (y : scalar ty) : bool := + Z.gtb (to_Z x) (to_Z y) . + +Definition scalar_eqb {ty : scalar_ty} (x : scalar ty) (y : scalar ty) : bool := + Z.eqb (to_Z x) (to_Z y) . + +Definition scalar_neqb {ty : scalar_ty} (x : scalar ty) (y : scalar ty) : bool := + negb (Z.eqb (to_Z x) (to_Z y)) . + + +(** The scalar types *) +Definition isize := scalar Isize. +Definition i8 := scalar I8. +Definition i16 := scalar I16. +Definition i32 := scalar I32. +Definition i64 := scalar I64. +Definition i128 := scalar I128. +Definition usize := scalar Usize. +Definition u8 := scalar U8. +Definition u16 := scalar U16. +Definition u32 := scalar U32. +Definition u64 := scalar U64. +Definition u128 := scalar U128. + +(** Negaion *) +Definition isize_neg := @scalar_neg Isize. +Definition i8_neg := @scalar_neg I8. +Definition i16_neg := @scalar_neg I16. +Definition i32_neg := @scalar_neg I32. +Definition i64_neg := @scalar_neg I64. +Definition i128_neg := @scalar_neg I128. + +(** Division *) +Definition isize_div := @scalar_div Isize. +Definition i8_div := @scalar_div I8. +Definition i16_div := @scalar_div I16. +Definition i32_div := @scalar_div I32. +Definition i64_div := @scalar_div I64. +Definition i128_div := @scalar_div I128. +Definition usize_div := @scalar_div Usize. +Definition u8_div := @scalar_div U8. +Definition u16_div := @scalar_div U16. +Definition u32_div := @scalar_div U32. +Definition u64_div := @scalar_div U64. +Definition u128_div := @scalar_div U128. + +(** Remainder *) +Definition isize_rem := @scalar_rem Isize. +Definition i8_rem := @scalar_rem I8. +Definition i16_rem := @scalar_rem I16. +Definition i32_rem := @scalar_rem I32. +Definition i64_rem := @scalar_rem I64. +Definition i128_rem := @scalar_rem I128. +Definition usize_rem := @scalar_rem Usize. +Definition u8_rem := @scalar_rem U8. +Definition u16_rem := @scalar_rem U16. +Definition u32_rem := @scalar_rem U32. +Definition u64_rem := @scalar_rem U64. +Definition u128_rem := @scalar_rem U128. + +(** Addition *) +Definition isize_add := @scalar_add Isize. +Definition i8_add := @scalar_add I8. +Definition i16_add := @scalar_add I16. +Definition i32_add := @scalar_add I32. +Definition i64_add := @scalar_add I64. +Definition i128_add := @scalar_add I128. +Definition usize_add := @scalar_add Usize. +Definition u8_add := @scalar_add U8. +Definition u16_add := @scalar_add U16. +Definition u32_add := @scalar_add U32. +Definition u64_add := @scalar_add U64. +Definition u128_add := @scalar_add U128. + +(** Substraction *) +Definition isize_sub := @scalar_sub Isize. +Definition i8_sub := @scalar_sub I8. +Definition i16_sub := @scalar_sub I16. +Definition i32_sub := @scalar_sub I32. +Definition i64_sub := @scalar_sub I64. +Definition i128_sub := @scalar_sub I128. +Definition usize_sub := @scalar_sub Usize. +Definition u8_sub := @scalar_sub U8. +Definition u16_sub := @scalar_sub U16. +Definition u32_sub := @scalar_sub U32. +Definition u64_sub := @scalar_sub U64. +Definition u128_sub := @scalar_sub U128. + +(** Multiplication *) +Definition isize_mul := @scalar_mul Isize. +Definition i8_mul := @scalar_mul I8. +Definition i16_mul := @scalar_mul I16. +Definition i32_mul := @scalar_mul I32. +Definition i64_mul := @scalar_mul I64. +Definition i128_mul := @scalar_mul I128. +Definition usize_mul := @scalar_mul Usize. +Definition u8_mul := @scalar_mul U8. +Definition u16_mul := @scalar_mul U16. +Definition u32_mul := @scalar_mul U32. +Definition u64_mul := @scalar_mul U64. +Definition u128_mul := @scalar_mul U128. + +(** Xor *) +Definition u8_xor := @scalar_xor U8. +Definition u16_xor := @scalar_xor U16. +Definition u32_xor := @scalar_xor U32. +Definition u64_xor := @scalar_xor U64. +Definition u128_xor := @scalar_xor U128. +Definition usize_xor := @scalar_xor Usize. +Definition i8_xor := @scalar_xor I8. +Definition i16_xor := @scalar_xor I16. +Definition i32_xor := @scalar_xor I32. +Definition i64_xor := @scalar_xor I64. +Definition i128_xor := @scalar_xor I128. +Definition isize_xor := @scalar_xor Isize. + +(** Or *) +Definition u8_or := @scalar_or U8. +Definition u16_or := @scalar_or U16. +Definition u32_or := @scalar_or U32. +Definition u64_or := @scalar_or U64. +Definition u128_or := @scalar_or U128. +Definition usize_or := @scalar_or Usize. +Definition i8_or := @scalar_or I8. +Definition i16_or := @scalar_or I16. +Definition i32_or := @scalar_or I32. +Definition i64_or := @scalar_or I64. +Definition i128_or := @scalar_or I128. +Definition isize_or := @scalar_or Isize. + +(** And *) +Definition u8_and := @scalar_and U8. +Definition u16_and := @scalar_and U16. +Definition u32_and := @scalar_and U32. +Definition u64_and := @scalar_and U64. +Definition u128_and := @scalar_and U128. +Definition usize_and := @scalar_and Usize. +Definition i8_and := @scalar_and I8. +Definition i16_and := @scalar_and I16. +Definition i32_and := @scalar_and I32. +Definition i64_and := @scalar_and I64. +Definition i128_and := @scalar_and I128. +Definition isize_and := @scalar_and Isize. + +(** Shift left *) +Definition u8_shl {ty} := @scalar_shl U8 ty. +Definition u16_shl {ty} := @scalar_shl U16 ty. +Definition u32_shl {ty} := @scalar_shl U32 ty. +Definition u64_shl {ty} := @scalar_shl U64 ty. +Definition u128_shl {ty} := @scalar_shl U128 ty. +Definition usize_shl {ty} := @scalar_shl Usize ty. +Definition i8_shl {ty} := @scalar_shl I8 ty. +Definition i16_shl {ty} := @scalar_shl I16 ty. +Definition i32_shl {ty} := @scalar_shl I32 ty. +Definition i64_shl {ty} := @scalar_shl I64 ty. +Definition i128_shl {ty} := @scalar_shl I128 ty. +Definition isize_shl {ty} := @scalar_shl Isize ty. + +(** Shift right *) +Definition u8_shr {ty} := @scalar_shr U8 ty. +Definition u16_shr {ty} := @scalar_shr U16 ty. +Definition u32_shr {ty} := @scalar_shr U32 ty. +Definition u64_shr {ty} := @scalar_shr U64 ty. +Definition u128_shr {ty} := @scalar_shr U128 ty. +Definition usize_shr {ty} := @scalar_shr Usize ty. +Definition i8_shr {ty} := @scalar_shr I8 ty. +Definition i16_shr {ty} := @scalar_shr I16 ty. +Definition i32_shr {ty} := @scalar_shr I32 ty. +Definition i64_shr {ty} := @scalar_shr I64 ty. +Definition i128_shr {ty} := @scalar_shr I128 ty. +Definition isize_shr {ty} := @scalar_shr Isize ty. + +(** Small utility *) +Definition usize_to_nat (x: usize) : nat := Z.to_nat (to_Z x). + +(** Notations *) +Notation "x %isize" := ((mk_scalar Isize x)%return) (at level 9). +Notation "x %i8" := ((mk_scalar I8 x)%return) (at level 9). +Notation "x %i16" := ((mk_scalar I16 x)%return) (at level 9). +Notation "x %i32" := ((mk_scalar I32 x)%return) (at level 9). +Notation "x %i64" := ((mk_scalar I64 x)%return) (at level 9). +Notation "x %i128" := ((mk_scalar I128 x)%return) (at level 9). +Notation "x %usize" := ((mk_scalar Usize x)%return) (at level 9). +Notation "x %u8" := ((mk_scalar U8 x)%return) (at level 9). +Notation "x %u16" := ((mk_scalar U16 x)%return) (at level 9). +Notation "x %u32" := ((mk_scalar U32 x)%return) (at level 9). +Notation "x %u64" := ((mk_scalar U64 x)%return) (at level 9). +Notation "x %u128" := ((mk_scalar U128 x)%return) (at level 9). + +Notation "x s= y" := (scalar_eqb x y) (at level 80) : Primitives_scope. +Notation "x s<> y" := (scalar_neqb x y) (at level 80) : Primitives_scope. +Notation "x s<= y" := (scalar_leb x y) (at level 80) : Primitives_scope. +Notation "x s< y" := (scalar_ltb x y) (at level 80) : Primitives_scope. +Notation "x s>= y" := (scalar_geb x y) (at level 80) : Primitives_scope. +Notation "x s> y" := (scalar_gtb x y) (at level 80) : Primitives_scope. + +(** Constants *) +Definition core_u8_max := u8_max %u32. +Definition core_u16_max := u16_max %u32. +Definition core_u32_max := u32_max %u32. +Definition core_u64_max := u64_max %u64. +Definition core_u128_max := u64_max %u128. +Axiom core_usize_max : usize. (** TODO *) +Definition core_i8_max := i8_max %i32. +Definition core_i16_max := i16_max %i32. +Definition core_i32_max := i32_max %i32. +Definition core_i64_max := i64_max %i64. +Definition core_i128_max := i64_max %i128. +Axiom core_isize_max : isize. (** TODO *) + +(*** core *) + +(** Trait declaration: [core::clone::Clone] *) +Record core_clone_Clone (self : Type) := { + clone : self -> result self +}. + +Definition core_clone_impls_CloneBool_clone (b : bool) : bool := b. + +Definition core_clone_CloneBool : core_clone_Clone bool := {| + clone := fun b => Ok (core_clone_impls_CloneBool_clone b) +|}. + +Definition core_clone_impls_CloneUsize_clone (x : usize) : usize := x. +Definition core_clone_impls_CloneU8_clone (x : u8) : u8 := x. +Definition core_clone_impls_CloneU16_clone (x : u16) : u16 := x. +Definition core_clone_impls_CloneU32_clone (x : u32) : u32 := x. +Definition core_clone_impls_CloneU64_clone (x : u64) : u64 := x. +Definition core_clone_impls_CloneU128_clone (x : u128) : u128 := x. + +Definition core_clone_impls_CloneIsize_clone (x : isize) : isize := x. +Definition core_clone_impls_CloneI8_clone (x : i8) : i8 := x. +Definition core_clone_impls_CloneI16_clone (x : i16) : i16 := x. +Definition core_clone_impls_CloneI32_clone (x : i32) : i32 := x. +Definition core_clone_impls_CloneI64_clone (x : i64) : i64 := x. +Definition core_clone_impls_CloneI128_clone (x : i128) : i128 := x. + +Definition core_clone_CloneUsize : core_clone_Clone usize := {| + clone := fun x => Ok (core_clone_impls_CloneUsize_clone x) +|}. + +Definition core_clone_CloneU8 : core_clone_Clone u8 := {| + clone := fun x => Ok (core_clone_impls_CloneU8_clone x) +|}. + +Definition core_clone_CloneU16 : core_clone_Clone u16 := {| + clone := fun x => Ok (core_clone_impls_CloneU16_clone x) +|}. + +Definition core_clone_CloneU32 : core_clone_Clone u32 := {| + clone := fun x => Ok (core_clone_impls_CloneU32_clone x) +|}. + +Definition core_clone_CloneU64 : core_clone_Clone u64 := {| + clone := fun x => Ok (core_clone_impls_CloneU64_clone x) +|}. + +Definition core_clone_CloneU128 : core_clone_Clone u128 := {| + clone := fun x => Ok (core_clone_impls_CloneU128_clone x) +|}. + +Definition core_clone_CloneIsize : core_clone_Clone isize := {| + clone := fun x => Ok (core_clone_impls_CloneIsize_clone x) +|}. + +Definition core_clone_CloneI8 : core_clone_Clone i8 := {| + clone := fun x => Ok (core_clone_impls_CloneI8_clone x) +|}. + +Definition core_clone_CloneI16 : core_clone_Clone i16 := {| + clone := fun x => Ok (core_clone_impls_CloneI16_clone x) +|}. + +Definition core_clone_CloneI32 : core_clone_Clone i32 := {| + clone := fun x => Ok (core_clone_impls_CloneI32_clone x) +|}. + +Definition core_clone_CloneI64 : core_clone_Clone i64 := {| + clone := fun x => Ok (core_clone_impls_CloneI64_clone x) +|}. + +Definition core_clone_CloneI128 : core_clone_Clone i128 := {| + clone := fun x => Ok (core_clone_impls_CloneI128_clone x) +|}. + +(** [core::option::{core::option::Option<T>}::unwrap] *) +Definition core_option_Option_unwrap (T : Type) (x : option T) : result T := + match x with + | None => Fail_ Failure + | Some x => Ok x + end. + +(*** core::ops *) + +(* Trait declaration: [core::ops::index::Index] *) +Record core_ops_index_Index (Self Idx : Type) := mk_core_ops_index_Index { + core_ops_index_Index_Output : Type; + core_ops_index_Index_index : Self -> Idx -> result core_ops_index_Index_Output; +}. +Arguments mk_core_ops_index_Index {_ _}. +Arguments core_ops_index_Index_Output {_ _}. +Arguments core_ops_index_Index_index {_ _}. + +(* Trait declaration: [core::ops::index::IndexMut] *) +Record core_ops_index_IndexMut (Self Idx : Type) := mk_core_ops_index_IndexMut { + core_ops_index_IndexMut_indexInst : core_ops_index_Index Self Idx; + core_ops_index_IndexMut_index_mut : + Self -> + Idx -> + result (core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) * + (core_ops_index_IndexMut_indexInst.(core_ops_index_Index_Output) -> result Self)); +}. +Arguments mk_core_ops_index_IndexMut {_ _}. +Arguments core_ops_index_IndexMut_indexInst {_ _}. +Arguments core_ops_index_IndexMut_index_mut {_ _}. + +(* Trait declaration [core::ops::deref::Deref] *) +Record core_ops_deref_Deref (Self : Type) := mk_core_ops_deref_Deref { + core_ops_deref_Deref_target : Type; + core_ops_deref_Deref_deref : Self -> result core_ops_deref_Deref_target; +}. +Arguments mk_core_ops_deref_Deref {_}. +Arguments core_ops_deref_Deref_target {_}. +Arguments core_ops_deref_Deref_deref {_}. + +(* Trait declaration [core::ops::deref::DerefMut] *) +Record core_ops_deref_DerefMut (Self : Type) := mk_core_ops_deref_DerefMut { + core_ops_deref_DerefMut_derefInst : core_ops_deref_Deref Self; + core_ops_deref_DerefMut_deref_mut : + Self -> + result (core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) * + (core_ops_deref_DerefMut_derefInst.(core_ops_deref_Deref_target) -> result Self)); +}. +Arguments mk_core_ops_deref_DerefMut {_}. +Arguments core_ops_deref_DerefMut_derefInst {_}. +Arguments core_ops_deref_DerefMut_deref_mut {_}. + +Record core_ops_range_Range (T : Type) := mk_core_ops_range_Range { + core_ops_range_Range_start : T; + core_ops_range_Range_end_ : T; +}. +Arguments mk_core_ops_range_Range {_}. +Arguments core_ops_range_Range_start {_}. +Arguments core_ops_range_Range_end_ {_}. + +(*** [alloc] *) + +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)) := + Ok (x, fun x => Ok x). + +(* Trait instance *) +Definition alloc_boxed_Box_coreopsDerefInst (Self : Type) : core_ops_deref_Deref Self := {| + core_ops_deref_Deref_target := Self; + core_ops_deref_Deref_deref := alloc_boxed_Box_deref Self; +|}. + +(* Trait instance *) +Definition alloc_boxed_Box_coreopsDerefMutInst (Self : Type) : core_ops_deref_DerefMut Self := {| + core_ops_deref_DerefMut_derefInst := alloc_boxed_Box_coreopsDerefInst Self; + core_ops_deref_DerefMut_deref_mut := alloc_boxed_Box_deref_mut Self; +|}. + + +(*** Arrays *) +Definition array T (n : usize) := { l: list T | Z.of_nat (length l) = to_Z n}. + +Lemma le_0_usize_max : 0 <= usize_max. +Proof. + pose (H := usize_max_bound). + unfold u32_max in H. + lia. +Qed. + +Lemma eqb_imp_eq (x y : Z) : Z.eqb x y = true -> x = y. +Proof. + lia. +Qed. + +(* TODO: finish the definitions *) +Axiom mk_array : forall (T : Type) (n : usize) (l : list T), array T n. + +(* For initialization *) +Axiom array_repeat : forall (T : Type) (n : usize) (x : T), array T n. + +Axiom array_index_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize), result T. +Axiom array_update_usize : forall (T : Type) (n : usize) (x : array T n) (i : usize) (nx : T), result (array T n). + +Definition array_index_mut_usize (T : Type) (n : usize) (a : array T n) (i : usize) : + result (T * (T -> result (array T n))) := + match array_index_usize T n a i with + | Fail_ e => Fail_ e + | Ok x => Ok (x, array_update_usize T n a i) + end. + +(*** Slice *) +Definition slice T := { l: list T | Z.of_nat (length l) <= usize_max}. + +Axiom slice_len : forall (T : Type) (s : slice T), usize. +Axiom slice_index_usize : forall (T : Type) (x : slice T) (i : usize), result T. +Axiom slice_update_usize : forall (T : Type) (x : slice T) (i : usize) (nx : T), result (slice T). + +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 + | Ok x => Ok (x, slice_update_usize T s i) + end. + +(*** Subslices *) + +Axiom array_to_slice : forall (T : Type) (n : usize) (x : array T n), result (slice T). +Axiom array_from_slice : forall (T : Type) (n : usize) (x : array T n) (s : slice T), result (array T n). + +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 + | 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). +Axiom array_update_subslice: forall (T : Type) (n : usize) (x : array T n) (r : core_ops_range_Range usize) (ns : slice T), result (array T n). + +Axiom slice_subslice: forall (T : Type) (x : slice T) (r : core_ops_range_Range usize), result (slice T). +Axiom slice_update_subslice: forall (T : Type) (x : slice T) (r : core_ops_range_Range usize) (ns : slice T), result (slice T). + +(*** Vectors *) + +Definition alloc_vec_Vec T := { l: list T | Z.of_nat (length l) <= usize_max }. + +Definition alloc_vec_Vec_to_list {T: Type} (v: alloc_vec_Vec T) : list T := proj1_sig v. + +Definition alloc_vec_Vec_length {T: Type} (v: alloc_vec_Vec T) : Z := Z.of_nat (length (alloc_vec_Vec_to_list v)). + +Definition alloc_vec_Vec_new (T: Type) : alloc_vec_Vec T := (exist _ [] le_0_usize_max). + +Lemma alloc_vec_Vec_len_in_usize {T} (v: alloc_vec_Vec T) : usize_min <= alloc_vec_Vec_length v <= usize_max. +Proof. + unfold alloc_vec_Vec_length, usize_min. + split. + - lia. + - apply (proj2_sig v). +Qed. + +Definition alloc_vec_Vec_len (T: Type) (v: alloc_vec_Vec T) : usize := + exist _ (alloc_vec_Vec_length v) (alloc_vec_Vec_len_in_usize v). + +Fixpoint list_update {A} (l: list A) (n: nat) (a: A) + : list A := + match l with + | [] => [] + | x :: t => match n with + | 0%nat => a :: t + | S m => x :: (list_update t m a) +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 => 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 => 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 <? Z.of_nat (length l) + then Ok (list_update l (usize_to_nat i) x) + else Fail_ Failure). + +(* Helper *) +Axiom alloc_vec_Vec_index_usize : forall {T : Type} (v : alloc_vec_Vec T) (i : usize), result T. + +(* Helper *) +Axiom alloc_vec_Vec_update_usize : forall {T : Type} (v : alloc_vec_Vec T) (i : usize) (x : T), result (alloc_vec_Vec T). + +Definition alloc_vec_Vec_index_mut_usize {T : Type} (v: alloc_vec_Vec T) (i: usize) : + result (T * (T -> result (alloc_vec_Vec T))) := + match alloc_vec_Vec_index_usize v i with + | Ok x => + Ok (x, alloc_vec_Vec_update_usize v i) + | Fail_ e => Fail_ e + end. + +(* Trait declaration: [core::slice::index::private_slice_index::Sealed] *) +Definition core_slice_index_private_slice_index_Sealed (self : Type) := unit. + +(* Trait declaration: [core::slice::index::SliceIndex] *) +Record core_slice_index_SliceIndex (Self T : Type) := mk_core_slice_index_SliceIndex { + core_slice_index_SliceIndex_sealedInst : core_slice_index_private_slice_index_Sealed Self; + core_slice_index_SliceIndex_Output : Type; + core_slice_index_SliceIndex_get : Self -> T -> result (option core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_get_mut : + Self -> T -> result (option core_slice_index_SliceIndex_Output * (option core_slice_index_SliceIndex_Output -> result T)); + core_slice_index_SliceIndex_get_unchecked : Self -> const_raw_ptr T -> result (const_raw_ptr core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_get_unchecked_mut : Self -> mut_raw_ptr T -> result (mut_raw_ptr core_slice_index_SliceIndex_Output); + core_slice_index_SliceIndex_index : Self -> T -> result core_slice_index_SliceIndex_Output; + core_slice_index_SliceIndex_index_mut : + Self -> T -> result (core_slice_index_SliceIndex_Output * (core_slice_index_SliceIndex_Output -> result T)); +}. +Arguments mk_core_slice_index_SliceIndex {_ _}. +Arguments core_slice_index_SliceIndex_sealedInst {_ _}. +Arguments core_slice_index_SliceIndex_Output {_ _}. +Arguments core_slice_index_SliceIndex_get {_ _}. +Arguments core_slice_index_SliceIndex_get_mut {_ _}. +Arguments core_slice_index_SliceIndex_get_unchecked {_ _}. +Arguments core_slice_index_SliceIndex_get_unchecked_mut {_ _}. +Arguments core_slice_index_SliceIndex_index {_ _}. +Arguments core_slice_index_SliceIndex_index_mut {_ _}. + +(* [core::slice::index::[T]::index]: forward function *) +Definition core_slice_index_Slice_index + (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (s : slice T) (i : Idx) : result inst.(core_slice_index_SliceIndex_Output) := + x <- inst.(core_slice_index_SliceIndex_get) i s; + match x with + | None => Fail_ Failure + | Some x => Ok x + end. + +(* [core::slice::index::Range:::get]: forward function *) +Axiom core_slice_index_RangeUsize_get : forall (T : Type) (i : core_ops_range_Range usize) (s : slice T), result (option (slice T)). + +(* [core::slice::index::Range::get_mut]: forward function *) +Axiom core_slice_index_RangeUsize_get_mut : + forall (T : Type), + core_ops_range_Range usize -> slice T -> + result (option (slice T) * (option (slice T) -> result (slice T))). + +(* [core::slice::index::Range::get_unchecked]: forward function *) +Definition core_slice_index_RangeUsize_get_unchecked + (T : Type) : + core_ops_range_Range usize -> const_raw_ptr (slice T) -> result (const_raw_ptr (slice T)) := + (* Don't know what the model should be - for now we always fail to make + sure code which uses it fails *) + fun _ _ => Fail_ Failure. + +(* [core::slice::index::Range::get_unchecked_mut]: forward function *) +Definition core_slice_index_RangeUsize_get_unchecked_mut + (T : Type) : + core_ops_range_Range usize -> mut_raw_ptr (slice T) -> result (mut_raw_ptr (slice T)) := + (* Don't know what the model should be - for now we always fail to make + sure code which uses it fails *) + fun _ _ => Fail_ Failure. + +(* [core::slice::index::Range::index]: forward function *) +Axiom core_slice_index_RangeUsize_index : + forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T). + +(* [core::slice::index::Range::index_mut]: forward function *) +Axiom core_slice_index_RangeUsize_index_mut : + forall (T : Type), core_ops_range_Range usize -> slice T -> result (slice T * (slice T -> result (slice T))). + +(* [core::slice::index::[T]::index_mut]: forward function *) +Axiom core_slice_index_Slice_index_mut : + forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)), + slice T -> Idx -> + result (inst.(core_slice_index_SliceIndex_Output) * + (inst.(core_slice_index_SliceIndex_Output) -> result (slice T))). + +(* [core::array::[T; N]::index]: forward function *) +Axiom core_array_Array_index : + forall (T Idx : Type) (N : usize) (inst : core_ops_index_Index (slice T) Idx) + (a : array T N) (i : Idx), result inst.(core_ops_index_Index_Output). + +(* [core::array::[T; N]::index_mut]: forward function *) +Axiom core_array_Array_index_mut : + forall (T Idx : Type) (N : usize) (inst : core_ops_index_IndexMut (slice T) Idx) + (a : array T N) (i : Idx), + result (inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output) * + (inst.(core_ops_index_IndexMut_indexInst).(core_ops_index_Index_Output) -> result (array T N))). + +(* Trait implementation: [core::slice::index::private_slice_index::Range] *) +Definition core_slice_index_private_slice_index_SealedRangeUsizeInst + : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) := tt. + +(* Trait implementation: [core::slice::index::Range] *) +Definition core_slice_index_SliceIndexRangeUsizeSliceTInst (T : Type) : + core_slice_index_SliceIndex (core_ops_range_Range usize) (slice T) := {| + core_slice_index_SliceIndex_sealedInst := core_slice_index_private_slice_index_SealedRangeUsizeInst; + core_slice_index_SliceIndex_Output := slice T; + core_slice_index_SliceIndex_get := core_slice_index_RangeUsize_get T; + core_slice_index_SliceIndex_get_mut := core_slice_index_RangeUsize_get_mut T; + core_slice_index_SliceIndex_get_unchecked := core_slice_index_RangeUsize_get_unchecked T; + core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_RangeUsize_get_unchecked_mut T; + core_slice_index_SliceIndex_index := core_slice_index_RangeUsize_index T; + core_slice_index_SliceIndex_index_mut := core_slice_index_RangeUsize_index_mut T; +|}. + +(* Trait implementation: [core::slice::index::[T]] *) +Definition core_ops_index_IndexSliceTIInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_Index (slice T) Idx := {| + core_ops_index_Index_Output := inst.(core_slice_index_SliceIndex_Output); + core_ops_index_Index_index := core_slice_index_Slice_index T Idx inst; +|}. + +(* Trait implementation: [core::slice::index::[T]] *) +Definition core_ops_index_IndexMutSliceTIInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_IndexMut (slice T) Idx := {| + core_ops_index_IndexMut_indexInst := core_ops_index_IndexSliceTIInst T Idx inst; + core_ops_index_IndexMut_index_mut := core_slice_index_Slice_index_mut T Idx inst; +|}. + +(* Trait implementation: [core::array::[T; N]] *) +Definition core_ops_index_IndexArrayInst (T Idx : Type) (N : usize) + (inst : core_ops_index_Index (slice T) Idx) : + core_ops_index_Index (array T N) Idx := {| + core_ops_index_Index_Output := inst.(core_ops_index_Index_Output); + core_ops_index_Index_index := core_array_Array_index T Idx N inst; +|}. + +(* Trait implementation: [core::array::[T; N]] *) +Definition core_ops_index_IndexMutArrayInst (T Idx : Type) (N : usize) + (inst : core_ops_index_IndexMut (slice T) Idx) : + core_ops_index_IndexMut (array T N) Idx := {| + core_ops_index_IndexMut_indexInst := core_ops_index_IndexArrayInst T Idx N inst.(core_ops_index_IndexMut_indexInst); + core_ops_index_IndexMut_index_mut := core_array_Array_index_mut T Idx N inst; +|}. + +(* [core::slice::index::usize::get]: forward function *) +Axiom core_slice_index_usize_get : forall (T : Type), usize -> slice T -> result (option T). + +(* [core::slice::index::usize::get_mut]: forward function *) +Axiom core_slice_index_usize_get_mut : + forall (T : Type), usize -> slice T -> result (option T * (option T -> result (slice T))). + +(* [core::slice::index::usize::get_unchecked]: forward function *) +Axiom core_slice_index_usize_get_unchecked : + forall (T : Type), usize -> const_raw_ptr (slice T) -> result (const_raw_ptr T). + +(* [core::slice::index::usize::get_unchecked_mut]: forward function *) +Axiom core_slice_index_usize_get_unchecked_mut : + forall (T : Type), usize -> mut_raw_ptr (slice T) -> result (mut_raw_ptr T). + +(* [core::slice::index::usize::index]: forward function *) +Axiom core_slice_index_usize_index : forall (T : Type), usize -> slice T -> result T. + +(* [core::slice::index::usize::index_mut]: forward function *) +Axiom core_slice_index_usize_index_mut : + forall (T : Type), usize -> slice T -> result (T * (T -> result (slice T))). + +(* Trait implementation: [core::slice::index::private_slice_index::usize] *) +Definition core_slice_index_private_slice_index_SealedUsizeInst + : core_slice_index_private_slice_index_Sealed usize := tt. + +(* Trait implementation: [core::slice::index::usize] *) +Definition core_slice_index_SliceIndexUsizeSliceTInst (T : Type) : + core_slice_index_SliceIndex usize (slice T) := {| + core_slice_index_SliceIndex_sealedInst := core_slice_index_private_slice_index_SealedUsizeInst; + core_slice_index_SliceIndex_Output := T; + core_slice_index_SliceIndex_get := core_slice_index_usize_get T; + core_slice_index_SliceIndex_get_mut := core_slice_index_usize_get_mut T; + core_slice_index_SliceIndex_get_unchecked := core_slice_index_usize_get_unchecked T; + core_slice_index_SliceIndex_get_unchecked_mut := core_slice_index_usize_get_unchecked_mut T; + core_slice_index_SliceIndex_index := core_slice_index_usize_index T; + core_slice_index_SliceIndex_index_mut := core_slice_index_usize_index_mut T; +|}. + +(* [alloc::vec::Vec::index]: forward function *) +Axiom alloc_vec_Vec_index : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (Self : alloc_vec_Vec T) (i : Idx), result inst.(core_slice_index_SliceIndex_Output). + +(* [alloc::vec::Vec::index_mut]: forward function *) +Axiom alloc_vec_Vec_index_mut : forall (T Idx : Type) (inst : core_slice_index_SliceIndex Idx (slice T)) + (Self : alloc_vec_Vec T) (i : Idx), + result (inst.(core_slice_index_SliceIndex_Output) * + (inst.(core_slice_index_SliceIndex_Output) -> result (alloc_vec_Vec T))). + +(* Trait implementation: [alloc::vec::Vec] *) +Definition alloc_vec_Vec_coreopsindexIndexInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_Index (alloc_vec_Vec T) Idx := {| + core_ops_index_Index_Output := inst.(core_slice_index_SliceIndex_Output); + core_ops_index_Index_index := alloc_vec_Vec_index T Idx inst; +|}. + +(* Trait implementation: [alloc::vec::Vec] *) +Definition alloc_vec_Vec_coreopsindexIndexMutInst (T Idx : Type) + (inst : core_slice_index_SliceIndex Idx (slice T)) : + core_ops_index_IndexMut (alloc_vec_Vec T) Idx := {| + core_ops_index_IndexMut_indexInst := alloc_vec_Vec_coreopsindexIndexInst T Idx inst; + core_ops_index_IndexMut_index_mut := alloc_vec_Vec_index_mut T Idx inst; +|}. + +(*** Theorems *) + +Axiom alloc_vec_Vec_index_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usize) (x : a), + alloc_vec_Vec_index a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i = + alloc_vec_Vec_index_usize v i. + +Axiom alloc_vec_Vec_index_mut_eq : forall {a : Type} (v : alloc_vec_Vec a) (i : usize) (x : a), + alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i = + alloc_vec_Vec_index_mut_usize v i. + +End Primitives. diff --git a/tests/coq/rename_attribute/RenameAttribute.v b/tests/coq/rename_attribute/RenameAttribute.v new file mode 100644 index 00000000..3ce7ba5c --- /dev/null +++ b/tests/coq/rename_attribute/RenameAttribute.v @@ -0,0 +1,103 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [rename_attribute] *) +Require Import Primitives. +Import Primitives. +Require Import Coq.ZArith.ZArith. +Require Import List. +Import ListNotations. +Local Open Scope Primitives_scope. +Module RenameAttribute. + +(** Trait declaration: [rename_attribute::BoolTrait] + Source: 'tests/src/rename_attribute.rs', lines 8:0-8:19 *) +Record BoolTest_t (Self : Type) := mkBoolTest_t { + BoolTest_t_getTest : Self -> result bool; +}. + +Arguments mkBoolTest_t { _ }. +Arguments BoolTest_t_getTest { _ }. + +(** [rename_attribute::{(rename_attribute::BoolTrait for bool)}::get_bool]: + Source: 'tests/src/rename_attribute.rs', lines 22:4-22:30 *) +Definition boolTraitBool_getTest (self : bool) : result bool := + Ok self. + +(** Trait implementation: [rename_attribute::{(rename_attribute::BoolTrait for bool)}] + Source: 'tests/src/rename_attribute.rs', lines 21:0-21:23 *) +Definition BoolImpl : BoolTest_t bool := {| + BoolTest_t_getTest := boolTraitBool_getTest; +|}. + +(** [rename_attribute::BoolTrait::ret_true]: + Source: 'tests/src/rename_attribute.rs', lines 15:4-15:30 *) +Definition boolTrait_retTest + {Self : Type} (self_clause : BoolTest_t Self) (self : Self) : result bool := + Ok true +. + +(** [rename_attribute::test_bool_trait]: + Source: 'tests/src/rename_attribute.rs', lines 28:0-28:42 *) +Definition boolFn (T : Type) (x : bool) : result bool := + b <- boolTraitBool_getTest x; + if b then boolTrait_retTest BoolImpl x else Ok false +. + +(** [rename_attribute::SimpleEnum] + Source: 'tests/src/rename_attribute.rs', lines 36:0-36:15 *) +Inductive VariantsTest_t := +| VariantsTest_Variant1 : VariantsTest_t +| VariantsTest_SecondVariant : VariantsTest_t +| VariantsTest_ThirdVariant : VariantsTest_t +. + +(** [rename_attribute::Foo] + Source: 'tests/src/rename_attribute.rs', lines 44:0-44:10 *) +Record StructTest_t := mkStructTest_t { structTest_FieldTest : u32; }. + +(** [rename_attribute::C] + Source: 'tests/src/rename_attribute.rs', lines 50:0-50:12 *) +Definition const_test_body : result u32 := + i <- u32_add 100%u32 10%u32; u32_add i 1%u32 +. +Definition const_test : u32 := const_test_body%global. + +(** [rename_attribute::CA] + Source: 'tests/src/rename_attribute.rs', lines 53:0-53:13 *) +Definition const_aeneas11_body : result u32 := u32_add 10%u32 1%u32. +Definition const_aeneas11 : u32 := const_aeneas11_body%global. + +(** [rename_attribute::factorial]: + Source: 'tests/src/rename_attribute.rs', lines 56:0-56:27 *) +Fixpoint factfn (n : nat) (n1 : u64) : result u64 := + match n with + | O => Fail_ OutOfFuel + | S n2 => + if n1 s<= 1%u64 + then Ok 1%u64 + else (i <- u64_sub n1 1%u64; i1 <- factfn n2 i; u64_mul n1 i1) + end +. + +(** [rename_attribute::sum]: loop 0: + Source: 'tests/src/rename_attribute.rs', lines 67:4-75:1 *) +Fixpoint no_borrows_sum_loop + (n : nat) (max : u32) (i : u32) (s : u32) : result u32 := + match n with + | O => Fail_ OutOfFuel + | S n1 => + if i s< max + then ( + s1 <- u32_add s i; + i1 <- u32_add i 1%u32; + no_borrows_sum_loop n1 max i1 s1) + else u32_mul s 2%u32 + end +. + +(** [rename_attribute::sum]: + Source: 'tests/src/rename_attribute.rs', lines 65:0-65:27 *) +Definition no_borrows_sum (n : nat) (max : u32) : result u32 := + no_borrows_sum_loop n max 0%u32 0%u32 +. + +End RenameAttribute. diff --git a/tests/fstar/rename_attribute/Primitives.fst b/tests/fstar/rename_attribute/Primitives.fst new file mode 100644 index 00000000..9951ccc3 --- /dev/null +++ b/tests/fstar/rename_attribute/Primitives.fst @@ -0,0 +1,929 @@ +/// This file lists primitive and assumed functions and types +module Primitives +open FStar.Mul +open FStar.List.Tot + +#set-options "--z3rlimit 15 --fuel 0 --ifuel 1" + +(*** Utilities *) +val list_update (#a : Type0) (ls : list a) (i : nat{i < length ls}) (x : a) : + ls':list a{ + length ls' = length ls /\ + index ls' i == x + } +#push-options "--fuel 1" +let rec list_update #a ls i x = + match ls with + | x' :: ls -> if i = 0 then x :: ls else x' :: list_update ls (i-1) x +#pop-options + +(*** Result *) +type error : Type0 = +| Failure +| OutOfFuel + +type result (a : Type0) : Type0 = +| Ok : v:a -> result a +| Fail : e:error -> result a + +// Monadic return operator +unfold let return (#a : Type0) (x : a) : result a = Ok x + +// Monadic bind operator. +// Allows to use the notation: +// ``` +// let* x = y in +// ... +// ``` +unfold let (let*) (#a #b : Type0) (m: result a) + (f: (x:a) -> Pure (result b) (requires (m == Ok x)) (ensures fun _ -> True)) : + result b = + match m with + | Ok x -> f x + | Fail e -> Fail e + +// Monadic assert(...) +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{Ok? (normalize_term x)}) : a = Ok?.v x + +(*** Misc *) +type char = FStar.Char.char +type string = string + +let is_zero (n: nat) : bool = n = 0 +let decrease (n: nat{n > 0}) : nat = n - 1 + +let core_mem_replace (a : Type0) (x : a) (y : a) : a & a = (x, x) + +// We don't really use raw pointers for now +type mut_raw_ptr (t : Type0) = { v : t } +type const_raw_ptr (t : Type0) = { v : t } + +(*** Scalars *) +/// Rem.: most of the following code was partially generated + +assume val size_numbits : pos + +// TODO: we could use FStar.Int.int_t and FStar.UInt.int_t + +let isize_min : int = -9223372036854775808 // TODO: should be opaque +let isize_max : int = 9223372036854775807 // TODO: should be opaque +let i8_min : int = -128 +let i8_max : int = 127 +let i16_min : int = -32768 +let i16_max : int = 32767 +let i32_min : int = -2147483648 +let i32_max : int = 2147483647 +let i64_min : int = -9223372036854775808 +let i64_max : int = 9223372036854775807 +let i128_min : int = -170141183460469231731687303715884105728 +let i128_max : int = 170141183460469231731687303715884105727 +let usize_min : int = 0 +let usize_max : int = 4294967295 // TODO: should be opaque +let u8_min : int = 0 +let u8_max : int = 255 +let u16_min : int = 0 +let u16_max : int = 65535 +let u32_min : int = 0 +let u32_max : int = 4294967295 +let u64_min : int = 0 +let u64_max : int = 18446744073709551615 +let u128_min : int = 0 +let u128_max : int = 340282366920938463463374607431768211455 + +type scalar_ty = +| Isize +| I8 +| I16 +| I32 +| I64 +| I128 +| Usize +| U8 +| U16 +| U32 +| U64 +| U128 + +let is_unsigned = function + | Isize | I8 | I16 | I32 | I64 | I128 -> false + | Usize | U8 | U16 | U32 | U64 | U128 -> true + +let scalar_min (ty : scalar_ty) : int = + match ty with + | Isize -> isize_min + | I8 -> i8_min + | I16 -> i16_min + | I32 -> i32_min + | I64 -> i64_min + | I128 -> i128_min + | Usize -> usize_min + | U8 -> u8_min + | U16 -> u16_min + | U32 -> u32_min + | U64 -> u64_min + | U128 -> u128_min + +let scalar_max (ty : scalar_ty) : int = + match ty with + | Isize -> isize_max + | I8 -> i8_max + | I16 -> i16_max + | I32 -> i32_max + | I64 -> i64_max + | I128 -> i128_max + | Usize -> usize_max + | U8 -> u8_max + | U16 -> u16_max + | U32 -> u32_max + | U64 -> u64_max + | U128 -> u128_max + +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 Ok x else Fail Failure + +let scalar_neg (#ty : scalar_ty) (x : scalar ty) : result (scalar ty) = mk_scalar ty (-x) + +let scalar_div (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + if y <> 0 then mk_scalar ty (x / y) else Fail Failure + +/// The remainder operation +let int_rem (x : int) (y : int{y <> 0}) : int = + if x >= 0 then (x % y) else -(x % y) + +(* Checking consistency with Rust *) +let _ = assert_norm(int_rem 1 2 = 1) +let _ = assert_norm(int_rem (-1) 2 = -1) +let _ = assert_norm(int_rem 1 (-2) = 1) +let _ = assert_norm(int_rem (-1) (-2) = -1) + +let scalar_rem (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + if y <> 0 then mk_scalar ty (int_rem x y) else Fail Failure + +let scalar_add (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x + y) + +let scalar_sub (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x - y) + +let scalar_mul (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = + mk_scalar ty (x * y) + +let scalar_xor (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logxor #8 x y + | U16 -> FStar.UInt.logxor #16 x y + | U32 -> FStar.UInt.logxor #32 x y + | U64 -> FStar.UInt.logxor #64 x y + | U128 -> FStar.UInt.logxor #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logxor #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logxor #16 x y + | I32 -> FStar.Int.logxor #32 x y + | I64 -> FStar.Int.logxor #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logxor #128 x y + | Isize -> admit() // TODO + +let scalar_or (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logor #8 x y + | U16 -> FStar.UInt.logor #16 x y + | U32 -> FStar.UInt.logor #32 x y + | U64 -> FStar.UInt.logor #64 x y + | U128 -> FStar.UInt.logor #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logor #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logor #16 x y + | I32 -> FStar.Int.logor #32 x y + | I64 -> FStar.Int.logor #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logor #128 x y + | Isize -> admit() // TODO + +let scalar_and (#ty : scalar_ty) + (x : scalar ty) (y : scalar ty) : scalar ty = + match ty with + | U8 -> FStar.UInt.logand #8 x y + | U16 -> FStar.UInt.logand #16 x y + | U32 -> FStar.UInt.logand #32 x y + | U64 -> FStar.UInt.logand #64 x y + | U128 -> FStar.UInt.logand #128 x y + | Usize -> admit() // TODO + | I8 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 8); + normalize_spec (scalar I8); + FStar.Int.logand #8 x y + | I16 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 16); + normalize_spec (scalar I16); + FStar.Int.logand #16 x y + | I32 -> FStar.Int.logand #32 x y + | I64 -> FStar.Int.logand #64 x y + | I128 -> + // Encoding issues... + normalize_spec (FStar.Int.int_t 128); + normalize_spec (scalar I128); + FStar.Int.logand #128 x y + | Isize -> admit() // TODO + +// Shift left +let scalar_shl (#ty0 #ty1 : scalar_ty) + (x : scalar ty0) (y : scalar ty1) : result (scalar ty0) = + admit() + +// Shift right +let scalar_shr (#ty0 #ty1 : scalar_ty) + (x : scalar ty0) (y : scalar ty1) : result (scalar ty0) = + admit() + +(** Cast an integer from a [src_ty] to a [tgt_ty] *) +// TODO: check the semantics of casts in Rust +let scalar_cast (src_ty : scalar_ty) (tgt_ty : scalar_ty) (x : scalar src_ty) : result (scalar tgt_ty) = + mk_scalar tgt_ty x + +// This can't fail, but for now we make all casts faillible (easier for the translation) +let scalar_cast_bool (tgt_ty : scalar_ty) (x : bool) : result (scalar tgt_ty) = + mk_scalar tgt_ty (if x then 1 else 0) + +/// The scalar types +type isize : eqtype = scalar Isize +type i8 : eqtype = scalar I8 +type i16 : eqtype = scalar I16 +type i32 : eqtype = scalar I32 +type i64 : eqtype = scalar I64 +type i128 : eqtype = scalar I128 +type usize : eqtype = scalar Usize +type u8 : eqtype = scalar U8 +type u16 : eqtype = scalar U16 +type u32 : eqtype = scalar U32 +type u64 : eqtype = scalar U64 +type u128 : eqtype = scalar U128 + + +let core_isize_min : isize = isize_min +let core_isize_max : isize = isize_max +let core_i8_min : i8 = i8_min +let core_i8_max : i8 = i8_max +let core_i16_min : i16 = i16_min +let core_i16_max : i16 = i16_max +let core_i32_min : i32 = i32_min +let core_i32_max : i32 = i32_max +let core_i64_min : i64 = i64_min +let core_i64_max : i64 = i64_max +let core_i128_min : i128 = i128_min +let core_i128_max : i128 = i128_max + +let core_usize_min : usize = usize_min +let core_usize_max : usize = usize_max +let core_u8_min : u8 = u8_min +let core_u8_max : u8 = u8_max +let core_u16_min : u16 = u16_min +let core_u16_max : u16 = u16_max +let core_u32_min : u32 = u32_min +let core_u32_max : u32 = u32_max +let core_u64_min : u64 = u64_min +let core_u64_max : u64 = u64_max +let core_u128_min : u128 = u128_min +let core_u128_max : u128 = u128_max + +/// Negation +let isize_neg = scalar_neg #Isize +let i8_neg = scalar_neg #I8 +let i16_neg = scalar_neg #I16 +let i32_neg = scalar_neg #I32 +let i64_neg = scalar_neg #I64 +let i128_neg = scalar_neg #I128 + +/// Division +let isize_div = scalar_div #Isize +let i8_div = scalar_div #I8 +let i16_div = scalar_div #I16 +let i32_div = scalar_div #I32 +let i64_div = scalar_div #I64 +let i128_div = scalar_div #I128 +let usize_div = scalar_div #Usize +let u8_div = scalar_div #U8 +let u16_div = scalar_div #U16 +let u32_div = scalar_div #U32 +let u64_div = scalar_div #U64 +let u128_div = scalar_div #U128 + +/// Remainder +let isize_rem = scalar_rem #Isize +let i8_rem = scalar_rem #I8 +let i16_rem = scalar_rem #I16 +let i32_rem = scalar_rem #I32 +let i64_rem = scalar_rem #I64 +let i128_rem = scalar_rem #I128 +let usize_rem = scalar_rem #Usize +let u8_rem = scalar_rem #U8 +let u16_rem = scalar_rem #U16 +let u32_rem = scalar_rem #U32 +let u64_rem = scalar_rem #U64 +let u128_rem = scalar_rem #U128 + +/// Addition +let isize_add = scalar_add #Isize +let i8_add = scalar_add #I8 +let i16_add = scalar_add #I16 +let i32_add = scalar_add #I32 +let i64_add = scalar_add #I64 +let i128_add = scalar_add #I128 +let usize_add = scalar_add #Usize +let u8_add = scalar_add #U8 +let u16_add = scalar_add #U16 +let u32_add = scalar_add #U32 +let u64_add = scalar_add #U64 +let u128_add = scalar_add #U128 + +/// Subtraction +let isize_sub = scalar_sub #Isize +let i8_sub = scalar_sub #I8 +let i16_sub = scalar_sub #I16 +let i32_sub = scalar_sub #I32 +let i64_sub = scalar_sub #I64 +let i128_sub = scalar_sub #I128 +let usize_sub = scalar_sub #Usize +let u8_sub = scalar_sub #U8 +let u16_sub = scalar_sub #U16 +let u32_sub = scalar_sub #U32 +let u64_sub = scalar_sub #U64 +let u128_sub = scalar_sub #U128 + +/// Multiplication +let isize_mul = scalar_mul #Isize +let i8_mul = scalar_mul #I8 +let i16_mul = scalar_mul #I16 +let i32_mul = scalar_mul #I32 +let i64_mul = scalar_mul #I64 +let i128_mul = scalar_mul #I128 +let usize_mul = scalar_mul #Usize +let u8_mul = scalar_mul #U8 +let u16_mul = scalar_mul #U16 +let u32_mul = scalar_mul #U32 +let u64_mul = scalar_mul #U64 +let u128_mul = scalar_mul #U128 + +/// Xor +let u8_xor = scalar_xor #U8 +let u16_xor = scalar_xor #U16 +let u32_xor = scalar_xor #U32 +let u64_xor = scalar_xor #U64 +let u128_xor = scalar_xor #U128 +let usize_xor = scalar_xor #Usize +let i8_xor = scalar_xor #I8 +let i16_xor = scalar_xor #I16 +let i32_xor = scalar_xor #I32 +let i64_xor = scalar_xor #I64 +let i128_xor = scalar_xor #I128 +let isize_xor = scalar_xor #Isize + +/// Or +let u8_or = scalar_or #U8 +let u16_or = scalar_or #U16 +let u32_or = scalar_or #U32 +let u64_or = scalar_or #U64 +let u128_or = scalar_or #U128 +let usize_or = scalar_or #Usize +let i8_or = scalar_or #I8 +let i16_or = scalar_or #I16 +let i32_or = scalar_or #I32 +let i64_or = scalar_or #I64 +let i128_or = scalar_or #I128 +let isize_or = scalar_or #Isize + +/// And +let u8_and = scalar_and #U8 +let u16_and = scalar_and #U16 +let u32_and = scalar_and #U32 +let u64_and = scalar_and #U64 +let u128_and = scalar_and #U128 +let usize_and = scalar_and #Usize +let i8_and = scalar_and #I8 +let i16_and = scalar_and #I16 +let i32_and = scalar_and #I32 +let i64_and = scalar_and #I64 +let i128_and = scalar_and #I128 +let isize_and = scalar_and #Isize + +/// Shift left +let u8_shl #ty = scalar_shl #U8 #ty +let u16_shl #ty = scalar_shl #U16 #ty +let u32_shl #ty = scalar_shl #U32 #ty +let u64_shl #ty = scalar_shl #U64 #ty +let u128_shl #ty = scalar_shl #U128 #ty +let usize_shl #ty = scalar_shl #Usize #ty +let i8_shl #ty = scalar_shl #I8 #ty +let i16_shl #ty = scalar_shl #I16 #ty +let i32_shl #ty = scalar_shl #I32 #ty +let i64_shl #ty = scalar_shl #I64 #ty +let i128_shl #ty = scalar_shl #I128 #ty +let isize_shl #ty = scalar_shl #Isize #ty + +/// Shift right +let u8_shr #ty = scalar_shr #U8 #ty +let u16_shr #ty = scalar_shr #U16 #ty +let u32_shr #ty = scalar_shr #U32 #ty +let u64_shr #ty = scalar_shr #U64 #ty +let u128_shr #ty = scalar_shr #U128 #ty +let usize_shr #ty = scalar_shr #Usize #ty +let i8_shr #ty = scalar_shr #I8 #ty +let i16_shr #ty = scalar_shr #I16 #ty +let i32_shr #ty = scalar_shr #I32 #ty +let i64_shr #ty = scalar_shr #I64 #ty +let i128_shr #ty = scalar_shr #I128 #ty +let isize_shr #ty = scalar_shr #Isize #ty + +(*** core *) + +/// Trait declaration: [core::clone::Clone] +noeq type core_clone_Clone (self : Type0) = { + clone : self → result self +} + +let core_clone_impls_CloneBool_clone (b : bool) : bool = b + +let core_clone_CloneBool : core_clone_Clone bool = { + clone = fun b -> Ok (core_clone_impls_CloneBool_clone b) +} + +let core_clone_impls_CloneUsize_clone (x : usize) : usize = x +let core_clone_impls_CloneU8_clone (x : u8) : u8 = x +let core_clone_impls_CloneU16_clone (x : u16) : u16 = x +let core_clone_impls_CloneU32_clone (x : u32) : u32 = x +let core_clone_impls_CloneU64_clone (x : u64) : u64 = x +let core_clone_impls_CloneU128_clone (x : u128) : u128 = x + +let core_clone_impls_CloneIsize_clone (x : isize) : isize = x +let core_clone_impls_CloneI8_clone (x : i8) : i8 = x +let core_clone_impls_CloneI16_clone (x : i16) : i16 = x +let core_clone_impls_CloneI32_clone (x : i32) : i32 = x +let core_clone_impls_CloneI64_clone (x : i64) : i64 = x +let core_clone_impls_CloneI128_clone (x : i128) : i128 = x + +let core_clone_CloneUsize : core_clone_Clone usize = { + clone = fun x -> Ok (core_clone_impls_CloneUsize_clone x) +} + +let core_clone_CloneU8 : core_clone_Clone u8 = { + clone = fun x -> Ok (core_clone_impls_CloneU8_clone x) +} + +let core_clone_CloneU16 : core_clone_Clone u16 = { + clone = fun x -> Ok (core_clone_impls_CloneU16_clone x) +} + +let core_clone_CloneU32 : core_clone_Clone u32 = { + clone = fun x -> Ok (core_clone_impls_CloneU32_clone x) +} + +let core_clone_CloneU64 : core_clone_Clone u64 = { + clone = fun x -> Ok (core_clone_impls_CloneU64_clone x) +} + +let core_clone_CloneU128 : core_clone_Clone u128 = { + clone = fun x -> Ok (core_clone_impls_CloneU128_clone x) +} + +let core_clone_CloneIsize : core_clone_Clone isize = { + clone = fun x -> Ok (core_clone_impls_CloneIsize_clone x) +} + +let core_clone_CloneI8 : core_clone_Clone i8 = { + clone = fun x -> Ok (core_clone_impls_CloneI8_clone x) +} + +let core_clone_CloneI16 : core_clone_Clone i16 = { + clone = fun x -> Ok (core_clone_impls_CloneI16_clone x) +} + +let core_clone_CloneI32 : core_clone_Clone i32 = { + clone = fun x -> Ok (core_clone_impls_CloneI32_clone x) +} + +let core_clone_CloneI64 : core_clone_Clone i64 = { + clone = fun x -> Ok (core_clone_impls_CloneI64_clone x) +} + +let core_clone_CloneI128 : core_clone_Clone i128 = { + clone = fun x -> Ok (core_clone_impls_CloneI128_clone x) +} + +(** [core::option::{core::option::Option<T>}::unwrap] *) +let core_option_Option_unwrap (t : Type0) (x : option t) : result t = + match x with + | None -> Fail Failure + | Some x -> Ok x + +(*** core::ops *) + +// Trait declaration: [core::ops::index::Index] +noeq type core_ops_index_Index (self idx : Type0) = { + output : Type0; + index : self → idx → result output +} + +// Trait declaration: [core::ops::index::IndexMut] +noeq type core_ops_index_IndexMut (self idx : Type0) = { + indexInst : core_ops_index_Index self idx; + index_mut : self → idx → result (indexInst.output & (indexInst.output → result self)); +} + +// Trait declaration [core::ops::deref::Deref] +noeq type core_ops_deref_Deref (self : Type0) = { + target : Type0; + deref : self → result target; +} + +// Trait declaration [core::ops::deref::DerefMut] +noeq type core_ops_deref_DerefMut (self : Type0) = { + derefInst : core_ops_deref_Deref self; + deref_mut : self → result (derefInst.target & (derefInst.target → result self)); +} + +type core_ops_range_Range (a : Type0) = { + start : a; + end_ : a; +} + +(*** [alloc] *) + +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)) = + Ok (x, (fun x -> Ok x)) + +// Trait instance +let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { + target = self; + deref = alloc_boxed_Box_deref self; +} + +// Trait instance +let alloc_boxed_Box_coreopsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { + derefInst = alloc_boxed_Box_coreopsDerefInst self; + deref_mut = alloc_boxed_Box_deref_mut self; +} + +(*** Array *) +type array (a : Type0) (n : usize) = s:list a{length s = n} + +// We tried putting the normalize_term condition as a refinement on the list +// but it didn't work. It works with the requires clause. +let mk_array (a : Type0) (n : usize) + (l : list a) : + Pure (array a n) + (requires (normalize_term(FStar.List.Tot.length l) = n)) + (ensures (fun _ -> True)) = + normalize_term_spec (FStar.List.Tot.length l); + l + +let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = + 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 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 + | Ok v -> + Ok (v, array_update_usize a n x i) + +(*** Slice *) +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 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 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 + | 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) = 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 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))) = + 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) = + admit() + +let array_update_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) (ns : slice a) : result (array a n) = + admit() + +let array_repeat (a : Type0) (n : usize) (x : a) : array a n = + admit() + +let slice_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) : result (slice a) = + admit() + +let slice_update_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) (ns : slice a) : result (slice a) = + admit() + +(*** Vector *) +type alloc_vec_Vec (a : Type0) = v:list a{length v <= usize_max} + +let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] == 0); [] +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 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 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 + | 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) : + Pure (result (alloc_vec_Vec a)) + (requires True) + (ensures (fun res -> + match res with + | Fail e -> e == Failure + | 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); + 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 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 + +// Trait declaration: [core::slice::index::SliceIndex] +noeq type core_slice_index_SliceIndex (self t : Type0) = { + sealedInst : core_slice_index_private_slice_index_Sealed self; + output : Type0; + get : self → t → result (option output); + get_mut : self → t → result (option output & (option output -> result t)); + get_unchecked : self → const_raw_ptr t → result (const_raw_ptr output); + get_unchecked_mut : self → mut_raw_ptr t → result (mut_raw_ptr output); + index : self → t → result output; + index_mut : self → t → result (output & (output -> result t)); +} + +// [core::slice::index::[T]::index]: forward function +let core_slice_index_Slice_index + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (s : slice t) (i : idx) : result inst.output = + let* x = inst.get i s in + match x with + | None -> Fail Failure + | 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) : + result (option (slice t)) = + admit () // TODO + +// [core::slice::index::Range::get_mut]: forward function +let core_slice_index_RangeUsize_get_mut (t : Type0) : + core_ops_range_Range usize → slice t → result (option (slice t) & (option (slice t) -> result (slice t))) = + admit () // TODO + +// [core::slice::index::Range::get_unchecked]: forward function +let core_slice_index_RangeUsize_get_unchecked + (t : Type0) : + core_ops_range_Range usize → const_raw_ptr (slice t) → result (const_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::get_unchecked_mut]: forward function +let core_slice_index_RangeUsize_get_unchecked_mut + (t : Type0) : + core_ops_range_Range usize → mut_raw_ptr (slice t) → result (mut_raw_ptr (slice t)) = + // Don't know what the model should be - for now we always fail to make + // sure code which uses it fails + fun _ _ -> Fail Failure + +// [core::slice::index::Range::index]: forward function +let core_slice_index_RangeUsize_index + (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = + admit () // TODO + +// [core::slice::index::Range::index_mut]: forward function +let core_slice_index_RangeUsize_index_mut (t : Type0) : + core_ops_range_Range usize → slice t → result (slice t & (slice t -> result (slice t))) = + admit () // TODO + +// [core::slice::index::[T]::index_mut]: forward function +let core_slice_index_Slice_index_mut + (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : + slice t → idx → result (inst.output & (inst.output -> result (slice t))) = + admit () // + +// [core::array::[T; N]::index]: forward function +let core_array_Array_index + (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) + (a : array t n) (i : idx) : result inst.output = + admit () // TODO + +// [core::array::[T; N]::index_mut]: forward function +let core_array_Array_index_mut + (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) + (a : array t n) (i : idx) : + result (inst.indexInst.output & (inst.indexInst.output -> result (array t n))) = + admit () // TODO + +// Trait implementation: [core::slice::index::private_slice_index::Range] +let core_slice_index_private_slice_index_SealedRangeUsizeInst + : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) = () + +// Trait implementation: [core::slice::index::Range] +let core_slice_index_SliceIndexRangeUsizeSliceTInst (t : Type0) : + core_slice_index_SliceIndex (core_ops_range_Range usize) (slice t) = { + sealedInst = core_slice_index_private_slice_index_SealedRangeUsizeInst; + output = slice t; + get = core_slice_index_RangeUsize_get t; + get_mut = core_slice_index_RangeUsize_get_mut t; + get_unchecked = core_slice_index_RangeUsize_get_unchecked t; + get_unchecked_mut = core_slice_index_RangeUsize_get_unchecked_mut t; + index = core_slice_index_RangeUsize_index t; + index_mut = core_slice_index_RangeUsize_index_mut t; +} + +// Trait implementation: [core::slice::index::[T]] +let core_ops_index_IndexSliceTIInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (slice t) idx = { + output = inst.output; + index = core_slice_index_Slice_index t idx inst; +} + +// Trait implementation: [core::slice::index::[T]] +let core_ops_index_IndexMutSliceTIInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (slice t) idx = { + indexInst = core_ops_index_IndexSliceTIInst t idx inst; + index_mut = core_slice_index_Slice_index_mut t idx inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_ops_index_IndexArrayInst (t idx : Type0) (n : usize) + (inst : core_ops_index_Index (slice t) idx) : + core_ops_index_Index (array t n) idx = { + output = inst.output; + index = core_array_Array_index t idx n inst; +} + +// Trait implementation: [core::array::[T; N]] +let core_ops_index_IndexMutArrayIInst (t idx : Type0) (n : usize) + (inst : core_ops_index_IndexMut (slice t) idx) : + core_ops_index_IndexMut (array t n) idx = { + indexInst = core_ops_index_IndexArrayInst t idx n inst.indexInst; + index_mut = core_array_Array_index_mut t idx n inst; +} + +// [core::slice::index::usize::get]: forward function +let core_slice_index_usize_get + (t : Type0) : usize → slice t → result (option t) = + admit () // TODO + +// [core::slice::index::usize::get_mut]: forward function +let core_slice_index_usize_get_mut (t : Type0) : + usize → slice t → result (option t & (option t -> result (slice t))) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked]: forward function +let core_slice_index_usize_get_unchecked + (t : Type0) : usize → const_raw_ptr (slice t) → result (const_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::get_unchecked_mut]: forward function +let core_slice_index_usize_get_unchecked_mut + (t : Type0) : usize → mut_raw_ptr (slice t) → result (mut_raw_ptr t) = + admit () // TODO + +// [core::slice::index::usize::index]: forward function +let core_slice_index_usize_index (t : Type0) : usize → slice t → result t = + admit () // TODO + +// [core::slice::index::usize::index_mut]: forward function +let core_slice_index_usize_index_mut (t : Type0) : + usize → slice t → result (t & (t -> result (slice t))) = + admit () // TODO + +// Trait implementation: [core::slice::index::private_slice_index::usize] +let core_slice_index_private_slice_index_SealedUsizeInst + : core_slice_index_private_slice_index_Sealed usize = () + +// Trait implementation: [core::slice::index::usize] +let core_slice_index_SliceIndexUsizeSliceTInst (t : Type0) : + core_slice_index_SliceIndex usize (slice t) = { + sealedInst = core_slice_index_private_slice_index_SealedUsizeInst; + output = t; + get = core_slice_index_usize_get t; + get_mut = core_slice_index_usize_get_mut t; + get_unchecked = core_slice_index_usize_get_unchecked t; + get_unchecked_mut = core_slice_index_usize_get_unchecked_mut t; + index = core_slice_index_usize_index t; + index_mut = core_slice_index_usize_index_mut t; +} + +// [alloc::vec::Vec::index]: forward function +let alloc_vec_Vec_index (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : result inst.output = + admit () // TODO + +// [alloc::vec::Vec::index_mut]: forward function +let alloc_vec_Vec_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) + (self : alloc_vec_Vec t) (i : idx) : + result (inst.output & (inst.output -> result (alloc_vec_Vec t))) = + admit () // TODO + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_Index (alloc_vec_Vec t) idx = { + output = inst.output; + index = alloc_vec_Vec_index t idx inst; +} + +// Trait implementation: [alloc::vec::Vec] +let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) + (inst : core_slice_index_SliceIndex idx (slice t)) : + core_ops_index_IndexMut (alloc_vec_Vec t) idx = { + indexInst = alloc_vec_Vec_coreopsindexIndexInst t idx inst; + index_mut = alloc_vec_Vec_index_mut t idx inst; +} + +(*** Theorems *) + +let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == + alloc_vec_Vec_index_usize v i) + [SMTPat (alloc_vec_Vec_index a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] + = + admit() + +let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : + Lemma ( + alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == + alloc_vec_Vec_index_mut_usize v i) + [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] + = + admit() diff --git a/tests/fstar/rename_attribute/RenameAttribute.Clauses.Template.fst b/tests/fstar/rename_attribute/RenameAttribute.Clauses.Template.fst new file mode 100644 index 00000000..d2229a71 --- /dev/null +++ b/tests/fstar/rename_attribute/RenameAttribute.Clauses.Template.fst @@ -0,0 +1,18 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [rename_attribute]: templates for the decreases clauses *) +module RenameAttribute.Clauses.Template +open Primitives +open RenameAttribute.Types + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [rename_attribute::factorial]: decreases clause + Source: 'tests/src/rename_attribute.rs', lines 56:0-56:27 *) +unfold let factfn_decreases (n : u64) : nat = admit () + +(** [rename_attribute::sum]: decreases clause + Source: 'tests/src/rename_attribute.rs', lines 67:4-75:1 *) +unfold +let no_borrows_sum_loop_decreases (max : u32) (i : u32) (s : u32) : nat = + admit () + diff --git a/tests/fstar/rename_attribute/RenameAttribute.Clauses.fst b/tests/fstar/rename_attribute/RenameAttribute.Clauses.fst new file mode 100644 index 00000000..3bf948d4 --- /dev/null +++ b/tests/fstar/rename_attribute/RenameAttribute.Clauses.fst @@ -0,0 +1,16 @@ +(** [rename_attribute]: the decreases clauses *) +module RenameAttribute.Clauses +open Primitives +open RenameAttribute.Types + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [rename_attribute::factorial]: decreases clause + Source: 'tests/src/rename_attribute.rs', lines 55:0-55:27 *) +unfold let factfn_decreases (n : u64) : nat = n + +(** [rename_attribute::sum]: decreases clause + Source: 'tests/src/rename_attribute.rs', lines 64:0-64:27 *) +unfold let no_borrows_sum_loop_decreases (max : u32) (i : u32) (s : u32) : nat = + if max >= i then max - i else 0 + diff --git a/tests/fstar/rename_attribute/RenameAttribute.Funs.fst b/tests/fstar/rename_attribute/RenameAttribute.Funs.fst new file mode 100644 index 00000000..d0b4838f --- /dev/null +++ b/tests/fstar/rename_attribute/RenameAttribute.Funs.fst @@ -0,0 +1,67 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [rename_attribute]: function definitions *) +module RenameAttribute.Funs +open Primitives +include RenameAttribute.Types +include RenameAttribute.Clauses + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** [rename_attribute::{(rename_attribute::BoolTrait for bool)}::get_bool]: + Source: 'tests/src/rename_attribute.rs', lines 22:4-22:30 *) +let boolTraitBool_getTest (self : bool) : result bool = + Ok self + +(** Trait implementation: [rename_attribute::{(rename_attribute::BoolTrait for bool)}] + Source: 'tests/src/rename_attribute.rs', lines 21:0-21:23 *) +let boolImpl : boolTest_t bool = { getTest = boolTraitBool_getTest; } + +(** [rename_attribute::BoolTrait::ret_true]: + Source: 'tests/src/rename_attribute.rs', lines 15:4-15:30 *) +let boolTrait_retTest + (#self : Type0) (self_clause : boolTest_t self) (self1 : self) : + result bool + = + Ok true + +(** [rename_attribute::test_bool_trait]: + Source: 'tests/src/rename_attribute.rs', lines 28:0-28:42 *) +let boolFn (t : Type0) (x : bool) : result bool = + let* b = boolTraitBool_getTest x in + if b then boolTrait_retTest boolImpl x else Ok false + +(** [rename_attribute::C] + Source: 'tests/src/rename_attribute.rs', lines 50:0-50:12 *) +let const_test_body : result u32 = let* i = u32_add 100 10 in u32_add i 1 +let const_test : u32 = eval_global const_test_body + +(** [rename_attribute::CA] + Source: 'tests/src/rename_attribute.rs', lines 53:0-53:13 *) +let const_aeneas11_body : result u32 = u32_add 10 1 +let const_aeneas11 : u32 = eval_global const_aeneas11_body + +(** [rename_attribute::factorial]: + Source: 'tests/src/rename_attribute.rs', lines 56:0-56:27 *) +let rec factfn (n : u64) : Tot (result u64) (decreases (factfn_decreases n)) = + if n <= 1 + then Ok 1 + else let* i = u64_sub n 1 in let* i1 = factfn i in u64_mul n i1 + +(** [rename_attribute::sum]: loop 0: + Source: 'tests/src/rename_attribute.rs', lines 67:4-75:1 *) +let rec no_borrows_sum_loop + (max : u32) (i : u32) (s : u32) : + Tot (result u32) (decreases (no_borrows_sum_loop_decreases max i s)) + = + if i < max + then + let* s1 = u32_add s i in + let* i1 = u32_add i 1 in + no_borrows_sum_loop max i1 s1 + else u32_mul s 2 + +(** [rename_attribute::sum]: + Source: 'tests/src/rename_attribute.rs', lines 65:0-65:27 *) +let no_borrows_sum (max : u32) : result u32 = + no_borrows_sum_loop max 0 0 + diff --git a/tests/fstar/rename_attribute/RenameAttribute.Types.fst b/tests/fstar/rename_attribute/RenameAttribute.Types.fst new file mode 100644 index 00000000..a64127d5 --- /dev/null +++ b/tests/fstar/rename_attribute/RenameAttribute.Types.fst @@ -0,0 +1,22 @@ +(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) +(** [rename_attribute]: type definitions *) +module RenameAttribute.Types +open Primitives + +#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" + +(** Trait declaration: [rename_attribute::BoolTrait] + Source: 'tests/src/rename_attribute.rs', lines 8:0-8:19 *) +noeq type boolTest_t (self : Type0) = { getTest : self -> result bool; } + +(** [rename_attribute::SimpleEnum] + Source: 'tests/src/rename_attribute.rs', lines 36:0-36:15 *) +type variantsTest_t = +| VariantsTest_Variant1 : variantsTest_t +| VariantsTest_SecondVariant : variantsTest_t +| VariantsTest_ThirdVariant : variantsTest_t + +(** [rename_attribute::Foo] + Source: 'tests/src/rename_attribute.rs', lines 44:0-44:10 *) +type structTest_t = { fieldTest : u32; } + diff --git a/tests/lean/RenameAttribute.lean b/tests/lean/RenameAttribute.lean new file mode 100644 index 00000000..ef42f4c5 --- /dev/null +++ b/tests/lean/RenameAttribute.lean @@ -0,0 +1,92 @@ +-- THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS +-- [rename_attribute] +import Base +open Primitives +set_option linter.dupNamespace false +set_option linter.hashCommand false +set_option linter.unusedVariables false + +namespace rename_attribute + +/- Trait declaration: [rename_attribute::BoolTrait] + Source: 'tests/src/rename_attribute.rs', lines 8:0-8:19 -/ +structure BoolTest (Self : Type) where + getTest : Self → Result Bool + +/- [rename_attribute::{(rename_attribute::BoolTrait for bool)}::get_bool]: + Source: 'tests/src/rename_attribute.rs', lines 22:4-22:30 -/ +def BoolTraitBool.getTest (self : Bool) : Result Bool := + Result.ok self + +/- Trait implementation: [rename_attribute::{(rename_attribute::BoolTrait for bool)}] + Source: 'tests/src/rename_attribute.rs', lines 21:0-21:23 -/ +def BoolImpl : BoolTest Bool := { + getTest := BoolTraitBool.getTest +} + +/- [rename_attribute::BoolTrait::ret_true]: + Source: 'tests/src/rename_attribute.rs', lines 15:4-15:30 -/ +def BoolTrait.retTest + {Self : Type} (self_clause : BoolTest Self) (self : Self) : Result Bool := + Result.ok true + +/- [rename_attribute::test_bool_trait]: + Source: 'tests/src/rename_attribute.rs', lines 28:0-28:42 -/ +def BoolFn (T : Type) (x : Bool) : Result Bool := + do + let b ← BoolTraitBool.getTest x + if b + then BoolTrait.retTest BoolImpl x + else Result.ok false + +/- [rename_attribute::SimpleEnum] + Source: 'tests/src/rename_attribute.rs', lines 36:0-36:15 -/ +inductive VariantsTest := +| Variant1 : VariantsTest +| SecondVariant : VariantsTest +| ThirdVariant : VariantsTest + +/- [rename_attribute::Foo] + Source: 'tests/src/rename_attribute.rs', lines 44:0-44:10 -/ +structure StructTest where + FieldTest : U32 + +/- [rename_attribute::C] + Source: 'tests/src/rename_attribute.rs', lines 50:0-50:12 -/ +def Const_Test_body : Result U32 := do + let i ← 100#u32 + 10#u32 + i + 1#u32 +def Const_Test : U32 := eval_global Const_Test_body + +/- [rename_attribute::CA] + Source: 'tests/src/rename_attribute.rs', lines 53:0-53:13 -/ +def Const_Aeneas11_body : Result U32 := 10#u32 + 1#u32 +def Const_Aeneas11 : U32 := eval_global Const_Aeneas11_body + +/- [rename_attribute::factorial]: + Source: 'tests/src/rename_attribute.rs', lines 56:0-56:27 -/ +divergent def Factfn (n : U64) : Result U64 := + if n <= 1#u64 + then Result.ok 1#u64 + else do + let i ← n - 1#u64 + let i1 ← Factfn i + n * i1 + +/- [rename_attribute::sum]: loop 0: + Source: 'tests/src/rename_attribute.rs', lines 67:4-75:1 -/ +divergent def No_borrows_sum_loop + (max : U32) (i : U32) (s : U32) : Result U32 := + if i < max + then do + let s1 ← s + i + let i1 ← i + 1#u32 + No_borrows_sum_loop max i1 s1 + else s * 2#u32 + +/- [rename_attribute::sum]: + Source: 'tests/src/rename_attribute.rs', lines 65:0-65:27 -/ +def No_borrows_sum (max : U32) : Result U32 := + No_borrows_sum_loop max 0#u32 0#u32 + +end rename_attribute diff --git a/tests/src/arrays.rs b/tests/src/arrays.rs index ddad2ad3..3d5b0e81 100644 --- a/tests/src/arrays.rs +++ b/tests/src/arrays.rs @@ -1,5 +1,5 @@ //@ [coq] aeneas-args=-use-fuel -//@ [fstar] aeneas-args=-decreases-clauses -template-clauses +//@ [fstar] aeneas-args=-decreases-clauses //@ [fstar] aeneas-args=-split-files //! Exercise the translation of arrays, with features supported by Eurydice diff --git a/tests/src/betree/aeneas-test-options b/tests/src/betree/aeneas-test-options index 5a1e4180..c59ada7a 100644 --- a/tests/src/betree/aeneas-test-options +++ b/tests/src/betree/aeneas-test-options @@ -1,4 +1,4 @@ charon-args=--polonius --opaque=betree_utils [!borrow-check] aeneas-args=-backward-no-state-update -test-trans-units -state -split-files [coq] aeneas-args=-use-fuel -[fstar] aeneas-args=-decreases-clauses -template-clauses +[fstar] aeneas-args=-decreases-clauses diff --git a/tests/src/hashmap.rs b/tests/src/hashmap.rs index 9ff448db..12a95d0f 100644 --- a/tests/src/hashmap.rs +++ b/tests/src/hashmap.rs @@ -1,7 +1,7 @@ //@ charon-args=--opaque=utils //@ [!borrow-check] aeneas-args=-state -split-files //@ [coq] aeneas-args=-use-fuel -//@ [fstar] aeneas-args=-decreases-clauses -template-clauses +//@ [fstar] aeneas-args=-decreases-clauses //@ [lean] aeneas-args=-no-gen-lib-entry // ^ the `-no-gen-lib-entry` is because we add a custom import in the Hashmap.lean file: we do not // want to overwrite it. diff --git a/tests/src/loops.rs b/tests/src/loops.rs index afc52ace..8a558b9d 100644 --- a/tests/src/loops.rs +++ b/tests/src/loops.rs @@ -1,5 +1,5 @@ //@ [coq] aeneas-args=-use-fuel -//@ [fstar] aeneas-args=-decreases-clauses -template-clauses +//@ [fstar] aeneas-args=-decreases-clauses //@ [fstar] aeneas-args=-split-files //@ [coq,fstar] subdir=misc use std::vec::Vec; diff --git a/tests/src/mutually-recursive-traits.lean.out b/tests/src/mutually-recursive-traits.lean.out index d4ca5af3..dffbb470 100644 --- a/tests/src/mutually-recursive-traits.lean.out +++ b/tests/src/mutually-recursive-traits.lean.out @@ -14,4 +14,4 @@ Called from Stdlib__List.iter in file "list.ml", line 110, characters 12-15 Called from Aeneas__Translate.extract_definitions in file "Translate.ml", line 836, characters 2-52 Called from Aeneas__Translate.extract_file in file "Translate.ml", line 963, characters 2-36 Called from Aeneas__Translate.translate_crate in file "Translate.ml", line 1512, characters 5-42 -Called from Dune__exe__Main in file "Main.ml", line 314, characters 14-66 +Called from Dune__exe__Main in file "Main.ml", line 317, characters 14-66 diff --git a/tests/src/rename_attribute.rs b/tests/src/rename_attribute.rs new file mode 100644 index 00000000..78765817 --- /dev/null +++ b/tests/src/rename_attribute.rs @@ -0,0 +1,75 @@ +//@ [fstar] aeneas-args=-decreases-clauses -split-files +//@ [coq] aeneas-args=-use-fuel +#![feature(register_tool)] +#![register_tool(charon)] +#![register_tool(aeneas)] + +#[charon::rename("BoolTest")] +pub trait BoolTrait { + // Required method + #[charon::rename("getTest")] + fn get_bool(&self) -> bool; + + // Provided method + #[charon::rename("retTest")] + fn ret_true(&self) -> bool { + true + } +} + +#[charon::rename("BoolImpl")] +impl BoolTrait for bool { + fn get_bool(&self) -> bool { + *self + } +} + +#[charon::rename("BoolFn")] +pub fn test_bool_trait<T>(x: bool) -> bool { + x.get_bool() && x.ret_true() +} + +#[charon::rename("TypeTest")] +type Test = i32; + +#[charon::rename("VariantsTest")] +enum SimpleEnum { + #[charon::rename("Variant1")] + FirstVariant, + SecondVariant, + ThirdVariant, +} + +#[charon::rename("StructTest")] +struct Foo { + #[charon::rename("FieldTest")] + field1: u32, +} + +#[charon::rename("Const_Test")] +const C: u32 = 100 + 10 + 1; + +#[aeneas::rename("Const_Aeneas11")] +const CA: u32 = 10 + 1; + +#[charon::rename("Factfn")] +fn factorial(n: u64) -> u64 { + if n <= 1 { + 1 + } else { + return n * factorial(n - 1); + } +} + +#[charon::rename("No_borrows_sum")] +pub fn sum(max: u32) -> u32 { + let mut i = 0; + let mut s = 0; + while i < max { + s += i; + i += 1; + } + + s *= 2; + s +} diff --git a/tests/src/traits.rs b/tests/src/traits.rs index fd50db8c..36389cdf 100644 --- a/tests/src/traits.rs +++ b/tests/src/traits.rs @@ -1,4 +1,4 @@ -//@ [fstar] aeneas-args=-decreases-clauses -template-clauses +//@ [fstar] aeneas-args=-decreases-clauses pub trait BoolTrait { // Required method fn get_bool(&self) -> bool; |