blob: 1837584a86e262f666bcbd67e008108136c0fc44 (
plain) (
blame)
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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
(* Printing a location in the source program *)
(* inspired from the source of the Caml Light 0.73 compiler *)
open Lexing
open Parsing
open Format
(* two important global variables: [input_name] and [input_chan] *)
type location =
Loc of position (* Position of the first character *)
* position (* Position of the next character following the last one *)
let input_name = ref "" (* Input file name. *)
let input_chan = ref stdin (* The channel opened on the input. *)
let initialize iname ic =
input_name := iname;
input_chan := ic
let no_location = Loc (dummy_pos, dummy_pos)
let error_prompt = ">"
(** Prints [n] times char [c] on [oc]. *)
let prints_n_chars ff n c = for i = 1 to n do pp_print_char ff c done
(** Prints out to [oc] a line designed to be printed under [line] from file [ic]
underlining from char [first] to char [last] with char [ch].
[line] is the index of the first char of line. *)
let underline_line ic ff ch line first last =
let c = ref ' '
and f = ref first
and l = ref (last-first) in
( try
seek_in ic line;
pp_print_string ff error_prompt;
while c := input_char ic; !c != '\n' do
if !f > 0 then begin
f := !f - 1;
pp_print_char ff (if !c == '\t' then !c else ' ')
end
else if !l > 0 then begin
l := !l - 1;
pp_print_char ff (if !c == '\t' then !c else ch)
end
else ()
done
with End_of_file ->
if !f = 0 && !l > 0 then prints_n_chars ff 5 ch )
let copy_lines nl ic ff prompt =
for i = 1 to nl do
pp_print_string ff prompt;
(try pp_print_string ff (input_line ic)
with End_of_file -> pp_print_string ff "<EOF>");
fprintf ff "@\n"
done
let copy_chunk p1 p2 ic ff =
try for i = p1 to p2 - 1 do pp_print_char ff (input_char ic) done
with End_of_file -> pp_print_string ff "<EOF>"
let skip_lines n ic =
try for i = 1 to n do
let _ = input_line ic in ()
done
with End_of_file -> ()
let print_location ff (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 *)
fprintf ff
"File \"%s\" line %d, character %d, to file \"%s\" line %d, character %d@."
f1 l1 n1 f2 l2 n2
else begin (* Same file *)
if l2 > l1 then
fprintf ff
"File \"%s\", line %d-%d, characters %d-%d:@\n" f1 l1 l2 n1 n2
else
fprintf ff "File \"%s\", line %d, characters %d-%d:@\n" f1 l1 n1 n2;
(* Output source code *)
try
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 ff ">";
underline_line ic ff '^' lp1 n1 n2 )
else (
underline_line ic ff '.' lp1 0 n1; (* dots until n1 *)
seek_in ic np1;
(* copy the end of the line l1 after the dots *)
copy_lines 1 ic ff "";
if l2 - l1 <= 8 then
(* copy the 6 or less middle lines *)
copy_lines (l2-l1-1) ic ff ">"
else (
(* sum up the middle lines to 6 *)
copy_lines 3 ic ff ">";
fprintf ff "..........@\n";
skip_lines (l2-l1-7) ic; (* skip middle lines *)
copy_lines 3 ic ff ">"
);
fprintf ff ">";
copy_chunk lp2 np2 ic ff; (* copy interesting begining of l2 *)
)
with Sys_error _ -> ();
end;
fprintf ff "@."
|
