diff options
author | Tom Smeding <tom.smeding@gmail.com> | 2018-03-26 21:34:51 +0200 |
---|---|---|
committer | Tom Smeding <tom.smeding@gmail.com> | 2018-03-26 21:34:51 +0200 |
commit | 0e1f435314b382cb78056f04d0997df43e4f8fcf (patch) | |
tree | 8195b40c448cbbafc868a9727b6e1c218f26ca00 /Optimiser.hs | |
parent | c25979b76c1dd22b6dc33acb994e9044c56a68f9 (diff) |
Rename files for case-sensitive file system
Diffstat (limited to 'Optimiser.hs')
-rw-r--r-- | Optimiser.hs | 24 |
1 files changed, 24 insertions, 0 deletions
diff --git a/Optimiser.hs b/Optimiser.hs new file mode 100644 index 0000000..c4c60cb --- /dev/null +++ b/Optimiser.hs @@ -0,0 +1,24 @@ +module Optimiser(optimise) where + +import Data.List + +import Intermediate + + +optimise :: IRProgram -> IRProgram +optimise (IRProgram bbs gfds datas) = IRProgram (mergeBlocks bbs) gfds datas + +mergeBlocks :: [BB] -> [BB] +mergeBlocks [] = [] +mergeBlocks allbbs@(BB startb _ _ : _) = + uncurry (++) (partition ((== startb) . bidOf) (go allbbs (length allbbs))) + where + go [] _ = [] + go bbs 0 = bbs + go (bb@(BB bid inss term) : bbs) n = case partition (hasJumpTo bid . termOf) bbs of + ([], _) -> go (bbs ++ [bb]) (n - 1) + ([BB bid' inss' _], rest) -> go (BB bid' (inss' ++ inss) term : rest) n + _ -> go (bbs ++ [bb]) (n - 1) + + hasJumpTo bid (IJmp a) = a == bid + hasJumpTo _ _ = False |