add slightly buggy closures; methods can access self fields
This commit is contained in:
parent
6837ee414f
commit
fab3b76d9c
|
@ -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);
|
||||
|
|
|
@ -57,29 +57,30 @@ 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
|
||||
| Args args ->
|
||||
| Fun { args } ->
|
||||
(* TODO: closure conversion *)
|
||||
List.assoc name args, None
|
||||
|
||||
| Obj { self; elems } ->
|
||||
if not (List.mem name elems) then
|
||||
raise Not_found;
|
||||
self, Some name
|
||||
|
||||
| Cons (e1, e2) ->
|
||||
begin
|
||||
try find name e1 with
|
||||
Not_found -> find name e2
|
||||
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)
|
||||
|
||||
|
@ -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 =
|
||||
let self = new_id () in
|
||||
and compile_lambda self env args body =
|
||||
let args = List.map (fun a -> a, new_id ()) args in
|
||||
(* FIXME: environment *)
|
||||
let env = ignore env; Env.Args args in
|
||||
let env = Env.Cons (Fun { args }, env) 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
|
||||
|
|
Loading…
Reference in New Issue