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