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 {-# OPTIONS -w #-}
   8 -- The above warning supression flag is a temporary kludge.
   9 -- While working on this module you are encouraged to remove it and fix
  10 -- any warnings in the module. See
  11 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
  12 -- for details
  13
  14 module RnTypes (
  15         -- Type related stuff
  16         rnHsType, rnLHsType, rnLHsTypes, rnContext,
  17         rnHsSigType, rnHsTypeFVs,
  18
  19         -- Precence related stuff
  20         mkOpAppRn, mkNegAppRn, mkOpFormRn, mkConOpPatRn,
  21         checkPrecMatch, checkSectionPrec
  22   ) where
  23
  24 import DynFlags
  25 import HsSyn
  26 import RdrHsSyn         ( extractHsRhoRdrTyVars )
  27 import RnHsSyn          ( extractHsTyNames, parrTyCon_name, tupleTyCon_name,
  28                           listTyCon_name
  29                         )
  30 import RnHsDoc          ( rnLHsDoc )
  31 import RnEnv
  32 import TcRnMonad
  33 import ErrUtils
  34 import RdrName
  35 import PrelNames
  36 import TypeRep          ( funTyCon )
  37 import Constants        ( mAX_TUPLE_SIZE )
  38 import Name
  39 import SrcLoc
  40 import NameSet
  41
  42 import Literal          ( inIntRange, inCharRange )
  43 import BasicTypes       ( compareFixity, funTyFixity, negateFixity,
  44                           Fixity(..), FixityDirection(..) )
  45 import ListSetOps       ( removeDups, minusList )
  46 import Outputable
  47
  48 #include "HsVersions.h"
  49 \end{code}
  50
  51 These type renamers are in a separate module, rather than in (say) RnSource,
  52 to break several loop.
  53
  54 %*********************************************************
  55 %*                                                      *
  56 \subsection{Renaming types}
  57 %*                                                      *
  58 %*********************************************************
  59
  60 \begin{code}
  61 rnHsTypeFVs :: SDoc -> LHsType RdrName -> RnM (LHsType Name, FreeVars)
  62 rnHsTypeFVs doc_str ty  = do
  63     ty' <- rnLHsType doc_str ty
  64     return (ty', extractHsTyNames ty')
  65
  66 rnHsSigType :: SDoc -> LHsType RdrName -> RnM (LHsType Name)
  67         -- rnHsSigType is used for source-language type signatures,
  68         -- which use *implicit* universal quantification.
  69 rnHsSigType doc_str ty
  70   = rnLHsType (text "In the type signature for" <+> doc_str) ty
  71 \end{code}
  72
  73 rnHsType is here because we call it from loadInstDecl, and I didn't
  74 want a gratuitous knot.
  75
  76 \begin{code}
  77 rnLHsType  :: SDoc -> LHsType RdrName -> RnM (LHsType Name)
  78 rnLHsType doc = wrapLocM (rnHsType doc)
  79
  80 rnHsType :: SDoc -> HsType RdrName -> RnM (HsType Name)
  81
  82 rnHsType doc (HsForAllTy Implicit _ ctxt ty) = do
  83         -- Implicit quantifiction in source code (no kinds on tyvars)
  84         -- Given the signature  C => T  we universally quantify
  85         -- over FV(T) \ {in-scope-tyvars}
  86     name_env <- getLocalRdrEnv
  87     let
  88         mentioned = extractHsRhoRdrTyVars ctxt ty
  89
  90         -- Don't quantify over type variables that are in scope;
  91         -- when GlasgowExts is off, there usually won't be any, except for
  92         -- class signatures:
  93         --      class C a where { op :: a -> a }
  94         forall_tyvars = filter (not . (`elemLocalRdrEnv` name_env) . unLoc) mentioned
  95         tyvar_bndrs   = userHsTyVarBndrs forall_tyvars
  96
  97     rnForAll doc Implicit tyvar_bndrs ctxt ty
  98
  99 rnHsType doc (HsForAllTy Explicit forall_tyvars ctxt tau) = do
 100         -- Explicit quantification.
 101         -- Check that the forall'd tyvars are actually
 102         -- mentioned in the type, and produce a warning if not
 103     let
 104         mentioned          = map unLoc (extractHsRhoRdrTyVars ctxt tau)
 105         forall_tyvar_names = hsLTyVarLocNames forall_tyvars
 106
 107         -- Explicitly quantified but not mentioned in ctxt or tau
 108         warn_guys = filter ((`notElem` mentioned) . unLoc) forall_tyvar_names
 109
 110     mapM_ (forAllWarn doc tau) warn_guys
 111     rnForAll doc Explicit forall_tyvars ctxt tau
 112
 113 rnHsType doc (HsTyVar tyvar) = do
 114     tyvar' <- lookupOccRn tyvar
 115     return (HsTyVar tyvar')
 116
 117 -- If we see (forall a . ty), without foralls on, the forall will give
 118 -- a sensible error message, but we don't want to complain about the dot too
 119 -- Hence the jiggery pokery with ty1
 120 rnHsType doc ty@(HsOpTy ty1 (L loc op) ty2)
 121   = setSrcSpan loc $
 122     do  { ops_ok <- doptM Opt_TypeOperators
 123         ; op' <- if ops_ok
 124                  then lookupOccRn op
 125                  else do { addErr (opTyErr op ty)
 126                          ; return (mkUnboundName op) }  -- Avoid double complaint
 127         ; let l_op' = L loc op'
 128         ; fix <- lookupTyFixityRn l_op'
 129         ; ty1' <- rnLHsType doc ty1
 130         ; ty2' <- rnLHsType doc ty2
 131         ; mkHsOpTyRn (\t1 t2 -> HsOpTy t1 l_op' t2) (ppr op') fix ty1' ty2' }
 132
 133 rnHsType doc (HsParTy ty) = do
 134     ty' <- rnLHsType doc ty
 135     return (HsParTy ty')
 136
 137 rnHsType doc (HsBangTy b ty) = do
 138     ty' <- rnLHsType doc ty
 139     return (HsBangTy b ty')
 140
 141 rnHsType doc (HsNumTy i)
 142   | i == 1    = return (HsNumTy i)
 143   | otherwise = addErr err_msg >> return (HsNumTy i)
 144   where
 145     err_msg = ptext SLIT("Only unit numeric type pattern is valid")
 146
 147
 148 rnHsType doc (HsFunTy ty1 ty2) = do
 149     ty1' <- rnLHsType doc ty1
 150         -- Might find a for-all as the arg of a function type
 151     ty2' <- rnLHsType doc ty2
 152         -- Or as the result.  This happens when reading Prelude.hi
 153         -- when we find return :: forall m. Monad m -> forall a. a -> m a
 154
 155         -- Check for fixity rearrangements
 156     mkHsOpTyRn HsFunTy (ppr funTyCon) funTyFixity ty1' ty2'
 157
 158 rnHsType doc (HsListTy ty) = do
 159     ty' <- rnLHsType doc ty
 160     return (HsListTy ty')
 161
 162 rnHsType doc (HsKindSig ty k) = do
 163     ty' <- rnLHsType doc ty
 164     return (HsKindSig ty' k)
 165
 166 rnHsType doc (HsPArrTy ty) = do
 167     ty' <- rnLHsType doc ty
 168     return (HsPArrTy ty')
 169
 170 -- Unboxed tuples are allowed to have poly-typed arguments.  These
 171 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
 172 rnHsType doc (HsTupleTy tup_con tys) = do
 173     tys' <- mapM (rnLHsType doc) tys
 174     return (HsTupleTy tup_con tys')
 175
 176 rnHsType doc (HsAppTy ty1 ty2) = do
 177     ty1' <- rnLHsType doc ty1
 178     ty2' <- rnLHsType doc ty2
 179     return (HsAppTy ty1' ty2')
 180
 181 rnHsType doc (HsPredTy pred) = do
 182     pred' <- rnPred doc pred
 183     return (HsPredTy pred')
 184
 185 rnHsType doc (HsSpliceTy _) = do
 186     addErr (ptext SLIT("Type splices are not yet implemented"))
 187     failM
 188
 189 rnHsType doc (HsDocTy ty haddock_doc) = do
 190     ty' <- rnLHsType doc ty
 191     haddock_doc' <- rnLHsDoc haddock_doc
 192     return (HsDocTy ty' haddock_doc')
 193
 194 rnLHsTypes doc tys = mapM (rnLHsType doc) tys
 195 \end{code}
 196
 197
 198 \begin{code}
 199 rnForAll :: SDoc -> HsExplicitForAll -> [LHsTyVarBndr RdrName]
 200          -> LHsContext RdrName -> LHsType RdrName -> RnM (HsType Name)
 201
 202 rnForAll doc exp [] (L _ []) (L _ ty) = rnHsType doc ty
 203         -- One reason for this case is that a type like Int#
 204         -- starts off as (HsForAllTy Nothing [] Int), in case
 205         -- there is some quantification.  Now that we have quantified
 206         -- and discovered there are no type variables, it's nicer to turn
 207         -- it into plain Int.  If it were Int# instead of Int, we'd actually
 208         -- get an error, because the body of a genuine for-all is
 209         -- of kind *.
 210
 211 rnForAll doc exp forall_tyvars ctxt ty
 212   = bindTyVarsRn doc forall_tyvars $ \ new_tyvars -> do
 213     new_ctxt <- rnContext doc ctxt
 214     new_ty <- rnLHsType doc ty
 215     return (HsForAllTy exp new_tyvars new_ctxt new_ty)
 216         -- Retain the same implicit/explicit flag as before
 217         -- so that we can later print it correctly
 218 \end{code}
 219
 220 %*********************************************************
 221 %*                                                      *
 222 \subsection{Contexts and predicates}
 223 %*                                                      *
 224 %*********************************************************
 225
 226 \begin{code}
 227 rnContext :: SDoc -> LHsContext RdrName -> RnM (LHsContext Name)
 228 rnContext doc = wrapLocM (rnContext' doc)
 229
 230 rnContext' :: SDoc -> HsContext RdrName -> RnM (HsContext Name)
 231 rnContext' doc ctxt = mapM (rnLPred doc) ctxt
 232
 233 rnLPred :: SDoc -> LHsPred RdrName -> RnM (LHsPred Name)
 234 rnLPred doc  = wrapLocM (rnPred doc)
 235
 236 rnPred doc (HsClassP clas tys)
 237   = do { clas_name <- lookupOccRn clas
 238        ; tys' <- rnLHsTypes doc tys
 239        ; return (HsClassP clas_name tys')
 240        }
 241 rnPred doc (HsEqualP ty1 ty2)
 242   = do { ty1' <- rnLHsType doc ty1
 243        ; ty2' <- rnLHsType doc ty2
 244        ; return (HsEqualP ty1' ty2')
 245        }
 246 rnPred doc (HsIParam n ty)
 247   = do { name <- newIPNameRn n
 248        ; ty' <- rnLHsType doc ty
 249        ; return (HsIParam name ty')
 250        }
 251 \end{code}
 252
 253
 254 %************************************************************************
 255 %*                                                                      *
 256         Fixities and precedence parsing
 257 %*                                                                      *
 258 %************************************************************************
 259
 260 @mkOpAppRn@ deals with operator fixities.  The argument expressions
 261 are assumed to be already correctly arranged.  It needs the fixities
 262 recorded in the OpApp nodes, because fixity info applies to the things
 263 the programmer actually wrote, so you can't find it out from the Name.
 264
 265 Furthermore, the second argument is guaranteed not to be another
 266 operator application.  Why? Because the parser parses all
 267 operator appications left-associatively, EXCEPT negation, which
 268 we need to handle specially.
 269 Infix types are read in a *right-associative* way, so that
 270         a `op` b `op` c
 271 is always read in as
 272         a `op` (b `op` c)
 273
 274 mkHsOpTyRn rearranges where necessary.  The two arguments
 275 have already been renamed and rearranged.  It's made rather tiresome
 276 by the presence of ->, which is a separate syntactic construct.
 277
 278 \begin{code}
 279 ---------------
 280 -- Building (ty1 `op1` (ty21 `op2` ty22))
 281 mkHsOpTyRn :: (LHsType Name -> LHsType Name -> HsType Name)
 282            -> SDoc -> Fixity -> LHsType Name -> LHsType Name
 283            -> RnM (HsType Name)
 284
 285 mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsOpTy ty21 op2 ty22))
 286   = do  { fix2 <- lookupTyFixityRn op2
 287         ; mk_hs_op_ty mk1 pp_op1 fix1 ty1
 288                       (\t1 t2 -> HsOpTy t1 op2 t2)
 289                       (ppr op2) fix2 ty21 ty22 loc2 }
 290
 291 mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty2@(L loc2 (HsFunTy ty21 ty22))
 292   = mk_hs_op_ty mk1 pp_op1 fix1 ty1
 293                 HsFunTy (ppr funTyCon) funTyFixity ty21 ty22 loc2
 294
 295 mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty2              -- Default case, no rearrangment
 296   = return (mk1 ty1 ty2)
 297
 298 ---------------
 299 mk_hs_op_ty :: (LHsType Name -> LHsType Name -> HsType Name)
 300             -> SDoc -> Fixity -> LHsType Name
 301             -> (LHsType Name -> LHsType Name -> HsType Name)
 302             -> SDoc -> Fixity -> LHsType Name -> LHsType Name -> SrcSpan
 303             -> RnM (HsType Name)
 304 mk_hs_op_ty mk1 pp_op1 fix1 ty1
 305             mk2 pp_op2 fix2 ty21 ty22 loc2
 306   | nofix_error     = do { addErr (precParseErr (quotes pp_op1,fix1)
 307                                                 (quotes pp_op2,fix2))
 308                          ; return (mk1 ty1 (L loc2 (mk2 ty21 ty22))) }
 309   | associate_right = return (mk1 ty1 (L loc2 (mk2 ty21 ty22)))
 310   | otherwise       = do { -- Rearrange to ((ty1 `op1` ty21) `op2` ty22)
 311                            new_ty <- mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty21
 312                          ; return (mk2 (noLoc new_ty) ty22) }
 313   where
 314     (nofix_error, associate_right) = compareFixity fix1 fix2
 315
 316
 317 ---------------------------
 318 mkOpAppRn :: LHsExpr Name                       -- Left operand; already rearranged
 319           -> LHsExpr Name -> Fixity             -- Operator and fixity
 320           -> LHsExpr Name                       -- Right operand (not an OpApp, but might
 321                                                 -- be a NegApp)
 322           -> RnM (HsExpr Name)
 323
 324 -- (e11 `op1` e12) `op2` e2
 325 mkOpAppRn e1@(L _ (OpApp e11 op1 fix1 e12)) op2 fix2 e2
 326   | nofix_error = do
 327     addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2))
 328     return (OpApp e1 op2 fix2 e2)
 329
 330   | associate_right = do
 331     new_e <- mkOpAppRn e12 op2 fix2 e2
 332     return (OpApp e11 op1 fix1 (L loc' new_e))
 333   where
 334     loc'= combineLocs e12 e2
 335     (nofix_error, associate_right) = compareFixity fix1 fix2
 336
 337 ---------------------------
 338 --      (- neg_arg) `op` e2
 339 mkOpAppRn e1@(L _ (NegApp neg_arg neg_name)) op2 fix2 e2
 340   | nofix_error = do
 341     addErr (precParseErr (pp_prefix_minus,negateFixity) (ppr_op op2,fix2))
 342     return (OpApp e1 op2 fix2 e2)
 343
 344   | associate_right = do
 345     new_e <- mkOpAppRn neg_arg op2 fix2 e2
 346     return (NegApp (L loc' new_e) neg_name)
 347   where
 348     loc' = combineLocs neg_arg e2
 349     (nofix_error, associate_right) = compareFixity negateFixity fix2
 350
 351 ---------------------------
 352 --      e1 `op` - neg_arg
 353 mkOpAppRn e1 op1 fix1 e2@(L _ (NegApp neg_arg _))       -- NegApp can occur on the right
 354   | not associate_right= do                     -- We *want* right association
 355     addErr (precParseErr (ppr_op op1, fix1) (pp_prefix_minus, negateFixity))
 356     return (OpApp e1 op1 fix1 e2)
 357   where
 358     (_, associate_right) = compareFixity fix1 negateFixity
 359
 360 ---------------------------
 361 --      Default case
 362 mkOpAppRn e1 op fix e2                  -- Default case, no rearrangment
 363   = ASSERT2( right_op_ok fix (unLoc e2),
 364              ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2
 365     )
 366     return (OpApp e1 op fix e2)
 367
 368 -- Parser left-associates everything, but
 369 -- derived instances may have correctly-associated things to
 370 -- in the right operarand.  So we just check that the right operand is OK
 371 right_op_ok fix1 (OpApp _ _ fix2 _)
 372   = not error_please && associate_right
 373   where
 374     (error_please, associate_right) = compareFixity fix1 fix2
 375 right_op_ok fix1 other
 376   = True
 377
 378 -- Parser initially makes negation bind more tightly than any other operator
 379 -- And "deriving" code should respect this (use HsPar if not)
 380 mkNegAppRn :: LHsExpr id -> SyntaxExpr id -> RnM (HsExpr id)
 381 mkNegAppRn neg_arg neg_name
 382   = ASSERT( not_op_app (unLoc neg_arg) )
 383     return (NegApp neg_arg neg_name)
 384
 385 not_op_app (OpApp _ _ _ _) = False
 386 not_op_app other           = True
 387
 388 ---------------------------
 389 mkOpFormRn :: LHsCmdTop Name            -- Left operand; already rearranged
 390           -> LHsExpr Name -> Fixity     -- Operator and fixity
 391           -> LHsCmdTop Name             -- Right operand (not an infix)
 392           -> RnM (HsCmd Name)
 393
 394 -- (e11 `op1` e12) `op2` e2
 395 mkOpFormRn a1@(L loc (HsCmdTop (L _ (HsArrForm op1 (Just fix1) [a11,a12])) _ _ _))
 396         op2 fix2 a2
 397   | nofix_error = do
 398     addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2))
 399     return (HsArrForm op2 (Just fix2) [a1, a2])
 400
 401   | associate_right = do
 402     new_c <- mkOpFormRn a12 op2 fix2 a2
 403     return (HsArrForm op1 (Just fix1)
 404         [a11, L loc (HsCmdTop (L loc new_c) [] placeHolderType [])])
 405         -- TODO: locs are wrong
 406   where
 407     (nofix_error, associate_right) = compareFixity fix1 fix2
 408
 409 --      Default case
 410 mkOpFormRn arg1 op fix arg2                     -- Default case, no rearrangment
 411   = return (HsArrForm op (Just fix) [arg1, arg2])
 412
 413
 414 --------------------------------------
 415 mkConOpPatRn :: Located Name -> Fixity -> LPat Name -> LPat Name
 416              -> RnM (Pat Name)
 417
 418 mkConOpPatRn op2 fix2 p1@(L loc (ConPatIn op1 (InfixCon p11 p12))) p2
 419   = do  { fix1 <- lookupFixityRn (unLoc op1)
 420         ; let (nofix_error, associate_right) = compareFixity fix1 fix2
 421
 422         ; if nofix_error then do
 423                 { addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2))
 424                 ; return (ConPatIn op2 (InfixCon p1 p2)) }
 425
 426           else if associate_right then do
 427                 { new_p <- mkConOpPatRn op2 fix2 p12 p2
 428                 ; return (ConPatIn op1 (InfixCon p11 (L loc new_p))) } -- XXX loc right?
 429           else return (ConPatIn op2 (InfixCon p1 p2)) }
 430
 431 mkConOpPatRn op fix p1 p2                       -- Default case, no rearrangment
 432   = ASSERT( not_op_pat (unLoc p2) )
 433     return (ConPatIn op (InfixCon p1 p2))
 434
 435 not_op_pat (ConPatIn _ (InfixCon _ _)) = False
 436 not_op_pat other                       = True
 437
 438 --------------------------------------
 439 checkPrecMatch :: Bool -> Name -> MatchGroup Name -> RnM ()
 440         -- True indicates an infix lhs
 441         -- See comments with rnExpr (OpApp ...) about "deriving"
 442
 443 checkPrecMatch False fn match
 444   = return ()
 445 checkPrecMatch True op (MatchGroup ms _)
 446   = mapM_ check ms
 447   where
 448     check (L _ (Match (p1:p2:_) _ _))
 449       = do checkPrec op (unLoc p1) False
 450            checkPrec op (unLoc p2) True
 451
 452     check _ = return ()
 453         -- This can happen.  Consider
 454         --      a `op` True = ...
 455         --      op          = ...
 456         -- The infix flag comes from the first binding of the group
 457         -- but the second eqn has no args (an error, but not discovered
 458         -- until the type checker).  So we don't want to crash on the
 459         -- second eqn.
 460
 461 checkPrec op (ConPatIn op1 (InfixCon _ _)) right = do
 462     op_fix@(Fixity op_prec  op_dir) <- lookupFixityRn op
 463     op1_fix@(Fixity op1_prec op1_dir) <- lookupFixityRn (unLoc op1)
 464     let
 465         inf_ok = op1_prec > op_prec ||
 466                  (op1_prec == op_prec &&
 467                   (op1_dir == InfixR && op_dir == InfixR && right ||
 468                    op1_dir == InfixL && op_dir == InfixL && not right))
 469
 470         info  = (ppr_op op,  op_fix)
 471         info1 = (ppr_op op1, op1_fix)
 472         (infol, infor) = if right then (info, info1) else (info1, info)
 473
 474     checkErr inf_ok (precParseErr infol infor)
 475
 476 checkPrec op pat right
 477   = return ()
 478
 479 -- Check precedence of (arg op) or (op arg) respectively
 480 -- If arg is itself an operator application, then either
 481 --   (a) its precedence must be higher than that of op
 482 --   (b) its precedency & associativity must be the same as that of op
 483 checkSectionPrec :: FixityDirection -> HsExpr RdrName
 484         -> LHsExpr Name -> LHsExpr Name -> RnM ()
 485 checkSectionPrec direction section op arg
 486   = case unLoc arg of
 487         OpApp _ op fix _ -> go_for_it (ppr_op op)     fix
 488         NegApp _ _       -> go_for_it pp_prefix_minus negateFixity
 489         other            -> return ()
 490   where
 491     L _ (HsVar op_name) = op
 492     go_for_it pp_arg_op arg_fix@(Fixity arg_prec assoc) = do
 493           op_fix@(Fixity op_prec _) <- lookupFixityRn op_name
 494           checkErr (op_prec < arg_prec
 495                      || op_prec == arg_prec && direction == assoc)
 496                   (sectionPrecErr (ppr_op op_name, op_fix)
 497                   (pp_arg_op, arg_fix) section)
 498 \end{code}
 499
 500 Precedence-related error messages
 501
 502 \begin{code}
 503 precParseErr op1 op2
 504   = hang (ptext SLIT("precedence parsing error"))
 505       4 (hsep [ptext SLIT("cannot mix"), ppr_opfix op1, ptext SLIT("and"),
 506                ppr_opfix op2,
 507                ptext SLIT("in the same infix expression")])
 508
 509 sectionPrecErr op arg_op section
 510  = vcat [ptext SLIT("The operator") <+> ppr_opfix op <+> ptext SLIT("of a section"),
 511          nest 4 (ptext SLIT("must have lower precedence than the operand") <+> ppr_opfix arg_op),
 512          nest 4 (ptext SLIT("in the section:") <+> quotes (ppr section))]
 513
 514 pp_prefix_minus = ptext SLIT("prefix `-'")
 515 ppr_op op = quotes (ppr op)     -- Here, op can be a Name or a (Var n), where n is a Name
 516 ppr_opfix (pp_op, fixity) = pp_op <+> brackets (ppr fixity)
 517 \end{code}
 518
 519 %*********************************************************
 520 %*                                                      *
 521 \subsection{Errors}
 522 %*                                                      *
 523 %*********************************************************
 524
 525 \begin{code}
 526 forAllWarn doc ty (L loc tyvar)
 527   = ifOptM Opt_WarnUnusedMatches        $
 528     addWarnAt loc (sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
 529                         nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
 530                    $$
 531                    doc)
 532
 533 opTyErr op ty@(HsOpTy ty1 _ ty2)
 534   = hang (ptext SLIT("Illegal operator") <+> quotes (ppr op) <+> ptext SLIT("in type") <+> quotes (ppr ty))
 535          2 extra
 536   where
 537     extra | op == dot_tv_RDR && forall_head ty1
 538           = ptext SLIT("Perhaps you intended to use -XRankNTypes or similar flag")
 539           | otherwise
 540           = ptext SLIT("Use -XTypeOperators to allow operators in types")
 541
 542     forall_head (L _ (HsTyVar tv))   = tv == forall_tv_RDR
 543     forall_head (L _ (HsAppTy ty _)) = forall_head ty
 544     forall_head _other               = False
 545 \end{code}