Annotation of /sml/trunk/src/compiler/Parse/parse/ml.grm

Parent Directory | Revision Log

---

Revision 79 - (view) (download)

1 :	monnier	16	(* ml.grm
2 :			*
3 :			* Copyright 1989,1992 by AT&T Bell Laboratories
4 :			*)
5 :
6 :			open Ast ErrorMsg Symbol FastSymbol AstUtil Fixity
7 :
8 :			type raw_symbol = FastSymbol.raw_symbol
9 :
10 :			fun markexp (e as MarkExp _, _, _) = e
11 :			| markexp(e,a,b) = MarkExp(e,(a,b))
12 :			(*fun markdec((d as MarkDec _, e), _,_) = (d,e)
13 :			| markdec((d,e),a,b) = (MarkDec(d,(a,b)),e)
14 :			*)
15 :			fun markdec(d as MarkDec _, _,_) = d
16 :			| markdec(d,a,b) = MarkDec(d,(a,b))
17 :
18 :			val asteriskHash = StrgHash.hashString "*"
19 :			val asteriskString = "*"
20 :			val equalHash = StrgHash.hashString "="
21 :			val equalString = "="
22 :			val bogusHash = StrgHash.hashString "BOGUS"
23 :			val bogusString = "BOGUS"
24 :			val quotedBogusHash = StrgHash.hashString "'BOGUS"
25 :			val quotedBogusString = "'BOGUS"
26 :			val quotedBogusHash = StrgHash.hashString "'BOGUS"
27 :			val quotedBogusString = "'BOGUS"
28 :
29 :			%%
30 :			%term
31 :			EOF | SEMICOLON
32 :			| ID of FastSymbol.raw_symbol | TYVAR of FastSymbol.raw_symbol
33 :			| INT of IntInf.int | INT0 of IntInf.int
34 :			| WORD of IntInf.int
35 :			| REAL of string
36 :			| STRING of string
37 :			| CHAR of string
38 :			| ABSTYPE | AND
39 :	league	79	| ARROW | AS | ASSERT | BAR | CASE | DATATYPE | DOTDOTDOT | ELSE | END | EQUALOP
40 :	monnier	16	| EQTYPE | EXCEPTION | DO | DOT | DARROW | FN | FUN | FUNCTOR | HANDLE
41 :			| HASH | IF | IN | INCLUDE | INFIX | INFIXR | LAZY | LET | LOCAL | NONFIX | OF
42 :			| OP | OPEN | OVERLOAD | RAISE | REC | SHARING | SIG | SIGNATURE | STRUCT
43 :			| STRUCTURE | THEN | TYPE | VAL | WHERE | WHILE | WILD | WITH | WITHTYPE
44 :			| ASTERISK | COLON | COLONGT | COMMA | LBRACE | LBRACKET | LPAREN | RBRACE
45 :			| RBRACKET | RPAREN | ORELSE | ANDALSO | FUNSIG | VECTORSTART | BEGINQ
46 :			| ENDQ of string | OBJL of string | AQID of FastSymbol.raw_symbol
47 :
48 :			%nonterm ident of FastSymbol.raw_symbol
49 :			| id of FastSymbol.raw_symbol
50 :			| int of IntInf.int
51 :			| op_op of unit
52 :			| qid of (FastSymbol.raw_symbol ->symbol) -> symbol list
53 :			| selector of symbol
54 :			| tycon of symbol list
55 :			| tlabel of (symbol * ty)
56 :			| tlabels of (symbol * ty) list
57 :			| ty' of ty
58 :			| tuple_ty of ty list
59 :			| ty of ty
60 :			| ty0_pc of ty list
61 :			| match of rule list
62 :			| rule of rule
63 :			| elabel of (symbol * exp)
64 :			| elabels of (symbol * exp) list
65 :			| exp_ps of exp list
66 :			| exp of exp
67 :			| app_exp of exp fixitem list
68 :			| aexp of exp
69 :			| exp_list of exp list
70 :			| exp_2c of exp list
71 :			| quote of exp list
72 :			| ot_list of exp list
73 :			| pat of pat
74 :			| apat of pat fixitem
75 :			| apat' of pat
76 :			| plabel of (symbol * pat)
77 :			| plabels of ((symbol * pat) list * bool)
78 :			| pat_2c of pat list
79 :			| pat_list of pat list
80 :			| or_pat_list of pat list
81 :			| vb of vb list
82 :			| constraint of ty option
83 :			| rvb of rvb list
84 :			| fb' of clause list
85 :			| fb of fb list
86 :			| apats of pat fixitem list
87 :			| clause of clause
88 :			| tb of tb list
89 :			| tyvars of tyvar list
90 :			| tyvarseq of tyvar list
91 :			| tyvar_pc of tyvar list
92 :			| db of db list
93 :			| dbrhs of dbrhs
94 :			| constrs of (symbol * ty option) list
95 :			| constr of symbol * ty option
96 :			| eb of eb list
97 :			| qid_p of Symbol.symbol list list
98 :			| fixity of fixity
99 :			| ldec of dec
100 :			| exp_pa of exp list
101 :			| ldecs of dec
102 :			| ops of symbol list
103 :			| spec_s of spec list
104 :			| spec of spec list
105 :			| idents of spec list
106 :			| strspec of (symbol * sigexp * path option) list
107 :			| fctspec of (symbol * fsigexp) list
108 :			| tyspec of (symbol * tyvar list * ty option) list
109 :			| valspec of (symbol * ty) list
110 :			| exnspec of (symbol * ty option) list
111 :			| sharespec of spec list
112 :			| patheqn of (FastSymbol.raw_symbol ->symbol) -> symbol list list
113 :			| whspec of wherespec list
114 :			| sign of sigexp
115 :			| sigconstraint_op of sigexp sigConst
116 :			| fsigconstraint_op of fsigexp sigConst
117 :			| sigb of sigb list
118 :			| fsigb of fsigb list
119 :			| fsig of fsigexp
120 :			| str of strexp
121 :			| arg_fct of (strexp * bool) list
122 :			| strdec of dec
123 :			| strdecs of dec
124 :			| sdec of dec
125 :			| sdecs of dec
126 :			| sdecs' of dec
127 :			| strb of strb list
128 :			| fparam of symbol option * sigexp
129 :			| fparamList of (symbol option * sigexp) list
130 :			| fctb of fctb list
131 :			| fct_exp of fsigexp sigConst -> fctexp
132 :			| interdec of dec
133 :
134 :			%verbose
135 :			%pos int
136 :			%arg (error) : pos * pos -> ErrorMsg.complainer
137 :			%start interdec
138 :			%eop EOF SEMICOLON
139 :			%noshift EOF
140 :
141 :			%nonassoc WITHTYPE
142 :			%right AND
143 :			%right ARROW
144 :			%right DARROW
145 :			%left DO
146 :			%left ELSE
147 :			%left RAISE
148 :			%right HANDLE
149 :			%left ORELSE
150 :			%left ANDALSO
151 :			%right AS
152 :			%left COLON
153 :
154 :
155 :			%name ML
156 :
157 :	league	79	%keyword ABSTYPE AND AS ASSERT CASE DATATYPE DOTDOTDOT ELSE END
158 :	monnier	16	EQTYPE EXCEPTION DO DARROW FN FUN FUNCTOR HANDLE
159 :			IF IN INCLUDE INFIX INFIXR LAZY LET LOCAL NONFIX OF OP
160 :			OPEN OVERLOAD RAISE REC SHARING SIG SIGNATURE STRUCT
161 :			STRUCTURE THEN TYPE VAL WHILE WHERE WITH WITHTYPE
162 :			ORELSE ANDALSO
163 :
164 :			%change -> VAL | -> THEN | -> ELSE | -> LPAREN | -> SEMICOLON |
165 :			DARROW -> EQUALOP | EQUALOP -> DARROW | AND -> ANDALSO | COLON -> OF |
166 :			SEMICOLON -> COMMA | COMMA -> SEMICOLON |
167 :			-> IN ID END | -> ELSE ID
168 :
169 :			%value ID (rawSymbol(bogusHash,bogusString))
170 :			%value TYVAR (rawSymbol(quotedBogusHash,quotedBogusString))
171 :			%value INT (IntInf.fromInt 1)
172 :			%value INT0 (IntInf.fromInt 0)
173 :			%value WORD (IntInf.fromInt 0)
174 :			%value REAL ("0.0")
175 :			%value STRING ("")
176 :			%value CHAR ("a")
177 :
178 :			%%
179 :
180 :			int : INT (INT)
181 :			| INT0 (INT0)
182 :
183 :			id : ID (ID)
184 :			| ASTERISK (rawSymbol (asteriskHash,asteriskString))
185 :
186 :			ident : ID (ID)
187 :			| ASTERISK (rawSymbol (asteriskHash,asteriskString))
188 :			| EQUALOP (rawSymbol (equalHash,equalString))
189 :
190 :			op_op : OP (error (OPleft,OPright) WARN "unnecessary `op'"
191 :			nullErrorBody)
192 :			| ()
193 :
194 :			qid : ID DOT qid (fn kind => strSymbol ID :: qid kind)
195 :			| ident (fn kind => [kind ident])
196 :
197 :			selector: id (labSymbol id)
198 :			| INT (Symbol.labSymbol(IntInf.toString INT))
199 :
200 :			tycon : ID DOT tycon (strSymbol ID :: tycon)
201 :			| ID ([tycSymbol ID])
202 :
203 :			tlabel : selector COLON ty (selector, ty )
204 :
205 :			tlabels : tlabel COMMA tlabels (tlabel :: tlabels)
206 :			| tlabel ([tlabel])
207 :
208 :			ty' : TYVAR (MarkTy (VarTy(Tyv(tyvSymbol TYVAR)),
209 :			(TYVARleft,TYVARright)))
210 :			| LBRACE tlabels
211 :			RBRACE (MarkTy(RecordTy tlabels,(LBRACEleft,RBRACEright)))
212 :			| LBRACE RBRACE (RecordTy [])
213 :			| LPAREN ty0_pc RPAREN tycon
214 :			(MarkTy(ConTy(tycon,ty0_pc),(tyconleft,tyconright)))
215 :			| LPAREN ty RPAREN (ty)
216 :			| ty' tycon (MarkTy(ConTy(tycon,[ty']),(tyconleft,tyconright)))
217 :			| tycon (MarkTy(ConTy(tycon,[]),(tyconleft,tyconright)))
218 :
219 :			tuple_ty : ty' ASTERISK tuple_ty (ty' :: tuple_ty)
220 :			| ty' ASTERISK ty' ([ty'1,ty'2])
221 :
222 :			ty : tuple_ty (TupleTy(tuple_ty))
223 :			| ty ARROW ty (ConTy([arrowTycon], [ty1,ty2]))
224 :			| ty' (ty')
225 :
226 :			ty0_pc : ty COMMA ty ([ty1,ty2])
227 :			| ty COMMA ty0_pc (ty :: ty0_pc)
228 :
229 :			match : rule ([rule])
230 :			| rule BAR match (rule :: match)
231 :
232 :			rule : pat DARROW exp (Rule{pat=pat,
233 :			exp=markexp(exp,expleft,expright)})
234 :
235 :			(* EXPRESSIONS *)
236 :
237 :			elabel : selector EQUALOP exp (selector,exp)
238 :
239 :			elabels : elabel COMMA elabels (elabel :: elabels)
240 :			| elabel ([elabel])
241 :
242 :			exp_ps : exp ([exp])
243 :			| exp SEMICOLON exp_ps (exp :: exp_ps)
244 :
245 :			exp : exp HANDLE match (HandleExp{expr=exp,rules=match})
246 :
247 :			| exp ORELSE exp (OrelseExp(markexp(exp1,exp1left,exp1right),
248 :			markexp(exp2,exp2left,exp2right)))
249 :			| exp ANDALSO exp (AndalsoExp(markexp(exp1,exp1left,exp1right),
250 :			markexp(exp2,exp2left,exp2right)))
251 :			| exp COLON ty (ConstraintExp{expr=exp,constraint=ty})
252 :			| app_exp (FlatAppExp(app_exp))
253 :			| FN match (markexp(FnExp match, FNleft,matchright))
254 :			| CASE exp OF match (markexp(CaseExp{expr=exp, rules=match},
255 :			CASEleft,matchright))
256 :			| WHILE exp DO exp (WhileExp
257 :			{test=markexp(exp1, exp1left, exp1right),
258 :			expr=markexp(exp2, exp2left, exp2right)})
259 :			| IF exp THEN exp ELSE exp (IfExp{test=exp1,
260 :			thenCase=markexp(exp2,exp2left,exp2right),
261 :			elseCase=markexp(exp3,exp3left,exp3right)})
262 :			| RAISE exp (markexp(markexp(RaiseExp exp, expleft,expright),
263 :			RAISEleft,expright))
264 :	league	79	| ASSERT exp (markexp(markexp(AssertExp exp, expleft,expright),
265 :			ASSERTleft,expright))
266 :	monnier	16
267 :			app_exp : aexp ([{item=markexp(aexp,aexpleft,aexpright),
268 :			region=(aexpleft,aexpright), fixity=NONE}])
269 :			| ident ([let val (v,f) = var'n'fix ident
270 :			in {item=markexp(VarExp [v],identleft,identright),
271 :			region=(identleft,identright),
272 :			fixity=SOME f}
273 :			end])
274 :			| aexp app_exp ({item=markexp(aexp,aexpleft,aexpright),
275 :			region=(aexpleft,aexpright), fixity=NONE}
276 :			:: app_exp)
277 :			| ident app_exp (let val (v,f) = var'n'fix ident
278 :			in {item=markexp(VarExp [v],identleft,identright),
279 :			region=(identleft,identright),
280 :			fixity=SOME f} :: app_exp
281 :			end)
282 :
283 :			aexp : OP ident (VarExp [varSymbol ident])
284 :			| ID DOT qid (VarExp (strSymbol ID :: qid varSymbol))
285 :			| int (IntExp int)
286 :			| WORD (WordExp WORD)
287 :			| REAL (RealExp REAL)
288 :			| STRING (StringExp STRING)
289 :			| CHAR (CharExp CHAR)
290 :			| HASH selector (markexp(SelectorExp selector,
291 :			HASHleft, selectorright))
292 :			| LBRACE elabels RBRACE (markexp(RecordExp elabels,
293 :			LBRACEleft,RBRACEright))
294 :			| LBRACE RBRACE (RecordExp nil)
295 :			| LPAREN RPAREN (unitExp)
296 :			| LPAREN exp_ps RPAREN (SeqExp exp_ps)
297 :			| LPAREN exp_2c RPAREN (TupleExp exp_2c)
298 :			| LBRACKET exp_list RBRACKET (ListExp exp_list)
299 :			| LBRACKET RBRACKET (ListExp nil)
300 :			| VECTORSTART exp_list RBRACKET (VectorExp exp_list)
301 :			| VECTORSTART RBRACKET (VectorExp nil)
302 :			| LET ldecs IN exp_ps END
303 :			(markexp (LetExp{dec=markdec(ldecs,ldecsleft,
304 :			ldecsright),
305 :			expr=SeqExp exp_ps},
306 :			LETleft,ENDright))
307 :			| AQID (VarExp([varSymbol AQID]))
308 :			| quote (ListExp quote)
309 :
310 :			quote : BEGINQ ENDQ ([QuoteExp ENDQ])
311 :			| BEGINQ ot_list ENDQ (ot_list @ [QuoteExp ENDQ])
312 :
313 :			ot_list : OBJL aexp ([QuoteExp OBJL,AntiquoteExp aexp])
314 :			| OBJL aexp ot_list (QuoteExp OBJL :: AntiquoteExp aexp ::
315 :			ot_list)
316 :
317 :			exp_2c : exp COMMA exp_2c (exp :: exp_2c)
318 :			| exp COMMA exp ([exp1, exp2])
319 :
320 :			exp_list : exp ([exp])
321 :			| exp COMMA exp_list (exp :: exp_list)
322 :
323 :			pat : pat AS pat (layered(pat1, pat2,
324 :			error(pat1left,pat2right)))
325 :			| pat COLON ty (ConstraintPat{pattern=pat, constraint=ty})
326 :			| apats (FlatAppPat apats)
327 :
328 :			apat : apat' ({item=apat', region=(apat'left,apat'right),
329 :			fixity=NONE})
330 :			| LPAREN pat RPAREN ({item=pat,
331 :			region=(LPARENleft,RPARENright),
332 :			fixity=NONE})
333 :			| id (let val (v,f) = var'n'fix id
334 :			in {item=VarPat [v],
335 :			region=(idleft,idright),
336 :			fixity=SOME f} end)
337 :			| LPAREN RPAREN ({item=unitPat,fixity=NONE,
338 :			region=(LPARENleft,RPARENright)})
339 :			| LPAREN pat COMMA pat_list RPAREN
340 :			({item=TuplePat(pat :: pat_list),
341 :			region=(LPARENleft,RPARENright),
342 :			fixity=NONE})
343 :			| LPAREN pat BAR or_pat_list RPAREN
344 :			({item=OrPat(pat :: or_pat_list),
345 :			region=(LPARENleft,RPARENright),
346 :			fixity=NONE})
347 :
348 :			apat' : OP ident (VarPat [varSymbol ident])
349 :			| ID DOT qid (VarPat (strSymbol ID :: qid varSymbol))
350 :			| int (IntPat int)
351 :			| WORD (WordPat WORD)
352 :			| STRING (StringPat STRING)
353 :			| CHAR (CharPat CHAR)
354 :			| WILD (WildPat)
355 :			| LBRACKET RBRACKET (ListPat nil)
356 :			| LBRACKET pat_list
357 :			RBRACKET (ListPat pat_list)
358 :			| VECTORSTART RBRACKET (VectorPat nil)
359 :			| VECTORSTART pat_list
360 :			RBRACKET (VectorPat pat_list)
361 :			| LBRACE RBRACE (unitPat)
362 :			| LBRACE plabels RBRACE
363 :			(let val (d,f) = plabels
364 :			in MarkPat(RecordPat{def=d,flexibility=f},
365 :			(LBRACEleft,RBRACEright)) end)
366 :
367 :			plabel : selector EQUALOP pat ((selector,pat))
368 :			| ID (labSymbol ID, VarPat [varSymbol ID])
369 :			| ID AS pat (labSymbol ID,
370 :			LayeredPat{varPat=VarPat [varSymbol ID],
371 :			expPat=pat})
372 :			| ID COLON ty (labSymbol ID,
373 :			ConstraintPat{pattern=VarPat [varSymbol ID],
374 :			constraint=ty})
375 :			| ID COLON ty AS pat (labSymbol ID,
376 :			LayeredPat
377 :			{varPat=ConstraintPat{pattern=VarPat [varSymbol ID],
378 :			constraint=ty},
379 :			expPat=pat})
380 :
381 :			plabels : plabel COMMA plabels (let val (a,(b,fx))=(plabel, plabels)
382 :			in (a::b, fx) end)
383 :			| plabel ([plabel],false)
384 :			| DOTDOTDOT (nil, true)
385 :
386 :			pat_list: pat ([pat])
387 :			| pat COMMA pat_list (pat :: pat_list)
388 :
389 :			or_pat_list : pat ([pat])
390 :			| pat BAR or_pat_list (pat :: or_pat_list)
391 :
392 :			vb : vb AND vb (vb1 @ vb2)
393 :			| LAZY pat EQUALOP exp ([MarkVb(LVb{exp=exp, pat=pat}, (patleft,expright))])
394 :			| pat EQUALOP exp ([MarkVb(Vb{exp=exp, pat=pat}, (patleft,expright))])
395 :
396 :			constraint : (NONE)
397 :			| COLON ty (SOME ty)
398 :
399 :			rvb : id constraint EQUALOP exp
400 :			(let val (v,f) = var'n'fix id
401 :			in [MarkRvb(Rvb{var=v,fixity=SOME(f,(idleft,idright)),
402 :			resultty=constraint,
403 :			exp=exp},(idleft,expright))] end)
404 :			| OP id constraint EQUALOP exp
405 :			([MarkRvb(Rvb{var=varSymbol id,fixity=NONE,
406 :			resultty=constraint,
407 :			exp=exp},(OPleft,expright))])
408 :			| rvb AND rvb (rvb1 @ rvb2)
409 :			| LAZY id constraint EQUALOP exp
410 :			(let val (v,f) = var'n'fix id
411 :			in [MarkRvb(LRvb{var=v,fixity=SOME(f,(idleft,idright)),
412 :			resultty=constraint,
413 :			exp=exp},(idleft,expright))] end)
414 :			| LAZY OP id constraint EQUALOP exp
415 :			([MarkRvb(LRvb{var=varSymbol id,fixity=NONE,
416 :			resultty=constraint,
417 :			exp=exp},(OPleft,expright))])
418 :
419 :
420 :			fb' : clause ([clause])
421 :			| clause BAR fb' (clause :: fb')
422 :
423 :			fb : fb' ([MarkFb(Fb fb', (fb'left,fb'right))])
424 :			| LAZY fb' ([MarkFb(LFb fb', (fb'left,fb'right))])
425 :			| fb' AND fb (MarkFb(Fb fb', (fb'left,fb'right)) :: fb)
426 :			| LAZY fb' AND fb (MarkFb(LFb fb', (fb'left,fb'right)) :: fb)
427 :
428 :			apats : apat ([apat])
429 :			| apat apats (apat :: apats)
430 :
431 :			clause : apats constraint EQUALOP exp
432 :			(Clause{pats=apats,
433 :			resultty=constraint,
434 :			exp=markexp(exp,expleft,expright)})
435 :
436 :
437 :			tb : tyvars ID EQUALOP ty ([MarkTb(
438 :			Tb{tyvars=tyvars,tyc=tycSymbol ID,def=ty},
439 :			(tyleft,tyright))])
440 :			| tb AND tb (tb1 @ tb2)
441 :
442 :			tyvars : TYVAR ([MarkTyv(Tyv(tyvSymbol TYVAR),
443 :			(TYVARleft,TYVARright))])
444 :			| LPAREN tyvar_pc RPAREN (tyvar_pc)
445 :			| (nil)
446 :
447 :			tyvarseq: TYVAR ([MarkTyv(Tyv(tyvSymbol TYVAR),
448 :			(TYVARleft,TYVARright))])
449 :			| LPAREN tyvar_pc RPAREN (tyvar_pc)
450 :
451 :			tyvar_pc: TYVAR ([MarkTyv(Tyv(tyvSymbol TYVAR), (TYVARleft,TYVARright))])
452 :			| TYVAR COMMA tyvar_pc
453 :			(MarkTyv(Tyv(tyvSymbol TYVAR),(TYVARleft,TYVARright))
454 :			:: tyvar_pc)
455 :
456 :			db : db AND db (db1 @ db2)
457 :			| tyvars ident EQUALOP dbrhs ([Db{tyc=tycSymbol ident,
458 :			tyvars=tyvars,
459 :			rhs=dbrhs}])
460 :			| LAZY tyvars ident EQUALOP dbrhs ([LDb{tyc=tycSymbol ident,
461 :			tyvars=tyvars,
462 :			rhs=dbrhs}])
463 :
464 :			dbrhs : constrs (Constrs constrs)
465 :			| DATATYPE tycon (Repl tycon)
466 :
467 :			constrs : constr ([constr])
468 :			| constr BAR constrs (constr :: constrs)
469 :
470 :			constr : op_op ident (varSymbol ident, NONE)
471 :			| op_op ident OF ty (varSymbol ident, SOME ty)
472 :
473 :			eb : op_op ident ([EbGen{exn=(varSymbol ident),etype=NONE}])
474 :			| op_op ident OF ty ([EbGen{exn=(varSymbol ident),etype=SOME ty}])
475 :			| op_op ident EQUALOP qid ([EbDef{exn=varSymbol ident,
476 :			edef=qid varSymbol}])
477 :			| eb AND eb (eb1 @ eb2)
478 :
479 :			qid_p : qid ([qid strSymbol])
480 :			| qid qid_p (qid strSymbol :: qid_p)
481 :
482 :			fixity : INFIX (infixleft 0)
483 :			| INFIX int (infixleft (checkFix(IntInf.toInt int,error(intleft,intright))))
484 :			| INFIXR (infixright 0)
485 :			| INFIXR int (infixright (checkFix(IntInf.toInt int,error(intleft,intright))))
486 :			| NONFIX (NONfix)
487 :
488 :			ldec : VAL vb (ValDec(vb,nil))
489 :			| VAL tyvarseq vb (ValDec(vb,tyvarseq))
490 :			| VAL REC rvb (ValrecDec(rvb,nil))
491 :			| VAL REC tyvarseq rvb (ValrecDec(rvb,tyvarseq))
492 :			| FUN fb (FunDec(fb,nil))
493 :			| FUN tyvarseq fb (FunDec(fb,tyvarseq))
494 :			| TYPE tb (TypeDec tb)
495 :			| DATATYPE db (DatatypeDec{datatycs=db,withtycs=[]})
496 :			| DATATYPE db WITHTYPE tb (DatatypeDec{datatycs=db,withtycs=tb})
497 :			| ABSTYPE db WITH ldecs END (AbstypeDec{abstycs=db,withtycs=[],
498 :			body=ldecs})
499 :			| ABSTYPE db WITHTYPE tb WITH ldecs END (AbstypeDec{abstycs=db,
500 :			withtycs=tb,
501 :			body=ldecs})
502 :			| EXCEPTION eb (ExceptionDec eb)
503 :			| OPEN qid_p (OpenDec qid_p)
504 :			| fixity ops (FixDec{fixity=fixity, ops=ops})
505 :			| OVERLOAD ident COLON ty AS exp_pa
506 :			(OvldDec(varSymbol ident,ty,exp_pa))
507 :
508 :			exp_pa : exp ([exp])
509 :			| exp AND exp_pa (exp :: exp_pa)
510 :
511 :			ldecs : (SeqDec nil)
512 :			| ldec ldecs (makeSEQdec
513 :			(markdec(ldec,ldecleft,ldecright), ldecs))
514 :			| SEMICOLON ldecs (ldecs)
515 :			| LOCAL ldecs IN ldecs END ldecs
516 :			(makeSEQdec
517 :			(markdec(LocalDec(markdec(ldecs1,ldecs1left,ldecs1right),
518 :			markdec(ldecs2,ldecs2left,ldecs2right)),
519 :			LOCALleft,ENDright),
520 :			ldecs3))
521 :
522 :			ops : ident ([fixSymbol ident])
523 :			| ident ops (fixSymbol ident :: ops)
524 :
525 :			spec_s : ([])
526 :			| spec spec_s (spec @ spec_s)
527 :			| SEMICOLON spec_s (spec_s)
528 :
529 :			spec : STRUCTURE strspec ([StrSpec strspec])
530 :			| FUNCTOR fctspec ([FctSpec fctspec])
531 :			| DATATYPE db ([DataSpec{datatycs=db,withtycs=nil}])
532 :			| DATATYPE db WITHTYPE tb ([DataSpec{datatycs=db,withtycs=tb}])
533 :			| TYPE tyspec ([TycSpec(tyspec,false)])
534 :			| EQTYPE tyspec ([TycSpec(tyspec,true)])
535 :			| VAL valspec ([ValSpec valspec])
536 :			| EXCEPTION exnspec ([ExceSpec exnspec])
537 :			| fixity ops ([FixSpec {fixity=fixity, ops=ops}])
538 :			| SHARING sharespec (sharespec)
539 :			| INCLUDE sign ([IncludeSpec sign])
540 :			| INCLUDE ident idents (IncludeSpec(VarSig(FastSymbol.sigSymbol ident))
541 :			:: idents)
542 :
543 :			idents : ident ([IncludeSpec(VarSig(FastSymbol.sigSymbol ident))])
544 :			| ident idents (IncludeSpec(VarSig(FastSymbol.sigSymbol ident))
545 :			:: idents)
546 :
547 :			strspec : strspec AND strspec (strspec1 @ strspec2)
548 :			| ident COLON sign ([(strSymbol ident, sign, NONE)])
549 :			| ident COLON sign EQUALOP qid
550 :			([(strSymbol ident, sign, SOME(qid strSymbol))])
551 :
552 :			fctspec : fctspec AND fctspec (fctspec1 @ fctspec2)
553 :			| ident fsig ([(fctSymbol ident, fsig)])
554 :
555 :			tyspec : tyspec AND tyspec (tyspec1 @ tyspec2)
556 :			| tyvars ID ([(tycSymbol ID,tyvars,NONE)])
557 :			| tyvars ID EQUALOP ty ([(tycSymbol ID,tyvars,SOME ty)])
558 :
559 :			valspec : valspec AND valspec (valspec1 @ valspec2)
560 :			| op_op ident COLON ty ([(varSymbol ident,ty)])
561 :
562 :
563 :			exnspec : exnspec AND exnspec (exnspec1 @ exnspec2)
564 :			| ident ([(varSymbol ident,NONE)])
565 :			| ident OF ty ([(varSymbol ident,SOME ty)])
566 :
567 :			sharespec: sharespec AND sharespec (sharespec1 @ sharespec2)
568 :			| TYPE patheqn ([MarkSpec (ShareTycSpec(patheqn tycSymbol),
569 :			(patheqnleft,patheqnright))])
570 :			| patheqn ([MarkSpec (ShareStrSpec (patheqn strSymbol),
571 :			(patheqnleft,patheqnright))])
572 :
573 :			patheqn : qid EQUALOP qid (fn kind => [qid1 kind, qid2 kind])
574 :			| qid EQUALOP patheqn (fn kind => qid kind :: patheqn kind)
575 :
576 :			whspec : whspec AND whspec (whspec1 @ whspec2)
577 :			| TYPE tyvars qid EQUALOP ty
578 :			([WhType(qid tycSymbol,tyvars,ty)])
579 :			| qid EQUALOP qid ([WhStruct(qid1 strSymbol,qid2 strSymbol)])
580 :
581 :			sign : ident (MarkSig(VarSig (sigSymbol ident),
582 :			(identleft,identright)))
583 :			| SIG spec_s END (MarkSig(BaseSig(spec_s),(spec_sleft,spec_sright)))
584 :			| sign WHERE whspec (MarkSig(AugSig(sign,whspec),(signleft,whspecright)))
585 :
586 :			sigconstraint_op : (NoSig)
587 :			| COLON sign (Transparent(sign))
588 :			| COLONGT sign (Opaque(sign))
589 :
590 :			fsigconstraint_op : (NoSig)
591 :			| COLON ident (Transparent(VarFsig (fsigSymbol ident)))
592 :			| COLONGT ident (Opaque(VarFsig (fsigSymbol ident)))
593 :
594 :			sigb : sigb AND sigb (sigb1 @ sigb2)
595 :			| ident EQUALOP sign ([Sigb{name=sigSymbol ident,def=sign}])
596 :
597 :			fsigb : fsigb AND fsigb (fsigb1 @ fsigb2)
598 :			| ident fparamList EQUALOP sign
599 :			([Fsigb{name=fsigSymbol ident,
600 :			def=BaseFsig{param=fparamList,result=sign}}])
601 :
602 :			fsig : COLON ident (VarFsig (fsigSymbol ident))
603 :			| fparamList COLON sign
604 :			(BaseFsig{param=fparamList,result=sign})
605 :
606 :			str : qid ((MarkStr(VarStr(qid strSymbol),(qidleft,qidright))))
607 :			| STRUCT strdecs END
608 :			(MarkStr(BaseStr strdecs,(STRUCTleft,ENDright)))
609 :			| qid arg_fct
610 :			(MarkStr(AppStr(qid fctSymbol,arg_fct),
611 :			(qidleft,arg_fctright)))
612 :			| LET strdecs IN str END
613 :			(MarkStr(LetStr(strdecs, str), (LETleft,ENDright)))
614 :			| str COLON sign
615 :			(MarkStr(ConstrainedStr(str,Transparent sign),
616 :			(strleft,signright)))
617 :			| str COLONGT sign
618 :			(MarkStr(ConstrainedStr(str,Opaque sign),
619 :			(strleft,signright)))
620 :
621 :			arg_fct : LPAREN strdecs RPAREN arg_fct ((MarkStr(BaseStr strdecs,
622 :			(strdecsleft,strdecsright)),
623 :			false) :: arg_fct)
624 :			| LPAREN str RPAREN arg_fct ((str, true) :: arg_fct)
625 :			| LPAREN str RPAREN ([(str, true)])
626 :			| LPAREN strdecs RPAREN ([(MarkStr(BaseStr strdecs,
627 :			(strdecsleft,strdecsright)),
628 :			false)])
629 :
630 :			strdecs : strdec strdecs (makeSEQdec (markdec(strdec,strdecleft,strdecright),
631 :			strdecs))
632 :			| SEMICOLON strdecs (strdecs)
633 :			| (SeqDec[])
634 :
635 :			sdecs : sdec sdecs (makeSEQdec (markdec(sdec,sdecleft,sdecright),
636 :			sdecs))
637 :			| SEMICOLON sdecs (sdecs)
638 :			| (SeqDec[])
639 :
640 :			sdecs' : sdec sdecs' (makeSEQdec (markdec(sdec,sdecleft,sdecright),
641 :			sdecs'))
642 :			| sdec (markdec(sdec, sdecleft,sdecright))
643 :
644 :			strdec : STRUCTURE strb (StrDec strb)
645 :			| FUNCTOR fctb (FctDec fctb)
646 :			| LOCAL strdecs IN strdecs END (LocalDec(markdec(strdecs1,
647 :			strdecs1left,strdecs1right),
648 :			markdec(strdecs2,strdecs2left,strdecs2right)))
649 :			| ldec (markdec(ldec,ldecleft,ldecright))
650 :
651 :			sdec : STRUCTURE strb (StrDec strb)
652 :			| SIGNATURE sigb (SigDec sigb)
653 :			| FUNSIG fsigb (FsigDec fsigb)
654 :			| FUNCTOR fctb (FctDec fctb)
655 :			| LOCAL sdecs IN sdecs END (LocalDec(markdec(sdecs1,
656 :			sdecs1left,sdecs1right),
657 :			markdec(sdecs2,sdecs2left,sdecs2right)))
658 :			| ldec (markdec(ldec,ldecleft,ldecright))
659 :
660 :			strb : ident sigconstraint_op EQUALOP str
661 :			([MarkStrb(Strb{name = strSymbol ident,def = str,
662 :			constraint=sigconstraint_op},
663 :			(identleft,strright))])
664 :			| strb AND strb (strb1 @ strb2)
665 :
666 :			fparam : ID COLON sign ((SOME(strSymbol ID),sign))
667 :			| spec_s ((NONE,MarkSig(BaseSig(spec_s),
668 :			(spec_sleft,spec_sright))))
669 :
670 :			fparamList
671 :			: LPAREN fparam RPAREN ([fparam])
672 :			| LPAREN fparam RPAREN fparamList (fparam :: fparamList)
673 :
674 :			fctb : ident fparamList sigconstraint_op EQUALOP str
675 :			([MarkFctb(Fctb {name = fctSymbol ident,
676 :			def = BaseFct{params=fparamList, body=str,
677 :			constraint=sigconstraint_op}},
678 :			(identleft,strright))])
679 :			| ident fsigconstraint_op EQUALOP fct_exp
680 :			([MarkFctb(Fctb {name=fctSymbol ident,
681 :			def=fct_exp (fsigconstraint_op)},
682 :			(identleft,fct_expright))])
683 :			| fctb AND fctb (fctb1 @ fctb2)
684 :
685 :			fct_exp: qid (fn constraint => VarFct(qid fctSymbol,constraint))
686 :			| qid arg_fct
687 :			(fn constraint =>
688 :			MarkFct(AppFct(qid fctSymbol,arg_fct,constraint),
689 :			(qidleft,arg_fctright)))
690 :			| LET strdecs IN fct_exp END
691 :			(fn constraint =>
692 :			MarkFct(LetFct(strdecs, fct_exp constraint),
693 :			(LETleft,ENDright)))
694 :
695 :			interdec: sdecs' (markdec(sdecs',sdecs'left,sdecs'right))
696 :
697 :			| exp (markdec(ValDec([Vb{exp=exp,pat=VarPat itsym}],nil),
698 :			expleft,expright))
699 :
700 :			(*
701 :			* $Log: ml.grm,v $
702 :			* Revision 1.14 1997/11/24 20:28:08 dbm
703 :			* Eliminiate resultStr, returnStr transforms from parsing by implementing
704 :			* them in the elaborator.
705 :			*
706 :			* Revision 1.13 1997/11/04 23:31:10 dbm
707 :			* Liberalized syntax for val rec (rhs can be an arbitrary expression) to
708 :			* improve syntax error messages by moving the checking to elabcore.sml.
709 :			*
710 :			* Revision 1.12 1997/10/26 23:16:12 dbm
711 :			* Change in argument type of StrSpec: signature no longer optional.
712 :			*
713 :			* Revision 1.11 1997/09/23 04:00:23 dbm
714 :			* New parsing of structure, functor exprs to fix EntityEnv.Unbound problem.
715 :			*
716 :			* Revision 1.10 1997/08/26 19:25:20 jhr
717 :			* Keyword clean-up: abstraction is gone; overload is _overload; lazy is _lazy.
718 :			*
719 :			* Revision 1.9 1997/08/25 23:03:35 walidt
720 :			* Add in the names of new fixityparse and lazycomp files, in comments.
721 :			*
722 :			*
723 :			* Merged the "lazy" extension to syntax with newest version.
724 :			*
725 :			* Revision 1.8 1997/08/02 02:23:02 dbm
726 :			* Added rules for "include <sigexp>" and signature constrained
727 :			* structure expressions.
728 :			*
729 :			* Revision 1.7 1997/07/15 16:16:21 dbm
730 :			* Eliminate "structure" from "where structure" syntax.
731 :			*
732 :			* Revision 1.6 1997/05/20 12:26:01 dbm
733 :			* SML '97 sharing, where structure.
734 :			*
735 :			* Revision 1.5 1997/04/14 21:36:39 dbm
736 :			* Added syntax for explicit type bindings in val, val rec, and fun decls.
737 :			* Added simultaneous type definitions (and structure definitions in signature
738 :			* where clauses.
739 :			*
740 :			* Revision 1.4 1997/03/17 18:57:20 dbm
741 :			* New rules for datatype replication declarations and specifications.
742 :			*
743 :			* Revision 1.3 1997/01/31 15:08:58 dbm
744 :			* Change in rules to add opaque signature constraints (":>").
745 :			*
746 :			* Revision 1.2 1997/01/28 23:20:44 jhr
747 :			* Integer and word literals are now represented by IntInf.int (instead of
748 :			* as strings).
749 :			*
750 :			*)

---

root@smlnj-gforge.cs.uchicago.edu	ViewVC Help
Powered by ViewVC 1.0.0