projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
5887983
)
LLVM: Code and speed improvement to dominateAllocs pass.
author
David Terei
<davidterei@gmail.com>
Wed, 21 Jul 2010 14:36:54 +0000
(14:36 +0000)
committer
David Terei
<davidterei@gmail.com>
Wed, 21 Jul 2010 14:36:54 +0000
(14:36 +0000)
compiler/llvmGen/LlvmCodeGen/CodeGen.hs
patch
|
blob
|
history
diff --git
a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index
37ad119
..
076974a
100644
(file)
--- a/
compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/
compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@
-26,6
+26,7
@@
import UniqSupply
import Unique
import Util
import Unique
import Util
+import Data.List ( partition )
import Control.Monad ( liftM )
type LlvmStatements = OrdList LlvmStatement
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)
-- 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
-- | Generate code for one block