diff --git a/creatur.cabal b/creatur.cabal
--- a/creatur.cabal
+++ b/creatur.cabal
@@ -1,5 +1,5 @@
 Name:              creatur
-Version:           3.0.0
+Version:           4.1.4
 Stability:         experimental
 Synopsis:          Framework for artificial life experiments.
 Description:       A software framework for automating experiments
@@ -38,6 +38,7 @@
                     ALife.Creatur.Daemon,
                     ALife.Creatur.Database,
                     ALife.Creatur.Database.FileSystem,
+                    ALife.Creatur.Genetics.Analysis,
                     ALife.Creatur.Genetics.Code,
                     ALife.Creatur.Genetics.BRGCBool,
                     ALife.Creatur.Genetics.BRGCWord8,
@@ -53,7 +54,7 @@
                     array ==0.4.*,
                     base ==4.*,
                     bytestring ==0.10.*,
-                    cereal ==0.3.*,
+                    cereal ==0.3.* || ==0.4.*,
                     directory ==1.2.*,
                     gray-extended ==1.*,
                     hdaemonize ==0.4.*,
@@ -79,7 +80,7 @@
                     array ==0.4.*,
                     base ==4.*,
                     binary == 0.5.*,
-                    cereal ==0.3.*,
+                    cereal ==0.3.* || ==0.4.*,
                     creatur,
                     hmatrix ==0.14.*,
                     HUnit ==1.2.*,
diff --git a/src/ALife/Creatur/Counter.hs b/src/ALife/Creatur/Counter.hs
--- a/src/ALife/Creatur/Counter.hs
+++ b/src/ALife/Creatur/Counter.hs
@@ -18,19 +18,21 @@
   ) where
 
 import ALife.Creatur.Clock (Clock, currentTime, incTime)
+import ALife.Creatur.Util (modifyLift, getLift)
 import Control.Monad (unless)
-import Control.Monad.IO.Class (liftIO)
-import Control.Monad.State (StateT, get, gets, modify, put)
+import Control.Monad.State (StateT, gets, modify)
 import System.Directory (doesFileExist)
+import System.IO (hGetContents, withFile, Handle, IOMode(ReadMode))
+import Text.Read (readEither)
 
 class Counter c where
   current :: StateT c IO Int
   increment :: StateT c IO ()
 
 data PersistentCounter = PersistentCounter {
-    initialised :: Bool,
-    time :: Int,
-    filename :: FilePath
+    cInitialised :: Bool,
+    cValue :: Int,
+    cFilename :: FilePath
   } deriving Show
 
 -- | Creates a counter that will store its value in the specified file.
@@ -38,35 +40,39 @@
 mkPersistentCounter = PersistentCounter False (-1)
 
 instance Counter PersistentCounter where
-  current = do
-    initIfNeeded
-    gets time
+  current = initIfNeeded >> gets cValue
   increment = do
