stdlib/lexing.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                           Objective Caml                            *)
   4 (*                                                                     *)
   5 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
   6 (*                                                                     *)
   7 (*  Copyright 1996 Institut National de Recherche en Informatique et   *)
   8 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   9 (*  under the terms of the GNU Library General Public License, with    *)
  10 (*  the special exception on linking described in file ../LICENSE.     *)
  11 (*                                                                     *)
  12 (***********************************************************************)
  13
  14 (* $Id$ *)
  15
  16 (* The run-time library for lexers generated by camllex *)
  17
  18 type position = {
  19   pos_fname : string;
  20   pos_lnum : int;
  21   pos_bol : int;
  22   pos_cnum : int;
  23 }
  24
  25 let dummy_pos = {
  26   pos_fname = "";
  27   pos_lnum = 0;
  28   pos_bol = 0;
  29   pos_cnum = -1;
  30 }
  31
  32 type lexbuf =
  33   { refill_buff : lexbuf -> unit;
  34     mutable lex_buffer : string;
  35     mutable lex_buffer_len : int;
  36     mutable lex_abs_pos : int;
  37     mutable lex_start_pos : int;
  38     mutable lex_curr_pos : int;
  39     mutable lex_last_pos : int;
  40     mutable lex_last_action : int;
  41     mutable lex_eof_reached : bool;
  42     mutable lex_mem : int array;
  43     mutable lex_start_p : position;
  44     mutable lex_curr_p : position;
  45   }
  46
  47 type lex_tables =
  48   { lex_base: string;
  49     lex_backtrk: string;
  50     lex_default: string;
  51     lex_trans: string;
  52     lex_check: string;
  53     lex_base_code : string;
  54     lex_backtrk_code : string;
  55     lex_default_code : string;
  56     lex_trans_code : string;
  57     lex_check_code : string;
  58     lex_code: string;}
  59
  60 external c_engine : lex_tables -> int -> lexbuf -> int = "caml_lex_engine"
  61 external c_new_engine : lex_tables -> int -> lexbuf -> int
  62                       = "caml_new_lex_engine"
  63
  64 let engine tbl state buf =
  65   let result = c_engine tbl state buf in
  66   if result >= 0 then begin
  67     buf.lex_start_p <- buf.lex_curr_p;
  68     buf.lex_curr_p <- {buf.lex_curr_p
  69                        with pos_cnum = buf.lex_abs_pos + buf.lex_curr_pos};
  70   end;
  71   result
  72 ;;
  73
  74 let new_engine tbl state buf =
  75   let result = c_new_engine tbl state buf in
  76   if result >= 0 then begin
  77     buf.lex_start_p <- buf.lex_curr_p;
  78     buf.lex_curr_p <- {buf.lex_curr_p
  79                        with pos_cnum = buf.lex_abs_pos + buf.lex_curr_pos};
  80   end;
  81   result
  82 ;;
  83
  84 let lex_refill read_fun aux_buffer lexbuf =
  85   let read =
  86     read_fun aux_buffer (String.length aux_buffer) in
  87   let n =
  88     if read > 0
  89     then read
  90     else (lexbuf.lex_eof_reached <- true; 0) in
  91   (* Current state of the buffer:
  92         <-------|---------------------|----------->
  93         |  junk |      valid data     |   junk    |
  94         ^       ^                     ^           ^
  95         0    start_pos             buffer_end    String.length buffer
  96   *)
  97   if lexbuf.lex_buffer_len + n > String.length lexbuf.lex_buffer then begin
  98     (* There is not enough space at the end of the buffer *)
  99     if lexbuf.lex_buffer_len - lexbuf.lex_start_pos + n
 100        <= String.length lexbuf.lex_buffer
 101     then begin
 102       (* But there is enough space if we reclaim the junk at the beginning
 103          of the buffer *)
 104       String.blit lexbuf.lex_buffer lexbuf.lex_start_pos
 105                   lexbuf.lex_buffer 0
 106                   (lexbuf.lex_buffer_len - lexbuf.lex_start_pos)
 107     end else begin
 108       (* We must grow the buffer.  Doubling its size will provide enough
 109          space since n <= String.length aux_buffer <= String.length buffer.
 110          Watch out for string length overflow, though. *)
 111       let newlen =
 112         min (2 * String.length lexbuf.lex_buffer) Sys.max_string_length in
 113       if lexbuf.lex_buffer_len - lexbuf.lex_start_pos + n > newlen
 114       then failwith "Lexing.lex_refill: cannot grow buffer";
 115       let newbuf = String.create newlen in
 116       (* Copy the valid data to the beginning of the new buffer *)
 117       String.blit lexbuf.lex_buffer lexbuf.lex_start_pos
 118                   newbuf 0
 119                   (lexbuf.lex_buffer_len - lexbuf.lex_start_pos);
 120       lexbuf.lex_buffer <- newbuf
 121     end;
 122     (* Reallocation or not, we have shifted the data left by
 123        start_pos characters; update the positions *)
 124     let s = lexbuf.lex_start_pos in
 125     lexbuf.lex_abs_pos <- lexbuf.lex_abs_pos + s;
 126     lexbuf.lex_curr_pos <- lexbuf.lex_curr_pos - s;
 127     lexbuf.lex_start_pos <- 0;
 128     lexbuf.lex_last_pos <- lexbuf.lex_last_pos - s;
 129     lexbuf.lex_buffer_len <- lexbuf.lex_buffer_len - s ;
 130     let t = lexbuf.lex_mem in
 131     for i = 0 to Array.length t-1 do
 132       let v = t.(i) in
 133       if v >= 0 then
 134         t.(i) <- v-s
 135     done
 136   end;
 137   (* There is now enough space at the end of the buffer *)
 138   String.blit aux_buffer 0
 139               lexbuf.lex_buffer lexbuf.lex_buffer_len
 140               n;
 141   lexbuf.lex_buffer_len <- lexbuf.lex_buffer_len + n
 142
 143 let zero_pos = {
 144   pos_fname = "";
 145   pos_lnum = 1;
 146   pos_bol = 0;
 147   pos_cnum = 0;
 148 };;
 149
 150 let from_function f =
 151   { refill_buff = lex_refill f (String.create 512);
 152     lex_buffer = String.create 1024;
 153     lex_buffer_len = 0;
 154     lex_abs_pos = 0;
 155     lex_start_pos = 0;
 156     lex_curr_pos = 0;
 157     lex_last_pos = 0;
 158     lex_last_action = 0;
 159     lex_mem = [||];
 160     lex_eof_reached = false;
 161     lex_start_p = zero_pos;
 162     lex_curr_p = zero_pos;
 163   }
 164
 165 let from_channel ic =
 166   from_function (fun buf n -> input ic buf 0 n)
 167
 168 let from_string s =
 169   { refill_buff = (fun lexbuf -> lexbuf.lex_eof_reached <- true);
 170     lex_buffer = s ^ "";
 171     lex_buffer_len = String.length s;
 172     lex_abs_pos = 0;
 173     lex_start_pos = 0;
 174     lex_curr_pos = 0;
 175     lex_last_pos = 0;
 176     lex_last_action = 0;
 177     lex_mem = [||];
 178     lex_eof_reached = true;
 179     lex_start_p = zero_pos;
 180     lex_curr_p = zero_pos;
 181   }
 182
 183 let lexeme lexbuf =
 184   let len = lexbuf.lex_curr_pos - lexbuf.lex_start_pos in
 185   let s = String.create len in
 186   String.unsafe_blit lexbuf.lex_buffer lexbuf.lex_start_pos s 0 len;
 187   s
 188
 189 let sub_lexeme lexbuf i1 i2 =
 190   let len = i2-i1 in
 191   let s = String.create len in
 192   String.unsafe_blit lexbuf.lex_buffer i1 s 0 len;
 193   s
 194
 195 let sub_lexeme_opt lexbuf i1 i2 =
 196   if i1 >= 0 then begin
 197     let len = i2-i1 in
 198     let s = String.create len in
 199     String.unsafe_blit lexbuf.lex_buffer i1 s 0 len;
 200     Some s
 201   end else begin
 202     None
 203   end
 204
 205 let sub_lexeme_char lexbuf i = lexbuf.lex_buffer.[i]
 206
 207 let sub_lexeme_char_opt lexbuf i =
 208   if i >= 0 then
 209     Some lexbuf.lex_buffer.[i]
 210   else
 211     None
 212
 213
 214 let lexeme_char lexbuf i =
 215   String.get lexbuf.lex_buffer (lexbuf.lex_start_pos + i)
 216
 217 let lexeme_start lexbuf = lexbuf.lex_start_p.pos_cnum;;
 218 let lexeme_end lexbuf = lexbuf.lex_curr_p.pos_cnum;;
 219
 220 let lexeme_start_p lexbuf = lexbuf.lex_start_p;;
 221 let lexeme_end_p lexbuf = lexbuf.lex_curr_p;;
 222
 223
 224 (* Discard data left in lexer buffer. *)
 225
 226 let flush_input lb =
 227   lb.lex_curr_pos <- 0;
 228   lb.lex_abs_pos <- 0;
 229   lb.lex_curr_p <- {lb.lex_curr_p with pos_cnum = 0};
 230   lb.lex_buffer_len <- 0;
 231 ;;