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