/usr/lib/ocaml/compiler-libs/parsing/location.ml is in ocaml-compiler-libs 3.12.1-2ubuntu2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 | (***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id: location.ml 11050 2011-05-17 16:14:39Z doligez $ *)
open Lexing
type t = { loc_start: position; loc_end: position; loc_ghost: bool };;
let none = { loc_start = dummy_pos; loc_end = dummy_pos; loc_ghost = true };;
let in_file name =
let loc = {
pos_fname = name;
pos_lnum = 1;
pos_bol = 0;
pos_cnum = -1;
} in
{ loc_start = loc; loc_end = loc; loc_ghost = true }
;;
let curr lexbuf = {
loc_start = lexbuf.lex_start_p;
loc_end = lexbuf.lex_curr_p;
loc_ghost = false
};;
let init lexbuf fname =
lexbuf.lex_curr_p <- {
pos_fname = fname;
pos_lnum = 1;
pos_bol = 0;
pos_cnum = 0;
}
;;
let symbol_rloc () = {
loc_start = Parsing.symbol_start_pos ();
loc_end = Parsing.symbol_end_pos ();
loc_ghost = false;
};;
let symbol_gloc () = {
loc_start = Parsing.symbol_start_pos ();
loc_end = Parsing.symbol_end_pos ();
loc_ghost = true;
};;
let rhs_loc n = {
loc_start = Parsing.rhs_start_pos n;
loc_end = Parsing.rhs_end_pos n;
loc_ghost = false;
};;
let input_name = ref "_none_"
let input_lexbuf = ref (None : lexbuf option)
(* Terminal info *)
let status = ref Terminfo.Uninitialised
let num_loc_lines = ref 0 (* number of lines already printed after input *)
(* Highlight the locations using standout mode. *)
let highlight_terminfo ppf num_lines lb loc1 loc2 =
Format.pp_print_flush ppf (); (* avoid mixing Format and normal output *)
(* Char 0 is at offset -lb.lex_abs_pos in lb.lex_buffer. *)
let pos0 = -lb.lex_abs_pos in
(* Do nothing if the buffer does not contain the whole phrase. *)
if pos0 < 0 then raise Exit;
(* Count number of lines in phrase *)
let lines = ref !num_loc_lines in
for i = pos0 to lb.lex_buffer_len - 1 do
if lb.lex_buffer.[i] = '\n' then incr lines
done;
(* If too many lines, give up *)
if !lines >= num_lines - 2 then raise Exit;
(* Move cursor up that number of lines *)
flush stdout; Terminfo.backup !lines;
(* Print the input, switching to standout for the location *)
let bol = ref false in
print_string "# ";
for pos = 0 to lb.lex_buffer_len - pos0 - 1 do
if !bol then (print_string " "; bol := false);
if pos = loc1.loc_start.pos_cnum || pos = loc2.loc_start.pos_cnum then
Terminfo.standout true;
if pos = loc1.loc_end.pos_cnum || pos = loc2.loc_end.pos_cnum then
Terminfo.standout false;
let c = lb.lex_buffer.[pos + pos0] in
print_char c;
bol := (c = '\n')
done;
(* Make sure standout mode is over *)
Terminfo.standout false;
(* Position cursor back to original location *)
Terminfo.resume !num_loc_lines;
flush stdout
(* Highlight the location by printing it again. *)
let highlight_dumb ppf lb loc =
(* Char 0 is at offset -lb.lex_abs_pos in lb.lex_buffer. *)
let pos0 = -lb.lex_abs_pos in
(* Do nothing if the buffer does not contain the whole phrase. *)
if pos0 < 0 then raise Exit;
let end_pos = lb.lex_buffer_len - pos0 - 1 in
(* Determine line numbers for the start and end points *)
let line_start = ref 0 and line_end = ref 0 in
for pos = 0 to end_pos do
if lb.lex_buffer.[pos + pos0] = '\n' then begin
if loc.loc_start.pos_cnum > pos then incr line_start;
if loc.loc_end.pos_cnum > pos then incr line_end;
end
done;
(* Print character location (useful for Emacs) *)
Format.fprintf ppf "Characters %i-%i:@."
loc.loc_start.pos_cnum loc.loc_end.pos_cnum;
(* Print the input, underlining the location *)
Format.pp_print_string ppf " ";
let line = ref 0 in
let pos_at_bol = ref 0 in
for pos = 0 to end_pos do
let c = lb.lex_buffer.[pos + pos0] in
if c <> '\n' then begin
if !line = !line_start && !line = !line_end then
(* loc is on one line: print whole line *)
Format.pp_print_char ppf c
else if !line = !line_start then
(* first line of multiline loc: print ... before loc_start *)
if pos < loc.loc_start.pos_cnum
then Format.pp_print_char ppf '.'
else Format.pp_print_char ppf c
else if !line = !line_end then
(* last line of multiline loc: print ... after loc_end *)
if pos < loc.loc_end.pos_cnum
then Format.pp_print_char ppf c
else Format.pp_print_char ppf '.'
else if !line > !line_start && !line < !line_end then
(* intermediate line of multiline loc: print whole line *)
Format.pp_print_char ppf c
end else begin
if !line = !line_start && !line = !line_end then begin
(* loc is on one line: underline location *)
Format.fprintf ppf "@. ";
for i = !pos_at_bol to loc.loc_start.pos_cnum - 1 do
Format.pp_print_char ppf ' '
done;
for i = loc.loc_start.pos_cnum to loc.loc_end.pos_cnum - 1 do
Format.pp_print_char ppf '^'
done
end;
if !line >= !line_start && !line <= !line_end then begin
Format.fprintf ppf "@.";
if pos < loc.loc_end.pos_cnum then Format.pp_print_string ppf " "
end;
incr line;
pos_at_bol := pos + 1;
end
done
(* Highlight the location using one of the supported modes. *)
let rec highlight_locations ppf loc1 loc2 =
match !status with
Terminfo.Uninitialised ->
status := Terminfo.setup stdout; highlight_locations ppf loc1 loc2
| Terminfo.Bad_term ->
begin match !input_lexbuf with
None -> false
| Some lb ->
let norepeat =
try Sys.getenv "TERM" = "norepeat" with Not_found -> false in
if norepeat then false else
try highlight_dumb ppf lb loc1; true
with Exit -> false
end
| Terminfo.Good_term num_lines ->
begin match !input_lexbuf with
None -> false
| Some lb ->
try highlight_terminfo ppf num_lines lb loc1 loc2; true
with Exit -> false
end
(* Print the location in some way or another *)
open Format
let reset () =
num_loc_lines := 0
let (msg_file, msg_line, msg_chars, msg_to, msg_colon, msg_head) =
("File \"", "\", line ", ", characters ", "-", ":", "")
(* return file, line, char from the given position *)
let get_pos_info pos =
let (filename, linenum, linebeg) =
if pos.pos_fname = "" && !input_name = "" then
("", -1, 0)
else if pos.pos_fname = "" then
Linenum.for_position !input_name pos.pos_cnum
else
(pos.pos_fname, pos.pos_lnum, pos.pos_bol)
in
(filename, linenum, pos.pos_cnum - linebeg)
;;
let print ppf loc =
let (file, line, startchar) = get_pos_info loc.loc_start in
let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum + startchar in
let (startchar, endchar) =
if startchar < 0 then (0, 1) else (startchar, endchar)
in
if file = "" then begin
if highlight_locations ppf loc none then () else
fprintf ppf "Characters %i-%i:@."
loc.loc_start.pos_cnum loc.loc_end.pos_cnum
end else begin
fprintf ppf "%s%s%s%i" msg_file file msg_line line;
fprintf ppf "%s%i" msg_chars startchar;
fprintf ppf "%s%i%s@.%s" msg_to endchar msg_colon msg_head;
end
;;
let print_error ppf loc =
print ppf loc;
fprintf ppf "Error: ";
;;
let print_error_cur_file ppf = print_error ppf (in_file !input_name);;
let print_warning loc ppf w =
if Warnings.is_active w then begin
let printw ppf w =
let n = Warnings.print ppf w in
num_loc_lines := !num_loc_lines + n
in
fprintf ppf "%a" print loc;
fprintf ppf "Warning %a@." printw w;
pp_print_flush ppf ();
incr num_loc_lines;
end
;;
let prerr_warning loc w = print_warning loc err_formatter w;;
let echo_eof () =
print_newline ();
incr num_loc_lines
|