add slightly buggy closures; methods can access self fields

bin/main.ml

@@ -5,7 +5,7 @@ let () =
   Logs.set_level (Some Logs.Debug);
 
   try
-    let ast = parse "fun twice(x) x*2  val r = min(5, twice(2))" in
+    let ast = parse "val two = 2  fun twice(x) x*two  val r = twice(8)" in
     Logs.debug (fun m -> m "[AST] %a" Ast.pp_modl ast);
     let prog = compile ast in
     Logs.debug (fun m -> Code.dump (m "[BC] %s") prog.main);

lib/compile/ir.ml

@@ -57,28 +57,29 @@ let make_id_dispenser () =
 
 module Env = struct
   type t =
-    | Empty
-    | Cons of t * t
-    | Args of (string * id) list
     | Obj of {
         self : id;
         elems : string list;
       }
+    | Fun of {
+        args : (string * id) list;
+        (* clos : ??? *)
+      }
+    | Cons of t * t
 
   let rec find name = function
-    | Empty -> raise Not_found
+    | Fun { args } ->
-    | Args args ->
+      (* TODO: closure conversion *)
       List.assoc name args, None
-    | Cons (e1, e2) ->
+
-      begin
-        try find name e1 with
-          Not_found -> find name e2
-      end
     | Obj { self; elems } ->
-      if List.mem name elems then
+      if not (List.mem name elems) then
-        self, Some name
+        raise Not_found;
-      else
+      self, Some name
-        raise Not_found
+
+    | Cons (e1, e2) ->
+      try find name e1 with
+        Not_found -> find name e2
 end
 
 let seq_r a b = Seq (b, a)
@@ -167,30 +168,29 @@ let lower ~lib (modl : Ast.modl) =
     if is_scope && not ends_with_exp then
       compile_error "scope does not end in expression";
 
-    (* build environment for field initializers; NOT for lambda capture *)
     let self = new_id () in
-    let env_in = Env.Cons (Obj { self; elems }, env) in
+    let env = Env.Cons (Obj { self; elems }, env) in
 
     let funs_r, vals_r, inits_r =
       List.fold_left
         (fun (fns, vls, ins) -> function
            | Ast.Item_exp exp ->
-             let init = lower_exp env_in exp in
+             let init = lower_exp env exp in
              fns, vls, init :: ins
 
            | Ast.Item_val (name, exp) ->
-             let init = Set ((self, name), lower_exp env_in exp) in
+             let init = Set ((self, name), lower_exp env exp) in
              fns, name :: vls, init :: ins
 
            | Ast.Item_obj (name, items) ->
              (* TODO: it would be ideal if we could construct the empty versions of obj's
                 in a sort of "pre-init" phase, before assigning field values. but for now,
                 obj items are identical to val's where the rhs is an obj expression. *)
-             let init = Set ((self, name), lower_block env_in items) in
+             let init = Set ((self, name), lower_block env items) in
              fns, name :: vls, init :: ins
 
            | Ast.Item_fun (name, args, body) ->
-             let fn = name, compile_lambda env args body in
+             let fn = name, compile_lambda self env args body in
              fn :: fns, vls, ins)
         ([], [], [])
         items
@@ -203,6 +203,7 @@ let lower ~lib (modl : Ast.modl) =
       | true, init :: inits -> init, inits
       | _,    inits         -> Var self, inits
     in
+
     (* reverse order of inits and decls since they are cons'ed backwards *)
     Let (
       self,
@@ -216,17 +217,14 @@ let lower ~lib (modl : Ast.modl) =
         inits_r      
     )
 
-  and compile_lambda env args body =
+  and compile_lambda self env args body =
-    let self = new_id () in
     let args = List.map (fun a -> a, new_id ()) args in
-    (* FIXME: environment *)
+    let env = Env.Cons (Fun { args }, env) in
-    let env = ignore env; Env.Args args in
     let body = lower_exp env body in
     let args = List.map snd args in
     { self; args; body }
+
   in
-
-
   let self = new_id () in
   let env = Env.Obj { self; elems = List.map fst lib } in
   let args = [] in