ghc/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         rnMatch, rnGRHSs, rnPat, rnExpr, rnExprs, rnStmt,
  15         checkPrecMatch
  16    ) where
  17
  18 #include "HsVersions.h"
  19
  20 import {-# SOURCE #-} RnBinds  ( rnBinds )
  21 import {-# SOURCE #-} RnSource ( rnHsTypeFVs )
  22
  23 import HsSyn
  24 import RdrHsSyn
  25 import RnHsSyn
  26 import RnMonad
  27 import RnEnv
  28 import RnHiFiles        ( lookupFixityRn )
  29 import RdrName          ( isRdrTyVar )
  30 import CmdLineOpts      ( DynFlag(..), opt_IgnoreAsserts )
  31 import Literal          ( inIntRange, inCharRange )
  32 import BasicTypes       ( Fixity(..), FixityDirection(..), defaultFixity, negateFixity )
  33 import PrelNames        ( hasKey, assertIdKey,
  34                           eqClass_RDR, foldr_RDR, build_RDR, eqString_RDR,
  35                           cCallableClass_RDR, cReturnableClass_RDR,
  36                           monadClass_RDR, enumClass_RDR, ordClass_RDR,
  37                           ratioDataCon_RDR, assertErr_RDR,
  38                           ioDataCon_RDR, plusInteger_RDR, timesInteger_RDR,
  39                         )
  40 import TysPrim          ( charPrimTyCon, addrPrimTyCon, intPrimTyCon,
  41                           floatPrimTyCon, doublePrimTyCon
  42                         )
  43 import TysWiredIn       ( intTyCon )
  44 import Name             ( NamedThing(..), mkSysLocalName, nameSrcLoc )
  45 import NameSet
  46 import UniqFM           ( isNullUFM )
  47 import FiniteMap        ( elemFM )
  48 import UniqSet          ( emptyUniqSet )
  49 import List             ( intersectBy )
  50 import ListSetOps       ( removeDups )
  51 import Outputable
  52 \end{code}
  53
  54
  55 *********************************************************
  56 *                                                       *
  57 \subsection{Patterns}
  58 *                                                       *
  59 *********************************************************
  60
  61 \begin{code}
  62 rnPat :: RdrNamePat -> RnMS (RenamedPat, FreeVars)
  63
  64 rnPat WildPatIn = returnRn (WildPatIn, emptyFVs)
  65
  66 rnPat (VarPatIn name)
  67   = lookupBndrRn  name                  `thenRn` \ vname ->
  68     returnRn (VarPatIn vname, emptyFVs)
  69
  70 rnPat (SigPatIn pat ty)
  71   = doptRn Opt_GlasgowExts `thenRn` \ glaExts ->
  72
  73     if glaExts
  74     then rnPat pat              `thenRn` \ (pat', fvs1) ->
  75          rnHsTypeFVs doc ty     `thenRn` \ (ty',  fvs2) ->
  76          returnRn (SigPatIn pat' ty', fvs1 `plusFV` fvs2)
  77
  78     else addErrRn (patSigErr ty)        `thenRn_`
  79          rnPat pat
  80   where
  81     doc = text "a pattern type-signature"
  82
  83 rnPat (LitPatIn s@(HsString _))
  84   = lookupOrigName eqString_RDR         `thenRn` \ eq ->
  85     returnRn (LitPatIn s, unitFV eq)
  86
  87 rnPat (LitPatIn lit)
  88   = litFVs lit          `thenRn` \ fvs ->
  89     returnRn (LitPatIn lit, fvs)
  90
  91 rnPat (NPatIn lit)
  92   = rnOverLit lit                       `thenRn` \ (lit', fvs1) ->
  93     lookupOrigName eqClass_RDR          `thenRn` \ eq   ->      -- Needed to find equality on pattern
  94     returnRn (NPatIn lit', fvs1 `addOneFV` eq)
  95
  96 rnPat (NPlusKPatIn name lit minus)
  97   = rnOverLit lit                       `thenRn` \ (lit', fvs) ->
  98     lookupOrigName ordClass_RDR         `thenRn` \ ord ->
  99     lookupBndrRn name                   `thenRn` \ name' ->
 100     lookupSyntaxName minus              `thenRn` \ minus' ->
 101     returnRn (NPlusKPatIn name' lit' minus', fvs `addOneFV` ord `addOneFV` minus')
 102
 103 rnPat (LazyPatIn pat)
 104   = rnPat pat           `thenRn` \ (pat', fvs) ->
 105     returnRn (LazyPatIn pat', fvs)
 106
 107 rnPat (AsPatIn name pat)
 108   = rnPat pat           `thenRn` \ (pat', fvs) ->
 109     lookupBndrRn name   `thenRn` \ vname ->
 110     returnRn (AsPatIn vname pat', fvs)
 111
 112 rnPat (ConPatIn con pats)
 113   = lookupOccRn con             `thenRn` \ con' ->
 114     mapFvRn rnPat pats          `thenRn` \ (patslist, fvs) ->
 115     returnRn (ConPatIn con' patslist, fvs `addOneFV` con')
 116
 117 rnPat (ConOpPatIn pat1 con _ pat2)
 118   = rnPat pat1          `thenRn` \ (pat1', fvs1) ->
 119     lookupOccRn con     `thenRn` \ con' ->
 120     rnPat pat2          `thenRn` \ (pat2', fvs2) ->
 121
 122     getModeRn           `thenRn` \ mode ->
 123         -- See comments with rnExpr (OpApp ...)
 124     (if isInterfaceMode mode
 125         then returnRn (ConOpPatIn pat1' con' defaultFixity pat2')
 126         else lookupFixityRn con'        `thenRn` \ fixity ->
 127              mkConOpPatRn pat1' con' fixity pat2'
 128     )                                                           `thenRn` \ pat' ->
 129     returnRn (pat', fvs1 `plusFV` fvs2 `addOneFV` con')
 130
 131 rnPat (ParPatIn pat)
 132   = rnPat pat           `thenRn` \ (pat', fvs) ->
 133     returnRn (ParPatIn pat', fvs)
 134
 135 rnPat (ListPatIn pats)
 136   = mapFvRn rnPat pats                  `thenRn` \ (patslist, fvs) ->
 137     returnRn (ListPatIn patslist, fvs `addOneFV` listTyCon_name)
 138
 139 rnPat (TuplePatIn pats boxed)
 140   = mapFvRn rnPat pats                                     `thenRn` \ (patslist, fvs) ->
 141     returnRn (TuplePatIn patslist boxed, fvs `addOneFV` tycon_name)
 142   where
 143     tycon_name = tupleTyCon_name boxed (length pats)
 144
 145 rnPat (RecPatIn con rpats)
 146   = lookupOccRn con     `thenRn` \ con' ->
 147     rnRpats rpats       `thenRn` \ (rpats', fvs) ->
 148     returnRn (RecPatIn con' rpats', fvs `addOneFV` con')
 149
 150 rnPat (TypePatIn name) =
 151     rnHsTypeFVs (text "type pattern") name      `thenRn` \ (name', fvs) ->
 152     returnRn (TypePatIn name', fvs)
 153 \end{code}
 154
 155 ************************************************************************
 156 *                                                                       *
 157 \subsection{Match}
 158 *                                                                       *
 159 ************************************************************************
 160
 161 \begin{code}
 162 rnMatch :: HsMatchContext RdrName -> RdrNameMatch -> RnMS (RenamedMatch, FreeVars)
 163
 164 rnMatch ctxt match@(Match _ pats maybe_rhs_sig grhss)
 165   = pushSrcLocRn (getMatchLoc match)    $
 166
 167         -- Bind pattern-bound type variables
 168     let
 169         rhs_sig_tys =  case maybe_rhs_sig of
 170                                 Nothing -> []
 171                                 Just ty -> [ty]
 172         pat_sig_tys = collectSigTysFromPats pats
 173         doc_sig     = text "In a result type-signature"
 174         doc_pat     = pprMatchContext ctxt
 175     in
 176     bindPatSigTyVars (rhs_sig_tys ++ pat_sig_tys)       $ \ sig_tyvars ->
 177
 178         -- Note that we do a single bindLocalsRn for all the
 179         -- matches together, so that we spot the repeated variable in
 180         --      f x x = 1
 181     bindLocalsFVRn doc_pat (collectPatsBinders pats)    $ \ new_binders ->
 182
 183     mapFvRn rnPat pats                  `thenRn` \ (pats', pat_fvs) ->
 184     rnGRHSs grhss                       `thenRn` \ (grhss', grhss_fvs) ->
 185     doptRn Opt_GlasgowExts              `thenRn` \ opt_GlasgowExts ->
 186     (case maybe_rhs_sig of
 187         Nothing -> returnRn (Nothing, emptyFVs)
 188         Just ty | opt_GlasgowExts -> rnHsTypeFVs doc_sig ty     `thenRn` \ (ty', ty_fvs) ->
 189                                      returnRn (Just ty', ty_fvs)
 190                 | otherwise       -> addErrRn (patSigErr ty)    `thenRn_`
 191                                      returnRn (Nothing, emptyFVs)
 192     )                                   `thenRn` \ (maybe_rhs_sig', ty_fvs) ->
 193
 194     let
 195         binder_set     = mkNameSet new_binders
 196         unused_binders = nameSetToList (binder_set `minusNameSet` grhss_fvs)
 197         all_fvs        = grhss_fvs `plusFV` pat_fvs `plusFV` ty_fvs
 198     in
 199     warnUnusedMatches unused_binders            `thenRn_`
 200
 201     returnRn (Match sig_tyvars pats' maybe_rhs_sig' grhss', all_fvs)
 202         -- The bindLocals and bindTyVars will remove the bound FVs
 203
 204
 205 bindPatSigTyVars :: [RdrNameHsType]
 206                  -> ([Name] -> RnMS (a, FreeVars))
 207                  -> RnMS (a, FreeVars)
 208   -- Find the type variables in the pattern type
 209   -- signatures that must be brought into scope
 210 bindPatSigTyVars tys thing_inside
 211   = getLocalNameEnv                     `thenRn` \ name_env ->
 212     let
 213         tyvars_in_sigs = extractSomeHsTysRdrNames isRdrTyVar tys
 214         forall_tyvars  = filter (not . (`elemFM` name_env)) tyvars_in_sigs
 215         doc_sig        = text "In a pattern type-signature"
 216     in
 217     bindNakedTyVarsFVRn doc_sig forall_tyvars thing_inside
 218 \end{code}
 219
 220 %************************************************************************
 221 %*                                                                      *
 222 \subsubsection{Guarded right-hand sides (GRHSs)}
 223 %*                                                                      *
 224 %************************************************************************
 225
 226 \begin{code}
 227 rnGRHSs :: RdrNameGRHSs -> RnMS (RenamedGRHSs, FreeVars)
 228
 229 rnGRHSs (GRHSs grhss binds _)
 230   = rnBinds binds               $ \ binds' ->
 231     mapFvRn rnGRHS grhss        `thenRn` \ (grhss', fvGRHSs) ->
 232     returnRn (GRHSs grhss' binds' placeHolderType, fvGRHSs)
 233
 234 rnGRHS (GRHS guarded locn)
 235   = doptRn Opt_GlasgowExts              `thenRn` \ opt_GlasgowExts ->
 236     pushSrcLocRn locn $
 237     (if not (opt_GlasgowExts || is_standard_guard guarded) then
 238                 addWarnRn (nonStdGuardErr guarded)
 239      else
 240                 returnRn ()
 241     )           `thenRn_`
 242
 243     rnStmts guarded     `thenRn` \ ((_, guarded'), fvs) ->
 244     returnRn (GRHS guarded' locn, fvs)
 245   where
 246         -- Standard Haskell 1.4 guards are just a single boolean
 247         -- expression, rather than a list of qualifiers as in the
 248         -- Glasgow extension
 249     is_standard_guard [ResultStmt _ _]                 = True
 250     is_standard_guard [ExprStmt _ _ _, ResultStmt _ _] = True
 251     is_standard_guard other                            = False
 252 \end{code}
 253
 254 %************************************************************************
 255 %*                                                                      *
 256 \subsubsection{Expressions}
 257 %*                                                                      *
 258 %************************************************************************
 259
 260 \begin{code}
 261 rnExprs :: [RdrNameHsExpr] -> RnMS ([RenamedHsExpr], FreeVars)
 262 rnExprs ls = rnExprs' ls emptyUniqSet
 263  where
 264   rnExprs' [] acc = returnRn ([], acc)
 265   rnExprs' (expr:exprs) acc
 266    = rnExpr expr                `thenRn` \ (expr', fvExpr) ->
 267
 268         -- Now we do a "seq" on the free vars because typically it's small
 269         -- or empty, especially in very long lists of constants
 270     let
 271         acc' = acc `plusFV` fvExpr
 272     in
 273     (grubby_seqNameSet acc' rnExprs') exprs acc'        `thenRn` \ (exprs', fvExprs) ->
 274     returnRn (expr':exprs', fvExprs)
 275
 276 -- Grubby little function to do "seq" on namesets; replace by proper seq when GHC can do seq
 277 grubby_seqNameSet ns result | isNullUFM ns = result
 278                             | otherwise    = result
 279 \end{code}
 280
 281 Variables. We look up the variable and return the resulting name.
 282
 283 \begin{code}
 284 rnExpr :: RdrNameHsExpr -> RnMS (RenamedHsExpr, FreeVars)
 285
 286 rnExpr (HsVar v)
 287   = lookupOccRn v       `thenRn` \ name ->
 288     if name `hasKey` assertIdKey then
 289         -- We expand it to (GHCerr.assert__ location)
 290         mkAssertExpr
 291     else
 292         -- The normal case
 293        returnRn (HsVar name, unitFV name)
 294
 295 rnExpr (HsIPVar v)
 296   = newIPName v                 `thenRn` \ name ->
 297     returnRn (HsIPVar name, emptyFVs)
 298
 299 rnExpr (HsLit lit)
 300   = litFVs lit          `thenRn` \ fvs ->
 301     returnRn (HsLit lit, fvs)
 302
 303 rnExpr (HsOverLit lit)
 304   = rnOverLit lit               `thenRn` \ (lit', fvs) ->
 305     returnRn (HsOverLit lit', fvs)
 306
 307 rnExpr (HsLam match)
 308   = rnMatch LambdaExpr match    `thenRn` \ (match', fvMatch) ->
 309     returnRn (HsLam match', fvMatch)
 310
 311 rnExpr (HsApp fun arg)
 312   = rnExpr fun          `thenRn` \ (fun',fvFun) ->
 313     rnExpr arg          `thenRn` \ (arg',fvArg) ->
 314     returnRn (HsApp fun' arg', fvFun `plusFV` fvArg)
 315
 316 rnExpr (OpApp e1 op _ e2)
 317   = rnExpr e1                           `thenRn` \ (e1', fv_e1) ->
 318     rnExpr e2                           `thenRn` \ (e2', fv_e2) ->
 319     rnExpr op                           `thenRn` \ (op'@(HsVar op_name), fv_op) ->
 320
 321         -- Deal with fixity
 322         -- When renaming code synthesised from "deriving" declarations
 323         -- we're in Interface mode, and we should ignore fixity; assume
 324         -- that the deriving code generator got the association correct
 325         -- Don't even look up the fixity when in interface mode
 326     getModeRn                           `thenRn` \ mode ->
 327     (if isInterfaceMode mode
 328         then returnRn (OpApp e1' op' defaultFixity e2')
 329         else lookupFixityRn op_name             `thenRn` \ fixity ->
 330              mkOpAppRn e1' op' fixity e2'
 331     )                                   `thenRn` \ final_e ->
 332
 333     returnRn (final_e,
 334               fv_e1 `plusFV` fv_op `plusFV` fv_e2)
 335
 336 rnExpr (NegApp e neg_name)
 337   = rnExpr e                    `thenRn` \ (e', fv_e) ->
 338     lookupSyntaxName neg_name   `thenRn` \ neg_name' ->
 339     mkNegAppRn e' neg_name'     `thenRn` \ final_e ->
 340     returnRn (final_e, fv_e `addOneFV` neg_name')
 341
 342 rnExpr (HsPar e)
 343   = rnExpr e            `thenRn` \ (e', fvs_e) ->
 344     returnRn (HsPar e', fvs_e)
 345
 346 rnExpr section@(SectionL expr op)
 347   = rnExpr expr                                 `thenRn` \ (expr', fvs_expr) ->
 348     rnExpr op                                   `thenRn` \ (op', fvs_op) ->
 349     checkSectionPrec "left" section op' expr'   `thenRn_`
 350     returnRn (SectionL expr' op', fvs_op `plusFV` fvs_expr)
 351
 352 rnExpr section@(SectionR op expr)
 353   = rnExpr op                                   `thenRn` \ (op',   fvs_op) ->
 354     rnExpr expr                                 `thenRn` \ (expr', fvs_expr) ->
 355     checkSectionPrec "right" section op' expr'  `thenRn_`
 356     returnRn (SectionR op' expr', fvs_op `plusFV` fvs_expr)
 357
 358 rnExpr (HsCCall fun args may_gc is_casm _)
 359         -- Check out the comment on RnIfaces.getNonWiredDataDecl about ccalls
 360   = lookupOrigNames [cCallableClass_RDR,
 361                           cReturnableClass_RDR,
 362                           ioDataCon_RDR]        `thenRn` \ implicit_fvs ->
 363     rnExprs args                                `thenRn` \ (args', fvs_args) ->
 364     returnRn (HsCCall fun args' may_gc is_casm placeHolderType,
 365               fvs_args `plusFV` implicit_fvs)
 366
 367 rnExpr (HsSCC lbl expr)
 368   = rnExpr expr         `thenRn` \ (expr', fvs_expr) ->
 369     returnRn (HsSCC lbl expr', fvs_expr)
 370
 371 rnExpr (HsCase expr ms src_loc)
 372   = pushSrcLocRn src_loc $
 373     rnExpr expr                         `thenRn` \ (new_expr, e_fvs) ->
 374     mapFvRn (rnMatch CaseAlt) ms        `thenRn` \ (new_ms, ms_fvs) ->
 375     returnRn (HsCase new_expr new_ms src_loc, e_fvs `plusFV` ms_fvs)
 376
 377 rnExpr (HsLet binds expr)
 378   = rnBinds binds               $ \ binds' ->
 379     rnExpr expr                  `thenRn` \ (expr',fvExpr) ->
 380     returnRn (HsLet binds' expr', fvExpr)
 381
 382 rnExpr (HsWith expr binds)
 383   = rnExpr expr                 `thenRn` \ (expr',fvExpr) ->
 384     rnIPBinds binds             `thenRn` \ (binds',fvBinds) ->
 385     returnRn (HsWith expr' binds', fvExpr `plusFV` fvBinds)
 386
 387 rnExpr e@(HsDo do_or_lc stmts src_loc)
 388   = pushSrcLocRn src_loc $
 389     lookupOrigNames implicit_rdr_names  `thenRn` \ implicit_fvs ->
 390     rnStmts stmts                       `thenRn` \ ((_, stmts'), fvs) ->
 391         -- check the statement list ends in an expression
 392     case last stmts' of {
 393         ResultStmt _ _ -> returnRn () ;
 394         _              -> addErrRn (doStmtListErr e)
 395     }                                   `thenRn_`
 396     returnRn (HsDo do_or_lc stmts' src_loc, fvs `plusFV` implicit_fvs)
 397   where
 398     implicit_rdr_names = [foldr_RDR, build_RDR, monadClass_RDR]
 399         -- Monad stuff should not be necessary for a list comprehension
 400         -- but the typechecker looks up the bind and return Ids anyway
 401         -- Oh well.
 402
 403
 404 rnExpr (ExplicitList _ exps)
 405   = rnExprs exps                        `thenRn` \ (exps', fvs) ->
 406     returnRn  (ExplicitList placeHolderType exps', fvs `addOneFV` listTyCon_name)
 407
 408 rnExpr (ExplicitTuple exps boxity)
 409   = rnExprs exps                                `thenRn` \ (exps', fvs) ->
 410     returnRn (ExplicitTuple exps' boxity, fvs `addOneFV` tycon_name)
 411   where
 412     tycon_name = tupleTyCon_name boxity (length exps)
 413
 414 rnExpr (RecordCon con_id rbinds)
 415   = lookupOccRn con_id                  `thenRn` \ conname ->
 416     rnRbinds "construction" rbinds      `thenRn` \ (rbinds', fvRbinds) ->
 417     returnRn (RecordCon conname rbinds', fvRbinds `addOneFV` conname)
 418
 419 rnExpr (RecordUpd expr rbinds)
 420   = rnExpr expr                 `thenRn` \ (expr', fvExpr) ->
 421     rnRbinds "update" rbinds    `thenRn` \ (rbinds', fvRbinds) ->
 422     returnRn (RecordUpd expr' rbinds', fvExpr `plusFV` fvRbinds)
 423
 424 rnExpr (ExprWithTySig expr pty)
 425   = rnExpr expr                                            `thenRn` \ (expr', fvExpr) ->
 426     rnHsTypeFVs (text "an expression type signature") pty  `thenRn` \ (pty', fvTy) ->
 427     returnRn (ExprWithTySig expr' pty', fvExpr `plusFV` fvTy)
 428
 429 rnExpr (HsIf p b1 b2 src_loc)
 430   = pushSrcLocRn src_loc $
 431     rnExpr p            `thenRn` \ (p', fvP) ->
 432     rnExpr b1           `thenRn` \ (b1', fvB1) ->
 433     rnExpr b2           `thenRn` \ (b2', fvB2) ->
 434     returnRn (HsIf p' b1' b2' src_loc, plusFVs [fvP, fvB1, fvB2])
 435
 436 rnExpr (HsType a)
 437   = rnHsTypeFVs doc a   `thenRn` \ (t, fvT) ->
 438     returnRn (HsType t, fvT)
 439   where
 440     doc = text "renaming a type pattern"
 441
 442 rnExpr (ArithSeqIn seq)
 443   = lookupOrigName enumClass_RDR        `thenRn` \ enum ->
 444     rn_seq seq                          `thenRn` \ (new_seq, fvs) ->
 445     returnRn (ArithSeqIn new_seq, fvs `addOneFV` enum)
 446   where
 447     rn_seq (From expr)
 448      = rnExpr expr      `thenRn` \ (expr', fvExpr) ->
 449        returnRn (From expr', fvExpr)
 450
 451     rn_seq (FromThen expr1 expr2)
 452      = rnExpr expr1     `thenRn` \ (expr1', fvExpr1) ->
 453        rnExpr expr2     `thenRn` \ (expr2', fvExpr2) ->
 454        returnRn (FromThen expr1' expr2', fvExpr1 `plusFV` fvExpr2)
 455
 456     rn_seq (FromTo expr1 expr2)
 457      = rnExpr expr1     `thenRn` \ (expr1', fvExpr1) ->
 458        rnExpr expr2     `thenRn` \ (expr2', fvExpr2) ->
 459        returnRn (FromTo expr1' expr2', fvExpr1 `plusFV` fvExpr2)
 460
 461     rn_seq (FromThenTo expr1 expr2 expr3)
 462      = rnExpr expr1     `thenRn` \ (expr1', fvExpr1) ->
 463        rnExpr expr2     `thenRn` \ (expr2', fvExpr2) ->
 464        rnExpr expr3     `thenRn` \ (expr3', fvExpr3) ->
 465        returnRn (FromThenTo expr1' expr2' expr3',
 466                   plusFVs [fvExpr1, fvExpr2, fvExpr3])
 467 \end{code}
 468
 469 These three are pattern syntax appearing in expressions.
 470 Since all the symbols are reservedops we can simply reject them.
 471 We return a (bogus) EWildPat in each case.
 472
 473 \begin{code}
 474 rnExpr e@EWildPat = addErrRn (patSynErr e)      `thenRn_`
 475                     returnRn (EWildPat, emptyFVs)
 476
 477 rnExpr e@(EAsPat _ _) = addErrRn (patSynErr e)  `thenRn_`
 478                         returnRn (EWildPat, emptyFVs)
 479
 480 rnExpr e@(ELazyPat _) = addErrRn (patSynErr e)  `thenRn_`
 481                         returnRn (EWildPat, emptyFVs)
 482 \end{code}
 483
 484
 485
 486 %************************************************************************
 487 %*                                                                      *
 488 \subsubsection{@Rbinds@s and @Rpats@s: in record expressions}
 489 %*                                                                      *
 490 %************************************************************************
 491
 492 \begin{code}
 493 rnRbinds str rbinds
 494   = mapRn_ field_dup_err dup_fields     `thenRn_`
 495     mapFvRn rn_rbind rbinds             `thenRn` \ (rbinds', fvRbind) ->
 496     returnRn (rbinds', fvRbind)
 497   where
 498     (_, dup_fields) = removeDups compare [ f | (f,_,_) <- rbinds ]
 499
 500     field_dup_err dups = addErrRn (dupFieldErr str dups)
 501
 502     rn_rbind (field, expr, pun)
 503       = lookupGlobalOccRn field `thenRn` \ fieldname ->
 504         rnExpr expr             `thenRn` \ (expr', fvExpr) ->
 505         returnRn ((fieldname, expr', pun), fvExpr `addOneFV` fieldname)
 506
 507 rnRpats rpats
 508   = mapRn_ field_dup_err dup_fields     `thenRn_`
 509     mapFvRn rn_rpat rpats               `thenRn` \ (rpats', fvs) ->
 510     returnRn (rpats', fvs)
 511   where
 512     (_, dup_fields) = removeDups compare [ f | (f,_,_) <- rpats ]
 513
 514     field_dup_err dups = addErrRn (dupFieldErr "pattern" dups)
 515
 516     rn_rpat (field, pat, pun)
 517       = lookupGlobalOccRn field `thenRn` \ fieldname ->
 518         rnPat pat               `thenRn` \ (pat', fvs) ->
 519         returnRn ((fieldname, pat', pun), fvs `addOneFV` fieldname)
 520 \end{code}
 521
 522 %************************************************************************
 523 %*                                                                      *
 524 \subsubsection{@rnIPBinds@s: in implicit parameter bindings}            *
 525 %*                                                                      *
 526 %************************************************************************
 527
 528 \begin{code}
 529 rnIPBinds [] = returnRn ([], emptyFVs)
 530 rnIPBinds ((n, expr) : binds)
 531   = newIPName n                 `thenRn` \ name ->
 532     rnExpr expr                 `thenRn` \ (expr',fvExpr) ->
 533     rnIPBinds binds             `thenRn` \ (binds',fvBinds) ->
 534     returnRn ((name, expr') : binds', fvExpr `plusFV` fvBinds)
 535
 536 \end{code}
 537
 538 %************************************************************************
 539 %*                                                                      *
 540 \subsubsection{@Stmt@s: in @do@ expressions}
 541 %*                                                                      *
 542 %************************************************************************
 543
 544 Note that although some bound vars may appear in the free var set for
 545 the first qual, these will eventually be removed by the caller. For
 546 example, if we have @[p | r <- s, q <- r, p <- q]@, when doing
 547 @[q <- r, p <- q]@, the free var set for @q <- r@ will
 548 be @{r}@, and the free var set for the entire Quals will be @{r}@. This
 549 @r@ will be removed only when we finally return from examining all the
 550 Quals.
 551
 552 \begin{code}
 553 rnStmts :: [RdrNameStmt]
 554         -> RnMS (([Name], [RenamedStmt]), FreeVars)
 555
 556 rnStmts []
 557   = returnRn (([], []), emptyFVs)
 558
 559 rnStmts (stmt:stmts)
 560   = getLocalNameEnv             `thenRn` \ name_env ->
 561     rnStmt stmt                         $ \ stmt' ->
 562     rnStmts stmts                       `thenRn` \ ((binders, stmts'), fvs) ->
 563     returnRn ((binders, stmt' : stmts'), fvs)
 564
 565 rnStmt :: RdrNameStmt
 566        -> (RenamedStmt -> RnMS (([Name], a), FreeVars))
 567        -> RnMS (([Name], a), FreeVars)
 568 -- The thing list of names returned is the list returned by the
 569 -- thing_inside, plus the binders of the arguments stmt
 570
 571 -- Because of mutual recursion we have to pass in rnExpr.
 572
 573 rnStmt (ParStmt stmtss) thing_inside
 574   = mapFvRn rnStmts stmtss              `thenRn` \ (bndrstmtss, fv_stmtss) ->
 575     let binderss = map fst bndrstmtss
 576         checkBndrs all_bndrs bndrs
 577           = checkRn (null (intersectBy eqOcc all_bndrs bndrs)) err `thenRn_`
 578             returnRn (bndrs ++ all_bndrs)
 579         eqOcc n1 n2 = nameOccName n1 == nameOccName n2
 580         err = text "duplicate binding in parallel list comprehension"
 581     in
 582     foldlRn checkBndrs [] binderss      `thenRn` \ new_binders ->
 583     bindLocalNamesFV new_binders        $
 584     thing_inside (ParStmtOut bndrstmtss)`thenRn` \ ((rest_bndrs, result), fv_rest) ->
 585     returnRn ((new_binders ++ rest_bndrs, result), fv_stmtss `plusFV` fv_rest)
 586
 587 rnStmt (BindStmt pat expr src_loc) thing_inside
 588   = pushSrcLocRn src_loc $
 589     rnExpr expr                                 `thenRn` \ (expr', fv_expr) ->
 590     bindPatSigTyVars (collectSigTysFromPat pat) $ \ sig_tyvars ->
 591     bindLocalsFVRn doc (collectPatBinders pat)  $ \ new_binders ->
 592     rnPat pat                                   `thenRn` \ (pat', fv_pat) ->
 593     thing_inside (BindStmt pat' expr' src_loc)  `thenRn` \ ((rest_binders, result), fvs) ->
 594     returnRn ((new_binders ++ rest_binders, result),
 595               fv_expr `plusFV` fvs `plusFV` fv_pat)
 596   where
 597     doc = text "In a pattern in 'do' binding"
 598
 599 rnStmt (ExprStmt expr _ src_loc) thing_inside
 600   = pushSrcLocRn src_loc $
 601     rnExpr expr                                                 `thenRn` \ (expr', fv_expr) ->
 602     thing_inside (ExprStmt expr' placeHolderType src_loc)       `thenRn` \ (result, fvs) ->
 603     returnRn (result, fv_expr `plusFV` fvs)
 604
 605 rnStmt (ResultStmt expr src_loc) thing_inside
 606   = pushSrcLocRn src_loc $
 607     rnExpr expr                                 `thenRn` \ (expr', fv_expr) ->
 608     thing_inside (ResultStmt expr' src_loc)     `thenRn` \ (result, fvs) ->
 609     returnRn (result, fv_expr `plusFV` fvs)
 610
 611 rnStmt (LetStmt binds) thing_inside
 612   = rnBinds binds                               $ \ binds' ->
 613     let new_binders = collectHsBinders binds' in
 614     thing_inside (LetStmt binds')    `thenRn` \ ((rest_binders, result), fvs) ->
 615     returnRn ((new_binders ++ rest_binders, result), fvs )
 616 \end{code}
 617
 618 %************************************************************************
 619 %*                                                                      *
 620 \subsubsection{Precedence Parsing}
 621 %*                                                                      *
 622 %************************************************************************
 623
 624 @mkOpAppRn@ deals with operator fixities.  The argument expressions
 625 are assumed to be already correctly arranged.  It needs the fixities
 626 recorded in the OpApp nodes, because fixity info applies to the things
 627 the programmer actually wrote, so you can't find it out from the Name.
 628
 629 Furthermore, the second argument is guaranteed not to be another
 630 operator application.  Why? Because the parser parses all
 631 operator appications left-associatively, EXCEPT negation, which
 632 we need to handle specially.
 633
 634 \begin{code}
 635 mkOpAppRn :: RenamedHsExpr                      -- Left operand; already rearranged
 636           -> RenamedHsExpr -> Fixity            -- Operator and fixity
 637           -> RenamedHsExpr                      -- Right operand (not an OpApp, but might
 638                                                 -- be a NegApp)
 639           -> RnMS RenamedHsExpr
 640
 641 ---------------------------
 642 -- (e11 `op1` e12) `op2` e2
 643 mkOpAppRn e1@(OpApp e11 op1 fix1 e12) op2 fix2 e2
 644   | nofix_error
 645   = addErrRn (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenRn_`
 646     returnRn (OpApp e1 op2 fix2 e2)
 647
 648   | associate_right
 649   = mkOpAppRn e12 op2 fix2 e2           `thenRn` \ new_e ->
 650     returnRn (OpApp e11 op1 fix1 new_e)
 651   where
 652     (nofix_error, associate_right) = compareFixity fix1 fix2
 653
 654 ---------------------------
 655 --      (- neg_arg) `op` e2
 656 mkOpAppRn e1@(NegApp neg_arg neg_name) op2 fix2 e2
 657   | nofix_error
 658   = addErrRn (precParseErr (pp_prefix_minus,negateFixity) (ppr_op op2,fix2))    `thenRn_`
 659     returnRn (OpApp e1 op2 fix2 e2)
 660
 661   | associate_right
 662   = mkOpAppRn neg_arg op2 fix2 e2       `thenRn` \ new_e ->
 663     returnRn (NegApp new_e neg_name)
 664   where
 665     (nofix_error, associate_right) = compareFixity negateFixity fix2
 666
 667 ---------------------------
 668 --      e1 `op` - neg_arg
 669 mkOpAppRn e1 op1 fix1 e2@(NegApp neg_arg _)     -- NegApp can occur on the right
 670   | not associate_right                         -- We *want* right association
 671   = addErrRn (precParseErr (ppr_op op1, fix1) (pp_prefix_minus, negateFixity))  `thenRn_`
 672     returnRn (OpApp e1 op1 fix1 e2)
 673   where
 674     (_, associate_right) = compareFixity fix1 negateFixity
 675
 676 ---------------------------
 677 --      Default case
 678 mkOpAppRn e1 op fix e2                  -- Default case, no rearrangment
 679   = ASSERT2( right_op_ok fix e2,
 680              ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2
 681     )
 682     returnRn (OpApp e1 op fix e2)
 683
 684 -- Parser left-associates everything, but
 685 -- derived instances may have correctly-associated things to
 686 -- in the right operarand.  So we just check that the right operand is OK
 687 right_op_ok fix1 (OpApp _ _ fix2 _)
 688   = not error_please && associate_right
 689   where
 690     (error_please, associate_right) = compareFixity fix1 fix2
 691 right_op_ok fix1 other
 692   = True
 693
 694 -- Parser initially makes negation bind more tightly than any other operator
 695 mkNegAppRn neg_arg neg_name
 696   =
 697 #ifdef DEBUG
 698     getModeRn                   `thenRn` \ mode ->
 699     ASSERT( not_op_app mode neg_arg )
 700 #endif
 701     returnRn (NegApp neg_arg neg_name)
 702
 703 not_op_app SourceMode (OpApp _ _ _ _) = False
 704 not_op_app mode other                 = True
 705 \end{code}
 706
 707 \begin{code}
 708 mkConOpPatRn :: RenamedPat -> Name -> Fixity -> RenamedPat
 709              -> RnMS RenamedPat
 710
 711 mkConOpPatRn p1@(ConOpPatIn p11 op1 fix1 p12)
 712              op2 fix2 p2
 713   | nofix_error
 714   = addErrRn (precParseErr (ppr_op op1,fix1) (ppr_op op2,fix2)) `thenRn_`
 715     returnRn (ConOpPatIn p1 op2 fix2 p2)
 716
 717   | associate_right
 718   = mkConOpPatRn p12 op2 fix2 p2                `thenRn` \ new_p ->
 719     returnRn (ConOpPatIn p11 op1 fix1 new_p)
 720
 721   where
 722     (nofix_error, associate_right) = compareFixity fix1 fix2
 723
 724 mkConOpPatRn p1 op fix p2                       -- Default case, no rearrangment
 725   = ASSERT( not_op_pat p2 )
 726     returnRn (ConOpPatIn p1 op fix p2)
 727
 728 not_op_pat (ConOpPatIn _ _ _ _) = False
 729 not_op_pat other                = True
 730 \end{code}
 731
 732 \begin{code}
 733 checkPrecMatch :: Bool -> Name -> RenamedMatch -> RnMS ()
 734
 735 checkPrecMatch False fn match
 736   = returnRn ()
 737
 738 checkPrecMatch True op (Match _ (p1:p2:_) _ _)
 739         -- True indicates an infix lhs
 740   = getModeRn           `thenRn` \ mode ->
 741         -- See comments with rnExpr (OpApp ...)
 742     if isInterfaceMode mode
 743         then returnRn ()
 744         else checkPrec op p1 False      `thenRn_`
 745              checkPrec op p2 True
 746
 747 checkPrecMatch True op _ = panic "checkPrecMatch"
 748
 749 checkPrec op (ConOpPatIn _ op1 _ _) right
 750   = lookupFixityRn op   `thenRn` \  op_fix@(Fixity op_prec  op_dir) ->
 751     lookupFixityRn op1  `thenRn` \ op1_fix@(Fixity op1_prec op1_dir) ->
 752     let
 753         inf_ok = op1_prec > op_prec ||
 754                  (op1_prec == op_prec &&
 755                   (op1_dir == InfixR && op_dir == InfixR && right ||
 756                    op1_dir == InfixL && op_dir == InfixL && not right))
 757
 758         info  = (ppr_op op,  op_fix)
 759         info1 = (ppr_op op1, op1_fix)
 760         (infol, infor) = if right then (info, info1) else (info1, info)
 761     in
 762     checkRn inf_ok (precParseErr infol infor)
 763
 764 checkPrec op pat right
 765   = returnRn ()
 766
 767 -- Check precedence of (arg op) or (op arg) respectively
 768 -- If arg is itself an operator application, its precedence should
 769 -- be higher than that of op
 770 checkSectionPrec left_or_right section op arg
 771   = case arg of
 772         OpApp _ op fix _ -> go_for_it (ppr_op op)     fix
 773         NegApp _ _       -> go_for_it pp_prefix_minus negateFixity
 774         other            -> returnRn ()
 775   where
 776     HsVar op_name = op
 777     go_for_it pp_arg_op arg_fix@(Fixity arg_prec _)
 778         = lookupFixityRn op_name        `thenRn` \ op_fix@(Fixity op_prec _) ->
 779           checkRn (op_prec < arg_prec)
 780                   (sectionPrecErr (ppr_op op_name, op_fix) (pp_arg_op, arg_fix) section)
 781 \end{code}
 782
 783 Consider
 784 \begin{verbatim}
 785         a `op1` b `op2` c
 786 \end{verbatim}
 787 @(compareFixity op1 op2)@ tells which way to arrange appication, or
 788 whether there's an error.
 789
 790 \begin{code}
 791 compareFixity :: Fixity -> Fixity
 792               -> (Bool,         -- Error please
 793                   Bool)         -- Associate to the right: a op1 (b op2 c)
 794 compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
 795   = case prec1 `compare` prec2 of
 796         GT -> left
 797         LT -> right
 798         EQ -> case (dir1, dir2) of
 799                         (InfixR, InfixR) -> right
 800                         (InfixL, InfixL) -> left
 801                         _                -> error_please
 802   where
 803     right        = (False, True)
 804     left         = (False, False)
 805     error_please = (True,  False)
 806 \end{code}
 807
 808 %************************************************************************
 809 %*                                                                      *
 810 \subsubsection{Literals}
 811 %*                                                                      *
 812 %************************************************************************
 813
 814 When literals occur we have to make sure
 815 that the types and classes they involve
 816 are made available.
 817
 818 \begin{code}
 819 litFVs (HsChar c)
 820    = checkRn (inCharRange c) (bogusCharError c) `thenRn_`
 821      returnRn (unitFV charTyCon_name)
 822
 823 litFVs (HsCharPrim c)         = returnRn (unitFV (getName charPrimTyCon))
 824 litFVs (HsString s)           = returnRn (mkFVs [listTyCon_name, charTyCon_name])
 825 litFVs (HsStringPrim s)       = returnRn (unitFV (getName addrPrimTyCon))
 826 litFVs (HsInt i)              = returnRn (unitFV (getName intTyCon))
 827 litFVs (HsIntPrim i)          = returnRn (unitFV (getName intPrimTyCon))
 828 litFVs (HsFloatPrim f)        = returnRn (unitFV (getName floatPrimTyCon))
 829 litFVs (HsDoublePrim d)       = returnRn (unitFV (getName doublePrimTyCon))
 830 litFVs (HsLitLit l bogus_ty)  = lookupOrigName cCallableClass_RDR       `thenRn` \ cc ->
 831                                 returnRn (unitFV cc)
 832 litFVs lit                    = pprPanic "RnExpr.litFVs" (ppr lit)      -- HsInteger and HsRat only appear
 833                                                                         -- in post-typechecker translations
 834
 835 rnOverLit (HsIntegral i from_integer_name)
 836   = lookupSyntaxName from_integer_name  `thenRn` \ from_integer_name' ->
 837     if inIntRange i then
 838         returnRn (HsIntegral i from_integer_name', unitFV from_integer_name')
 839     else
 840         lookupOrigNames [plusInteger_RDR, timesInteger_RDR]     `thenRn` \ ns ->
 841         -- Big integer literals are built, using + and *,
 842         -- out of small integers (DsUtils.mkIntegerLit)
 843         -- [NB: plusInteger, timesInteger aren't rebindable...
 844         --      they are used to construct the argument to fromInteger,
 845         --      which is the rebindable one.]
 846     returnRn (HsIntegral i from_integer_name', ns `addOneFV` from_integer_name')
 847
 848 rnOverLit (HsFractional i from_rat_name)
 849   = lookupSyntaxName from_rat_name                                              `thenRn` \ from_rat_name' ->
 850     lookupOrigNames [ratioDataCon_RDR, plusInteger_RDR, timesInteger_RDR]       `thenRn` \ ns ->
 851         -- We have to make sure that the Ratio type is imported with
 852         -- its constructor, because literals of type Ratio t are
 853         -- built with that constructor.
 854         -- The Rational type is needed too, but that will come in
 855         -- when fractionalClass does.
 856         -- The plus/times integer operations may be needed to construct the numerator
 857         -- and denominator (see DsUtils.mkIntegerLit)
 858     returnRn (HsFractional i from_rat_name', ns `addOneFV` from_rat_name')
 859 \end{code}
 860
 861 %************************************************************************
 862 %*                                                                      *
 863 \subsubsection{Assertion utils}
 864 %*                                                                      *
 865 %************************************************************************
 866
 867 \begin{code}
 868 mkAssertExpr :: RnMS (RenamedHsExpr, FreeVars)
 869 mkAssertExpr =
 870   lookupOrigName assertErr_RDR          `thenRn` \ name ->
 871   getSrcLocRn                           `thenRn` \ sloc ->
 872
 873     -- if we're ignoring asserts, return (\ _ e -> e)
 874     -- if not, return (assertError "src-loc")
 875
 876   if opt_IgnoreAsserts then
 877     getUniqRn                           `thenRn` \ uniq ->
 878     let
 879      vname = mkSysLocalName uniq SLIT("v")
 880      expr  = HsLam ignorePredMatch
 881      loc   = nameSrcLoc vname
 882      ignorePredMatch = mkSimpleMatch [WildPatIn, VarPatIn vname] (HsVar vname) placeHolderType loc
 883     in
 884     returnRn (expr, unitFV name)
 885   else
 886     let
 887      expr =
 888           HsApp (HsVar name)
 889                 (HsLit (HsString (_PK_ (showSDoc (ppr sloc)))))
 890
 891     in
 892     returnRn (expr, unitFV name)
 893
 894 \end{code}
 895
 896 %************************************************************************
 897 %*                                                                      *
 898 \subsubsection{Errors}
 899 %*                                                                      *
 900 %************************************************************************
 901
 902 \begin{code}
 903 ppr_op op = quotes (ppr op)     -- Here, op can be a Name or a (Var n), where n is a Name
 904 ppr_opfix (pp_op, fixity) = pp_op <+> brackets (ppr fixity)
 905 pp_prefix_minus = ptext SLIT("prefix `-'")
 906
 907 dupFieldErr str (dup:rest)
 908   = hsep [ptext SLIT("duplicate field name"),
 909           quotes (ppr dup),
 910           ptext SLIT("in record"), text str]
 911
 912 precParseErr op1 op2
 913   = hang (ptext SLIT("precedence parsing error"))
 914       4 (hsep [ptext SLIT("cannot mix"), ppr_opfix op1, ptext SLIT("and"),
 915                ppr_opfix op2,
 916                ptext SLIT("in the same infix expression")])
 917
 918 sectionPrecErr op arg_op section
 919  = vcat [ptext SLIT("The operator") <+> ppr_opfix op <+> ptext SLIT("of a section"),
 920          nest 4 (ptext SLIT("must have lower precedence than the operand") <+> ppr_opfix arg_op),
 921          nest 4 (ptext SLIT("in the section:") <+> quotes (ppr section))]
 922
 923 nonStdGuardErr guard
 924   = hang (ptext
 925     SLIT("accepting non-standard pattern guards (-fglasgow-exts to suppress this message)")
 926     ) 4 (ppr guard)
 927
 928 patSigErr ty
 929   =  (ptext SLIT("Illegal signature in pattern:") <+> ppr ty)
 930         $$ nest 4 (ptext SLIT("Use -fglasgow-exts to permit it"))
 931
 932 patSynErr e
 933   = sep [ptext SLIT("Pattern syntax in expression context:"),
 934          nest 4 (ppr e)]
 935
 936 doStmtListErr e
 937   = sep [ptext SLIT("`do' statements must end in expression:"),
 938          nest 4 (ppr e)]
 939
 940 bogusCharError c
 941   = ptext SLIT("character literal out of range: '\\") <> int c <> char '\''
 942 \end{code}