compiler/rename/RnExpr.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[RnExpr]{Renaming of expressions}
   5
   6 Basically dependency analysis.
   7
   8 Handles @Match@, @GRHSs@, @HsExpr@, and @Qualifier@ datatypes.  In
   9 general, all of these functions return a renamed thing, and a set of
  10 free variables.
  11
  12 \begin{code}
  13 module RnExpr (
  14         rnLExpr, rnExpr, rnStmts
  15    ) where
  16
  17 #include "HsVersions.h"
  18
  19 import RnSource  ( rnSrcDecls, rnSplice, checkTH )
  20 import RnBinds   ( rnLocalBindsAndThen, rnValBinds,
  21                    rnMatchGroup, trimWith )
  22 import HsSyn
  23 import RnHsSyn
  24 import TcRnMonad
  25 import RnEnv
  26 import HscTypes         ( availNames )
  27 import OccName          ( plusOccEnv )
  28 import RnNames          ( getLocalDeclBinders, extendRdrEnvRn )
  29 import RnTypes          ( rnHsTypeFVs, rnLPat, rnOverLit, rnPatsAndThen, rnLit,
  30                           mkOpFormRn, mkOpAppRn, mkNegAppRn, checkSectionPrec,
  31                           dupFieldErr, checkTupSize )
  32 import DynFlags         ( DynFlag(..) )
  33 import BasicTypes       ( FixityDirection(..) )
  34 import SrcLoc           ( SrcSpan )
  35 import PrelNames        ( thFAKE, hasKey, assertIdKey, assertErrorName,
  36                           loopAName, choiceAName, appAName, arrAName, composeAName, firstAName,
  37                           negateName, thenMName, bindMName, failMName )
  38 #if defined(GHCI) && defined(BREAKPOINT)
  39 import PrelNames        ( breakpointJumpName, breakpointCondJumpName
  40                         , undefined_RDR, breakpointIdKey, breakpointCondIdKey )
  41 import UniqFM           ( eltsUFM )
  42 import DynFlags         ( GhcMode(..) )
  43 import Name             ( isTyVarName )
  44 #endif
  45 import Name             ( Name, nameOccName, nameIsLocalOrFrom )
  46 import NameSet
  47 import RdrName          ( RdrName, extendLocalRdrEnv, lookupLocalRdrEnv, hideSomeUnquals )
  48 import LoadIface        ( loadInterfaceForName )
  49 import UniqFM           ( isNullUFM )
  50 import UniqSet          ( emptyUniqSet )
  51 import List             ( nub )
  52 import Util             ( isSingleton )
  53 import ListSetOps       ( removeDups )
  54 import Maybes           ( expectJust )
  55 import Outputable
  56 import SrcLoc           ( Located(..), unLoc, getLoc, cmpLocated )
  57 import FastString
  58
  59 import List             ( unzip4 )
  60 \end{code}
  61
  62
  63 %************************************************************************
  64 %*                                                                      *
  65 \subsubsection{Expressions}
  66 %*                                                                      *
  67 %************************************************************************
  68
  69 \begin{code}
  70 rnExprs :: [LHsExpr RdrName] -> RnM ([LHsExpr Name], FreeVars)
  71 rnExprs ls = rnExprs' ls emptyUniqSet
  72  where
  73   rnExprs' [] acc = returnM ([], acc)
  74   rnExprs' (expr:exprs) acc
  75    = rnLExpr expr               `thenM` \ (expr', fvExpr) ->
  76
  77         -- Now we do a "seq" on the free vars because typically it's small
  78         -- or empty, especially in very long lists of constants
  79     let
  80         acc' = acc `plusFV` fvExpr
  81     in
  82     (grubby_seqNameSet acc' rnExprs') exprs acc'        `thenM` \ (exprs', fvExprs) ->
  83     returnM (expr':exprs', fvExprs)
  84
  85 -- Grubby little function to do "seq" on namesets; replace by proper seq when GHC can do seq
  86 grubby_seqNameSet ns result | isNullUFM ns = result
  87                             | otherwise    = result
  88 \end{code}
  89
  90 Variables. We look up the variable and return the resulting name.
  91
  92 \begin{code}
  93 rnLExpr :: LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars)
  94 rnLExpr = wrapLocFstM rnExpr
  95
  96 rnExpr :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars)
  97
  98 rnExpr (HsVar v)
  99   = do name           <- lookupOccRn v
 100        localRdrEnv    <- getLocalRdrEnv
 101        lclEnv         <- getLclEnv
 102        ignore_asserts <- doptM Opt_IgnoreAsserts
 103        ignore_breakpoints <- doptM Opt_IgnoreBreakpoints
 104        ghcMode        <- getGhcMode
 105        let conds = [ (name `hasKey` assertIdKey
 106                       && not ignore_asserts,
 107                       do (e, fvs) <- mkAssertErrorExpr
 108                          return (e, fvs `addOneFV` name))
 109 #if defined(GHCI) && defined(BREAKPOINT)
 110                    , (name `hasKey` breakpointIdKey
 111                       && not ignore_breakpoints
 112                       && ghcMode == Interactive,
 113                          do let isWantedName = not.isTyVarName
 114                             (e, fvs) <- mkBreakpointExpr (filter isWantedName (eltsUFM localRdrEnv))
 115                             return (e, fvs `addOneFV` name)
 116                      )
 117                    , (name `hasKey` breakpointCondIdKey
 118                       && not ignore_breakpoints
 119                       && ghcMode == Interactive,
 120                          do let isWantedName = not.isTyVarName
 121                             (e, fvs) <- mkBreakpointCondExpr (filter isWantedName (eltsUFM localRdrEnv))
 122                             return (e, fvs `addOneFV` name)
 123                      )
 124 #endif
 125                    ]
 126        case lookup True conds of
 127          Just action -> action
 128          Nothing     -> return (HsVar name, unitFV name)
 129
 130 rnExpr (HsIPVar v)
 131   = newIPNameRn v               `thenM` \ name ->
 132     returnM (HsIPVar name, emptyFVs)
 133
 134 rnExpr (HsLit lit)
 135   = rnLit lit           `thenM_`
 136     returnM (HsLit lit, emptyFVs)
 137
 138 rnExpr (HsOverLit lit)
 139   = rnOverLit lit               `thenM` \ (lit', fvs) ->
 140     returnM (HsOverLit lit', fvs)
 141
 142 rnExpr (HsApp fun arg)
 143   = rnLExpr fun         `thenM` \ (fun',fvFun) ->
 144     rnLExpr arg         `thenM` \ (arg',fvArg) ->
 145     returnM (HsApp fun' arg', fvFun `plusFV` fvArg)
 146
 147 rnExpr (OpApp e1 op _ e2)
 148   = rnLExpr e1                          `thenM` \ (e1', fv_e1) ->
 149     rnLExpr e2                          `thenM` \ (e2', fv_e2) ->
 150     rnLExpr op                          `thenM` \ (op'@(L _ (HsVar op_name)), fv_op) ->
 151
 152         -- Deal with fixity
 153         -- When renaming code synthesised from "deriving" declarations
 154         -- we used to avoid fixity stuff, but we can't easily tell any
 155         -- more, so I've removed the test.  Adding HsPars in TcGenDeriv
 156         -- should prevent bad things happening.
 157     lookupFixityRn op_name              `thenM` \ fixity ->
 158     mkOpAppRn e1' op' fixity e2'        `thenM` \ final_e ->
 159
 160     returnM (final_e,
 161               fv_e1 `plusFV` fv_op `plusFV` fv_e2)
 162
 163 rnExpr (NegApp e _)
 164   = rnLExpr e                   `thenM` \ (e', fv_e) ->
 165     lookupSyntaxName negateName `thenM` \ (neg_name, fv_neg) ->
 166     mkNegAppRn e' neg_name      `thenM` \ final_e ->
 167     returnM (final_e, fv_e `plusFV` fv_neg)
 168
 169 rnExpr (HsPar e)
 170   = rnLExpr e           `thenM` \ (e', fvs_e) ->
 171     returnM (HsPar e', fvs_e)
 172
 173 -- Template Haskell extensions
 174 -- Don't ifdef-GHCI them because we want to fail gracefully
 175 -- (not with an rnExpr crash) in a stage-1 compiler.
 176 rnExpr e@(HsBracket br_body)
 177   = checkTH e "bracket"         `thenM_`
 178     rnBracket br_body           `thenM` \ (body', fvs_e) ->
 179     returnM (HsBracket body', fvs_e)
 180
 181 rnExpr e@(HsSpliceE splice)
 182   = rnSplice splice             `thenM` \ (splice', fvs) ->
 183     returnM (HsSpliceE splice', fvs)
 184
 185 rnExpr section@(SectionL expr op)
 186   = rnLExpr expr                `thenM` \ (expr', fvs_expr) ->
 187     rnLExpr op                  `thenM` \ (op', fvs_op) ->
 188     checkSectionPrec InfixL section op' expr' `thenM_`
 189     returnM (SectionL expr' op', fvs_op `plusFV` fvs_expr)
 190
 191 rnExpr section@(SectionR op expr)
 192   = rnLExpr op                                  `thenM` \ (op',   fvs_op) ->
 193     rnLExpr expr                                        `thenM` \ (expr', fvs_expr) ->
 194     checkSectionPrec InfixR section op' expr'   `thenM_`
 195     returnM (SectionR op' expr', fvs_op `plusFV` fvs_expr)
 196
 197 rnExpr (HsCoreAnn ann expr)
 198   = rnLExpr expr `thenM` \ (expr', fvs_expr) ->
 199     returnM (HsCoreAnn ann expr', fvs_expr)
 200
 201 rnExpr (HsSCC lbl expr)
 202   = rnLExpr expr                `thenM` \ (expr', fvs_expr) ->
 203     returnM (HsSCC lbl expr', fvs_expr)
 204
 205 rnExpr (HsLam matches)
 206   = rnMatchGroup LambdaExpr matches     `thenM` \ (matches', fvMatch) ->
 207     returnM (HsLam matches', fvMatch)
 208
 209 rnExpr (HsCase expr matches)
 210   = rnLExpr expr                        `thenM` \ (new_expr, e_fvs) ->
 211     rnMatchGroup CaseAlt matches        `thenM` \ (new_matches, ms_fvs) ->
 212     returnM (HsCase new_expr new_matches, e_fvs `plusFV` ms_fvs)
 213
 214 rnExpr (HsLet binds expr)
 215   = rnLocalBindsAndThen binds           $ \ binds' ->
 216     rnLExpr expr                         `thenM` \ (expr',fvExpr) ->
 217     returnM (HsLet binds' expr', fvExpr)
 218
 219 rnExpr e@(HsDo do_or_lc stmts body _)
 220   = do  { ((stmts', body'), fvs) <- rnStmts do_or_lc stmts $
 221                                     rnLExpr body
 222         ; return (HsDo do_or_lc stmts' body' placeHolderType, fvs) }
 223
 224 rnExpr (ExplicitList _ exps)
 225   = rnExprs exps                        `thenM` \ (exps', fvs) ->
 226     returnM  (ExplicitList placeHolderType exps', fvs `addOneFV` listTyCon_name)
 227
 228 rnExpr (ExplicitPArr _ exps)
 229   = rnExprs exps                        `thenM` \ (exps', fvs) ->
 230     returnM  (ExplicitPArr placeHolderType exps', fvs)
 231
 232 rnExpr e@(ExplicitTuple exps boxity)
 233   = checkTupSize tup_size                       `thenM_`
 234     rnExprs exps                                `thenM` \ (exps', fvs) ->
 235     returnM (ExplicitTuple exps' boxity, fvs `addOneFV` tycon_name)
 236   where
 237     tup_size   = length exps
 238     tycon_name = tupleTyCon_name boxity tup_size
 239
 240 rnExpr (RecordCon con_id _ rbinds)
 241   = lookupLocatedOccRn con_id           `thenM` \ conname ->
 242     rnRbinds "construction" rbinds      `thenM` \ (rbinds', fvRbinds) ->
 243     returnM (RecordCon conname noPostTcExpr rbinds',
 244              fvRbinds `addOneFV` unLoc conname)
 245
 246 rnExpr (RecordUpd expr rbinds _ _)
 247   = rnLExpr expr                `thenM` \ (expr', fvExpr) ->
 248     rnRbinds "update" rbinds    `thenM` \ (rbinds', fvRbinds) ->
 249     returnM (RecordUpd expr' rbinds' placeHolderType placeHolderType,
 250              fvExpr `plusFV` fvRbinds)
 251
 252 rnExpr (ExprWithTySig expr pty)
 253   = do  { (pty', fvTy) <- rnHsTypeFVs doc pty
 254         ; (expr', fvExpr) <- bindSigTyVarsFV (hsExplicitTvs pty') $
 255                              rnLExpr expr
 256         ; return (ExprWithTySig expr' pty', fvExpr `plusFV` fvTy) }
 257   where
 258     doc = text "In an expression type signature"
 259
 260 rnExpr (HsIf p b1 b2)
 261   = rnLExpr p           `thenM` \ (p', fvP) ->
 262     rnLExpr b1          `thenM` \ (b1', fvB1) ->
 263     rnLExpr b2          `thenM` \ (b2', fvB2) ->
 264     returnM (HsIf p' b1' b2', plusFVs [fvP, fvB1, fvB2])
 265
 266 rnExpr (HsType a)
 267   = rnHsTypeFVs doc a   `thenM` \ (t, fvT) ->
 268     returnM (HsType t, fvT)
 269   where
 270     doc = text "In a type argument"
 271
 272 rnExpr (ArithSeq _ seq)
 273   = rnArithSeq seq       `thenM` \ (new_seq, fvs) ->
 274     returnM (ArithSeq noPostTcExpr new_seq, fvs)
 275
 276 rnExpr (PArrSeq _ seq)
 277   = rnArithSeq seq       `thenM` \ (new_seq, fvs) ->
 278     returnM (PArrSeq noPostTcExpr new_seq, fvs)
 279 \end{code}
 280
 281 These three are pattern syntax appearing in expressions.
 282 Since all the symbols are reservedops we can simply reject them.
 283 We return a (bogus) EWildPat in each case.
 284
 285 \begin{code}
 286 rnExpr e@EWildPat      = patSynErr e
 287 rnExpr e@(EAsPat {})   = patSynErr e
 288 rnExpr e@(ELazyPat {}) = patSynErr e
 289 \end{code}
 290
 291 %************************************************************************
 292 %*                                                                      *
 293         Arrow notation
 294 %*                                                                      *
 295 %************************************************************************
 296
 297 \begin{code}
 298 rnExpr (HsProc pat body)
 299   = newArrowScope $
 300     rnPatsAndThen ProcExpr [pat] $ \ [pat'] ->
 301     rnCmdTop body                `thenM` \ (body',fvBody) ->
 302     returnM (HsProc pat' body', fvBody)
 303
 304 rnExpr (HsArrApp arrow arg _ ho rtl)
 305   = select_arrow_scope (rnLExpr arrow)  `thenM` \ (arrow',fvArrow) ->
 306     rnLExpr arg                         `thenM` \ (arg',fvArg) ->
 307     returnM (HsArrApp arrow' arg' placeHolderType ho rtl,
 308              fvArrow `plusFV` fvArg)
 309   where
 310     select_arrow_scope tc = case ho of
 311         HsHigherOrderApp -> tc
 312         HsFirstOrderApp  -> escapeArrowScope tc
 313
 314 -- infix form
 315 rnExpr (HsArrForm op (Just _) [arg1, arg2])
 316   = escapeArrowScope (rnLExpr op)
 317                         `thenM` \ (op'@(L _ (HsVar op_name)),fv_op) ->
 318     rnCmdTop arg1       `thenM` \ (arg1',fv_arg1) ->
 319     rnCmdTop arg2       `thenM` \ (arg2',fv_arg2) ->
 320
 321         -- Deal with fixity
 322
 323     lookupFixityRn op_name              `thenM` \ fixity ->
 324     mkOpFormRn arg1' op' fixity arg2'   `thenM` \ final_e ->
 325
 326     returnM (final_e,
 327               fv_arg1 `plusFV` fv_op `plusFV` fv_arg2)
 328
 329 rnExpr (HsArrForm op fixity cmds)
 330   = escapeArrowScope (rnLExpr op)       `thenM` \ (op',fvOp) ->
 331     rnCmdArgs cmds                      `thenM` \ (cmds',fvCmds) ->
 332     returnM (HsArrForm op' fixity cmds', fvOp `plusFV` fvCmds)
 333
 334 rnExpr other = pprPanic "rnExpr: unexpected expression" (ppr other)
 335         -- HsWrap
 336 \end{code}
 337
 338
 339 %************************************************************************
 340 %*                                                                      *
 341         Arrow commands
 342 %*                                                                      *
 343 %************************************************************************
 344
 345 \begin{code}
 346 rnCmdArgs [] = returnM ([], emptyFVs)
 347 rnCmdArgs (arg:args)
 348   = rnCmdTop arg        `thenM` \ (arg',fvArg) ->
 349     rnCmdArgs args      `thenM` \ (args',fvArgs) ->
 350     returnM (arg':args', fvArg `plusFV` fvArgs)
 351
 352
 353 rnCmdTop = wrapLocFstM rnCmdTop'
 354  where
 355   rnCmdTop' (HsCmdTop cmd _ _ _)
 356    = rnLExpr (convertOpFormsLCmd cmd) `thenM` \ (cmd', fvCmd) ->
 357      let
 358         cmd_names = [arrAName, composeAName, firstAName] ++
 359                     nameSetToList (methodNamesCmd (unLoc cmd'))
 360      in
 361         -- Generate the rebindable syntax for the monad
 362      lookupSyntaxTable cmd_names        `thenM` \ (cmd_names', cmd_fvs) ->
 363
 364      returnM (HsCmdTop cmd' [] placeHolderType cmd_names',
 365              fvCmd `plusFV` cmd_fvs)
 366
 367 ---------------------------------------------------
 368 -- convert OpApp's in a command context to HsArrForm's
 369
 370 convertOpFormsLCmd :: LHsCmd id -> LHsCmd id
 371 convertOpFormsLCmd = fmap convertOpFormsCmd
 372
 373 convertOpFormsCmd :: HsCmd id -> HsCmd id
 374
 375 convertOpFormsCmd (HsApp c e) = HsApp (convertOpFormsLCmd c) e
 376 convertOpFormsCmd (HsLam match) = HsLam (convertOpFormsMatch match)
 377 convertOpFormsCmd (OpApp c1 op fixity c2)
 378   = let
 379         arg1 = L (getLoc c1) $ HsCmdTop (convertOpFormsLCmd c1) [] placeHolderType []
 380         arg2 = L (getLoc c2) $ HsCmdTop (convertOpFormsLCmd c2) [] placeHolderType []
 381     in
 382     HsArrForm op (Just fixity) [arg1, arg2]
 383
 384 convertOpFormsCmd (HsPar c) = HsPar (convertOpFormsLCmd c)
 385
 386 -- gaw 2004
 387 convertOpFormsCmd (HsCase exp matches)
 388   = HsCase exp (convertOpFormsMatch matches)
 389
 390 convertOpFormsCmd (HsIf exp c1 c2)
 391   = HsIf exp (convertOpFormsLCmd c1) (convertOpFormsLCmd c2)
 392
 393 convertOpFormsCmd (HsLet binds cmd)
 394   = HsLet binds (convertOpFormsLCmd cmd)
 395
 396 convertOpFormsCmd (HsDo ctxt stmts body ty)
 397   = HsDo ctxt (map (fmap convertOpFormsStmt) stmts)
 398               (convertOpFormsLCmd body) ty
 399
 400 -- Anything else is unchanged.  This includes HsArrForm (already done),
 401 -- things with no sub-commands, and illegal commands (which will be
 402 -- caught by the type checker)
 403 convertOpFormsCmd c = c
 404
 405 convertOpFormsStmt (BindStmt pat cmd _ _)
 406   = BindStmt pat (convertOpFormsLCmd cmd) noSyntaxExpr noSyntaxExpr
 407 convertOpFormsStmt (ExprStmt cmd _ _)
 408   = ExprStmt (convertOpFormsLCmd cmd) noSyntaxExpr placeHolderType
 409 convertOpFormsStmt (RecStmt stmts lvs rvs es binds)
 410   = RecStmt (map (fmap convertOpFormsStmt) stmts) lvs rvs es binds
 411 convertOpFormsStmt stmt = stmt
 412
 413 convertOpFormsMatch (MatchGroup ms ty)
 414   = MatchGroup (map (fmap convert) ms) ty
 415  where convert (Match pat mty grhss)
 416           = Match pat mty (convertOpFormsGRHSs grhss)
 417
 418 convertOpFormsGRHSs (GRHSs grhss binds)
 419   = GRHSs (map convertOpFormsGRHS grhss) binds
 420
 421 convertOpFormsGRHS = fmap convert
 422  where
 423    convert (GRHS stmts cmd) = GRHS stmts (convertOpFormsLCmd cmd)
 424
 425 ---------------------------------------------------
 426 type CmdNeeds = FreeVars        -- Only inhabitants are
 427                                 --      appAName, choiceAName, loopAName
 428
 429 -- find what methods the Cmd needs (loop, choice, apply)
 430 methodNamesLCmd :: LHsCmd Name -> CmdNeeds
 431 methodNamesLCmd = methodNamesCmd . unLoc
 432
 433 methodNamesCmd :: HsCmd Name -> CmdNeeds
 434
 435 methodNamesCmd cmd@(HsArrApp _arrow _arg _ HsFirstOrderApp _rtl)
 436   = emptyFVs
 437 methodNamesCmd cmd@(HsArrApp _arrow _arg _ HsHigherOrderApp _rtl)
 438   = unitFV appAName
 439 methodNamesCmd cmd@(HsArrForm {}) = emptyFVs
 440
 441 methodNamesCmd (HsPar c) = methodNamesLCmd c
 442
 443 methodNamesCmd (HsIf p c1 c2)
 444   = methodNamesLCmd c1 `plusFV` methodNamesLCmd c2 `addOneFV` choiceAName
 445
 446 methodNamesCmd (HsLet b c) = methodNamesLCmd c
 447
 448 methodNamesCmd (HsDo sc stmts body ty)
 449   = methodNamesStmts stmts `plusFV` methodNamesLCmd body
 450
 451 methodNamesCmd (HsApp c e) = methodNamesLCmd c
 452
 453 methodNamesCmd (HsLam match) = methodNamesMatch match
 454
 455 methodNamesCmd (HsCase scrut matches)
 456   = methodNamesMatch matches `addOneFV` choiceAName
 457
 458 methodNamesCmd other = emptyFVs
 459    -- Other forms can't occur in commands, but it's not convenient
 460    -- to error here so we just do what's convenient.
 461    -- The type checker will complain later
 462
 463 ---------------------------------------------------
 464 methodNamesMatch (MatchGroup ms _)
 465   = plusFVs (map do_one ms)
 466  where
 467     do_one (L _ (Match pats sig_ty grhss)) = methodNamesGRHSs grhss
 468
 469 -------------------------------------------------
 470 -- gaw 2004
 471 methodNamesGRHSs (GRHSs grhss binds) = plusFVs (map methodNamesGRHS grhss)
 472
 473 -------------------------------------------------
 474 methodNamesGRHS (L _ (GRHS stmts rhs)) = methodNamesLCmd rhs
 475
 476 ---------------------------------------------------
 477 methodNamesStmts stmts = plusFVs (map methodNamesLStmt stmts)
 478
 479 ---------------------------------------------------
 480 methodNamesLStmt = methodNamesStmt . unLoc
 481
 482 methodNamesStmt (ExprStmt cmd _ _)     = methodNamesLCmd cmd
 483 methodNamesStmt (BindStmt pat cmd _ _) = methodNamesLCmd cmd
 484 methodNamesStmt (RecStmt stmts _ _ _ _)
 485   = methodNamesStmts stmts `addOneFV` loopAName
 486 methodNamesStmt (LetStmt b)  = emptyFVs
 487 methodNamesStmt (ParStmt ss) = emptyFVs
 488    -- ParStmt can't occur in commands, but it's not convenient to error
 489    -- here so we just do what's convenient
 490 \end{code}
 491
 492
 493 %************************************************************************
 494 %*                                                                      *
 495         Arithmetic sequences
 496 %*                                                                      *
 497 %************************************************************************
 498
 499 \begin{code}
 500 rnArithSeq (From expr)
 501  = rnLExpr expr         `thenM` \ (expr', fvExpr) ->
 502    returnM (From expr', fvExpr)
 503
 504 rnArithSeq (FromThen expr1 expr2)
 505  = rnLExpr expr1        `thenM` \ (expr1', fvExpr1) ->
 506    rnLExpr expr2        `thenM` \ (expr2', fvExpr2) ->
 507    returnM (FromThen expr1' expr2', fvExpr1 `plusFV` fvExpr2)
 508
 509 rnArithSeq (FromTo expr1 expr2)
 510  = rnLExpr expr1        `thenM` \ (expr1', fvExpr1) ->
 511    rnLExpr expr2        `thenM` \ (expr2', fvExpr2) ->
 512    returnM (FromTo expr1' expr2', fvExpr1 `plusFV` fvExpr2)
 513
 514 rnArithSeq (FromThenTo expr1 expr2 expr3)
 515  = rnLExpr expr1        `thenM` \ (expr1', fvExpr1) ->
 516    rnLExpr expr2        `thenM` \ (expr2', fvExpr2) ->
 517    rnLExpr expr3        `thenM` \ (expr3', fvExpr3) ->
 518    returnM (FromThenTo expr1' expr2' expr3',
 519             plusFVs [fvExpr1, fvExpr2, fvExpr3])
 520 \end{code}
 521
 522
 523 %************************************************************************
 524 %*                                                                      *
 525 \subsubsection{@Rbinds@s and @Rpats@s: in record expressions}
 526 %*                                                                      *
 527 %************************************************************************
 528
 529 \begin{code}
 530 rnRbinds str rbinds
 531   = mappM_ field_dup_err dup_fields     `thenM_`
 532     mapFvRn rn_rbind rbinds             `thenM` \ (rbinds', fvRbind) ->
 533     returnM (rbinds', fvRbind)
 534   where
 535     (_, dup_fields) = removeDups cmpLocated [ f | (f,_) <- rbinds ]
 536
 537     field_dup_err dups = mappM_ (\f -> addLocErr f (dupFieldErr str)) dups
 538
 539     rn_rbind (field, expr)
 540       = lookupLocatedGlobalOccRn field  `thenM` \ fieldname ->
 541         rnLExpr expr                    `thenM` \ (expr', fvExpr) ->
 542         returnM ((fieldname, expr'), fvExpr `addOneFV` unLoc fieldname)
 543 \end{code}
 544
 545 %************************************************************************
 546 %*                                                                      *
 547         Template Haskell brackets
 548 %*                                                                      *
 549 %************************************************************************
 550
 551 \begin{code}
 552 rnBracket (VarBr n) = do { name <- lookupOccRn n
 553                          ; this_mod <- getModule
 554                          ; checkM (nameIsLocalOrFrom this_mod name) $   -- Reason: deprecation checking asumes the
 555                            do { loadInterfaceForName msg name           -- home interface is loaded, and this is the
 556                               ; return () }                             -- only way that is going to happen
 557                          ; returnM (VarBr name, unitFV name) }
 558                     where
 559                       msg = ptext SLIT("Need interface for Template Haskell quoted Name")
 560
 561 rnBracket (ExpBr e) = do { (e', fvs) <- rnLExpr e
 562                          ; return (ExpBr e', fvs) }
 563 rnBracket (PatBr p) = do { (p', fvs) <- rnLPat p
 564                          ; return (PatBr p', fvs) }
 565 rnBracket (TypBr t) = do { (t', fvs) <- rnHsTypeFVs doc t
 566                          ; return (TypBr t', fvs) }
 567                     where
 568                       doc = ptext SLIT("In a Template-Haskell quoted type")
 569 rnBracket (DecBr group)
 570   = do  { gbl_env  <- getGblEnv
 571
 572         ; let gbl_env1 = gbl_env { tcg_mod = thFAKE }
 573         -- Note the thFAKE.  The top-level names from the bracketed
 574         -- declarations will go into the name cache, and we don't want them to
 575         -- confuse the Names for the current module.
 576         -- By using a pretend module, thFAKE, we keep them safely out of the way.
 577
 578         ; avails <- getLocalDeclBinders gbl_env1 group
 579         ; let names = concatMap availNames avails
 580
 581         ; let new_occs = map nameOccName names
 582               trimmed_rdr_env = hideSomeUnquals (tcg_rdr_env gbl_env) new_occs
 583
 584         ; rdr_env' <- extendRdrEnvRn trimmed_rdr_env avails
 585         -- In this situation we want to *shadow* top-level bindings.
 586         --      foo = 1
 587         --      bar = [d| foo = 1|]
 588         -- If we don't shadow, we'll get an ambiguity complaint when we do
 589         -- a lookupTopBndrRn (which uses lookupGreLocalRn) on the binder of the 'foo'
 590         --
 591         -- Furthermore, arguably if the splice does define foo, that should hide
 592         -- any foo's further out
 593         --
 594         -- The shadowing is acheived by the call to hideSomeUnquals, which removes
 595         -- the unqualified bindings of things defined by the bracket
 596
 597         ; setGblEnv (gbl_env { tcg_rdr_env = rdr_env',
 598                                tcg_dus = emptyDUs }) $ do
 599                 -- The emptyDUs is so that we just collect uses for this group alone
 600
 601         { (tcg_env, group') <- rnSrcDecls group
 602                 -- Discard the tcg_env; it contains only extra info about fixity
 603         ; return (DecBr group', allUses (tcg_dus tcg_env)) } }
 604 \end{code}
 605
 606 %************************************************************************
 607 %*                                                                      *
 608 \subsubsection{@Stmt@s: in @do@ expressions}
 609 %*                                                                      *
 610 %************************************************************************
 611
 612 \begin{code}
 613 rnStmts :: HsStmtContext Name -> [LStmt RdrName]
 614         -> RnM (thing, FreeVars)
 615         -> RnM (([LStmt Name], thing), FreeVars)
 616
 617 rnStmts (MDoExpr _) = rnMDoStmts
 618 rnStmts ctxt        = rnNormalStmts ctxt
 619
 620 rnNormalStmts :: HsStmtContext Name -> [LStmt RdrName]
 621               -> RnM (thing, FreeVars)
 622               -> RnM (([LStmt Name], thing), FreeVars)
 623 -- Used for cases *other* than recursive mdo
 624 -- Implements nested scopes
 625
 626 rnNormalStmts ctxt [] thing_inside
 627   = do  { (thing, fvs) <- thing_inside
 628         ; return (([],thing), fvs) }
 629
 630 rnNormalStmts ctxt (L loc stmt : stmts) thing_inside
 631   = do  { ((stmt', (stmts', thing)), fvs)
 632                 <- rnStmt ctxt stmt     $
 633                    rnNormalStmts ctxt stmts thing_inside
 634         ; return (((L loc stmt' : stmts'), thing), fvs) }
 635
 636 rnStmt :: HsStmtContext Name -> Stmt RdrName
 637        -> RnM (thing, FreeVars)
 638        -> RnM ((Stmt Name, thing), FreeVars)
 639
 640 rnStmt ctxt (ExprStmt expr _ _) thing_inside
 641   = do  { (expr', fv_expr) <- rnLExpr expr
 642         ; (then_op, fvs1)  <- lookupSyntaxName thenMName
 643         ; (thing, fvs2)    <- thing_inside
 644         ; return ((ExprStmt expr' then_op placeHolderType, thing),
 645                   fv_expr `plusFV` fvs1 `plusFV` fvs2) }
 646
 647 rnStmt ctxt (BindStmt pat expr _ _) thing_inside
 648   = do  { (expr', fv_expr) <- rnLExpr expr
 649                 -- The binders do not scope over the expression
 650         ; (bind_op, fvs1) <- lookupSyntaxName bindMName
 651         ; (fail_op, fvs2) <- lookupSyntaxName failMName
 652         ; rnPatsAndThen (StmtCtxt ctxt) [pat] $ \ [pat'] -> do
 653         { (thing, fvs3) <- thing_inside
 654         ; return ((BindStmt pat' expr' bind_op fail_op, thing),
 655                   fv_expr `plusFV` fvs1 `plusFV` fvs2 `plusFV` fvs3) }}
 656         -- fv_expr shouldn't really be filtered by the rnPatsAndThen
 657         -- but it does not matter because the names are unique
 658
 659 rnStmt ctxt (LetStmt binds) thing_inside
 660   = do  { checkErr (ok ctxt binds)
 661                    (badIpBinds (ptext SLIT("a parallel list comprehension:")) binds)
 662         ; rnLocalBindsAndThen binds             $ \ binds' -> do
 663         { (thing, fvs) <- thing_inside
 664         ; return ((LetStmt binds', thing), fvs) }}
 665   where
 666         -- We do not allow implicit-parameter bindings in a parallel
 667         -- list comprehension.  I'm not sure what it might mean.
 668     ok (ParStmtCtxt _) (HsIPBinds _) = False
 669     ok _               _             = True
 670
 671 rnStmt ctxt (RecStmt rec_stmts _ _ _ _) thing_inside
 672   = bindLocatedLocalsRn doc (collectLStmtsBinders rec_stmts)    $ \ bndrs ->
 673     rn_rec_stmts bndrs rec_stmts        `thenM` \ segs ->
 674     thing_inside                        `thenM` \ (thing, fvs) ->
 675     let
 676         segs_w_fwd_refs          = addFwdRefs segs
 677         (ds, us, fs, rec_stmts') = unzip4 segs_w_fwd_refs
 678         later_vars = nameSetToList (plusFVs ds `intersectNameSet` fvs)
 679         fwd_vars   = nameSetToList (plusFVs fs)
 680         uses       = plusFVs us
 681         rec_stmt   = RecStmt rec_stmts' later_vars fwd_vars [] emptyLHsBinds
 682     in
 683     returnM ((rec_stmt, thing), uses `plusFV` fvs)
 684   where
 685     doc = text "In a recursive do statement"
 686
 687 rnStmt ctxt (ParStmt segs) thing_inside
 688   = do  { opt_GlasgowExts <- doptM Opt_GlasgowExts
 689         ; checkM opt_GlasgowExts parStmtErr
 690         ; orig_lcl_env <- getLocalRdrEnv
 691         ; ((segs',thing), fvs) <- go orig_lcl_env [] segs
 692         ; return ((ParStmt segs', thing), fvs) }
 693   where
 694 --  type ParSeg id = [([LStmt id], [id])]
 695 --  go :: NameSet -> [ParSeg RdrName]
 696 --       -> RnM (([ParSeg Name], thing), FreeVars)
 697
 698     go orig_lcl_env bndrs []
 699         = do { let { (bndrs', dups) = removeDups cmpByOcc bndrs
 700                    ; inner_env = extendLocalRdrEnv orig_lcl_env bndrs' }
 701              ; mappM dupErr dups
 702              ; (thing, fvs) <- setLocalRdrEnv inner_env thing_inside
 703              ; return (([], thing), fvs) }
 704
 705     go orig_lcl_env bndrs_so_far ((stmts, _) : segs)
 706         = do { ((stmts', (bndrs, segs', thing)), fvs)
 707                   <- rnNormalStmts par_ctxt stmts $ do
 708                      {  -- Find the Names that are bound by stmts
 709                        lcl_env <- getLocalRdrEnv
 710                      ; let { rdr_bndrs = collectLStmtsBinders stmts
 711                            ; bndrs = map ( expectJust "rnStmt"
 712                                          . lookupLocalRdrEnv lcl_env
 713                                          . unLoc) rdr_bndrs
 714                            ; new_bndrs = nub bndrs ++ bndrs_so_far
 715                                 -- The nub is because there might be shadowing
 716                                 --      x <- e1; x <- e2
 717                                 -- So we'll look up (Unqual x) twice, getting
 718                                 -- the second binding both times, which is the
 719                         }       -- one we want
 720
 721                         -- Typecheck the thing inside, passing on all
 722                         -- the Names bound, but separately; revert the envt
 723                      ; ((segs', thing), fvs) <- setLocalRdrEnv orig_lcl_env $
 724                                                 go orig_lcl_env new_bndrs segs
 725
 726                         -- Figure out which of the bound names are used
 727                      ; let used_bndrs = filter (`elemNameSet` fvs) bndrs
 728                      ; return ((used_bndrs, segs', thing), fvs) }
 729
 730              ; let seg' = (stmts', bndrs)
 731              ; return (((seg':segs'), thing),
 732                        delListFromNameSet fvs bndrs) }
 733
 734     par_ctxt = ParStmtCtxt ctxt
 735
 736     cmpByOcc n1 n2 = nameOccName n1 `compare` nameOccName n2
 737     dupErr vs = addErr (ptext SLIT("Duplicate binding in parallel list comprehension for:")
 738                         <+> quotes (ppr (head vs)))
 739 \end{code}
 740
 741
 742 %************************************************************************
 743 %*                                                                      *
 744 \subsubsection{mdo expressions}
 745 %*                                                                      *
 746 %************************************************************************
 747
 748 \begin{code}
 749 type FwdRefs = NameSet
 750 type Segment stmts = (Defs,
 751                       Uses,     -- May include defs
 752                       FwdRefs,  -- A subset of uses that are
 753                                 --   (a) used before they are bound in this segment, or
 754                                 --   (b) used here, and bound in subsequent segments
 755                       stmts)    -- Either Stmt or [Stmt]
 756
 757
 758 ----------------------------------------------------
 759 rnMDoStmts :: [LStmt RdrName]
 760            -> RnM (thing, FreeVars)
 761            -> RnM (([LStmt Name], thing), FreeVars)
 762 rnMDoStmts stmts thing_inside
 763   =     -- Step1: bring all the binders of the mdo into scope
 764         -- Remember that this also removes the binders from the
 765         -- finally-returned free-vars
 766     bindLocatedLocalsRn doc (collectLStmtsBinders stmts)        $ \ bndrs ->
 767     do  {
 768         -- Step 2: Rename each individual stmt, making a
 769         --         singleton segment.  At this stage the FwdRefs field
 770         --         isn't finished: it's empty for all except a BindStmt
 771         --         for which it's the fwd refs within the bind itself
 772         --         (This set may not be empty, because we're in a recursive
 773         --          context.)
 774           segs <- rn_rec_stmts bndrs stmts
 775
 776         ; (thing, fvs_later) <- thing_inside
 777
 778         ; let
 779         -- Step 3: Fill in the fwd refs.
 780         --         The segments are all singletons, but their fwd-ref
 781         --         field mentions all the things used by the segment
 782         --         that are bound after their use
 783             segs_w_fwd_refs = addFwdRefs segs
 784
 785         -- Step 4: Group together the segments to make bigger segments
 786         --         Invariant: in the result, no segment uses a variable
 787         --                    bound in a later segment
 788             grouped_segs = glomSegments segs_w_fwd_refs
 789
 790         -- Step 5: Turn the segments into Stmts
 791         --         Use RecStmt when and only when there are fwd refs
 792         --         Also gather up the uses from the end towards the
 793         --         start, so we can tell the RecStmt which things are
 794         --         used 'after' the RecStmt
 795             (stmts', fvs) = segsToStmts grouped_segs fvs_later
 796
 797         ; return ((stmts', thing), fvs) }
 798   where
 799     doc = text "In a recursive mdo-expression"
 800
 801 ---------------------------------------------
 802 rn_rec_stmts :: [Name] -> [LStmt RdrName] -> RnM [Segment (LStmt Name)]
 803 rn_rec_stmts bndrs stmts = mappM (rn_rec_stmt bndrs) stmts      `thenM` \ segs_s ->
 804                            returnM (concat segs_s)
 805
 806 ----------------------------------------------------
 807 rn_rec_stmt :: [Name] -> LStmt RdrName -> RnM [Segment (LStmt Name)]
 808         -- Rename a Stmt that is inside a RecStmt (or mdo)
 809         -- Assumes all binders are already in scope
 810         -- Turns each stmt into a singleton Stmt
 811
 812 rn_rec_stmt all_bndrs (L loc (ExprStmt expr _ _))
 813   = rnLExpr expr                `thenM` \ (expr', fvs) ->
 814     lookupSyntaxName thenMName  `thenM` \ (then_op, fvs1) ->
 815     returnM [(emptyNameSet, fvs `plusFV` fvs1, emptyNameSet,
 816               L loc (ExprStmt expr' then_op placeHolderType))]
 817
 818 rn_rec_stmt all_bndrs (L loc (BindStmt pat expr _ _))
 819   = rnLExpr expr                `thenM` \ (expr', fv_expr) ->
 820     rnLPat pat                  `thenM` \ (pat', fv_pat) ->
 821     lookupSyntaxName bindMName  `thenM` \ (bind_op, fvs1) ->
 822     lookupSyntaxName failMName  `thenM` \ (fail_op, fvs2) ->
 823     let
 824         bndrs = mkNameSet (collectPatBinders pat')
 825         fvs   = fv_expr `plusFV` fv_pat `plusFV` fvs1 `plusFV` fvs2
 826     in
 827     returnM [(bndrs, fvs, bndrs `intersectNameSet` fvs,
 828               L loc (BindStmt pat' expr' bind_op fail_op))]
 829
 830 rn_rec_stmt all_bndrs (L loc (LetStmt binds@(HsIPBinds _)))
 831   = do  { addErr (badIpBinds (ptext SLIT("an mdo expression")) binds)
 832         ; failM }
 833
 834 rn_rec_stmt all_bndrs (L loc (LetStmt (HsValBinds binds)))
 835   = rnValBinds (trimWith all_bndrs) binds       `thenM` \ (binds', du_binds) ->
 836     returnM [(duDefs du_binds, duUses du_binds,
 837               emptyNameSet, L loc (LetStmt (HsValBinds binds')))]
 838
 839 rn_rec_stmt all_bndrs (L loc (RecStmt stmts _ _ _ _))   -- Flatten Rec inside Rec
 840   = rn_rec_stmts all_bndrs stmts
 841
 842 rn_rec_stmt all_bndrs stmt@(L _ (ParStmt _))    -- Syntactically illegal in mdo
 843   = pprPanic "rn_rec_stmt" (ppr stmt)
 844
 845 ---------------------------------------------
 846 addFwdRefs :: [Segment a] -> [Segment a]
 847 -- So far the segments only have forward refs *within* the Stmt
 848 --      (which happens for bind:  x <- ...x...)
 849 -- This function adds the cross-seg fwd ref info
 850
 851 addFwdRefs pairs
 852   = fst (foldr mk_seg ([], emptyNameSet) pairs)
 853   where
 854     mk_seg (defs, uses, fwds, stmts) (segs, later_defs)
 855         = (new_seg : segs, all_defs)
 856         where
 857           new_seg = (defs, uses, new_fwds, stmts)
 858           all_defs = later_defs `unionNameSets` defs
 859           new_fwds = fwds `unionNameSets` (uses `intersectNameSet` later_defs)
 860                 -- Add the downstream fwd refs here
 861
 862 ----------------------------------------------------
 863 --      Glomming the singleton segments of an mdo into
 864 --      minimal recursive groups.
 865 --
 866 -- At first I thought this was just strongly connected components, but
 867 -- there's an important constraint: the order of the stmts must not change.
 868 --
 869 -- Consider
 870 --      mdo { x <- ...y...
 871 --            p <- z
 872 --            y <- ...x...
 873 --            q <- x
 874 --            z <- y
 875 --            r <- x }
 876 --
 877 -- Here, the first stmt mention 'y', which is bound in the third.
 878 -- But that means that the innocent second stmt (p <- z) gets caught
 879 -- up in the recursion.  And that in turn means that the binding for
 880 -- 'z' has to be included... and so on.
 881 --
 882 -- Start at the tail { r <- x }
 883 -- Now add the next one { z <- y ; r <- x }
 884 -- Now add one more     { q <- x ; z <- y ; r <- x }
 885 -- Now one more... but this time we have to group a bunch into rec
 886 --      { rec { y <- ...x... ; q <- x ; z <- y } ; r <- x }
 887 -- Now one more, which we can add on without a rec
 888 --      { p <- z ;
 889 --        rec { y <- ...x... ; q <- x ; z <- y } ;
 890 --        r <- x }
 891 -- Finally we add the last one; since it mentions y we have to
 892 -- glom it togeher with the first two groups
 893 --      { rec { x <- ...y...; p <- z ; y <- ...x... ;
 894 --              q <- x ; z <- y } ;
 895 --        r <- x }
 896
 897 glomSegments :: [Segment (LStmt Name)] -> [Segment [LStmt Name]]
 898
 899 glomSegments [] = []
 900 glomSegments ((defs,uses,fwds,stmt) : segs)
 901         -- Actually stmts will always be a singleton
 902   = (seg_defs, seg_uses, seg_fwds, seg_stmts)  : others
 903   where
 904     segs'            = glomSegments segs
 905     (extras, others) = grab uses segs'
 906     (ds, us, fs, ss) = unzip4 extras
 907
 908     seg_defs  = plusFVs ds `plusFV` defs
 909     seg_uses  = plusFVs us `plusFV` uses
 910     seg_fwds  = plusFVs fs `plusFV` fwds
 911     seg_stmts = stmt : concat ss
 912
 913     grab :: NameSet             -- The client
 914          -> [Segment a]
 915          -> ([Segment a],       -- Needed by the 'client'
 916              [Segment a])       -- Not needed by the client
 917         -- The result is simply a split of the input
 918     grab uses dus
 919         = (reverse yeses, reverse noes)
 920         where
 921           (noes, yeses)           = span not_needed (reverse dus)
 922           not_needed (defs,_,_,_) = not (intersectsNameSet defs uses)
 923
 924
 925 ----------------------------------------------------
 926 segsToStmts :: [Segment [LStmt Name]]
 927             -> FreeVars                 -- Free vars used 'later'
 928             -> ([LStmt Name], FreeVars)
 929
 930 segsToStmts [] fvs_later = ([], fvs_later)
 931 segsToStmts ((defs, uses, fwds, ss) : segs) fvs_later
 932   = ASSERT( not (null ss) )
 933     (new_stmt : later_stmts, later_uses `plusFV` uses)
 934   where
 935     (later_stmts, later_uses) = segsToStmts segs fvs_later
 936     new_stmt | non_rec   = head ss
 937              | otherwise = L (getLoc (head ss)) $
 938                            RecStmt ss (nameSetToList used_later) (nameSetToList fwds)
 939                                       [] emptyLHsBinds
 940              where
 941                non_rec    = isSingleton ss && isEmptyNameSet fwds
 942                used_later = defs `intersectNameSet` later_uses
 943                                 -- The ones needed after the RecStmt
 944 \end{code}
 945
 946 %************************************************************************
 947 %*                                                                      *
 948 \subsubsection{breakpoint utils}
 949 %*                                                                      *
 950 %************************************************************************
 951
 952 \begin{code}
 953 #if defined(GHCI) && defined(BREAKPOINT)
 954 mkBreakpointExpr :: [Name] -> RnM (HsExpr Name, FreeVars)
 955 mkBreakpointExpr = mkBreakpointExpr' breakpointJumpName
 956
 957 mkBreakpointCondExpr :: [Name] -> RnM (HsExpr Name, FreeVars)
 958 mkBreakpointCondExpr = mkBreakpointExpr' breakpointCondJumpName
 959
 960 mkBreakpointExpr' :: Name -> [Name] -> RnM (HsExpr Name, FreeVars)
 961 mkBreakpointExpr' breakpointFunc scope
 962     = do sloc <- getSrcSpanM
 963          undef <- lookupOccRn undefined_RDR
 964          let inLoc = L sloc
 965              lHsApp x y = inLoc (HsApp x y)
 966              mkExpr fnName args = mkExpr' fnName (reverse args)
 967              mkExpr' fnName [] = inLoc (HsVar fnName)
 968              mkExpr' fnName (arg:args)
 969                  = lHsApp (mkExpr' fnName args) (inLoc arg)
 970              expr = unLoc $ mkExpr breakpointFunc [mkScopeArg scope, HsVar undef, msg]
 971              mkScopeArg args = unLoc $ mkExpr undef (map HsVar args)
 972              msg = srcSpanLit sloc
 973          return (expr, emptyFVs)
 974
 975 srcSpanLit :: SrcSpan -> HsExpr Name
 976 srcSpanLit span = HsLit (HsString (mkFastString (showSDoc (ppr span))))
 977 #endif
 978
 979 srcSpanPrimLit :: SrcSpan -> HsExpr Name
 980 srcSpanPrimLit span = HsLit (HsStringPrim (mkFastString (showSDoc (ppr span))))
 981 \end{code}
 982
 983 %************************************************************************
 984 %*                                                                      *
 985 \subsubsection{Assertion utils}
 986 %*                                                                      *
 987 %************************************************************************
 988
 989 \begin{code}
 990 mkAssertErrorExpr :: RnM (HsExpr Name, FreeVars)
 991 -- Return an expression for (assertError "Foo.hs:27")
 992 mkAssertErrorExpr
 993   = getSrcSpanM                         `thenM` \ sloc ->
 994     let
 995         expr = HsApp (L sloc (HsVar assertErrorName))
 996                      (L sloc (srcSpanPrimLit sloc))
 997     in
 998     returnM (expr, emptyFVs)
 999 \end{code}
1000
1001 %************************************************************************
1002 %*                                                                      *
1003 \subsubsection{Errors}
1004 %*                                                                      *
1005 %************************************************************************
1006
1007 \begin{code}
1008 patSynErr e = do { addErr (sep [ptext SLIT("Pattern syntax in expression context:"),
1009                                 nest 4 (ppr e)])
1010                  ; return (EWildPat, emptyFVs) }
1011
1012 parStmtErr = addErr (ptext SLIT("Illegal parallel list comprehension: use -fglasgow-exts"))
1013
1014 badIpBinds what binds
1015   = hang (ptext SLIT("Implicit-parameter bindings illegal in") <+> what)
1016          2 (ppr binds)
1017 \end{code}