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