add slightly buggy closures; methods can access self fields

This commit is contained in:
tali 2023-12-13 17:32:13 -05:00
parent 6837ee414f
commit fab3b76d9c
2 changed files with 25 additions and 27 deletions

View File

@ -5,7 +5,7 @@ let () =
Logs.set_level (Some Logs.Debug); Logs.set_level (Some Logs.Debug);
try 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); Logs.debug (fun m -> m "[AST] %a" Ast.pp_modl ast);
let prog = compile ast in let prog = compile ast in
Logs.debug (fun m -> Code.dump (m "[BC] %s") prog.main); Logs.debug (fun m -> Code.dump (m "[BC] %s") prog.main);

View File

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