diff --git a/bin/main.ml b/bin/main.ml index 8f52a2c..1029a36 100644 --- a/bin/main.ml +++ b/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); diff --git a/lib/compile/ir.ml b/lib/compile/ir.ml index 561e8d7..9c3a6ad 100644 --- a/lib/compile/ir.ml +++ b/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 - | Args args -> + | Fun { 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 - self, Some name - else - raise Not_found + if not (List.mem name elems) then + raise Not_found; + self, Some name + + | 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 = - 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