Moved qparser and syntax in the library folder

1 files changed, 61 insertions, 0 deletions

diff --git a/lib/qparser/lexbuf.ml b/lib/qparser/lexbuf.ml
new file mode 100644
index 0000000..3f0b186
--- /dev/null
+++ b/lib/qparser/lexbuf.ml
@@ -0,0 +1,61 @@
+type t = {
+  buffer : Sedlexing.lexbuf;
+  mutable start_p : Lexing.position option;
+  mutable expression_level : int;
+  reset_line : bool;
+}
+
+let buffer : t -> Sedlexing.lexbuf = fun t -> t.buffer
+
+let start : t -> unit =
+ fun t ->
+  let _start_pos, end_pos = Sedlexing.lexing_positions t.buffer in
+  let () =
+    if not t.reset_line then
+      Sedlexing.set_position t.buffer { end_pos with Lexing.pos_lnum = 1 }
+  in
+  t.start_p <- None;
+  t.expression_level <- 0
+
+let positions : t -> Lexing.position * Lexing.position =
+ fun t -> Sedlexing.lexing_positions t.buffer
+
+let content : t -> string = fun t -> Sedlexing.Utf8.lexeme t.buffer
+
+let from_lexbuf : ?reset_line:bool -> Sedlexing.lexbuf -> t =
+ fun ?(reset_line = true) t ->
+  { buffer = t; start_p = None; expression_level = 0; reset_line }
+
+let set_start_position : t -> Lexing.position -> unit =
+ fun t position -> t.start_p <- Some position
+
+let tokenize : (t -> 'a) -> t -> unit -> 'a * Lexing.position * Lexing.position
+    =
+ fun f t ->
+  let lexer () =
+    (* Clear the previous registered start position if any *)
+    t.start_p <- None;
+    let token = f t in
+    let default, curr_p = positions t in
+
+    let start_p = Option.value ~default t.start_p in
+
+    (token, start_p, curr_p)
+  in
+  lexer
+
+(* The comment system is terrible. The same symbol can be used for :
+     - starting a comment
+     - inequality operation
+   In order to manage this, I try to identify the context in a very basic way,
+   using a counter for determining the token to send.
+*)
+
+let incr_level : t -> unit =
+ fun t -> t.expression_level <- t.expression_level + 1
+
+let decr_level : t -> unit =
+ fun t -> t.expression_level <- t.expression_level - 1
+
+let reset_level : t -> unit = fun t -> t.expression_level <- 0
+let level : t -> int = fun t -> t.expression_level