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(..) )
  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, mkTypeKind )
  18 import Lex
  19
  20 import RnMonad          ( SYN_IE(ImportVersion), SYN_IE(LocalVersion), ParsedIface(..),
  21                           SYN_IE(RdrNamePragma), SYN_IE(ExportItem)
  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           ( ppShow )
  29 import PprStyle         -- PprDebug for panic
  30 import Maybes           ( MaybeErr(..) )
  31
  32 ------------------------------------------------------------------
  33
  34 parseType :: [IfaceToken] -> MaybeErr RdrNameHsType (PprStyle -> Int -> Bool -> PrettyRep)
  35 parseType ls =
  36   let
  37    res =
  38     case parseT ls of
  39       v@(Succeeded _) -> v
  40       Failed err      -> panic (ppShow 80 (err PprDebug))
  41   in
  42   res
  43
  44 }
  45
  46 %name parseT
  47 %tokentype { IfaceToken }
  48 %monad      { IfM }{ thenIf }{ returnIf }
  49
  50 %token
  51         FORALL              { ITforall }
  52         DCOLON              { ITdcolon }
  53         COMMA               { ITcomma }
  54         DARROW              { ITdarrow }
  55         OCURLY              { ITocurly }
  56         OBRACK              { ITobrack }
  57         OPAREN              { IToparen }
  58         RARROW              { ITrarrow }
  59         CCURLY              { ITccurly }
  60         CBRACK              { ITcbrack }
  61         CPAREN              { ITcparen }
  62
  63         VARID               { ITvarid    $$ }
  64         CONID               { ITconid    $$ }
  65         VARSYM              { ITvarsym   $$ }
  66         CONSYM              { ITconsym   $$ }
  67         QCONID              { ITqconid   $$ }
  68
  69         UNKNOWN             { ITunknown $$ }
  70 %%
  71
  72 type            :: { RdrNameHsType }
  73 type            : FORALL forall context DARROW type     { mkHsForAllTy $2 $3 $5 }
  74                 | tautype                               { $1 }
  75
  76 forall          : OBRACK tv_bndrs CBRACK                { $2 }
  77
  78 context         :: { RdrNameContext }
  79 context         :                                       { [] }
  80                 | OCURLY context_list1 CCURLY           { $2 }
  81
  82 context_list1   :: { RdrNameContext }
  83 context_list1   : class                                 { [$1] }
  84                 | class COMMA context_list1             { $1 : $3 }
  85
  86 class           :: { (RdrName, RdrNameHsType) }
  87 class           :  qtc_name atype                       { ($1, $2) }
  88
  89
  90 tautype         :: { RdrNameHsType }
  91 tautype         :  btype                                { $1 }
  92                 |  btype RARROW tautype                 { MonoFunTy $1 $3 }
  93
  94 types2          :: { [RdrNameHsType]                    {- Two or more -}  }
  95 types2          :  type COMMA type                      { [$1,$3] }
  96                 |  type COMMA types2                    { $1 : $3 }
  97
  98 btype           :: { RdrNameHsType }
  99 btype           :  atype                                { $1 }
 100                 |  btype atype                          { MonoTyApp $1 $2 }
 101
 102 atype           :: { RdrNameHsType }
 103 atype           :  qtc_name                             { MonoTyVar $1 }
 104                 |  tv_name                              { MonoTyVar $1 }
 105                 |  OPAREN types2 CPAREN                 { MonoTupleTy dummyRdrTcName $2 }
 106                 |  OBRACK type CBRACK                   { MonoListTy  dummyRdrTcName $2 }
 107                 |  OCURLY qtc_name atype CCURLY         { MonoDictTy $2 $3 }
 108                 |  OPAREN type CPAREN                   { $2 }
 109
 110 atypes          :: { [RdrNameHsType]    {-  Zero or more -} }
 111 atypes          :                                       { [] }
 112                 |  atype atypes                         { $1 : $2
 113 ---------------------------------------------------------------------
 114                                                         }
 115
 116 tv_bndr         :: { HsTyVar RdrName }
 117 tv_bndr         :  tv_name DCOLON akind { IfaceTyVar $1 $3 }
 118                 |  tv_name              { UserTyVar $1 }
 119
 120 tv_bndrs        :: { [HsTyVar RdrName] }
 121                 :                       { [] }
 122                 | tv_bndr tv_bndrs      { $1 : $2 }
 123
 124 kind            :: { Kind }
 125                 : akind                 { $1 }
 126                 | akind RARROW kind     { mkArrowKind $1 $3 }
 127
 128 akind           :: { Kind }
 129                 : VARSYM                { mkTypeKind {- ToDo: check that it's "*" -} }
 130                 | OPAREN kind CPAREN    { $2 }
 131
 132 tv_name         :: { RdrName }
 133 tv_name         :  VARID                { Unqual (TvOcc $1) }
 134
 135 tv_names        :: { [RdrName] }
 136                 :                       { [] }
 137                 | tv_name tv_names      { $1 : $2 }
 138 qtc_name        :: { RdrName }
 139 qtc_name        :  QCONID               { tcQual $1 }
 140