ghc/compiler/rename/RnTypes.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[RnSource]{Main pass of renamer}
   5
   6 \begin{code}
   7 module RnTypes ( rnHsType, rnContext,
   8                  rnHsSigType, rnHsTypeFVs, rnHsSigTypeFVs,
   9                  rnPat, rnPats, rnPatsAndThen,  -- Here because it's not part
  10                  rnOverLit, litFVs,             -- of any mutual recursion
  11                  precParseErr, sectionPrecErr, dupFieldErr, patSigErr, checkTupSize
  12   ) where
  13
  14 import CmdLineOpts      ( DynFlag(Opt_WarnUnusedMatches, Opt_GlasgowExts) )
  15
  16 import HsSyn
  17 import RdrHsSyn ( RdrNameContext, RdrNameHsType, RdrNamePat,
  18                   extractHsRhoRdrTyVars )
  19 import RnHsSyn  ( RenamedContext, RenamedHsType, RenamedPat,
  20                   extractHsTyNames,
  21                   parrTyCon_name, tupleTyCon_name, listTyCon_name, charTyCon_name )
  22 import RnEnv    ( lookupOccRn, lookupBndrRn, lookupSyntaxName, lookupGlobalOccRn,
  23                   bindTyVarsRn, lookupFixityRn, mapFvRn, newIPNameRn,
  24                   bindPatSigTyVarsFV, bindLocalsFV, warnUnusedMatches )
  25 import TcRnMonad
  26 import RdrName  ( elemLocalRdrEnv )
  27 import PrelNames( eqStringName, eqClassName, integralClassName,
  28                   negateName, minusName, lengthPName, indexPName, plusIntegerName, fromIntegerName,
  29                   timesIntegerName, ratioDataConName, fromRationalName )
  30 import Constants        ( mAX_TUPLE_SIZE )
  31 import TysWiredIn       ( intTyCon )
  32 import TysPrim          ( charPrimTyCon, addrPrimTyCon, intPrimTyCon,
  33                           floatPrimTyCon, doublePrimTyCon )
  34 import Name     ( Name, NamedThing(..) )
  35 import NameSet
  36
  37 import Literal          ( inIntRange, inCharRange )
  38 import BasicTypes       ( compareFixity )
  39 import ListSetOps       ( removeDups )
  40 import Outputable
  41
  42 #include "HsVersions.h"
  43 \end{code}
  44
  45 These type renamers are in a separate module, rather than in (say) RnSource,
  46 to break several loop.
  47
  48 %*********************************************************
  49 %*                                                      *
  50 \subsection{Renaming types}
  51 %*                                                      *
  52 %*********************************************************
  53
  54 \begin{code}
  55 rnHsTypeFVs :: SDoc -> RdrNameHsType -> RnM (RenamedHsType, FreeVars)
  56 rnHsTypeFVs doc_str ty
  57   = rnHsType doc_str ty         `thenM` \ ty' ->
  58     returnM (ty', extractHsTyNames ty')
  59
  60 rnHsSigTypeFVs :: SDoc -> RdrNameHsType -> RnM (RenamedHsType, FreeVars)
  61 rnHsSigTypeFVs doc_str ty
  62   = rnHsSigType doc_str ty      `thenM` \ ty' ->
  63     returnM (ty', extractHsTyNames ty')
  64
  65 rnHsSigType :: SDoc -> RdrNameHsType -> RnM RenamedHsType
  66         -- rnHsSigType is used for source-language type signatures,
  67         -- which use *implicit* universal quantification.
  68 rnHsSigType doc_str ty
  69   = rnHsType (text "In the type signature for" <+> doc_str) ty
  70 \end{code}
  71
  72 rnHsType is here because we call it from loadInstDecl, and I didn't
  73 want a gratuitous knot.
  74
  75 \begin{code}
  76 rnHsType :: SDoc -> RdrNameHsType -> RnM RenamedHsType
  77
  78 rnHsType doc (HsForAllTy Implicit _ ctxt ty)
  79         -- Implicit quantifiction in source code (no kinds on tyvars)
  80         -- Given the signature  C => T  we universally quantify
  81         -- over FV(T) \ {in-scope-tyvars}
  82   = getLocalRdrEnv              `thenM` \ name_env ->
  83     let
  84         mentioned = extractHsRhoRdrTyVars ctxt ty
  85
  86         -- Don't quantify over type variables that are in scope;
  87         -- when GlasgowExts is off, there usually won't be any, except for
  88         -- class signatures:
  89         --      class C a where { op :: a -> a }
  90         forall_tyvars = filter (not . (`elemLocalRdrEnv` name_env)) mentioned
  91     in
  92     rnForAll doc Implicit (map UserTyVar forall_tyvars) ctxt ty
  93
  94 rnHsType doc (HsForAllTy Explicit forall_tyvars ctxt tau)
  95         -- Explicit quantification.
  96         -- Check that the forall'd tyvars are actually
  97         -- mentioned in the type, and produce a warning if not
  98   = let
  99         mentioned          = extractHsRhoRdrTyVars ctxt tau
 100         forall_tyvar_names = hsTyVarNames forall_tyvars
 101
 102         -- Explicitly quantified but not mentioned in ctxt or tau
 103         warn_guys = filter (`notElem` mentioned) forall_tyvar_names
 104     in
 105     mappM_ (forAllWarn doc tau) warn_guys       `thenM_`
 106     rnForAll doc Explicit forall_tyvars ctxt tau
 107
 108 rnHsType doc (HsTyVar tyvar)
 109   = lookupOccRn tyvar           `thenM` \ tyvar' ->
 110     returnM (HsTyVar tyvar')
 111
 112 rnHsType doc (HsOpTy ty1 op ty2)
 113   = lookupOccRn op              `thenM` \ op' ->
 114     rnHsType doc ty1            `thenM` \ ty1' ->
 115     rnHsType doc ty2            `thenM` \ ty2' ->
 116     lookupTyFixityRn op'        `thenM` \ fix ->
 117     mkHsOpTyRn op' fix ty1' ty2'
 118
 119 rnHsType doc (HsParTy ty)
 120   = rnHsType doc ty             `thenM` \ ty' ->
 121     returnM (HsParTy ty')
 122
 123 rnHsType doc (HsNumTy i)
 124   | i == 1    = returnM (HsNumTy i)
 125   | otherwise = addErr err_msg  `thenM_`  returnM (HsNumTy i)
 126   where
 127     err_msg = ptext SLIT("Only unit numeric type pattern is valid")
 128
 129
 130 rnHsType doc (HsFunTy ty1 ty2)
 131   = rnHsType doc ty1    `thenM` \ ty1' ->
 132         -- Might find a for-all as the arg of a function type
 133     rnHsType doc ty2    `thenM` \ ty2' ->
 134         -- Or as the result.  This happens when reading Prelude.hi
 135         -- when we find return :: forall m. Monad m -> forall a. a -> m a
 136     returnM (HsFunTy ty1' ty2')
 137
 138 rnHsType doc (HsListTy ty)
 139   = rnHsType doc ty                             `thenM` \ ty' ->
 140     returnM (HsListTy ty')
 141
 142 rnHsType doc (HsKindSig ty k)
 143   = rnHsType doc ty                             `thenM` \ ty' ->
 144     returnM (HsKindSig ty' k)
 145
 146 rnHsType doc (HsPArrTy ty)
 147   = rnHsType doc ty                             `thenM` \ ty' ->
 148     returnM (HsPArrTy ty')
 149
 150 -- Unboxed tuples are allowed to have poly-typed arguments.  These
 151 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
 152 rnHsType doc (HsTupleTy tup_con tys)
 153   = mappM (rnHsType doc) tys            `thenM` \ tys' ->
 154     returnM (HsTupleTy tup_con tys')
 155
 156 rnHsType doc (HsAppTy ty1 ty2)
 157   = rnHsType doc ty1            `thenM` \ ty1' ->
 158     rnHsType doc ty2            `thenM` \ ty2' ->
 159     returnM (HsAppTy ty1' ty2')
 160
 161 rnHsType doc (HsPredTy pred)
 162   = rnPred doc pred     `thenM` \ pred' ->
 163     returnM (HsPredTy pred')
 164
 165 rnHsTypes doc tys = mappM (rnHsType doc) tys
 166 \end{code}
 167
 168
 169 \begin{code}
 170 rnForAll doc exp [] [] ty = rnHsType doc ty
 171         -- One reason for this case is that a type like Int#
 172         -- starts of as (HsForAllTy Nothing [] Int), in case
 173         -- there is some quantification.  Now that we have quantified
 174         -- and discovered there are no type variables, it's nicer to turn
 175         -- it into plain Int.  If it were Int# instead of Int, we'd actually
 176         -- get an error, because the body of a genuine for-all is
 177         -- of kind *.
 178
 179 rnForAll doc exp forall_tyvars ctxt ty
 180   = bindTyVarsRn doc forall_tyvars      $ \ new_tyvars ->
 181     rnContext doc ctxt                  `thenM` \ new_ctxt ->
 182     rnHsType doc ty                     `thenM` \ new_ty ->
 183     returnM (HsForAllTy exp new_tyvars new_ctxt new_ty)
 184         -- Retain the same implicit/explicit flag as before
 185         -- so that we can later print it correctly
 186 \end{code}
 187
 188
 189 %*********************************************************
 190 %*                                                      *
 191 \subsection{Fixities}
 192 %*                                                      *
 193 %*********************************************************
 194
 195 Infix types are read in a *right-associative* way, so that
 196         a `op` b `op` c
 197 is always read in as
 198         a `op` (b `op` c)
 199
 200 mkHsOpTyRn rearranges where necessary.  The two arguments
 201 have already been renamed and rearranged.  It's made rather tiresome
 202 by the presence of ->
 203
 204 \begin{code}
 205 lookupTyFixityRn n
 206   = doptM Opt_GlasgowExts                       `thenM` \ glaExts ->
 207     warnIf (not glaExts) (infixTyConWarn n)     `thenM_`
 208     lookupFixityRn n
 209
 210 -- Building (ty1 `op1` (ty21 `op2` ty22))
 211 mkHsOpTyRn :: Name -> Fixity
 212            -> RenamedHsType -> RenamedHsType
 213            -> RnM RenamedHsType
 214
 215 mkHsOpTyRn op1 fix1 ty1 ty2@(HsOpTy ty21 op2 ty22)
 216   = lookupTyFixityRn op2                `thenM` \ fix2 ->
 217     let
 218         (nofix_error, associate_right) = compareFixity fix1 fix2
 219     in
 220     if nofix_error then
 221         addErr (precParseErr (quotes (ppr op1),fix1)
 222                                (quotes (ppr op2),fix2)) `thenM_`
 223         returnM (HsOpTy ty1 op1 ty2)
 224     else
 225     if not associate_right then
 226         -- Rearrange to ((ty1 `op1` ty21) `op2` ty22)
 227         mkHsOpTyRn op1 fix1 ty1 ty21            `thenM` \ new_ty ->
 228         returnM (HsOpTy new_ty op2 ty22)
 229     else
 230     returnM (HsOpTy ty1 op1 ty2)
 231
 232 mkHsOpTyRn op fix ty1 ty2                       -- Default case, no rearrangment
 233   = returnM (HsOpTy ty1 op ty2)
 234 \end{code}
 235
 236 %*********************************************************
 237 %*                                                      *
 238 \subsection{Contexts and predicates}
 239 %*                                                      *
 240 %*********************************************************
 241
 242 \begin{code}
 243 rnContext :: SDoc -> RdrNameContext -> RnM RenamedContext
 244 rnContext doc ctxt = mappM (rnPred doc) ctxt
 245
 246 rnPred doc (HsClassP clas tys)
 247   = lookupOccRn clas            `thenM` \ clas_name ->
 248     rnHsTypes doc tys           `thenM` \ tys' ->
 249     returnM (HsClassP clas_name tys')
 250
 251 rnPred doc (HsIParam n ty)
 252   = newIPNameRn n               `thenM` \ name ->
 253     rnHsType doc ty             `thenM` \ ty' ->
 254     returnM (HsIParam name ty')
 255 \end{code}
 256
 257
 258 *********************************************************
 259 *                                                       *
 260 \subsection{Patterns}
 261 *                                                       *
 262 *********************************************************
 263
 264 \begin{code}
 265 rnPatsAndThen :: HsMatchContext Name
 266               -> Bool
 267               -> [RdrNamePat]
 268               -> ([RenamedPat] -> RnM (a, FreeVars))
 269               -> RnM (a, FreeVars)
 270 -- Bring into scope all the binders and type variables
 271 -- bound by the patterns; then rename the patterns; then
 272 -- do the thing inside.
 273 --
 274 -- Note that we do a single bindLocalsRn for all the
 275 -- matches together, so that we spot the repeated variable in
 276 --      f x x = 1
 277
 278 rnPatsAndThen ctxt repUnused pats thing_inside
 279   = bindPatSigTyVarsFV pat_sig_tys      $
 280     bindLocalsFV doc_pat bndrs          $ \ new_bndrs ->
 281     rnPats pats                         `thenM` \ (pats', pat_fvs) ->
 282     thing_inside pats'                  `thenM` \ (res, res_fvs) ->
 283
 284     let
 285         unused_binders = filter (not . (`elemNameSet` res_fvs)) new_bndrs
 286     in
 287     (if repUnused
 288      then warnUnusedMatches unused_binders
 289      else returnM ())                  `thenM_`
 290     returnM (res, res_fvs `plusFV` pat_fvs)
 291   where
 292     pat_sig_tys = collectSigTysFromPats pats
 293     bndrs       = collectPatsBinders    pats
 294     doc_pat     = ptext SLIT("In") <+> pprMatchContext ctxt
 295
 296 rnPats :: [RdrNamePat] -> RnM ([RenamedPat], FreeVars)
 297 rnPats ps = mapFvRn rnPat ps
 298
 299 rnPat :: RdrNamePat -> RnM (RenamedPat, FreeVars)
 300
 301 rnPat (WildPat _) = returnM (WildPat placeHolderType, emptyFVs)
 302
 303 rnPat (VarPat name)
 304   = lookupBndrRn  name                  `thenM` \ vname ->
 305     returnM (VarPat vname, emptyFVs)
 306
 307 rnPat (SigPatIn pat ty)
 308   = doptM Opt_GlasgowExts `thenM` \ glaExts ->
 309
 310     if glaExts
 311     then rnPat pat              `thenM` \ (pat', fvs1) ->
 312          rnHsTypeFVs doc ty     `thenM` \ (ty',  fvs2) ->
 313          returnM (SigPatIn pat' ty', fvs1 `plusFV` fvs2)
 314
 315     else addErr (patSigErr ty)  `thenM_`
 316          rnPat pat
 317   where
 318     doc = text "In a pattern type-signature"
 319
 320 rnPat (LitPat s@(HsString _))
 321   = returnM (LitPat s, unitFV eqStringName)
 322
 323 rnPat (LitPat lit)
 324   = litFVs lit          `thenM` \ fvs ->
 325     returnM (LitPat lit, fvs)
 326
 327 rnPat (NPatIn lit mb_neg)
 328   = rnOverLit lit                       `thenM` \ (lit', fvs1) ->
 329     (case mb_neg of
 330         Nothing -> returnM (Nothing, emptyFVs)
 331         Just _  -> lookupSyntaxName negateName  `thenM` \ (neg, fvs) ->
 332                    returnM (Just neg, fvs)
 333     )                                   `thenM` \ (mb_neg', fvs2) ->
 334     returnM (NPatIn lit' mb_neg',
 335               fvs1 `plusFV` fvs2 `addOneFV` eqClassName)
 336         -- Needed to find equality on pattern
 337
 338 rnPat (NPlusKPatIn name lit _)
 339   = rnOverLit lit                       `thenM` \ (lit', fvs1) ->
 340     lookupBndrRn name                   `thenM` \ name' ->
 341     lookupSyntaxName minusName          `thenM` \ (minus, fvs2) ->
 342     returnM (NPlusKPatIn name' lit' minus,
 343               fvs1 `plusFV` fvs2 `addOneFV` integralClassName)
 344         -- The Report says that n+k patterns must be in Integral
 345
 346 rnPat (LazyPat pat)
 347   = rnPat pat           `thenM` \ (pat', fvs) ->
 348     returnM (LazyPat pat', fvs)
 349
 350 rnPat (AsPat name pat)
 351   = rnPat pat           `thenM` \ (pat', fvs) ->
 352     lookupBndrRn name   `thenM` \ vname ->
 353     returnM (AsPat vname pat', fvs)
 354
 355 rnPat (ConPatIn con stuff) = rnConPat con stuff
 356
 357
 358 rnPat (ParPat pat)
 359   = rnPat pat           `thenM` \ (pat', fvs) ->
 360     returnM (ParPat pat', fvs)
 361
 362 rnPat (ListPat pats _)
 363   = rnPats pats                 `thenM` \ (patslist, fvs) ->
 364     returnM (ListPat patslist placeHolderType, fvs `addOneFV` listTyCon_name)
 365
 366 rnPat (PArrPat pats _)
 367   = rnPats pats                 `thenM` \ (patslist, fvs) ->
 368     returnM (PArrPat patslist placeHolderType,
 369               fvs `plusFV` implicit_fvs `addOneFV` parrTyCon_name)
 370   where
 371     implicit_fvs = mkFVs [lengthPName, indexPName]
 372
 373 rnPat (TuplePat pats boxed)
 374   = checkTupSize tup_size       `thenM_`
 375     rnPats pats                 `thenM` \ (patslist, fvs) ->
 376     returnM (TuplePat patslist boxed, fvs `addOneFV` tycon_name)
 377   where
 378     tup_size   = length pats
 379     tycon_name = tupleTyCon_name boxed tup_size
 380
 381 rnPat (TypePat name) =
 382     rnHsTypeFVs (text "In a type pattern") name `thenM` \ (name', fvs) ->
 383     returnM (TypePat name', fvs)
 384
 385 ------------------------------
 386 rnConPat con (PrefixCon pats)
 387   = lookupOccRn con     `thenM` \ con' ->
 388     rnPats pats         `thenM` \ (pats', fvs) ->
 389     returnM (ConPatIn con' (PrefixCon pats'), fvs `addOneFV` con')
 390
 391 rnConPat con (RecCon rpats)
 392   = lookupOccRn con     `thenM` \ con' ->
 393     rnRpats rpats       `thenM` \ (rpats', fvs) ->
 394     returnM (ConPatIn con' (RecCon rpats'), fvs `addOneFV` con')
 395
 396 rnConPat con (InfixCon pat1 pat2)
 397   = lookupOccRn con                             `thenM` \ con' ->
 398     rnPat pat1                                  `thenM` \ (pat1', fvs1) ->
 399     rnPat pat2                                  `thenM` \ (pat2', fvs2) ->
 400     lookupFixityRn con'                         `thenM` \ fixity ->
 401     mkConOpPatRn con' fixity pat1' pat2'        `thenM` \ pat' ->
 402     returnM (pat', fvs1 `plusFV` fvs2 `addOneFV` con')
 403
 404 ------------------------
 405 rnRpats rpats
 406   = mappM_ field_dup_err dup_fields     `thenM_`
 407     mapFvRn rn_rpat rpats               `thenM` \ (rpats', fvs) ->
 408     returnM (rpats', fvs)
 409   where
 410     (_, dup_fields) = removeDups compare [ f | (f,_) <- rpats ]
 411
 412     field_dup_err dups = addErr (dupFieldErr "pattern" dups)
 413
 414     rn_rpat (field, pat)
 415       = lookupGlobalOccRn field `thenM` \ fieldname ->
 416         rnPat pat               `thenM` \ (pat', fvs) ->
 417         returnM ((fieldname, pat'), fvs `addOneFV` fieldname)
 418 \end{code}
 419
 420 \begin{code}
 421 mkConOpPatRn :: Name -> Fixity -> RenamedPat -> RenamedPat
 422              -> RnM RenamedPat
 423
 424 mkConOpPatRn op2 fix2 p1@(ConPatIn op1 (InfixCon p11 p12)) p2
 425   = lookupFixityRn op1          `thenM` \ fix1 ->
 426     let
 427         (nofix_error, associate_right) = compareFixity fix1 fix2
 428     in
 429     if nofix_error then
 430         addErr (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2))       `thenM_`
 431         returnM (ConPatIn op2 (InfixCon p1 p2))
 432     else
 433     if associate_right then
 434         mkConOpPatRn op2 fix2 p12 p2            `thenM` \ new_p ->
 435         returnM (ConPatIn op1 (InfixCon p11 new_p))
 436     else
 437     returnM (ConPatIn op2 (InfixCon p1 p2))
 438
 439 mkConOpPatRn op fix p1 p2                       -- Default case, no rearrangment
 440   = ASSERT( not_op_pat p2 )
 441     returnM (ConPatIn op (InfixCon p1 p2))
 442
 443 not_op_pat (ConPatIn _ (InfixCon _ _)) = False
 444 not_op_pat other                       = True
 445 \end{code}
 446
 447
 448 %************************************************************************
 449 %*                                                                      *
 450 \subsubsection{Literals}
 451 %*                                                                      *
 452 %************************************************************************
 453
 454 When literals occur we have to make sure
 455 that the types and classes they involve
 456 are made available.
 457
 458 \begin{code}
 459 litFVs (HsChar c)
 460    = checkErr (inCharRange c) (bogusCharError c) `thenM_`
 461      returnM (unitFV charTyCon_name)
 462
 463 litFVs (HsCharPrim c)         = returnM (unitFV (getName charPrimTyCon))
 464 litFVs (HsString s)           = returnM (mkFVs [listTyCon_name, charTyCon_name])
 465 litFVs (HsStringPrim s)       = returnM (unitFV (getName addrPrimTyCon))
 466 litFVs (HsInt i)              = returnM (unitFV (getName intTyCon))
 467 litFVs (HsIntPrim i)          = returnM (unitFV (getName intPrimTyCon))
 468 litFVs (HsFloatPrim f)        = returnM (unitFV (getName floatPrimTyCon))
 469 litFVs (HsDoublePrim d)       = returnM (unitFV (getName doublePrimTyCon))
 470 litFVs lit                    = pprPanic "RnExpr.litFVs" (ppr lit)      -- HsInteger and HsRat only appear
 471                                                                         -- in post-typechecker translations
 472 bogusCharError c
 473   = ptext SLIT("character literal out of range: '\\") <> int c <> char '\''
 474
 475 rnOverLit (HsIntegral i _)
 476   = lookupSyntaxName fromIntegerName    `thenM` \ (from_integer_name, fvs) ->
 477     if inIntRange i then
 478         returnM (HsIntegral i from_integer_name, fvs)
 479     else let
 480         extra_fvs = mkFVs [plusIntegerName, timesIntegerName]
 481         -- Big integer literals are built, using + and *,
 482         -- out of small integers (DsUtils.mkIntegerLit)
 483         -- [NB: plusInteger, timesInteger aren't rebindable...
 484         --      they are used to construct the argument to fromInteger,
 485         --      which is the rebindable one.]
 486     in
 487     returnM (HsIntegral i from_integer_name, fvs `plusFV` extra_fvs)
 488
 489 rnOverLit (HsFractional i _)
 490   = lookupSyntaxName fromRationalName           `thenM` \ (from_rat_name, fvs) ->
 491     let
 492         extra_fvs = mkFVs [ratioDataConName, plusIntegerName, timesIntegerName]
 493         -- We have to make sure that the Ratio type is imported with
 494         -- its constructor, because literals of type Ratio t are
 495         -- built with that constructor.
 496         -- The Rational type is needed too, but that will come in
 497         -- as part of the type for fromRational.
 498         -- The plus/times integer operations may be needed to construct the numerator
 499         -- and denominator (see DsUtils.mkIntegerLit)
 500     in
 501     returnM (HsFractional i from_rat_name, fvs `plusFV` extra_fvs)
 502 \end{code}
 503
 504
 505
 506 %*********************************************************
 507 %*                                                      *
 508 \subsection{Errors}
 509 %*                                                      *
 510 %*********************************************************
 511
 512 \begin{code}
 513 checkTupSize :: Int -> RnM ()
 514 checkTupSize tup_size
 515   | tup_size <= mAX_TUPLE_SIZE
 516   = returnM ()
 517   | otherwise
 518   = addErr (sep [ptext SLIT("A") <+> int tup_size <> ptext SLIT("-tuple is too large for GHC"),
 519                  nest 2 (parens (ptext SLIT("max size is") <+> int mAX_TUPLE_SIZE)),
 520                  nest 2 (ptext SLIT("Workaround: use nested tuples or define a data type"))])
 521
 522 forAllWarn doc ty tyvar
 523   = ifOptM Opt_WarnUnusedMatches        $
 524     addWarn (sep [ptext SLIT("The universally quantified type variable") <+> quotes (ppr tyvar),
 525                    nest 4 (ptext SLIT("does not appear in the type") <+> quotes (ppr ty))]
 526                    $$
 527                    doc
 528                 )
 529
 530 precParseErr op1 op2
 531   = hang (ptext SLIT("precedence parsing error"))
 532       4 (hsep [ptext SLIT("cannot mix"), ppr_opfix op1, ptext SLIT("and"),
 533                ppr_opfix op2,
 534                ptext SLIT("in the same infix expression")])
 535
 536 sectionPrecErr op arg_op section
 537  = vcat [ptext SLIT("The operator") <+> ppr_opfix op <+> ptext SLIT("of a section"),
 538          nest 4 (ptext SLIT("must have lower precedence than the operand") <+> ppr_opfix arg_op),
 539          nest 4 (ptext SLIT("in the section:") <+> quotes (ppr section))]
 540
 541 infixTyConWarn op
 542   = ftext FSLIT("Accepting non-standard infix type constructor") <+> quotes (ppr op)
 543
 544 patSigErr ty
 545   =  (ptext SLIT("Illegal signature in pattern:") <+> ppr ty)
 546         $$ nest 4 (ptext SLIT("Use -fglasgow-exts to permit it"))
 547
 548 dupFieldErr str (dup:rest)
 549   = hsep [ptext SLIT("duplicate field name"),
 550           quotes (ppr dup),
 551           ptext SLIT("in record"), text str]
 552
 553 ppr_op op = quotes (ppr op)     -- Here, op can be a Name or a (Var n), where n is a Name
 554 ppr_opfix (pp_op, fixity) = pp_op <+> brackets (ppr fixity)
 555 \end{code}