+
+%************************************************************************
+%* *
+\section{Dealing with a single binder}
+%* *
+%************************************************************************
+
+When we hit a binder we may need to
+ (a) apply the the type envt (if non-empty) to its type
+ (b) apply the type envt and id envt to its SpecEnv (if it has one)
+ (c) give it a new unique to avoid name clashes
+
+\begin{code}
+simplBinder :: SimplEnv -> InBinder -> SmplM (SimplEnv, OutId)
+simplBinder env (id, occ_info)
+ | no_need_to_clone -- Not in scope (or cloning disabled), so no need to clone
+ && empty_ty_subst -- No type substitution to do inside the Id
+ && isNullIdEnv id_subst -- No id substitution to do inside the Id
+ = let
+ env' = setIdEnv env (new_in_scope_ids id, id_subst)
+ in
+ returnSmpl (env', id)
+
+ | otherwise
+ =
+#if DEBUG
+ -- I reckon the empty-env thing should catch
+ -- most no-free-tyvars things, so this test should be redundant
+-- (if idHasNoFreeTyVars id then pprTrace "applyEnvsToId" (ppr id) else (\x -> x))
+#endif
+ (let
+ -- id1 has its type zapped
+ id1 | empty_ty_subst = id
+ | otherwise = mkIdWithNewType id ty'
+ -- id2 has its SpecEnv zapped (see comment inside Simplify.completeBind)
+ id2 | empty_spec_env = id1
+ | otherwise = setIdSpecialisation id1 emptySpecEnv
+ in
+ if no_need_to_clone then
+ -- No need to clone, but we *must* zap any current substitution
+ -- for the variable. For example:
+ -- (\x.e) with id_subst = [x |-> e']
+ -- Here we must simply zap the substitution for x
+ let
+ new_id_subst = delOneFromIdEnv id_subst id
+ new_env = setIdEnv env (new_in_scope_ids id2, new_id_subst)
+ in
+ returnSmpl (new_env, id2)
+ else
+ -- Must clone
+ getUniqueSmpl `thenSmpl` \ uniq ->
+ let
+ id3 = mkIdWithNewUniq id2 uniq
+ new_env = setIdEnv env (new_in_scope_ids id3,
+ addOneToIdEnv id_subst id (SubstVar id3))
+ in
+ returnSmpl (new_env, id3)
+ )
+ where
+ ((in_scope_tyvars, ty_subst), (in_scope_ids, id_subst)) = getEnvs env
+
+ empty_ty_subst = isEmptyTyVarEnv ty_subst
+ empty_spec_env = isEmptySpecEnv (getIdSpecialisation id)
+
+ no_need_to_clone = not need_to_clone
+ need_to_clone = not (externallyVisibleId id) &&
+ ( elemIdEnv id in_scope_ids || clone_binds_please)
+ {-
+ The SimplCloneBinds option isn't just here as another simplifier knob we can
+ twiddle. Prior to floating bindings outwards, we have to make sure that no
+ duplicate bindings exist as floating may cause bindings with identical
+ uniques to come into scope, with disastrous consequences.
+
+ To avoid this situation, we make sure that cloning is turned *on* in the
+ simplifier pass prior to running an outward floating pass.
+ -}
+ clone_binds_please = switchIsOn sw_chkr SimplCloneBinds
+
+ new_in_scope_ids id' = addOneToIdEnv in_scope_ids id' (id', occ_info, NoUnfolding)
+
+ ty = idType id
+ ty' = instantiateTy ty_subst ty
+
+ sw_chkr = getSwitchChecker env
+
+
+simplBinders :: SimplEnv -> [InBinder] -> SmplM (SimplEnv, [OutId])
+simplBinders env binders = mapAccumLSmpl simplBinder env binders
+\end{code}
+
+\begin{code}
+simplTyBinder :: SimplEnv -> TyVar -> SmplM (SimplEnv, TyVar)
+simplTyBinder env tyvar
+ | no_need_to_clone
+ = -- No need to clone; but must zap any binding for tyvar
+ -- see comments with simplBinder above
+ let
+ env' = setTyEnv env (tyvars `addOneToTyVarSet` tyvar,
+ delFromTyVarEnv ty_subst tyvar)
+ in
+ returnSmpl (env', tyvar)
+
+ | otherwise -- Need to clone
+ = getUniqueSmpl `thenSmpl` \ uniq ->
+ let
+ tyvar' = cloneTyVar tyvar uniq
+ env' = setTyEnv env (tyvars `addOneToTyVarSet` tyvar',
+ addToTyVarEnv ty_subst tyvar (mkTyVarTy tyvar'))
+ in
+ returnSmpl (env', tyvar')
+ where
+ ((tyvars, ty_subst), (ids, id_subst)) = getEnvs env
+ no_need_to_clone = not (tyvar `elementOfTyVarSet` tyvars) &&
+ not clone_binds_please
+
+ clone_binds_please = switchIsOn sw_chkr SimplCloneBinds
+ sw_chkr = getSwitchChecker env
+
+
+simplTyBinders :: SimplEnv -> [TyVar] -> SmplM (SimplEnv, [TyVar])
+simplTyBinders env binders = mapAccumLSmpl simplTyBinder env binders
+\end{code}