source: Deliverables/D2.2/8051/src/utilities/position.ml @ 486

Last change on this file since 486 was 486, checked in by ayache, 8 years ago

Deliverable D2.2

File size: 2.4 KB
Line 
1open Lexing
2
3type t =
4    {
5      start_p : Lexing.position;
6      end_p   : Lexing.position
7    }
8
9type position = t
10
11type 'a located =
12    {
13      value    : 'a;
14      position : t;
15    }
16
17let value { value = v } =
18  v
19
20let position { position = p } =
21  p
22
23let destruct p =
24  (p.value, p.position)
25
26let with_pos p v =
27  {
28    value     = v;
29    position  = p;
30  }
31
32let with_poss p1 p2 v =
33  with_pos { start_p = p1; end_p = p2 } v
34
35let map f v =
36  {
37    value     = f v.value;
38    position  = v.position;
39  }
40
41let iter f { value = v } =
42  f v
43
44let mapd f v =
45  let w1, w2 = f v.value in
46  let pos = v.position in
47    ({ value = w1; position = pos }, { value = w2; position = pos })
48
49let dummy =
50  {
51    start_p = Lexing.dummy_pos;
52    end_p   = Lexing.dummy_pos
53  }
54
55let unknown_pos v =
56  {
57    value     = v;
58    position  = dummy
59  }
60
61let start_of_position p = p.start_p
62
63let end_of_position p = p.end_p
64
65let filename_of_position p =
66  p.start_p.Lexing.pos_fname
67
68let line p =
69  p.pos_lnum
70
71let column p =
72  p.pos_cnum - p.pos_bol
73
74let characters p1 p2 =
75  (column p1, p2.pos_cnum - p1.pos_bol) (* intentionally [p1.pos_bol] *)
76
77let join x1 x2 =
78  {
79    start_p = if x1 = dummy then x2.start_p else x1.start_p;
80    end_p   = if x2 = dummy then x1.end_p else x2.end_p
81  }
82
83let lex_join x1 x2 =
84  {
85    start_p = x1;
86    end_p   = x2
87  }
88
89let join_located l1 l2 f =
90  {
91    value    = f l1.value l2.value;
92    position = join l1.position l2.position;
93  }
94
95let string_of_lex_pos p =
96  let c = p.pos_cnum - p.pos_bol in
97  (string_of_int p.pos_lnum)^":"^(string_of_int c)
98
99let string_of_pos p =
100  let filename = filename_of_position p in
101  let l = line p.start_p in
102  let c1, c2 = characters p.start_p p.end_p in
103    if filename = "" then
104      Printf.sprintf "Line %d, characters %d-%d" l c1 c2
105    else 
106      Printf.sprintf "File \"%s\", line %d, characters %d-%d" filename l c1 c2
107
108let pos_or_undef = function
109  | None -> dummy
110  | Some x -> x
111
112let cpos lexbuf =
113  {
114    start_p = Lexing.lexeme_start_p lexbuf;
115    end_p   = Lexing.lexeme_end_p   lexbuf;
116  }
117
118let with_cpos lexbuf v =
119  with_pos (cpos lexbuf) v
120
121let string_of_cpos lexbuf =
122  string_of_pos (cpos lexbuf)
123
124let joinf f t1 t2 =
125  join (f t1) (f t2)
126
127let ljoinf f =
128  List.fold_left (fun p t -> join p (f t)) dummy
129
130let join_located_list ls f =
131  {
132    value     = f (List.map (fun l -> l.value) ls);
133    position  = ljoinf (fun x -> x.position) ls
134  }
Note: See TracBrowser for help on using the repository browser.