Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch :
http://hackage.haskell.org/trac/ghc/changeset/23f26fc2cf0e937bfc2e218ec90728cc90a7d262 >--------------------------------------------------------------- commit 23f26fc2cf0e937bfc2e218ec90728cc90a7d262 Author: Max Bolingbroke <batterseapo...@hotmail.com> Date: Fri Apr 27 09:23:50 2012 +0100 Slight cleanup is msgMatch (remove redudant var-kind tests) >--------------------------------------------------------------- compiler/supercompile/Supercompile/Drive/MSG.hs | 21 ++++++++------------- 1 files changed, 8 insertions(+), 13 deletions(-) diff --git a/compiler/supercompile/Supercompile/Drive/MSG.hs b/compiler/supercompile/Supercompile/Drive/MSG.hs index 74fc782..7397775 100644 --- a/compiler/supercompile/Supercompile/Drive/MSG.hs +++ b/compiler/supercompile/Supercompile/Drive/MSG.hs @@ -431,24 +431,19 @@ msgMatch inst_mtch ((_, Heap h_l _, rn_l, k_l), (heap@(Heap _ ids), k, qa), (dee -- 3) Is the left-hand heap empty of anything except lambdaBounds, and if it has been instantiated on the right, was that valid? -- NB: we can safely ignore stack-bound variables because stack-bound vars are only matched against stack-bound vars, heap-bound -- ones are only matched against heap-bound ones, and we don't have any generalisation flag to check on update frames. - , Just h_is_gen <- forM (M.toList h_l) $ \(x_l, hb_l) -> case heapBindingLambdaBoundness hb_l of - Nothing -> Nothing - Just gen_l -> Just (case () of - () | isCoVar x_l, Just q_r <- getCoVar_maybe (lookupCoVarSubst rn_l_inv x_l) -> q_r - | isId x_l -> renameId rn_l_inv x_l - | isTyVar x_l, Just a_r <- getTyVar_maybe (lookupTyVarSubst rn_l_inv x_l) -> a_r - | otherwise -> panic "msgMatch: impossible variable type/non-invertible renaming", gen_l) , let k_r_bvs = stackBoundVars k_r heap_non_instantiating x_r = case M.lookup x_r h_r of Nothing | x_r `elemVarSet` k_r_bvs -> True -- Instantiating with an update-frame bound thing is *probably* OK Just hb_r -> isJust (heapBindingLambdaBoundness hb_r) _ -> panic "msgMatch: variable unbound on right" -- (ppr rn_l $$ ppr rn_r $$ ppr x $$ ppr (renameId rn_l x) $$ ppr x_r) - , all (\(x, gen_l) -> mayInstantiate inst_mtch gen_l || case () of - () | isCoVar x, let co_r = lookupCoVarSubst rn_r x -> maybe False heap_non_instantiating (getCoVar_maybe co_r) - | isId x, let x_r = renameId rn_r x -> heap_non_instantiating x_r - | isTyVar x, let ty_r = lookupTyVarSubst rn_r x -> isJust (getTyVar_maybe ty_r) - | otherwise -> panic "msgMatch: impossible variable type") -- TODO: perhaps type/covar instantiation should be unconditonally allowed? - h_is_gen + , flip all (M.toList h_l) $ \(x_l, hb_l) -> case heapBindingLambdaBoundness hb_l of + Nothing -> False + Just gen_l -> mayInstantiate inst_mtch gen_l || case () of + () | isCoVar x_l, Just q <- getCoVar_maybe (lookupCoVarSubst rn_l_inv x_l), let co_r = lookupCoVarSubst rn_r q -> maybe False heap_non_instantiating (getCoVar_maybe co_r) + | isId x_l, let x = renameId rn_l_inv x_l, let x_r = renameId rn_r x -> heap_non_instantiating x_r + | isTyVar x_l, Just a <- getTyVar_maybe (lookupTyVarSubst rn_l_inv x_l), let ty_r = lookupTyVarSubst rn_r a -> isJust (getTyVar_maybe ty_r) + | otherwise -> panic "msgMatch: impossible variable type/non-invertible renaming" + -- TODO: perhaps type/covar instantiation should be unconditonally allowed? = Just (RightIsInstance heap_r (composeRenamings ids rn_l_inv rn_r) k_r) -- Now look for type generalisation information _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
