location.ml 1.01 KB
Newer Older
1
2
3
4
type loc = int * int
exception Location of loc * exn

let noloc = (-1,-1)
5

6
7
8
let source = ref ""
let set_source s = source := s

9
10
11
12
13
14
15
16
17
18
19
20
21
22
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
23
24
25
26
27
28
29
30
31
32
33
34
35
36

let print_loc ppf (i,j) =  
  if !source = "" then
    Format.fprintf ppf "at chars %i-%i" i j
  else (
    let (l1,c1) = get_line_number !source i
    and (l2,c2) = get_line_number !source 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
  )
37

38
39
40
41
42
43
44
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 }