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