compiler/rename/RnPat.lhs

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