type t = { buffer : Sedlexing.lexbuf; mutable start_p : Lexing.position option; mutable expression_level : int; } 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 Sedlexing.set_position t.buffer { end_pos with Lexing.pos_lnum = 1 }; 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 : Sedlexing.lexbuf -> t = fun t -> { buffer = t; start_p = None; expression_level = 0 } 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