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