Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / lib / location.ml @ 9b0432bc

History | View | Annotate | Download (4.54 KB)

1
(********************************************************************)
2
(*                                                                  *)
3
(*  The LustreC compiler toolset   /  The LustreC Development Team  *)
4
(*  Copyright 2012 -    --   ONERA - CNRS - INPT                    *)
5
(*                                                                  *)
6
(*  LustreC is free software, distributed WITHOUT ANY WARRANTY      *)
7
(*  under the terms of the GNU Lesser General Public License        *)
8
(*  version 2.1.                                                    *)
9
(*                                                                  *)
10
(********************************************************************)
11

    
12
type position = [%import: Lexing.position] [@@deriving show]
13

    
14
type t = { loc_start: Lexing.position [@printer pp_position]; loc_end: Lexing.position [@printer pp_position]}
15
[@@deriving show]
16

    
17
type filename = string
18
[@@deriving show]
19

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

    
22
let set_input, get_input, get_module =
23
  let input_name : filename ref = ref "__UNINITIALIZED__" in
24
  let module_name : filename ref = ref "__UNINITIALIZED__" in
25
  (fun name -> input_name := name; module_name := Filename.chop_extension name),
26
  (fun () -> !input_name),
27
  (fun () -> !module_name)
28

    
29
let curr lexbuf = {
30
  loc_start = lexbuf.Lexing.lex_start_p;
31
  loc_end = lexbuf.Lexing.lex_curr_p
32
}
33

    
34
let init lexbuf fname =
35
  lexbuf.Lexing.lex_curr_p <- {
36
    Lexing.pos_fname = fname;
37
    Lexing.pos_lnum = 1;
38
    Lexing.pos_bol = 0;
39
    Lexing.pos_cnum = 0;
40
  }
41

    
42
let shift_pos pos1 pos2 =
43
  (* Format.eprintf "Shift pos %s by pos %s@." pos1.Lexing.pos_fname pos2.Lexing.pos_fname;
44
   * assert (pos1.Lexing.pos_fname = pos2.Lexing.pos_fname); *)
45
  {Lexing.pos_fname = pos1.Lexing.pos_fname;
46
    Lexing.pos_lnum = pos1.Lexing.pos_lnum + pos2.Lexing.pos_lnum -1;
47

    
48
    (* New try *)
49
    Lexing.pos_bol = pos2.Lexing.pos_bol;
50
    Lexing.pos_cnum = pos2.Lexing.pos_cnum;
51
    (*
52
    Lexing.pos_bol = pos1.Lexing.pos_bol + pos2.Lexing.pos_bol;
53
    Lexing.pos_cnum =if pos2.Lexing.pos_lnum = 1 then pos1.Lexing.pos_cnum + pos2.Lexing.pos_cnum else pos2.Lexing.pos_cnum
54
     *)
55
}
56

    
57
    
58

    
59
open Format
60

    
61
let print loc =
62
  let filename = loc.loc_start.Lexing.pos_fname in
63
  let line = loc.loc_start.Lexing.pos_lnum in
64
  let start_char =
65
    loc.loc_start.Lexing.pos_cnum - loc.loc_start.Lexing.pos_bol
66
  in
67
  let end_char =
68
    loc.loc_end.Lexing.pos_cnum - loc.loc_start.Lexing.pos_cnum + start_char
69
  in
70
  let (start_char, end_char) =
71
    if start_char < 0 then (0,1) else (start_char, end_char)
72
  in
73
  print_string ("File \""^filename^"\", line ");
74
  print_int line;
75
  print_string ", characters ";
76
  print_int start_char;
77
  print_string "-";
78
  print_int end_char;
79
  print_string ":";
80
  print_newline ()
81

    
82
let loc_line loc = loc.loc_start.Lexing.pos_lnum 
83
  
84
let pp_loc fmt loc =
85
  if loc == dummy_loc then () else
86
  let filename = loc.loc_start.Lexing.pos_fname in
87
  let line = loc_line loc in
88
  let start_char =
89
    loc.loc_start.Lexing.pos_cnum - loc.loc_start.Lexing.pos_bol
90
  in
91
  let end_char =
92
    loc.loc_end.Lexing.pos_cnum - loc.loc_start.Lexing.pos_cnum + start_char
93
  in
94
  let (start_char, end_char) =
95
    if start_char < 0 then (0,1) else (start_char, end_char)
96
  in
97
  Format.fprintf fmt "File \"%s\", line %i, characters %i-%i:" filename line start_char end_char;
98
  (* Format.fprintf fmt "@.loc1=(%i,%i,%i) loc2=(%i,%i,%i)@."
99
   *   loc.loc_start.Lexing.pos_lnum
100
   *   loc.loc_start.Lexing.pos_bol
101
   *   loc.loc_start.Lexing.pos_cnum
102
   *   loc.loc_end.Lexing.pos_lnum
103
   *   loc.loc_end.Lexing.pos_bol
104
   *   loc.loc_end.Lexing.pos_cnum;
105
   *    () *)
106

    
107
  ()
108
  
109
let pp_c_loc fmt loc =
110
  let filename = loc.loc_start.Lexing.pos_fname in
111
  let line = loc.loc_start.Lexing.pos_lnum in
112
  Format.fprintf fmt "#line %i \"%s\"" line filename
113

    
114
let shift loc1 loc2 =
115
  let new_loc = 
116
    {loc_start = shift_pos loc1.loc_start loc2.loc_start;
117
     loc_end  = shift_pos loc1.loc_start loc2.loc_end
118
    }
119
  in
120
  (* Format.eprintf "loc1: %a@.loc2: %a@.nloc: %a@."
121
   *   pp_loc loc1
122
   *   pp_loc loc2
123
   *   pp_loc new_loc
124
   * ; *)
125
  new_loc
126

    
127
let loc_pile = ref []
128
let push_loc l =
129
  loc_pile := l::!loc_pile
130
let pop_loc () = loc_pile := List.tl !loc_pile
131
  
132
let symbol_rloc () =
133
  let curr_loc =
134
  {
135
    loc_start = Parsing.symbol_start_pos ();
136
    loc_end = Parsing.symbol_end_pos ()
137
  }
138
  in
139

    
140
  let res =
141
    if List.length !loc_pile > 0 then
142
    shift (List.hd !loc_pile) curr_loc
143
  else
144
    curr_loc
145
  in
146
  (* Format.eprintf "Loc: %a@." pp_loc res; *)
147
  res
148
    (* Local Variables: *)
149
    (* compile-command:"make -C .." *)
150
    (* End: *)