summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Terei <davidterei@gmail.com>2010-07-21 14:36:54 +0000
committerDavid Terei <davidterei@gmail.com>2010-07-21 14:36:54 +0000
commit8f08820e42c7f3a31c1eb12b8d6ce80118b9d682 (patch)
tree7fd14256e0acb0f511583e755247c7016ded7a6f
parent58879838c504929d5e0be905b4f8266df385cfdd (diff)
downloadhaskell-8f08820e42c7f3a31c1eb12b8d6ce80118b9d682.tar.gz
LLVM: Code and speed improvement to dominateAllocs pass.
-rw-r--r--compiler/llvmGen/LlvmCodeGen/CodeGen.hs12
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