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 _) = do
 174     addErr (ptext (sLit "Type splices are not yet implemented"))
 175     failM
 176
 177 rnHsType doc (HsDocTy ty haddock_doc) = do
 178     ty' <- rnLHsType doc ty
 179     haddock_doc' <- rnLHsDoc haddock_doc
 180     return (HsDocTy ty' haddock_doc')
 181
 182 rnLHsTypes :: SDoc -> [LHsType RdrName]
 183            -> IOEnv (Env TcGblEnv TcLclEnv) [LHsType Name]
 184 rnLHsTypes doc tys = mapM (rnLHsType doc) tys
 185 \end{code}
 186
 187
 188 \begin{code}
 189 rnForAll :: SDoc -> HsExplicitForAll -> [LHsTyVarBndr RdrName]
 190          -> LHsContext RdrName -> LHsType RdrName -> RnM (HsType Name)
 191
 192 rnForAll doc _ [] (L _ []) (L _ ty) = rnHsType doc ty
 193         -- One reason for this case is that a type like Int#
 194         -- starts off as (HsForAllTy Nothing [] Int), in case
 195         -- there is some quantification.  Now that we have quantified
 196         -- and discovered there are no type variables, it's nicer to turn
 197         -- it into plain Int.  If it were Int# instead of Int, we'd actually
 198         -- get an error, because the body of a genuine for-all is
 199         -- of kind *.
 200
 201 rnForAll doc exp forall_tyvars ctxt ty
 202   = bindTyVarsRn doc forall_tyvars $ \ new_tyvars -> do
 203     new_ctxt <- rnContext doc ctxt
 204     new_ty <- rnLHsType doc ty
 205     return (HsForAllTy exp new_tyvars new_ctxt new_ty)
 206         -- Retain the same implicit/explicit flag as before
 207         -- so that we can later print it correctly
 208 \end{code}
 209
 210 %*********************************************************
 211 %*                                                      *
 212 \subsection{Contexts and predicates}
 213 %*                                                      *
 214 %*********************************************************
 215
 216 \begin{code}
 217 rnContext :: SDoc -> LHsContext RdrName -> RnM (LHsContext Name)
 218 rnContext doc = wrapLocM (rnContext' doc)
 219
 220 rnContext' :: SDoc -> HsContext RdrName -> RnM (HsContext Name)
 221 rnContext' doc ctxt = mapM (rnLPred doc) ctxt
 222
 223 rnLPred :: SDoc -> LHsPred RdrName -> RnM (LHsPred Name)
 224 rnLPred doc  = wrapLocM (rnPred doc)
 225
 226 rnPred :: SDoc -> HsPred RdrName
 227        -> IOEnv (Env TcGblEnv TcLclEnv) (HsPred Name)
 228 rnPred doc (HsClassP clas tys)
 229   = do { clas_name <- lookupOccRn clas
 230        ; tys' <- rnLHsTypes doc tys
 231        ; return (HsClassP clas_name tys')
 232        }
 233 rnPred doc (HsEqualP ty1 ty2)
 234   = do { ty1' <- rnLHsType doc ty1
 235        ; ty2' <- rnLHsType doc ty2
 236        ; return (HsEqualP ty1' ty2')
 237        }
 238 rnPred doc (HsIParam n ty)
 239   = do { name <- newIPNameRn n
 240        ; ty' <- rnLHsType doc ty
 241        ; return (HsIParam name ty')
 242        }
 243 \end{code}
 244
 245
 246 %************************************************************************
 247 %*                                                                      *
 248         Fixities and precedence parsing
 249 %*                                                                      *
 250 %************************************************************************
 251
 252 @mkOpAppRn@ deals with operator fixities.  The argument expressions
 253 are assumed to be already correctly arranged.  It needs the fixities
 254 recorded in the OpApp nodes, because fixity info applies to the things
 255 the programmer actually wrote, so you can't find it out from the Name.
 256
 257 Furthermore, the second argument is guaranteed not to be another
 258 operator application.  Why? Because the parser parses all
 259 operator appications left-associatively, EXCEPT negation, which
 260 we need to handle specially.
 261 Infix types are read in a *right-associative* way, so that
 262         a `op` b `op` c
 263 is always read in as
 264         a `op` (b `op` c)
 265
 266 mkHsOpTyRn rearranges where necessary.  The two arguments
 267 have already been renamed and rearranged.  It's made rather tiresome
 268 by the presence of ->, which is a separate syntactic construct.
 269
 270 \begin{code}
 271 ---------------
 272 -- Building (ty1 `op1` (ty21 `op2` ty22))
 273 mkHsOpTyRn :: (LHsType Name -> LHsType Name -> HsType Name)
 274            -> SDoc -> Fixity -> LHsType Name -> LHsType Name
 275            -> RnM (HsType Name)
 276
 277 mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsOpTy ty21 op2 ty22))
 278   = do  { fix2 <- lookupTyFixityRn op2
 279         ; mk_hs_op_ty mk1 pp_op1 fix1 ty1
 280                       (\t1 t2 -> HsOpTy t1 op2 t2)
 281                       (ppr op2) fix2 ty21 ty22 loc2 }
 282
 283 mkHsOpTyRn mk1 pp_op1 fix1 ty1 (L loc2 (HsFunTy ty21 ty22))
 284   = mk_hs_op_ty mk1 pp_op1 fix1 ty1
 285                 HsFunTy (ppr funTyCon) funTyFixity ty21 ty22 loc2
 286
 287 mkHsOpTyRn mk1 _ _ ty1 ty2              -- Default case, no rearrangment
 288   = return (mk1 ty1 ty2)
 289
 290 ---------------
 291 mk_hs_op_ty :: (LHsType Name -> LHsType Name -> HsType Name)
 292             -> SDoc -> Fixity -> LHsType Name
 293             -> (LHsType Name -> LHsType Name -> HsType Name)
 294             -> SDoc -> Fixity -> LHsType Name -> LHsType Name -> SrcSpan
 295             -> RnM (HsType Name)
 296 mk_hs_op_ty mk1 pp_op1 fix1 ty1
 297             mk2 pp_op2 fix2 ty21 ty22 loc2
 298   | nofix_error     = do { addErr (precParseErr (quotes pp_op1,fix1)
 299                                                 (quotes pp_op2,fix2))
 300                          ; return (mk1 ty1 (L loc2 (mk2 ty21 ty22))) }
 301   | associate_right = return (mk1 ty1 (L loc2 (mk2 ty21 ty22)))
 302   | otherwise       = do { -- Rearrange to ((ty1 `op1` ty21) `op2` ty22)
 303                            new_ty <- mkHsOpTyRn mk1 pp_op1 fix1 ty1 ty21
 304                          ; return (mk2 (noLoc new_ty) ty22) }
 305   where
 306     (nofix_error, associate_right) = compareFixity fix1 fix2
 307
 308
 309 ---------------------------
 310 mkOpAppRn :: LHsExpr Name                       -- Left operand; already rearranged
 311           -> LHsExpr Name -> Fixity             -- Operator and fixity
 312           -> LHsExpr Name                       -- Right operand (not an OpApp, but might
 313                                                 -- be a NegApp)
 314           -> RnM (HsExpr Name)
 315
 316 -- (e11 `op1` e12) `op2` e2
 317 mkOpAppRn e1@(L _ (OpApp e11 op1 fix1 e12)) op2 fix2 e2
 318   | nofix_error = do
 319     addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2))
 320     return (OpApp e1 op2 fix2 e2)
 321
 322   | associate_right = do
 323     new_e <- mkOpAppRn e12 op2 fix2 e2
 324     return (OpApp e11 op1 fix1 (L loc' new_e))
 325   where
 326     loc'= combineLocs e12 e2
 327     (nofix_error, associate_right) = compareFixity fix1 fix2
 328
 329 ---------------------------
 330 --      (- neg_arg) `op` e2
 331 mkOpAppRn e1@(L _ (NegApp neg_arg neg_name)) op2 fix2 e2
 332   | nofix_error = do
 333     addErr (precParseErr (pp_prefix_minus,negateFixity) (ppr_op op2,fix2))
 334     return (OpApp e1 op2 fix2 e2)
 335
 336   | associate_right = do
 337     new_e <- mkOpAppRn neg_arg op2 fix2 e2
 338     return (NegApp (L loc' new_e) neg_name)
 339   where
 340     loc' = combineLocs neg_arg e2
 341     (nofix_error, associate_right) = compareFixity negateFixity fix2
 342
 343 ---------------------------
 344 --      e1 `op` - neg_arg
 345 mkOpAppRn e1 op1 fix1 e2@(L _ (NegApp _ _))     -- NegApp can occur on the right
 346   | not associate_right= do                     -- We *want* right association
 347     addErr (precParseErr (ppr_op op1, fix1) (pp_prefix_minus, negateFixity))
 348     return (OpApp e1 op1 fix1 e2)
 349   where
 350     (_, associate_right) = compareFixity fix1 negateFixity
 351
 352 ---------------------------
 353 --      Default case
 354 mkOpAppRn e1 op fix e2                  -- Default case, no rearrangment
 355   = ASSERT2( right_op_ok fix (unLoc e2),
 356              ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2
 357     )
 358     return (OpApp e1 op fix e2)
 359
 360 -- Parser left-associates everything, but
 361 -- derived instances may have correctly-associated things to
 362 -- in the right operarand.  So we just check that the right operand is OK
 363 right_op_ok :: Fixity -> HsExpr Name -> Bool
 364 right_op_ok fix1 (OpApp _ _ fix2 _)
 365   = not error_please && associate_right
 366   where
 367     (error_please, associate_right) = compareFixity fix1 fix2
 368 right_op_ok _ _
 369   = True
 370
 371 -- Parser initially makes negation bind more tightly than any other operator
 372 -- And "deriving" code should respect this (use HsPar if not)
 373 mkNegAppRn :: LHsExpr id -> SyntaxExpr id -> RnM (HsExpr id)
 374 mkNegAppRn neg_arg neg_name
 375   = ASSERT( not_op_app (unLoc neg_arg) )
 376     return (NegApp neg_arg neg_name)
 377
 378 not_op_app :: HsExpr id -> Bool
 379 not_op_app (OpApp _ _ _ _) = False
 380 not_op_app _               = True
 381
 382 ---------------------------
 383 mkOpFormRn :: LHsCmdTop Name            -- Left operand; already rearranged
 384           -> LHsExpr Name -> Fixity     -- Operator and fixity
 385           -> LHsCmdTop Name             -- Right operand (not an infix)
 386           -> RnM (HsCmd Name)
 387
 388 -- (e11 `op1` e12) `op2` e2
 389 mkOpFormRn a1@(L loc (HsCmdTop (L _ (HsArrForm op1 (Just fix1) [a11,a12])) _ _ _))
 390         op2 fix2 a2
 391   | nofix_error = do
 392     addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2))
 393     return (HsArrForm op2 (Just fix2) [a1, a2])
 394
 395   | associate_right = do
 396     new_c <- mkOpFormRn a12 op2 fix2 a2
 397     return (HsArrForm op1 (Just fix1)
 398         [a11, L loc (HsCmdTop (L loc new_c) [] placeHolderType [])])
 399         -- TODO: locs are wrong
 400   where
 401     (nofix_error, associate_right) = compareFixity fix1 fix2
 402
 403 --      Default case
 404 mkOpFormRn arg1 op fix arg2                     -- Default case, no rearrangment
 405   = return (HsArrForm op (Just fix) [arg1, arg2])
 406
 407
 408 --------------------------------------
 409 mkConOpPatRn :: Located Name -> Fixity -> LPat Name -> LPat Name
 410              -> RnM (Pat Name)
 411
 412 mkConOpPatRn op2 fix2 p1@(L loc (ConPatIn op1 (InfixCon p11 p12))) p2
 413   = do  { fix1 <- lookupFixityRn (unLoc op1)
 414         ; let (nofix_error, associate_right) = compareFixity fix1 fix2
 415
 416         ; if nofix_error then do
 417                 { addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2))
 418                 ; return (ConPatIn op2 (InfixCon p1 p2)) }
 419
 420           else if associate_right then do
 421                 { new_p <- mkConOpPatRn op2 fix2 p12 p2
 422                 ; return (ConPatIn op1 (InfixCon p11 (L loc new_p))) } -- XXX loc right?
 423           else return (ConPatIn op2 (InfixCon p1 p2)) }
 424
 425 mkConOpPatRn op _ p1 p2                         -- Default case, no rearrangment
 426   = ASSERT( not_op_pat (unLoc p2) )
 427     return (ConPatIn op (InfixCon p1 p2))
 428
 429 not_op_pat :: Pat Name -> Bool
 430 not_op_pat (ConPatIn _ (InfixCon _ _)) = False
 431 not_op_pat _                           = True
 432
 433 --------------------------------------
 434 checkPrecMatch :: Bool -> Name -> MatchGroup Name -> RnM ()
 435         -- True indicates an infix lhs
 436         -- See comments with rnExpr (OpApp ...) about "deriving"
 437
 438 checkPrecMatch False _ _
 439   = return ()
 440 checkPrecMatch True op (MatchGroup ms _)
 441   = mapM_ check ms
 442   where
 443     check (L _ (Match (p1:p2:_) _ _))
 444       = do checkPrec op (unLoc p1) False
 445            checkPrec op (unLoc p2) True
 446
 447     check _ = return ()
 448         -- This can happen.  Consider
 449         --      a `op` True = ...
 450         --      op          = ...
 451         -- The infix flag comes from the first binding of the group
 452         -- but the second eqn has no args (an error, but not discovered
 453         -- until the type checker).  So we don't want to crash on the
 454         -- second eqn.
 455
 456 checkPrec :: Name -> Pat Name -> Bool -> IOEnv (Env TcGblEnv TcLclEnv) ()
 457 checkPrec op (ConPatIn op1 (InfixCon _ _)) right = do
 458     op_fix@(Fixity op_prec  op_dir) <- lookupFixityRn op
 459     op1_fix@(Fixity op1_prec op1_dir) <- lookupFixityRn (unLoc op1)
 460     let
 461         inf_ok = op1_prec > op_prec ||
 462                  (op1_prec == op_prec &&
 463                   (op1_dir == InfixR && op_dir == InfixR && right ||
 464                    op1_dir == InfixL && op_dir == InfixL && not right))
 465
 466         info  = (ppr_op op,  op_fix)
 467         info1 = (ppr_op op1, op1_fix)
 468         (infol, infor) = if right then (info, info1) else (info1, info)
 469
 470     checkErr inf_ok (precParseErr infol infor)
 471
 472 checkPrec _ _ _
 473   = return ()
 474
 475 -- Check precedence of (arg op) or (op arg) respectively
 476 -- If arg is itself an operator application, then either
 477 --   (a) its precedence must be higher than that of op
 478 --   (b) its precedency & associativity must be the same as that of op
 479 checkSectionPrec :: FixityDirection -> HsExpr RdrName
 480         -> LHsExpr Name -> LHsExpr Name -> RnM ()
 481 checkSectionPrec direction section op arg
 482   = case unLoc arg of
 483         OpApp _ op fix _ -> go_for_it (ppr_op op)     fix
 484         NegApp _ _       -> go_for_it pp_prefix_minus negateFixity
 485         _                -> return ()
 486   where
 487     L _ (HsVar op_name) = op
 488     go_for_it pp_arg_op arg_fix@(Fixity arg_prec assoc) = do
 489           op_fix@(Fixity op_prec _) <- lookupFixityRn op_name
 490           checkErr (op_prec < arg_prec
 491                      || op_prec == arg_prec && direction == assoc)
 492                   (sectionPrecErr (ppr_op op_name, op_fix)
 493                   (pp_arg_op, arg_fix) section)
 494 \end{code}
 495
 496 Precedence-related error messages
 497
 498 \begin{code}
 499 precParseErr :: (SDoc, Fixity) -> (SDoc, Fixity) -> SDoc
 500 precParseErr op1 op2
 501   = hang (ptext (sLit "precedence parsing error"))
 502       4 (hsep [ptext (sLit "cannot mix"), ppr_opfix op1, ptext (sLit "and"),
 503                ppr_opfix op2,
 504                ptext (sLit "in the same infix expression")])
 505
 506 sectionPrecErr :: (SDoc, Fixity) -> (SDoc, Fixity) -> HsExpr RdrName -> SDoc
 507 sectionPrecErr op arg_op section
 508  = vcat [ptext (sLit "The operator") <+> ppr_opfix op <+> ptext (sLit "of a section"),
 509          nest 4 (ptext (sLit "must have lower precedence than the operand") <+> ppr_opfix arg_op),
 510          nest 4 (ptext (sLit "in the section:") <+> quotes (ppr section))]
 511
 512 pp_prefix_minus :: SDoc
 513 pp_prefix_minus = ptext (sLit "prefix `-'")
 514 ppr_op :: Outputable a => a -> SDoc
 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 :: (SDoc, Fixity) -> SDoc
 517 ppr_opfix (pp_op, fixity) = pp_op <+> brackets (ppr fixity)
 518 \end{code}
 519
 520 %*********************************************************
 521 %*                                                      *
 522 \subsection{Errors}
 523 %*                                                      *
 524 %*********************************************************
 525
 526 \begin{code}
 527 forAllWarn :: SDoc -> LHsType RdrName -> Located RdrName
 528            -> TcRnIf TcGblEnv TcLclEnv ()
 529 forAllWarn doc ty (L loc tyvar)
 530   = ifOptM Opt_WarnUnusedMatches        $
 531     addWarnAt loc (sep [ptext (sLit "The universally quantified type variable") <+> quotes (ppr tyvar),
 532                         nest 4 (ptext (sLit "does not appear in the type") <+> quotes (ppr ty))]
 533                    $$
 534                    doc)
 535
 536 opTyErr :: RdrName -> HsType RdrName -> SDoc
 537 opTyErr op ty@(HsOpTy ty1 _ _)
 538   = hang (ptext (sLit "Illegal operator") <+> quotes (ppr op) <+> ptext (sLit "in type") <+> quotes (ppr ty))
 539          2 extra
 540   where
 541     extra | op == dot_tv_RDR && forall_head ty1
 542           = ptext (sLit "Perhaps you intended to use -XRankNTypes or similar flag")
 543           | otherwise
 544           = ptext (sLit "Use -XTypeOperators to allow operators in types")
 545
 546     forall_head (L _ (HsTyVar tv))   = tv == forall_tv_RDR
 547     forall_head (L _ (HsAppTy ty _)) = forall_head ty
 548     forall_head _other               = False
 549 opTyErr _ ty = pprPanic "opTyErr: Not an op" (ppr ty)
 550 \end{code}