diff --git a/Data/Chatty/Atoms.hs b/Data/Chatty/Atoms.hs
--- a/Data/Chatty/Atoms.hs
+++ b/Data/Chatty/Atoms.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE ExistentialQuantification, ScopedTypeVariables #-}
 {-
   This module is part of Chatty.
   Copyleft (c) 2014 Marvin Cohrs
@@ -31,12 +32,34 @@
 import Data.Typeable
 import Data.Chatty.AVL
 import Data.Chatty.Counter
+import Unsafe.Coerce
 
 -- | Phantom type for atom IDs
-newtype Atom a = Atom Int deriving (Ord,Eq)
+data Atom a = Atom Int
+            | forall b. FunAtom Int (Atom b) (b -> a) (b -> a -> b)
+            | forall b c. FunAtom2 Int (Atom b) (Atom c) ((b,c) -> a) ((b,c) -> a -> (b,c))
 
+instance Eq (Atom a) where
+  (Atom n) == (Atom m) = n == m
+  (FunAtom i _ _ _) == (FunAtom j _ _ _) = i == j
+  (FunAtom2 i _ _ _ _) == (FunAtom2 j _ _ _ _) = i == j
+  _ == _ = False
+
+instance Ord (Atom a) where
+  (Atom n) `compare` (Atom m) = n `compare` m
+  (FunAtom i _ _ _) `compare` (Atom m) = i `compare` m
+  (FunAtom2 i _ _ _ _) `compare` (Atom m) = i `compare` m
+  (Atom n) `compare` (FunAtom j _ _ _) = n `compare` j
+  (FunAtom i _ _ _) `compare` (FunAtom j _ _ _) = i `compare` j
+  (FunAtom2 i _ _ _ _) `compare` (FunAtom j _ _ _) = i `compare` j
+  (Atom n) `compare` (FunAtom2 j _ _ _ _) = n `compare` j
+  (FunAtom i _ _ _) `compare` (FunAtom2 j _ _ _ _) = i `compare` j
+  (FunAtom2 i _ _ _ _) `compare` (FunAtom2 j _ _ _ _) = i `compare` j
+
+newtype Container = Container ()
+
 -- | The storage monad
-newtype AtomStoreT m a = AtomStore { runAtomStoreT :: AVL (Int,Dynamic) -> m (a,AVL (Int,Dynamic)) }
+newtype AtomStoreT m a = AtomStore { runAtomStoreT :: AVL (Int, Container) -> m (a,AVL (Int,Container)) }
 
 instance Functor m => Functor (AtomStoreT m) where
   fmap f a = AtomStore $ \s -> fmap (first f) $ runAtomStoreT a s
@@ -57,48 +80,90 @@
 -- | Typeclass for all atom-storing monads.
 class ChCounter m => ChAtoms m where
   -- | Reserve a new atom.
-  newAtom :: Typeable v => m (Atom v)
+  newAtom :: m (Atom v)
+  newAtom = liftM Atom countOn
+  -- | Construct a new functional atom.
+  funAtom :: Atom b -> (b -> a) -> (b -> a -> b) -> m (Atom a)
+  funAtom b r p = do
+    i <- countOn
+    return $ FunAtom i b r p
+  -- | Construct a new doubly-source functional atom
+  funAtom2 :: Atom b -> Atom c -> ((b,c) -> a) -> ((b,c) -> a -> (b,c)) -> m (Atom a)
+  funAtom2 b c r p = do
+    i <- countOn
+    return $ FunAtom2 i b c r p
   -- | Save a value for the given atom.
-  putAtom :: Typeable v => Atom v -> v -> m ()
+  putAtom :: Atom v -> v -> m ()
   -- | Get the value from a given atom.
-  getAtom :: Typeable v => Atom v -> m v
+  getAtom :: Atom v -> m v
   -- | Dispose the given atom.
   dispAtom :: Atom v -> m ()
   -- | Clone the given atom.
-  cloneAtom :: Typeable v => Atom v -> m (Atom v)
+  cloneAtom :: Atom v -> m (Atom v)
   cloneAtom a = do
     b <- newAtom
     v <- getAtom a
     putAtom b v
     return b
 
-instance (Functor m,ChCounter m) => ChAtoms (AtomStoreT m) where
-  newAtom = fmap Atom $ lift countOn
-  putAtom (Atom a) v = AtomStore $ \s -> return ((),avlInsert (a,toDyn v) s)
-  getAtom (Atom a) = AtomStore $ \s -> let Just v = avlLookup a s in return (fromDyn v undefined,s)
+instance ChCounter m => ChAtoms (AtomStoreT m) where
+  putAtom (Atom a) v = AtomStore $ \s -> return ((),avlInsert (a,unsafeCoerce v) s)
+  putAtom (FunAtom _ b _ p) v = do
+    bv <- getAtom b
+    putAtom b $ p bv v
+  putAtom (FunAtom2 _ b c _ p) v = do
+    bv <- getAtom b
+    cv <- getAtom c
+    let (bv',cv') = p (bv, cv) v
+    putAtom b bv'
+    putAtom c cv'
+  getAtom (Atom a) = AtomStore $ \s -> let Just v = avlLookup a s in return (unsafeCoerce v,s)
+  getAtom (FunAtom _ b g _) = liftM g $ getAtom b
+  getAtom (FunAtom2 _ b c g _) = do
+    bv <- getAtom b
+    cv <- getAtom c
+    return $ g (bv,cv)
   dispAtom (Atom a) = AtomStore $ \s -> return ((),avlRemove a s)
+  dispAtom (FunAtom _ _ _ _) = return ()
+  dispAtom (FunAtom2 _ _ _ _ _) = return ()
 
--- | Atomar operation (almost arrow)
-newtype (Typeable a,Typeable b) => Atomar m a b = Atomar { runAtomar :: Atom a -> m (Atom b) }
+-- Stop it. This just doesn't work safely.
+{-- | Arrow type operating on atoms. Works by overwriting the educt. You should really *not* use
+-- this for general a->b arrows, but only for a->a, unless you are sure that all Atom a references
+-- are gone! Otherwise segfaults are waiting for you!
+newtype Atomar m a b = Atomar { runAtomar :: Atom a -> m (Atom b) }
 
-{-instance MonadAtoms m => C.Category (Atomar m) where
+instance ChAtoms m => C.Category (Atomar m) where
   id = Atomar return
   a . b = Atomar (runAtomar a <=< runAtomar b)
 
-instance MonadAtoms m => Arrow (Atomar m) where
+instance ChAtoms m => Arrow (Atomar m) where
   arr = Atomar . mapAtom
   first f = Atomar $ \a -> do
-    b <- cloneAtom a
-    b' <- mapAtom fst b
-    c <- runAtomar f b'
-    v <- getAtom c
-    mapAtom (first $ const v) a
-    dispAtom c-}
+    let afst = funAtom a fst $ \(_,s) f -> (f,s)
+    mapAtom afst
+-}
 
 -- | Run a pure function on atoms.
-mapAtom :: (Typeable a, Typeable b, ChAtoms m) => (a -> b) -> Atom a -> m (Atom b)
-mapAtom f (Atom a) = do
-  v <- getAtom (Atom a)
-  putAtom (Atom a) $ f v
-  return (Atom a)
+mapAtom :: ChAtoms m => (a -> a) -> Atom a -> m ()
+mapAtom f a = do
+  v <- getAtom a
+  putAtom a $ f v
 
+-- | Arrow type operating on atoms. Works by cloning the educt, then overwriting the clone.
+-- You shouldn't use this inside long-term environments, as massive usage blows up the memory.
+newtype Redundant m a b = Redundant { runRedundant :: Atom a -> m (Atom b) }
+
+instance ChAtoms m => C.Category (Redundant m) where
+  id = Redundant return
+  a . b = Redundant (runRedundant a <=< runRedundant b)
+
+instance ChAtoms m => Arrow (Redundant m) where
+  arr f = Redundant $ \a -> do
+    v <- getAtom a
+    b <- newAtom
+    putAtom b $ f v
+    return b
+  first f = Redundant $ \a -> do
+    c <- runRedundant f =<< funAtom a fst (\(_, s) f -> (f, s))
+    funAtom2 a c (\((_,s),f) -> (f,s)) $ \((e,s),f) (f',s') -> ((e,s'),f')
diff --git a/chatty-utils.cabal b/chatty-utils.cabal
--- a/chatty-utils.cabal
+++ b/chatty-utils.cabal
@@ -10,7 +10,7 @@
 -- PVP summary:      +-+------- breaking API changes
 --                   | | +----- non-breaking API additions
 --                   | | | +--- code changes with no API change
-version:             0.6
+version:             0.7.1
 
 -- A short (one-line) description of the package.
 synopsis:            Some utilities every serious chatty-based application may need.