1-----------------------------------------------------------------------------
2$Id: ErlParser.ly,v 1.2 1997/09/24 10:11:23 simonm Exp $
3
4Syntactic analyser for Erlang
5
6Copyright : (c) 1996 Ellemtel Telecommunications Systems Laborotories, Sweden
7Author    : Simon Marlow <simonm@dcs.gla.ac.uk>
8-----------------------------------------------------------------------------
9
10> {
11> module Parser (parse) where
12> import GenUtils
13> import Lexer
14> import AbsSyn
15> import Types
16> import ParseMonad
17> }
18
19> %token
20> 	atom		{ T_Atom $$ }
21> 	var		{ T_Var $$ }
22>	int		{ T_Int $$ }
23>	float		{ T_Float $$ }
24>	string		{ T_String $$ }
25
26> 	'bor'		{ T_Bor }
27> 	'bxor'		{ T_Bxor }
28>	'bsl'		{ T_Bsl }
29>	'bsr'		{ T_Bsr }
30>	'div'		{ T_Div }
31>	'rem'		{ T_Rem }
32>	'band'		{ T_Band }
33>	'bnot'		{ T_Bnot }
34>	'begin'    	{ T_Begin }
35>	'end'    	{ T_End }
36>	'catch'    	{ T_Catch }
37>	'case'    	{ T_Case }
38>	'of'    	{ T_Of }
39>	'if'    	{ T_If }
40>	'receive'    	{ T_Receive }
41>	'after'    	{ T_After }
42>	'when'    	{ T_When }
43>	'fun'		{ T_Fun }
44>	'true'    	{ T_True }
45>	'deftype'	{ T_DefType }
46>	'type'		{ T_Type }
47
48> 	'+'		{ T_Plus }
49> 	'-'		{ T_Minus }
50> 	'*'		{ T_Mult }
51> 	'/'		{ T_Divide }
52> 	'=='		{ T_Eq }
53> 	'/='		{ T_Neq }
54> 	'=<'		{ T_Leq }
55> 	'<'		{ T_Lt }
56> 	'>='		{ T_Geq }
57> 	'>'		{ T_Gt }
58> 	'=:='		{ T_ExactEq }
59> 	'=/='		{ T_ExactNeq }
60
61> 	'!'		{ T_Pling }
62> 	'='		{ T_Equals }
63> 	'['		{ T_LSquare }
64> 	']'		{ T_RSquare }
65> 	'('		{ T_LParen }
66> 	')'		{ T_RParen }
67> 	'{'		{ T_LCurly }
68> 	'}'		{ T_RCurly }
69> 	','		{ T_Comma }
70> 	';'		{ T_SemiColon }
71> 	'|'		{ T_Bar }
72> 	':'		{ T_Colon }
73> 	'->'		{ T_Arrow }
74> 	'.'		{ T_Dot }
75>	'\\'		{ T_BackSlash }
76
77>	header_prog	{ T_Prog }
78>	header_iface	{ T_Interface }
79
80> %monad { P } { thenP } { returnP }
81> %lexer { lexer } { T_EOF }
82> %name parse
83> %tokentype	{ Token }
84
85> %%
86
87> parse :: { ProgOrInterface }
88> 	: header_prog program		{ It's_a_prog   $2 }
89> 	| header_iface interface	{ It's_an_iface $2 }
90
91> program :: { [Form] }
92> 	: 				{ [] }
93>	| form program			{ $1 : $2 }
94
95> add_op :: { BinOp }
96> 	: '+'				{ O_Add }
97>	| '-'				{ O_Subtract }
98>	| 'bor'				{ O_Bor }
99>	| 'bxor'			{ O_Bxor }
100>	| 'bsl'				{ O_Bsl }
101>	| 'bsr'				{ O_Bsr }
102
103> comp_op :: { CompOp }
104> 	: '=='				{ O_Eq }
105>	| '/='				{ O_Neq }
106>	| '=<'				{ O_Leq }
107>	| '<'				{ O_Lt }
108>	| '>='				{ O_Geq }
109>	| '>'				{ O_Gt }
110>	| '=:='				{ O_ExactEq }
111>	| '=/='				{ O_ExactNeq }
112
113> mult_op :: { BinOp }
114> 	: '*'				{ O_Multiply }
115>	| '/'				{ O_Divide }
116>	| 'div'				{ O_Div }
117>	| 'rem'				{ O_Rem }
118>	| 'band'			{ O_Band }
119
120> prefix_op :: { UnOp }
121> 	: '+'				{ O_Plus }
122>	| '-'				{ O_Negate }
123>	| 'bnot'			{ O_Bnot }
124
125> basic_type :: { Expr }
126> 	: atm				{ E_Atom $1 }
127>	| int				{ E_Int $1 }
128>	| float				{ E_Float $1 }
129>	| string		{ foldr E_Cons E_Nil (map (E_Int . ord) $1) }
130>	| var				{ E_Var $1 }
131
132> pattern :: { Expr }
133> 	: basic_type			{ $1 }
134>	| '[' ']'			{ E_Nil }
135>	| '[' pattern pat_tail ']'	{ E_Cons $2 $3 }
136>	| '{' '}'			{ E_Tuple [] }
137>	| '{' patterns '}'		{ E_Tuple $2 }
138>	| atm '{' patterns '}'		{ E_Struct $1 $3 }
139
140> pat_tail :: { Expr }
141> 	: '|' pattern			{ $2 }
142>	| ',' pattern pat_tail		{ E_Cons $2 $3 }
143>	|				{ E_Nil }
144
145> patterns :: { [ Expr ] }
146> 	: pattern			{ [ $1 ] }
147>	| pattern ',' patterns		{ $1 : $3 }
148
149> expr :: { Expr }
150>	: 'catch' expr			{ E_Catch $2 }
151>	| 'fun' '(' formal_param_list ')' '->' expr 'end' { E_Fun $3 $6 }
152>	| 'fun' var '/' int		{ E_FunName (LocFun $2 $4) }
153>	| 'fun' var ':' var '/' int	{ E_FunName (ExtFun $2 $4 $6) }
154>	| expr200			{ $1 }
155
156> expr200 :: { Expr }
157>	: expr300 '=' expr		{ E_Match $1 $3 }
158>	| expr300 '!' expr		{ E_Send $1 $3 }
159>	| expr300			{ $1 }
160
161> expr300 :: { Expr }
162> 	: expr300 add_op expr400	{ E_BinOp $2 $1 $3 }
163>	| expr400			{ $1 }
164
165> expr400 :: { Expr }
166> 	: expr400 mult_op expr500	{ E_BinOp $2 $1 $3 }
167>	| expr500			{ $1 }
168
169> expr500 :: { Expr }
170> 	: prefix_op expr0		{ E_UnOp $1 $2 }
171>	| expr0				{ $1 }
172
173> expr0 :: { Expr }
174> 	: basic_type				{ $1 }
175> 	| '[' ']'				{ E_Nil }
176>	| '[' expr expr_tail ']'		{ E_Cons $2 $3 }
177>	| '{' maybeexprs '}'			{ E_Tuple $2 }
178>	| atm '{' maybeexprs '}'		{ E_Struct $1 $3 }
179> 	| atm '(' maybeexprs ')'  { E_Call (LocFun $1 (length $3)) $3 }
180>	| atm ':' atm '(' maybeexprs ')'
181>				  { E_Call (ExtFun $1 $3 (length $5)) $5 }
182>	| '(' expr ')'				{ $2 }
183>	| 'begin' exprs 'end'			{ E_Block $2 }
184>	| 'case' expr 'of' cr_clauses 'end'  	{ E_Case $2 $4 }
185>	| 'if' if_clauses 'end'			{ E_If $2 }
186> 	| 'receive' 'after' expr '->' exprs 'end'
187>					{ E_Receive [] (Just ($3,$5)) }
188>	| 'receive' cr_clauses 'end'	{ E_Receive $2 Nothing }
189>	| 'receive' cr_clauses 'after' expr '->' exprs 'end'
190>					{ E_Receive $2 (Just ($4,$6)) }
191
192> expr_tail :: { Expr }
193> 	: '|' expr			{ $2 }
194>	| ',' expr expr_tail		{ E_Cons $2 $3 }
195>	| 				{ E_Nil }
196
197> cr_clause :: { CaseClause }
198> 	: expr clause_guard '->' exprs 	{ ($1,$2,$4) }
199
200> clause_guard :: { [ GuardTest ] }
201> 	: 'when' guard			{ $2 }
202>	|				{ [] }
203
204> cr_clauses :: { [ CaseClause ] }
205> 	: cr_clause			{ [ $1 ] }
206>	| cr_clause ';' cr_clauses	{ $1 : $3 }
207
208> if_clause :: { IfClause }
209> 	: guard '->' exprs		{ ($1,$3) }
210
211> if_clauses :: { [ IfClause ] }
212> 	: if_clause			{ [ $1 ] }
213>	| if_clause ';' if_clauses	{ $1 : $3 }
214
215> maybeexprs :: { [ Expr ] }
216>	: exprs				{ $1 }
217>	|				{ [] }
218
219> exprs :: { [ Expr ] }
220> 	: expr				{ [ $1 ] }
221>	| expr ',' exprs		{ $1 : $3 }
222
223> guard_test :: { GuardTest }
224> 	: atm '(' maybeexprs ')' 	{ G_Bif $1 $3 }
225>	| expr300 comp_op expr300       { G_Cmp $2 $1 $3 }
226
227> guard_tests :: { [ GuardTest ] }
228> 	: guard_test			{ [ $1 ] }
229>	| guard_test ',' guard_tests	{ $1 : $3 }
230
231> guard :: { [ GuardTest ] }
232> 	: 'true'			{ [] }
233>	| guard_tests			{ $1 }
234
235> function_clause :: { FunctionClause }
236> 	: atm '(' formal_param_list ')' clause_guard '->' exprs
237>					{ (LocFun $1 (length $3),$3,$5,$7) }
238
239> formal_param_list :: { [ Expr ] }
240>	:				{ [] }
241> 	| patterns			{ $1 }
242
243> function :: { Function }
244> 	: function_clause		{ [ $1 ] }
245>	| function_clause ';' function	{ $1 : $3 }
246
247> attribute :: { Attribute }
248> 	: pattern			{ A_Pat $1 }
249>	| '[' farity_list ']'		{ A_Funs $2 }
250>	| atm ',' '[' maybe_farity_list ']'	{ A_AtomAndFuns $1 $4 }
251
252> maybe_farity_list :: { [ Fun ] }
253> 	: farity_list			{ $1 }
254>	| 				{ [] }
255
256> farity_list :: { [ Fun ] }
257> 	: farity			{ [ $1 ] }
258>	| farity ',' farity_list	{ $1 : $3 }
259
260> farity :: { Fun }
261> 	: atm '/' int			{ LocFun $1 $3 }
262
263> form :: { Form }
264> 	: '-' atm '(' attribute ')' '.'  { F_Directive $2 $4 }
265>	| '-' 'type' sigdef '.'		 { $3 }
266>	| '-' 'deftype' deftype '.'	 { $3 }
267>	| function '.'			 { F_Function $1 }
268
269> abstype :: { Form }
270>	: atm '(' maybetyvars ')' maybeconstraints
271>		{ F_AbsTypeDef (Tycon $1 (length $3)) $3 (snd $5) }
272
273> deftype :: { Form }
274> 	: atm '(' maybetyvars ')' '=' utype maybeconstraints
275>		{ F_TypeDef (Tycon $1 (length $3)) $3 $6 (fst $7) (snd $7) }
276
277> sigdef :: { Form }
278> 	: atm '(' maybeutypes ')' '->' utype maybeconstraints
279>		{ F_TypeSig  ($1,length $3) $3 $6 (fst $7) (snd $7) }
280
281> header :: { (String,Int,[UType]) }
282>	 : atm '(' maybeutypes ')'		{ ($1, length $3, $3) }
283
284> tycon_args :: { [ TyVar ] }
285>	: tycon_args ',' var			{ STyVar $3 : $1 }
286> 	| var					{ [ STyVar $1 ] }
287
288-----------------------------------------------------------------------------
289Interfaces & Types
290
291> interface :: { (Module, [ Form ]) }
292> 	: '-' atm '(' atm ')' '.' signatures
293>					{ ($4, $7) }
294
295> signatures :: { [ Form ] }
296> 	: signatures typedef '.'	{ $2 : $1 }
297>	|				{ [] }
298
299> typedef :: { Form }
300> typedef
301>	: '-' 'deftype' deftype		{ $3 }
302>	| '-' 'deftype' abstype		{ $3 }
303>	| sigdef			{ $1 }
304
305> maybeconstraints :: { ([Constraint], [VarConstraint]) }
306> 	: 'when' constraints 		{ splitConstraints $2 }
307>	|				{ ([],[]) }
308
309> constraints :: { [ VarOrTypeCon ] }
310> 	: constraints ';' constraint	{ $1 ++ $3 }
311>	| constraint			{ $1 }
312
313> constraint :: { [ VarOrTypeCon ] }
314> 	: utype '<' '=' utype		{ [TypeCon ($1,$4)] }
315>	| utype '=' utype		{ [TypeCon ($1,$3),TypeCon($3,$1)] }
316>	| var '\\' tags			{ [VarCon (STyVar $1,(canonTags $3))] }
317
318> maybeutypes :: { [ UType ] }
319>	: utypes			{ reverse $1 }
320>	|				{ [] }
321
322> utypes :: { [ UType ] }
323> 	: utypes ',' utype		{ $3 : $1 }
324>	| utype				{ [$1] }
325
326> maybetyvars :: { [ TyVar ] }
327>	: tyvars			{ reverse $1 }
328>	|				{ [] }
329
330> tyvars :: { [ TyVar ] }
331>	: tyvars ',' var		{ STyVar $3 : $1 }
332>	| var				{ [ STyVar $1 ] }
333
334> utype :: { UType }
335> 	: ptypes			{ U (reverse $1) [] }
336>	| ptypes '|' tyvar		{ U (reverse $1) [$3] }
337>	| tyvar				{ U [] [$1] }
338>	| '(' utype ')'			{ $2 }
339>	| '(' ')'			{ U [] [] }
340
341> tyvar :: { TaggedTyVar }
342> 	: var				{ TyVar [] (STyVar $1) }
343>	| int				{ if $1 /= 1 then
344>						error "Illegal type variable"
345>					  else universalTyVar }
346>	| int '\\' tags			{ if $1 /= 1 then
347>						error "Illegal type variable"
348>					  else partialUniversalTyVar $3 }
349
350> ptypes :: { [ PType ] }
351> 	: ptypes '|' ptype		{ $3 : $1 }
352> 	| ptype				{ [$1] }
353
354> ptype :: { PType }
355> 	: atm '(' ')'			{ conToType $1 [] }
356>	| atm '(' utypes ')'		{ conToType $1 (reverse $3) }
357> 	| atm				{ TyAtom $1 }
358>	| '{' utypes '}'		{ tytuple (reverse $2) }
359>	| atm '{' maybeutypes '}'	{ TyStruct $1 $3 }
360>	| '[' utype ']'			{ tylist $2 }
361
362> taglist :: { [ Tag ] }
363> 	: taglist ',' tag		{ $3 : $1 }
364> 	| tag				{ [ $1 ] }
365
366> tags  :: { [ Tag ] }
367>	: tag				{ [ $1 ] }
368>	| '(' taglist ')'		{ $2 }
369
370> tag	:: { Tag }
371>  	: atm '(' ')'			{ conToTag $1 }
372> 	| atm				{ TagAtom $1 }
373>	| atm '/' int			{ TagStruct $1 $3 }
374>	| '{' int '}'			{ tagtuple $2 }
375>	| '[' ']'			{ taglist }
376
377Horrible - keywords that can be atoms too.
378
379> atm	:: { String }
380> 	: atom				{ $1 }
381> 	| 'true'			{ "true" }
382>	| 'deftype'			{ "deftype" }
383>	| 'type'			{ "type" }
384
385> {
386> utypeToVar (U [] [TyVar [] x]) = x
387> utypeToVar _ = error "Type constructor arguments must be variables\n"
388
389> happyError :: P a
390> happyError s line = failP (show line ++ ": Parse error\n") s line
391> }
392