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