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
|
(***********************************************************************)
(* *)
(* HEVEA *)
(* *)
(* Luc Maranget, projet PARA, INRIA Rocquencourt *)
(* *)
(* Copyright 1998 Institut National de Recherche en Informatique et *)
(* Automatique. Distributed only by permission. *)
(* *)
(***********************************************************************)
{
open Lexing
open SaveUtils
module type Config = sig
type t
val of_string : string -> t
val of_out : Out.t -> t
end
module type S = sig
type out
val opt : Lexing.lexbuf -> out
val arg : Lexing.lexbuf -> out
val arg2 : Lexing.lexbuf -> out
end
module Make(C:Config) = struct
type out = C.t
}
let command_name =
'\\' (( ['@''A'-'Z' 'a'-'z']+ '*'?) | [^ 'A'-'Z' 'a'-'z'] | "\\*")
let space = [' ''\t''\r']
rule opt = parse
| space* '\n'? space* '['
{put_echo (lexeme lexbuf) ;
opt2 lexbuf}
| '%' { skip_comment lexbuf ; opt lexbuf }
| eof {raise Eof}
| "" {raise NoOpt}
and opt2 = parse
| '{' {incr brace_nesting;
put_both_char '{' ; opt2 lexbuf}
| '}' { decr brace_nesting;
if !brace_nesting >= 0 then begin
put_both_char '}' ; opt2 lexbuf
end else begin
error "Bad brace nesting in optional argument"
end}
| ']'
{if !brace_nesting > 0 then begin
put_both_char ']' ; opt2 lexbuf
end else begin
put_echo_char ']' ;
C.of_out arg_buff
end}
| '%' { skip_comment lexbuf ; opt2 lexbuf }
| command_name as lxm
{put_both lxm ; opt2 lexbuf }
| _ as lxm
{put_both_char lxm ; opt2 lexbuf }
and skip_comment = parse
| eof {()}
| '\n' space* {()}
| _ {skip_comment lexbuf}
and arg = parse
space+ | '\n'+ {put_echo (lexeme lexbuf) ; arg lexbuf}
| '{'
{incr brace_nesting;
put_echo_char '{' ;
arg2 lexbuf}
| '%'
{skip_comment lexbuf ; arg lexbuf}
| "\\box" '\\' (['A'-'Z' 'a'-'z']+ '*'? | [^ 'A'-'Z' 'a'-'z'])
{let lxm = lexeme lexbuf in
put_echo lxm ;
C.of_string lxm}
| command_name
{blit_both lexbuf ;
skip_blanks lexbuf}
| '#' ['1'-'9']
{let lxm = lexeme lexbuf in
put_echo lxm ;
C.of_string lxm}
| [^ '}']
{let c = lexeme_char lexbuf 0 in
put_both_char c ;
C.of_out arg_buff}
| eof {raise Eof}
| "" {error "Argument expected"}
and skip_blanks = parse
| space* '\n' as lxm
{seen_par := false ;
put_echo lxm ;
more_skip lexbuf}
| space* as lxm
{put_echo lxm ; C.of_out 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 ; C.of_out arg_buff}
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 '}' ;
C.of_out arg_buff
end}
| '%'
{skip_comment lexbuf ; arg2 lexbuf}
| command_name
| [^'\\''{''}''%']+
{blit_both lexbuf ; arg2 lexbuf }
| _
{let c = lexeme_char lexbuf 0 in
put_both_char c ; arg2 lexbuf}
| eof
{error "End of file in argument"}
{
end
module String =
Make
(struct
type t = string
let of_string x = x
let of_out = Out.to_string
end)
module List =
Make
(struct
type t = string list
let of_string x = [x]
let of_out = Out.to_list
end)
}
|
