aboutsummaryrefslogtreecommitdiff
path: root/lib/qparser/lexbuf.ml
blob: 3f0b186eb4b05b680d45d5984bd1997d170708c0 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
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