Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch :
http://hackage.haskell.org/trac/ghc/changeset/eb618767b338fc95189356f85d5e3ffc478551be >--------------------------------------------------------------- commit eb618767b338fc95189356f85d5e3ffc478551be Author: Max Bolingbroke <batterseapo...@hotmail.com> Date: Fri Apr 27 10:55:48 2012 +0100 Suppress warnings when renaming an out term >--------------------------------------------------------------- .../supercompile/Supercompile/Drive/Process3.hs | 8 +++++++- 1 files changed, 7 insertions(+), 1 deletions(-) diff --git a/compiler/supercompile/Supercompile/Drive/Process3.hs b/compiler/supercompile/Supercompile/Drive/Process3.hs index 0b36e7e..3ee8967 100644 --- a/compiler/supercompile/Supercompile/Drive/Process3.hs +++ b/compiler/supercompile/Supercompile/Drive/Process3.hs @@ -7,7 +7,7 @@ import Supercompile.Drive.Split import Supercompile.Drive.Process import Supercompile.Core.FreeVars -import Supercompile.Core.Renaming (renameFVedTerm) +import Supercompile.Core.Renaming import Supercompile.Core.Size (fvedTermSize) import Supercompile.Core.Syntax import Supercompile.Core.Tag @@ -175,6 +175,11 @@ runScpM tag_anns me = fvedTermSize e' `seq` trace ("Deepest path:\n" ++ showSDoc e' = letRec fulfils e +mkOutRenaming :: Renaming -> ScpM Renaming +mkOutRenaming rn = ScpM $ StateT $ \s -> let (pss, ps) = trainToList (promises (scpMemoState s)) + hs = concatMap (\(p, ps) -> fun p : map fun ps) pss ++ map fun ps + in return (foldr (\x rn -> insertIdRenaming rn x x) rn hs, s) + callCCM :: ((a -> ScpM ()) -> ScpM a) -> ScpM a callCCM act = ScpM $ StateT $ \s -> ReaderT $ \env -> callCC (\jump_back -> unReaderT (unStateT (unScpM (act (\a -> ScpM $ StateT $ \s' -> ReaderT $ \_ -> case s' `rolledBackTo` s of Just s'' -> jump_back (a, s''); Nothing -> return ((), s')))) s) env) @@ -267,6 +272,7 @@ sc' mb_h state = {-# SCC "sc'" #-} case mb_h of -> pprTrace "MSG success" (pPrintFullState quietStatePrettiness (deeds, heap, k, qa) $$ pPrintFullState quietStatePrettiness (deeds_r', heap_r, k_r, fmap Question (annedVar (mkTag 0) nullAddrId))) $ do (deeds', e) <- sc (deeds, heap, k, qa) + rn_r <- mkOutRenaming rn_r -- Just to suppress warnings from renameId (since output term may mention h functions). Alternatively, I could rename the State I pass to "sc" liftM ((,) True) $ insertTagsM $ instanceSplit (deeds' `plusDeeds` deeds_r', heap_r, k_r, renameFVedTerm ids rn_r e) sc where [deeds, deeds_r'] = splitDeeds deeds_r [heapSize heap + stackSize k + annedSize qa, heapSize heap_r + stackSize k_r] _ -> (if sC_ROLLBACK then (\gen -> shallow_rb gen >> my_split state sc) else try_generalise) ({-# SCC "mK_GENERALISER'" #-} mK_GENERALISER shallow_state state)) _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
