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

Diff of /driver/cduce.ml

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

revision 233 by abate, Tue Jul 10 17:17:31 2007 UTC revision 798 by abate, Tue Jul 10 18:03:55 2007 UTC
# Line 1  Line 1 
1  open Location  open Location
2  open Ident  open Ident
3    
4    exception InvalidInputFilename of string
5    exception InvalidObjectFilename of string
6    
7      (* if set to false toplevel exception aren't cought. Useful for debugging with
8       * OCAMLRUNPARAM="b" *)
9    let catch_exceptions = true
10    
11    (* retuns a filename without the suffix suff if any *)
12    let prefix filename suff =
13      if Filename.check_suffix filename suff then
14        try
15          Filename.chop_extension filename
16        with Invalid_argument filename -> failwith "Not a point in the suffix?"
17      else filename
18    
19  let quiet = ref false  let quiet = ref false
20    let toplevel = ref false
21    
22    let typing_env = State.ref "Cduce.typing_env" Builtin.env
23    let eval_env = State.ref "Cduce.eval_env" Eval.empty
24    let compile_env = State.ref "Cduce.compile_env" Compile.empty
25    
26    let do_compile = ref false
27    
28    let get_global_value v =
29      if !do_compile
30      then Eval.L.var (Compile.find v !compile_env)
31      else Eval.find_value v !eval_env
32    
33    let get_global_type v =
34      Typer.find_value v !typing_env
35    
36  let typing_env = State.ref "Cduce.typing_env" Typer.Env.empty  let enter_global_value x v t =
37  let glb_env = State.ref "Cduce.glb_env" Typer.TypeEnv.empty    typing_env := Typer.enter_value x t !typing_env;
38  let eval_env = Eval.global_env  
39      if !do_compile
40      then (compile_env := Compile.enter_global !compile_env x; Eval.L.push v)
41      else eval_env := Eval.enter_value x v !eval_env
42    
43    let rec is_abstraction = function
44      | Ast.Abstraction _ -> true
45      | Ast.LocatedExpr (_,e) -> is_abstraction e
46      | _ -> false
47    
48  let print_norm ppf d =  let print_norm ppf d =
49    Location.protect ppf    Location.protect ppf
50      (fun ppf -> Types.Print.print_descr ppf ((*Types.normalize*) d))      (fun ppf -> Types.Print.print ppf ((*Types.normalize*) d))
51    
52    let print_sample ppf s =
53      Location.protect ppf
54        (fun ppf -> Sample.print ppf s)
55    
56    let print_protect ppf s =
57      Location.protect ppf (fun ppf -> Format.fprintf ppf "%s" s)
58    
59  let print_value ppf v =  let print_value ppf v =
60    Location.protect ppf (fun ppf -> Value.print ppf v)    Location.protect ppf (fun ppf -> Value.print ppf v)
61    
62  let dump_env ppf =  let dump_value ppf x t v =
63    Format.fprintf ppf "Global types:";    Format.fprintf ppf "@[val %a : @[%a = %a@]@]@."
64    Typer.TypeEnv.iter (fun x _ -> Format.fprintf ppf " %s" x) !glb_env;      U.print (Id.value x) print_norm t print_value v
   Format.fprintf ppf ".@\n";  
   Eval.Env.iter  
     (fun x v ->  
        let t = Typer.Env.find x !typing_env in  
        Format.fprintf ppf "@[|- %s : %a@ => %a@]@\n"  
          (Id.value x)  
          print_norm t  
          print_value v  
     )  
     !eval_env  
