Merge in new code generator branch.

This changes the new code generator to make use of the Hoopl package
for dataflow analysis.  Hoopl is a new boot package, and is maintained
in a separate upstream git repository (as usual, GHC has its own
lagging darcs mirror in http://darcs.haskell.org/packages/hoopl).

During this merge I squashed recent history into one patch.  I tried
to rebase, but the history had some internal conflicts of its own
which made rebase extremely confusing, so I gave up. The history I
squashed was:

  - Update new codegen to work with latest Hoopl
  - Add some notes on new code gen to cmm-notes
  - Enable Hoopl lag package.
  - Add SPJ note to cmm-notes
  - Improve GC calls on new code generator.

Work in this branch was done by:
   - Milan Straka <fox@ucw.cz>
   - John Dias <dias@cs.tufts.edu>
   - David Terei <davidterei@gmail.com>

Edward Z. Yang <ezyang@mit.edu> merged in further changes from GHC HEAD
and fixed a few bugs.

1 files changed, 73 insertions, 73 deletions

diff --git a/compiler/cmm/OptimizationFuel.hs b/compiler/cmm/OptimizationFuel.hs
index 175dcd09b1..e1f1e3c39e 100644
--- a/compiler/cmm/OptimizationFuel.hs
+++ b/compiler/cmm/OptimizationFuel.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TypeFamilies #-}
 -- | Optimisation fuel is used to control the amount of work the optimiser does.
 --
 -- Every optimisation step consumes a certain amount of fuel and stops when
@@ -5,27 +6,25 @@
 -- the optimiser with varying amount of fuel to find out the exact number of
 -- steps where a bug is introduced in the output.
 module OptimizationFuel
-    ( OptimizationFuel,  canRewriteWithFuel, maybeRewriteWithFuel, oneLessFuel
-    , OptFuelState, initOptFuelState --, setTotalFuel
-    , tankFilledTo, diffFuel
-    , FuelConsumer
-    , FuelUsingMonad, FuelState
-    , lastFuelPass, fuelExhausted, fuelRemaining, fuelDecrement, fuelDec1
+    ( OptimizationFuel, amountOfFuel, tankFilledTo, anyFuelLeft, oneLessFuel
+    , OptFuelState, initOptFuelState
+    , FuelConsumer, FuelUsingMonad, FuelState
+    , fuelGet, fuelSet, lastFuelPass, setFuelPass
+    , fuelExhausted, fuelDec1, tryWithFuel
     , runFuelIO, fuelConsumingPass
-    , FuelMonad
+    , FuelUniqSM
     , liftUniq
-    , lGraphOfGraph -- needs to be able to create a unique ID...
     )
 where
 
-import BlockId
-import ZipCfg
---import GHC.Exts (State#)
-import Panic
 import Data.IORef
 import Control.Monad
 import StaticFlags (opt_Fuel)
 import UniqSupply
+import Panic ()
+
+import Compiler.Hoopl
+import Compiler.Hoopl.GHC (getFuel, setFuel)
 
 #include "HsVersions.h"
 
@@ -45,45 +44,44 @@ initOptFuelState =
 
 type FuelConsumer a = OptimizationFuel -> (a, OptimizationFuel)
 
-canRewriteWithFuel :: OptimizationFuel -> Bool
-oneLessFuel :: OptimizationFuel -> OptimizationFuel
-maybeRewriteWithFuel :: OptimizationFuel -> Maybe a -> Maybe a
-diffFuel :: OptimizationFuel -> OptimizationFuel -> Int
-   -- to measure consumption during compilation
 tankFilledTo :: Int -> OptimizationFuel
+amountOfFuel :: OptimizationFuel -> Int
+
+anyFuelLeft :: OptimizationFuel -> Bool
+oneLessFuel :: OptimizationFuel -> OptimizationFuel
 
 #ifdef DEBUG
 newtype OptimizationFuel = OptimizationFuel Int
   deriving Show
 
 tankFilledTo = OptimizationFuel
-canRewriteWithFuel (OptimizationFuel f) = f > 0
-maybeRewriteWithFuel fuel ma = if canRewriteWithFuel fuel then ma else Nothing
+amountOfFuel (OptimizationFuel f) = f
+
+anyFuelLeft (OptimizationFuel f) = f > 0
 oneLessFuel (OptimizationFuel f) = ASSERT (f > 0) (OptimizationFuel (f - 1))
-diffFuel (OptimizationFuel f) (OptimizationFuel f') = f - f'
 #else
 -- type OptimizationFuel = State# () -- would like this, but it won't work
 data OptimizationFuel = OptimizationFuel
   deriving Show
-tankFilledTo _ = panic "tankFilledTo" -- should be impossible to evaluate
-  -- realWorld# might come in handy, too...
-canRewriteWithFuel OptimizationFuel = True
-maybeRewriteWithFuel _ ma = ma
-oneLessFuel f = f
-diffFuel _ _ = 0
+tankFilledTo _ = OptimizationFuel
+amountOfFuel _ = maxBound
+
+anyFuelLeft _ = True
+oneLessFuel _ = OptimizationFuel
 #endif
 
-data FuelState = FuelState { fs_fuellimit :: OptimizationFuel, fs_lastpass :: String }
-newtype FuelMonad a = FuelMonad (FuelState -> UniqSM (a, FuelState))
+data FuelState = FuelState { fs_fuel :: OptimizationFuel, fs_lastpass :: String }
+newtype FuelUniqSM a = FUSM { unFUSM :: FuelState -> UniqSM (a, FuelState) }
 
-fuelConsumingPass :: String -> FuelConsumer a -> FuelMonad a
-fuelConsumingPass name f = do fuel <- fuelRemaining
+fuelConsumingPass :: String -> FuelConsumer a -> FuelUniqSM a
+fuelConsumingPass name f = do setFuelPass name
+                              fuel <- fuelGet
                               let (a, fuel') = f fuel
-                              fuelDecrement name fuel fuel'
+                              fuelSet fuel'
                               return a
 
-runFuelIO :: OptFuelState -> FuelMonad a -> IO a
-runFuelIO fs (FuelMonad f) =
+runFuelIO :: OptFuelState -> FuelUniqSM a -> IO a
+runFuelIO fs (FUSM f) =
     do pass <- readIORef (pass_ref fs)
        fuel <- readIORef (fuel_ref fs)
        u    <- mkSplitUniqSupply 'u'
@@ -92,49 +90,51 @@ runFuelIO fs (FuelMonad f) =
        writeIORef (fuel_ref fs) fuel'
        return a
 
-instance Monad FuelMonad where
-  FuelMonad f >>= k = FuelMonad (\s -> do (a, s') <- f s
-                                          let FuelMonad f' = k a in (f' s'))
-  return a = FuelMonad (\s -> return (a, s))
+instance Monad FuelUniqSM where
+  FUSM f >>= k = FUSM (\s -> f s >>= \(a, s') -> unFUSM (k a) s')
+  return a     = FUSM (\s -> return (a, s))
 
-instance MonadUnique FuelMonad where
+instance MonadUnique FuelUniqSM where
     getUniqueSupplyM = liftUniq getUniqueSupplyM
     getUniqueM       = liftUniq getUniqueM
     getUniquesM      = liftUniq getUniquesM
-liftUniq :: UniqSM x -> FuelMonad x
-liftUniq x = FuelMonad (\s -> x >>= (\u -> return (u, s)))
+
+liftUniq :: UniqSM x -> FuelUniqSM x
+liftUniq x = FUSM (\s -> x >>= (\u -> return (u, s)))
 
 class Monad m => FuelUsingMonad m where
-  fuelRemaining :: m OptimizationFuel
-  fuelDecrement :: String -> OptimizationFuel -> OptimizationFuel -> m ()
-  fuelDec1      :: m ()
-  fuelExhausted :: m Bool
-  lastFuelPass  :: m String
-
-instance FuelUsingMonad FuelMonad where
-  fuelRemaining = extract fs_fuellimit
-  lastFuelPass  = extract fs_lastpass
-  fuelExhausted = extract $ not . canRewriteWithFuel . fs_fuellimit
-  fuelDecrement p f f' = FuelMonad (\s -> return ((), fuelDecrementState p f f' s))
-  fuelDec1      = FuelMonad f 
-     where f s = if canRewriteWithFuel (fs_fuellimit s) then
-                    return ((), s { fs_fuellimit = oneLessFuel (fs_fuellimit s) })
-                 else panic "Tried to use exhausted fuel supply"
-
-extract :: (FuelState -> a) -> FuelMonad a
-extract f = FuelMonad (\s -> return (f s, s))
-
-fuelDecrementState
-    :: String -> OptimizationFuel -> OptimizationFuel -> FuelState -> FuelState
-fuelDecrementState new_optimizer old new s =
-    FuelState { fs_fuellimit = lim, fs_lastpass = optimizer }
-  where lim = if diffFuel old (fs_fuellimit s) == 0 then new
-              else panic $
-                   concat ["lost track of ", new_optimizer, "'s transactions"]
-        optimizer = if diffFuel old new > 0 then new_optimizer else fs_lastpass s
-
--- lGraphOfGraph is here because we need uniques to implement it.
-lGraphOfGraph :: Graph m l -> FuelMonad (LGraph m l)
-lGraphOfGraph (Graph tail blocks) =
-  do entry <- liftM BlockId $ getUniqueM
-     return $ LGraph entry (insertBlock (Block entry tail) blocks)
+  fuelGet      :: m OptimizationFuel
+  fuelSet      :: OptimizationFuel -> m ()
+  lastFuelPass :: m String
+  setFuelPass  :: String -> m ()
+
+fuelExhausted :: FuelUsingMonad m => m Bool
+fuelExhausted = fuelGet >>= return . anyFuelLeft
+
+fuelDec1 :: FuelUsingMonad m => m ()
+fuelDec1 = fuelGet >>= fuelSet . oneLessFuel
+
+tryWithFuel :: FuelUsingMonad m => a -> m (Maybe a)
+tryWithFuel r = do f <- fuelGet
+                   if anyFuelLeft f then fuelSet (oneLessFuel f) >> return (Just r)
+                                    else return Nothing
+
+instance FuelUsingMonad FuelUniqSM where
+  fuelGet          = extract fs_fuel
+  lastFuelPass     = extract fs_lastpass
+  fuelSet fuel     = FUSM (\s -> return ((), s { fs_fuel     = fuel }))
+  setFuelPass pass = FUSM (\s -> return ((), s { fs_lastpass = pass }))
+
+extract :: (FuelState -> a) -> FuelUniqSM a
+extract f = FUSM (\s -> return (f s, s))
+
+instance FuelMonad FuelUniqSM where
+  getFuel = liftM amountOfFuel fuelGet
+  setFuel = fuelSet . tankFilledTo
+
+-- Don't bother to checkpoint the unique supply; it doesn't matter
+instance CheckpointMonad FuelUniqSM where
+    type Checkpoint FuelUniqSM = FuelState
+    checkpoint = FUSM $ \fuel -> return (fuel, fuel) 
+    restart fuel = FUSM $ \_ -> return ((), fuel)
+