module StgSubst where
#include "HsVersions.h"
import GhcPrelude
import Id
import VarEnv
import Control.Monad.Trans.State.Strict
import Outputable
import Util
data Subst = Subst InScopeSet IdSubstEnv
type IdSubstEnv = IdEnv Id
emptySubst :: Subst
emptySubst = mkEmptySubst emptyInScopeSet
mkEmptySubst :: InScopeSet -> Subst
mkEmptySubst in_scope = Subst in_scope emptyVarEnv
substBndr :: Id -> Subst -> (Id, Subst)
substBndr id (Subst in_scope env)
= (new_id, Subst new_in_scope new_env)
where
new_id = uniqAway in_scope id
no_change = new_id == id
new_in_scope = in_scope `extendInScopeSet` new_id
new_env
| no_change = delVarEnv env id
| otherwise = extendVarEnv env id new_id
substBndrs :: Traversable f => f Id -> Subst -> (f Id, Subst)
substBndrs = runState . traverse (state . substBndr)
lookupIdSubst :: HasCallStack => Id -> Subst -> Id
lookupIdSubst id (Subst in_scope env)
| not (isLocalId id) = id
| Just id' <- lookupVarEnv env id = id'
| Just id' <- lookupInScope in_scope id = id'
| otherwise = WARN( True, text "StgSubst.lookupIdSubst" <+> ppr id $$ ppr in_scope)
id
noWarnLookupIdSubst :: HasCallStack => Id -> Subst -> Id
noWarnLookupIdSubst id (Subst in_scope env)
| not (isLocalId id) = id
| Just id' <- lookupVarEnv env id = id'
| Just id' <- lookupInScope in_scope id = id'
| otherwise = id
extendInScope :: Id -> Subst -> Subst
extendInScope id (Subst in_scope env) = Subst (in_scope `extendInScopeSet` id) env
extendSubst :: Id -> Id -> Subst -> Subst
extendSubst id new_id (Subst in_scope env)
= ASSERT2( new_id `elemInScopeSet` in_scope, ppr id <+> ppr new_id $$ ppr in_scope )
Subst in_scope (extendVarEnv env id new_id)