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

Diff of /driver/cduce.ml

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

revision 420 by abate, Tue Jul 10 17:32:43 2007 UTC revision 421 by abate, Tue Jul 10 17:33:25 2007 UTC
# Line 5  Line 5 
5    
6  let quiet = ref false  let quiet = ref false
7    
8  let typing_env = State.ref "Cduce.typing_env" Typer.Env.empty  let typing_env = State.ref "Cduce.typing_env" Env.empty
9    
10  let enter_global_value x v t =  let enter_global_value x v t =
11    Eval.enter_global x v;    Eval.enter_global x v;
12    typing_env := Typer.Env.add x t !typing_env    typing_env := Env.add x t !typing_env
13    
14  let rec is_abstraction = function  let rec is_abstraction = function
15    | Ast.Abstraction _ -> true    | Ast.Abstraction _ -> true
# Line 27  Line 27 
27    Format.fprintf ppf "Global types:";    Format.fprintf ppf "Global types:";
28    Typer.dump_global_types ppf;    Typer.dump_global_types ppf;
29    Format.fprintf ppf ".@\n";    Format.fprintf ppf ".@\n";
30    Eval.Env.iter    Env.iter
31      (fun x v ->      (fun x v ->
32         let t = Typer.Env.find x !typing_env in         let t = Env.find x !typing_env in
33         Format.fprintf ppf "@[|- %a : %a@ => %a@]@\n"         Format.fprintf ppf "@[|- %a : %a@ => %a@]@\n"
34           U.print (Id.value x)           U.print (Id.value x)
35           print_norm t           print_norm t
# Line 63  Line 63 
63          print_norm t1          print_norm t1
64          msg          msg
65          print_norm t2          print_norm t2
66    | Typer.Constraint (s,t,msg) ->    | Typer.Error s ->
67          Format.fprintf ppf "%s@\n" s
68      | Typer.Constraint (s,t) ->
69        Format.fprintf ppf "This expression should have type:@\n%a@\n"        Format.fprintf ppf "This expression should have type:@\n%a@\n"
70          print_norm t;          print_norm t;
71        Format.fprintf ppf "but its inferred type is:@\n%a@\n"        Format.fprintf ppf "but its inferred type is:@\n%a@\n"
# Line 72  Line 74 
74        Location.protect ppf        Location.protect ppf
75          (fun ppf ->          (fun ppf ->
76             Sample.print ppf (Sample.get (Types.diff s t)));             Sample.print ppf (Sample.get (Types.diff s t)));
77        Format.fprintf ppf "@\n%s@\n" msg        Format.fprintf ppf "@\n"
78    | Typer.NonExhaustive t ->    | Typer.NonExhaustive t ->
79        Format.fprintf ppf "This pattern matching is not exhaustive@\n";        Format.fprintf ppf "This pattern matching is not exhaustive@\n";
80        Format.fprintf ppf "Residual type:@\n%a@\n"        Format.fprintf ppf "Residual type:@\n%a@\n"
# Line 131  Line 133 
133    
134    
135    
 let mk_builtin () =  
   let bi = List.map (fun (n,t) -> [n, mknoloc (Ast.Internal t)])  
              Builtin.types in  
   List.iter Typer.register_global_types bi  
   
 let () = mk_builtin ()  
136    
137    
138  let run ppf ppf_err input =  let run ppf ppf_err input =
139    let insert_type_bindings =    let insert_type_bindings =
140      List.iter (fun (x,t) ->      List.iter (fun (x,t) ->
141                   typing_env := Typer.Env.add x t !typing_env;                   typing_env := Env.add x t !typing_env;
142                   if not !quiet then                   if not !quiet then
143                     Format.fprintf ppf "|- %a : %a@\n@." U.print (Id.value x) print_norm t)                     Format.fprintf ppf "|- %a : %a@\n@." U.print (Id.value x) print_norm t)
144    in    in
# Line 153  Line 149 
149    in    in
150    
151    let eval_decl decl =    let eval_decl decl =
152      let bindings = Eval.eval_let_decl Eval.Env.empty decl in      let bindings = Eval.eval_let_decl Env.empty decl in
153      List.iter      List.iter
154        (fun (x,v) ->        (fun (x,v) ->
155           Eval.enter_global x v;           Eval.enter_global x v;
# Line 171  Line 167 
167            Location.dump_loc ppf e.Typed.exp_loc;            Location.dump_loc ppf e.Typed.exp_loc;
168            if not !quiet then            if not !quiet then
169              Format.fprintf ppf "|- %a@\n@." print_norm t;              Format.fprintf ppf "|- %a@\n@." print_norm t;
170            let v = Eval.eval Eval.Env.empty e in            let v = Eval.eval Env.empty e in
171            if not !quiet then            if not !quiet then
172              Format.fprintf ppf "=> @[%a@]@\n@." print_value v              Format.fprintf ppf "=> @[%a@]@\n@." print_value v
173        | Ast.LetDecl (p,e) when is_abstraction e -> ()        | Ast.LetDecl (p,e) when is_abstraction e -> ()
Legend:
Removed from v.420  
changed lines
  Added in v.421
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5