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 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450
|
(***********************************************************************)
(* *)
(* HEVEA *)
(* *)
(* Luc Maranget, projet PARA, INRIA Rocquencourt *)
(* *)
(* Copyright 1998 Institut National de Recherche en Informatique et *)
(* Automatique. Distributed only by permission. *)
(* *)
(***********************************************************************)
{
open Lexing
open Misc
open SaveUtils
let rec peek_next_char lb =
let pos = lb.lex_curr_pos
and len = lb.lex_buffer_len in
if pos >= len then begin
if lb.lex_eof_reached then
raise Not_found
else begin
lb.refill_buff lb ;
peek_next_char lb
end
end else
Bytes.unsafe_get lb.lex_buffer pos
let if_next_char c lb =
try
peek_next_char lb = c
with
| Not_found -> false
let rec if_next_string s lb =
if s = "" then
true
else
let pos = lb.lex_curr_pos
and len = lb.lex_buffer_len
and slen = String.length s in
if pos + slen - 1 >= len then begin
if lb.lex_eof_reached then begin
false
end else begin
lb.refill_buff lb ;
if_next_string s lb
end
end else
let b = lb.lex_buffer in
let rec do_rec k =
if k >= slen then true
else
Bytes.get b (pos+k) = String.get s k &&
do_rec (k+1) in
do_rec 0
type kmp_t = Continue of int | Stop of string
let rec kmp_char delim next i c =
if i < 0 then begin
Out.put_char arg_buff c ;
Continue 0
end else if c = delim.[i] then begin
if i >= String.length delim - 1 then
Stop (Out.to_string arg_buff)
else
Continue (i+1)
end else begin
if next.(i) >= 0 then
Out.put arg_buff (String.sub delim 0 (i-next.(i))) ;
kmp_char delim next next.(i) c
end
}
let command_name =
'\\' (( ['@''A'-'Z' 'a'-'z']+ '*'?) | [^ 'A'-'Z' 'a'-'z'] | "\\*")
let space = [' ''\t''\r']
rule skip_comment = parse
| eof {()}
| '\n' space* {check_comment lexbuf}
| _ {skip_comment lexbuf}
and check_comment = parse
| '%' {skip_comment lexbuf}
| "" {()}
and first_char = parse
| _
{let lxm = lexeme_char lexbuf 0 in
put_echo_char lxm ;
lxm}
| eof {raise Eof}
and rest = parse
| _ * eof
{let lxm = lexeme lexbuf in
put_echo lxm ;
lxm}
and skip_blanks = parse
| space* '\n' as lxm
{seen_par := false ;
put_echo lxm ;
more_skip lexbuf}
| space* as lxm
{put_echo lxm ; Out.to_string arg_buff}
and more_skip = parse
(space* '\n' space*)+ as lxm
{seen_par := true ;
put_echo lxm ;
more_skip lexbuf}
| space* as lxm
{ put_echo lxm ; Out.to_string arg_buff}
and skip_equal = parse
space* '='? space* {()}
and arg2 = parse
'{'
{incr brace_nesting;
put_both_char '{' ;
arg2 lexbuf}
| '}'
{decr brace_nesting;
if !brace_nesting > 0 then begin
put_both_char '}' ; arg2 lexbuf
end else begin
put_echo_char '}' ;
Out.to_string arg_buff
end}
| "\\{" | "\\}" | "\\\\"
{blit_both lexbuf ; arg2 lexbuf }
| eof
{error "End of file in argument"}
| [^'\\''{''}']+
{blit_both lexbuf ; arg2 lexbuf }
| _
{let c = lexeme_char lexbuf 0 in
put_both_char c ; arg2 lexbuf}
and csname get_prim subst = parse
(space|'\n')+
{ blit_echo lexbuf ; csname get_prim subst lexbuf }
| '{'? "\\csname" space*
{blit_echo lexbuf ;
let r = incsname lexbuf in
"\\"^get_prim r}
| ""
{let r = Saver.String.arg lexbuf in
let r = subst r in
try
check_csname get_prim (MyLexing.from_string r)
with
| Exit -> r }
and check_csname get_prim = parse
| "\\csname" space*
{ let r = incsname lexbuf in
"\\"^get_prim r}
| command_name
| ""
{ raise Exit }
and incsname = parse
"\\endcsname" '}'?
{let lxm = lexeme lexbuf in
put_echo lxm ; Out.to_string arg_buff}
| _
{put_both_char (lexeme_char lexbuf 0) ;
incsname lexbuf}
| eof {error "End of file in command name"}
and cite_arg = parse
| space* '{' {cite_args_bis lexbuf}
| eof {raise Eof}
| "" {error "No opening ``{'' in citation argument"}
and cite_args_bis = parse
[^'}'' ''\t''\r''\n''%'',']+
{let lxm = lexeme lexbuf in lxm::cite_args_bis lexbuf}
| '%' [^'\n']* '\n' {cite_args_bis lexbuf}
| ',' {cite_args_bis lexbuf}
| (space|'\n')+ {cite_args_bis lexbuf}
| '}' {[]}
| "" {error "Bad syntax for \\cite argument"}
and num_arg = parse
| (space|'\n')+ {(fun get_int -> num_arg lexbuf get_int)}
| ['0'-'9']+
{fun _get_int ->
let lxm = lexeme lexbuf in
my_int_of_string lxm}
| "'" ['0'-'7']+
{fun _get_int ->let lxm = lexeme lexbuf in
my_int_of_string ("0o"^String.sub lxm 1 (String.length lxm-1))}
| '"' ['0'-'9' 'a'-'f' 'A'-'F']+ (* '"' *)
{fun _get_int ->let lxm = lexeme lexbuf in
my_int_of_string ("0x"^String.sub lxm 1 (String.length lxm-1))}
| '`' '\\' _
{fun _get_int ->let c = lexeme_char lexbuf 2 in
Char.code c}
| '`' '#' ['1'-'9']
{fun get_int ->
let lxm = lexeme lexbuf in
get_int (String.sub lxm 1 2)}
| '`' _
{fun _get_int ->let c = lexeme_char lexbuf 1 in
Char.code c}
| ""
{fun get_int ->
let s = Saver.String.arg lexbuf in
get_int s}
and filename = parse
[' ''\n']+ {put_echo (lexeme lexbuf) ; filename lexbuf}
| [^'\n''{'' ']+ {let lxm = lexeme lexbuf in put_echo lxm ; lxm}
| "" {Saver.String.arg lexbuf}
and remain = parse
_ * eof {Lexing.lexeme lexbuf}
and get_limits r = parse
space+ {get_limits r lexbuf}
| "\\limits" {get_limits (Some Limits) lexbuf}
| "\\nolimits" {get_limits (Some NoLimits) lexbuf}
| "\\intlimits" {get_limits (Some IntLimits) lexbuf}
| eof {raise (LimitEof r)}
| "" {r}
and get_sup = parse
| space* '^' {try Some (Saver.String.arg lexbuf) with Eof -> error "End of file after ^"}
| eof {raise Eof}
| "" {None}
and get_sub = parse
| space* '_' {try Some (Saver.String.arg lexbuf) with Eof -> error "End of file after _"}
| eof {raise Eof}
| "" {None}
and defargs = parse
| '#' ['1'-'9']
{let lxm = lexeme lexbuf in
put_echo lxm ;
lxm::defargs lexbuf}
| [^'{'] | "\\{"
{blit_both lexbuf ;
let r = in_defargs lexbuf in
r :: defargs lexbuf}
| "" {[]}
and in_defargs = parse
| "\\{" | "\\#" {blit_both lexbuf ; in_defargs lexbuf}
| [^'{''#'] {put_both_char (lexeme_char lexbuf 0) ; in_defargs lexbuf}
| "" {Out.to_string arg_buff}
and get_defargs = parse
[^'{']* {let r = lexeme lexbuf in r}
and tagout = parse
| "<br>" {Out.put_char tag_buff ' ' ; tagout lexbuf}
| '<' {intag lexbuf}
| " " {Out.put tag_buff " " ; tagout lexbuf}
| ">" {Out.put tag_buff ">" ; tagout lexbuf}
| "<" {Out.put tag_buff "<" ; tagout lexbuf}
| _ {Out.blit tag_buff lexbuf ; tagout lexbuf}
| eof {Out.to_string tag_buff}
and intag = parse
'>' {tagout lexbuf}
| '"' {instring lexbuf} (* '"' *)
| _ {intag lexbuf}
| eof {Out.to_string tag_buff}
and instring = parse
'"' {intag lexbuf}
| '\\' '"' {instring lexbuf}
| _ {instring lexbuf}
| eof {Out.to_string tag_buff}
and checklimits = parse
"\\limits" {true}
| "\\nolimits" {false}
| "" {false}
and eat_delim_init delim next i = parse
| eof {raise Eof}
| '{'
{ put_echo_char '{' ;
incr brace_nesting ;
let r = arg2 lexbuf in
check_comment lexbuf ;
if if_next_string delim lexbuf then begin
skip_delim_rec delim 0 lexbuf ;
r
end else begin
Out.put_char arg_buff '{' ;
Out.put arg_buff r ;
Out.put_char arg_buff '}' ;
eat_delim_rec delim next 0 lexbuf
end}
| "" {eat_delim_rec delim next i lexbuf}
and eat_delim_rec delim next i = parse
| "\\{"
{
put_echo "\\{" ;
match kmp_char delim next i '\\' with
| Stop _ ->
error "Delimitors cannot end with ``\\''"
| Continue i -> match kmp_char delim next i '{' with
| Stop s -> s
| Continue i -> eat_delim_rec delim next i lexbuf}
| '{'
{
put_echo_char '{' ;
Out.put arg_buff (if i > 0 then String.sub delim 0 i else "") ;
Out.put_char arg_buff '{' ;
incr brace_nesting ;
let r = arg2 lexbuf in
Out.put arg_buff r ;
Out.put_char arg_buff '}' ;
eat_delim_rec delim next 0 lexbuf
}
| _
{
let c = lexeme_char lexbuf 0 in
put_echo_char c ;
match kmp_char delim next i c with
| Stop s -> s
| Continue i -> eat_delim_rec delim next i lexbuf}
| eof
{error
("End of file in delimited argument, read:\n" ^
Out.to_string echo_buff)}
and skip_delim_init delim i = parse
| space|'\n' {skip_delim_init delim i lexbuf}
| "" {skip_delim_rec delim i lexbuf}
and skip_delim_rec delim i = parse
| _
{
let c = lexeme_char lexbuf 0 in
put_echo_char c ;
if c <> delim.[i] then
raise (Delim delim) ;
if i+1 < String.length delim then
skip_delim_rec delim (i+1) lexbuf}
| eof
{ error ("End of file checking delimiter ``"^delim^"''")}
and check_equal = parse
| '=' {true}
| "" {false}
and do_xyarg = parse
| [^'{']
{let lxm = Lexing.lexeme_char lexbuf 0 in
put_both_char lxm ;
do_xyarg lexbuf}
| eof {raise Eof}
| "" {Out.to_string arg_buff}
and simple_delim c = parse
| _ as x
{if c = x then begin
put_echo_char x ;
Out.to_string arg_buff
end else begin
put_both_char x ;
simple_delim c lexbuf
end
}
| eof
{error (Printf.sprintf "End of file in simple delim '%c'" c)}
and gobble_one_char = parse
| _ {()}
| "" {fatal ("Gobble at end of file")}
{
let arg = Saver.String.arg
let arg_list = Saver.List.arg
let opt = Saver.String.opt
let opt_list = Saver.List.opt
let start_echo = SaveUtils.start_echo
let get_echo = SaveUtils.get_echo
exception NoOpt = SaveUtils.NoOpt
exception LimitEof = SaveUtils.LimitEof
exception Eof = SaveUtils.Eof
let seen_par = SaveUtils.seen_par
let set_verbose = SaveUtils.set_verbose
let empty_buffs = SaveUtils.empty_buffs
exception Delim = SaveUtils.Delim
exception Error = SaveUtils.Error
let init_kmp s =
let l = String.length s in
let r = Array.make l (-1) in
let rec init_rec i j =
if i+1 < l then begin
if j = -1 || s.[i]=s.[j] then begin
r.(i+1) <- j+1 ;
init_rec (i+1) (j+1)
end else
init_rec i r.(j)
end in
init_rec 0 (-1) ;
r
let with_delim delim lexbuf =
let next = init_kmp delim in
check_comment lexbuf ;
let r = eat_delim_init delim next 0 lexbuf in
r
and skip_delim delim lexbuf =
check_comment lexbuf ;
skip_delim_init delim 0 lexbuf
let skip_blanks_init lexbuf =
let _ = skip_blanks lexbuf in
()
let arg_verbatim lexbuf =
ignore (skip_blanks lexbuf) ;
match first_char lexbuf with
| '{' ->
incr brace_nesting ;
arg2 lexbuf
| c -> simple_delim c lexbuf
let xy_arg lexbuf = do_xyarg lexbuf
}
|