tried to identify slowdown - possible 'foldl (++) graphlist' causing much GC-activity in the long-run

dist/build/autogen/Paths_hgraph.hs

@@ -1,7 +1,7 @@
 module Paths_hgraph (
     version,
     getBinDir, getLibDir, getDataDir, getLibexecDir,
-    getDataFileName, getSysconfDir
+    getDataFileName
   ) where
 
 import qualified Control.Exception as Exception
@@ -15,20 +15,18 @@ catchIO = Exception.catch
 
 version :: Version
 version = Version {versionBranch = [0,0,1], versionTags = []}
-bindir, libdir, datadir, libexecdir, sysconfdir :: FilePath
+bindir, libdir, datadir, libexecdir :: FilePath
 
 bindir     = "/home/sdressel/.cabal/bin"
-libdir     = "/home/sdressel/.cabal/lib/x86_64-linux-ghc-7.6.3/hgraph-0.0.1"
+libdir     = "/home/sdressel/.cabal/lib/hgraph-0.0.1/ghc-7.6.3"
-datadir    = "/home/sdressel/.cabal/share/x86_64-linux-ghc-7.6.3/hgraph-0.0.1"
+datadir    = "/home/sdressel/.cabal/share/hgraph-0.0.1"
 libexecdir = "/home/sdressel/.cabal/libexec"
-sysconfdir = "/home/sdressel/.cabal/etc"
 
-getBinDir, getLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath
+getBinDir, getLibDir, getDataDir, getLibexecDir :: IO FilePath
 getBinDir = catchIO (getEnv "hgraph_bindir") (\_ -> return bindir)
 getLibDir = catchIO (getEnv "hgraph_libdir") (\_ -> return libdir)
 getDataDir = catchIO (getEnv "hgraph_datadir") (\_ -> return datadir)
 getLibexecDir = catchIO (getEnv "hgraph_libexecdir") (\_ -> return libexecdir)
-getSysconfDir = catchIO (getEnv "hgraph_sysconfdir") (\_ -> return sysconfdir)
 
 getDataFileName :: FilePath -> IO FilePath
 getDataFileName name = do

src/Main.hs

@@ -25,7 +25,7 @@ import System.Exit (exitFailure)
 import System.Environment
 import Test.QuickCheck.All (quickCheckAll)
 import qualified Data.ByteString.Char8 as B
-import Data.ByteString.Lazy.Char8 (ByteString)
+import Data.ByteString.Char8 (ByteString)
 import Control.Monad.Par.Scheds.Trace
 import qualified Data.Stream as S
 import Data.Either (lefts, rights)
@@ -39,7 +39,8 @@ import Data.Array.Accelerate.Interpreter as I
 type Matrix e = A.Array A.DIM2 e
 
 
-
+-- TODO: Give createGraph a presized Array and no dynamic [Int].
+-- should be createGraph :: T.Text -> Either (Matrix Int) T.Text
 createGraph :: T.Text -> Either [Int] T.Text
 createGraph input = createGraph' input (Left [])
     where
