ghc/compiler/rename/RnExpr4.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[RnExpr4]{Renaming of expressions (pass 4)}
   5
   6 Basically dependency analysis.
   7
   8 Handles @Match@, @GRHSsAndBinds@, @HsExpr@, and @Qual@ datatypes.  In
   9 general, all of these functions return a renamed thing, and a set of
  10 free variables.
  11
  12 \begin{code}
  13 #include "HsVersions.h"
  14
  15 module RnExpr4 (
  16         rnMatch, rnGRHSsAndBinds, rnPat
  17
  18         -- and to make the interface self-sufficient...
  19    ) where
  20
  21 import Ubiq{-uitous-}
  22 import RnLoop           -- break the RnPass4/RnExpr4/RnBinds4 loops
  23
  24 import HsSyn
  25 import RdrHsSyn
  26 import RnHsSyn
  27 import RnMonad4
  28
  29 -- others:
  30 import Name             ( Name(..) )
  31 import NameTypes        ( FullName{-instances-} )
  32 import Outputable       ( isConop )
  33 import UniqSet          ( emptyUniqSet, singletonUniqSet,
  34                           unionUniqSets, unionManyUniqSets,
  35                           UniqSet(..)
  36                         )
  37 import Util             ( panic )
  38 \end{code}
  39
  40
  41 *********************************************************
  42 *                                                       *
  43 \subsection{Patterns}
  44 *                                                       *
  45 *********************************************************
  46
  47 \begin{code}
  48 rnPat ::  ProtoNamePat -> Rn4M RenamedPat
  49
  50 rnPat WildPatIn = returnRn4 WildPatIn
  51
  52 rnPat (VarPatIn name)
  53   = lookupValue name    `thenRn4` \ vname ->
  54     returnRn4 (VarPatIn vname)
  55
  56 rnPat (LitPatIn n) = returnRn4 (LitPatIn n)
  57
  58 rnPat (LazyPatIn pat)
  59   = rnPat pat   `thenRn4` \ pat' ->
  60     returnRn4 (LazyPatIn pat')
  61
  62 rnPat (AsPatIn name pat)
  63   = rnPat pat   `thenRn4` \ pat' ->
  64     lookupValue name    `thenRn4` \ vname ->
  65     returnRn4 (AsPatIn vname pat')
  66
  67 rnPat (ConPatIn name pats)
  68   = lookupValue name        `thenRn4` \ name' ->
  69     mapRn4 rnPat pats  `thenRn4` \ patslist ->
  70     returnRn4 (ConPatIn name' patslist)
  71
  72 rnPat (ConOpPatIn pat1 name pat2)
  73   = lookupValue name    `thenRn4` \ name' ->
  74     rnPat pat1  `thenRn4` \ pat1' ->
  75     rnPat pat2  `thenRn4` \ pat2' ->
  76     returnRn4 (ConOpPatIn pat1' name' pat2')
  77
  78 rnPat (ListPatIn pats)
  79   = mapRn4 rnPat pats `thenRn4` \ patslist ->
  80     returnRn4 (ListPatIn patslist)
  81
  82 rnPat (TuplePatIn pats)
  83   = mapRn4 rnPat pats `thenRn4` \ patslist ->
  84     returnRn4 (TuplePatIn patslist)
  85
  86 rnPat (RecPatIn con rpats)
  87   = panic "rnPat:RecPatIn"
  88
  89 \end{code}
  90
  91 ************************************************************************
  92 *                                                                       *
  93 \subsection{Match}
  94 *                                                                       *
  95 ************************************************************************
  96
  97 \begin{code}
  98 rnMatch :: ProtoNameMatch -> Rn4M (RenamedMatch, FreeVars)
  99
 100 rnMatch match
 101   = getSrcLocRn4                        `thenRn4` \ src_loc ->
 102     namesFromProtoNames "variable in pattern"
 103          (binders `zip` repeat src_loc) `thenRn4` \ new_binders ->
 104     extendSS2 new_binders (rnMatch_aux match)
 105   where
 106     binders = collect_binders match
 107
 108     collect_binders :: ProtoNameMatch -> [ProtoName]
 109
 110     collect_binders (GRHSMatch _) = []
 111     collect_binders (PatMatch pat match)
 112       = collectPatBinders pat ++ collect_binders match
 113
 114 rnMatch_aux (PatMatch pat match)
 115   = rnPat pat           `thenRn4` \ pat' ->
 116     rnMatch_aux match   `thenRn4` \ (match', fvMatch) ->
 117     returnRn4 (PatMatch pat' match', fvMatch)
 118
 119 rnMatch_aux (GRHSMatch grhss_and_binds)
 120   = rnGRHSsAndBinds grhss_and_binds `thenRn4` \ (grhss_and_binds', fvs) ->
 121     returnRn4 (GRHSMatch grhss_and_binds', fvs)
 122 \end{code}
 123
 124 %************************************************************************
 125 %*                                                                      *
 126 \subsubsection{Guarded right-hand sides (GRHSsAndBinds)}
 127 %*                                                                      *
 128 %************************************************************************
 129
 130 \begin{code}
 131 rnGRHSsAndBinds :: ProtoNameGRHSsAndBinds -> Rn4M (RenamedGRHSsAndBinds, FreeVars)
 132
 133 rnGRHSsAndBinds (GRHSsAndBindsIn grhss binds)
 134   = rnBinds binds                       `thenRn4` \ (binds', fvBinds, scope) ->
 135     extendSS2 scope (rnGRHSs grhss)     `thenRn4` \ (grhss', fvGRHS) ->
 136     returnRn4 (GRHSsAndBindsIn grhss' binds', fvBinds `unionUniqSets` fvGRHS)
 137   where
 138     rnGRHSs [] = returnRn4 ([], emptyUniqSet)
 139
 140     rnGRHSs (grhs:grhss)
 141       = rnGRHS  grhs   `thenRn4` \ (grhs',  fvs) ->
 142         rnGRHSs grhss  `thenRn4` \ (grhss', fvss) ->
 143         returnRn4 (grhs' : grhss', fvs `unionUniqSets` fvss)
 144
 145     rnGRHS (GRHS guard expr locn)
 146       = pushSrcLocRn4 locn                                (
 147         rnExpr guard   `thenRn4` \ (guard', fvsg) ->
 148         rnExpr expr     `thenRn4` \ (expr',  fvse) ->
 149         returnRn4 (GRHS guard' expr' locn, fvsg `unionUniqSets` fvse)
 150         )
 151
 152     rnGRHS (OtherwiseGRHS expr locn)
 153       = pushSrcLocRn4 locn                                (
 154         rnExpr expr     `thenRn4` \ (expr', fvs) ->
 155         returnRn4 (OtherwiseGRHS expr' locn, fvs)
 156         )
 157 \end{code}
 158
 159 %************************************************************************
 160 %*                                                                      *
 161 \subsubsection{Expressions}
 162 %*                                                                      *
 163 %************************************************************************
 164
 165 \begin{code}
 166 rnExprs :: [ProtoNameHsExpr] -> Rn4M ([RenamedHsExpr], FreeVars)
 167
 168 rnExprs [] = returnRn4 ([], emptyUniqSet)
 169
 170 rnExprs (expr:exprs)
 171   = rnExpr expr         `thenRn4` \ (expr', fvExpr) ->
 172     rnExprs exprs       `thenRn4` \ (exprs', fvExprs) ->
 173     returnRn4 (expr':exprs', fvExpr `unionUniqSets` fvExprs)
 174 \end{code}
 175
 176 Variables. We look up the variable and return the resulting name.  The
 177 interesting question is what the free-variable set should be.  We
 178 don't want to return imported or prelude things as free vars.  So we
 179 look at the Name returned from the lookup, and make it part of the
 180 free-var set iff:
 181 \begin{itemize}
 182 \item
 183 if it's a @Short@,
 184 \item
 185 or it's an @ValName@ and it's defined in this module
 186 (this includes locally-defined constructrs, but that's too bad)
 187 \end{itemize}
 188
 189 \begin{code}
 190 rnExpr :: ProtoNameHsExpr -> Rn4M (RenamedHsExpr, FreeVars)
 191
 192 rnExpr (HsVar v)
 193   = lookupValue v       `thenRn4` \ vname ->
 194     returnRn4 (HsVar vname, fv_set vname)
 195   where
 196     fv_set n@(Short uniq sname)     = singletonUniqSet n
 197     fv_set n@(ValName uniq fname)
 198           | isLocallyDefined fname
 199           && not (isConop (getOccurrenceName fname))
 200                                     = singletonUniqSet n
 201     fv_set other                    = emptyUniqSet
 202
 203 rnExpr (HsLit lit)  = returnRn4 (HsLit lit, emptyUniqSet)
 204
 205 rnExpr (HsLam match)
 206   = rnMatch match       `thenRn4` \ (match', fvMatch) ->
 207     returnRn4 (HsLam match', fvMatch)
 208
 209 rnExpr (HsApp fun arg)
 210   = rnExpr fun          `thenRn4` \ (fun',fvFun) ->
 211     rnExpr arg          `thenRn4` \ (arg',fvArg) ->
 212     returnRn4 (HsApp fun' arg', fvFun `unionUniqSets` fvArg)
 213
 214 rnExpr (OpApp e1 op e2)
 215   = rnExpr e1           `thenRn4` \ (e1', fvs_e1) ->
 216     rnExpr op           `thenRn4` \ (op', fvs_op) ->
 217     rnExpr e2           `thenRn4` \ (e2', fvs_e2) ->
 218     returnRn4 (OpApp e1' op' e2', (fvs_op `unionUniqSets` fvs_e1) `unionUniqSets` fvs_e2)
 219
 220 rnExpr (SectionL expr op)
 221   = rnExpr expr         `thenRn4` \ (expr', fvs_expr) ->
 222     rnExpr op           `thenRn4` \ (op', fvs_op) ->
 223     returnRn4 (SectionL expr' op', fvs_op `unionUniqSets` fvs_expr)
 224
 225 rnExpr (SectionR op expr)
 226   = rnExpr op           `thenRn4` \ (op',   fvs_op) ->
 227     rnExpr expr         `thenRn4` \ (expr', fvs_expr) ->
 228     returnRn4 (SectionR op' expr', fvs_op `unionUniqSets` fvs_expr)
 229
 230 rnExpr (CCall fun args may_gc is_casm fake_result_ty)
 231   = rnExprs args         `thenRn4` \ (args', fvs_args) ->
 232     returnRn4 (CCall fun args' may_gc is_casm fake_result_ty, fvs_args)
 233
 234 rnExpr (HsSCC label expr)
 235   = rnExpr expr         `thenRn4` \ (expr', fvs_expr) ->
 236     returnRn4 (HsSCC label expr', fvs_expr)
 237
 238 rnExpr (HsCase expr ms src_loc)
 239   = pushSrcLocRn4 src_loc $
 240     rnExpr expr                 `thenRn4` \ (new_expr, e_fvs) ->
 241     mapAndUnzipRn4 rnMatch ms   `thenRn4` \ (new_ms, ms_fvs) ->
 242     returnRn4 (HsCase new_expr new_ms src_loc, unionManyUniqSets (e_fvs : ms_fvs))
 243
 244 rnExpr (HsLet binds expr)
 245   = rnBinds binds               `thenRn4` \ (binds', fvBinds, new_binders) ->
 246     extendSS2 new_binders (rnExpr expr) `thenRn4` \ (expr',fvExpr) ->
 247     returnRn4 (HsLet binds' expr', fvBinds `unionUniqSets` fvExpr)
 248
 249 rnExpr (HsDo stmts src_loc)
 250   = pushSrcLocRn4 src_loc $
 251     rnStmts stmts               `thenRn4` \ (stmts', fvStmts) ->
 252     returnRn4 (HsDo stmts' src_loc, fvStmts)
 253
 254 rnExpr (ListComp expr quals)
 255   = rnQuals quals               `thenRn4` \ ((quals', qual_binders), fvQuals) ->
 256     extendSS2 qual_binders (rnExpr expr) `thenRn4` \ (expr', fvExpr) ->
 257     returnRn4 (ListComp expr' quals', fvExpr `unionUniqSets` fvQuals)
 258
 259 rnExpr (ExplicitList exps)
 260   = rnExprs exps         `thenRn4` \ (exps', fvs) ->
 261     returnRn4  (ExplicitList exps', fvs)
 262
 263 rnExpr (ExplicitTuple exps)
 264   = rnExprs exps         `thenRn4` \ (exps', fvExps) ->
 265     returnRn4 (ExplicitTuple exps', fvExps)
 266
 267 rnExpr (RecordCon con rbinds)
 268   = panic "rnExpr:RecordCon"
 269 rnExpr (RecordUpd exp rbinds)
 270   = panic "rnExpr:RecordUpd"
 271
 272 rnExpr (ExprWithTySig expr pty)
 273   = rnExpr expr                     `thenRn4` \ (expr', fvExpr) ->
 274     rnPolyType False nullTyVarNamesEnv pty `thenRn4` \ pty' ->
 275     returnRn4 (ExprWithTySig expr' pty', fvExpr)
 276
 277 rnExpr (HsIf p b1 b2 src_loc)
 278   = pushSrcLocRn4 src_loc $
 279     rnExpr p    `thenRn4` \ (p', fvP) ->
 280     rnExpr b1   `thenRn4` \ (b1', fvB1) ->
 281     rnExpr b2   `thenRn4` \ (b2', fvB2) ->
 282     returnRn4 (HsIf p' b1' b2' src_loc, unionManyUniqSets [fvP, fvB1, fvB2])
 283
 284 rnExpr (ArithSeqIn seq)
 285   = rn_seq seq `thenRn4` \ (new_seq, fvs) ->
 286     returnRn4 (ArithSeqIn new_seq, fvs)
 287   where
 288     rn_seq (From expr)
 289      = rnExpr expr       `thenRn4` \ (expr', fvExpr) ->
 290        returnRn4 (From expr', fvExpr)
 291
 292     rn_seq (FromThen expr1 expr2)
 293      = rnExpr expr1      `thenRn4` \ (expr1', fvExpr1) ->
 294        rnExpr expr2      `thenRn4` \ (expr2', fvExpr2) ->
 295        returnRn4 (FromThen expr1' expr2', fvExpr1 `unionUniqSets` fvExpr2)
 296
 297     rn_seq (FromTo expr1 expr2)
 298      = rnExpr expr1      `thenRn4` \ (expr1', fvExpr1) ->
 299        rnExpr expr2      `thenRn4` \ (expr2', fvExpr2) ->
 300        returnRn4 (FromTo expr1' expr2', fvExpr1 `unionUniqSets` fvExpr2)
 301
 302     rn_seq (FromThenTo expr1 expr2 expr3)
 303      = rnExpr expr1      `thenRn4` \ (expr1', fvExpr1) ->
 304        rnExpr expr2      `thenRn4` \ (expr2', fvExpr2) ->
 305        rnExpr expr3      `thenRn4` \ (expr3', fvExpr3) ->
 306        returnRn4 (FromThenTo expr1' expr2' expr3',
 307                   unionManyUniqSets [fvExpr1, fvExpr2, fvExpr3])
 308
 309 \end{code}
 310
 311 %************************************************************************
 312 %*                                                                      *
 313 \subsubsection{@Qual@s: in list comprehensions}
 314 %*                                                                      *
 315 %************************************************************************
 316
 317 Note that although some bound vars may appear in the free var set for
 318 the first qual, these will eventually be removed by the caller. For
 319 example, if we have @[p | r <- s, q <- r, p <- q]@, when doing
 320 @[q <- r, p <- q]@, the free var set for @q <- r@ will
 321 be @{r}@, and the free var set for the entire Quals will be @{r}@. This
 322 @r@ will be removed only when we finally return from examining all the
 323 Quals.
 324
 325 \begin{code}
 326 rnQuals :: [ProtoNameQual]
 327          -> Rn4M (([RenamedQual],       -- renamed qualifiers
 328                   [Name]),              -- qualifiers' binders
 329                   FreeVars)             -- free variables
 330
 331 rnQuals [qual]                          -- must be at least one qual
 332   = rnQual qual `thenRn4` \ ((new_qual, bs), fvs) ->
 333     returnRn4 (([new_qual], bs), fvs)
 334
 335 rnQuals (qual: quals)
 336   = rnQual qual                         `thenRn4` \ ((qual',  bs1), fvQuals1) ->
 337     extendSS2 bs1 (rnQuals quals)       `thenRn4` \ ((quals', bs2), fvQuals2) ->
 338     returnRn4
 339        ((qual' : quals', bs2 ++ bs1),   -- The ones on the right (bs2) shadow the
 340                                         -- ones on the left (bs1)
 341         fvQuals1 `unionUniqSets` fvQuals2)
 342
 343 rnQual (GeneratorQual pat expr)
 344   = rnExpr expr          `thenRn4` \ (expr', fvExpr) ->
 345     let
 346         binders = collectPatBinders pat
 347     in
 348     getSrcLocRn4                 `thenRn4` \ src_loc ->
 349     namesFromProtoNames "variable in list-comprehension-generator pattern"
 350          (binders `zip` repeat src_loc)   `thenRn4` \ new_binders ->
 351     extendSS new_binders (rnPat pat) `thenRn4` \ pat' ->
 352
 353     returnRn4 ((GeneratorQual pat' expr', new_binders), fvExpr)
 354
 355 rnQual (FilterQual expr)
 356   = rnExpr expr  `thenRn4` \ (expr', fvs) ->
 357     returnRn4 ((FilterQual expr', []), fvs)
 358
 359 rnQual (LetQual binds)
 360   = rnBinds binds       `thenRn4` \ (binds', binds_fvs, new_binders) ->
 361     returnRn4 ((LetQual binds', new_binders), binds_fvs)
 362 \end{code}
 363
 364
 365 %************************************************************************
 366 %*                                                                      *
 367 \subsubsection{@Stmt@s: in @do@ expressions}
 368 %*                                                                      *
 369 %************************************************************************
 370
 371 \begin{code}
 372 rnStmts :: [ProtoNameStmt]
 373         -> Rn4M ([RenamedStmt],         -- renamed qualifiers
 374                  FreeVars)              -- free variables
 375
 376 rnStmts [stmt@(ExprStmt _ _)]           -- last stmt must be ExprStmt
 377   = rnStmt stmt                         `thenRn4` \ ((stmt',[]), fvStmt) ->
 378     returnRn4 ([stmt'], fvStmt)
 379
 380 rnStmts (stmt:stmts)
 381   = rnStmt stmt                         `thenRn4` \ ((stmt',bs), fvStmt) ->
 382     extendSS2 bs (rnStmts stmts)        `thenRn4` \ (stmts',     fvStmts) ->
 383     returnRn4 (stmt':stmts', fvStmt `unionUniqSets` fvStmts)
 384
 385
 386 rnStmt (BindStmt pat expr src_loc)
 387   = pushSrcLocRn4 src_loc $
 388     rnExpr expr                         `thenRn4` \ (expr', fvExpr) ->
 389     let
 390         binders = collectPatBinders pat
 391     in
 392     namesFromProtoNames "variable in do binding"
 393          (binders `zip` repeat src_loc) `thenRn4` \ new_binders ->
 394     extendSS new_binders (rnPat pat)    `thenRn4` \ pat' ->
 395
 396     returnRn4 ((BindStmt pat' expr' src_loc, new_binders), fvExpr)
 397
 398 rnStmt (ExprStmt expr src_loc)
 399   =
 400     rnExpr expr                         `thenRn4` \ (expr', fvs) ->
 401     returnRn4 ((ExprStmt expr' src_loc, []), fvs)
 402
 403 rnStmt (LetStmt binds)
 404   = rnBinds binds       `thenRn4` \ (binds', binds_fvs, new_binders) ->
 405     returnRn4 ((LetStmt binds', new_binders), binds_fvs)
 406
 407 \end{code}