[project @ 1997-01-17 00:32:23 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         PRIM_CASE       { ITprim_case }
97         OF              { ITof }
98         LET             { ITlet }
99         LETREC          { ITletrec }
100         IN              { ITin }
101         ATSIGN          { ITatsign }
102         COERCE_IN       { ITcoerce_in }
103         COERCE_OUT      { ITcoerce_out }
104         CHAR            { ITchar $$ }
105         STRING          { ITstring $$ } 
106         DOUBLE          { ITdouble $$ }
107         INTEGER_LIT     { ITinteger_lit }
108         STRING_LIT      { ITstring_lit }
109         FLOAT_LIT       { ITfloat_lit }
110         RATIONAL_LIT    { ITrational_lit }
111         ADDR_LIT        { ITaddr_lit }
112         LIT_LIT         { ITlit_lit }
113         CCALL           { ITccall $$ }
114 %%
115
116 iface           :: { ParsedIface }
117 iface           : INTERFACE CONID INTEGER
118                   inst_modules_part 
119                   usages_part
120                   exports_part fixities_part
121                   instances_part
122                   decls_part
123                   { ParsedIface 
124                         $2                      -- Module name
125                         (fromInteger $3)        -- Module version
126                         $5                      -- Usages
127                         $6                      -- Exports
128                         $4                      -- Instance modules
129                         $7                      -- Fixities
130                         $9                      -- Decls
131                         $8                      -- Local instances
132                     }
133
134
135 usages_part         :: { [ImportVersion OccName] }
136 usages_part         :  USAGES_PART module_stuff_pairs           { $2 }
137                     |                                           { [] }
138
139 module_stuff_pairs  :: { [ImportVersion OccName] }
140 module_stuff_pairs  :                                           { [] }
141                     |  module_stuff_pair module_stuff_pairs     { $1 : $2 }
142
143 module_stuff_pair   ::  { ImportVersion OccName }
144 module_stuff_pair   :  mod_name INTEGER DCOLON name_version_pairs SEMI
145                         { ($1, fromInteger $2, $4) }
146
147 versions_part       :: { [LocalVersion OccName] }
148 versions_part       :  VERSIONS_PART name_version_pairs         { $2 }
149                     |                                           { [] }
150
151 name_version_pairs  ::  { [LocalVersion OccName] }
152 name_version_pairs  :                                           { [] }
153                     |  name_version_pair name_version_pairs     { $1 : $2 }
154
155 name_version_pair   ::  { LocalVersion OccName }
156 name_version_pair   :  entity_occ INTEGER                       { ($1, fromInteger $2)
157 --------------------------------------------------------------------------
158                                                                 }
159
160 exports_part    :: { [ExportItem] }
161 exports_part    :  EXPORTS_PART export_items                    { $2 }
162                 |                                               { [] }
163
164 export_items    :: { [ExportItem] }
165 export_items    :                                               { [] }
166                 |  mod_name entities SEMI export_items          { ($1,$2) : $4 }
167
168 entities        :: { [(OccName, [OccName])] }
169 entities        :                                               { [] }
170                 |  entity entities                              { $1 : $2 }
171
172 entity          :: { (OccName, [OccName]) }
173 entity          :  entity_occ maybe_inside                      { ($1, $2) }
174
175 maybe_inside    :: { [OccName] }
176 maybe_inside    :                                               { [] }
177                 |  OPAREN val_occs CPAREN                       { $2
178 --------------------------------------------------------------------------
179                                                                 }
180
181 inst_modules_part :: { [Module] }
182 inst_modules_part :                                             { [] }
183                   |  INSTANCE_MODULES_PART mod_list             { $2 }
184
185 mod_list        :: { [Module] }
186 mod_list        :                                               { [] }
187                 |  mod_name mod_list                            { $1 : $2
188 --------------------------------------------------------------------------
189                                                                   }
190
191 fixities_part   :: { [(OccName,Fixity)] }
192 fixities_part   :                                               { [] }
193                 |  FIXITIES_PART fixes                          { $2 }
194
195 fixes           :: { [(OccName,Fixity)] }
196 fixes           :                                               { []  }
197                 |  fix fixes                                    { $1 : $2 }
198
199 fix             :: { (OccName, Fixity) }
200 fix             :  INFIXL INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixL) }
201                 |  INFIXR INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixR) }
202                 |  INFIX  INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixN)
203 --------------------------------------------------------------------------
204                                                                                       }
205
206 decls_part      :: { [(Version, RdrNameHsDecl)] }
207 decls_part      :                                       { [] }
208                 |       DECLARATIONS_PART topdecls      { $2 }
209
210 topdecls        :: { [(Version, RdrNameHsDecl)] }
211 topdecls        :                                       { [] }
212                 |  version topdecl topdecls             { ($1,$2) : $3 }
213
214 version         :: { Version }
215 version         :  INTEGER                              { fromInteger $1 }
216
217 topdecl         :: { RdrNameHsDecl }
218 topdecl         :  TYPE  tc_name tv_bndrs EQUAL type SEMI
219                         { TyD (TySynonym $2 $3 $5 mkIfaceSrcLoc) }
220                 |  DATA decl_context tc_name tv_bndrs EQUAL constrs deriving SEMI
221                         { TyD (TyData $2 $3 $4 $6 $7 noDataPragmas mkIfaceSrcLoc) }
222                 |  NEWTYPE decl_context tc_name tv_bndrs EQUAL constr1 deriving SEMI
223                         { TyD (TyNew $2 $3 $4 $6 $7 noDataPragmas mkIfaceSrcLoc) }
224                 |  CLASS decl_context tc_name tv_bndr csigs SEMI
225                         { ClD (ClassDecl $2 $3 $4 $5 EmptyMonoBinds noClassPragmas mkIfaceSrcLoc) }
226                 |  var_name DCOLON type id_info SEMI
227                         { SigD (IfaceSig $1 $3 $4 mkIfaceSrcLoc) }
228
229 decl_context    :: { RdrNameContext }
230 decl_context    :                                       { [] }
231                 | OCURLY context_list1 CCURLY DARROW    { $2 }
232
233 csigs           :: { [RdrNameSig] }
234 csigs           :                               { [] }
235                 | WHERE OCURLY csigs1 CCURLY    { $3 }
236
237 csigs1          :: { [RdrNameSig] }
238 csigs1          : csig                          { [$1] }
239                 | csig SEMI csigs1              { $1 : $3 }
240
241 csig            :: { RdrNameSig }
242 csig            :  var_name DCOLON type         { ClassOpSig $1 $3 noClassOpPragmas mkIfaceSrcLoc
243 ----------------------------------------------------------------
244                                                  }
245
246 constrs         :: { [RdrNameConDecl] }
247 constrs         :  constr               { [$1] }
248                 |  constr VBAR constrs  { $1 : $3 }
249
250 constr          :: { RdrNameConDecl }
251 constr          :  data_name batypes                    { ConDecl $1 $2 mkIfaceSrcLoc }
252                 |  data_name OCURLY fields1 CCURLY      { RecConDecl $1 $3 mkIfaceSrcLoc }
253
254 constr1         :: { RdrNameConDecl     {- For a newtype -} }
255 constr1         :  data_name atype                      { NewConDecl $1 $2 mkIfaceSrcLoc }
256
257 deriving        :: { Maybe [RdrName] }
258                 :                                       { Nothing }
259                 | DERIVING OPAREN qtc_names1 CPAREN     { Just $3 }
260
261 batypes         :: { [RdrNameBangType] }
262 batypes         :                                       { [] }
263                 |  batype batypes                       { $1 : $2 }
264
265 batype          :: { RdrNameBangType }
266 batype          :  atype                                { Unbanged $1 }
267                 |  BANG atype                           { Banged   $2 }
268
269 fields1         :: { [([RdrName], RdrNameBangType)] }
270 fields1         : field                                 { [$1] }
271                 | field COMMA fields1                   { $1 : $3 }
272
273 field           :: { ([RdrName], RdrNameBangType) }
274 field           :  var_names1 DCOLON type               { ($1, Unbanged $3) }
275                 |  var_names1 DCOLON BANG type          { ($1, Banged   $4)
276 --------------------------------------------------------------------------
277                                                         }
278
279 forall          :: { [HsTyVar RdrName] }
280 forall          : OBRACK tv_bndrs CBRACK                { $2 }
281
282 context         :: { RdrNameContext }
283 context         :                                       { [] }
284                 | OCURLY context_list1 CCURLY           { $2 }
285
286 context_list1   :: { RdrNameContext }
287 context_list1   : class                                 { [$1] }
288                 | class COMMA context_list1             { $1 : $3 }
289
290 class           :: { (RdrName, RdrNameHsType) }
291 class           :  qtc_name atype                       { ($1, $2) }
292
293 type            :: { RdrNameHsType }
294 type            : FORALL forall context DARROW type     { mkHsForAllTy $2 $3 $5 }
295                 | tautype                               { $1 }
296
297 tautype         :: { RdrNameHsType }
298 tautype         :  btype                                { $1 }
299                 |  btype RARROW tautype                 { MonoFunTy $1 $3 }
300
301 types2          :: { [RdrNameHsType]                    {- Two or more -}  }    
302 types2          :  type COMMA type                      { [$1,$3] }
303                 |  type COMMA types2                    { $1 : $3 }
304
305 btype           :: { RdrNameHsType }
306 btype           :  atype                                { $1 }
307                 |  btype atype                          { MonoTyApp $1 $2 }
308
309 atype           :: { RdrNameHsType }
310 atype           :  qtc_name                             { MonoTyVar $1 }
311                 |  tv_name                              { MonoTyVar $1 }
312                 |  OPAREN types2 CPAREN                 { MonoTupleTy dummyRdrTcName $2 }
313                 |  OBRACK type CBRACK                   { MonoListTy  dummyRdrTcName $2 }
314                 |  OCURLY qtc_name atype CCURLY         { MonoDictTy $2 $3 }
315                 |  OPAREN type CPAREN                   { $2 }
316
317 atypes          :: { [RdrNameHsType]    {-  Zero or more -} }
318 atypes          :                                       { [] }
319                 |  atype atypes                         { $1 : $2
320 ---------------------------------------------------------------------
321                                                         }
322
323 mod_name        :: { Module }
324                 :  CONID                { $1 }
325
326 var_occ         :: { OccName }
327 var_occ         : VARID                 { VarOcc $1 }
328                 | VARSYM                { VarOcc $1 }
329                 | BANG                  { VarOcc SLIT("!") {-sigh, double-sigh-} }
330
331 tc_occ          :: { OccName }
332 tc_occ          :  CONID                { TCOcc $1 }
333                 |  CONSYM               { TCOcc $1 }
334                 |  OPAREN RARROW CPAREN { TCOcc SLIT("->") }
335
336 entity_occ      :: { OccName }
337 entity_occ      :  var_occ              { $1 }
338                 |  tc_occ               { $1 }
339                 |  RARROW               { TCOcc SLIT("->") {- Allow un-paren'd arrow -} }
340
341 val_occ         :: { OccName }
342 val_occ         :  var_occ              { $1 }
343                 |  CONID                { VarOcc $1 }
344                 |  CONSYM               { VarOcc $1 }
345
346 val_occs        :: { [OccName] }
347                 :                       { [] }
348                 |  val_occ val_occs     { $1 : $2 }
349
350
351 qvar_name       :: { RdrName }
352                 :  QVARID               { varQual $1 }
353                 |  QVARSYM              { varQual $1 }
354
355 var_name        :: { RdrName }
356 var_name        :  var_occ              { Unqual $1 }
357
358 var_names1      :: { [RdrName] }
359 var_names1      : var_name              { [$1] }
360                 | var_name var_names1   { $1 : $2 }
361
362 any_var_name    :: {RdrName}
363 any_var_name    :  var_name             { $1 }
364                 |  qvar_name            { $1 }
365
366 qdata_name      :: { RdrName }
367 qdata_name      :  QCONID               { varQual $1 }
368                 |  QCONSYM              { varQual $1 }
369
370 data_name       :: { RdrName }
371 data_name       :  CONID                { Unqual (VarOcc $1) }
372                 |  CONSYM               { Unqual (VarOcc $1) }
373
374
375 qtc_name        :: { RdrName }
376 qtc_name        :  QCONID               { tcQual $1 }
377
378 qtc_names1      :: { [RdrName] }
379                 : qtc_name                      { [$1] }
380                 | qtc_name COMMA qtc_names1     { $1 : $3 }
381
382 tc_name         :: { RdrName }
383 tc_name         : tc_occ                        { Unqual $1 }
384
385 tv_name         :: { RdrName }
386 tv_name         :  VARID                { Unqual (TvOcc $1) }
387
388 tv_names        :: { [RdrName] }
389                 :                       { [] }
390                 | tv_name tv_names      { $1 : $2 }
391
392 tv_bndr         :: { HsTyVar RdrName }
393 tv_bndr         :  tv_name DCOLON akind { IfaceTyVar $1 $3 }
394                 |  tv_name              { UserTyVar $1 }
395
396 tv_bndrs        :: { [HsTyVar RdrName] }
397                 :                       { [] }
398                 | tv_bndr tv_bndrs      { $1 : $2 }
399
400 kind            :: { Kind }
401                 : akind                 { $1 }
402                 | akind RARROW kind     { mkArrowKind $1 $3 }
403
404 akind           :: { Kind }
405                 : VARSYM                { mkTypeKind {- ToDo: check that it's "*" -} }
406                 | OPAREN kind CPAREN    { $2
407 --------------------------------------------------------------------------
408                                         }
409
410
411 instances_part  :: { [RdrNameInstDecl] }
412 instances_part  :  INSTANCES_PART instdecls { $2 }
413                 |                           { [] }
414
415 instdecls       :: { [RdrNameInstDecl] }
416 instdecls       :                           { [] }
417                 |  instd instdecls          { $1 : $2 }
418
419 instd           :: { RdrNameInstDecl }
420 instd           :  INSTANCE type EQUAL var_name SEMI 
421                         { InstDecl $2
422                                    EmptyMonoBinds       {- No bindings -}
423                                    []                   {- No user pragmas -}
424                                    (Just $4)            {- Dfun id -}
425                                    mkIfaceSrcLoc 
426 --------------------------------------------------------------------------
427                     }
428
429 id_info         :: { [HsIdInfo RdrName] }
430 id_info         :                                               { [] }
431                 | id_info_item id_info                          { $1 : $2 }
432
433 id_info_item    :: { HsIdInfo RdrName }
434 id_info_item    : ARITY_PART arity_info                 { HsArity $2 }
435                 | STRICT_PART strict_info               { HsStrictness $2 }
436                 | BOTTOM                                { HsStrictness mkBottomStrictnessInfo }
437                 | UNFOLD_PART core_expr                 { HsUnfold $2 }
438
439 arity_info      :: { ArityInfo }
440 arity_info      : INTEGER                                       { exactArity (fromInteger $1) }
441
442 strict_info     :: { StrictnessInfo RdrName }
443 strict_info     : DEMAND any_var_name                           { mkStrictnessInfo $1 (Just $2) }
444                 | DEMAND                                        { mkStrictnessInfo $1 Nothing }
445
446 core_expr       :: { UfExpr RdrName }
447 core_expr       : any_var_name                                  { UfVar $1 }
448                 | qdata_name                                    { UfVar $1 }
449                 | core_lit                                      { UfLit $1 }
450                 | OPAREN core_expr CPAREN                       { $2 }
451
452                 | core_expr ATSIGN atype                        { UfApp $1 (UfTyArg $3) }
453                 | core_expr core_arg                            { UfApp $1 $2 }
454                 | LAM core_val_bndrs RARROW core_expr           { foldr UfLam $4 $2 }
455                 | BIGLAM core_tv_bndrs RARROW core_expr         { foldr UfLam $4 $2 }
456
457                 | CASE core_expr OF 
458                   OCURLY alg_alts core_default CCURLY           { UfCase $2 (UfAlgAlts  $5 $6) }
459                 | PRIM_CASE core_expr OF 
460                   OCURLY prim_alts core_default CCURLY          { UfCase $2 (UfPrimAlts $5 $6) }
461
462
463                 | LET OCURLY core_val_bndr EQUAL core_expr CCURLY
464                   IN core_expr                                  { UfLet (UfNonRec $3 $5) $8 }
465                 | LETREC OCURLY rec_binds CCURLY                
466                   IN core_expr                                  { UfLet (UfRec $3) $6 }
467
468                 | coerce atype core_expr                        { UfCoerce $1 $2 $3 }
469
470                 | CCALL ccall_string 
471                         OBRACK atype atypes CBRACK core_args    { let
472                                                                         (is_casm, may_gc) = $1
473                                                                   in
474                                                                   UfPrim (UfCCallOp $2 is_casm may_gc $5 $4)
475                                                                          $7
476                                                                 }
477
478 rec_binds       :: { [(UfBinder RdrName, UfExpr RdrName)] }
479                 :                                               { [] }
480                 | core_val_bndr EQUAL core_expr SEMI rec_binds  { ($1,$3) : $5 }
481
482 coerce          :: { UfCoercion RdrName }
483 coerce          : COERCE_IN  qdata_name                         { UfIn  $2 }
484                 | COERCE_OUT qdata_name                         { UfOut $2 }
485                 
486 prim_alts       :: { [(Literal,UfExpr RdrName)] }
487                 :                                               { [] }
488                 | core_lit RARROW core_expr SEMI prim_alts      { ($1,$3) : $5 }
489
490 alg_alts        :: { [(RdrName, [UfBinder RdrName], UfExpr RdrName)] }
491                 :                                               { [] }
492                 | qdata_name core_val_bndrs RARROW 
493                         core_expr SEMI alg_alts                 { ($1,$2,$4) : $6 }
494
495 core_default    :: { UfDefault RdrName }
496                 :                                               { UfNoDefault }
497                 | core_val_bndr RARROW core_expr SEMI           { UfBindDefault $1 $3 }
498
499 core_arg        :: { UfArg RdrName }
500                 : var_name                                      { UfVarArg $1 }
501                 | qvar_name                                     { UfVarArg $1 }
502                 | qdata_name                                    { UfVarArg $1 }
503                 | core_lit                                      { UfLitArg $1 }
504
505 core_args       :: { [UfArg RdrName] }
506                 :                                               { [] }
507                 | core_arg core_args                            { $1 : $2 }
508
509 core_lit        :: { Literal }
510 core_lit        : INTEGER                       { MachInt $1 True }
511                 | CHAR                          { MachChar $1 }
512                 | STRING                        { MachStr $1 }
513                 | STRING_LIT STRING             { NoRepStr $2 }
514                 | DOUBLE                        { MachDouble (toRational $1) }
515                 | FLOAT_LIT DOUBLE              { MachFloat (toRational $2) }
516
517                 | INTEGER_LIT INTEGER           { NoRepInteger  $2 (panic "NoRepInteger type") 
518                                                         -- The type checker will add the types
519                                                 }
520
521                 | RATIONAL_LIT INTEGER INTEGER  { NoRepRational ($2 % $3) 
522                                                                 (panic "NoRepRational type")
523                                                                         -- The type checker will add the type
524                                                 }
525
526                 | ADDR_LIT INTEGER              { MachAddr $2 }
527                 | LIT_LIT STRING                { MachLitLit $2 (panic "ParseIface.y: ToDo: need PrimRep on LitLits in ifaces") }
528
529 core_val_bndr   :: { UfBinder RdrName }
530 core_val_bndr   : var_name DCOLON atype                         { UfValBinder $1 $3 }
531
532 core_val_bndrs  :: { [UfBinder RdrName] }
533 core_val_bndrs  :                                               { [] }
534                 | core_val_bndr core_val_bndrs                  { $1 : $2 }
535
536 core_tv_bndr    :: { UfBinder RdrName }
537 core_tv_bndr    :  tv_name DCOLON akind                         { UfTyBinder $1 $3 }
538                 |  tv_name                                      { UfTyBinder $1 mkTypeKind }
539
540 core_tv_bndrs   :: { [UfBinder RdrName] }
541 core_tv_bndrs   :                                               { [] }
542                 | core_tv_bndr core_tv_bndrs                    { $1 : $2 }
543
544 ccall_string    :: { FAST_STRING }
545                 : STRING                                        { $1 }
546                 | VARID                                         { $1 }
547                 | CONID                                         { $1 }