weigh-0.0.7/src/0000755000000000000000000000000013205536310011574 5ustar0000000000000000weigh-0.0.7/src/Weigh/0000755000000000000000000000000013207220041012630 5ustar0000000000000000weigh-0.0.7/src/test/0000755000000000000000000000000013205527526012564 5ustar0000000000000000weigh-0.0.7/src/Weigh.hs0000644000000000000000000003373313205536310013204 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE BangPatterns #-} -- | Framework for seeing how much a function allocates. -- -- Example: -- -- @ -- import Weigh -- main = -- mainWith (do func "integers count 0" count 0 -- func "integers count 1" count 1 -- func "integers count 2" count 2 -- func "integers count 3" count 3 -- func "integers count 10" count 10 -- func "integers count 100" count 100) -- where count :: Integer -> () -- count 0 = () -- count a = count (a - 1) -- @ module Weigh (-- * Main entry points mainWith ,weighResults -- * Configuration ,setColumns ,Column(..) -- * Simple combinators ,func ,io ,value ,action -- * Validating combinators ,validateAction ,validateFunc -- * Validators ,maxAllocs -- * Types ,Weigh ,Weight(..) -- * Handy utilities ,commas -- * Internals ,weighDispatch ,weighFunc ,weighAction ) where import Control.Applicative import Control.Arrow import Control.DeepSeq import Control.Monad.State import Data.List import Data.List.Split import Data.Maybe import Data.Int import Prelude import System.Environment import System.Exit import System.IO import System.IO.Temp import System.Mem import System.Process import Text.Printf import qualified Weigh.GHCStats as GHCStats -------------------------------------------------------------------------------- -- Types -- | Table column. data Column = Case | Allocated | GCs| Live | Check | Max deriving (Show, Eq, Enum) -- | Weigh configuration. data Config = Config {configColumns :: [Column]} deriving (Show) -- | Weigh specification monad. newtype Weigh a = Weigh {runWeigh :: State (Config, [(String,Action)]) a} deriving (Monad,Functor,Applicative) -- | How much a computation weighed in at. data Weight = Weight {weightLabel :: !String ,weightAllocatedBytes :: !Int64 ,weightGCs :: !Int64 ,weightLiveBytes :: !Int64 ,weightMaxBytes :: !Int64 } deriving (Read,Show) -- | An action to run. data Action = forall a b. (NFData a) => Action {_actionRun :: !(Either (b -> IO a) (b -> a)) ,_actionArg :: !b ,actionCheck :: Weight -> Maybe String} -------------------------------------------------------------------------------- -- Main-runners -- | Just run the measuring and print a report. Uses 'weighResults'. mainWith :: Weigh a -> IO () mainWith m = do (results, config) <- weighResults m unless (null results) (do putStrLn "" putStrLn (report config results)) case mapMaybe (\(w,r) -> do msg <- r return (w,msg)) results of [] -> return () errors -> do putStrLn "\nCheck problems:" mapM_ (\(w,r) -> putStrLn (" " ++ weightLabel w ++ "\n " ++ r)) errors exitWith (ExitFailure (-1)) -- | Run the measuring and return all the results, each one may have -- an error. weighResults :: Weigh a -> IO ([(Weight,Maybe String)], Config) weighResults m = do args <- getArgs let (config, cases) = execState (runWeigh m) (defaultConfig, []) result <- weighDispatch args cases case result of Nothing -> return ([], config) Just weights -> return ( map (\w -> case lookup (weightLabel w) cases of Nothing -> (w, Nothing) Just a -> (w, actionCheck a w)) weights , config) -------------------------------------------------------------------------------- -- User DSL -- | Default columns to display. defaultColumns :: [Column] defaultColumns = [Case, Allocated, GCs] -- | Default config. defaultConfig :: Config defaultConfig = Config {configColumns = defaultColumns} -- | Set the config. Default is: 'defaultConfig'. setColumns :: [Column] -> Weigh () setColumns cs = Weigh (modify (first (\c -> c {configColumns = cs}))) -- | Weigh a function applied to an argument. -- -- Implemented in terms of 'validateFunc'. func :: (NFData a) => String -- ^ Name of the case. -> (b -> a) -- ^ Function that does some action to measure. -> b -- ^ Argument to that function. -> Weigh () func name !f !x = validateFunc name f x (const Nothing) -- | Weigh an action applied to an argument. -- -- Implemented in terms of 'validateAction'. io :: (NFData a) => String -- ^ Name of the case. -> (b -> IO a) -- ^ Aciton that does some IO to measure. -> b -- ^ Argument to that function. -> Weigh () io name !f !x = validateAction name f x (const Nothing) -- | Weigh a value. -- -- Implemented in terms of 'action'. value :: NFData a => String -- ^ Name for the value. -> a -- ^ The value to measure. -> Weigh () value name !v = func name id v -- | Weigh an IO action. -- -- Implemented in terms of 'validateAction'. action :: NFData a => String -- ^ Name for the value. -> IO a -- ^ The action to measure. -> Weigh () action name !m = io name (const m) () -- | Make a validator that set sthe maximum allocations. maxAllocs :: Int64 -- ^ The upper bound. -> (Weight -> Maybe String) maxAllocs n = \w -> if weightAllocatedBytes w > n then Just ("Allocated bytes exceeds " ++ commas n ++ ": " ++ commas (weightAllocatedBytes w)) else Nothing -- | Weigh an IO action, validating the result. validateAction :: (NFData a) => String -- ^ Name of the action. -> (b -> IO a) -- ^ The function which performs some IO. -> b -- ^ Argument to the function. Doesn't have to be forced. -> (Weight -> Maybe String) -- ^ A validating function, returns maybe an error. -> Weigh () validateAction name !m !arg !validate = tellAction [(name,Action (Left m) arg validate)] -- | Weigh a function, validating the result validateFunc :: (NFData a) => String -- ^ Name of the function. -> (b -> a) -- ^ The function which calculates something. -> b -- ^ Argument to the function. Doesn't have to be forced. -> (Weight -> Maybe String) -- ^ A validating function, returns maybe an error. -> Weigh () validateFunc name !f !x !validate = tellAction [(name,Action (Right f) x validate)] -- | Write out an action. tellAction :: [(String, Action)] -> Weigh () tellAction x = Weigh (modify (second ( ++ x))) -------------------------------------------------------------------------------- -- Internal measuring actions -- | Weigh a set of actions. The value of the actions are forced -- completely to ensure they are fully allocated. weighDispatch :: [String] -- ^ Program arguments. -> [(String,Action)] -- ^ Weigh name:action mapping. -> IO (Maybe [Weight]) weighDispatch args cases = case args of ("--case":label:fp:_) -> let !_ = force fp in case lookup label (deepseq (map fst cases) cases) of Nothing -> error "No such case!" Just act -> do case act of Action !run arg _ -> do (bytes, gcs, liveBytes, maxByte) <- case run of Right f -> weighFunc f arg Left m -> weighAction m arg writeFile fp (show (Weight { weightLabel = label , weightAllocatedBytes = bytes , weightGCs = gcs , weightLiveBytes = liveBytes , weightMaxBytes = maxByte })) return Nothing _ | names == nub names -> fmap Just (mapM (fork . fst) cases) | otherwise -> error "Non-unique names specified for things to measure." where names = map fst cases -- | Fork a case and run it. fork :: String -- ^ Label for the case. -> IO Weight fork label = withSystemTempFile "weigh" (\fp h -> do hClose h me <- getExecutablePath (exit, _, err) <- readProcessWithExitCode me ["--case", label, fp, "+RTS", "-T", "-RTS"] "" case exit of ExitFailure {} -> error ("Error in case (" ++ show label ++ "):\n " ++ err) ExitSuccess -> do out <- readFile fp case reads out of [(!r, _)] -> return r _ -> error (concat [ "Malformed output from subprocess. Weigh" , " (currently) communicates with its sub-" , "processes via a temporary file." ])) -- | Weigh a pure function. This function is heavily documented inside. weighFunc :: (NFData a) => (b -> a) -- ^ A function whose memory use we want to measure. -> b -- ^ Argument to the function. Doesn't have to be forced. -> IO (Int64,Int64,Int64,Int64) -- ^ Bytes allocated and garbage collections. weighFunc run !arg = do ghcStatsSizeInBytes <- GHCStats.getGhcStatsSizeInBytes performGC -- The above forces getStats data to be generated NOW. !bootupStats <- GHCStats.getStats -- We need the above to subtract "program startup" overhead. This -- operation itself adds n bytes for the size of GCStats, but we -- subtract again that later. let !_ = force (run arg) performGC -- The above forces getStats data to be generated NOW. !actionStats <- GHCStats.getStats let reflectionGCs = 1 -- We performed an additional GC. actionBytes = (GHCStats.totalBytesAllocated actionStats - GHCStats.totalBytesAllocated bootupStats) - -- We subtract the size of "bootupStats", which will be -- included after we did the performGC. fromIntegral ghcStatsSizeInBytes actionGCs = GHCStats.gcCount actionStats - GHCStats.gcCount bootupStats - reflectionGCs -- If overheadBytes is too large, we conservatively just -- return zero. It's not perfect, but this library is for -- measuring large quantities anyway. actualBytes = max 0 actionBytes liveBytes = max 0 (GHCStats.liveBytes actionStats - GHCStats.liveBytes bootupStats) maxBytes = max 0 (GHCStats.maxBytesInUse actionStats - GHCStats.maxBytesInUse bootupStats) return ( fromIntegral actualBytes , fromIntegral actionGCs , fromIntegral liveBytes , fromIntegral maxBytes) -- | Weigh a pure function. This function is heavily documented inside. weighAction :: (NFData a) => (b -> IO a) -- ^ A function whose memory use we want to measure. -> b -- ^ Argument to the function. Doesn't have to be forced. -> IO (Int64,Int64,Int64,Int64) -- ^ Bytes allocated and garbage collections. weighAction run !arg = do ghcStatsSizeInBytes <- GHCStats.getGhcStatsSizeInBytes performGC -- The above forces getStats data to be generated NOW. !bootupStats <- GHCStats.getStats -- We need the above to subtract "program startup" overhead. This -- operation itself adds n bytes for the size of GCStats, but we -- subtract again that later. !_ <- fmap force (run arg) performGC -- The above forces getStats data to be generated NOW. !actionStats <- GHCStats.getStats let reflectionGCs = 1 -- We performed an additional GC. actionBytes = (GHCStats.totalBytesAllocated actionStats - GHCStats.totalBytesAllocated bootupStats) - -- We subtract the size of "bootupStats", which will be -- included after we did the performGC. fromIntegral ghcStatsSizeInBytes actionGCs = GHCStats.gcCount actionStats - GHCStats.gcCount bootupStats - reflectionGCs -- If overheadBytes is too large, we conservatively just -- return zero. It's not perfect, but this library is for -- measuring large quantities anyway. actualBytes = max 0 actionBytes liveBytes = max 0 (GHCStats.liveBytes actionStats - GHCStats.liveBytes bootupStats) maxBytes = max 0 (GHCStats.maxBytesInUse actionStats - GHCStats.maxBytesInUse bootupStats) return ( fromIntegral actualBytes , fromIntegral actionGCs , fromIntegral liveBytes , fromIntegral maxBytes) -------------------------------------------------------------------------------- -- Formatting functions -- | Make a report of the weights. report :: Config -> [(Weight,Maybe String)] -> String report config = tablize . (select headings :) . map (select . toRow) where select row = mapMaybe (\name -> lookup name row) (configColumns config) headings = [ (Case, (True, "Case")) , (Allocated, (False, "Allocated")) , (GCs, (False, "GCs")) , (Live, (False, "Live")) , (Check, (True, "Check")) , (Max, (False, "Max")) ] toRow (w, err) = [ (Case, (True, weightLabel w)) , (Allocated, (False, commas (weightAllocatedBytes w))) , (GCs, (False, commas (weightGCs w))) , (Live, (False, commas (weightLiveBytes w))) , (Max, (False, commas (weightMaxBytes w))) , ( Check , ( True , case err of Nothing -> "OK" Just {} -> "INVALID")) ] -- | Make a table out of a list of rows. tablize :: [[(Bool,String)]] -> String tablize xs = intercalate "\n" (map (intercalate " " . map fill . zip [0 ..]) xs) where fill (x',(left',text')) = printf ("%" ++ direction ++ show width ++ "s") text' where direction = if left' then "-" else "" width = maximum (map (length . snd . (!! x')) xs) -- | Formatting an integral number to 1,000,000, etc. commas :: (Num a,Integral a,Show a) => a -> String commas = reverse . intercalate "," . chunksOf 3 . reverse . show weigh-0.0.7/src/Weigh/GHCStats.hs0000644000000000000000000000277313207220041014615 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE CPP #-} -- | Calculate the size of GHC.Stats statically. module Weigh.GHCStats (getGhcStatsSizeInBytes ,getStats ,gcCount ,totalBytesAllocated ,liveBytes ,maxBytesInUse) where #if __GLASGOW_HASKELL__ < 802 import Data.Int #else import Data.Int import Data.Word #endif import GHC.Stats import System.Mem #if __GLASGOW_HASKELL__ < 802 -- | Get GHC's statistics. getStats :: IO GCStats getStats = getGCStats gcCount :: GCStats -> Int64 gcCount = numGcs totalBytesAllocated :: GCStats -> Int64 totalBytesAllocated = bytesAllocated liveBytes :: GCStats -> Int64 liveBytes = currentBytesUsed maxBytesInUse :: GCStats -> Int64 maxBytesInUse = maxBytesUsed #else -- | Get GHC's statistics. getStats :: IO RTSStats getStats = getRTSStats gcCount :: RTSStats -> Word32 gcCount = gcs totalBytesAllocated :: RTSStats -> Word64 totalBytesAllocated = allocated_bytes liveBytes :: RTSStats -> Word64 liveBytes = cumulative_live_bytes maxBytesInUse :: RTSStats -> Word64 maxBytesInUse = max_live_bytes #endif -- | Get the size of a 'RTSStats' object in bytes. getGhcStatsSizeInBytes :: IO Int64 getGhcStatsSizeInBytes = do s1 <- oneGetStats s2 <- twoGetSTats return (fromIntegral (totalBytesAllocated s2 - totalBytesAllocated s1)) where oneGetStats = do performGC !s <- getStats return s twoGetSTats = do performGC !_ <- getStats !s <- getStats return s weigh-0.0.7/src/test/Maps.hs0000644000000000000000000000343512724541005014016 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveGeneric #-} -- | Example uses of comparing map-like data structures. module Main where import Control.DeepSeq import qualified Data.HashMap.Lazy import qualified Data.HashMap.Strict import qualified Data.IntMap.Lazy import qualified Data.IntMap.Strict import qualified Data.Map.Lazy import qualified Data.Map.Strict import System.Random import Weigh -- | Weigh maps. main :: IO () main = mainWith (do inserts fromlists) inserts :: Weigh () inserts = do func "Data.Map.Strict.insert mempty" (\(k,v) -> Data.Map.Strict.insert k v mempty) (1 :: Int,1 :: Int) func "Data.Map.Lazy.insert mempty" (\(k,v) -> Data.Map.Lazy.insert k v mempty) (1 :: Int,1 :: Int) func "Data.HashMap.Strict.insert mempty" (\(k,v) -> Data.HashMap.Strict.insert k v mempty) (1 :: Int,1 :: Int) func "Data.HashMap.Lazy.insert mempty" (\(k,v) -> Data.HashMap.Lazy.insert k v mempty) (1 :: Int,1 :: Int) fromlists :: Weigh () fromlists = do let !elems = force (zip (randoms (mkStdGen 0) :: [Int]) [1 :: Int .. 1000000]) func "Data.Map.Strict.fromList (1 million)" Data.Map.Strict.fromList elems func "Data.Map.Lazy.fromList (1 million)" Data.Map.Lazy.fromList elems func "Data.IntMap.Strict.fromList (1 million)" Data.IntMap.Strict.fromList elems func "Data.IntMap.Lazy.fromList (1 million)" Data.IntMap.Lazy.fromList elems func "Data.HashMap.Strict.fromList (1 million)" Data.HashMap.Strict.fromList elems func "Data.HashMap.Lazy.fromList (1 million)" Data.HashMap.Lazy.fromList elems weigh-0.0.7/src/test/Main.hs0000644000000000000000000000534413205527526014012 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveGeneric #-} -- | Example uses of Weigh which should work. module Main where import Control.DeepSeq import Weigh import GHC.Generics -- | Weigh integers. main :: IO () main = mainWith (do integers ioactions ints struct packing) -- | Weigh IO actions. ioactions :: Weigh () ioactions = do action "integers count IO CAF 0" (return (count 0)) io "integers count IO func 0" (return . count) 0 action "integers count IO CAF 1" (return (count 1)) io "integers count IO func 1" (return . count) 1 where count :: Integer -> () count 0 = () count a = count (a - 1) -- | Just counting integers. integers :: Weigh () integers = do func "integers count 0" count 0 func "integers count 1" count 1 func "integers count 2" count 2 func "integers count 3" count 3 func "integers count 10" count 10 func "integers count 100" count 100 where count :: Integer -> () count 0 = () count a = count (a - 1) -- | We count ints and ensure that the allocations are optimized away -- to only two 64-bit Ints (16 bytes). ints :: Weigh () ints = do validateFunc "ints count 1" count 1 (maxAllocs 0) validateFunc "ints count 10" count 10 (maxAllocs 0) validateFunc "ints count 1000000" count 1000000 (maxAllocs 0) where count :: Int -> () count 0 = () count a = count (a - 1) -- | Some simple data structure of two ints. data IntegerStruct = IntegerStruct !Integer !Integer deriving (Generic) instance NFData IntegerStruct -- | Weigh allocating a user-defined structure. struct :: Weigh () struct = do func "\\_ -> IntegerStruct 0 0" (\_ -> IntegerStruct 0 0) (5 :: Integer) func "\\x -> IntegerStruct x 0" (\x -> IntegerStruct x 0) 5 func "\\x -> IntegerStruct x x" (\x -> IntegerStruct x x) 5 func "\\x -> IntegerStruct (x+1) x" (\x -> IntegerStruct (x+1) x) 5 func "\\x -> IntegerStruct (x+1) (x+1)" (\x -> IntegerStruct (x+1) (x+1)) 5 func "\\x -> IntegerStruct (x+1) (x+2)" (\x -> IntegerStruct (x+1) (x+2)) 5 -- | A simple structure with an Int in it. data HasInt = HasInt !Int deriving (Generic) instance NFData HasInt -- | A simple structure with an Int in it. data HasPacked = HasPacked HasInt deriving (Generic) instance NFData HasPacked -- | A simple structure with an Int in it. data HasUnpacked = HasUnpacked {-# UNPACK #-} !HasInt deriving (Generic) instance NFData HasUnpacked -- | Weigh: packing vs no packing. packing :: Weigh () packing = do func "\\x -> HasInt x" (\x -> HasInt x) 5 func "\\x -> HasUnpacked (HasInt x)" (\x -> HasUnpacked (HasInt x)) 5 func "\\x -> HasPacked (HasInt x)" (\x -> HasPacked (HasInt x)) 5 weigh-0.0.7/LICENSE0000644000000000000000000000275412717346662012042 0ustar0000000000000000Copyright Chris Done (c) 2016 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Chris Done nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.weigh-0.0.7/Setup.hs0000644000000000000000000000005612717346662012462 0ustar0000000000000000import Distribution.Simple main = defaultMain weigh-0.0.7/weigh.cabal0000644000000000000000000000312513207221306013073 0ustar0000000000000000name: weigh version: 0.0.7 synopsis: Measure allocations of a Haskell functions/values description: Please see README.md homepage: https://github.com/fpco/weigh#readme license: BSD3 license-file: LICENSE author: Chris Done maintainer: chrisdone@fpcomplete.com copyright: FP Complete category: Web build-type: Simple extra-source-files: README.md CHANGELOG cabal-version: >=1.10 flag weigh-maps manual: True default: False description: Weigh maps. library hs-source-dirs: src ghc-options: -Wall -O2 exposed-modules: Weigh other-modules: Weigh.GHCStats build-depends: base >= 4.7 && < 5 , process , deepseq , mtl , split , template-haskell , temporary default-language: Haskell2010 test-suite weigh-test default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: src/test ghc-options: -O2 main-is: Main.hs build-depends: base , weigh , deepseq test-suite weigh-maps if !flag(weigh-maps) buildable: False default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: src/test ghc-options: -O2 main-is: Maps.hs build-depends: base , weigh , deepseq , containers , unordered-containers , bytestring-trie , random weigh-0.0.7/README.md0000644000000000000000000000306712722070162012273 0ustar0000000000000000# weigh [![Build Status](https://travis-ci.org/fpco/weigh.png)](https://travis-ci.org/fpco/weigh) Measures the memory usage of a Haskell value or function ## Example use ``` haskell import Weigh -- | Weigh integers. main :: IO () main = mainWith (do integers ints) -- | Just counting integers. integers :: Weigh () integers = do func "integers count 0" count 0 func "integers count 1" count 1 func "integers count 2" count 2 func "integers count 3" count 3 func "integers count 10" count 10 func "integers count 100" count 100 where count :: Integer -> () count 0 = () count a = count (a - 1) -- | We count ints and ensure that the allocations are optimized away -- to only two 64-bit Ints (16 bytes). ints :: Weigh () ints = do validateFunc "ints count 1" count 1 (maxAllocs 24) validateFunc "ints count 10" count 10 (maxAllocs 24) validateFunc "ints count 1000000" count 1000000 (maxAllocs 24) where count :: Int -> () count 0 = () count a = count (a - 1) ``` Output results: ``` Case Bytes GCs Check integers count 0 0 0 OK integers count 1 32 0 OK integers count 2 64 0 OK integers count 3 96 0 OK integers count 10 320 0 OK integers count 100 3,200 0 OK ints count 1 0 0 OK ints count 10 0 0 OK ints count 1000000 0 0 OK ``` You can try this out with `stack test` in the `weight` directory. To try out other examples, try: * `stack test :weigh-maps --flag weigh:weigh-maps` weigh-0.0.7/CHANGELOG0000644000000000000000000000054713205536445012236 0ustar00000000000000000.0.6: * Support GHC 8.2 * Use more reliable calculations 0.0.4: * Added more system-independent word size calculation 0.0.3: * Added more docs to haddocks * Export more internal combinators 0.0.2: * Remove magic numbers from weighing code, better accuracy * Add additional `io` combinator 0.0.1: * Support GHC 8. 0.0.0: * First release.