diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,2 +1,25 @@
-union-find
-========
+# union-find
+
+A simple Haskell library that implements Tarjan's Union/Find
+algorithm.  Useful, for example, to implement unification in a type
+inference system.
+
+The Union/Find algorithm implements these operations in
+(effectively) constant-time:
+
+ 1. Check whether two elements are in the same equivalence class.
+
+ 2. Create a union of two equivalence classes.
+
+ 3. Look up the descriptor of the equivalence class.
+
+
+## Installation
+
+Using `cabal` (which comes with the Haskell Platform):
+
+    $ cabal install union-find
+
+or in the checked-out repository:
+
+    $ cabal install
diff --git a/src/Control/Monad/Trans/UnionFind.hs b/src/Control/Monad/Trans/UnionFind.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Monad/Trans/UnionFind.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Control.Monad.Trans.UnionFind
+  ( UnionFindT, runUnionFind
+  , Point, fresh, repr, descriptor, union, equivalent
+  ) where
+
+import Control.Applicative (Applicative)
+import Control.Monad.Trans.Class (MonadTrans(..))
+import Control.Monad.Trans.State (StateT(..), evalStateT)
+import Data.UnionFind.IntMap (Point)
+import qualified Control.Monad.Trans.State as State
+import qualified Data.UnionFind.IntMap as UF
+
+-- | A monad transformer that adds union find operations.
+--
+-- The @p@ parameter is the type of points.  Uses the
+-- "Data.UnionFind.IntMap" as the underlying union-find
+-- implementation.
+newtype UnionFindT p m a = UnionFindT {
+  unUnionFindT :: StateT (UF.PointSupply p) m a
+  } deriving (Functor, Applicative, Monad, MonadTrans)
+
+runUnionFind :: Monad m => UnionFindT p m a -> m a
+runUnionFind = (`evalStateT` UF.newPointSupply) . unUnionFindT
+
+swap :: (a, b) -> (b, a)
+swap (x, y) = (y, x)
+
+-- | Create a new point with the given descriptor.  The returned is
+-- only equivalent to itself.
+--
+-- Note that a 'Point' has its own identity.  That is, if two points
+-- are equivalent then their descriptors are equal, but not vice
+-- versa.
+--
+fresh :: Monad m => p -> UnionFindT p m (Point p)
+fresh x = UnionFindT . StateT $ return . swap . flip UF.fresh x
+
+-- | /O(1)/. @repr point@ returns the representative point of
+-- @point@'s equivalence class.
+repr :: Monad m => Point p -> UnionFindT p m (Point p)
+repr = UnionFindT . State.gets . flip UF.repr
+
+-- | Return the descriptor of the 
+descriptor :: Monad m => Point p -> UnionFindT p m p
+descriptor = UnionFindT . State.gets . flip UF.descriptor
+
+-- | Join the equivalence classes of the points.  The resulting
+-- equivalence class will get the descriptor of the second argument.
+union :: Monad m => Point p -> Point p -> UnionFindT p m ()
+union p1 p2 = UnionFindT . State.modify $ \x -> UF.union x p1 p2
+
+-- | Test if the two elements are in the same equivalence class.
+-- 
+-- @
+-- liftA2 (==) (repr x) (repr y)
+-- @
+equivalent :: Monad m => Point p -> Point p -> UnionFindT p m Bool
+equivalent p1 p2 = UnionFindT . State.gets $ \x -> UF.equivalent x p1 p2
diff --git a/src/Data/UnionFind/IntMap.hs b/src/Data/UnionFind/IntMap.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/UnionFind/IntMap.hs
@@ -0,0 +1,101 @@
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE BangPatterns #-}
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+--
+-- NOTE: Does not currently ensure that a 'Point' was indeed generated
+-- by the specified 'PointSupply'.
+--
+module Data.UnionFind.IntMap 
+    ( newPointSupply, fresh, repr, descriptor, union, equivalent,
+      PointSupply, Point ) where
+
+import qualified Data.IntMap as IM
+
+data PointSupply a = PointSupply !Int (IM.IntMap (Link a))
+  deriving Show
+
+data Link a 
+    = Info {-# UNPACK #-} !Int a
+      -- ^ This is the descriptive element of the equivalence class
+      -- and its rank.
+    | Link {-# UNPACK #-} !Int
+      -- ^ Pointer to some other element of the equivalence class.
+     deriving Show
+
+newtype Point a = Point Int
+
+newPointSupply :: PointSupply a
+newPointSupply = PointSupply 0 IM.empty
+
+fresh :: PointSupply a -> a -> (PointSupply a, Point a)
+fresh (PointSupply next eqs) a =
+  (PointSupply (next + 1) (IM.insert next (Info 0 a) eqs), Point next)
+
+-- freshList :: PointSupply a -> [a] -> (PointSupply a, [Point a])
+-- freshList 
+
+repr :: PointSupply a -> Point a -> Point a
+repr ps p = reprInfo ps p (\n _rank _a -> Point n)
+
+reprInfo :: PointSupply a -> Point a -> (Int -> Int -> a -> r) -> r
+reprInfo (PointSupply _next eqs) (Point n) k = go n
+  where
+    go !i =
+      case eqs IM.! i of
+        Link i' -> go i'
+        Info r a -> k i r a
+  
+union :: PointSupply a -> Point a -> Point a -> PointSupply a
+union ps@(PointSupply next eqs) p1 p2 =
+  reprInfo ps p1 $ \i1 r1 _a1 -> 
+  reprInfo ps p2 $ \i2 r2 a2 ->
+  if i1 == i2 then ps else
+    case r1 `compare` r2 of
+      LT ->
+        -- No rank or descriptor update necessary
+        let !eqs1 = IM.insert i1 (Link i2) eqs in
+        PointSupply next eqs1
+      EQ ->
+        let !eqs1 = IM.insert i1 (Link i2) eqs
+            !eqs2 = IM.insert i2 (Info (r2 + 1) a2) eqs1 in
+        PointSupply next eqs2
+      GT ->
+        let !eqs1 = IM.insert i1 (Info r2 a2) eqs
+            !eqs2 = IM.insert i2 (Link i1) eqs1 in
+        PointSupply next eqs2
+
+descriptor :: PointSupply a -> Point a -> a
+descriptor ps p = reprInfo ps p (\_ _ a -> a)
+
+equivalent :: PointSupply a -> Point a -> Point a -> Bool
+equivalent ps p1 p2 =
+  reprInfo ps p1 $ \i1 _ _ ->
+  reprInfo ps p2 $ \i2 _ _ ->
+  i1 == i2
+
+{-
+tst1 :: IO ()
+tst1 = do
+  let ps0 = newPointSupply
+      (ps1, p1) = fresh ps0 "hello"
+      (ps2, p2) = fresh ps1 "world"
+      (ps3, p3) = fresh ps2 "you"
+      (ps, p4) = fresh ps3 "there"
+  let ps' = union ps p1 p2
+  print (descr ps p1, descr ps p2, equivalent ps p1 p2)
+  print (descr ps' p1, descr ps' p2, equivalent ps' p1 p2)
+  let ps'' = union ps' p3 p1
+  print (descr ps'' p1, descr ps'' p3, equivalent ps'' p1 p3)
+  print ps''
+-}
+
+-- TODO: should fail
+{-
+tst2 :: IO ()
+tst2 = do
+  let as0 = newPointSupply
+      (as, a1) = fresh as0 "foo"
+      bs0 = newPointSupply
+      (bs, b1) = fresh bs0 "bar"
+  print $ union as a1 b1
+  -}    
diff --git a/src/Data/UnionFind/ST.hs b/src/Data/UnionFind/ST.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/UnionFind/ST.hs
@@ -0,0 +1,169 @@
+-- | An implementation of Tarjan's UNION-FIND algorithm.  (Robert E
+-- Tarjan. \"Efficiency of a Good But Not Linear Set Union Algorithm\", JACM
+-- 22(2), 1975)
+--
+-- The algorithm implements three operations efficiently (all amortised
+-- @O(1)@):
+--
+--  1. Check whether two elements are in the same equivalence class.
+--
+--  2. Create a union of two equivalence classes.
+--
+--  3. Look up the descriptor of the equivalence class.
+-- 
+-- The implementation is based on mutable references.  Each
+-- equivalence class has exactly one member that serves as its
+-- representative element.  Every element either is the representative
+-- element of its equivalence class or points to another element in
+-- the same equivalence class.  Equivalence testing thus consists of
+-- following the pointers to the representative elements and then
+-- comparing these for identity.
+--
+-- The algorithm performs lazy path compression.  That is, whenever we
+-- walk along a path greater than length 1 we automatically update the
+-- pointers along the path to directly point to the representative
+-- element.  Consequently future lookups will be have a path length of
+-- at most 1.
+--
+{-# OPTIONS_GHC -funbox-strict-fields #-}
+module Data.UnionFind.ST
+  ( Point, fresh, repr, union, union', equivalent, redundant,
+    descriptor, setDescriptor, modifyDescriptor )
+where
+
+import Control.Applicative
+import Control.Monad ( when )
+import Control.Monad.ST
+import Data.STRef
+
+-- | The abstract type of an element of the sets we work on.  It is
+-- parameterised over the type of the descriptor.
+newtype Point s a = Pt (STRef s (Link s a)) deriving Eq
+
+data Link s a
+    = Info {-# UNPACK #-} !(STRef s (Info a))
+      -- ^ This is the descriptive element of the equivalence class.
+    | Link {-# UNPACK #-} !(Point s a)
+      -- ^ Pointer to some other element of the equivalence class.
+     deriving Eq
+
+data Info a = MkInfo
+  { weight :: {-# UNPACK #-} !Int
+    -- ^ The size of the equivalence class, used by 'union'.
+  , descr  :: a
+  } deriving Eq
+
+-- | /O(1)/. Create a fresh point and return it.  A fresh point is in
+-- the equivalence class that contains only itself.
+fresh :: a -> ST s (Point s a)
+fresh desc = do
+  info <- newSTRef (MkInfo { weight = 1, descr = desc })
+  l <- newSTRef (Info info)
+  return (Pt l)
+
+-- | /O(1)/. @repr point@ returns the representative point of
+-- @point@'s equivalence class.
+--
+-- This method performs the path compresssion.
+repr :: Point s a -> ST s (Point s a)
+repr point@(Pt l) = do
+  link <- readSTRef l
+  case link of
+    Info _ -> return point
+    Link pt'@(Pt l') -> do
+      pt'' <- repr pt'
+      when (pt'' /= pt') $ do
+        -- At this point we know that @pt'@ is not the representative
+        -- element of @point@'s equivalent class.  Therefore @pt'@'s
+        -- link must be of the form @Link r@.  We write this same
+        -- value into @point@'s link reference and thereby perform
+        -- path compression.
+        link' <- readSTRef l'
+        writeSTRef l link'
+      return pt''
+
+-- | Return the reference to the point's equivalence class's
+-- descriptor.
+descrRef :: Point s a -> ST s (STRef s (Info a))
+descrRef point@(Pt link_ref) = do
+  link <- readSTRef link_ref
+  case link of
+    Info info -> return info
+    Link (Pt link'_ref) -> do
+      link' <- readSTRef link'_ref
+      case link' of
+        Info info -> return info
+        _ -> descrRef =<< repr point
+
+-- | /O(1)/. Return the descriptor associated with argument point's
+-- equivalence class.
+descriptor :: Point s a -> ST s a
+descriptor point = do
+  descr <$> (readSTRef =<< descrRef point)
+
+-- | /O(1)/. Replace the descriptor of the point's equivalence class
+-- with the second argument.
+setDescriptor :: Point s a -> a -> ST s ()
+setDescriptor point new_descr = do
+  r <- descrRef point
+  modifySTRef r $ \i -> i { descr = new_descr }
+
+modifyDescriptor :: Point s a -> (a -> a) -> ST s ()
+modifyDescriptor point f = do
+  r <- descrRef point
+  modifySTRef r $ \i -> i { descr = f (descr i) }
+
+-- | /O(1)/. Join the equivalence classes of the points (which must be
+-- distinct).  The resulting equivalence class will get the descriptor
+-- of the second argument.
+union :: Point s a -> Point s a -> ST s ()
+union p1 p2 = union' p1 p2 (\_ d2 -> return d2)
+
+-- | Like 'union', but sets the descriptor returned from the callback.
+-- 
+-- The intention is to keep the descriptor of the second argument to
+-- the callback, but the callback might adjust the information of the
+-- descriptor or perform side effects.
+union' :: Point s a -> Point s a -> (a -> a -> ST s a) -> ST s ()
+union' p1 p2 update = do
+  point1@(Pt link_ref1) <- repr p1
+  point2@(Pt link_ref2) <- repr p2
+  -- The precondition ensures that we don't create cyclic structures.
+  when (point1 /= point2) $ do
+    Info info_ref1 <- readSTRef link_ref1
+    Info info_ref2 <- readSTRef link_ref2
+    MkInfo w1 d1 <- readSTRef info_ref1 -- d1 is discarded
+    MkInfo w2 d2 <- readSTRef info_ref2
+    d2' <- update d1 d2
+    -- Make the smaller tree a a subtree of the bigger one.  The idea
+    -- is this: We increase the path length of one set by one.
+    -- Assuming all elements are accessed equally often, this means
+    -- the penalty is smaller if we do it for the smaller set of the
+    -- two.
+    if w1 >= w2 then do
+      writeSTRef link_ref2 (Link point1)
+      writeSTRef info_ref1 (MkInfo (w1 + w2) d2')
+     else do
+      writeSTRef link_ref1 (Link point2)
+      writeSTRef info_ref2 (MkInfo (w1 + w2) d2')
+
+-- | /O(1)/. Return @True@ if both points belong to the same
+-- | equivalence class.
+equivalent :: Point s a -> Point s a -> ST s Bool
+equivalent p1 p2 = (==) <$> repr p1 <*> repr p2
+
+-- | /O(1)/. Returns @True@ for all but one element of an equivalence
+-- class.  That is, if @ps = [p1, .., pn]@ are all in the same
+-- equivalence class, then the following assertion holds.
+-- 
+-- > do rs <- mapM redundant ps
+-- >    assert (length (filter (==False) rs) == 1)
+-- 
+-- It is unspecified for which element function returns @False@, so be
+-- really careful when using this.
+redundant :: Point s a -> ST s Bool
+redundant (Pt link_r) = do
+  link <- readSTRef link_r
+  case link of
+    Info _ -> return False
+    Link _ -> return True
diff --git a/union-find.cabal b/union-find.cabal
--- a/union-find.cabal
+++ b/union-find.cabal
@@ -1,5 +1,5 @@
 Name:            union-find
-Version:         0.1
+Version:         0.2
 License:         BSD3
 License-File:    LICENSE
 Author:          Thomas Schilling <nominolo@googlemail.com>
@@ -28,10 +28,13 @@
 
 Library
   Build-Depends:
-    base >= 4 && < 5
+    base >= 4 && < 5, containers >= 0.3, transformers >= 0.2
   GHC-Options:
     -Wall
   Exposed-Modules:
+    Control.Monad.Trans.UnionFind
     Data.UnionFind.IO
+    Data.UnionFind.ST
+    Data.UnionFind.IntMap
   Hs-Source-Dirs: src