1 -- | Optimisation fuel is used to control the amount of work the optimiser does.
3 -- Every optimisation step consumes a certain amount of fuel and stops when
4 -- it runs out of fuel. This can be used e.g. to debug optimiser bugs: Run
5 -- the optimiser with varying amount of fuel to find out the exact number of
6 -- steps where a bug is introduced in the output.
7 module OptimizationFuel
8 ( OptimizationFuel, canRewriteWithFuel, maybeRewriteWithFuel, oneLessFuel
9 , OptFuelState, initOptFuelState --, setTotalFuel
10 , tankFilledTo, diffFuel
12 , FuelUsingMonad, FuelState
13 , lastFuelPass, fuelExhausted, fuelRemaining, fuelDecrement, fuelDec1
14 , runFuelIO, fuelConsumingPass
17 , lGraphOfGraph -- needs to be able to create a unique ID...
23 --import GHC.Exts (State#)
27 import StaticFlags (opt_Fuel)
30 #include "HsVersions.h"
33 -- We limit the number of transactions executed using a record of flags
34 -- stored in an HscEnv. The flags store the name of the last optimization
35 -- pass and the amount of optimization fuel remaining.
37 OptFuelState { pass_ref :: IORef String
38 , fuel_ref :: IORef OptimizationFuel
40 initOptFuelState :: IO OptFuelState
42 do pass_ref' <- newIORef "unoptimized program"
43 fuel_ref' <- newIORef (tankFilledTo opt_Fuel)
44 return OptFuelState {pass_ref = pass_ref', fuel_ref = fuel_ref'}
46 type FuelConsumer a = OptimizationFuel -> (a, OptimizationFuel)
48 canRewriteWithFuel :: OptimizationFuel -> Bool
49 oneLessFuel :: OptimizationFuel -> OptimizationFuel
50 maybeRewriteWithFuel :: OptimizationFuel -> Maybe a -> Maybe a
51 diffFuel :: OptimizationFuel -> OptimizationFuel -> Int
52 -- to measure consumption during compilation
53 tankFilledTo :: Int -> OptimizationFuel
56 newtype OptimizationFuel = OptimizationFuel Int
59 tankFilledTo = OptimizationFuel
60 canRewriteWithFuel (OptimizationFuel f) = f > 0
61 maybeRewriteWithFuel fuel ma = if canRewriteWithFuel fuel then ma else Nothing
62 oneLessFuel (OptimizationFuel f) = ASSERT (f > 0) (OptimizationFuel (f - 1))
63 diffFuel (OptimizationFuel f) (OptimizationFuel f') = f - f'
65 -- type OptimizationFuel = State# () -- would like this, but it won't work
66 data OptimizationFuel = OptimizationFuel
68 tankFilledTo _ = panic "tankFilledTo" -- should be impossible to evaluate
69 -- realWorld# might come in handy, too...
70 canRewriteWithFuel OptimizationFuel = True
71 maybeRewriteWithFuel _ ma = ma
76 data FuelState = FuelState { fs_fuellimit :: OptimizationFuel, fs_lastpass :: String }
77 newtype FuelMonad a = FuelMonad (FuelState -> UniqSM (a, FuelState))
79 fuelConsumingPass :: String -> FuelConsumer a -> FuelMonad a
80 fuelConsumingPass name f = do fuel <- fuelRemaining
81 let (a, fuel') = f fuel
82 fuelDecrement name fuel fuel'
85 runFuelIO :: OptFuelState -> FuelMonad a -> IO a
86 runFuelIO fs (FuelMonad f) =
87 do pass <- readIORef (pass_ref fs)
88 fuel <- readIORef (fuel_ref fs)
89 u <- mkSplitUniqSupply 'u'
90 let (a, FuelState fuel' pass') = initUs_ u $ f (FuelState fuel pass)
91 writeIORef (pass_ref fs) pass'
92 writeIORef (fuel_ref fs) fuel'
95 instance Monad FuelMonad where
96 FuelMonad f >>= k = FuelMonad (\s -> do (a, s') <- f s
97 let FuelMonad f' = k a in (f' s'))
98 return a = FuelMonad (\s -> return (a, s))
100 instance MonadUnique FuelMonad where
101 getUniqueSupplyM = liftUniq getUniqueSupplyM
102 getUniqueM = liftUniq getUniqueM
103 getUniquesM = liftUniq getUniquesM
104 liftUniq :: UniqSM x -> FuelMonad x
105 liftUniq x = FuelMonad (\s -> x >>= (\u -> return (u, s)))
107 class Monad m => FuelUsingMonad m where
108 fuelRemaining :: m OptimizationFuel
109 fuelDecrement :: String -> OptimizationFuel -> OptimizationFuel -> m ()
111 fuelExhausted :: m Bool
112 lastFuelPass :: m String
114 instance FuelUsingMonad FuelMonad where
115 fuelRemaining = extract fs_fuellimit
116 lastFuelPass = extract fs_lastpass
117 fuelExhausted = extract $ not . canRewriteWithFuel . fs_fuellimit
118 fuelDecrement p f f' = FuelMonad (\s -> return ((), fuelDecrementState p f f' s))
119 fuelDec1 = FuelMonad f
120 where f s = if canRewriteWithFuel (fs_fuellimit s) then
121 return ((), s { fs_fuellimit = oneLessFuel (fs_fuellimit s) })
122 else panic "Tried to use exhausted fuel supply"
124 extract :: (FuelState -> a) -> FuelMonad a
125 extract f = FuelMonad (\s -> return (f s, s))
128 :: String -> OptimizationFuel -> OptimizationFuel -> FuelState -> FuelState
129 fuelDecrementState new_optimizer old new s =
130 FuelState { fs_fuellimit = lim, fs_lastpass = optimizer }
131 where lim = if diffFuel old (fs_fuellimit s) == 0 then new
133 concat ["lost track of ", new_optimizer, "'s transactions"]
134 optimizer = if diffFuel old new > 0 then new_optimizer else fs_lastpass s
136 -- lGraphOfGraph is here because we need uniques to implement it.
137 lGraphOfGraph :: Graph m l -> FuelMonad (LGraph m l)
138 lGraphOfGraph (Graph tail blocks) =
139 do entry <- liftM BlockId $ getUniqueM
140 return $ LGraph entry (insertBlock (Block entry tail) blocks)