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.ml23
1 files changed, 20 insertions, 3 deletions
diff --git a/lib/qparser/lexbuf.ml b/lib/qparser/lexbuf.ml
index 2433ea5..1d93f67 100644
--- a/lib/qparser/lexbuf.ml
+++ b/lib/qparser/lexbuf.ml
@@ -1,3 +1,5 @@
+open StdLabels
+
type t = {
buffer : Sedlexing.lexbuf;
mutable start_p : Lexing.position option;
@@ -6,7 +8,7 @@ type t = {
}
and lexer = t -> Tokens.token
-and buffer_builder = Buffer.t -> lexer
+and buffer_builder = ?nested:bool -> Buffer.t -> lexer
and stringWraper = {
start_string : lexer -> lexer;
@@ -22,15 +24,22 @@ and stringWraper = {
}
and state =
- | Token of stringWraper
+ | Token
| String of stringWraper
| MString of int
| EndString of stringWraper
| Expression
+let pp_state format = function
+ | Token -> Format.fprintf format "Token"
+ | String _ -> Format.fprintf format "String"
+ | MString _ -> Format.fprintf format "MString"
+ | EndString _ -> Format.fprintf format "EndString"
+ | Expression -> Format.fprintf format "Expression"
+
let state : t -> state option = fun t -> Stack.top_opt t.state
let enter_state : t -> state -> unit = fun t state -> Stack.push state t.state
-let leave_state : t -> unit = fun t -> ignore (Stack.pop_opt t.state)
+let leave_state : t -> unit = fun t -> ignore @@ Stack.pop_opt t.state
let buffer : t -> Sedlexing.lexbuf = fun t -> t.buffer
let start : t -> unit =
@@ -80,3 +89,11 @@ let tokenize : (t -> 'a) -> t -> unit -> 'a * Lexing.position * Lexing.position
lexer
let rollback : t -> unit = fun t -> Sedlexing.rollback t.buffer
+
+let overlay : t -> lexer -> lexer =
+ fun t lexer ->
+ let rev_list = Stack.fold (fun acc a -> a :: acc) [] t.state in
+ List.fold_left rev_list ~init:lexer ~f:(fun (acc : lexer) layer ->
+ match layer with
+ | String wraper | EndString wraper -> wraper.start_string acc
+ | _ -> acc)