[project @ 1996-12-19 09:10:02 by simonpj]
[ghc-hetmet.git] / ghc / compiler / rename / ParseIface.y
1 {
2 #include "HsVersions.h"
3
4 module ParseIface ( parseIface ) where
5
6 IMP_Ubiq(){-uitous-}
7
8 import HsSyn            -- quite a bit of stuff
9 import RdrHsSyn         -- oodles of synonyms
10 import HsDecls          ( HsIdInfo(..) )
11 import HsTypes          ( mkHsForAllTy )
12 import HsCore
13 import Literal
14 import HsPragmas        ( noGenPragmas, noDataPragmas, noClassPragmas, noClassOpPragmas, noInstancePragmas )
15 import IdInfo           ( exactArity, mkStrictnessInfo, mkBottomStrictnessInfo,
16                           ArgUsageInfo, FBTypeInfo
17                         )
18 import Kind             ( Kind, mkArrowKind, mkTypeKind )
19 import Lex              
20
21 import RnMonad          ( SYN_IE(ImportVersion), SYN_IE(LocalVersion), ParsedIface(..),
22                           SYN_IE(RdrNamePragma), SYN_IE(ExportItem)
23                         ) 
24 import Bag              ( emptyBag, unitBag, snocBag )
25 import FiniteMap        ( emptyFM, unitFM, addToFM, plusFM, bagToFM, FiniteMap )
26 import Name             ( OccName(..), Provenance )
27 import SrcLoc           ( mkIfaceSrcLoc )
28 import Util             ( panic{-, pprPanic ToDo:rm-} )
29
30
31 -----------------------------------------------------------------
32
33 parseIface = parseIToks . lexIface
34
35 -----------------------------------------------------------------
36 }
37
38 %name       parseIToks
39 %tokentype  { IfaceToken }
40 %monad      { IfM }{ thenIf }{ returnIf }
41
42 %token
43         INTERFACE           { ITinterface }
44         USAGES_PART         { ITusages }
45         VERSIONS_PART       { ITversions }
46         EXPORTS_PART        { ITexports }
47         INSTANCE_MODULES_PART { ITinstance_modules }
48         INSTANCES_PART      { ITinstances }
49         FIXITIES_PART       { ITfixities }
50         DECLARATIONS_PART   { ITdeclarations }
51         PRAGMAS_PART        { ITpragmas }
52         BANG                { ITbang }
53         CBRACK              { ITcbrack }
54         CCURLY              { ITccurly }
55         CLASS               { ITclass }
56         COMMA               { ITcomma }
57         CPAREN              { ITcparen }
58         DARROW              { ITdarrow }
59         DATA                { ITdata }
60         DCOLON              { ITdcolon }
61         DERIVING            { ITderiving }
62         DOTDOT              { ITdotdot }
63         EQUAL               { ITequal }
64         FORALL              { ITforall }
65         INFIX               { ITinfix }
66         INFIXL              { ITinfixl }
67         INFIXR              { ITinfixr }
68         INSTANCE            { ITinstance }
69         NEWTYPE             { ITnewtype }
70         OBRACK              { ITobrack }
71         OCURLY              { ITocurly }
72         OPAREN              { IToparen }
73         RARROW              { ITrarrow }
74         SEMI                { ITsemi }
75         TYPE                { ITtype }
76         VBAR                { ITvbar }
77         WHERE               { ITwhere }
78         INTEGER             { ITinteger  $$ }
79         VARID               { ITvarid    $$ }
80         CONID               { ITconid    $$ }
81         VARSYM              { ITvarsym   $$ }
82         CONSYM              { ITconsym   $$ }
83         QVARID              { ITqvarid   $$ }
84         QCONID              { ITqconid   $$ }
85         QVARSYM             { ITqvarsym  $$ }
86         QCONSYM             { ITqconsym  $$ }
87
88         ARITY_PART      { ITarity }
89         STRICT_PART     { ITstrict }
90         UNFOLD_PART     { ITunfold }
91         DEMAND          { ITdemand $$ }
92         BOTTOM          { ITbottom }
93         LAM             { ITlam }
94         BIGLAM          { ITbiglam }
95         CASE            { ITcase }
96         OF              { ITof }
97         LET             { ITlet }
98         LETREC          { ITletrec }
99         IN              { ITin }
100         COERCE_IN       { ITcoerce_in }
101         COERCE_OUT      { ITcoerce_out }
102         CHAR            { ITchar $$ }
103         STRING          { ITstring $$ } 
104 %%
105
106 iface           :: { ParsedIface }
107 iface           : INTERFACE CONID INTEGER
108                   inst_modules_part 
109                   usages_part
110                   exports_part fixities_part
111                   instances_part
112                   decls_part
113                   { ParsedIface 
114                         $2                      -- Module name
115                         (fromInteger $3)        -- Module version
116                         $5                      -- Usages
117                         $6                      -- Exports
118                         $4                      -- Instance modules
119                         $7                      -- Fixities
120                         $9                      -- Decls
121                         $8                      -- Local instances
122                     }
123
124
125 usages_part         :: { [ImportVersion OccName] }
126 usages_part         :  USAGES_PART module_stuff_pairs           { $2 }
127                     |                                           { [] }
128
129 module_stuff_pairs  :: { [ImportVersion OccName] }
130 module_stuff_pairs  :                                           { [] }
131                     |  module_stuff_pair module_stuff_pairs     { $1 : $2 }
132
133 module_stuff_pair   ::  { ImportVersion OccName }
134 module_stuff_pair   :  mod_name INTEGER DCOLON name_version_pairs SEMI
135                         { ($1, fromInteger $2, $4) }
136
137 versions_part       :: { [LocalVersion OccName] }
138 versions_part       :  VERSIONS_PART name_version_pairs         { $2 }
139                     |                                           { [] }
140
141 name_version_pairs  ::  { [LocalVersion OccName] }
142 name_version_pairs  :                                           { [] }
143                     |  name_version_pair name_version_pairs     { $1 : $2 }
144
145 name_version_pair   ::  { LocalVersion OccName }
146 name_version_pair   :  entity_occ INTEGER                       { ($1, fromInteger $2)
147 --------------------------------------------------------------------------
148                                                                 }
149
150 exports_part    :: { [ExportItem] }
151 exports_part    :  EXPORTS_PART export_items                    { $2 }
152                 |                                               { [] }
153
154 export_items    :: { [ExportItem] }
155 export_items    :                                               { [] }
156                 |  export_item export_items                     { $1 : $2 }
157
158 export_item     :: { ExportItem }
159 export_item     :  mod_name entity_occ maybe_dotdot             { ($1, $2, $3) }
160
161 maybe_dotdot    :: { [OccName] }
162 maybe_dotdot    :                                               { [] }
163                 |  OPAREN val_occs CPAREN                       { $2
164 --------------------------------------------------------------------------
165                                                                 }
166
167 inst_modules_part :: { [Module] }
168 inst_modules_part :                                             { [] }
169                   |  INSTANCE_MODULES_PART mod_list             { $2 }
170
171 mod_list        :: { [Module] }
172 mod_list        :                                               { [] }
173                 |  mod_name mod_list                            { $1 : $2
174 --------------------------------------------------------------------------
175                                                                   }
176
177 fixities_part   :: { [(OccName,Fixity)] }
178 fixities_part   :                                               { [] }
179                 |  FIXITIES_PART fixes                          { $2 }
180
181 fixes           :: { [(OccName,Fixity)] }
182 fixes           :                                               { []  }
183                 |  fix fixes                                    { $1 : $2 }
184
185 fix             :: { (OccName, Fixity) }
186 fix             :  INFIXL INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixL) }
187                 |  INFIXR INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixR) }
188                 |  INFIX  INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixN)
189 --------------------------------------------------------------------------
190                                                                                       }
191
192 decls_part      :: { [(Version, RdrNameHsDecl)] }
193 decls_part      :                                       { [] }
194                 |       DECLARATIONS_PART topdecls      { $2 }
195
196 topdecls        :: { [(Version, RdrNameHsDecl)] }
197 topdecls        :                                       { [] }
198                 |  version topdecl topdecls             { ($1,$2) : $3 }
199
200 version         :: { Version }
201 version         :  INTEGER                              { fromInteger $1 }
202
203 topdecl         :: { RdrNameHsDecl }
204 topdecl         :  TYPE  tc_name tv_bndrs EQUAL type SEMI
205                         { TyD (TySynonym $2 $3 $5 mkIfaceSrcLoc) }
206                 |  DATA decl_context tc_name tv_bndrs EQUAL constrs deriving SEMI
207                         { TyD (TyData $2 $3 $4 $6 $7 noDataPragmas mkIfaceSrcLoc) }
208                 |  NEWTYPE decl_context tc_name tv_bndrs EQUAL constr1 deriving SEMI
209                         { TyD (TyNew $2 $3 $4 $6 $7 noDataPragmas mkIfaceSrcLoc) }
210                 |  CLASS decl_context tc_name tv_bndr csigs SEMI
211                         { ClD (ClassDecl $2 $3 $4 $5 EmptyMonoBinds noClassPragmas mkIfaceSrcLoc) }
212                 |  var_name DCOLON ctype id_info SEMI
213                         { SigD (IfaceSig $1 $3 $4 mkIfaceSrcLoc) }
214
215 decl_context    :: { RdrNameContext }
216 decl_context    :                                       { [] }
217                 | OCURLY context_list1 CCURLY DARROW    { $2 }
218
219 csigs           :: { [RdrNameSig] }
220 csigs           :                               { [] }
221                 | WHERE OCURLY csigs1 CCURLY    { $3 }
222
223 csigs1          :: { [RdrNameSig] }
224 csigs1          : csig                          { [$1] }
225                 | csig SEMI csigs1              { $1 : $3 }
226
227 csig            :: { RdrNameSig }
228 csig            :  var_name DCOLON ctype        { ClassOpSig $1 $3 noClassOpPragmas mkIfaceSrcLoc
229 ----------------------------------------------------------------
230                                                  }
231
232 constrs         :: { [RdrNameConDecl] }
233 constrs         :  constr               { [$1] }
234                 |  constr VBAR constrs  { $1 : $3 }
235
236 constr          :: { RdrNameConDecl }
237 constr          :  data_name batypes                    { ConDecl $1 $2 mkIfaceSrcLoc }
238                 |  data_name OCURLY fields1 CCURLY      { RecConDecl $1 $3 mkIfaceSrcLoc }
239
240 constr1         :: { RdrNameConDecl     {- For a newtype -} }
241 constr1         :  data_name atype                      { NewConDecl $1 $2 mkIfaceSrcLoc }
242
243 deriving        :: { Maybe [RdrName] }
244                 :                                       { Nothing }
245                 | DERIVING OPAREN qtc_names1 CPAREN     { Just $3 }
246
247 batypes         :: { [RdrNameBangType] }
248 batypes         :                                       { [] }
249                 |  batype batypes                       { $1 : $2 }
250
251 batype          :: { RdrNameBangType }
252 batype          :  atype                                { Unbanged $1 }
253                 |  BANG atype                           { Banged   $2 }
254
255 fields1         :: { [([RdrName], RdrNameBangType)] }
256 fields1         : field                                 { [$1] }
257                 | field COMMA fields1                   { $1 : $3 }
258
259 field           :: { ([RdrName], RdrNameBangType) }
260 field           :  var_name DCOLON ctype                { ([$1], Unbanged $3) }
261                 |  var_name DCOLON BANG ctype           { ([$1], Banged   $4)
262 --------------------------------------------------------------------------
263                                                         }
264
265 forall          :: { [HsTyVar RdrName] }
266 forall          : OBRACK tv_bndrs CBRACK                { $2 }
267
268 context         :: { RdrNameContext }
269 context         :                                       { [] }
270                 | OCURLY context_list1 CCURLY           { $2 }
271
272 context_list1   :: { RdrNameContext }
273 context_list1   : class                                 { [$1] }
274                 | class COMMA context_list1             { $1 : $3 }
275
276 class           :: { (RdrName, RdrNameHsType) }
277 class           :  qtc_name atype                       { ($1, $2) }
278
279 ctype           :: { RdrNameHsType }
280 ctype           : FORALL forall context DARROW type     { mkHsForAllTy $2 $3 $5 }
281                 | type                                  { $1 }
282
283 type            :: { RdrNameHsType }
284 type            :  btype                                { $1 }
285                 |  btype RARROW type                    { MonoFunTy $1 $3 }
286
287 ctypes2         :: { [RdrNameHsType]                    {- Two or more -}  }    
288 ctypes2         :  ctype COMMA ctype                    { [$1,$3] }
289                 |  ctype COMMA ctypes2                  { $1 : $3 }
290
291 btype           :: { RdrNameHsType }
292 btype           :  atype                                { $1 }
293                 |  qtc_name atypes1                     { MonoTyApp $1 $2 }
294                 |  tv_name  atypes1                     { MonoTyApp $1 $2 }
295
296 atype           :: { RdrNameHsType }
297 atype           :  qtc_name                             { MonoTyApp $1 [] }
298                 |  tv_name                              { MonoTyVar $1 }
299                 |  OPAREN ctypes2 CPAREN                { MonoTupleTy dummyRdrTcName $2 }
300                 |  OBRACK type CBRACK                   { MonoListTy  dummyRdrTcName $2 }
301                 |  OCURLY qtc_name atype CCURLY         { MonoDictTy $2 $3 }
302                 |  OPAREN ctype CPAREN                  { $2 }
303
304 atypes1         :: { [RdrNameHsType]    {-  One or more -} }
305 atypes1         :  atype                                { [$1] }
306                 |  atype atypes1                        { $1 : $2
307 ---------------------------------------------------------------------
308                                                         }
309
310 mod_name        :: { Module }
311                 :  CONID                { $1 }
312
313 var_occ         :: { OccName }
314 var_occ         : VARID                 { VarOcc $1 }
315                 | VARSYM                { VarOcc $1 }
316                 | BANG                  { VarOcc SLIT("!") {-sigh, double-sigh-} }
317
318 entity_occ      :: { OccName }
319 entity_occ      :  var_occ              { $1 }
320                 |  CONID                { TCOcc $1 }
321                 |  CONSYM               { TCOcc $1 }
322
323 val_occ         :: { OccName }
324 val_occ         :  var_occ              { $1 }
325                 |  CONID                { VarOcc $1 }
326                 |  CONSYM               { VarOcc $1 }
327
328 val_occs        :: { [OccName] }
329                 :                       { [] }
330                 |  val_occ val_occs     { $1 : $2 }
331
332
333 qvar_name       :: { RdrName }
334                 :  QVARID               { varQual $1 }
335                 |  QVARSYM              { varQual $1 }
336
337 var_name        :: { RdrName }
338 var_name        :  var_occ              { Unqual $1 }
339
340
341 qdata_name      :: { RdrName }
342 qdata_name      :  QCONID               { varQual $1 }
343                 |  QCONSYM              { varQual $1 }
344
345 data_name       :: { RdrName }
346 data_name       :  CONID                { Unqual (VarOcc $1) }
347                 |  CONSYM               { Unqual (VarOcc $1) }
348
349
350 qtc_name        :: { RdrName }
351 qtc_name        :  QCONID               { tcQual $1 }
352
353 qtc_names1      :: { [RdrName] }
354                 : qtc_name                      { [$1] }
355                 | qtc_name COMMA qtc_names1     { $1 : $3 }
356
357 tc_name         :: { RdrName }
358 tc_name         : CONID                 { Unqual (TCOcc $1) }           
359
360
361 tv_name         :: { RdrName }
362 tv_name         :  VARID                { Unqual (TvOcc $1) }
363
364 tv_names        :: { [RdrName] }
365                 :                       { [] }
366                 | tv_name tv_names      { $1 : $2 }
367
368 tv_bndr         :: { HsTyVar RdrName }
369 tv_bndr         :  tv_name DCOLON akind { IfaceTyVar $1 $3 }
370                 |  tv_name              { UserTyVar $1 }
371
372 tv_bndrs        :: { [HsTyVar RdrName] }
373                 :                       { [] }
374                 | tv_bndr tv_bndrs      { $1 : $2 }
375
376 kind            :: { Kind }
377                 : akind                 { $1 }
378                 | akind RARROW kind     { mkArrowKind $1 $3 }
379
380 akind           :: { Kind }
381                 : VARSYM                { mkTypeKind {- ToDo: check that it's "*" -} }
382                 | OPAREN kind CPAREN    { $2
383 --------------------------------------------------------------------------
384                                         }
385
386
387 instances_part  :: { [RdrNameInstDecl] }
388 instances_part  :  INSTANCES_PART instdecls { $2 }
389                 |                           { [] }
390
391 instdecls       :: { [RdrNameInstDecl] }
392 instdecls       :                           { [] }
393                 |  instd instdecls          { $1 : $2 }
394
395 instd           :: { RdrNameInstDecl }
396 instd           :  INSTANCE ctype EQUAL var_name SEMI 
397                         { InstDecl $2
398                                    EmptyMonoBinds       {- No bindings -}
399                                    []                   {- No user pragmas -}
400                                    (Just $4)            {- Dfun id -}
401                                    mkIfaceSrcLoc 
402 --------------------------------------------------------------------------
403                     }
404
405 id_info         :: { [HsIdInfo RdrName] }
406 id_info         :                                               { [] }
407                 | ARITY_PART arity_info id_info                 { HsArity $2 :  $3 }
408                 | STRICT_PART strict_info id_info               { HsStrictness $2 : $3 }
409                 | UNFOLD_PART core_expr id_info                 { HsUnfold $2 : $3 }
410
411 arity_info      :: { ArityInfo }
412 arity_info      : INTEGER                                       { exactArity (fromInteger $1) }
413
414 strict_info     :: { StrictnessInfo RdrName }
415 strict_info     : DEMAND qvar_name                              { mkStrictnessInfo $1 (Just $2) }
416                 | DEMAND                                        { mkStrictnessInfo $1 Nothing }
417                 | BOTTOM                                        { mkBottomStrictnessInfo }
418
419 core_expr       :: { UfExpr RdrName }
420 core_expr       : var_name                                      { UfVar $1 }
421                 | qvar_name                                     { UfVar $1 }
422                 | qdata_name                                    { UfVar $1 }
423                 | core_lit                                      { UfLit $1 }
424                 | core_expr core_arg                            { UfApp $1 $2 }
425                 | LAM core_val_bndr RARROW core_expr            { UfLam $2 $4 }
426                 | BIGLAM core_tv_bndrs RARROW core_expr         { foldr UfLam $4 $2 }
427
428                 | CASE core_expr OF 
429                   OCURLY alg_alts core_default CCURLY           { UfCase $2 (UfAlgAlts  $5 $6) }
430                 | CASE BANG core_expr OF 
431                   OCURLY prim_alts core_default CCURLY          { UfCase $3 (UfPrimAlts $6 $7) }
432
433                 | LET OCURLY core_val_bndr EQUAL core_expr CCURLY
434                   IN core_expr                                  { UfLet (UfNonRec $3 $5) $8 }
435                 | LETREC OCURLY rec_binds CCURLY                
436                   IN core_expr                                  { UfLet (UfRec $3) $6 }
437
438                 | qdata_name BANG core_args                     { UfCon $1 $3 }
439                 | qvar_name  BANG core_args                     { UfPrim (UfOtherOp $1) $3 }
440                 | coerce atype core_expr                        { UfCoerce $1 $2 $3 }
441
442 rec_binds       :: { [(UfBinder RdrName, UfExpr RdrName)] }
443                 :                                               { [] }
444                 | core_val_bndr EQUAL core_expr SEMI rec_binds  { ($1,$3) : $5 }
445
446 coerce          :: { UfCoercion RdrName }
447 coerce          : COERCE_IN  qdata_name                         { UfIn  $2 }
448                 | COERCE_OUT qdata_name                         { UfOut $2 }
449                 
450 prim_alts       :: { [(Literal,UfExpr RdrName)] }
451                 :                                               { [] }
452                 | core_lit RARROW core_expr SEMI prim_alts      { ($1,$3) : $5 }
453
454 alg_alts        :: { [(RdrName, [UfBinder RdrName], UfExpr RdrName)] }
455                 :                                               { [] }
456                 | qdata_name core_val_bndrs RARROW 
457                         core_expr SEMI alg_alts                 { ($1,$2,$4) : $6 }
458
459 core_default    :: { UfDefault RdrName }
460                 :                                               { UfNoDefault }
461                 | core_val_bndr RARROW core_expr                { UfBindDefault $1 $3 }
462
463 core_arg        :: { UfArg RdrName }
464                 : var_name                                      { UfVarArg $1 }
465                 | qvar_name                                     { UfVarArg $1 }
466                 | qdata_name                                    { UfVarArg $1 }
467                 | core_lit                                      { UfLitArg $1 }
468                 | OBRACK atype CBRACK                           { UfTyArg  $2 }
469
470 core_args       :: { [UfArg RdrName] }
471                 :                                               { [] }
472                 | core_arg core_args                            { $1 : $2 }
473
474 core_lit        :: { Literal }
475 core_lit        : INTEGER                                       { MachInt $1 True }
476                 | CHAR                                          { MachChar $1 }
477                 | STRING                                        { MachStr $1 }
478
479 core_val_bndr   :: { UfBinder RdrName }
480 core_val_bndr   : var_name DCOLON atype                         { UfValBinder $1 $3 }
481
482 core_val_bndrs  :: { [UfBinder RdrName] }
483 core_val_bndrs  :                                               { [] }
484                 | core_val_bndr core_val_bndrs                  { $1 : $2 }
485
486 core_tv_bndr    :: { UfBinder RdrName }
487 core_tv_bndr    :  tv_name DCOLON akind                         { UfTyBinder $1 $3 }
488                 |  tv_name                                      { UfTyBinder $1 mkTypeKind }
489
490 core_tv_bndrs   :: { [UfBinder RdrName] }
491 core_tv_bndrs   :                                               { [] }
492                 | core_tv_bndr core_tv_bndrs                    { $1 : $2 }
493