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