Commit 862a0081 authored by Pietro Abate's avatar Pietro Abate

[r2005-07-30 09:27:30 by afrisch] New printer for locations

Original author: afrisch
Date: 2005-07-30 09:27:30+00:00
parent 4b36bdb3
......@@ -79,7 +79,7 @@ let directive_help ppf =
let rec print_exn ppf = function
| Location (loc, w, exn) ->
Format.fprintf ppf "Error %a:@." Location.print_loc (loc,w);
Location.print_loc ppf (loc,w);
Location.html_hilight (loc,w);
print_exn ppf exn
| Value.CDuceExn v ->
......@@ -122,7 +122,7 @@ let rec print_exn ppf = function
Ident.print x
| Ulexer.Error (i,j,s) ->
let loc = Location.loc_of_pos (i,j), `Full in
Format.fprintf ppf "Error %a:@." Location.print_loc loc;
Location.print_loc ppf loc;
Location.html_hilight loc;
Format.fprintf ppf "%s" s
| Parser.Error s | Stream.Error s ->
......
......@@ -88,9 +88,9 @@ let compile verbose name src =
let p =
try Parser.prog input
with
| Stdpp.Exc_located (_, (Location _ as e)) -> raise e
| Stdpp.Exc_located (_, (Location _ | Ulexer.Error _ as e)) -> raise e
| Stdpp.Exc_located ((i,j), e) ->
raise_loc i.Lexing.pos_cnum j.Lexing.pos_cnum e
raise_loc i.Lexing.pos_cnum j.Lexing.pos_cnum e
in
if src <> "" then close_in ic;
......
......@@ -121,12 +121,14 @@ let toploop () =
Sys.catch_break true;
Cduce.toplevel := true;
Librarian.run_loaded := true;
Location.push_source `Stream;
let read i =
let buf_in = Buffer.create 1024 in
Location.push_source (`Buffer buf_in);
let read _i =
if !bol then
if !Ulexer.in_comment then outflush "* " else outflush "> ";
try
let c = input_char stdin in
Buffer.add_char buf_in c;
bol := c = '\n';
Some c
with Sys.Break -> quit ()
......@@ -135,6 +137,7 @@ let toploop () =
let rec loop () =
outflush "# ";
bol := false;
Buffer.clear buf_in;
ignore (Cduce.topinput ppf ppf_err input);
while (input_char stdin != '\n') do () done;
loop () in
......
(* TODO: handle encodings of the input for pretty printing
fragments of code *)
type source = [ `None | `File of string | `Stream | `String of string ]
type source = [ `None | `File of string | `Stream | `String of string
| `Buffer of Buffer.t ]
type loc = source * int * int
type precise = [ `Full | `Char of int ]
......@@ -43,13 +44,10 @@ let get_viewport () = !viewport
The clean solution is probably to have the real lexer
count the lines. *)
let get_line_number src i =
let enc = ref Ulexing.Latin1 in
let ic = open_in_bin src in
let lb = Ulexing.from_var_enc_channel enc ic in
let get_line_start enc lb i =
let rec count line start = lexer
| '\n' | "\n\r" | '\r' ->
if (Ulexing.lexeme_start lb >= i) then (line, i - start)
if (Ulexing.lexeme_start lb >= i) then (line, start)
else
aux (line + 1) (Ulexing.lexeme_end lb)
| "#utf8" ->
......@@ -62,35 +60,49 @@ let get_line_number src i =
enc := Ulexing.Latin1;
aux line start
| eof ->
(line, i - start)
(line, start)
| _ ->
aux line start
and aux line start =
if (Ulexing.lexeme_start lb >= i) then (line, i - start)
if (Ulexing.lexeme_start lb >= i) then (line, start)
else count line start lb
in
let r = aux 1 0 in
aux 1 0
let get_line_number src i =
let enc = ref Ulexing.Latin1 in
let ic = open_in_bin src in
let lb = Ulexing.from_var_enc_channel enc ic in
let r = get_line_start enc lb i in
close_in ic;
r
let get_line_number_str src i =
let enc = ref Ulexing.Latin1 in
let lb = Ulexing.from_var_enc_string enc src in
get_line_start enc lb i
let print_precise ppf = function
| `Full -> ()
| `Char i -> Format.fprintf ppf " (char # %i)" i
| `Char i -> Format.fprintf ppf "Char %i of the string:@\n" i
let print_loc ppf ((src,i,j),w) =
match src with
| `None -> Format.fprintf ppf "somewhere (no source defined !)"
| `None -> () (*Format.fprintf ppf "somewhere (no source defined !)"*)
| `Stream | `String _ ->
Format.fprintf ppf "at chars %i-%i%a" i j print_precise w
Format.fprintf ppf "At chars %i-%i:@\n%a" i j print_precise w
| `Buffer b ->
let b = Buffer.contents b in
let (l1,start1) = get_line_number_str b i in
Format.fprintf ppf "Line %i, characters %i-%i:@\n%a"
l1 (i - start1) (j - start1)
print_precise w
| `File fn ->
let (l1,c1) = get_line_number fn i
and (l2,c2) = get_line_number fn j in
if l1 = l2 then
Format.fprintf ppf "at line %i (chars %i-%i)%a, file %s"
l1 c1 c2 print_precise w fn
else
Format.fprintf ppf "at lines %i (char %i) - %i (char %i)%a, file %s"
l1 c1 l2 c2 print_precise w fn
let (l1,start1) = get_line_number fn i in
Format.fprintf ppf "File \"%s\", line %i, characters %i-%i:@\n%a"
fn l1 (i - start1) (j - start1)
print_precise w
let extr s i j =
try
......
(* Locations in source file,
and presentation of results and errors *)
type source = [ `None | `File of string | `Stream | `String of string ]
type source =
[ `None | `File of string | `Stream | `String of string
| `Buffer of Buffer.t ]
type loc = source * int * int
type precise = [ `Full | `Char of int ]
exception Location of loc * precise * exn
exception Generic of string
val noloc:loc
val nopos:int * int
......
......@@ -11,9 +11,9 @@ let (>) (x:int) y = x > y
let warning loc msg =
let v = Location.get_viewport () in
let ppf = if Html.is_html v then Html.ppf v else Format.err_formatter in
Format.fprintf ppf "Warning %a:@\n" Location.print_loc (loc,`Full);
Location.print_loc ppf (loc,`Full);
Location.html_hilight (loc,`Full);
Format.fprintf ppf "%s@." msg
Format.fprintf ppf "Warning: %s@." msg
exception NonExhaustive of Types.descr
exception Constraint of Types.descr * Types.descr
......
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