Source file `loc.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
(*********************************************************************************)
(*                OCaml-RDF                                                      *)
(*                                                                               *)
(*    Copyright (C) 2012-2024 Institut National de Recherche en Informatique     *)
(*    et en Automatique. All rights reserved.                                    *)
(*                                                                               *)
(*    This program is free software; you can redistribute it and/or modify       *)
(*    it under the terms of the GNU Lesser General Public License version        *)
(*    3 as published by the Free Software Foundation.                            *)
(*                                                                               *)
(*    This program is distributed in the hope that it will be useful,            *)
(*    but WITHOUT ANY WARRANTY; without even the implied warranty of             *)
(*    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *)
(*    GNU General Public License for more details.                               *)
(*                                                                               *)
(*    You should have received a copy of the GNU General Public License          *)
(*    along with this program; if not, write to the Free Software                *)
(*    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA                   *)
(*    02111-1307  USA                                                            *)
(*                                                                               *)
(*    Contact: Maxence.Guesdon@inria.fr                                          *)
(*                                                                               *)
(*********************************************************************************)

(** *)


(* Print the location in some way or another *)

open Format
open Lexing

type loc =
  { loc_start : Lexing.position ;
    loc_end : Lexing.position ;
  }

let dummy_loc = {
    loc_start = Lexing.dummy_pos ;
    loc_end = Lexing.dummy_pos ;
  }


let source_info_string s start stop =
  let bols = List.rev (Utf8.utf8_get_bol s) in
  let rec search cnum = function
    [] -> (1,0)
  | (line,bol) :: q ->
      if cnum >= bol then (line, bol) else search cnum q
  in
  let pos p =
    let (line, bol) = search p bols in
    { pos_cnum = p ; pos_fname = "" ;
      pos_bol = bol ; pos_lnum = line ;
    }
  in
  { loc_start = pos start ; loc_end = pos stop }
;;

let source_info_file file start stop =
  let s = Misc.string_of_file file in
  let loc = source_info_string s start stop in
  {
    loc_start = {loc.loc_start with pos_fname = file } ;
    loc_end = { loc.loc_end with pos_fname = file } ;
  }

let (msg_file, msg_line, msg_char, msg_chars, msg_to, msg_colon, msg_head) =
  ("File ", "line ", ", character ", ", characters ", "-", ":", "")

(* return file, line, char from the given position *)
let get_pos_info pos =
  let (filename, linenum, linebeg) =
(*    if pos.pos_fname = "" then
      ("", -1, 0)
    else
*)      (pos.pos_fname, pos.pos_lnum, pos.pos_bol)
  in
  (filename, linenum, pos.pos_cnum - linebeg)
;;

let pp ppf loc =
  let (file, line, startchar) = get_pos_info loc.loc_start in
  let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum + startchar in
  let (startchar, endchar) =
    if startchar < 0 then (0, 1) else (startchar, endchar)
  in
  if file <> "" then fprintf ppf "%s \"%s\", " msg_file file;
  fprintf ppf "%s%i" msg_line line;
  if startchar <> endchar then
    begin
      fprintf ppf "%s%i" msg_chars startchar;
      fprintf ppf "%s%i%s@.%s" msg_to endchar msg_colon msg_head
    end
  else
    begin
      fprintf ppf "%s%i" msg_char startchar;
      fprintf ppf "%s@.%s" msg_colon msg_head
    end
;;

let string_of_loc loc =
  pp Format.str_formatter loc;
  Format.flush_str_formatter ()
;;