/[svn]/driver/cduce.ml
ViewVC logotype

Diff of /driver/cduce.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1096 by abate, Tue Jul 10 18:22:13 2007 UTC revision 1097 by abate, Tue Jul 10 18:22:27 2007 UTC
# Line 22  Line 22 
22  let verbose = ref false  let verbose = ref false
23    
24  let typing_env = State.ref "Cduce.typing_env" Builtin.env  let typing_env = State.ref "Cduce.typing_env" Builtin.env
25  let compile_env = State.ref "Cduce.compile_env" Compile.empty  let compile_env = State.ref "Cduce.compile_env" Compile.empty_toplevel
26    
27  let get_global_value cenv v =  let get_global_value cenv v =
28    Eval.var (Compile.find v !compile_env)    Eval.var (Compile.find v !compile_env)
# Line 30  Line 30 
30  let get_global_type v =  let get_global_type v =
31    Typer.find_value v !typing_env    Typer.find_value v !typing_env
32    
 let enter_global_value x v t =  
   typing_env := Typer.enter_value x t !typing_env;  
   compile_env := Compile.enter_global !compile_env x;  
   Eval.push v  
   
33  let rec is_abstraction = function  let rec is_abstraction = function
34    | Ast.Abstraction _ -> true    | Ast.Abstraction _ -> true
35    | Ast.LocatedExpr (_,e) -> is_abstraction e    | Ast.LocatedExpr (_,e) -> is_abstraction e
# Line 165  Line 160 
160    
161  let eval_quiet tenv cenv e =  let eval_quiet tenv cenv e =
162    let (e,_) = Typer.type_expr tenv e in    let (e,_) = Typer.type_expr tenv e in
163    let e = Compile.compile_eval cenv e in    let e = Compile.compile_expr cenv e in
164    Eval.expr e    Eval.expr e
165    
166  let debug ppf tenv cenv = function  let debug ppf tenv cenv = function
# Line 255  Line 250 
250    let (tenv,cenv,_) =    let (tenv,cenv,_) =
251      Compile.comp_unit      Compile.comp_unit
252        ~run:true ~show:(show ppf)        ~run:true ~show:(show ppf)
253        ~loading:(fun cu -> Librarian.import cu; Librarian.run Value.nil cu)        ~loading:Librarian.import_and_run
254        ~directive:(directive ppf)        ~directive:(directive ppf)
255        !typing_env !compile_env phs in        !typing_env !compile_env phs in
256    typing_env := tenv;    typing_env := tenv;
# Line 279  Line 274 
274    try phrases ppf (parse rule input); true    try phrases ppf (parse rule input); true
275    with exn -> catch_exn ppf_err exn; false    with exn -> catch_exn ppf_err exn; false
276    
 let script = run Parser.prog  
277  let topinput = run Parser.top_phrases  let topinput = run Parser.top_phrases
278    
279  ifdef ML_INTERFACE then  ifdef ML_INTERFACE then
# Line 330  Line 324 
324      exit 0      exit 0
325    with exn -> catch_exn Format.err_formatter exn; exit 1    with exn -> catch_exn Format.err_formatter exn; exit 1
326    
327  let compile_run src argv =  let compile_run src =
328    try    try
329      if not (Filename.check_suffix src ".cd")      if not (Filename.check_suffix src ".cd")
330      then raise (InvalidInputFilename src);      then raise (InvalidInputFilename src);
331      let cu = Filename.chop_suffix (Filename.basename src) ".cd" in      let cu = Filename.chop_suffix (Filename.basename src) ".cd" in
332      let id = Types.CompUnit.mk (U.mk_latin1 cu) in      let id = Types.CompUnit.mk (U.mk_latin1 cu) in
333      Librarian.compile !verbose id src;      Librarian.compile !verbose id src;
334      Librarian.run argv id      Librarian.run id
335    with exn -> catch_exn Format.err_formatter exn; exit 1    with exn -> catch_exn Format.err_formatter exn; exit 1
336    
337  let run obj argv =  let run obj =
338    try    try
339      if not (Filename.check_suffix obj ".cdo") || (Filename.basename obj <> obj)      if not (Filename.check_suffix obj ".cdo") || (Filename.basename obj <> obj)
340      then raise (InvalidObjectFilename obj);      then raise (InvalidObjectFilename obj);
341      let cu = Filename.chop_suffix (Filename.basename obj) ".cdo" in      let cu = Filename.chop_suffix (Filename.basename obj) ".cdo" in
342      let id = Types.CompUnit.mk (U.mk_latin1 cu) in      let id = Types.CompUnit.mk (U.mk_latin1 cu) in
343      Librarian.import id;      Librarian.import_and_run id
     Librarian.run argv id  
344    with exn -> catch_exn Format.err_formatter exn; exit 1    with exn -> catch_exn Format.err_formatter exn; exit 1
345    
346    
Legend:
Removed from v.1096  
changed lines
  Added in v.1097
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5