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

[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
typing_env := Typer.enter_ns pr ns !typing_env;
phrases ppf rest
| { descr = Ast.Using (x,cu) } :: rest ->
Librarian.import cu;
Librarian.run Value.nil cu;
typing_env := Typer.enter_cu x cu !typing_env;
phrases ppf rest
| { descr = Ast.EvalStatement e } :: rest ->
......
......@@ -159,19 +159,34 @@ and load_check id exp =
let rec run argv id =
let cu = find id in
List.iter (run argv) cu.depends;
Eval.L.push argv;
List.iter Eval.L.eval cu.code;
cu.vals <- Some (Eval.L.comp_unit ())
match cu.vals with
| None ->
List.iter (run argv) cu.depends;
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 () =
Typer.from_comp_unit := (fun cu -> (load cu).typing);
Compile.from_comp_unit := (fun cu -> (load cu).compile);
Eval.L.from_comp_unit := (fun cu i ->
match (load cu).vals with
| None -> assert false
| Some a -> a.(i))
Eval.L.from_comp_unit :=
(fun cu i ->
match (load cu).vals with
| 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
(* 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
| Typed.Forget (e,_) -> eval env e
| Typed.Var s -> (match Env.find s env with Value.Delayed x -> !x | x -> x)
| Typed.ExtVar _ -> assert false
| Typed.Apply (f,arg) -> eval_apply (eval env f) (eval env arg)
| Typed.ExtVar (cu,i) -> !from_comp_unit cu i
| Typed.Apply (f,arg) -> !eval_apply (eval env f) (eval env arg)
| Typed.Abstraction a -> eval_abstraction env a
| Typed.RecordLitt r -> Record (LabelMap.map (eval env) r)
| Typed.Pair (e1,e2) -> Pair (eval env e1, eval env e2)
......@@ -92,10 +95,11 @@ and eval_abstraction env a =
(a.Typed.fun_iface, eval_branches env a.Typed.fun_body) in
self := a;
a
(*
and eval_apply f arg = match f with
| Abstraction (_,clos) -> clos arg
| _ -> assert false
*)
and eval_branches env brs arg =
let (disp, rhs) = Typed.dispatcher brs in
......@@ -567,3 +571,5 @@ let eval = function
| Let_funs funs -> eval_rec_funs funs
end
let () = eval_apply := L.eval_apply
......@@ -5,6 +5,7 @@ exception MultipleDeclaration of id
type env
val empty: env
val from_comp_unit: (Types.CompUnit.t -> id -> t) ref
val enter_value: id -> t -> env -> env
val enter_values: (id * t) list -> env -> env
......
......@@ -102,6 +102,10 @@ let iter_values env f =
let enter_cu x cu env =
{ 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 *)
let set_ns_table_for_printer env =
......@@ -791,7 +795,7 @@ let rec expr env loc = function
| "", id -> let id = ident id in
exp loc (Fv.singleton id) (Typed.Var 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)))
| Apply (e1,e2) ->
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