alphaCaml.opp.exp 7.39 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
%{

open Syntax

%}
%{

  let error i msg =
    Error.error2 (Parsing.rhs_start_pos i) (Parsing.rhs_end_pos i) msg

  (* Used to collect inline pattern type definitions without too much
     fuss. [inline_defs] gathers the inline definitions found so far.
     [current_params] contains the type parameters currently in scope. *)

  let inline_defs =
    ref []

  let current_params =
    ref []

%}
%start phrase
%token AND
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
%token ATOM
%token BAR
%token BINDS
%token COLON
%token COMMA
%token CONTAINER
%token DOT
%token EOF
%token EQUAL
%token IDENTIFIER
%token INNER
%token LANGLE
%token LBRACE
%token <Lexing.position * Lexing.position * string> LID
%token LPAREN
%token MODULE
%token NEUTRAL
%token <string> OCAML
%token OF
%token OUTER
%token QUOTE
%token RANGLE
%token RBRACE
%token RPAREN
%token SEMICOLON
%token SORT
%token STAR
%token TYPE
%token <Lexing.position * Lexing.position * string> UID
%token WITH
54
55
56
57
%type <string * Syntax.declaration list> phrase
%%

typevar:
58
  _1 = QUOTE _2 = LID
59
    {    ( _2 )}
60
61

typevars:
62
  _1 = typevar
63
64
65
    {    ( [ _1 ] )}
| _1 = typevars _2 = COMMA _3 = typevar
    {    ( _3 :: _1 )}
66
67

params:
68
  
69
70
71
72
73
    {    ( [] )}
| _1 = typevar
    {    ( [ _1 ] )}
| _1 = LPAREN _2 = typevars _3 = RPAREN
    {    ( List.rev _2 )}
74
75

params_and_set_current:
76
  _1 = params
77
    {    ( let params = _1 in
78
      current_params := params;
79
      params )}
80
81

identifier:
82
  _1 = LID
83
84
85
86
87
    {    ( _1 )}
| _1 = UID _2 = DOT _3 = identifier
    {    ( let (pos1, _, id1) = _1
      and (_, pos2, id2) = _3 in
      (pos1, pos2, id1 ^ "." ^ id2) )}
88
89

container:
90
  
91
92
93
    {    ( None )}
| _1 = identifier
    {    ( Some _1 )}
94
95

expfactor:
96
  _1 = ATOM _2 = LID
97
98
99
100
101
102
103
104
105
106
107
108
109
110
    {    ( EAtom _2 )}
| _1 = OCAML
    {    ( EEscape _1 )}
| _1 = params _2 = LID _3 = container
    {    ( ETypRef (_3, _1, _2) )}
| _1 = LANGLE _2 = params _3 = LID _4 = RANGLE
    {    ( EAbstraction (_2, _3) )}
| _1 = LANGLE _2 = LPAREN _3 = LID _4 = BINDS _5 = sorts _6 = RPAREN _7 = patrhs _8 = RANGLE
    {    ( inline_defs := DeclPatType (!current_params, _3, _5, _7) :: !inline_defs;
      EAbstraction (!current_params, _3) )}
| _1 = ATOM _2 = error
    {    ( error 2 "\"atom\" should be followed by a sort (a lowercase identifier)" )}
