Merge obj-drop and closure-drop code, handles freeing bound exteriors now.

2 files changed, 52 insertions, 44 deletions

diff --git a/src/boot/me/semant.ml b/src/boot/me/semant.ml
index 8a7d6aa0..be777bc6 100644
--- a/src/boot/me/semant.ml
+++ b/src/boot/me/semant.ml
@@ -1918,19 +1918,24 @@ let rec closure_box_rty
 
   let rc = word_rty word_bits in
   let tydesc = sp (tydesc_rty word_bits) in
-  let targ = fn_rty word_bits in
+  let targ = fn_rty true word_bits in
   let bound_args = r (Array.map (slot_referent_type word_bits) bs) in
 
     r [| rc; r [| tydesc; targ; bound_args |] |]
 
-and fn_rty (word_bits:Il.bits) : Il.referent_ty =
+and fn_rty (opaque_box_body:bool) (word_bits:Il.bits) : Il.referent_ty =
   let s t = Il.ScalarTy t in
   let p t = Il.AddrTy t in
   let sp t = s (p t) in
   let r rtys = Il.StructTy rtys in
   let word = word_rty word_bits in
 
-  let box_ptr = sp (Il.StructTy [| word; Il.OpaqueTy |]) in
+  let box =
+    if opaque_box_body
+    then r [| word; Il.OpaqueTy |]
+    else closure_box_rty word_bits [||]
+  in
+  let box_ptr = sp box in
   let code_ptr = sp Il.CodeTy in
 
     r [| code_ptr; box_ptr |]
@@ -1985,7 +1990,7 @@ and referent_type (word_bits:Il.bits) (t:Ast.ty) : Il.referent_ty =
       | Ast.TY_tup tt -> tup tt
       | Ast.TY_rec tr -> tup (Array.map snd tr)
 
-      | Ast.TY_fn _ -> fn_rty word_bits
+      | Ast.TY_fn _ -> fn_rty false word_bits
       | Ast.TY_obj _ -> obj_rty word_bits
 
       | Ast.TY_tag ttag -> tag ttag
diff --git a/src/boot/me/trans.ml b/src/boot/me/trans.ml
index a37ed460..f0483e6e 100644
--- a/src/boot/me/trans.ml
+++ b/src/boot/me/trans.ml
@@ -2604,56 +2604,59 @@ let trans_visitor
 
       match ty with
 
-          Ast.TY_fn _ ->
-            note_drop_step ty "drop_ty: fn path";
-            let box = get_element_ptr cell Abi.fn_field_box in
-            let null_jmp = null_check box in
-              (* Drop non-null bindings. *)
-              (* FIXME (issue #58): this is completely wrong, Closures need to
-               * carry tydescs like objs. For now this only works by accident,
-               * and will leak closures with box substructure.
-               *)
-              drop_ty ty_params box (Ast.TY_box Ast.TY_int) curr_iso;
-              patch null_jmp;
-              note_drop_step ty "drop_ty: done fn path";
-
+          Ast.TY_fn _
         | Ast.TY_obj _ ->
-            note_drop_step ty "drop_ty: obj path";
-            let binding = get_element_ptr cell Abi.obj_field_box in
-            let null_jmp = null_check binding in
-            let rc_jmp = drop_refcount_and_cmp binding in
-            let obj_box = deref binding in
-            let obj = get_element_ptr obj_box Abi.box_rc_field_body in
-            let tydesc = get_element_ptr obj Abi.obj_body_elt_tydesc in
-            let body = get_element_ptr obj Abi.obj_body_elt_fields in
-            let ty_params = get_tydesc_params ty_params tydesc in
-            let dtor =
-              get_element_ptr (deref tydesc) Abi.tydesc_field_obj_drop_glue
+            note_drop_step ty "drop_ty: obj/fn path";
+            let box_ptr =
+              get_element_ptr cell Abi.binding_field_bound_data
             in
-            let null_dtor_jmp = null_check dtor in
-              (* Call any dtor, if present. *)
-              note_drop_step ty "drop_ty: calling obj dtor";
-              trans_call_dynamic_glue
-                tydesc
-                Abi.tydesc_field_obj_drop_glue
-                None
-                [| binding |]
-                (Some binding);
-              patch null_dtor_jmp;
-              (* Drop the body. *)
-              note_drop_step ty "drop_ty: dropping obj body";
+            let _ = check_box_rty box_ptr in
+            let null_jmp = null_check box_ptr in
+            let rc_jmp = drop_refcount_and_cmp box_ptr in
+            let box = deref box_ptr in
+            let body = get_element_ptr box Abi.box_rc_field_body in
+            let tydesc = get_element_ptr body Abi.obj_body_elt_tydesc in
+            let fields =
+              match ty with
+                  Ast.TY_fn _ ->
+                    get_element_ptr body Abi.closure_body_elt_bound_args
+                | _ ->
+                    get_element_ptr body Abi.obj_body_elt_fields
+            in
+            let ty_params = get_tydesc_params ty_params tydesc in
+              begin
+                match ty with
+                    Ast.TY_obj _ ->
+                      let dtor =
+                        get_element_ptr (deref tydesc)
+                          Abi.tydesc_field_obj_drop_glue
+                      in
+                      let null_dtor_jmp = null_check dtor in
+                        (* Call any dtor, if present. *)
+                        note_drop_step ty "drop_ty: calling obj/fn dtor";
+                        trans_call_dynamic_glue
+                          tydesc
+                          Abi.tydesc_field_obj_drop_glue
+                          None
+                          [| box_ptr |]
+                          (Some box_ptr);
+                        patch null_dtor_jmp;
+                  | _ -> ()
+              end;
+              (* Drop the fields. *)
+              note_drop_step ty "drop_ty: dropping obj/fn fields";
               trans_call_dynamic_glue
                 tydesc
                 Abi.tydesc_field_drop_glue
                 None
-                [| ty_params; alias body |]
+                [| ty_params; alias fields |]
                 None;
               (* FIXME: this will fail if the user has lied about the
                * state-ness of their obj. We need to store state-ness in the
                * captured tydesc, and use that.  *)
-              note_drop_step ty "drop_ty: freeing obj body";
-              trans_free binding (type_has_state ty);
-              mov binding zero;
+              note_drop_step ty "drop_ty: freeing obj/fn body";
+              trans_free box_ptr (type_has_state ty);
+              mov box_ptr zero;
               patch rc_jmp;
               patch null_jmp;
               note_drop_step ty "drop_ty: done obj path";