Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Tree: 1f404558b0
Fetching contributors…

Cannot retrieve contributors at this time

240 lines (212 sloc) 7.341 kB
(***********************************************************************)
(* *)
(* 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: lexing.ml 8787 2008-01-22 16:27:53Z doligez $ *)
(* The run-time library for lexers generated by camllex *)
type position = {
pos_fname : string;
pos_lnum : int;
pos_bol : int;
pos_cnum : int;
}
let dummy_pos = {
pos_fname = "";
pos_lnum = 0;
pos_bol = 0;
pos_cnum = -1;
}
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;
mutable lex_mem : int array;
mutable lex_start_p : position;
mutable lex_curr_p : position;
}
type lex_tables =
{ lex_base: string;
lex_backtrk: string;
lex_default: string;
lex_trans: string;
lex_check: string;
lex_base_code : string;
lex_backtrk_code : string;
lex_default_code : string;
lex_trans_code : string;
lex_check_code : string;
lex_code: string;}
external c_engine : lex_tables -> int -> lexbuf -> int = "caml_lex_engine"
external c_new_engine : lex_tables -> int -> lexbuf -> int
= "caml_new_lex_engine"
let engine tbl state buf =
let result = c_engine tbl state buf in
if result >= 0 then begin
buf.lex_start_p <- buf.lex_curr_p;
buf.lex_curr_p <- {buf.lex_curr_p
with pos_cnum = buf.lex_abs_pos + buf.lex_curr_pos};
end;
result
;;
let new_engine tbl state buf =
let result = c_new_engine tbl state buf in
if result >= 0 then begin
buf.lex_start_p <- buf.lex_curr_p;
buf.lex_curr_p <- {buf.lex_curr_p
with pos_cnum = buf.lex_abs_pos + buf.lex_curr_pos};
end;
result
;;
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 ;
let t = lexbuf.lex_mem in
for i = 0 to Array.length t-1 do
let v = t.(i) in
if v >= 0 then
t.(i) <- v-s
done
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 zero_pos = {
pos_fname = "";
pos_lnum = 1;
pos_bol = 0;
pos_cnum = 0;
};;
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_mem = [||];
lex_eof_reached = false;
lex_start_p = zero_pos;
lex_curr_p = zero_pos;
}
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_mem = [||];
lex_eof_reached = true;
lex_start_p = zero_pos;
lex_curr_p = zero_pos;
}
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 sub_lexeme lexbuf i1 i2 =
let len = i2-i1 in
let s = String.create len in
String.unsafe_blit lexbuf.lex_buffer i1 s 0 len;
s
let sub_lexeme_opt lexbuf i1 i2 =
if i1 >= 0 then begin
let len = i2-i1 in
let s = String.create len in
String.unsafe_blit lexbuf.lex_buffer i1 s 0 len;
Some s
end else begin
None
end
let sub_lexeme_char lexbuf i = lexbuf.lex_buffer.[i]
let sub_lexeme_char_opt lexbuf i =
if i >= 0 then
Some lexbuf.lex_buffer.[i]
else
None
let lexeme_char lexbuf i =
String.get lexbuf.lex_buffer (lexbuf.lex_start_pos + i)
let lexeme_start lexbuf = lexbuf.lex_start_p.pos_cnum;;
let lexeme_end lexbuf = lexbuf.lex_curr_p.pos_cnum;;
let lexeme_start_p lexbuf = lexbuf.lex_start_p;;
let lexeme_end_p lexbuf = lexbuf.lex_curr_p;;
let new_line lexbuf =
let lcp = lexbuf.lex_curr_p in
lexbuf.lex_curr_p <- { lcp with
pos_lnum = lcp.pos_lnum + 1;
pos_bol = lcp.pos_cnum;
}
;;
(* Discard data left in lexer buffer. *)
let flush_input lb =
lb.lex_curr_pos <- 0;
lb.lex_abs_pos <- 0;
lb.lex_curr_p <- {lb.lex_curr_p with pos_cnum = 0};
lb.lex_buffer_len <- 0;
;;
Jump to Line
Something went wrong with that request. Please try again.