65    
66    let dump_env ppf =
67      Format.fprintf ppf "Types:%a@." Typer.dump_types !typing_env;
68      Format.fprintf ppf "Namespace prefixes:@\n%a" Typer.dump_ns !typing_env;
69      Format.fprintf ppf "Namespace prefixes used for pretty-printing:@.%t"
70        Ns.InternalPrinter.dump;
71      Format.fprintf ppf "Schemas: %s@."
72        (String.concat " " (Typer.get_schema_names ()));
73      Format.fprintf ppf "Values:@.";
74      Typer.iter_values !typing_env
75        (fun x t -> dump_value ppf x t (get_global_value x))
76    
77    let directive_help ppf =
78      Format.fprintf ppf
79    "Toplevel directives:
80      #quit;;                 quit the interpreter
81      #env;;                  dump current environment
82      #reinit_ns;;            reinitialize namespace processing
83      #help;;                 shows this help message
84      #dump_value <expr>;;    dump an XML-ish representation of the resulting
85                              value of a given expression
86      #print_schema <name>;;
87      #print_type <name>;;
88    "
89    
90  let rec print_exn ppf = function  let rec print_exn ppf = function
91    | Location (loc, exn) ->    | Location (loc, w, exn) ->
92        Format.fprintf ppf "Error %a:@\n" Location.print_loc loc;        Format.fprintf ppf "Error %a:@." Location.print_loc (loc,w);
93        Format.fprintf ppf "%a" Location.html_hilight loc;        Format.fprintf ppf "%a" Location.html_hilight (loc,w);
94        print_exn ppf exn        print_exn ppf exn
95    | Value.CDuceExn v ->    | Value.CDuceExn v ->
96        Format.fprintf ppf "Uncaught CDuce exception: @[%a@]@\n"        Format.fprintf ppf "Uncaught CDuce exception: @[%a@]@."
97          print_value v          print_value v
98    | Typer.WrongLabel (t,l) ->    | Typer.WrongLabel (t,l) ->
99        Format.fprintf ppf "Wrong record selection: the label %s@\n"        Format.fprintf ppf "Wrong record selection; field %a "
100          (LabelPool.value l);          Label.print (LabelPool.value l);
101        Format.fprintf ppf "applied to an expression of type %a@\n"        Format.fprintf ppf "not present in an expression of type:@.%a@."
102          print_norm t          print_norm t
103    | Typer.ShouldHave (t,msg) ->    | Typer.ShouldHave (t,msg) ->
104        Format.fprintf ppf "This expression should have type %a@\n%s@\n"        Format.fprintf ppf "This expression should have type:@.%a@.%a@."
105          print_norm t          print_norm t
106          msg          print_protect msg
107    | Typer.Constraint (s,t,msg) ->    | Typer.ShouldHave2 (t1,msg,t2) ->
108        Format.fprintf ppf "This expression should have type %a@\n"        Format.fprintf ppf "This expression should have type:@.%a@.%a %a@."
109            print_norm t1
110            print_protect msg
111            print_norm t2
112      | Typer.Error s ->
113          Format.fprintf ppf "%a@." print_protect s
114      | Typer.Constraint (s,t) ->
115          Format.fprintf ppf "This expression should have type:@.%a@."
116          print_norm t;          print_norm t;
117        Format.fprintf ppf "but its infered type is: %a@\n"        Format.fprintf ppf "but its inferred type is:@.%a@."
118          print_norm s;          print_norm s;
119        Format.fprintf ppf "which is not a subtype, as shown by the value %a@\n"        Format.fprintf ppf "which is not a subtype, as shown by the sample:@.%a@."
120          Types.Sample.print (Types.Sample.get (Types.diff s t));          print_sample (Sample.get (Types.diff s t))
       Format.fprintf ppf "%s@\n" msg  
