From 506e9dc3f8f2759769c3293e9cbeba5d6fe79a31 Mon Sep 17 00:00:00 2001
From: Aymeric Fromherz
Date: Mon, 27 May 2024 16:03:36 +0200
Subject: Add markers everywhere, do not use them yet

---
 compiler/InterpreterLoopsJoinCtxs.ml | 33 ++++++++++++++++++++++-----------
 1 file changed, 22 insertions(+), 11 deletions(-)

(limited to 'compiler/InterpreterLoopsJoinCtxs.ml')

diff --git a/compiler/InterpreterLoopsJoinCtxs.ml b/compiler/InterpreterLoopsJoinCtxs.ml
index c67869ac..7ea442db 100644
--- a/compiler/InterpreterLoopsJoinCtxs.ml
+++ b/compiler/InterpreterLoopsJoinCtxs.ml
@@ -39,13 +39,13 @@ let reorder_loans_borrows_in_fresh_abs (span : Meta.span)
     *)
     let get_borrow_id (av : typed_avalue) : BorrowId.id =
       match av.value with
-      | ABorrow (AMutBorrow (bid, _) | ASharedBorrow bid) -> bid
+      | ABorrow (AMutBorrow (_, bid, _) | ASharedBorrow (_, bid)) -> bid
       | _ -> craise __FILE__ __LINE__ span "Unexpected"
     in
     let get_loan_id (av : typed_avalue) : BorrowId.id =
       match av.value with
-      | ALoan (AMutLoan (lid, _)) -> lid
-      | ALoan (ASharedLoan (lids, _, _)) -> BorrowId.Set.min_elt lids
+      | ALoan (AMutLoan (_, lid, _)) -> lid
+      | ALoan (ASharedLoan (_, lids, _, _)) -> BorrowId.Set.min_elt lids
       | _ -> craise __FILE__ __LINE__ span "Unexpected"
     in
     (* We use ordered maps to reorder the borrows and loans *)
@@ -314,11 +314,14 @@ let mk_collapse_ctx_merge_duplicate_funs (span : Meta.span)
      Note that the join matcher doesn't implement match functions for avalues
      (see the comments in {!MakeJoinMatcher}.
   *)
-  let merge_amut_borrows id ty0 child0 _ty1 child1 =
+  let merge_amut_borrows id ty0 pm0 child0 _ty1 pm1 child1 =
     (* Sanity checks *)
     sanity_check __FILE__ __LINE__ (is_aignored child0.value) span;
     sanity_check __FILE__ __LINE__ (is_aignored child1.value) span;
 
+    (* TODO: Handle markers *)
+    sanity_check __FILE__ __LINE__ (pm0 = PNone && pm1 = PNone) span;
+
     (* We need to pick a type for the avalue. The types on the left and on the
        right may use different regions: it doesn't really matter (here, we pick
        the one from the left), because we will merge those regions together
@@ -326,11 +329,11 @@ let mk_collapse_ctx_merge_duplicate_funs (span : Meta.span)
     *)
     let ty = ty0 in
     let child = child0 in
-    let value = ABorrow (AMutBorrow (id, child)) in
+    let value = ABorrow (AMutBorrow (PNone, id, child)) in
     { value; ty }
   in
 
-  let merge_ashared_borrows id ty0 ty1 =
+  let merge_ashared_borrows id ty0 pm0 ty1 pm1 =
     (* Sanity checks *)
     let _ =
       let _, ty0, _ = ty_as_ref ty0 in
@@ -343,23 +346,28 @@ let mk_collapse_ctx_merge_duplicate_funs (span : Meta.span)
         span
     in
 
+    (* TODO: Handle markers *)
+    sanity_check __FILE__ __LINE__ (pm0 = PNone && pm1 = PNone) span;
+
     (* Same remarks as for [merge_amut_borrows] *)
     let ty = ty0 in
-    let value = ABorrow (ASharedBorrow id) in
+    let value = ABorrow (ASharedBorrow (PNone, id)) in
     { value; ty }
   in
 
-  let merge_amut_loans id ty0 child0 _ty1 child1 =
+  let merge_amut_loans id ty0 pm0 child0 _ty1 pm1 child1 =
     (* Sanity checks *)
     sanity_check __FILE__ __LINE__ (is_aignored child0.value) span;
     sanity_check __FILE__ __LINE__ (is_aignored child1.value) span;
+    (* TODO: Handle markers *)
+    sanity_check __FILE__ __LINE__ (pm0 = PNone && pm1 = PNone) span;
     (* Same remarks as for [merge_amut_borrows] *)
     let ty = ty0 in
     let child = child0 in
-    let value = ALoan (AMutLoan (id, child)) in
+    let value = ALoan (AMutLoan (PNone, id, child)) in
     { value; ty }
   in
-  let merge_ashared_loans ids ty0 (sv0 : typed_value) child0 _ty1
+  let merge_ashared_loans ids ty0 pm0 (sv0 : typed_value) child0 _ty1 pm1
       (sv1 : typed_value) child1 =
     (* Sanity checks *)
     sanity_check __FILE__ __LINE__ (is_aignored child0.value) span;
@@ -375,10 +383,13 @@ let mk_collapse_ctx_merge_duplicate_funs (span : Meta.span)
     sanity_check __FILE__ __LINE__
       (not (value_has_loans_or_borrows ctx sv1.value))
       span;
+    (* TODO: Handle markers *)
+    sanity_check __FILE__ __LINE__ (pm0 = PNone && pm1 = PNone) span;
+
     let ty = ty0 in
     let child = child0 in
     let sv = M.match_typed_values ctx ctx sv0 sv1 in
-    let value = ALoan (ASharedLoan (ids, sv, child)) in
+    let value = ALoan (ASharedLoan (PNone, ids, sv, child)) in
     { value; ty }
   in
   {
-- 
cgit v1.3.1


From c236ccfb22e64f56f4398d067582ebd570bf1a0b Mon Sep 17 00:00:00 2001
From: Aymeric Fromherz
Date: Mon, 27 May 2024 16:44:28 +0200
Subject: Add projection markers when joining environments

---
 compiler/InterpreterLoopsJoinCtxs.ml | 59 ++++++++++++++++++++++++++++++++++++
 1 file changed, 59 insertions(+)

(limited to 'compiler/InterpreterLoopsJoinCtxs.ml')

diff --git a/compiler/InterpreterLoopsJoinCtxs.ml b/compiler/InterpreterLoopsJoinCtxs.ml
index 7ea442db..0f61f619 100644
--- a/compiler/InterpreterLoopsJoinCtxs.ml
+++ b/compiler/InterpreterLoopsJoinCtxs.ml
@@ -467,6 +467,65 @@ let join_ctxs (span : Meta.span) (loop_id : LoopId.id) (fixed_ids : ids_sets)
           (* This should have been eliminated *)
           craise __FILE__ __LINE__ span "Unreachable"
     in
+
+    (* Add a projection marker to a typed avalue *)
+    let add_marker_avalue (pm : proj_marker) (av : typed_avalue) : typed_avalue
+        =
+      let obj =
+        object
+          inherit [_] map_typed_avalue as super
+
+          method! visit_borrow_content _ _ =
+            craise __FILE__ __LINE__ span "Unexpected borrow"
+
+          method! visit_loan_content _ _ =
+            craise __FILE__ __LINE__ span "Unexpected loan"
+
+          method! visit_symbolic_value _ sv =
+            (* While ctx0 and ctx1 are different, we assume that the type info context is
+               the same in both. Hence, we can use ctx0's types wlog *)
+            sanity_check __FILE__ __LINE__
+              (not (symbolic_value_has_borrows ctx0 sv))
+              span;
+            sv
+
+          method! visit_aloan_content env lc =
+            match lc with
+            | AMutLoan (pm0, bid, av) ->
+                sanity_check __FILE__ __LINE__ (pm0 = PNone) span;
+                super#visit_aloan_content env (AMutLoan (pm, bid, av))
+            | ASharedLoan (pm0, bids, av, child) ->
+                sanity_check __FILE__ __LINE__ (pm0 = PNone) span;
+                super#visit_aloan_content env
+                  (ASharedLoan (pm, bids, av, child))
+            | _ -> craise __FILE__ __LINE__ span "Unsupported yet"
+
+          method! visit_aborrow_content env bc =
+            match bc with
+            | AMutBorrow (pm0, bid, av) ->
+                sanity_check __FILE__ __LINE__ (pm0 = PNone) span;
+                super#visit_aborrow_content env (AMutBorrow (pm, bid, av))
+            | ASharedBorrow (pm0, bid) ->
+                sanity_check __FILE__ __LINE__ (pm0 = PNone) span;
+                super#visit_aborrow_content env (ASharedBorrow (pm, bid))
+            | _ -> craise __FILE__ __LINE__ span "Unsupported yet"
+        end
+      in
+      obj#visit_typed_avalue () av
+    in
+
+    (* Add projection marker to all abstractions in the left and right environments *)
+    let add_marker (pm : proj_marker) (ee : env_elem) : env_elem =
+      match ee with
+      | EAbs abs ->
+          EAbs
+            { abs with avalues = List.map (add_marker_avalue pm) abs.avalues }
+      | x -> x
+    in
+
+    let env0 = List.map (add_marker PLeft) env0 in
+    let env1 = List.map (add_marker PRight) env1 in
+
     List.iter check_valid env0;
     List.iter check_valid env1;
     (* Concatenate the suffixes and append the abstractions introduced while
-- 
cgit v1.3.1


From 309435d24edb689736da83025eb08a6761b28b8b Mon Sep 17 00:00:00 2001
From: Aymeric Fromherz
Date: Mon, 27 May 2024 17:51:50 +0200
Subject: Split collapse into collapse and reduce, rename accordingly

---
 compiler/InterpreterBorrows.ml         |   1 +
 compiler/InterpreterLoopsFixedPoint.ml |   2 +-
 compiler/InterpreterLoopsJoinCtxs.ml   | 193 +++++++++++++++++++++++++++++++--
 compiler/InterpreterLoopsMatchCtxs.mli |   2 +-
 4 files changed, 185 insertions(+), 13 deletions(-)

(limited to 'compiler/InterpreterLoopsJoinCtxs.ml')

diff --git a/compiler/InterpreterBorrows.ml b/compiler/InterpreterBorrows.ml
index 93238729..94f32b73 100644
--- a/compiler/InterpreterBorrows.ml
+++ b/compiler/InterpreterBorrows.ml
@@ -2291,6 +2291,7 @@ let merge_into_abstraction_aux (span : Meta.span) (abs_kind : abs_kind)
   (* Sanity check: there is no loan/borrows which appears in both abstractions,
      unless we allow to merge duplicates *)
   if merge_funs = None then (
+    (* TODO: In this case, there should be no proj markers *)
     sanity_check __FILE__ __LINE__
       (BorrowId.Set.disjoint borrows0 borrows1)
       span;
diff --git a/compiler/InterpreterLoopsFixedPoint.ml b/compiler/InterpreterLoopsFixedPoint.ml
index 599fabfd..26505902 100644
--- a/compiler/InterpreterLoopsFixedPoint.ml
+++ b/compiler/InterpreterLoopsFixedPoint.ml
@@ -131,7 +131,7 @@ let cleanup_fresh_values_and_abs (config : config) (span : Meta.span)
     We do this in order to enforce some structure in the environments: this
     allows us to find fixed-points. Note that this function needs to be
     called typically after we merge abstractions together (see {!collapse_ctx}
-    for instance).
+    and {!reduce_ctx} for instance).
  *)
 let reorder_loans_borrows_in_fresh_abs (span : Meta.span)
     (old_abs_ids : AbstractionId.Set.t) (ctx : eval_ctx) : eval_ctx =
diff --git a/compiler/InterpreterLoopsJoinCtxs.ml b/compiler/InterpreterLoopsJoinCtxs.ml
index 0f61f619..960edb99 100644
--- a/compiler/InterpreterLoopsJoinCtxs.ml
+++ b/compiler/InterpreterLoopsJoinCtxs.ml
@@ -17,7 +17,7 @@ let log = Logging.loops_join_ctxs_log
     We do this in order to enforce some structure in the environments: this
     allows us to find fixed-points. Note that this function needs to be
     called typically after we merge abstractions together (see {!collapse_ctx}
-    for instance).
+    and {!reduce_ctx} for instance).
  *)
 let reorder_loans_borrows_in_fresh_abs (span : Meta.span)
     (old_abs_ids : AbstractionId.Set.t) (ctx : eval_ctx) : eval_ctx =
@@ -70,7 +70,7 @@ let reorder_loans_borrows_in_fresh_abs (span : Meta.span)
 
   { ctx with env }
 
-(** Collapse an environment.
+(** Reduce an environment.
 
     We do this to simplify an environment, for the purpose of finding a loop
     fixed point.
@@ -129,6 +129,171 @@ let reorder_loans_borrows_in_fresh_abs (span : Meta.span)
     This can happen when merging environments (note that such environments are not well-formed -
     they become well formed again after collapsing).
  *)
+let reduce_ctx (span : Meta.span) (loop_id : LoopId.id)
+    (merge_funs : merge_duplicates_funcs option) (old_ids : ids_sets)
+    (ctx0 : eval_ctx) : eval_ctx =
+  (* Debug *)
+  log#ldebug
+    (lazy
+      ("reduce_ctx:\n\n- fixed_ids:\n" ^ show_ids_sets old_ids ^ "\n\n- ctx0:\n"
+      ^ eval_ctx_to_string ~span:(Some span) ctx0
+      ^ "\n\n"));
+
+  let abs_kind : abs_kind = Loop (loop_id, None, LoopSynthInput) in
+  let can_end = true in
+  let destructure_shared_values = true in
+  let is_fresh_abs_id (id : AbstractionId.id) : bool =
+    not (AbstractionId.Set.mem id old_ids.aids)
+  in
+  let is_fresh_did (id : DummyVarId.id) : bool =
+    not (DummyVarId.Set.mem id old_ids.dids)
+  in
+  (* Convert the dummy values to abstractions (note that when we convert
+     values to abstractions, the resulting abstraction should be destructured) *)
+  (* Note that we preserve the order of the dummy values: we replace them with
+     abstractions in place - this makes matching easier *)
+  let env =
+    List.concat
+      (List.map
+         (fun ee ->
+           match ee with
+           | EAbs _ | EFrame | EBinding (BVar _, _) -> [ ee ]
+           | EBinding (BDummy id, v) ->
+               if is_fresh_did id then
+                 let absl =
+                   convert_value_to_abstractions span abs_kind can_end
+                     destructure_shared_values ctx0 v
+                 in
+                 List.map (fun abs -> EAbs abs) absl
+               else [ ee ])
+         ctx0.env)
+  in
+  let ctx = { ctx0 with env } in
+  log#ldebug
+    (lazy
+      ("reduce_ctx: after converting values to abstractions:\n"
+     ^ show_ids_sets old_ids ^ "\n\n- ctx:\n"
+      ^ eval_ctx_to_string ~span:(Some span) ctx
+      ^ "\n\n"));
+
+  log#ldebug
+    (lazy
+      ("reduce_ctx: after decomposing the shared values in the abstractions:\n"
+     ^ show_ids_sets old_ids ^ "\n\n- ctx:\n"
+      ^ eval_ctx_to_string ~span:(Some span) ctx
+      ^ "\n\n"));
+
+  (* Explore all the *new* abstractions, and compute various maps *)
+  let explore (abs : abs) = is_fresh_abs_id abs.abs_id in
+  let ids_maps =
+    compute_abs_borrows_loans_maps span (merge_funs = None) explore env
+  in
+  let {
+    abs_ids;
+    abs_to_borrows;
+    abs_to_loans = _;
+    abs_to_borrows_loans;
+    borrow_to_abs = _;
+    loan_to_abs;
+    borrow_loan_to_abs;
+  } =
+    ids_maps
+  in
+
+  (* Change the merging behaviour depending on the input parameters *)
+  let abs_to_borrows, loan_to_abs =
+    if merge_funs <> None then (abs_to_borrows_loans, borrow_loan_to_abs)
+    else (abs_to_borrows, loan_to_abs)
+  in
+
+  (* Merge the abstractions together *)
+  let merged_abs : AbstractionId.id UnionFind.elem AbstractionId.Map.t =
+    AbstractionId.Map.of_list
+      (List.map (fun id -> (id, UnionFind.make id)) abs_ids)
+  in
+
+  let ctx = ref ctx in
+
+  (* Merge all the mergeable abs.
+
+     We iterate over the abstractions, then over the borrows in the abstractions.
+     We do this because we want to control the order in which abstractions
+     are merged (the ids are iterated in increasing order). Otherwise, we
+     could simply iterate over all the borrows in [borrow_to_abs]...
+  *)
+  List.iter
+    (fun abs_id0 ->
+      let bids = AbstractionId.Map.find abs_id0 abs_to_borrows in
+      let bids = BorrowId.Set.elements bids in
+      List.iter
+        (fun bid ->
+          match BorrowId.Map.find_opt bid loan_to_abs with
+          | None -> (* Nothing to do *) ()
+          | Some abs_ids1 ->
+              AbstractionId.Set.iter
+                (fun abs_id1 ->
+                  (* We need to merge - unless we have already merged *)
+                  (* First, find the representatives for the two abstractions (the
+                     representative is the abstraction into which we merged) *)
+                  let abs_ref0 =
+                    UnionFind.find (AbstractionId.Map.find abs_id0 merged_abs)
+                  in
+                  let abs_id0 = UnionFind.get abs_ref0 in
+                  let abs_ref1 =
+                    UnionFind.find (AbstractionId.Map.find abs_id1 merged_abs)
+                  in
+                  let abs_id1 = UnionFind.get abs_ref1 in
+                  (* If the two ids are the same, it means the abstractions were already merged *)
+                  if abs_id0 = abs_id1 then ()
+                  else (
+                    (* We actually need to merge the abstractions *)
+
+                    (* Debug *)
+                    log#ldebug
+                      (lazy
+                        ("reduce_ctx: merging abstraction "
+                        ^ AbstractionId.to_string abs_id1
+                        ^ " into "
+                        ^ AbstractionId.to_string abs_id0
+                        ^ ":\n\n"
+                        ^ eval_ctx_to_string ~span:(Some span) !ctx));
+
+                    (* Update the environment - pay attention to the order: we
+                       we merge [abs_id1] *into* [abs_id0] *)
+                    let nctx, abs_id =
+                      merge_into_abstraction span abs_kind can_end merge_funs
+                        !ctx abs_id1 abs_id0
+                    in
+                    ctx := nctx;
+
+                    (* Update the union find *)
+                    let abs_ref_merged = UnionFind.union abs_ref0 abs_ref1 in
+                    UnionFind.set abs_ref_merged abs_id))
+                abs_ids1)
+        bids)
+    abs_ids;
+
+  log#ldebug
+    (lazy
+      ("reduce_ctx:\n\n- fixed_ids:\n" ^ show_ids_sets old_ids
+     ^ "\n\n- after reduce:\n"
+      ^ eval_ctx_to_string ~span:(Some span) !ctx
+      ^ "\n\n"));
+
+  (* Reorder the loans and borrows in the fresh abstractions *)
+  let ctx = reorder_loans_borrows_in_fresh_abs span old_ids.aids !ctx in
+
+  log#ldebug
+    (lazy
+      ("reduce_ctx:\n\n- fixed_ids:\n" ^ show_ids_sets old_ids
+     ^ "\n\n- after reduce and reorder borrows/loans:\n"
+      ^ eval_ctx_to_string ~span:(Some span) ctx
+      ^ "\n\n"));
+
+  (* Return the new context *)
+  ctx
+
+(* TODO Adapt and comment *)
 let collapse_ctx (span : Meta.span) (loop_id : LoopId.id)
     (merge_funs : merge_duplicates_funcs option) (old_ids : ids_sets)
     (ctx0 : eval_ctx) : eval_ctx =
@@ -523,9 +688,10 @@ let join_ctxs (span : Meta.span) (loop_id : LoopId.id) (fixed_ids : ids_sets)
       | x -> x
     in
 
-    let env0 = List.map (add_marker PLeft) env0 in
-    let env1 = List.map (add_marker PRight) env1 in
-
+    (* TODO: Readd this
+       let env0 = List.map (add_marker PLeft) env0 in
+       let env1 = List.map (add_marker PRight) env1 in
+    *)
     List.iter check_valid env0;
     List.iter check_valid env1;
     (* Concatenate the suffixes and append the abstractions introduced while
@@ -776,11 +942,11 @@ let loop_join_origin_with_continue_ctxs (config : config) (span : Meta.span)
         ("loop_join_origin_with_continue_ctxs:join_one: after destructure:\n"
         ^ eval_ctx_to_string ~span:(Some span) ctx));
 
-    (* Collapse the context we want to add to the join *)
-    let ctx = collapse_ctx span loop_id None fixed_ids ctx in
+    (* Reduce the context we want to add to the join *)
+    let ctx = reduce_ctx span loop_id None fixed_ids ctx in
     log#ldebug
       (lazy
-        ("loop_join_origin_with_continue_ctxs:join_one: after collapse:\n"
+        ("loop_join_origin_with_continue_ctxs:join_one: after reduce:\n"
         ^ eval_ctx_to_string ~span:(Some span) ctx));
 
     (* Refresh the fresh abstractions *)
@@ -793,15 +959,20 @@ let loop_join_origin_with_continue_ctxs (config : config) (span : Meta.span)
         ("loop_join_origin_with_continue_ctxs:join_one: after join:\n"
         ^ eval_ctx_to_string ~span:(Some span) ctx1));
 
-    (* Collapse again - the join might have introduce abstractions we want
-       to merge with the others (note that those abstractions may actually
-       lead to borrows/loans duplications) *)
+    (* Collapse to eliminate the markers *)
     joined_ctx := collapse_ctx_with_merge span loop_id fixed_ids !joined_ctx;
     log#ldebug
       (lazy
         ("loop_join_origin_with_continue_ctxs:join_one: after join-collapse:\n"
         ^ eval_ctx_to_string ~span:(Some span) !joined_ctx));
 
+    (* Reduce again to reach fixed point *)
+    joined_ctx := reduce_ctx span loop_id None fixed_ids !joined_ctx;
+    log#ldebug
+      (lazy
+        ("loop_join_origin_with_continue_ctxs:join_one: after last reduce:\n"
+        ^ eval_ctx_to_string ~span:(Some span) !joined_ctx));
+
     (* Sanity check *)
     if !Config.sanity_checks then Invariants.check_invariants span !joined_ctx;
     (* Return *)
diff --git a/compiler/InterpreterLoopsMatchCtxs.mli b/compiler/InterpreterLoopsMatchCtxs.mli
index ab585220..7d214cb6 100644
--- a/compiler/InterpreterLoopsMatchCtxs.mli
+++ b/compiler/InterpreterLoopsMatchCtxs.mli
@@ -188,7 +188,7 @@ val prepare_match_ctx_with_target :
 
    We want to introduce an abstraction [abs@2], which has the same shape as [abs@fp]
    above (the fixed-point abstraction), and which is actually the identity. If we do so,
-   we get an environment which is actually also a fixed point (we can collapse
+   we get an environment which is actually also a fixed point (we can reduce 
    the dummy variables and [abs@1] to actually retrieve the fixed point we
    computed, and we use the fact that those values and abstractions can't be
    *directly* manipulated unless we end this newly introduced [abs@2], which we
-- 
cgit v1.3.1


From 3c1e6d37a2b40b880b04b2d2aac95d6f06822327 Mon Sep 17 00:00:00 2001
From: Aymeric Fromherz
Date: Mon, 27 May 2024 17:56:10 +0200
Subject: Simplify reduce_ctx

---
 compiler/InterpreterLoopsJoinCtxs.ml | 27 ++++++---------------------
 1 file changed, 6 insertions(+), 21 deletions(-)

(limited to 'compiler/InterpreterLoopsJoinCtxs.ml')

diff --git a/compiler/InterpreterLoopsJoinCtxs.ml b/compiler/InterpreterLoopsJoinCtxs.ml
index 960edb99..5b9022b2 100644
--- a/compiler/InterpreterLoopsJoinCtxs.ml
+++ b/compiler/InterpreterLoopsJoinCtxs.ml
@@ -122,15 +122,8 @@ let reorder_loans_borrows_in_fresh_abs (span : Meta.span)
       i -> s@7 : u32
       abs@4 { MB l0, ML l4 }
     ]}
-
-    [merge_funs]: those are used to merge loans or borrows which appear in both
-    abstractions (rem.: here we mean that, for instance, both abstractions
-    contain a shared loan with id l0).
-    This can happen when merging environments (note that such environments are not well-formed -
-    they become well formed again after collapsing).
  *)
-let reduce_ctx (span : Meta.span) (loop_id : LoopId.id)
-    (merge_funs : merge_duplicates_funcs option) (old_ids : ids_sets)
+let reduce_ctx (span : Meta.span) (loop_id : LoopId.id) (old_ids : ids_sets)
     (ctx0 : eval_ctx) : eval_ctx =
   (* Debug *)
   log#ldebug
@@ -185,9 +178,7 @@ let reduce_ctx (span : Meta.span) (loop_id : LoopId.id)
 
   (* Explore all the *new* abstractions, and compute various maps *)
   let explore (abs : abs) = is_fresh_abs_id abs.abs_id in
-  let ids_maps =
-    compute_abs_borrows_loans_maps span (merge_funs = None) explore env
-  in
+  let ids_maps = compute_abs_borrows_loans_maps span true explore env in
   let {
     abs_ids;
     abs_to_borrows;
@@ -200,12 +191,6 @@ let reduce_ctx (span : Meta.span) (loop_id : LoopId.id)
     ids_maps
   in
 
-  (* Change the merging behaviour depending on the input parameters *)
-  let abs_to_borrows, loan_to_abs =
-    if merge_funs <> None then (abs_to_borrows_loans, borrow_loan_to_abs)
-    else (abs_to_borrows, loan_to_abs)
-  in
-
   (* Merge the abstractions together *)
   let merged_abs : AbstractionId.id UnionFind.elem AbstractionId.Map.t =
     AbstractionId.Map.of_list
@@ -261,8 +246,8 @@ let reduce_ctx (span : Meta.span) (loop_id : LoopId.id)
                     (* Update the environment - pay attention to the order: we
                        we merge [abs_id1] *into* [abs_id0] *)
                     let nctx, abs_id =
-                      merge_into_abstraction span abs_kind can_end merge_funs
-                        !ctx abs_id1 abs_id0
+                      merge_into_abstraction span abs_kind can_end None !ctx
+                        abs_id1 abs_id0
                     in
                     ctx := nctx;
 
@@ -943,7 +928,7 @@ let loop_join_origin_with_continue_ctxs (config : config) (span : Meta.span)
         ^ eval_ctx_to_string ~span:(Some span) ctx));
 
     (* Reduce the context we want to add to the join *)
-    let ctx = reduce_ctx span loop_id None fixed_ids ctx in
+    let ctx = reduce_ctx span loop_id fixed_ids ctx in
     log#ldebug
       (lazy
         ("loop_join_origin_with_continue_ctxs:join_one: after reduce:\n"
@@ -967,7 +952,7 @@ let loop_join_origin_with_continue_ctxs (config : config) (span : Meta.span)
         ^ eval_ctx_to_string ~span:(Some span) !joined_ctx));
 
     (* Reduce again to reach fixed point *)
-    joined_ctx := reduce_ctx span loop_id None fixed_ids !joined_ctx;
+    joined_ctx := reduce_ctx span loop_id fixed_ids !joined_ctx;
     log#ldebug
       (lazy
         ("loop_join_origin_with_continue_ctxs:join_one: after last reduce:\n"
-- 
cgit v1.3.1


From 4b14d42b2c2eff3104f0bc342f0bc5ff7cecd5e9 Mon Sep 17 00:00:00 2001
From: Aymeric Fromherz
Date: Mon, 27 May 2024 17:57:50 +0200
Subject: Simplify collapse_ctx

---
 compiler/InterpreterLoopsJoinCtxs.ml | 11 +++++------
 1 file changed, 5 insertions(+), 6 deletions(-)

(limited to 'compiler/InterpreterLoopsJoinCtxs.ml')

diff --git a/compiler/InterpreterLoopsJoinCtxs.ml b/compiler/InterpreterLoopsJoinCtxs.ml
index 5b9022b2..81e5004f 100644
--- a/compiler/InterpreterLoopsJoinCtxs.ml
+++ b/compiler/InterpreterLoopsJoinCtxs.ml
@@ -280,7 +280,7 @@ let reduce_ctx (span : Meta.span) (loop_id : LoopId.id) (old_ids : ids_sets)
 
 (* TODO Adapt and comment *)
 let collapse_ctx (span : Meta.span) (loop_id : LoopId.id)
-    (merge_funs : merge_duplicates_funcs option) (old_ids : ids_sets)
+    (merge_funs : merge_duplicates_funcs) (old_ids : ids_sets)
     (ctx0 : eval_ctx) : eval_ctx =
   (* Debug *)
   log#ldebug
@@ -337,7 +337,7 @@ let collapse_ctx (span : Meta.span) (loop_id : LoopId.id)
   (* Explore all the *new* abstractions, and compute various maps *)
   let explore (abs : abs) = is_fresh_abs_id abs.abs_id in
   let ids_maps =
-    compute_abs_borrows_loans_maps span (merge_funs = None) explore env
+    compute_abs_borrows_loans_maps span false explore env
   in
   let {
     abs_ids;
@@ -353,8 +353,7 @@ let collapse_ctx (span : Meta.span) (loop_id : LoopId.id)
 
   (* Change the merging behaviour depending on the input parameters *)
   let abs_to_borrows, loan_to_abs =
-    if merge_funs <> None then (abs_to_borrows_loans, borrow_loan_to_abs)
-    else (abs_to_borrows, loan_to_abs)
+ (abs_to_borrows_loans, borrow_loan_to_abs)
   in
 
   (* Merge the abstractions together *)
@@ -412,7 +411,7 @@ let collapse_ctx (span : Meta.span) (loop_id : LoopId.id)
                     (* Update the environment - pay attention to the order: we
                        we merge [abs_id1] *into* [abs_id0] *)
                     let nctx, abs_id =
-                      merge_into_abstraction span abs_kind can_end merge_funs
+                      merge_into_abstraction span abs_kind can_end (Some merge_funs)
                         !ctx abs_id1 abs_id0
                     in
                     ctx := nctx;
@@ -566,7 +565,7 @@ let merge_into_abstraction (span : Meta.span) (loop_id : LoopId.id)
 let collapse_ctx_with_merge (span : Meta.span) (loop_id : LoopId.id)
     (old_ids : ids_sets) (ctx : eval_ctx) : eval_ctx =
   let merge_funs = mk_collapse_ctx_merge_duplicate_funs span loop_id ctx in
-  try collapse_ctx span loop_id (Some merge_funs) old_ids ctx
+  try collapse_ctx span loop_id merge_funs old_ids ctx
   with ValueMatchFailure _ -> craise __FILE__ __LINE__ span "Unexpected"
 
 let join_ctxs (span : Meta.span) (loop_id : LoopId.id) (fixed_ids : ids_sets)
-- 
cgit v1.3.1


From 445c566f11dcc9ba8c69a154902a12a18ba3a2aa Mon Sep 17 00:00:00 2001
From: Aymeric Fromherz
Date: Tue, 28 May 2024 14:28:40 +0200
Subject: Add type and set/map for marker and borrow id

---
 compiler/InterpreterLoopsCore.ml          | 14 ++++++++++++++
 compiler/InterpreterLoopsJoinCtxs.ml      | 14 ++++++--------
 compiler/InterpreterLoopsMatchCtxs.ml     |  2 +-
 tests/test_runner/aeneas_test_runner.opam |  2 +-
 4 files changed, 22 insertions(+), 10 deletions(-)

(limited to 'compiler/InterpreterLoopsJoinCtxs.ml')

diff --git a/compiler/InterpreterLoopsCore.ml b/compiler/InterpreterLoopsCore.ml
index 675dc544..9aee361d 100644
--- a/compiler/InterpreterLoopsCore.ml
+++ b/compiler/InterpreterLoopsCore.ml
@@ -26,6 +26,20 @@ type ctx_or_update = (eval_ctx, updt_env_kind) result
 (** Union Find *)
 module UF = UnionFind.Make (UnionFind.StoreMap)
 
+type marker_borrow_id = proj_marker * BorrowId.id [@@deriving show, ord]
+
+module MarkerBorrowIdOrd = struct
+  type t = marker_borrow_id
+
+  let compare = compare_marker_borrow_id
+  let to_string = show_marker_borrow_id
+  let pp_t = pp_marker_borrow_id
+  let show_t = show_marker_borrow_id
+end
+
+module MarkerBorrowIdSet = Collections.MakeSet (MarkerBorrowIdOrd)
+module MarkerBorrowIdMap = Collections.MakeMap (MarkerBorrowIdOrd)
+
 (** A small utility -
 
     Rem.: some environments may be ill-formed (they may contain several times
diff --git a/compiler/InterpreterLoopsJoinCtxs.ml b/compiler/InterpreterLoopsJoinCtxs.ml
index 81e5004f..5c3ce66d 100644
--- a/compiler/InterpreterLoopsJoinCtxs.ml
+++ b/compiler/InterpreterLoopsJoinCtxs.ml
@@ -280,8 +280,8 @@ let reduce_ctx (span : Meta.span) (loop_id : LoopId.id) (old_ids : ids_sets)
 
 (* TODO Adapt and comment *)
 let collapse_ctx (span : Meta.span) (loop_id : LoopId.id)
-    (merge_funs : merge_duplicates_funcs) (old_ids : ids_sets)
-    (ctx0 : eval_ctx) : eval_ctx =
+    (merge_funs : merge_duplicates_funcs) (old_ids : ids_sets) (ctx0 : eval_ctx)
+    : eval_ctx =
   (* Debug *)
   log#ldebug
     (lazy
@@ -336,9 +336,7 @@ let collapse_ctx (span : Meta.span) (loop_id : LoopId.id)
 
   (* Explore all the *new* abstractions, and compute various maps *)
   let explore (abs : abs) = is_fresh_abs_id abs.abs_id in
-  let ids_maps =
-    compute_abs_borrows_loans_maps span false explore env
-  in
+  let ids_maps = compute_abs_borrows_loans_maps span false explore env in
   let {
     abs_ids;
     abs_to_borrows;
@@ -353,7 +351,7 @@ let collapse_ctx (span : Meta.span) (loop_id : LoopId.id)
 
   (* Change the merging behaviour depending on the input parameters *)
   let abs_to_borrows, loan_to_abs =
- (abs_to_borrows_loans, borrow_loan_to_abs)
+    (abs_to_borrows_loans, borrow_loan_to_abs)
   in
 
   (* Merge the abstractions together *)
@@ -411,8 +409,8 @@ let collapse_ctx (span : Meta.span) (loop_id : LoopId.id)
                     (* Update the environment - pay attention to the order: we
                        we merge [abs_id1] *into* [abs_id0] *)
                     let nctx, abs_id =
-                      merge_into_abstraction span abs_kind can_end (Some merge_funs)
-                        !ctx abs_id1 abs_id0
+                      merge_into_abstraction span abs_kind can_end
+                        (Some merge_funs) !ctx abs_id1 abs_id0
                     in
                     ctx := nctx;
 
diff --git a/compiler/InterpreterLoopsMatchCtxs.ml b/compiler/InterpreterLoopsMatchCtxs.ml
index 729b248f..9fe4638d 100644
--- a/compiler/InterpreterLoopsMatchCtxs.ml
+++ b/compiler/InterpreterLoopsMatchCtxs.ml
@@ -32,7 +32,7 @@ let compute_abs_borrows_loans_maps (span : Meta.span) (no_duplicates : bool)
 
   let module R (Id0 : Identifiers.Id) (Id1 : Identifiers.Id) = struct
     (*
-       [check_singleton_sets]: check that the mapping maps to a singletong.
+       [check_singleton_sets]: check that the mapping maps to a singleton.
        [check_not_already_registered]: check if the mapping was not already registered.
     *)
     let register_mapping (check_singleton_sets : bool)
diff --git a/tests/test_runner/aeneas_test_runner.opam b/tests/test_runner/aeneas_test_runner.opam
index b57cc9f6..1539c521 100644
--- a/tests/test_runner/aeneas_test_runner.opam
+++ b/tests/test_runner/aeneas_test_runner.opam
@@ -7,7 +7,7 @@ homepage: "https://github.com/AeneasVerif/aeneas"
 bug-reports: "https://github.com/AeneasVerif/aeneas/issues"
 depends: [
   "ocaml"
-  "dune" {>= "3.12"}
+  "dune" {>= "3.7"}
   "odoc" {with-doc}
 ]
 build: [
-- 
cgit v1.3.1


From 96d803a7aefe27d4401a336c426161d387987b63 Mon Sep 17 00:00:00 2001
From: Aymeric Fromherz
Date: Tue, 28 May 2024 14:51:25 +0200
Subject: Compute marker information for borrow/loan maps

---
 compiler/InterpreterLoopsCore.ml      | 25 +++++++---
 compiler/InterpreterLoopsJoinCtxs.ml  |  8 ++--
 compiler/InterpreterLoopsMatchCtxs.ml | 90 +++++++++++++++++++----------------
 3 files changed, 73 insertions(+), 50 deletions(-)

(limited to 'compiler/InterpreterLoopsJoinCtxs.ml')

diff --git a/compiler/InterpreterLoopsCore.ml b/compiler/InterpreterLoopsCore.ml
index 9aee361d..23e05e06 100644
--- a/compiler/InterpreterLoopsCore.ml
+++ b/compiler/InterpreterLoopsCore.ml
@@ -40,6 +40,19 @@ end
 module MarkerBorrowIdSet = Collections.MakeSet (MarkerBorrowIdOrd)
 module MarkerBorrowIdMap = Collections.MakeMap (MarkerBorrowIdOrd)
 
+module MarkerBorrowId : sig
+  type t
+
+  module Set : Collections.Set with type elt = t
+  module Map : Collections.Map with type key = t
+end
+with type t = marker_borrow_id = struct
+  type t = marker_borrow_id
+
+  module Set = MarkerBorrowIdSet
+  module Map = MarkerBorrowIdMap
+end
+
 (** A small utility -
 
     Rem.: some environments may be ill-formed (they may contain several times
@@ -49,12 +62,12 @@ module MarkerBorrowIdMap = Collections.MakeMap (MarkerBorrowIdOrd)
 *)
 type abs_borrows_loans_maps = {
   abs_ids : AbstractionId.id list;
-  abs_to_borrows : BorrowId.Set.t AbstractionId.Map.t;
-  abs_to_loans : BorrowId.Set.t AbstractionId.Map.t;
-  abs_to_borrows_loans : BorrowId.Set.t AbstractionId.Map.t;
-  borrow_to_abs : AbstractionId.Set.t BorrowId.Map.t;
-  loan_to_abs : AbstractionId.Set.t BorrowId.Map.t;
-  borrow_loan_to_abs : AbstractionId.Set.t BorrowId.Map.t;
+  abs_to_borrows : MarkerBorrowId.Set.t AbstractionId.Map.t;
+  abs_to_loans : MarkerBorrowId.Set.t AbstractionId.Map.t;
+  abs_to_borrows_loans : MarkerBorrowId.Set.t AbstractionId.Map.t;
+  borrow_to_abs : AbstractionId.Set.t MarkerBorrowId.Map.t;
+  loan_to_abs : AbstractionId.Set.t MarkerBorrowId.Map.t;
+  borrow_loan_to_abs : AbstractionId.Set.t MarkerBorrowId.Map.t;
 }
 
 (** See {!module:Aeneas.InterpreterLoopsMatchCtxs.MakeMatcher} and [Matcher].
diff --git a/compiler/InterpreterLoopsJoinCtxs.ml b/compiler/InterpreterLoopsJoinCtxs.ml
index 5c3ce66d..7f80e496 100644
--- a/compiler/InterpreterLoopsJoinCtxs.ml
+++ b/compiler/InterpreterLoopsJoinCtxs.ml
@@ -209,10 +209,10 @@ let reduce_ctx (span : Meta.span) (loop_id : LoopId.id) (old_ids : ids_sets)
   List.iter
     (fun abs_id0 ->
       let bids = AbstractionId.Map.find abs_id0 abs_to_borrows in
-      let bids = BorrowId.Set.elements bids in
+      let bids = MarkerBorrowId.Set.elements bids in
       List.iter
         (fun bid ->
-          match BorrowId.Map.find_opt bid loan_to_abs with
+          match MarkerBorrowId.Map.find_opt bid loan_to_abs with
           | None -> (* Nothing to do *) ()
           | Some abs_ids1 ->
               AbstractionId.Set.iter
@@ -372,10 +372,10 @@ let collapse_ctx (span : Meta.span) (loop_id : LoopId.id)
   List.iter
     (fun abs_id0 ->
       let bids = AbstractionId.Map.find abs_id0 abs_to_borrows in
-      let bids = BorrowId.Set.elements bids in
+      let bids = MarkerBorrowId.Set.elements bids in
       List.iter
         (fun bid ->
-          match BorrowId.Map.find_opt bid loan_to_abs with
+          match MarkerBorrowId.Map.find_opt bid loan_to_abs with
           | None -> (* Nothing to do *) ()
           | Some abs_ids1 ->
               AbstractionId.Set.iter
diff --git a/compiler/InterpreterLoopsMatchCtxs.ml b/compiler/InterpreterLoopsMatchCtxs.ml
index 9fe4638d..be6f3ade 100644
--- a/compiler/InterpreterLoopsMatchCtxs.ml
+++ b/compiler/InterpreterLoopsMatchCtxs.ml
@@ -26,59 +26,59 @@ let compute_abs_borrows_loans_maps (span : Meta.span) (no_duplicates : bool)
   let abs_to_borrows = ref AbstractionId.Map.empty in
   let abs_to_loans = ref AbstractionId.Map.empty in
   let abs_to_borrows_loans = ref AbstractionId.Map.empty in
-  let borrow_to_abs = ref BorrowId.Map.empty in
-  let loan_to_abs = ref BorrowId.Map.empty in
-  let borrow_loan_to_abs = ref BorrowId.Map.empty in
+  let borrow_to_abs = ref MarkerBorrowId.Map.empty in
+  let loan_to_abs = ref MarkerBorrowId.Map.empty in
+  let borrow_loan_to_abs = ref MarkerBorrowId.Map.empty in
 
-  let module R (Id0 : Identifiers.Id) (Id1 : Identifiers.Id) = struct
+  let module R (M : Collections.Map) (S : Collections.Set) = struct
     (*
        [check_singleton_sets]: check that the mapping maps to a singleton.
        [check_not_already_registered]: check if the mapping was not already registered.
     *)
     let register_mapping (check_singleton_sets : bool)
-        (check_not_already_registered : bool) (map : Id1.Set.t Id0.Map.t ref)
-        (id0 : Id0.id) (id1 : Id1.id) : unit =
+        (check_not_already_registered : bool) (map : S.t M.t ref) (id0 : M.key)
+        (id1 : S.elt) : unit =
       (* Sanity check *)
       (if check_singleton_sets || check_not_already_registered then
-         match Id0.Map.find_opt id0 !map with
+         match M.find_opt id0 !map with
          | None -> ()
          | Some set ->
              sanity_check __FILE__ __LINE__
-               ((not check_not_already_registered) || not (Id1.Set.mem id1 set))
+               ((not check_not_already_registered) || not (S.mem id1 set))
                span);
       (* Update the mapping *)
       map :=
-        Id0.Map.update id0
+        M.update id0
           (fun ids ->
             match ids with
-            | None -> Some (Id1.Set.singleton id1)
+            | None -> Some (S.singleton id1)
             | Some ids ->
                 (* Sanity check *)
                 sanity_check __FILE__ __LINE__ (not check_singleton_sets) span;
                 sanity_check __FILE__ __LINE__
-                  ((not check_not_already_registered)
-                  || not (Id1.Set.mem id1 ids))
+                  ((not check_not_already_registered) || not (S.mem id1 ids))
                   span;
                 (* Update *)
-                Some (Id1.Set.add id1 ids))
+                Some (S.add id1 ids))
           !map
   end in
-  let module RAbsBorrow = R (AbstractionId) (BorrowId) in
-  let module RBorrowAbs = R (BorrowId) (AbstractionId) in
-  let register_borrow_id abs_id bid =
-    RAbsBorrow.register_mapping false no_duplicates abs_to_borrows abs_id bid;
-    RAbsBorrow.register_mapping false false abs_to_borrows_loans abs_id bid;
-    RBorrowAbs.register_mapping no_duplicates no_duplicates borrow_to_abs bid
-      abs_id;
-    RBorrowAbs.register_mapping false false borrow_loan_to_abs bid abs_id
+  let module RAbsBorrow = R (AbstractionId.Map) (MarkerBorrowId.Set) in
+  let module RBorrowAbs = R (MarkerBorrowId.Map) (AbstractionId.Set) in
+  let register_borrow_id abs_id pm bid =
+    RAbsBorrow.register_mapping false no_duplicates abs_to_borrows abs_id
+      (pm, bid);
+    RAbsBorrow.register_mapping false false abs_to_borrows_loans abs_id (pm, bid);
+    RBorrowAbs.register_mapping no_duplicates no_duplicates borrow_to_abs
+      (pm, bid) abs_id;
+    RBorrowAbs.register_mapping false false borrow_loan_to_abs (pm, bid) abs_id
   in
 
-  let register_loan_id abs_id bid =
-    RAbsBorrow.register_mapping false no_duplicates abs_to_loans abs_id bid;
-    RAbsBorrow.register_mapping false false abs_to_borrows_loans abs_id bid;
-    RBorrowAbs.register_mapping no_duplicates no_duplicates loan_to_abs bid
-      abs_id;
-    RBorrowAbs.register_mapping false false borrow_loan_to_abs bid abs_id
+  let register_loan_id abs_id pm bid =
+    RAbsBorrow.register_mapping false no_duplicates abs_to_loans abs_id (pm, bid);
+    RAbsBorrow.register_mapping false false abs_to_borrows_loans abs_id (pm, bid);
+    RBorrowAbs.register_mapping no_duplicates no_duplicates loan_to_abs
+      (pm, bid) abs_id;
+    RBorrowAbs.register_mapping false false borrow_loan_to_abs (pm, bid) abs_id
   in
 
   let explore_abs =
@@ -86,35 +86,43 @@ let compute_abs_borrows_loans_maps (span : Meta.span) (no_duplicates : bool)
       inherit [_] iter_typed_avalue as super
 
       (** Make sure we don't register the ignored ids *)
-      method! visit_aloan_content abs_id lc =
+      method! visit_aloan_content (abs_id, pm) lc =
         match lc with
-        | AMutLoan _ | ASharedLoan _ ->
+        | AMutLoan (pm, _, _) | ASharedLoan (pm, _, _, _) ->
             (* Process those normally *)
-            super#visit_aloan_content abs_id lc
+            super#visit_aloan_content (abs_id, pm) lc
         | AIgnoredMutLoan (_, child)
         | AEndedIgnoredMutLoan { child; given_back = _; given_back_span = _ }
         | AIgnoredSharedLoan child ->
+            sanity_check __FILE__ __LINE__ (pm = PNone) span;
             (* Ignore the id of the loan, if there is *)
-            self#visit_typed_avalue abs_id child
+            self#visit_typed_avalue (abs_id, pm) child
         | AEndedMutLoan _ | AEndedSharedLoan _ ->
             craise __FILE__ __LINE__ span "Unreachable"
 
       (** Make sure we don't register the ignored ids *)
-      method! visit_aborrow_content abs_id bc =
+      method! visit_aborrow_content (abs_id, pm) bc =
         match bc with
-        | AMutBorrow _ | ASharedBorrow _ | AProjSharedBorrow _ ->
+        | AMutBorrow (pm, _, _) | ASharedBorrow (pm, _) ->
+            (* Add the current marker, and process them recursively *)
+            super#visit_aborrow_content (abs_id, pm) bc
+        | AProjSharedBorrow _ ->
+            sanity_check __FILE__ __LINE__ (pm = PNone) span;
             (* Process those normally *)
-            super#visit_aborrow_content abs_id bc
+            super#visit_aborrow_content (abs_id, pm) bc
         | AIgnoredMutBorrow (_, child)
         | AEndedIgnoredMutBorrow { child; given_back = _; given_back_span = _ }
           ->
+            sanity_check __FILE__ __LINE__ (pm = PNone) span;
             (* Ignore the id of the borrow, if there is *)
-            self#visit_typed_avalue abs_id child
+            self#visit_typed_avalue (abs_id, pm) child
         | AEndedMutBorrow _ | AEndedSharedBorrow ->
             craise __FILE__ __LINE__ span "Unreachable"
 
-      method! visit_borrow_id abs_id bid = register_borrow_id abs_id bid
-      method! visit_loan_id abs_id lid = register_loan_id abs_id lid
+      method! visit_borrow_id (abs_id, pm) bid =
+        register_borrow_id abs_id pm bid
+
+      method! visit_loan_id (abs_id, pm) lid = register_loan_id abs_id pm lid
     end
   in
 
@@ -123,11 +131,13 @@ let compute_abs_borrows_loans_maps (span : Meta.span) (no_duplicates : bool)
       let abs_id = abs.abs_id in
       if explore abs then (
         abs_to_borrows :=
-          AbstractionId.Map.add abs_id BorrowId.Set.empty !abs_to_borrows;
+          AbstractionId.Map.add abs_id MarkerBorrowId.Set.empty !abs_to_borrows;
         abs_to_loans :=
-          AbstractionId.Map.add abs_id BorrowId.Set.empty !abs_to_loans;
+          AbstractionId.Map.add abs_id MarkerBorrowId.Set.empty !abs_to_loans;
         abs_ids := abs.abs_id :: !abs_ids;
-        List.iter (explore_abs#visit_typed_avalue abs.abs_id) abs.avalues)
+        List.iter
+          (explore_abs#visit_typed_avalue (abs.abs_id, PNone))
+          abs.avalues)
       else ())
     env;
 
-- 
cgit v1.3.1


From ce8614be6bd96c51756bf5922b5dfd4c59650dd4 Mon Sep 17 00:00:00 2001
From: Aymeric Fromherz
Date: Thu, 30 May 2024 12:33:05 +0200
Subject: Implement two phases of loops join + collapse

---
 compiler/InterpreterBorrows.ml                     | 531 +++++++++++++--------
 compiler/InterpreterLoopsCore.ml                   |  27 --
 compiler/InterpreterLoopsJoinCtxs.ml               | 346 ++++++++------
 compiler/Values.ml                                 |  31 ++
 tests/coq/arrays/Arrays.v                          |  68 +--
 tests/coq/demo/Demo.v                              |  27 +-
 tests/coq/hashmap/Hashmap_Funs.v                   | 198 +-------
 tests/coq/hashmap_on_disk/HashmapMain_Funs.v       | 205 +-------
 tests/coq/misc/Loops.v                             | 446 +----------------
 tests/fstar/arrays/Arrays.Clauses.Template.fst     |  19 -
 tests/fstar/arrays/Arrays.Funs.fst                 |  54 +--
 tests/fstar/demo/Demo.fst                          |  24 +-
 tests/fstar/hashmap/Hashmap.Clauses.Template.fst   |  56 ---
 tests/fstar/hashmap/Hashmap.Funs.fst               | 154 +-----
 .../HashmapMain.Clauses.Template.fst               |  57 ---
 tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst   | 164 +------
 tests/fstar/misc/Loops.Clauses.Template.fst        | 105 ----
 tests/fstar/misc/Loops.Funs.fst                    | 364 +-------------
 tests/lean/Arrays.lean                             |  53 +-
 tests/lean/Demo/Demo.lean                          |  25 +-
 tests/lean/Hashmap/Funs.lean                       | 148 +-----
 tests/lean/HashmapMain/Funs.lean                   | 154 +-----
 tests/lean/Loops.lean                              | 375 +--------------
 23 files changed, 660 insertions(+), 2971 deletions(-)

(limited to 'compiler/InterpreterLoopsJoinCtxs.ml')

diff --git a/compiler/InterpreterBorrows.ml b/compiler/InterpreterBorrows.ml
index 94f32b73..e9be07aa 100644
--- a/compiler/InterpreterBorrows.ml
+++ b/compiler/InterpreterBorrows.ml
@@ -1993,7 +1993,9 @@ let convert_value_to_abstractions (span : Meta.span) (abs_kind : abs_kind)
   (* Return *)
   List.rev !absl
 
-type borrow_or_loan_id = BorrowId of borrow_id | LoanId of loan_id
+type marker_borrow_or_loan_id =
+  | BorrowId of proj_marker * borrow_id
+  | LoanId of proj_marker * loan_id
 
 type g_loan_content_with_ty =
   (ety * loan_content, rty * aloan_content) concrete_or_abs
@@ -2002,12 +2004,12 @@ type g_borrow_content_with_ty =
   (ety * borrow_content, rty * aborrow_content) concrete_or_abs
 
 type merge_abstraction_info = {
-  loans : loan_id_set;
-  borrows : borrow_id_set;
-  borrows_loans : borrow_or_loan_id list;
+  loans : MarkerBorrowId.Set.t;
+  borrows : MarkerBorrowId.Set.t;
+  borrows_loans : marker_borrow_or_loan_id list;
       (** We use a list to preserve the order in which the borrows were found *)
-  loan_to_content : g_loan_content_with_ty BorrowId.Map.t;
-  borrow_to_content : g_borrow_content_with_ty BorrowId.Map.t;
+  loan_to_content : g_loan_content_with_ty MarkerBorrowId.Map.t;
+  borrow_to_content : g_borrow_content_with_ty MarkerBorrowId.Map.t;
 }
 
 (** Small utility to help merging abstractions.
@@ -2023,46 +2025,57 @@ type merge_abstraction_info = {
       contain shared loans).
  *)
 let compute_merge_abstraction_info (span : Meta.span) (ctx : eval_ctx)
-    (abs : abs) : merge_abstraction_info =
-  let loans : loan_id_set ref = ref BorrowId.Set.empty in
-  let borrows : borrow_id_set ref = ref BorrowId.Set.empty in
-  let borrows_loans : borrow_or_loan_id list ref = ref [] in
-  let loan_to_content : g_loan_content_with_ty BorrowId.Map.t ref =
-    ref BorrowId.Map.empty
+    (avalues : typed_avalue list) : merge_abstraction_info =
+  let loans : MarkerBorrowId.Set.t ref = ref MarkerBorrowId.Set.empty in
+  let borrows : MarkerBorrowId.Set.t ref = ref MarkerBorrowId.Set.empty in
+  let borrows_loans : marker_borrow_or_loan_id list ref = ref [] in
+  let loan_to_content : g_loan_content_with_ty MarkerBorrowId.Map.t ref =
+    ref MarkerBorrowId.Map.empty
   in
-  let borrow_to_content : g_borrow_content_with_ty BorrowId.Map.t ref =
-    ref BorrowId.Map.empty
+  let borrow_to_content : g_borrow_content_with_ty MarkerBorrowId.Map.t ref =
+    ref MarkerBorrowId.Map.empty
   in
 
-  let push_loans ids (lc : g_loan_content_with_ty) : unit =
-    sanity_check __FILE__ __LINE__ (BorrowId.Set.disjoint !loans ids) span;
-    loans := BorrowId.Set.union !loans ids;
-    BorrowId.Set.iter
-      (fun id ->
+  let push_loans pm ids (lc : g_loan_content_with_ty) : unit =
+    let pm_ids =
+      BorrowId.Set.to_seq ids
+      |> Seq.map (fun x -> (pm, x))
+      |> MarkerBorrowId.Set.of_seq
+    in
+    sanity_check __FILE__ __LINE__
+      (MarkerBorrowId.Set.disjoint !loans pm_ids)
+      span;
+    loans := MarkerBorrowId.Set.union !loans pm_ids;
+    MarkerBorrowId.Set.iter
+      (fun (pm, id) ->
         sanity_check __FILE__ __LINE__
-          (not (BorrowId.Map.mem id !loan_to_content))
+          (not (MarkerBorrowId.Map.mem (pm, id) !loan_to_content))
           span;
-        loan_to_content := BorrowId.Map.add id lc !loan_to_content;
-        borrows_loans := LoanId id :: !borrows_loans)
-      ids
+        loan_to_content := MarkerBorrowId.Map.add (pm, id) lc !loan_to_content;
+        borrows_loans := LoanId (pm, id) :: !borrows_loans)
+      pm_ids
   in
-  let push_loan id (lc : g_loan_content_with_ty) : unit =
-    sanity_check __FILE__ __LINE__ (not (BorrowId.Set.mem id !loans)) span;
-    loans := BorrowId.Set.add id !loans;
+  let push_loan pm id (lc : g_loan_content_with_ty) : unit =
+    sanity_check __FILE__ __LINE__
+      (not (MarkerBorrowId.Set.mem (pm, id) !loans))
+      span;
+    loans := MarkerBorrowId.Set.add (pm, id) !loans;
     sanity_check __FILE__ __LINE__
-      (not (BorrowId.Map.mem id !loan_to_content))
+      (not (MarkerBorrowId.Map.mem (pm, id) !loan_to_content))
       span;
-    loan_to_content := BorrowId.Map.add id lc !loan_to_content;
-    borrows_loans := LoanId id :: !borrows_loans
+    loan_to_content := MarkerBorrowId.Map.add (pm, id) lc !loan_to_content;
+    borrows_loans := LoanId (pm, id) :: !borrows_loans
   in
-  let push_borrow id (bc : g_borrow_content_with_ty) : unit =
-    sanity_check __FILE__ __LINE__ (not (BorrowId.Set.mem id !borrows)) span;
-    borrows := BorrowId.Set.add id !borrows;
+  let push_borrow pm id (bc : g_borrow_content_with_ty) : unit =
+    sanity_check __FILE__ __LINE__
+      (not (MarkerBorrowId.Set.mem (pm, id) !borrows))
+      span;
+    borrows := MarkerBorrowId.Set.add (pm, id) !borrows;
     sanity_check __FILE__ __LINE__
-      (not (BorrowId.Map.mem id !borrow_to_content))
+      (not (MarkerBorrowId.Map.mem (pm, id) !borrow_to_content))
       span;
-    borrow_to_content := BorrowId.Map.add id bc !borrow_to_content;
-    borrows_loans := BorrowId id :: !borrows_loans
+    borrow_to_content := MarkerBorrowId.Map.add (pm, id) bc !borrow_to_content;
+    borrows_loans := BorrowId (pm, id) :: !borrows_loans
   in
 
   let iter_avalues =
@@ -2086,7 +2099,7 @@ let compute_merge_abstraction_info (span : Meta.span) (ctx : eval_ctx)
           | Abstract _ -> craise __FILE__ __LINE__ span "Unreachable"
         in
         (match lc with
-        | VSharedLoan (bids, _) -> push_loans bids (Concrete (ty, lc))
+        | VSharedLoan (bids, _) -> push_loans PNone bids (Concrete (ty, lc))
         | VMutLoan _ -> craise __FILE__ __LINE__ span "Unreachable");
         (* Continue *)
         super#visit_loan_content env lc
@@ -2104,14 +2117,8 @@ let compute_merge_abstraction_info (span : Meta.span) (ctx : eval_ctx)
         in
         (* Register the loans *)
         (match lc with
-        | ASharedLoan (pm, bids, _, _) ->
-            (* TODO: We should keep track of the marker here *)
-            sanity_check __FILE__ __LINE__ (pm = PNone) span;
-            push_loans bids (Abstract (ty, lc))
-        | AMutLoan (pm, bid, _) ->
-            (* TODO: We should keep track of the marker here *)
-            sanity_check __FILE__ __LINE__ (pm = PNone) span;
-            push_loan bid (Abstract (ty, lc))
+        | ASharedLoan (pm, bids, _, _) -> push_loans pm bids (Abstract (ty, lc))
+        | AMutLoan (pm, bid, _) -> push_loan pm bid (Abstract (ty, lc))
         | AEndedMutLoan _ | AEndedSharedLoan _ | AIgnoredMutLoan _
         | AEndedIgnoredMutLoan _ | AIgnoredSharedLoan _ ->
             (* The abstraction has been destructured, so those shouldn't appear *)
@@ -2127,18 +2134,12 @@ let compute_merge_abstraction_info (span : Meta.span) (ctx : eval_ctx)
         in
         (* Explore the borrow content *)
         (match bc with
-        | AMutBorrow (pm, bid, _) ->
-            (* TODO: We should keep track of the marker here *)
-            sanity_check __FILE__ __LINE__ (pm = PNone) span;
-            push_borrow bid (Abstract (ty, bc))
-        | ASharedBorrow (pm, bid) ->
-            (* TODO: We should keep track of the marker here *)
-            sanity_check __FILE__ __LINE__ (pm = PNone) span;
-            push_borrow bid (Abstract (ty, bc))
+        | AMutBorrow (pm, bid, _) | ASharedBorrow (pm, bid) ->
+            push_borrow pm bid (Abstract (ty, bc))
         | AProjSharedBorrow asb ->
             let register asb =
               match asb with
-              | AsbBorrow bid -> push_borrow bid (Abstract (ty, bc))
+              | AsbBorrow bid -> push_borrow PNone bid (Abstract (ty, bc))
               | AsbProjReborrows _ ->
                   (* Can only happen if the symbolic value (potentially) contains
                      borrows - i.e., we have nested borrows *)
@@ -2159,7 +2160,7 @@ let compute_merge_abstraction_info (span : Meta.span) (ctx : eval_ctx)
     end
   in
 
-  List.iter (iter_avalues#visit_typed_avalue None) abs.avalues;
+  List.iter (iter_avalues#visit_typed_avalue None) avalues;
 
   {
     loans = !loans;
@@ -2275,7 +2276,7 @@ let merge_into_abstraction_aux (span : Meta.span) (abs_kind : abs_kind)
     loan_to_content = loan_to_content0;
     borrow_to_content = borrow_to_content0;
   } =
-    compute_merge_abstraction_info span ctx abs0
+    compute_merge_abstraction_info span ctx abs0.avalues
   in
 
   let {
@@ -2285,17 +2286,28 @@ let merge_into_abstraction_aux (span : Meta.span) (abs_kind : abs_kind)
     loan_to_content = loan_to_content1;
     borrow_to_content = borrow_to_content1;
   } =
-    compute_merge_abstraction_info span ctx abs1
+    compute_merge_abstraction_info span ctx abs1.avalues
   in
 
   (* Sanity check: there is no loan/borrows which appears in both abstractions,
      unless we allow to merge duplicates *)
   if merge_funs = None then (
-    (* TODO: In this case, there should be no proj markers *)
     sanity_check __FILE__ __LINE__
-      (BorrowId.Set.disjoint borrows0 borrows1)
+      (List.for_all
+         (function LoanId (pm, _) | BorrowId (pm, _) -> pm = PNone)
+         borrows_loans0)
+      span;
+    sanity_check __FILE__ __LINE__
+      (List.for_all
+         (function LoanId (pm, _) | BorrowId (pm, _) -> pm = PNone)
+         borrows_loans1)
       span;
-    sanity_check __FILE__ __LINE__ (BorrowId.Set.disjoint loans0 loans1) span);
+    sanity_check __FILE__ __LINE__
+      (MarkerBorrowId.Set.disjoint borrows0 borrows1)
+      span;
+    sanity_check __FILE__ __LINE__
+      (MarkerBorrowId.Set.disjoint loans0 loans1)
+      span);
 
   (* Merge.
      There are several cases:
@@ -2315,8 +2327,8 @@ let merge_into_abstraction_aux (span : Meta.span) (abs_kind : abs_kind)
      We ignore this case for now: we check that whenever we merge two shared loans,
      then their sets of ids are equal.
   *)
-  let merged_borrows = ref BorrowId.Set.empty in
-  let merged_loans = ref BorrowId.Set.empty in
+  let merged_borrows = ref MarkerBorrowId.Set.empty in
+  let merged_loans = ref MarkerBorrowId.Set.empty in
   let avalues = ref [] in
   let push_avalue av =
     log#ldebug
@@ -2329,142 +2341,43 @@ let merge_into_abstraction_aux (span : Meta.span) (abs_kind : abs_kind)
     match av with None -> () | Some av -> push_avalue av
   in
 
-  let intersect =
-    BorrowId.Set.union
-      (BorrowId.Set.inter loans0 borrows1)
-      (BorrowId.Set.inter loans1 borrows0)
-  in
-  let filter_bids (bids : BorrowId.Set.t) : BorrowId.Set.t =
-    let bids = BorrowId.Set.diff bids intersect in
-    sanity_check __FILE__ __LINE__ (not (BorrowId.Set.is_empty bids)) span;
-    bids
+  (* Phase 1 of the merge: We want to simplify all loan/borrow pairs. *)
+
+  (* There is an asymetry in the merge: We only simplify a loan/borrow pair if the loan is in
+     the abstraction on the left *)
+  let intersect = MarkerBorrowId.Set.inter loans0 borrows1 in
+
+  (* This function is called when handling shared loans, where the projection marker is global to a set of borrow ids.
+     Tracking this requires some set transformations *)
+  let filter_bids (pm : proj_marker) (bids : BorrowId.Set.t) : BorrowId.Set.t =
+    let bids =
+      BorrowId.Set.to_seq bids
+      |> Seq.map (fun x -> (pm, x))
+      |> MarkerBorrowId.Set.of_seq
+    in
+    let bids = MarkerBorrowId.Set.diff bids intersect in
+    sanity_check __FILE__ __LINE__ (not (MarkerBorrowId.Set.is_empty bids)) span;
+    MarkerBorrowId.Set.to_seq bids |> Seq.map snd |> BorrowId.Set.of_seq
   in
-  let filter_bid (bid : BorrowId.id) : BorrowId.id option =
-    if BorrowId.Set.mem bid intersect then None else Some bid
+  let filter_bid (bid : marker_borrow_id) : marker_borrow_id option =
+    if MarkerBorrowId.Set.mem bid intersect then None else Some bid
   in
 
-  let borrow_is_merged id = BorrowId.Set.mem id !merged_borrows in
+  let borrow_is_merged id = MarkerBorrowId.Set.mem id !merged_borrows in
   let set_borrow_as_merged id =
-    merged_borrows := BorrowId.Set.add id !merged_borrows
+    merged_borrows := MarkerBorrowId.Set.add id !merged_borrows
   in
-  let loan_is_merged id = BorrowId.Set.mem id !merged_loans in
+  let loan_is_merged id = MarkerBorrowId.Set.mem id !merged_loans in
   let set_loan_as_merged id =
-    merged_loans := BorrowId.Set.add id !merged_loans
+    merged_loans := MarkerBorrowId.Set.add id !merged_loans
   in
-  let set_loans_as_merged ids = BorrowId.Set.iter set_loan_as_merged ids in
-
-  (* Some utility functions *)
-  (* Merge two aborrow contents - note that those contents must have the same id *)
-  let merge_aborrow_contents (ty0 : rty) (bc0 : aborrow_content) (ty1 : rty)
-      (bc1 : aborrow_content) : typed_avalue =
-    match (bc0, bc1) with
-    | AMutBorrow (pm0, id0, child0), AMutBorrow (pm1, id1, child1) ->
-        (* Sanity-check of the precondition *)
-        sanity_check __FILE__ __LINE__ (id0 = id1) span;
-        (* TODO: We should handle the markers here *)
-        sanity_check __FILE__ __LINE__ (pm0 = PNone && pm1 = PNone) span;
-        (Option.get merge_funs).merge_amut_borrows id0 ty0 pm0 child0 ty1 pm1
-          child1
-    | ASharedBorrow (pm0, id0), ASharedBorrow (pm1, id1) ->
-        (* Sanity-check of the precondition *)
-        sanity_check __FILE__ __LINE__ (id0 = id1) span;
-        (* TODO: We should handle the markers here *)
-        sanity_check __FILE__ __LINE__ (pm0 = PNone && pm1 = PNone) span;
-        (Option.get merge_funs).merge_ashared_borrows id0 ty0 pm0 ty1 pm1
-    | AProjSharedBorrow _, AProjSharedBorrow _ ->
-        (* Unreachable because requires nested borrows *)
-        craise __FILE__ __LINE__ span "Unreachable"
-    | _ ->
-        (* Unreachable because those cases are ignored (ended/ignored borrows)
-           or inconsistent *)
-        craise __FILE__ __LINE__ span "Unreachable"
-  in
-
-  let merge_g_borrow_contents (bc0 : g_borrow_content_with_ty)
-      (bc1 : g_borrow_content_with_ty) : typed_avalue =
-    match (bc0, bc1) with
-    | Concrete _, Concrete _ ->
-        (* This can happen only in case of nested borrows *)
-        craise __FILE__ __LINE__ span "Unreachable"
-    | Abstract (ty0, bc0), Abstract (ty1, bc1) ->
-        merge_aborrow_contents ty0 bc0 ty1 bc1
-    | Concrete _, Abstract _ | Abstract _, Concrete _ ->
-        (* TODO: is it really unreachable? *)
-        craise __FILE__ __LINE__ span "Unreachable"
-  in
-
-  let merge_aloan_contents (ty0 : rty) (lc0 : aloan_content) (ty1 : rty)
-      (lc1 : aloan_content) : typed_avalue option =
-    match (lc0, lc1) with
-    | AMutLoan (pm0, id0, child0), AMutLoan (pm1, id1, child1) ->
-        (* Sanity-check of the precondition *)
-        sanity_check __FILE__ __LINE__ (id0 = id1) span;
-        (* TODO: We should handle the markers here *)
-        sanity_check __FILE__ __LINE__ (pm0 = PNone && pm1 = PNone) span;
-        (* Register the loan id *)
-        set_loan_as_merged id0;
-        (* Merge *)
-        Some
-          ((Option.get merge_funs).merge_amut_loans id0 ty0 pm0 child0 ty1 pm1
-             child1)
-    | ASharedLoan (pm0, ids0, sv0, child0), ASharedLoan (pm1, ids1, sv1, child1)
-      ->
-        (* TODO: We should handle the markers here *)
-        sanity_check __FILE__ __LINE__ (pm0 = PNone && pm1 = PNone) span;
-        (* Filter the ids *)
-        let ids0 = filter_bids ids0 in
-        let ids1 = filter_bids ids1 in
-        (* Check that the sets of ids are the same - if it is not the case, it
-           means we actually need to merge more than 2 avalues: we ignore this
-           case for now *)
-        sanity_check __FILE__ __LINE__ (BorrowId.Set.equal ids0 ids1) span;
-        let ids = ids0 in
-        if BorrowId.Set.is_empty ids then (
-          (* If the set of ids is empty, we can eliminate this shared loan.
-             For now, we check that we can eliminate the whole shared value
-             altogether.
-             A more complete approach would be to explore the value and introduce
-             as many shared loans/borrows/etc. as necessary for the sub-values.
-             For now, we check that there are no such values that we would need
-             to preserve (in practice it works because we destructure the
-             shared values in the abstractions, and forbid nested borrows).
-          *)
-          sanity_check __FILE__ __LINE__
-            (not (value_has_loans_or_borrows ctx sv0.value))
-            span;
-          sanity_check __FILE__ __LINE__
-            (not (value_has_loans_or_borrows ctx sv0.value))
-            span;
-          sanity_check __FILE__ __LINE__ (is_aignored child0.value) span;
-          sanity_check __FILE__ __LINE__ (is_aignored child1.value) span;
-          None)
-        else (
-          (* Register the loan ids *)
-          set_loans_as_merged ids;
-          (* Merge *)
-          Some
-            ((Option.get merge_funs).merge_ashared_loans ids ty0 pm0 sv0 child0
-               ty1 pm1 sv1 child1))
-    | _ ->
-        (* Unreachable because those cases are ignored (ended/ignored borrows)
-           or inconsistent *)
-        craise __FILE__ __LINE__ span "Unreachable"
-  in
-
-  (* Note that because we may filter ids from a set of id, this function has
-     to register the merged loan ids: the caller doesn't do it (contrary to
-     the borrow case) *)
-  let merge_g_loan_contents (lc0 : g_loan_content_with_ty)
-      (lc1 : g_loan_content_with_ty) : typed_avalue option =
-    match (lc0, lc1) with
-    | Concrete _, Concrete _ ->
-        (* This can not happen: the values should have been destructured *)
-        craise __FILE__ __LINE__ span "Unreachable"
-    | Abstract (ty0, lc0), Abstract (ty1, lc1) ->
-        merge_aloan_contents ty0 lc0 ty1 lc1
-    | Concrete _, Abstract _ | Abstract _, Concrete _ ->
-        (* TODO: is it really unreachable? *)
-        craise __FILE__ __LINE__ span "Unreachable"
+  let set_loans_as_merged pm ids =
+    let ids =
+      BorrowId.Set.to_seq ids
+      |> Seq.map (fun x -> (pm, x))
+      |> MarkerBorrowId.Set.of_seq
+    in
+    MarkerBorrowId.Set.iter set_loan_as_merged ids
   in
 
   (* Note that we first explore the borrows/loans of [abs1], because we
@@ -2475,11 +2388,12 @@ let merge_into_abstraction_aux (span : Meta.span) (abs_kind : abs_kind)
   List.iter
     (fun bl ->
       match bl with
-      | BorrowId bid ->
+      | BorrowId (pm, bid) ->
+          let bid = (pm, bid) in
           log#ldebug
             (lazy
               ("merge_into_abstraction_aux: merging borrow "
-             ^ BorrowId.to_string bid));
+              ^ MarkerBorrowId.to_string bid));
 
           (* Check if the borrow has already been merged - this can happen
              because we go through all the borrows/loans in [abs0] *then*
@@ -2493,8 +2407,8 @@ let merge_into_abstraction_aux (span : Meta.span) (abs_kind : abs_kind)
             | None -> ()
             | Some bid ->
                 (* Lookup the contents *)
-                let bc0 = BorrowId.Map.find_opt bid borrow_to_content0 in
-                let bc1 = BorrowId.Map.find_opt bid borrow_to_content1 in
+                let bc0 = MarkerBorrowId.Map.find_opt bid borrow_to_content0 in
+                let bc1 = MarkerBorrowId.Map.find_opt bid borrow_to_content1 in
                 (* Merge *)
                 let av : typed_avalue =
                   match (bc0, bc1) with
@@ -2508,12 +2422,15 @@ let merge_into_abstraction_aux (span : Meta.span) (abs_kind : abs_kind)
                           craise __FILE__ __LINE__ span "Unreachable"
                       | Abstract (ty, bc) -> { value = ABorrow bc; ty })
                   | Some bc0, Some bc1 ->
-                      sanity_check __FILE__ __LINE__ (merge_funs <> None) span;
-                      merge_g_borrow_contents bc0 bc1
+                      (* With markers, the case where the same borrow is duplicated should now be unreachable.
+                         Note, this is due to all shared borrows currently taking different ids, this will
+                         not be the case anymore when shared loans will take a unique id instead of a set *)
+                      craise __FILE__ __LINE__ span "Unreachable"
                   | None, None -> craise __FILE__ __LINE__ span "Unreachable"
                 in
                 push_avalue av)
-      | LoanId bid ->
+      | LoanId (pm, bid) ->
+          let bid = (pm, bid) in
           if
             (* Check if the loan has already been treated - it can happen
                for the same reason as for borrows, and also because shared
@@ -2526,15 +2443,15 @@ let merge_into_abstraction_aux (span : Meta.span) (abs_kind : abs_kind)
             log#ldebug
               (lazy
                 ("merge_into_abstraction_aux: merging loan "
-               ^ BorrowId.to_string bid));
+                ^ MarkerBorrowId.to_string bid));
 
             (* Check if we need to filter it *)
             match filter_bid bid with
             | None -> ()
             | Some bid ->
                 (* Lookup the contents *)
-                let lc0 = BorrowId.Map.find_opt bid loan_to_content0 in
-                let lc1 = BorrowId.Map.find_opt bid loan_to_content1 in
+                let lc0 = MarkerBorrowId.Map.find_opt bid loan_to_content0 in
+                let lc1 = MarkerBorrowId.Map.find_opt bid loan_to_content1 in
                 (* Merge *)
                 let av : typed_avalue option =
                   match (lc0, lc1) with
@@ -2547,9 +2464,7 @@ let merge_into_abstraction_aux (span : Meta.span) (abs_kind : abs_kind)
                       | Abstract (ty, lc) -> (
                           match lc with
                           | ASharedLoan (pm, bids, sv, child) ->
-                              (* TODO: We should handle the markers here *)
-                              sanity_check __FILE__ __LINE__ (pm = PNone) span;
-                              let bids = filter_bids bids in
+                              let bids = filter_bids pm bids in
                               sanity_check __FILE__ __LINE__
                                 (not (BorrowId.Set.is_empty bids))
                                 span;
@@ -2559,7 +2474,7 @@ let merge_into_abstraction_aux (span : Meta.span) (abs_kind : abs_kind)
                                 (not (value_has_loans_or_borrows ctx sv.value))
                                 span;
                               let lc = ASharedLoan (pm, bids, sv, child) in
-                              set_loans_as_merged bids;
+                              set_loans_as_merged pm bids;
                               Some { value = ALoan lc; ty }
                           | AMutLoan _ ->
                               set_loan_as_merged bid;
@@ -2570,8 +2485,8 @@ let merge_into_abstraction_aux (span : Meta.span) (abs_kind : abs_kind)
                               (* The abstraction has been destructured, so those shouldn't appear *)
                               craise __FILE__ __LINE__ span "Unreachable"))
                   | Some lc0, Some lc1 ->
-                      sanity_check __FILE__ __LINE__ (merge_funs <> None) span;
-                      merge_g_loan_contents lc0 lc1
+                      (* With projection markers, shared loans should not be duplicated *)
+                      craise __FILE__ __LINE__ span "Unreachable"
                   | None, None -> craise __FILE__ __LINE__ span "Unreachable"
                 in
                 push_opt_avalue av))
@@ -2579,7 +2494,209 @@ let merge_into_abstraction_aux (span : Meta.span) (abs_kind : abs_kind)
 
   (* Reverse the avalues (we visited the loans/borrows in order, but pushed
      new values at the beggining of the stack of avalues) *)
-  let avalues = List.rev !avalues in
+  let abs_values = List.rev !avalues in
+
+  (* Phase 2: We now remove markers, by replacing pairs of the same element with left/right markers into one element
+     with only one marker. To do so, we linearly traverse the abstraction created through the first phase *)
+
+  (* We first reset the list of avalues, and will construct avalues similarly to the previous phase *)
+  avalues := [];
+
+  (* We recompute the relevant information on the abstraction after phase 1 *)
+  let { loans; borrows; borrows_loans; loan_to_content; borrow_to_content } =
+    compute_merge_abstraction_info span ctx abs_values
+  in
+
+  (* We will merge elements with the same borrow/loan id, but with different markers.
+     Hence, we only keep track of the id here: if Borrow PLeft bid has been merged
+     and we see Borrow PRight bid, we should ignore Borrow PRight bid *)
+  let merged_borrows = ref BorrowId.Set.empty in
+  let merged_loans = ref BorrowId.Set.empty in
+
+  let borrow_is_merged id = BorrowId.Set.mem id !merged_borrows in
+  let set_borrow_as_merged id =
+    merged_borrows := BorrowId.Set.add id !merged_borrows
+  in
+
+  let loan_is_merged id = BorrowId.Set.mem id !merged_loans in
+  let set_loan_as_merged id =
+    merged_loans := BorrowId.Set.add id !merged_loans
+  in
+  let set_loans_as_merged ids = BorrowId.Set.iter set_loan_as_merged ids in
+
+  (* Recreates an avalue from a borrow_content. *)
+  let avalue_from_bc = function
+    | Concrete (_, _) ->
+        (* This can happen only in case of nested borrows, and should have been filtered during phase 1 *)
+        craise __FILE__ __LINE__ span "Unreachable"
+    | Abstract (ty, bc) -> { value = ABorrow bc; ty }
+  in
+
+  (* Recreates an avalue from a loan_content *)
+  let avalue_from_lc = function
+    | Concrete (_, _) ->
+        (* This can happen only in case of nested borrows, and should have been filtered during phase 1 *)
+        craise __FILE__ __LINE__ span "Unreachable"
+    | Abstract (ty, bc) -> { value = ALoan bc; ty }
+  in
+
+  (* Some utility functions *)
+  (* Merge two aborrow contents - note that those contents must have the same id *)
+  let merge_aborrow_contents (ty0 : rty) (bc0 : aborrow_content) (ty1 : rty)
+      (bc1 : aborrow_content) : typed_avalue =
+    match (bc0, bc1) with
+    | AMutBorrow (pm0, id0, child0), AMutBorrow (pm1, id1, child1) ->
+        (* Sanity-check of the precondition *)
+        sanity_check __FILE__ __LINE__ (id0 = id1) span;
+        sanity_check __FILE__ __LINE__
+          ((pm0 = PLeft && pm1 = PRight) || (pm0 = PRight && pm1 = PLeft))
+          span;
+        (Option.get merge_funs).merge_amut_borrows id0 ty0 pm0 child0 ty1 pm1
+          child1
+    | ASharedBorrow (pm0, id0), ASharedBorrow (pm1, id1) ->
+        (* Sanity-check of the precondition *)
+        sanity_check __FILE__ __LINE__ (id0 = id1) span;
+        sanity_check __FILE__ __LINE__
+          ((pm0 = PLeft && pm1 = PRight) || (pm0 = PRight && pm1 = PLeft))
+          span;
+        (Option.get merge_funs).merge_ashared_borrows id0 ty0 pm0 ty1 pm1
+    | AProjSharedBorrow _, AProjSharedBorrow _ ->
+        (* Unreachable because requires nested borrows *)
+        craise __FILE__ __LINE__ span "Unreachable"
+    | _ ->
+        (* Unreachable because those cases are ignored (ended/ignored borrows)
+           or inconsistent *)
+        craise __FILE__ __LINE__ span "Unreachable"
+  in
+
+  let merge_g_borrow_contents (bc0 : g_borrow_content_with_ty)
+      (bc1 : g_borrow_content_with_ty) : typed_avalue =
+    match (bc0, bc1) with
+    | Concrete _, Concrete _ ->
+        (* This can happen only in case of nested borrows *)
+        craise __FILE__ __LINE__ span "Unreachable"
+    | Abstract (ty0, bc0), Abstract (ty1, bc1) ->
+        merge_aborrow_contents ty0 bc0 ty1 bc1
+    | Concrete _, Abstract _ | Abstract _, Concrete _ ->
+        (* TODO: is it really unreachable? *)
+        craise __FILE__ __LINE__ span "Unreachable"
+  in
+
+  let merge_aloan_contents (ty0 : rty) (lc0 : aloan_content) (ty1 : rty)
+      (lc1 : aloan_content) : typed_avalue =
+    match (lc0, lc1) with
+    | AMutLoan (pm0, id0, child0), AMutLoan (pm1, id1, child1) ->
+        (* Sanity-check of the precondition *)
+        sanity_check __FILE__ __LINE__ (id0 = id1) span;
+        sanity_check __FILE__ __LINE__
+          ((pm0 = PLeft && pm1 = PRight) || (pm0 = PRight && pm1 = PLeft))
+          span;
+        (* Register the loan id *)
+        set_loan_as_merged id0;
+        (* Merge *)
+        (Option.get merge_funs).merge_amut_loans id0 ty0 pm0 child0 ty1 pm1
+          child1
+    | ASharedLoan (pm0, ids0, sv0, child0), ASharedLoan (pm1, ids1, sv1, child1)
+      ->
+        sanity_check __FILE__ __LINE__
+          ((pm0 = PLeft && pm1 = PRight) || (pm0 = PRight && pm1 = PLeft))
+          span;
+        (* Check that the sets of ids are the same - if it is not the case, it
+           means we actually need to merge more than 2 avalues: we ignore this
+           case for now *)
+        sanity_check __FILE__ __LINE__ (BorrowId.Set.equal ids0 ids1) span;
+        let ids = ids0 in
+        (* Register the loan ids *)
+        set_loans_as_merged ids;
+        (* Merge *)
+        (Option.get merge_funs).merge_ashared_loans ids ty0 pm0 sv0 child0 ty1
+          pm1 sv1 child1
+    | _ ->
+        (* Unreachable because those cases are ignored (ended/ignored borrows)
+           or inconsistent *)
+        craise __FILE__ __LINE__ span "Unreachable"
+  in
+
+  (* Note that because we may filter ids from a set of id, this function has
+     to register the merged loan ids: the caller doesn't do it (contrary to
+     the borrow case) *)
+  let merge_g_loan_contents (lc0 : g_loan_content_with_ty)
+      (lc1 : g_loan_content_with_ty) : typed_avalue =
+    match (lc0, lc1) with
+    | Concrete _, Concrete _ ->
+        (* This can not happen: the values should have been destructured *)
+        craise __FILE__ __LINE__ span "Unreachable"
+    | Abstract (ty0, lc0), Abstract (ty1, lc1) ->
+        merge_aloan_contents ty0 lc0 ty1 lc1
+    | Concrete _, Abstract _ | Abstract _, Concrete _ ->
+        (* TODO: is it really unreachable? *)
+        craise __FILE__ __LINE__ span "Unreachable"
+  in
+
+  let invert_proj_marker = function
+    | PNone -> craise __FILE__ __LINE__ span "Unreachable"
+    | PLeft -> PRight
+    | PRight -> PLeft
+  in
+
+  (* We now iter over all elements in the current abstraction. For each element with a marker
+     (i.e., not PNone), we attempt to find the dual element in the rest of the list. If so,
+     we remove both elements, and insert the same element but with no marker.
+
+     Importantly, attempting the merge when first seeing a marked element allows us to preserve
+     the structure of the abstraction we are merging into (abs1). During phase1, we traversed
+     the borrow_loans of the abs1 first, and hence these elements are at the top of the list *)
+  List.iter
+    (function
+      | BorrowId (PNone, bid) ->
+          (* This element has no marker. We do not filter it, hence we retrieve the contents and inject it into
+             the avalues list *)
+          let bc = MarkerBorrowId.Map.find (PNone, bid) borrow_to_content in
+          push_avalue (avalue_from_bc bc)
+      | BorrowId (pm, bid) ->
+          (* Check if the borrow has already been merged. If so, it was already added to the avalues list, we skip it *)
+          if borrow_is_merged bid then ()
+          else (
+            set_borrow_as_merged bid;
+            let bc0 = MarkerBorrowId.Map.find (pm, bid) borrow_to_content in
+            let obc1 =
+              MarkerBorrowId.Map.find_opt
+                (invert_proj_marker pm, bid)
+                borrow_to_content
+            in
+            match obc1 with
+            | None ->
+                (* No dual element found, we keep the current one in the list of avalues, with the same marker *)
+                push_avalue (avalue_from_bc bc0)
+            | Some bc1 ->
+                (* We have borrows with left and right markers in the environment.
+                   We merge their values, and push the result to the list of avalues. The merge will also remove the projection marker *)
+                push_avalue (merge_g_borrow_contents bc0 bc1))
+      | LoanId (PNone, bid) ->
+          (* Same as BorrowId PNone above. We do not filter this element *)
+          let lc = MarkerBorrowId.Map.find (PNone, bid) loan_to_content in
+          push_avalue (avalue_from_lc lc)
+      | LoanId (pm, bid) -> (
+          if
+            (* Check if the loan has already been merged. If so, we skip it *)
+            loan_is_merged bid
+          then ()
+          else
+            let lc0 = MarkerBorrowId.Map.find (pm, bid) loan_to_content in
+            let olc1 =
+              MarkerBorrowId.Map.find_opt
+                (invert_proj_marker pm, bid)
+                loan_to_content
+            in
+            match olc1 with
+            | None ->
+                (* No dual element found, we keep the current one with the same marker *)
+                push_avalue (avalue_from_lc lc0)
+            | Some lc1 -> push_avalue (merge_g_loan_contents lc0 lc1)))
+    borrows_loans;
+
+  (* We traversed and pushed elements in the same order as the traversal, so we do not need to reverse the list *)
+  let avalues = !avalues in
 
   (* Reorder the avalues. We want the avalues to have the borrows first, then
      the loans (this structure is more stable when we merge abstractions together,
diff --git a/compiler/InterpreterLoopsCore.ml b/compiler/InterpreterLoopsCore.ml
index 23e05e06..cd609ab0 100644
--- a/compiler/InterpreterLoopsCore.ml
+++ b/compiler/InterpreterLoopsCore.ml
@@ -26,33 +26,6 @@ type ctx_or_update = (eval_ctx, updt_env_kind) result
 (** Union Find *)
 module UF = UnionFind.Make (UnionFind.StoreMap)
 
-type marker_borrow_id = proj_marker * BorrowId.id [@@deriving show, ord]
-
-module MarkerBorrowIdOrd = struct
-  type t = marker_borrow_id
-
-  let compare = compare_marker_borrow_id
-  let to_string = show_marker_borrow_id
-  let pp_t = pp_marker_borrow_id
-  let show_t = show_marker_borrow_id
-end
-
-module MarkerBorrowIdSet = Collections.MakeSet (MarkerBorrowIdOrd)
-module MarkerBorrowIdMap = Collections.MakeMap (MarkerBorrowIdOrd)
-
-module MarkerBorrowId : sig
-  type t
-
-  module Set : Collections.Set with type elt = t
-  module Map : Collections.Map with type key = t
-end
-with type t = marker_borrow_id = struct
-  type t = marker_borrow_id
-
-  module Set = MarkerBorrowIdSet
-  module Map = MarkerBorrowIdMap
-end
-
 (** A small utility -
 
     Rem.: some environments may be ill-formed (they may contain several times
diff --git a/compiler/InterpreterLoopsJoinCtxs.ml b/compiler/InterpreterLoopsJoinCtxs.ml
index 7f80e496..1e099d96 100644
--- a/compiler/InterpreterLoopsJoinCtxs.ml
+++ b/compiler/InterpreterLoopsJoinCtxs.ml
@@ -122,8 +122,13 @@ let reorder_loans_borrows_in_fresh_abs (span : Meta.span)
       i -> s@7 : u32
       abs@4 { MB l0, ML l4 }
     ]}
+
+    If [merge_funs] is None, we ensure that there are no markers in the environments.
+    If [merge_funs] is Some _, we merge environments that contain borrow/loan pairs with the same markers, omitting
+    pairs with the PNone marker (i.e., no marker)
  *)
-let reduce_ctx (span : Meta.span) (loop_id : LoopId.id) (old_ids : ids_sets)
+let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option)
+    (span : Meta.span) (loop_id : LoopId.id) (old_ids : ids_sets)
     (ctx0 : eval_ctx) : eval_ctx =
   (* Debug *)
   log#ldebug
@@ -132,6 +137,8 @@ let reduce_ctx (span : Meta.span) (loop_id : LoopId.id) (old_ids : ids_sets)
       ^ eval_ctx_to_string ~span:(Some span) ctx0
       ^ "\n\n"));
 
+  let allow_markers = merge_funs <> None in
+
   let abs_kind : abs_kind = Loop (loop_id, None, LoopSynthInput) in
   let can_end = true in
   let destructure_shared_values = true in
@@ -212,49 +219,53 @@ let reduce_ctx (span : Meta.span) (loop_id : LoopId.id) (old_ids : ids_sets)
       let bids = MarkerBorrowId.Set.elements bids in
       List.iter
         (fun bid ->
+          if not allow_markers then
+            sanity_check __FILE__ __LINE__ (fst bid = PNone) span;
           match MarkerBorrowId.Map.find_opt bid loan_to_abs with
           | None -> (* Nothing to do *) ()
           | Some abs_ids1 ->
-              AbstractionId.Set.iter
-                (fun abs_id1 ->
-                  (* We need to merge - unless we have already merged *)
-                  (* First, find the representatives for the two abstractions (the
-                     representative is the abstraction into which we merged) *)
-                  let abs_ref0 =
-                    UnionFind.find (AbstractionId.Map.find abs_id0 merged_abs)
-                  in
-                  let abs_id0 = UnionFind.get abs_ref0 in
-                  let abs_ref1 =
-                    UnionFind.find (AbstractionId.Map.find abs_id1 merged_abs)
-                  in
-                  let abs_id1 = UnionFind.get abs_ref1 in
-                  (* If the two ids are the same, it means the abstractions were already merged *)
-                  if abs_id0 = abs_id1 then ()
-                  else (
-                    (* We actually need to merge the abstractions *)
-
-                    (* Debug *)
-                    log#ldebug
-                      (lazy
-                        ("reduce_ctx: merging abstraction "
-                        ^ AbstractionId.to_string abs_id1
-                        ^ " into "
-                        ^ AbstractionId.to_string abs_id0
-                        ^ ":\n\n"
-                        ^ eval_ctx_to_string ~span:(Some span) !ctx));
-
-                    (* Update the environment - pay attention to the order: we
-                       we merge [abs_id1] *into* [abs_id0] *)
-                    let nctx, abs_id =
-                      merge_into_abstraction span abs_kind can_end None !ctx
-                        abs_id1 abs_id0
+              if allow_markers && fst bid = PNone then ()
+              else
+                AbstractionId.Set.iter
+                  (fun abs_id1 ->
+                    (* We need to merge - unless we have already merged *)
+                    (* First, find the representatives for the two abstractions (the
+                       representative is the abstraction into which we merged) *)
+                    let abs_ref0 =
+                      UnionFind.find (AbstractionId.Map.find abs_id0 merged_abs)
                     in
-                    ctx := nctx;
-
-                    (* Update the union find *)
-                    let abs_ref_merged = UnionFind.union abs_ref0 abs_ref1 in
-                    UnionFind.set abs_ref_merged abs_id))
-                abs_ids1)
+                    let abs_id0 = UnionFind.get abs_ref0 in
+                    let abs_ref1 =
+                      UnionFind.find (AbstractionId.Map.find abs_id1 merged_abs)
+                    in
+                    let abs_id1 = UnionFind.get abs_ref1 in
+                    (* If the two ids are the same, it means the abstractions were already merged *)
+                    if abs_id0 = abs_id1 then ()
+                    else (
+                      (* We actually need to merge the abstractions *)
+
+                      (* Debug *)
+                      log#ldebug
+                        (lazy
+                          ("reduce_ctx: merging abstraction "
+                          ^ AbstractionId.to_string abs_id1
+                          ^ " into "
+                          ^ AbstractionId.to_string abs_id0
+                          ^ ":\n\n"
+                          ^ eval_ctx_to_string ~span:(Some span) !ctx));
+
+                      (* Update the environment - pay attention to the order: we
+                         we merge [abs_id1] *into* [abs_id0] *)
+                      let nctx, abs_id =
+                        merge_into_abstraction span abs_kind can_end merge_funs
+                          !ctx abs_id1 abs_id0
+                      in
+                      ctx := nctx;
+
+                      (* Update the union find *)
+                      let abs_ref_merged = UnionFind.union abs_ref0 abs_ref1 in
+                      UnionFind.set abs_ref_merged abs_id))
+                  abs_ids1)
         bids)
     abs_ids;
 
@@ -278,8 +289,11 @@ let reduce_ctx (span : Meta.span) (loop_id : LoopId.id) (old_ids : ids_sets)
   (* Return the new context *)
   ctx
 
+(* Reduce_ctx can only be called in a context with no markers *)
+let reduce_ctx = reduce_ctx_with_markers None
+
 (* TODO Adapt and comment *)
-let collapse_ctx (span : Meta.span) (loop_id : LoopId.id)
+let collapse_ctx_markers (span : Meta.span) (loop_id : LoopId.id)
     (merge_funs : merge_duplicates_funcs) (old_ids : ids_sets) (ctx0 : eval_ctx)
     : eval_ctx =
   (* Debug *)
@@ -296,128 +310,153 @@ let collapse_ctx (span : Meta.span) (loop_id : LoopId.id)
   let is_fresh_abs_id (id : AbstractionId.id) : bool =
     not (AbstractionId.Set.mem id old_ids.aids)
   in
-  let is_fresh_did (id : DummyVarId.id) : bool =
-    not (DummyVarId.Set.mem id old_ids.dids)
-  in
-  (* Convert the dummy values to abstractions (note that when we convert
-     values to abstractions, the resulting abstraction should be destructured) *)
-  (* Note that we preserve the order of the dummy values: we replace them with
-     abstractions in place - this makes matching easier *)
-  let env =
-    List.concat
-      (List.map
-         (fun ee ->
-           match ee with
-           | EAbs _ | EFrame | EBinding (BVar _, _) -> [ ee ]
-           | EBinding (BDummy id, v) ->
-               if is_fresh_did id then
-                 let absl =
-                   convert_value_to_abstractions span abs_kind can_end
-                     destructure_shared_values ctx0 v
-                 in
-                 List.map (fun abs -> EAbs abs) absl
-               else [ ee ])
-         ctx0.env)
-  in
-  let ctx = { ctx0 with env } in
-  log#ldebug
-    (lazy
-      ("collapse_ctx: after converting values to abstractions:\n"
-     ^ show_ids_sets old_ids ^ "\n\n- ctx:\n"
-      ^ eval_ctx_to_string ~span:(Some span) ctx
-      ^ "\n\n"));
-
-  log#ldebug
-    (lazy
-      ("collapse_ctx: after decomposing the shared values in the abstractions:\n"
-     ^ show_ids_sets old_ids ^ "\n\n- ctx:\n"
-      ^ eval_ctx_to_string ~span:(Some span) ctx
-      ^ "\n\n"));
 
   (* Explore all the *new* abstractions, and compute various maps *)
   let explore (abs : abs) = is_fresh_abs_id abs.abs_id in
-  let ids_maps = compute_abs_borrows_loans_maps span false explore env in
+  let ids_maps = compute_abs_borrows_loans_maps span false explore ctx0.env in
   let {
     abs_ids;
     abs_to_borrows;
-    abs_to_loans = _;
+    abs_to_loans;
     abs_to_borrows_loans;
-    borrow_to_abs = _;
+    borrow_to_abs;
     loan_to_abs;
     borrow_loan_to_abs;
   } =
     ids_maps
   in
 
-  (* Change the merging behaviour depending on the input parameters *)
-  let abs_to_borrows, loan_to_abs =
-    (abs_to_borrows_loans, borrow_loan_to_abs)
-  in
-
   (* Merge the abstractions together *)
   let merged_abs : AbstractionId.id UnionFind.elem AbstractionId.Map.t =
     AbstractionId.Map.of_list
       (List.map (fun id -> (id, UnionFind.make id)) abs_ids)
   in
 
-  let ctx = ref ctx in
+  let ctx = ref ctx0 in
 
-  (* Merge all the mergeable abs.
+  let invert_proj_marker = function
+    | PNone -> craise __FILE__ __LINE__ span "Unreachable"
+    | PLeft -> PRight
+    | PRight -> PLeft
+  in
 
-     We iterate over the abstractions, then over the borrows in the abstractions.
-     We do this because we want to control the order in which abstractions
-     are merged (the ids are iterated in increasing order). Otherwise, we
-     could simply iterate over all the borrows in [borrow_to_abs]...
+  (* Merge all the mergeable abs where the same element in present in both abs,
+     but with left and right markers respectively.
+
+     We first check all borrows, then all loans
   *)
   List.iter
     (fun abs_id0 ->
       let bids = AbstractionId.Map.find abs_id0 abs_to_borrows in
       let bids = MarkerBorrowId.Set.elements bids in
       List.iter
-        (fun bid ->
-          match MarkerBorrowId.Map.find_opt bid loan_to_abs with
-          | None -> (* Nothing to do *) ()
-          | Some abs_ids1 ->
-              AbstractionId.Set.iter
-                (fun abs_id1 ->
-                  (* We need to merge - unless we have already merged *)
-                  (* First, find the representatives for the two abstractions (the
-                     representative is the abstraction into which we merged) *)
-                  let abs_ref0 =
-                    UnionFind.find (AbstractionId.Map.find abs_id0 merged_abs)
-                  in
-                  let abs_id0 = UnionFind.get abs_ref0 in
-                  let abs_ref1 =
-                    UnionFind.find (AbstractionId.Map.find abs_id1 merged_abs)
-                  in
-                  let abs_id1 = UnionFind.get abs_ref1 in
-                  (* If the two ids are the same, it means the abstractions were already merged *)
-                  if abs_id0 = abs_id1 then ()
-                  else (
-                    (* We actually need to merge the abstractions *)
-
-                    (* Debug *)
-                    log#ldebug
-                      (lazy
-                        ("collapse_ctx: merging abstraction "
-                        ^ AbstractionId.to_string abs_id1
-                        ^ " into "
-                        ^ AbstractionId.to_string abs_id0
-                        ^ ":\n\n"
-                        ^ eval_ctx_to_string ~span:(Some span) !ctx));
-
-                    (* Update the environment - pay attention to the order: we
-                       we merge [abs_id1] *into* [abs_id0] *)
-                    let nctx, abs_id =
-                      merge_into_abstraction span abs_kind can_end
-                        (Some merge_funs) !ctx abs_id1 abs_id0
+        (fun (pm, bid) ->
+          if pm = PNone then ()
+          else
+            (* We are looking for an element with the same borrow_id, but with the dual marker *)
+            match
+              MarkerBorrowId.Map.find_opt
+                (invert_proj_marker pm, bid)
+                borrow_to_abs
+            with
+            | None -> (* Nothing to do *) ()
+            | Some abs_ids1 ->
+                AbstractionId.Set.iter
+                  (fun abs_id1 ->
+                    (* We need to merge - unless we have already merged *)
+                    (* First, find the representatives for the two abstractions (the
+                       representative is the abstraction into which we merged) *)
+                    let abs_ref0 =
+                      UnionFind.find (AbstractionId.Map.find abs_id0 merged_abs)
                     in
-                    ctx := nctx;
-
-                    (* Update the union find *)
-                    let abs_ref_merged = UnionFind.union abs_ref0 abs_ref1 in
-                    UnionFind.set abs_ref_merged abs_id))
-                abs_ids1)
+                    let abs_id0 = UnionFind.get abs_ref0 in
+                    let abs_ref1 =
+                      UnionFind.find (AbstractionId.Map.find abs_id1 merged_abs)
+                    in
+                    let abs_id1 = UnionFind.get abs_ref1 in
+                    (* If the two ids are the same, it means the abstractions were already merged *)
+                    if abs_id0 = abs_id1 then ()
+                    else (
+                      (* We actually need to merge the abstractions *)
+
+                      (* Debug *)
+                      log#ldebug
+                        (lazy
+                          ("collapse_ctx: merging abstraction "
+                          ^ AbstractionId.to_string abs_id1
+                          ^ " into "
+                          ^ AbstractionId.to_string abs_id0
+                          ^ ":\n\n"
+                          ^ eval_ctx_to_string ~span:(Some span) !ctx));
+
+                      (* Update the environment - pay attention to the order: we
+                         we merge [abs_id1] *into* [abs_id0] *)
+                      let nctx, abs_id =
+                        merge_into_abstraction span abs_kind can_end
+                          (Some merge_funs) !ctx abs_id1 abs_id0
+                      in
+                      ctx := nctx;
+
+                      (* Update the union find *)
+                      let abs_ref_merged = UnionFind.union abs_ref0 abs_ref1 in
+                      UnionFind.set abs_ref_merged abs_id))
+                  abs_ids1)
+        bids;
+      (* We now traverse the loans *)
+      let bids = AbstractionId.Map.find abs_id0 abs_to_loans in
+      let bids = MarkerBorrowId.Set.elements bids in
+      List.iter
+        (fun (pm, bid) ->
+          if pm = PNone then ()
+          else
+            (* We are looking for an element with the same borrow_id, but with the dual marker *)
+            match
+              MarkerBorrowId.Map.find_opt
+                (invert_proj_marker pm, bid)
+                loan_to_abs
+            with
+            | None -> (* Nothing to do *) ()
+            | Some abs_ids1 ->
+                AbstractionId.Set.iter
+                  (fun abs_id1 ->
+                    (* We need to merge - unless we have already merged *)
+                    (* First, find the representatives for the two abstractions (the
+                       representative is the abstraction into which we merged) *)
+                    let abs_ref0 =
+                      UnionFind.find (AbstractionId.Map.find abs_id0 merged_abs)
+                    in
+                    let abs_id0 = UnionFind.get abs_ref0 in
+                    let abs_ref1 =
+                      UnionFind.find (AbstractionId.Map.find abs_id1 merged_abs)
+                    in
+                    let abs_id1 = UnionFind.get abs_ref1 in
+                    (* If the two ids are the same, it means the abstractions were already merged *)
+                    if abs_id0 = abs_id1 then ()
+                    else (
+                      (* We actually need to merge the abstractions *)
+
+                      (* Debug *)
+                      log#ldebug
+                        (lazy
+                          ("collapse_ctx: merging abstraction "
+                          ^ AbstractionId.to_string abs_id1
+                          ^ " into "
+                          ^ AbstractionId.to_string abs_id0
+                          ^ ":\n\n"
+                          ^ eval_ctx_to_string ~span:(Some span) !ctx));
+
+                      (* Update the environment - pay attention to the order: we
+                         we merge [abs_id1] *into* [abs_id0] *)
+                      let nctx, abs_id =
+                        merge_into_abstraction span abs_kind can_end
+                          (Some merge_funs) !ctx abs_id1 abs_id0
+                      in
+                      ctx := nctx;
+
+                      (* Update the union find *)
+                      let abs_ref_merged = UnionFind.union abs_ref0 abs_ref1 in
+                      UnionFind.set abs_ref_merged abs_id))
+                  abs_ids1)
         bids)
     abs_ids;
 
@@ -441,6 +480,25 @@ let collapse_ctx (span : Meta.span) (loop_id : LoopId.id)
   (* Return the new context *)
   ctx
 
+(* Collapse two environments containing projection markers; this function is called after
+   joining environments.
+
+   The collapse is done in two steps.
+   First, we reduce the environment, merging for instance abstractions containing MB l0 _ and ML l0,
+   when both elements have the same marker, e.g., PNone, PLeft, or PRight.
+
+   Second, we merge abstractions containing the same element with left and right markers respectively.
+
+   At the end of the second step, all markers should have been removed from the resulting environment.
+*)
+let collapse_ctx (span : Meta.span) (loop_id : LoopId.id)
+    (merge_funs : merge_duplicates_funcs) (old_ids : ids_sets) (ctx0 : eval_ctx)
+    : eval_ctx =
+  let ctx =
+    reduce_ctx_with_markers (Some merge_funs) span loop_id old_ids ctx0
+  in
+  collapse_ctx_markers span loop_id merge_funs old_ids ctx
+
 let mk_collapse_ctx_merge_duplicate_funs (span : Meta.span)
     (loop_id : LoopId.id) (ctx : eval_ctx) : merge_duplicates_funcs =
   (* Rem.: the merge functions raise exceptions (that we catch). *)
@@ -466,9 +524,6 @@ let mk_collapse_ctx_merge_duplicate_funs (span : Meta.span)
     sanity_check __FILE__ __LINE__ (is_aignored child0.value) span;
     sanity_check __FILE__ __LINE__ (is_aignored child1.value) span;
 
-    (* TODO: Handle markers *)
-    sanity_check __FILE__ __LINE__ (pm0 = PNone && pm1 = PNone) span;
-
     (* We need to pick a type for the avalue. The types on the left and on the
        right may use different regions: it doesn't really matter (here, we pick
        the one from the left), because we will merge those regions together
@@ -493,9 +548,6 @@ let mk_collapse_ctx_merge_duplicate_funs (span : Meta.span)
         span
     in
 
-    (* TODO: Handle markers *)
-    sanity_check __FILE__ __LINE__ (pm0 = PNone && pm1 = PNone) span;
-
     (* Same remarks as for [merge_amut_borrows] *)
     let ty = ty0 in
     let value = ABorrow (ASharedBorrow (PNone, id)) in
@@ -506,8 +558,7 @@ let mk_collapse_ctx_merge_duplicate_funs (span : Meta.span)
     (* Sanity checks *)
     sanity_check __FILE__ __LINE__ (is_aignored child0.value) span;
     sanity_check __FILE__ __LINE__ (is_aignored child1.value) span;
-    (* TODO: Handle markers *)
-    sanity_check __FILE__ __LINE__ (pm0 = PNone && pm1 = PNone) span;
+
     (* Same remarks as for [merge_amut_borrows] *)
     let ty = ty0 in
     let child = child0 in
@@ -530,8 +581,6 @@ let mk_collapse_ctx_merge_duplicate_funs (span : Meta.span)
     sanity_check __FILE__ __LINE__
       (not (value_has_loans_or_borrows ctx sv1.value))
       span;
-    (* TODO: Handle markers *)
-    sanity_check __FILE__ __LINE__ (pm0 = PNone && pm1 = PNone) span;
 
     let ty = ty0 in
     let child = child0 in
@@ -670,10 +719,9 @@ let join_ctxs (span : Meta.span) (loop_id : LoopId.id) (fixed_ids : ids_sets)
       | x -> x
     in
 
-    (* TODO: Readd this
-       let env0 = List.map (add_marker PLeft) env0 in
-       let env1 = List.map (add_marker PRight) env1 in
-    *)
+    let env0 = List.map (add_marker PLeft) env0 in
+    let env1 = List.map (add_marker PRight) env1 in
+
     List.iter check_valid env0;
     List.iter check_valid env1;
     (* Concatenate the suffixes and append the abstractions introduced while
diff --git a/compiler/Values.ml b/compiler/Values.ml
index ca33604d..c32cbc6e 100644
--- a/compiler/Values.ml
+++ b/compiler/Values.ml
@@ -180,6 +180,37 @@ type abstraction_id_set = AbstractionId.Set.t [@@deriving show, ord]
     For additional explanations see: https://arxiv.org/pdf/2404.02680#section.5 *)
 type proj_marker = PNone | PLeft | PRight [@@deriving show, ord]
 
+type marker_borrow_id = proj_marker * BorrowId.id [@@deriving show, ord]
+
+module MarkerBorrowIdOrd = struct
+  type t = marker_borrow_id
+
+  let compare = compare_marker_borrow_id
+  let to_string = show_marker_borrow_id
+  let pp_t = pp_marker_borrow_id
+  let show_t = show_marker_borrow_id
+end
+
+module MarkerBorrowIdSet = Collections.MakeSet (MarkerBorrowIdOrd)
+module MarkerBorrowIdMap = Collections.MakeMap (MarkerBorrowIdOrd)
+
+module MarkerBorrowId : sig
+  type t
+
+  val to_string : t -> string
+
+  module Set : Collections.Set with type elt = t
+  module Map : Collections.Map with type key = t
+end
+with type t = marker_borrow_id = struct
+  type t = marker_borrow_id
+
+  let to_string = show_marker_borrow_id
+
+  module Set = MarkerBorrowIdSet
+  module Map = MarkerBorrowIdMap
+end
+
 (** Ancestor for {!typed_avalue} iter visitor *)
 class ['self] iter_typed_avalue_base =
   object (self : 'self)
diff --git a/tests/coq/arrays/Arrays.v b/tests/coq/arrays/Arrays.v
index 35dea58c..b7bef7c7 100644
--- a/tests/coq/arrays/Arrays.v
+++ b/tests/coq/arrays/Arrays.v
@@ -375,58 +375,15 @@ Definition non_copyable_array : result unit :=
   take_array_t (mk_array AB_t 2%usize [ AB_A; AB_B ])
 .
 
-(** [arrays::sum]: loop 0:
-    Source: 'tests/src/arrays.rs', lines 242:0-250:1 *)
-Fixpoint sum_loop
-  (n : nat) (s : slice u32) (sum1 : u32) (i : usize) : result u32 :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    let i1 := slice_len u32 s in
-    if i s< i1
-    then (
-      i2 <- slice_index_usize u32 s i;
-      sum3 <- u32_add sum1 i2;
-      i3 <- usize_add i 1%usize;
-      sum_loop n1 s sum3 i3)
-    else Ok sum1
-  end
-.
-
 (** [arrays::sum]:
     Source: 'tests/src/arrays.rs', lines 242:0-242:28 *)
 Definition sum (n : nat) (s : slice u32) : result u32 :=
-  sum_loop n s 0%u32 0%usize
-.
-
-(** [arrays::sum2]: loop 0:
-    Source: 'tests/src/arrays.rs', lines 252:0-261:1 *)
-Fixpoint sum2_loop
-  (n : nat) (s : slice u32) (s2 : slice u32) (sum1 : u32) (i : usize) :
-  result u32
-  :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    let i1 := slice_len u32 s in
-    if i s< i1
-    then (
-      i2 <- slice_index_usize u32 s i;
-      i3 <- slice_index_usize u32 s2 i;
-      i4 <- u32_add i2 i3;
-      sum3 <- u32_add sum1 i4;
-      i5 <- usize_add i 1%usize;
-      sum2_loop n1 s s2 sum3 i5)
-    else Ok sum1
-  end
-.
+  admit.
 
 (** [arrays::sum2]:
     Source: 'tests/src/arrays.rs', lines 252:0-252:41 *)
 Definition sum2 (n : nat) (s : slice u32) (s2 : slice u32) : result u32 :=
-  let i := slice_len u32 s in
-  let i1 := slice_len u32 s2 in
-  if negb (i s= i1) then Fail_ Failure else sum2_loop n s s2 0%u32 0%usize
+  admit
 .
 
 (** [arrays::f0]:
@@ -507,29 +464,10 @@ Definition ite : result unit :=
   Ok tt
 .
 
-(** [arrays::zero_slice]: loop 0:
-    Source: 'tests/src/arrays.rs', lines 303:0-310:1 *)
-Fixpoint zero_slice_loop
-  (n : nat) (a : slice u8) (i : usize) (len : usize) : result (slice u8) :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    if i s< len
-    then (
-      p <- slice_index_mut_usize u8 a i;
-      let (_, index_mut_back) := p in
-      i1 <- usize_add i 1%usize;
-      a1 <- index_mut_back 0%u8;
-      zero_slice_loop n1 a1 i1 len)
-    else Ok a
-  end
-.
-
 (** [arrays::zero_slice]:
     Source: 'tests/src/arrays.rs', lines 303:0-303:31 *)
 Definition zero_slice (n : nat) (a : slice u8) : result (slice u8) :=
-  let len := slice_len u8 a in zero_slice_loop n a 0%usize len
-.
+  admit.
 
 (** [arrays::iter_mut_slice]: loop 0:
     Source: 'tests/src/arrays.rs', lines 312:0-318:1 *)
diff --git a/tests/coq/demo/Demo.v b/tests/coq/demo/Demo.v
index 8d8f840d..14b1ca9d 100644
--- a/tests/coq/demo/Demo.v
+++ b/tests/coq/demo/Demo.v
@@ -90,38 +90,13 @@ Fixpoint list_nth_mut
   end
 .
 
-(** [demo::list_nth_mut1]: loop 0:
-    Source: 'tests/src/demo.rs', lines 69:0-78:1 *)
-Fixpoint list_nth_mut1_loop
-  (T : Type) (n : nat) (l : CList_t T) (i : u32) :
-  result (T * (T -> result (CList_t T)))
-  :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match l with
-    | CList_CCons x tl =>
-      if i s= 0%u32
-      then let back := fun (ret : T) => Ok (CList_CCons ret tl) in Ok (x, back)
-      else (
-        i1 <- u32_sub i 1%u32;
-        p <- list_nth_mut1_loop T n1 tl i1;
-        let (t, back) := p in
-        let back1 := fun (ret : T) => tl1 <- back ret; Ok (CList_CCons x tl1)
-          in
-        Ok (t, back1))
-    | CList_CNil => Fail_ Failure
-    end
-  end
-.
-
 (** [demo::list_nth_mut1]:
     Source: 'tests/src/demo.rs', lines 69:0-69:77 *)
 Definition list_nth_mut1
   (T : Type) (n : nat) (l : CList_t T) (i : u32) :
   result (T * (T -> result (CList_t T)))
   :=
-  list_nth_mut1_loop T n l i
+  admit
 .
 
 (** [demo::i32_id]:
diff --git a/tests/coq/hashmap/Hashmap_Funs.v b/tests/coq/hashmap/Hashmap_Funs.v
index 1f2b2b22..b5c2bff0 100644
--- a/tests/coq/hashmap/Hashmap_Funs.v
+++ b/tests/coq/hashmap/Hashmap_Funs.v
@@ -67,41 +67,11 @@ Definition hashMap_new (T : Type) (n : nat) : result (HashMap_t T) :=
   hashMap_new_with_capacity T n 32%usize 4%usize 5%usize
 .
 
-(** [hashmap::{hashmap::HashMap<T>}::clear]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 80:4-88:5 *)
-Fixpoint hashMap_clear_loop
-  (T : Type) (n : nat) (slots : alloc_vec_Vec (List_t T)) (i : usize) :
-  result (alloc_vec_Vec (List_t T))
-  :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    let i1 := alloc_vec_Vec_len (List_t T) slots in
-    if i s< i1
-    then (
-      p <-
-        alloc_vec_Vec_index_mut (List_t T) usize
-          (core_slice_index_SliceIndexUsizeSliceTInst (List_t T)) slots i;
-      let (_, index_mut_back) := p in
-      i2 <- usize_add i 1%usize;
-      slots1 <- index_mut_back List_Nil;
-      hashMap_clear_loop T n1 slots1 i2)
-    else Ok slots
-  end
-.
-
 (** [hashmap::{hashmap::HashMap<T>}::clear]:
     Source: 'tests/src/hashmap.rs', lines 80:4-80:27 *)
 Definition hashMap_clear
   (T : Type) (n : nat) (self : HashMap_t T) : result (HashMap_t T) :=
-  hm <- hashMap_clear_loop T n self.(hashMap_slots) 0%usize;
-  Ok
-    {|
-      hashMap_num_entries := 0%usize;
-      hashMap_max_load_factor := self.(hashMap_max_load_factor);
-      hashMap_max_load := self.(hashMap_max_load);
-      hashMap_slots := hm
-    |}
+  admit
 .
 
 (** [hashmap::{hashmap::HashMap<T>}::len]:
@@ -110,35 +80,13 @@ Definition hashMap_len (T : Type) (self : HashMap_t T) : result usize :=
   Ok self.(hashMap_num_entries)
 .
 
-(** [hashmap::{hashmap::HashMap<T>}::insert_in_list]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 97:4-114:5 *)
-Fixpoint hashMap_insert_in_list_loop
-  (T : Type) (n : nat) (key : usize) (value : T) (ls : List_t T) :
-  result (bool * (List_t T))
-  :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls with
-    | List_Cons ckey cvalue tl =>
-      if ckey s= key
-      then Ok (false, List_Cons ckey value tl)
-      else (
-        p <- hashMap_insert_in_list_loop T n1 key value tl;
-        let (b, tl1) := p in
-        Ok (b, List_Cons ckey cvalue tl1))
-    | List_Nil => Ok (true, List_Cons key value List_Nil)
-    end
-  end
-.
-
 (** [hashmap::{hashmap::HashMap<T>}::insert_in_list]:
     Source: 'tests/src/hashmap.rs', lines 97:4-97:71 *)
 Definition hashMap_insert_in_list
   (T : Type) (n : nat) (key : usize) (value : T) (ls : List_t T) :
   result (bool * (List_t T))
   :=
-  hashMap_insert_in_list_loop T n key value ls
+  admit
 .
 
 (** [hashmap::{hashmap::HashMap<T>}::insert_no_resize]:
@@ -179,57 +127,13 @@ Definition hashMap_insert_no_resize
       |})
 .
 
-(** [hashmap::{hashmap::HashMap<T>}::move_elements_from_list]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 183:4-196:5 *)
-Fixpoint hashMap_move_elements_from_list_loop
-  (T : Type) (n : nat) (ntable : HashMap_t T) (ls : List_t T) :
-  result (HashMap_t T)
-  :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls with
-    | List_Cons k v tl =>
-      ntable1 <- hashMap_insert_no_resize T n1 ntable k v;
-      hashMap_move_elements_from_list_loop T n1 ntable1 tl
-    | List_Nil => Ok ntable
-    end
-  end
-.
-
 (** [hashmap::{hashmap::HashMap<T>}::move_elements_from_list]:
     Source: 'tests/src/hashmap.rs', lines 183:4-183:72 *)
 Definition hashMap_move_elements_from_list
   (T : Type) (n : nat) (ntable : HashMap_t T) (ls : List_t T) :
   result (HashMap_t T)
   :=
-  hashMap_move_elements_from_list_loop T n ntable ls
-.
-
-(** [hashmap::{hashmap::HashMap<T>}::move_elements]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 171:4-180:5 *)
-Fixpoint hashMap_move_elements_loop
-  (T : Type) (n : nat) (ntable : HashMap_t T)
-  (slots : alloc_vec_Vec (List_t T)) (i : usize) :
-  result ((HashMap_t T) * (alloc_vec_Vec (List_t T)))
-  :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    let i1 := alloc_vec_Vec_len (List_t T) slots in
-    if i s< i1
-    then (
-      p <-
-        alloc_vec_Vec_index_mut (List_t T) usize
-          (core_slice_index_SliceIndexUsizeSliceTInst (List_t T)) slots i;
-      let (l, index_mut_back) := p in
-      let (ls, l1) := core_mem_replace (List_t T) l List_Nil in
-      ntable1 <- hashMap_move_elements_from_list T n1 ntable ls;
-      i2 <- usize_add i 1%usize;
-      slots1 <- index_mut_back l1;
-      hashMap_move_elements_loop T n1 ntable1 slots1 i2)
-    else Ok (ntable, slots)
-  end
+  admit
 .
 
 (** [hashmap::{hashmap::HashMap<T>}::move_elements]:
@@ -239,7 +143,7 @@ Definition hashMap_move_elements
   (slots : alloc_vec_Vec (List_t T)) (i : usize) :
   result ((HashMap_t T) * (alloc_vec_Vec (List_t T)))
   :=
-  hashMap_move_elements_loop T n ntable slots i
+  admit
 .
 
 (** [hashmap::{hashmap::HashMap<T>}::try_resize]:
@@ -287,28 +191,11 @@ Definition hashMap_insert
   else Ok self1
 .
 
-(** [hashmap::{hashmap::HashMap<T>}::contains_key_in_list]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 206:4-219:5 *)
-Fixpoint hashMap_contains_key_in_list_loop
-  (T : Type) (n : nat) (key : usize) (ls : List_t T) : result bool :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls with
-    | List_Cons ckey _ tl =>
-      if ckey s= key
-      then Ok true
-      else hashMap_contains_key_in_list_loop T n1 key tl
-    | List_Nil => Ok false
-    end
-  end
-.
-
 (** [hashmap::{hashmap::HashMap<T>}::contains_key_in_list]:
     Source: 'tests/src/hashmap.rs', lines 206:4-206:68 *)
 Definition hashMap_contains_key_in_list
   (T : Type) (n : nat) (key : usize) (ls : List_t T) : result bool :=
-  hashMap_contains_key_in_list_loop T n key ls
+  admit
 .
 
 (** [hashmap::{hashmap::HashMap<T>}::contains_key]:
@@ -325,26 +212,11 @@ Definition hashMap_contains_key
   hashMap_contains_key_in_list T n key l
 .
 
-(** [hashmap::{hashmap::HashMap<T>}::get_in_list]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 224:4-237:5 *)
-Fixpoint hashMap_get_in_list_loop
-  (T : Type) (n : nat) (key : usize) (ls : List_t T) : result T :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls with
-    | List_Cons ckey cvalue tl =>
-      if ckey s= key then Ok cvalue else hashMap_get_in_list_loop T n1 key tl
-    | List_Nil => Fail_ Failure
-    end
-  end
-.
-
 (** [hashmap::{hashmap::HashMap<T>}::get_in_list]:
     Source: 'tests/src/hashmap.rs', lines 224:4-224:70 *)
 Definition hashMap_get_in_list
   (T : Type) (n : nat) (key : usize) (ls : List_t T) : result T :=
-  hashMap_get_in_list_loop T n key ls
+  admit
 .
 
 (** [hashmap::{hashmap::HashMap<T>}::get]:
@@ -361,39 +233,13 @@ Definition hashMap_get
   hashMap_get_in_list T n key l
 .
 
-(** [hashmap::{hashmap::HashMap<T>}::get_mut_in_list]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 245:4-254:5 *)
-Fixpoint hashMap_get_mut_in_list_loop
-  (T : Type) (n : nat) (ls : List_t T) (key : usize) :
-  result (T * (T -> result (List_t T)))
-  :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls with
-    | List_Cons ckey cvalue tl =>
-      if ckey s= key
-      then
-        let back := fun (ret : T) => Ok (List_Cons ckey ret tl) in
-        Ok (cvalue, back)
-      else (
-        p <- hashMap_get_mut_in_list_loop T n1 tl key;
-        let (t, back) := p in
-        let back1 :=
-          fun (ret : T) => tl1 <- back ret; Ok (List_Cons ckey cvalue tl1) in
-        Ok (t, back1))
-    | List_Nil => Fail_ Failure
-    end
-  end
-.
-
 (** [hashmap::{hashmap::HashMap<T>}::get_mut_in_list]:
     Source: 'tests/src/hashmap.rs', lines 245:4-245:86 *)
 Definition hashMap_get_mut_in_list
   (T : Type) (n : nat) (ls : List_t T) (key : usize) :
   result (T * (T -> result (List_t T)))
   :=
-  hashMap_get_mut_in_list_loop T n ls key
+  admit
 .
 
 (** [hashmap::{hashmap::HashMap<T>}::get_mut]:
@@ -426,41 +272,13 @@ Definition hashMap_get_mut
   Ok (t, back)
 .
 
-(** [hashmap::{hashmap::HashMap<T>}::remove_from_list]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 265:4-291:5 *)
-Fixpoint hashMap_remove_from_list_loop
-  (T : Type) (n : nat) (key : usize) (ls : List_t T) :
-  result ((option T) * (List_t T))
-  :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls with
-    | List_Cons ckey t tl =>
-      if ckey s= key
-      then
-        let (mv_ls, _) :=
-          core_mem_replace (List_t T) (List_Cons ckey t tl) List_Nil in
-        match mv_ls with
-        | List_Cons _ cvalue tl1 => Ok (Some cvalue, tl1)
-        | List_Nil => Fail_ Failure
-        end
-      else (
-        p <- hashMap_remove_from_list_loop T n1 key tl;
-        let (o, tl1) := p in
-        Ok (o, List_Cons ckey t tl1))
-    | List_Nil => Ok (None, List_Nil)
-    end
-  end
-.
-
 (** [hashmap::{hashmap::HashMap<T>}::remove_from_list]:
     Source: 'tests/src/hashmap.rs', lines 265:4-265:69 *)
 Definition hashMap_remove_from_list
   (T : Type) (n : nat) (key : usize) (ls : List_t T) :
   result ((option T) * (List_t T))
   :=
-  hashMap_remove_from_list_loop T n key ls
+  admit
 .
 
 (** [hashmap::{hashmap::HashMap<T>}::remove]:
diff --git a/tests/coq/hashmap_on_disk/HashmapMain_Funs.v b/tests/coq/hashmap_on_disk/HashmapMain_Funs.v
index facd84ea..e37b111c 100644
--- a/tests/coq/hashmap_on_disk/HashmapMain_Funs.v
+++ b/tests/coq/hashmap_on_disk/HashmapMain_Funs.v
@@ -74,44 +74,13 @@ Definition hashmap_HashMap_new
   hashmap_HashMap_new_with_capacity T n 32%usize 4%usize 5%usize
 .
 
-(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::clear]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 80:4-88:5 *)
-Fixpoint hashmap_HashMap_clear_loop
-  (T : Type) (n : nat) (slots : alloc_vec_Vec (hashmap_List_t T)) (i : usize) :
-  result (alloc_vec_Vec (hashmap_List_t T))
-  :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    let i1 := alloc_vec_Vec_len (hashmap_List_t T) slots in
-    if i s< i1
-    then (
-      p <-
-        alloc_vec_Vec_index_mut (hashmap_List_t T) usize
-          (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t T)) slots
-          i;
-      let (_, index_mut_back) := p in
-      i2 <- usize_add i 1%usize;
-      slots1 <- index_mut_back Hashmap_List_Nil;
-      hashmap_HashMap_clear_loop T n1 slots1 i2)
-    else Ok slots
-  end
-.
-
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::clear]:
     Source: 'tests/src/hashmap.rs', lines 80:4-80:27 *)
 Definition hashmap_HashMap_clear
   (T : Type) (n : nat) (self : hashmap_HashMap_t T) :
   result (hashmap_HashMap_t T)
   :=
-  hm <- hashmap_HashMap_clear_loop T n self.(hashmap_HashMap_slots) 0%usize;
-  Ok
-    {|
-      hashmap_HashMap_num_entries := 0%usize;
-      hashmap_HashMap_max_load_factor := self.(hashmap_HashMap_max_load_factor);
-      hashmap_HashMap_max_load := self.(hashmap_HashMap_max_load);
-      hashmap_HashMap_slots := hm
-    |}
+  admit
 .
 
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::len]:
@@ -121,36 +90,13 @@ Definition hashmap_HashMap_len
   Ok self.(hashmap_HashMap_num_entries)
 .
 
-(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::insert_in_list]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 97:4-114:5 *)
-Fixpoint hashmap_HashMap_insert_in_list_loop
-  (T : Type) (n : nat) (key : usize) (value : T) (ls : hashmap_List_t T) :
-  result (bool * (hashmap_List_t T))
-  :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls with
-    | Hashmap_List_Cons ckey cvalue tl =>
-      if ckey s= key
-      then Ok (false, Hashmap_List_Cons ckey value tl)
-      else (
-        p <- hashmap_HashMap_insert_in_list_loop T n1 key value tl;
-        let (b, tl1) := p in
-        Ok (b, Hashmap_List_Cons ckey cvalue tl1))
-    | Hashmap_List_Nil =>
-      Ok (true, Hashmap_List_Cons key value Hashmap_List_Nil)
-    end
-  end
-.
-
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::insert_in_list]:
     Source: 'tests/src/hashmap.rs', lines 97:4-97:71 *)
 Definition hashmap_HashMap_insert_in_list
   (T : Type) (n : nat) (key : usize) (value : T) (ls : hashmap_List_t T) :
   result (bool * (hashmap_List_t T))
   :=
-  hashmap_HashMap_insert_in_list_loop T n key value ls
+  admit
 .
 
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::insert_no_resize]:
@@ -193,58 +139,13 @@ Definition hashmap_HashMap_insert_no_resize
       |})
 .
 
-(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements_from_list]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 183:4-196:5 *)
-Fixpoint hashmap_HashMap_move_elements_from_list_loop
-  (T : Type) (n : nat) (ntable : hashmap_HashMap_t T) (ls : hashmap_List_t T) :
-  result (hashmap_HashMap_t T)
-  :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls with
-    | Hashmap_List_Cons k v tl =>
-      ntable1 <- hashmap_HashMap_insert_no_resize T n1 ntable k v;
-      hashmap_HashMap_move_elements_from_list_loop T n1 ntable1 tl
-    | Hashmap_List_Nil => Ok ntable
-    end
-  end
-.
-
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements_from_list]:
     Source: 'tests/src/hashmap.rs', lines 183:4-183:72 *)
 Definition hashmap_HashMap_move_elements_from_list
   (T : Type) (n : nat) (ntable : hashmap_HashMap_t T) (ls : hashmap_List_t T) :
   result (hashmap_HashMap_t T)
   :=
-  hashmap_HashMap_move_elements_from_list_loop T n ntable ls
-.
-
-(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 171:4-180:5 *)
-Fixpoint hashmap_HashMap_move_elements_loop
-  (T : Type) (n : nat) (ntable : hashmap_HashMap_t T)
-  (slots : alloc_vec_Vec (hashmap_List_t T)) (i : usize) :
-  result ((hashmap_HashMap_t T) * (alloc_vec_Vec (hashmap_List_t T)))
-  :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    let i1 := alloc_vec_Vec_len (hashmap_List_t T) slots in
-    if i s< i1
-    then (
-      p <-
-        alloc_vec_Vec_index_mut (hashmap_List_t T) usize
-          (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t T)) slots
-          i;
-      let (l, index_mut_back) := p in
-      let (ls, l1) := core_mem_replace (hashmap_List_t T) l Hashmap_List_Nil in
-      ntable1 <- hashmap_HashMap_move_elements_from_list T n1 ntable ls;
-      i2 <- usize_add i 1%usize;
-      slots1 <- index_mut_back l1;
-      hashmap_HashMap_move_elements_loop T n1 ntable1 slots1 i2)
-    else Ok (ntable, slots)
-  end
+  admit
 .
 
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements]:
@@ -254,7 +155,7 @@ Definition hashmap_HashMap_move_elements
   (slots : alloc_vec_Vec (hashmap_List_t T)) (i : usize) :
   result ((hashmap_HashMap_t T) * (alloc_vec_Vec (hashmap_List_t T)))
   :=
-  hashmap_HashMap_move_elements_loop T n ntable slots i
+  admit
 .
 
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::try_resize]:
@@ -307,28 +208,11 @@ Definition hashmap_HashMap_insert
   else Ok self1
 .
 
-(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::contains_key_in_list]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 206:4-219:5 *)
-Fixpoint hashmap_HashMap_contains_key_in_list_loop
-  (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : result bool :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls with
-    | Hashmap_List_Cons ckey _ tl =>
-      if ckey s= key
-      then Ok true
-      else hashmap_HashMap_contains_key_in_list_loop T n1 key tl
-    | Hashmap_List_Nil => Ok false
-    end
-  end
-.
-
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::contains_key_in_list]:
     Source: 'tests/src/hashmap.rs', lines 206:4-206:68 *)
 Definition hashmap_HashMap_contains_key_in_list
   (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : result bool :=
-  hashmap_HashMap_contains_key_in_list_loop T n key ls
+  admit
 .
 
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::contains_key]:
@@ -347,28 +231,11 @@ Definition hashmap_HashMap_contains_key
   hashmap_HashMap_contains_key_in_list T n key l
 .
 
-(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_in_list]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 224:4-237:5 *)
-Fixpoint hashmap_HashMap_get_in_list_loop
-  (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : result T :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls with
-    | Hashmap_List_Cons ckey cvalue tl =>
-      if ckey s= key
-      then Ok cvalue
-      else hashmap_HashMap_get_in_list_loop T n1 key tl
-    | Hashmap_List_Nil => Fail_ Failure
-    end
-  end
-.
-
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_in_list]:
     Source: 'tests/src/hashmap.rs', lines 224:4-224:70 *)
 Definition hashmap_HashMap_get_in_list
   (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : result T :=
-  hashmap_HashMap_get_in_list_loop T n key ls
+  admit
 .
 
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get]:
@@ -385,40 +252,13 @@ Definition hashmap_HashMap_get
   hashmap_HashMap_get_in_list T n key l
 .
 
-(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_mut_in_list]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 245:4-254:5 *)
-Fixpoint hashmap_HashMap_get_mut_in_list_loop
-  (T : Type) (n : nat) (ls : hashmap_List_t T) (key : usize) :
-  result (T * (T -> result (hashmap_List_t T)))
-  :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls with
-    | Hashmap_List_Cons ckey cvalue tl =>
-      if ckey s= key
-      then
-        let back := fun (ret : T) => Ok (Hashmap_List_Cons ckey ret tl) in
-        Ok (cvalue, back)
-      else (
-        p <- hashmap_HashMap_get_mut_in_list_loop T n1 tl key;
-        let (t, back) := p in
-        let back1 :=
-          fun (ret : T) =>
-            tl1 <- back ret; Ok (Hashmap_List_Cons ckey cvalue tl1) in
-        Ok (t, back1))
-    | Hashmap_List_Nil => Fail_ Failure
-    end
-  end
-.
-
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_mut_in_list]:
     Source: 'tests/src/hashmap.rs', lines 245:4-245:86 *)
 Definition hashmap_HashMap_get_mut_in_list
   (T : Type) (n : nat) (ls : hashmap_List_t T) (key : usize) :
   result (T * (T -> result (hashmap_List_t T)))
   :=
-  hashmap_HashMap_get_mut_in_list_loop T n ls key
+  admit
 .
 
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_mut]:
@@ -452,42 +292,13 @@ Definition hashmap_HashMap_get_mut
   Ok (t, back)
 .
 
-(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::remove_from_list]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 265:4-291:5 *)
-Fixpoint hashmap_HashMap_remove_from_list_loop
-  (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) :
-  result ((option T) * (hashmap_List_t T))
-  :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls with
-    | Hashmap_List_Cons ckey t tl =>
-      if ckey s= key
-      then
-        let (mv_ls, _) :=
-          core_mem_replace (hashmap_List_t T) (Hashmap_List_Cons ckey t tl)
-            Hashmap_List_Nil in
-        match mv_ls with
-        | Hashmap_List_Cons _ cvalue tl1 => Ok (Some cvalue, tl1)
-        | Hashmap_List_Nil => Fail_ Failure
-        end
-      else (
-        p <- hashmap_HashMap_remove_from_list_loop T n1 key tl;
-        let (o, tl1) := p in
-        Ok (o, Hashmap_List_Cons ckey t tl1))
-    | Hashmap_List_Nil => Ok (None, Hashmap_List_Nil)
-    end
-  end
-.
-
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::remove_from_list]:
     Source: 'tests/src/hashmap.rs', lines 265:4-265:69 *)
 Definition hashmap_HashMap_remove_from_list
   (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) :
   result ((option T) * (hashmap_List_t T))
   :=
-  hashmap_HashMap_remove_from_list_loop T n key ls
+  admit
 .
 
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::remove]:
diff --git a/tests/coq/misc/Loops.v b/tests/coq/misc/Loops.v
index bf0a8bc1..bd2b287b 100644
--- a/tests/coq/misc/Loops.v
+++ b/tests/coq/misc/Loops.v
@@ -93,32 +93,11 @@ Definition sum_array (N : usize) (n : nat) (a : array u32 N) : result u32 :=
   sum_array_loop N n a 0%usize 0%u32
 .
 
-(** [loops::clear]: loop 0:
-    Source: 'tests/src/loops.rs', lines 62:0-68:1 *)
-Fixpoint clear_loop
-  (n : nat) (v : alloc_vec_Vec u32) (i : usize) : result (alloc_vec_Vec u32) :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    let i1 := alloc_vec_Vec_len u32 v in
-    if i s< i1
-    then (
-      p <-
-        alloc_vec_Vec_index_mut u32 usize
-          (core_slice_index_SliceIndexUsizeSliceTInst u32) v i;
-      let (_, index_mut_back) := p in
-      i2 <- usize_add i 1%usize;
-      v1 <- index_mut_back 0%u32;
-      clear_loop n1 v1 i2)
-    else Ok v
-  end
-.
-
 (** [loops::clear]:
     Source: 'tests/src/loops.rs', lines 62:0-62:30 *)
 Definition clear
   (n : nat) (v : alloc_vec_Vec u32) : result (alloc_vec_Vec u32) :=
-  clear_loop n v 0%usize
+  admit
 .
 
 (** [loops::List]
@@ -131,47 +110,10 @@ Inductive List_t (T : Type) :=
 Arguments List_Cons { _ }.
 Arguments List_Nil { _ }.
 
-(** [loops::list_mem]: loop 0:
-    Source: 'tests/src/loops.rs', lines 76:0-85:1 *)
-Fixpoint list_mem_loop (n : nat) (x : u32) (ls : List_t u32) : result bool :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls with
-    | List_Cons y tl => if y s= x then Ok true else list_mem_loop n1 x tl
-    | List_Nil => Ok false
-    end
-  end
-.
-
 (** [loops::list_mem]:
     Source: 'tests/src/loops.rs', lines 76:0-76:52 *)
 Definition list_mem (n : nat) (x : u32) (ls : List_t u32) : result bool :=
-  list_mem_loop n x ls
-.
-
-(** [loops::list_nth_mut_loop]: loop 0:
-    Source: 'tests/src/loops.rs', lines 88:0-98:1 *)
-Fixpoint list_nth_mut_loop_loop
-  (T : Type) (n : nat) (ls : List_t T) (i : u32) :
-  result (T * (T -> result (List_t T)))
-  :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls with
-    | List_Cons x tl =>
-      if i s= 0%u32
-      then let back := fun (ret : T) => Ok (List_Cons ret tl) in Ok (x, back)
-      else (
-        i1 <- u32_sub i 1%u32;
-        p <- list_nth_mut_loop_loop T n1 tl i1;
-        let (t, back) := p in
-        let back1 := fun (ret : T) => tl1 <- back ret; Ok (List_Cons x tl1) in
-        Ok (t, back1))
-    | List_Nil => Fail_ Failure
-    end
-  end
+  admit
 .
 
 (** [loops::list_nth_mut_loop]:
@@ -180,56 +122,14 @@ Definition list_nth_mut_loop
   (T : Type) (n : nat) (ls : List_t T) (i : u32) :
   result (T * (T -> result (List_t T)))
   :=
-  list_nth_mut_loop_loop T n ls i
-.
-
-(** [loops::list_nth_shared_loop]: loop 0:
-    Source: 'tests/src/loops.rs', lines 101:0-111:1 *)
-Fixpoint list_nth_shared_loop_loop
-  (T : Type) (n : nat) (ls : List_t T) (i : u32) : result T :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls with
-    | List_Cons x tl =>
-      if i s= 0%u32
-      then Ok x
-      else (i1 <- u32_sub i 1%u32; list_nth_shared_loop_loop T n1 tl i1)
-    | List_Nil => Fail_ Failure
-    end
-  end
+  admit
 .
 
 (** [loops::list_nth_shared_loop]:
     Source: 'tests/src/loops.rs', lines 101:0-101:66 *)
 Definition list_nth_shared_loop
   (T : Type) (n : nat) (ls : List_t T) (i : u32) : result T :=
-  list_nth_shared_loop_loop T n ls i
-.
-
-(** [loops::get_elem_mut]: loop 0:
-    Source: 'tests/src/loops.rs', lines 113:0-127:1 *)
-Fixpoint get_elem_mut_loop
-  (n : nat) (x : usize) (ls : List_t usize) :
-  result (usize * (usize -> result (List_t usize)))
-  :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls with
-    | List_Cons y tl =>
-      if y s= x
-      then
-        let back := fun (ret : usize) => Ok (List_Cons ret tl) in Ok (y, back)
-      else (
-        p <- get_elem_mut_loop n1 x tl;
-        let (i, back) := p in
-        let back1 := fun (ret : usize) => tl1 <- back ret; Ok (List_Cons y tl1)
-          in
-        Ok (i, back1))
-    | List_Nil => Fail_ Failure
-    end
-  end
+  admit
 .
 
 (** [loops::get_elem_mut]:
@@ -238,28 +138,7 @@ Definition get_elem_mut
   (n : nat) (slots : alloc_vec_Vec (List_t usize)) (x : usize) :
   result (usize * (usize -> result (alloc_vec_Vec (List_t usize))))
   :=
-  p <-
-    alloc_vec_Vec_index_mut (List_t usize) usize
-      (core_slice_index_SliceIndexUsizeSliceTInst (List_t usize)) slots 0%usize;
-  let (ls, index_mut_back) := p in
-  p1 <- get_elem_mut_loop n x ls;
-  let (i, back) := p1 in
-  let back1 := fun (ret : usize) => l <- back ret; index_mut_back l in
-  Ok (i, back1)
-.
-
-(** [loops::get_elem_shared]: loop 0:
-    Source: 'tests/src/loops.rs', lines 129:0-143:1 *)
-Fixpoint get_elem_shared_loop
-  (n : nat) (x : usize) (ls : List_t usize) : result usize :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls with
-    | List_Cons y tl => if y s= x then Ok y else get_elem_shared_loop n1 x tl
-    | List_Nil => Fail_ Failure
-    end
-  end
+  admit
 .
 
 (** [loops::get_elem_shared]:
@@ -268,10 +147,7 @@ Definition get_elem_shared
   (n : nat) (slots : alloc_vec_Vec (List_t usize)) (x : usize) :
   result usize
   :=
-  ls <-
-    alloc_vec_Vec_index (List_t usize) usize
-      (core_slice_index_SliceIndexUsizeSliceTInst (List_t usize)) slots 0%usize;
-  get_elem_shared_loop n x ls
+  admit
 .
 
 (** [loops::id_mut]:
@@ -288,101 +164,20 @@ Definition id_mut
 Definition id_shared (T : Type) (ls : List_t T) : result (List_t T) :=
   Ok ls.
 
-(** [loops::list_nth_mut_loop_with_id]: loop 0:
-    Source: 'tests/src/loops.rs', lines 154:0-165:1 *)
-Fixpoint list_nth_mut_loop_with_id_loop
-  (T : Type) (n : nat) (i : u32) (ls : List_t T) :
-  result (T * (T -> result (List_t T)))
-  :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls with
-    | List_Cons x tl =>
-      if i s= 0%u32
-      then let back := fun (ret : T) => Ok (List_Cons ret tl) in Ok (x, back)
-      else (
-        i1 <- u32_sub i 1%u32;
-        p <- list_nth_mut_loop_with_id_loop T n1 i1 tl;
-        let (t, back) := p in
-        let back1 := fun (ret : T) => tl1 <- back ret; Ok (List_Cons x tl1) in
-        Ok (t, back1))
-    | List_Nil => Fail_ Failure
-    end
-  end
-.
-
 (** [loops::list_nth_mut_loop_with_id]:
     Source: 'tests/src/loops.rs', lines 154:0-154:75 *)
 Definition list_nth_mut_loop_with_id
   (T : Type) (n : nat) (ls : List_t T) (i : u32) :
   result (T * (T -> result (List_t T)))
   :=
-  p <- id_mut T ls;
-  let (ls1, id_mut_back) := p in
-  p1 <- list_nth_mut_loop_with_id_loop T n i ls1;
-  let (t, back) := p1 in
-  let back1 := fun (ret : T) => l <- back ret; id_mut_back l in
-  Ok (t, back1)
-.
-
-(** [loops::list_nth_shared_loop_with_id]: loop 0:
-    Source: 'tests/src/loops.rs', lines 168:0-179:1 *)
-Fixpoint list_nth_shared_loop_with_id_loop
-  (T : Type) (n : nat) (i : u32) (ls : List_t T) : result T :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls with
-    | List_Cons x tl =>
-      if i s= 0%u32
-      then Ok x
-      else (
-        i1 <- u32_sub i 1%u32; list_nth_shared_loop_with_id_loop T n1 i1 tl)
-    | List_Nil => Fail_ Failure
-    end
-  end
+  admit
 .
 
 (** [loops::list_nth_shared_loop_with_id]:
     Source: 'tests/src/loops.rs', lines 168:0-168:70 *)
 Definition list_nth_shared_loop_with_id
   (T : Type) (n : nat) (ls : List_t T) (i : u32) : result T :=
-  ls1 <- id_shared T ls; list_nth_shared_loop_with_id_loop T n i ls1
-.
-
-(** [loops::list_nth_mut_loop_pair]: loop 0:
-    Source: 'tests/src/loops.rs', lines 184:0-205:1 *)
-Fixpoint list_nth_mut_loop_pair_loop
-  (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) :
-  result ((T * T) * (T -> result (List_t T)) * (T -> result (List_t T)))
-  :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls0 with
-    | List_Cons x0 tl0 =>
-      match ls1 with
-      | List_Cons x1 tl1 =>
-        if i s= 0%u32
-        then
-          let back'a := fun (ret : T) => Ok (List_Cons ret tl0) in
-          let back'b := fun (ret : T) => Ok (List_Cons ret tl1) in
-          Ok ((x0, x1), back'a, back'b)
-        else (
-          i1 <- u32_sub i 1%u32;
-          t <- list_nth_mut_loop_pair_loop T n1 tl0 tl1 i1;
-          let '(p, back'a, back'b) := t in
-          let back'a1 :=
-            fun (ret : T) => tl01 <- back'a ret; Ok (List_Cons x0 tl01) in
-          let back'b1 :=
-            fun (ret : T) => tl11 <- back'b ret; Ok (List_Cons x1 tl11) in
-          Ok (p, back'a1, back'b1))
-      | List_Nil => Fail_ Failure
-      end
-    | List_Nil => Fail_ Failure
-    end
-  end
+  admit
 .
 
 (** [loops::list_nth_mut_loop_pair]:
@@ -391,31 +186,7 @@ Definition list_nth_mut_loop_pair
   (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) :
   result ((T * T) * (T -> result (List_t T)) * (T -> result (List_t T)))
   :=
-  list_nth_mut_loop_pair_loop T n ls0 ls1 i
-.
-
-(** [loops::list_nth_shared_loop_pair]: loop 0:
-    Source: 'tests/src/loops.rs', lines 208:0-229:1 *)
-Fixpoint list_nth_shared_loop_pair_loop
-  (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) :
-  result (T * T)
-  :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls0 with
-    | List_Cons x0 tl0 =>
-      match ls1 with
-      | List_Cons x1 tl1 =>
-        if i s= 0%u32
-        then Ok (x0, x1)
-        else (
-          i1 <- u32_sub i 1%u32; list_nth_shared_loop_pair_loop T n1 tl0 tl1 i1)
-      | List_Nil => Fail_ Failure
-      end
-    | List_Nil => Fail_ Failure
-    end
-  end
+  admit
 .
 
 (** [loops::list_nth_shared_loop_pair]:
@@ -424,43 +195,7 @@ Definition list_nth_shared_loop_pair
   (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) :
   result (T * T)
   :=
-  list_nth_shared_loop_pair_loop T n ls0 ls1 i
-.
-
-(** [loops::list_nth_mut_loop_pair_merge]: loop 0:
-    Source: 'tests/src/loops.rs', lines 233:0-248:1 *)
-Fixpoint list_nth_mut_loop_pair_merge_loop
-  (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) :
-  result ((T * T) * ((T * T) -> result ((List_t T) * (List_t T))))
-  :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls0 with
-    | List_Cons x0 tl0 =>
-      match ls1 with
-      | List_Cons x1 tl1 =>
-        if i s= 0%u32
-        then
-          let back :=
-            fun (ret : (T * T)) =>
-              let (t, t1) := ret in Ok (List_Cons t tl0, List_Cons t1 tl1) in
-          Ok ((x0, x1), back)
-        else (
-          i1 <- u32_sub i 1%u32;
-          p <- list_nth_mut_loop_pair_merge_loop T n1 tl0 tl1 i1;
-          let (p1, back) := p in
-          let back1 :=
-            fun (ret : (T * T)) =>
-              p2 <- back ret;
-              let (tl01, tl11) := p2 in
-              Ok (List_Cons x0 tl01, List_Cons x1 tl11) in
-          Ok (p1, back1))
-      | List_Nil => Fail_ Failure
-      end
-    | List_Nil => Fail_ Failure
-    end
-  end
+  admit
 .
 
 (** [loops::list_nth_mut_loop_pair_merge]:
@@ -469,32 +204,7 @@ Definition list_nth_mut_loop_pair_merge
   (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) :
   result ((T * T) * ((T * T) -> result ((List_t T) * (List_t T))))
   :=
-  list_nth_mut_loop_pair_merge_loop T n ls0 ls1 i
-.
-
-(** [loops::list_nth_shared_loop_pair_merge]: loop 0:
-    Source: 'tests/src/loops.rs', lines 251:0-266:1 *)
-Fixpoint list_nth_shared_loop_pair_merge_loop
-  (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) :
-  result (T * T)
-  :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls0 with
-    | List_Cons x0 tl0 =>
-      match ls1 with
-      | List_Cons x1 tl1 =>
-        if i s= 0%u32
-        then Ok (x0, x1)
-        else (
-          i1 <- u32_sub i 1%u32;
-          list_nth_shared_loop_pair_merge_loop T n1 tl0 tl1 i1)
-      | List_Nil => Fail_ Failure
-      end
-    | List_Nil => Fail_ Failure
-    end
-  end
+  admit
 .
 
 (** [loops::list_nth_shared_loop_pair_merge]:
@@ -503,38 +213,7 @@ Definition list_nth_shared_loop_pair_merge
   (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) :
   result (T * T)
   :=
-  list_nth_shared_loop_pair_merge_loop T n ls0 ls1 i
-.
-
-(** [loops::list_nth_mut_shared_loop_pair]: loop 0:
-    Source: 'tests/src/loops.rs', lines 269:0-284:1 *)
-Fixpoint list_nth_mut_shared_loop_pair_loop
-  (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) :
-  result ((T * T) * (T -> result (List_t T)))
-  :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls0 with
-    | List_Cons x0 tl0 =>
-      match ls1 with
-      | List_Cons x1 tl1 =>
-        if i s= 0%u32
-        then
-          let back := fun (ret : T) => Ok (List_Cons ret tl0) in
-          Ok ((x0, x1), back)
-        else (
-          i1 <- u32_sub i 1%u32;
-          p <- list_nth_mut_shared_loop_pair_loop T n1 tl0 tl1 i1;
-          let (p1, back) := p in
-          let back1 :=
-            fun (ret : T) => tl01 <- back ret; Ok (List_Cons x0 tl01) in
-          Ok (p1, back1))
-      | List_Nil => Fail_ Failure
-      end
-    | List_Nil => Fail_ Failure
-    end
-  end
+  admit
 .
 
 (** [loops::list_nth_mut_shared_loop_pair]:
@@ -543,38 +222,7 @@ Definition list_nth_mut_shared_loop_pair
   (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) :
   result ((T * T) * (T -> result (List_t T)))
   :=
-  list_nth_mut_shared_loop_pair_loop T n ls0 ls1 i
-.
-
-(** [loops::list_nth_mut_shared_loop_pair_merge]: loop 0:
-    Source: 'tests/src/loops.rs', lines 288:0-303:1 *)
-Fixpoint list_nth_mut_shared_loop_pair_merge_loop
-  (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) :
-  result ((T * T) * (T -> result (List_t T)))
-  :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls0 with
-    | List_Cons x0 tl0 =>
-      match ls1 with
-      | List_Cons x1 tl1 =>
-        if i s= 0%u32
-        then
-          let back := fun (ret : T) => Ok (List_Cons ret tl0) in
-          Ok ((x0, x1), back)
-        else (
-          i1 <- u32_sub i 1%u32;
-          p <- list_nth_mut_shared_loop_pair_merge_loop T n1 tl0 tl1 i1;
-          let (p1, back) := p in
-          let back1 :=
-            fun (ret : T) => tl01 <- back ret; Ok (List_Cons x0 tl01) in
-          Ok (p1, back1))
-      | List_Nil => Fail_ Failure
-      end
-    | List_Nil => Fail_ Failure
-    end
-  end
+  admit
 .
 
 (** [loops::list_nth_mut_shared_loop_pair_merge]:
@@ -583,38 +231,7 @@ Definition list_nth_mut_shared_loop_pair_merge
   (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) :
   result ((T * T) * (T -> result (List_t T)))
   :=
-  list_nth_mut_shared_loop_pair_merge_loop T n ls0 ls1 i
-.
-
-(** [loops::list_nth_shared_mut_loop_pair]: loop 0:
-    Source: 'tests/src/loops.rs', lines 307:0-322:1 *)
-Fixpoint list_nth_shared_mut_loop_pair_loop
-  (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) :
-  result ((T * T) * (T -> result (List_t T)))
-  :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls0 with
-    | List_Cons x0 tl0 =>
-      match ls1 with
-      | List_Cons x1 tl1 =>
-        if i s= 0%u32
-        then
-          let back := fun (ret : T) => Ok (List_Cons ret tl1) in
-          Ok ((x0, x1), back)
-        else (
-          i1 <- u32_sub i 1%u32;
-          p <- list_nth_shared_mut_loop_pair_loop T n1 tl0 tl1 i1;
-          let (p1, back) := p in
-          let back1 :=
-            fun (ret : T) => tl11 <- back ret; Ok (List_Cons x1 tl11) in
-          Ok (p1, back1))
-      | List_Nil => Fail_ Failure
-      end
-    | List_Nil => Fail_ Failure
-    end
-  end
+  admit
 .
 
 (** [loops::list_nth_shared_mut_loop_pair]:
@@ -623,38 +240,7 @@ Definition list_nth_shared_mut_loop_pair
   (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) :
   result ((T * T) * (T -> result (List_t T)))
   :=
-  list_nth_shared_mut_loop_pair_loop T n ls0 ls1 i
-.
-
-(** [loops::list_nth_shared_mut_loop_pair_merge]: loop 0:
-    Source: 'tests/src/loops.rs', lines 326:0-341:1 *)
-Fixpoint list_nth_shared_mut_loop_pair_merge_loop
-  (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) :
-  result ((T * T) * (T -> result (List_t T)))
-  :=
-  match n with
-  | O => Fail_ OutOfFuel
-  | S n1 =>
-    match ls0 with
-    | List_Cons x0 tl0 =>
-      match ls1 with
-      | List_Cons x1 tl1 =>
-        if i s= 0%u32
-        then
-          let back := fun (ret : T) => Ok (List_Cons ret tl1) in
-          Ok ((x0, x1), back)
-        else (
-          i1 <- u32_sub i 1%u32;
-          p <- list_nth_shared_mut_loop_pair_merge_loop T n1 tl0 tl1 i1;
-          let (p1, back) := p in
-          let back1 :=
-            fun (ret : T) => tl11 <- back ret; Ok (List_Cons x1 tl11) in
-          Ok (p1, back1))
-      | List_Nil => Fail_ Failure
-      end
-    | List_Nil => Fail_ Failure
-    end
-  end
+  admit
 .
 
 (** [loops::list_nth_shared_mut_loop_pair_merge]:
@@ -663,7 +249,7 @@ Definition list_nth_shared_mut_loop_pair_merge
   (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) :
   result ((T * T) * (T -> result (List_t T)))
   :=
-  list_nth_shared_mut_loop_pair_merge_loop T n ls0 ls1 i
+  admit
 .
 
 (** [loops::ignore_input_mut_borrow]: loop 0:
diff --git a/tests/fstar/arrays/Arrays.Clauses.Template.fst b/tests/fstar/arrays/Arrays.Clauses.Template.fst
index e695b89b..c189e41e 100644
--- a/tests/fstar/arrays/Arrays.Clauses.Template.fst
+++ b/tests/fstar/arrays/Arrays.Clauses.Template.fst
@@ -6,25 +6,6 @@ open Arrays.Types
 
 #set-options "--z3rlimit 50 --fuel 1 --ifuel 1"
 
-(** [arrays::sum]: decreases clause
-    Source: 'tests/src/arrays.rs', lines 242:0-250:1 *)
-unfold
-let sum_loop_decreases (s : slice u32) (sum1 : u32) (i : usize) : nat =
-  admit ()
-
-(** [arrays::sum2]: decreases clause
-    Source: 'tests/src/arrays.rs', lines 252:0-261:1 *)
-unfold
-let sum2_loop_decreases (s : slice u32) (s2 : slice u32) (sum1 : u32)
-  (i : usize) : nat =
-  admit ()
-
-(** [arrays::zero_slice]: decreases clause
-    Source: 'tests/src/arrays.rs', lines 303:0-310:1 *)
-unfold
-let zero_slice_loop_decreases (a : slice u8) (i : usize) (len : usize) : nat =
-  admit ()
-
 (** [arrays::iter_mut_slice]: decreases clause
     Source: 'tests/src/arrays.rs', lines 312:0-318:1 *)
 unfold
diff --git a/tests/fstar/arrays/Arrays.Funs.fst b/tests/fstar/arrays/Arrays.Funs.fst
index 6196e3b7..f77b9c40 100644
--- a/tests/fstar/arrays/Arrays.Funs.fst
+++ b/tests/fstar/arrays/Arrays.Funs.fst
@@ -306,49 +306,15 @@ let take_array_t (a : array aB_t 2) : result unit =
 let non_copyable_array : result unit =
   take_array_t (mk_array aB_t 2 [ AB_A; AB_B ])
 
-(** [arrays::sum]: loop 0:
-    Source: 'tests/src/arrays.rs', lines 242:0-250:1 *)
-let rec sum_loop
-  (s : slice u32) (sum1 : u32) (i : usize) :
-  Tot (result u32) (decreases (sum_loop_decreases s sum1 i))
-  =
-  let i1 = slice_len u32 s in
-  if i < i1
-  then
-    let* i2 = slice_index_usize u32 s i in
-    let* sum3 = u32_add sum1 i2 in
-    let* i3 = usize_add i 1 in
-    sum_loop s sum3 i3
-  else Ok sum1
-
 (** [arrays::sum]:
     Source: 'tests/src/arrays.rs', lines 242:0-242:28 *)
 let sum (s : slice u32) : result u32 =
-  sum_loop s 0 0
-
-(** [arrays::sum2]: loop 0:
-    Source: 'tests/src/arrays.rs', lines 252:0-261:1 *)
-let rec sum2_loop
-  (s : slice u32) (s2 : slice u32) (sum1 : u32) (i : usize) :
-  Tot (result u32) (decreases (sum2_loop_decreases s s2 sum1 i))
-  =
-  let i1 = slice_len u32 s in
-  if i < i1
-  then
-    let* i2 = slice_index_usize u32 s i in
-    let* i3 = slice_index_usize u32 s2 i in
-    let* i4 = u32_add i2 i3 in
-    let* sum3 = u32_add sum1 i4 in
-    let* i5 = usize_add i 1 in
-    sum2_loop s s2 sum3 i5
-  else Ok sum1
+  admit
 
 (** [arrays::sum2]:
     Source: 'tests/src/arrays.rs', lines 252:0-252:41 *)
 let sum2 (s : slice u32) (s2 : slice u32) : result u32 =
-  let i = slice_len u32 s in
-  let i1 = slice_len u32 s2 in
-  if not (i = i1) then Fail Failure else sum2_loop s s2 0 0
+  admit
 
 (** [arrays::f0]:
     Source: 'tests/src/arrays.rs', lines 263:0-263:11 *)
@@ -414,24 +380,10 @@ let ite : result unit =
   let* _ = to_slice_mut_back s1 in
   Ok ()
 
-(** [arrays::zero_slice]: loop 0:
-    Source: 'tests/src/arrays.rs', lines 303:0-310:1 *)
-let rec zero_slice_loop
-  (a : slice u8) (i : usize) (len : usize) :
-  Tot (result (slice u8)) (decreases (zero_slice_loop_decreases a i len))
-  =
-  if i < len
-  then
-    let* (_, index_mut_back) = slice_index_mut_usize u8 a i in
-    let* i1 = usize_add i 1 in
-    let* a1 = index_mut_back 0 in
-    zero_slice_loop a1 i1 len
-  else Ok a
-
 (** [arrays::zero_slice]:
     Source: 'tests/src/arrays.rs', lines 303:0-303:31 *)
 let zero_slice (a : slice u8) : result (slice u8) =
-  let len = slice_len u8 a in zero_slice_loop a 0 len
+  admit
 
 (** [arrays::iter_mut_slice]: loop 0:
     Source: 'tests/src/arrays.rs', lines 312:0-318:1 *)
diff --git a/tests/fstar/demo/Demo.fst b/tests/fstar/demo/Demo.fst
index 41fd9804..c78dab8e 100644
--- a/tests/fstar/demo/Demo.fst
+++ b/tests/fstar/demo/Demo.fst
@@ -76,35 +76,13 @@ let rec list_nth_mut
     | CList_CNil -> Fail Failure
     end
 
-(** [demo::list_nth_mut1]: loop 0:
-    Source: 'tests/src/demo.rs', lines 69:0-78:1 *)
-let rec list_nth_mut1_loop
-  (t : Type0) (n : nat) (l : cList_t t) (i : u32) :
-  result (t & (t -> result (cList_t t)))
-  =
-  if is_zero n
-  then Fail OutOfFuel
-  else
-    let n1 = decrease n in
-    begin match l with
-    | CList_CCons x tl ->
-      if i = 0
-      then let back = fun ret -> Ok (CList_CCons ret tl) in Ok (x, back)
-      else
-        let* i1 = u32_sub i 1 in
-        let* (x1, back) = list_nth_mut1_loop t n1 tl i1 in
-        let back1 = fun ret -> let* tl1 = back ret in Ok (CList_CCons x tl1) in
-        Ok (x1, back1)
-    | CList_CNil -> Fail Failure
-    end
-
 (** [demo::list_nth_mut1]:
     Source: 'tests/src/demo.rs', lines 69:0-69:77 *)
 let list_nth_mut1
   (t : Type0) (n : nat) (l : cList_t t) (i : u32) :
   result (t & (t -> result (cList_t t)))
   =
-  list_nth_mut1_loop t n l i
+  admit
 
 (** [demo::i32_id]:
     Source: 'tests/src/demo.rs', lines 80:0-80:28 *)
diff --git a/tests/fstar/hashmap/Hashmap.Clauses.Template.fst b/tests/fstar/hashmap/Hashmap.Clauses.Template.fst
index b96f6784..5effb67a 100644
--- a/tests/fstar/hashmap/Hashmap.Clauses.Template.fst
+++ b/tests/fstar/hashmap/Hashmap.Clauses.Template.fst
@@ -13,59 +13,3 @@ let hashMap_allocate_slots_loop_decreases (t : Type0)
   (slots : alloc_vec_Vec (list_t t)) (n : usize) : nat =
   admit ()
 
-(** [hashmap::{hashmap::HashMap<T>}::clear]: decreases clause
-    Source: 'tests/src/hashmap.rs', lines 80:4-88:5 *)
-unfold
-let hashMap_clear_loop_decreases (t : Type0) (slots : alloc_vec_Vec (list_t t))
-  (i : usize) : nat =
-  admit ()
-
-(** [hashmap::{hashmap::HashMap<T>}::insert_in_list]: decreases clause
-    Source: 'tests/src/hashmap.rs', lines 97:4-114:5 *)
-unfold
-let hashMap_insert_in_list_loop_decreases (t : Type0) (key : usize) (value : t)
-  (ls : list_t t) : nat =
-  admit ()
-
-(** [hashmap::{hashmap::HashMap<T>}::move_elements_from_list]: decreases clause
-    Source: 'tests/src/hashmap.rs', lines 183:4-196:5 *)
-unfold
-let hashMap_move_elements_from_list_loop_decreases (t : Type0)
-  (ntable : hashMap_t t) (ls : list_t t) : nat =
-  admit ()
-
-(** [hashmap::{hashmap::HashMap<T>}::move_elements]: decreases clause
-    Source: 'tests/src/hashmap.rs', lines 171:4-180:5 *)
-unfold
-let hashMap_move_elements_loop_decreases (t : Type0) (ntable : hashMap_t t)
-  (slots : alloc_vec_Vec (list_t t)) (i : usize) : nat =
-  admit ()
-
-(** [hashmap::{hashmap::HashMap<T>}::contains_key_in_list]: decreases clause
-    Source: 'tests/src/hashmap.rs', lines 206:4-219:5 *)
-unfold
-let hashMap_contains_key_in_list_loop_decreases (t : Type0) (key : usize)
-  (ls : list_t t) : nat =
-  admit ()
-
-(** [hashmap::{hashmap::HashMap<T>}::get_in_list]: decreases clause
-    Source: 'tests/src/hashmap.rs', lines 224:4-237:5 *)
-unfold
-let hashMap_get_in_list_loop_decreases (t : Type0) (key : usize)
-  (ls : list_t t) : nat =
-  admit ()
-
-(** [hashmap::{hashmap::HashMap<T>}::get_mut_in_list]: decreases clause
-    Source: 'tests/src/hashmap.rs', lines 245:4-254:5 *)
-unfold
-let hashMap_get_mut_in_list_loop_decreases (t : Type0) (ls : list_t t)
-  (key : usize) : nat =
-  admit ()
-
-(** [hashmap::{hashmap::HashMap<T>}::remove_from_list]: decreases clause
-    Source: 'tests/src/hashmap.rs', lines 265:4-291:5 *)
-unfold
-let hashMap_remove_from_list_loop_decreases (t : Type0) (key : usize)
-  (ls : list_t t) : nat =
-  admit ()
-
diff --git a/tests/fstar/hashmap/Hashmap.Funs.fst b/tests/fstar/hashmap/Hashmap.Funs.fst
index 2aca9fbe..638cd66f 100644
--- a/tests/fstar/hashmap/Hashmap.Funs.fst
+++ b/tests/fstar/hashmap/Hashmap.Funs.fst
@@ -58,59 +58,23 @@ let hashMap_new_with_capacity
 let hashMap_new (t : Type0) : result (hashMap_t t) =
   hashMap_new_with_capacity t 32 4 5
 
-(** [hashmap::{hashmap::HashMap<T>}::clear]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 80:4-88:5 *)
-let rec hashMap_clear_loop
-  (t : Type0) (slots : alloc_vec_Vec (list_t t)) (i : usize) :
-  Tot (result (alloc_vec_Vec (list_t t)))
-  (decreases (hashMap_clear_loop_decreases t slots i))
-  =
-  let i1 = alloc_vec_Vec_len (list_t t) slots in
-  if i < i1
-  then
-    let* (_, index_mut_back) =
-      alloc_vec_Vec_index_mut (list_t t) usize
-        (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) slots i in
-    let* i2 = usize_add i 1 in
-    let* slots1 = index_mut_back List_Nil in
-    hashMap_clear_loop t slots1 i2
-  else Ok slots
-
 (** [hashmap::{hashmap::HashMap<T>}::clear]:
     Source: 'tests/src/hashmap.rs', lines 80:4-80:27 *)
 let hashMap_clear (t : Type0) (self : hashMap_t t) : result (hashMap_t t) =
-  let* hm = hashMap_clear_loop t self.slots 0 in
-  Ok { self with num_entries = 0; slots = hm }
+  admit
 
 (** [hashmap::{hashmap::HashMap<T>}::len]:
     Source: 'tests/src/hashmap.rs', lines 90:4-90:30 *)
 let hashMap_len (t : Type0) (self : hashMap_t t) : result usize =
   Ok self.num_entries
 
-(** [hashmap::{hashmap::HashMap<T>}::insert_in_list]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 97:4-114:5 *)
-let rec hashMap_insert_in_list_loop
-  (t : Type0) (key : usize) (value : t) (ls : list_t t) :
-  Tot (result (bool & (list_t t)))
-  (decreases (hashMap_insert_in_list_loop_decreases t key value ls))
-  =
-  begin match ls with
-  | List_Cons ckey cvalue tl ->
-    if ckey = key
-    then Ok (false, List_Cons ckey value tl)
-    else
-      let* (b, tl1) = hashMap_insert_in_list_loop t key value tl in
-      Ok (b, List_Cons ckey cvalue tl1)
-  | List_Nil -> Ok (true, List_Cons key value List_Nil)
-  end
-
 (** [hashmap::{hashmap::HashMap<T>}::insert_in_list]:
     Source: 'tests/src/hashmap.rs', lines 97:4-97:71 *)
 let hashMap_insert_in_list
   (t : Type0) (key : usize) (value : t) (ls : list_t t) :
   result (bool & (list_t t))
   =
-  hashMap_insert_in_list_loop t key value ls
+  admit
 
 (** [hashmap::{hashmap::HashMap<T>}::insert_no_resize]:
     Source: 'tests/src/hashmap.rs', lines 117:4-117:54 *)
@@ -133,46 +97,11 @@ let hashMap_insert_no_resize
     Ok { self with num_entries = i1; slots = v }
   else let* v = index_mut_back l1 in Ok { self with slots = v }
 
-(** [hashmap::{hashmap::HashMap<T>}::move_elements_from_list]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 183:4-196:5 *)
-let rec hashMap_move_elements_from_list_loop
-  (t : Type0) (ntable : hashMap_t t) (ls : list_t t) :
-  Tot (result (hashMap_t t))
-  (decreases (hashMap_move_elements_from_list_loop_decreases t ntable ls))
-  =
-  begin match ls with
-  | List_Cons k v tl ->
-    let* ntable1 = hashMap_insert_no_resize t ntable k v in
-    hashMap_move_elements_from_list_loop t ntable1 tl
-  | List_Nil -> Ok ntable
-  end
-
 (** [hashmap::{hashmap::HashMap<T>}::move_elements_from_list]:
     Source: 'tests/src/hashmap.rs', lines 183:4-183:72 *)
 let hashMap_move_elements_from_list
   (t : Type0) (ntable : hashMap_t t) (ls : list_t t) : result (hashMap_t t) =
-  hashMap_move_elements_from_list_loop t ntable ls
-
-(** [hashmap::{hashmap::HashMap<T>}::move_elements]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 171:4-180:5 *)
-let rec hashMap_move_elements_loop
-  (t : Type0) (ntable : hashMap_t t) (slots : alloc_vec_Vec (list_t t))
-  (i : usize) :
-  Tot (result ((hashMap_t t) & (alloc_vec_Vec (list_t t))))
-  (decreases (hashMap_move_elements_loop_decreases t ntable slots i))
-  =
-  let i1 = alloc_vec_Vec_len (list_t t) slots in
-  if i < i1
-  then
-    let* (l, index_mut_back) =
-      alloc_vec_Vec_index_mut (list_t t) usize
-        (core_slice_index_SliceIndexUsizeSliceTInst (list_t t)) slots i in
-    let (ls, l1) = core_mem_replace (list_t t) l List_Nil in
-    let* ntable1 = hashMap_move_elements_from_list t ntable ls in
-    let* i2 = usize_add i 1 in
-    let* slots1 = index_mut_back l1 in
-    hashMap_move_elements_loop t ntable1 slots1 i2
-  else Ok (ntable, slots)
+  admit
 
 (** [hashmap::{hashmap::HashMap<T>}::move_elements]:
     Source: 'tests/src/hashmap.rs', lines 171:4-171:95 *)
@@ -181,7 +110,7 @@ let hashMap_move_elements
   (i : usize) :
   result ((hashMap_t t) & (alloc_vec_Vec (list_t t)))
   =
-  hashMap_move_elements_loop t ntable slots i
+  admit
 
 (** [hashmap::{hashmap::HashMap<T>}::try_resize]:
     Source: 'tests/src/hashmap.rs', lines 140:4-140:28 *)
@@ -213,24 +142,11 @@ let hashMap_insert
   let* i = hashMap_len t self1 in
   if i > self1.max_load then hashMap_try_resize t self1 else Ok self1
 
-(** [hashmap::{hashmap::HashMap<T>}::contains_key_in_list]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 206:4-219:5 *)
-let rec hashMap_contains_key_in_list_loop
-  (t : Type0) (key : usize) (ls : list_t t) :
-  Tot (result bool)
-  (decreases (hashMap_contains_key_in_list_loop_decreases t key ls))
-  =
-  begin match ls with
-  | List_Cons ckey _ tl ->
-    if ckey = key then Ok true else hashMap_contains_key_in_list_loop t key tl
-  | List_Nil -> Ok false
-  end
-
 (** [hashmap::{hashmap::HashMap<T>}::contains_key_in_list]:
     Source: 'tests/src/hashmap.rs', lines 206:4-206:68 *)
 let hashMap_contains_key_in_list
   (t : Type0) (key : usize) (ls : list_t t) : result bool =
-  hashMap_contains_key_in_list_loop t key ls
+  admit
 
 (** [hashmap::{hashmap::HashMap<T>}::contains_key]:
     Source: 'tests/src/hashmap.rs', lines 199:4-199:49 *)
@@ -245,22 +161,10 @@ let hashMap_contains_key
       hash_mod in
   hashMap_contains_key_in_list t key l
 
-(** [hashmap::{hashmap::HashMap<T>}::get_in_list]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 224:4-237:5 *)
-let rec hashMap_get_in_list_loop
-  (t : Type0) (key : usize) (ls : list_t t) :
-  Tot (result t) (decreases (hashMap_get_in_list_loop_decreases t key ls))
-  =
-  begin match ls with
-  | List_Cons ckey cvalue tl ->
-    if ckey = key then Ok cvalue else hashMap_get_in_list_loop t key tl
-  | List_Nil -> Fail Failure
-  end
-
 (** [hashmap::{hashmap::HashMap<T>}::get_in_list]:
     Source: 'tests/src/hashmap.rs', lines 224:4-224:70 *)
 let hashMap_get_in_list (t : Type0) (key : usize) (ls : list_t t) : result t =
-  hashMap_get_in_list_loop t key ls
+  admit
 
 (** [hashmap::{hashmap::HashMap<T>}::get]:
     Source: 'tests/src/hashmap.rs', lines 239:4-239:55 *)
@@ -274,32 +178,13 @@ let hashMap_get (t : Type0) (self : hashMap_t t) (key : usize) : result t =
       hash_mod in
   hashMap_get_in_list t key l
 
-(** [hashmap::{hashmap::HashMap<T>}::get_mut_in_list]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 245:4-254:5 *)
-let rec hashMap_get_mut_in_list_loop
-  (t : Type0) (ls : list_t t) (key : usize) :
-  Tot (result (t & (t -> result (list_t t))))
-  (decreases (hashMap_get_mut_in_list_loop_decreases t ls key))
-  =
-  begin match ls with
-  | List_Cons ckey cvalue tl ->
-    if ckey = key
-    then let back = fun ret -> Ok (List_Cons ckey ret tl) in Ok (cvalue, back)
-    else
-      let* (x, back) = hashMap_get_mut_in_list_loop t tl key in
-      let back1 =
-        fun ret -> let* tl1 = back ret in Ok (List_Cons ckey cvalue tl1) in
-      Ok (x, back1)
-  | List_Nil -> Fail Failure
-  end
-
 (** [hashmap::{hashmap::HashMap<T>}::get_mut_in_list]:
     Source: 'tests/src/hashmap.rs', lines 245:4-245:86 *)
 let hashMap_get_mut_in_list
   (t : Type0) (ls : list_t t) (key : usize) :
   result (t & (t -> result (list_t t)))
   =
-  hashMap_get_mut_in_list_loop t ls key
+  admit
 
 (** [hashmap::{hashmap::HashMap<T>}::get_mut]:
     Source: 'tests/src/hashmap.rs', lines 257:4-257:67 *)
@@ -322,36 +207,13 @@ let hashMap_get_mut
       Ok { self with slots = v } in
   Ok (x, back)
 
-(** [hashmap::{hashmap::HashMap<T>}::remove_from_list]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 265:4-291:5 *)
-let rec hashMap_remove_from_list_loop
-  (t : Type0) (key : usize) (ls : list_t t) :
-  Tot (result ((option t) & (list_t t)))
-  (decreases (hashMap_remove_from_list_loop_decreases t key ls))
-  =
-  begin match ls with
-  | List_Cons ckey x tl ->
-    if ckey = key
-    then
-      let (mv_ls, _) =
-        core_mem_replace (list_t t) (List_Cons ckey x tl) List_Nil in
-      begin match mv_ls with
-      | List_Cons _ cvalue tl1 -> Ok (Some cvalue, tl1)
-      | List_Nil -> Fail Failure
-      end
-    else
-      let* (o, tl1) = hashMap_remove_from_list_loop t key tl in
-      Ok (o, List_Cons ckey x tl1)
-  | List_Nil -> Ok (None, List_Nil)
-  end
-
 (** [hashmap::{hashmap::HashMap<T>}::remove_from_list]:
     Source: 'tests/src/hashmap.rs', lines 265:4-265:69 *)
 let hashMap_remove_from_list
   (t : Type0) (key : usize) (ls : list_t t) :
   result ((option t) & (list_t t))
   =
-  hashMap_remove_from_list_loop t key ls
+  admit
 
 (** [hashmap::{hashmap::HashMap<T>}::remove]:
     Source: 'tests/src/hashmap.rs', lines 294:4-294:52 *)
diff --git a/tests/fstar/hashmap_on_disk/HashmapMain.Clauses.Template.fst b/tests/fstar/hashmap_on_disk/HashmapMain.Clauses.Template.fst
index 0715bdcb..3c6b4af0 100644
--- a/tests/fstar/hashmap_on_disk/HashmapMain.Clauses.Template.fst
+++ b/tests/fstar/hashmap_on_disk/HashmapMain.Clauses.Template.fst
@@ -13,60 +13,3 @@ let hashmap_HashMap_allocate_slots_loop_decreases (t : Type0)
   (slots : alloc_vec_Vec (hashmap_List_t t)) (n : usize) : nat =
   admit ()
 
-(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::clear]: decreases clause
-    Source: 'tests/src/hashmap.rs', lines 80:4-88:5 *)
-unfold
-let hashmap_HashMap_clear_loop_decreases (t : Type0)
-  (slots : alloc_vec_Vec (hashmap_List_t t)) (i : usize) : nat =
-  admit ()
-
-(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::insert_in_list]: decreases clause
-    Source: 'tests/src/hashmap.rs', lines 97:4-114:5 *)
-unfold
-let hashmap_HashMap_insert_in_list_loop_decreases (t : Type0) (key : usize)
-  (value : t) (ls : hashmap_List_t t) : nat =
-  admit ()
-
-(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements_from_list]: decreases clause
-    Source: 'tests/src/hashmap.rs', lines 183:4-196:5 *)
-unfold
-let hashmap_HashMap_move_elements_from_list_loop_decreases (t : Type0)
-  (ntable : hashmap_HashMap_t t) (ls : hashmap_List_t t) : nat =
-  admit ()
-
-(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements]: decreases clause
-    Source: 'tests/src/hashmap.rs', lines 171:4-180:5 *)
-unfold
-let hashmap_HashMap_move_elements_loop_decreases (t : Type0)
-  (ntable : hashmap_HashMap_t t) (slots : alloc_vec_Vec (hashmap_List_t t))
-  (i : usize) : nat =
-  admit ()
-
-(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::contains_key_in_list]: decreases clause
-    Source: 'tests/src/hashmap.rs', lines 206:4-219:5 *)
-unfold
-let hashmap_HashMap_contains_key_in_list_loop_decreases (t : Type0)
-  (key : usize) (ls : hashmap_List_t t) : nat =
-  admit ()
-
-(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_in_list]: decreases clause
-    Source: 'tests/src/hashmap.rs', lines 224:4-237:5 *)
-unfold
-let hashmap_HashMap_get_in_list_loop_decreases (t : Type0) (key : usize)
-  (ls : hashmap_List_t t) : nat =
-  admit ()
-
-(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_mut_in_list]: decreases clause
-    Source: 'tests/src/hashmap.rs', lines 245:4-254:5 *)
-unfold
-let hashmap_HashMap_get_mut_in_list_loop_decreases (t : Type0)
-  (ls : hashmap_List_t t) (key : usize) : nat =
-  admit ()
-
-(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::remove_from_list]: decreases clause
-    Source: 'tests/src/hashmap.rs', lines 265:4-291:5 *)
-unfold
-let hashmap_HashMap_remove_from_list_loop_decreases (t : Type0) (key : usize)
-  (ls : hashmap_List_t t) : nat =
-  admit ()
-
diff --git a/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst b/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst
index 4a032207..27041dd6 100644
--- a/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst
+++ b/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst
@@ -61,31 +61,11 @@ let hashmap_HashMap_new_with_capacity
 let hashmap_HashMap_new (t : Type0) : result (hashmap_HashMap_t t) =
   hashmap_HashMap_new_with_capacity t 32 4 5
 
-(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::clear]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 80:4-88:5 *)
-let rec hashmap_HashMap_clear_loop
-  (t : Type0) (slots : alloc_vec_Vec (hashmap_List_t t)) (i : usize) :
-  Tot (result (alloc_vec_Vec (hashmap_List_t t)))
-  (decreases (hashmap_HashMap_clear_loop_decreases t slots i))
-  =
-  let i1 = alloc_vec_Vec_len (hashmap_List_t t) slots in
-  if i < i1
-  then
-    let* (_, index_mut_back) =
-      alloc_vec_Vec_index_mut (hashmap_List_t t) usize
-        (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) slots i
-      in
-    let* i2 = usize_add i 1 in
-    let* slots1 = index_mut_back Hashmap_List_Nil in
-    hashmap_HashMap_clear_loop t slots1 i2
-  else Ok slots
-
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::clear]:
     Source: 'tests/src/hashmap.rs', lines 80:4-80:27 *)
 let hashmap_HashMap_clear
   (t : Type0) (self : hashmap_HashMap_t t) : result (hashmap_HashMap_t t) =
-  let* hm = hashmap_HashMap_clear_loop t self.slots 0 in
-  Ok { self with num_entries = 0; slots = hm }
+  admit
 
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::len]:
     Source: 'tests/src/hashmap.rs', lines 90:4-90:30 *)
@@ -93,30 +73,13 @@ let hashmap_HashMap_len
   (t : Type0) (self : hashmap_HashMap_t t) : result usize =
   Ok self.num_entries
 
-(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::insert_in_list]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 97:4-114:5 *)
-let rec hashmap_HashMap_insert_in_list_loop
-  (t : Type0) (key : usize) (value : t) (ls : hashmap_List_t t) :
-  Tot (result (bool & (hashmap_List_t t)))
-  (decreases (hashmap_HashMap_insert_in_list_loop_decreases t key value ls))
-  =
-  begin match ls with
-  | Hashmap_List_Cons ckey cvalue tl ->
-    if ckey = key
-    then Ok (false, Hashmap_List_Cons ckey value tl)
-    else
-      let* (b, tl1) = hashmap_HashMap_insert_in_list_loop t key value tl in
-      Ok (b, Hashmap_List_Cons ckey cvalue tl1)
-  | Hashmap_List_Nil -> Ok (true, Hashmap_List_Cons key value Hashmap_List_Nil)
-  end
-
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::insert_in_list]:
     Source: 'tests/src/hashmap.rs', lines 97:4-97:71 *)
 let hashmap_HashMap_insert_in_list
   (t : Type0) (key : usize) (value : t) (ls : hashmap_List_t t) :
   result (bool & (hashmap_List_t t))
   =
-  hashmap_HashMap_insert_in_list_loop t key value ls
+  admit
 
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::insert_no_resize]:
     Source: 'tests/src/hashmap.rs', lines 117:4-117:54 *)
@@ -139,50 +102,13 @@ let hashmap_HashMap_insert_no_resize
     Ok { self with num_entries = i1; slots = v }
   else let* v = index_mut_back l1 in Ok { self with slots = v }
 
-(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements_from_list]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 183:4-196:5 *)
-let rec hashmap_HashMap_move_elements_from_list_loop
-  (t : Type0) (ntable : hashmap_HashMap_t t) (ls : hashmap_List_t t) :
-  Tot (result (hashmap_HashMap_t t))
-  (decreases (
-    hashmap_HashMap_move_elements_from_list_loop_decreases t ntable ls))
-  =
-  begin match ls with
-  | Hashmap_List_Cons k v tl ->
-    let* ntable1 = hashmap_HashMap_insert_no_resize t ntable k v in
-    hashmap_HashMap_move_elements_from_list_loop t ntable1 tl
-  | Hashmap_List_Nil -> Ok ntable
-  end
-
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements_from_list]:
     Source: 'tests/src/hashmap.rs', lines 183:4-183:72 *)
 let hashmap_HashMap_move_elements_from_list
   (t : Type0) (ntable : hashmap_HashMap_t t) (ls : hashmap_List_t t) :
   result (hashmap_HashMap_t t)
   =
-  hashmap_HashMap_move_elements_from_list_loop t ntable ls
-
-(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 171:4-180:5 *)
-let rec hashmap_HashMap_move_elements_loop
-  (t : Type0) (ntable : hashmap_HashMap_t t)
-  (slots : alloc_vec_Vec (hashmap_List_t t)) (i : usize) :
-  Tot (result ((hashmap_HashMap_t t) & (alloc_vec_Vec (hashmap_List_t t))))
-  (decreases (hashmap_HashMap_move_elements_loop_decreases t ntable slots i))
-  =
-  let i1 = alloc_vec_Vec_len (hashmap_List_t t) slots in
-  if i < i1
-  then
-    let* (l, index_mut_back) =
-      alloc_vec_Vec_index_mut (hashmap_List_t t) usize
-        (core_slice_index_SliceIndexUsizeSliceTInst (hashmap_List_t t)) slots i
-      in
-    let (ls, l1) = core_mem_replace (hashmap_List_t t) l Hashmap_List_Nil in
-    let* ntable1 = hashmap_HashMap_move_elements_from_list t ntable ls in
-    let* i2 = usize_add i 1 in
-    let* slots1 = index_mut_back l1 in
-    hashmap_HashMap_move_elements_loop t ntable1 slots1 i2
-  else Ok (ntable, slots)
+  admit
 
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements]:
     Source: 'tests/src/hashmap.rs', lines 171:4-171:95 *)
@@ -191,7 +117,7 @@ let hashmap_HashMap_move_elements
   (slots : alloc_vec_Vec (hashmap_List_t t)) (i : usize) :
   result ((hashmap_HashMap_t t) & (alloc_vec_Vec (hashmap_List_t t)))
   =
-  hashmap_HashMap_move_elements_loop t ntable slots i
+  admit
 
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::try_resize]:
     Source: 'tests/src/hashmap.rs', lines 140:4-140:28 *)
@@ -223,26 +149,11 @@ let hashmap_HashMap_insert
   let* i = hashmap_HashMap_len t self1 in
   if i > self1.max_load then hashmap_HashMap_try_resize t self1 else Ok self1
 
-(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::contains_key_in_list]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 206:4-219:5 *)
-let rec hashmap_HashMap_contains_key_in_list_loop
-  (t : Type0) (key : usize) (ls : hashmap_List_t t) :
-  Tot (result bool)
-  (decreases (hashmap_HashMap_contains_key_in_list_loop_decreases t key ls))
-  =
-  begin match ls with
-  | Hashmap_List_Cons ckey _ tl ->
-    if ckey = key
-    then Ok true
-    else hashmap_HashMap_contains_key_in_list_loop t key tl
-  | Hashmap_List_Nil -> Ok false
-  end
-
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::contains_key_in_list]:
     Source: 'tests/src/hashmap.rs', lines 206:4-206:68 *)
 let hashmap_HashMap_contains_key_in_list
   (t : Type0) (key : usize) (ls : hashmap_List_t t) : result bool =
-  hashmap_HashMap_contains_key_in_list_loop t key ls
+  admit
 
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::contains_key]:
     Source: 'tests/src/hashmap.rs', lines 199:4-199:49 *)
@@ -257,24 +168,11 @@ let hashmap_HashMap_contains_key
       self.slots hash_mod in
   hashmap_HashMap_contains_key_in_list t key l
 
-(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_in_list]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 224:4-237:5 *)
-let rec hashmap_HashMap_get_in_list_loop
-  (t : Type0) (key : usize) (ls : hashmap_List_t t) :
-  Tot (result t)
-  (decreases (hashmap_HashMap_get_in_list_loop_decreases t key ls))
-  =
-  begin match ls with
-  | Hashmap_List_Cons ckey cvalue tl ->
-    if ckey = key then Ok cvalue else hashmap_HashMap_get_in_list_loop t key tl
-  | Hashmap_List_Nil -> Fail Failure
-  end
-
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_in_list]:
     Source: 'tests/src/hashmap.rs', lines 224:4-224:70 *)
 let hashmap_HashMap_get_in_list
   (t : Type0) (key : usize) (ls : hashmap_List_t t) : result t =
-  hashmap_HashMap_get_in_list_loop t key ls
+  admit
 
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get]:
     Source: 'tests/src/hashmap.rs', lines 239:4-239:55 *)
@@ -289,35 +187,13 @@ let hashmap_HashMap_get
       self.slots hash_mod in
   hashmap_HashMap_get_in_list t key l
 
-(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_mut_in_list]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 245:4-254:5 *)
-let rec hashmap_HashMap_get_mut_in_list_loop
-  (t : Type0) (ls : hashmap_List_t t) (key : usize) :
-  Tot (result (t & (t -> result (hashmap_List_t t))))
-  (decreases (hashmap_HashMap_get_mut_in_list_loop_decreases t ls key))
-  =
-  begin match ls with
-  | Hashmap_List_Cons ckey cvalue tl ->
-    if ckey = key
-    then
-      let back = fun ret -> Ok (Hashmap_List_Cons ckey ret tl) in
-      Ok (cvalue, back)
-    else
-      let* (x, back) = hashmap_HashMap_get_mut_in_list_loop t tl key in
-      let back1 =
-        fun ret ->
-          let* tl1 = back ret in Ok (Hashmap_List_Cons ckey cvalue tl1) in
-      Ok (x, back1)
-  | Hashmap_List_Nil -> Fail Failure
-  end
-
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_mut_in_list]:
     Source: 'tests/src/hashmap.rs', lines 245:4-245:86 *)
 let hashmap_HashMap_get_mut_in_list
   (t : Type0) (ls : hashmap_List_t t) (key : usize) :
   result (t & (t -> result (hashmap_List_t t)))
   =
-  hashmap_HashMap_get_mut_in_list_loop t ls key
+  admit
 
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_mut]:
     Source: 'tests/src/hashmap.rs', lines 257:4-257:67 *)
@@ -340,37 +216,13 @@ let hashmap_HashMap_get_mut
       Ok { self with slots = v } in
   Ok (x, back)
 
-(** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::remove_from_list]: loop 0:
-    Source: 'tests/src/hashmap.rs', lines 265:4-291:5 *)
-let rec hashmap_HashMap_remove_from_list_loop
-  (t : Type0) (key : usize) (ls : hashmap_List_t t) :
-  Tot (result ((option t) & (hashmap_List_t t)))
-  (decreases (hashmap_HashMap_remove_from_list_loop_decreases t key ls))
-  =
-  begin match ls with
-  | Hashmap_List_Cons ckey x tl ->
-    if ckey = key
-    then
-      let (mv_ls, _) =
-        core_mem_replace (hashmap_List_t t) (Hashmap_List_Cons ckey x tl)
-          Hashmap_List_Nil in
-      begin match mv_ls with
-      | Hashmap_List_Cons _ cvalue tl1 -> Ok (Some cvalue, tl1)
-      | Hashmap_List_Nil -> Fail Failure
-      end
-    else
-      let* (o, tl1) = hashmap_HashMap_remove_from_list_loop t key tl in
-      Ok (o, Hashmap_List_Cons ckey x tl1)
-  | Hashmap_List_Nil -> Ok (None, Hashmap_List_Nil)
-  end
-
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::remove_from_list]:
     Source: 'tests/src/hashmap.rs', lines 265:4-265:69 *)
 let hashmap_HashMap_remove_from_list
   (t : Type0) (key : usize) (ls : hashmap_List_t t) :
   result ((option t) & (hashmap_List_t t))
   =
-  hashmap_HashMap_remove_from_list_loop t key ls
+  admit
 
 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::remove]:
     Source: 'tests/src/hashmap.rs', lines 294:4-294:52 *)
diff --git a/tests/fstar/misc/Loops.Clauses.Template.fst b/tests/fstar/misc/Loops.Clauses.Template.fst
index 77f9c3e4..21c128bb 100644
--- a/tests/fstar/misc/Loops.Clauses.Template.fst
+++ b/tests/fstar/misc/Loops.Clauses.Template.fst
@@ -30,111 +30,6 @@ let sum_array_loop_decreases (n : usize) (a : array u32 n) (i : usize)
   (s : u32) : nat =
   admit ()
 
-(** [loops::clear]: decreases clause
-    Source: 'tests/src/loops.rs', lines 62:0-68:1 *)
-unfold
-let clear_loop_decreases (v : alloc_vec_Vec u32) (i : usize) : nat = admit ()
-
-(** [loops::list_mem]: decreases clause
-    Source: 'tests/src/loops.rs', lines 76:0-85:1 *)
-unfold let list_mem_loop_decreases (x : u32) (ls : list_t u32) : nat = admit ()
-
-(** [loops::list_nth_mut_loop]: decreases clause
-    Source: 'tests/src/loops.rs', lines 88:0-98:1 *)
-unfold
-let list_nth_mut_loop_loop_decreases (t : Type0) (ls : list_t t) (i : u32) :
-  nat =
-  admit ()
-
-(** [loops::list_nth_shared_loop]: decreases clause
-    Source: 'tests/src/loops.rs', lines 101:0-111:1 *)
-unfold
-let list_nth_shared_loop_loop_decreases (t : Type0) (ls : list_t t) (i : u32) :
-  nat =
-  admit ()
-
-(** [loops::get_elem_mut]: decreases clause
-    Source: 'tests/src/loops.rs', lines 113:0-127:1 *)
-unfold
-let get_elem_mut_loop_decreases (x : usize) (ls : list_t usize) : nat =
-  admit ()
-
-(** [loops::get_elem_shared]: decreases clause
-    Source: 'tests/src/loops.rs', lines 129:0-143:1 *)
-unfold
-let get_elem_shared_loop_decreases (x : usize) (ls : list_t usize) : nat =
-  admit ()
-
-(** [loops::list_nth_mut_loop_with_id]: decreases clause
-    Source: 'tests/src/loops.rs', lines 154:0-165:1 *)
-unfold
-let list_nth_mut_loop_with_id_loop_decreases (t : Type0) (i : u32)
-  (ls : list_t t) : nat =
-  admit ()
-
-(** [loops::list_nth_shared_loop_with_id]: decreases clause
-    Source: 'tests/src/loops.rs', lines 168:0-179:1 *)
-unfold
-let list_nth_shared_loop_with_id_loop_decreases (t : Type0) (i : u32)
-  (ls : list_t t) : nat =
-  admit ()
-
-(** [loops::list_nth_mut_loop_pair]: decreases clause
-    Source: 'tests/src/loops.rs', lines 184:0-205:1 *)
-unfold
-let list_nth_mut_loop_pair_loop_decreases (t : Type0) (ls0 : list_t t)
-  (ls1 : list_t t) (i : u32) : nat =
-  admit ()
-
-(** [loops::list_nth_shared_loop_pair]: decreases clause
-    Source: 'tests/src/loops.rs', lines 208:0-229:1 *)
-unfold
-let list_nth_shared_loop_pair_loop_decreases (t : Type0) (ls0 : list_t t)
-  (ls1 : list_t t) (i : u32) : nat =
-  admit ()
-
-(** [loops::list_nth_mut_loop_pair_merge]: decreases clause
-    Source: 'tests/src/loops.rs', lines 233:0-248:1 *)
-unfold
-let list_nth_mut_loop_pair_merge_loop_decreases (t : Type0) (ls0 : list_t t)
-  (ls1 : list_t t) (i : u32) : nat =
-  admit ()
-
-(** [loops::list_nth_shared_loop_pair_merge]: decreases clause
-    Source: 'tests/src/loops.rs', lines 251:0-266:1 *)
-unfold
-let list_nth_shared_loop_pair_merge_loop_decreases (t : Type0) (ls0 : list_t t)
-  (ls1 : list_t t) (i : u32) : nat =
-  admit ()
-
-(** [loops::list_nth_mut_shared_loop_pair]: decreases clause
-    Source: 'tests/src/loops.rs', lines 269:0-284:1 *)
-unfold
-let list_nth_mut_shared_loop_pair_loop_decreases (t : Type0) (ls0 : list_t t)
-  (ls1 : list_t t) (i : u32) : nat =
-  admit ()
-
-(** [loops::list_nth_mut_shared_loop_pair_merge]: decreases clause
-    Source: 'tests/src/loops.rs', lines 288:0-303:1 *)
-unfold
-let list_nth_mut_shared_loop_pair_merge_loop_decreases (t : Type0)
-  (ls0 : list_t t) (ls1 : list_t t) (i : u32) : nat =
-  admit ()
-
-(** [loops::list_nth_shared_mut_loop_pair]: decreases clause
-    Source: 'tests/src/loops.rs', lines 307:0-322:1 *)
-unfold
-let list_nth_shared_mut_loop_pair_loop_decreases (t : Type0) (ls0 : list_t t)
-  (ls1 : list_t t) (i : u32) : nat =
-  admit ()
-
-(** [loops::list_nth_shared_mut_loop_pair_merge]: decreases clause
-    Source: 'tests/src/loops.rs', lines 326:0-341:1 *)
-unfold
-let list_nth_shared_mut_loop_pair_merge_loop_decreases (t : Type0)
-  (ls0 : list_t t) (ls1 : list_t t) (i : u32) : nat =
-  admit ()
-
 (** [loops::ignore_input_mut_borrow]: decreases clause
     Source: 'tests/src/loops.rs', lines 345:0-349:1 *)
 unfold let ignore_input_mut_borrow_loop_decreases (i : u32) : nat = admit ()
diff --git a/tests/fstar/misc/Loops.Funs.fst b/tests/fstar/misc/Loops.Funs.fst
index 0eafeebb..dc53a04b 100644
--- a/tests/fstar/misc/Loops.Funs.fst
+++ b/tests/fstar/misc/Loops.Funs.fst
@@ -77,62 +77,15 @@ let rec sum_array_loop
 let sum_array (n : usize) (a : array u32 n) : result u32 =
   sum_array_loop n a 0 0
 
-(** [loops::clear]: loop 0:
-    Source: 'tests/src/loops.rs', lines 62:0-68:1 *)
-let rec clear_loop
-  (v : alloc_vec_Vec u32) (i : usize) :
-  Tot (result (alloc_vec_Vec u32)) (decreases (clear_loop_decreases v i))
-  =
-  let i1 = alloc_vec_Vec_len u32 v in
-  if i < i1
-  then
-    let* (_, index_mut_back) =
-      alloc_vec_Vec_index_mut u32 usize
-        (core_slice_index_SliceIndexUsizeSliceTInst u32) v i in
-    let* i2 = usize_add i 1 in
-    let* v1 = index_mut_back 0 in
-    clear_loop v1 i2
-  else Ok v
-
 (** [loops::clear]:
     Source: 'tests/src/loops.rs', lines 62:0-62:30 *)
 let clear (v : alloc_vec_Vec u32) : result (alloc_vec_Vec u32) =
-  clear_loop v 0
-
-(** [loops::list_mem]: loop 0:
-    Source: 'tests/src/loops.rs', lines 76:0-85:1 *)
-let rec list_mem_loop
-  (x : u32) (ls : list_t u32) :
-  Tot (result bool) (decreases (list_mem_loop_decreases x ls))
-  =
-  begin match ls with
-  | List_Cons y tl -> if y = x then Ok true else list_mem_loop x tl
-  | List_Nil -> Ok false
-  end
+  admit
 
 (** [loops::list_mem]:
     Source: 'tests/src/loops.rs', lines 76:0-76:52 *)
 let list_mem (x : u32) (ls : list_t u32) : result bool =
-  list_mem_loop x ls
-
-(** [loops::list_nth_mut_loop]: loop 0:
-    Source: 'tests/src/loops.rs', lines 88:0-98:1 *)
-let rec list_nth_mut_loop_loop
-  (t : Type0) (ls : list_t t) (i : u32) :
-  Tot (result (t & (t -> result (list_t t))))
-  (decreases (list_nth_mut_loop_loop_decreases t ls i))
-  =
-  begin match ls with
-  | List_Cons x tl ->
-    if i = 0
-    then let back = fun ret -> Ok (List_Cons ret tl) in Ok (x, back)
-    else
-      let* i1 = u32_sub i 1 in
-      let* (x1, back) = list_nth_mut_loop_loop t tl i1 in
-      let back1 = fun ret -> let* tl1 = back ret in Ok (List_Cons x tl1) in
-      Ok (x1, back1)
-  | List_Nil -> Fail Failure
-  end
+  admit
 
 (** [loops::list_nth_mut_loop]:
     Source: 'tests/src/loops.rs', lines 88:0-88:71 *)
@@ -140,44 +93,12 @@ let list_nth_mut_loop
   (t : Type0) (ls : list_t t) (i : u32) :
   result (t & (t -> result (list_t t)))
   =
-  list_nth_mut_loop_loop t ls i
-
-(** [loops::list_nth_shared_loop]: loop 0:
-    Source: 'tests/src/loops.rs', lines 101:0-111:1 *)
-let rec list_nth_shared_loop_loop
-  (t : Type0) (ls : list_t t) (i : u32) :
-  Tot (result t) (decreases (list_nth_shared_loop_loop_decreases t ls i))
-  =
-  begin match ls with
-  | List_Cons x tl ->
-    if i = 0
-    then Ok x
-    else let* i1 = u32_sub i 1 in list_nth_shared_loop_loop t tl i1
-  | List_Nil -> Fail Failure
-  end
+  admit
 
 (** [loops::list_nth_shared_loop]:
     Source: 'tests/src/loops.rs', lines 101:0-101:66 *)
 let list_nth_shared_loop (t : Type0) (ls : list_t t) (i : u32) : result t =
-  list_nth_shared_loop_loop t ls i
-
-(** [loops::get_elem_mut]: loop 0:
-    Source: 'tests/src/loops.rs', lines 113:0-127:1 *)
-let rec get_elem_mut_loop
-  (x : usize) (ls : list_t usize) :
-  Tot (result (usize & (usize -> result (list_t usize))))
-  (decreases (get_elem_mut_loop_decreases x ls))
-  =
-  begin match ls with
-  | List_Cons y tl ->
-    if y = x
-    then let back = fun ret -> Ok (List_Cons ret tl) in Ok (y, back)
-    else
-      let* (i, back) = get_elem_mut_loop x tl in
-      let back1 = fun ret -> let* tl1 = back ret in Ok (List_Cons y tl1) in
-      Ok (i, back1)
-  | List_Nil -> Fail Failure
-  end
+  admit
 
 (** [loops::get_elem_mut]:
     Source: 'tests/src/loops.rs', lines 113:0-113:73 *)
@@ -185,32 +106,13 @@ let get_elem_mut
   (slots : alloc_vec_Vec (list_t usize)) (x : usize) :
   result (usize & (usize -> result (alloc_vec_Vec (list_t usize))))
   =
-  let* (ls, index_mut_back) =
-    alloc_vec_Vec_index_mut (list_t usize) usize
-      (core_slice_index_SliceIndexUsizeSliceTInst (list_t usize)) slots 0 in
-  let* (i, back) = get_elem_mut_loop x ls in
-  let back1 = fun ret -> let* l = back ret in index_mut_back l in
-  Ok (i, back1)
-
-(** [loops::get_elem_shared]: loop 0:
-    Source: 'tests/src/loops.rs', lines 129:0-143:1 *)
-let rec get_elem_shared_loop
-  (x : usize) (ls : list_t usize) :
-  Tot (result usize) (decreases (get_elem_shared_loop_decreases x ls))
-  =
-  begin match ls with
-  | List_Cons y tl -> if y = x then Ok y else get_elem_shared_loop x tl
-  | List_Nil -> Fail Failure
-  end
+  admit
 
 (** [loops::get_elem_shared]:
     Source: 'tests/src/loops.rs', lines 129:0-129:68 *)
 let get_elem_shared
   (slots : alloc_vec_Vec (list_t usize)) (x : usize) : result usize =
-  let* ls =
-    alloc_vec_Vec_index (list_t usize) usize
-      (core_slice_index_SliceIndexUsizeSliceTInst (list_t usize)) slots 0 in
-  get_elem_shared_loop x ls
+  admit
 
 (** [loops::id_mut]:
     Source: 'tests/src/loops.rs', lines 145:0-145:50 *)
@@ -225,85 +127,19 @@ let id_mut
 let id_shared (t : Type0) (ls : list_t t) : result (list_t t) =
   Ok ls
 
-(** [loops::list_nth_mut_loop_with_id]: loop 0:
-    Source: 'tests/src/loops.rs', lines 154:0-165:1 *)
-let rec list_nth_mut_loop_with_id_loop
-  (t : Type0) (i : u32) (ls : list_t t) :
-  Tot (result (t & (t -> result (list_t t))))
-  (decreases (list_nth_mut_loop_with_id_loop_decreases t i ls))
-  =
-  begin match ls with
-  | List_Cons x tl ->
-    if i = 0
-    then let back = fun ret -> Ok (List_Cons ret tl) in Ok (x, back)
-    else
-      let* i1 = u32_sub i 1 in
-      let* (x1, back) = list_nth_mut_loop_with_id_loop t i1 tl in
-      let back1 = fun ret -> let* tl1 = back ret in Ok (List_Cons x tl1) in
-      Ok (x1, back1)
-  | List_Nil -> Fail Failure
-  end
-
 (** [loops::list_nth_mut_loop_with_id]:
     Source: 'tests/src/loops.rs', lines 154:0-154:75 *)
 let list_nth_mut_loop_with_id
   (t : Type0) (ls : list_t t) (i : u32) :
   result (t & (t -> result (list_t t)))
   =
-  let* (ls1, id_mut_back) = id_mut t ls in
-  let* (x, back) = list_nth_mut_loop_with_id_loop t i ls1 in
-  let back1 = fun ret -> let* l = back ret in id_mut_back l in
-  Ok (x, back1)
-
-(** [loops::list_nth_shared_loop_with_id]: loop 0:
-    Source: 'tests/src/loops.rs', lines 168:0-179:1 *)
-let rec list_nth_shared_loop_with_id_loop
-  (t : Type0) (i : u32) (ls : list_t t) :
-  Tot (result t)
-  (decreases (list_nth_shared_loop_with_id_loop_decreases t i ls))
-  =
-  begin match ls with
-  | List_Cons x tl ->
-    if i = 0
-    then Ok x
-    else let* i1 = u32_sub i 1 in list_nth_shared_loop_with_id_loop t i1 tl
-  | List_Nil -> Fail Failure
-  end
+  admit
 
 (** [loops::list_nth_shared_loop_with_id]:
     Source: 'tests/src/loops.rs', lines 168:0-168:70 *)
 let list_nth_shared_loop_with_id
   (t : Type0) (ls : list_t t) (i : u32) : result t =
-  let* ls1 = id_shared t ls in list_nth_shared_loop_with_id_loop t i ls1
-
-(** [loops::list_nth_mut_loop_pair]: loop 0:
-    Source: 'tests/src/loops.rs', lines 184:0-205:1 *)
-let rec list_nth_mut_loop_pair_loop
-  (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) :
-  Tot (result ((t & t) & (t -> result (list_t t)) & (t -> result (list_t t))))
-  (decreases (list_nth_mut_loop_pair_loop_decreases t ls0 ls1 i))
-  =
-  begin match ls0 with
-  | List_Cons x0 tl0 ->
-    begin match ls1 with
-    | List_Cons x1 tl1 ->
-      if i = 0
-      then
-        let back'a = fun ret -> Ok (List_Cons ret tl0) in
-        let back'b = fun ret -> Ok (List_Cons ret tl1) in
-        Ok ((x0, x1), back'a, back'b)
-      else
-        let* i1 = u32_sub i 1 in
-        let* (p, back'a, back'b) = list_nth_mut_loop_pair_loop t tl0 tl1 i1 in
-        let back'a1 =
-          fun ret -> let* tl01 = back'a ret in Ok (List_Cons x0 tl01) in
-        let back'b1 =
-          fun ret -> let* tl11 = back'b ret in Ok (List_Cons x1 tl11) in
-        Ok (p, back'a1, back'b1)
-    | List_Nil -> Fail Failure
-    end
-  | List_Nil -> Fail Failure
-  end
+  admit
 
 (** [loops::list_nth_mut_loop_pair]:
     Source: 'tests/src/loops.rs', lines 184:0-188:27 *)
@@ -311,62 +147,13 @@ let list_nth_mut_loop_pair
   (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) :
   result ((t & t) & (t -> result (list_t t)) & (t -> result (list_t t)))
   =
-  list_nth_mut_loop_pair_loop t ls0 ls1 i
-
-(** [loops::list_nth_shared_loop_pair]: loop 0:
-    Source: 'tests/src/loops.rs', lines 208:0-229:1 *)
-let rec list_nth_shared_loop_pair_loop
-  (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) :
-  Tot (result (t & t))
-  (decreases (list_nth_shared_loop_pair_loop_decreases t ls0 ls1 i))
-  =
-  begin match ls0 with
-  | List_Cons x0 tl0 ->
-    begin match ls1 with
-    | List_Cons x1 tl1 ->
-      if i = 0
-      then Ok (x0, x1)
-      else let* i1 = u32_sub i 1 in list_nth_shared_loop_pair_loop t tl0 tl1 i1
-    | List_Nil -> Fail Failure
-    end
-  | List_Nil -> Fail Failure
-  end
+  admit
 
 (** [loops::list_nth_shared_loop_pair]:
     Source: 'tests/src/loops.rs', lines 208:0-212:19 *)
 let list_nth_shared_loop_pair
   (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) =
-  list_nth_shared_loop_pair_loop t ls0 ls1 i
-
-(** [loops::list_nth_mut_loop_pair_merge]: loop 0:
-    Source: 'tests/src/loops.rs', lines 233:0-248:1 *)
-let rec list_nth_mut_loop_pair_merge_loop
-  (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) :
-  Tot (result ((t & t) & ((t & t) -> result ((list_t t) & (list_t t)))))
-  (decreases (list_nth_mut_loop_pair_merge_loop_decreases t ls0 ls1 i))
-  =
-  begin match ls0 with
-  | List_Cons x0 tl0 ->
-    begin match ls1 with
-    | List_Cons x1 tl1 ->
-      if i = 0
-      then
-        let back =
-          fun ret ->
-            let (x, x2) = ret in Ok (List_Cons x tl0, List_Cons x2 tl1) in
-        Ok ((x0, x1), back)
-      else
-        let* i1 = u32_sub i 1 in
-        let* (p, back) = list_nth_mut_loop_pair_merge_loop t tl0 tl1 i1 in
-        let back1 =
-          fun ret ->
-            let* (tl01, tl11) = back ret in
-            Ok (List_Cons x0 tl01, List_Cons x1 tl11) in
-        Ok (p, back1)
-    | List_Nil -> Fail Failure
-    end
-  | List_Nil -> Fail Failure
-  end
+  admit
 
 (** [loops::list_nth_mut_loop_pair_merge]:
     Source: 'tests/src/loops.rs', lines 233:0-237:27 *)
@@ -374,58 +161,13 @@ let list_nth_mut_loop_pair_merge
   (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) :
   result ((t & t) & ((t & t) -> result ((list_t t) & (list_t t))))
   =
-  list_nth_mut_loop_pair_merge_loop t ls0 ls1 i
-
-(** [loops::list_nth_shared_loop_pair_merge]: loop 0:
-    Source: 'tests/src/loops.rs', lines 251:0-266:1 *)
-let rec list_nth_shared_loop_pair_merge_loop
-  (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) :
-  Tot (result (t & t))
-  (decreases (list_nth_shared_loop_pair_merge_loop_decreases t ls0 ls1 i))
-  =
-  begin match ls0 with
-  | List_Cons x0 tl0 ->
-    begin match ls1 with
-    | List_Cons x1 tl1 ->
-      if i = 0
-      then Ok (x0, x1)
-      else
-        let* i1 = u32_sub i 1 in
-        list_nth_shared_loop_pair_merge_loop t tl0 tl1 i1
-    | List_Nil -> Fail Failure
-    end
-  | List_Nil -> Fail Failure
-  end
+  admit
 
 (** [loops::list_nth_shared_loop_pair_merge]:
     Source: 'tests/src/loops.rs', lines 251:0-255:19 *)
 let list_nth_shared_loop_pair_merge
   (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) =
-  list_nth_shared_loop_pair_merge_loop t ls0 ls1 i
-
-(** [loops::list_nth_mut_shared_loop_pair]: loop 0:
-    Source: 'tests/src/loops.rs', lines 269:0-284:1 *)
-let rec list_nth_mut_shared_loop_pair_loop
-  (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) :
-  Tot (result ((t & t) & (t -> result (list_t t))))
-  (decreases (list_nth_mut_shared_loop_pair_loop_decreases t ls0 ls1 i))
-  =
-  begin match ls0 with
-  | List_Cons x0 tl0 ->
-    begin match ls1 with
-    | List_Cons x1 tl1 ->
-      if i = 0
-      then let back = fun ret -> Ok (List_Cons ret tl0) in Ok ((x0, x1), back)
-      else
-        let* i1 = u32_sub i 1 in
-        let* (p, back) = list_nth_mut_shared_loop_pair_loop t tl0 tl1 i1 in
-        let back1 = fun ret -> let* tl01 = back ret in Ok (List_Cons x0 tl01)
-          in
-        Ok (p, back1)
-    | List_Nil -> Fail Failure
-    end
-  | List_Nil -> Fail Failure
-  end
+  admit
 
 (** [loops::list_nth_mut_shared_loop_pair]:
     Source: 'tests/src/loops.rs', lines 269:0-273:23 *)
@@ -433,32 +175,7 @@ let list_nth_mut_shared_loop_pair
   (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) :
   result ((t & t) & (t -> result (list_t t)))
   =
-  list_nth_mut_shared_loop_pair_loop t ls0 ls1 i
-
-(** [loops::list_nth_mut_shared_loop_pair_merge]: loop 0:
-    Source: 'tests/src/loops.rs', lines 288:0-303:1 *)
-let rec list_nth_mut_shared_loop_pair_merge_loop
-  (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) :
-  Tot (result ((t & t) & (t -> result (list_t t))))
-  (decreases (list_nth_mut_shared_loop_pair_merge_loop_decreases t ls0 ls1 i))
-  =
-  begin match ls0 with
-  | List_Cons x0 tl0 ->
-    begin match ls1 with
-    | List_Cons x1 tl1 ->
-      if i = 0
-      then let back = fun ret -> Ok (List_Cons ret tl0) in Ok ((x0, x1), back)
-      else
-        let* i1 = u32_sub i 1 in
-        let* (p, back) = list_nth_mut_shared_loop_pair_merge_loop t tl0 tl1 i1
-          in
-        let back1 = fun ret -> let* tl01 = back ret in Ok (List_Cons x0 tl01)
-          in
-        Ok (p, back1)
-    | List_Nil -> Fail Failure
-    end
-  | List_Nil -> Fail Failure
-  end
+  admit
 
 (** [loops::list_nth_mut_shared_loop_pair_merge]:
     Source: 'tests/src/loops.rs', lines 288:0-292:23 *)
@@ -466,31 +183,7 @@ let list_nth_mut_shared_loop_pair_merge
   (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) :
   result ((t & t) & (t -> result (list_t t)))
   =
-  list_nth_mut_shared_loop_pair_merge_loop t ls0 ls1 i
-
-(** [loops::list_nth_shared_mut_loop_pair]: loop 0:
-    Source: 'tests/src/loops.rs', lines 307:0-322:1 *)
-let rec list_nth_shared_mut_loop_pair_loop
-  (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) :
-  Tot (result ((t & t) & (t -> result (list_t t))))
-  (decreases (list_nth_shared_mut_loop_pair_loop_decreases t ls0 ls1 i))
-  =
-  begin match ls0 with
-  | List_Cons x0 tl0 ->
-    begin match ls1 with
-    | List_Cons x1 tl1 ->
-      if i = 0
-      then let back = fun ret -> Ok (List_Cons ret tl1) in Ok ((x0, x1), back)
-      else
-        let* i1 = u32_sub i 1 in
-        let* (p, back) = list_nth_shared_mut_loop_pair_loop t tl0 tl1 i1 in
-        let back1 = fun ret -> let* tl11 = back ret in Ok (List_Cons x1 tl11)
-          in
-        Ok (p, back1)
-    | List_Nil -> Fail Failure
-    end
-  | List_Nil -> Fail Failure
-  end
+  admit
 
 (** [loops::list_nth_shared_mut_loop_pair]:
     Source: 'tests/src/loops.rs', lines 307:0-311:23 *)
@@ -498,32 +191,7 @@ let list_nth_shared_mut_loop_pair
   (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) :
   result ((t & t) & (t -> result (list_t t)))
   =
-  list_nth_shared_mut_loop_pair_loop t ls0 ls1 i
-
-(** [loops::list_nth_shared_mut_loop_pair_merge]: loop 0:
-    Source: 'tests/src/loops.rs', lines 326:0-341:1 *)
-let rec list_nth_shared_mut_loop_pair_merge_loop
-  (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) :
-  Tot (result ((t & t) & (t -> result (list_t t))))
-  (decreases (list_nth_shared_mut_loop_pair_merge_loop_decreases t ls0 ls1 i))
-  =
-  begin match ls0 with
-  | List_Cons x0 tl0 ->
-    begin match ls1 with
-    | List_Cons x1 tl1 ->
-      if i = 0
-      then let back = fun ret -> Ok (List_Cons ret tl1) in Ok ((x0, x1), back)
-      else
-        let* i1 = u32_sub i 1 in
-        let* (p, back) = list_nth_shared_mut_loop_pair_merge_loop t tl0 tl1 i1
-          in
-        let back1 = fun ret -> let* tl11 = back ret in Ok (List_Cons x1 tl11)
-          in
-        Ok (p, back1)
-    | List_Nil -> Fail Failure
-    end
-  | List_Nil -> Fail Failure
-  end
+  admit
 
 (** [loops::list_nth_shared_mut_loop_pair_merge]:
     Source: 'tests/src/loops.rs', lines 326:0-330:23 *)
@@ -531,7 +199,7 @@ let list_nth_shared_mut_loop_pair_merge
   (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) :
   result ((t & t) & (t -> result (list_t t)))
   =
-  list_nth_shared_mut_loop_pair_merge_loop t ls0 ls1 i
+  admit
 
 (** [loops::ignore_input_mut_borrow]: loop 0:
     Source: 'tests/src/loops.rs', lines 345:0-349:1 *)
diff --git a/tests/lean/Arrays.lean b/tests/lean/Arrays.lean
index 5ffcce51..464c3ced 100644
--- a/tests/lean/Arrays.lean
+++ b/tests/lean/Arrays.lean
@@ -345,48 +345,15 @@ def take_array_t (a : Array AB 2#usize) : Result Unit :=
 def non_copyable_array : Result Unit :=
   take_array_t (Array.make AB 2#usize [ AB.A, AB.B ])
 
-/- [arrays::sum]: loop 0:
-   Source: 'tests/src/arrays.rs', lines 242:0-250:1 -/
-divergent def sum_loop (s : Slice U32) (sum1 : U32) (i : Usize) : Result U32 :=
-  let i1 := Slice.len U32 s
-  if i < i1
-  then
-    do
-    let i2 ← Slice.index_usize U32 s i
-    let sum3 ← sum1 + i2
-    let i3 ← i + 1#usize
-    sum_loop s sum3 i3
-  else Result.ok sum1
-
 /- [arrays::sum]:
    Source: 'tests/src/arrays.rs', lines 242:0-242:28 -/
 def sum (s : Slice U32) : Result U32 :=
-  sum_loop s 0#u32 0#usize
-
-/- [arrays::sum2]: loop 0:
-   Source: 'tests/src/arrays.rs', lines 252:0-261:1 -/
-divergent def sum2_loop
-  (s : Slice U32) (s2 : Slice U32) (sum1 : U32) (i : Usize) : Result U32 :=
-  let i1 := Slice.len U32 s
-  if i < i1
-  then
-    do
-    let i2 ← Slice.index_usize U32 s i
-    let i3 ← Slice.index_usize U32 s2 i
-    let i4 ← i2 + i3
-    let sum3 ← sum1 + i4
-    let i5 ← i + 1#usize
-    sum2_loop s s2 sum3 i5
-  else Result.ok sum1
+  sorry
 
 /- [arrays::sum2]:
    Source: 'tests/src/arrays.rs', lines 252:0-252:41 -/
 def sum2 (s : Slice U32) (s2 : Slice U32) : Result U32 :=
-  let i := Slice.len U32 s
-  let i1 := Slice.len U32 s2
-  if ¬ (i = i1)
-  then Result.fail .panic
-  else sum2_loop s s2 0#u32 0#usize
+  sorry
 
 /- [arrays::f0]:
    Source: 'tests/src/arrays.rs', lines 263:0-263:11 -/
@@ -460,24 +427,10 @@ def ite : Result Unit :=
   let _ ← to_slice_mut_back s1
   Result.ok ()
 
-/- [arrays::zero_slice]: loop 0:
-   Source: 'tests/src/arrays.rs', lines 303:0-310:1 -/
-divergent def zero_slice_loop
-  (a : Slice U8) (i : Usize) (len : Usize) : Result (Slice U8) :=
-  if i < len
-  then
-    do
-    let (_, index_mut_back) ← Slice.index_mut_usize U8 a i
-    let i1 ← i + 1#usize
-    let a1 ← index_mut_back 0#u8
-    zero_slice_loop a1 i1 len
-  else Result.ok a
-
 /- [arrays::zero_slice]:
    Source: 'tests/src/arrays.rs', lines 303:0-303:31 -/
 def zero_slice (a : Slice U8) : Result (Slice U8) :=
-  let len := Slice.len U8 a
-  zero_slice_loop a 0#usize len
+  sorry
 
 /- [arrays::iter_mut_slice]: loop 0:
    Source: 'tests/src/arrays.rs', lines 312:0-318:1 -/
diff --git a/tests/lean/Demo/Demo.lean b/tests/lean/Demo/Demo.lean
index a9b349b3..7402f010 100644
--- a/tests/lean/Demo/Demo.lean
+++ b/tests/lean/Demo/Demo.lean
@@ -87,36 +87,13 @@ divergent def list_nth_mut
       Result.ok (t, back)
   | CList.CNil => Result.fail .panic
 
-/- [demo::list_nth_mut1]: loop 0:
-   Source: 'tests/src/demo.rs', lines 69:0-78:1 -/
-divergent def list_nth_mut1_loop
-  (T : Type) (l : CList T) (i : U32) :
-  Result (T × (T → Result (CList T)))
-  :=
-  match l with
-  | CList.CCons x tl =>
-    if i = 0#u32
-    then
-      let back := fun ret => Result.ok (CList.CCons ret tl)
-      Result.ok (x, back)
-    else
-      do
-      let i1 ← i - 1#u32
-      let (t, back) ← list_nth_mut1_loop T tl i1
-      let back1 :=
-        fun ret => do
-                   let tl1 ← back ret
-                   Result.ok (CList.CCons x tl1)
-      Result.ok (t, back1)
-  | CList.CNil => Result.fail .panic
-
 /- [demo::list_nth_mut1]:
    Source: 'tests/src/demo.rs', lines 69:0-69:77 -/
 def list_nth_mut1
   (T : Type) (l : CList T) (i : U32) :
   Result (T × (T → Result (CList T)))
   :=
-  list_nth_mut1_loop T l i
+  sorry
 
 /- [demo::i32_id]:
    Source: 'tests/src/demo.rs', lines 80:0-80:28 -/
diff --git a/tests/lean/Hashmap/Funs.lean b/tests/lean/Hashmap/Funs.lean
index cb11e5cf..a107240e 100644
--- a/tests/lean/Hashmap/Funs.lean
+++ b/tests/lean/Hashmap/Funs.lean
@@ -57,59 +57,23 @@ def HashMap.new_with_capacity
 def HashMap.new (T : Type) : Result (HashMap T) :=
   HashMap.new_with_capacity T 32#usize 4#usize 5#usize
 
-/- [hashmap::{hashmap::HashMap<T>}::clear]: loop 0:
-   Source: 'tests/src/hashmap.rs', lines 80:4-88:5 -/
-divergent def HashMap.clear_loop
-  (T : Type) (slots : alloc.vec.Vec (List T)) (i : Usize) :
-  Result (alloc.vec.Vec (List T))
-  :=
-  let i1 := alloc.vec.Vec.len (List T) slots
-  if i < i1
-  then
-    do
-    let (_, index_mut_back) ←
-      alloc.vec.Vec.index_mut (List T) Usize
-        (core.slice.index.SliceIndexUsizeSliceTInst (List T)) slots i
-    let i2 ← i + 1#usize
-    let slots1 ← index_mut_back List.Nil
-    HashMap.clear_loop T slots1 i2
-  else Result.ok slots
-
 /- [hashmap::{hashmap::HashMap<T>}::clear]:
    Source: 'tests/src/hashmap.rs', lines 80:4-80:27 -/
 def HashMap.clear (T : Type) (self : HashMap T) : Result (HashMap T) :=
-  do
-  let hm ← HashMap.clear_loop T self.slots 0#usize
-  Result.ok { self with num_entries := 0#usize, slots := hm }
+  sorry
 
 /- [hashmap::{hashmap::HashMap<T>}::len]:
    Source: 'tests/src/hashmap.rs', lines 90:4-90:30 -/
 def HashMap.len (T : Type) (self : HashMap T) : Result Usize :=
   Result.ok self.num_entries
 
-/- [hashmap::{hashmap::HashMap<T>}::insert_in_list]: loop 0:
-   Source: 'tests/src/hashmap.rs', lines 97:4-114:5 -/
-divergent def HashMap.insert_in_list_loop
-  (T : Type) (key : Usize) (value : T) (ls : List T) :
-  Result (Bool × (List T))
-  :=
-  match ls with
-  | List.Cons ckey cvalue tl =>
-    if ckey = key
-    then Result.ok (false, List.Cons ckey value tl)
-    else
-      do
-      let (b, tl1) ← HashMap.insert_in_list_loop T key value tl
-      Result.ok (b, List.Cons ckey cvalue tl1)
-  | List.Nil => Result.ok (true, List.Cons key value List.Nil)
-
 /- [hashmap::{hashmap::HashMap<T>}::insert_in_list]:
    Source: 'tests/src/hashmap.rs', lines 97:4-97:71 -/
 def HashMap.insert_in_list
   (T : Type) (key : Usize) (value : T) (ls : List T) :
   Result (Bool × (List T))
   :=
-  HashMap.insert_in_list_loop T key value ls
+  sorry
 
 /- [hashmap::{hashmap::HashMap<T>}::insert_no_resize]:
    Source: 'tests/src/hashmap.rs', lines 117:4-117:54 -/
@@ -135,43 +99,11 @@ def HashMap.insert_no_resize
        let v ← index_mut_back l1
        Result.ok { self with slots := v }
 
-/- [hashmap::{hashmap::HashMap<T>}::move_elements_from_list]: loop 0:
-   Source: 'tests/src/hashmap.rs', lines 183:4-196:5 -/
-divergent def HashMap.move_elements_from_list_loop
-  (T : Type) (ntable : HashMap T) (ls : List T) : Result (HashMap T) :=
-  match ls with
-  | List.Cons k v tl =>
-    do
-    let ntable1 ← HashMap.insert_no_resize T ntable k v
-    HashMap.move_elements_from_list_loop T ntable1 tl
-  | List.Nil => Result.ok ntable
-
 /- [hashmap::{hashmap::HashMap<T>}::move_elements_from_list]:
    Source: 'tests/src/hashmap.rs', lines 183:4-183:72 -/
 def HashMap.move_elements_from_list
   (T : Type) (ntable : HashMap T) (ls : List T) : Result (HashMap T) :=
-  HashMap.move_elements_from_list_loop T ntable ls
-
-/- [hashmap::{hashmap::HashMap<T>}::move_elements]: loop 0:
-   Source: 'tests/src/hashmap.rs', lines 171:4-180:5 -/
-divergent def HashMap.move_elements_loop
-  (T : Type) (ntable : HashMap T) (slots : alloc.vec.Vec (List T)) (i : Usize)
-  :
-  Result ((HashMap T) × (alloc.vec.Vec (List T)))
-  :=
-  let i1 := alloc.vec.Vec.len (List T) slots
-  if i < i1
-  then
-    do
-    let (l, index_mut_back) ←
-      alloc.vec.Vec.index_mut (List T) Usize
-        (core.slice.index.SliceIndexUsizeSliceTInst (List T)) slots i
-    let (ls, l1) := core.mem.replace (List T) l List.Nil
-    let ntable1 ← HashMap.move_elements_from_list T ntable ls
-    let i2 ← i + 1#usize
-    let slots1 ← index_mut_back l1
-    HashMap.move_elements_loop T ntable1 slots1 i2
-  else Result.ok (ntable, slots)
+  sorry
 
 /- [hashmap::{hashmap::HashMap<T>}::move_elements]:
    Source: 'tests/src/hashmap.rs', lines 171:4-171:95 -/
@@ -180,7 +112,7 @@ def HashMap.move_elements
   :
   Result ((HashMap T) × (alloc.vec.Vec (List T)))
   :=
-  HashMap.move_elements_loop T ntable slots i
+  sorry
 
 /- [hashmap::{hashmap::HashMap<T>}::try_resize]:
    Source: 'tests/src/hashmap.rs', lines 140:4-140:28 -/
@@ -219,22 +151,11 @@ def HashMap.insert
   then HashMap.try_resize T self1
   else Result.ok self1
 
-/- [hashmap::{hashmap::HashMap<T>}::contains_key_in_list]: loop 0:
-   Source: 'tests/src/hashmap.rs', lines 206:4-219:5 -/
-divergent def HashMap.contains_key_in_list_loop
-  (T : Type) (key : Usize) (ls : List T) : Result Bool :=
-  match ls with
-  | List.Cons ckey _ tl =>
-    if ckey = key
-    then Result.ok true
-    else HashMap.contains_key_in_list_loop T key tl
-  | List.Nil => Result.ok false
-
 /- [hashmap::{hashmap::HashMap<T>}::contains_key_in_list]:
    Source: 'tests/src/hashmap.rs', lines 206:4-206:68 -/
 def HashMap.contains_key_in_list
   (T : Type) (key : Usize) (ls : List T) : Result Bool :=
-  HashMap.contains_key_in_list_loop T key ls
+  sorry
 
 /- [hashmap::{hashmap::HashMap<T>}::contains_key]:
    Source: 'tests/src/hashmap.rs', lines 199:4-199:49 -/
@@ -249,21 +170,10 @@ def HashMap.contains_key
       (core.slice.index.SliceIndexUsizeSliceTInst (List T)) self.slots hash_mod
   HashMap.contains_key_in_list T key l
 
-/- [hashmap::{hashmap::HashMap<T>}::get_in_list]: loop 0:
-   Source: 'tests/src/hashmap.rs', lines 224:4-237:5 -/
-divergent def HashMap.get_in_list_loop
-  (T : Type) (key : Usize) (ls : List T) : Result T :=
-  match ls with
-  | List.Cons ckey cvalue tl =>
-    if ckey = key
-    then Result.ok cvalue
-    else HashMap.get_in_list_loop T key tl
-  | List.Nil => Result.fail .panic
-
 /- [hashmap::{hashmap::HashMap<T>}::get_in_list]:
    Source: 'tests/src/hashmap.rs', lines 224:4-224:70 -/
 def HashMap.get_in_list (T : Type) (key : Usize) (ls : List T) : Result T :=
-  HashMap.get_in_list_loop T key ls
+  sorry
 
 /- [hashmap::{hashmap::HashMap<T>}::get]:
    Source: 'tests/src/hashmap.rs', lines 239:4-239:55 -/
@@ -277,36 +187,13 @@ def HashMap.get (T : Type) (self : HashMap T) (key : Usize) : Result T :=
       (core.slice.index.SliceIndexUsizeSliceTInst (List T)) self.slots hash_mod
   HashMap.get_in_list T key l
 
-/- [hashmap::{hashmap::HashMap<T>}::get_mut_in_list]: loop 0:
-   Source: 'tests/src/hashmap.rs', lines 245:4-254:5 -/
-divergent def HashMap.get_mut_in_list_loop
-  (T : Type) (ls : List T) (key : Usize) :
-  Result (T × (T → Result (List T)))
-  :=
-  match ls with
-  | List.Cons ckey cvalue tl =>
-    if ckey = key
-    then
-      let back := fun ret => Result.ok (List.Cons ckey ret tl)
-      Result.ok (cvalue, back)
-    else
-      do
-      let (t, back) ← HashMap.get_mut_in_list_loop T tl key
-      let back1 :=
-        fun ret =>
-          do
-          let tl1 ← back ret
-          Result.ok (List.Cons ckey cvalue tl1)
-      Result.ok (t, back1)
-  | List.Nil => Result.fail .panic
-
 /- [hashmap::{hashmap::HashMap<T>}::get_mut_in_list]:
    Source: 'tests/src/hashmap.rs', lines 245:4-245:86 -/
 def HashMap.get_mut_in_list
   (T : Type) (ls : List T) (key : Usize) :
   Result (T × (T → Result (List T)))
   :=
-  HashMap.get_mut_in_list_loop T ls key
+  sorry
 
 /- [hashmap::{hashmap::HashMap<T>}::get_mut]:
    Source: 'tests/src/hashmap.rs', lines 257:4-257:67 -/
@@ -330,30 +217,11 @@ def HashMap.get_mut
       Result.ok { self with slots := v }
   Result.ok (t, back)
 
-/- [hashmap::{hashmap::HashMap<T>}::remove_from_list]: loop 0:
-   Source: 'tests/src/hashmap.rs', lines 265:4-291:5 -/
-divergent def HashMap.remove_from_list_loop
-  (T : Type) (key : Usize) (ls : List T) : Result ((Option T) × (List T)) :=
-  match ls with
-  | List.Cons ckey t tl =>
-    if ckey = key
-    then
-      let (mv_ls, _) :=
-        core.mem.replace (List T) (List.Cons ckey t tl) List.Nil
-      match mv_ls with
-      | List.Cons _ cvalue tl1 => Result.ok (some cvalue, tl1)
-      | List.Nil => Result.fail .panic
-    else
-      do
-      let (o, tl1) ← HashMap.remove_from_list_loop T key tl
-      Result.ok (o, List.Cons ckey t tl1)
-  | List.Nil => Result.ok (none, List.Nil)
-
 /- [hashmap::{hashmap::HashMap<T>}::remove_from_list]:
    Source: 'tests/src/hashmap.rs', lines 265:4-265:69 -/
 def HashMap.remove_from_list
   (T : Type) (key : Usize) (ls : List T) : Result ((Option T) × (List T)) :=
-  HashMap.remove_from_list_loop T key ls
+  sorry
 
 /- [hashmap::{hashmap::HashMap<T>}::remove]:
    Source: 'tests/src/hashmap.rs', lines 294:4-294:52 -/
diff --git a/tests/lean/HashmapMain/Funs.lean b/tests/lean/HashmapMain/Funs.lean
index e27305b1..d3c4ae77 100644
--- a/tests/lean/HashmapMain/Funs.lean
+++ b/tests/lean/HashmapMain/Funs.lean
@@ -60,61 +60,24 @@ def hashmap.HashMap.new_with_capacity
 def hashmap.HashMap.new (T : Type) : Result (hashmap.HashMap T) :=
   hashmap.HashMap.new_with_capacity T 32#usize 4#usize 5#usize
 
-/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::clear]: loop 0:
-   Source: 'tests/src/hashmap.rs', lines 80:4-88:5 -/
-divergent def hashmap.HashMap.clear_loop
-  (T : Type) (slots : alloc.vec.Vec (hashmap.List T)) (i : Usize) :
-  Result (alloc.vec.Vec (hashmap.List T))
-  :=
-  let i1 := alloc.vec.Vec.len (hashmap.List T) slots
-  if i < i1
-  then
-    do
-    let (_, index_mut_back) ←
-      alloc.vec.Vec.index_mut (hashmap.List T) Usize
-        (core.slice.index.SliceIndexUsizeSliceTInst (hashmap.List T)) slots i
-    let i2 ← i + 1#usize
-    let slots1 ← index_mut_back hashmap.List.Nil
-    hashmap.HashMap.clear_loop T slots1 i2
-  else Result.ok slots
-
 /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::clear]:
    Source: 'tests/src/hashmap.rs', lines 80:4-80:27 -/
 def hashmap.HashMap.clear
   (T : Type) (self : hashmap.HashMap T) : Result (hashmap.HashMap T) :=
-  do
-  let hm ← hashmap.HashMap.clear_loop T self.slots 0#usize
-  Result.ok { self with num_entries := 0#usize, slots := hm }
+  sorry
 
 /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::len]:
    Source: 'tests/src/hashmap.rs', lines 90:4-90:30 -/
 def hashmap.HashMap.len (T : Type) (self : hashmap.HashMap T) : Result Usize :=
   Result.ok self.num_entries
 
-/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::insert_in_list]: loop 0:
-   Source: 'tests/src/hashmap.rs', lines 97:4-114:5 -/
-divergent def hashmap.HashMap.insert_in_list_loop
-  (T : Type) (key : Usize) (value : T) (ls : hashmap.List T) :
-  Result (Bool × (hashmap.List T))
-  :=
-  match ls with
-  | hashmap.List.Cons ckey cvalue tl =>
-    if ckey = key
-    then Result.ok (false, hashmap.List.Cons ckey value tl)
-    else
-      do
-      let (b, tl1) ← hashmap.HashMap.insert_in_list_loop T key value tl
-      Result.ok (b, hashmap.List.Cons ckey cvalue tl1)
-  | hashmap.List.Nil =>
-    Result.ok (true, hashmap.List.Cons key value hashmap.List.Nil)
-
 /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::insert_in_list]:
    Source: 'tests/src/hashmap.rs', lines 97:4-97:71 -/
 def hashmap.HashMap.insert_in_list
   (T : Type) (key : Usize) (value : T) (ls : hashmap.List T) :
   Result (Bool × (hashmap.List T))
   :=
-  hashmap.HashMap.insert_in_list_loop T key value ls
+  sorry
 
 /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::insert_no_resize]:
    Source: 'tests/src/hashmap.rs', lines 117:4-117:54 -/
@@ -141,47 +104,13 @@ def hashmap.HashMap.insert_no_resize
        let v ← index_mut_back l1
        Result.ok { self with slots := v }
 
-/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements_from_list]: loop 0:
-   Source: 'tests/src/hashmap.rs', lines 183:4-196:5 -/
-divergent def hashmap.HashMap.move_elements_from_list_loop
-  (T : Type) (ntable : hashmap.HashMap T) (ls : hashmap.List T) :
-  Result (hashmap.HashMap T)
-  :=
-  match ls with
-  | hashmap.List.Cons k v tl =>
-    do
-    let ntable1 ← hashmap.HashMap.insert_no_resize T ntable k v
-    hashmap.HashMap.move_elements_from_list_loop T ntable1 tl
-  | hashmap.List.Nil => Result.ok ntable
-
 /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements_from_list]:
    Source: 'tests/src/hashmap.rs', lines 183:4-183:72 -/
 def hashmap.HashMap.move_elements_from_list
   (T : Type) (ntable : hashmap.HashMap T) (ls : hashmap.List T) :
   Result (hashmap.HashMap T)
   :=
-  hashmap.HashMap.move_elements_from_list_loop T ntable ls
-
-/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements]: loop 0:
-   Source: 'tests/src/hashmap.rs', lines 171:4-180:5 -/
-divergent def hashmap.HashMap.move_elements_loop
-  (T : Type) (ntable : hashmap.HashMap T)
-  (slots : alloc.vec.Vec (hashmap.List T)) (i : Usize) :
-  Result ((hashmap.HashMap T) × (alloc.vec.Vec (hashmap.List T)))
-  :=
-  let i1 := alloc.vec.Vec.len (hashmap.List T) slots
-  if i < i1
-  then
-    do
-    let (l, index_mut_back) ←
-      alloc.vec.Vec.index_mut (hashmap.List T) Usize
-        (core.slice.index.SliceIndexUsizeSliceTInst (hashmap.List T)) slots i
-    let (ls, l1) := core.mem.replace (hashmap.List T) l hashmap.List.Nil
-    let ntable1 ← hashmap.HashMap.move_elements_from_list T ntable ls
-    let i2 ← i + 1#usize
-    let slots1 ← index_mut_back l1
-    hashmap.HashMap.move_elements_loop T ntable1 slots1 i2
-  else Result.ok (ntable, slots)
+  sorry
 
 /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements]:
    Source: 'tests/src/hashmap.rs', lines 171:4-171:95 -/
@@ -190,7 +119,7 @@ def hashmap.HashMap.move_elements
   (slots : alloc.vec.Vec (hashmap.List T)) (i : Usize) :
   Result ((hashmap.HashMap T) × (alloc.vec.Vec (hashmap.List T)))
   :=
-  hashmap.HashMap.move_elements_loop T ntable slots i
+  sorry
 
 /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::try_resize]:
    Source: 'tests/src/hashmap.rs', lines 140:4-140:28 -/
@@ -230,22 +159,11 @@ def hashmap.HashMap.insert
   then hashmap.HashMap.try_resize T self1
   else Result.ok self1
 
-/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::contains_key_in_list]: loop 0:
-   Source: 'tests/src/hashmap.rs', lines 206:4-219:5 -/
-divergent def hashmap.HashMap.contains_key_in_list_loop
-  (T : Type) (key : Usize) (ls : hashmap.List T) : Result Bool :=
-  match ls with
-  | hashmap.List.Cons ckey _ tl =>
-    if ckey = key
-    then Result.ok true
-    else hashmap.HashMap.contains_key_in_list_loop T key tl
-  | hashmap.List.Nil => Result.ok false
-
 /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::contains_key_in_list]:
    Source: 'tests/src/hashmap.rs', lines 206:4-206:68 -/
 def hashmap.HashMap.contains_key_in_list
   (T : Type) (key : Usize) (ls : hashmap.List T) : Result Bool :=
-  hashmap.HashMap.contains_key_in_list_loop T key ls
+  sorry
 
 /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::contains_key]:
    Source: 'tests/src/hashmap.rs', lines 199:4-199:49 -/
@@ -261,22 +179,11 @@ def hashmap.HashMap.contains_key
       hash_mod
   hashmap.HashMap.contains_key_in_list T key l
 
-/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_in_list]: loop 0:
-   Source: 'tests/src/hashmap.rs', lines 224:4-237:5 -/
-divergent def hashmap.HashMap.get_in_list_loop
-  (T : Type) (key : Usize) (ls : hashmap.List T) : Result T :=
-  match ls with
-  | hashmap.List.Cons ckey cvalue tl =>
-    if ckey = key
-    then Result.ok cvalue
-    else hashmap.HashMap.get_in_list_loop T key tl
-  | hashmap.List.Nil => Result.fail .panic
-
 /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_in_list]:
    Source: 'tests/src/hashmap.rs', lines 224:4-224:70 -/
 def hashmap.HashMap.get_in_list
   (T : Type) (key : Usize) (ls : hashmap.List T) : Result T :=
-  hashmap.HashMap.get_in_list_loop T key ls
+  sorry
 
 /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get]:
    Source: 'tests/src/hashmap.rs', lines 239:4-239:55 -/
@@ -292,36 +199,13 @@ def hashmap.HashMap.get
       hash_mod
   hashmap.HashMap.get_in_list T key l
 
-/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_mut_in_list]: loop 0:
-   Source: 'tests/src/hashmap.rs', lines 245:4-254:5 -/
-divergent def hashmap.HashMap.get_mut_in_list_loop
-  (T : Type) (ls : hashmap.List T) (key : Usize) :
-  Result (T × (T → Result (hashmap.List T)))
-  :=
-  match ls with
-  | hashmap.List.Cons ckey cvalue tl =>
-    if ckey = key
-    then
-      let back := fun ret => Result.ok (hashmap.List.Cons ckey ret tl)
-      Result.ok (cvalue, back)
-    else
-      do
-      let (t, back) ← hashmap.HashMap.get_mut_in_list_loop T tl key
-      let back1 :=
-        fun ret =>
-          do
-          let tl1 ← back ret
-          Result.ok (hashmap.List.Cons ckey cvalue tl1)
-      Result.ok (t, back1)
-  | hashmap.List.Nil => Result.fail .panic
-
 /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_mut_in_list]:
    Source: 'tests/src/hashmap.rs', lines 245:4-245:86 -/
 def hashmap.HashMap.get_mut_in_list
   (T : Type) (ls : hashmap.List T) (key : Usize) :
   Result (T × (T → Result (hashmap.List T)))
   :=
-  hashmap.HashMap.get_mut_in_list_loop T ls key
+  sorry
 
 /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_mut]:
    Source: 'tests/src/hashmap.rs', lines 257:4-257:67 -/
@@ -346,35 +230,13 @@ def hashmap.HashMap.get_mut
       Result.ok { self with slots := v }
   Result.ok (t, back)
 
-/- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::remove_from_list]: loop 0:
-   Source: 'tests/src/hashmap.rs', lines 265:4-291:5 -/
-divergent def hashmap.HashMap.remove_from_list_loop
-  (T : Type) (key : Usize) (ls : hashmap.List T) :
-  Result ((Option T) × (hashmap.List T))
-  :=
-  match ls with
-  | hashmap.List.Cons ckey t tl =>
-    if ckey = key
-    then
-      let (mv_ls, _) :=
-        core.mem.replace (hashmap.List T) (hashmap.List.Cons ckey t tl)
-          hashmap.List.Nil
-      match mv_ls with
-      | hashmap.List.Cons _ cvalue tl1 => Result.ok (some cvalue, tl1)
-      | hashmap.List.Nil => Result.fail .panic
-    else
-      do
-      let (o, tl1) ← hashmap.HashMap.remove_from_list_loop T key tl
-      Result.ok (o, hashmap.List.Cons ckey t tl1)
-  | hashmap.List.Nil => Result.ok (none, hashmap.List.Nil)
-
 /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::remove_from_list]:
    Source: 'tests/src/hashmap.rs', lines 265:4-265:69 -/
 def hashmap.HashMap.remove_from_list
   (T : Type) (key : Usize) (ls : hashmap.List T) :
   Result ((Option T) × (hashmap.List T))
   :=
-  hashmap.HashMap.remove_from_list_loop T key ls
+  sorry
 
 /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::remove]:
    Source: 'tests/src/hashmap.rs', lines 294:4-294:52 -/
diff --git a/tests/lean/Loops.lean b/tests/lean/Loops.lean
index d5bda6ab..046d2240 100644
--- a/tests/lean/Loops.lean
+++ b/tests/lean/Loops.lean
@@ -72,26 +72,10 @@ divergent def sum_array_loop
 def sum_array (N : Usize) (a : Array U32 N) : Result U32 :=
   sum_array_loop N a 0#usize 0#u32
 
-/- [loops::clear]: loop 0:
-   Source: 'tests/src/loops.rs', lines 62:0-68:1 -/
-divergent def clear_loop
-  (v : alloc.vec.Vec U32) (i : Usize) : Result (alloc.vec.Vec U32) :=
-  let i1 := alloc.vec.Vec.len U32 v
-  if i < i1
-  then
-    do
-    let (_, index_mut_back) ←
-      alloc.vec.Vec.index_mut U32 Usize
-        (core.slice.index.SliceIndexUsizeSliceTInst U32) v i
-    let i2 ← i + 1#usize
-    let v1 ← index_mut_back 0#u32
-    clear_loop v1 i2
-  else Result.ok v
-
 /- [loops::clear]:
    Source: 'tests/src/loops.rs', lines 62:0-62:30 -/
 def clear (v : alloc.vec.Vec U32) : Result (alloc.vec.Vec U32) :=
-  clear_loop v 0#usize
+  sorry
 
 /- [loops::List]
    Source: 'tests/src/loops.rs', lines 70:0-70:16 -/
@@ -99,86 +83,21 @@ inductive List (T : Type) :=
 | Cons : T → List T → List T
 | Nil : List T
 
-/- [loops::list_mem]: loop 0:
-   Source: 'tests/src/loops.rs', lines 76:0-85:1 -/
-divergent def list_mem_loop (x : U32) (ls : List U32) : Result Bool :=
-  match ls with
-  | List.Cons y tl => if y = x
-                      then Result.ok true
-                      else list_mem_loop x tl
-  | List.Nil => Result.ok false
-
 /- [loops::list_mem]:
    Source: 'tests/src/loops.rs', lines 76:0-76:52 -/
 def list_mem (x : U32) (ls : List U32) : Result Bool :=
-  list_mem_loop x ls
-
-/- [loops::list_nth_mut_loop]: loop 0:
-   Source: 'tests/src/loops.rs', lines 88:0-98:1 -/
-divergent def list_nth_mut_loop_loop
-  (T : Type) (ls : List T) (i : U32) : Result (T × (T → Result (List T))) :=
-  match ls with
-  | List.Cons x tl =>
-    if i = 0#u32
-    then
-      let back := fun ret => Result.ok (List.Cons ret tl)
-      Result.ok (x, back)
-    else
-      do
-      let i1 ← i - 1#u32
-      let (t, back) ← list_nth_mut_loop_loop T tl i1
-      let back1 :=
-        fun ret => do
-                   let tl1 ← back ret
-                   Result.ok (List.Cons x tl1)
-      Result.ok (t, back1)
-  | List.Nil => Result.fail .panic
+  sorry
 
 /- [loops::list_nth_mut_loop]:
    Source: 'tests/src/loops.rs', lines 88:0-88:71 -/
 def list_nth_mut_loop
   (T : Type) (ls : List T) (i : U32) : Result (T × (T → Result (List T))) :=
-  list_nth_mut_loop_loop T ls i
-
-/- [loops::list_nth_shared_loop]: loop 0:
-   Source: 'tests/src/loops.rs', lines 101:0-111:1 -/
-divergent def list_nth_shared_loop_loop
-  (T : Type) (ls : List T) (i : U32) : Result T :=
-  match ls with
-  | List.Cons x tl =>
-    if i = 0#u32
-    then Result.ok x
-    else do
-         let i1 ← i - 1#u32
-         list_nth_shared_loop_loop T tl i1
-  | List.Nil => Result.fail .panic
+  sorry
 
 /- [loops::list_nth_shared_loop]:
    Source: 'tests/src/loops.rs', lines 101:0-101:66 -/
 def list_nth_shared_loop (T : Type) (ls : List T) (i : U32) : Result T :=
-  list_nth_shared_loop_loop T ls i
-
-/- [loops::get_elem_mut]: loop 0:
-   Source: 'tests/src/loops.rs', lines 113:0-127:1 -/
-divergent def get_elem_mut_loop
-  (x : Usize) (ls : List Usize) :
-  Result (Usize × (Usize → Result (List Usize)))
-  :=
-  match ls with
-  | List.Cons y tl =>
-    if y = x
-    then
-      let back := fun ret => Result.ok (List.Cons ret tl)
-      Result.ok (y, back)
-    else
-      do
-      let (i, back) ← get_elem_mut_loop x tl
-      let back1 :=
-        fun ret => do
-                   let tl1 ← back ret
-                   Result.ok (List.Cons y tl1)
-      Result.ok (i, back1)
-  | List.Nil => Result.fail .panic
+  sorry
 
 /- [loops::get_elem_mut]:
    Source: 'tests/src/loops.rs', lines 113:0-113:73 -/
@@ -186,35 +105,13 @@ def get_elem_mut
   (slots : alloc.vec.Vec (List Usize)) (x : Usize) :
   Result (Usize × (Usize → Result (alloc.vec.Vec (List Usize))))
   :=
-  do
-  let (ls, index_mut_back) ←
-    alloc.vec.Vec.index_mut (List Usize) Usize
-      (core.slice.index.SliceIndexUsizeSliceTInst (List Usize)) slots 0#usize
-  let (i, back) ← get_elem_mut_loop x ls
-  let back1 := fun ret => do
-                          let l ← back ret
-                          index_mut_back l
-  Result.ok (i, back1)
-
-/- [loops::get_elem_shared]: loop 0:
-   Source: 'tests/src/loops.rs', lines 129:0-143:1 -/
-divergent def get_elem_shared_loop
-  (x : Usize) (ls : List Usize) : Result Usize :=
-  match ls with
-  | List.Cons y tl => if y = x
-                      then Result.ok y
-                      else get_elem_shared_loop x tl
-  | List.Nil => Result.fail .panic
+  sorry
 
 /- [loops::get_elem_shared]:
    Source: 'tests/src/loops.rs', lines 129:0-129:68 -/
 def get_elem_shared
   (slots : alloc.vec.Vec (List Usize)) (x : Usize) : Result Usize :=
-  do
-  let ls ←
-    alloc.vec.Vec.index (List Usize) Usize
-      (core.slice.index.SliceIndexUsizeSliceTInst (List Usize)) slots 0#usize
-  get_elem_shared_loop x ls
+  sorry
 
 /- [loops::id_mut]:
    Source: 'tests/src/loops.rs', lines 145:0-145:50 -/
@@ -229,90 +126,17 @@ def id_mut
 def id_shared (T : Type) (ls : List T) : Result (List T) :=
   Result.ok ls
 
-/- [loops::list_nth_mut_loop_with_id]: loop 0:
-   Source: 'tests/src/loops.rs', lines 154:0-165:1 -/
-divergent def list_nth_mut_loop_with_id_loop
-  (T : Type) (i : U32) (ls : List T) : Result (T × (T → Result (List T))) :=
-  match ls with
-  | List.Cons x tl =>
-    if i = 0#u32
-    then
-      let back := fun ret => Result.ok (List.Cons ret tl)
-      Result.ok (x, back)
-    else
-      do
-      let i1 ← i - 1#u32
-      let (t, back) ← list_nth_mut_loop_with_id_loop T i1 tl
-      let back1 :=
-        fun ret => do
-                   let tl1 ← back ret
-                   Result.ok (List.Cons x tl1)
-      Result.ok (t, back1)
-  | List.Nil => Result.fail .panic
-
 /- [loops::list_nth_mut_loop_with_id]:
    Source: 'tests/src/loops.rs', lines 154:0-154:75 -/
 def list_nth_mut_loop_with_id
   (T : Type) (ls : List T) (i : U32) : Result (T × (T → Result (List T))) :=
-  do
-  let (ls1, id_mut_back) ← id_mut T ls
-  let (t, back) ← list_nth_mut_loop_with_id_loop T i ls1
-  let back1 := fun ret => do
-                          let l ← back ret
-                          id_mut_back l
-  Result.ok (t, back1)
-
-/- [loops::list_nth_shared_loop_with_id]: loop 0:
-   Source: 'tests/src/loops.rs', lines 168:0-179:1 -/
-divergent def list_nth_shared_loop_with_id_loop
-  (T : Type) (i : U32) (ls : List T) : Result T :=
-  match ls with
-  | List.Cons x tl =>
-    if i = 0#u32
-    then Result.ok x
-    else do
-         let i1 ← i - 1#u32
-         list_nth_shared_loop_with_id_loop T i1 tl
-  | List.Nil => Result.fail .panic
+  sorry
 
 /- [loops::list_nth_shared_loop_with_id]:
    Source: 'tests/src/loops.rs', lines 168:0-168:70 -/
 def list_nth_shared_loop_with_id
   (T : Type) (ls : List T) (i : U32) : Result T :=
-  do
-  let ls1 ← id_shared T ls
-  list_nth_shared_loop_with_id_loop T i ls1
-
-/- [loops::list_nth_mut_loop_pair]: loop 0:
-   Source: 'tests/src/loops.rs', lines 184:0-205:1 -/
-divergent def list_nth_mut_loop_pair_loop
-  (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) :
-  Result ((T × T) × (T → Result (List T)) × (T → Result (List T)))
-  :=
-  match ls0 with
-  | List.Cons x0 tl0 =>
-    match ls1 with
-    | List.Cons x1 tl1 =>
-      if i = 0#u32
-      then
-        let back'a := fun ret => Result.ok (List.Cons ret tl0)
-        let back'b := fun ret => Result.ok (List.Cons ret tl1)
-        Result.ok ((x0, x1), back'a, back'b)
-      else
-        do
-        let i1 ← i - 1#u32
-        let (p, back'a, back'b) ← list_nth_mut_loop_pair_loop T tl0 tl1 i1
-        let back'a1 :=
-          fun ret => do
-                     let tl01 ← back'a ret
-                     Result.ok (List.Cons x0 tl01)
-        let back'b1 :=
-          fun ret => do
-                     let tl11 ← back'b ret
-                     Result.ok (List.Cons x1 tl11)
-        Result.ok (p, back'a1, back'b1)
-    | List.Nil => Result.fail .panic
-  | List.Nil => Result.fail .panic
+  sorry
 
 /- [loops::list_nth_mut_loop_pair]:
    Source: 'tests/src/loops.rs', lines 184:0-188:27 -/
@@ -320,59 +144,13 @@ def list_nth_mut_loop_pair
   (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) :
   Result ((T × T) × (T → Result (List T)) × (T → Result (List T)))
   :=
-  list_nth_mut_loop_pair_loop T ls0 ls1 i
-
-/- [loops::list_nth_shared_loop_pair]: loop 0:
-   Source: 'tests/src/loops.rs', lines 208:0-229:1 -/
-divergent def list_nth_shared_loop_pair_loop
-  (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) :=
-  match ls0 with
-  | List.Cons x0 tl0 =>
-    match ls1 with
-    | List.Cons x1 tl1 =>
-      if i = 0#u32
-      then Result.ok (x0, x1)
-      else do
-           let i1 ← i - 1#u32
-           list_nth_shared_loop_pair_loop T tl0 tl1 i1
-    | List.Nil => Result.fail .panic
-  | List.Nil => Result.fail .panic
+  sorry
 
 /- [loops::list_nth_shared_loop_pair]:
    Source: 'tests/src/loops.rs', lines 208:0-212:19 -/
 def list_nth_shared_loop_pair
   (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) :=
-  list_nth_shared_loop_pair_loop T ls0 ls1 i
-
-/- [loops::list_nth_mut_loop_pair_merge]: loop 0:
-   Source: 'tests/src/loops.rs', lines 233:0-248:1 -/
-divergent def list_nth_mut_loop_pair_merge_loop
-  (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) :
-  Result ((T × T) × ((T × T) → Result ((List T) × (List T))))
-  :=
-  match ls0 with
-  | List.Cons x0 tl0 =>
-    match ls1 with
-    | List.Cons x1 tl1 =>
-      if i = 0#u32
-      then
-        let back :=
-          fun ret =>
-            let (t, t1) := ret
-            Result.ok (List.Cons t tl0, List.Cons t1 tl1)
-        Result.ok ((x0, x1), back)
-      else
-        do
-        let i1 ← i - 1#u32
-        let (p, back) ← list_nth_mut_loop_pair_merge_loop T tl0 tl1 i1
-        let back1 :=
-          fun ret =>
-            do
-            let (tl01, tl11) ← back ret
-            Result.ok (List.Cons x0 tl01, List.Cons x1 tl11)
-        Result.ok (p, back1)
-    | List.Nil => Result.fail .panic
-  | List.Nil => Result.fail .panic
+  sorry
 
 /- [loops::list_nth_mut_loop_pair_merge]:
    Source: 'tests/src/loops.rs', lines 233:0-237:27 -/
@@ -380,56 +158,13 @@ def list_nth_mut_loop_pair_merge
   (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) :
   Result ((T × T) × ((T × T) → Result ((List T) × (List T))))
   :=
-  list_nth_mut_loop_pair_merge_loop T ls0 ls1 i
-
-/- [loops::list_nth_shared_loop_pair_merge]: loop 0:
-   Source: 'tests/src/loops.rs', lines 251:0-266:1 -/
-divergent def list_nth_shared_loop_pair_merge_loop
-  (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) :=
-  match ls0 with
-  | List.Cons x0 tl0 =>
-    match ls1 with
-    | List.Cons x1 tl1 =>
-      if i = 0#u32
-      then Result.ok (x0, x1)
-      else
-        do
-        let i1 ← i - 1#u32
-        list_nth_shared_loop_pair_merge_loop T tl0 tl1 i1
-    | List.Nil => Result.fail .panic
-  | List.Nil => Result.fail .panic
+  sorry
 
 /- [loops::list_nth_shared_loop_pair_merge]:
    Source: 'tests/src/loops.rs', lines 251:0-255:19 -/
 def list_nth_shared_loop_pair_merge
   (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) :=
-  list_nth_shared_loop_pair_merge_loop T ls0 ls1 i
-
-/- [loops::list_nth_mut_shared_loop_pair]: loop 0:
-   Source: 'tests/src/loops.rs', lines 269:0-284:1 -/
-divergent def list_nth_mut_shared_loop_pair_loop
-  (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) :
-  Result ((T × T) × (T → Result (List T)))
-  :=
-  match ls0 with
-  | List.Cons x0 tl0 =>
-    match ls1 with
-    | List.Cons x1 tl1 =>
-      if i = 0#u32
-      then
-        let back := fun ret => Result.ok (List.Cons ret tl0)
-        Result.ok ((x0, x1), back)
-      else
-        do
-        let i1 ← i - 1#u32
-        let (p, back) ← list_nth_mut_shared_loop_pair_loop T tl0 tl1 i1
-        let back1 :=
-          fun ret => do
-                     let tl01 ← back ret
-                     Result.ok (List.Cons x0 tl01)
-        Result.ok (p, back1)
-    | List.Nil => Result.fail .panic
-  | List.Nil => Result.fail .panic
+  sorry
 
 /- [loops::list_nth_mut_shared_loop_pair]:
    Source: 'tests/src/loops.rs', lines 269:0-273:23 -/
@@ -437,33 +172,7 @@ def list_nth_mut_shared_loop_pair
   (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) :
   Result ((T × T) × (T → Result (List T)))
   :=
-  list_nth_mut_shared_loop_pair_loop T ls0 ls1 i
-
-/- [loops::list_nth_mut_shared_loop_pair_merge]: loop 0:
-   Source: 'tests/src/loops.rs', lines 288:0-303:1 -/
-divergent def list_nth_mut_shared_loop_pair_merge_loop
-  (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) :
-  Result ((T × T) × (T → Result (List T)))
-  :=
-  match ls0 with
-  | List.Cons x0 tl0 =>
-    match ls1 with
-    | List.Cons x1 tl1 =>
-      if i = 0#u32
-      then
-        let back := fun ret => Result.ok (List.Cons ret tl0)
-        Result.ok ((x0, x1), back)
-      else
-        do
-        let i1 ← i - 1#u32
-        let (p, back) ← list_nth_mut_shared_loop_pair_merge_loop T tl0 tl1 i1
-        let back1 :=
-          fun ret => do
-                     let tl01 ← back ret
-                     Result.ok (List.Cons x0 tl01)
-        Result.ok (p, back1)
-    | List.Nil => Result.fail .panic
-  | List.Nil => Result.fail .panic
+  sorry
 
 /- [loops::list_nth_mut_shared_loop_pair_merge]:
    Source: 'tests/src/loops.rs', lines 288:0-292:23 -/
@@ -471,33 +180,7 @@ def list_nth_mut_shared_loop_pair_merge
   (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) :
   Result ((T × T) × (T → Result (List T)))
   :=
-  list_nth_mut_shared_loop_pair_merge_loop T ls0 ls1 i
-
-/- [loops::list_nth_shared_mut_loop_pair]: loop 0:
-   Source: 'tests/src/loops.rs', lines 307:0-322:1 -/
-divergent def list_nth_shared_mut_loop_pair_loop
-  (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) :
-  Result ((T × T) × (T → Result (List T)))
-  :=
-  match ls0 with
-  | List.Cons x0 tl0 =>
-    match ls1 with
-    | List.Cons x1 tl1 =>
-      if i = 0#u32
-      then
-        let back := fun ret => Result.ok (List.Cons ret tl1)
-        Result.ok ((x0, x1), back)
-      else
-        do
-        let i1 ← i - 1#u32
-        let (p, back) ← list_nth_shared_mut_loop_pair_loop T tl0 tl1 i1
-        let back1 :=
-          fun ret => do
-                     let tl11 ← back ret
-                     Result.ok (List.Cons x1 tl11)
-        Result.ok (p, back1)
-    | List.Nil => Result.fail .panic
-  | List.Nil => Result.fail .panic
+  sorry
 
 /- [loops::list_nth_shared_mut_loop_pair]:
    Source: 'tests/src/loops.rs', lines 307:0-311:23 -/
@@ -505,33 +188,7 @@ def list_nth_shared_mut_loop_pair
   (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) :
   Result ((T × T) × (T → Result (List T)))
   :=
-  list_nth_shared_mut_loop_pair_loop T ls0 ls1 i
-
-/- [loops::list_nth_shared_mut_loop_pair_merge]: loop 0:
-   Source: 'tests/src/loops.rs', lines 326:0-341:1 -/
-divergent def list_nth_shared_mut_loop_pair_merge_loop
-  (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) :
-  Result ((T × T) × (T → Result (List T)))
-  :=
-  match ls0 with
-  | List.Cons x0 tl0 =>
-    match ls1 with
-    | List.Cons x1 tl1 =>
-      if i = 0#u32
-      then
-        let back := fun ret => Result.ok (List.Cons ret tl1)
-        Result.ok ((x0, x1), back)
-      else
-        do
-        let i1 ← i - 1#u32
-        let (p, back) ← list_nth_shared_mut_loop_pair_merge_loop T tl0 tl1 i1
-        let back1 :=
-          fun ret => do
-                     let tl11 ← back ret
-                     Result.ok (List.Cons x1 tl11)
-        Result.ok (p, back1)
-    | List.Nil => Result.fail .panic
-  | List.Nil => Result.fail .panic
+  sorry
 
 /- [loops::list_nth_shared_mut_loop_pair_merge]:
    Source: 'tests/src/loops.rs', lines 326:0-330:23 -/
@@ -539,7 +196,7 @@ def list_nth_shared_mut_loop_pair_merge
   (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) :
   Result ((T × T) × (T → Result (List T)))
   :=
-  list_nth_shared_mut_loop_pair_merge_loop T ls0 ls1 i
+  sorry
 
 /- [loops::ignore_input_mut_borrow]: loop 0:
    Source: 'tests/src/loops.rs', lines 345:0-349:1 -/
-- 
cgit v1.3.1


From 52bcaf0cdd1c08ece0f9f09bdc0d32b753a2a00f Mon Sep 17 00:00:00 2001
From: Aymeric Fromherz
Date: Fri, 31 May 2024 11:55:51 +0200
Subject: Add markers when creating new abstractions because of a join with
 bottom

---
 compiler/InterpreterLoopsCore.ml      | 44 ++++++++++++++++++++++++++++++
 compiler/InterpreterLoopsJoinCtxs.ml  | 51 +++--------------------------------
 compiler/InterpreterLoopsMatchCtxs.ml | 16 ++++++++++-
 3 files changed, 63 insertions(+), 48 deletions(-)

(limited to 'compiler/InterpreterLoopsJoinCtxs.ml')

diff --git a/compiler/InterpreterLoopsCore.ml b/compiler/InterpreterLoopsCore.ml
index cd609ab0..8d6caac4 100644
--- a/compiler/InterpreterLoopsCore.ml
+++ b/compiler/InterpreterLoopsCore.ml
@@ -429,3 +429,47 @@ let ids_sets_empty_borrows_loans (ids : ids_sets) : ids_sets =
     }
   in
   ids
+
+(* Small utility: Add a projection marker to a typed avalue.
+   This can be used in combination with List.map to add markers to an entire abstraction
+*)
+let add_marker_avalue (span : Meta.span) (ctx : eval_ctx) (pm : proj_marker)
+    (av : typed_avalue) : typed_avalue =
+  let obj =
+    object
+      inherit [_] map_typed_avalue as super
+
+      method! visit_borrow_content _ _ =
+        craise __FILE__ __LINE__ span "Unexpected borrow"
+
+      method! visit_loan_content _ _ =
+        craise __FILE__ __LINE__ span "Unexpected loan"
+
+      method! visit_symbolic_value _ sv =
+        sanity_check __FILE__ __LINE__
+          (not (symbolic_value_has_borrows ctx sv))
+          span;
+        sv
+
+      method! visit_aloan_content env lc =
+        match lc with
+        | AMutLoan (pm0, bid, av) ->
+            sanity_check __FILE__ __LINE__ (pm0 = PNone) span;
+            super#visit_aloan_content env (AMutLoan (pm, bid, av))
+        | ASharedLoan (pm0, bids, av, child) ->
+            sanity_check __FILE__ __LINE__ (pm0 = PNone) span;
+            super#visit_aloan_content env (ASharedLoan (pm, bids, av, child))
+        | _ -> craise __FILE__ __LINE__ span "Unsupported yet"
+
+      method! visit_aborrow_content env bc =
+        match bc with
+        | AMutBorrow (pm0, bid, av) ->
+            sanity_check __FILE__ __LINE__ (pm0 = PNone) span;
+            super#visit_aborrow_content env (AMutBorrow (pm, bid, av))
+        | ASharedBorrow (pm0, bid) ->
+            sanity_check __FILE__ __LINE__ (pm0 = PNone) span;
+            super#visit_aborrow_content env (ASharedBorrow (pm, bid))
+        | _ -> craise __FILE__ __LINE__ span "Unsupported yet"
+    end
+  in
+  obj#visit_typed_avalue () av
diff --git a/compiler/InterpreterLoopsJoinCtxs.ml b/compiler/InterpreterLoopsJoinCtxs.ml
index 1e099d96..2f2dba41 100644
--- a/compiler/InterpreterLoopsJoinCtxs.ml
+++ b/compiler/InterpreterLoopsJoinCtxs.ml
@@ -664,58 +664,15 @@ let join_ctxs (span : Meta.span) (loop_id : LoopId.id) (fixed_ids : ids_sets)
           craise __FILE__ __LINE__ span "Unreachable"
     in
 
-    (* Add a projection marker to a typed avalue *)
-    let add_marker_avalue (pm : proj_marker) (av : typed_avalue) : typed_avalue
-        =
-      let obj =
-        object
-          inherit [_] map_typed_avalue as super
-
-          method! visit_borrow_content _ _ =
-            craise __FILE__ __LINE__ span "Unexpected borrow"
-
-          method! visit_loan_content _ _ =
-            craise __FILE__ __LINE__ span "Unexpected loan"
-
-          method! visit_symbolic_value _ sv =
-            (* While ctx0 and ctx1 are different, we assume that the type info context is
-               the same in both. Hence, we can use ctx0's types wlog *)
-            sanity_check __FILE__ __LINE__
-              (not (symbolic_value_has_borrows ctx0 sv))
-              span;
-            sv
-
-          method! visit_aloan_content env lc =
-            match lc with
-            | AMutLoan (pm0, bid, av) ->
-                sanity_check __FILE__ __LINE__ (pm0 = PNone) span;
-                super#visit_aloan_content env (AMutLoan (pm, bid, av))
-            | ASharedLoan (pm0, bids, av, child) ->
-                sanity_check __FILE__ __LINE__ (pm0 = PNone) span;
-                super#visit_aloan_content env
-                  (ASharedLoan (pm, bids, av, child))
-            | _ -> craise __FILE__ __LINE__ span "Unsupported yet"
-
-          method! visit_aborrow_content env bc =
-            match bc with
-            | AMutBorrow (pm0, bid, av) ->
-                sanity_check __FILE__ __LINE__ (pm0 = PNone) span;
-                super#visit_aborrow_content env (AMutBorrow (pm, bid, av))
-            | ASharedBorrow (pm0, bid) ->
-                sanity_check __FILE__ __LINE__ (pm0 = PNone) span;
-                super#visit_aborrow_content env (ASharedBorrow (pm, bid))
-            | _ -> craise __FILE__ __LINE__ span "Unsupported yet"
-        end
-      in
-      obj#visit_typed_avalue () av
-    in
-
     (* Add projection marker to all abstractions in the left and right environments *)
     let add_marker (pm : proj_marker) (ee : env_elem) : env_elem =
       match ee with
       | EAbs abs ->
           EAbs
-            { abs with avalues = List.map (add_marker_avalue pm) abs.avalues }
+            {
+              abs with
+              avalues = List.map (add_marker_avalue span ctx0 pm) abs.avalues;
+            }
       | x -> x
     in
 
diff --git a/compiler/InterpreterLoopsMatchCtxs.ml b/compiler/InterpreterLoopsMatchCtxs.ml
index 9b1d3dd0..713f462b 100644
--- a/compiler/InterpreterLoopsMatchCtxs.ml
+++ b/compiler/InterpreterLoopsMatchCtxs.ml
@@ -516,7 +516,7 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct
       let borrow_ty = mk_ref_ty (RFVar rid) bv_ty kind in
 
       (* Generate the avalues for the abstraction *)
-      let mk_aborrow (pm: proj_marker) (bid : borrow_id) : typed_avalue =
+      let mk_aborrow (pm : proj_marker) (bid : borrow_id) : typed_avalue =
         let value = ABorrow (ASharedBorrow (pm, bid)) in
         { value; ty = borrow_ty }
       in
@@ -832,6 +832,20 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct
           convert_value_to_abstractions span abs_kind can_end
             destructure_shared_values ctx v
         in
+        (* Add a marker to the abstraction indicating the provenance of the value *)
+        let absl =
+          List.map
+            (fun abs ->
+              {
+                abs with
+                avalues =
+                  List.map
+                    (add_marker_avalue span ctx0
+                       (if value_is_left then PLeft else PRight))
+                    abs.avalues;
+              })
+            absl
+        in
         push_absl absl;
         (* Return [Bottom] *)
         mk_bottom span v.ty
-- 
cgit v1.3.1


From e2afa2a24b290a55451431373152bf5a26c78d24 Mon Sep 17 00:00:00 2001
From: Aymeric Fromherz
Date: Fri, 31 May 2024 13:48:44 +0200
Subject: Fix unused variables warnings

---
 compiler/InterpreterBorrows.ml       | 14 ++++++++++----
 compiler/InterpreterLoopsJoinCtxs.ml | 17 ++++++++---------
 2 files changed, 18 insertions(+), 13 deletions(-)

(limited to 'compiler/InterpreterLoopsJoinCtxs.ml')

diff --git a/compiler/InterpreterBorrows.ml b/compiler/InterpreterBorrows.ml
index d48635fc..653dea7c 100644
--- a/compiler/InterpreterBorrows.ml
+++ b/compiler/InterpreterBorrows.ml
@@ -1713,7 +1713,7 @@ let destructure_abs (span : Meta.span) (abs_kind : abs_kind) (can_end : bool)
             let ignored = mk_aignored span child_av.ty in
             let value = ABorrow (AMutBorrow (pm, bid, ignored)) in
             push { value; ty }
-        | ASharedBorrow (pm, _) ->
+        | ASharedBorrow _ ->
             (* Nothing specific to do: keep the value as it is *)
             push av
         | AIgnoredMutBorrow (opt_bid, child_av) ->
@@ -2417,7 +2417,7 @@ let merge_into_abstraction_aux (span : Meta.span) (abs_kind : abs_kind)
                           *)
                           craise __FILE__ __LINE__ span "Unreachable"
                       | Abstract (ty, bc) -> { value = ABorrow bc; ty })
-                  | Some bc0, Some bc1 ->
+                  | Some _, Some _ ->
                       (* With markers, the case where the same borrow is duplicated should now be unreachable.
                          Note, this is due to all shared borrows currently taking different ids, this will
                          not be the case anymore when shared loans will take a unique id instead of a set *)
@@ -2480,7 +2480,7 @@ let merge_into_abstraction_aux (span : Meta.span) (abs_kind : abs_kind)
                           | AIgnoredSharedLoan _ ->
                               (* The abstraction has been destructured, so those shouldn't appear *)
                               craise __FILE__ __LINE__ span "Unreachable"))
-                  | Some lc0, Some lc1 ->
+                  | Some _, Some _ ->
                       (* With projection markers, shared loans should not be duplicated *)
                       craise __FILE__ __LINE__ span "Unreachable"
                   | None, None -> craise __FILE__ __LINE__ span "Unreachable"
@@ -2503,7 +2503,13 @@ let merge_into_abstraction_aux (span : Meta.span) (abs_kind : abs_kind)
   avalues := [];
 
   (* We recompute the relevant information on the abstraction after phase 1 *)
-  let { loans; borrows; borrows_loans; loan_to_content; borrow_to_content } =
+  let {
+    loans = _;
+    borrows = _;
+    borrows_loans;
+    loan_to_content;
+    borrow_to_content;
+  } =
     compute_merge_abstraction_info span ctx abs_values
   in
 
diff --git a/compiler/InterpreterLoopsJoinCtxs.ml b/compiler/InterpreterLoopsJoinCtxs.ml
index 2f2dba41..4b5cfb82 100644
--- a/compiler/InterpreterLoopsJoinCtxs.ml
+++ b/compiler/InterpreterLoopsJoinCtxs.ml
@@ -190,10 +190,10 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option)
     abs_ids;
     abs_to_borrows;
     abs_to_loans = _;
-    abs_to_borrows_loans;
+    abs_to_borrows_loans = _;
     borrow_to_abs = _;
     loan_to_abs;
-    borrow_loan_to_abs;
+    borrow_loan_to_abs = _;
   } =
     ids_maps
   in
@@ -306,7 +306,6 @@ let collapse_ctx_markers (span : Meta.span) (loop_id : LoopId.id)
 
   let abs_kind : abs_kind = Loop (loop_id, None, LoopSynthInput) in
   let can_end = true in
-  let destructure_shared_values = true in
   let is_fresh_abs_id (id : AbstractionId.id) : bool =
     not (AbstractionId.Set.mem id old_ids.aids)
   in
@@ -318,10 +317,10 @@ let collapse_ctx_markers (span : Meta.span) (loop_id : LoopId.id)
     abs_ids;
     abs_to_borrows;
     abs_to_loans;
-    abs_to_borrows_loans;
+    abs_to_borrows_loans = _;
     borrow_to_abs;
     loan_to_abs;
-    borrow_loan_to_abs;
+    borrow_loan_to_abs = _;
   } =
     ids_maps
   in
@@ -519,7 +518,7 @@ let mk_collapse_ctx_merge_duplicate_funs (span : Meta.span)
      Note that the join matcher doesn't implement match functions for avalues
      (see the comments in {!MakeJoinMatcher}.
   *)
-  let merge_amut_borrows id ty0 pm0 child0 _ty1 pm1 child1 =
+  let merge_amut_borrows id ty0 _pm0 child0 _ty1 _pm1 child1 =
     (* Sanity checks *)
     sanity_check __FILE__ __LINE__ (is_aignored child0.value) span;
     sanity_check __FILE__ __LINE__ (is_aignored child1.value) span;
@@ -535,7 +534,7 @@ let mk_collapse_ctx_merge_duplicate_funs (span : Meta.span)
     { value; ty }
   in
 
-  let merge_ashared_borrows id ty0 pm0 ty1 pm1 =
+  let merge_ashared_borrows id ty0 _pm0 ty1 _pm1 =
     (* Sanity checks *)
     let _ =
       let _, ty0, _ = ty_as_ref ty0 in
@@ -554,7 +553,7 @@ let mk_collapse_ctx_merge_duplicate_funs (span : Meta.span)
     { value; ty }
   in
 
-  let merge_amut_loans id ty0 pm0 child0 _ty1 pm1 child1 =
+  let merge_amut_loans id ty0 _pm0 child0 _ty1 _pm1 child1 =
     (* Sanity checks *)
     sanity_check __FILE__ __LINE__ (is_aignored child0.value) span;
     sanity_check __FILE__ __LINE__ (is_aignored child1.value) span;
@@ -565,7 +564,7 @@ let mk_collapse_ctx_merge_duplicate_funs (span : Meta.span)
     let value = ALoan (AMutLoan (PNone, id, child)) in
     { value; ty }
   in
-  let merge_ashared_loans ids ty0 pm0 (sv0 : typed_value) child0 _ty1 pm1
+  let merge_ashared_loans ids ty0 _pm0 (sv0 : typed_value) child0 _ty1 _pm1
       (sv1 : typed_value) child1 =
     (* Sanity checks *)
     sanity_check __FILE__ __LINE__ (is_aignored child0.value) span;
-- 
cgit v1.3.1


From 3598da14b7de6452b03e98e701996a8b6d4d5d38 Mon Sep 17 00:00:00 2001
From: Aymeric Fromherz
Date: Fri, 31 May 2024 14:46:12 +0200
Subject: Add documentation to collapse

---
 compiler/InterpreterLoopsJoinCtxs.ml | 28 +++++++++++++++++++++++++++-
 1 file changed, 27 insertions(+), 1 deletion(-)

(limited to 'compiler/InterpreterLoopsJoinCtxs.ml')

diff --git a/compiler/InterpreterLoopsJoinCtxs.ml b/compiler/InterpreterLoopsJoinCtxs.ml
index 4b5cfb82..930bffac 100644
--- a/compiler/InterpreterLoopsJoinCtxs.ml
+++ b/compiler/InterpreterLoopsJoinCtxs.ml
@@ -292,7 +292,33 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option)
 (* Reduce_ctx can only be called in a context with no markers *)
 let reduce_ctx = reduce_ctx_with_markers None
 
-(* TODO Adapt and comment *)
+(* Collapse an environment
+
+  This is the second part of a join, where we attempt to simplify and remove all projection markers.
+  This function is called after reducing the environments, and attempting to simplify all the pairs
+  of borrows and loans.
+
+  We traverse all abstractions, and merge abstractions when they contain the same element,
+  but with dual markers (i.e., PLeft and PRight).
+
+  For instance, if we have the abstractions
+
+  abs@0 { | MB l0 _ |, ML l1 }
+  abs@1 { ︙MB l0 _ ︙, ML l2 }
+
+  we will merge abs@0 and abs@1 into a new abstraction abs@2, removing the marker for duplicated elements,
+  and taking the join of the remaining elements
+
+  abs@2 { MB l0 _, ML l1, ML l2 }
+
+  Rem.: Doing this might introduce new pairs of borrow/loans to be merged in different abstractions: in the example above,
+  this could occur if there was another abstraction in the context containing ML l0, which would need to be simplified through
+  a further reduce.
+  It is unclear whether this can happen in practice. If so, a solution would be to preprocess the environments when doing
+  a join: while not in the current formalism, it is sound to split an element with no markers into a duplicated pair of the
+  same element with left and right markers. Doing this before reduce would allow to reduce all possible pairs of borrow/loans,
+  before finally collapsing and removing all markers.
+*)
 let collapse_ctx_markers (span : Meta.span) (loop_id : LoopId.id)
     (merge_funs : merge_duplicates_funcs) (old_ids : ids_sets) (ctx0 : eval_ctx)
     : eval_ctx =
-- 
cgit v1.3.1


From f5a7a0ceccfeec0dd8801d5a874cb66c1a356f8f Mon Sep 17 00:00:00 2001
From: Aymeric Fromherz
Date: Fri, 31 May 2024 15:00:23 +0200
Subject: format

---
 compiler/InterpreterLoopsJoinCtxs.ml | 36 ++++++++++++++++++------------------
 1 file changed, 18 insertions(+), 18 deletions(-)

(limited to 'compiler/InterpreterLoopsJoinCtxs.ml')

diff --git a/compiler/InterpreterLoopsJoinCtxs.ml b/compiler/InterpreterLoopsJoinCtxs.ml
index 930bffac..b58d1b3e 100644
--- a/compiler/InterpreterLoopsJoinCtxs.ml
+++ b/compiler/InterpreterLoopsJoinCtxs.ml
@@ -294,30 +294,30 @@ let reduce_ctx = reduce_ctx_with_markers None
 
 (* Collapse an environment
 
-  This is the second part of a join, where we attempt to simplify and remove all projection markers.
-  This function is called after reducing the environments, and attempting to simplify all the pairs
-  of borrows and loans.
+   This is the second part of a join, where we attempt to simplify and remove all projection markers.
+   This function is called after reducing the environments, and attempting to simplify all the pairs
+   of borrows and loans.
 
-  We traverse all abstractions, and merge abstractions when they contain the same element,
-  but with dual markers (i.e., PLeft and PRight).
+   We traverse all abstractions, and merge abstractions when they contain the same element,
+   but with dual markers (i.e., PLeft and PRight).
 
-  For instance, if we have the abstractions
+   For instance, if we have the abstractions
 
-  abs@0 { | MB l0 _ |, ML l1 }
-  abs@1 { ︙MB l0 _ ︙, ML l2 }
+   abs@0 { | MB l0 _ |, ML l1 }
+   abs@1 { ︙MB l0 _ ︙, ML l2 }
 
-  we will merge abs@0 and abs@1 into a new abstraction abs@2, removing the marker for duplicated elements,
-  and taking the join of the remaining elements
+   we will merge abs@0 and abs@1 into a new abstraction abs@2, removing the marker for duplicated elements,
+   and taking the join of the remaining elements
 
-  abs@2 { MB l0 _, ML l1, ML l2 }
+   abs@2 { MB l0 _, ML l1, ML l2 }
 
-  Rem.: Doing this might introduce new pairs of borrow/loans to be merged in different abstractions: in the example above,
-  this could occur if there was another abstraction in the context containing ML l0, which would need to be simplified through
-  a further reduce.
-  It is unclear whether this can happen in practice. If so, a solution would be to preprocess the environments when doing
-  a join: while not in the current formalism, it is sound to split an element with no markers into a duplicated pair of the
-  same element with left and right markers. Doing this before reduce would allow to reduce all possible pairs of borrow/loans,
-  before finally collapsing and removing all markers.
+   Rem.: Doing this might introduce new pairs of borrow/loans to be merged in different abstractions: in the example above,
+   this could occur if there was another abstraction in the context containing ML l0, which would need to be simplified through
+   a further reduce.
+   It is unclear whether this can happen in practice. If so, a solution would be to preprocess the environments when doing
+   a join: while not in the current formalism, it is sound to split an element with no markers into a duplicated pair of the
+   same element with left and right markers. Doing this before reduce would allow to reduce all possible pairs of borrow/loans,
+   before finally collapsing and removing all markers.
 *)
 let collapse_ctx_markers (span : Meta.span) (loop_id : LoopId.id)
     (merge_funs : merge_duplicates_funcs) (old_ids : ids_sets) (ctx0 : eval_ctx)
-- 
cgit v1.3.1


From 9aa328a70011d2784a943830bffabc600caba4ab Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Mon, 3 Jun 2024 12:52:04 +0200
Subject: Cleanup a bit

---
 compiler/InterpreterLoopsCore.ml       |  16 ++--
 compiler/InterpreterLoopsJoinCtxs.ml   |  16 +---
 compiler/InterpreterLoopsMatchCtxs.ml  | 142 +++++++++++++++++----------------
 compiler/InterpreterLoopsMatchCtxs.mli |   4 +-
 4 files changed, 87 insertions(+), 91 deletions(-)

(limited to 'compiler/InterpreterLoopsJoinCtxs.ml')

diff --git a/compiler/InterpreterLoopsCore.ml b/compiler/InterpreterLoopsCore.ml
index 8d6caac4..4149b19e 100644
--- a/compiler/InterpreterLoopsCore.ml
+++ b/compiler/InterpreterLoopsCore.ml
@@ -26,21 +26,21 @@ type ctx_or_update = (eval_ctx, updt_env_kind) result
 (** Union Find *)
 module UF = UnionFind.Make (UnionFind.StoreMap)
 
-(** A small utility -
-
-    Rem.: some environments may be ill-formed (they may contain several times
-    the same loan or borrow - this happens for instance when merging
-    environments). This is the reason why we use sets in some places (for
-    instance, [borrow_to_abs] maps to a *set* of ids).
+(** A small utility.
+
+    Remark: we use projection markers, meaning we compute maps from/to
+    pairs of (projection marker, borrow/loan id). This allows us to use
+    this utility during a reduce phase (when we simplify the environment
+    and all markers should be [PNone]) as well as during a collapse (where
+    we actually have markers because we performed a join and are progressively
+    transforming the environment to get rid of those markers).
 *)
 type abs_borrows_loans_maps = {
   abs_ids : AbstractionId.id list;
   abs_to_borrows : MarkerBorrowId.Set.t AbstractionId.Map.t;
   abs_to_loans : MarkerBorrowId.Set.t AbstractionId.Map.t;
-  abs_to_borrows_loans : MarkerBorrowId.Set.t AbstractionId.Map.t;
   borrow_to_abs : AbstractionId.Set.t MarkerBorrowId.Map.t;
   loan_to_abs : AbstractionId.Set.t MarkerBorrowId.Map.t;
-  borrow_loan_to_abs : AbstractionId.Set.t MarkerBorrowId.Map.t;
 }
 
 (** See {!module:Aeneas.InterpreterLoopsMatchCtxs.MakeMatcher} and [Matcher].
diff --git a/compiler/InterpreterLoopsJoinCtxs.ml b/compiler/InterpreterLoopsJoinCtxs.ml
index b58d1b3e..ce874992 100644
--- a/compiler/InterpreterLoopsJoinCtxs.ml
+++ b/compiler/InterpreterLoopsJoinCtxs.ml
@@ -185,15 +185,13 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option)
 
   (* Explore all the *new* abstractions, and compute various maps *)
   let explore (abs : abs) = is_fresh_abs_id abs.abs_id in
-  let ids_maps = compute_abs_borrows_loans_maps span true explore env in
+  let ids_maps = compute_abs_borrows_loans_maps span explore env in
   let {
     abs_ids;
     abs_to_borrows;
     abs_to_loans = _;
-    abs_to_borrows_loans = _;
     borrow_to_abs = _;
     loan_to_abs;
-    borrow_loan_to_abs = _;
   } =
     ids_maps
   in
@@ -338,16 +336,8 @@ let collapse_ctx_markers (span : Meta.span) (loop_id : LoopId.id)
 
   (* Explore all the *new* abstractions, and compute various maps *)
   let explore (abs : abs) = is_fresh_abs_id abs.abs_id in
-  let ids_maps = compute_abs_borrows_loans_maps span false explore ctx0.env in
-  let {
-    abs_ids;
-    abs_to_borrows;
-    abs_to_loans;
-    abs_to_borrows_loans = _;
-    borrow_to_abs;
-    loan_to_abs;
-    borrow_loan_to_abs = _;
-  } =
+  let ids_maps = compute_abs_borrows_loans_maps span explore ctx0.env in
+  let { abs_ids; abs_to_borrows; abs_to_loans; borrow_to_abs; loan_to_abs } =
     ids_maps
   in
 
diff --git a/compiler/InterpreterLoopsMatchCtxs.ml b/compiler/InterpreterLoopsMatchCtxs.ml
index 713f462b..bc39d5ec 100644
--- a/compiler/InterpreterLoopsMatchCtxs.ml
+++ b/compiler/InterpreterLoopsMatchCtxs.ml
@@ -20,32 +20,28 @@ module S = SynthesizeSymbolic
 (** The local logger *)
 let log = Logging.loops_match_ctxs_log
 
-let compute_abs_borrows_loans_maps (span : Meta.span) (no_duplicates : bool)
-    (explore : abs -> bool) (env : env) : abs_borrows_loans_maps =
+let compute_abs_borrows_loans_maps (span : Meta.span) (explore : abs -> bool)
+    (env : env) : abs_borrows_loans_maps =
   let abs_ids = ref [] in
   let abs_to_borrows = ref AbstractionId.Map.empty in
   let abs_to_loans = ref AbstractionId.Map.empty in
-  let abs_to_borrows_loans = ref AbstractionId.Map.empty in
   let borrow_to_abs = ref MarkerBorrowId.Map.empty in
   let loan_to_abs = ref MarkerBorrowId.Map.empty in
-  let borrow_loan_to_abs = ref MarkerBorrowId.Map.empty in
 
   let module R (M : Collections.Map) (S : Collections.Set) = struct
     (*
        [check_singleton_sets]: check that the mapping maps to a singleton.
-       [check_not_already_registered]: check if the mapping was not already registered.
+       We need this because to tweak the behavior of the sanity checks because
+       of the following cases:
+       - when computing the map from borrow ids (with marker) to the region
+         abstractions they belong to, the marked borrow ids can map to a single
+         region abstraction, i.e., to a singleton set of region abstraction ids
+       - however, when computing the mapping from region abstractions to
+         the borrow ids they contain, this time we do map abstraction ids
+         to sets which can compute strictly more than one value
     *)
-    let register_mapping (check_singleton_sets : bool)
-        (check_not_already_registered : bool) (map : S.t M.t ref) (id0 : M.key)
-        (id1 : S.elt) : unit =
-      (* Sanity check *)
-      (if check_singleton_sets || check_not_already_registered then
-         match M.find_opt id0 !map with
-         | None -> ()
-         | Some set ->
-             sanity_check __FILE__ __LINE__
-               ((not check_not_already_registered) || not (S.mem id1 set))
-               span);
+    let register_mapping (check_singleton_sets : bool) (map : S.t M.t ref)
+        (id0 : M.key) (id1 : S.elt) : unit =
       (* Update the mapping *)
       map :=
         M.update id0
@@ -53,11 +49,11 @@ let compute_abs_borrows_loans_maps (span : Meta.span) (no_duplicates : bool)
             match ids with
             | None -> Some (S.singleton id1)
             | Some ids ->
-                (* Sanity check *)
+                (* Check that we are allowed to map id0 to a set which is not
+                   a singleton *)
                 sanity_check __FILE__ __LINE__ (not check_singleton_sets) span;
-                sanity_check __FILE__ __LINE__
-                  ((not check_not_already_registered) || not (S.mem id1 ids))
-                  span;
+                (* Check that the mapping was not already registered *)
+                sanity_check __FILE__ __LINE__ (not (S.mem id1 ids)) span;
                 (* Update *)
                 Some (S.add id1 ids))
           !map
@@ -65,20 +61,13 @@ let compute_abs_borrows_loans_maps (span : Meta.span) (no_duplicates : bool)
   let module RAbsBorrow = R (AbstractionId.Map) (MarkerBorrowId.Set) in
   let module RBorrowAbs = R (MarkerBorrowId.Map) (AbstractionId.Set) in
   let register_borrow_id abs_id pm bid =
-    RAbsBorrow.register_mapping false no_duplicates abs_to_borrows abs_id
-      (pm, bid);
-    RAbsBorrow.register_mapping false false abs_to_borrows_loans abs_id (pm, bid);
-    RBorrowAbs.register_mapping no_duplicates no_duplicates borrow_to_abs
-      (pm, bid) abs_id;
-    RBorrowAbs.register_mapping false false borrow_loan_to_abs (pm, bid) abs_id
+    RAbsBorrow.register_mapping false abs_to_borrows abs_id (pm, bid);
+    RBorrowAbs.register_mapping true borrow_to_abs (pm, bid) abs_id
   in
 
   let register_loan_id abs_id pm bid =
-    RAbsBorrow.register_mapping false no_duplicates abs_to_loans abs_id (pm, bid);
-    RAbsBorrow.register_mapping false false abs_to_borrows_loans abs_id (pm, bid);
-    RBorrowAbs.register_mapping no_duplicates no_duplicates loan_to_abs
-      (pm, bid) abs_id;
-    RBorrowAbs.register_mapping false false borrow_loan_to_abs (pm, bid) abs_id
+    RAbsBorrow.register_mapping false abs_to_loans abs_id (pm, bid);
+    RBorrowAbs.register_mapping true loan_to_abs (pm, bid) abs_id
   in
 
   let explore_abs =
@@ -87,10 +76,19 @@ let compute_abs_borrows_loans_maps (span : Meta.span) (no_duplicates : bool)
 
       (** Make sure we don't register the ignored ids *)
       method! visit_aloan_content (abs_id, pm) lc =
+        sanity_check __FILE__ __LINE__ (pm = PNone) span;
         match lc with
-        | AMutLoan (pm, _, _) | ASharedLoan (pm, _, _, _) ->
-            (* Process those normally *)
-            super#visit_aloan_content (abs_id, pm) lc
+        | AMutLoan (npm, lid, child) ->
+            (* Add the current marker when visiting the loan id *)
+            self#visit_loan_id (abs_id, npm) lid;
+            (* Recurse with the old marker *)
+            super#visit_typed_avalue (abs_id, pm) child
+        | ASharedLoan (npm, lids, sv, child) ->
+            (* Add the current marker when visiting the loan ids and the shared value *)
+            self#visit_loan_id_set (abs_id, npm) lids;
+            self#visit_typed_value (abs_id, npm) sv;
+            (* Recurse with the old marker *)
+            self#visit_typed_avalue (abs_id, pm) child
         | AIgnoredMutLoan (_, child)
         | AEndedIgnoredMutLoan { child; given_back = _; given_back_span = _ }
         | AIgnoredSharedLoan child ->
@@ -102,10 +100,16 @@ let compute_abs_borrows_loans_maps (span : Meta.span) (no_duplicates : bool)
 
       (** Make sure we don't register the ignored ids *)
       method! visit_aborrow_content (abs_id, pm) bc =
+        sanity_check __FILE__ __LINE__ (pm = PNone) span;
         match bc with
-        | AMutBorrow (pm, _, _) | ASharedBorrow (pm, _) ->
-            (* Add the current marker, and process them recursively *)
-            super#visit_aborrow_content (abs_id, pm) bc
+        | AMutBorrow (npm, bid, child) ->
+            (* Add the current marker when visiting the borrow id *)
+            self#visit_borrow_id (abs_id, npm) bid;
+            (* Recurse with the old marker *)
+            self#visit_typed_avalue (abs_id, pm) child
+        | ASharedBorrow (npm, bid) ->
+            (* Add the current marker when visiting the borrow id *)
+            self#visit_borrow_id (abs_id, npm) bid
         | AProjSharedBorrow _ ->
             sanity_check __FILE__ __LINE__ (pm = PNone) span;
             (* Process those normally *)
@@ -147,10 +151,8 @@ let compute_abs_borrows_loans_maps (span : Meta.span) (no_duplicates : bool)
     abs_ids = !abs_ids;
     abs_to_borrows = !abs_to_borrows;
     abs_to_loans = !abs_to_loans;
-    abs_to_borrows_loans = !abs_to_borrows_loans;
     borrow_to_abs = !borrow_to_abs;
     loan_to_abs = !loan_to_abs;
-    borrow_loan_to_abs = !borrow_loan_to_abs;
   }
 
 (** Match two types during a join.
@@ -557,7 +559,7 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct
          an abstraction:
 
          {[
-           { MB bid0, ML nbid }  // where nbid fresh
+           { MB bid0, ML bid' }  // where bid' fresh
          ]}
 
          and we use bid' for the borrow id that we return.
@@ -565,7 +567,7 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct
          We do this because we want to make sure that, whenever a mutably
          borrowed value is modified in a loop iteration, then there is
          a fresh abstraction between this borrowed value and the fixed
-         abstractions.
+         abstractions (this is tantamount to introducing a reborrow).
 
          Example:
          ========
@@ -596,6 +598,15 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct
          to say [unit]) while the backward loop function gives back a new value
          for [v] (i.e., a new symbolic value which will replace [s0]).
 
+         By introducing the fresh region abstraction wet get:
+         {[
+           abs'0 { ML l0 } // input abstraction
+           abs'1 { MB l0, ML l1 } // fresh abstraction
+           v -> MB l1 s1
+           i -> 0
+         ]}
+
+
          In the future, we will also compute joins at the *loop exits*: when we
          do so, we won't introduce reborrows like above: the forward loop function
          will update [v], while the backward loop function will return nothing.
@@ -613,7 +624,8 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct
 
         let kind = RMut in
         let bv_ty = bv.ty in
-        sanity_check __FILE__ __LINE__ (ty_no_regions bv_ty) span;
+        cassert __FILE__ __LINE__ (ty_no_regions bv_ty) span
+          "Nested borrows are not supported yet";
         let borrow_ty = mk_ref_ty (RFVar rid) bv_ty kind in
 
         let borrow_av =
@@ -651,9 +663,10 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct
         (nbid, bv))
     else
       (* We replace bid0 and bid1 with a fresh borrow id, and introduce
-         an abstraction which links all of them:
+         an abstraction which links all of them. This time we have to introduce
+         markers:
          {[
-           { MB bid0, MB bid1, ML bid2 }
+           { |MB bid0|, ︙MB bid1︙, ML bid2 }
          ]}
       *)
       let rid = fresh_region_id () in
@@ -761,24 +774,16 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct
     (* Check that:
        - there are no borrows in the symbolic value
        - there are no borrows in the "regular" value
-       If there are loans in the regular value, raise an exception.
     *)
     let type_infos = ctx0.type_ctx.type_infos in
-    cassert __FILE__ __LINE__
+    sanity_check __FILE__ __LINE__
       (not (ty_has_borrows type_infos sv.sv_ty))
-      span
-      "Check that:\n\
-      \    - there are no borrows in the symbolic value\n\
-      \    - there are no borrows in the \"regular\" value\n\
-      \    If there are loans in the regular value, raise an exception.";
-    cassert __FILE__ __LINE__
+      span;
+    sanity_check __FILE__ __LINE__
       (not (ValuesUtils.value_has_borrows type_infos v.value))
-      span
-      "Check that:\n\
-      \    - there are no borrows in the symbolic value\n\
-      \    - there are no borrows in the \"regular\" value\n\
-      \    If there are loans in the regular value, raise an exception.";
+      span;
     let value_is_left = not left in
+    (* If there are loans in the regular value, raise an exception. *)
     (match InterpreterBorrowsCore.get_first_loan_in_value v with
     | None -> ()
     | Some (VSharedLoan (ids, _)) ->
@@ -798,13 +803,13 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct
     then mk_bottom span sv.sv_ty
     else mk_fresh_symbolic_typed_value span sv.sv_ty
 
-  let match_bottom_with_other (ctx0 : eval_ctx) (ctx1 : eval_ctx) (left : bool)
-      (v : typed_value) : typed_value =
+  let match_bottom_with_other (ctx0 : eval_ctx) (ctx1 : eval_ctx)
+      (bottom_is_left : bool) (v : typed_value) : typed_value =
+    let value_is_left = not bottom_is_left in
     (* If there are outer loans in the non-bottom value, raise an exception.
        Otherwise, convert it to an abstraction and return [Bottom].
     *)
     let with_borrows = false in
-    let value_is_left = not left in
     match
       InterpreterBorrowsCore.get_first_outer_loan_or_borrow_in_value
         with_borrows v
@@ -821,8 +826,6 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct
             if value_is_left then raise (ValueMatchFailure (LoanInLeft id))
             else raise (ValueMatchFailure (LoanInRight id)))
     | None ->
-        (*   *)
-
         (* Convert the value to an abstraction *)
         let abs_kind : abs_kind = Loop (S.loop_id, None, LoopSynthInput) in
         let can_end = true in
@@ -833,16 +836,13 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct
             destructure_shared_values ctx v
         in
         (* Add a marker to the abstraction indicating the provenance of the value *)
+        let pm = if value_is_left then PLeft else PRight in
         let absl =
           List.map
             (fun abs ->
               {
                 abs with
-                avalues =
-                  List.map
-                    (add_marker_avalue span ctx0
-                       (if value_is_left then PLeft else PRight))
-                    abs.avalues;
+                avalues = List.map (add_marker_avalue span ctx0 pm) abs.avalues;
               })
             absl
         in
@@ -1246,6 +1246,8 @@ struct
 
   let match_ashared_borrows (_ : eval_ctx) (_ : eval_ctx) _ty0 pm0 bid0 _ty1 pm1
       bid1 ty =
+    (* We are checking whether that two environments are equivalent:
+       there shouldn't be any projection markers *)
     sanity_check __FILE__ __LINE__ (pm0 = PNone && pm1 = PNone) span;
     let bid = match_borrow_id bid0 bid1 in
     let value = ABorrow (ASharedBorrow (PNone, bid)) in
@@ -1253,6 +1255,8 @@ struct
 
   let match_amut_borrows (_ : eval_ctx) (_ : eval_ctx) _ty0 pm0 bid0 _av0 _ty1
       pm1 bid1 _av1 ty av =
+    (* We are checking whether that two environments are equivalent:
+       there shouldn't be any projection markers *)
     sanity_check __FILE__ __LINE__ (pm0 = PNone && pm1 = PNone) span;
     let bid = match_borrow_id bid0 bid1 in
     let value = ABorrow (AMutBorrow (PNone, bid, av)) in
@@ -1260,6 +1264,8 @@ struct
 
   let match_ashared_loans (_ : eval_ctx) (_ : eval_ctx) _ty0 pm0 ids0 _v0 _av0
       _ty1 pm1 ids1 _v1 _av1 ty v av =
+    (* We are checking whether that two environments are equivalent:
+       there shouldn't be any projection markers *)
     sanity_check __FILE__ __LINE__ (pm0 = PNone && pm1 = PNone) span;
     let bids = match_loan_ids ids0 ids1 in
     let value = ALoan (ASharedLoan (PNone, bids, v, av)) in
@@ -1267,6 +1273,8 @@ struct
 
   let match_amut_loans (ctx0 : eval_ctx) (ctx1 : eval_ctx) _ty0 pm0 id0 _av0
       _ty1 pm1 id1 _av1 ty av =
+    (* We are checking whether that two environments are equivalent:
+       there shouldn't be any projection markers *)
     sanity_check __FILE__ __LINE__ (pm0 = PNone && pm1 = PNone) span;
     log#ldebug
       (lazy
diff --git a/compiler/InterpreterLoopsMatchCtxs.mli b/compiler/InterpreterLoopsMatchCtxs.mli
index 7d214cb6..cd807358 100644
--- a/compiler/InterpreterLoopsMatchCtxs.mli
+++ b/compiler/InterpreterLoopsMatchCtxs.mli
@@ -13,13 +13,11 @@ open InterpreterLoopsCore
 (** Compute various maps linking the abstractions and the borrows/loans they contain.
 
     Parameters:
-    - [no_duplicates]: checks that borrows/loans are not referenced more than once
-      (see the documentation for {!type:InterpreterLoopsCore.abs_borrows_loans_maps}).
     - [explore]: this function is used to filter abstractions.
     - [env]
  *)
 val compute_abs_borrows_loans_maps :
-  Meta.span -> bool -> (abs -> bool) -> env -> abs_borrows_loans_maps
+  Meta.span -> (abs -> bool) -> env -> abs_borrows_loans_maps
 
 (** Generic functor to implement matching functions between values, environments,
     etc.
-- 
cgit v1.3.1


From ec1e958fd7bd82a4e931e1dc7acb79eeccef92ac Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Mon, 3 Jun 2024 14:30:31 +0200
Subject: Factor out some code and update some comments

---
 compiler/InterpreterBorrows.ml         |  60 +++++++++++
 compiler/InterpreterBorrows.mli        |  17 +++
 compiler/InterpreterLoopsFixedPoint.ml |  76 ++------------
 compiler/InterpreterLoopsJoinCtxs.ml   | 186 ++++++++++++++++-----------------
 4 files changed, 173 insertions(+), 166 deletions(-)

(limited to 'compiler/InterpreterLoopsJoinCtxs.ml')

diff --git a/compiler/InterpreterBorrows.ml b/compiler/InterpreterBorrows.ml
index a31d36cd..48292181 100644
--- a/compiler/InterpreterBorrows.ml
+++ b/compiler/InterpreterBorrows.ml
@@ -2814,3 +2814,63 @@ let merge_into_abstraction (span : Meta.span) (abs_kind : abs_kind)
 
   (* Return *)
   (ctx, nabs.abs_id)
+
+let reorder_loans_borrows_in_fresh_abs (span : Meta.span) (allow_markers : bool)
+    (old_abs_ids : AbstractionId.Set.t) (ctx : eval_ctx) : eval_ctx =
+  let reorder_in_fresh_abs (abs : abs) : abs =
+    (* Split between the loans and borrows *)
+    let is_borrow (av : typed_avalue) : bool =
+      match av.value with
+      | ABorrow _ -> true
+      | ALoan _ -> false
+      | _ -> craise __FILE__ __LINE__ span "Unexpected"
+    in
+    let aborrows, aloans = List.partition is_borrow abs.avalues in
+
+    (* Reoder the borrows, and the loans.
+
+       After experimenting, it seems that a good way of reordering the loans
+       and the borrows to find fixed points is simply to sort them by increasing
+       order of id (taking the smallest id of a set of ids, in case of sets).
+
+       This is actually not as arbitrary as it might seem, because the ids give
+       us the order in which we introduced those borrows/loans.
+    *)
+    let get_borrow_id (av : typed_avalue) : BorrowId.id =
+      match av.value with
+      | ABorrow (AMutBorrow (pm, bid, _) | ASharedBorrow (pm, bid)) ->
+          sanity_check __FILE__ __LINE__ (allow_markers || pm = PNone) span;
+          bid
+      | _ -> craise __FILE__ __LINE__ span "Unexpected"
+    in
+    let get_loan_id (av : typed_avalue) : BorrowId.id =
+      match av.value with
+      | ALoan (AMutLoan (pm, lid, _)) ->
+          sanity_check __FILE__ __LINE__ (allow_markers || pm = PNone) span;
+          lid
+      | ALoan (ASharedLoan (pm, lids, _, _)) ->
+          sanity_check __FILE__ __LINE__ (allow_markers || pm = PNone) span;
+          BorrowId.Set.min_elt lids
+      | _ -> craise __FILE__ __LINE__ span "Unexpected"
+    in
+    (* We use ordered maps to reorder the borrows and loans *)
+    let reorder (get_bid : typed_avalue -> BorrowId.id)
+        (values : typed_avalue list) : typed_avalue list =
+      List.map snd
+        (BorrowId.Map.bindings
+           (BorrowId.Map.of_list (List.map (fun v -> (get_bid v, v)) values)))
+    in
+    let aborrows = reorder get_borrow_id aborrows in
+    let aloans = reorder get_loan_id aloans in
+    let avalues = List.append aborrows aloans in
+    { abs with avalues }
+  in
+
+  let reorder_in_abs (abs : abs) =
+    if AbstractionId.Set.mem abs.abs_id old_abs_ids then abs
+    else reorder_in_fresh_abs abs
+  in
+
+  let env = env_map_abs reorder_in_abs ctx.env in
+
+  { ctx with env }
diff --git a/compiler/InterpreterBorrows.mli b/compiler/InterpreterBorrows.mli
index c119311f..0bc2bfab 100644
--- a/compiler/InterpreterBorrows.mli
+++ b/compiler/InterpreterBorrows.mli
@@ -269,3 +269,20 @@ val merge_into_abstraction :
   AbstractionId.id ->
   AbstractionId.id ->
   eval_ctx * AbstractionId.id
+
+(** Reorder the loans and borrows in the fresh abstractions.
+
+    We do this in order to enforce some structure in the environments: this
+    allows us to find fixed-points. Note that this function needs to be
+    called typically after we merge abstractions together (see {!reduce_ctx}
+    and {!collapse_ctx} for instance).
+
+    Inputs:
+    - [span]
+    - [allow_markers]: disables some sanity checks (which check that projection
+      markers don't appear).
+    - [old_abs_ids]
+    - [eval_ctx]
+ *)
+val reorder_loans_borrows_in_fresh_abs :
+  Meta.span -> bool -> AbstractionId.Set.t -> eval_ctx -> eval_ctx
diff --git a/compiler/InterpreterLoopsFixedPoint.ml b/compiler/InterpreterLoopsFixedPoint.ml
index 26505902..033deebb 100644
--- a/compiler/InterpreterLoopsFixedPoint.ml
+++ b/compiler/InterpreterLoopsFixedPoint.ml
@@ -126,70 +126,6 @@ let cleanup_fresh_values_and_abs (config : config) (span : Meta.span)
   let ctx = cleanup_fresh_values fixed_ids ctx in
   (ctx, cc)
 
-(** Reorder the loans and borrows in the fresh abstractions.
-
-    We do this in order to enforce some structure in the environments: this
-    allows us to find fixed-points. Note that this function needs to be
-    called typically after we merge abstractions together (see {!collapse_ctx}
-    and {!reduce_ctx} for instance).
- *)
-let reorder_loans_borrows_in_fresh_abs (span : Meta.span)
-    (old_abs_ids : AbstractionId.Set.t) (ctx : eval_ctx) : eval_ctx =
-  let reorder_in_fresh_abs (abs : abs) : abs =
-    (* Split between the loans and borrows *)
-    let is_borrow (av : typed_avalue) : bool =
-      match av.value with
-      | ABorrow _ -> true
-      | ALoan _ -> false
-      | _ -> craise __FILE__ __LINE__ span "Unexpected"
-    in
-    let aborrows, aloans = List.partition is_borrow abs.avalues in
-
-    (* Reoder the borrows, and the loans.
-
-       After experimenting, it seems that a good way of reordering the loans
-       and the borrows to find fixed points is simply to sort them by increasing
-       order of id (taking the smallest id of a set of ids, in case of sets).
-    *)
-    let get_borrow_id (av : typed_avalue) : BorrowId.id =
-      match av.value with
-      | ABorrow (AMutBorrow (pm, bid, _) | ASharedBorrow (pm, bid)) ->
-          sanity_check __FILE__ __LINE__ (pm = PNone) span;
-          bid
-      | _ -> craise __FILE__ __LINE__ span "Unexpected"
-    in
-    let get_loan_id (av : typed_avalue) : BorrowId.id =
-      match av.value with
-      | ALoan (AMutLoan (pm, lid, _)) ->
-          sanity_check __FILE__ __LINE__ (pm = PNone) span;
-          lid
-      | ALoan (ASharedLoan (pm, lids, _, _)) ->
-          sanity_check __FILE__ __LINE__ (pm = PNone) span;
-          BorrowId.Set.min_elt lids
-      | _ -> craise __FILE__ __LINE__ span "Unexpected"
-    in
-    (* We use ordered maps to reorder the borrows and loans *)
-    let reorder (get_bid : typed_avalue -> BorrowId.id)
-        (values : typed_avalue list) : typed_avalue list =
-      List.map snd
-        (BorrowId.Map.bindings
-           (BorrowId.Map.of_list (List.map (fun v -> (get_bid v, v)) values)))
-    in
-    let aborrows = reorder get_borrow_id aborrows in
-    let aloans = reorder get_loan_id aloans in
-    let avalues = List.append aborrows aloans in
-    { abs with avalues }
-  in
-
-  let reorder_in_abs (abs : abs) =
-    if AbstractionId.Set.mem abs.abs_id old_abs_ids then abs
-    else reorder_in_fresh_abs abs
-  in
-
-  let env = env_map_abs reorder_in_abs ctx.env in
-
-  { ctx with env }
-
 let prepare_ashared_loans (span : Meta.span) (loop_id : LoopId.id option) :
     cm_fun =
  fun ctx0 ->
@@ -251,11 +187,14 @@ let prepare_ashared_loans (span : Meta.span) (loop_id : LoopId.id option) :
        SL {l0, l1} s0
      ]}
 
-     and introduce the corresponding abstraction for the borrow l0
-     (and we do something similar for l1):
+     and introduce the corresponding abstractions for the borrows l0 and l1:
      {[
-       abs'2 { SB l0, SL {l2} s2 }
+       abs'2 { SB l0, SL {l0'} s1 } // Reborrow for l0
+       abs'3 { SB l1, SL {l1'} s2 } // Reborrow for l1
      ]}
+
+     Remark: of course we also need to replace the [SB l0] and the [SB l1]
+     values we find in the environments with [SB l0'] and [SB l1'].
   *)
   let push_abs_for_shared_value (abs : abs) (sv : typed_value)
       (lid : BorrowId.id) : unit =
@@ -821,7 +760,8 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span)
 
     (* Reorder the loans and borrows in the fresh abstractions in the fixed-point *)
     let fp =
-      reorder_loans_borrows_in_fresh_abs span (Option.get !fixed_ids).aids !fp
+      reorder_loans_borrows_in_fresh_abs span false (Option.get !fixed_ids).aids
+        !fp
     in
 
     (* Update the abstraction's [can_end] field and their kinds.
diff --git a/compiler/InterpreterLoopsJoinCtxs.ml b/compiler/InterpreterLoopsJoinCtxs.ml
index ce874992..d2f52781 100644
--- a/compiler/InterpreterLoopsJoinCtxs.ml
+++ b/compiler/InterpreterLoopsJoinCtxs.ml
@@ -1,6 +1,7 @@
 open Types
 open Values
 open Contexts
+open Utils
 open TypesUtils
 open ValuesUtils
 open InterpreterUtils
@@ -12,64 +13,6 @@ open Errors
 (** The local logger *)
 let log = Logging.loops_join_ctxs_log
 
-(** Reorder the loans and borrows in the fresh abstractions.
-
-    We do this in order to enforce some structure in the environments: this
-    allows us to find fixed-points. Note that this function needs to be
-    called typically after we merge abstractions together (see {!collapse_ctx}
-    and {!reduce_ctx} for instance).
- *)
-let reorder_loans_borrows_in_fresh_abs (span : Meta.span)
-    (old_abs_ids : AbstractionId.Set.t) (ctx : eval_ctx) : eval_ctx =
-  let reorder_in_fresh_abs (abs : abs) : abs =
-    (* Split between the loans and borrows *)
-    let is_borrow (av : typed_avalue) : bool =
-      match av.value with
-      | ABorrow _ -> true
-      | ALoan _ -> false
-      | _ -> craise __FILE__ __LINE__ span "Unexpected"
-    in
-    let aborrows, aloans = List.partition is_borrow abs.avalues in
-
-    (* Reoder the borrows, and the loans.
-
-       After experimenting, it seems that a good way of reordering the loans
-       and the borrows to find fixed points is simply to sort them by increasing
-       order of id (taking the smallest id of a set of ids, in case of sets).
-    *)
-    let get_borrow_id (av : typed_avalue) : BorrowId.id =
-      match av.value with
-      | ABorrow (AMutBorrow (_, bid, _) | ASharedBorrow (_, bid)) -> bid
-      | _ -> craise __FILE__ __LINE__ span "Unexpected"
-    in
-    let get_loan_id (av : typed_avalue) : BorrowId.id =
-      match av.value with
-      | ALoan (AMutLoan (_, lid, _)) -> lid
-      | ALoan (ASharedLoan (_, lids, _, _)) -> BorrowId.Set.min_elt lids
-      | _ -> craise __FILE__ __LINE__ span "Unexpected"
-    in
-    (* We use ordered maps to reorder the borrows and loans *)
-    let reorder (get_bid : typed_avalue -> BorrowId.id)
-        (values : typed_avalue list) : typed_avalue list =
-      List.map snd
-        (BorrowId.Map.bindings
-           (BorrowId.Map.of_list (List.map (fun v -> (get_bid v, v)) values)))
-    in
-    let aborrows = reorder get_borrow_id aborrows in
-    let aloans = reorder get_loan_id aloans in
-    let avalues = List.append aborrows aloans in
-    { abs with avalues }
-  in
-
-  let reorder_in_abs (abs : abs) =
-    if AbstractionId.Set.mem abs.abs_id old_abs_ids then abs
-    else reorder_in_fresh_abs abs
-  in
-
-  let env = env_map_abs reorder_in_abs ctx.env in
-
-  { ctx with env }
-
 (** Reduce an environment.
 
     We do this to simplify an environment, for the purpose of finding a loop
@@ -84,8 +27,8 @@ let reorder_loans_borrows_in_fresh_abs (span : Meta.span)
     In effect, this allows us to merge newly introduced abstractions/borrows
     with their parent abstractions.
     
-    For instance, when evaluating the first loop iteration, we start in the
-    following environment:
+    For instance, looking at the [list_nth_mut] example, when evaluating the
+    first loop iteration, we start in the following environment:
     {[
       abs@0 { ML l0 }
       ls -> MB l0 (s2 : loops::List<T>)
@@ -115,7 +58,8 @@ let reorder_loans_borrows_in_fresh_abs (span : Meta.span)
       abs@3 { MB l1 }
     ]}
 
-    We finally merge the new abstractions together. It gives:
+    We finally merge the new abstractions together (abs@1 and abs@2 because
+    of l2, and abs@1 and abs@3 because of l1). It gives:
     {[
       abs@0 { ML l0 }
       ls -> MB l4 (s@6 : loops::List<T>)
@@ -123,9 +67,20 @@ let reorder_loans_borrows_in_fresh_abs (span : Meta.span)
       abs@4 { MB l0, ML l4 }
     ]}
 
-    If [merge_funs] is None, we ensure that there are no markers in the environments.
-    If [merge_funs] is Some _, we merge environments that contain borrow/loan pairs with the same markers, omitting
-    pairs with the PNone marker (i.e., no marker)
+    If [merge_funs] is [None], we check that there are no markers in the environments.
+    This is the "reduce" operation.
+    If [merge_funs] is [Some _], when merging abstractions together, we merge the pairs
+    of borrows and the pairs of loans with complementary markers. This is useful to
+    reuse the reduce operation to implement the collapse.
+    For instance, when merging:
+    {[
+      abs@0 { ML l0, |MB l1| }
+      abs@1 { MB l0, ︙MB l1︙ }
+    ]}
+    We get:
+    {[
+      abs@2 { MB l1 }
+    ]}
  *)
 let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option)
     (span : Meta.span) (loop_id : LoopId.id) (old_ids : ids_sets)
@@ -274,8 +229,9 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option)
       ^ eval_ctx_to_string ~span:(Some span) !ctx
       ^ "\n\n"));
 
-  (* Reorder the loans and borrows in the fresh abstractions *)
-  let ctx = reorder_loans_borrows_in_fresh_abs span old_ids.aids !ctx in
+  (* Reorder the loans and borrows in the fresh abstractions - note that we may
+     not have eliminated all the markers at this point. *)
+  let ctx = reorder_loans_borrows_in_fresh_abs span true old_ids.aids !ctx in
 
   log#ldebug
     (lazy
@@ -287,37 +243,28 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option)
   (* Return the new context *)
   ctx
 
-(* Reduce_ctx can only be called in a context with no markers *)
+(** Reduce_ctx can only be called in a context with no markers *)
 let reduce_ctx = reduce_ctx_with_markers None
 
-(* Collapse an environment
-
-   This is the second part of a join, where we attempt to simplify and remove all projection markers.
-   This function is called after reducing the environments, and attempting to simplify all the pairs
-   of borrows and loans.
+(** Auxiliary function for collapse (see below).
 
    We traverse all abstractions, and merge abstractions when they contain the same element,
-   but with dual markers (i.e., PLeft and PRight).
+   but with dual markers (i.e., [PLeft] and [PRight]).
 
    For instance, if we have the abstractions
 
-   abs@0 { | MB l0 _ |, ML l1 }
-   abs@1 { ︙MB l0 _ ︙, ML l2 }
-
-   we will merge abs@0 and abs@1 into a new abstraction abs@2, removing the marker for duplicated elements,
-   and taking the join of the remaining elements
+   {[
+     abs@0 { | MB l0 _ |, ML l1 }
+     abs@1 { ︙MB l0 _ ︙, ML l2 }
+   ]}
 
-   abs@2 { MB l0 _, ML l1, ML l2 }
-
-   Rem.: Doing this might introduce new pairs of borrow/loans to be merged in different abstractions: in the example above,
-   this could occur if there was another abstraction in the context containing ML l0, which would need to be simplified through
-   a further reduce.
-   It is unclear whether this can happen in practice. If so, a solution would be to preprocess the environments when doing
-   a join: while not in the current formalism, it is sound to split an element with no markers into a duplicated pair of the
-   same element with left and right markers. Doing this before reduce would allow to reduce all possible pairs of borrow/loans,
-   before finally collapsing and removing all markers.
+   We merge abs@0 and abs@1 into a new abstraction abs@2. This allows us to
+   eliminate the markers used for [MB l0]:
+   {[
+     abs@2 { MB l0 _, ML l1, ML l2 }
+   ]}
 *)
-let collapse_ctx_markers (span : Meta.span) (loop_id : LoopId.id)
+let collapse_ctx_collapse (span : Meta.span) (loop_id : LoopId.id)
     (merge_funs : merge_duplicates_funcs) (old_ids : ids_sets) (ctx0 : eval_ctx)
     : eval_ctx =
   (* Debug *)
@@ -482,8 +429,9 @@ let collapse_ctx_markers (span : Meta.span) (loop_id : LoopId.id)
       ^ eval_ctx_to_string ~span:(Some span) !ctx
       ^ "\n\n"));
 
-  (* Reorder the loans and borrows in the fresh abstractions *)
-  let ctx = reorder_loans_borrows_in_fresh_abs span old_ids.aids !ctx in
+  (* Reorder the loans and borrows in the fresh abstractions - note that we may
+     not have eliminated all the markers yet *)
+  let ctx = reorder_loans_borrows_in_fresh_abs span true old_ids.aids !ctx in
 
   log#ldebug
     (lazy
@@ -495,16 +443,55 @@ let collapse_ctx_markers (span : Meta.span) (loop_id : LoopId.id)
   (* Return the new context *)
   ctx
 
-(* Collapse two environments containing projection markers; this function is called after
-   joining environments.
+(** Small utility: check whether an environment contains markers *)
+let eval_ctx_has_markers (ctx : eval_ctx) : bool =
+  let visitor =
+    object
+      inherit [_] iter_eval_ctx
+
+      method! visit_proj_marker _ pm =
+        match pm with PNone -> () | PLeft | PRight -> raise Found
+    end
+  in
+  try
+    visitor#visit_eval_ctx () ctx;
+    false
+  with Found -> true
+
+(** Collapse two environments containing projection markers; this function is called after
+    joining environments.
 
-   The collapse is done in two steps.
-   First, we reduce the environment, merging for instance abstractions containing MB l0 _ and ML l0,
-   when both elements have the same marker, e.g., PNone, PLeft, or PRight.
+    The collapse is done in two steps.
 
-   Second, we merge abstractions containing the same element with left and right markers respectively.
+    First, we reduce the environment, merging any two pair of fresh abstractions
+    which contain a loan (in one) and its corresponding borrow (in the other).
+    For instance, we merge abs@0 and abs@1 below:
+    {[
+      abs@0 { |ML l0|, ML l1 }
+      abs@1 { |MB l0 _|, ML l2 }
+                ~~>
+      abs@2 { ML l1, ML l2 }
+    ]}
+    Note that we also merge abstractions when the loan/borrow don't have the same
+    markers. For instance, below:
+    {[
+      abs@0 { ML l0, ML l1 } // ML l0 doesn't have markers
+      abs@1 { |MB l0 _|, ML l2 }
+                ~~>
+      abs@2 { ︙ML l0︙, ML l1, ML l2 }
+    ]}
 
-   At the end of the second step, all markers should have been removed from the resulting environment.
+    Second, we merge abstractions containing the same element with left and right markers
+    respectively. For instance:
+    {[
+      abs@0 { | MB l0 _ |, ML l1 }
+      abs@1 { ︙MB l0 _ ︙, ML l2 }
+                ~~>
+      abs@2 { MB l0 _, ML l1, ML l2 }
+    ]}
+
+    At the end of the second step, all markers should have been removed from the resulting
+    environment.
 *)
 let collapse_ctx (span : Meta.span) (loop_id : LoopId.id)
     (merge_funs : merge_duplicates_funcs) (old_ids : ids_sets) (ctx0 : eval_ctx)
@@ -512,7 +499,10 @@ let collapse_ctx (span : Meta.span) (loop_id : LoopId.id)
   let ctx =
     reduce_ctx_with_markers (Some merge_funs) span loop_id old_ids ctx0
   in
-  collapse_ctx_markers span loop_id merge_funs old_ids ctx
+  let ctx = collapse_ctx_collapse span loop_id merge_funs old_ids ctx in
+  (* Sanity check: there are no markers remaining *)
+  sanity_check __FILE__ __LINE__ (not (eval_ctx_has_markers ctx)) span;
+  ctx
 
 let mk_collapse_ctx_merge_duplicate_funs (span : Meta.span)
     (loop_id : LoopId.id) (ctx : eval_ctx) : merge_duplicates_funcs =
-- 
cgit v1.3.1


From 67ef9b5316b6550c3386ae095197ea513ed7dfbb Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Mon, 3 Jun 2024 14:56:42 +0200
Subject: Cleanup a bit

---
 compiler/InterpreterLoopsCore.ml      | 20 ++++++++---
 compiler/InterpreterLoopsJoinCtxs.ml  | 67 +++++++++++++++++++----------------
 compiler/InterpreterLoopsMatchCtxs.ml | 10 +-----
 3 files changed, 53 insertions(+), 44 deletions(-)

(limited to 'compiler/InterpreterLoopsJoinCtxs.ml')

diff --git a/compiler/InterpreterLoopsCore.ml b/compiler/InterpreterLoopsCore.ml
index 4149b19e..df808385 100644
--- a/compiler/InterpreterLoopsCore.ml
+++ b/compiler/InterpreterLoopsCore.ml
@@ -430,11 +430,11 @@ let ids_sets_empty_borrows_loans (ids : ids_sets) : ids_sets =
   in
   ids
 
-(* Small utility: Add a projection marker to a typed avalue.
-   This can be used in combination with List.map to add markers to an entire abstraction
-*)
-let add_marker_avalue (span : Meta.span) (ctx : eval_ctx) (pm : proj_marker)
-    (av : typed_avalue) : typed_avalue =
+(** Small utility: add a projection marker to a typed avalue.
+    This can be used in combination with List.map to add markers to an entire abstraction
+ *)
+let typed_avalue_add_marker (span : Meta.span) (ctx : eval_ctx)
+    (pm : proj_marker) (av : typed_avalue) : typed_avalue =
   let obj =
     object
       inherit [_] map_typed_avalue as super
@@ -473,3 +473,13 @@ let add_marker_avalue (span : Meta.span) (ctx : eval_ctx) (pm : proj_marker)
     end
   in
   obj#visit_typed_avalue () av
+
+(** Small utility: add a projection marker to an abstraction.
+    This can be used in combination with List.map to add markers to an entire abstraction
+ *)
+let abs_add_marker (span : Meta.span) (ctx : eval_ctx) (pm : proj_marker)
+    (abs : abs) : abs =
+  {
+    abs with
+    avalues = List.map (typed_avalue_add_marker span ctx pm) abs.avalues;
+  }
diff --git a/compiler/InterpreterLoopsJoinCtxs.ml b/compiler/InterpreterLoopsJoinCtxs.ml
index d2f52781..b25ea0fc 100644
--- a/compiler/InterpreterLoopsJoinCtxs.ml
+++ b/compiler/InterpreterLoopsJoinCtxs.ml
@@ -67,20 +67,23 @@ let log = Logging.loops_join_ctxs_log
       abs@4 { MB l0, ML l4 }
     ]}
 
-    If [merge_funs] is [None], we check that there are no markers in the environments.
-    This is the "reduce" operation.
-    If [merge_funs] is [Some _], when merging abstractions together, we merge the pairs
-    of borrows and the pairs of loans with complementary markers. This is useful to
-    reuse the reduce operation to implement the collapse.
-    For instance, when merging:
-    {[
-      abs@0 { ML l0, |MB l1| }
-      abs@1 { MB l0, ︙MB l1︙ }
-    ]}
-    We get:
-    {[
-      abs@2 { MB l1 }
-    ]}
+    - If [merge_funs] is [None], we check that there are no markers in the environments.
+      This is the "reduce" operation.
+    - If [merge_funs] is [Some _], when merging abstractions together, we merge the pairs
+      of borrows and the pairs of loans with the same markers **if this marker is not**
+      [PNone]. This is useful to reuse the reduce operation to implement the collapse.
+      Note that we ignore borrows/loans with the [PNone] marker: the goal of the collapse
+      operation is to *eliminate* markers, not to simplify the environment.
+
+      For instance, when merging:
+      {[
+        abs@0 { ML l0, |MB l1| }
+        abs@1 { MB l0, ︙MB l1︙ }
+      ]}
+      We get:
+      {[
+        abs@2 { MB l1 }
+      ]}
  *)
 let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option)
     (span : Meta.span) (loop_id : LoopId.id) (old_ids : ids_sets)
@@ -92,7 +95,7 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option)
       ^ eval_ctx_to_string ~span:(Some span) ctx0
       ^ "\n\n"));
 
-  let allow_markers = merge_funs <> None in
+  let with_markers = merge_funs <> None in
 
   let abs_kind : abs_kind = Loop (loop_id, None, LoopSynthInput) in
   let can_end = true in
@@ -172,18 +175,27 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option)
       let bids = MarkerBorrowId.Set.elements bids in
       List.iter
         (fun bid ->
-          if not allow_markers then
+          if not with_markers then
             sanity_check __FILE__ __LINE__ (fst bid = PNone) span;
-          match MarkerBorrowId.Map.find_opt bid loan_to_abs with
-          | None -> (* Nothing to do *) ()
-          | Some abs_ids1 ->
-              if allow_markers && fst bid = PNone then ()
-              else
+          (* If we use markers: we are doing a collapse, which means we attempt
+             to eliminate markers (and this is the only goal of the operation).
+             We thus ignore the non-marked values (we merge non-marked values
+             when doing a "real" reduce, to simplify the environment in order
+             to converge to a fixed-point, for instance). *)
+          if with_markers && fst bid = PNone then ()
+          else
+            match MarkerBorrowId.Map.find_opt bid loan_to_abs with
+            | None -> (* Nothing to do *) ()
+            | Some abs_ids1 ->
                 AbstractionId.Set.iter
                   (fun abs_id1 ->
                     (* We need to merge - unless we have already merged *)
-                    (* First, find the representatives for the two abstractions (the
-                       representative is the abstraction into which we merged) *)
+                    (* First, find the representatives for the two abstractions.
+
+                       We may have merged some abstractions already, so maybe abs_id0
+                       and abs_id1 don't exist anymore, because they may have been
+                       merged into other abstractions: we look for the abstractions
+                       resulting from such merged. *)
                     let abs_ref0 =
                       UnionFind.find (AbstractionId.Map.find abs_id0 merged_abs)
                     in
@@ -207,7 +219,7 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option)
                           ^ ":\n\n"
                           ^ eval_ctx_to_string ~span:(Some span) !ctx));
 
-                      (* Update the environment - pay attention to the order: we
+                      (* Update the environment - pay attention to the order:
                          we merge [abs_id1] *into* [abs_id0] *)
                       let nctx, abs_id =
                         merge_into_abstraction span abs_kind can_end merge_funs
@@ -672,12 +684,7 @@ let join_ctxs (span : Meta.span) (loop_id : LoopId.id) (fixed_ids : ids_sets)
     (* Add projection marker to all abstractions in the left and right environments *)
     let add_marker (pm : proj_marker) (ee : env_elem) : env_elem =
       match ee with
-      | EAbs abs ->
-          EAbs
-            {
-              abs with
-              avalues = List.map (add_marker_avalue span ctx0 pm) abs.avalues;
-            }
+      | EAbs abs -> EAbs (abs_add_marker span ctx0 pm abs)
       | x -> x
     in
 
diff --git a/compiler/InterpreterLoopsMatchCtxs.ml b/compiler/InterpreterLoopsMatchCtxs.ml
index bc39d5ec..3f7c023e 100644
--- a/compiler/InterpreterLoopsMatchCtxs.ml
+++ b/compiler/InterpreterLoopsMatchCtxs.ml
@@ -837,15 +837,7 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct
         in
         (* Add a marker to the abstraction indicating the provenance of the value *)
         let pm = if value_is_left then PLeft else PRight in
-        let absl =
-          List.map
-            (fun abs ->
-              {
-                abs with
-                avalues = List.map (add_marker_avalue span ctx0 pm) abs.avalues;
-              })
-            absl
-        in
+        let absl = List.map (abs_add_marker span ctx0 pm) absl in
         push_absl absl;
         (* Return [Bottom] *)
         mk_bottom span v.ty
-- 
cgit v1.3.1


From 311a162dcc65233d628303a1114b529b8eff29a0 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Mon, 3 Jun 2024 16:11:24 +0200
Subject: Change the order in which we merge abstractions

---
 compiler/InterpreterBorrows.ml         | 86 +++++++++++++---------------------
 compiler/InterpreterBorrows.mli        | 46 +++++++++---------
 compiler/InterpreterLoopsFixedPoint.ml | 18 +++++--
 compiler/InterpreterLoopsJoinCtxs.ml   | 52 ++++++++++----------
 compiler/InterpreterLoopsJoinCtxs.mli  |  2 +-
 5 files changed, 99 insertions(+), 105 deletions(-)

(limited to 'compiler/InterpreterLoopsJoinCtxs.ml')

diff --git a/compiler/InterpreterBorrows.ml b/compiler/InterpreterBorrows.ml
index 48292181..b46a5da8 100644
--- a/compiler/InterpreterBorrows.ml
+++ b/compiler/InterpreterBorrows.ml
@@ -566,7 +566,9 @@ let give_back_avalue_to_same_abstraction (_config : config) (span : Meta.span)
         | AEndedSharedLoan (_, _) ->
             (* Nothing special to do *)
             super#visit_ALoan opt_abs lc
-        | ASharedLoan (_, _, _, _) -> internal_error __FILE__ __LINE__ span
+        | ASharedLoan (_, _, _, _) ->
+            (* We get there if the projection marker is not [PNone] *)
+            internal_error __FILE__ __LINE__ span
         | AIgnoredMutLoan (bid_opt, child) ->
             (* This loan is ignored, but we may have to project on a subvalue
              * of the value which is given back *)
@@ -2013,7 +2015,7 @@ type merge_abstraction_info = {
     We compute the list of loan/borrow contents, maps from borrow/loan ids
     to borrow/loan contents, etc.
 
-    Note that this function is very specific to [merge_into_abstraction]: we
+    Note that this function is very specific to [merge_into_first_abstraction]: we
     have strong assumptions about the shape of the abstraction, and in
     particular that:
     - its values don't contain nested borrows
@@ -2032,25 +2034,6 @@ let compute_merge_abstraction_info (span : Meta.span) (ctx : eval_ctx)
     ref MarkerBorrowId.Map.empty
   in
 
-  let push_loans pm ids (lc : g_loan_content_with_ty) : unit =
-    let pm_ids =
-      BorrowId.Set.to_seq ids
-      |> Seq.map (fun x -> (pm, x))
-      |> MarkerBorrowId.Set.of_seq
-    in
-    sanity_check __FILE__ __LINE__
-      (MarkerBorrowId.Set.disjoint !loans pm_ids)
-      span;
-    loans := MarkerBorrowId.Set.union !loans pm_ids;
-    MarkerBorrowId.Set.iter
-      (fun (pm, id) ->
-        sanity_check __FILE__ __LINE__
-          (not (MarkerBorrowId.Map.mem (pm, id) !loan_to_content))
-          span;
-        loan_to_content := MarkerBorrowId.Map.add (pm, id) lc !loan_to_content;
-        borrows_loans := LoanId (pm, id) :: !borrows_loans)
-      pm_ids
-  in
   let push_loan pm id (lc : g_loan_content_with_ty) : unit =
     sanity_check __FILE__ __LINE__
       (not (MarkerBorrowId.Set.mem (pm, id) !loans))
@@ -2062,6 +2045,9 @@ let compute_merge_abstraction_info (span : Meta.span) (ctx : eval_ctx)
     loan_to_content := MarkerBorrowId.Map.add (pm, id) lc !loan_to_content;
     borrows_loans := LoanId (pm, id) :: !borrows_loans
   in
+  let push_loans pm ids lc : unit =
+    BorrowId.Set.iter (fun id -> push_loan pm id lc) ids
+  in
   let push_borrow pm id (bc : g_borrow_content_with_ty) : unit =
     sanity_check __FILE__ __LINE__
       (not (MarkerBorrowId.Set.mem (pm, id) !borrows))
@@ -2086,19 +2072,11 @@ let compute_merge_abstraction_info (span : Meta.span) (ctx : eval_ctx)
       method! visit_typed_value _ (v : typed_value) =
         super#visit_typed_value (Some (Concrete v.ty)) v
 
-      method! visit_loan_content env lc =
-        (* Can happen if we explore shared values whose sub-values are
-           reborrowed *)
-        let ty =
-          match Option.get env with
-          | Concrete ty -> ty
-          | Abstract _ -> craise __FILE__ __LINE__ span "Unreachable"
-        in
-        (match lc with
-        | VSharedLoan (bids, _) -> push_loans PNone bids (Concrete (ty, lc))
-        | VMutLoan _ -> craise __FILE__ __LINE__ span "Unreachable");
-        (* Continue *)
-        super#visit_loan_content env lc
+      method! visit_loan_content _ _ =
+        (* Could happen if we explore shared values whose sub-values are
+           reborrowed. We use the fact that we destructure the nested shared
+           loans before reducing a context or computing a join. *)
+        craise __FILE__ __LINE__ span "Unreachable"
 
       method! visit_borrow_content _ _ =
         (* Can happen if we explore shared values which contain borrows -
@@ -2244,12 +2222,12 @@ type merge_duplicates_funcs = {
 
     Merge two abstractions into one, without updating the context.
  *)
-let merge_into_abstraction_aux (span : Meta.span) (abs_kind : abs_kind)
+let merge_into_first_abstraction_aux (span : Meta.span) (abs_kind : abs_kind)
     (can_end : bool) (merge_funs : merge_duplicates_funcs option)
     (ctx : eval_ctx) (abs0 : abs) (abs1 : abs) : abs =
   log#ldebug
     (lazy
-      ("merge_into_abstraction_aux:\n- abs0:\n"
+      ("merge_into_first_abstraction_aux:\n- abs0:\n"
       ^ abs_to_string span ctx abs0
       ^ "\n\n- abs1:\n"
       ^ abs_to_string span ctx abs1));
@@ -2285,8 +2263,7 @@ let merge_into_abstraction_aux (span : Meta.span) (abs_kind : abs_kind)
     compute_merge_abstraction_info span ctx abs1.avalues
   in
 
-  (* Sanity check: there is no loan/borrows which appears in both abstractions,
-     unless we allow to merge duplicates *)
+  (* Sanity check: no markers appear unless we allow merging duplicates *)
   if merge_funs = None then (
     sanity_check __FILE__ __LINE__
       (List.for_all
@@ -2313,7 +2290,7 @@ let merge_into_abstraction_aux (span : Meta.span) (abs_kind : abs_kind)
      - if a borrow/loan is present in both abstractions, we need to merge its
        content.
 
-     Note that it is possible that we may need to merge strictly more than 2 avalues,
+     Note that it is possible that we may need to merge strictly more than two avalues,
      because of shared loans. For instance, if we have:
      {[
        abs'0 { shared_loan { l0, l1 } ... }
@@ -2329,7 +2306,7 @@ let merge_into_abstraction_aux (span : Meta.span) (abs_kind : abs_kind)
   let push_avalue av =
     log#ldebug
       (lazy
-        ("merge_into_abstraction_aux: push_avalue: "
+        ("merge_into_first_abstraction_aux: push_avalue: "
         ^ typed_avalue_to_string ~span:(Some span) ctx av));
     avalues := av :: !avalues
   in
@@ -2337,14 +2314,14 @@ let merge_into_abstraction_aux (span : Meta.span) (abs_kind : abs_kind)
     match av with None -> () | Some av -> push_avalue av
   in
 
-  (* Phase 1 of the merge: We want to simplify all loan/borrow pairs. *)
+  (* Phase 1 of the merge: we simplify all loan/borrow pairs. *)
 
-  (* There is an asymetry in the merge: We only simplify a loan/borrow pair if the loan is in
-     the abstraction on the left *)
+  (* There is an asymetry in the merge: we only simplify a loan/borrow pair
+     if the loan is in the abstraction on the left *)
   let intersect = MarkerBorrowId.Set.inter loans0 borrows1 in
 
-  (* This function is called when handling shared loans, where the projection marker is global to a set of borrow ids.
-     Tracking this requires some set transformations *)
+  (* This function is called when handling shared loans: we have to apply a projection
+     marker to a set of borrow ids. *)
   let filter_bids (pm : proj_marker) (bids : BorrowId.Set.t) : BorrowId.Set.t =
     let bids =
       BorrowId.Set.to_seq bids
@@ -2388,7 +2365,7 @@ let merge_into_abstraction_aux (span : Meta.span) (abs_kind : abs_kind)
           let bid = (pm, bid) in
           log#ldebug
             (lazy
-              ("merge_into_abstraction_aux: merging borrow "
+              ("merge_into_first_abstraction_aux: merging borrow "
               ^ MarkerBorrowId.to_string bid));
 
           (* Check if the borrow has already been merged - this can happen
@@ -2438,7 +2415,7 @@ let merge_into_abstraction_aux (span : Meta.span) (abs_kind : abs_kind)
           else (
             log#ldebug
               (lazy
-                ("merge_into_abstraction_aux: merging loan "
+                ("merge_into_first_abstraction_aux: merging loan "
                 ^ MarkerBorrowId.to_string bid));
 
             (* Check if we need to filter it *)
@@ -2496,7 +2473,7 @@ let merge_into_abstraction_aux (span : Meta.span) (abs_kind : abs_kind)
      with only one marker. To do so, we linearly traverse the abstraction created through the first phase *)
   log#ldebug
     (lazy
-      ("merge_into_abstraction_aux: starting phase 2\n- abs:\n"
+      ("merge_into_first_abstraction_aux: starting phase 2\n- abs:\n"
       ^ abs_to_string span ctx { abs0 with avalues = abs_values }));
 
   (* We first reset the list of avalues, and will construct avalues similarly to the previous phase *)
@@ -2777,7 +2754,7 @@ let ctx_merge_regions (ctx : eval_ctx) (rid : RegionId.id)
   let env = Substitute.env_subst_rids rsubst ctx.env in
   { ctx with env }
 
-let merge_into_abstraction (span : Meta.span) (abs_kind : abs_kind)
+let merge_into_first_abstraction (span : Meta.span) (abs_kind : abs_kind)
     (can_end : bool) (merge_funs : merge_duplicates_funcs option)
     (ctx : eval_ctx) (abs_id0 : AbstractionId.id) (abs_id1 : AbstractionId.id) :
     eval_ctx * AbstractionId.id =
@@ -2787,13 +2764,14 @@ let merge_into_abstraction (span : Meta.span) (abs_kind : abs_kind)
 
   (* Merge them *)
   let nabs =
-    merge_into_abstraction_aux span abs_kind can_end merge_funs ctx abs0 abs1
+    merge_into_first_abstraction_aux span abs_kind can_end merge_funs ctx abs0
+      abs1
   in
 
-  (* Update the environment: replace the abstraction 1 with the result of the merge,
-     remove the abstraction 0 *)
-  let ctx = fst (ctx_subst_abs span ctx abs_id1 nabs) in
-  let ctx = fst (ctx_remove_abs span ctx abs_id0) in
+  (* Update the environment: replace the abstraction 0 with the result of the merge,
+     remove the abstraction 1 *)
+  let ctx = fst (ctx_subst_abs span ctx abs_id0 nabs) in
+  let ctx = fst (ctx_remove_abs span ctx abs_id1) in
 
   (* Merge all the regions from the abstraction into one (the first - i.e., the
      one with the smallest id). Note that we need to do this in the whole
diff --git a/compiler/InterpreterBorrows.mli b/compiler/InterpreterBorrows.mli
index 0bc2bfab..cf14e94b 100644
--- a/compiler/InterpreterBorrows.mli
+++ b/compiler/InterpreterBorrows.mli
@@ -212,24 +212,36 @@ type merge_duplicates_funcs = {
 
 (** Merge an abstraction into another abstraction.
 
-    We insert the result of the merge in place of the second abstraction (and in
+    We insert the result of the merge in place of the first abstraction (and in
     particular, we don't simply push the merged abstraction at the end of the
     environment: this helps preserving the structure of the environment, when
     computing loop fixed points for instance).
 
-    When we merge two abstractions together, we remove the loans/borrows
-    which appear in one and whose associated loans/borrows appear in the
-    other. For instance:
+    When we merge two abstractions together, we remove the loans which appear
+    in the *left* abstraction and whose corresponding borrows appear in the
+    **right** abstraction.
+    For instance:
     {[
       abs'0 { mut_borrow l0, mut_loan l1 }   // Rem.: mut_loan l1
       abs'1 { mut_borrow l1, mut_borrow l2 } // Rem.: mut_borrow l1
 
           ~~>
 
-      abs'01 { mut_borrow l0, mut_borrow l2 }
+      abs'2 { mut_borrow l0, mut_borrow l2 }
+    ]}
+
+    We also simplify the markers, when the same value appears in both abstractions
+    but with different markers. For instance:
+    {[
+      abs'0 { |mut_borrow l0|, mut_loan l1 }
+      abs'1 { ︙mut_borrow l0︙, mut_borrow l1 }
+
+          ~~>
+
+      abs'2 { mut_borrow l0 }
     ]}
 
-    Also, we merge all their regions together. For instance, if [abs'0] projects
+    Finally, we merge all their regions together. For instance, if [abs'0] projects
     region [r0] and [abs'1] projects region [r1], we pick one of the two, say [r0]
     (the one with the smallest index in practice) and substitute [r1] with [r0]
     in the whole context.
@@ -237,22 +249,10 @@ type merge_duplicates_funcs = {
     Parameters:
     - [kind]
     - [can_end]
-    - [merge_funs]: Those functions are used to merge borrows/loans with the
-      *same ids*. For instance, when performing environment joins we may introduce
-      abstractions which both contain loans/borrows with the same ids. When we
-      later merge those abstractions together, we need to call a merge function
-      to reconcile the borrows/loans. For instance, if both abstractions contain
-      the same shared loan [l0], we will call {!merge_ashared_borrows} to derive
-      a shared value for the merged shared loans.
-
-      For instance, this happens for the following abstractions:
-      {[
-        abs'0 { mut_borrow l0, mut_loan l1 } // mut_borrow l0 !
-        abs'1 { mut_borrow l0, mut_loan l2 } // mut_borrow l0 !
-      ]}
-      If you want to forbid this, provide [None]. In that case, [merge_into_abstraction]
-      actually simply performs some sort of a union.
-
+    - [merge_funs]: those functions are used to merge borrows/loans with the
+      *same ids* but different markers. This is necessary when doing a collapse
+      (see the computation of joins).
+      If [merge_funs] are not provided, we check that there are no markers.
     - [ctx]
     - [abs_id0]
     - [abs_id1]
@@ -260,7 +260,7 @@ type merge_duplicates_funcs = {
     We return the updated context as well as the id of the new abstraction which
     results from the merge.
  *)
-val merge_into_abstraction :
+val merge_into_first_abstraction :
   Meta.span ->
   abs_kind ->
   bool ->
diff --git a/compiler/InterpreterLoopsFixedPoint.ml b/compiler/InterpreterLoopsFixedPoint.ml
index 033deebb..79beb761 100644
--- a/compiler/InterpreterLoopsFixedPoint.ml
+++ b/compiler/InterpreterLoopsFixedPoint.ml
@@ -696,10 +696,22 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span)
        region id to abstraction id *)
     let fp = ref fp in
     let rg_to_abs = ref RegionGroupId.Map.empty in
+    (* List the ids of all the abstractions in the context, in the order in
+       which they appear (this is important to preserve some structure:
+       we will explore them in this order) *)
+    let all_abs_ids =
+      List.filter_map
+        (function EAbs abs -> Some abs.abs_id | _ -> None)
+        !fp.env
+    in
     let _ =
       RegionGroupId.Map.iter
         (fun rg_id ids ->
-          let ids = AbstractionId.Set.elements ids in
+          (* Make sure we explore the ids in the order in which they appear
+             in the context *)
+          let ids =
+            List.filter (fun id -> AbstractionId.Set.mem id ids) all_abs_ids
+          in
           (* Retrieve the first id of the group *)
           match ids with
           | [] ->
@@ -742,8 +754,8 @@ let compute_loop_entry_fixed_point (config : config) (span : Meta.span)
                         ^ AbstractionId.to_string !id0));
                     (* Note that we merge *into* [id0] *)
                     let fp', id0' =
-                      merge_into_abstraction span loop_id abs_kind false !fp id
-                        !id0
+                      merge_into_first_abstraction span loop_id abs_kind false
+                        !fp !id0 id
                     in
                     fp := fp';
                     id0 := id0';
diff --git a/compiler/InterpreterLoopsJoinCtxs.ml b/compiler/InterpreterLoopsJoinCtxs.ml
index b25ea0fc..8ad5272a 100644
--- a/compiler/InterpreterLoopsJoinCtxs.ml
+++ b/compiler/InterpreterLoopsJoinCtxs.ml
@@ -146,10 +146,10 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option)
   let ids_maps = compute_abs_borrows_loans_maps span explore env in
   let {
     abs_ids;
-    abs_to_borrows;
-    abs_to_loans = _;
-    borrow_to_abs = _;
-    loan_to_abs;
+    abs_to_borrows = _;
+    abs_to_loans;
+    borrow_to_abs;
+    loan_to_abs = _;
   } =
     ids_maps
   in
@@ -164,27 +164,28 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option)
 
   (* Merge all the mergeable abs.
 
-     We iterate over the abstractions, then over the borrows in the abstractions.
+     We iterate over the abstractions, then over the loans in the abstractions.
      We do this because we want to control the order in which abstractions
      are merged (the ids are iterated in increasing order). Otherwise, we
-     could simply iterate over all the borrows in [borrow_to_abs]...
+     could simply iterate over all the borrows in [loan_to_abs]...
   *)
   List.iter
     (fun abs_id0 ->
-      let bids = AbstractionId.Map.find abs_id0 abs_to_borrows in
-      let bids = MarkerBorrowId.Set.elements bids in
+      let lids = AbstractionId.Map.find abs_id0 abs_to_loans in
+      let lids = MarkerBorrowId.Set.elements lids in
       List.iter
-        (fun bid ->
+        (fun lid ->
           if not with_markers then
-            sanity_check __FILE__ __LINE__ (fst bid = PNone) span;
+            sanity_check __FILE__ __LINE__ (fst lid = PNone) span;
           (* If we use markers: we are doing a collapse, which means we attempt
              to eliminate markers (and this is the only goal of the operation).
              We thus ignore the non-marked values (we merge non-marked values
              when doing a "real" reduce, to simplify the environment in order
              to converge to a fixed-point, for instance). *)
-          if with_markers && fst bid = PNone then ()
+          if with_markers && fst lid = PNone then ()
           else
-            match MarkerBorrowId.Map.find_opt bid loan_to_abs with
+            (* Find the borrow corresponding to the loan we want to eliminate *)
+            match MarkerBorrowId.Map.find_opt lid borrow_to_abs with
             | None -> (* Nothing to do *) ()
             | Some abs_ids1 ->
                 AbstractionId.Set.iter
@@ -220,10 +221,12 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option)
                           ^ eval_ctx_to_string ~span:(Some span) !ctx));
 
                       (* Update the environment - pay attention to the order:
-                         we merge [abs_id1] *into* [abs_id0] *)
+                         we merge [abs_id1] *into* [abs_id0].
+                         In particular, as [abs_id0] contains the loan, it has
+                         to be on the left. *)
                       let nctx, abs_id =
-                        merge_into_abstraction span abs_kind can_end merge_funs
-                          !ctx abs_id1 abs_id0
+                        merge_into_first_abstraction span abs_kind can_end
+                          merge_funs !ctx abs_id0 abs_id1
                       in
                       ctx := nctx;
 
@@ -231,7 +234,7 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option)
                       let abs_ref_merged = UnionFind.union abs_ref0 abs_ref1 in
                       UnionFind.set abs_ref_merged abs_id))
                   abs_ids1)
-        bids)
+        lids)
     abs_ids;
 
   log#ldebug
@@ -366,8 +369,8 @@ let collapse_ctx_collapse (span : Meta.span) (loop_id : LoopId.id)
                       (* Update the environment - pay attention to the order: we
                          we merge [abs_id1] *into* [abs_id0] *)
                       let nctx, abs_id =
-                        merge_into_abstraction span abs_kind can_end
-                          (Some merge_funs) !ctx abs_id1 abs_id0
+                        merge_into_first_abstraction span abs_kind can_end
+                          (Some merge_funs) !ctx abs_id0 abs_id1
                       in
                       ctx := nctx;
 
@@ -422,8 +425,8 @@ let collapse_ctx_collapse (span : Meta.span) (loop_id : LoopId.id)
                       (* Update the environment - pay attention to the order: we
                          we merge [abs_id1] *into* [abs_id0] *)
                       let nctx, abs_id =
-                        merge_into_abstraction span abs_kind can_end
-                          (Some merge_funs) !ctx abs_id1 abs_id0
+                        merge_into_first_abstraction span abs_kind can_end
+                          (Some merge_funs) !ctx abs_id0 abs_id1
                       in
                       ctx := nctx;
 
@@ -544,7 +547,7 @@ let mk_collapse_ctx_merge_duplicate_funs (span : Meta.span)
     (* We need to pick a type for the avalue. The types on the left and on the
        right may use different regions: it doesn't really matter (here, we pick
        the one from the left), because we will merge those regions together
-       anyway (see the comments for {!merge_into_abstraction}).
+       anyway (see the comments for {!merge_into_first_abstraction}).
     *)
     let ty = ty0 in
     let child = child0 in
@@ -612,12 +615,13 @@ let mk_collapse_ctx_merge_duplicate_funs (span : Meta.span)
     merge_ashared_loans;
   }
 
-let merge_into_abstraction (span : Meta.span) (loop_id : LoopId.id)
+let merge_into_first_abstraction (span : Meta.span) (loop_id : LoopId.id)
     (abs_kind : abs_kind) (can_end : bool) (ctx : eval_ctx)
     (aid0 : AbstractionId.id) (aid1 : AbstractionId.id) :
     eval_ctx * AbstractionId.id =
   let merge_funs = mk_collapse_ctx_merge_duplicate_funs span loop_id ctx in
-  merge_into_abstraction span abs_kind can_end (Some merge_funs) ctx aid0 aid1
+  merge_into_first_abstraction span abs_kind can_end (Some merge_funs) ctx aid0
+    aid1
 
 (** Collapse an environment, merging the duplicated borrows/loans.
 
@@ -965,7 +969,7 @@ let loop_join_origin_with_continue_ctxs (config : config) (span : Meta.span)
         ("loop_join_origin_with_continue_ctxs:join_one: after join-collapse:\n"
         ^ eval_ctx_to_string ~span:(Some span) !joined_ctx));
 
-    (* Reduce again to reach fixed point *)
+    (* Reduce again to reach a fixed point *)
     joined_ctx := reduce_ctx span loop_id fixed_ids !joined_ctx;
     log#ldebug
       (lazy
diff --git a/compiler/InterpreterLoopsJoinCtxs.mli b/compiler/InterpreterLoopsJoinCtxs.mli
index f4b5194a..a194e25b 100644
--- a/compiler/InterpreterLoopsJoinCtxs.mli
+++ b/compiler/InterpreterLoopsJoinCtxs.mli
@@ -15,7 +15,7 @@ open InterpreterLoopsCore
     - [aid0]
     - [aid1]
  *)
-val merge_into_abstraction :
+val merge_into_first_abstraction :
   Meta.span ->
   loop_id ->
   abs_kind ->
-- 
cgit v1.3.1


From 3cb17966aa0c5d0e84b734c2afb4dce0f4bf22d2 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Tue, 4 Jun 2024 10:52:00 +0200
Subject: Start factoring out the code of reduce_ctx and collapse_ctx

---
 compiler/InterpreterLoopsJoinCtxs.ml | 253 ++++++++++++++++++++++-------------
 1 file changed, 162 insertions(+), 91 deletions(-)

(limited to 'compiler/InterpreterLoopsJoinCtxs.ml')

diff --git a/compiler/InterpreterLoopsJoinCtxs.ml b/compiler/InterpreterLoopsJoinCtxs.ml
index 8ad5272a..e1a91707 100644
--- a/compiler/InterpreterLoopsJoinCtxs.ml
+++ b/compiler/InterpreterLoopsJoinCtxs.ml
@@ -13,6 +13,128 @@ open Errors
 (** The local logger *)
 let log = Logging.loops_join_ctxs_log
 
+(** Utility.
+
+    An environment augmented with information about its borrows/loans/abstractions
+    for the purpose of merging abstractions together.
+    We provide functions to update this information when merging two abstractions
+    together. We use it in {!reduce_ctx} and {!collapse_ctx}.
+*)
+type ctx_with_info = { ctx : eval_ctx; info : abs_borrows_loans_maps }
+
+let ctx_with_info_merge_into_first_abs (span : Meta.span) (abs_kind : abs_kind)
+    (can_end : bool) (merge_funs : merge_duplicates_funcs option)
+    (ctx : ctx_with_info) (abs_id0 : AbstractionId.id)
+    (abs_id1 : AbstractionId.id) : ctx_with_info =
+  (* Compute the new context and the new abstraction id *)
+  let nctx, nabs_id =
+    merge_into_first_abstraction span abs_kind can_end merge_funs ctx.ctx
+      abs_id0 abs_id1
+  in
+  let nabs = ctx_lookup_abs nctx nabs_id in
+  (* Update the information *)
+  let {
+    abs_to_borrows = nabs_to_borrows;
+    abs_to_loans = nabs_to_loans;
+    borrow_to_abs = borrow_to_nabs;
+    loan_to_abs = loan_to_nabs;
+    _;
+  } =
+    compute_abs_borrows_loans_maps span (fun _ -> true) [ EAbs nabs ]
+  in
+  let { abs_ids; abs_to_borrows; abs_to_loans; borrow_to_abs; loan_to_abs } =
+    ctx.info
+  in
+  let abs_ids =
+    List.filter_map
+      (fun id ->
+        if id = abs_id0 then Some nabs_id
+        else if id = abs_id1 then None
+        else Some id)
+      abs_ids
+  in
+  (* Update the maps from makred borrows/loans to abstractions *)
+  let update_to_abs abs_to to_nabs to_abs =
+    (* Remove the old bindings *)
+    let abs0_elems = AbstractionId.Map.find abs_id0 abs_to in
+    let abs1_elems = AbstractionId.Map.find abs_id1 abs_to in
+    let abs01_elems = MarkerBorrowId.Set.union abs0_elems abs1_elems in
+    let to_abs =
+      MarkerBorrowId.Map.filter
+        (fun id _ -> not (MarkerBorrowId.Set.mem id abs01_elems))
+        to_abs
+    in
+    (* Add the new ones *)
+    let merge _ _ _ =
+      (* We shouldn't have twice the same key *)
+      craise __FILE__ __LINE__ span "Unreachable"
+    in
+    MarkerBorrowId.Map.union merge to_nabs to_abs
+  in
+  let borrow_to_abs =
+    update_to_abs abs_to_borrows borrow_to_nabs borrow_to_abs
+  in
+  let loan_to_abs = update_to_abs abs_to_loans loan_to_nabs loan_to_abs in
+
+  (* Update the maps from abstractions to marked borrows/loans *)
+  let update_abs_to nabs_to abs_to =
+    AbstractionId.Map.add_strict nabs_id
+      (AbstractionId.Map.find nabs_id nabs_to)
+      (AbstractionId.Map.remove abs_id0
+         (AbstractionId.Map.remove abs_id1 abs_to))
+  in
+  let abs_to_borrows = update_abs_to nabs_to_borrows abs_to_borrows in
+  let abs_to_loans = update_abs_to nabs_to_loans abs_to_loans in
+  let info =
+    { abs_ids; abs_to_borrows; abs_to_loans; borrow_to_abs; loan_to_abs }
+  in
+  { ctx = nctx; info }
+
+exception AbsToMerge of abstraction_id * abstraction_id
+
+(** Repeatedly iterate through the borrows/loans in an environment and merge the
+    abstractions that have to be merged according to a user-provided policy. *)
+let repeat_iter_borrows_merge (span : Meta.span) (old_ids : ids_sets)
+    (abs_kind : abs_kind) (can_end : bool)
+    (merge_funs : merge_duplicates_funcs option)
+    (iter :
+      ctx_with_info -> (abstraction_id -> marker_borrow_id -> unit) -> unit)
+    (policy :
+      ctx_with_info ->
+      abstraction_id ->
+      marker_borrow_id ->
+      (abstraction_id * abstraction_id) option) (ctx : eval_ctx) : eval_ctx =
+  (* Compute the information *)
+  let ctx =
+    let is_fresh_abs_id (id : AbstractionId.id) : bool =
+      not (AbstractionId.Set.mem id old_ids.aids)
+    in
+    let explore (abs : abs) = is_fresh_abs_id abs.abs_id in
+    let info = compute_abs_borrows_loans_maps span explore ctx.env in
+    { ctx; info }
+  in
+  (* Explore and merge *)
+  let rec explore_merge (ctx : ctx_with_info) : eval_ctx =
+    try
+      iter ctx (fun aid mbid ->
+          (* Check if we need to merge some abstractions *)
+          match policy ctx aid mbid with
+          | None -> (* No *) ()
+          | Some (abs_id0, abs_id1) ->
+              (* Yes: raise an exception *)
+              raise (AbsToMerge (abs_id0, abs_id1)));
+      (* No exception raise: return the current context *)
+      ctx.ctx
+    with AbsToMerge (abs_id0, abs_id1) ->
+      (* Merge and recurse *)
+      let ctx =
+        ctx_with_info_merge_into_first_abs span abs_kind can_end merge_funs ctx
+          abs_id0 abs_id1
+      in
+      explore_merge ctx
+  in
+  explore_merge ctx
+
 (** Reduce an environment.
 
     We do this to simplify an environment, for the purpose of finding a loop
@@ -141,112 +263,61 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option)
       ^ eval_ctx_to_string ~span:(Some span) ctx
       ^ "\n\n"));
 
-  (* Explore all the *new* abstractions, and compute various maps *)
-  let explore (abs : abs) = is_fresh_abs_id abs.abs_id in
-  let ids_maps = compute_abs_borrows_loans_maps span explore env in
-  let {
-    abs_ids;
-    abs_to_borrows = _;
-    abs_to_loans;
-    borrow_to_abs;
-    loan_to_abs = _;
-  } =
-    ids_maps
-  in
-
-  (* Merge the abstractions together *)
-  let merged_abs : AbstractionId.id UnionFind.elem AbstractionId.Map.t =
-    AbstractionId.Map.of_list
-      (List.map (fun id -> (id, UnionFind.make id)) abs_ids)
-  in
-
-  let ctx = ref ctx in
-
   (* Merge all the mergeable abs.
 
-     We iterate over the abstractions, then over the loans in the abstractions.
+     We iterate over the *new* abstractions, then over the loans in the abstractions.
      We do this because we want to control the order in which abstractions
      are merged (the ids are iterated in increasing order). Otherwise, we
      could simply iterate over all the borrows in [loan_to_abs]...
   *)
-  List.iter
-    (fun abs_id0 ->
-      let lids = AbstractionId.Map.find abs_id0 abs_to_loans in
-      let lids = MarkerBorrowId.Set.elements lids in
-      List.iter
-        (fun lid ->
-          if not with_markers then
-            sanity_check __FILE__ __LINE__ (fst lid = PNone) span;
-          (* If we use markers: we are doing a collapse, which means we attempt
-             to eliminate markers (and this is the only goal of the operation).
-             We thus ignore the non-marked values (we merge non-marked values
-             when doing a "real" reduce, to simplify the environment in order
-             to converge to a fixed-point, for instance). *)
-          if with_markers && fst lid = PNone then ()
-          else
-            (* Find the borrow corresponding to the loan we want to eliminate *)
-            match MarkerBorrowId.Map.find_opt lid borrow_to_abs with
-            | None -> (* Nothing to do *) ()
-            | Some abs_ids1 ->
-                AbstractionId.Set.iter
-                  (fun abs_id1 ->
-                    (* We need to merge - unless we have already merged *)
-                    (* First, find the representatives for the two abstractions.
-
-                       We may have merged some abstractions already, so maybe abs_id0
-                       and abs_id1 don't exist anymore, because they may have been
-                       merged into other abstractions: we look for the abstractions
-                       resulting from such merged. *)
-                    let abs_ref0 =
-                      UnionFind.find (AbstractionId.Map.find abs_id0 merged_abs)
-                    in
-                    let abs_id0 = UnionFind.get abs_ref0 in
-                    let abs_ref1 =
-                      UnionFind.find (AbstractionId.Map.find abs_id1 merged_abs)
-                    in
-                    let abs_id1 = UnionFind.get abs_ref1 in
-                    (* If the two ids are the same, it means the abstractions were already merged *)
-                    if abs_id0 = abs_id1 then ()
-                    else (
-                      (* We actually need to merge the abstractions *)
-
-                      (* Debug *)
-                      log#ldebug
-                        (lazy
-                          ("reduce_ctx: merging abstraction "
-                          ^ AbstractionId.to_string abs_id1
-                          ^ " into "
-                          ^ AbstractionId.to_string abs_id0
-                          ^ ":\n\n"
-                          ^ eval_ctx_to_string ~span:(Some span) !ctx));
-
-                      (* Update the environment - pay attention to the order:
-                         we merge [abs_id1] *into* [abs_id0].
-                         In particular, as [abs_id0] contains the loan, it has
-                         to be on the left. *)
-                      let nctx, abs_id =
-                        merge_into_first_abstraction span abs_kind can_end
-                          merge_funs !ctx abs_id0 abs_id1
-                      in
-                      ctx := nctx;
-
-                      (* Update the union find *)
-                      let abs_ref_merged = UnionFind.union abs_ref0 abs_ref1 in
-                      UnionFind.set abs_ref_merged abs_id))
-                  abs_ids1)
-        lids)
-    abs_ids;
+  let ctx =
+    repeat_iter_borrows_merge span old_ids abs_kind can_end merge_funs
+      (fun ctx f ->
+        List.iter
+          (fun abs_id0 ->
+            let lids = AbstractionId.Map.find abs_id0 ctx.info.abs_to_loans in
+            MarkerBorrowId.Set.iter (f abs_id0) lids)
+          ctx.info.abs_ids)
+      (fun ctx abs_id0 lid ->
+        if not with_markers then
+          sanity_check __FILE__ __LINE__ (fst lid = PNone) span;
+        (* If we use markers: we are doing a collapse, which means we attempt
+           to eliminate markers (and this is the only goal of the operation).
+           We thus ignore the non-marked values (we merge non-marked values
+           when doing a "real" reduce, to simplify the environment in order
+           to converge to a fixed-point, for instance). *)
+        if with_markers && fst lid = PNone then None
+        else
+          (* Find the borrow corresponding to the loan we want to eliminate *)
+          match MarkerBorrowId.Map.find_opt lid ctx.info.borrow_to_abs with
+          | None -> (* Nothing to to *) None
+          | Some abs_ids1 -> (
+              (* We need to merge *)
+              match AbstractionId.Set.elements abs_ids1 with
+              | [] -> None
+              | abs_id1 :: _ ->
+                  log#ldebug
+                    (lazy
+                      ("reduce_ctx: merging abstraction "
+                      ^ AbstractionId.to_string abs_id1
+                      ^ " into "
+                      ^ AbstractionId.to_string abs_id0
+                      ^ ":\n\n"
+                      ^ eval_ctx_to_string ~span:(Some span) ctx.ctx));
+                  Some (abs_id0, abs_id1)))
+      ctx
+  in
 
   log#ldebug
     (lazy
       ("reduce_ctx:\n\n- fixed_ids:\n" ^ show_ids_sets old_ids
      ^ "\n\n- after reduce:\n"
-      ^ eval_ctx_to_string ~span:(Some span) !ctx
+      ^ eval_ctx_to_string ~span:(Some span) ctx
       ^ "\n\n"));
 
   (* Reorder the loans and borrows in the fresh abstractions - note that we may
      not have eliminated all the markers at this point. *)
-  let ctx = reorder_loans_borrows_in_fresh_abs span true old_ids.aids !ctx in
+  let ctx = reorder_loans_borrows_in_fresh_abs span true old_ids.aids ctx in
 
   log#ldebug
     (lazy
-- 
cgit v1.3.1


From 90a1c44c1be56e81c17373723d5098e2cfa48a37 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Tue, 4 Jun 2024 13:14:39 +0200
Subject: Factor out the code in collapse_ctx

---
 compiler/InterpreterBorrows.ml       |   2 +
 compiler/InterpreterLoopsJoinCtxs.ml | 207 +++++++++--------------------------
 2 files changed, 56 insertions(+), 153 deletions(-)

(limited to 'compiler/InterpreterLoopsJoinCtxs.ml')

diff --git a/compiler/InterpreterBorrows.ml b/compiler/InterpreterBorrows.ml
index 22ae8663..dee4903c 100644
--- a/compiler/InterpreterBorrows.ml
+++ b/compiler/InterpreterBorrows.ml
@@ -2856,6 +2856,8 @@ let merge_abstractions (span : Meta.span) (abs_kind : abs_kind) (can_end : bool)
       ^ abs_to_string span ctx abs0
       ^ "\n\n- abs1:\n"
       ^ abs_to_string span ctx abs1));
+  (* Sanity check: we can't merge an abstraction with itself *)
+  sanity_check __FILE__ __LINE__ (abs0.abs_id <> abs1.abs_id) span;
 
   (* Check that the abstractions are destructured (i.e., there are no nested
      values, etc.) *)
diff --git a/compiler/InterpreterLoopsJoinCtxs.ml b/compiler/InterpreterLoopsJoinCtxs.ml
index e1a91707..7405f651 100644
--- a/compiler/InterpreterLoopsJoinCtxs.ml
+++ b/compiler/InterpreterLoopsJoinCtxs.ml
@@ -97,13 +97,9 @@ exception AbsToMerge of abstraction_id * abstraction_id
 let repeat_iter_borrows_merge (span : Meta.span) (old_ids : ids_sets)
     (abs_kind : abs_kind) (can_end : bool)
     (merge_funs : merge_duplicates_funcs option)
-    (iter :
-      ctx_with_info -> (abstraction_id -> marker_borrow_id -> unit) -> unit)
-    (policy :
-      ctx_with_info ->
-      abstraction_id ->
-      marker_borrow_id ->
-      (abstraction_id * abstraction_id) option) (ctx : eval_ctx) : eval_ctx =
+    (iter : ctx_with_info -> ('a -> unit) -> unit)
+    (policy : ctx_with_info -> 'a -> (abstraction_id * abstraction_id) option)
+    (ctx : eval_ctx) : eval_ctx =
   (* Compute the information *)
   let ctx =
     let is_fresh_abs_id (id : AbstractionId.id) : bool =
@@ -116,9 +112,9 @@ let repeat_iter_borrows_merge (span : Meta.span) (old_ids : ids_sets)
   (* Explore and merge *)
   let rec explore_merge (ctx : ctx_with_info) : eval_ctx =
     try
-      iter ctx (fun aid mbid ->
+      iter ctx (fun x ->
           (* Check if we need to merge some abstractions *)
-          match policy ctx aid mbid with
+          match policy ctx x with
           | None -> (* No *) ()
           | Some (abs_id0, abs_id1) ->
               (* Yes: raise an exception *)
@@ -222,9 +218,6 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option)
   let abs_kind : abs_kind = Loop (loop_id, None, LoopSynthInput) in
   let can_end = true in
   let destructure_shared_values = true in
-  let is_fresh_abs_id (id : AbstractionId.id) : bool =
-    not (AbstractionId.Set.mem id old_ids.aids)
-  in
   let is_fresh_did (id : DummyVarId.id) : bool =
     not (DummyVarId.Set.mem id old_ids.dids)
   in
@@ -276,9 +269,9 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option)
         List.iter
           (fun abs_id0 ->
             let lids = AbstractionId.Map.find abs_id0 ctx.info.abs_to_loans in
-            MarkerBorrowId.Set.iter (f abs_id0) lids)
+            MarkerBorrowId.Set.iter (fun lid -> f (abs_id0, lid)) lids)
           ctx.info.abs_ids)
-      (fun ctx abs_id0 lid ->
+      (fun ctx (abs_id0, lid) ->
         if not with_markers then
           sanity_check __FILE__ __LINE__ (fst lid = PNone) span;
         (* If we use markers: we are doing a collapse, which means we attempt
@@ -351,36 +344,18 @@ let reduce_ctx = reduce_ctx_with_markers None
    ]}
 *)
 let collapse_ctx_collapse (span : Meta.span) (loop_id : LoopId.id)
-    (merge_funs : merge_duplicates_funcs) (old_ids : ids_sets) (ctx0 : eval_ctx)
+    (merge_funs : merge_duplicates_funcs) (old_ids : ids_sets) (ctx : eval_ctx)
     : eval_ctx =
   (* Debug *)
   log#ldebug
     (lazy
       ("collapse_ctx:\n\n- fixed_ids:\n" ^ show_ids_sets old_ids
-     ^ "\n\n- ctx0:\n"
-      ^ eval_ctx_to_string ~span:(Some span) ctx0
+     ^ "\n\n- initial ctx:\n"
+      ^ eval_ctx_to_string ~span:(Some span) ctx
       ^ "\n\n"));
 
   let abs_kind : abs_kind = Loop (loop_id, None, LoopSynthInput) in
   let can_end = true in
-  let is_fresh_abs_id (id : AbstractionId.id) : bool =
-    not (AbstractionId.Set.mem id old_ids.aids)
-  in
-
-  (* Explore all the *new* abstractions, and compute various maps *)
-  let explore (abs : abs) = is_fresh_abs_id abs.abs_id in
-  let ids_maps = compute_abs_borrows_loans_maps span explore ctx0.env in
-  let { abs_ids; abs_to_borrows; abs_to_loans; borrow_to_abs; loan_to_abs } =
-    ids_maps
-  in
-
-  (* Merge the abstractions together *)
-  let merged_abs : AbstractionId.id UnionFind.elem AbstractionId.Map.t =
-    AbstractionId.Map.of_list
-      (List.map (fun id -> (id, UnionFind.make id)) abs_ids)
-  in
-
-  let ctx = ref ctx0 in
 
   let invert_proj_marker = function
     | PNone -> craise __FILE__ __LINE__ span "Unreachable"
@@ -390,134 +365,60 @@ let collapse_ctx_collapse (span : Meta.span) (loop_id : LoopId.id)
 
   (* Merge all the mergeable abs where the same element in present in both abs,
      but with left and right markers respectively.
-
-     We first check all borrows, then all loans
   *)
-  List.iter
-    (fun abs_id0 ->
-      let bids = AbstractionId.Map.find abs_id0 abs_to_borrows in
-      let bids = MarkerBorrowId.Set.elements bids in
-      List.iter
-        (fun (pm, bid) ->
-          if pm = PNone then ()
-          else
-            (* We are looking for an element with the same borrow_id, but with the dual marker *)
-            match
-              MarkerBorrowId.Map.find_opt
-                (invert_proj_marker pm, bid)
-                borrow_to_abs
-            with
-            | None -> (* Nothing to do *) ()
-            | Some abs_ids1 ->
-                AbstractionId.Set.iter
-                  (fun abs_id1 ->
-                    (* We need to merge - unless we have already merged *)
-                    (* First, find the representatives for the two abstractions (the
-                       representative is the abstraction into which we merged) *)
-                    let abs_ref0 =
-                      UnionFind.find (AbstractionId.Map.find abs_id0 merged_abs)
-                    in
-                    let abs_id0 = UnionFind.get abs_ref0 in
-                    let abs_ref1 =
-                      UnionFind.find (AbstractionId.Map.find abs_id1 merged_abs)
-                    in
-                    let abs_id1 = UnionFind.get abs_ref1 in
-                    (* If the two ids are the same, it means the abstractions were already merged *)
-                    if abs_id0 = abs_id1 then ()
-                    else (
-                      (* We actually need to merge the abstractions *)
-
-                      (* Debug *)
-                      log#ldebug
-                        (lazy
-                          ("collapse_ctx: merging abstraction "
-                          ^ AbstractionId.to_string abs_id1
-                          ^ " into "
-                          ^ AbstractionId.to_string abs_id0
-                          ^ ":\n\n"
-                          ^ eval_ctx_to_string ~span:(Some span) !ctx));
-
-                      (* Update the environment - pay attention to the order: we
-                         we merge [abs_id1] *into* [abs_id0] *)
-                      let nctx, abs_id =
-                        merge_into_first_abstraction span abs_kind can_end
-                          (Some merge_funs) !ctx abs_id0 abs_id1
-                      in
-                      ctx := nctx;
-
-                      (* Update the union find *)
-                      let abs_ref_merged = UnionFind.union abs_ref0 abs_ref1 in
-                      UnionFind.set abs_ref_merged abs_id))
-                  abs_ids1)
-        bids;
-      (* We now traverse the loans *)
-      let bids = AbstractionId.Map.find abs_id0 abs_to_loans in
-      let bids = MarkerBorrowId.Set.elements bids in
-      List.iter
-        (fun (pm, bid) ->
-          if pm = PNone then ()
-          else
-            (* We are looking for an element with the same borrow_id, but with the dual marker *)
-            match
-              MarkerBorrowId.Map.find_opt
-                (invert_proj_marker pm, bid)
-                loan_to_abs
-            with
-            | None -> (* Nothing to do *) ()
-            | Some abs_ids1 ->
-                AbstractionId.Set.iter
-                  (fun abs_id1 ->
-                    (* We need to merge - unless we have already merged *)
-                    (* First, find the representatives for the two abstractions (the
-                       representative is the abstraction into which we merged) *)
-                    let abs_ref0 =
-                      UnionFind.find (AbstractionId.Map.find abs_id0 merged_abs)
-                    in
-                    let abs_id0 = UnionFind.get abs_ref0 in
-                    let abs_ref1 =
-                      UnionFind.find (AbstractionId.Map.find abs_id1 merged_abs)
-                    in
-                    let abs_id1 = UnionFind.get abs_ref1 in
-                    (* If the two ids are the same, it means the abstractions were already merged *)
-                    if abs_id0 = abs_id1 then ()
-                    else (
-                      (* We actually need to merge the abstractions *)
-
-                      (* Debug *)
-                      log#ldebug
-                        (lazy
-                          ("collapse_ctx: merging abstraction "
-                          ^ AbstractionId.to_string abs_id1
-                          ^ " into "
-                          ^ AbstractionId.to_string abs_id0
-                          ^ ":\n\n"
-                          ^ eval_ctx_to_string ~span:(Some span) !ctx));
-
-                      (* Update the environment - pay attention to the order: we
-                         we merge [abs_id1] *into* [abs_id0] *)
-                      let nctx, abs_id =
-                        merge_into_first_abstraction span abs_kind can_end
-                          (Some merge_funs) !ctx abs_id0 abs_id1
-                      in
-                      ctx := nctx;
-
-                      (* Update the union find *)
-                      let abs_ref_merged = UnionFind.union abs_ref0 abs_ref1 in
-                      UnionFind.set abs_ref_merged abs_id))
-                  abs_ids1)
-        bids)
-    abs_ids;
+  (* The iter function: iterate over the abstractions, and inside an abstraction
+     over the borrows then the loans *)
+  let iter ctx f =
+    List.iter
+      (fun abs_id0 ->
+        (* Small helper *)
+        let iterate is_borrow =
+          let m =
+            if is_borrow then ctx.info.abs_to_borrows else ctx.info.abs_to_loans
+          in
+          let ids = AbstractionId.Map.find abs_id0 m in
+          MarkerBorrowId.Set.iter (fun id -> f (abs_id0, is_borrow, id)) ids
+        in
+        (* Iterate over the borrows *)
+        iterate true;
+        (* Iterate over the loans *)
+        iterate false)
+      ctx.info.abs_ids
+  in
+  (* Check if there is an abstraction with the same borrow/loan id and the dual
+     marker, and merge them if it is the case. *)
+  let merge_policy ctx (abs_id0, is_borrow, (pm, bid)) =
+    if pm = PNone then None
+    else
+      (* Look for an element with the dual marker *)
+      match
+        MarkerBorrowId.Map.find_opt
+          (invert_proj_marker pm, bid)
+          (if is_borrow then ctx.info.borrow_to_abs else ctx.info.loan_to_abs)
+      with
+      | None -> (* Nothing to do *) None
+      | Some abs_ids1 -> (
+          (* We need to merge *)
+          match AbstractionId.Set.elements abs_ids1 with
+          | [] -> None
+          | abs_id1 :: _ -> Some (abs_id0, abs_id1))
+  in
+  (* Iterate and merge *)
+  let ctx =
+    repeat_iter_borrows_merge span old_ids abs_kind can_end (Some merge_funs)
+      iter merge_policy ctx
+  in
 
   log#ldebug
     (lazy
       ("collapse_ctx:\n\n- fixed_ids:\n" ^ show_ids_sets old_ids
      ^ "\n\n- after collapse:\n"
-      ^ eval_ctx_to_string ~span:(Some span) !ctx
+      ^ eval_ctx_to_string ~span:(Some span) ctx
       ^ "\n\n"));
 
   (* Reorder the loans and borrows in the fresh abstractions - note that we may
      not have eliminated all the markers yet *)
-  let ctx = reorder_loans_borrows_in_fresh_abs span true old_ids.aids !ctx in
+  let ctx = reorder_loans_borrows_in_fresh_abs span true old_ids.aids ctx in
 
   log#ldebug
     (lazy
-- 
cgit v1.3.1


From aa847c5ea1cfc1695b95d91cd10e3dc5bace4c33 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Tue, 4 Jun 2024 13:17:26 +0200
Subject: Do more cleanup

---
 compiler/InterpreterLoopsJoinCtxs.ml | 84 +++++++++++++++++++-----------------
 1 file changed, 44 insertions(+), 40 deletions(-)

(limited to 'compiler/InterpreterLoopsJoinCtxs.ml')

diff --git a/compiler/InterpreterLoopsJoinCtxs.ml b/compiler/InterpreterLoopsJoinCtxs.ml
index 7405f651..20271f9c 100644
--- a/compiler/InterpreterLoopsJoinCtxs.ml
+++ b/compiler/InterpreterLoopsJoinCtxs.ml
@@ -256,49 +256,53 @@ let reduce_ctx_with_markers (merge_funs : merge_duplicates_funcs option)
       ^ eval_ctx_to_string ~span:(Some span) ctx
       ^ "\n\n"));
 
-  (* Merge all the mergeable abs.
-
-     We iterate over the *new* abstractions, then over the loans in the abstractions.
+  (*
+   * Merge all the mergeable abs.
+   *)
+  (* We iterate over the *new* abstractions, then over the loans in the abstractions.
      We do this because we want to control the order in which abstractions
      are merged (the ids are iterated in increasing order). Otherwise, we
-     could simply iterate over all the borrows in [loan_to_abs]...
-  *)
+     could simply iterate over all the borrows in [loan_to_abs]... *)
+  let iterate ctx f =
+    List.iter
+      (fun abs_id0 ->
+        let lids = AbstractionId.Map.find abs_id0 ctx.info.abs_to_loans in
+        MarkerBorrowId.Set.iter (fun lid -> f (abs_id0, lid)) lids)
+      ctx.info.abs_ids
+  in
+  (* Given a loan, check if there is a fresh abstraction with the corresponding borrow *)
+  let merge_policy ctx (abs_id0, lid) =
+    if not with_markers then
+      sanity_check __FILE__ __LINE__ (fst lid = PNone) span;
+    (* If we use markers: we are doing a collapse, which means we attempt
+       to eliminate markers (and this is the only goal of the operation).
+       We thus ignore the non-marked values (we merge non-marked values
+       when doing a "real" reduce, to simplify the environment in order
+       to converge to a fixed-point, for instance). *)
+    if with_markers && fst lid = PNone then None
+    else
+      (* Find the borrow corresponding to the loan we want to eliminate *)
+      match MarkerBorrowId.Map.find_opt lid ctx.info.borrow_to_abs with
+      | None -> (* Nothing to to *) None
+      | Some abs_ids1 -> (
+          (* We need to merge *)
+          match AbstractionId.Set.elements abs_ids1 with
+          | [] -> None
+          | abs_id1 :: _ ->
+              log#ldebug
+                (lazy
+                  ("reduce_ctx: merging abstraction "
+                  ^ AbstractionId.to_string abs_id1
+                  ^ " into "
+                  ^ AbstractionId.to_string abs_id0
+                  ^ ":\n\n"
+                  ^ eval_ctx_to_string ~span:(Some span) ctx.ctx));
+              Some (abs_id0, abs_id1))
+  in
+  (* Iterate and merge *)
   let ctx =
-    repeat_iter_borrows_merge span old_ids abs_kind can_end merge_funs
-      (fun ctx f ->
-        List.iter
-          (fun abs_id0 ->
-            let lids = AbstractionId.Map.find abs_id0 ctx.info.abs_to_loans in
-            MarkerBorrowId.Set.iter (fun lid -> f (abs_id0, lid)) lids)
-          ctx.info.abs_ids)
-      (fun ctx (abs_id0, lid) ->
-        if not with_markers then
-          sanity_check __FILE__ __LINE__ (fst lid = PNone) span;
-        (* If we use markers: we are doing a collapse, which means we attempt
-           to eliminate markers (and this is the only goal of the operation).
-           We thus ignore the non-marked values (we merge non-marked values
-           when doing a "real" reduce, to simplify the environment in order
-           to converge to a fixed-point, for instance). *)
-        if with_markers && fst lid = PNone then None
-        else
-          (* Find the borrow corresponding to the loan we want to eliminate *)
-          match MarkerBorrowId.Map.find_opt lid ctx.info.borrow_to_abs with
-          | None -> (* Nothing to to *) None
-          | Some abs_ids1 -> (
-              (* We need to merge *)
-              match AbstractionId.Set.elements abs_ids1 with
-              | [] -> None
-              | abs_id1 :: _ ->
-                  log#ldebug
-                    (lazy
-                      ("reduce_ctx: merging abstraction "
-                      ^ AbstractionId.to_string abs_id1
-                      ^ " into "
-                      ^ AbstractionId.to_string abs_id0
-                      ^ ":\n\n"
-                      ^ eval_ctx_to_string ~span:(Some span) ctx.ctx));
-                  Some (abs_id0, abs_id1)))
-      ctx
+    repeat_iter_borrows_merge span old_ids abs_kind can_end merge_funs iterate
+      merge_policy ctx
   in
 
   log#ldebug
-- 
cgit v1.3.1


From 2a7a18d6a07ea4967ba9ec0763e6b7d04849dc7e Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Tue, 4 Jun 2024 13:33:32 +0200
Subject: Improve collapse_ctx

---
 compiler/InterpreterLoopsJoinCtxs.ml | 43 +++++++++++++++++++++++++++++++++++-
 1 file changed, 42 insertions(+), 1 deletion(-)

(limited to 'compiler/InterpreterLoopsJoinCtxs.ml')

diff --git a/compiler/InterpreterLoopsJoinCtxs.ml b/compiler/InterpreterLoopsJoinCtxs.ml
index 20271f9c..dbb4e5e9 100644
--- a/compiler/InterpreterLoopsJoinCtxs.ml
+++ b/compiler/InterpreterLoopsJoinCtxs.ml
@@ -389,6 +389,43 @@ let collapse_ctx_collapse (span : Meta.span) (loop_id : LoopId.id)
         iterate false)
       ctx.info.abs_ids
   in
+  (* Small utility: check if we need to swap two region abstractions before
+     merging them.
+
+     We might have to swap the order to make sure that if there
+     are loans in one abstraction and the corresponding borrows
+     in the other they get properly merged (if we merge them in the wrong
+     order, we might introduce borrowing cycles).
+
+     Example:
+     If we are merging abs0 and abs1 because of the marked value
+     [MB l0]:
+     {[
+       abs0 { |MB l0|, MB l1 }
+       abs1 { ︙MB l0︙, ML l1 }
+     ]}
+     we want to make sure that we swap them (abs1 goes to the
+     left) to make sure [MB l1] and [ML l1] get properly eliminated.
+
+     Remark: in case there is a borrowing cycle between the two abstractions
+     (which shouldn't happen) then there isn't much we can do, and whatever
+     the order in which we merge, we will preserve the cycle.
+  *)
+  let swap_abs info abs_id0 abs_id1 =
+    let abs0_borrows =
+      BorrowId.Set.of_list
+        (List.map snd
+           (MarkerBorrowId.Set.elements
+              (AbstractionId.Map.find abs_id0 info.abs_to_borrows)))
+    in
+    let abs1_loans =
+      BorrowId.Set.of_list
+        (List.map snd
+           (MarkerBorrowId.Set.elements
+              (AbstractionId.Map.find abs_id1 info.abs_to_loans)))
+    in
+    not (BorrowId.Set.disjoint abs0_borrows abs1_loans)
+  in
   (* Check if there is an abstraction with the same borrow/loan id and the dual
      marker, and merge them if it is the case. *)
   let merge_policy ctx (abs_id0, is_borrow, (pm, bid)) =
@@ -405,7 +442,11 @@ let collapse_ctx_collapse (span : Meta.span) (loop_id : LoopId.id)
           (* We need to merge *)
           match AbstractionId.Set.elements abs_ids1 with
           | [] -> None
-          | abs_id1 :: _ -> Some (abs_id0, abs_id1))
+          | abs_id1 :: _ ->
+              (* Check if we need to swap *)
+              Some
+                (if swap_abs ctx.info abs_id0 abs_id1 then (abs_id1, abs_id0)
+                 else (abs_id0, abs_id1)))
   in
   (* Iterate and merge *)
   let ctx =
-- 
cgit v1.3.1