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               rnPatsAndThen_LocalRightwards, 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               rnHsRecFields_Con, rnHsRecFields_Update, --rename record fields in a constructor
  21                                                        --and in an update
  22
  23               -- Literals
  24               rnLit, rnOverLit,
  25
  26               -- Quasiquotation
  27               rnQuasiQuote,
  28
  29              -- Pattern Error messages that are also used elsewhere
  30              checkTupSize, patSigErr
  31              ) where
  32
  33 -- ENH: thin imports to only what is necessary for patterns
  34
  35 import {-# SOURCE #-} RnExpr ( rnLExpr )
  36 #ifdef GHCI
  37 import {-# SOURCE #-} TcSplice ( runQuasiQuotePat )
  38 #endif  /* GHCI */
  39
  40 #include "HsVersions.h"
  41
  42 import HsSyn
  43 import TcRnMonad
  44 import TcHsSyn          ( hsOverLitName )
  45 import RnEnv
  46 import RnTypes
  47 import DynFlags         ( DynFlag(..) )
  48 import PrelNames
  49 import Constants        ( mAX_TUPLE_SIZE )
  50 import Name
  51 import NameSet
  52 import RdrName
  53 import ListSetOps       ( removeDups, minusList )
  54 import Outputable
  55 import SrcLoc
  56 import FastString
  57 import Literal          ( inCharRange )
  58 \end{code}
  59
  60
  61 %*********************************************************
  62 %*                                                      *
  63 \subsection{Patterns}
  64 %*                                                      *
  65 %*********************************************************
  66
  67 \begin{code}
  68 -- externally abstract type of name makers,
  69 -- which is how you go from a RdrName to a Name
  70 data NameMaker = NM (forall a. Located RdrName -> (Name -> RnM (a, FreeVars))
  71                                                -> RnM (a, FreeVars))
  72
  73 matchNameMaker :: NameMaker
  74 matchNameMaker
  75   = NM (\ rdr_name thing_inside ->
  76         do { names@[name] <- newLocalsRn [rdr_name]
  77            ; bindLocalNamesFV names $ do
  78            { (res, fvs) <- thing_inside name
  79            ; warnUnusedMatches names fvs
  80            ; return (res, fvs) }})
  81
  82 topRecNameMaker, localRecNameMaker
  83   :: MiniFixityEnv -> NameMaker
  84
  85 -- topNameMaker and localBindMaker do not check for unused binding
  86 localRecNameMaker fix_env
  87   = NM (\ rdr_name thing_inside ->
  88         do { [name] <- newLocalsRn [rdr_name]
  89            ; bindLocalNamesFV_WithFixities [name] fix_env $
  90              thing_inside name })
  91
  92 topRecNameMaker fix_env
  93   = NM (\rdr_name thing_inside ->
  94         do { mod <- getModule
  95            ; name <- newTopSrcBinder mod rdr_name
  96            ; bindLocalNamesFV_WithFixities [name] fix_env $
  97              thing_inside name })
  98                 -- Note: the bindLocalNamesFV_WithFixities is somewhat suspicious
  99                 --       because it binds a top-level name as a local name.
 100                 --       however, this binding seems to work, and it only exists for
 101                 --       the duration of the patterns and the continuation;
 102                 --       then the top-level name is added to the global env
 103                 --       before going on to the RHSes (see RnSource.lhs).
 104
 105 applyNameMaker :: NameMaker -> Located RdrName
 106                -> (Name -> RnM (a,FreeVars)) -> RnM (a, FreeVars)
 107 applyNameMaker (NM f) = f
 108
 109
 110 -- There are various entry points to renaming patterns, depending on
 111 --  (1) whether the names created should be top-level names or local names
 112 --  (2) whether the scope of the names is entirely given in a continuation
 113 --      (e.g., in a case or lambda, but not in a let or at the top-level,
 114 --       because of the way mutually recursive bindings are handled)
 115 --  (3) whether the a type signature in the pattern can bind
 116 --      lexically-scoped type variables (for unpacking existential
 117 --      type vars in data constructors)
 118 --  (4) whether we do duplicate and unused variable checking
 119 --  (5) whether there are fixity declarations associated with the names
 120 --      bound by the patterns that need to be brought into scope with them.
 121 --
 122 --  Rather than burdening the clients of this module with all of these choices,
 123 --  we export the three points in this design space that we actually need:
 124
 125 -- entry point 1:
 126 -- binds local names; the scope of the bindings is entirely in the thing_inside
 127 --   allows type sigs to bind type vars
 128 --   local namemaker
 129 --   unused and duplicate checking
 130 --   no fixities
 131 rnPatsAndThen_LocalRightwards :: HsMatchContext Name -- for error messages
 132                               -> [LPat RdrName]
 133                               -- the continuation gets:
 134                               --    the list of renamed patterns
 135                               --    the (overall) free vars of all of them
 136                               -> ([LPat Name] -> RnM (a, FreeVars))
 137                               -> RnM (a, FreeVars)
 138
 139 rnPatsAndThen_LocalRightwards ctxt pats thing_inside
 140   = do  { envs_before <- getRdrEnvs
 141
 142           -- (0) bring into scope all of the type variables bound by the patterns
 143           -- (1) rename the patterns, bringing into scope all of the term variables
 144           -- (2) then do the thing inside.
 145         ; bindPatSigTyVarsFV (collectSigTysFromPats pats) $
 146           rnLPatsAndThen matchNameMaker pats    $ \ pats' ->
 147             do { -- Check for duplicated and shadowed names
 148                  -- Because we don't bind the vars all at once, we can't
 149                  --     check incrementally for duplicates;
 150                  -- Nor can we check incrementally for shadowing, else we'll
 151                  --     complain *twice* about duplicates e.g. f (x,x) = ...
 152             ; let names = collectPatsBinders pats'
 153             ; checkDupNames doc_pat names
 154             ; checkShadowedNames doc_pat envs_before
 155                                  [(nameSrcSpan name, nameOccName name) | name <- names]
 156             ; thing_inside pats' } }
 157   where
 158     doc_pat = ptext (sLit "In") <+> pprMatchContext ctxt
 159
 160
 161 -- entry point 2:
 162 -- binds local names; in a recursive scope that involves other bound vars
 163 --      e.g let { (x, Just y) = e1; ... } in ...
 164 --   does NOT allows type sig to bind type vars
 165 --   local namemaker
 166 --   no unused and duplicate checking
 167 --   fixities might be coming in
 168 rnBindPat :: NameMaker
 169           -> LPat RdrName
 170           -> RnM (LPat Name,
 171                        -- free variables of the pattern,
 172                        -- but not including variables bound by this pattern
 173                    FreeVars)
 174
 175 rnBindPat name_maker pat
 176   = rnLPatsAndThen name_maker [pat] $ \ [pat'] ->
 177     return (pat', emptyFVs)
 178
 179
 180 -- general version: parametrized by how you make new names
 181 -- invariant: what-to-do continuation only gets called with a list whose length is the same as
 182 --            the part of the pattern we're currently renaming
 183 rnLPatsAndThen :: NameMaker -- how to make a new variable
 184                -> [LPat RdrName]   -- part of pattern we're currently renaming
 185                -> ([LPat Name] -> RnM (a, FreeVars)) -- what to do afterwards
 186                -> RnM (a, FreeVars) -- renaming of the whole thing
 187
 188 rnLPatsAndThen var = mapFvRnCPS (rnLPatAndThen var)
 189
 190
 191 -- the workhorse
 192 rnLPatAndThen :: NameMaker
 193               -> LPat RdrName   -- part of pattern we're currently renaming
 194               -> (LPat Name -> RnM (a, FreeVars)) -- what to do afterwards
 195               -> RnM (a, FreeVars) -- renaming of the whole thing
 196 rnLPatAndThen var@(NM varf) (L loc p) cont =
 197     setSrcSpan loc $
 198       let reloc = L loc
 199           lcont = \ unlocated -> cont (reloc unlocated)
 200       in
 201        case p of
 202          WildPat _   -> lcont (WildPat placeHolderType)
 203
 204          ParPat pat  -> rnLPatAndThen var pat $ \ pat' -> lcont (ParPat pat')
 205          LazyPat pat -> rnLPatAndThen var pat $ \ pat' -> lcont (LazyPat pat')
 206          BangPat pat -> rnLPatAndThen var pat $ \ pat' -> lcont (BangPat pat')
 207
 208          VarPat name ->
 209             varf (reloc name) $ \ newBoundName ->
 210             lcont (VarPat newBoundName)
 211                -- we need to bind pattern variables for view pattern expressions
 212                -- (e.g. in the pattern (x, x -> y) x needs to be bound in the rhs of the tuple)
 213
 214          SigPatIn pat ty -> do
 215              patsigs <- doptM Opt_ScopedTypeVariables
 216              if patsigs
 217               then rnLPatAndThen var pat
 218                       (\ pat' -> do { (ty', fvs1) <- rnHsTypeFVs tvdoc ty
 219                                     ; (res, fvs2) <- lcont (SigPatIn pat' ty')
 220                                     ; return (res, fvs1 `plusFV` fvs2) })
 221               else do addErr (patSigErr ty)
 222                       rnLPatAndThen var pat cont
 223            where
 224              tvdoc = text "In a pattern type-signature"
 225
 226          LitPat lit@(HsString s) ->
 227              do ovlStr <- doptM Opt_OverloadedStrings
 228                 if ovlStr
 229                  then rnLPatAndThen var (reloc $ mkNPat (mkHsIsString s placeHolderType) Nothing) cont
 230                  else do { rnLit lit; lcont (LitPat lit) }   -- Same as below
 231
 232          LitPat lit -> do { rnLit lit; lcont (LitPat lit) }
 233
 234          NPat lit mb_neg _eq ->
 235            do { (lit', fvs1) <- rnOverLit lit
 236               ; (mb_neg', fvs2) <- case mb_neg of
 237                                      Nothing -> return (Nothing, emptyFVs)
 238                                      Just _  -> do { (neg, fvs) <- lookupSyntaxName negateName
 239                                                    ; return (Just neg, fvs) }
 240               ; (eq', fvs3) <- lookupSyntaxName eqName
 241               ; (res, fvs4) <- lcont (NPat lit' mb_neg' eq')
 242               ; return (res, fvs1 `plusFV` fvs2 `plusFV` fvs3 `plusFV` fvs4) }
 243                 -- Needed to find equality on pattern
 244
 245          NPlusKPat name lit _ _ ->
 246            varf name $ \ new_name ->
 247            do { (lit', fvs1) <- rnOverLit lit
 248               ; (minus, fvs2) <- lookupSyntaxName minusName
 249               ; (ge, fvs3) <- lookupSyntaxName geName
 250               ; (res, fvs4) <- lcont (NPlusKPat (L (nameSrcSpan new_name) new_name) lit' ge minus)
 251               ; return (res, fvs1 `plusFV` fvs2 `plusFV` fvs3 `plusFV` fvs4) }
 252                 -- The Report says that n+k patterns must be in Integral
 253
 254          AsPat name pat ->
 255            varf name $ \ new_name ->
 256            rnLPatAndThen var pat $ \ pat' ->
 257            lcont (AsPat (L (nameSrcSpan new_name) new_name) pat')
 258
 259          ViewPat expr pat ty ->
 260            do { vp_flag <- doptM Opt_ViewPatterns
 261               ; checkErr vp_flag (badViewPat p)
 262                 -- because of the way we're arranging the recursive calls,
 263                 -- this will be in the right context
 264               ; (expr', fv_expr) <- rnLExpr expr
 265               ; (res, fvs_res) <- rnLPatAndThen var pat $ \ pat' ->
 266                                   lcont (ViewPat expr' pat' ty)
 267               ; return (res, fvs_res `plusFV` fv_expr) }
 268
 269 #ifndef GHCI
 270          (QuasiQuotePat _) -> pprPanic "Can't do QuasiQuotePat without GHCi" (ppr p)
 271 #else
 272          QuasiQuotePat qq -> do
 273              (qq', _) <- rnQuasiQuote qq
 274              pat' <- runQuasiQuotePat qq'
 275              rnLPatAndThen var pat' $ \ (L _ pat'') ->
 276                  lcont pat''
 277 #endif  /* GHCI */
 278
 279          ConPatIn con stuff ->
 280              -- rnConPatAndThen takes care of reconstructing the pattern
 281              rnConPatAndThen var con stuff cont
 282
 283          ListPat pats _ ->
 284            rnLPatsAndThen var pats $ \ patslist ->
 285                lcont (ListPat patslist placeHolderType)
 286
 287          PArrPat pats _ ->
 288            do { (res, res_fvs) <- rnLPatsAndThen var pats $ \ patslist ->
 289                                   lcont (PArrPat patslist placeHolderType)
 290               ; return (res, res_fvs `plusFV` implicit_fvs) }
 291            where
 292              implicit_fvs = mkFVs [lengthPName, indexPName]
 293
 294          TuplePat pats boxed _ ->
 295            do { checkTupSize (length pats)
 296               ; rnLPatsAndThen var pats $ \ patslist ->
 297                 lcont (TuplePat patslist boxed placeHolderType) }
 298
 299          TypePat ty ->
 300            do { (ty', fvs1) <- rnHsTypeFVs (text "In a type pattern") ty
 301               ; (res, fvs2) <- lcont (TypePat ty')
 302               ; return (res, fvs1 `plusFV` fvs2) }
 303
 304          p -> pprPanic "rnLPatAndThen" (ppr p)
 305
 306
 307 -- helper for renaming constructor patterns
 308 rnConPatAndThen :: NameMaker
 309                 -> Located RdrName          -- the constructor
 310                 -> HsConPatDetails RdrName
 311                 -> (LPat Name -> RnM (a, FreeVars)) -- what to do afterwards
 312                 -> RnM (a, FreeVars)
 313
 314 rnConPatAndThen var (con@(L loc _)) (PrefixCon pats) cont
 315   = do  { con' <- lookupLocatedOccRn con
 316         ; (res, res_fvs) <- rnLPatsAndThen var pats $ \ pats' ->
 317                             cont (L loc $ ConPatIn con' (PrefixCon pats'))
 318         ; return (res, res_fvs `addOneFV` unLoc con') }
 319
 320 rnConPatAndThen var (con@(L loc _)) (InfixCon pat1 pat2) cont
 321   = do  { con' <- lookupLocatedOccRn con
 322         ; (res, res_fvs) <- rnLPatAndThen var pat1 $ \ pat1' ->
 323                             rnLPatAndThen var pat2 $ \ pat2' ->
 324                             do { fixity <- lookupFixityRn (unLoc con')
 325                                ; pat' <- mkConOpPatRn con' fixity pat1' pat2'
 326                                ; cont (L loc pat') }
 327         ; return (res, res_fvs `addOneFV` unLoc con') }
 328
 329 rnConPatAndThen var (con@(L loc _)) (RecCon rpats) cont
 330   = do  { con' <- lookupLocatedOccRn con
 331         ; (res, res_fvs) <- rnHsRecFieldsAndThen_Pattern con' var rpats $ \ rpats' ->
 332                             cont (L loc $ ConPatIn con' (RecCon rpats'))
 333         ; return (res, res_fvs `addOneFV` unLoc con') }
 334
 335 -- what kind of record expression we're doing
 336 -- the first two tell the name of the datatype constructor in question
 337 -- and give a way of creating a variable to fill in a ..
 338 data RnHsRecFieldsChoice a = Constructor (Located Name) (RdrName -> a)
 339                            | Pattern  (Located Name) (RdrName -> a)
 340                            | Update
 341
 342 choiceToMessage :: RnHsRecFieldsChoice t -> String
 343 choiceToMessage (Constructor _ _) = "construction"
 344 choiceToMessage (Pattern _ _) = "pattern"
 345 choiceToMessage Update = "update"
 346
 347 doDotDot :: RnHsRecFieldsChoice t -> Maybe (Located Name, RdrName -> t)
 348 doDotDot (Constructor a b) = Just (a,b)
 349 doDotDot (Pattern a b) = Just (a,b)
 350 doDotDot Update        = Nothing
 351
 352 getChoiceName :: RnHsRecFieldsChoice field -> Maybe (Located Name)
 353 getChoiceName (Constructor n _) = Just n
 354 getChoiceName (Pattern n _) = Just n
 355 getChoiceName (Update) = Nothing
 356
 357
 358
 359 -- helper for renaming record patterns;
 360 -- parameterized so that it can also be used for expressions
 361 rnHsRecFieldsAndThen :: RnHsRecFieldsChoice field
 362                      -- how to rename the fields (CPSed)
 363                      -> (Located field -> (Located field' -> RnM (c, FreeVars))
 364                                        -> RnM (c, FreeVars))
 365                      -- the actual fields
 366                      -> HsRecFields RdrName (Located field)
 367                      -- what to do in the scope of the field vars
 368                      -> (HsRecFields Name (Located field') -> RnM (c, FreeVars))
 369                      -> RnM (c, FreeVars)
 370 -- Haddock comments for record fields are renamed to Nothing here
 371 rnHsRecFieldsAndThen choice rn_thing (HsRecFields fields dd) cont =
 372     let
 373
 374         -- helper to collect and report duplicate record fields
 375         reportDuplicateFields doingstr fields =
 376             let
 377                 -- each list represents a RdrName that occurred more than once
 378                 -- (the list contains all occurrences)
 379                 -- invariant: each list in dup_fields is non-empty
 380                 dup_fields :: [[RdrName]]
 381                 (_, dup_fields) = removeDups compare
 382                                                  (map (unLoc . hsRecFieldId) fields)
 383
 384                 -- duplicate field reporting function
 385                 field_dup_err dup_group = addErr (dupFieldErr doingstr (head dup_group))
 386             in
 387               mapM_ field_dup_err dup_fields
 388
 389         -- helper to rename each field
 390         rn_field pun_ok (HsRecField field inside pun) cont = do
 391           fieldname <- lookupRecordBndr (getChoiceName choice) field
 392           checkErr (not pun || pun_ok) (badPun field)
 393           (res, res_fvs) <- rn_thing inside $ \ inside' ->
 394                             cont (HsRecField fieldname inside' pun)
 395           return (res, res_fvs `addOneFV` unLoc fieldname)
 396
 397         -- Compute the extra fields to be filled in by the dot-dot notation
 398         dot_dot_fields fs con mk_field cont = do
 399             con_fields <- lookupConstructorFields (unLoc con)
 400             let missing_fields = con_fields `minusList` fs
 401             loc <- getSrcSpanM  -- Rather approximate
 402             -- it's important that we make the RdrName fields that we morally wrote
 403             -- and then rename them in the usual manner
 404             -- (rather than trying to make the result of renaming directly)
 405             -- because, for patterns, renaming can bind vars in the continuation
 406             mapFvRnCPS rn_thing
 407              (map (L loc . mk_field . mkRdrUnqual . getOccName) missing_fields) $
 408               \ rhss ->
 409                   let new_fs = [ HsRecField (L loc f) r False
 410                                  | (f, r) <- missing_fields `zip` rhss ]
 411                   in
 412                   cont new_fs
 413
 414    in do
 415        -- report duplicate fields
 416        let doingstr = choiceToMessage choice
 417        reportDuplicateFields doingstr fields
 418
 419        -- rename the records as written
 420        -- check whether punning (implicit x=x) is allowed
 421        pun_flag <- doptM Opt_RecordPuns
 422        -- rename the fields
 423        mapFvRnCPS (rn_field pun_flag) fields $ \ fields1 ->
 424
 425            -- handle ..
 426            case dd of
 427              Nothing -> cont (HsRecFields fields1 dd)
 428              Just n  -> ASSERT( n == length fields ) do
 429                           dd_flag <- doptM Opt_RecordWildCards
 430                           checkErr dd_flag (needFlagDotDot doingstr)
 431                           let fld_names1 = map (unLoc . hsRecFieldId) fields1
 432                           case doDotDot choice of
 433                                 Nothing -> do addErr (badDotDot doingstr)
 434                                               -- we return a junk value here so that error reporting goes on
 435                                               cont (HsRecFields fields1 dd)
 436                                 Just (con, mk_field) ->
 437                                     dot_dot_fields fld_names1 con mk_field $
 438                                       \ fields2 ->
 439                                           cont (HsRecFields (fields1 ++ fields2) dd)
 440
 441 needFlagDotDot :: String -> SDoc
 442 needFlagDotDot str = vcat [ptext (sLit "Illegal `..' in record") <+> text str,
 443                           ptext (sLit "Use -XRecordWildCards to permit this")]
 444
 445 badDotDot :: String -> SDoc
 446 badDotDot str = ptext (sLit "You cannot use `..' in record") <+> text str
 447
 448 badPun :: Located RdrName -> SDoc
 449 badPun fld = vcat [ptext (sLit "Illegal use of punning for field") <+> quotes (ppr fld),
 450                    ptext (sLit "Use -XNamedFieldPuns to permit this")]
 451
 452
 453 -- wrappers
 454 rnHsRecFieldsAndThen_Pattern :: Located Name
 455                              -> NameMaker -- new name maker
 456                              -> HsRecFields RdrName (LPat RdrName)
 457                              -> (HsRecFields Name (LPat Name) -> RnM (c, FreeVars))
 458                              -> RnM (c, FreeVars)
 459 rnHsRecFieldsAndThen_Pattern n var
 460   = rnHsRecFieldsAndThen (Pattern n VarPat) (rnLPatAndThen var)
 461
 462
 463 -- wrapper to use rnLExpr in CPS style;
 464 -- because it does not bind any vars going forward, it does not need
 465 -- to be written that way
 466 rnLExprAndThen :: (LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars))
 467                -> LHsExpr RdrName
 468                -> (LHsExpr Name -> RnM (c, FreeVars))
 469                -> RnM (c, FreeVars)
 470 rnLExprAndThen f e cont = do { (x, fvs1) <- f e
 471                              ; (res, fvs2) <- cont x
 472                              ; return (res, fvs1 `plusFV` fvs2) }
 473
 474
 475 -- non-CPSed because exprs don't leave anything bound
 476 rnHsRecFields_Con :: Located Name
 477                   -> (LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars))
 478                   -> HsRecFields RdrName (LHsExpr RdrName)
 479                   -> RnM (HsRecFields Name (LHsExpr Name), FreeVars)
 480 rnHsRecFields_Con n rnLExpr fields = rnHsRecFieldsAndThen (Constructor n HsVar)
 481                                      (rnLExprAndThen rnLExpr) fields $ \ res ->
 482                                      return (res, emptyFVs)
 483
 484 rnHsRecFields_Update :: (LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars))
 485                      -> HsRecFields RdrName (LHsExpr RdrName)
 486                      -> RnM (HsRecFields Name (LHsExpr Name), FreeVars)
 487 rnHsRecFields_Update rnLExpr fields = rnHsRecFieldsAndThen Update
 488                                       (rnLExprAndThen rnLExpr) fields $ \ res ->
 489                                       return (res, emptyFVs)
 490 \end{code}
 491
 492
 493
 494 %************************************************************************
 495 %*                                                                      *
 496 \subsubsection{Literals}
 497 %*                                                                      *
 498 %************************************************************************
 499
 500 When literals occur we have to make sure
 501 that the types and classes they involve
 502 are made available.
 503
 504 \begin{code}
 505 rnLit :: HsLit -> RnM ()
 506 rnLit (HsChar c) = checkErr (inCharRange c) (bogusCharError c)
 507 rnLit _ = return ()
 508
 509 rnOverLit :: HsOverLit t -> RnM (HsOverLit Name, FreeVars)
 510 rnOverLit lit@(OverLit {ol_val=val})
 511   = do  { let std_name = hsOverLitName val
 512         ; (from_thing_name, fvs) <- lookupSyntaxName std_name
 513         ; let rebindable = case from_thing_name of
 514                                 HsVar v -> v /= std_name
 515                                 _       -> panic "rnOverLit"
 516         ; return (lit { ol_witness = from_thing_name
 517                       , ol_rebindable = rebindable }, fvs) }
 518 \end{code}
 519
 520 ----------------------------------------------------------------
 521 -- Old code returned extra free vars need in desugarer
 522 -- but that is no longer necessary, I believe
 523 --     if inIntRange i then
 524 --        return (HsIntegral i from_integer_name placeHolderType, fvs)
 525 --     else let
 526 --      extra_fvs = mkFVs [plusIntegerName, timesIntegerName]
 527 -- Big integer literals are built, using + and *,
 528 -- out of small integers (DsUtils.mkIntegerLit)
 529 -- [NB: plusInteger, timesInteger aren't rebindable...
 530 --      they are used to construct the argument to fromInteger,
 531 --      which is the rebindable one.]
 532
 533 -- (HsFractional i _ _) = do
 534 --      extra_fvs = mkFVs [ratioDataConName, plusIntegerName, timesIntegerName]
 535 -- We have to make sure that the Ratio type is imported with
 536 -- its constructor, because literals of type Ratio t are
 537 -- built with that constructor.
 538 -- The Rational type is needed too, but that will come in
 539 -- as part of the type for fromRational.
 540 -- The plus/times integer operations may be needed to construct the numerator
 541 -- and denominator (see DsUtils.mkIntegerLit)
 542
 543 %************************************************************************
 544 %*                                                                      *
 545 \subsubsection{Quasiquotation}
 546 %*                                                                      *
 547 %************************************************************************
 548
 549 See Note [Quasi-quote overview] in TcSplice.
 550
 551 \begin{code}
 552 rnQuasiQuote :: HsQuasiQuote RdrName -> RnM (HsQuasiQuote Name, FreeVars)
 553 rnQuasiQuote (HsQuasiQuote n quoter quoteSpan quote)
 554   = do  { loc  <- getSrcSpanM
 555         ; [n'] <- newLocalsRn [L loc n]
 556         ; quoter' <-  (lookupOccRn quoter)
 557                 -- If 'quoter' is not in scope, proceed no further
 558                 -- Otherwise lookupOcc adds an error messsage and returns
 559                 -- an "unubound name", which makes the subsequent attempt to
 560                 -- run the quote fail
 561         ; return (HsQuasiQuote n' quoter' quoteSpan quote, unitFV quoter') }
 562 \end{code}
 563
 564 %************************************************************************
 565 %*                                                                      *
 566 \subsubsection{Errors}
 567 %*                                                                      *
 568 %************************************************************************
 569
 570 \begin{code}
 571 checkTupSize :: Int -> RnM ()
 572 checkTupSize tup_size
 573   | tup_size <= mAX_TUPLE_SIZE
 574   = return ()
 575   | otherwise
 576   = addErr (sep [ptext (sLit "A") <+> int tup_size <> ptext (sLit "-tuple is too large for GHC"),
 577                  nest 2 (parens (ptext (sLit "max size is") <+> int mAX_TUPLE_SIZE)),
 578                  nest 2 (ptext (sLit "Workaround: use nested tuples or define a data type"))])
 579
 580 patSigErr :: Outputable a => a -> SDoc
 581 patSigErr ty
 582   =  (ptext (sLit "Illegal signature in pattern:") <+> ppr ty)
 583         $$ nest 4 (ptext (sLit "Use -XScopedTypeVariables to permit it"))
 584
 585 dupFieldErr :: String -> RdrName -> SDoc
 586 dupFieldErr str dup
 587   = hsep [ptext (sLit "duplicate field name"),
 588           quotes (ppr dup),
 589           ptext (sLit "in record"), text str]
 590
 591 bogusCharError :: Char -> SDoc
 592 bogusCharError c
 593   = ptext (sLit "character literal out of range: '\\") <> char c  <> char '\''
 594
 595 badViewPat :: Pat RdrName -> SDoc
 596 badViewPat pat = vcat [ptext (sLit "Illegal view pattern: ") <+> ppr pat,
 597                        ptext (sLit "Use -XViewPatterns to enable view patterns")]
 598
 599 \end{code}