blob: f0f8ca54aef9bf70116db699df386af1b911b270 (
plain)
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
|
type error = {
message : string;
start_pos : Lexing.position;
end_pos : Lexing.position;
}
(** Error reported when the syntax is invalid *)
let format_error : Format.formatter -> error -> unit =
fun f e ->
let start_c = e.start_pos.Lexing.pos_cnum - e.start_pos.Lexing.pos_bol
and end_c = e.end_pos.Lexing.pos_cnum - e.end_pos.Lexing.pos_bol
and start_line = e.start_pos.Lexing.pos_lnum
and end_line = e.end_pos.Lexing.pos_lnum in
if start_line != end_line then
Format.fprintf f "Lines %d-%d %s" start_line end_line e.message
else Format.fprintf f "Line %d %d:%d %s" start_line start_c end_c e.message
(**
Run the QSP parser and apply the analyzer over it.
See [syntax/S]
*)
let parse :
(module Qsp_syntax.S.Analyzer with type Location.repr = 'a) ->
Lexing.lexbuf ->
('a, error) Result.t =
fun (type a) (module S : Qsp_syntax.S.Analyzer with type Location.repr = a) ->
let module Parser = Parser.Make (S) in
let module IncrementalParser =
Interpreter.Interpreter (Parser.MenhirInterpreter) in
fun lexbuf ->
IncrementalParser.of_lexbuf lexbuf Lexer.token Parser.Incremental.main
|> Result.map_error (fun e ->
let message =
match e.Interpreter.code with
| Interpreter.InvalidSyntax -> "Invalid Syntax"
| Interpreter.MenhirCode c ->
String.concat ""
[
"(Code "; string_of_int c; ")\n"; Parser_messages.message c;
]
in
{ message; start_pos = e.start_pos; end_pos = e.end_pos })
|
