env cons-list instead of tree structure
This commit is contained in:
parent
752d36d855
commit
c986aa6ec0
|
@ -64,27 +64,33 @@ and lambda = {
|
||||||
|
|
||||||
module Env = struct
|
module Env = struct
|
||||||
type t =
|
type t =
|
||||||
|
| Empty
|
||||||
| Obj of {
|
| Obj of {
|
||||||
|
pred : t;
|
||||||
self : id;
|
self : id;
|
||||||
elems : (string, string) Hashtbl.t;
|
elems : (string, string) Hashtbl.t;
|
||||||
}
|
}
|
||||||
| Fun of {
|
| Fun of {
|
||||||
|
pred : t;
|
||||||
args : (string * id) list;
|
args : (string * id) list;
|
||||||
(* clos : ??? *)
|
(* clos : ??? *)
|
||||||
}
|
}
|
||||||
| Cons of t * t
|
|
||||||
|
|
||||||
let rec find name = function
|
let rec find name = function
|
||||||
| Fun { args } ->
|
| Empty ->
|
||||||
(* TODO: closure conversion *)
|
raise Not_found
|
||||||
List.assoc name args, None
|
|
||||||
|
|
||||||
| Obj { self; elems } ->
|
| Fun { pred; args } ->
|
||||||
self, Some (Hashtbl.find elems name)
|
begin match List.assoc name args with
|
||||||
|
| id -> id, None
|
||||||
|
| exception Not_found -> find name pred
|
||||||
|
end
|
||||||
|
|
||||||
| Cons (e1, e2) ->
|
| Obj { pred; self; elems } ->
|
||||||
try find name e1 with
|
begin match Hashtbl.find elems name with
|
||||||
Not_found -> find name e2
|
| elem -> self, Some elem
|
||||||
|
| exception Not_found -> find name pred
|
||||||
|
end
|
||||||
end
|
end
|
||||||
|
|
||||||
let seq_r a b = Seq (b, a)
|
let seq_r a b = Seq (b, a)
|
||||||
|
@ -179,8 +185,8 @@ let lower ~lib (modl : Ast.modl) =
|
||||||
compile_error "scope does not end in expression";
|
compile_error "scope does not end in expression";
|
||||||
|
|
||||||
let self = new_id "obj" in
|
let self = new_id "obj" in
|
||||||
let env' = Env.Obj { self; elems } in
|
let env = Env.Obj { self; elems; pred = env } in
|
||||||
let env = Env.Cons (env', env) in
|
let env' = Env.Obj { self; elems; pred = Empty } in
|
||||||
|
|
||||||
let funs_r, vals_r, inits_r =
|
let funs_r, vals_r, inits_r =
|
||||||
List.fold_left
|
List.fold_left
|
||||||
|
@ -228,7 +234,7 @@ let lower ~lib (modl : Ast.modl) =
|
||||||
|
|
||||||
and lower_lambda self env args body =
|
and lower_lambda self env args body =
|
||||||
let args = List.map (fun a -> a, new_id a) args in
|
let args = List.map (fun a -> a, new_id a) args in
|
||||||
let env = Env.Cons (Fun { args }, env) in
|
let env = Env.Fun { args; pred = env } in
|
||||||
(* TODO: closure conversion *)
|
(* TODO: closure conversion *)
|
||||||
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
|
||||||
|
@ -239,7 +245,7 @@ let lower ~lib (modl : Ast.modl) =
|
||||||
let self = new_id "lib" in
|
let self = new_id "lib" in
|
||||||
let elems = Hashtbl.create 128 in
|
let elems = Hashtbl.create 128 in
|
||||||
List.iter (fun (name, _) -> Hashtbl.add elems name name) lib;
|
List.iter (fun (name, _) -> Hashtbl.add elems name name) lib;
|
||||||
let env = Env.Obj { self; elems } in
|
let env = Env.Obj { self; elems; pred = Empty } in
|
||||||
let args = [] in
|
let args = [] in
|
||||||
let body = lower_block env modl.items in
|
let body = lower_block env modl.items in
|
||||||
{ self; args; body }
|
{ self; args; body }
|
||||||
|
|
Loading…
Reference in New Issue