location.ml 1.16 KB
Newer Older
1
type loc = int * int
2
3
type source = [ `None | `File of string | `Stream | `String of string ]

4
5
6
exception Location of loc * exn

let noloc = (-1,-1)
7

8
let source = ref `None
9
10
let set_source s = source := s

11
12
13
14
15
16
17
18
19
20
21
22
23
24
let get_line_number src i =
  let ic = open_in_bin src in
  let rec aux pos line start =
    if (pos >= i) 
    then (line,i - start) 
    else
      match input_char ic with
	| '\r' when pos = start -> aux (pos + 1) line (pos + 1)
	| '\r' | '\n' -> aux (pos + 1) (line + 1) (pos + 1)
	| _ -> aux (pos + 1) line start
  in
  let r = aux 0 1 0 in
  close_in ic;
  r
25
26

let print_loc ppf (i,j) =  
27
28
29
30
31
32
33
34
35
36
37
38
39
  match !source with
    | `None -> Format.fprintf ppf "somewhere (no source defined !)"
    | `Stream | `String _ ->
	Format.fprintf ppf "at chars %i-%i" i j
    | `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)"
	    l1 c1 c2
	else
	  Format.fprintf ppf "at lines %i (char %i) - %i (char %i)"
	    l1 c1 l2 c2
40

41
42
43
44
45
46
47
type 'a located = { loc : loc; descr : 'a }

type expr = A | B of expr located

let rec recurs f x = f (recurs f) x.loc x.descr

let mk loc x = { loc = loc; descr = x }