Some closures closed but buggy overall [skip ci]

compiler/lcalc/closure_conversion.ml

@@ -64,6 +64,80 @@ let rec close_closures_expr (ctx : ctx) (e : expr Pos.marked) :
           (fun new_args -> (ETuple (List.rev new_args, s), Pos.get_position e))
           (Bindlib.box_list new_args),
         free_vars )
+  | ETupleAccess (e1, n, s, typs) ->
+      let new_e1, free_vars = close_closures_expr ctx e1 in
+      ( Bindlib.box_apply
+          (fun new_e1 ->
+            (ETupleAccess (new_e1, n, s, typs), Pos.get_position e))
+          new_e1,
+        free_vars )
+  | EInj (e1, n, e_name, typs) ->
+      let new_e1, free_vars = close_closures_expr ctx e1 in
+      ( Bindlib.box_apply
+          (fun new_e1 -> (EInj (new_e1, n, e_name, typs), Pos.get_position e))
+          new_e1,
+        free_vars )
+  | EMatch (e1, arms, e_name) ->
+      let new_e1, free_vars = close_closures_expr ctx e1 in
+      (* We do not close the clotures inside the arms of the match expression,
+         since they get a special treatment at compilation to Scalc. *)
+      let new_arms, free_vars =
+        List.fold_right
+          (fun arm (new_arms, free_vars) ->
+            match Pos.unmark arm with
+            | EAbs ((binder, binder_pos), typs) ->
+                let vars, body = Bindlib.unmbind binder in
+                let new_body, new_free_vars = close_closures_expr ctx body in
+                let new_binder = Bindlib.bind_mvar vars new_body in
+                ( Bindlib.box_apply
+                    (fun new_binder ->
+                      ( EAbs ((new_binder, binder_pos), typs),
+                        Pos.get_position arm ))
+                    new_binder
+                  :: new_arms,
+                  VarSet.union free_vars new_free_vars )
+            | _ -> failwith "should not happen")
+          arms ([], free_vars)
+      in
+      ( Bindlib.box_apply2
+          (fun new_e1 new_arms ->
+            (EMatch (new_e1, new_arms, e_name), Pos.get_position e))
+          new_e1
+          (Bindlib.box_list new_arms),
+        free_vars )
+  | EArray args ->
+      let new_args, free_vars =
+        List.fold_right
+          (fun arg (new_args, free_vars) ->
+            let new_arg, new_free_vars = close_closures_expr ctx arg in
+            (new_arg :: new_args, VarSet.union free_vars new_free_vars))
+          args ([], VarSet.empty)
+      in
+      ( Bindlib.box_apply
+          (fun new_args -> (EArray new_args, Pos.get_position e))
+          (Bindlib.box_list new_args),
+        free_vars )
+  | ELit l -> (Bindlib.box (ELit l, Pos.get_position e), VarSet.empty)
+  | EApp ((EAbs ((binder, binder_pos), typs_abs), e1_pos), args) ->
+      (* let-binding, we should not close these *)
+      let vars, body = Bindlib.unmbind binder in
+      let new_body, free_vars = close_closures_expr ctx body in
+      let new_binder = Bindlib.bind_mvar vars new_body in
+      let new_args, free_vars =
+        List.fold_right
+          (fun arg (new_args, free_vars) ->
+            let new_arg, new_free_vars = close_closures_expr ctx arg in
+            (new_arg :: new_args, VarSet.union free_vars new_free_vars))
+          args ([], free_vars)
+      in
+      ( Bindlib.box_apply2
+          (fun new_binder new_args ->
+            ( EApp
+                ((EAbs ((new_binder, binder_pos), typs_abs), e1_pos), new_args),
+              Pos.get_position e ))
+          new_binder
+          (Bindlib.box_list new_args),
+        free_vars )
   | EAbs ((binder, binder_pos), typs) ->
       (* This is a closure we'll have to close *)
       let vars, body = Bindlib.unmbind binder in
@@ -87,7 +161,46 @@ let rec close_closures_expr (ctx : ctx) (e : expr Pos.marked) :
               Pos.get_position e ))
           new_binder,
         extra_vars )
-  | _ -> (Bindlib.box e, VarSet.empty)
+  | EApp (e1, args) ->
+      let new_e1, free_vars = close_closures_expr ctx e1 in
+      let new_args, free_vars =
+        List.fold_right
+          (fun arg (new_args, free_vars) ->
+            let new_arg, new_free_vars = close_closures_expr ctx arg in
+            (new_arg :: new_args, VarSet.union free_vars new_free_vars))
+          args ([], free_vars)
+      in
+      ( Bindlib.box_apply2
+          (fun new_e1 new_e2 -> (EApp (new_e1, new_e2), Pos.get_position e))
+          new_e1
+          (Bindlib.box_list new_args),
+        free_vars )
+  | EAssert e1 ->
+      let new_e1, free_vars = close_closures_expr ctx e1 in
+      ( Bindlib.box_apply
+          (fun new_e1 -> (EAssert new_e1, Pos.get_position e))
+          new_e1,
+        free_vars )
+  | EOp op -> (Bindlib.box (EOp op, Pos.get_position e), VarSet.empty)
+  | EIfThenElse (e1, e2, e3) ->
+      let new_e1, free_vars1 = close_closures_expr ctx e1 in
+      let new_e2, free_vars2 = close_closures_expr ctx e2 in
+      let new_e3, free_vars3 = close_closures_expr ctx e3 in
+      ( Bindlib.box_apply3
+          (fun new_e1 new_e2 new_e3 ->
+            (EIfThenElse (new_e1, new_e2, new_e3), Pos.get_position e))
+          new_e1 new_e2 new_e3,
+        VarSet.union (VarSet.union free_vars1 free_vars2) free_vars3 )
+  | ERaise except ->
+      (Bindlib.box (ERaise except, Pos.get_position e), VarSet.empty)
+  | ECatch (e1, except, e2) ->
+      let new_e1, free_vars1 = close_closures_expr ctx e1 in
+      let new_e2, free_vars2 = close_closures_expr ctx e2 in
+      ( Bindlib.box_apply2
+          (fun new_e1 new_e2 ->
+            (ECatch (new_e1, except, new_e2), Pos.get_position e))
+          new_e1 new_e2,
+        VarSet.union free_vars1 free_vars2 )
 
 let closure_conversion (p : program) : program Bindlib.box * closure list =
   let new_scopes, closures =