positions.ml 3.68 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13
(******************************************************************************)
(*                                                                            *)
(*                                   Menhir                                   *)
(*                                                                            *)
(*                       François Pottier, Inria Paris                        *)
(*              Yann Régis-Gianas, PPS, Université Paris Diderot              *)
(*                                                                            *)
(*  Copyright Inria. All rights reserved. This file is distributed under the  *)
(*  terms of the GNU General Public License version 2, as described in the    *)
(*  file LICENSE.                                                             *)
(*                                                                            *)
(******************************************************************************)

14 15
open Lexing

16
type t =
17 18
  (* Start and end positions. *)
  position * position
19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38

type 'a located =
    {
      value    : 'a;
      position : t;
    }

let value { value = v } =
  v

let position { position = p } =
  p

let with_pos p v =
  {
    value     = v;
    position  = p;
  }

let with_poss p1 p2 v =
39
  with_pos (p1, p2) v
40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55

let map f v =
  {
    value     = f v.value;
    position  = v.position;
  }

let iter f { value = v } =
  f v

let mapd f v =
  let w1, w2 = f v.value in
  let pos = v.position in
  { value = w1; position = pos },
  { value = w2; position = pos }

56
let dummy =
57
  (dummy_pos, dummy_pos)
58

59
let unknown_pos v =
60 61 62 63 64
  {
    value     = v;
    position  = dummy
  }

65
let start_of_position (p, _) = p
66

67
let end_of_position (_, p) = p
68

69
let filename_of_position p =
70
  (start_of_position p).pos_fname
71 72 73 74 75 76 77 78 79 80 81

let line p =
  p.pos_lnum

let column p =
  p.pos_cnum - p.pos_bol

let characters p1 p2 =
  (column p1, p2.pos_cnum - p1.pos_bol) (* intentionally [p1.pos_bol] *)

let join x1 x2 =
82 83 84 85
(
  start_of_position (if x1 = dummy then x2 else x1),
  end_of_position   (if x2 = dummy then x1 else x2)
)
86 87

let lex_join x1 x2 =
88
  (x1, x2)
89

90
let join_located l1 l2 f =
91 92 93 94 95
  {
    value    = f l1.value l2.value;
    position = join l1.position l2.position;
  }

96
let string_of_lex_pos p =
97 98 99
  let c = p.pos_cnum - p.pos_bol in
  (string_of_int p.pos_lnum)^":"^(string_of_int c)

100
let string_of_pos p =
101
  let filename = filename_of_position p in
102
  (* [filename] is hopefully not "". *)
103 104
  let l = line (start_of_position p) in
  let c1, c2 = characters (start_of_position p) (end_of_position p) in
105 106 107 108 109 110 111
  Printf.sprintf "File \"%s\", line %d, characters %d-%d" filename l c1 c2

let pos_or_undef = function
  | None -> dummy
  | Some x -> x

let cpos lexbuf =
112
  (lexeme_start_p lexbuf, lexeme_end_p lexbuf)
113 114 115 116

let with_cpos lexbuf v =
  with_pos (cpos lexbuf) v

117
let string_of_cpos lexbuf =
118 119
  string_of_pos (cpos lexbuf)

120
let joinf f t1 t2 =
121 122 123 124 125
  join (f t1) (f t2)

let ljoinf f =
  List.fold_left (fun p t -> join p (f t)) dummy

126
let join_located_list ls f =
127 128 129 130 131 132 133 134 135 136 137
  {
    value     = f (List.map (fun l -> l.value) ls);
    position  = ljoinf (fun x -> x.position) ls
  }

(* The functions that print error messages and warnings require a list of
   positions. The following auxiliary functions help build such lists. *)

type positions =
    t list

138 139
let one (pos : position) : positions =
  [ (pos, pos) ] (* or: lex_join pos pos *)
140

141
let two (pos1 : position) (pos2 : position) : positions =
142 143
  [ lex_join pos1 pos2 ]

144 145
let lexbuf (lexbuf : lexbuf) : positions =
  [ lex_join lexbuf.lex_start_p lexbuf.lex_curr_p ]
146

147
let print (pos : position) =
148 149 150 151 152 153
  Printf.printf
    "{ pos_fname = \"%s\"; pos_lnum = %d; pos_bol = %d; pos_cnum = %d }\n"
      pos.pos_fname
      pos.pos_lnum
      pos.pos_bol
      pos.pos_cnum