Commit 729085af authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2003-10-08 21:45:06 by cvscast] Toplevel and sep. comp.

Original author: cvscast
Date: 2003-10-08 21:45:07+00:00
parent c979b48b
...@@ -251,6 +251,9 @@ let rec phrases ppf phs = match phs with ...@@ -251,6 +251,9 @@ let rec phrases ppf phs = match phs with
typing_env := Typer.enter_ns pr ns !typing_env; typing_env := Typer.enter_ns pr ns !typing_env;
phrases ppf rest phrases ppf rest
| { descr = Ast.Using (x,cu) } :: rest -> | { descr = Ast.Using (x,cu) } :: rest ->
Librarian.import cu;
Librarian.run Value.nil cu;
typing_env := Typer.enter_cu x cu !typing_env; typing_env := Typer.enter_cu x cu !typing_env;
phrases ppf rest phrases ppf rest
| { descr = Ast.EvalStatement e } :: rest -> | { descr = Ast.EvalStatement e } :: rest ->
......
...@@ -159,19 +159,34 @@ and load_check id exp = ...@@ -159,19 +159,34 @@ and load_check id exp =
let rec run argv id = let rec run argv id =
let cu = find id in let cu = find id in
List.iter (run argv) cu.depends; match cu.vals with
Eval.L.push argv; | None ->
List.iter Eval.L.eval cu.code; List.iter (run argv) cu.depends;
cu.vals <- Some (Eval.L.comp_unit ()) Eval.L.push argv;
List.iter Eval.L.eval cu.code;
cu.vals <- Some (Eval.L.comp_unit ())
| Some _ -> ()
let import id = ignore (load id) let import id = ignore (load id)
let () = let () =
Typer.from_comp_unit := (fun cu -> (load cu).typing); Typer.from_comp_unit := (fun cu -> (load cu).typing);
Compile.from_comp_unit := (fun cu -> (load cu).compile); Compile.from_comp_unit := (fun cu -> (load cu).compile);
Eval.L.from_comp_unit := (fun cu i -> Eval.L.from_comp_unit :=
match (load cu).vals with (fun cu i ->
| None -> assert false match (load cu).vals with
| Some a -> a.(i)) | None -> assert false
| Some a -> a.(i));
Eval.from_comp_unit :=
(fun cu id ->
let c = load cu in
let pos =
match Compile.find id c.compile with
| Lambda.Global i -> i
| _ -> assert false in
run Value.nil cu;
match c.vals with
| None -> assert false
| Some a -> a.(pos))
...@@ -24,11 +24,14 @@ let map f v = let acc0 = make_accu () in set_cdr (f acc0 v) nil; get_accu acc0 ...@@ -24,11 +24,14 @@ let map f v = let acc0 = make_accu () in set_cdr (f acc0 v) nil; get_accu acc0
(* Evaluation of expressions *) (* Evaluation of expressions *)
let from_comp_unit = ref (fun cu i -> assert false)
let eval_apply = ref (fun f x -> assert false)
let rec eval env e0 = match e0.Typed.exp_descr with let rec eval env e0 = match e0.Typed.exp_descr with
| Typed.Forget (e,_) -> eval env e | Typed.Forget (e,_) -> eval env e
| Typed.Var s -> (match Env.find s env with Value.Delayed x -> !x | x -> x) | Typed.Var s -> (match Env.find s env with Value.Delayed x -> !x | x -> x)
| Typed.ExtVar _ -> assert false | Typed.ExtVar (cu,i) -> !from_comp_unit cu i
| Typed.Apply (f,arg) -> eval_apply (eval env f) (eval env arg) | Typed.Apply (f,arg) -> !eval_apply (eval env f) (eval env arg)
| Typed.Abstraction a -> eval_abstraction env a | Typed.Abstraction a -> eval_abstraction env a
| Typed.RecordLitt r -> Record (LabelMap.map (eval env) r) | Typed.RecordLitt r -> Record (LabelMap.map (eval env) r)
| Typed.Pair (e1,e2) -> Pair (eval env e1, eval env e2) | Typed.Pair (e1,e2) -> Pair (eval env e1, eval env e2)
...@@ -92,10 +95,11 @@ and eval_abstraction env a = ...@@ -92,10 +95,11 @@ and eval_abstraction env a =
(a.Typed.fun_iface, eval_branches env a.Typed.fun_body) in (a.Typed.fun_iface, eval_branches env a.Typed.fun_body) in
self := a; self := a;
a a
(*
and eval_apply f arg = match f with and eval_apply f arg = match f with
| Abstraction (_,clos) -> clos arg | Abstraction (_,clos) -> clos arg
| _ -> assert false | _ -> assert false
*)
and eval_branches env brs arg = and eval_branches env brs arg =
let (disp, rhs) = Typed.dispatcher brs in let (disp, rhs) = Typed.dispatcher brs in
...@@ -567,3 +571,5 @@ let eval = function ...@@ -567,3 +571,5 @@ let eval = function
| Let_funs funs -> eval_rec_funs funs | Let_funs funs -> eval_rec_funs funs
end end
let () = eval_apply := L.eval_apply
...@@ -5,6 +5,7 @@ exception MultipleDeclaration of id ...@@ -5,6 +5,7 @@ exception MultipleDeclaration of id
type env type env
val empty: env val empty: env
val from_comp_unit: (Types.CompUnit.t -> id -> t) ref
val enter_value: id -> t -> env -> env val enter_value: id -> t -> env -> env
val enter_values: (id * t) list -> env -> env val enter_values: (id * t) list -> env -> env
......
...@@ -102,6 +102,10 @@ let iter_values env f = ...@@ -102,6 +102,10 @@ let iter_values env f =
let enter_cu x cu env = let enter_cu x cu env =
{ env with cu = Env.add (ident x) cu env.cu } { env with cu = Env.add (ident x) cu env.cu }
let find_cu x env =
try Env.find x env.cu
with Not_found -> failwith ("Unbound compunit prefix " ^ (Ident.to_string x))
(* Namespaces *) (* Namespaces *)
let set_ns_table_for_printer env = let set_ns_table_for_printer env =
...@@ -791,7 +795,7 @@ let rec expr env loc = function ...@@ -791,7 +795,7 @@ let rec expr env loc = function
| "", id -> let id = ident id in | "", id -> let id = ident id in
exp loc (Fv.singleton id) (Typed.Var id) exp loc (Fv.singleton id) (Typed.Var id)
| cu, id -> | cu, id ->
let cu = Env.find (ident (U.mk cu)) env.cu in let cu = find_cu (ident (U.mk cu)) env in
exp loc Fv.empty (Typed.ExtVar (cu, ident id))) exp loc Fv.empty (Typed.ExtVar (cu, ident id)))
| Apply (e1,e2) -> | Apply (e1,e2) ->
let (fv1,e1) = expr env loc e1 and (fv2,e2) = expr env loc e2 in let (fv1,e1) = expr env loc e1 and (fv2,e2) = expr env loc e2 in
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment