diff options
author | David Terei <davidterei@gmail.com> | 2010-07-21 14:36:54 +0000 |
---|---|---|
committer | David Terei <davidterei@gmail.com> | 2010-07-21 14:36:54 +0000 |
commit | 8f08820e42c7f3a31c1eb12b8d6ce80118b9d682 (patch) | |
tree | 7fd14256e0acb0f511583e755247c7016ded7a6f | |
parent | 58879838c504929d5e0be905b4f8266df385cfdd (diff) | |
download | haskell-8f08820e42c7f3a31c1eb12b8d6ce80118b9d682.tar.gz |
LLVM: Code and speed improvement to dominateAllocs pass.
-rw-r--r-- | compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 12 |
1 files changed, 5 insertions, 7 deletions
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index 37ad1198a6..076974a3c5 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -26,6 +26,7 @@ import UniqSupply import Unique import Util +import Data.List ( partition ) import Control.Monad ( liftM ) type LlvmStatements = OrdList LlvmStatement @@ -79,13 +80,10 @@ basicBlocksCodeGen env (block:blocks) (lblocks', ltops') -- of a function to make sure they dominate all possible paths in the CFG. dominateAllocs :: LlvmBasicBlock -> (LlvmBasicBlock, [LlvmStatement]) dominateAllocs (BasicBlock id stmts) - = (BasicBlock id allstmts, allallocs) - where - (allstmts, allallocs) = foldl split ([],[]) stmts - split (stmts', allocs) s@(Assignment _ (Alloca _ _)) - = (stmts', allocs ++ [s]) - split (stmts', allocs) other - = (stmts' ++ [other], allocs) + = let (allocs, stmts') = partition isAlloc stmts + isAlloc (Assignment _ (Alloca _ _)) = True + isAlloc _other = False + in (BasicBlock id stmts', allocs) -- | Generate code for one block |