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
|
/***********************************************************************/
/* */
/* 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 Q Public License version 1.0. */
/* */
/***********************************************************************/
/* $Id: parser.mly 7815 2007-01-29 16:44:16Z maranget $ */
/* 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
%token Tstar Tmaybe Tplus Tlparen Trparen Tcaret Tdash Tlet Tas Tsharp
%right Tas
%left Tsharp
%left Tor
%nonassoc CONCAT
%nonassoc Tmaybe Tstar Tplus
Tident Tchar Tstring Tunderscore Teof Tlbracket Tlparen
%start lexer_definition
%type <Syntax.lexer_definition> lexer_definition
%%
lexer_definition:
header named_regexps Trule definition other_definitions header Tend
{ {header = $1;
entrypoints = $4 :: List.rev $5;
trailer = $6} }
;
header:
Taction
{ $1 }
| /*epsilon*/
{ { 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*/
{ [] }
;
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 = {
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 }
;
%%
|
