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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
open Elpi_util
open Elpi_lexer_config
exception ParseError = Parser_config.ParseError
module type Parser = sig
val program : file:string -> Ast.Program.t
val goal : loc:Util.Loc.t -> text:string -> Ast.Goal.t
val goal_from : loc:Util.Loc.t -> Lexing.lexbuf -> Ast.Goal.t
val program_from : loc:Util.Loc.t -> digest:Digest.t -> Lexing.lexbuf -> Ast.Program.t
end
module type Parser_w_Internals = sig
include Parser
module Internal : sig
val infix_SYMB : (Lexing.lexbuf -> Tokens.token) -> Lexing.lexbuf -> Ast.Func.t
val prefix_SYMB : (Lexing.lexbuf -> Tokens.token) -> Lexing.lexbuf -> Ast.Func.t
val postfix_SYMB : (Lexing.lexbuf -> Tokens.token) -> Lexing.lexbuf -> Ast.Func.t
end
end
module type Config = sig
val versions : (int * int * int) Util.StrMap.t
val resolver : ?cwd:string -> unit:string -> unit -> string
end
module Make(C : Config) = struct
let parse_ref : (?cwd:string -> string -> Ast.Program.t) ref =
ref (fun ?cwd:_ _ -> assert false)
module ParseFile = struct
let parse_file ?cwd file = !parse_ref ?cwd file
let client_payload : Obj.t option ref = ref None
let set_current_clent_loc_pyload x = client_payload := Some x
let get_current_client_loc_payload () = !client_payload
end
module Grammar = Grammar.Make(ParseFile)
let message_of_state s = try Error_messages.message s with Not_found -> "syntax error"
let raise_parse_error lexbuf stateid =
let message = message_of_state stateid in
let loc = lexbuf.Lexing.lex_curr_p in
let loc = {
Util.Loc.client_payload = None;
source_name = loc.Lexing.pos_fname;
line = loc.Lexing.pos_lnum;
line_starts_at = loc.Lexing.pos_bol;
source_start = loc.Lexing.pos_cnum;
source_stop = loc.Lexing.pos_cnum;
} in
raise (Parser_config.ParseError(loc,message))
let parse grammar lexbuf =
let buffer, lexer = MenhirLib.ErrorReports.wrap Lexer.(token C.versions) in
try
Grammar.MenhirInterpreter.loop_handle
(fun x -> x)
(function (HandlingError e) -> raise_parse_error lexbuf Grammar.MenhirInterpreter.(current_state_number e) | _ -> assert false)
(Grammar.MenhirInterpreter.lexer_lexbuf_to_supplier lexer lexbuf)
(grammar lexbuf.lex_curr_p)
with
| Ast.Term.NotInProlog(loc,message) ->
raise (Parser_config.ParseError(loc,message^"\n"))
| Lexer.Error(loc,message) ->
let loc = {
Util.Loc.client_payload = None;
source_name = loc.Lexing.pos_fname;
line = loc.Lexing.pos_lnum;
line_starts_at = loc.Lexing.pos_bol;
source_start = loc.Lexing.pos_cnum;
source_stop = loc.Lexing.pos_cnum;
} in
raise (Parser_config.ParseError(loc,message))
let already_parsed = Hashtbl.create 11
let cleanup_fname filename = Re.Str.replace_first (Re.Str.regexp "/_build/[^/]+") "" filename
let parse_one_file digest filename =
if Hashtbl.mem already_parsed digest then
Hashtbl.find already_parsed digest
else
let ic = open_in filename in
let lexbuf = Lexing.from_channel ic in
let dest = cleanup_fname filename in
lexbuf.Lexing.lex_curr_p <- { lexbuf.lex_curr_p with pos_fname = dest };
let ast = parse Grammar.Incremental.program lexbuf in
let output = { Ast.file_name = filename; deps = []; digest; ast } in
Hashtbl.add already_parsed digest output;
close_in ic;
output
let () =
parse_ref := (fun ?cwd filename ->
let filename = C.resolver ?cwd ~unit:filename () in
let digest = Digest.file filename in
if Filename.extension filename = ".mod" then
let sig_filename = Filename.chop_extension filename ^ ".sig" in
if Sys.file_exists sig_filename then
let ds = Digest.file sig_filename in
let s = parse_one_file ds sig_filename in
let m = parse_one_file digest filename in
{ Ast.file_name = filename; digest = Digest.string (ds^digest); deps = []; ast = s.ast @ m.ast }
else parse_one_file digest filename
else parse_one_file digest filename)
let to_lexing_loc { Util.Loc.source_name; line; line_starts_at; source_start; _ } =
{ Lexing.pos_fname = source_name;
pos_lnum = line;
pos_bol = line_starts_at;
pos_cnum = source_start; }
let lexing_set_position lexbuf loc =
Option.iter ParseFile.set_current_clent_loc_pyload loc.Util.Loc.client_payload;
let loc = to_lexing_loc loc in
let open Lexing in
lexbuf.lex_abs_pos <- loc.pos_cnum;
lexbuf.lex_start_p <- loc;
lexbuf.lex_curr_p <- loc
let goal_from ~loc lexbuf =
lexing_set_position lexbuf loc;
parse Grammar.Incremental.goal lexbuf
let goal ~loc ~text =
let lexbuf = Lexing.from_string text in
goal_from ~loc lexbuf
let program_from ~loc ~digest lexbuf =
Hashtbl.clear already_parsed;
lexing_set_position lexbuf loc;
let ast = parse Grammar.Incremental.program lexbuf in
let filename = let open Util.Loc in
Printf.sprintf "%s:%d:%d" loc.source_name loc.source_stop lexbuf.Lexing.lex_curr_pos in
{ Ast.file_name = filename; deps = []; digest; ast }
let program ~file =
Hashtbl.clear already_parsed;
!parse_ref file
module Internal = struct
let infix_SYMB = Grammar.infix_SYMB
let prefix_SYMB = Grammar.prefix_SYMB
let postfix_SYMB = Grammar.postfix_SYMB
end
end