File: fix_location.ml

package info (click to toggle)
otags 4.05.1-1
  • links: PTS, VCS
  • area: main
  • in suites: buster, sid
  • size: 424 kB
  • ctags: 356
  • sloc: ml: 1,267; sh: 212; makefile: 194
file content (93 lines) | stat: -rw-r--r-- 2,791 bytes parent folder | download
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
(* Otags III
 * 
 * Hendrik Tews Copyright (C) 2010 - 2017
 * 
 * This file is part of "Otags III".
 * 
 * "Otags III" is free software: you can redistribute it and/or
 * modify it under the terms of the GNU General Public License as
 * published by the Free Software Foundation, either version 3 of the
 * License, or (at your option) any later version.
 * 
 * "Otags III" 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 in file COPYING in this or one of the parent
 * directories for more details.
 * 
 * You should have received a copy of the GNU General Public License
 * along with "Otags III". If not, see
 * <http://www.gnu.org/licenses/>.
 * 
 * fix locations after line directives
 * 
 *)

open Source_channel



let newline_hash : (string, int array) Hashtbl.t = Hashtbl.create 53

let reset_locations () = Hashtbl.reset newline_hash

let parse_newlines loc =
  let ic = get_channel loc in
  let nl_pos = ref [0] in
  let pos = ref 0 in
  seek_in ic 0;
  (try
     while true do
       let line_length = String.length(input_line ic) in
       pos := !pos + line_length +1;
       nl_pos := !pos :: !nl_pos;
     done
   with
     | End_of_file -> ()
  );
  Hashtbl.add newline_hash
              loc.Location.loc_start.Lexing.pos_fname
              (Array.of_list (List.rev !nl_pos))

let fix_loc loc =
  let start_loc = loc.Location.loc_start in
  let nl_array =
    try
      Hashtbl.find newline_hash start_loc.Lexing.pos_fname
    with
      | Not_found ->
         parse_newlines loc;
         Hashtbl.find newline_hash start_loc.Lexing.pos_fname
  in
  if start_loc.Lexing.pos_bol = nl_array.(start_loc.Lexing.pos_lnum - 1)
  then
    begin
      (* Printf.eprintf "FL : %s correct\n" (full_string_of_loc loc); *)
      loc
    end
  else
    let start_diff =
      nl_array.(start_loc.Lexing.pos_lnum - 1) - start_loc.Lexing.pos_bol in
    let start_loc =
      { start_loc with
        Lexing.pos_bol = nl_array.(start_loc.Lexing.pos_lnum - 1);
        pos_cnum = start_loc.Lexing.pos_cnum + start_diff
      } in
    let end_loc = loc.Location.loc_end in
    let end_diff =
      nl_array.(end_loc.Lexing.pos_lnum - 1) - end_loc.Lexing.pos_bol in
    let end_loc =
      { end_loc with
        Lexing.pos_bol = nl_array.(end_loc.Lexing.pos_lnum - 1);
        pos_cnum = end_loc.Lexing.pos_cnum + end_diff
      } in
    let new_loc = { loc with
                    Location.loc_start = start_loc;
                    loc_end = end_loc
                  } in
    (* 
     * Printf.eprintf "FL : %s -> %s\n"
     *                (full_string_of_loc loc) (full_string_of_loc new_loc);
     *)
    new_loc