000001| (** Operations for error reporting *)
000002|
000003| (* calc_pos : Lexing.position -> int * int *)
000004| let calc_pos pos =
000005| (*[0]*)let line = pos.Lexing.pos_lnum in
000006| (*[0]*)let column = pos.Lexing.pos_cnum - pos.Lexing.pos_bol in
000007| ((*[0]*)line,column)
000008|
000009| (* pos_to_string : Lexing.position -> string *)
000010| let pos_to_string pos =
000011| (*[0]*)let fname = pos.Lexing.pos_fname in
000012| (*[0]*)let line,col = calc_pos pos in
000013| (*[0]*)fname ^ ":" ^ (string_of_int line) ^ ":" ^ (string_of_int col) ^ ":"
000014|
000015| (* print_col_mark : Lexing.position -> string -> unit *)
000016| let print_col_mark pos line =
000017| (*[0]*)let rec print_col i col =
000018| (*[0]*)if i > col
000019| then (*[0]*)print_string "^"
000020| else
000021| (*[0]*)begin
000022| (match line.[i] with
000023| | '\t' -> (*[0]*)print_char '\t'
000024| | _ -> (*[0]*)print_char ' ');
000025| (*[0]*)print_col (i+1) col
000026| end
000027| in
000028| ((*[0]*)try (*[0]*)print_col 0 (pos.Lexing.pos_cnum - pos.Lexing.pos_bol - 1)
000029| with Invalid_argument _ ->
000030| (*[0]*)print_newline ();
000031| (*[0]*)print_endline
000032| "Warning: attempt to print invalid Lexing.position: column index out of bounds")
000033|
000034| (* get_line : Lexing.position -> string *)
000035| let rec get_line pos =
000036| (*[0]*)let inch = open_in pos.Lexing.pos_fname in
000037| (*[0]*)let rec read_line i = match i with
000038| | 1 -> (*[0]*)input_line inch; (* Note: may raise 'End_of_file' *)
000039| | n -> (*[0]*)let _ = input_line inch in
000040| (*[0]*)read_line (i-1) in
000041| (*[0]*)let line = read_line pos.Lexing.pos_lnum in
000042| (*[0]*)begin
000043| (*[0]*)close_in inch;
000044| (*[0]*)line
000045| end
000046|
000047| (* error : string -> string -> 'a *)
000048| let error msg1 msg2 pos =
000049| (*[0]*)if pos = Lexing.dummy_pos
000050| then
000051| (*[0]*)begin
000052| (*[0]*)List.iter print_string [msg1; ", "; msg2; "\n\n"];
000053| (*[0]*)exit 1
000054| end
000055| else
000056| (*[0]*)if pos.Lexing.pos_fname = ""
000057| then
000058| (*[0]*)begin
000059| (*[0]*)List.iter print_string [pos_to_string pos; " "; msg1; " - "; msg2; "\n\n"];
000060| (*[0]*)exit 1
000061| end
000062| else
000063| (*[0]*)begin
000064| (*[0]*)List.iter print_string [pos_to_string pos; " "; msg1; " - "; msg2; "\n\n"];
000065| ((*[0]*)try
000066| (*[0]*)let line = get_line pos in
000067| (*[0]*)print_endline line;
000068| (*[0]*)print_col_mark pos line;
000069| (*[0]*)print_newline ();
000070| (*[0]*)exit 1
000071| with
000072| | End_of_file ->
000073| (*[0]*)print_endline "Unexpected end of file";
000074| (*[0]*)exit 1)
000075| end