ghc/compiler/rename/ParseType.y

   1 {
   2 #include "HsVersions.h"
   3 module ParseType ( parseType ) 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 HsPragmas        ( noGenPragmas, noDataPragmas, noClassPragmas, noClassOpPragmas, noInstancePragmas )
  14 import IdInfo           ( exactArity, mkStrictnessInfo, mkBottomStrictnessInfo,
  15                           ArgUsageInfo, FBTypeInfo
  16                         )
  17 import Kind             ( Kind, mkArrowKind, mkBoxedTypeKind )
  18 import Lex
  19
  20 import RnMonad          ( SYN_IE(ImportVersion), SYN_IE(LocalVersion), ParsedIface(..),
  21                           SYN_IE(RdrNamePragma), SYN_IE(ExportItem), GenAvailInfo
  22                         )
  23 import Bag              ( emptyBag, unitBag, snocBag )
  24 import FiniteMap        ( emptyFM, unitFM, addToFM, plusFM, bagToFM, FiniteMap )
  25 import Name             ( OccName(..), isTCOcc, Provenance )
  26 import SrcLoc           ( mkIfaceSrcLoc )
  27 import Util             ( panic{-, pprPanic ToDo:rm-} )
  28 import Pretty           ( Doc )
  29 import Outputable       ( PprStyle(..) )
  30 import Maybes           ( MaybeErr(..) )
  31
  32 ------------------------------------------------------------------
  33
  34 parseType :: StringBuffer -> MaybeErr RdrNameHsType (PprStyle -> Doc)
  35 parseType ls =
  36   let
  37    res =
  38     case parseT ls 1 of
  39       v@(Succeeded _) -> v
  40       Failed err      -> panic (show (err PprDebug))
  41   in
  42   res
  43
  44 }
  45
  46 %name parseT
  47 %tokentype { IfaceToken }
  48 %monad     { IfM }{ thenIf }{ returnIf }
  49 %lexer     { lexIface } { ITeof }
  50
  51 %token
  52         FORALL              { ITforall }
  53         DCOLON              { ITdcolon }
  54         COMMA               { ITcomma }
  55         DARROW              { ITdarrow }
  56         OCURLY              { ITocurly }
  57         OBRACK              { ITobrack }
  58         OPAREN              { IToparen }
  59         RARROW              { ITrarrow }
  60         CCURLY              { ITccurly }
  61         CBRACK              { ITcbrack }
  62         CPAREN              { ITcparen }
  63
  64         VARID               { ITvarid    $$ }
  65         CONID               { ITconid    $$ }
  66         VARSYM              { ITvarsym   $$ }
  67         CONSYM              { ITconsym   $$ }
  68         QCONID              { ITqconid   $$ }
  69
  70         UNKNOWN             { ITunknown $$ }
  71 %%
  72
  73 type            :: { RdrNameHsType }
  74 type            : FORALL forall context DARROW type     { mkHsForAllTy $2 $3 $5 }
  75                 |  btype RARROW type                    { MonoFunTy $1 $3 }
  76                 |  btype                                { $1 }
  77
  78 forall          : OBRACK tv_bndrs CBRACK                { $2 }
  79
  80 context         :: { RdrNameContext }
  81 context         :                                       { [] }
  82                 | OCURLY context_list1 CCURLY           { $2 }
  83
  84 context_list1   :: { RdrNameContext }
  85 context_list1   : class                                 { [$1] }
  86                 | class COMMA context_list1             { $1 : $3 }
  87
  88 class           :: { (RdrName, RdrNameHsType) }
  89 class           :  tc_name atype                        { ($1, $2) }
  90
  91
  92 types2          :: { [RdrNameHsType]                    {- Two or more -}  }
  93 types2          :  type COMMA type                      { [$1,$3] }
  94                 |  type COMMA types2                    { $1 : $3 }
  95
  96 btype           :: { RdrNameHsType }
  97 btype           :  atype                                { $1 }
  98                 |  btype atype                          { MonoTyApp $1 $2 }
  99
 100 atype           :: { RdrNameHsType }
 101 atype           :  tc_name                              { MonoTyVar $1 }
 102                 |  tv_name                              { MonoTyVar $1 }
 103                 |  OPAREN types2 CPAREN                 { MonoTupleTy dummyRdrTcName $2 }
 104                 |  OBRACK type CBRACK                   { MonoListTy  dummyRdrTcName $2 }
 105                 |  OCURLY tc_name atype CCURLY          { MonoDictTy $2 $3 }
 106                 |  OPAREN type CPAREN                   { $2 }
 107
 108 atypes          :: { [RdrNameHsType]    {-  Zero or more -} }
 109 atypes          :                                       { [] }
 110                 |  atype atypes                         { $1 : $2
 111 ---------------------------------------------------------------------
 112                                                         }
 113
 114 tv_bndr         :: { HsTyVar RdrName }
 115 tv_bndr         :  tv_name DCOLON akind { IfaceTyVar $1 $3 }
 116                 |  tv_name              { UserTyVar $1 }
 117
 118 tv_bndrs        :: { [HsTyVar RdrName] }
 119                 :                       { [] }
 120                 | tv_bndr tv_bndrs      { $1 : $2 }
 121
 122 kind            :: { Kind }
 123                 : akind                 { $1 }
 124                 | akind RARROW kind     { mkArrowKind $1 $3 }
 125
 126 akind           :: { Kind }
 127                 : VARSYM                { mkBoxedTypeKind {- ToDo: check that it's "*" -} }
 128                 | OPAREN kind CPAREN    { $2 }
 129
 130 tv_name         :: { RdrName }
 131 tv_name         :  VARID                { Unqual (TvOcc $1) }
 132                 |  VARSYM               { Unqual (TvOcc $1) {- Allow t2 as a tyvar -} }
 133
 134 tv_names        :: { [RdrName] }
 135                 :                       { [] }
 136                 | tv_name tv_names      { $1 : $2 }
 137
 138 tc_name         :: { RdrName }
 139 tc_name         :  QCONID               { lexTcQual $1 }
 140                 |  CONID                { Unqual (TCOcc $1) }
 141                 |  CONSYM               { Unqual (TCOcc $1) }
 142                 |  OPAREN RARROW CPAREN { Unqual (TCOcc SLIT("->")) }
 143