Revert back to old freeing scheme

tjammer · Dec 20, 2023 · b7a7681 · b7a7681
1 parent c0211c6
commit b7a7681
Show file tree

Hide file tree

Showing 5 changed files with 216 additions and 464 deletions.
diff --git a/lib/codegen/autogen.ml b/lib/codegen/autogen.ml
@@ -7,7 +7,7 @@ module Make (T : Lltypes_intf.S) (H : Helpers.S) (Arr : Arr_intf.S) = struct
   open Arr
   open Malloc_types
 
-  type func = Copy | Free | Free_except of Part_set.t
+  type func = Copy | Free | Free_except of Pset.t
 
   let func_tbl = Hashtbl.create 64
   let cls_func_tbl = Hashtbl.create 64
@@ -32,7 +32,7 @@ module Make (T : Lltypes_intf.S) (H : Helpers.S) (Arr : Arr_intf.S) = struct
 
   let path_name pset =
     let show_path path = String.concat "-" (List.map string_of_int path) in
-    String.concat "." (Part_set.ints pset |> Seq.map show_path |> List.of_seq)
+    String.concat "." (Pset.to_seq pset |> Seq.map show_path |> List.of_seq)
 
   let name typ = function
     | Copy -> "__copy_" ^ Monomorph_tree.short_name ~closure:false typ
@@ -338,7 +338,7 @@ module Make (T : Lltypes_intf.S) (H : Helpers.S) (Arr : Arr_intf.S) = struct
       make_ptr param v |> free_call
 
   let free_except param pset v =
-    if Part_set.is_empty pset then free param v
+    if Pset.is_empty pset then free param v
     else if contains_allocation v.typ then
       let () = decl_children_exc pset v v.typ in
       make_ptr param v |> free_except_call pset

diff --git a/lib/codegen/autogen_intf.ml b/lib/codegen/autogen_intf.ml
@@ -3,7 +3,7 @@ module type S = sig
 
   val copy : param -> Monomorph_tree.alloca -> llvar -> llvar
   val free : param -> llvar -> unit
-  val free_except : param -> Malloc_types.Part_set.t -> llvar -> unit
+  val free_except : param -> Malloc_types.Pset.t -> llvar -> unit
   val gen_functions : unit -> unit
 
   (* Closures *)

diff --git a/lib/codegen/codegen.ml b/lib/codegen/codegen.ml
@@ -1233,7 +1233,7 @@ end = struct
         List.iter
           (fun i ->
             (* Printf.printf "freeing except %i with paths %s, is %b\n" i.id *)
-            (*   (Part_set.show i.paths) *)
+            (*   (show_pset i.paths) *)
             (*   (Option.is_some (Hashtbl.find_opt free_tbl i.id)); *)
             Option.iter
               (Auto.free_except param i.paths)
@@ -1243,16 +1243,15 @@ end = struct
         List.iter
           (fun i ->
             (* Printf.printf "freeing only %i with paths %s\n" i.id *)
-            (*   (Part_set.show i.paths); *)
+            (*   (show_pset i.paths); *)
             Option.iter
               (fun init ->
                 (* TODO check for empty in monomorph_tree *)
-                if Part_set.is_empty i.paths then Auto.free param init
+                if Pset.is_empty i.paths then Auto.free param init
                 else
-                  Part_set.fold
-                    (fun path () ->
-                      get_path (Part.ints path) init |> Auto.free param)
-                    i.paths ())
+                  Pset.iter
+                    (fun path -> get_path path init |> Auto.free param)
+                    i.paths)
               (Hashtbl.find_opt free_tbl i.id))
           fs);