@@ -50,38 +51,16 @@ createGraph input = createGraph' input (Left [])
                     let next = (createGraph' (T.tail a) r) in
                         case next of
                             Left xs ->
-                                case T.head a of
+                                case T.head (traceEvent "parsing" a) of
-                                    '0' -> Left $ 0:xs
+                                    '0' -> Left $ traceEvent "parse-concat" 0:xs
-                                    '1' -> Left $ 1:xs
+                                    '1' -> Left $ traceEvent "parse-concat" 1:xs
                                     _   -> Right $ T.append (T.pack "cannot parse ") a
                             Right errstr ->
                                 Right errstr
 --createGraph input = Right $ "Parsing-error in line: " ++ input
 
--- TODO: not needed anymore. remove? Later use?
+--concatWith :: String -> String -> String -> String
-graphFolder :: [Either [Int] String] -> (Either [[Int]] String)
+--concatWith d a b = a ++ d ++ b
-graphFolder [] = Right "empty Graph"
-graphFolder l = graphFolder' l (Left [[]])
-    where
-    graphFolder' :: [Either [Int] String] -> (Either [[Int]] String) -> (Either [[Int]] String)
-    graphFolder' [] r      = r
-    graphFolder' (a:as) r  =
-                    case a of
-                    -- we have an intact [Int]
-                    Left b ->
-                        case graphFolder' as r of
-                        -- append if rest is ok.
-                        Left xs  -> Left (b:xs)
-                        -- ooops. Error-String -> Discard result
-                        Right s -> Right s
-                    -- we have an Error-String -> ignore results, append errors if possible
-                    Right s ->
-                        case graphFolder' as r of
-                        Left x   -> Right s
-                        Right ss -> Right (ss ++ "\n" ++ s)
-
-concatWith :: String -> String -> String -> String
-concatWith d a b = a ++ d ++ b
 
 emptyLine :: T.Text -> Bool
 emptyLine a
@@ -93,10 +72,13 @@ emptyLog [] = True
 emptyLog a = False --emptyLine $ foldl True (&&) (map emptyLine a)
 
 -- TODO: implement calculation
-doCalculation :: Matrix Int -> B.ByteString
+--doCalculation :: Matrix Int -> B.ByteString
-doCalculation a = B.pack $ "" --(show a) ++ "\n"
+doCalculation a = B.pack $ (show a) ++ "\n"
 
+infixl 1 +||
 
+(+||) :: a -> Strategy a -> a
+a +|| b = a `using` b
 
 exeMain = do
     args <- getArgs
@@ -104,29 +86,32 @@ exeMain = do
             ["-"] -> B.getContents
             [] -> error "Error: No filename or stdinput (-) given."
             [file] -> B.readFile file
+    -- read file and clean
+    readFile <- return $ filter (not . emptyLine) (T.lines (decodeUtf8 input))
+    inputLines <- return $ length readFile
+    -- TODO: concat with foldl1' kills us later -> use presized/preallocated array so we
+    --       dont copy that much lateron. Best would be Matrix Int
     -- unrefined_graph::[Either [Int] String] - [Int] is Adjacency-Line, String is parse-Error
-    unrefined_graph <- return $ parMap (rparWith rdeepseq) --run parallel, evaluate fully
+    unrefined_graph <- return $ (map (traceEvent "mapping" . createGraph) readFile)
-                                                        -- and filter empty lines
+                                        +|| (parBuffer 100 rdeepseq) --run parallel, evaluate fully
-                                        (createGraph) (filter (not . emptyLine)
-                                                        -- split at \n, convert to String
-                                                        (T.lines (decodeUtf8 input)))
     --egraph <- return $ graphFolder unrefined_graph
-    (graph, log, lines) <- return $ ((foldl1 (++) (lefts unrefined_graph), -- concatenated graph
+
-                                T.intercalate (T.singleton '\n') (rights unrefined_graph), -- concat error-log
+    (graph, log, lines) <- return $ ((foldl1' ((traceEvent "concatenating graph") . (++)) (lefts unrefined_graph), -- concatenated graph
-                                length unrefined_graph) -- number of elements in graph
+                                traceEvent "concatenating log" T.intercalate (T.singleton '\n') (rights unrefined_graph), -- concat error-log
+                                traceEvent "getting length" length unrefined_graph) -- number of elements in graph
                                                     -- in parallel
                                                     `using` parTuple3 rdeepseq rdeepseq rdeepseq)
 
     -- validate graph
-    log <- return $ let l = length graph in
+    log <- return $ let l = traceEvent "first validation" length graph in
                         if l /= lines*lines then
                             T.append log $ T.pack $ "Lines dont match up. Read " ++ (show l) ++
                                                     " chars. Expected " ++ (show (lines*lines)) ++
                                                     " chars.\n"
                         else
                             log
-    output <- return $ case emptyLine log of
+    output <- return $ case emptyLine (traceEvent "last validation" log) of
-        True -> doCalculation $ A.fromList (A.Z A.:. lines A.:. lines) graph
+        True -> doCalculation $ graph --A.fromList (A.Z A.:. lines A.:. lines) graph
         _    -> encodeUtf8 $ T.append (T.append (T.pack "Error detected:\n") log) (T.pack "\n\n")
     B.putStr output