| _1 = LANGLE _2 = error
    {    ( error 2 "The contents of an abstraction should be either\n\
111
               a (possibly parameterized) pattern type identifier or\n\
112
113
114
115
116
117
118
119
120
               an inline pattern type definition." )}
| _1 = INNER
    {    ( error 1 "\"inner\" does not make sense in an expression type." )}
| _1 = OUTER
    {    ( error 1 "\"outer\" does not make sense in an expression type." )}
| _1 = NEUTRAL
    {    ( error 1 "\"neutral\" does not make sense in an expression type." )}
| _1 = error
    {    ( error 1 "Invalid expression factor." )}
121
122

patfactor:
123
  _1 = ATOM _2 = LID
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
    {    ( PAtom _2 )}
| _1 = OCAML
    {    ( PEscape _1 )}
| _1 = params _2 = LID _3 = container
    {    ( PTypRef (MRef, _3, _1, _2) )}
| _1 = patmodifier _2 = params _3 = LID _4 = container
    {    ( PTypRef (_1, _4, _2, _3) )}
| _1 = ATOM _2 = error
    {    ( error 2 "\"atom\" should be followed by a sort (a lowercase identifier)" )}
| _1 = patmodifier _2 = error
    {    ( error 2 "\"inner\", \"outer\", and \"neutral\" should be followed by a\n(possibly parameterized) type identifier." )}
| _1 = LANGLE
    {    ( error 1 "An abstraction does not make sense in a pattern type." )}
| _1 = error
    {    ( error 1 "Invalid pattern factor." )}
139
140

patmodifier:
141
  _1 = INNER
142
143
144
145
146
    {    ( MInner )}
| _1 = OUTER
    {    ( MOuter )}
| _1 = NEUTRAL
    {    ( MNeutral )}
147
148

expfactors:
149
  _1 = expfactor
150
151
152
153
154
    {    ( [ (None, _1) ] )}
| _1 = expfactors _2 = STAR _3 = expfactor
    {    ( (None, _3) :: _1 )}
| _1 = expfactors _2 = error
    {    ( error 2 "Undetermined syntax error." )}
155
156

patfactors:
157
  _1 = patfactor
158
159
160
161
162
    {    ( [ (None, _1) ] )}
| _1 = patfactors _2 = STAR _3 = patfactor
    {    ( (None, _3) :: _1 )}
| _1 = patfactors _2 = error
    {    ( error 2 "Undetermined syntax error." )}
163
164

explfactor:
165
  _1 = LID _2 = COLON _3 = expfactor
166
167
168
    {    ( (Some _1, _3) )}
| _1 = error
    {    ( error 1 "\"<label> : <expression factor>\" expected." )}
169
170

explfactors:
171
  _1 = explfactor
172
173
174
175
176
    {    ( [ _1 ] )}
| _1 = explfactors _2 = SEMICOLON _3 = explfactor
    {    ( _3 :: _1 )}
| _1 = explfactors _2 = error
    {    ( error 2 "\";\" or \"}\" expected." )}
177
178

patlfactor:
179
  _1 = LID _2 = COLON _3 = patfactor
180
181
182
    {    ( (Some _1, _3) )}
| _1 = error
    {    ( error 1 "\"<label> : <pattern factor>\" expected." )}
183
184

patlfactors:
185
  _1 = patlfactor
186
187
188
189
190
    {    ( [ _1 ] )}
| _1 = patlfactors _2 = SEMICOLON _3 = patlfactor
    {    ( _3 :: _1 )}
| _1 = patlfactors _2 = error
    {    ( error 2 "\";\" or \"}\" expected." )}
191
192

expsummand:
193
  _1 = BAR _2 = UID
194
195
196
197
198
    {    ( Summand (Some _2, []) )}
| _1 = BAR _2 = UID _3 = OF _4 = expfactors
    {    ( Summand (Some _2, List.rev _4) )}
| _1 = BAR _2 = error
    {    ( error 2 "\"| <uppercase identifier> [ of <expression factors> ]\" expected." )}
199
200

patsummand:
201
  _1 = BAR _2 = UID
202
203
204
205
206
    {    ( Summand (Some _2, []) )}
| _1 = BAR _2 = UID _3 = OF _4 = patfactors
    {    ( Summand (Some _2, List.rev _4) )}
| _1 = BAR _2 = error
    {    ( error 2 "\"| <uppercase identifier> [ of <pattern factors> ]\" expected." )}
207
208

expsummands:
209
  _1 = expsummand
210
211
212
    {    ( [ _1 ] )}
| _1 = expsummands _2 = expsummand
    {    ( _2 :: _1 )}
213
214

patsummands:
215
  _1 = patsummand
216
217
218
    {    ( [ _1 ] )}
| _1 = patsummands _2 = patsummand
    {    ( _2 :: _1 )}
219
220

sorts:
221
  _1 = LID
222
223
224
    {    ( [ _1 ] )}
| _1 = sorts _2 = COMMA _3 = LID
    {    ( _3 :: _1 )}
225
226

optional_semicolon:
227
  
228
229
230
    {    ( () )}
| _1 = SEMICOLON
    {    ( () )}
231
232

exprhs:
233
  _1 = expsummands
234
235
236
237
238
    {    ( List.rev _1 )}
| _1 = expfactors
    {    ( [ Summand (None, List.rev _1) ] )}
| _1 = LBRACE _2 = explfactors _3 = optional_semicolon _4 = RBRACE
    {    ( [ Summand (None, List.rev _2) ] )}
239
240

patrhs:
241
  _1 = patsummands
242
243
244
245
246
    {    ( List.rev _1 )}
| _1 = patfactors
    {    ( [ Summand (None, List.rev _1) ] )}
| _1 = LBRACE _2 = patlfactors _3 = RBRACE
    {    ( [ Summand (None, List.rev _2) ] )}
247
248

declaration:
249
  _1 = TYPE _2 = params_and_set_current _3 = LID _4 = EQUAL _5 = exprhs
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
    {    ( DeclExpType (_2, _3, _5) )}
| _1 = TYPE _2 = params_and_set_current _3 = LID _4 = BINDS _5 = sorts _6 = EQUAL _7 = patrhs
    {    ( DeclPatType (_2, _3, _5, _7) )}
| _1 = TYPE _2 = error
    {    ( error 2 "\"type [ <parameters> ] <identifier> [ binds <sorts> ] = <type definition>\"\nexpected." )}
| _1 = SORT _2 = LID
    {    ( DeclSort _2 )}
| _1 = SORT _2 = error
    {    ( error 2 "\"sort <identifier>\" expected." )}
| _1 = CONTAINER _2 = identifier _3 = WITH _4 = identifier _5 = AND _6 = identifier
    {    ( DeclContainer (_2, _4, _6) )}
| _1 = CONTAINER _2 = error
    {    ( error 2 "\"container <identifier> with <identifier> and <identifier>\" expected.\n\
               The three identifiers are the container type and its map and fold functions." )}
| _1 = IDENTIFIER _2 = MODULE _3 = UID
    {    ( DeclIdentifier _3 )}
| _1 = IDENTIFIER _2 = error
    {    ( error 2 "\"identifier module <uppercase identifier>\" expected." )}
268
269

declarations:
270
  
271
272
273
    {    ( [] )}
| _1 = declarations _2 = declaration
    {    ( _2 :: _1 )}
274
275

prologue:
276
  
277
278
279
    {    ( "\n\n" )}
| _1 = OCAML
    {    ( "\n\n(* Prologue. *)" ^ _1 )}
280
281

phrase:
282
  _1 = prologue _2 = declarations _3 = EOF
283
284
285
    {    ( _1, List.rev (!inline_defs @ _2) )}
| _1 = error
    {    ( error 1 "\"type\", \"sort\", \"container\",\nor \"identifier module\" declaration expected." )}
286
287
288
289

%%


290