ocaml/stdlib/lexing.ml

(* The run-time library for lexers generated by camllex *)

type lexbuf =
  { refill_buff : lexbuf -> unit;
    mutable lex_buffer : string;
    mutable lex_buffer_len : int;
    mutable lex_abs_pos : int;
    mutable lex_start_pos : int;
    mutable lex_curr_pos : int;
    mutable lex_last_pos : int;
    mutable lex_last_action : lexbuf -> Obj.t }

let lex_aux_buffer = String.create 1024

let lex_refill read_fun lexbuf =
  let read =
    read_fun lex_aux_buffer 1024 in
  let n =
    if read > 0
    then read
    else (String.unsafe_set lex_aux_buffer 0 '\000'; 1) in
  if lexbuf.lex_start_pos < n then begin
    let oldlen = lexbuf.lex_buffer_len in
    let newlen = oldlen * 2 in
    let newbuf = String.create newlen in
    String.unsafe_blit lexbuf.lex_buffer 0 newbuf oldlen oldlen;
    lexbuf.lex_buffer <- newbuf;
    lexbuf.lex_buffer_len <- newlen;
    lexbuf.lex_abs_pos <- lexbuf.lex_abs_pos - oldlen;
    lexbuf.lex_curr_pos <- lexbuf.lex_curr_pos + oldlen;
    lexbuf.lex_start_pos <- lexbuf.lex_start_pos + oldlen;
    lexbuf.lex_last_pos <- lexbuf.lex_last_pos + oldlen
  end;
  String.unsafe_blit lexbuf.lex_buffer n
                     lexbuf.lex_buffer 0 
                     (lexbuf.lex_buffer_len - n);
  String.unsafe_blit lex_aux_buffer 0
                     lexbuf.lex_buffer (lexbuf.lex_buffer_len - n)
                     n;
  lexbuf.lex_abs_pos <- lexbuf.lex_abs_pos + n;
  lexbuf.lex_curr_pos <- lexbuf.lex_curr_pos - n;
  lexbuf.lex_start_pos <- lexbuf.lex_start_pos - n;
  lexbuf.lex_last_pos <- lexbuf.lex_last_pos - n

let dummy_action x = failwith "lexing: empty token"

let from_function f =
  { refill_buff = lex_refill f;
    lex_buffer = String.create 2048;
    lex_buffer_len = 2048;
    lex_abs_pos = - 2048;
    lex_start_pos = 2048;
    lex_curr_pos = 2048;
    lex_last_pos = 2048;
    lex_last_action = dummy_action }

let from_channel ic =
  from_function (fun buf n -> input ic buf 0 n)

let from_string s =
  { refill_buff =
      (fun lexbuf -> lexbuf.lex_curr_pos <- lexbuf.lex_curr_pos - 1);
    lex_buffer = s ^ "\000";
    lex_buffer_len = String.length s + 1;
    lex_abs_pos = 0;
    lex_start_pos = 0;
    lex_curr_pos = 0;
    lex_last_pos = 0;
    lex_last_action = dummy_action }

let get_next_char lexbuf =
  let p = lexbuf.lex_curr_pos in
  if p < lexbuf.lex_buffer_len then begin
    let c = String.unsafe_get lexbuf.lex_buffer p in
    lexbuf.lex_curr_pos <- p + 1;
    c
  end else begin
    lexbuf.refill_buff lexbuf;
    let p = lexbuf.lex_curr_pos in
    let c = String.unsafe_get lexbuf.lex_buffer p in
    lexbuf.lex_curr_pos <- p + 1;
    c
  end

let lexeme lexbuf =
  let len = lexbuf.lex_curr_pos - lexbuf.lex_start_pos in
  let s = String.create len in
  String.unsafe_blit lexbuf.lex_buffer lexbuf.lex_start_pos s 0 len;
  s

let lexeme_char lexbuf i =
  String.get lexbuf.lex_buffer (lexbuf.lex_start_pos + i)

let start_lexing lexbuf =
  lexbuf.lex_start_pos <- lexbuf.lex_curr_pos;
  lexbuf.lex_last_action <- dummy_action

let backtrack lexbuf =
  lexbuf.lex_curr_pos <- lexbuf.lex_last_pos;
  Obj.magic(lexbuf.lex_last_action lexbuf)

let lexeme_start lexbuf =
  lexbuf.lex_abs_pos + lexbuf.lex_start_pos
and lexeme_end lexbuf =
  lexbuf.lex_abs_pos + lexbuf.lex_curr_pos