Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : supercompiler
http://hackage.haskell.org/trac/ghc/changeset/113770f45993956c3b2ea5af0b98a898cabc1f55 >--------------------------------------------------------------- commit 113770f45993956c3b2ea5af0b98a898cabc1f55 Author: Max Bolingbroke <batterseapo...@hotmail.com> Date: Fri Jul 29 17:57:24 2011 +0100 Remove some redundant insertion operations on Renaming >--------------------------------------------------------------- .../supercompile/Supercompile/Core/Renaming.hs | 9 --------- .../Supercompile/Evaluator/Evaluate.hs | 4 ++-- 2 files changed, 2 insertions(+), 11 deletions(-) diff --git a/compiler/supercompile/Supercompile/Core/Renaming.hs b/compiler/supercompile/Supercompile/Core/Renaming.hs index 1258f28..ab6a87a 100644 --- a/compiler/supercompile/Supercompile/Core/Renaming.hs +++ b/compiler/supercompile/Supercompile/Core/Renaming.hs @@ -7,7 +7,6 @@ module Supercompile.Core.Renaming ( -- | Extending the renaming insertIdRenaming, insertIdRenamings, - insertIdCoVarRenaming, insertIdCoVarRenamings, insertTypeSubst, insertTypeSubsts, insertCoercionSubst, insertCoercionSubsts, @@ -123,14 +122,6 @@ insertIdRenaming (id_subst, tv_subst, co_subst) x x' insertIdRenamings :: Renaming -> [(Id, Out Id)] -> Renaming insertIdRenamings = foldr (\(x, x') rn -> insertIdRenaming rn x x') -insertIdCoVarRenaming :: Renaming -> Id -> Out Id -> Renaming -insertIdCoVarRenaming rn x x' - | isCoVar x = insertCoercionSubst rn x (mkCoVarCo x') - | otherwise = insertIdRenaming rn x x' - -insertIdCoVarRenamings :: Renaming -> [(Id, Out Id)] -> Renaming -insertIdCoVarRenamings = foldr (\(x, x') rn -> insertIdCoVarRenaming rn x x') - insertTypeSubst :: Renaming -> TyVar -> Out Type -> Renaming insertTypeSubst (id_subst, tv_subst, co_subst) x ty' = (id_subst, extendVarEnv tv_subst x ty', co_subst) diff --git a/compiler/supercompile/Supercompile/Evaluator/Evaluate.hs b/compiler/supercompile/Supercompile/Evaluator/Evaluate.hs index 458694f..c18b163 100644 --- a/compiler/supercompile/Supercompile/Evaluator/Evaluate.hs +++ b/compiler/supercompile/Supercompile/Evaluator/Evaluate.hs @@ -211,7 +211,7 @@ step' normalising state = apply deeds tg_v (Heap h ids) k in_v@(_, (_, v)) x' = do (mb_co, (rn, Lambda x e_body)) <- deferenceLambdaish (Heap h ids) in_v case mb_co of - Nothing -> fmap (\deeds -> (deeds, Heap h ids, k, (insertIdCoVarRenaming rn x x', e_body))) $ + Nothing -> fmap (\deeds -> (deeds, Heap h ids, k, (insertIdRenaming rn x x', e_body))) $ claimDeeds (deeds + 1 + annedValueSize' v) (annedSize e_body) Just (co', tg_co) -> fmap (\deeds -> (deeds, Heap (M.insert y' (internallyBound (mkIdentityRenaming (annedTermFreeVars e_arg), e_arg)) h) ids', Tagged tg_co (CastIt res_co') : k, (rn', e_body))) $ claimDeeds (deeds + 1 + annedValueSize' v) (annedSize e_arg + annedSize e_body) @@ -261,7 +261,7 @@ step' normalising state = rn_alts' = insertTypeSubsts rn_alts (alt_as `zip` tys') deeds2 = deeds1 + annedAltsSize rest , Just res <- [do (deeds3, h', ids', rn_alts') <- case mb_dc_cos of - Nothing -> return (deeds2, h1, ids, insertIdCoVarRenamings (insertCoercionSubsts rn_alts' (alt_qs `zip` cos')) (alt_xs `zip` xs')) + Nothing -> return (deeds2, h1, ids, insertIdRenamings (insertCoercionSubsts rn_alts' (alt_qs `zip` cos')) (alt_xs `zip` xs')) Just dc_cos -> foldM (\(deeds, h, ids, rn_alts) (uncast_e_arg', alt_y, (dc_co, tg_co)) -> let Pair _dc_co_from_ty' dc_co_to_ty' = coercionKind dc_co -- TODO: use to_tc_arg_tys' from above? (ids', rn_alts', y') = renameNonRecBinder ids rn_alts (alt_y `setIdType` dc_co_to_ty') _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
