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