[make the mutable 'Stats' based on 'Stat' internally
John Meacham <john@repetae.net>**20070523034801] hunk ./Stats.hs 9
-    getTicks,
+    isEmpty,
+    null,
hunk ./Stats.hs 45
-import qualified Data.HashTable as H
-import qualified Data.Map as Map
+import Prelude hiding(null)
hunk ./Stats.hs 47
+import qualified Data.Map as Map
+import qualified Prelude(null)
hunk ./Stats.hs 58
--- Stateful stats
-
-data Stats = Stats !(IORef Int) !(H.HashTable Atom Int)
-
-{-# NOINLINE theStats #-}
-theStats :: Stats
-theStats = unsafePerformIO new
-
-{-# NOINLINE printStats #-}
-printStats :: IORef Bool
-printStats = unsafePerformIO $ newIORef False
-
-setPrintStats :: Bool -> IO ()
-setPrintStats b = writeIORef printStats b
-
-combine :: Stats -> Stats -> IO ()
-combine stats (Stats _ h2) = do
-    ls <- H.toList h2
-    let f (a,i) = ticks stats i a
-    mapM_ f ls
-
-new = do
-    h <- H.new (==) (fromIntegral . atomIndex)
-    r <- newIORef 0
-    return $ Stats r h
-
-clear (Stats r h) = do
-    writeIORef r 0
-    xs <- H.toList h
-    mapM_ (H.delete h) (fsts xs)
-
-toList (Stats _ h) = H.toList h
-getTicks (Stats r _)  = readIORef r
-
-tick stats k = ticks stats 1 k
-
-
-ticks _ 0 _ = return ()
-ticks (Stats r h) c k' = do
-    let k = toAtom k'
-    liftIO $ modifyIORef r (+ c)
-    liftIO $ readIORef r >>= evaluate
-    v <- liftIO $ H.lookup h k
-    case v of
-        Just n -> liftIO $ H.delete h k >> (H.insert h k $! (n + c))
-        Nothing -> liftIO $ H.insert h k c
hunk ./Stats.hs 60
-splitUp n str = filter (not . null) (f n str)  where
+splitUp n str = filter (not . Prelude.null) (f n str)  where
hunk ./Stats.hs 124
---instance Monoid Stat where
---    mempty = Stat Map.empty
---    mappend (Stat a) (Stat b) = Stat $ Map.unionWith (+) a b
-    --mconcat xs = Stat $ Map.unionsWith (+) [ x | Stat x <- xs]
hunk ./Stats.hs 126
------------------
--- pure + mutable
------------------
-
-
-tickStat ::  Stats -> Stat -> IO ()
-tickStat stats (Stat stat) = sequence_  [ ticks stats n (unsafeIntToAtom a) | (a,n) <- IB.toList stat]
-
-mtickStat :: MonadStats m =>  Stat -> m ()
-mtickStat (Stat stats)  = sequence_  [ mticks n (unsafeIntToAtom a) | (a,n) <- IB.toList stats]
-
-runStatIO :: MonadIO m =>  Stats -> StatT m a -> m a
-runStatIO stats action = do
-    (a,s) <- runStatT action
-    liftIO $ tickStat stats s
-    return a
-
-getStat :: Stats -> IO Stat
-getStat stats = do
-    ll <- toList stats
-    return (Stat $ IB.fromList [ (unsafeAtomToInt x,y) | (x,y) <- ll])
-
hunk ./Stats.hs 133
+    mtickStat :: Stat -> m ()
+
+
hunk ./Stats.hs 158
+   mtickStat s = StatM () s
hunk ./Stats.hs 176
+    mtickStat _ = return ()
hunk ./Stats.hs 184
+    mtickStat s = lift $ mtickStat s
hunk ./Stats.hs 188
+    mtickStat s =  StatT $ tell s
hunk ./Stats.hs 191
+
+singleStat :: ToAtom a => Int -> a -> Stat
hunk ./Stats.hs 196
+null (Stat r) = IB.null r
+
hunk ./Stats.hs 204
+    mtickStat (Stat s) = do
+        tickStat theStats (Stat s)
+        p <- readIORef printStats
+        when p $ forM_ (IB.toList s) $ \ (x,y) -> do
+            CharIO.putStrLn (show (unsafeIntToAtom x) ++ ": " ++ show y)
+
+
+
+--------------------
+-- Stateful IO stats
+--------------------
+
+newtype Stats = Stats (IORef Stat)
+
+{-# NOINLINE theStats #-}
+theStats :: Stats
+theStats = unsafePerformIO new
+
+{-# NOINLINE printStats #-}
+printStats :: IORef Bool
+printStats = unsafePerformIO $ newIORef False
+
+setPrintStats :: Bool -> IO ()
+setPrintStats b = writeIORef printStats b
+
+combine :: Stats -> Stats -> IO ()
+combine (Stats s1) (Stats s2) = do
+    s <- readIORef s2
+    modifyIORef s1 (mappend s)
+
+new = Stats `liftM` newIORef mempty
+
+clear (Stats h) = writeIORef h mempty
+
+toList (Stats r) = do
+    Stat s <- readIORef r
+    return [(unsafeIntToAtom x,y) | (x,y) <- IB.toList s]
+
+isEmpty (Stats r) = null `liftM` readIORef r
+
+tick stats k = ticks stats 1 k
+
+
+ticks (Stats r) c k = modifyIORef r (mappend $ singleStat c k)
+
+-----------------
+-- pure + mutable
+-----------------
+
+
+tickStat ::  Stats -> Stat -> IO ()
+tickStat (Stats r) s = modifyIORef r (mappend s)
+
+
+runStatIO :: MonadIO m =>  Stats -> StatT m a -> m a
+runStatIO stats action = do
+    (a,s) <- runStatT action
+    liftIO $ tickStat stats s
+    return a
+
+getStat :: Stats -> IO Stat
+getStat stats = do
+    ll <- toList stats
+    return (Stat $ IB.fromList [ (unsafeAtomToInt x,y) | (x,y) <- ll])