aboutsummaryrefslogtreecommitdiff
path: root/lib/qparser/analyzer.ml
diff options
context:
space:
mode:
Diffstat (limited to 'lib/qparser/analyzer.ml')
-rw-r--r--lib/qparser/analyzer.ml42
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)