121    | Typer.NonExhaustive t ->    | Typer.NonExhaustive t ->
122        Format.fprintf ppf "This pattern matching is not exhaustive@\n";        Format.fprintf ppf "This pattern matching is not exhaustive@.";
123        Format.fprintf ppf "Residual type: %a@\n"        Format.fprintf ppf "Residual type:@.%a@."
124          print_norm t;          print_norm t;
125        Format.fprintf ppf "Sample value: %a@\n"        Format.fprintf ppf "Sample:@.%a@." print_sample (Sample.get t)
126          Types.Sample.print (Types.Sample.get t)    | Typer.UnboundId (x,tn) ->
127    | Typer.UnboundId x ->        Format.fprintf ppf "Unbound identifier %a%s@." U.print (Id.value x)
128        Format.fprintf ppf "Unbound identifier %s@\n" x          (if tn then " (it is a type name)" else "")
129    | Wlexer.Illegal_character c ->    | Ulexer.Error (i,j,s) ->
130        Format.fprintf ppf "Illegal character (%s)@\n" (Char.escaped c)        let loc = Location.loc_of_pos (i,j), `Full in
131    | Wlexer.Unterminated_comment ->        Format.fprintf ppf "Error %a:@." Location.print_loc loc;
132        Format.fprintf ppf "Comment not terminated@\n"        Format.fprintf ppf "%a%s" Location.html_hilight loc s
   | Wlexer.Unterminated_string ->  
       Format.fprintf ppf "String literal not terminated@\n"  
   | Wlexer.Unterminated_string_in_comment ->  
       Format.fprintf ppf "This comment contains an unterminated string literal@\n"  
133    | Parser.Error s | Stream.Error s ->    | Parser.Error s | Stream.Error s ->
134        Format.fprintf ppf "Parsing error: %s@\n" s        Format.fprintf ppf "Parsing error: %a@." print_protect s
135      | Librarian.InconsistentCrc id ->
136          Format.fprintf ppf "Link error:@.";
137          let name = Encodings.Utf8.to_string (Types.CompUnit.value id) in
138          Format.fprintf ppf "Inconsistent checksum (compilation unit: %s)@."
139            name
140      | Librarian.NoImplementation id ->
141          Format.fprintf ppf "Link error:@.";
142          let name = Encodings.Utf8.to_string (Types.CompUnit.value id) in
143          Format.fprintf ppf "No implementation found for compilation unit: %s@."
144            name
145      | Librarian.Loop id ->
146          Format.fprintf ppf "Compilation error:@.";
147          let name = Encodings.Utf8.to_string (Types.CompUnit.value id) in
148          Format.fprintf ppf "Loop between compilation unit (compilation unit: %s)@."
149            name
150      | InvalidInputFilename f ->
151          Format.fprintf ppf "Compilation error:@.";
152          Format.fprintf ppf "Source filename must have extension .cd@.";
153      | InvalidObjectFilename f ->
154          Format.fprintf ppf "Compilation error:@.";
155          Format.fprintf ppf "Object filename must have extension .cdo and no path@.";
156      | Librarian.InvalidObject f ->
157          Format.fprintf ppf "Invalid object file %s@." f
158      | Librarian.CannotOpen f ->
159          Format.fprintf ppf "Cannot open file %s@." f
160    | Location.Generic s ->    | Location.Generic s ->
161        Format.fprintf ppf "%s@\n" s        Format.fprintf ppf "%a@." print_protect s
162    | exn ->    | exn ->
163        raise exn  (*      raise exn *)
164  (*        Format.fprintf ppf "%a@." print_protect (Printexc.to_string exn)
165        Format.fprintf ppf "%s@\n" (Printexc.to_string exn)  
166  *)  
167    let display ppf l =
168      if not !quiet then
169        List.iter
170          (fun (x,t) -> dump_value ppf x t (get_global_value x))
171          l
172    
173    let eval ppf e =
174      let (e,t) = Typer.type_expr !typing_env e in
175    
176      if not !quiet then
177        Location.dump_loc ppf (e.Typed.exp_loc,`Full);
178    
179      let v =
180        if !do_compile then
181          let e = Compile.compile_eval !compile_env e in
182          Eval.L.expr e
183        else
184          Eval.eval !eval_env e
185      in
186      if not !quiet then
187        Format.fprintf ppf "- : @[@[%a@] =@ @[%a@]@]@."
188          print_norm t print_value v;
189      v
190    
191    let let_decl ppf p e =
192      let (tenv,decl,typs) = Typer.type_let_decl !typing_env p e in
193    
194      let () =
195        if !do_compile then
196          let (env,decl) = Compile.compile_let_decl !compile_env decl in
197          Eval.L.eval decl;
198          compile_env := env
199        else
200          eval_env := Eval.eval_let_decl !eval_env decl
201      in
202      typing_env := tenv;
203      display ppf typs
204    
205    
206    let let_funs ppf funs =
207      let (tenv,funs,typs) = Typer.type_let_funs !typing_env funs in
208    
209      let () =
210        if !do_compile then
211          let (env,funs) = Compile.compile_rec_funs !compile_env funs in
212          Eval.L.eval funs;
213          compile_env := env;
214        else
215          eval_env := Eval.eval_rec_funs !eval_env funs
216      in
217      typing_env := tenv;
218      display ppf typs
219    
220    
221  let debug ppf = function  let debug ppf = function
222    | `Subtype (t1,t2) ->    | `Subtype (t1,t2) ->
223        Format.fprintf ppf "[DEBUG:subtype]@\n";        Format.fprintf ppf "[DEBUG:subtype]@.";
224        let t1 = Types.descr (Typer.typ !glb_env t1)        let t1 = Types.descr (Typer.typ !typing_env t1)
225        and t2 = Types.descr (Typer.typ !glb_env t2) in        and t2 = Types.descr (Typer.typ !typing_env t2) in
226        Format.fprintf ppf "%a <= %a : %b@\n" print_norm t1 print_norm t2        let s = Types.subtype t1 t2 in
227          (Types.subtype t1 t2)        Format.fprintf ppf "%a %a %a : %b@." print_norm t1 print_protect "<=" print_norm t2 s
228      | `Sample t ->
229          Format.fprintf ppf "[DEBUG:sample]@.";
230          (try
231             let t = Types.descr (Typer.typ !typing_env t) in
232             Format.fprintf ppf "%a@." print_sample (Sample.get t)
233           with Not_found ->
234             Format.fprintf ppf "Empty type : no sample !@.")
235    | `Filter (t,p) ->    | `Filter (t,p) ->
236        Format.fprintf ppf "[DEBUG:filter]@\n";        Format.fprintf ppf "[DEBUG:filter]@.";
237        let t = Typer.typ !glb_env t        let t = Typer.typ !typing_env t
238        and p = Typer.pat !glb_env p in        and p = Typer.pat !typing_env p in
239        let f = Patterns.filter (Types.descr t) p in        let f = Patterns.filter (Types.descr t) p in
240        List.iter (fun (x,t) ->        List.iter (fun (x,t) ->
241                     Format.fprintf ppf " %s:%a@\n" (Id.value x)                     Format.fprintf ppf " %a:%a@." U.print (Id.value x)
242                       print_norm (Types.descr t)) f                       print_norm (Types.descr t)) f
   | `Compile2 (t,pl) ->  
       Format.fprintf ppf "[DEBUG:compile2]@\n";  
 (*      let t = Types.descr (Typer.typ !glb_env t) in  
       let pl = List.map (fun p ->  
                            let p = Typer.pat !glb_env p in  
                            let a = Types.descr (Patterns.accept p) in  
                            (Some p, Types.cap a t)) pl in  
       let d = Patterns.Compiler.make_dispatcher t pl in  
       Patterns.Compiler.print_disp ppf d *)  
       ()  
   
