ocaml/stdlib/lexing.ml

(***********************************************************************)
(*                                                                     *)
(*                           Objective Caml                            *)
(*                                                                     *)
(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
(*                                                                     *)
(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
(*  en Automatique.  All rights reserved.  This file is distributed    *)
(*  under the terms of the GNU Library General Public License, with    *)
(*  the special exception on linking described in file ../LICENSE.     *)
(*                                                                     *)
(***********************************************************************)

(* $Id$ *)

(* 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 : int;
    mutable lex_eof_reached : bool }

type lex_tables =
  { lex_base: string;
    lex_backtrk: string;
    lex_default: string;
    lex_trans: string;
    lex_check: string }

external engine: lex_tables -> int -> lexbuf -> int = "lex_engine"

let lex_refill read_fun aux_buffer lexbuf =
  let read =
    read_fun aux_buffer (String.length aux_buffer) in
  let n =
    if read > 0
    then read
    else (lexbuf.lex_eof_reached <- true; 0) in
  (* Current state of the buffer:
        <-------|---------------------|----------->
        |  junk |      valid data     |   junk    |
        ^       ^                     ^           ^
        0    start_pos             buffer_end    String.length buffer
  *)
  if lexbuf.lex_buffer_len + n > String.length lexbuf.lex_buffer then begin
    (* There is not enough space at the end of the buffer *)
    if lexbuf.lex_buffer_len - lexbuf.lex_start_pos + n 
       <= String.length lexbuf.lex_buffer
    then begin
      (* But there is enough space if we reclaim the junk at the beginning
         of the buffer *)
      String.blit lexbuf.lex_buffer lexbuf.lex_start_pos
                  lexbuf.lex_buffer 0
                  (lexbuf.lex_buffer_len - lexbuf.lex_start_pos)
    end else begin
      (* We must grow the buffer.  Doubling its size will provide enough
         space since n <= String.length aux_buffer <= String.length buffer.
         Watch out for string length overflow, though. *)
      let newlen =
        min (2 * String.length lexbuf.lex_buffer) Sys.max_string_length in
      if lexbuf.lex_buffer_len - lexbuf.lex_start_pos + n > newlen
      then failwith "Lexing.lex_refill: cannot grow buffer";
      let newbuf = String.create newlen in
      (* Copy the valid data to the beginning of the new buffer *)
      String.blit lexbuf.lex_buffer lexbuf.lex_start_pos
                  newbuf 0
                  (lexbuf.lex_buffer_len - lexbuf.lex_start_pos);
      lexbuf.lex_buffer <- newbuf
    end;
    (* Reallocation or not, we have shifted the data left by
       start_pos characters; update the positions *)
    let s = lexbuf.lex_start_pos in
    lexbuf.lex_abs_pos <- lexbuf.lex_abs_pos + s;
    lexbuf.lex_curr_pos <- lexbuf.lex_curr_pos - s;
    lexbuf.lex_start_pos <- 0;
    lexbuf.lex_last_pos <- lexbuf.lex_last_pos - s;
    lexbuf.lex_buffer_len <- lexbuf.lex_buffer_len - s
  end;
  (* There is now enough space at the end of the buffer *)
  String.blit aux_buffer 0
              lexbuf.lex_buffer lexbuf.lex_buffer_len
              n;
  lexbuf.lex_buffer_len <- lexbuf.lex_buffer_len + n

let from_function f =
  { refill_buff = lex_refill f (String.create 512);
    lex_buffer = String.create 1024;
    lex_buffer_len = 0;
    lex_abs_pos = 0;
    lex_start_pos = 0;
    lex_curr_pos = 0;
    lex_last_pos = 0;
    lex_last_action = 0;
    lex_eof_reached = false }

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

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

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 lexeme_start lexbuf =
  lexbuf.lex_abs_pos + lexbuf.lex_start_pos
and lexeme_end lexbuf =
  lexbuf.lex_abs_pos + lexbuf.lex_curr_pos