Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch :
http://hackage.haskell.org/trac/ghc/changeset/2d199e5cf3be7fcd18a6aa37af4524e9dd629d9d >--------------------------------------------------------------- commit 2d199e5cf3be7fcd18a6aa37af4524e9dd629d9d Author: Max Bolingbroke <batterseapo...@hotmail.com> Date: Tue Mar 20 15:27:49 2012 +0000 Fix possible out-of-scope error in CoreBinds to CoreTerm translation >--------------------------------------------------------------- compiler/supercompile/Supercompile.hs | 9 +++++---- 1 files changed, 5 insertions(+), 4 deletions(-) diff --git a/compiler/supercompile/Supercompile.hs b/compiler/supercompile/Supercompile.hs index decf6e3..8a38c66 100644 --- a/compiler/supercompile/Supercompile.hs +++ b/compiler/supercompile/Supercompile.hs @@ -69,10 +69,11 @@ partitionBinds should_sc initial_binds = go initial_inside initial_undecided coreBindsFVs :: [CoreBind] -> S.FreeVars coreBindsFVs bs = unionVarSets [fvs | b <- bs, fvs <- map S.idFreeVars (bindersOf b) ++ map exprFreeVars (rhssOfBind b)] -coreBindsToCoreTerm :: (Id -> Bool) -> [CoreBind] -> (CoreExpr, Var -> [CoreBind]) +coreBindsToCoreTerm :: (Id -> Bool) -> [CoreBind] -> (CoreExpr, Var -> [(Var, CoreExpr)]) coreBindsToCoreTerm should_sc binds - = (mkLets internal_sc_binds (mkLiftedVarTup sc_internal_xs), - \y -> [NonRec x (mkLiftedTupleSelector sc_internal_xs internal_x (Var y)) | (x, internal_x) <- sc_xs_internal_xs] ++ dont_sc_binds) + = --pprTrace "coreBindsToCoreTerm" (ppr (bindersOfBinds binds, bindersOfBinds sc_binds, bindersOfBinds dont_sc_binds, dont_sc_binds_fvs, sc_xs_internal_xs, sc_xs, bindersOfBinds internal_sc_binds)) $ + (mkLets internal_sc_binds (mkLiftedVarTup sc_internal_xs), + \y -> [(x, mkLiftedTupleSelector sc_internal_xs internal_x (Var y)) | (x, internal_x) <- sc_xs_internal_xs] ++ flattenBinds dont_sc_binds) where -- We put all the sc_binds into a local let, and use unboxed tuples to bind back to the top level the names of -- any of those sc_binds that are either exported *or* in the free variables of something from dont_sc_binds. @@ -206,6 +207,6 @@ supercompileProgram binds = supercompileProgramSelective selector binds | otherwise = const True supercompileProgramSelective :: (Id -> Bool) -> [CoreBind] -> IO [CoreBind] -supercompileProgramSelective should_sc binds = liftM (\e' -> NonRec x e' : rebuild x) (supercompile e) +supercompileProgramSelective should_sc binds = liftM (\e' -> [Rec $ (x, e') : rebuild x]) (supercompile e) where x = mkSysLocal (fsLit "sc") topUnique (exprType e) (e, rebuild) = coreBindsToCoreTerm should_sc binds _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
