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 module RnPat (-- main entry points
  14               rnPats, rnBindPat,
  15
  16               NameMaker, applyNameMaker,     -- a utility for making names:
  17               localRecNameMaker, topRecNameMaker,  --   sometimes we want to make local names,
  18                                              --   sometimes we want to make top (qualified) names.
  19
  20               rnHsRecFields1, HsRecFieldContext(..),
  21
  22               -- Literals
  23               rnLit, rnOverLit,
  24
  25               -- Quasiquotation
  26               rnQuasiQuote,
  27
  28              -- Pattern Error messages that are also used elsewhere
  29              checkTupSize, patSigErr
  30              ) where
  31
  32 -- ENH: thin imports to only what is necessary for patterns
  33
  34 import {-# SOURCE #-} RnExpr ( rnLExpr )
  35 #ifdef GHCI
  36 import {-# SOURCE #-} TcSplice ( runQuasiQuotePat )
  37 #endif  /* GHCI */
  38
  39 #include "HsVersions.h"
  40
  41 import HsSyn
  42 import TcRnMonad
  43 import TcHsSyn          ( hsOverLitName )
  44 import RnEnv
  45 import RnTypes
  46 import DynFlags         ( DynFlag(..) )
  47 import PrelNames
  48 import Constants        ( mAX_TUPLE_SIZE )
  49 import Name
  50 import NameSet
  51 import Module
  52 import RdrName
  53 import ListSetOps       ( removeDups, minusList )
  54 import Outputable
  55 import SrcLoc
  56 import FastString
  57 import Literal          ( inCharRange )
  58 import Control.Monad    ( when )
  59 \end{code}
  60
  61
  62 %*********************************************************
  63 %*                                                      *
  64         The CpsRn Monad
  65 %*                                                      *
  66 %*********************************************************
  67
  68 Note [CpsRn monad]
  69 ~~~~~~~~~~~~~~~~~~
  70 The CpsRn monad uses continuation-passing style to support this
  71 style of programming:
  72
  73         do { ...
  74            ; ns <- bindNames rs
  75            ; ...blah... }
  76
  77    where rs::[RdrName], ns::[Name]
  78
  79 The idea is that '...blah...'
  80   a) sees the bindings of ns
  81   b) returns the free variables it mentions
  82      so that bindNames can report unused ones
  83
  84 In particular,
  85     mapM rnPatAndThen [p1, p2, p3]
  86 has a *left-to-right* scoping: it makes the binders in
  87 p1 scope over p2,p3.
  88
  89 \begin{code}
  90 newtype CpsRn b = CpsRn { unCpsRn :: forall r. (b -> RnM (r, FreeVars))
  91                                             -> RnM (r, FreeVars) }
  92         -- See Note [CpsRn monad]
  93
  94 instance Monad CpsRn where
  95   return x = CpsRn (\k -> k x)
  96   (CpsRn m) >>= mk = CpsRn (\k -> m (\v -> unCpsRn (mk v) k))
  97
  98 runCps :: CpsRn a -> RnM (a, FreeVars)
  99 runCps (CpsRn m) = m (\r -> return (r, emptyFVs))
 100
 101 liftCps :: RnM a -> CpsRn a
 102 liftCps rn_thing = CpsRn (\k -> rn_thing >>= k)
 103
 104 liftCpsFV :: RnM (a, FreeVars) -> CpsRn a
 105 liftCpsFV rn_thing = CpsRn (\k -> do { (v,fvs1) <- rn_thing
 106                                      ; (r,fvs2) <- k v
 107                                      ; return (r, fvs1 `plusFV` fvs2) })
 108
 109 wrapSrcSpanCps :: (a -> CpsRn b) -> Located a -> CpsRn (Located b)
 110 -- Set the location, and also wrap it around the value returned
 111 wrapSrcSpanCps fn (L loc a)
 112   = CpsRn (\k -> setSrcSpan loc $
 113                  unCpsRn (fn a) $ \v ->
 114                  k (L loc v))
 115
 116 lookupConCps :: Located RdrName -> CpsRn (Located Name)
 117 lookupConCps con_rdr
 118   = CpsRn (\k -> do { con_name <- lookupLocatedOccRn con_rdr
 119                     ; (r, fvs) <- k con_name
 120                     ; return (r, fvs `plusFV` unitFV (unLoc con_name)) })
 121 \end{code}
 122
 123 %*********************************************************
 124 %*                                                      *
 125         Name makers
 126 %*                                                      *
 127 %*********************************************************
 128
 129 Externally abstract type of name makers,
 130 which is how you go from a RdrName to a Name
 131
 132 \begin{code}
 133 data NameMaker
 134   = LamMk       -- Lambdas
 135       Bool      -- True <=> report unused bindings
 136                 --   (even if True, the warning only comes out
 137                 --    if -fwarn-unused-matches is on)
 138
 139   | LetMk       -- Let bindings, incl top level
 140                 -- Do *not* check for unused bindings
 141       (Maybe Module)   -- Just m  => top level of module m
 142                        -- Nothing => not top level
 143       MiniFixityEnv
 144
 145 topRecNameMaker :: Module -> MiniFixityEnv -> NameMaker
 146 topRecNameMaker mod fix_env = LetMk (Just mod) fix_env
 147
 148 localRecNameMaker :: MiniFixityEnv -> NameMaker
 149 localRecNameMaker fix_env = LetMk Nothing fix_env
 150
 151 matchNameMaker :: HsMatchContext a -> NameMaker
 152 matchNameMaker ctxt = LamMk report_unused
 153   where
 154     -- Do not report unused names in interactive contexts
 155     -- i.e. when you type 'x <- e' at the GHCi prompt
 156     report_unused = case ctxt of
 157                       StmtCtxt GhciStmt -> False
 158                       _                 -> True
 159
 160 newName :: NameMaker -> Located RdrName -> CpsRn Name
 161 newName (LamMk report_unused) rdr_name
 162   = CpsRn (\ thing_inside ->
 163         do { name <- newLocalBndrRn rdr_name
 164            ; (res, fvs) <- bindLocalName name (thing_inside name)
 165            ; when report_unused $ warnUnusedMatches [name] fvs
 166            ; return (res, name `delFV` fvs) })
 167
 168 newName (LetMk mb_top fix_env) rdr_name
 169   = CpsRn (\ thing_inside ->
 170         do { name <- case mb_top of
 171                        Nothing  -> newLocalBndrRn rdr_name
 172                        Just mod -> newTopSrcBinder mod rdr_name
 173            ; bindLocalNamesFV_WithFixities [name] fix_env $
 174              thing_inside name })
 175
 176     -- Note: the bindLocalNamesFV_WithFixities is somewhat suspicious
 177     --       because it binds a top-level name as a local name.
 178     --       however, this binding seems to work, and it only exists for
 179     --       the duration of the patterns and the continuation;
 180     --       then the top-level name is added to the global env
 181     --       before going on to the RHSes (see RnSource.lhs).
 182 \end{code}
 183
 184
 185 %*********************************************************
 186 %*                                                      *
 187         External entry points
 188 %*                                                      *
 189 %*********************************************************
 190
 191 There are various entry points to renaming patterns, depending on
 192  (1) whether the names created should be top-level names or local names
 193  (2) whether the scope of the names is entirely given in a continuation
 194      (e.g., in a case or lambda, but not in a let or at the top-level,
 195       because of the way mutually recursive bindings are handled)
 196  (3) whether the a type signature in the pattern can bind
 197         lexically-scoped type variables (for unpacking existential
 198         type vars in data constructors)
 199  (4) whether we do duplicate and unused variable checking
 200  (5) whether there are fixity declarations associated with the names
 201      bound by the patterns that need to be brought into scope with them.
 202
 203  Rather than burdening the clients of this module with all of these choices,
 204  we export the three points in this design space that we actually need:
 205
 206 \begin{code}
 207 -- ----------- Entry point 1: rnPats -------------------
 208 -- Binds local names; the scope of the bindings is entirely in the thing_inside
 209 --   * allows type sigs to bind type vars
 210 --   * local namemaker
 211 --   * unused and duplicate checking
 212 --   * no fixities
 213 rnPats :: HsMatchContext Name -- for error messages
 214        -> [LPat RdrName]
 215        -> ([LPat Name] -> RnM (a, FreeVars))
 216        -> RnM (a, FreeVars)
 217 rnPats ctxt pats thing_inside
 218   = do  { envs_before <- getRdrEnvs
 219
 220           -- (0) bring into scope all of the type variables bound by the patterns
 221           -- (1) rename the patterns, bringing into scope all of the term variables
 222           -- (2) then do the thing inside.
 223         ; bindPatSigTyVarsFV (collectSigTysFromPats pats)     $
 224           unCpsRn (rnLPatsAndThen (matchNameMaker ctxt) pats) $ \ pats' -> do
 225         { -- Check for duplicated and shadowed names
 226                  -- Because we don't bind the vars all at once, we can't
 227                  --     check incrementally for duplicates;
 228                  -- Nor can we check incrementally for shadowing, else we'll
 229                  --     complain *twice* about duplicates e.g. f (x,x) = ...
 230         ; let names = collectPatsBinders pats'
 231         ; addErrCtxt doc_pat $ checkDupAndShadowedNames envs_before names
 232         ; thing_inside pats' } }
 233   where
 234     doc_pat = ptext (sLit "In") <+> pprMatchContext ctxt
 235
 236
 237 applyNameMaker :: NameMaker -> Located RdrName -> RnM Name
 238 applyNameMaker mk rdr = do { (n, _fvs) <- runCps (newName mk rdr); return n }
 239
 240 -- ----------- Entry point 2: rnBindPat -------------------
 241 -- Binds local names; in a recursive scope that involves other bound vars
 242 --      e.g let { (x, Just y) = e1; ... } in ...
 243 --   * does NOT allows type sig to bind type vars
 244 --   * local namemaker
 245 --   * no unused and duplicate checking
 246 --   * fixities might be coming in
 247 rnBindPat :: NameMaker
 248           -> LPat RdrName
 249           -> RnM (LPat Name, FreeVars)
 250    -- Returned FreeVars are the free variables of the pattern,
 251    -- of course excluding variables bound by this pattern
 252
 253 rnBindPat name_maker pat = runCps (rnLPatAndThen name_maker pat)
 254 \end{code}
 255
 256
 257 %*********************************************************
 258 %*                                                      *
 259         The main event
 260 %*                                                      *
 261 %*********************************************************
 262
 263 \begin{code}
 264 -- ----------- Entry point 3: rnLPatAndThen -------------------
 265 -- General version: parametrized by how you make new names
 266
 267 rnLPatsAndThen :: NameMaker -> [LPat RdrName] -> CpsRn [LPat Name]
 268 rnLPatsAndThen mk = mapM (rnLPatAndThen mk)
 269   -- Despite the map, the monad ensures that each pattern binds
 270   -- variables that may be mentioned in subsequent patterns in the list
 271
 272 --------------------
 273 -- The workhorse
 274 rnLPatAndThen :: NameMaker -> LPat RdrName -> CpsRn (LPat Name)
 275 rnLPatAndThen nm lpat = wrapSrcSpanCps (rnPatAndThen nm) lpat
 276
 277 rnPatAndThen :: NameMaker -> Pat RdrName -> CpsRn (Pat Name)
 278 rnPatAndThen _  (WildPat _)   = return (WildPat placeHolderType)
 279 rnPatAndThen mk (ParPat pat)  = do { pat' <- rnLPatAndThen mk pat; return (ParPat pat') }
 280 rnPatAndThen mk (LazyPat pat) = do { pat' <- rnLPatAndThen mk pat; return (LazyPat pat') }
 281 rnPatAndThen mk (BangPat pat) = do { pat' <- rnLPatAndThen mk pat; return (BangPat pat') }
 282 rnPatAndThen mk (VarPat rdr)  = do { loc <- liftCps getSrcSpanM
 283                                    ; name <- newName mk (L loc rdr)
 284                                    ; return (VarPat name) }
 285      -- we need to bind pattern variables for view pattern expressions
 286      -- (e.g. in the pattern (x, x -> y) x needs to be bound in the rhs of the tuple)
 287
 288 rnPatAndThen mk (SigPatIn pat ty)
 289   = do { patsigs <- liftCps (doptM Opt_ScopedTypeVariables)
 290        ; if patsigs
 291          then do { pat' <- rnLPatAndThen mk pat
 292                  ; ty' <- liftCpsFV (rnHsTypeFVs tvdoc ty)
 293                  ; return (SigPatIn pat' ty') }
 294          else do { liftCps (addErr (patSigErr ty))
 295                  ; rnPatAndThen mk (unLoc pat) } }
 296   where
 297     tvdoc = text "In a pattern type-signature"
 298
 299 rnPatAndThen mk (LitPat lit)
 300   | HsString s <- lit
 301   = do { ovlStr <- liftCps (doptM Opt_OverloadedStrings)
 302        ; if ovlStr
 303          then rnPatAndThen mk (mkNPat (mkHsIsString s placeHolderType) Nothing)
 304          else normal_lit }
 305   | otherwise = normal_lit
 306   where
 307     normal_lit = do { liftCps (rnLit lit); return (LitPat lit) }
 308
 309 rnPatAndThen _ (NPat lit mb_neg _eq)
 310   = do { lit'    <- liftCpsFV $ rnOverLit lit
 311        ; mb_neg' <- liftCpsFV $ case mb_neg of
 312                       Nothing -> return (Nothing, emptyFVs)
 313                       Just _  -> do { (neg, fvs) <- lookupSyntaxName negateName
 314                                     ; return (Just neg, fvs) }
 315        ; eq' <- liftCpsFV $ lookupSyntaxName eqName
 316        ; return (NPat lit' mb_neg' eq') }
 317
 318 rnPatAndThen mk (NPlusKPat rdr lit _ _)
 319   = do { new_name <- newName mk rdr
 320        ; lit'  <- liftCpsFV $ rnOverLit lit
 321        ; minus <- liftCpsFV $ lookupSyntaxName minusName
 322        ; ge    <- liftCpsFV $ lookupSyntaxName geName
 323        ; return (NPlusKPat (L (nameSrcSpan new_name) new_name) lit' ge minus) }
 324                 -- The Report says that n+k patterns must be in Integral
 325
 326 rnPatAndThen mk (AsPat rdr pat)
 327   = do { new_name <- newName mk rdr
 328        ; pat' <- rnLPatAndThen mk pat
 329        ; return (AsPat (L (nameSrcSpan new_name) new_name) pat') }
 330
 331 rnPatAndThen mk p@(ViewPat expr pat ty)
 332   = do { liftCps $ do { vp_flag <- doptM Opt_ViewPatterns
 333                       ; checkErr vp_flag (badViewPat p) }
 334          -- Because of the way we're arranging the recursive calls,
 335          -- this will be in the right context
 336        ; expr' <- liftCpsFV $ rnLExpr expr
 337        ; pat' <- rnLPatAndThen mk pat
 338        ; return (ViewPat expr' pat' ty) }
 339
 340 rnPatAndThen mk (ConPatIn con stuff)
 341    -- rnConPatAndThen takes care of reconstructing the pattern
 342   = rnConPatAndThen mk con stuff
 343
 344 rnPatAndThen mk (ListPat pats _)
 345   = do { pats' <- rnLPatsAndThen mk pats
 346        ; return (ListPat pats' placeHolderType) }
 347
 348 rnPatAndThen mk (PArrPat pats _)
 349   = do { pats' <- rnLPatsAndThen mk pats
 350        ; return (PArrPat pats' placeHolderType) }
 351
 352 rnPatAndThen mk (TuplePat pats boxed _)
 353   = do { liftCps $ checkTupSize (length pats)
 354        ; pats' <- rnLPatsAndThen mk pats
 355        ; return (TuplePat pats' boxed placeHolderType) }
 356
 357 rnPatAndThen _ (TypePat ty)
 358   = do { ty' <- liftCpsFV $ rnHsTypeFVs (text "In a type pattern") ty
 359        ; return (TypePat ty') }
 360
 361 #ifndef GHCI
 362 rnPatAndThen _ p@(QuasiQuotePat {})
 363   = pprPanic "Can't do QuasiQuotePat without GHCi" (ppr p)
 364 #else
 365 rnPatAndThen mk (QuasiQuotePat qq)
 366   = do { qq' <- liftCpsFV $ rnQuasiQuote qq
 367        ; pat <- liftCps $ runQuasiQuotePat qq'
 368        ; L _ pat' <- rnLPatAndThen mk pat
 369        ; return pat' }
 370 #endif  /* GHCI */
 371
 372 rnPatAndThen _ pat = pprPanic "rnLPatAndThen" (ppr pat)
 373
 374
 375 --------------------
 376 rnConPatAndThen :: NameMaker
 377                 -> Located RdrName          -- the constructor
 378                 -> HsConPatDetails RdrName
 379                 -> CpsRn (Pat Name)
 380
 381 rnConPatAndThen mk con (PrefixCon pats)
 382   = do  { con' <- lookupConCps con
 383         ; pats' <- rnLPatsAndThen mk pats
 384         ; return (ConPatIn con' (PrefixCon pats')) }
 385
 386 rnConPatAndThen mk con (InfixCon pat1 pat2)
 387   = do  { con' <- lookupConCps con
 388         ; pat1' <- rnLPatAndThen mk pat1
 389         ; pat2' <- rnLPatAndThen mk pat2
 390         ; fixity <- liftCps $ lookupFixityRn (unLoc con')
 391         ; liftCps $ mkConOpPatRn con' fixity pat1' pat2' }
 392
 393 rnConPatAndThen mk con (RecCon rpats)
 394   = do  { con' <- lookupConCps con
 395         ; rpats' <- rnHsRecPatsAndThen mk con' rpats
 396         ; return (ConPatIn con' (RecCon rpats')) }
 397
 398 --------------------
 399 rnHsRecPatsAndThen :: NameMaker
 400                    -> Located Name      -- Constructor
 401                    -> HsRecFields RdrName (LPat RdrName)
 402                    -> CpsRn (HsRecFields Name (LPat Name))
 403 rnHsRecPatsAndThen mk (L _ con) hs_rec_fields@(HsRecFields { rec_dotdot = dd })
 404   = do { flds <- liftCpsFV $ rnHsRecFields1 (HsRecFieldPat con) VarPat hs_rec_fields
 405        ; flds' <- mapM rn_field (flds `zip` [1..])
 406        ; return (HsRecFields { rec_flds = flds', rec_dotdot = dd }) }
 407   where
 408     rn_field (fld, n') = do { arg' <- rnLPatAndThen (nested_mk dd mk n')
 409                                                     (hsRecFieldArg fld)
 410                             ; return (fld { hsRecFieldArg = arg' }) }
 411
 412         -- Suppress unused-match reporting for fields introduced by ".."
 413     nested_mk Nothing  mk                    _  = mk
 414     nested_mk (Just _) mk@(LetMk {})         _  = mk
 415     nested_mk (Just n) (LamMk report_unused) n' = LamMk (report_unused && (n' <= n))
 416 \end{code}
 417
 418
 419 %************************************************************************
 420 %*                                                                      *
 421         Record fields
 422 %*                                                                      *
 423 %************************************************************************
 424
 425 \begin{code}
 426 data HsRecFieldContext
 427   = HsRecFieldCon Name
 428   | HsRecFieldPat Name
 429   | HsRecFieldUpd
 430
 431 rnHsRecFields1
 432     :: HsRecFieldContext
 433     -> (RdrName -> arg) -- When punning, use this to build a new field
 434     -> HsRecFields RdrName (Located arg)
 435     -> RnM ([HsRecField Name (Located arg)], FreeVars)
 436
 437 -- This supprisingly complicated pass
 438 --   a) looks up the field name (possibly using disambiguation)
 439 --   b) fills in puns and dot-dot stuff
 440 -- When we we've finished, we've renamed the LHS, but not the RHS,
 441 -- of each x=e binding
 442
 443 rnHsRecFields1 ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
 444   = do { pun_ok      <- doptM Opt_RecordPuns
 445        ; disambig_ok <- doptM Opt_DisambiguateRecordFields
 446        ; parent <- check_disambiguation disambig_ok mb_con
 447        ; flds1 <- mapM (rn_fld pun_ok parent) flds
 448        ; mapM_ (addErr . dupFieldErr ctxt) dup_flds
 449        ; flds2 <- rn_dotdot dotdot mb_con flds1
 450        ; return (flds2, mkFVs (getFieldIds flds2)) }
 451   where
 452     mb_con = case ctxt of
 453                 HsRecFieldUpd     -> Nothing
 454                 HsRecFieldCon con -> Just con
 455                 HsRecFieldPat con -> Just con
 456     doc = case mb_con of
 457             Nothing  -> ptext (sLit "constructor field name")
 458             Just con -> ptext (sLit "field of constructor") <+> quotes (ppr con)
 459
 460     name_to_arg (L loc n) = L loc (mk_arg (mkRdrUnqual (nameOccName n)))
 461
 462     rn_fld pun_ok parent (HsRecField { hsRecFieldId = fld
 463                                      , hsRecFieldArg = arg
 464                                      , hsRecPun = pun })
 465       = do { fld' <- wrapLocM (lookupSubBndr parent doc) fld
 466            ; arg' <- if pun
 467                      then do { checkErr pun_ok (badPun fld)
 468                              ; return (name_to_arg fld') }
 469                      else return arg
 470            ; return (HsRecField { hsRecFieldId = fld'
 471                                 , hsRecFieldArg = arg'
 472                                 , hsRecPun = pun }) }
 473
 474     rn_dotdot Nothing _mb_con flds     -- No ".." at all
 475       = return flds
 476     rn_dotdot (Just {}) Nothing flds   -- ".." on record update
 477       = do { addErr (badDotDot ctxt); return flds }
 478     rn_dotdot (Just n) (Just con) flds -- ".." on record con/pat
 479       = ASSERT( n == length flds )
 480         do { loc <- getSrcSpanM -- Rather approximate
 481            ; dd_flag <- doptM Opt_RecordWildCards
 482            ; checkErr dd_flag (needFlagDotDot ctxt)
 483
 484            ; con_fields <- lookupConstructorFields con
 485            ; let present_flds = getFieldIds flds
 486                  absent_flds  = con_fields `minusList` present_flds
 487                  extras = [ HsRecField
 488                               { hsRecFieldId = L loc f
 489                               , hsRecFieldArg = name_to_arg (L loc f)
 490                               , hsRecPun = False }
 491                           | f <- absent_flds ]
 492
 493            ; return (flds ++ extras) }
 494
 495     check_disambiguation :: Bool -> Maybe Name -> RnM Parent
 496     -- When disambiguation is on, return the parent *type constructor*
 497     -- That is, the parent of the data constructor.  That's the parent
 498     -- to use for looking up record fields.
 499     check_disambiguation disambig_ok mb_con
 500       | disambig_ok, Just con <- mb_con
 501       = do { env <- getGlobalRdrEnv
 502            ; return (case lookupGRE_Name env con of
 503                        [gre] -> gre_par gre
 504                        gres  -> WARN( True, ppr con <+> ppr gres ) NoParent) }
 505       | otherwise = return NoParent
 506
 507     dup_flds :: [[RdrName]]
 508         -- Each list represents a RdrName that occurred more than once
 509         -- (the list contains all occurrences)
 510         -- Each list in dup_fields is non-empty
 511     (_, dup_flds) = removeDups compare (getFieldIds flds)
 512
 513 getFieldIds :: [HsRecField id arg] -> [id]
 514 getFieldIds flds = map (unLoc . hsRecFieldId) flds
 515
 516 needFlagDotDot :: HsRecFieldContext -> SDoc
 517 needFlagDotDot ctxt = vcat [ptext (sLit "Illegal `..' in record") <+> pprRFC ctxt,
 518                             ptext (sLit "Use -XRecordWildCards to permit this")]
 519
 520 badDotDot :: HsRecFieldContext -> SDoc
 521 badDotDot ctxt = ptext (sLit "You cannot use `..' in a record") <+> pprRFC ctxt
 522
 523 badPun :: Located RdrName -> SDoc
 524 badPun fld = vcat [ptext (sLit "Illegal use of punning for field") <+> quotes (ppr fld),
 525                    ptext (sLit "Use -XNamedFieldPuns to permit this")]
 526
 527 dupFieldErr :: HsRecFieldContext -> [RdrName] -> SDoc
 528 dupFieldErr ctxt dups
 529   = hsep [ptext (sLit "duplicate field name"),
 530           quotes (ppr (head dups)),
 531           ptext (sLit "in record"), pprRFC ctxt]
 532
 533 pprRFC :: HsRecFieldContext -> SDoc
 534 pprRFC (HsRecFieldCon {}) = ptext (sLit "construction")
 535 pprRFC (HsRecFieldPat {}) = ptext (sLit "pattern")
 536 pprRFC (HsRecFieldUpd {}) = ptext (sLit "update")
 537 \end{code}
 538
 539
 540 %************************************************************************
 541 %*                                                                      *
 542 \subsubsection{Literals}
 543 %*                                                                      *
 544 %************************************************************************
 545
 546 When literals occur we have to make sure
 547 that the types and classes they involve
 548 are made available.
 549
 550 \begin{code}
 551 rnLit :: HsLit -> RnM ()
 552 rnLit (HsChar c) = checkErr (inCharRange c) (bogusCharError c)
 553 rnLit _ = return ()
 554
 555 rnOverLit :: HsOverLit t -> RnM (HsOverLit Name, FreeVars)
 556 rnOverLit lit@(OverLit {ol_val=val})
 557   = do  { let std_name = hsOverLitName val
 558         ; (from_thing_name, fvs) <- lookupSyntaxName std_name
 559         ; let rebindable = case from_thing_name of
 560                                 HsVar v -> v /= std_name
 561                                 _       -> panic "rnOverLit"
 562         ; return (lit { ol_witness = from_thing_name
 563                       , ol_rebindable = rebindable }, fvs) }
 564 \end{code}
 565
 566 %************************************************************************
 567 %*                                                                      *
 568 \subsubsection{Quasiquotation}
 569 %*                                                                      *
 570 %************************************************************************
 571
 572 See Note [Quasi-quote overview] in TcSplice.
 573
 574 \begin{code}
 575 rnQuasiQuote :: HsQuasiQuote RdrName -> RnM (HsQuasiQuote Name, FreeVars)
 576 rnQuasiQuote (HsQuasiQuote n quoter quoteSpan quote)
 577   = do  { loc  <- getSrcSpanM
 578         ; n' <- newLocalBndrRn (L loc n)
 579         ; quoter' <- lookupOccRn quoter
 580                 -- If 'quoter' is not in scope, proceed no further
 581                 -- Otherwise lookupOcc adds an error messsage and returns
 582                 -- an "unubound name", which makes the subsequent attempt to
 583                 -- run the quote fail
 584         ; return (HsQuasiQuote n' quoter' quoteSpan quote, unitFV quoter') }
 585 \end{code}
 586
 587 %************************************************************************
 588 %*                                                                      *
 589 \subsubsection{Errors}
 590 %*                                                                      *
 591 %************************************************************************
 592
 593 \begin{code}
 594 checkTupSize :: Int -> RnM ()
 595 checkTupSize tup_size
 596   | tup_size <= mAX_TUPLE_SIZE
 597   = return ()
 598   | otherwise
 599   = addErr (sep [ptext (sLit "A") <+> int tup_size <> ptext (sLit "-tuple is too large for GHC"),
 600                  nest 2 (parens (ptext (sLit "max size is") <+> int mAX_TUPLE_SIZE)),
 601                  nest 2 (ptext (sLit "Workaround: use nested tuples or define a data type"))])
 602
 603 patSigErr :: Outputable a => a -> SDoc
 604 patSigErr ty
 605   =  (ptext (sLit "Illegal signature in pattern:") <+> ppr ty)
 606         $$ nest 4 (ptext (sLit "Use -XScopedTypeVariables to permit it"))
 607
 608 bogusCharError :: Char -> SDoc
 609 bogusCharError c
 610   = ptext (sLit "character literal out of range: '\\") <> char c  <> char '\''
 611
 612 badViewPat :: Pat RdrName -> SDoc
 613 badViewPat pat = vcat [ptext (sLit "Illegal view pattern: ") <+> ppr pat,
 614                        ptext (sLit "Use -XViewPatterns to enable view patterns")]
 615 \end{code}