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

Diff of /driver/cduce.ml

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

revision 923 by abate, Tue Jul 10 18:05:21 2007 UTC revision 924 by abate, Tue Jul 10 18:11:42 2007 UTC
# Line 4  Line 4 
4  exception InvalidInputFilename of string  exception InvalidInputFilename of string
5  exception InvalidObjectFilename of string  exception InvalidObjectFilename of string
6    
7    (* if set to false toplevel exception aren't cought. Useful for debugging with  (* if set to false toplevel exception aren't cought.
8     * OCAMLRUNPARAM="b" *)   * Useful for debugging with OCAMLRUNPARAM="b" *)
9  let catch_exceptions = true  let catch_exceptions = true
10    
11  (* retuns a filename without the suffix suff if any *)  (* retuns a filename without the suffix suff if any *)
# Line 21  Line 21 
21    
22    
23  let typing_env = State.ref "Cduce.typing_env" Builtin.env  let typing_env = State.ref "Cduce.typing_env" Builtin.env
 let eval_env = State.ref "Cduce.eval_env" Eval.empty  
24  let compile_env = State.ref "Cduce.compile_env" Compile.empty  let compile_env = State.ref "Cduce.compile_env" Compile.empty
25    
 let do_compile = ref false  
   
26  let get_global_value v =  let get_global_value v =
27    if !do_compile    Eval.var (Compile.find v !compile_env)
   then Eval.L.var (Compile.find v !compile_env)  
   else Eval.find_value v !eval_env  
28    
29  let get_global_type v =  let get_global_type v =
30    Typer.find_value v !typing_env    Typer.find_value v !typing_env
31    
32  let enter_global_value x v t =  let enter_global_value x v t =
33    typing_env := Typer.enter_value x t !typing_env;    typing_env := Typer.enter_value x t !typing_env;
34      compile_env := Compile.enter_global !compile_env x;
35    if !do_compile    Eval.push v
   then (compile_env := Compile.enter_global !compile_env x; Eval.L.push v)  
   else eval_env := Eval.enter_value x v !eval_env  
36    
37  let rec is_abstraction = function  let rec is_abstraction = function
38    | Ast.Abstraction _ -> true    | Ast.Abstraction _ -> true
# Line 171  Line 164 
164        (fun (x,t) -> dump_value ppf x t (get_global_value x))        (fun (x,t) -> dump_value ppf x t (get_global_value x))
165        l        l
166    
167    let eval_quiet e =
168      let (e,t) = Typer.type_expr !typing_env e in
169      let e = Compile.compile_eval !compile_env e in
170      Eval.expr e
171    
172  let eval ppf e =  let eval ppf e =
173    let (e,t) = Typer.type_expr !typing_env e in    let (e,t) = Typer.type_expr !typing_env e in
174    
175    if not !quiet then    if not !quiet then
176      Location.dump_loc ppf (e.Typed.exp_loc,`Full);      Location.dump_loc ppf (e.Typed.exp_loc,`Full);
177    
   let v =  
     if !do_compile then  
178        let e = Compile.compile_eval !compile_env e in        let e = Compile.compile_eval !compile_env e in
179        Eval.L.expr e    let v = Eval.expr e in
180      else  
       Eval.eval !eval_env e  
   in  
181    if not !quiet then    if not !quiet then
182      Format.fprintf ppf "- : @[@[%a@] =@ @[%a@]@]@."      Format.fprintf ppf "- : @[@[%a@] =@ @[%a@]@]@."
183        print_norm t print_value v;        print_norm t print_value v;
# Line 192  Line 186 
186  let let_decl ppf p e =  let let_decl ppf p e =
187    let (tenv,decl,typs) = Typer.type_let_decl !typing_env p e in    let (tenv,decl,typs) = Typer.type_let_decl !typing_env p e in
188    
   let () =  
     if !do_compile then  
189        let (env,decl) = Compile.compile_let_decl !compile_env decl in        let (env,decl) = Compile.compile_let_decl !compile_env decl in
190        Eval.L.eval decl;    Eval.eval decl;
191        compile_env := env    compile_env := env;
192      else  
       eval_env := Eval.eval_let_decl !eval_env decl  
   in  
193    typing_env := tenv;    typing_env := tenv;
194    display ppf typs    display ppf typs
195    
# Line 207  Line 197 
197  let let_funs ppf funs =  let let_funs ppf funs =
198    let (tenv,funs,typs) = Typer.type_let_funs !typing_env funs in    let (tenv,funs,typs) = Typer.type_let_funs !typing_env funs in
199    
   let () =  
     if !do_compile then  
200        let (env,funs) = Compile.compile_rec_funs !compile_env funs in        let (env,funs) = Compile.compile_rec_funs !compile_env funs in
201        Eval.L.eval funs;    Eval.eval funs;
202        compile_env := env;        compile_env := env;
203      else  
       eval_env := Eval.eval_rec_funs !eval_env funs  
   in  
204    typing_env := tenv;    typing_env := tenv;
205    display ppf typs    display ppf typs
206    
# Line 326  Line 312 
312        directive_help ppf;        directive_help ppf;
313        phrases ppf rest        phrases ppf rest
314    | { descr = Ast.Directive (`Dump pexpr) } :: rest ->    | { descr = Ast.Directive (`Dump pexpr) } :: rest ->
315        Format.fprintf ppf "%a@."        Format.fprintf ppf "%a@." Value.dump_xml (eval_quiet pexpr);
         Value.dump_xml (Eval.eval !eval_env  
           (fst (Typer.type_expr !typing_env pexpr)));  
316        phrases ppf rest        phrases ppf rest
317    | [] -> ()    | [] -> ()
318    
Legend:
Removed from v.923  
changed lines
  Added in v.924
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5