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
|
/***********************************************************************/
/* */
/* 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 Q Public License version 1.0. */
/* */
/***********************************************************************/
/* The grammar for lexer definitions */
%{
open Syntax
(* Auxiliaries for the parser. *)
let named_regexps =
(Hashtbl.create 13 : (string, regular_expression) Hashtbl.t)
let regexp_for_string s =
let rec re_string n =
if n >= String.length s then Epsilon
else if succ n = String.length s then
Characters (Cset.singleton (Char.code s.[n]))
else
Sequence
(Characters(Cset.singleton (Char.code s.[n])),
re_string (succ n))
in re_string 0
let rec remove_as = function
| Bind (e,_) -> remove_as e
| Epsilon|Eof|Characters _ as e -> e
| Sequence (e1, e2) -> Sequence (remove_as e1, remove_as e2)
| Alternative (e1, e2) -> Alternative (remove_as e1, remove_as e2)
| Repetition e -> Repetition (remove_as e)
let as_cset = function
| Characters s -> s
| _ -> raise Cset.Bad
%}
%token <string> Tident
%token <int> Tchar
%token <string> Tstring
%token <Syntax.location> Taction
%token Trule Tparse Tparse_shortest Tand Tequal Tend Tor Tunderscore Teof
Tlbracket Trbracket Trefill
%token Tstar Tmaybe Tplus Tlparen Trparen Tcaret Tdash Tlet Tas Tsharp
%right Tas
%left Tor
%nonassoc CONCAT
%nonassoc Tmaybe Tstar Tplus
%left Tsharp
%nonassoc Tident Tchar Tstring Tunderscore Teof Tlbracket Tlparen
%start lexer_definition
%type <Syntax.lexer_definition> lexer_definition
%%
lexer_definition:
header named_regexps refill_handler Trule definition other_definitions
header Tend
{ {header = $1;
refill_handler = $3;
entrypoints = $5 :: List.rev $6;
trailer = $7} }
;
header:
Taction
{ $1 }
| /*epsilon*/
{ { loc_file = ""; start_pos = 0; end_pos = 0; start_line = 1;
start_col = 0 } }
;
named_regexps:
named_regexps Tlet Tident Tequal regexp
{ Hashtbl.add named_regexps $3 $5 }
| /*epsilon*/
{ () }
;
other_definitions:
other_definitions Tand definition
{ $3::$1 }
| /*epsilon*/
{ [] }
;
refill_handler:
| Trefill Taction { Some $2 }
| /*empty*/ { None }
;
definition:
Tident arguments Tequal Tparse entry
{ {name=$1 ; shortest=false ; args=$2 ; clauses=$5} }
| Tident arguments Tequal Tparse_shortest entry
{ {name=$1 ; shortest=true ; args=$2 ; clauses=$5} }
;
arguments:
Tident arguments { $1::$2 }
| /*epsilon*/ { [] }
;
entry:
case rest_of_entry
{ $1::List.rev $2 }
| Tor case rest_of_entry
{ $2::List.rev $3 }
;
rest_of_entry:
rest_of_entry Tor case
{ $3::$1 }
|
{ [] }
;
case:
regexp Taction
{ ($1,$2) }
;
regexp:
Tunderscore
{ Characters Cset.all_chars }
| Teof
{ Eof }
| Tchar
{ Characters (Cset.singleton $1) }
| Tstring
{ regexp_for_string $1 }
| Tlbracket char_class Trbracket
{ Characters $2 }
| regexp Tstar
{ Repetition $1 }
| regexp Tmaybe
{ Alternative(Epsilon, $1) }
| regexp Tplus
{ Sequence(Repetition (remove_as $1), $1) }
| regexp Tsharp regexp
{
let s1 = as_cset $1
and s2 = as_cset $3 in
Characters (Cset.diff s1 s2)
}
| regexp Tor regexp
{ Alternative($1,$3) }
| regexp regexp %prec CONCAT
{ Sequence($1,$2) }
| Tlparen regexp Trparen
{ $2 }
| Tident
{ try
Hashtbl.find named_regexps $1
with Not_found ->
let p = Parsing.symbol_start_pos () in
Printf.eprintf "File \"%s\", line %d, character %d:\n\
Reference to unbound regexp name `%s'.\n"
p.Lexing.pos_fname p.Lexing.pos_lnum
(p.Lexing.pos_cnum - p.Lexing.pos_bol)
$1;
exit 2 }
| regexp Tas ident
{let p1 = Parsing.rhs_start_pos 3
and p2 = Parsing.rhs_end_pos 3 in
let p = {
loc_file = p1.Lexing.pos_fname ;
start_pos = p1.Lexing.pos_cnum ;
end_pos = p2.Lexing.pos_cnum ;
start_line = p1.Lexing.pos_lnum ;
start_col = p1.Lexing.pos_cnum - p1.Lexing.pos_bol ; } in
Bind ($1, ($3, p))}
;
ident:
Tident {$1}
;
char_class:
Tcaret char_class1
{ Cset.complement $2 }
| char_class1
{ $1 }
;
char_class1:
Tchar Tdash Tchar
{ Cset.interval $1 $3 }
| Tchar
{ Cset.singleton $1 }
| char_class1 char_class1 %prec CONCAT
{ Cset.union $1 $2 }
;
%%
|