243    | `Accept p ->    | `Accept p ->
244        Format.fprintf ppf "[DEBUG:accept]@\n";        Format.fprintf ppf "[DEBUG:accept]@.";
245        let p = Typer.pat !glb_env p in        let p = Typer.pat !typing_env p in
246        let t = Patterns.accept p in        let t = Patterns.accept p in
247        Format.fprintf ppf " %a@\n" Types.Print.print t        Format.fprintf ppf " %a@." Types.Print.print (Types.descr t)
248    | `Compile (t,pl) ->    | `Compile (t,pl) ->
249        Format.fprintf ppf "[DEBUG:compile]@\n";        Format.fprintf ppf "[DEBUG:compile]@.";
250        let t = Typer.typ !glb_env t        let t = Typer.typ !typing_env t
251        and pl = List.map (Typer.pat !glb_env) pl in        and pl = List.map (Typer.pat !typing_env) pl in
252        Patterns.Compile.debug_compile ppf t pl        Patterns.Compile.debug_compile ppf t pl
253    | `Normal_record p -> assert false    | `Explain (t,e) ->
254          Format.fprintf ppf "[DEBUG:explain]@.";
255          let t = Typer.typ !typing_env t in
256          (match Explain.explain (Types.descr t) (eval ppf e) with
257             | Some p ->
258                 Format.fprintf ppf "Explanation: @[%a@]@."
259                   Explain.print_path p
260             | None ->
261                 Format.fprintf ppf "Explanation: value has given type@.")
262    
263    
264    let rec collect_funs ppf accu = function
265      | { descr = Ast.FunDecl e } :: rest -> collect_funs ppf (e::accu) rest
266      | rest -> let_funs ppf accu; rest
267    
268    let rec collect_types ppf accu = function
269      | { descr = Ast.TypeDecl (x,t) } :: rest ->
270          collect_types ppf ((x,t) :: accu) rest
271      | rest ->
272          typing_env :=
273            Typer.enter_types (Typer.type_defs !typing_env accu) !typing_env;
274          rest
275    
276    let flush_stdout () = Format.fprintf Format.std_formatter "@."
277    
278    let rec phrases ppf phs = match phs with
279      | { descr = Ast.FunDecl _ } :: _ ->
280          phrases ppf (collect_funs ppf [] phs)
281      | { descr = Ast.TypeDecl (_,_) } :: _ ->
282          phrases ppf (collect_types ppf [] phs)
283      | { descr = Ast.SchemaDecl (name, schema) } :: rest ->
284          Typer.register_schema name schema;
285          phrases ppf rest
286      | { descr = Ast.Namespace (pr,ns) } :: rest ->
287          typing_env := Typer.enter_ns pr ns !typing_env;
288          phrases ppf rest
289      | { descr = Ast.Using (x,cu) } :: rest ->
290          Librarian.import cu;
291          Librarian.run Value.nil cu;
292          typing_env := Typer.enter_cu x cu !typing_env;
293          phrases ppf rest
294      | { descr = Ast.EvalStatement e } :: rest ->
295          ignore (eval ppf e);
296          phrases ppf rest
297      | { descr = Ast.LetDecl (p,e) } :: rest ->
298          let_decl ppf p e;
299          phrases ppf rest
300      | { descr = Ast.Debug l } :: rest ->
301          debug ppf l;
302          phrases ppf rest
303      | { descr = Ast.Directive `Quit } :: rest ->
304          if !toplevel then raise End_of_file;
305          phrases ppf rest
306      | { descr = Ast.Directive `Env } :: rest ->
307          dump_env ppf;
308          phrases ppf rest
309      | { descr = Ast.Directive (`Print_schema schema) } :: rest ->
310          Schema_common.print_schema ppf (Typer.get_schema schema);
311          flush_stdout ();
312          phrases ppf rest
313      | { descr = Ast.Directive (`Print_type name) } :: rest ->
314          Typer.dump_type Format.std_formatter !typing_env name;
315          flush_stdout ();
316          phrases ppf rest
317      | { descr = Ast.Directive (`Print_schema_type schema_ref) } :: rest ->
318          Typer.dump_schema_type Format.std_formatter schema_ref;
319          flush_stdout ();
320          phrases ppf rest
321      | { descr = Ast.Directive `Reinit_ns } :: rest ->
322          Typer.set_ns_table_for_printer !typing_env;
323          phrases ppf rest
324      | { descr = Ast.Directive `Help } :: rest ->
325          directive_help ppf;
326          phrases ppf rest
327      | { descr = Ast.Directive (`Dump pexpr) } :: rest ->
328          Format.fprintf ppf "%a@."
329            Value.dump_xml (Eval.eval !eval_env
330              (fst (Typer.type_expr !typing_env pexpr)));
331          phrases ppf rest
332      | [] -> ()
333    
334    let catch_exn ppf_err exn =
335      if not catch_exceptions then raise exn;
336      match exn with
337      | (End_of_file | Failure _ | Not_found | Invalid_argument _ | Sys.Break)
338          as e ->
339          raise e
340      | exn ->
341          print_exn ppf_err exn;
342          Format.fprintf ppf_err "@."
343    
344  let mk_builtin () =  let parse rule input =
345    let bi = List.map (fun (n,t) -> [n, mk noloc (Ast.Internal t)])    try Parser.localize_exn (fun () -> rule input)
346               Builtin.types in    with e -> Parser.sync (); raise e
   glb_env := List.fold_left Typer.register_global_types !glb_env bi  
