[commit: ghc] supercompiler: Generalise the type of memo, for now (c16f4e6)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : supercompiler

http://hackage.haskell.org/trac/ghc/changeset/c16f4e62d10b7aeaaa0a10ac05a18c367c9464c5

>---------------------------------------------------------------

commit c16f4e62d10b7aeaaa0a10ac05a18c367c9464c5
Author: Max Bolingbroke <[email protected]>
Date:   Wed Oct 26 15:10:58 2011 +0100

    Generalise the type of memo, for now

>---------------------------------------------------------------

 .../supercompile/Supercompile/Drive/Process2.hs    |   11 ++++++-----
 1 files changed, 6 insertions(+), 5 deletions(-)

diff --git a/compiler/supercompile/Supercompile/Drive/Process2.hs b/compiler/supercompile/Supercompile/Drive/Process2.hs
index 70c6014..694b3fb 100644
--- a/compiler/supercompile/Supercompile/Drive/Process2.hs
+++ b/compiler/supercompile/Supercompile/Drive/Process2.hs
@@ -219,8 +219,9 @@ promise state ms = (p, ms)
 instance MonadStatics (DelayM (MemoT HistoryM)) where
     -- FIXME
 
-memo :: (State -> HistoryM (ScpM (Deeds, Out FVedTerm)))
-     -> State -> MemoT HistoryM (ScpM (Deeds, Out FVedTerm))
+memo :: (Applicative t, Monad m)
+     => (State -> t (m (Deeds, Out FVedTerm)))
+     -> State -> MemoT t (m (Deeds, Out FVedTerm))
 memo opt state = MT $ \ms ->
      -- NB: If tb contains a dead PureHeap binding (hopefully impossible) then it may have a free variable that
      -- I can't rename, so "rename" will cause an error. Not observed in practice yet.
@@ -229,12 +230,12 @@ memo opt state = MT $ \ms ->
          , Just rn_lr <- [(\res -> if isNothing res then pprTraceSC "no match:" (ppr (fun p)) res else res) $
                           match (meaning p) state]
          ] of (p, res):_ -> pure $ (do { traceRenderScpM "=sc" (fun p, PrettyDoc (pPrintFullState True state), res)
-                                       ; pure res }, ms)
-              _          -> opt state >>= \mres -> return
+                                       ; return res }, ms)
+              _          -> flip fmap (opt state) $ \mres ->
                                    (do { traceRenderScpM ">sc" (fun p, PrettyDoc (pPrintFullState True state))
                                        ; res <- mres
                                        ; traceRenderScpM "<sc" (fun p, PrettyDoc (pPrintFullState False state), res)
-                                       ; pure res }, ms')
+                                       ; return res }, ms')
                 where (p, ms') = promise state ms