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