diff options
Diffstat (limited to 'lib/qparser/analyzer.ml')
-rw-r--r-- | lib/qparser/analyzer.ml | 42 |
1 files changed, 42 insertions, 0 deletions
diff --git a/lib/qparser/analyzer.ml b/lib/qparser/analyzer.ml new file mode 100644 index 0000000..da1adbf --- /dev/null +++ b/lib/qparser/analyzer.ml @@ -0,0 +1,42 @@ +(** + 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) -> + Lexbuf.t -> + ('a, Qsp_syntax.Report.t) 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 l -> + let lexer = Lexbuf.tokenize Lexer.token l in + + let init = Parser.Incremental.main (fst (Lexbuf.positions l)) in + + IncrementalParser.of_lexbuf lexer l init + |> Result.map_error (fun e -> + let message = + match e.IncrementalParser.code with + | Interpreter.InvalidSyntax -> "Invalid Syntax" + | Interpreter.UnrecoverableError -> "UnrecoverableError" + | Interpreter.MenhirCode c -> + let message_content = + try Parser_messages.message c + with Not_found -> + String.concat "" [ "(Error code "; string_of_int c; ")" ] + in + + String.concat "" [ String.trim @@ message_content ] + in + let report = + Qsp_syntax.Report.error (e.start_pos, e.end_pos) message + in + + (* Discard the remaining file to read. The parser is now in a blank + state, it does not make sense to keep feeding it with the new + tokens. *) + Lexer.discard l; + report) |