-    t <- current
-    let t' = t + 1
-    f <- gets filename
-    modify (\c -> c { time=t' })
-    liftIO $ writeFile f $ show t'
+    modify (\c -> c { cValue=1 + cValue c })
+    getLift store
 
+store :: PersistentCounter -> IO ()
+store counter = writeFile (cFilename counter) $ show (cValue counter)
+  
 initIfNeeded :: StateT PersistentCounter IO ()
 initIfNeeded = do
-  isInitialised <- gets initialised
-  unless isInitialised $ do
-    counter <- get
-    counter' <- liftIO $ initialise counter
-    put counter'
+  isInitialised <- gets cInitialised
+  unless isInitialised $ modifyLift initialise
 
 initialise :: PersistentCounter -> IO PersistentCounter
 initialise counter = do
-  let f = filename counter
+  let f = cFilename counter
   fExists <- doesFileExist f
   if fExists
     then do
-      s <- readFile f
-      return $ counter { initialised=True, time=read s }
-    else return $ counter { initialised=True, time=0 }
+      x <- withFile f ReadMode readCounter -- closes file ASAP
+      case x of
+        Left msg -> error $ "Unable to read counter from " ++ f ++ ": " ++ msg
+        Right c  -> return $ counter { cInitialised=True, cValue=c }
+    else return $ counter { cInitialised=True, cValue=0 }
 
 instance Clock PersistentCounter where
   currentTime = current
   incTime = increment
 
+readCounter :: Handle -> IO (Either String Int)
+readCounter h = do
+  s <- hGetContents h
+  let x = readEither s :: Either String Int
+  case x of
+    Left msg -> return $ Left (msg ++ "\"" ++ s ++ "\"")
+    Right c  -> return $ Right c
diff --git a/src/ALife/Creatur/Daemon.hs b/src/ALife/Creatur/Daemon.hs
--- a/src/ALife/Creatur/Daemon.hs
+++ b/src/ALife/Creatur/Daemon.hs
@@ -21,8 +21,9 @@
 
 import Control.Concurrent (MVar, newMVar, readMVar, swapMVar, 
   threadDelay)
-import Control.Exception (SomeException, handle)
+import Control.Exception (SomeException, handle, catch)
 import Control.Monad.State (StateT, execStateT)
+import System.IO (hPutStr, stderr)
 import System.IO.Unsafe (unsafePerformIO)
 import System.Posix.Daemonize (CreateDaemon(..), serviced, simpleDaemon)
 import System.Posix.Signals (Handler(Catch), fullSignalSet, 
@@ -68,7 +69,7 @@
 daemonMain d s _ = do
   s' <- onStartup d s
   _ <- installHandler sigTERM (Catch handleTERM) (Just fullSignalSet)
-  _ <- daemonMainLoop d s'
+  _ <- wrap (daemonMainLoop d s')
   return ()
 
 daemonMainLoop :: Daemon s -> s -> IO ()
@@ -80,6 +81,13 @@
     else do
       s' <- handle (onException d s) $ execStateT (task d) s
       daemonMainLoop d s'
+
+wrap :: IO () -> IO ()
+wrap t = catch t
+  (\e -> do
+     let err = show (e :: SomeException)
+     hPutStr stderr ("Warning: " ++ err)
+     return ())
 
 handleTERM :: IO ()
 handleTERM = do
diff --git a/src/ALife/Creatur/Database.hs b/src/ALife/Creatur/Database.hs
--- a/src/ALife/Creatur/Database.hs
+++ b/src/ALife/Creatur/Database.hs
@@ -27,10 +27,16 @@
 -- | A database offering storage and retrieval for records.
 class Database d where
   type DBRecord d
-  -- | Get a list of all keys in the database.
+  -- | Get a list of all active keys in the database.
   keys :: StateT d IO [String]
-  -- | Read a record from the database.
+  -- | Get a list of all archived keys in the database. If the database
+  --   does not implement archiving, it may return an empty list.
+  archivedKeys :: StateT d IO [String]
+  -- | Read an active record from the database.
   lookup :: Serialize (DBRecord d) => 
+    String -> StateT d IO (Either String (DBRecord d))
+  -- | Read an archived record from the database.
+  lookupInArchive :: Serialize (DBRecord d) => 
     String -> StateT d IO (Either String (DBRecord d))
   -- | Write a record to the database. 
   --   If an agent with the same name already exists, it will be overwritten.
diff --git a/src/ALife/Creatur/Database/FileSystem.hs b/src/ALife/Creatur/Database/FileSystem.hs
--- a/src/ALife/Creatur/Database/FileSystem.hs
+++ b/src/ALife/Creatur/Database/FileSystem.hs
@@ -18,12 +18,14 @@
     mkFSDatabase
   ) where
 
+import Prelude hiding (readFile, writeFile)
+
 import ALife.Creatur.Database (Database(..), DBRecord, Record, 
   delete, key, keys, store)
-import Prelude hiding (readFile, writeFile)
+import ALife.Creatur.Util (modifyLift)
 import Control.Monad (unless, when)
 import Control.Monad.IO.Class (liftIO)
-import Control.Monad.State (StateT, get, gets, put)
+import Control.Monad.State (StateT, gets)
 import Data.ByteString as BS (readFile, writeFile)
 import qualified Data.Serialize as DS 
   (Serialize, decode, encode)
@@ -42,18 +44,14 @@
 instance Database (FSDatabase r) where
   type DBRecord (FSDatabase r) = r
 
-  keys = do
-    initIfNeeded
-    d <- gets mainDir
-    files <- liftIO $ getDirectoryContents d
-    return $ filter isRecordFileName files
+  keys = keysIn mainDir
 
-  lookup k = do
-    initIfNeeded
-    d <- gets mainDir
-    let f = d ++ '/':k
-    liftIO $ readRecord3 f
+  archivedKeys = keysIn archiveDir
 
+  lookup k = k `lookupIn` mainDir
+
+  lookupInArchive k = k `lookupIn` archiveDir
+
   store r = do
     initIfNeeded
     writeRecord2 mainDir r
@@ -63,6 +61,25 @@
     fileExists <- liftIO $ doesFileExist name
     when fileExists $ liftIO $ removeFile name
 
+keysIn
+  :: (FSDatabase r -> FilePath) -> StateT (FSDatabase r) IO [String]
+keysIn x = do
+    initIfNeeded
+    d <- gets x
+    files <- liftIO $ getDirectoryContents d
+    return $ filter isRecordFileName files
+
+lookupIn
+  :: DS.Serialize r =>
+     String
+     -> (FSDatabase r -> FilePath)
+     -> StateT (FSDatabase r) IO (Either String r)
+lookupIn k x = do
+    initIfNeeded
+    d <- gets x
+    let f = d ++ '/':k
+    liftIO $ readRecord3 f
+  
 -- | @'mkFSDatabase' d@ (re)creates the FSDatabase in the
 --   directory @d@.
 mkFSDatabase :: FilePath -> FSDatabase r
@@ -71,10 +88,7 @@
 initIfNeeded :: StateT (FSDatabase r) IO ()
 initIfNeeded = do
   isInitialised <- gets initialised
-  unless isInitialised $ do
-    u <- get
-    u' <- liftIO $ initialise u
-    put u'
+  unless isInitialised $ modifyLift initialise
 
 initialise :: FSDatabase r -> IO (FSDatabase r)
 initialise u = do
diff --git a/src/ALife/Creatur/Genetics/Analysis.hs b/src/ALife/Creatur/Genetics/Analysis.hs
new file mode 100644
--- /dev/null
+++ b/src/ALife/Creatur/Genetics/Analysis.hs
@@ -0,0 +1,76 @@
+------------------------------------------------------------------------
+-- |
+-- Module      :  ALife.Creatur.Genetics.Analysis
+-- Copyright   :  (c) Amy de Buitléir 2013
+-- License     :  BSD-style
+-- Maintainer  :  amy@nualeargais.ie
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- ???
+--
+------------------------------------------------------------------------
+{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances,
+    DefaultSignatures, DeriveGeneric, TypeOperators #-}
+module ALife.Creatur.Genetics.Analysis
+  (
+    Analysable(..)
+  ) where
+
+import Data.Word (Word8, Word16)
+import GHC.Generics
+
+class Analysable g where
+  -- | Writes a gene to a sequence.
+  analyse :: g -> String
+
+  default analyse :: (Generic g, GAnalysable (Rep g)) => g -> String
+  analyse = ganalyse . from
+
+class GAnalysable f where
+  ganalyse :: f a -> String
+
+-- | Unit: used for constructors without arguments
+instance GAnalysable U1 where
+  ganalyse U1 = "U1 "
+
+-- | Constants, additional parameters and recursion of kind *
+instance (GAnalysable a, GAnalysable b) => GAnalysable (a :*: b) where
+  ganalyse (a :*: b) = ganalyse a ++ ":*: " ++ ganalyse b
+
+-- | Meta-information (constructor names, etc.)
+instance (GAnalysable a, GAnalysable b) => GAnalysable (a :+: b) where
+  ganalyse (L1 x) = "L1 " ++ ganalyse x
+  ganalyse (R1 x) = "R1 " ++ ganalyse x
+
+-- | Sums: encode choice between constructors
+instance (GAnalysable a) => GAnalysable (M1 i c a) where
+  ganalyse (M1 x) = "M1 " ++ ganalyse x
+
+-- | Products: encode multiple arguments to constructors
+instance (Analysable a) => GAnalysable (K1 i a) where
+  ganalyse (K1 x) = "K1 " ++ analyse x
+
+--
+-- Instances
+--
+
+instance Analysable Bool where
+  analyse x = show x ++ " "
+
+instance Analysable Char where
+  analyse x = show x ++ " "
+
+instance Analysable Word8 where
+  analyse x = show x ++ " "
+
+instance Analysable Word16 where
+  analyse x = show x ++ " "
+
+instance (Analysable a) => Analysable [a]
+
+instance (Analysable a) => Analysable (Maybe a)
+
+instance (Analysable a, Analysable b) => Analysable (a, b)
+
+instance (Analysable a, Analysable b) => Analysable (Either a b)
diff --git a/src/ALife/Creatur/Genetics/BRGCBool.hs b/src/ALife/Creatur/Genetics/BRGCBool.hs
--- a/src/ALife/Creatur/Genetics/BRGCBool.hs
+++ b/src/ALife/Creatur/Genetics/BRGCBool.hs
@@ -45,6 +45,7 @@
 
 import Prelude hiding (read)
 import ALife.Creatur.Genetics.Diploid (Diploid, express)
+import ALife.Creatur.Util (fromEither)
 import Codec.Gray (integralToGray, grayToIntegral)
 import Control.Applicative ((<$>), (<*>))
 import Control.Monad (replicateM)
@@ -52,7 +53,6 @@
 import qualified Control.Monad.State.Lazy as S (put, get, gets)
 import Data.Char (ord, chr, intToDigit)
 import Data.Functor.Identity (Identity)
-import Data.Maybe (fromMaybe)
 import Data.Word (Word8, Word16)
 import GHC.Generics
 import Numeric (showIntAtBase)
@@ -69,7 +69,7 @@
 
 type Reader = StateT (Sequence, Int) Identity
 
-read :: Genetic g => Sequence -> Maybe g
+read :: Genetic g => Sequence -> Either [String] g
 read s = evalState get (s, 0)
 
 runReader :: Reader g -> Sequence -> g
@@ -99,24 +99,24 @@
   put = gput . from
 
   -- | Reads the next gene in a sequence.
-  get :: Reader (Maybe g)
+  get :: Reader (Either [String] g)
 
-  default get :: (Generic g, GGenetic (Rep g)) => Reader (Maybe g)
+  default get :: (Generic g, GGenetic (Rep g)) => Reader (Either [String] g)
   get = do
     a <- gget
     return . fmap to $ a
 
   getWithDefault :: g -> Reader g
-  getWithDefault d = fmap (fromMaybe d) get
+  getWithDefault d = fmap (fromEither d) get
 
 class GGenetic f where
   gput :: f a -> Writer ()
-  gget :: Reader (Maybe (f a))
+  gget :: Reader (Either [String] (f a))
 
 -- | Unit: used for constructors without arguments
 instance GGenetic U1 where
   gput U1 = return ()
-  gget = return (Just U1)
+  gget = return (Right U1)
 
 -- | Constants, additional parameters and recursion of kind *
 instance (GGenetic a, GGenetic b) => GGenetic (a :*: b) where
@@ -132,9 +132,10 @@
   gput (R1 x) = put False >> gput x
   gget = do
     a <- get
-    if a == Just True
-       then fmap (fmap L1) gget
-       else fmap (fmap R1) gget
+    case a of
+      Right True  -> fmap (fmap L1) gget
+      Right False -> fmap (fmap R1) gget
+      Left s -> return (Left s)
 
 -- | Sums: encode choice between constructors
 instance (GGenetic a) => GGenetic (M1 i c a) where
@@ -160,11 +161,11 @@
     (xs, i) <- S.get
     let xs' = drop i xs
     if null xs'
-       then return Nothing
+       then return $ Left ["End of sequence"]
        else do
          let x = head xs'
          S.put (xs, i+1)
-         return $ Just x
+         return $ Right x
 
 instance Genetic Char where
   put = putRawBoolArray . intToBools 8 . ord
@@ -184,6 +185,11 @@
 
 instance (Genetic a) => Genetic (Maybe a)
 
+instance (Genetic a, Genetic b) => Genetic (a, b)
+
+instance (Genetic a, Genetic b) => Genetic (Either a b)
+
+
 --
 -- Utilities
 --
@@ -192,7 +198,7 @@
 putRawBoolArray :: [Bool] -> Writer ()
 putRawBoolArray = mapM_ put
 
-getRawBoolArray :: Int -> Reader (Maybe [Bool])
+getRawBoolArray :: Int -> Reader (Either [String] [Bool])
 getRawBoolArray n = do
   xs <- replicateM n get
   return . sequence $ xs
@@ -216,7 +222,7 @@
 
 type DiploidReader = StateT ((Sequence, Int), (Sequence, Int)) Identity
 
-readAndExpress :: (Genetic g, Diploid g) => DiploidSequence -> Maybe g
+readAndExpress :: (Genetic g, Diploid g) => DiploidSequence -> Either [String] g
 readAndExpress (s1, s2) = evalState getAndExpress ((s1, 0), (s2, 0))
 
 runDiploidReader :: DiploidReader g -> DiploidSequence -> g
@@ -242,19 +248,23 @@
 --   information, and return the resulting gene (after taking
 --   into account any dominance relationship) and the remaining
 --   (unread) portion of the two nucleotide strands.
-getAndExpress :: (Genetic g, Diploid g) => DiploidReader (Maybe g)
+getAndExpress :: (Genetic g, Diploid g) => DiploidReader (Either [String] g)
 getAndExpress = do
   (sa, sb) <- S.get
   let (a, sa') = runState get sa
   let (b, sb') = runState get sb
   S.put (sa', sb')
-  return $ expressMaybe a b
+  return $ expressEither a b
 
 getAndExpressWithDefault :: (Genetic g, Diploid g) => g -> DiploidReader g
-getAndExpressWithDefault d = fmap (fromMaybe d) getAndExpress
+getAndExpressWithDefault d = fmap (fromEither d) getAndExpress
 
-expressMaybe :: Diploid g => Maybe g -> Maybe g -> Maybe g
-expressMaybe (Just a) (Just b) = Just (express a b)
-expressMaybe (Just a) Nothing  = Just a
-expressMaybe Nothing (Just b)  = Just b
-expressMaybe Nothing Nothing   = Nothing
+expressEither
+  :: Diploid g
+    => Either [String] g -> Either [String] g
+      -> Either [String] g
+expressEither (Right a) (Right b) = Right (express a b)
+expressEither (Right a) (Left _)  = Right a
+expressEither (Left _)  (Right b) = Right b
+expressEither (Left xs) (Left ys) =
+  Left $ (map ("sequence 1: " ++) xs) ++ (map ("sequence 2: " ++) ys)
diff --git a/src/ALife/Creatur/Genetics/BRGCWord8.hs b/src/ALife/Creatur/Genetics/BRGCWord8.hs
--- a/src/ALife/Creatur/Genetics/BRGCWord8.hs
+++ b/src/ALife/Creatur/Genetics/BRGCWord8.hs
@@ -42,18 +42,20 @@
     copy2,
     consumed2,
     putRawWord8,
-    getRawWord8
+    getRawWord8,
+    putRawWord8s,
+    getRawWord8s
   ) where
 
 import Prelude hiding (read)
 import ALife.Creatur.Genetics.Diploid (Diploid, express)
+import ALife.Creatur.Util (fromEither)
 import Codec.Gray (integralToGray, grayToIntegral)
 import Control.Applicative ((<$>), (<*>))
 import Control.Monad.State.Lazy (StateT, runState, execState, evalState)
 import qualified Control.Monad.State.Lazy as S (put, get, gets)
 import Data.Char (ord, chr)
 import Data.Functor.Identity (Identity)
-import Data.Maybe (fromMaybe)
 import Data.Word (Word8, Word16)
 import GHC.Generics
 
@@ -69,7 +71,7 @@
 
 type Reader = StateT (Sequence, Int) Identity
 
-read :: Genetic g => Sequence -> Maybe g
+read :: Genetic g => Sequence -> Either [String] g
 read s = evalState get (s, 0)
 
 runReader :: Reader g -> Sequence -> g
@@ -99,24 +101,24 @@
   put = gput . from
 
   -- | Reads the next gene in a sequence.
-  get :: Reader (Maybe g)
+  get :: Reader (Either [String] g)
 
-  default get :: (Generic g, GGenetic (Rep g)) => Reader (Maybe g)
+  default get :: (Generic g, GGenetic (Rep g)) => Reader (Either [String] g)
   get = do
     a <- gget
     return . fmap to $ a
 
   getWithDefault :: g -> Reader g
-  getWithDefault d = fmap (fromMaybe d) get
+  getWithDefault d = fmap (fromEither d) get
 
 class GGenetic f where
   gput :: f a -> Writer ()
-  gget :: Reader (Maybe (f a))
+  gget :: Reader (Either [String] (f a))
 
 -- | Unit: used for constructors without arguments
 instance GGenetic U1 where
   gput U1 = return ()
-  gget = return (Just U1)
+  gget = return (Right U1)
 
 -- | Constants, additional parameters and recursion of kind *
 instance (GGenetic a, GGenetic b) => GGenetic (a :*: b) where
@@ -133,11 +135,11 @@
   gget = do
     a <- getRawWord8
     case a of
-      (Just x) -> do
+      Right x -> do
         if even x -- Only care about the last bit
           then fmap (fmap L1) gget
           else fmap (fmap R1) gget
-      Nothing -> return Nothing
+      Left s -> return $ Left s
 
 -- | Sums: encode choice between constructors
 instance (GGenetic a) => GGenetic (M1 i c a) where
@@ -177,16 +179,21 @@
           high = fromIntegral (x `div` 0x100)
           low = fromIntegral (x `mod` 0x100)
   get = do
-    h <- getRawWord8 :: Reader (Maybe Word8)
-    let high = fmap (\x -> fromIntegral x * 0x100) h :: Maybe Word16
-    l <- getRawWord8 :: Reader (Maybe Word8)
-    let low = fmap fromIntegral l :: Maybe Word16
+    h <- getRawWord8 :: Reader (Either [String] Word8)
+    let high = fmap (\x -> fromIntegral x * 0x100) h :: Either [String] Word16
+    l <- getRawWord8 :: Reader (Either [String] Word8)
+    let low = fmap fromIntegral l :: Either [String] Word16
     return . fmap grayToIntegral $ (+) <$> high <*> low
 
 instance (Genetic a) => Genetic [a]
 
 instance (Genetic a) => Genetic (Maybe a)
 
+instance (Genetic a, Genetic b) => Genetic (a, b)
+
+instance (Genetic a, Genetic b) => Genetic (Either a b)
+
+
 --
 -- Utilities
 --
@@ -198,17 +205,36 @@
   S.put (xs ++ [x])
 
 -- | Read a Word8 value from the genome without decoding it
-getRawWord8 :: Reader (Maybe Word8)
+getRawWord8 :: Reader (Either [String] Word8)
 getRawWord8 = do
   (xs, i) <- S.get
   let xs' = drop i xs
   if null xs'
-     then return Nothing
+     then return $ Left ["End of sequence"]
      else do
        let x = head xs'
        S.put (xs, i+1)
-       return $ Just x
+       return $ Right x
 
+-- | Write a raw sequence of Word8 values to the genome
+putRawWord8s :: [Word8] -> Writer ()
+putRawWord8s = mapM_ putRawWord8
+
+-- | Read a raw sequence of Word8 values from the genome
+getRawWord8s :: Int -> Reader (Either [String] [Word8])
+getRawWord8s n =
+  if n == 0
+    then return $ Right []
+    else do
+      (xs, i) <- S.get
+      let xs' = drop i xs
+      if null xs' || length xs' < n
+        then return $ Left ["End of genes"]
+        else do
+          let ys = take n xs'
+          S.put (xs, i+n)
+          return $ Right ys
+
 --
 -- Diploid genes
 --
@@ -217,7 +243,7 @@
 
 type DiploidReader = StateT ((Sequence, Int), (Sequence, Int)) Identity
 
-readAndExpress :: (Genetic g, Diploid g) => DiploidSequence -> Maybe g
+readAndExpress :: (Genetic g, Diploid g) => DiploidSequence -> Either [String] g
 readAndExpress (s1, s2) = evalState getAndExpress ((s1, 0), (s2, 0))
 
 runDiploidReader :: DiploidReader g -> DiploidSequence -> g
@@ -243,19 +269,23 @@
 --   information, and return the resulting gene (after taking
 --   into account any dominance relationship) and the remaining
 --   (unread) portion of the two nucleotide strands.
-getAndExpress :: (Genetic g, Diploid g) => DiploidReader (Maybe g)
+getAndExpress :: (Genetic g, Diploid g) => DiploidReader (Either [String] g)
 getAndExpress = do
   (sa, sb) <- S.get
   let (a, sa') = runState get sa
   let (b, sb') = runState get sb
   S.put (sa', sb')
-  return $ expressMaybe a b
+  return $ expressEither a b
 
 getAndExpressWithDefault :: (Genetic g, Diploid g) => g -> DiploidReader g
-getAndExpressWithDefault d = fmap (fromMaybe d) getAndExpress
+getAndExpressWithDefault d = fmap (fromEither d) getAndExpress
 
-expressMaybe :: Diploid g => Maybe g -> Maybe g -> Maybe g
-expressMaybe (Just a) (Just b) = Just (express a b)
-expressMaybe (Just a) Nothing  = Just a
-expressMaybe Nothing (Just b)  = Just b
-expressMaybe Nothing Nothing   = Nothing
+expressEither
+  :: Diploid g
+    => Either [String] g -> Either [String] g
+      -> Either [String] g
+expressEither (Right a) (Right b) = Right (express a b)
+expressEither (Right a) (Left _)  = Right a
+expressEither (Left _)  (Right b) = Right b
+expressEither (Left xs) (Left ys) =
+  Left $ (map ("sequence 1: " ++) xs) ++ (map ("sequence 2: " ++) ys)
diff --git a/src/ALife/Creatur/Genetics/Diploid.hs b/src/ALife/Creatur/Genetics/Diploid.hs
--- a/src/ALife/Creatur/Genetics/Diploid.hs
+++ b/src/ALife/Creatur/Genetics/Diploid.hs
@@ -96,6 +96,8 @@
 
 instance (Diploid a) => Diploid (Maybe a)
 
+instance (Diploid a, Diploid b) => Diploid (a, b)
+
 -- TODO: Types I might want to define instances for
 -- Bool	 
 -- Char	 
diff --git a/src/ALife/Creatur/Genetics/Reproduction/Asexual.hs b/src/ALife/Creatur/Genetics/Reproduction/Asexual.hs
--- a/src/ALife/Creatur/Genetics/Reproduction/Asexual.hs
+++ b/src/ALife/Creatur/Genetics/Reproduction/Asexual.hs
@@ -46,7 +46,7 @@
 
   -- | Builds an agent based on the genome provided, if it is possible
   --   to do so.
-  build :: AgentId -> Base a -> Maybe a
+  build :: AgentId -> Base a -> Either [String] a
 
   -- | @'makeOffspring' (parent1, parent2) name@ uses the genetic
   --   information from @parent1@ and @parent2@ to produce a child with
@@ -55,7 +55,9 @@
   --   1. Calls @'recombine'@ to create a genome for the child.
   --
   --   2. Calls @'build'@ to construct a child with this genome.
-  makeOffspring :: RandomGen r => a -> a -> AgentId -> Rand r (Maybe a)
+  makeOffspring
+    :: RandomGen r
+      => a -> a -> AgentId -> Rand r (Either [String] a)
   makeOffspring a b name = do
     g <- recombine a b
     return $ build name g
diff --git a/src/ALife/Creatur/Genetics/Reproduction/Sexual.hs b/src/ALife/Creatur/Genetics/Reproduction/Sexual.hs
--- a/src/ALife/Creatur/Genetics/Reproduction/Sexual.hs
+++ b/src/ALife/Creatur/Genetics/Reproduction/Sexual.hs
@@ -43,7 +43,7 @@
 
   -- | Builds an agent based on the genome provided, if it is possible
   --   to do so.
-  build :: AgentId -> (Base a, Base a) -> Maybe a
+  build :: AgentId -> (Base a, Base a) -> Either [String] a
 
   -- | @'makeOffspring' (parent1, parent2) name@ uses the genetic
   --   information from @parent1@ and @parent2@ to produce a child with
@@ -55,7 +55,9 @@
   --   1. Pairs the two strands to create a genome for the child.
   --
   --   1. Calls @'build'@ construct a child with this genome.
-  makeOffspring :: RandomGen r => a -> a -> AgentId -> Rand r (Maybe a)
+  makeOffspring
+    :: RandomGen r
+      => a -> a -> AgentId -> Rand r (Either [String] a)
   makeOffspring a b name = do
     ga <- produceGamete a
     gb <- produceGamete b
diff --git a/src/ALife/Creatur/Logger.hs b/src/ALife/Creatur/Logger.hs
--- a/src/ALife/Creatur/Logger.hs
+++ b/src/ALife/Creatur/Logger.hs
@@ -20,15 +20,15 @@
     mkSimpleRotatingLogger
   ) where
 
+import ALife.Creatur.Util (modifyLift, getLift)
 import Control.Monad (when, unless)
-import Control.Monad.IO.Class (liftIO)
-import Control.Monad.State (StateT, get, gets, put)
+import Control.Monad.State (StateT, gets)
 import Data.Time (formatTime, getZonedTime)
 import System.Directory (createDirectoryIfMissing, doesFileExist, renameFile)
 import System.Locale (defaultTimeLocale)
 
 class Logger l where
-  -- | @'write' msg@ formats and writes a new log message.
+  -- | @'writeToLog' msg@ formats and writes a new log message.
   writeToLog :: String -> StateT l IO ()
 
 -- | A rotating logger.
@@ -55,18 +55,13 @@
 instance Logger SimpleRotatingLogger where
   writeToLog msg = do
     initIfNeeded
-    logger <- get
-    logger' <- liftIO $ bumpRecordCount logger
-    put logger'
-    liftIO $ write' logger' msg
+    modifyLift bumpRecordCount
+    getLift $ write' msg
 
 initIfNeeded :: StateT SimpleRotatingLogger IO ()
 initIfNeeded = do
   isInitialised <- gets initialised
-  unless isInitialised $ do
-    logger <- get
-    logger' <- liftIO $ initialise logger
-    put logger'
+  unless isInitialised $ modifyLift initialise
 
 initialise :: SimpleRotatingLogger -> IO SimpleRotatingLogger
 initialise logger = do
@@ -79,8 +74,8 @@
       return $ logger { initialised=True, recordCount=read s}
     else return $ logger { initialised=True, recordCount=0}
 
-write' :: SimpleRotatingLogger -> String -> IO ()
-write' logger msg = do
+write' :: String -> SimpleRotatingLogger -> IO ()
+write' msg logger = do
   timestamp <-
       fmap (formatTime defaultTimeLocale "%y%m%d%H%M%S%z") getZonedTime
   appendFile (logFilename logger)
@@ -89,12 +84,12 @@
 bumpRecordCount :: SimpleRotatingLogger -> IO SimpleRotatingLogger
 bumpRecordCount logger = do
   let n = 1 + recordCount logger
-  when (0 == n `mod` maxRecordsPerFile logger) $ liftIO $ rotateLog logger
+  when (0 == n `mod` maxRecordsPerFile logger) $ rotateLog logger
   writeFile (expFilename logger) (show n)
   return logger{ recordCount=n }
 
 rotateLog :: SimpleRotatingLogger -> IO ()
 rotateLog logger = do
   let f = logFilename logger
-  renameFile f $ f ++ '.' : (show . recordCount) logger
+  renameFile f $ f ++ '.' : (show . recordCount $ logger)
 
diff --git a/src/ALife/Creatur/Universe.hs b/src/ALife/Creatur/Universe.hs
--- a/src/ALife/Creatur/Universe.hs
+++ b/src/ALife/Creatur/Universe.hs
@@ -10,8 +10,8 @@
 -- Provides a habitat for artificial life.
 --
 ------------------------------------------------------------------------
-{-# LANGUAGE TemplateHaskell, TypeFamilies, FlexibleContexts #-}
-
+{-# LANGUAGE TemplateHaskell, TypeFamilies, FlexibleContexts,
+    UndecidableInstances #-}
 module ALife.Creatur.Universe
  (
     Universe(..),
@@ -23,10 +23,16 @@
     multiLookup,
     extra,
     agentIds,
+    getAgent,
+    archivedAgentIds,
+    getAgentFromArchive,
     addAgent,
-    storeOrArchive
+    storeOrArchive,
+    archiveAgent
  ) where
 
+import Prelude hiding (lookup)
+
 import ALife.Creatur (Agent, AgentId, agentId, isAlive)
 import ALife.Creatur.AgentNamer (AgentNamer, SimpleAgentNamer, 
   mkSimpleAgentNamer)
@@ -34,7 +40,7 @@
 import ALife.Creatur.Clock (Clock, currentTime, incTime)
 import ALife.Creatur.Counter (PersistentCounter, mkPersistentCounter)
 import ALife.Creatur.Database as D (Database, DBRecord, Record,
-  delete, keys, lookup, store)
+  delete, key, keys, archivedKeys, lookup, lookupInArchive, store)
 import ALife.Creatur.Database.FileSystem (FSDatabase, mkFSDatabase)
 import ALife.Creatur.Logger (Logger, SimpleRotatingLogger, 
   mkSimpleRotatingLogger, writeToLog)
@@ -64,12 +70,35 @@
   currentTime = zoom clock currentTime
   incTime = zoom clock incTime
 
+-- instance (Database d, DBRecord d ~ DBRecord (Universe c l d n x a)) =>
+--     Database (Universe c l d n x a) where
+--   type DBRecord (Universe c l d n x a) = a
+--   keys = zoom agentDB keys
+--   archivedKeys = zoom agentDB archivedKeys
+--   lookup = zoom agentDB . lookup
+--   lookupInArchive = zoom agentDB . lookupInArchive
+--   store = zoom agentDB . store
+--   delete = zoom agentDB . delete
+
 instance AgentNamer n => AgentNamer (Universe c l d n x a) where
   genName = zoom namer N.genName
 
 agentIds :: Database d => StateT (Universe c l d n x a) IO [String]
 agentIds = zoom agentDB keys
 
+archivedAgentIds :: Database d => StateT (Universe c l d n x a) IO [String]
+archivedAgentIds = zoom agentDB archivedKeys
+
+getAgent
+  :: (Serialize a, Database d, a ~ DBRecord d)
+    => String -> StateT (Universe c l d n x a) IO (Either String a)
+getAgent = zoom agentDB . lookup
+
+getAgentFromArchive
+  :: (Serialize a, Database d, a ~ DBRecord d)
+    => String -> StateT (Universe c l d n x a) IO (Either String a)
+getAgentFromArchive = zoom agentDB . lookupInArchive
+
 multiLookup :: (Serialize a, Database d, Record a, a ~ DBRecord d) => 
   [AgentId] -> StateT d IO (Either String [DBRecord d])
 multiLookup names = do
@@ -88,7 +117,11 @@
 
 addAgent :: (Serialize a, Database d, Record a, a ~ DBRecord d) =>
      DBRecord d -> StateT (Universe c l d n x a) IO ()
-addAgent a = zoom agentDB (store a)
+addAgent = zoom agentDB . store
+
+archiveAgent :: (Serialize a, Database d, Record a, a ~ DBRecord d) =>
+     DBRecord d -> StateT (Universe c l d n x a) IO ()
+archiveAgent = zoom agentDB . delete . D.key
 
 type SimpleUniverse a = 
   Universe PersistentCounter SimpleRotatingLogger (FSDatabase a)
diff --git a/src/ALife/Creatur/Util.hs b/src/ALife/Creatur/Util.hs
--- a/src/ALife/Creatur/Util.hs
+++ b/src/ALife/Creatur/Util.hs
@@ -30,13 +30,17 @@
     boolsToBits,
     showBin,
     -- * Monads
-    stateMap
+    stateMap,
+    fromEither,
+    catEithers,
+    modifyLift,
+    getLift
 --    constrain,
   ) where
 
 import Control.Monad (forM_, liftM)
 import Control.Monad.Random (Rand, RandomGen, getRandomRs)
-import Control.Monad.State (StateT(..))
+import Control.Monad.State (StateT(..), get, lift, put)
 import Data.Array.ST (runSTArray)
 import Data.Char (intToDigit)
 import Data.List.Split (chunksOf)
@@ -168,6 +172,46 @@
 
 stateMap :: Monad m => (s -> t) -> (t -> s) -> StateT s m a -> StateT t m a
 stateMap f g (StateT h) = StateT $ liftM (fmap f) . h . g
+
+-- | The 'fromEither' function takes a default value and an 'Either'
+--   value.  If the 'Either' is 'Left', it returns the default value;
+--   otherwise, it returns the value contained in the 'Right'.
+fromEither     :: a -> Either e a -> a
+fromEither d x = case x of {Left _ -> d; Right v  -> v}
+
+-- | The 'catEithers' function takes a list of 'Either's and returns
+--   a list of all the 'Right' values. 
+catEithers              :: [Either e a] -> [a]
+catEithers ls = [x | Right x <- ls]
+
+-- | Like modify, but the function that maps the old state to the
+--   new state operates in the inner monad.
+--   For example,
+--   
+--   > s <- get
+--   > s' = lift $ f s
+--   > put s'
+--   
+--   can be replaced with
+--   
+--   > modifyLift f
+modifyLift :: Monad m => (s -> m s) -> StateT s m ()
+modifyLift f = get >>= lift . f >>= put
+
+-- | Invoke a function in the inner monad, and pass the state as
+--   a parameter.
+--   Similar to modifyLift, but the function being invoked doesn't
+--   have a return value, so the state is not modified.
+--   For example,
+--   
+--   > s <- get
+--   > s' = lift $ f s
+--   
+--   can be replaced with
+--   
+--   > getLift f
+getLift :: Monad m => (s -> m ()) -> StateT s m ()
+getLift f = get >>= lift . f >> return ()
 
 rotate :: [a] -> [a]
 rotate [] = []
diff --git a/test/ALife/Creatur/Genetics/BRGCBoolQC.hs b/test/ALife/Creatur/Genetics/BRGCBoolQC.hs
--- a/test/ALife/Creatur/Genetics/BRGCBoolQC.hs
+++ b/test/ALife/Creatur/Genetics/BRGCBoolQC.hs
@@ -18,6 +18,7 @@
 
 import Prelude hiding (read)
 import ALife.Creatur.Genetics.BRGCBool
+import ALife.Creatur.Genetics.Analysis (Analysable)
 import Control.Applicative ((<$>), (<*>))
 import Data.Word (Word8, Word16)
 import GHC.Generics (Generic)
@@ -27,7 +28,7 @@
   oneof, property, sized, vectorOf)
 
 prop_round_trippable :: (Eq g, Genetic g) => g -> Property
-prop_round_trippable g = property $ g' == Just g
+prop_round_trippable g = property $ g' == Right g
   where x = write g
         g' = read x
 
@@ -35,6 +36,7 @@
   deriving (Show, Eq, Generic)
 
 instance Genetic TestStructure
+instance Analysable TestStructure
 
 sizedArbTestStructure :: Int -> Gen TestStructure
 sizedArbTestStructure 0 =
@@ -52,19 +54,19 @@
   
 instance Arbitrary TestStructure where
   arbitrary = sized sizedArbTestStructure
-              
+
 test :: Test
 test = testGroup "ALife.Creatur.Genetics.BRGCBoolQC"
   [
-    testProperty "prop_encoding_round_trippable - Bool"
+    testProperty "prop_round_trippable - Bool"
       (prop_round_trippable :: Bool -> Property),
-    testProperty "prop_encoding_round_trippable - Char"
+    testProperty "prop_round_trippable - Char"
       (prop_round_trippable :: Char -> Property),
-    testProperty "prop_encoding_round_trippable - Word8"
+    testProperty "prop_round_trippable - Word8"
       (prop_round_trippable :: Word8 -> Property),
-    testProperty "prop_encoding_round_trippable - Word16"
+    testProperty "prop_round_trippable - Word16"
       (prop_round_trippable :: Word16 -> Property),
-    testProperty "prop_encoding_round_trippable - TestStructure"
+    testProperty "prop_round_trippable - TestStructure"
       (prop_round_trippable :: TestStructure -> Property)
   ]
 
diff --git a/test/ALife/Creatur/Genetics/BRGCWord8QC.hs b/test/ALife/Creatur/Genetics/BRGCWord8QC.hs
--- a/test/ALife/Creatur/Genetics/BRGCWord8QC.hs
+++ b/test/ALife/Creatur/Genetics/BRGCWord8QC.hs
@@ -18,6 +18,7 @@
 
 import Prelude hiding (read)
 import ALife.Creatur.Genetics.BRGCWord8
+import ALife.Creatur.Genetics.Analysis (Analysable)
 import Control.Applicative ((<$>), (<*>))
 import Data.Word (Word8, Word16)
 import GHC.Generics (Generic)
@@ -27,7 +28,7 @@
   oneof, property, sized, vectorOf)
 
 prop_round_trippable :: (Eq g, Genetic g) => g -> Property
-prop_round_trippable g = property $ g' == Just g
+prop_round_trippable g = property $ g' == Right g
   where x = write g
         g' = read x
 
@@ -35,6 +36,7 @@
   deriving (Show, Eq, Generic)
 
 instance Genetic TestStructure
+instance Analysable TestStructure
 
 sizedArbTestStructure :: Int -> Gen TestStructure
 sizedArbTestStructure 0 =
@@ -52,19 +54,19 @@
   
 instance Arbitrary TestStructure where
   arbitrary = sized sizedArbTestStructure
-              
+
 test :: Test
 test = testGroup "ALife.Creatur.Genetics.BRGCWord8QC"
   [
-    testProperty "prop_encoding_round_trippable - Bool"
+    testProperty "prop_round_trippable - Bool"
       (prop_round_trippable :: Bool -> Property),
-    testProperty "prop_encoding_round_trippable - Char"
+    testProperty "prop_round_trippable - Char"
       (prop_round_trippable :: Char -> Property),
-    testProperty "prop_encoding_round_trippable - Word8"
+    testProperty "prop_round_trippable - Word8"
       (prop_round_trippable :: Word8 -> Property),
-    testProperty "prop_encoding_round_trippable - Word16"
+    testProperty "prop_round_trippable - Word16"
       (prop_round_trippable :: Word16 -> Property),
-    testProperty "prop_encoding_round_trippable - TestStructure"
+    testProperty "prop_round_trippable - TestStructure"
       (prop_round_trippable :: TestStructure -> Property)
   ]