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,
   8                   rnContext, precParseErr, sectionPrecErr ) where
   9
  10 import CmdLineOpts      ( DynFlag(Opt_WarnMisc, Opt_WarnUnusedMatches, Opt_GlasgowExts) )
  11
  12 import HsSyn
  13 import RdrHsSyn ( RdrNameContext, RdrNameHsType, extractHsTyRdrTyVars, extractHsCtxtRdrTyVars )
  14 import RnHsSyn  ( RenamedContext, RenamedHsType, extractHsTyNames, tupleTyCon_name )
  15 import RnEnv    ( lookupOccRn, newIPName, bindTyVarsRn, lookupFixityRn )
  16 import RnMonad
  17
  18 import PrelInfo ( cCallishClassKeys )
  19 import RdrName  ( elemRdrEnv )
  20 import NameSet  ( FreeVars )
  21 import Unique   ( Uniquable(..) )
  22
  23 import BasicTypes       ( compareFixity, arrowFixity )
  24 import List             ( nub )
  25 import ListSetOps       ( removeDupsEq )
  26 import Outputable
  27
  28 #include "HsVersions.h"
  29 \end{code}
  30
  31 These type renamers are in a separate module, rather than in (say) RnSource,
  32 to break several loop.
  33
  34 %*********************************************************
  35 %*                                                      *
  36 \subsection{Renaming types}
  37 %*                                                      *
  38 %*********************************************************
  39
  40 \begin{code}
  41 rnHsTypeFVs :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
  42 rnHsTypeFVs doc_str ty
  43   = rnHsType doc_str ty         `thenRn` \ ty' ->
  44     returnRn (ty', extractHsTyNames ty')
  45
  46 rnHsSigTypeFVs :: SDoc -> RdrNameHsType -> RnMS (RenamedHsType, FreeVars)
  47 rnHsSigTypeFVs doc_str ty
  48   = rnHsSigType doc_str ty      `thenRn` \ ty' ->
  49     returnRn (ty', extractHsTyNames ty')
  50
  51 rnHsSigType :: SDoc -> RdrNameHsType -> RnMS RenamedHsType
  52         -- rnHsSigType is used for source-language type signatures,
  53         -- which use *implicit* universal quantification.
  54 rnHsSigType doc_str ty
  55   = rnHsType (text "In the type signature for" <+> doc_str) ty
  56 \end{code}
  57
  58 rnHsType is here because we call it from loadInstDecl, and I didn't
  59 want a gratuitous knot.
  60
  61 \begin{code}
  62 rnHsType :: SDoc -> RdrNameHsType -> RnMS RenamedHsType
  63
  64 rnHsType doc (HsForAllTy Nothing ctxt ty)
  65         -- Implicit quantifiction in source code (no kinds on tyvars)
  66         -- Given the signature  C => T  we universally quantify
  67         -- over FV(T) \ {in-scope-tyvars}
  68   = getLocalNameEnv             `thenRn` \ name_env ->
  69     let
  70         mentioned_in_tau  = extractHsTyRdrTyVars ty
  71         mentioned_in_ctxt = extractHsCtxtRdrTyVars ctxt
  72         mentioned         = nub (mentioned_in_tau ++ mentioned_in_ctxt)
  73
  74         -- Don't quantify over type variables that are in scope;
  75         -- when GlasgowExts is off, there usually won't be any, except for
  76         -- class signatures:
  77         --      class C a where { op :: a -> a }
  78         forall_tyvars = filter (not . (`elemRdrEnv` name_env)) mentioned
  79     in
  80     rnForAll doc (map UserTyVar forall_tyvars) ctxt ty
  81
  82 rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt tau)
  83         -- Explicit quantification.
  84         -- Check that the forall'd tyvars are actually
  85         -- mentioned in the type, and produce a warning if not
  86   = let
  87         mentioned_in_tau                = extractHsTyRdrTyVars tau
  88         mentioned_in_ctxt               = extractHsCtxtRdrTyVars ctxt
  89         mentioned                       = nub (mentioned_in_tau ++ mentioned_in_ctxt)
  90         forall_tyvar_names              = hsTyVarNames forall_tyvars
  91
  92         -- Explicitly quantified but not mentioned in ctxt or tau
  93         warn_guys                       = filter (`notElem` mentioned) forall_tyvar_names
  94     in
  95     mapRn_ (forAllWarn doc tau) warn_guys       `thenRn_`
  96     rnForAll doc forall_tyvars ctxt tau
  97
  98 rnHsType doc (HsTyVar tyvar)
  99   = lookupOccRn tyvar           `thenRn` \ tyvar' ->
 100     returnRn (HsTyVar tyvar')
 101
 102 rnHsType doc (HsOpTy ty1 op ty2)
 103   = (case op of
 104         HsArrow  -> returnRn HsArrow
 105         HsTyOp n -> lookupOccRn n    `thenRn` \ n' ->
 106                     returnRn (HsTyOp n')
 107     )                           `thenRn` \ op' ->
 108     rnHsType doc ty1            `thenRn` \ ty1' ->
 109     rnHsType doc ty2            `thenRn` \ ty2' ->
 110     lookupTyFixityRn op'        `thenRn` \ fix ->
 111     mkHsOpTyRn op' fix ty1' ty2'
 112
 113 rnHsType doc (HsParTy ty)
 114   = rnHsType doc ty             `thenRn` \ ty' ->
 115     returnRn (HsParTy ty')
 116
 117 rnHsType doc (HsNumTy i)
 118   | i == 1    = returnRn (HsNumTy i)
 119   | otherwise = failWithRn (HsNumTy i)
 120                            (ptext SLIT("Only unit numeric type pattern is valid"))
 121
 122 rnHsType doc (HsFunTy ty1 ty2)
 123   = rnHsType doc ty1    `thenRn` \ ty1' ->
 124         -- Might find a for-all as the arg of a function type
 125     rnHsType doc ty2    `thenRn` \ ty2' ->
 126         -- Or as the result.  This happens when reading Prelude.hi
 127         -- when we find return :: forall m. Monad m -> forall a. a -> m a
 128     returnRn (HsFunTy ty1' ty2')
 129
 130 rnHsType doc (HsListTy ty)
 131   = rnHsType doc ty                             `thenRn` \ ty' ->
 132     returnRn (HsListTy ty')
 133
 134 rnHsType doc (HsKindSig ty k)
 135   = rnHsType doc ty                             `thenRn` \ ty' ->
 136     returnRn (HsKindSig ty' k)
 137
 138 rnHsType doc (HsPArrTy ty)
 139   = rnHsType doc ty                             `thenRn` \ ty' ->
 140     returnRn (HsPArrTy ty')
 141
 142 -- Unboxed tuples are allowed to have poly-typed arguments.  These
 143 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
 144 rnHsType doc (HsTupleTy (HsTupCon _ boxity arity) tys)
 145         -- Don't do lookupOccRn, because this is built-in syntax
 146         -- so it doesn't need to be in scope
 147   = mapRn (rnHsType doc) tys            `thenRn` \ tys' ->
 148     returnRn (HsTupleTy (HsTupCon tup_name boxity arity) tys')
 149   where
 150     tup_name = tupleTyCon_name boxity arity
 151
 152
 153 rnHsType doc (HsAppTy ty1 ty2)
 154   = rnHsType doc ty1            `thenRn` \ ty1' ->
 155     rnHsType doc ty2            `thenRn` \ ty2' ->
 156     returnRn (HsAppTy ty1' ty2')
 157
 158 rnHsType doc (HsPredTy pred)
 159   = rnPred doc pred     `thenRn` \ pred' ->
 160     returnRn (HsPredTy pred')
 161
 162 rnHsTypes doc tys = mapRn (rnHsType doc) tys
 163 \end{code}
 164
 165
 166 \begin{code}
 167 rnForAll doc forall_tyvars ctxt ty
 168   = bindTyVarsRn doc forall_tyvars      $ \ new_tyvars ->
 169     rnContext doc ctxt                  `thenRn` \ new_ctxt ->
 170     rnHsType doc ty                     `thenRn` \ new_ty ->
 171     returnRn (mkHsForAllTy (Just new_tyvars) new_ctxt new_ty)
 172 \end{code}
 173
 174
 175 %*********************************************************
 176 %*                                                      *
 177 \subsection{Fixities}
 178 %*                                                      *
 179 %*********************************************************
 180
 181 Infix types are read in a *right-associative* way, so that
 182         a `op` b `op` c
 183 is always read in as
 184         a `op` (b `op` c)
 185
 186 mkHsOpTyRn rearranges where necessary.  The two arguments
 187 have already been renamed and rearranged.  It's made rather tiresome
 188 by the presence of ->
 189
 190 \begin{code}
 191 lookupTyFixityRn HsArrow    = returnRn arrowFixity
 192 lookupTyFixityRn (HsTyOp n)
 193   = doptRn Opt_GlasgowExts                      `thenRn` \ glaExts ->
 194     warnCheckRn glaExts (infixTyConWarn n)      `thenRn_`
 195     lookupFixityRn n
 196
 197 -- Building (ty1 `op1` (ty21 `op2` ty22))
 198 mkHsOpTyRn :: HsTyOp Name -> Fixity
 199            -> RenamedHsType -> RenamedHsType
 200            -> RnMS RenamedHsType
 201
 202 mkHsOpTyRn op1 fix1 ty1 ty2@(HsOpTy ty21 op2 ty22)
 203   = lookupTyFixityRn op2                `thenRn` \ fix2 ->
 204     let
 205         (nofix_error, associate_right) = compareFixity fix1 fix2
 206     in
 207     if nofix_error then
 208         addErrRn (precParseErr (quotes (ppr op1),fix1)
 209                                (quotes (ppr op2),fix2)) `thenRn_`
 210         returnRn (HsOpTy ty1 op1 ty2)
 211     else
 212     if not associate_right then
 213         -- Rearrange to ((ty1 `op1` ty21) `op2` ty22)
 214         mkHsOpTyRn op1 fix1 ty1 ty21            `thenRn` \ new_ty ->
 215         returnRn (HsOpTy new_ty op2 ty22)
 216     else
 217     returnRn (HsOpTy ty1 op1 ty2)
 218
 219 mkHsOpTyRn op fix ty1 ty2                       -- Default case, no rearrangment
 220   = returnRn (HsOpTy ty1 op ty2)
 221
 222 mkHsFunTyRn ty1 ty2                     -- Precedence of function arrow is 0
 223   = returnRn (HsFunTy ty1 ty2)          -- so no rearrangement reqd.  Change
 224                                         -- this if fixity of -> increases.
 225
 226 not_op_ty (HsOpTy _ _ _) = False
 227 not_op_ty other          = True
 228 \end{code}
 229
 230 %*********************************************************
 231 %*                                                      *
 232 \subsection{Contexts and predicates}
 233 %*                                                      *
 234 %*********************************************************
 235
 236 \begin{code}
 237 rnContext :: SDoc -> RdrNameContext -> RnMS RenamedContext
 238 rnContext doc ctxt
 239   = mapRn rn_pred ctxt          `thenRn` \ theta ->
 240
 241         -- Check for duplicate assertions
 242         -- If this isn't an error, then it ought to be:
 243     ifOptRn Opt_WarnMisc (
 244         let
 245             (_, dups) = removeDupsEq theta
 246                 -- We only have equality, not ordering
 247         in
 248         mapRn (addWarnRn . dupClassAssertWarn theta) dups
 249     )                           `thenRn_`
 250
 251     returnRn theta
 252   where
 253         --Someone discovered that @CCallable@ and @CReturnable@
 254         -- could be used in contexts such as:
 255         --      foo :: CCallable a => a -> PrimIO Int
 256         -- Doing this utterly wrecks the whole point of introducing these
 257         -- classes so we specifically check that this isn't being done.
 258     rn_pred pred = rnPred doc pred                              `thenRn` \ pred'->
 259                    checkRn (not (bad_pred pred'))
 260                            (naughtyCCallContextErr pred')       `thenRn_`
 261                    returnRn pred'
 262
 263     bad_pred (HsClassP clas _) = getUnique clas `elem` cCallishClassKeys
 264     bad_pred other             = False
 265
 266
 267 rnPred doc (HsClassP clas tys)
 268   = lookupOccRn clas            `thenRn` \ clas_name ->
 269     rnHsTypes doc tys           `thenRn` \ tys' ->
 270     returnRn (HsClassP clas_name tys')
 271
 272 rnPred doc (HsIParam n ty)
 273   = newIPName n                 `thenRn` \ name ->
 274     rnHsType doc ty             `thenRn` \ ty' ->
 275     returnRn (HsIParam name ty')
 276 \end{code}
 277
 278
 279 %*********************************************************
 280 %*                                                      *
 281 \subsection{Errors}
 282 %*                                                      *
 283 %*********************************************************
 284
 285 \end{code}
 286 \begin{code}
 287 forAllWarn doc ty tyvar
 288   = ifOptRn Opt_WarnUnusedMatches       $
 289     getModeRn                           `thenRn` \ mode ->
 290     case mode of {
 291 #ifndef DEBUG
 292              InterfaceMode -> returnRn () ; -- Don't warn of unused tyvars in interface files
 293                                             -- unless DEBUG is on, in which case it is slightly
 294                                             -- informative.  They can arise from mkRhsTyLam,
 295 #endif                                      -- leading to (say)         f :: forall a b. [b] -> [b]
 296              other ->
 297                 addWarnRn (
 298                    sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
 299                    nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
 300                    $$
 301                    doc
 302                 )
 303           }
 304
 305 dupClassAssertWarn ctxt (assertion : dups)
 306   = sep [hsep [ptext SLIT("Duplicate class assertion"),
 307                quotes (ppr assertion),
 308                ptext SLIT("in the context:")],
 309          nest 4 (pprHsContext ctxt <+> ptext SLIT("..."))]
 310
 311 naughtyCCallContextErr (HsClassP clas _)
 312   = sep [ptext SLIT("Can't use class") <+> quotes (ppr clas),
 313          ptext SLIT("in a context")]
 314
 315 precParseErr op1 op2
 316   = hang (ptext SLIT("precedence parsing error"))
 317       4 (hsep [ptext SLIT("cannot mix"), ppr_opfix op1, ptext SLIT("and"),
 318                ppr_opfix op2,
 319                ptext SLIT("in the same infix expression")])
 320
 321 sectionPrecErr op arg_op section
 322  = vcat [ptext SLIT("The operator") <+> ppr_opfix op <+> ptext SLIT("of a section"),
 323          nest 4 (ptext SLIT("must have lower precedence than the operand") <+> ppr_opfix arg_op),
 324          nest 4 (ptext SLIT("in the section:") <+> quotes (ppr section))]
 325
 326 infixTyConWarn op
 327   = ftext FSLIT("Accepting non-standard infix type constructor") <+> quotes (ppr op)
 328
 329 ppr_opfix (pp_op, fixity) = pp_op <+> brackets (ppr fixity)
 330 \end{code}