X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplEnv.lhs;h=e62c24fe382c854772e09ce64181d7f332f318d9;hb=a5f2ab64f2f1306c803c0c20e21238973070f74b;hp=d0240fb961fb8c63d93f499ddfbe5252ca894a6b;hpb=58e45ee86bbda3f24a4caf41c0aea7a6b787367e;p=ghc-hetmet.git diff --git a/compiler/simplCore/SimplEnv.lhs b/compiler/simplCore/SimplEnv.lhs index d0240fb..e62c24f 100644 --- a/compiler/simplCore/SimplEnv.lhs +++ b/compiler/simplCore/SimplEnv.lhs @@ -455,7 +455,7 @@ floatBinds (Floats bs _) = fromOL bs \begin{code} -substId :: SimplEnv -> Id -> SimplSR +substId :: SimplEnv -> InId -> SimplSR -- Returns DoneEx only on a non-Var expression substId (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v | not (isLocalId v) @@ -464,7 +464,9 @@ substId (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v = case lookupVarEnv ids v of Nothing -> DoneId (refine in_scope v) Just (DoneId v) -> DoneId (refine in_scope v) - Just (DoneEx (Var v)) -> DoneId (refine in_scope v) + Just (DoneEx (Var v)) + | isLocalId v -> DoneId (refine in_scope v) + | otherwise -> DoneId v Just res -> res -- DoneEx non-var, or ContEx where @@ -475,7 +477,7 @@ refine in_scope v = case lookupInScope in_scope v of Just v' -> v' Nothing -> WARN( True, ppr v ) v -- This is an error! -lookupRecBndr :: SimplEnv -> Id -> Id +lookupRecBndr :: SimplEnv -> InId -> OutId -- Look up an Id which has been put into the envt by simplRecBndrs, -- but where we have not yet done its RHS lookupRecBndr (SimplEnv { seInScope = in_scope, seIdSubst = ids }) v @@ -657,7 +659,7 @@ addBndrRules env in_id out_id where subst = mkCoreSubst env old_rules = idSpecialisation in_id - new_rules = CoreSubst.substSpec subst old_rules + new_rules = CoreSubst.substSpec subst out_id old_rules final_id = out_id `setIdSpecialisation` new_rules ------------------