```-----------------------------------------------------------------------------
--		The fuel monad
-----------------------------------------------------------------------------

module Compiler.Hoopl.Fuel
( Fuel, infiniteFuel, fuelRemaining
, withFuel
)
where

import Compiler.Hoopl.Unique

class Monad m => FuelMonad m where
getFuel :: m Fuel
setFuel :: Fuel -> m ()

-- | Find out how much fuel remains after a computation.
-- Can be subtracted from initial fuel to get total consumption.
fuelRemaining :: FuelMonad m => m Fuel
fuelRemaining = getFuel

class FuelMonadT fm where
runWithFuel :: (Monad m, FuelMonad (fm m)) => Fuel -> fm m a -> m a

type Fuel = Int

withFuel :: FuelMonad m => Maybe a -> m (Maybe a)
withFuel Nothing  = return Nothing
withFuel (Just a) = do f <- getFuel
if f == 0
then return Nothing
else setFuel (f-1) >> return (Just a)

----------------------------------------------------------------

newtype CheckingFuelMonad m a = FM { unFM :: Fuel -> m (a, Fuel) }

return a = FM (\f -> return (a, f))
fm >>= k = FM (\f -> do { (a, f') <- unFM fm f; unFM (k a) f' })

freshUnique = FM (\f -> do { l <- freshUnique; return (l, f) })

getFuel   = FM (\f -> return (f, f))
setFuel f = FM (\_ -> return ((),f))

runWithFuel fuel m = do { (a, _) <- unFM m fuel; return a }

----------------------------------------------------------------

newtype InfiniteFuelMonad m a = IFM { unIFM :: m a }
return a = IFM \$ return a
m >>= k  = IFM \$ do { a <- unIFM m; unIFM (k a) }

freshUnique = IFM \$ freshUnique

getFuel   = return infiniteFuel
setFuel _ = return ()

runWithFuel _ = unIFM

infiniteFuel :: Fuel -- effectively infinite, any, but subtractable
infiniteFuel = maxBound