Commit 8f409a1f authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2002-11-09 18:43:47 by cvscast] Empty log message

Original author: cvscast
Date: 2002-11-09 18:43:48+00:00
parent bd9892a7
open Location
let print_norm ppf d =
Types.Print.print_descr ppf ((*Types.normalize*) d)
Location.protect ppf
(fun ppf -> Types.Print.print_descr ppf ((*Types.normalize*) d))
let print_value ppf v =
Location.protect ppf (fun ppf -> Value.print ppf v)
let rec print_exn ppf = function
| Location (loc, exn) ->
Format.fprintf ppf "Error %a:@\n" Location.print_loc loc;
Format.pp_print_flush ppf ();
Format.fprintf (Location.output ()) "%a" Location.html_hilight loc;
Format.fprintf ppf "%a" Location.html_hilight loc;
print_exn ppf exn
| Value.CDuceExn v ->
Format.fprintf ppf "Uncaught CDuce exception: @[%a@]@\n"
Value.print v
print_value v
| Typer.WrongLabel (t,l) ->
Format.fprintf ppf "Wrong record selection: the label %s@\n"
(Types.LabelPool.value l);
......@@ -149,7 +152,7 @@ let run ppf input =
List.iter
(fun (x,v) ->
Eval.enter_global x v;
Format.fprintf ppf "=> %s : @[%a@]@\n@." x Value.print v
Format.fprintf ppf "=> %s : @[%a@]@\n@." x print_value v
) bindings
in
......@@ -161,7 +164,7 @@ let run ppf input =
Location.dump_loc (Location.output ()) e.Typed.exp_loc;
Format.fprintf ppf "|- %a@\n@." print_norm t;
let v = Eval.eval !eval_env e in
Format.fprintf ppf "=> @[%a@]@\n@." Value.print v
Format.fprintf ppf "=> @[%a@]@\n@." print_value v
| Ast.LetDecl (p,{descr=Ast.Abstraction _}) -> ()
| Ast.LetDecl (p,e) ->
let decl = Typer.let_decl p e in
......
......@@ -13,7 +13,7 @@ let main (cgi : Netcgi.std_activation) =
Location.set_output ppf;
Load_xml.set_auth false;
Cduce.run (Location.protect ppf) input;
Cduce.run ppf input;
let res = Format.flush_str_formatter () in
cgi # output # output_string ("\
......
......@@ -67,7 +67,7 @@ let html_hilight ppf (i,j) =
let i0 = beg_of_line s i in
let j0 = end_of_line s j in
Format.fprintf ppf
"<i>%s<font color=red><b>%s</b></font>%s</div></i>@\n"
"<i>%s<font color=red><b>%s</b></font>%s</i>@."
(extr s i0 i)
(extr s i j)
(extr s j j0)
......@@ -81,13 +81,17 @@ type expr = A | B of expr located
let mk loc x = { loc = loc; descr = x }
let protect ppf =
let protect ppf f =
match !viewport with
| `Html ->
Format.make_formatter
(fun s i j -> Format.pp_print_string ppf (extr s i (i+j)))
(fun () -> Format.pp_print_flush ppf ())
| _ -> ppf
let b = Buffer.create 63 in
let ppf' = Format.formatter_of_buffer b in
f ppf';
Format.pp_print_flush ppf' ();
let s = Buffer.contents b in
let s = Netencoding.Html.encode_from_latin1 s in
Format.pp_print_string ppf s
| _ -> f ppf
let outputr = ref Format.std_formatter
let output () = !outputr
......
......@@ -15,7 +15,7 @@ val set_viewport: viewport -> unit
val set_output: Format.formatter -> unit
val output: unit -> Format.formatter
val protect: Format.formatter -> Format.formatter
val protect: Format.formatter -> (Format.formatter -> unit) -> unit
val print_loc: Format.formatter -> loc -> unit
val dump_loc: Format.formatter -> loc -> unit
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment