diff --git a/Data/VCD.hs b/Data/VCD.hs
new file mode 100644
--- /dev/null
+++ b/Data/VCD.hs
@@ -0,0 +1,228 @@
+module Data.VCD
+  ( VCD
+  , Timescale (..)
+  , newVCD
+  , level
+  , signal
+  , step
+  ) where
+
+import Control.Monad
+import Data.Bits
+import Data.Char
+import Data.Int
+import Data.IORef
+import Data.Word
+import System.IO
+import Text.Printf
+
+data VCD = VCD
+  { handle :: Handle
+  , defs   :: IORef Bool
+  , dirty  :: IORef Bool
+  , time   :: IORef Int
+  , codes  :: IORef [String]
+  }
+
+data Timescale = US | MS | S
+
+instance Show Timescale where
+  show US = "us"
+  show MS = "ms"
+  show S  = "s"
+
+assertDefs :: VCD -> IO ()
+assertDefs vcd = do
+  defs <- readIORef $ defs vcd
+  when (not defs) $ error "VCD signal definition in recording phase"
+
+assertNotDefs :: VCD -> IO ()
+assertNotDefs vcd = do
+  defs <- readIORef $ defs vcd
+  when defs $ error "VCD signal recording in definition phase"
+
+nextCode :: VCD -> IO String
+nextCode vcd = do
+  assertDefs vcd
+  codes' <- readIORef $ codes vcd
+  writeIORef (codes vcd) (tail codes')
+  return $ head codes'
+
+class Signal a where signal :: VCD -> String -> IO (a -> IO ())
+
+instance Signal Bool where
+  signal vcd name = do
+    code <- nextCode vcd
+    hPutStrLn (handle vcd) $ printf "$var wire 1 %s %s $end" code name
+    last <- newIORef Nothing
+    return $ \ a -> do
+      assertNotDefs vcd
+      last' <- readIORef last
+      when (last' /= Just a) $ do
+        hPutStrLn (handle vcd) $ (if a then "1" else "0") ++ code
+        writeIORef last $ Just a
+        writeIORef (dirty vcd) True
+
+bitsSignal :: Bits a => VCD -> String -> IO (a -> IO ())
+bitsSignal vcd name = do
+  let dumb = 0
+  code <- nextCode vcd
+  hPutStrLn (handle vcd) $ printf "$var %s %d %s %s $end" (if isSigned dumb then "integer" else "wire") (bitSize dumb) code name
+  last <- newIORef Nothing
+  return $ \ a -> do
+    assertNotDefs vcd
+    when (a == dumb) (return ())
+    last' <- readIORef last
+    when (last' /= Just a) $ do
+      hPutStrLn (handle vcd) $ printf "b%s %s" (bitString a) code
+      writeIORef last $ Just a
+      writeIORef (dirty vcd) True
+
+bitString :: Bits a => a -> String
+bitString n = if null bits then "0" else bits
+  where
+  bits = dropWhile (== '0') $ [ if testBit n i then '1' else '0' | i <- [bitSize n - 1, bitSize n - 2 .. 0] ]
+
+instance Signal Int    where signal = bitsSignal
+instance Signal Int8   where signal = bitsSignal
+instance Signal Int16  where signal = bitsSignal
+instance Signal Int32  where signal = bitsSignal
+instance Signal Int64  where signal = bitsSignal
+instance Signal Word8  where signal = bitsSignal
+instance Signal Word16 where signal = bitsSignal
+instance Signal Word32 where signal = bitsSignal
+instance Signal Word64 where signal = bitsSignal
+   
+instance Signal Float where
+  signal vcd name = do
+    code <- nextCode vcd
+    hPutStrLn (handle vcd) $ printf "$var real 32 %s %s $end" code name
+    last <- newIORef Nothing
+    return $ \ a -> do
+      assertNotDefs vcd
+      last' <- readIORef last
+      when (last' /= Just a) $ do
+        hPutStrLn (handle vcd) $ printf "r%s %s" (show a) code
+        writeIORef last $ Just a
+        writeIORef (dirty vcd) True
+
+instance Signal Double where
+  signal vcd name = do
+    code <- nextCode vcd
+    hPutStrLn (handle vcd) $ printf "$var real 64 %s %s $end" code name
+    last <- newIORef Nothing
+    return $ \ a -> do
+      assertNotDefs vcd
+      last' <- readIORef last
+      when (last' /= Just a) $ do
+        hPutStrLn (handle vcd) $ printf "r%s %s" (show a) code
+        writeIORef last $ Just a
+        writeIORef (dirty vcd) True
+
+
+newVCD :: Handle -> Timescale -> IO VCD
+newVCD h ts = do
+  hPutStrLn h $ "$timescale"
+  hPutStrLn h $ "  1 " ++ show ts
+  hPutStrLn h $ "$end"
+  defs  <- newIORef True
+  dirty <- newIORef True
+  time  <- newIORef 0
+  codes <- newIORef identCodes
+  return VCD
+    { handle = h
+    , defs   = defs
+    , dirty  = dirty
+    , time   = time
+    , codes  = codes
+    }
+
+level :: VCD -> String -> IO a -> IO a
+level vcd name a = do
+  hPutStrLn (handle vcd) $ "$scope module " ++ name ++ " $end"
+  a <- a
+  hPutStrLn (handle vcd) $ "$upscope $end"
+  return a
+
+step :: VCD -> Int -> IO ()
+step vcd n = do
+  defs' <- readIORef $ defs vcd
+  when defs' $ do
+    hPutStrLn (handle vcd) "$enddefinitions $end"
+    writeIORef (defs vcd) False
+
+  dirty' <- readIORef $ dirty vcd
+  when dirty' $ do
+    t <- readIORef $ time vcd
+    hPutStrLn (handle vcd) $ "#" ++ show (t + n)
+    writeIORef (dirty vcd) False
+    writeIORef (time vcd) $ t + n
+    hFlush $ handle vcd
+
+identCodes :: [String]
+identCodes = map code [0..]
+  where
+  code :: Int -> String
+  code i | i < 94 =           [chr (33 + mod i 94)] 
+  code i = code (div i 94) ++ [chr (33 + mod i 94)] 
+
+
+{-
+writeVCD :: Handle -> Handle -> String -> String -> [String] -> [Type] -> (String -> [String]) -> (String -> Int) -> IO ()
+writeVCD i o date version names' types' f toTime = do
+  hPutStrLn o $ "$date"
+  hPutStrLn o date
+  hPutStrLn o $ "$end"
+  hPutStrLn o $ "$version"
+  hPutStrLn o version
+  hPutStrLn o $ "$end"
+  hPutStrLn o $ "$timescale"
+  hPutStrLn o $ "  1 ms"
+  hPutStrLn o $ "$end"
+  mapM_ writeVarDecl $ zip3 names types identCodes
+  hPutStrLn o $ "$enddefinitions $end"
+  hFlush o
+  writeSamples 0 (replicate (length names) "")
+  hClose o
+  where
+  names = tail names'
+  types = tail types'
+
+  writeVarDecl :: (String, Type, String) -> IO ()
+  writeVarDecl (name, t, code) = hPutStrLn o $ case t of
+    Bool   -> "$var wire 1 "     ++ code ++ " " ++ name ++ " $end"
+    Int8   -> "$var integer 8 "  ++ code ++ " " ++ name ++ " $end"
+    Int16  -> "$var integer 16 " ++ code ++ " " ++ name ++ " $end"
+    Int32  -> "$var integer 32 " ++ code ++ " " ++ name ++ " $end"
+    Int64  -> "$var integer 64 " ++ code ++ " " ++ name ++ " $end"
+    Word8  -> "$var wire 8 "     ++ code ++ " " ++ name ++ " $end"
+    Word16 -> "$var wire 16 "    ++ code ++ " " ++ name ++ " $end"
+    Word32 -> "$var wire 32 "    ++ code ++ " " ++ name ++ " $end"
+    Word64 -> "$var wire 64 "    ++ code ++ " " ++ name ++ " $end"
+    Float  -> "$var real 32 "    ++ code ++ " " ++ name ++ " $end"
+    Double -> "$var real 64 "    ++ code ++ " " ++ name ++ " $end"
+
+  writeSamples :: Int -> [String] -> IO ()
+  writeSamples lastTime lastValues = do
+    eof <- hIsEOF i
+    case eof of
+      True  -> hPutStrLn o $ "#" ++ show (lastTime + 1)
+      False -> do
+        l <- hGetRealLine i
+        let values' = f l
+            time = (toTime $ head values') :: Int
+            values = tail values'
+        when (values /= lastValues) $ hPutStrLn o $ "#" ++ show time
+        mapM_ writeValue $ zip4 types identCodes values lastValues  --XXX Would not work if first value is invalid.
+        hFlush o
+        writeSamples time values
+
+  writeValue :: (Type, String, String, String) -> IO ()
+  writeValue (t, c, v, vl) | v == vl                = return ()
+                           | otherwise              = case t of
+    Bool    -> hPutStrLn o $ v ++ c
+    Float   -> hPutStrLn o $ "r" ++ v ++ " " ++ c
+    Double  -> hPutStrLn o $ "r" ++ v ++ " " ++ c
+    _       -> hPutStrLn o $ "b" ++ bitString (read v) ++ " " ++ c
+  
+-}
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,27 @@
+Copyright (c) Tom Hawkins 2010
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+2. 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.
+3. Neither the name of the author nor the names of his contributors
+   may be used to endorse or promote products derived from this software
+   without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,8 @@
+#! /usr/bin/env runhaskell
+
+> module Main (main) where
+>
+> import Distribution.Simple (defaultMain)
+>
+> main :: IO ()
+> main = defaultMain
diff --git a/vcd.cabal b/vcd.cabal
new file mode 100644
--- /dev/null
+++ b/vcd.cabal
@@ -0,0 +1,39 @@
+name:    vcd
+version: 0.0.0
+
+category: Data
+
+synopsis: Tools for writing VCD files.
+
+description:
+  VCD (value change dump) is a format for capturing digital and analog waveforms.
+  GTKWave is a popular viewer of VCD files.
+
+author:     Tom Hawkins <tomahawkins@gmail.com>
+maintainer: Tom Hawkins <tomahawkins@gmail.com>
+
+license:      BSD3
+license-file: LICENSE
+
+homepage: http://tomahawkins.org
+
+build-type:    Simple
+cabal-version: >= 1.6
+
+library
+    build-depends:
+        base       >= 4.2     && < 5
+
+    exposed-modules:
+        Data.VCD
+
+--    extensions:
+
+    if impl(ghc > 6.8)
+          ghc-options: -fwarn-tabs
+    ghc-options:       -W
+
+source-repository head
+    type:     git
+    location: git://github.com/tomahawkins/vcd.git
+