347    
348  let () = mk_builtin ()  let run rule ppf ppf_err input =
349      try phrases ppf (parse rule input); true
350      with exn -> catch_exn ppf_err exn; false
351    
352    let script = run Parser.prog
353    let topinput = run Parser.top_phrases
354    
355  let run ppf ppf_err input =  let compile src out_dir =
356    let insert_type_bindings =    try
357      List.iter (fun (x,t) ->      if not (Filename.check_suffix src ".cd")
358                   typing_env := Typer.Env.add x t !typing_env;      then raise (InvalidInputFilename src);
359                   if not !quiet then      let cu = Filename.chop_suffix (Filename.basename src) ".cd" in
360                     Format.fprintf ppf "|- %s : %a@\n@." (Id.value x) print_norm t)      let out_dir =
361    in        match out_dir with
362            | None -> Filename.dirname src
363    let type_decl decl =          | Some x -> x in
364      insert_type_bindings (Typer.type_let_decl !typing_env decl)      let out = Filename.concat out_dir (cu ^ ".cdo") in
365    in      let id = Types.CompUnit.mk (U.mk_latin1 cu) in
366        Librarian.compile id src;
367    let eval_decl decl =      Librarian.save id out;
368      let bindings = Eval.eval_let_decl Eval.Env.empty decl in      exit 0
369      List.iter    with exn -> catch_exn Format.err_formatter exn; exit 1
       (fun (x,v) ->  
          Eval.enter_global x v;  
          if not !quiet then  
            Format.fprintf ppf "=> %s : @[%a@]@\n@." (Id.value x) print_value v  
       ) bindings  
   in  
   
   let phrase ph =  
     match ph.descr with  
       | Ast.EvalStatement e ->  
           let (fv,e) = Typer.expr !glb_env e in  
           let t = Typer.type_check !typing_env e Types.any true in  
           Location.dump_loc ppf e.Typed.exp_loc;  
           if not !quiet then  
             Format.fprintf ppf "|- %a@\n@." print_norm t;  
           let v = Eval.eval Eval.Env.empty e in  
           if not !quiet then  
             Format.fprintf ppf "=> @[%a@]@\n@." print_value v  
       | Ast.LetDecl (p,{descr=Ast.Abstraction _}) -> ()  
       | Ast.LetDecl (p,e) ->  
           let decl = Typer.let_decl !glb_env p e in  
           type_decl decl;  
           eval_decl decl  
       | Ast.TypeDecl _ -> ()  
       | Ast.Debug l -> debug ppf l  
       | _ -> assert false  
   in  
