diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Anton Kholomiov 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:
+
+    * 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 Anton Kholomiov 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.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+import Distribution.Simple
+main = defaultMain
diff --git a/data-fix-cse.cabal b/data-fix-cse.cabal
new file mode 100644
--- /dev/null
+++ b/data-fix-cse.cabal
@@ -0,0 +1,37 @@
+Name:            data-fix-cse
+Version:         0.0.1
+Cabal-Version:   >= 1.6
+License:         BSD3
+License-file:    LICENSE
+Author:          Anton Kholomiov, Oleg Kiselyov
+Maintainer:      <anton.kholomiov@gmail.com>
+Category:        Data
+Synopsis:        Common subexpression elimination for the fixploint types.   
+Build-Type:      Simple
+Description:     
+  Common subexpression elimination for the fixploint types.   
+
+Stability:       Experimental
+
+Extra-Source-Files:
+    test/Exp.hs
+    test/Impl.hs
+    test/Expl.hs
+
+Homepage:        https://github.com/anton-k/data-fix-cse
+Bug-Reports:     https://github.com/anton-k/data-fix-cse/issues
+
+Source-repository head
+    Type: git
+    Location: https://github.com/anton-k/data-fix-cse
+
+Library
+  Build-depends: base >= 4, base < 5, data-fix, transformers, containers
+  Hs-source-dirs: src/
+
+  ghc-options: -Wall
+
+  Exposed-Modules: 
+      Data.Fix.Cse
+  Other-Modules:  
+      Data.Fix.BiMap
diff --git a/src/Data/Fix/BiMap.hs b/src/Data/Fix/BiMap.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Fix/BiMap.hs
@@ -0,0 +1,57 @@
+-- Establishing a bijection between the values of the type a and integers, with
+-- the operations to retrieve the value given its key,
+-- to find the key for the existing value, and to extend the 
+-- bijection with a new association.
+
+-- The type 'a' of values should at least permit equality comparison;
+-- In the present implementation, we require 'a' to be a member
+-- of Ord.
+
+-- There are many ways to implement bi-maps, for example, using hash tables,
+-- or maps.
+-- Our implementation uses Data.Map and Data.IntMap to record
+-- both parts of the association.
+
+module Data.Fix.BiMap (
+	      BiMap, empty, getDag,
+	      lookup_key, 
+	      lookup_val, 
+	      insert,
+	      size,
+	     )
+    where
+
+import qualified Data.Map    as M
+import qualified Data.IntMap as IM
+
+data BiMap a = BiMap (M.Map a Int) (IM.IntMap a)
+
+getDag :: BiMap a -> IM.IntMap a
+getDag (BiMap _ a) = a
+
+-- Find a key for a value
+lookup_key :: Ord a => a -> BiMap a -> Maybe Int
+lookup_key v (BiMap m _) = M.lookup v m
+
+-- Find a value for a key
+lookup_val :: Int -> BiMap a -> a
+lookup_val k (BiMap _ m) = m IM.! k
+
+-- Insert the value and return the corresponding key
+-- and the new map
+-- Alas, Map interface does not have an operation to insert and find the index 
+-- at the same time (although such an operation is easily possible)
+insert :: Ord a => a -> BiMap a -> (Int, BiMap a)
+insert v (BiMap m im) = (k, BiMap m' im')
+ where m'  = M.insert v k m
+       im' = IM.insert k v im
+       k   = IM.size im
+
+empty :: BiMap a
+empty = BiMap (M.empty) (IM.empty)
+
+instance Show a => Show (BiMap a) where
+    show (BiMap _ m) =  "BiMap" ++ show (IM.toList m)
+
+size :: BiMap a -> Int
+size (BiMap _ m) = IM.size m
diff --git a/src/Data/Fix/Cse.hs b/src/Data/Fix/Cse.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Fix/Cse.hs
@@ -0,0 +1,106 @@
+-- | Implements common subexpression elimination (CSE) with hashconsig algorithm as described in
+-- the paper 'Implementing Explicit and Finding Implicit Sharing in EDSLs' by Oleg Kiselyov. 
+-- You can define your datatype as a fixpoint type. Then the only thing you need to perform CSE
+-- is to define an instance of the class 'Traversable' for your datatype.
+module Data.Fix.Cse (
+    VarName, Dag, fromDag,
+    -- * Implicit sharing
+    cse,
+
+    -- * Explicit sharing
+    letCse, Let(..),
+    letCata, letCataM,
+    letWrapper
+) where
+
+import Control.Applicative hiding (empty)
+
+import Data.Fix
+import Control.Monad.Trans.State.Strict
+import qualified Data.IntMap as IM
+import Data.Traversable
+import Control.Monad.Trans.Class(lift)
+
+import Data.Fix.BiMap
+
+type VarName = Int
+
+-- | Directed acyclic graphs.
+type Dag f = IM.IntMap (f VarName)
+
+-- | If plain lists are enough for your case. 
+fromDag :: Dag f -> [(VarName, f VarName)]
+fromDag = IM.toList
+
+-- | Performs common subexpression elimination with implicit sharing.  
+cse :: (Eq (f Int), Ord (f Int), Traversable f) => Fix f -> Dag f
+cse x = getDag $ execState (cataM hashcons x) empty
+
+
+-- | With explicit sharing you provide user with the special function that
+-- encodes let-bindings for your EDSL ('LetBind'). You should not use 'LetLift' case.
+-- It's reserverd for the CSE algorithm. 
+data Let f a
+    = LetExp (f a)
+    | LetBind a (a -> a)
+    | LetLift VarName
+
+-- | Helper function to make explicit let-bindings.
+-- For exampe:
+--
+-- > newtype T = T { unT :: Fix (Let f) }
+-- > 
+-- > let_ :: T -> (T -> T) -> T
+-- > let_ = letWrapper T unT
+letWrapper :: (Fix (Let f) -> a) -> (a -> Fix (Let f)) -> a -> (a -> a) -> a
+letWrapper to from a e = to $ Fix $ LetBind (from a) (from . e . to)
+
+-- | Performs common subexpression elimination with explicit sharing.  
+-- To make sharing explicit you can use the datatype 'Let'.
+letCse :: (Eq (f Int), Ord (f Int), Traversable f)
+   => Fix (Let f) -> Dag f
+letCse x = getDag $ execState (letCataM hashcons x) empty
+
+-- | Monadic catamorphism for fixpoint types wrapped in the type 'Let'.
+letCataM :: (Applicative m, Monad m, Traversable f) =>
+   (f a -> m a) -> Fix (Let f) -> m a
+letCataM m expr = evalStateT (go expr) IM.empty
+   where go    = phi . unFix
+         phi x = case x of
+                   LetLift var -> do
+                                  s <- get
+                                  return ((IM.!) s var)
+                   LetExp a    -> (lift . m) =<< traverse go a
+                   LetBind a e -> do
+                                  v <- go a
+                                  s <- get
+                                  let var = IM.size s
+                                  let s' = IM.insert var v s
+                                  put s'
+                                  go . e . Fix . LetLift $ var
+
+-- | Catamorphism for fixpoint types wrapped in the type 'Let'.
+letCata :: (Functor f, Traversable f) =>
+   (f a -> a) -> Fix (Let f) -> a
+letCata f expr = evalState (go expr) IM.empty
+   where go    = phi . unFix
+         phi x = case x of
+                   LetLift var -> do
+                                  s <- get
+                                  return ((IM.!) s var)
+                   LetExp a    -> traverse go a >>= return . f
+                   LetBind a e -> do
+                                  v <- go a
+                                  s <- get
+                                  let var = IM.size s
+                                  let s' = IM.insert var v s
+                                  put s'
+                                  go . e . Fix . LetLift $ var
+
+hashcons :: (Ord a) => a -> State (BiMap a) Int
+hashcons e = do
+  m <- get
+  case lookup_key e m of
+    Nothing -> let (k,m') = insert e m
+               in  put m' >> return k
+    Just k  -> return k
diff --git a/test/Exp.hs b/test/Exp.hs
new file mode 100644
--- /dev/null
+++ b/test/Exp.hs
@@ -0,0 +1,47 @@
+module Exp where
+
+import Control.Applicative hiding (Const)
+import Data.Monoid
+import Data.Traversable
+import Data.Foldable
+
+data Exp a 
+    = Var String
+    | Const Int
+    | Add a a
+    deriving (Show, Eq, Ord)
+
+instance Functor Exp where
+    fmap f x = case x of
+        Var str     -> Var str
+        Const n     -> Const n
+        Add a b     -> Add (f a) (f b)
+
+instance Foldable Exp where
+    foldMap f x = case x of
+        Add a b     -> f a <> f b
+        _           -> mempty
+
+instance Traversable Exp where
+    traverse f x = case x of
+        Var str     -> pure $ Var str
+        Const n     -> pure $ Const n
+        Add a b     -> Add <$> f a <*> f b
+
+-----------------------------------------------
+-- interpreters
+
+-- ignore variables
+expAsInt :: Exp Int -> Int
+expAsInt x = case x of
+    Var str     -> error "boom" 
+    Const n     -> n
+    Add a b     -> a + b
+
+expAsDepth :: Exp Int -> Int
+expAsDepth x = case x of
+    Add a b     -> 1 + max a b
+    _           -> 1
+
+
+
diff --git a/test/Expl.hs b/test/Expl.hs
new file mode 100644
--- /dev/null
+++ b/test/Expl.hs
@@ -0,0 +1,64 @@
+-- | Explicit sharing
+module Main where
+
+import Data.Fix
+import Data.Fix.Cse
+
+import Exp
+
+newtype T = T { unT :: Fix (Let Exp) }
+   
+instance Num T where
+    (+) a b = T $ Fix $ LetExp $ Add (unT a) (unT b)
+    fromInteger = T . Fix . LetExp . Const . fromInteger
+
+    (*) = undefined
+    negate = undefined
+    abs = undefined
+    signum = undefined
+
+
+var :: String -> T
+var = T . Fix . LetExp . Var
+
+x = var "x"
+y = var "y"
+z = var "z"
+
+
+let_ :: T -> (T -> T) -> T
+let_ = letWrapper T unT
+
+mulT :: Int -> T -> T
+mulT 0 _ = 0
+mulT 1 x = x
+mulT n x
+    | n `mod` 2 == 0    = let_ (x + x) $ \y -> mulT (n `div` 2) y
+    | otherwise         = mulT (n - 1) x + x 
+
+-- interpreters
+
+asInt :: T -> Int
+asInt = letCata expAsInt . unT
+
+asDepth :: T -> Int
+asDepth = letCata expAsDepth . unT
+
+exec :: T -> Int
+exec = length . fromDag . letCse . unT
+
+-----------------------------------------------
+-- expression
+
+expr = mulT (2^30) 2
+
+main = do
+    print $ exec expr
+    putStrLn "" 
+    putStr "value: "
+    print $ asInt expr
+    putStrLn ""
+    putStr "depth: "
+    print $ asDepth expr
+
+
diff --git a/test/Impl.hs b/test/Impl.hs
new file mode 100644
--- /dev/null
+++ b/test/Impl.hs
@@ -0,0 +1,62 @@
+-- | Implicit sharing
+module Main where
+
+import Data.Monoid
+import Control.Applicative hiding (Const)
+
+import Data.Fix
+import Data.Fix.Cse
+
+import Exp
+
+-----------------------------------------------
+-- implicit sharing
+
+newtype T = T { unT :: Fix Exp }
+    deriving (Show, Eq)
+
+   
+instance Num T where
+    (+) a b = T $ Fix $ Add (unT a) (unT b)
+    fromInteger = T . Fix . Const . fromInteger
+
+    (*) = undefined
+    negate = undefined
+    abs = undefined
+    signum = undefined
+
+var :: String -> T
+var = T . Fix . Var
+
+x = var "x"
+y = var "y"
+z = var "z"
+
+
+mulT :: Int -> T -> T
+mulT 0 _ = 0
+mulT 1 x = x
+mulT n x
+    | n `mod` 2 == 0    = mulT (n `div` 2) (x + x)
+    | otherwise         = mulT (n - 1) x + x 
+
+-- interpreters
+
+asInt :: T -> Int
+asInt = cata expAsInt . unT
+
+asDepth :: T -> Int
+asDepth = cata expAsDepth . unT
+
+exec :: T -> Dag Exp
+exec = cse . unT
+
+-----------------------------------------------
+-- expression
+
+expr = mulT (2^20) 2
+
+main = do
+    putStrLn $ show $ length $ fromDag $ exec expr
+
+