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