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

Original author: cvscast
Date: 2003-10-08 21:45:07+00:00

driver/cduce.ml

@@ -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 ->

driver/librarian.ml

@@ -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))
 
 

runtime/eval.ml

@@ -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

runtime/eval.mli

@@ -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

typing/typer.ml

@@ -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