ghc/compiler/rename/RnTypes.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[RnSource]{Main pass of renamer}
   5
   6 \begin{code}
   7 module RnTypes (  rnHsType, rnHsSigType, rnHsTypeFVs, rnHsSigTypeFVs, rnContext ) where
   8
   9 import CmdLineOpts      ( DynFlag(Opt_WarnMisc, Opt_WarnUnusedMatches) )
  10
  11 import HsSyn
  12 import RdrHsSyn ( RdrNameContext, RdrNameHsType, extractHsTyRdrTyVars, extractHsCtxtRdrTyVars )
  13 import RnHsSyn  ( RenamedContext, RenamedHsType, extractHsTyNames, tupleTyCon_name )
  14 import RnEnv    ( lookupOccRn, newIPName, bindTyVarsRn )
  15 import RnMonad
  16
  17 import PrelInfo ( cCallishClassKeys )
  18 import RdrName  ( elemRdrEnv )
  19 import NameSet  ( FreeVars )
  20 import Unique   ( Uniquable(..) )
  21
  22 import List             ( nub )
  23 import ListSetOps       ( removeDupsEq )
  24 import Outputable
  25
  26 #include "HsVersions.h"
  27 \end{code}
  28
  29 These type renamers are in a separate module, rather than in (say) RnSource,
  30 to break several loop.
  31
  32 %*********************************************************
  33 %*                                                      *
  34 \subsection{Renaming types}
  35 %*                                                      *
  36 %*********************************************************
  37
  38 \begin{code}
  39 rnHsTypeFVs :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
  40 rnHsTypeFVs doc_str ty
  41   = rnHsType doc_str ty         `thenRn` \ ty' ->
  42     returnRn (ty', extractHsTyNames ty')
  43
  44 rnHsSigTypeFVs :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
  45 rnHsSigTypeFVs doc_str ty
  46   = rnHsSigType doc_str ty      `thenRn` \ ty' ->
  47     returnRn (ty', extractHsTyNames ty')
  48
  49 rnHsSigType :: SDoc -> RdrNameHsType -> RnMS RenamedHsType
  50         -- rnHsSigType is used for source-language type signatures,
  51         -- which use *implicit* universal quantification.
  52 rnHsSigType doc_str ty
  53   = rnHsType (text "In the type signature for" <+> doc_str) ty
  54 \end{code}
  55
  56 rnHsType is here because we call it from loadInstDecl, and I didn't
  57 want a gratuitous knot.
  58
  59 \begin{code}
  60 rnHsType :: SDoc -> RdrNameHsType -> RnMS RenamedHsType
  61
  62 rnHsType doc (HsForAllTy Nothing ctxt ty)
  63         -- Implicit quantifiction in source code (no kinds on tyvars)
  64         -- Given the signature  C => T  we universally quantify
  65         -- over FV(T) \ {in-scope-tyvars}
  66   = getLocalNameEnv             `thenRn` \ name_env ->
  67     let
  68         mentioned_in_tau  = extractHsTyRdrTyVars ty
  69         mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
  70         mentioned         = nub (mentioned_in_tau ++ mentioned_in_ctxt)
  71
  72         -- Don't quantify over type variables that are in scope;
  73         -- when GlasgowExts is off, there usually won't be any, except for
  74         -- class signatures:
  75         --      class C a where { op :: a -> a }
  76         forall_tyvars = filter (not . (`elemRdrEnv` name_env)) mentioned
  77     in
  78     rnForAll doc (map UserTyVar forall_tyvars) ctxt ty
  79
  80 rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt tau)
  81         -- Explicit quantification.
  82         -- Check that the forall'd tyvars are actually
  83         -- mentioned in the type, and produce a warning if not
  84   = let
  85         mentioned_in_tau                = extractHsTyRdrTyVars tau
  86         mentioned_in_ctxt               = extractHsCtxtRdrTyVars ctxt
  87         mentioned                       = nub (mentioned_in_tau ++ mentioned_in_ctxt)
  88         forall_tyvar_names              = hsTyVarNames forall_tyvars
  89
  90         -- Explicitly quantified but not mentioned in ctxt or tau
  91         warn_guys                       = filter (`notElem` mentioned) forall_tyvar_names
  92     in
  93     mapRn_ (forAllWarn doc tau) warn_guys       `thenRn_`
  94     rnForAll doc forall_tyvars ctxt tau
  95
  96 rnHsType doc (HsTyVar tyvar)
  97   = lookupOccRn tyvar           `thenRn` \ tyvar' ->
  98     returnRn (HsTyVar tyvar')
  99
 100 rnHsType doc (HsOpTy ty1 opname ty2)
 101   = lookupOccRn opname  `thenRn` \ name' ->
 102     rnHsType doc ty1    `thenRn` \ ty1' ->
 103     rnHsType doc ty2    `thenRn` \ ty2' ->
 104     returnRn (HsOpTy ty1' name' ty2')
 105
 106 rnHsType doc (HsNumTy i)
 107   | i == 1    = returnRn (HsNumTy i)
 108   | otherwise = failWithRn (HsNumTy i)
 109                            (ptext SLIT("Only unit numeric type pattern is valid"))
 110
 111 rnHsType doc (HsFunTy ty1 ty2)
 112   = rnHsType doc ty1    `thenRn` \ ty1' ->
 113         -- Might find a for-all as the arg of a function type
 114     rnHsType doc ty2    `thenRn` \ ty2' ->
 115         -- Or as the result.  This happens when reading Prelude.hi
 116         -- when we find return :: forall m. Monad m -> forall a. a -> m a
 117     returnRn (HsFunTy ty1' ty2')
 118
 119 rnHsType doc (HsListTy ty)
 120   = rnHsType doc ty                             `thenRn` \ ty' ->
 121     returnRn (HsListTy ty')
 122
 123 rnHsType doc (HsKindSig ty k)
 124   = rnHsType doc ty                             `thenRn` \ ty' ->
 125     returnRn (HsKindSig ty' k)
 126
 127 rnHsType doc (HsPArrTy ty)
 128   = rnHsType doc ty                             `thenRn` \ ty' ->
 129     returnRn (HsPArrTy ty')
 130
 131 -- Unboxed tuples are allowed to have poly-typed arguments.  These
 132 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
 133 rnHsType doc (HsTupleTy (HsTupCon _ boxity arity) tys)
 134         -- Don't do lookupOccRn, because this is built-in syntax
 135         -- so it doesn't need to be in scope
 136   = mapRn (rnHsType doc) tys            `thenRn` \ tys' ->
 137     returnRn (HsTupleTy (HsTupCon tup_name boxity arity) tys')
 138   where
 139     tup_name = tupleTyCon_name boxity arity
 140
 141
 142 rnHsType doc (HsAppTy ty1 ty2)
 143   = rnHsType doc ty1            `thenRn` \ ty1' ->
 144     rnHsType doc ty2            `thenRn` \ ty2' ->
 145     returnRn (HsAppTy ty1' ty2')
 146
 147 rnHsType doc (HsPredTy pred)
 148   = rnPred doc pred     `thenRn` \ pred' ->
 149     returnRn (HsPredTy pred')
 150
 151 rnHsTypes doc tys = mapRn (rnHsType doc) tys
 152 \end{code}
 153
 154 \begin{code}
 155 rnForAll doc forall_tyvars ctxt ty
 156   = bindTyVarsRn doc forall_tyvars      $ \ new_tyvars ->
 157     rnContext doc ctxt                  `thenRn` \ new_ctxt ->
 158     rnHsType doc ty                     `thenRn` \ new_ty ->
 159     returnRn (mkHsForAllTy (Just new_tyvars) new_ctxt new_ty)
 160 \end{code}
 161
 162 \begin{code}
 163 rnContext :: SDoc -> RdrNameContext -> RnMS RenamedContext
 164 rnContext doc ctxt
 165   = mapRn rn_pred ctxt          `thenRn` \ theta ->
 166
 167         -- Check for duplicate assertions
 168         -- If this isn't an error, then it ought to be:
 169     ifOptRn Opt_WarnMisc (
 170         let
 171             (_, dups) = removeDupsEq theta
 172                 -- We only have equality, not ordering
 173         in
 174         mapRn (addWarnRn . dupClassAssertWarn theta) dups
 175     )                           `thenRn_`
 176
 177     returnRn theta
 178   where
 179         --Someone discovered that @CCallable@ and @CReturnable@
 180         -- could be used in contexts such as:
 181         --      foo :: CCallable a => a -> PrimIO Int
 182         -- Doing this utterly wrecks the whole point of introducing these
 183         -- classes so we specifically check that this isn't being done.
 184     rn_pred pred = rnPred doc pred                              `thenRn` \ pred'->
 185                    checkRn (not (bad_pred pred'))
 186                            (naughtyCCallContextErr pred')       `thenRn_`
 187                    returnRn pred'
 188
 189     bad_pred (HsClassP clas _) = getUnique clas `elem` cCallishClassKeys
 190     bad_pred other             = False
 191
 192
 193 rnPred doc (HsClassP clas tys)
 194   = lookupOccRn clas            `thenRn` \ clas_name ->
 195     rnHsTypes doc tys           `thenRn` \ tys' ->
 196     returnRn (HsClassP clas_name tys')
 197
 198 rnPred doc (HsIParam n ty)
 199   = newIPName n                 `thenRn` \ name ->
 200     rnHsType doc ty             `thenRn` \ ty' ->
 201     returnRn (HsIParam name ty')
 202 \end{code}
 203
 204 \end{code}
 205 \begin{code}
 206 forAllWarn doc ty tyvar
 207   = ifOptRn Opt_WarnUnusedMatches       $
 208     getModeRn                           `thenRn` \ mode ->
 209     case mode of {
 210 #ifndef DEBUG
 211              InterfaceMode -> returnRn () ; -- Don't warn of unused tyvars in interface files
 212                                             -- unless DEBUG is on, in which case it is slightly
 213                                             -- informative.  They can arise from mkRhsTyLam,
 214 #endif                                      -- leading to (say)         f :: forall a b. [b] -> [b]
 215              other ->
 216                 addWarnRn (
 217                    sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
 218                    nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
 219                    $$
 220                    doc
 221                 )
 222           }
 223
 224 dupClassAssertWarn ctxt (assertion : dups)
 225   = sep [hsep [ptext SLIT("Duplicate class assertion"),
 226                quotes (ppr assertion),
 227                ptext SLIT("in the context:")],
 228          nest 4 (pprHsContext ctxt <+> ptext SLIT("..."))]
 229
 230 naughtyCCallContextErr (HsClassP clas _)
 231   = sep [ptext SLIT("Can't use class") <+> quotes (ppr clas),
 232          ptext SLIT("in a context")]
 233 \end{code}