1 files changed, 44 insertions, 0 deletions
diff --git a/lib/analyzer.ml b/lib/analyzer.ml
new file mode 100644
index 0000000..1a9b17b
--- /dev/null
+++ b/lib/analyzer.ml
@@ -0,0 +1,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 (Qsp_syntax.Tree) 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 })