X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FllvmGen%2FLlvmCodeGen%2FCodeGen.hs;fp=compiler%2FllvmGen%2FLlvmCodeGen%2FCodeGen.hs;h=076974a3c59d2277695d1d6c7e9c99606380ef68;hp=37ad1198a6cf9b4644f1dbb0096ada8662aa651d;hb=8f08820e42c7f3a31c1eb12b8d6ce80118b9d682;hpb=58879838c504929d5e0be905b4f8266df385cfdd

diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index 37ad119..076974a 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