ghc/compiler/rename/ParseIface.y

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