370    
371    let do_fun_decls decls =  let compile_run src argv =
     let decls = List.map (fun (p,e) -> Typer.let_decl !glb_env p e) decls in  
     insert_type_bindings (Typer.type_rec_funs !typing_env decls);  
     List.iter eval_decl decls  
   in  
   let rec phrases funs = function  
     | { descr = Ast.LetDecl (p,({descr=Ast.Abstraction _} as e))} :: phs ->  
         phrases ((p,e)::funs) phs  
     | ph :: phs ->  
         do_fun_decls funs;  
         phrase ph;  
         phrases [] phs  
     | _ ->  
         do_fun_decls funs  
   in  
372    try    try
373      let p =      if not (Filename.check_suffix src ".cd")
374        try Parser.prog input      then raise (InvalidInputFilename src);
375        with      let cu = Filename.chop_suffix (Filename.basename src) ".cd" in
376          | Stdpp.Exc_located (_, (Location _ as e)) -> raise e      let id = Types.CompUnit.mk (U.mk_latin1 cu) in
377          | Stdpp.Exc_located (loc, e) -> raise (Location (loc, e))      Librarian.compile id src;
378      in      Librarian.run argv id
379      let (type_decls,fun_decls) =    with exn -> catch_exn Format.err_formatter exn; exit 1
       List.fold_left  
         (fun ((typs,funs) as accu) ph -> match ph.descr with  
            | Ast.TypeDecl (x,t) -> ((x,t) :: typs,funs)  
            | Ast.LetDecl (p,({descr=Ast.Abstraction _} as e)) ->  
                (typs, (p,e)::funs)  
            | _ -> accu  
         ) ([],[]) p in  
     glb_env := Typer.register_global_types !glb_env type_decls;  
     phrases [] p;  
     true  
   with  
     | (Failure _ | Not_found | Invalid_argument _) as e ->  
         raise e  (* To get ocamlrun stack trace *)  
     | exn -> print_exn ppf_err exn; false  
380    
381    let run obj argv =
382      try
383        if not (Filename.check_suffix obj ".cdo") || (Filename.basename obj <> obj)
384        then raise (InvalidObjectFilename obj);
385        let cu = Filename.chop_suffix (Filename.basename obj) ".cdo" in
386        let id = Types.CompUnit.mk (U.mk_latin1 cu) in
387        Librarian.import id;
388        Librarian.run argv id
389      with exn -> catch_exn Format.err_formatter exn; exit 1
390    

Legend:
Removed from v.233  
changed lines
  Added in v.798

CVS Admin">CVS Admin
ViewVC Help
Powered by ViewVC 1.1.5