+ rn_env = me_env menv
+ unfolding = idUnfolding (lookupRnInScope rn_env (rnOccR rn_env v2))
+ -- Notice that we look up v2 in the in-scope set
+ -- See Note [Lookup in-scope]
+ -- Remember to apply any renaming first (hence rnOccR)
+
+-- Note [Matching lets]
+-- ~~~~~~~~~~~~~~~~~~~~
+-- Matching a let-expression. Consider
+-- RULE forall x. f (g x) = <rhs>
+-- and target expression
+-- f (let { w=R } in g E))
+-- Then we'd like the rule to match, to generate
+-- let { w=R } in (\x. <rhs>) E
+-- In effect, we want to float the let-binding outward, to enable
+-- the match to happen. This is the WHOLE REASON for accumulating
+-- bindings in the SubstEnv
+--
+-- We can only do this if
+-- (a) Widening the scope of w does not capture any variables
+-- We use a conservative test: w is not already in scope
+-- If not, we clone the binders, and substitute
+-- (b) The free variables of R are not bound by the part of the
+-- target expression outside the let binding; e.g.
+-- f (\v. let w = v+1 in g E)
+-- Here we obviously cannot float the let-binding for w.
+--
+-- You may think rule (a) would never apply, because rule matching is
+-- mostly invoked from the simplifier, when we have just run substExpr
+-- over the argument, so there will be no shadowing anyway.
+-- The fly in the ointment is that the forall'd variables of the
+-- RULE itself are considered in scope.
+--
+-- I though of various cheapo ways to solve this tiresome problem,
+-- but ended up doing the straightforward thing, which is to
+-- clone the binders if they are in scope. It's tiresome, and
+-- potentially inefficient, because of the calls to substExpr,
+-- but I don't think it'll happen much in pracice.
+
+{- Cases to think about
+ (let x=y+1 in \x. (x,x))
+ --> let x=y+1 in (\x1. (x1,x1))
+ (\x. let x = y+1 in (x,x))
+ --> let x1 = y+1 in (\x. (x1,x1)
+ (let x=y+1 in (x,x), let x=y-1 in (x,x))
+ --> let x=y+1 in let x1=y-1 in ((x,x),(x1,x1))
+
+Watch out!
+ (let x=y+1 in let z=x+1 in (z,z)
+ --> matches (p,p) but watch out that the use of
+ x on z's rhs is OK!
+I'm removing the cloning because that makes the above case
+fail, because the inner let looks as if it has locally-bound vars -}
+
+match menv subst@(tv_subst, id_subst, binds) e1 (Let bind e2)
+ | all freshly_bound bndrs,
+ not (any locally_bound bind_fvs)
+ = match (menv { me_env = rn_env' })
+ (tv_subst, id_subst, binds `snocOL` bind')
+ e1 e2'
+ where
+ rn_env = me_env menv
+ bndrs = bindersOf bind
+ bind_fvs = varSetElems (bindFreeVars bind)
+ locally_bound x = inRnEnvR rn_env x
+ freshly_bound x = not (x `rnInScope` rn_env)
+ bind' = bind
+ e2' = e2
+ rn_env' = extendRnInScopeList rn_env bndrs
+{-
+ (rn_env', bndrs') = mapAccumL rnBndrR rn_env bndrs
+ s_prs = [(bndr, Var bndr') | (bndr,bndr') <- zip bndrs bndrs', bndr /= bndr']
+ subst = mkSubst (rnInScopeSet rn_env) emptyVarEnv (mkVarEnv s_prs)
+ (bind', e2') | null s_prs = (bind, e2)
+ | otherwise = (s_bind, substExpr subst e2)
+ s_bind = case bind of
+ NonRec {} -> NonRec (head bndrs') (head rhss)
+ Rec {} -> Rec (bndrs' `zip` map (substExpr subst) rhss)
+-}
projects / ghc-hetmet.git / blobdiff