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           ( Doc )
  29 import PprStyle         -- PprDebug for panic
  30 import Maybes           ( MaybeErr(..) )
  31
  32 ------------------------------------------------------------------
  33
  34 parseType :: [IfaceToken] -> MaybeErr RdrNameHsType (PprStyle -> Doc)
  35 parseType ls =
  36   let
  37    res =
  38     case parseT ls 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
  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                 |  btype RARROW type                    { MonoFunTy $1 $3 }
  75                 |  btype                                { $1 }
  76
  77 forall          : OBRACK tv_bndrs CBRACK                { $2 }
  78
  79 context         :: { RdrNameContext }
  80 context         :                                       { [] }
  81                 | OCURLY context_list1 CCURLY           { $2 }
  82
  83 context_list1   :: { RdrNameContext }
  84 context_list1   : class                                 { [$1] }
  85                 | class COMMA context_list1             { $1 : $3 }
  86
  87 class           :: { (RdrName, RdrNameHsType) }
  88 class           :  tc_name atype                        { ($1, $2) }
  89
  90
  91 types2          :: { [RdrNameHsType]                    {- Two or more -}  }
  92 types2          :  type COMMA type                      { [$1,$3] }
  93                 |  type COMMA types2                    { $1 : $3 }
  94
  95 btype           :: { RdrNameHsType }
  96 btype           :  atype                                { $1 }
  97                 |  btype atype                          { MonoTyApp $1 $2 }
  98
  99 atype           :: { RdrNameHsType }
 100 atype           :  tc_name                              { MonoTyVar $1 }
 101                 |  tv_name                              { MonoTyVar $1 }
 102                 |  OPAREN types2 CPAREN                 { MonoTupleTy dummyRdrTcName $2 }
 103                 |  OBRACK type CBRACK                   { MonoListTy  dummyRdrTcName $2 }
 104                 |  OCURLY tc_name atype CCURLY          { MonoDictTy $2 $3 }
 105                 |  OPAREN type CPAREN                   { $2 }
 106
 107 atypes          :: { [RdrNameHsType]    {-  Zero or more -} }
 108 atypes          :                                       { [] }
 109                 |  atype atypes                         { $1 : $2
 110 ---------------------------------------------------------------------
 111                                                         }
 112
 113 tv_bndr         :: { HsTyVar RdrName }
 114 tv_bndr         :  tv_name DCOLON akind { IfaceTyVar $1 $3 }
 115                 |  tv_name              { UserTyVar $1 }
 116
 117 tv_bndrs        :: { [HsTyVar RdrName] }
 118                 :                       { [] }
 119                 | tv_bndr tv_bndrs      { $1 : $2 }
 120
 121 kind            :: { Kind }
 122                 : akind                 { $1 }
 123                 | akind RARROW kind     { mkArrowKind $1 $3 }
 124
 125 akind           :: { Kind }
 126                 : VARSYM                { mkTypeKind {- ToDo: check that it's "*" -} }
 127                 | OPAREN kind CPAREN    { $2 }
 128
 129 tv_name         :: { RdrName }
 130 tv_name         :  VARID                { Unqual (TvOcc $1) }
 131
 132 tv_names        :: { [RdrName] }
 133                 :                       { [] }
 134                 | tv_name tv_names      { $1 : $2 }
 135
 136 tc_name         :: { RdrName }
 137 tc_name         :  QCONID               { tcQual $1 }
 138                 |  CONID                { Unqual (TCOcc $1) }
 139                 |  CONSYM               { Unqual (TCOcc $1) }
 140                 |  OPAREN RARROW CPAREN { Unqual (TCOcc SLIT("->")) }
 141