"Committed_by_peb"

1 files changed, 16 insertions, 7 deletions

diff --git a/src/GF/System/Tracing.hs b/src/GF/System/Tracing.hs
index b092949e8..179ed986d 100644
--- a/src/GF/System/Tracing.hs
+++ b/src/GF/System/Tracing.hs
@@ -5,16 +5,17 @@
 -- Stability   : (stable)
 -- Portability : (portable)
 --
--- > CVS $Date: 2005/03/29 11:58:46 $ 
+-- > CVS $Date: 2005/04/11 13:52:57 $ 
 -- > CVS $Author: peb $
--- > CVS $Revision: 1.1 $
+-- > CVS $Revision: 1.2 $
 --
 -- Tracing utilities for debugging purposes.
 -- If the CPP symbol TRACING is set, then the debugging output is shown.
 -----------------------------------------------------------------------------
 
 
-module GF.System.Tracing (trace, trace2, traceDot, traceCall, tracePrt) where
+module GF.System.Tracing
+    (trace, trace2, traceM, traceCall, tracePrt, traceCalcFirst) where
 
 import qualified IOExts 
 
@@ -26,8 +27,8 @@ trace :: String -> a -> a
 -- @{fun: out}@
 trace2 :: String -> String -> a -> a
 
--- | emit a dot before(?) calculating the value, for displaying progress
-traceDot :: a -> a
+-- | monadic version of 'trace2'
+traceM :: Monad m => String -> String -> m ()
 
 -- | show when a value is starting to be calculated (with a '+'), 
 -- and when it is finished (with a '-')
@@ -37,20 +38,28 @@ traceCall :: String -> String -> (a -> String) -> a -> a
 -- @{fun: value}@
 tracePrt :: String -> (a -> String) -> a -> a
 
+-- | this is equivalent to 'seq' when tracing, but
+-- just skips the first argument otherwise
+traceCalcFirst :: a -> b -> b
+
 #if TRACING
 trace str a = IOExts.trace (bold ++ "{" ++ normal ++ str ++ bold ++ "}" ++ normal) a
 trace2 fun str a = trace (bold ++ fgcol 1 ++ fun ++ ": " ++ normal ++ str) a 
-traceDot a = IOExts.unsafePerformIO (putStr ".") `seq` a
+traceM fun str = trace2 fun str (return ())
 traceCall fun start prt val 
     = trace2 ("+" ++ fun) start $
       val `seq` trace2 ("-" ++ fun) (prt val) val
 tracePrt mod prt val = val `seq` trace2 mod (prt val) val
+traceCalcFirst = seq
+
 #else
 trace _ = id
 trace2 _ _ = id
-traceDot = id
+traceM _ _ = return ()
 traceCall _ _ _ = id
 tracePrt _ _ = id
+traceCalcFirst _ = id
+
 #endif