compiler/rename/RnPat.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[RnPat]{Renaming of patterns}
   5
   6 Basically dependency analysis.
   7
   8 Handles @Match@, @GRHSs@, @HsExpr@, and @Qualifier@ datatypes.  In
   9 general, all of these functions return a renamed thing, and a set of
  10 free variables.
  11
  12 \begin{code}
  13 {-# OPTIONS -w #-}
  14 -- The above warning supression flag is a temporary kludge.
  15 -- While working on this module you are encouraged to remove it and fix
  16 -- any warnings in the module. See
  17 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
  18 -- for details
  19
  20 module RnPat (-- main entry points
  21               rnPatsAndThen_LocalRightwards, rnBindPat,
  22
  23               NameMaker, applyNameMaker,     -- a utility for making names:
  24               localRecNameMaker, topRecNameMaker,  --   sometimes we want to make local names,
  25                                              --   sometimes we want to make top (qualified) names.
  26
  27               rnHsRecFields_Con, rnHsRecFields_Update, --rename record fields in a constructor
  28                                                        --and in an update
  29
  30               -- Literals
  31               rnLit, rnOverLit,
  32
  33              -- Pattern Error messages that are also used elsewhere
  34              checkTupSize, patSigErr
  35              ) where
  36
  37 -- ENH: thin imports to only what is necessary for patterns
  38
  39 import {-# SOURCE #-} RnExpr( rnLExpr, rnStmts)
  40
  41 #include "HsVersions.h"
  42
  43 import HsSyn
  44 import TcRnMonad
  45 import RnEnv
  46 import HscTypes         ( availNames )
  47 import RnNames          ( getLocalDeclBinders, extendRdrEnvRn )
  48 import RnTypes          ( rnHsTypeFVs,
  49                           mkOpFormRn, mkOpAppRn, mkNegAppRn, checkSectionPrec, mkConOpPatRn
  50                            )
  51 import DynFlags         ( DynFlag(..) )
  52 import BasicTypes       ( FixityDirection(..) )
  53 import SrcLoc           ( SrcSpan )
  54 import PrelNames        ( thFAKE, hasKey, assertIdKey, assertErrorName,
  55                           loopAName, choiceAName, appAName, arrAName, composeAName, firstAName,
  56                           negateName, thenMName, bindMName, failMName,
  57                         eqClassName, integralClassName, geName, eqName,
  58                           negateName, minusName, lengthPName, indexPName,
  59                           plusIntegerName, fromIntegerName, timesIntegerName,
  60                           ratioDataConName, fromRationalName, fromStringName )
  61 import Constants        ( mAX_TUPLE_SIZE )
  62 import Name             ( Name, nameOccName, nameIsLocalOrFrom, getOccName, nameSrcSpan )
  63 import NameSet
  64 import UniqFM
  65 import RdrName        ( RdrName, extendLocalRdrEnv, lookupLocalRdrEnv, hideSomeUnquals, mkRdrUnqual, nameRdrName )
  66 import LoadIface        ( loadInterfaceForName )
  67 import UniqFM           ( isNullUFM )
  68 import UniqSet          ( emptyUniqSet )
  69 import List             ( nub )
  70 import Util             ( isSingleton )
  71 import ListSetOps       ( removeDups, minusList )
  72 import Maybes           ( expectJust )
  73 import Outputable
  74 import SrcLoc           ( Located(..), unLoc, getLoc, cmpLocated, noLoc )
  75 import FastString
  76 import Literal          ( inIntRange, inCharRange )
  77 import List             ( unzip4 )
  78 import Bag            (foldrBag)
  79
  80 import ErrUtils       (Message)
  81 \end{code}
  82
  83
  84 *********************************************************
  85 *                                                       *
  86 \subsection{Patterns}
  87 *                                                       *
  88 *********************************************************
  89
  90 \begin{code}
  91 -- externally abstract type of name makers,
  92 -- which is how you go from a RdrName to a Name
  93 data NameMaker = NM (forall a. Located RdrName -> (Name -> RnM (a, FreeVars))
  94                                                -> RnM (a, FreeVars))
  95
  96 matchNameMaker :: NameMaker
  97 matchNameMaker
  98   = NM (\ rdr_name thing_inside ->
  99         do { names@[name] <- newLocalsRn [rdr_name]
 100            ; bindLocalNamesFV names $
 101              warnUnusedMatches names $
 102              thing_inside name })
 103
 104 topRecNameMaker, localRecNameMaker
 105   :: UniqFM (Located Fixity) -- mini fixity env for the names we're about to bind
 106                              -- these fixities need to be brought into scope with the names
 107   -> NameMaker
 108
 109 -- topNameMaker and localBindMaker do not check for unused binding
 110 localRecNameMaker fix_env
 111   = NM (\ rdr_name thing_inside ->
 112         do { [name] <- newLocalsRn [rdr_name]
 113            ; bindLocalNamesFV_WithFixities [name] fix_env $
 114              thing_inside name })
 115
 116 topRecNameMaker fix_env
 117   = NM (\rdr_name thing_inside ->
 118         do { mod <- getModule
 119            ; name <- newTopSrcBinder mod rdr_name
 120            ; bindLocalNamesFV_WithFixities [name] fix_env $
 121              thing_inside name })
 122                 -- Note: the bindLocalNamesFV_WithFixities is somewhat suspicious
 123                 --       because it binds a top-level name as a local name.
 124                 --       however, this binding seems to work, and it only exists for
 125                 --       the duration of the patterns and the continuation;
 126                 --       then the top-level name is added to the global env
 127                 --       before going on to the RHSes (see RnSource.lhs).
 128
 129 applyNameMaker :: NameMaker -> Located RdrName
 130                -> (Name -> RnM (a,FreeVars)) -> RnM (a, FreeVars)
 131 applyNameMaker (NM f) = f
 132
 133
 134 -- There are various entry points to renaming patterns, depending on
 135 --  (1) whether the names created should be top-level names or local names
 136 --  (2) whether the scope of the names is entirely given in a continuation
 137 --      (e.g., in a case or lambda, but not in a let or at the top-level,
 138 --       because of the way mutually recursive bindings are handled)
 139 --  (3) whether the a type signature in the pattern can bind
 140 --      lexically-scoped type variables (for unpacking existential
 141 --      type vars in data constructors)
 142 --  (4) whether we do duplicate and unused variable checking
 143 --  (5) whether there are fixity declarations associated with the names
 144 --      bound by the patterns that need to be brought into scope with them.
 145 --
 146 --  Rather than burdening the clients of this module with all of these choices,
 147 --  we export the three points in this design space that we actually need:
 148
 149 -- entry point 1:
 150 -- binds local names; the scope of the bindings is entirely in the thing_inside
 151 --   allows type sigs to bind type vars
 152 --   local namemaker
 153 --   unused and duplicate checking
 154 --   no fixities
 155 rnPatsAndThen_LocalRightwards :: HsMatchContext Name -- for error messages
 156                               -> [LPat RdrName]
 157                               -- the continuation gets:
 158                               --    the list of renamed patterns
 159                               --    the (overall) free vars of all of them
 160                               -> ([LPat Name] -> RnM (a, FreeVars))
 161                               -> RnM (a, FreeVars)
 162
 163 rnPatsAndThen_LocalRightwards ctxt pats thing_inside
 164   = do  { -- Check for duplicated and shadowed names
 165           -- Because we don't bind the vars all at once, we can't
 166           --    check incrementally for duplicates;
 167           -- Nor can we check incrementally for shadowing, else we'll
 168           --    complain *twice* about duplicates e.g. f (x,x) = ...
 169           let rdr_names_w_loc = collectLocatedPatsBinders pats
 170         ; checkDupNames  doc_pat rdr_names_w_loc
 171         ; checkShadowing doc_pat rdr_names_w_loc
 172
 173           -- (0) bring into scope all of the type variables bound by the patterns
 174           -- (1) rename the patterns, bringing into scope all of the term variables
 175           -- (2) then do the thing inside.
 176         ; bindPatSigTyVarsFV (collectSigTysFromPats pats) $
 177           rnLPatsAndThen matchNameMaker pats    $
 178           thing_inside }
 179   where
 180     doc_pat = ptext SLIT("In") <+> pprMatchContext ctxt
 181
 182
 183 -- entry point 2:
 184 -- binds local names; in a recursive scope that involves other bound vars
 185 --      e.g let { (x, Just y) = e1; ... } in ...
 186 --   does NOT allows type sig to bind type vars
 187 --   local namemaker
 188 --   no unused and duplicate checking
 189 --   fixities might be coming in
 190 rnBindPat :: NameMaker
 191           -> LPat RdrName
 192           -> RnM (LPat Name,
 193                        -- free variables of the pattern,
 194                        -- but not including variables bound by this pattern
 195                    FreeVars)
 196
 197 rnBindPat name_maker pat
 198   = rnLPatsAndThen name_maker [pat] $ \ [pat'] ->
 199     return (pat', emptyFVs)
 200
 201
 202 -- general version: parametrized by how you make new names
 203 -- invariant: what-to-do continuation only gets called with a list whose length is the same as
 204 --            the part of the pattern we're currently renaming
 205 rnLPatsAndThen :: NameMaker -- how to make a new variable
 206                -> [LPat RdrName]   -- part of pattern we're currently renaming
 207                -> ([LPat Name] -> RnM (a, FreeVars)) -- what to do afterwards
 208                -> RnM (a, FreeVars) -- renaming of the whole thing
 209
 210 rnLPatsAndThen var = mapFvRnCPS (rnLPatAndThen var)
 211
 212
 213 -- the workhorse
 214 rnLPatAndThen :: NameMaker
 215               -> LPat RdrName   -- part of pattern we're currently renaming
 216               -> (LPat Name -> RnM (a, FreeVars)) -- what to do afterwards
 217               -> RnM (a, FreeVars) -- renaming of the whole thing
 218 rnLPatAndThen var@(NM varf) (L loc p) cont =
 219     setSrcSpan loc $
 220       let reloc = L loc
 221           lcont = \ unlocated -> cont (reloc unlocated)
 222       in
 223        case p of
 224          WildPat _   -> lcont (WildPat placeHolderType)
 225
 226          ParPat pat  -> rnLPatAndThen var pat $ \ pat' -> lcont (ParPat pat')
 227          LazyPat pat -> rnLPatAndThen var pat $ \ pat' -> lcont (LazyPat pat')
 228          BangPat pat -> rnLPatAndThen var pat $ \ pat' -> lcont (BangPat pat')
 229
 230          VarPat name ->
 231             varf (reloc name) $ \ newBoundName ->
 232             lcont (VarPat newBoundName)
 233                -- we need to bind pattern variables for view pattern expressions
 234                -- (e.g. in the pattern (x, x -> y) x needs to be bound in the rhs of the tuple)
 235
 236          SigPatIn pat ty ->
 237              doptM Opt_PatternSignatures `thenM` \ patsigs ->
 238              if patsigs
 239              then rnLPatAndThen var pat
 240                       (\ pat' -> do { (ty', fvs1) <- rnHsTypeFVs tvdoc ty
 241                                     ; (res, fvs2) <- lcont (SigPatIn pat' ty')
 242                                     ; return (res, fvs1 `plusFV` fvs2) })
 243              else addErr (patSigErr ty) `thenM_`
 244                   rnLPatAndThen var pat cont
 245            where
 246              tvdoc = text "In a pattern type-signature"
 247
 248          LitPat lit@(HsString s) ->
 249              do ovlStr <- doptM Opt_OverloadedStrings
 250                 if ovlStr
 251                  then rnLPatAndThen var (reloc $ mkNPat (mkHsIsString s placeHolderType) Nothing) cont
 252                  else do { rnLit lit; lcont (LitPat lit) }   -- Same as below
 253
 254          LitPat lit -> do { rnLit lit; lcont (LitPat lit) }
 255
 256          NPat lit mb_neg eq ->
 257            do { (lit', fvs1) <- rnOverLit lit
 258               ; (mb_neg', fvs2) <- case mb_neg of
 259                                      Nothing -> return (Nothing, emptyFVs)
 260                                      Just _  -> do { (neg, fvs) <- lookupSyntaxName negateName
 261                                                    ; return (Just neg, fvs) }
 262               ; (eq', fvs3) <- lookupSyntaxName eqName
 263               ; (res, fvs4) <- lcont (NPat lit' mb_neg' eq')
 264               ; return (res, fvs1 `plusFV` fvs2 `plusFV` fvs3 `plusFV` fvs4) }
 265                 -- Needed to find equality on pattern
 266
 267          NPlusKPat name lit _ _ ->
 268            varf name $ \ new_name ->
 269            do { (lit', fvs1) <- rnOverLit lit
 270               ; (minus, fvs2) <- lookupSyntaxName minusName
 271               ; (ge, fvs3) <- lookupSyntaxName geName
 272               ; (res, fvs4) <- lcont (NPlusKPat (L (nameSrcSpan new_name) new_name) lit' ge minus)
 273               ; return (res, fvs1 `plusFV` fvs2 `plusFV` fvs3 `plusFV` fvs4) }
 274                 -- The Report says that n+k patterns must be in Integral
 275
 276          AsPat name pat ->
 277            varf name $ \ new_name ->
 278            rnLPatAndThen var pat $ \ pat' ->
 279            lcont (AsPat (L (nameSrcSpan new_name) new_name) pat')
 280
 281          ViewPat expr pat ty ->
 282            do { vp_flag <- doptM Opt_ViewPatterns
 283               ; checkErr vp_flag (badViewPat p)
 284                 -- because of the way we're arranging the recursive calls,
 285                 -- this will be in the right context
 286               ; (expr', fv_expr) <- rnLExpr expr
 287               ; (res, fvs_res) <- rnLPatAndThen var pat $ \ pat' ->
 288                                   lcont (ViewPat expr' pat' ty)
 289               ; return (res, fvs_res `plusFV` fv_expr) }
 290
 291          ConPatIn con stuff ->
 292              -- rnConPatAndThen takes care of reconstructing the pattern
 293              rnConPatAndThen var con stuff cont
 294
 295          ListPat pats _ ->
 296            rnLPatsAndThen var pats $ \ patslist ->
 297                lcont (ListPat patslist placeHolderType)
 298
 299          PArrPat pats _ ->
 300            do { (res, res_fvs) <- rnLPatsAndThen var pats $ \ patslist ->
 301                                   lcont (PArrPat patslist placeHolderType)
 302               ; return (res, res_fvs `plusFV` implicit_fvs) }
 303            where
 304              implicit_fvs = mkFVs [lengthPName, indexPName]
 305
 306          TuplePat pats boxed _ ->
 307            do { checkTupSize (length pats)
 308               ; rnLPatsAndThen var pats $ \ patslist ->
 309                 lcont (TuplePat patslist boxed placeHolderType) }
 310
 311          TypePat name ->
 312            do { (name', fvs1) <- rnHsTypeFVs (text "In a type pattern") name
 313               ; (res, fvs2) <- lcont (TypePat name')
 314               ; return (res, fvs1 `plusFV` fvs2) }
 315
 316
 317 -- helper for renaming constructor patterns
 318 rnConPatAndThen :: NameMaker
 319                 -> Located RdrName          -- the constructor
 320                 -> HsConPatDetails RdrName
 321                 -> (LPat Name -> RnM (a, FreeVars)) -- what to do afterwards
 322                 -> RnM (a, FreeVars)
 323
 324 rnConPatAndThen var (con@(L loc _)) (PrefixCon pats) cont
 325   = do  { con' <- lookupLocatedOccRn con
 326         ; (res, res_fvs) <- rnLPatsAndThen var pats $ \ pats' ->
 327                             cont (L loc $ ConPatIn con' (PrefixCon pats'))
 328         ; return (res, res_fvs `addOneFV` unLoc con') }
 329
 330 rnConPatAndThen var (con@(L loc _)) (InfixCon pat1 pat2) cont
 331   = do  { con' <- lookupLocatedOccRn con
 332         ; (res, res_fvs) <- rnLPatAndThen var pat1 $ \ pat1' ->
 333                             rnLPatAndThen var pat2 $ \ pat2' ->
 334                             do { fixity <- lookupFixityRn (unLoc con')
 335                                ; pat' <- mkConOpPatRn con' fixity pat1' pat2'
 336                                ; cont (L loc pat') }
 337         ; return (res, res_fvs `addOneFV` unLoc con') }
 338
 339 rnConPatAndThen var (con@(L loc _)) (RecCon rpats) cont
 340   = do  { con' <- lookupLocatedOccRn con
 341         ; (res, res_fvs) <- rnHsRecFieldsAndThen_Pattern con' var rpats $ \ rpats' ->
 342                             cont (L loc $ ConPatIn con' (RecCon rpats'))
 343         ; return (res, res_fvs `addOneFV` unLoc con') }
 344
 345 -- what kind of record expression we're doing
 346 -- the first two tell the name of the datatype constructor in question
 347 -- and give a way of creating a variable to fill in a ..
 348 data RnHsRecFieldsChoice a = Constructor (Located Name) (RdrName -> a)
 349                            | Pattern  (Located Name) (RdrName -> a)
 350                            | Update
 351
 352 choiceToMessage (Constructor _ _) = "construction"
 353 choiceToMessage (Pattern _ _) = "pattern"
 354 choiceToMessage Update = "update"
 355
 356 doDotDot (Constructor a b) = Just (a,b)
 357 doDotDot (Pattern a b) = Just (a,b)
 358 doDotDot Update        = Nothing
 359
 360 getChoiceName (Constructor n _) = Just n
 361 getChoiceName (Pattern n _) = Just n
 362 getChoiceName (Update) = Nothing
 363
 364
 365
 366 -- helper for renaming record patterns;
 367 -- parameterized so that it can also be used for expressions
 368 rnHsRecFieldsAndThen :: RnHsRecFieldsChoice field
 369                      -- how to rename the fields (CPSed)
 370                      -> (Located field -> (Located field' -> RnM (c, FreeVars))
 371                                        -> RnM (c, FreeVars))
 372                      -- the actual fields
 373                      -> HsRecFields RdrName (Located field)
 374                      -- what to do in the scope of the field vars
 375                      -> (HsRecFields Name (Located field') -> RnM (c, FreeVars))
 376                      -> RnM (c, FreeVars)
 377 -- Haddock comments for record fields are renamed to Nothing here
 378 rnHsRecFieldsAndThen choice rn_thing (HsRecFields fields dd) cont =
 379     let
 380
 381         -- helper to collect and report duplicate record fields
 382         reportDuplicateFields doingstr fields =
 383             let
 384                 -- each list represents a RdrName that occurred more than once
 385                 -- (the list contains all occurrences)
 386                 -- invariant: each list in dup_fields is non-empty
 387                 dup_fields :: [[RdrName]]
 388                 (_, dup_fields) = removeDups compare
 389                                                  (map (unLoc . hsRecFieldId) fields)
 390
 391                 -- duplicate field reporting function
 392                 field_dup_err dup_group = addErr (dupFieldErr doingstr (head dup_group))
 393             in
 394               mappM_ field_dup_err dup_fields
 395
 396         -- helper to rename each field
 397         rn_field pun_ok (HsRecField field inside pun) cont = do
 398           fieldname <- lookupRecordBndr (getChoiceName choice) field
 399           checkErr (not pun || pun_ok) (badPun field)
 400           (res, res_fvs) <- rn_thing inside $ \ inside' ->
 401                             cont (HsRecField fieldname inside' pun)
 402           return (res, res_fvs `addOneFV` unLoc fieldname)
 403
 404         -- Compute the extra fields to be filled in by the dot-dot notation
 405         dot_dot_fields fs con mk_field cont = do
 406             con_fields <- lookupConstructorFields (unLoc con)
 407             let missing_fields = con_fields `minusList` fs
 408             loc <- getSrcSpanM  -- Rather approximate
 409             -- it's important that we make the RdrName fields that we morally wrote
 410             -- and then rename them in the usual manner
 411             -- (rather than trying to make the result of renaming directly)
 412             -- because, for patterns, renaming can bind vars in the continuation
 413             mapFvRnCPS rn_thing
 414              (map (L loc . mk_field . mkRdrUnqual . getOccName) missing_fields) $
 415               \ rhss ->
 416                   let new_fs = [ HsRecField (L loc f) r False
 417                                  | (f, r) <- missing_fields `zip` rhss ]
 418                   in
 419                   cont new_fs
 420
 421    in do
 422        -- report duplicate fields
 423        let doingstr = choiceToMessage choice
 424        reportDuplicateFields doingstr fields
 425
 426        -- rename the records as written
 427        -- check whether punning (implicit x=x) is allowed
 428        pun_flag <- doptM Opt_RecordPuns
 429        -- rename the fields
 430        mapFvRnCPS (rn_field pun_flag) fields $ \ fields1 ->
 431
 432            -- handle ..
 433            case dd of
 434              Nothing -> cont (HsRecFields fields1 dd)
 435              Just n  -> ASSERT( n == length fields ) do
 436                           dd_flag <- doptM Opt_RecordWildCards
 437                           checkErr dd_flag (needFlagDotDot doingstr)
 438                           let fld_names1 = map (unLoc . hsRecFieldId) fields1
 439                           case doDotDot choice of
 440                                 Nothing -> addErr (badDotDot doingstr) `thenM_`
 441                                            -- we return a junk value here so that error reporting goes on
 442                                            cont (HsRecFields fields1 dd)
 443                                 Just (con, mk_field) ->
 444                                     dot_dot_fields fld_names1 con mk_field $
 445                                       \ fields2 ->
 446                                           cont (HsRecFields (fields1 ++ fields2) dd)
 447
 448 needFlagDotDot str = vcat [ptext SLIT("Illegal `..' in record") <+> text str,
 449                           ptext SLIT("Use -XRecordWildCards to permit this")]
 450
 451 badDotDot str = ptext SLIT("You cannot use `..' in record") <+> text str
 452
 453 badPun fld = vcat [ptext SLIT("Illegal use of punning for field") <+> quotes (ppr fld),
 454                    ptext SLIT("Use -XRecordPuns to permit this")]
 455
 456
 457 -- wrappers
 458 rnHsRecFieldsAndThen_Pattern :: Located Name
 459                              -> NameMaker -- new name maker
 460                              -> HsRecFields RdrName (LPat RdrName)
 461                              -> (HsRecFields Name (LPat Name) -> RnM (c, FreeVars))
 462                              -> RnM (c, FreeVars)
 463 rnHsRecFieldsAndThen_Pattern n var
 464   = rnHsRecFieldsAndThen (Pattern n VarPat) (rnLPatAndThen var)
 465
 466
 467 -- wrapper to use rnLExpr in CPS style;
 468 -- because it does not bind any vars going forward, it does not need
 469 -- to be written that way
 470 rnLExprAndThen :: (LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars))
 471                -> LHsExpr RdrName
 472                -> (LHsExpr Name -> RnM (c, FreeVars))
 473                -> RnM (c, FreeVars)
 474 rnLExprAndThen f e cont = do { (x, fvs1) <- f e
 475                              ; (res, fvs2) <- cont x
 476                              ; return (res, fvs1 `plusFV` fvs2) }
 477
 478
 479 -- non-CPSed because exprs don't leave anything bound
 480 rnHsRecFields_Con :: Located Name
 481                   -> (LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars))
 482                   -> HsRecFields RdrName (LHsExpr RdrName)
 483                   -> RnM (HsRecFields Name (LHsExpr Name), FreeVars)
 484 rnHsRecFields_Con n rnLExpr fields = rnHsRecFieldsAndThen (Constructor n HsVar)
 485                                      (rnLExprAndThen rnLExpr) fields $ \ res ->
 486                                      return (res, emptyFVs)
 487
 488 rnHsRecFields_Update :: (LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars))
 489                      -> HsRecFields RdrName (LHsExpr RdrName)
 490                      -> RnM (HsRecFields Name (LHsExpr Name), FreeVars)
 491 rnHsRecFields_Update rnLExpr fields = rnHsRecFieldsAndThen Update
 492                                       (rnLExprAndThen rnLExpr) fields $ \ res ->
 493                                       return (res, emptyFVs)
 494 \end{code}
 495
 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 placeHolderType, 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 placeHolderType, 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 placeHolderType, fvs `plusFV` extra_fvs)
 540
 541 rnOverLit (HsIsString s _ _)
 542   = lookupSyntaxName fromStringName     `thenM` \ (from_string_name, fvs) ->
 543         returnM (HsIsString s from_string_name placeHolderType, fvs)
 544 \end{code}
 545
 546
 547 %************************************************************************
 548 %*                                                                      *
 549 \subsubsection{Errors}
 550 %*                                                                      *
 551 %************************************************************************
 552
 553 \begin{code}
 554 checkTupSize :: Int -> RnM ()
 555 checkTupSize tup_size
 556   | tup_size <= mAX_TUPLE_SIZE
 557   = returnM ()
 558   | otherwise
 559   = addErr (sep [ptext SLIT("A") <+> int tup_size <> ptext SLIT("-tuple is too large for GHC"),
 560                  nest 2 (parens (ptext SLIT("max size is") <+> int mAX_TUPLE_SIZE)),
 561                  nest 2 (ptext SLIT("Workaround: use nested tuples or define a data type"))])
 562
 563 patSigErr ty
 564   =  (ptext SLIT("Illegal signature in pattern:") <+> ppr ty)
 565         $$ nest 4 (ptext SLIT("Use -XPatternSignatures to permit it"))
 566
 567 dupFieldErr str dup
 568   = hsep [ptext SLIT("duplicate field name"),
 569           quotes (ppr dup),
 570           ptext SLIT("in record"), text str]
 571
 572 bogusCharError c
 573   = ptext SLIT("character literal out of range: '\\") <> char c  <> char '\''
 574
 575 badViewPat pat = vcat [ptext SLIT("Illegal view pattern: ") <+> ppr pat,
 576                        ptext SLIT("Use -XViewPatterns to enalbe view patterns")]
 577
 578 \end{code}