location change. Heptc works with menhir.
parent
91aa437264
commit
5e737d0094
@ -1,154 +1,128 @@
|
|||||||
(* Printing a location in the source program *)
|
(* Printing a location in the source program *)
|
||||||
(* taken from the source of the Caml Light 0.73 compiler *)
|
(* inspired from the source of the Caml Light 0.73 compiler *)
|
||||||
|
|
||||||
open Lexing
|
open Lexing
|
||||||
open Parsing
|
open Parsing
|
||||||
|
|
||||||
(* two important global variables: [input_name] and [input_chan] *)
|
(* two important global variables: [input_name] and [input_chan] *)
|
||||||
type location =
|
type location =
|
||||||
Loc of int (* Position of the first character *)
|
Loc of position (* Position of the first character *)
|
||||||
* int (* Position of the next character following the last one *)
|
* position (* Position of the next character following the last one *)
|
||||||
|
|
||||||
|
|
||||||
let input_name = ref "" (* Input file name. *)
|
let input_name = ref "" (* Input file name. *)
|
||||||
|
|
||||||
let input_chan = ref stdin (* The channel opened on the input. *)
|
let input_chan = ref stdin (* The channel opened on the input. *)
|
||||||
|
|
||||||
let initialize iname ic =
|
let initialize iname ic =
|
||||||
input_name := iname;
|
input_name := iname;
|
||||||
input_chan := ic
|
input_chan := ic
|
||||||
|
|
||||||
|
|
||||||
let no_location = Loc(0,0)
|
let no_location = Loc (dummy_pos, dummy_pos)
|
||||||
|
|
||||||
|
|
||||||
let error_prompt = ">"
|
let error_prompt = ">"
|
||||||
|
|
||||||
let current_loc () =
|
|
||||||
Loc(symbol_start(), symbol_end())
|
|
||||||
|
|
||||||
|
(** Prints [n] times char [c] on [oc]. *)
|
||||||
|
let prints_n_chars oc n c = for i = 1 to n do output_char oc c done
|
||||||
|
|
||||||
let output_lines oc char1 char2 charline1 line1 line2 =
|
(** Prints out to [oc] a line designed to be printed under [line] from file [ic]
|
||||||
let n1 = char1 - charline1
|
underlining from char [first] to char [last] with char [ch].
|
||||||
and n2 = char2 - charline1 in
|
[line] is the index of the first char of line. *)
|
||||||
if line2 > line1 then
|
let underline_line ic oc ch line first last =
|
||||||
Printf.fprintf oc
|
let c = ref ' '
|
||||||
", line %d-%d, characters %d-%d:\n" line1 line2 n1 n2
|
and f = ref first
|
||||||
else
|
and l = ref (last-first) in
|
||||||
Printf.fprintf oc ", line %d, characters %d-%d:\n" line1 n1 n2;
|
( try
|
||||||
()
|
seek_in ic line;
|
||||||
|
output_string oc error_prompt;
|
||||||
|
while c := input_char ic; !c != '\n' do
|
||||||
let output_loc oc input seek line_flag (Loc(pos1, pos2)) =
|
if !f > 0 then begin
|
||||||
let pr_chars n c =
|
f := !f - 1;
|
||||||
for i = 1 to n do output_char oc c done in
|
output_char oc (if !c == '\t' then !c else ' ')
|
||||||
let skip_line () =
|
end
|
||||||
try
|
else if !l > 0 then begin
|
||||||
while input() != '\n' do () done
|
l := !l - 1;
|
||||||
with End_of_file -> () in
|
output_char oc (if !c == '\t' then !c else ch)
|
||||||
let copy_line () =
|
end
|
||||||
let c = ref ' ' in
|
else ()
|
||||||
begin try
|
|
||||||
while c := input(); !c != '\n' do output_char oc !c done
|
|
||||||
with End_of_file ->
|
|
||||||
output_string oc "<EOF>"
|
|
||||||
end;
|
|
||||||
output_char oc '\n' in
|
|
||||||
let pr_line first len ch =
|
|
||||||
let c = ref ' '
|
|
||||||
and f = ref first
|
|
||||||
and l = ref len in
|
|
||||||
try
|
|
||||||
while c := input (); !c != '\n' do
|
|
||||||
if !f > 0 then begin
|
|
||||||
f := !f - 1;
|
|
||||||
output_char oc (if !c == '\t' then !c else ' ')
|
|
||||||
end
|
|
||||||
else if !l > 0 then begin
|
|
||||||
l := !l - 1;
|
|
||||||
output_char oc (if !c == '\t' then !c else ch)
|
|
||||||
end
|
|
||||||
else ()
|
|
||||||
done
|
|
||||||
with End_of_file ->
|
|
||||||
if !f = 0 && !l > 0 then pr_chars 5 ch in
|
|
||||||
let pos = ref 0
|
|
||||||
and line1 = ref 1
|
|
||||||
and line1_pos = ref 0
|
|
||||||
and line2 = ref 1
|
|
||||||
and line2_pos = ref 0 in
|
|
||||||
seek 0;
|
|
||||||
begin try
|
|
||||||
while !pos < pos1 do
|
|
||||||
incr pos;
|
|
||||||
if input() == '\n' then begin incr line1; line1_pos := !pos; () end
|
|
||||||
done
|
done
|
||||||
with End_of_file -> ()
|
with End_of_file ->
|
||||||
end;
|
if !f = 0 && !l > 0 then prints_n_chars oc 5 ch )
|
||||||
line2 := !line1;
|
|
||||||
line2_pos := !line1_pos;
|
|
||||||
begin try
|
let copy_lines nl ic oc prompt =
|
||||||
while !pos < pos2 do
|
for i = 1 to nl do
|
||||||
incr pos;
|
output_string oc prompt;
|
||||||
if input() == '\n' then
|
(try output_string oc (input_line ic)
|
||||||
begin incr line2; line2_pos := !pos; () end
|
with End_of_file -> output_string oc "<EOF>");
|
||||||
|
output_char oc '\n'
|
||||||
|
done
|
||||||
|
|
||||||
|
let copy_chunk p1 p2 ic oc =
|
||||||
|
try for i = p1 to p2 - 1 do output_char oc (input_char ic) done
|
||||||
|
with End_of_file -> output_string oc "<EOF>"
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
let skip_lines n ic =
|
||||||
|
try for i = 1 to n do
|
||||||
|
let _ = input_line ic in ()
|
||||||
done
|
done
|
||||||
with End_of_file -> ()
|
with End_of_file -> ()
|
||||||
end;
|
|
||||||
if line_flag then output_lines oc pos1 pos2 !line1_pos !line1 !line2;
|
|
||||||
if !line1 == !line2 then begin
|
|
||||||
seek !line1_pos;
|
|
||||||
output_string oc error_prompt;
|
|
||||||
copy_line ();
|
|
||||||
seek !line1_pos;
|
|
||||||
output_string oc error_prompt;
|
|
||||||
pr_line (pos1 - !line1_pos) (pos2 - pos1) '^';
|
|
||||||
output_char oc '\n'
|
|
||||||
end else begin
|
|
||||||
seek !line1_pos;
|
|
||||||
output_string oc error_prompt;
|
|
||||||
pr_line 0 (pos1 - !line1_pos) '.';
|
|
||||||
seek pos1;
|
|
||||||
copy_line();
|
|
||||||
if !line2 - !line1 <= 8 then
|
|
||||||
for i = !line1 + 1 to !line2 - 1 do
|
|
||||||
output_string oc error_prompt;
|
|
||||||
copy_line()
|
|
||||||
done
|
|
||||||
else
|
|
||||||
begin
|
|
||||||
for i = !line1 + 1 to !line1 + 3 do
|
|
||||||
output_string oc error_prompt;
|
|
||||||
copy_line()
|
|
||||||
done;
|
|
||||||
output_string oc error_prompt; output_string oc "..........\n";
|
|
||||||
for i = !line1 + 4 to !line2 - 4 do skip_line() done;
|
|
||||||
for i = !line2 - 3 to !line2 - 1 do
|
|
||||||
output_string oc error_prompt;
|
|
||||||
copy_line()
|
|
||||||
done
|
|
||||||
end;
|
|
||||||
begin try
|
|
||||||
output_string oc error_prompt;
|
|
||||||
for i = !line2_pos to pos2 - 1 do
|
|
||||||
output_char oc (input())
|
|
||||||
done;
|
|
||||||
pr_line 0 100 '.'
|
|
||||||
with End_of_file -> output_string oc "<EOF>"
|
|
||||||
end;
|
|
||||||
output_char oc '\n'
|
|
||||||
end
|
|
||||||
|
|
||||||
|
|
||||||
let output_location oc loc =
|
|
||||||
let p = pos_in !input_chan in
|
|
||||||
Printf.fprintf oc "File \"%s\"" !input_name;
|
|
||||||
output_loc
|
|
||||||
oc (fun () -> input_char !input_chan) (seek_in !input_chan) true
|
|
||||||
loc;
|
|
||||||
seek_in !input_chan p
|
|
||||||
|
|
||||||
|
let output_location oc (Loc(p1,p2)) =
|
||||||
|
let n1 = p1.pos_cnum - p1.pos_bol in (* character number *)
|
||||||
|
let n2 = p2.pos_cnum - p2.pos_bol in
|
||||||
|
let np1 = p1.pos_cnum in (* character position *)
|
||||||
|
let np2 = p2.pos_cnum in
|
||||||
|
let l1 = p1.pos_lnum in (* line number *)
|
||||||
|
let l2 = p2.pos_lnum in
|
||||||
|
let lp1 = p1.pos_bol in (* line position *)
|
||||||
|
let lp2 = p2.pos_bol in
|
||||||
|
let f1 = p1.pos_fname in (* file name *)
|
||||||
|
let f2 = p2.pos_fname in
|
||||||
|
|
||||||
|
if f1 != f2 then (* Strange case *)
|
||||||
|
Printf.fprintf oc
|
||||||
|
"File \"%s\" line %d, character %d, to file \"%s\" line %d, character %d\n"
|
||||||
|
f1 l1 n1 f2 l2 n2
|
||||||
|
|
||||||
let output_input_name oc =
|
else begin
|
||||||
Printf.fprintf oc "File \"%s\", line 1:\n" !input_name
|
if l2 > l1 then
|
||||||
|
Printf.fprintf oc
|
||||||
|
"File \"%s\", line %d-%d, characters %d-%d:\n" f1 l1 l2 n1 n2
|
||||||
|
else
|
||||||
|
Printf.fprintf oc "File \"%s\", line %d, characters %d-%d:\n" f1 l1 n1 n2;
|
||||||
|
(* Output source code *)
|
||||||
|
let ic = open_in f1 in
|
||||||
|
|
||||||
|
if l1 == l2 then (
|
||||||
|
(* Only one line : copy full line and underline *)
|
||||||
|
seek_in ic lp1;
|
||||||
|
copy_lines 1 ic oc ">";
|
||||||
|
underline_line ic oc '^' lp1 n1 n2 )
|
||||||
|
else (
|
||||||
|
underline_line ic oc '.' lp1 0 n1; (* dots until n1 *)
|
||||||
|
seek_in ic np1;
|
||||||
|
(* copy the end of the line l1 after the dots *)
|
||||||
|
copy_lines 1 ic oc "";
|
||||||
|
if l2 - l1 <= 8 then
|
||||||
|
(* copy the 6 or less middle lines *)
|
||||||
|
copy_lines (l2-l1-1) ic oc ">"
|
||||||
|
else (
|
||||||
|
(* sum up the middle lines to 6 *)
|
||||||
|
copy_lines 3 ic oc ">";
|
||||||
|
output_string oc "..........\n";
|
||||||
|
skip_lines (l2-l1-7) ic; (* skip middle lines *)
|
||||||
|
copy_lines 3 ic oc ">"
|
||||||
|
);
|
||||||
|
output_string oc ">";
|
||||||
|
copy_chunk lp2 np2 ic oc; (* copy interesting begining of l2 *)
|
||||||
|
);
|
||||||
|
output_char oc '\n'
|
||||||
|
end;
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue