diff options
Diffstat (limited to 'Optimiser.hs')
| -rw-r--r-- | Optimiser.hs | 44 |
1 files changed, 21 insertions, 23 deletions
diff --git a/Optimiser.hs b/Optimiser.hs index f94441c..c438c82 100644 --- a/Optimiser.hs +++ b/Optimiser.hs @@ -1,4 +1,4 @@ -module Optimiser(optimise) where +module Optimiser(optimise, OptimiserLevel(..)) where import Data.Either import Data.Function @@ -14,35 +14,33 @@ import ReplaceRefs import Utils +data OptimiserLevel = Level0 | Level1 + deriving (Show, Eq, Ord) + type Optimisation = IRProgram -> IRProgram type FuncOptimisation = IRFunc -> IRFunc -optimise :: IRProgram -> Error IRProgram -optimise prog = - let optlist = [trace "-- OPT PASS --" {-, \p -> trace (pretty p) p-}] ++ optimisations +optimise :: OptimiserLevel -> IRProgram -> Error IRProgram +optimise optlevel prog = + let optlist = {-[trace "-- OPT PASS --", \p -> trace (pretty p) p] ++ -} optimisations reslist = scanl (flip ($)) prog $ cycle optlist passreslist = map fst $ filter (\(_, i) -> i `mod` length optlist == 0) $ zip reslist [0..] applyFinalOpts p = foldl (flip ($)) p finaloptimisations - in if True - then return $ applyFinalOpts $ - fst $ fromJust $ find (uncurry (==)) $ zip passreslist (tail passreslist) - else return $ reslist !! 5 + in return $ applyFinalOpts $ + fst $ fromJust $ find (uncurry (==)) $ zip passreslist (tail passreslist) where - -- optimisations = map funcopt - -- [chainJumps, removeUnusedBlocks] - -- optimisations = map funcopt - -- [chainJumps, mergeTerminators, looseJumps, - -- removeUnusedBlocks, - -- constantPropagate, movPush] - optimisations = map funcopt - [chainJumps, mergeTerminators, looseJumps, - removeUnusedBlocks, removeDuplicateBlocks, - identityOps, - constantPropagate, movPush, - arithPush, removeUnusedInstructions, - evaluateInstructions, evaluateTerminators] - finaloptimisations = map funcopt - [reorderBlocks, flipJccs, invertJccs] + optimisations = case optlevel of + Level0 -> map funcopt [chainJumps, mergeTerminators, looseJumps, removeUnusedBlocks] + Level1 -> map funcopt + [chainJumps, mergeTerminators, looseJumps, + removeUnusedBlocks, removeDuplicateBlocks, + identityOps, + constantPropagate, movPush, + arithPush, removeUnusedInstructions, + evaluateInstructions, evaluateTerminators] + finaloptimisations = case optlevel of + Level0 -> map funcopt [flipJccs] + Level1 -> map funcopt [reorderBlocks, flipJccs, invertJccs] funcopt :: FuncOptimisation -> Optimisation |