ghc/compiler/rename/ParseIface.y

   1 {
   2 #include "HsVersions.h"
   3 module ParseIface ( parseIface ) where
   4
   5 IMP_Ubiq(){-uitous-}
   6
   7 import CmdLineOpts      ( opt_IgnoreIfacePragmas )
   8
   9 import HsSyn            -- quite a bit of stuff
  10 import RdrHsSyn         -- oodles of synonyms
  11 import HsDecls          ( HsIdInfo(..) )
  12 import HsTypes          ( mkHsForAllTy )
  13 import HsCore
  14 import Literal
  15 import BasicTypes       ( Fixity(..), FixityDirection(..), NewOrData(..), Version(..) )
  16 import HsPragmas        ( noGenPragmas, noDataPragmas, noClassPragmas, noClassOpPragmas, noInstancePragmas )
  17 import IdInfo           ( exactArity, mkStrictnessInfo, mkBottomStrictnessInfo,
  18                           ArgUsageInfo, FBTypeInfo, ArityInfo, StrictnessInfo
  19                         )
  20 import Kind             ( Kind, mkArrowKind, mkTypeKind )
  21 import Lex
  22
  23 import RnMonad          ( SYN_IE(ImportVersion), SYN_IE(LocalVersion), ParsedIface(..),
  24                           SYN_IE(RdrNamePragma), SYN_IE(ExportItem)
  25                         )
  26 import Bag              ( emptyBag, unitBag, snocBag )
  27 import FiniteMap        ( emptyFM, unitFM, addToFM, plusFM, bagToFM, FiniteMap )
  28 import Name             ( OccName(..), isTCOcc, Provenance, SYN_IE(Module) )
  29 import SrcLoc           ( mkIfaceSrcLoc )
  30 import Util             ( panic{-, pprPanic ToDo:rm-} )
  31 import ParseType        ( parseType )
  32 import ParseUnfolding   ( parseUnfolding )
  33 import Maybes
  34
  35 -----------------------------------------------------------------
  36
  37 parseIface ls = parseIToks (lexIface ls)
  38
  39 -----------------------------------------------------------------
  40 }
  41
  42 %name       parseIToks
  43 %tokentype  { IfaceToken }
  44 %monad      { IfM }{ thenIf }{ returnIf }
  45
  46 %token
  47         INTERFACE           { ITinterface }
  48         USAGES_PART         { ITusages }
  49         VERSIONS_PART       { ITversions }
  50         EXPORTS_PART        { ITexports }
  51         INSTANCE_MODULES_PART { ITinstance_modules }
  52         INSTANCES_PART      { ITinstances }
  53         FIXITIES_PART       { ITfixities }
  54         DECLARATIONS_PART   { ITdeclarations }
  55         PRAGMAS_PART        { ITpragmas }
  56         DATA                { ITdata }
  57         TYPE                { ITtype }
  58         NEWTYPE             { ITnewtype }
  59         DERIVING            { ITderiving }
  60         CLASS               { ITclass }
  61         WHERE               { ITwhere }
  62         INSTANCE            { ITinstance }
  63         INFIXL              { ITinfixl }
  64         INFIXR              { ITinfixr }
  65         INFIX               { ITinfix }
  66         FORALL              { ITforall }
  67         BANG                { ITbang }
  68         VBAR                { ITvbar }
  69         DCOLON              { ITdcolon }
  70         COMMA               { ITcomma }
  71         DARROW              { ITdarrow }
  72         DOTDOT              { ITdotdot }
  73         EQUAL               { ITequal }
  74         OCURLY              { ITocurly }
  75         OBRACK              { ITobrack }
  76         OPAREN              { IToparen }
  77         RARROW              { ITrarrow }
  78         CCURLY              { ITccurly }
  79         CBRACK              { ITcbrack }
  80         CPAREN              { ITcparen }
  81         SEMI                { ITsemi }
  82
  83         VARID               { ITvarid    $$ }
  84         CONID               { ITconid    $$ }
  85         VARSYM              { ITvarsym   $$ }
  86         CONSYM              { ITconsym   $$ }
  87         QVARID              { ITqvarid   $$ }
  88         QCONID              { ITqconid   $$ }
  89         QVARSYM             { ITqvarsym  $$ }
  90         QCONSYM             { ITqconsym  $$ }
  91
  92         IDINFO_PART     { ITidinfo $$ }
  93         TYPE_PART       { ITtysig $$ }
  94         ARITY_PART      { ITarity }
  95         STRICT_PART     { ITstrict }
  96         UNFOLD_PART     { ITunfold $$ }
  97         DEMAND          { ITdemand $$ }
  98         BOTTOM          { ITbottom }
  99         LAM             { ITlam }
 100         BIGLAM          { ITbiglam }
 101         CASE            { ITcase }
 102         PRIM_CASE       { ITprim_case }
 103         LET             { ITlet }
 104         LETREC          { ITletrec }
 105         IN              { ITin }
 106         OF              { ITof }
 107         COERCE_IN       { ITcoerce_in }
 108         COERCE_OUT      { ITcoerce_out }
 109         ATSIGN          { ITatsign }
 110         CCALL           { ITccall $$ }
 111         SCC             { ITscc $$ }
 112
 113         CHAR            { ITchar $$ }
 114         STRING          { ITstring $$ }
 115         INTEGER         { ITinteger  $$ }
 116         DOUBLE          { ITdouble $$ }
 117
 118         INTEGER_LIT     { ITinteger_lit }
 119         FLOAT_LIT       { ITfloat_lit }
 120         RATIONAL_LIT    { ITrational_lit }
 121         ADDR_LIT        { ITaddr_lit }
 122         LIT_LIT         { ITlit_lit }
 123         STRING_LIT      { ITstring_lit }
 124
 125         UNKNOWN         { ITunknown $$ }
 126 %%
 127
 128 iface           :: { ParsedIface }
 129 iface           : INTERFACE CONID INTEGER
 130                   inst_modules_part
 131                   usages_part
 132                   exports_part fixities_part
 133                   instances_part
 134                   decls_part
 135                   { ParsedIface
 136                         $2                      -- Module name
 137                         (fromInteger $3)        -- Module version
 138                         $5                      -- Usages
 139                         $6                      -- Exports
 140                         $4                      -- Instance modules
 141                         $7                      -- Fixities
 142                         $9                      -- Decls
 143                         $8                      -- Local instances
 144                     }
 145
 146
 147 usages_part         :: { [ImportVersion OccName] }
 148 usages_part         :  USAGES_PART module_stuff_pairs           { $2 }
 149                     |                                           { [] }
 150
 151 module_stuff_pairs  :: { [ImportVersion OccName] }
 152 module_stuff_pairs  :                                           { [] }
 153                     |  module_stuff_pair module_stuff_pairs     { $1 : $2 }
 154
 155 module_stuff_pair   ::  { ImportVersion OccName }
 156 module_stuff_pair   :  mod_name INTEGER DCOLON name_version_pairs SEMI
 157                         { ($1, fromInteger $2, $4) }
 158
 159 versions_part       :: { [LocalVersion OccName] }
 160 versions_part       :  VERSIONS_PART name_version_pairs         { $2 }
 161                     |                                           { [] }
 162
 163 name_version_pairs  ::  { [LocalVersion OccName] }
 164 name_version_pairs  :                                           { [] }
 165                     |  name_version_pair name_version_pairs     { $1 : $2 }
 166
 167 name_version_pair   ::  { LocalVersion OccName }
 168 name_version_pair   :  entity_occ INTEGER                       { ($1, fromInteger $2)
 169 --------------------------------------------------------------------------
 170                                                                 }
 171
 172 exports_part    :: { [ExportItem] }
 173 exports_part    :  EXPORTS_PART export_items                    { $2 }
 174                 |                                               { [] }
 175
 176 export_items    :: { [ExportItem] }
 177 export_items    :                                               { [] }
 178                 |  mod_name entities SEMI export_items          { ($1,$2) : $4 }
 179
 180 entities        :: { [(OccName, [OccName])] }
 181 entities        :                                               { [] }
 182                 |  entity entities                              { $1 : $2 }
 183
 184 entity          :: { (OccName, [OccName]) }
 185 entity          :  entity_occ                                   { ($1, if isTCOcc $1
 186                                                                        then [$1]  {- AvailTC -}
 187                                                                        else [])   {- Avail -} }
 188                 |  entity_occ stuff_inside                      { ($1, ($1 : $2)) {- TyCls exported too -} }
 189                 |  entity_occ BANG stuff_inside                 { ($1, $3)        {- TyCls not exported -} }
 190
 191 stuff_inside    :: { [OccName] }
 192 stuff_inside    :  OPAREN val_occs1 CPAREN                      { $2
 193 --------------------------------------------------------------------------
 194                                                                 }
 195
 196 inst_modules_part :: { [Module] }
 197 inst_modules_part :                                             { [] }
 198                   |  INSTANCE_MODULES_PART mod_list             { $2 }
 199
 200 mod_list        :: { [Module] }
 201 mod_list        :                                               { [] }
 202                 |  mod_name mod_list                            { $1 : $2
 203 --------------------------------------------------------------------------
 204                                                                   }
 205
 206 fixities_part   :: { [(OccName,Fixity)] }
 207 fixities_part   :                                               { [] }
 208                 |  FIXITIES_PART fixes                          { $2 }
 209
 210 fixes           :: { [(OccName,Fixity)] }
 211 fixes           :                                               { []  }
 212                 |  fix fixes                                    { $1 : $2 }
 213
 214 fix             :: { (OccName, Fixity) }
 215 fix             :  INFIXL INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixL) }
 216                 |  INFIXR INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixR) }
 217                 |  INFIX  INTEGER val_occ SEMI { ($3, Fixity (fromInteger $2) InfixN)
 218 --------------------------------------------------------------------------
 219                                                                                       }
 220
 221 decls_part      :: { [(Version, RdrNameHsDecl)] }
 222 decls_part      :                                       { [] }
 223                 |       DECLARATIONS_PART topdecls      { $2 }
 224
 225 topdecls        :: { [(Version, RdrNameHsDecl)] }
 226 topdecls        :                                       { [] }
 227                 |  version topdecl topdecls             { ($1,$2) : $3 }
 228
 229 version         :: { Version }
 230 version         :  INTEGER                              { fromInteger $1 }
 231
 232 topdecl         :: { RdrNameHsDecl }
 233 topdecl         :  TYPE  tc_name tv_bndrs EQUAL type SEMI
 234                         { TyD (TySynonym $2 $3 $5 mkIfaceSrcLoc) }
 235                 |  DATA decl_context tc_name tv_bndrs constrs deriving SEMI
 236                         { TyD (TyData DataType $2 $3 $4 $5 $6 noDataPragmas mkIfaceSrcLoc) }
 237                 |  NEWTYPE decl_context tc_name tv_bndrs newtype_constr deriving SEMI
 238                         { TyD (TyData NewType $2 $3 $4 $5 $6 noDataPragmas mkIfaceSrcLoc) }
 239                 |  CLASS decl_context tc_name tv_bndr csigs SEMI
 240                         { ClD (ClassDecl $2 $3 $4 $5 EmptyMonoBinds noClassPragmas mkIfaceSrcLoc) }
 241                 |  var_name TYPE_PART id_info
 242                         {
 243                          let
 244                           (Succeeded tp) = parseType $2
 245                          in
 246                          SigD (IfaceSig $1 tp $3 mkIfaceSrcLoc) }
 247
 248 id_info         :: { [HsIdInfo RdrName] }
 249 id_info         :                               { [] }
 250                 | IDINFO_PART   { let { (Succeeded id_info) = parseUnfolding $1 } in id_info}
 251
 252 decl_context    :: { RdrNameContext }
 253 decl_context    :                                       { [] }
 254                 | OCURLY context_list1 CCURLY DARROW    { $2 }
 255
 256
 257 csigs           :: { [RdrNameSig] }
 258 csigs           :                               { [] }
 259                 | WHERE OCURLY csigs1 CCURLY    { $3 }
 260
 261 csigs1          :: { [RdrNameSig] }
 262 csigs1          : csig                          { [$1] }
 263                 | csig SEMI csigs1              { $1 : $3 }
 264
 265 csig            :: { RdrNameSig }
 266 csig            :  var_name DCOLON type         { ClassOpSig $1 $1 $3 mkIfaceSrcLoc
 267 ----------------------------------------------------------------
 268                                                  }
 269
 270 constrs         :: { [RdrNameConDecl] {- empty for handwritten abstract -} }
 271                 :                               { [] }
 272                 | EQUAL constrs1                { $2 }
 273
 274 constrs1        :: { [RdrNameConDecl] }
 275 constrs1        :  constr               { [$1] }
 276                 |  constr VBAR constrs1 { $1 : $3 }
 277
 278 constr          :: { RdrNameConDecl }
 279 constr          :  data_name batypes                    { ConDecl $1 [] (VanillaCon $2) mkIfaceSrcLoc }
 280                 |  data_name OCURLY fields1 CCURLY      { ConDecl $1 [] (RecCon $3)     mkIfaceSrcLoc }
 281
 282 newtype_constr  :: { [RdrNameConDecl] {- Empty if handwritten abstract -} }
 283 newtype_constr  :                               { [] }
 284                 | EQUAL data_name atype         { [ConDecl $2 [] (NewCon $3) mkIfaceSrcLoc] }
 285
 286 deriving        :: { Maybe [RdrName] }
 287                 :                                       { Nothing }
 288                 | DERIVING OPAREN tc_names1 CPAREN      { Just $3 }
 289
 290 batypes         :: { [RdrNameBangType] }
 291 batypes         :                                       { [] }
 292                 |  batype batypes                       { $1 : $2 }
 293
 294 batype          :: { RdrNameBangType }
 295 batype          :  atype                                { Unbanged $1 }
 296                 |  BANG atype                           { Banged   $2 }
 297
 298 fields1         :: { [([RdrName], RdrNameBangType)] }
 299 fields1         : field                                 { [$1] }
 300                 | field COMMA fields1                   { $1 : $3 }
 301
 302 field           :: { ([RdrName], RdrNameBangType) }
 303 field           :  var_names1 DCOLON type               { ($1, Unbanged $3) }
 304                 |  var_names1 DCOLON BANG type          { ($1, Banged   $4)
 305 --------------------------------------------------------------------------
 306                                                         }
 307
 308 forall          :: { [HsTyVar RdrName] }
 309 forall          : OBRACK tv_bndrs CBRACK                { $2 }
 310
 311 context         :: { RdrNameContext }
 312 context         :                                       { [] }
 313                 | OCURLY context_list1 CCURLY           { $2 }
 314
 315 context_list1   :: { RdrNameContext }
 316 context_list1   : class                                 { [$1] }
 317                 | class COMMA context_list1             { $1 : $3 }
 318
 319 class           :: { (RdrName, RdrNameHsType) }
 320 class           :  tc_name atype                        { ($1, $2) }
 321
 322 type            :: { RdrNameHsType }
 323 type            : FORALL forall context DARROW type     { mkHsForAllTy $2 $3 $5 }
 324                 |  btype RARROW type                    { MonoFunTy $1 $3 }
 325                 |  btype                                { $1 }
 326
 327 types2          :: { [RdrNameHsType]                    {- Two or more -}  }
 328 types2          :  type COMMA type                      { [$1,$3] }
 329                 |  type COMMA types2                    { $1 : $3 }
 330
 331 btype           :: { RdrNameHsType }
 332 btype           :  atype                                { $1 }
 333                 |  btype atype                          { MonoTyApp $1 $2 }
 334
 335 atype           :: { RdrNameHsType }
 336 atype           :  tc_name                              { MonoTyVar $1 }
 337                 |  tv_name                              { MonoTyVar $1 }
 338                 |  OPAREN types2 CPAREN                 { MonoTupleTy dummyRdrTcName $2 }
 339                 |  OBRACK type CBRACK                   { MonoListTy  dummyRdrTcName $2 }
 340                 |  OCURLY tc_name atype CCURLY          { MonoDictTy $2 $3 }
 341                 |  OPAREN type CPAREN                   { $2 }
 342
 343 atypes          :: { [RdrNameHsType]    {-  Zero or more -} }
 344 atypes          :                                       { [] }
 345                 |  atype atypes                         { $1 : $2
 346 ---------------------------------------------------------------------
 347                                                         }
 348
 349 mod_name        :: { Module }
 350                 :  CONID                { $1 }
 351
 352 var_occ         :: { OccName }
 353 var_occ         : VARID                 { VarOcc $1 }
 354                 | VARSYM                { VarOcc $1 }
 355                 | BANG                  { VarOcc SLIT("!") {-sigh, double-sigh-} }
 356
 357 tc_occ          :: { OccName }
 358 tc_occ          :  CONID                { TCOcc $1 }
 359                 |  CONSYM               { TCOcc $1 }
 360                 |  OPAREN RARROW CPAREN { TCOcc SLIT("->") }
 361
 362 entity_occ      :: { OccName }
 363 entity_occ      :  var_occ              { $1 }
 364                 |  tc_occ               { $1 }
 365                 |  RARROW               { TCOcc SLIT("->") {- Allow un-paren'd arrow -} }
 366
 367 val_occ         :: { OccName }
 368 val_occ         :  var_occ              { $1 }
 369                 |  CONID                { VarOcc $1 }
 370                 |  CONSYM               { VarOcc $1 }
 371
 372 val_occs1       :: { [OccName] }
 373                 :  val_occ              { [$1] }
 374                 |  val_occ val_occs1    { $1 : $2 }
 375
 376
 377 qvar_name       :: { RdrName }
 378                 :  QVARID               { varQual $1 }
 379                 |  QVARSYM              { varQual $1 }
 380
 381 var_name        :: { RdrName }
 382 var_name        :  var_occ              { Unqual $1 }
 383
 384 var_names1      :: { [RdrName] }
 385 var_names1      : var_name              { [$1] }
 386                 | var_name var_names1   { $1 : $2 }
 387
 388 any_var_name    :: {RdrName}
 389 any_var_name    :  var_name             { $1 }
 390                 |  qvar_name            { $1 }
 391
 392 qdata_name      :: { RdrName }
 393 qdata_name      :  QCONID               { varQual $1 }
 394                 |  QCONSYM              { varQual $1 }
 395
 396 data_name       :: { RdrName }
 397 data_name       :  CONID                { Unqual (VarOcc $1) }
 398                 |  CONSYM               { Unqual (VarOcc $1) }
 399
 400
 401 tc_names1       :: { [RdrName] }
 402                 : tc_name                       { [$1] }
 403                 | tc_name COMMA tc_names1       { $1 : $3 }
 404
 405 tc_name         :: { RdrName }
 406 tc_name         : tc_occ                        { Unqual $1 }
 407                 | QCONID                        { tcQual $1 }
 408
 409 tv_name         :: { RdrName }
 410 tv_name         :  VARID                { Unqual (TvOcc $1) }
 411
 412 tv_names        :: { [RdrName] }
 413                 :                       { [] }
 414                 | tv_name tv_names      { $1 : $2 }
 415
 416 tv_bndr         :: { HsTyVar RdrName }
 417 tv_bndr         :  tv_name DCOLON akind { IfaceTyVar $1 $3 }
 418                 |  tv_name              { UserTyVar $1 }
 419
 420 tv_bndrs        :: { [HsTyVar RdrName] }
 421                 :                       { [] }
 422                 | tv_bndr tv_bndrs      { $1 : $2 }
 423
 424 kind            :: { Kind }
 425                 : akind                 { $1 }
 426                 | akind RARROW kind     { mkArrowKind $1 $3 }
 427
 428 akind           :: { Kind }
 429                 : VARSYM                { mkTypeKind {- ToDo: check that it's "*" -} }
 430                 | OPAREN kind CPAREN    { $2
 431 --------------------------------------------------------------------------
 432                                         }
 433
 434
 435 instances_part  :: { [RdrNameInstDecl] }
 436 instances_part  :  INSTANCES_PART instdecls { $2 }
 437                 |                           { [] }
 438
 439 instdecls       :: { [RdrNameInstDecl] }
 440 instdecls       :                           { [] }
 441                 |  instd instdecls          { $1 : $2 }
 442
 443 instd           :: { RdrNameInstDecl }
 444 instd           :  INSTANCE type EQUAL var_name SEMI
 445                         { InstDecl $2
 446                                    EmptyMonoBinds       {- No bindings -}
 447                                    []                   {- No user pragmas -}
 448                                    (Just $4)            {- Dfun id -}
 449                                    mkIfaceSrcLoc
 450 --------------------------------------------------------------------------
 451                     }