cduce.ml 1.22 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
open Location

let input = Stream.of_channel stdin
let ppf = Format.std_formatter
let prog () = 
  try Parser.prog input
  with
    | Stdpp.Exc_located (loc, e) -> 
        raise (Location (loc, e))

let rec print_exn ppf = function
  | Location ((i,j), exn) ->
      Format.fprintf ppf "Error at chars %i-%i@\n" i j;
      print_exn ppf exn
  | Typer.Constraint (s,t,msg) ->
      Format.fprintf ppf "%s@\n" msg;
      Format.fprintf ppf "%a is not a subtype of %a@\n" 
	Types.Print.print_descr s 
	Types.Print.print_descr t;
      Format.fprintf ppf "as shown by %a@\n" 
	Types.Print.print_sample (Types.Sample.get (Types.diff s t))
  | exn ->
      Format.fprintf ppf "%s@\n" (Printexc.to_string exn)

let phrase ph =
  match ph.descr with
    | Ast.EvalStatement e ->
	let (fv,e) = Typer.expr e in
	let t = Typer.compute_type Typer.Env.empty e in
	Format.fprintf ppf "%a@\n" Types.Print.print_descr t;
31
    | Ast.TypeDecl _ -> ()
32 33 34
    | _ -> assert false

let () = 
35 36 37 38 39 40 41 42 43 44
  try 
    let p = prog () in
    let type_decls = 
      List.fold_left
	(fun accu ph -> match ph.descr with
	   | Ast.TypeDecl (x,t) -> (x,t) :: accu
	   | _ -> accu
	) [] p in
    Typer.register_global_types type_decls;
    List.iter phrase p
45 46
  with exn -> print_exn ppf exn