summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorSon Ho2023-12-22 23:04:31 +0100
committerSon Ho2023-12-22 23:04:31 +0100
commit9a8e43df626400aacdfcb9d2cf2eec38d71d2d73 (patch)
tree2df260fb8340c64348f046c32cbb1c712a508341 /compiler
parentd9ace7d5f1968f26b586fb712c725b2ce51086f8 (diff)
Fix minor issues
Diffstat (limited to '')
-rw-r--r--compiler/ExtractBase.ml81
-rw-r--r--compiler/PureUtils.ml2
-rw-r--r--compiler/SymbolicToPure.ml57
3 files changed, 103 insertions, 37 deletions
diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml
index 0af7a9b4..db887539 100644
--- a/compiler/ExtractBase.ml
+++ b/compiler/ExtractBase.ml
@@ -1051,33 +1051,60 @@ let assumed_variants () : (assumed_ty * VariantId.id * string) list =
let assumed_llbc_functions () :
(A.assumed_fun_id * T.RegionGroupId.id option * string) list =
let rg0 = Some T.RegionGroupId.zero in
- match !backend with
- | FStar | Coq | HOL4 ->
- [
- (ArrayIndexShared, None, "array_index_usize");
- (ArrayIndexMut, None, "array_index_usize");
- (ArrayIndexMut, rg0, "array_update_usize");
- (ArrayToSliceShared, None, "array_to_slice");
- (ArrayToSliceMut, None, "array_to_slice");
- (ArrayToSliceMut, rg0, "array_from_slice");
- (ArrayRepeat, None, "array_repeat");
- (SliceIndexShared, None, "slice_index_usize");
- (SliceIndexMut, None, "slice_index_usize");
- (SliceIndexMut, rg0, "slice_update_usize");
- ]
- | Lean ->
- [
- (ArrayIndexShared, None, "Array.index_usize");
- (ArrayIndexMut, None, "Array.index_usize");
- (ArrayIndexMut, rg0, "Array.update_usize");
- (ArrayToSliceShared, None, "Array.to_slice");
- (ArrayToSliceMut, None, "Array.to_slice");
- (ArrayToSliceMut, rg0, "Array.from_slice");
- (ArrayRepeat, None, "Array.repeat");
- (SliceIndexShared, None, "Slice.index_usize");
- (SliceIndexMut, None, "Slice.index_usize");
- (SliceIndexMut, rg0, "Slice.update_usize");
- ]
+ let regular : (A.assumed_fun_id * T.RegionGroupId.id option * string) list =
+ match !backend with
+ | FStar | Coq | HOL4 ->
+ [
+ (ArrayIndexShared, None, "array_index_usize");
+ (ArrayToSliceShared, None, "array_to_slice");
+ (ArrayRepeat, None, "array_repeat");
+ (SliceIndexShared, None, "slice_index_usize");
+ ]
+ | Lean ->
+ [
+ (ArrayIndexShared, None, "Array.index_usize");
+ (ArrayToSliceShared, None, "Array.to_slice");
+ (ArrayRepeat, None, "Array.repeat");
+ (SliceIndexShared, None, "Slice.index_usize");
+ ]
+ in
+ let mut_funs : (A.assumed_fun_id * T.RegionGroupId.id option * string) list =
+ if !Config.return_back_funs then
+ match !backend with
+ | FStar | Coq | HOL4 ->
+ [
+ (ArrayIndexMut, None, "array_index_mut_usize");
+ (ArrayToSliceMut, None, "array_to_slice_mut");
+ (SliceIndexMut, None, "slice_index_mut_usize");
+ ]
+ | Lean ->
+ [
+ (ArrayIndexMut, None, "Array.index_mut_usize");
+ (ArrayToSliceMut, None, "Array.to_slice_mut");
+ (SliceIndexMut, None, "Slice.index_mut_usize");
+ ]
+ else
+ match !backend with
+ | FStar | Coq | HOL4 ->
+ [
+ (ArrayIndexMut, None, "array_index_usize");
+ (ArrayIndexMut, rg0, "array_update_usize");
+ (ArrayToSliceMut, None, "array_to_slice");
+ (ArrayToSliceMut, rg0, "array_from_slice");
+ (SliceIndexMut, None, "slice_index_usize");
+ (SliceIndexMut, rg0, "slice_update_usize");
+ ]
+ | Lean ->
+ [
+ (ArrayIndexMut, None, "Array.index_usize");
+ (ArrayIndexMut, rg0, "Array.update_usize");
+ (ArrayToSliceMut, None, "Array.to_slice");
+ (ArrayToSliceMut, rg0, "Array.from_slice");
+ (SliceIndexMut, None, "Slice.index_usize");
+ (SliceIndexMut, rg0, "Slice.update_usize");
+ ]
+ in
+ regular @ mut_funs
let assumed_pure_functions () : (pure_assumed_fun_id * string) list =
match !backend with
diff --git a/compiler/PureUtils.ml b/compiler/PureUtils.ml
index cc439e64..80bf3c42 100644
--- a/compiler/PureUtils.ml
+++ b/compiler/PureUtils.ml
@@ -731,7 +731,7 @@ let mk_lambda_from_var (var : var) (mp : mplace option) (e : texpression) :
let mk_lambdas_from_vars (vars : var list) (mps : mplace option list)
(e : texpression) : texpression =
let vars = List.combine vars mps in
- List.fold_left (fun e (v, mp) -> mk_lambda_from_var v mp e) e vars
+ List.fold_right (fun (v, mp) e -> mk_lambda_from_var v mp e) vars e
let rec destruct_lambdas (e : texpression) : typed_pattern list * texpression =
match e.e with
diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml
index f0d1ca62..3a50e495 100644
--- a/compiler/SymbolicToPure.ml
+++ b/compiler/SymbolicToPure.ml
@@ -734,11 +734,15 @@ let rec translate_back_ty (type_infos : type_infos)
None
| TTraitType (trait_ref, generics, type_name) ->
assert (generics.regions = []);
- (* Translate the trait ref and the generics as "forward" generics -
- we do not want to filter any type *)
- let trait_ref = translate_fwd_trait_ref type_infos trait_ref in
- let generics = translate_fwd_generic_args type_infos generics in
- Some (TTraitType (trait_ref, generics, type_name))
+ assert (
+ AssociatedTypes.trait_instance_id_is_local_clause trait_ref.trait_id);
+ if inside_mut then
+ (* Translate the trait ref and the generics as "forward" generics -
+ we do not want to filter any type *)
+ let trait_ref = translate_fwd_trait_ref type_infos trait_ref in
+ let generics = translate_fwd_generic_args type_infos generics in
+ Some (TTraitType (trait_ref, generics, type_name))
+ else None
| TArrow _ -> raise (Failure "TODO")
(** Simply calls [translate_back_ty] *)
@@ -1056,7 +1060,21 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed
Upon ending the abstraction for 'a, we need to get back the borrow
the function returned.
*)
- List.filter_map (translate_back_ty_for_gid gid) [ sg.output ]
+ let inputs =
+ List.filter_map (translate_back_ty_for_gid gid) [ sg.output ]
+ in
+ log#ldebug
+ (lazy
+ (let ctx = Print.Contexts.decls_ctx_to_fmt_env decls_ctx in
+ let pctx = PrintPure.decls_ctx_to_fmt_env decls_ctx in
+ let output = Print.Types.ty_to_string ctx sg.output in
+ let inputs =
+ Print.list_to_string (PrintPure.ty_to_string pctx false) inputs
+ in
+ "translate_back_inputs_for_gid:" ^ "\n- gid: "
+ ^ RegionGroupId.to_string gid
+ ^ "\n- output: " ^ output ^ "\n- back inputs: " ^ inputs ^ "\n"));
+ inputs
in
let compute_back_outputs_for_gid (gid : RegionGroupId.id) :
string option list * ty list =
@@ -1080,7 +1098,21 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed
let outputs =
List.map (fun (name, opt_ty) -> (name, Option.get opt_ty)) outputs
in
- List.split outputs
+ let names, outputs = List.split outputs in
+ log#ldebug
+ (lazy
+ (let ctx = Print.Contexts.decls_ctx_to_fmt_env decls_ctx in
+ let pctx = PrintPure.decls_ctx_to_fmt_env decls_ctx in
+ let inputs =
+ Print.list_to_string (Print.Types.ty_to_string ctx) sg.inputs
+ in
+ let outputs =
+ Print.list_to_string (PrintPure.ty_to_string pctx false) outputs
+ in
+ "compute_back_outputs_for_gid:" ^ "\n- gid: "
+ ^ RegionGroupId.to_string gid
+ ^ "\n- inputs: " ^ inputs ^ "\n- back outputs: " ^ outputs ^ "\n"));
+ (names, outputs)
in
let compute_back_info_for_group (rg : T.region_var_group) :
RegionGroupId.id * back_sg_info =
@@ -1201,8 +1233,15 @@ let translate_fun_sig_from_decl_to_decomposed (decls_ctx : C.decls_ctx)
(fun (v : LlbcAst.var) -> v.name)
(LlbcAstUtils.fun_body_get_input_vars body)
in
- translate_fun_sig_to_decomposed decls_ctx fdef.def_id fdef.signature
- input_names
+ let sg =
+ translate_fun_sig_to_decomposed decls_ctx fdef.def_id fdef.signature
+ input_names
+ in
+ log#ldebug
+ (lazy
+ ("translate_fun_sig_from_decl_to_decomposed:" ^ "\n- name: "
+ ^ T.show_name fdef.name ^ "\n- sg:\n" ^ show_decomposed_fun_sig sg ^ "\n"));
+ sg
let mk_output_ty_from_effect_info (effect_info : fun_effect_info) (ty : ty) : ty
=