-
Notifications
You must be signed in to change notification settings - Fork 125
/
bslRegisterParserState.ml
72 lines (55 loc) · 2.03 KB
/
bslRegisterParserState.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
(*
Copyright © 2011 MLstate
This file is part of OPA.
OPA is free software: you can redistribute it and/or modify it under the
terms of the GNU Affero General Public License, version 3, as published by
the Free Software Foundation.
OPA 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 Affero General Public License for
more details.
You should have received a copy of the GNU Affero General Public License
along with OPA. If not, see <http://www.gnu.org/licenses/>.
*)
(* CF mli *)
type filename = string
type line_number = int
let private_filename = ref ( "<unnamed file>" : filename )
let private_line_number = ref ( (-1) : line_number )
(* The last directive is set by BslRegisterLib,
so that the parser can make some context check *)
let private_last_directive = ref None
let set_last_directive directive = private_last_directive := Some directive
let get_last_directive () = !private_last_directive
let make_pos () = FilePos.make_pos_from_line !private_filename !private_line_number
let pp_citation fmt () =
let pos = make_pos () in
if FilePos.is_empty pos then
Format.fprintf fmt "File \"%s\", line %d@\n" !private_filename !private_line_number
else
FilePos.citation fmt pos
let warning fmt =
OManager.warning ~wclass:WarningClass.bsl_register ("@\n%a"^^fmt) pp_citation ()
let error fmt =
OManager.printf "%a" pp_citation () ;
OManager.error fmt
module TypeVar =
struct
let tbl = Hashtbl.create 10
let var name =
try Hashtbl.find tbl name with
| Not_found ->
let typevar = BslTypes.TypeVar.next ~name () in
Hashtbl.add tbl name typevar;
typevar
let fresh () =
BslTypes.TypeVar.next ()
let reset () =
Hashtbl.clear tbl
end
let init_file ~filename =
private_last_directive := None;
private_filename := filename
let init_line ~line_number =
TypeVar.reset ();
private_line_number := line_number