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