diff options
author | Chimrod <> | 2023-10-06 08:35:56 +0200 |
---|---|---|
committer | Chimrod <> | 2023-10-06 08:35:56 +0200 |
commit | 97ab5c9a21166f0bffee482210d69877fd6809fa (patch) | |
tree | d1fa44000fa07631edc8924a90020f2cfe637263 /lib/qparser/analyzer.ml | |
parent | 40f4dbe7844725e0ab07f03f25c35f55b4699b46 (diff) |
Moved qparser and syntax in the library folder
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) |