/usr/lib/ocaml/lexing.ml is in ocaml-nox 4.05.0-10ubuntu1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 | (**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* 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 Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(* 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 : bytes;
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 (Bytes.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 Bytes.length buffer
*)
if lexbuf.lex_buffer_len + n > Bytes.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
<= Bytes.length lexbuf.lex_buffer
then begin
(* But there is enough space if we reclaim the junk at the beginning
of the buffer *)
Bytes.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 * Bytes.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 = Bytes.create newlen in
(* Copy the valid data to the beginning of the new buffer *)
Bytes.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 *)
Bytes.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 (Bytes.create 512);
lex_buffer = Bytes.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 = Bytes.of_string s; (* have to make a copy for compatibility
with unsafe-string mode *)
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
Bytes.sub_string lexbuf.lex_buffer lexbuf.lex_start_pos len
let sub_lexeme lexbuf i1 i2 =
let len = i2-i1 in
Bytes.sub_string lexbuf.lex_buffer i1 len
let sub_lexeme_opt lexbuf i1 i2 =
if i1 >= 0 then begin
let len = i2-i1 in
Some (Bytes.sub_string lexbuf.lex_buffer i1 len)
end else begin
None
end
let sub_lexeme_char lexbuf i = Bytes.get lexbuf.lex_buffer i
let sub_lexeme_char_opt lexbuf i =
if i >= 0 then
Some (Bytes.get lexbuf.lex_buffer i)
else
None
let lexeme_char lexbuf i =
Bytes.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;
|