[project @ 2001-05-24 13:59:09 by simonpj]
[ghc-hetmet.git] / ghc / compiler / rename / ParseIface.y
1 {-      Notes about the syntax of interface files
2         ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
3 The header
4 ~~~~~~~~~~
5   interface "edison" M 4 6 2 ! 406      Module M, version 4, from package 'edison',
6                                         Fixities version 6, rules version 2
7                                         Interface syntax version 406
8                                         ! means M contains orphans
9
10 Import declarations
11 ~~~~~~~~~~~~~~~~~~~
12   import Foo ;                          To compile M I used nothing from Foo, but it's 
13                                         below me in the hierarchy
14
15   import Foo ! @ ;                      Ditto, but the ! means that Foo contains orphans
16                                         and        the @ means that Foo is a boot interface
17
18   import Foo :: 3 ;                     To compile M I used everything from Foo, which has 
19                                         module version 3
20
21   import Foo :: 3 2 6 a 1 b 3 c 7 ;     To compile M I used Foo.  It had 
22                                                 module version 3
23                                                 fixity version 2
24                                                 rules  version 6
25                                         and some specific things besides.
26
27 -}
28
29
30 {
31 module ParseIface ( parseIface, parseType, parseRules, parseIdInfo ) where
32
33 #include "HsVersions.h"
34
35 import HsSyn            -- quite a bit of stuff
36 import RdrHsSyn         -- oodles of synonyms
37 import HsTypes          ( mkHsForAllTy, mkHsTupCon )
38 import HsCore
39 import Demand           ( mkStrictnessInfo )
40 import Literal          ( Literal(..), mkMachInt, mkMachInt64, mkMachWord, mkMachWord64 )
41 import BasicTypes       ( Fixity(..), FixityDirection(..), 
42                           NewOrData(..), Version, initialVersion, Boxity(..)
43                         )
44 import CostCentre       ( CostCentre(..), IsCafCC(..), IsDupdCC(..) )
45 import Demand           ( StrictnessMark(..) )
46 import Type             ( Kind, mkArrowKind, liftedTypeKind, openTypeKind, usageTypeKind )
47 import IdInfo           ( InlinePragInfo(..) )
48 import ForeignCall      ( ForeignCall(..), CCallConv(..), CCallSpec(..), CCallTarget(..) )
49 import Lex              
50
51 import RnMonad          ( ParsedIface(..), ExportItem, IfaceDeprecs ) 
52 import HscTypes         ( WhetherHasOrphans, IsBootInterface, GenAvailInfo(..), 
53                           ImportVersion, WhatsImported(..),
54                           RdrAvailInfo )
55
56 import RdrName          ( RdrName, mkRdrUnqual, mkIfaceOrig )
57 import Name             ( OccName )
58 import OccName          ( mkSysOccFS,
59                           tcName, varName, dataName, clsName, tvName,
60                           EncodedFS 
61                         )
62 import Module           ( ModuleName, PackageName, mkSysModuleNameFS, mkModule )
63 import SrcLoc           ( SrcLoc )
64 import CmdLineOpts      ( opt_InPackage, opt_IgnoreIfacePragmas )
65 import Outputable
66 import Class            ( DefMeth (..) )
67
68 import GlaExts
69 import FastString       ( tailFS )
70 }
71
72 %name       parseIface      iface
73 %name       parseType       type
74 %name       parseIdInfo     id_info
75 %name       parseRules      rules_and_deprecs
76
77 %tokentype  { Token }
78 %monad      { P }{ thenP }{ returnP }
79 %lexer      { lexer } { ITeof }
80
81 %token
82  'as'           { ITas }
83  'case'         { ITcase }                      -- Haskell keywords
84  'class'        { ITclass } 
85  'data'         { ITdata } 
86  'default'      { ITdefault }
87  'deriving'     { ITderiving }
88  'do'           { ITdo }
89  'else'         { ITelse }
90  'hiding'       { IThiding }
91  'if'           { ITif }
92  'import'       { ITimport }
93  'in'           { ITin }
94  'infix'        { ITinfix }
95  'infixl'       { ITinfixl }
96  'infixr'       { ITinfixr }
97  'instance'     { ITinstance }
98  'let'          { ITlet }
99  'module'       { ITmodule }
100  'newtype'      { ITnewtype }
101  'of'           { ITof }
102  'qualified'    { ITqualified }
103  'then'         { ITthen }
104  'type'         { ITtype }
105  'where'        { ITwhere }
106
107  'forall'       { ITforall }                    -- GHC extension keywords
108  'foreign'      { ITforeign }
109  'export'       { ITexport }
110  'label'        { ITlabel } 
111  'dynamic'      { ITdynamic }
112  'unsafe'       { ITunsafe }
113  'with'         { ITwith }
114  'stdcall'      { ITstdcallconv }
115  'ccall'        { ITccallconv }
116
117  '__interface'  { ITinterface }                 -- interface keywords
118  '__export'     { IT__export }
119  '__depends'    { ITdepends }
120  '__forall'     { IT__forall }
121  '__letrec'     { ITletrec }
122  '__coerce'     { ITcoerce }
123  '__inline_me'  { ITinlineMe }
124  '__inline_call'{ ITinlineCall }
125  '__DEFAULT'    { ITdefaultbranch }
126  '__bot'        { ITbottom }
127  '__integer'    { ITinteger_lit }
128  '__float'      { ITfloat_lit }
129  '__word'       { ITword_lit }
130  '__int64'      { ITint64_lit }
131  '__word64'     { ITword64_lit }
132  '__rational'   { ITrational_lit }
133  '__addr'       { ITaddr_lit }
134  '__label'      { ITlabel_lit }
135  '__litlit'     { ITlit_lit }
136  '__string'     { ITstring_lit }
137  '__ccall'      { ITccall $$ }
138  '__scc'        { ITscc }
139  '__sccC'       { ITsccAllCafs }
140
141  '__u'          { ITusage }
142
143  '__A'          { ITarity }
144  '__P'          { ITspecialise }
145  '__C'          { ITnocaf }
146  '__U'          { ITunfold $$ }
147  '__S'          { ITstrict $$ }
148  '__R'          { ITrules }
149  '__M'          { ITcprinfo }
150  '__D'          { ITdeprecated }
151
152  '..'           { ITdotdot }                    -- reserved symbols
153  '::'           { ITdcolon }
154  '='            { ITequal }
155  '\\'           { ITlam }
156  '|'            { ITvbar }
157  '<-'           { ITlarrow }
158  '->'           { ITrarrow }
159  '@'            { ITat }
160  '=>'           { ITdarrow }
161  '-'            { ITminus }
162  '!'            { ITbang }
163
164  '{'            { ITocurly }                    -- special symbols
165  '}'            { ITccurly }
166  '{|'           { ITocurlybar }                         -- special symbols
167  '|}'           { ITccurlybar }                         -- special symbols
168  '['            { ITobrack }
169  ']'            { ITcbrack }
170  '('            { IToparen }
171  ')'            { ITcparen }
172  '(#'           { IToubxparen }
173  '#)'           { ITcubxparen }
174  ';'            { ITsemi }
175  ','            { ITcomma }
176  '.'            { ITdot }
177
178  VARID          { ITvarid    $$ }               -- identifiers
179  CONID          { ITconid    $$ }
180  VARSYM         { ITvarsym   $$ }
181  CONSYM         { ITconsym   $$ }
182  QVARID         { ITqvarid   $$ }
183  QCONID         { ITqconid   $$ }
184  QVARSYM        { ITqvarsym  $$ }
185  QCONSYM        { ITqconsym  $$ }
186
187  IPVARID        { ITipvarid  $$ }               -- GHC extension
188
189  PRAGMA         { ITpragma   $$ }
190
191  CHAR           { ITchar     $$ }
192  STRING         { ITstring   $$ }
193  INTEGER        { ITinteger  $$ }
194  RATIONAL       { ITrational $$ }
195  CLITLIT        { ITlitlit   $$ }
196
197  UNKNOWN        { ITunknown  $$ }
198 %%
199
200 iface           :: { ParsedIface }
201 iface           : '__interface' package mod_name 
202                         version sub_versions
203                         orphans checkVersion 'where'
204                   exports_part
205                   import_part
206                   fix_decl_part
207                   instance_decl_part
208                   decls_part
209                   rules_and_deprecs_part
210                   { ParsedIface {
211                         pi_mod  = mkModule $3 $2,       -- Module itself
212                         pi_vers = $4,                   -- Module version
213                         pi_orphan  = $6,
214                         pi_exports = (fst $5, $9),      -- Exports
215                         pi_usages  = $10,               -- Usages
216                         pi_fixity  = $11,               -- Fixies
217                         pi_insts   = $12,               -- Local instances
218                         pi_decls   = $13,               -- Decls
219                         pi_rules   = (snd $5,fst $14),  -- Rules 
220                         pi_deprecs = snd $14            -- Deprecations 
221                    } }
222
223 -- Versions for exports and rules (optional)
224 sub_versions :: { (Version,Version) }
225         : '[' version version ']'               { ($2,$3) }
226         | {- empty -}                           { (initialVersion, initialVersion) }
227
228 --------------------------------------------------------------------------
229
230 import_part :: { [ImportVersion OccName] }
231 import_part :                                             { [] }
232             |  import_decl import_part                    { $1 : $2 }
233             
234 import_decl :: { ImportVersion OccName }
235 import_decl : 'import' mod_name orphans is_boot whats_imported ';'
236                         { ({-mkSysModuleNameFS-} $2, $3, $4, $5) }
237
238 orphans             :: { WhetherHasOrphans }
239 orphans             :                                           { False }
240                     | '!'                                       { True }
241
242 is_boot             :: { IsBootInterface }
243 is_boot             :                                           { False }
244                     | '@'                                       { True }
245
246 whats_imported      :: { WhatsImported OccName }
247 whats_imported      :                                                   { NothingAtAll }
248                     | '::' version                                      { Everything $2 }
249                     | '::' version version version name_version_pairs   { Specifically $2 (Just $3) $5 $4 }
250                     | '::' version version name_version_pairs           { Specifically $2 Nothing $4 $3 }
251
252 name_version_pairs  ::  { [(OccName, Version)] }
253 name_version_pairs  :                                           { [] }
254                     |  name_version_pair name_version_pairs     { $1 : $2 }
255
256 name_version_pair   ::  { (OccName, Version) }
257 name_version_pair   :  var_occ version                          { ($1, $2) }
258                     |  tc_occ  version                          { ($1, $2) }
259
260
261 --------------------------------------------------------------------------
262
263 exports_part    :: { [ExportItem] }
264 exports_part    :                                       { [] }
265                 | '__export' mod_name entities ';'
266                         exports_part                    { ({-mkSysModuleNameFS-} $2, $3) : $5 }
267
268 entities        :: { [RdrAvailInfo] }
269 entities        :                                       { [] }
270                 |  entity entities                      { $1 : $2 }
271
272 entity          :: { RdrAvailInfo }
273 entity          :  var_occ                              { Avail $1 }
274                 |  tc_occ                               { AvailTC $1 [$1] }
275                 |  tc_occ '|' stuff_inside              { AvailTC $1 $3 }
276                 |  tc_occ stuff_inside                  { AvailTC $1 ($1:$2) }
277                 -- Note that the "main name" comes at the beginning
278
279 stuff_inside    :: { [OccName] }
280 stuff_inside    :  '{' val_occs '}'                     { $2 }
281
282 val_occ         :: { OccName }
283                 :  var_occ              { $1 }
284                 |  data_occ             { $1 }
285
286 val_occs        :: { [OccName] }
287                 :  val_occ              { [$1] }
288                 |  val_occ val_occs     { $1 : $2 }
289
290
291 --------------------------------------------------------------------------
292
293 fix_decl_part :: { [RdrNameFixitySig] }
294 fix_decl_part : {- empty -}                             { [] }
295               | fix_decls ';'                           { $1 }
296
297 fix_decls     :: { [RdrNameFixitySig] }
298 fix_decls     :                                         { [] }
299               | fix_decl fix_decls                      { $1 : $2 }
300
301 fix_decl :: { RdrNameFixitySig }
302 fix_decl : src_loc fixity prec var_or_data_name         { FixitySig $4 (Fixity $3 $2) $1 }
303
304 fixity      :: { FixityDirection }
305 fixity      : 'infixl'                                  { InfixL }
306             | 'infixr'                                  { InfixR }
307             | 'infix'                                   { InfixN }
308    
309 prec        :: { Int }
310 prec        : INTEGER                                   { fromInteger $1 }
311
312 -----------------------------------------------------------------------------
313
314 csigs           :: { [RdrNameSig] }
315 csigs           :                               { [] }
316                 | 'where' '{' csigs1 '}'        { $3 }
317
318 csigs1          :: { [RdrNameSig] }
319 csigs1          :                               { [] }
320                 | csig ';' csigs1               { $1 : $3 }
321
322 csig            :: { RdrNameSig }
323 csig            :  src_loc qvar_name '::' type          { ClassOpSig $2 NoDefMeth $4 $1 }
324                 |  src_loc qvar_name ';' '::' type      { ClassOpSig $2 GenDefMeth $5 $1 }              
325                 |  src_loc qvar_name '=' '::' type      { mkClassOpSigDM $2 $5 $1 }
326
327 --------------------------------------------------------------------------
328
329 instance_decl_part :: { [RdrNameInstDecl] }
330 instance_decl_part : {- empty -}                       { [] }
331                    | instance_decl_part inst_decl      { $2 : $1 }
332
333 inst_decl       :: { RdrNameInstDecl }
334 inst_decl       :  src_loc 'instance' type '=' qvar_name ';'
335                         { InstDecl $3
336                                    EmptyMonoBinds       {- No bindings -}
337                                    []                   {- No user pragmas -}
338                                    (Just $5)            {- Dfun id -}
339                                    $1
340                         }
341
342 --------------------------------------------------------------------------
343
344 decls_part :: { [(Version, RdrNameTyClDecl)] }
345 decls_part 
346         :  {- empty -}                          { [] }
347         |  opt_version decl ';' decls_part              { ($1,$2):$4 }
348
349 decl    :: { RdrNameTyClDecl }
350 decl    : src_loc qvar_name '::' type maybe_idinfo
351                         { IfaceSig $2 $4 ($5 $2) $1 }
352         | src_loc 'type' qtc_name tv_bndrs '=' type                    
353                         { TySynonym $3 $4 $6 $1 }
354         | src_loc 'foreign' 'type' qtc_name                    
355                         { ForeignType $4 DNType $1 }
356         | src_loc 'data' opt_decl_context qtc_name tv_bndrs constrs            
357                         { mkTyData DataType $3 $4 $5 $6 (length $6) Nothing $1 }
358         | src_loc 'newtype' opt_decl_context qtc_name tv_bndrs newtype_constr
359                         { mkTyData NewType $3 $4 $5 $6 1 Nothing $1 }
360         | src_loc 'class' opt_decl_context qtc_name tv_bndrs fds csigs
361                         { mkClassDecl $3 $4 $5 $6 $7 Nothing $1 }
362
363 maybe_idinfo  :: { RdrName -> [HsIdInfo RdrName] }
364 maybe_idinfo  : {- empty -}     { \_ -> [] }
365               | pragma          { \x -> if opt_IgnoreIfacePragmas then [] 
366                                         else case $1 of
367                                                 POk _ id_info -> id_info
368                                                 PFailed err -> pprPanic "IdInfo parse failed" 
369                                                                         (vcat [ppr x, err])
370                                 }
371     {-
372       If a signature decl is being loaded, and opt_IgnoreIfacePragmas is on,
373       we toss away unfolding information.
374
375       Also, if the signature is loaded from a module we're importing from source,
376       we do the same. This is to avoid situations when compiling a pair of mutually
377       recursive modules, peering at unfolding info in the interface file of the other, 
378       e.g., you compile A, it looks at B's interface file and may as a result change
379       its interface file. Hence, B is recompiled, maybe changing its interface file,
380       which will the unfolding info used in A to become invalid. Simple way out is to
381       just ignore unfolding info.
382
383       [Jan 99: I junked the second test above.  If we're importing from an hi-boot
384        file there isn't going to *be* any pragma info.  The above comment
385        dates from a time where we picked up a .hi file first if it existed.]
386     -}
387
388 pragma  :: { ParseResult [HsIdInfo RdrName] }
389 pragma  : src_loc PRAGMA        { parseIdInfo $2 PState{ bol = 0#, atbol = 1#,
390                                                         context = [],
391                                                         glasgow_exts = 1#,
392                                                         loc = $1 }
393                                 }
394
395 -----------------------------------------------------------------------------
396
397 rules_and_deprecs_part :: { ([RdrNameRuleDecl], IfaceDeprecs) }
398 rules_and_deprecs_part : {- empty -}    { ([], Nothing) }
399                        | rules_prag     { case $1 of
400                                              POk _ rds -> rds
401                                              PFailed err -> pprPanic "Rules/Deprecations parse failed" err
402                                         }
403
404 rules_prag :: { ParseResult ([RdrNameRuleDecl], IfaceDeprecs) }
405 rules_prag : src_loc PRAGMA     { parseRules $2 PState{ bol = 0#, atbol = 1#,
406                                                         context = [],
407                                                         glasgow_exts = 1#,
408                                                         loc = $1 }
409                                 }
410
411 rules_and_deprecs :: { ([RdrNameRuleDecl], IfaceDeprecs) }
412 rules_and_deprecs : rule_prag deprec_prag       { ($1, $2) }
413
414  
415 -----------------------------------------------------------------------------
416
417 rule_prag :: { [RdrNameRuleDecl] }
418 rule_prag : {- empty -}                 { [] }
419           | '__R' rules                 { $2 }
420
421 rules      :: { [RdrNameRuleDecl] }
422            : {- empty -}        { [] }
423            | rule ';' rules     { $1:$3 }
424
425 rule       :: { RdrNameRuleDecl }
426 rule       : src_loc STRING rule_forall qvar_name 
427              core_args '=' core_expr    { IfaceRule $2 $3 $4 $5 $7 $1 } 
428
429 rule_forall     :: { [UfBinder RdrName] }
430 rule_forall     : '__forall' '{' core_bndrs '}' { $3 }
431                   
432 -----------------------------------------------------------------------------
433
434 deprec_prag     :: { IfaceDeprecs }
435 deprec_prag     : {- empty -}           { Nothing }
436                 | '__D' deprecs         { Just $2 } 
437
438 deprecs         :: { Either DeprecTxt [(RdrName,DeprecTxt)] }
439 deprecs         : STRING                { Left $1 }
440                 | deprec_list           { Right $1 }
441
442 deprec_list     :: { [(RdrName,DeprecTxt)] }
443 deprec_list     : deprec                        { [$1] }
444                 | deprec ';' deprec_list        { $1 : $3 }
445
446 deprec          :: { (RdrName,DeprecTxt) }
447 deprec          : deprec_name STRING    { ($1, $2) }
448
449 deprec_name     :: { RdrName }
450                 : qvar_name             { $1 }
451                 | qtc_name              { $1 }
452
453 -----------------------------------------------------------------------------
454
455 version         :: { Version }
456 version         :  INTEGER                      { fromInteger $1 }
457
458 opt_version     :: { Version }
459 opt_version     : version                       { $1 }
460                 | {- empty -}                   { initialVersion }
461         
462 opt_decl_context  :: { RdrNameContext }
463 opt_decl_context  :                             { [] }
464                   | context '=>'                { $1 }
465
466 ----------------------------------------------------------------------------
467
468 constrs         :: { [RdrNameConDecl] {- empty for handwritten abstract -} }
469                 :                       { [] }
470                 | '=' constrs1          { $2 }
471
472 constrs1        :: { [RdrNameConDecl] }
473 constrs1        :  constr               { [$1] }
474                 |  constr '|' constrs1  { $1 : $3 }
475
476 constr          :: { RdrNameConDecl }
477 constr          :  src_loc ex_stuff qdata_name batypes          { mk_con_decl $3 $2 (VanillaCon $4) $1 }
478                 |  src_loc ex_stuff qdata_name '{' fields1 '}'  { mk_con_decl $3 $2 (RecCon $5)     $1 }
479                 -- We use "data_fs" so as to include ()
480
481 newtype_constr  :: { [RdrNameConDecl] {- Not allowed to be empty -} }
482 newtype_constr  : src_loc '=' ex_stuff qdata_name atype { [mk_con_decl $4 $3 (VanillaCon [unbangedType $5]) $1] }
483                 | src_loc '=' ex_stuff qdata_name '{' qvar_name '::' atype '}'
484                                                         { [mk_con_decl $4 $3 (RecCon [([$6], unbangedType $8)]) $1] }
485
486 ex_stuff :: { ([HsTyVarBndr RdrName], RdrNameContext) }
487 ex_stuff        :                                       { ([],[]) }
488                 | '__forall' tv_bndrs opt_context '=>'  { ($2,$3) }
489
490 batypes         :: { [RdrNameBangType] }
491 batypes         :                                       { [] }
492                 |  batype batypes                       { $1 : $2 }
493
494 batype          :: { RdrNameBangType }
495 batype          :  tatype                               { unbangedType $1 }
496                 |  '!' tatype                           { BangType MarkedStrict    $2 }
497                 |  '!' '!' tatype                       { BangType MarkedUnboxed   $3 }
498
499 fields1         :: { [([RdrName], RdrNameBangType)] }
500 fields1         : field                                 { [$1] }
501                 | field ',' fields1                     { $1 : $3 }
502
503 field           :: { ([RdrName], RdrNameBangType) }
504 field           :  qvar_names1 '::' ttype               { ($1, unbangedType $3) }
505                 |  qvar_names1 '::' '!' ttype           { ($1, BangType MarkedStrict    $4) }
506                 |  qvar_names1 '::' '!' '!' ttype       { ($1, BangType MarkedUnboxed   $5) }
507
508 --------------------------------------------------------------------------
509
510 type            :: { RdrNameHsType }
511 type            : '__forall' tv_bndrs 
512                         opt_context '=>' type   { mkHsForAllTy (Just $2) $3 $5 }
513                 | btype '->' type               { HsFunTy $1 $3 }
514                 | btype                         { $1 }
515
516 opt_context     :: { RdrNameContext }
517 opt_context     :                                       { [] }
518                 | context                               { $1 }
519
520 context         :: { RdrNameContext }
521 context         : '(' context_list1 ')'                 { $2 }
522                 | '{' context_list1 '}'                 { $2 }  -- Backward compatibility
523
524 context_list1   :: { RdrNameContext }
525 context_list1   : class                                 { [$1] }
526                 | class ',' context_list1               { $1 : $3 }
527
528 class           :: { HsPred RdrName }
529 class           :  qcls_name atypes                     { (HsClassP $1 $2) }
530                 |  ipvar_name '::' type                 { (HsIParam $1 $3) }
531
532 types0          :: { [RdrNameHsType]                    {- Zero or more -}  }   
533 types0          :  {- empty -}                          { [ ] }
534                 |  type                                 { [ $1 ] }
535                 |  types2                               { $1 }
536
537 types2          :: { [RdrNameHsType]                    {- Two or more -}  }    
538 types2          :  type ',' type                        { [$1,$3] }
539                 |  type ',' types2                      { $1 : $3 }
540
541 btype           :: { RdrNameHsType }
542 btype           :  atype                                { $1 }
543                 |  btype atype                          { HsAppTy $1 $2 }
544                 |  '__u' atype atype                    { HsUsageTy $2 $3 }
545
546 atype           :: { RdrNameHsType }
547 atype           :  qtc_name                             { HsTyVar $1 }
548                 |  tv_name                              { HsTyVar $1 }
549                 |  '.'                                  { hsUsOnce }
550                 |  '!'                                  { hsUsMany }
551                 |  '(' ')'                              { HsTupleTy (mkHsTupCon tcName Boxed   []) [] }
552                 |  '(' types2 ')'                       { HsTupleTy (mkHsTupCon tcName Boxed   $2) $2 }
553                 |  '(#' types0 '#)'                     { HsTupleTy (mkHsTupCon tcName Unboxed $2) $2 }
554                 |  '[' type ']'                         { HsListTy  $2 }
555                 |  '{' qcls_name atypes '}'             { mkHsDictTy $2 $3 }
556                 |  '{' ipvar_name '::' type '}'         { mkHsIParamTy $2 $4 }
557                 |  '(' type ')'                         { $2 }
558
559 atypes          :: { [RdrNameHsType]    {-  Zero or more -} }
560 atypes          :                                       { [] }
561                 |  atype atypes                         { $1 : $2 }
562 --------------------------------------------------------------------------
563
564 -- versions of type/btype/atype that cant begin with '!' (or '.')
565 -- for use where the kind is definitely known NOT to be '$'
566
567 ttype           :: { RdrNameHsType }
568 ttype           : '__forall' tv_bndrs 
569                         opt_context '=>' type           { mkHsForAllTy (Just $2) $3 $5 }
570                 | tbtype '->' type                      { HsFunTy $1 $3 }
571                 | tbtype                                { $1 }
572
573 tbtype          :: { RdrNameHsType }
574 tbtype          :  tatype                               { $1 }
575                 |  tbtype atype                         { HsAppTy $1 $2 }
576                 |  '__u' atype atype                    { HsUsageTy $2 $3 }
577
578 tatype          :: { RdrNameHsType }
579 tatype          :  qtc_name                             { HsTyVar $1 }
580                 |  tv_name                              { HsTyVar $1 }
581                 |  '(' ')'                              { HsTupleTy (mkHsTupCon tcName Boxed   []) [] }
582                 |  '(' types2 ')'                       { HsTupleTy (mkHsTupCon tcName Boxed   $2) $2 }
583                 |  '(#' types0 '#)'                     { HsTupleTy (mkHsTupCon tcName Unboxed $2) $2 }
584                 |  '[' type ']'                         { HsListTy  $2 }
585                 |  '{' qcls_name atypes '}'             { mkHsDictTy $2 $3 }
586                 |  '{' ipvar_name '::' type '}'         { mkHsIParamTy $2 $4 }
587                 |  '(' type ')'                         { $2 }
588 ---------------------------------------------------------------------
589
590 package         :: { PackageName }
591                 :  STRING               { $1 }
592                 | {- empty -}           { opt_InPackage }       -- Useful for .hi-boot files,
593                                                                 -- which can omit the package Id
594                                                                 -- Module loops are always within a package
595
596 mod_name        :: { ModuleName }
597                 :  CONID                { mkSysModuleNameFS $1 }
598
599
600 ---------------------------------------------------
601 var_fs          :: { EncodedFS }
602                 : VARID                 { $1 }
603                 | '!'                   { SLIT("!") }
604                 | 'as'                  { SLIT("as") }
605                 | 'qualified'           { SLIT("qualified") }
606                 | 'hiding'              { SLIT("hiding") }
607                 | 'forall'              { SLIT("forall") }
608                 | 'foreign'             { SLIT("foreign") }
609                 | 'export'              { SLIT("export") }
610                 | 'label'               { SLIT("label") }
611                 | 'dynamic'             { SLIT("dynamic") }
612                 | 'unsafe'              { SLIT("unsafe") }
613                 | 'with'                { SLIT("with") }
614                 | 'ccall'               { SLIT("ccall") }
615                 | 'stdcall'             { SLIT("stdcall") }
616
617 qvar_fs         :: { (EncodedFS, EncodedFS) }
618                 :  QVARID               { $1 }
619                 |  QVARSYM              { $1 }
620
621 var_occ         :: { OccName }
622                 :  var_fs               { mkSysOccFS varName $1 }
623
624 var_name        :: { RdrName }
625 var_name        :  var_occ              { mkRdrUnqual $1 }
626
627 qvar_name       :: { RdrName }
628 qvar_name       :  var_name             { $1 }
629                 |  qvar_fs              { mkIfaceOrig varName $1 }
630
631 ipvar_name      :: { RdrName }
632                 :  IPVARID              { mkRdrUnqual (mkSysOccFS varName (tailFS $1)) }
633
634 qvar_names1     :: { [RdrName] }
635 qvar_names1     : qvar_name             { [$1] }
636                 | qvar_name qvar_names1 { $1 : $2 }
637
638 var_names       :: { [RdrName] }
639 var_names       :                       { [] }
640                 | var_name var_names    { $1 : $2 }
641
642 var_names1      :: { [RdrName] }
643 var_names1      : var_name var_names    { $1 : $2 }
644
645 ---------------------------------------------------
646 -- For some bizarre reason, 
647 --      (,,,)      is dealt with by the parser
648 --      Foo.(,,,)  is dealt with by the lexer
649 -- Sigh
650
651 data_fs         :: { EncodedFS }
652                 :  CONID                { $1 }
653                 |  CONSYM               { $1 }
654
655 qdata_fs        :: { (EncodedFS, EncodedFS) }
656                 :  QCONID               { $1 }
657                 |  QCONSYM              { $1 }
658
659 data_occ        :: { OccName }
660                 :  data_fs              { mkSysOccFS dataName $1 }
661
662 data_name       :: { RdrName }
663                 :  data_occ             { mkRdrUnqual $1 }
664
665 qdata_name      :: { RdrName }
666 qdata_name      :  data_name            { $1 }
667                 |  qdata_fs             { mkIfaceOrig dataName $1 }
668                                 
669 var_or_data_name :: { RdrName }
670                   : qvar_name                    { $1 }
671                   | qdata_name                   { $1 }
672
673 ---------------------------------------------------
674 tc_occ          :: { OccName }
675                 :  data_fs              { mkSysOccFS tcName $1 }
676
677 tc_name         :: { RdrName }
678                 :  tc_occ               { mkRdrUnqual $1 }
679
680 qtc_name        :: { RdrName }
681                 : tc_name               { $1 }
682                 | qdata_fs              { mkIfaceOrig tcName $1 }
683
684 ---------------------------------------------------
685 cls_name        :: { RdrName }
686                 :  data_fs              { mkRdrUnqual (mkSysOccFS clsName $1) }
687
688 qcls_name       :: { RdrName }
689                 : cls_name              { $1 }
690                 | qdata_fs              { mkIfaceOrig clsName $1 }
691
692 ---------------------------------------------------
693 tv_name         :: { RdrName }
694                 :  VARID                { mkRdrUnqual (mkSysOccFS tvName $1) }
695
696 tv_bndr         :: { HsTyVarBndr RdrName }
697                 :  tv_name '::' akind   { IfaceTyVar $1 $3 }
698                 |  tv_name              { IfaceTyVar $1 liftedTypeKind }
699
700 tv_bndrs        :: { [HsTyVarBndr RdrName] }
701                 : tv_bndrs1             { $1 }
702                 | '[' tv_bndrs1 ']'     { $2 }  -- Backward compatibility
703
704 tv_bndrs1       :: { [HsTyVarBndr RdrName] }
705                 :                       { [] }
706                 | tv_bndr tv_bndrs1     { $1 : $2 }
707
708 ---------------------------------------------------
709 fds :: { [([RdrName], [RdrName])] }
710         : {- empty -}                   { [] }
711         | '|' fds1                      { reverse $2 }
712
713 fds1 :: { [([RdrName], [RdrName])] }
714         : fds1 ',' fd                   { $3 : $1 }
715         | fd                            { [$1] }
716
717 fd :: { ([RdrName], [RdrName]) }
718         : varids0 '->' varids0          { (reverse $1, reverse $3) }
719
720 varids0 :: { [RdrName] }
721         : {- empty -}                   { [] }
722         | varids0 tv_name               { $2 : $1 }
723
724 ---------------------------------------------------
725 kind            :: { Kind }
726                 : akind                 { $1 }
727                 | akind '->' kind       { mkArrowKind $1 $3 }
728
729 akind           :: { Kind }
730                 : VARSYM                { if $1 == SLIT("*") then
731                                                 liftedTypeKind
732                                           else if $1 == SLIT("?") then
733                                                 openTypeKind
734                                           else if $1 == SLIT("\36") then
735                                                 usageTypeKind  -- dollar
736                                           else panic "ParseInterface: akind"
737                                         }
738                 | '(' kind ')'  { $2 }
739
740 --------------------------------------------------------------------------
741
742 id_info         :: { [HsIdInfo RdrName] }
743                 : id_info_item                  { [$1] }
744                 | id_info_item id_info          { $1 : $2 }
745
746 id_info_item    :: { HsIdInfo RdrName }
747                 : '__A' INTEGER                 { HsArity (fromInteger $2) }
748                 | '__U' inline_prag core_expr   { HsUnfold $2 $3 }
749                 | '__M'                         { HsCprInfo }
750                 | '__S'                         { HsStrictness (mkStrictnessInfo $1) }
751                 | '__C'                         { HsNoCafRefs }
752                 | '__P' qvar_name INTEGER       { HsWorker $2 (fromInteger $3) }
753
754 inline_prag     :: { InlinePragInfo }
755                 :  {- empty -}                  { NoInlinePragInfo }
756                 | '[' from_prag phase ']'       { IMustNotBeINLINEd $2 $3 }
757
758 from_prag       :: { Bool }
759                 : {- empty -}                   { True }
760                 | '!'                           { False }
761
762 phase           :: { Maybe Int }
763                 : {- empty -}                   { Nothing }
764                 | INTEGER                       { Just (fromInteger $1) }
765
766 -------------------------------------------------------
767 core_expr       :: { UfExpr RdrName }
768 core_expr       : '\\' core_bndrs '->' core_expr        { foldr UfLam $4 $2 }
769                 | 'case' core_expr 'of' var_name
770                   '{' core_alts '}'                     { UfCase $2 $4 $6 }
771
772                 | 'let' '{' core_val_bndr '=' core_expr
773                       '}' 'in' core_expr                { UfLet (UfNonRec $3 $5) $8 }
774                 | '__letrec' '{' rec_binds '}'          
775                   'in' core_expr                        { UfLet (UfRec $3) $6 }
776
777                 | '__litlit' STRING atype               { UfLitLit $2 $3 }
778
779                 | fexpr                                 { $1 }
780
781 fexpr   :: { UfExpr RdrName }
782 fexpr   : fexpr core_arg                                { UfApp $1 $2 }
783         | scc core_aexpr                                { UfNote (UfSCC $1) $2  }
784         | '__inline_me' core_aexpr                      { UfNote UfInlineMe $2 }
785         | '__inline_call' core_aexpr                    { UfNote UfInlineCall $2 }
786         | '__coerce' atype core_aexpr                   { UfNote (UfCoerce $2) $3 }
787         | core_aexpr                                    { $1 }
788
789 core_arg        :: { UfExpr RdrName }
790                 : '@' atype                                     { UfType $2 }
791                 | core_aexpr                                    { $1 }
792
793 core_args       :: { [UfExpr RdrName] }
794                 :                                               { [] }
795                 | core_arg core_args                            { $1 : $2 }
796
797 core_aexpr      :: { UfExpr RdrName }              -- Atomic expressions
798 core_aexpr      : qvar_name                                     { UfVar $1 }
799                 | qdata_name                                    { UfVar $1 }
800
801                 | core_lit               { UfLit $1 }
802                 | '(' core_expr ')'      { $2 }
803
804                 | '('  ')'               { UfTuple (mkHsTupCon dataName Boxed [])   [] }
805                 | '(' comma_exprs2 ')'   { UfTuple (mkHsTupCon dataName Boxed $2)   $2 }
806                 | '(#' comma_exprs0 '#)' { UfTuple (mkHsTupCon dataName Unboxed $2) $2 }
807
808                 | '{' '__ccall' ccall_string type '}'       
809                            { let
810                                  (is_dyn, is_casm, may_gc) = $2
811
812                                  target | is_dyn    = DynamicTarget
813                                         | is_casm   = CasmTarget $3
814                                         | otherwise = StaticTarget $3
815
816                                  ccall = CCallSpec target CCallConv may_gc
817                              in
818                              UfFCall (CCall ccall) $4
819                            }
820
821
822 comma_exprs0    :: { [UfExpr RdrName] } -- Zero or more
823 comma_exprs0    : {- empty -}                   { [ ] }
824                 | core_expr                     { [ $1 ] }
825                 | comma_exprs2                  { $1 }
826
827 comma_exprs2    :: { [UfExpr RdrName] } -- Two or more
828 comma_exprs2    : core_expr ',' core_expr                       { [$1,$3] }
829                 | core_expr ',' comma_exprs2                    { $1 : $3 }
830
831 rec_binds       :: { [(UfBinder RdrName, UfExpr RdrName)] }
832                 :                                               { [] }
833                 | core_val_bndr '=' core_expr ';' rec_binds     { ($1,$3) : $5 }
834
835 core_alts       :: { [UfAlt RdrName] }
836                 :                                               { [] }
837                 | core_alt ';' core_alts                        { $1 : $3 }
838
839 core_alt        :: { UfAlt RdrName }
840 core_alt        : core_pat '->' core_expr       { (fst $1, snd $1, $3) }
841
842 core_pat        :: { (UfConAlt RdrName, [RdrName]) }
843 core_pat        : core_lit                      { (UfLitAlt  $1, []) }
844                 | '__litlit' STRING atype       { (UfLitLitAlt $2 $3, []) }
845                 | qdata_name core_pat_names     { (UfDataAlt $1, $2) }
846                 | '('  ')'                      { (UfTupleAlt (mkHsTupCon dataName Boxed []),   []) }
847                 | '(' comma_var_names1 ')'      { (UfTupleAlt (mkHsTupCon dataName Boxed $2),   $2) }
848                 | '(#' comma_var_names1 '#)'    { (UfTupleAlt (mkHsTupCon dataName Unboxed $2), $2) }
849                 | '__DEFAULT'                   { (UfDefault, []) }
850                 | '(' core_pat ')'              { $2 }
851
852 core_pat_names :: { [RdrName] }
853 core_pat_names :                                { [] }
854                 | core_pat_name core_pat_names  { $1 : $2 }
855
856 -- Tyvar names and variable names live in different name spaces
857 -- so they need to be signalled separately.  But we don't record 
858 -- types or kinds in a pattern; we work that out from the type 
859 -- of the case scrutinee
860 core_pat_name   :: { RdrName }
861 core_pat_name   : var_name                      { $1 }
862                 | '@' tv_name                   { $2 }
863         
864 comma_var_names1 :: { [RdrName] }       -- One or more
865 comma_var_names1 : var_name                                     { [$1] }
866                  | var_name ',' comma_var_names1                { $1 : $3 }
867
868 core_lit        :: { Literal }
869 core_lit        : integer                       { mkMachInt $1 }
870                 | CHAR                          { MachChar $1 }
871                 | STRING                        { MachStr $1 }
872                 | rational                      { MachDouble $1 }
873                 | '__word' integer              { mkMachWord $2 }
874                 | '__word64' integer            { mkMachWord64 $2 }
875                 | '__int64' integer             { mkMachInt64 $2 }
876                 | '__float' rational            { MachFloat $2 }
877                 | '__addr' integer              { MachAddr $2 }
878                 | '__label' STRING              { MachLabel $2 }
879
880 integer         :: { Integer }
881                 : INTEGER                       { $1 }
882                 | '-' INTEGER                   { (-$2) }
883
884 rational        :: { Rational }
885                 : RATIONAL                      { $1 }
886                 | '-' RATIONAL                  { (-$2) }
887
888 core_bndr       :: { UfBinder RdrName }
889 core_bndr       : core_val_bndr                                 { $1 }
890                 | core_tv_bndr                                  { $1 }
891
892 core_bndrs      :: { [UfBinder RdrName] }
893 core_bndrs      :                                               { [] }
894                 | core_bndr core_bndrs                          { $1 : $2 }
895
896 core_val_bndr   :: { UfBinder RdrName }
897 core_val_bndr   : var_name '::' atype                           { UfValBinder $1 $3 }
898
899 core_tv_bndr    :: { UfBinder RdrName }
900 core_tv_bndr    :  '@' tv_name '::' akind               { UfTyBinder $2 $4 }
901                 |  '@' tv_name                          { UfTyBinder $2 liftedTypeKind }
902
903 ccall_string    :: { FAST_STRING }
904                 : STRING                                        { $1 }
905                 | CLITLIT                                       { $1 }
906                 | VARID                                         { $1 }
907                 | CONID                                         { $1 }
908
909 ------------------------------------------------------------------------
910 scc     :: { CostCentre }
911         :  '__sccC' '{' mod_name '}'                      { AllCafsCC $3 }
912         |  '__scc' '{' cc_name mod_name cc_dup cc_caf '}'
913                              { NormalCC { cc_name = $3, cc_mod = $4,
914                                           cc_is_dupd = $5, cc_is_caf = $6 } }
915
916 cc_name :: { EncodedFS }
917         : CONID                 { $1 }
918         | var_fs                { $1 }
919   
920 cc_dup  :: { IsDupdCC }
921 cc_dup  :                       { OriginalCC }
922         | '!'                   { DupdCC }
923
924 cc_caf  :: { IsCafCC }
925         :                       { NotCafCC }
926         | '__C'                 { CafCC }
927
928 -------------------------------------------------------------------
929
930 src_loc :: { SrcLoc }
931 src_loc :                               {% getSrcLocP }
932
933 -- Check the project version: this makes sure
934 -- that the project version (e.g. 407) in the interface
935 -- file is the same as that for the compiler that's reading it
936 checkVersion :: { () }
937            : {-empty-}                  {% checkVersion Nothing }
938            | INTEGER                    {% checkVersion (Just (fromInteger $1)) }
939
940 ------------------------------------------------------------------- 
941
942 --                      Haskell code 
943 {
944 happyError :: P a
945 happyError buf PState{ loc = loc } = PFailed (ifaceParseErr buf loc)
946
947 mk_con_decl name (ex_tvs, ex_ctxt) details loc = mkConDecl name ex_tvs ex_ctxt details loc
948 }