[create log files on the fly
Helmut Grohne <grohne@cs.uni-bonn.de>**20150226121856
 Ignore-this: eb96b0b8c4b8b639c7de2a149dac6ab
 
 Previously, igor would collect all log entries and after finishing a synthesis
 output them in one batch. Likely this causes lots of thunks to reference
 unneeded data structures (as prettyfication is lazy) and thus excessive memory
 usage. In fact, a -hd heap profile shows excessive thunks in
 Igor2.Logging.Logger and a -hy heap profile shows excessive Logs.
 
 This change regresses the error handling during log file writing and lets igor
 crash instead.
] hunk ./src/Igor2/Config.hs 10
-    delBackground, setPredicates, addPredicates, setCtxFile, delPredicates,
-    getLogState
+    delBackground, setPredicates, addPredicates, setCtxFile, delPredicates
hunk ./src/Igor2/Config.hs 110
-
-getLogState :: SCR -> LogState
-getLogState scr = mkLogState (scr_verbosity scr) (scr_verbose scr) (scr_dumpLog scr)
hunk ./src/Igor2/Logging/Logger.hs 15
-    module Control.Monad.Writer.Strict,
hunk ./src/Igor2/Logging/Logger.hs 26
-import Data.Maybe (maybeToList)
+import Data.Maybe (isJust)
hunk ./src/Igor2/Logging/Logger.hs 29
-import Control.Monad.Writer.Strict (MonadWriter(tell), WriterT, Writer(..), runWriter, runWriterT)
hunk ./src/Igor2/Logging/Logger.hs 33
+import qualified System.IO as SIO
hunk ./src/Igor2/Logging/Logger.hs 50
-                   ,dumpLog  :: Bool}    -- ^dump to log file
+                   ,dumpLog  :: Maybe SIO.Handle} -- ^dump to log file
hunk ./src/Igor2/Logging/Logger.hs 101
-isDumping :: (MonadState LogState m) =>m Bool
-isDumping = gets dumpLog
+isDumping :: (MonadState LogState m) => m Bool
+isDumping = liftM isJust $ gets dumpLog
hunk ./src/Igor2/Logging/Logger.hs 104
-setDumping ::  (MonadState LogState m) =>Bool -> m ()
+setDumping ::  (MonadState LogState m) => Maybe (SIO.Handle) -> m ()
hunk ./src/Igor2/Logging/Logger.hs 118
-              isDumping >>= flip when ( tell . newLog $ le)))
+              gets dumpLog >>= maybe (return ()) (\h -> liftIO $ displayIO h (renderPretty 0.5 140 msg))))
hunk ./src/Igor2/Logging/Logger.hs 145
-newtype ELT m a = ELT { unELT :: (StateT LogState (ErrorT String (WriterT Log m)) a) }
+newtype ELT m a = ELT { unELT :: (StateT LogState (ErrorT String m) a) }
hunk ./src/Igor2/Logging/Logger.hs 152
-    lift = ELT . lift . lift . lift
+    lift = ELT . lift . lift
hunk ./src/Igor2/Logging/Logger.hs 169
-runELT :: (Monad m) => (ELT m a) -> LogState -> m (Either String a, Log) 
-runELT m s = runWriterT (runErrorT (evalStateT (unELT m) s))
+runELT :: (Monad m) => ELT m a -> LogState -> m (Either String a)
+runELT m s = runErrorT (evalStateT (unELT m) s)
hunk ./src/Igor2/Logging/Logger.hs 173
-runLM :: ELT (C IO) a -> LogState -> C IO (Either String a, Log)
+runLM :: ELT (C IO) a -> LogState -> C IO (Either String a)
hunk ./src/Igor2/SynthesisEngine.hs 41
-startSynthesis :: Context  -> SCR -> [FunBind] -> [FunBind]
-               -> IO (Either String ([(Name,Int)],[[[FunBind]]]),Log)
-startSynthesis ctx conf tgt bgk =
-    (withC (runLM (synthesise ctx conf (toRbs tgt)(toRbs bgk)) (getLogState conf)) ctx)
-         `catchError` \m -> return (Left (show m), emptyLog)
+startSynthesis :: Context  -> SCR -> LogState -> [FunBind] -> [FunBind]
+               -> IO (Either String ([(Name, Int)], [[[FunBind]]]))
+startSynthesis ctx conf logstate tgt bgk =
+    (withC (runLM (synthesise ctx conf (toRbs tgt)(toRbs bgk)) logstate) ctx)
+         `catchError` \m -> return (Left (show m))
hunk ./src/Igor2/UI/UIStarter.hs 261
-          (res,t) <- time (startSynthesis (spec_ctx $ context s) conf ts bs)
-          let s' = either (const s)((modifyHistory s (tgts,bgks)).snd)(fst $ res) 
+          (res, t) <- withLogState s conf (\logstate -> time (startSynthesis (spec_ctx $ context s) conf logstate ts bs))
+          let s' = either (const s) (modifyHistory s (tgts, bgks) . snd) res
hunk ./src/Igor2/UI/UIStarter.hs 288
-            -> (Either String ([(Name,Int)],[[[a]]]),Log) -> IO()
-printResult s c t (rs,l) = do 
-    let w   = (fromInteger.colWidth $ s)
+            -> Either String ([(Name, Int)], [[[a]]]) -> IO ()
+printResult s c t rs = do
+    let w   = fromInteger $ colWidth s
hunk ./src/Igor2/UI/UIStarter.hs 293
-    writeToFile s  $ introBanner <$$> pretty c <$$> logBanner w <$$> 
-                     pretty l <$$> resBanner w <$$> res
hunk ./src/Igor2/UI/UIStarter.hs 294
-writeToFile :: EnvState -> Doc -> IO ()
-writeToFile s d = do
-    (checkDir (dumpDir s) >> when (dumpLog s) writeLog >> return ())
-      `catchError` (reportError "Log not dumped:")
-    
-    where
-    writeLog = do name    <- showDate
-                  file    <- return ((dumpDir s) ++ "/" ++ name ++ ".log")
-                  fhandle <- openFile file AppendMode
-                  displayIO fhandle (renderPretty 0.5 140 d) 
-                  --hPutDoc fhandle d
-                  hClose fhandle
-                  
+withLogState :: Pretty a => EnvState -> SCR -> (LogState -> IO a) -> IO a
+withLogState s c action = do
+    if dumpLog s then do
+        checkDir (dumpDir s)
+        name <- showDate
+        let file = dumpDir s ++ "/" ++ name ++ ".log"
+        fhandle <- openFile file AppendMode
+	let bannerWidth = fromInteger (colWidth s)
+	renderLog fhandle $ introBanner <$$> pretty c <$$> logBanner bannerWidth
+        result <- action . hToLogState $ Just fhandle
+	renderLog fhandle $ resBanner bannerWidth <$$> pretty result
+        hClose fhandle
+        return result
+      else action $ hToLogState Nothing
+    where hToLogState = mkLogState (verbosity s) (verbose s)
+          renderLog fhandle = displayIO fhandle . renderPretty 0.5 140
+