diff options
Diffstat (limited to 'lib/qparser/analyzer.ml')
| -rw-r--r-- | lib/qparser/analyzer.ml | 53 |
1 files changed, 28 insertions, 25 deletions
diff --git a/lib/qparser/analyzer.ml b/lib/qparser/analyzer.ml index fba96e0..06960f6 100644 --- a/lib/qparser/analyzer.ml +++ b/lib/qparser/analyzer.ml @@ -4,10 +4,11 @@ See [syntax/S] *) let parse : - (module Qsp_syntax.S.Analyzer with type Location.repr = 'a) -> + type a. + (module Qsp_syntax.S.Analyzer with type Location.t = a) -> Lexbuf.t -> - ('a, Qsp_syntax.Report.t) Result.t = - fun (type a) (module S : Qsp_syntax.S.Analyzer with type Location.repr = a) -> + (a * Qsp_syntax.Report.t list, Qsp_syntax.Report.t) Result.t = + fun (module S : Qsp_syntax.S.Analyzer with type Location.t = a) -> let module Parser = Parser.Make (S) in let module IncrementalParser = Interpreter.Interpreter (Parser.MenhirInterpreter) in @@ -34,28 +35,30 @@ let parse : Error err in - Result.map_error - (fun e -> - let message = - match e.IncrementalParser.code with - | Interpreter.InvalidSyntax -> "Invalid Syntax" - | Interpreter.UnrecoverableError -> "UnrecoverableError" - | Interpreter.Custom msg -> msg - | Interpreter.MenhirCode c -> - let message_content = - try Parser_messages.message c - with Not_found -> - String.concat "" [ "(Error code "; string_of_int c; ")" ] - in + evaluation + |> Result.map (fun e -> e []) + |> Result.map_error (fun e -> + let message = + match e.IncrementalParser.code with + | Interpreter.InvalidSyntax -> "Invalid Syntax" + | Interpreter.UnrecoverableError -> "UnrecoverableError" + | Interpreter.Custom msg -> msg + | 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 + 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. *) - let () = try Lexer.discard l with _ -> () 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. *) + let () = try Lexer.discard l with _ -> () in - report) - evaluation + report) |