diff --git a/Control/CP/ComposableTransformers.hs b/Control/CP/ComposableTransformers.hs
new file mode 100644
--- /dev/null
+++ b/Control/CP/ComposableTransformers.hs
@@ -0,0 +1,274 @@
+{- 
+ - 	Monadic Constraint Programming
+ - 	http://www.cs.kuleuven.be/~toms/Haskell/
+ - 	Tom Schrijvers
+ -}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ImpredicativeTypes #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+module Control.CP.ComposableTransformers where 
+
+import Control.CP.Transformers
+import Control.CP.SearchTree
+import Control.CP.Solver
+import Control.CP.Queue
+
+import System.Random (mkStdGen, randoms)
+
+--------------------------------------------------------------------------------
+-- EVALUATION
+--------------------------------------------------------------------------------
+
+solve :: (Queue q, Solver solver, CTransformer c, CForSolver c ~ solver,
+          Elem q ~ (Label solver,Tree solver (CForResult c),CTreeState c)) 
+      => q -> c -> Tree solver (CForResult c) -> (Int,[CForResult c])
+solve q c model = runSM $ eval model q (TStack c)
+
+--------------------------------------------------------------------------------
+-- COMPOSABLE TRANSFORMERS
+--------------------------------------------------------------------------------
+
+data TStack es ts (solver :: * -> *) a where
+   TStack :: (CTransformer c, CForSolver c ~ solver, CForResult c ~ a) 
+          => c -> TStack (CEvalState c) (CTreeState c) solver a
+
+instance Solver solver => Transformer (TStack es ts solver a) where
+  type EvalState (TStack es ts solver a) = es
+  type TreeState (TStack es ts solver a) = ts
+  type ForSolver (TStack es ts solver a) = solver
+  type ForResult (TStack es ts solver a) = a
+  initT  (TStack c) _  = return $ initCT c
+  leftT  (TStack c) _  = leftCT c
+  rightT (TStack c) _  = rightCT c
+  nextT = nextTStack 
+  returnT i wl t@(TStack c) es = returnCT c es (\es' -> continue i wl t es') (\es' -> endT i wl t es')
+
+nextTStack :: 
+     (Solver solver, Queue q, Elem q ~ (Label solver,Tree solver a,ts))
+     => Int -> Tree solver a -> q -> (TStack es ts solver a) -> es -> ts -> solver (Int,[a])
+nextTStack i tree q t es ts =
+    case t of
+      TStack c ->
+        nextCT tree c es ts (\tree' es' ts' -> eval' i tree' q t es' ts') 
+                            (\es'       -> continue i q t es')
+			    (\es' -> endT i q t es')
+
+--------------------------------------------------------------------------------
+type CSearchSig c a =
+     (Solver (CForSolver c), CTransformer c) 
+     => Tree (CForSolver c) a -> c -> CEvalState c -> CTreeState c -> (EVAL c a) -> (CONTINUE c a) -> (EXIT c a) -> (CForSolver c) (Int,[a])
+
+type CContinueSig c a =
+     (Solver (CForSolver c), CTransformer c) 
+     => c -> CEvalState c -> (CONTINUE c a) -> (EXIT c a) -> (CForSolver c) (Int,[a])
+
+type EVAL     c a = (Tree (CForSolver c) a -> CEvalState c -> CTreeState c-> (CForSolver c) (Int,[a]))
+type CONTINUE c a = (CEvalState c -> (CForSolver c) (Int,[a]))
+type EXIT     c a = (CEvalState c) -> (CForSolver c) (Int,[a]) 
+
+class Solver (CForSolver c) => CTransformer c where
+  type CEvalState c :: *
+  type CTreeState c :: *
+  type CForSolver c :: (* -> *)
+  type CForResult c :: *
+  initCT :: c -> (CEvalState c, CTreeState c)
+  leftCT, rightCT :: c -> CTreeState c -> CTreeState c
+  leftCT  _  = id
+  rightCT    = leftCT
+  nextCT :: CSearchSig c (CForResult c)
+  nextCT   = evalCT
+  returnCT :: CContinueSig c (CForResult c) 
+  returnCT = continueCT
+  completeCT :: c -> CEvalState c -> Bool
+  completeCT _ _ = True
+
+evalCT :: CSearchSig c a
+evalCT tree c es ts eval continue exit =
+  eval tree es ts
+
+continueCT :: CContinueSig c a
+continueCT c es continue exit =
+  continue es
+
+exitCT :: CContinueSig c a
+exitCT c es continue exit =
+  exit es
+
+newtype CNodeBoundedST (solver :: * -> *) a = CNBST Int
+
+instance Solver solver => CTransformer (CNodeBoundedST solver a) where
+  type CEvalState (CNodeBoundedST solver a) = Int
+  type CTreeState (CNodeBoundedST solver a) = ()
+  type CForSolver (CNodeBoundedST solver a) = solver
+  type CForResult (CNodeBoundedST solver a) = a
+  initCT (CNBST n)  = (n,())  
+  nextCT tree c es ts eval' continue exit
+    | es == 0    = exit es
+    | otherwise  = eval' tree (es - 1) ts
+
+newtype CDepthBoundedST (solver :: * -> *) a = CDBST Int
+
+instance Solver solver => CTransformer (CDepthBoundedST solver a) where
+  type CEvalState (CDepthBoundedST solver a)  = Bool
+  type CTreeState (CDepthBoundedST solver a)  = Int
+  type CForSolver (CDepthBoundedST solver a)  = solver
+  type CForResult (CDepthBoundedST solver a)  = a
+  initCT (CDBST n)  = (True,n)
+  leftCT _ ts      = ts - 1
+  nextCT tree c es ts eval' continue exit
+    | ts == 0    = continue False
+    | otherwise  = eval' tree es ts
+  completeCT _ es  = es
+
+newtype CLimitedDiscrepancyST (solver :: * -> *) a = CLDST Int
+
+instance Solver solver => CTransformer (CLimitedDiscrepancyST solver a) where
+  type CEvalState (CLimitedDiscrepancyST solver a) = ()
+  type CTreeState (CLimitedDiscrepancyST solver a) = Int
+  type CForSolver (CLimitedDiscrepancyST solver a) = solver
+  type CForResult (CLimitedDiscrepancyST solver a) = a
+  initCT (CLDST n)  = ((),n)
+  rightCT _ n  = n - 1
+  nextCT tree c es ts eval' continue exit
+    | ts == 0    = continue es
+    | otherwise  = eval' tree es ts
+
+newtype CRandomST (solver :: * -> *) a  = CRST Int
+
+instance Solver solver => CTransformer (CRandomST solver a) where
+  type CEvalState (CRandomST solver a) = [Bool]
+  type CTreeState (CRandomST solver a) = ()
+  type CForSolver (CRandomST solver a) = solver
+  type CForResult (CRandomST solver a) = a
+  initCT (CRST n)  = (randoms $ mkStdGen n,())
+  nextCT tree@(Try l r) c (switch:es)
+    | switch        = evalCT (Try r l) c es
+    | otherwise     = evalCT tree      c es
+  nextCT tree@(Add d (Try l r)) c (switch:es)
+    | switch        = evalCT (Add d (Try r l)) c es
+    | otherwise     = evalCT tree      c es
+  nextCT tree c es  = evalCT tree      c es
+
+data CIdentityCST (solver :: * -> *) a  = CIST
+
+instance Solver solver => CTransformer (CIdentityCST solver a) where
+  type CEvalState (CIdentityCST solver a)  = ()
+  type CTreeState (CIdentityCST solver a)  = ()
+  type CForSolver (CIdentityCST solver a)  = solver
+  type CForResult (CIdentityCST solver a)  = a
+  initCT _  = ((),())
+
+data CFirstSolutionST (solver :: * -> *) a  = CFSST
+
+instance Solver solver => CTransformer (CFirstSolutionST solver a) where
+  type CEvalState (CFirstSolutionST solver a)  = Bool
+  type CTreeState (CFirstSolutionST solver a)  = ()
+  type CForSolver (CFirstSolutionST solver a)  = solver
+  type CForResult (CFirstSolutionST solver a)  = a
+  initCT _  = (True,())
+  returnCT _ es continue exit =
+    exit False
+  completeCT _ es = es 
+
+
+--------------------------------------------------------------------------------
+data Composition es ts solver a where
+  (:-) :: (CTransformer c1, CTransformer c2,
+           CForSolver c1 ~ solver, CForSolver c2 ~ solver,
+           CForResult c1 ~ a,      CForResult c2 ~ a
+          ) 
+       => c1 -> c2 -> Composition (CEvalState c1,CEvalState c2) (CTreeState c1,CTreeState c2) solver a
+
+instance Solver solver => CTransformer (Composition es ts solver a) where
+  type CEvalState (Composition es ts solver a) = es
+  type CTreeState (Composition es ts solver a) = ts
+  type CForSolver (Composition es ts solver a) = solver
+  type CForResult (Composition es ts solver a) = a
+  initCT (c1 :- c2)       = let (es1,ts1) = initCT c1 
+                                (es2,ts2) = initCT c2 
+                            in ((es1,es2),(ts1,ts2))
+  leftCT (c1 :- c2) (ts1,ts2)   = (leftCT c1 ts1,leftCT c2 ts2)
+  rightCT (c1 :- c2) (ts1,ts2)  = (rightCT c1 ts1,rightCT c2 ts2)
+  nextCT tree (c1 :- c2) (es1,es2) (ts1,ts2) eval' continue exit  =
+    nextCT tree c1 es1 ts1 
+           (\tree' es1' ts1' -> nextCT tree' c2 es2 ts2 
+                                   (\tree'' es2' ts2' -> eval' tree'' (es1',es2') (ts1',ts2'))
+                                   (\es2' -> continue (es1',es2'))
+				   (\es2' -> exit (es1',es2')) ) 
+           (\es1' -> continue (es1',es2))
+           (\es1' -> exit (es1',es2))
+  returnCT (c1 :- c2) (es1,es2) continue exit =
+    returnCT c1 es1 (\es1' -> returnCT c2 es2 (\es2' -> continue (es1',es2')) (\es2' -> exit (es1',es2'))) 
+		    (\es1' -> exit (es1',es2))
+  completeCT (c1 :- c2) (es1,es2)  = completeCT c1 es1 && completeCT c2 es2
+
+--------------------------------------------------------------------------------
+-- BRANCH & BOUND
+--------------------------------------------------------------------------------
+
+newtype CBranchBoundST (solver :: * -> *) a = CBBST (NewBound solver) 
+data    BBEvalState solver  = BBP Int (Bound solver)
+
+type Bound    solver  = forall a. Tree solver a -> Tree solver a
+type NewBound solver  = solver (Bound solver)
+
+instance Solver solver => CTransformer (CBranchBoundST solver a) where
+  type CEvalState (CBranchBoundST solver a) = BBEvalState solver
+  type CTreeState (CBranchBoundST solver a) = Int
+  type CForSolver (CBranchBoundST solver a) = solver
+  type CForResult (CBranchBoundST solver a) = a
+  initCT _  = (BBP 0 id,0)
+  nextCT tree c es@(BBP nv bound) v eval continue exit
+    | nv > v        = eval (bound tree) es nv
+    | otherwise     = eval tree         es v
+  returnCT (CBBST newBound) (BBP v bound) continue exit =
+    do bound' <- newBound
+       continue $ BBP (v + 1) bound' 
+
+--------------------------------------------------------------------------------
+-- RESTARTING
+--------------------------------------------------------------------------------
+
+data SealedCST es ts solver a where
+  Seal :: CTransformer c => c -> SealedCST (CEvalState c) (CTreeState c) (CForSolver c) (CForResult c)
+
+instance Solver solver => CTransformer (SealedCST es ts solver a) where
+  type CEvalState (SealedCST es ts solver a) = es
+  type CTreeState (SealedCST es ts solver a) = ts
+  type CForSolver (SealedCST es ts solver a) = solver
+  type CForResult (SealedCST es ts solver a) = a
+  leftCT (Seal c) 	= leftCT c
+  rightCT (Seal c)	= rightCT c
+  initCT (Seal c)       = initCT c
+  nextCT tree (Seal c)  = nextCT tree c
+  returnCT (Seal c)     = returnCT c
+  completeCT (Seal c)   = completeCT c
+
+data RestartST es ts (solver :: * -> *) a = RestartST [SealedCST es ts solver a] (Tree solver a -> solver (Tree solver a))
+
+instance Solver solver => Transformer (RestartST es ts solver a) where
+  type EvalState (RestartST es ts solver a) = (SealedCST es ts solver a,[SealedCST es ts solver a],es,Label solver,Tree solver a)
+  type TreeState (RestartST es ts solver a) = ts
+  type ForSolver (RestartST es ts solver a) = solver
+  type ForResult (RestartST es ts solver a) = a
+  initT  (RestartST (c:cs) _) tree  = 
+ 	let (es,ts) = initCT c
+        in do l <-  markSM
+	      return ((c,cs,es,l,tree),ts)
+  leftT  _ (c,_,_,_,_)      = leftCT c
+  rightT _ (c,_,_,_,_)      = rightCT c
+  nextT i tree q t es@(c,cs,es_c,l,tree0) ts = 
+        nextCT tree c es_c ts (\tree' es_c' ts' -> eval' i tree' q t (c,cs,es_c',l,tree0) ts') 
+                              (\es_c'       -> continue i q t (c,cs,es_c',l,tree0))
+			      (\es_c' -> endT i q t (c,cs,es_c',l,tree0))
+  returnT i wl t es@(c,cs,es_c,l,tree0)  = returnCT c es_c (\es_c' -> continue i wl t (c,cs,es_c',l,tree0)) (\es_c' -> endT i wl t (c,cs,es_c',l,tree0))
+  endT i wl t es@(_,[],_,_,_)      = return (i,[])
+  endT i wl t@(RestartST _ f) es@(c0,(c:cs),es_c0,l,tree0)   
+    | completeCT c0 es_c0  = return (i,[])
+    | otherwise            = let (es,ts) = initCT c
+                             in  do tree' <- f tree0
+                                    continue i (pushQ (l,tree',ts) $ emptyQ wl) t (c,cs,es,l,tree0)
+ 
diff --git a/Control/CP/FD/Domain.hs b/Control/CP/FD/Domain.hs
new file mode 100644
--- /dev/null
+++ b/Control/CP/FD/Domain.hs
@@ -0,0 +1,167 @@
+{- 
+ - Origin:
+ - 	Constraint Programming in Haskell 
+ - 	http://overtond.blogspot.com/2008/07/pre.html
+ - 	author: David Overton, Melbourne Australia
+ -
+ - Modifications:
+ - 	Monadic Constraint Programming
+ - 	http://www.cs.kuleuven.be/~toms/Haskell/
+ - 	Tom Schrijvers
+ -} 
+
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverlappingInstances #-}
+{-# LANGUAGE IncoherentInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+module Control.CP.FD.Domain (
+    Domain,
+    ToDomain,
+    toDomain,
+    member,
+    isSubsetOf,
+    elems,
+    intersection,
+    difference,
+    union,
+    empty,
+    null,
+    singleton,
+    isSingleton,
+    filterLessThan,
+    filterGreaterThan,
+    findMax,
+    findMin,
+    size,
+    shiftDomain
+) where
+
+import qualified Data.IntSet as IntSet
+import Data.IntSet (IntSet)
+import Prelude hiding (null)
+
+data Domain
+    = Set IntSet
+    | Range Int Int
+    deriving Show
+
+size :: Domain -> Int
+size (Range l u) = u - l + 1
+size (Set set)   = IntSet.size set
+
+-- Domain constructors
+class ToDomain a where
+    toDomain :: a -> Domain
+
+instance ToDomain Domain where
+    toDomain = id
+
+instance ToDomain IntSet where
+    toDomain = Set
+
+instance Integral a => ToDomain [a] where
+    toDomain = toDomain . IntSet.fromList . map fromIntegral
+
+instance (Integral a, Integral b) => ToDomain (a, b) where
+    toDomain (a, b) = Range (fromIntegral a) (fromIntegral b)
+
+instance ToDomain () where
+    toDomain () = Range minBound maxBound
+
+instance Integral a => ToDomain a where
+    toDomain a = toDomain (a, a)
+
+-- Operations on Domains
+instance Eq Domain where
+    (Range xl xh) == (Range yl yh) = xl == yl && xh == yh
+    xs == ys = elems xs == elems ys
+
+member :: Int -> Domain -> Bool
+member n (Set xs) = n `IntSet.member` xs
+member n (Range xl xh) = n >= xl && n <= xh
+
+isSubsetOf :: Domain -> Domain -> Bool
+isSubsetOf (Set xs) (Set ys) = xs `IntSet.isSubsetOf` ys
+isSubsetOf (Range xl xh) (Range yl yh) = xl >= yl && xh <= yh
+isSubsetOf (Set xs) yd@(Range yl yh) =
+    isSubsetOf (Range xl xh) yd where
+        xl = IntSet.findMin xs
+        xh = IntSet.findMax xs
+isSubsetOf (Range xl xh) (Set ys) =
+    all (`IntSet.member` ys) [xl..xh]
+
+elems :: Domain -> [Int]
+elems (Set xs) = IntSet.elems xs
+elems (Range xl xh) = [xl..xh]
+
+intersection :: Domain -> Domain -> Domain
+intersection (Set xs) (Set ys) = Set (xs `IntSet.intersection` ys)
+intersection (Range xl xh) (Range yl yh) = Range (max xl yl) (min xh yh)
+intersection (Set xs) (Range yl yh) =
+    Set $ IntSet.filter (\x -> x >= yl && x <= yh) xs
+intersection x y = intersection y x
+
+union :: Domain -> Domain -> Domain
+union (Set xs) (Set ys) = Set (xs `IntSet.union` ys)
+union (Range xl xh) (Range yl yh) 
+      | xh + 1 >= yl || yh+1 >= xl = Range (min xl yl) (max xh yh)
+      | otherwise = union (Set $ IntSet.fromList [xl..xh]) 
+                          (Set $ IntSet.fromList [yl..yh]) 
+union x@(Set xs) y@(Range yl yh) =
+      if null x then y 
+      else
+      let xmin = IntSet.findMin xs
+          xmax = IntSet.findMax xs
+      in 
+      if (xmin + 1 >= yl && xmax - 1 <= yh) 
+         then Range (min xmin yl) (max xmax yh)
+         else union (Set xs) (Set $ IntSet.fromList [yl..yh])
+union x y = union y x
+
+difference :: Domain -> Domain -> Domain
+difference (Set xs) (Set ys) = Set (xs `IntSet.difference` ys)
+difference xd@(Range xl xh) (Range yl yh)
+    | yl > xh || yh < xl = xd
+    | otherwise = Set $ IntSet.fromList [x | x <- [xl..xh], x < yl || x > yh]
+difference (Set xs) (Range yl yh) =
+    Set $ IntSet.filter (\x -> x < yl || x > yh) xs
+difference (Range xl xh) (Set ys)
+    | IntSet.findMin ys > xh || IntSet.findMax ys < xl = Range xl xh
+    | otherwise = Set $
+        IntSet.fromList [x | x <- [xl..xh], not (x `IntSet.member` ys)]
+
+null :: Domain -> Bool
+null (Set xs) = IntSet.null xs
+null (Range xl xh) = xl > xh
+
+singleton :: Int -> Domain
+singleton x = Set (IntSet.singleton x)
+
+isSingleton :: Domain -> Bool
+isSingleton (Set xs) = case IntSet.elems xs of
+    [x] -> True
+    _   -> False
+isSingleton (Range xl xh) = xl == xh
+
+filterLessThan :: Int -> Domain -> Domain
+filterLessThan n (Set xs) = Set $ IntSet.filter (< n) xs
+filterLessThan n (Range xl xh) = Range xl (min (n-1) xh)
+
+filterGreaterThan :: Int -> Domain -> Domain
+filterGreaterThan n (Set xs) = Set $ IntSet.filter (> n) xs
+filterGreaterThan n (Range xl xh) = Range (max (n+1) xl) xh
+
+findMax :: Domain -> Int
+findMax (Set xs) = IntSet.findMax xs
+findMax (Range xl xh) = xh
+
+findMin :: Domain -> Int
+findMin (Set xs) = IntSet.findMin xs
+findMin (Range xl xh) = xl
+
+empty :: Domain
+empty = Range 1 0
+
+shiftDomain :: Domain -> Int -> Domain
+shiftDomain (Range l u) d = Range (l + d) (u + d)
+shiftDomain (Set xs) d = Set $ IntSet.fromList $ map (+d) (IntSet.elems xs)
diff --git a/Control/CP/FD/FD.hs b/Control/CP/FD/FD.hs
new file mode 100644
--- /dev/null
+++ b/Control/CP/FD/FD.hs
@@ -0,0 +1,412 @@
+{- 
+ - Origin:
+ - 	Constraint Programming in Haskell 
+ - 	http://overtond.blogspot.com/2008/07/pre.html
+ - 	author: David Overton, Melbourne Australia
+ -
+ - Modifications:
+ - 	Monadic Constraint Programming
+ - 	http://www.cs.kuleuven.be/~toms/Haskell/
+ - 	Tom Schrijvers
+ -} 
+
+{-# OPTIONS_GHC -fglasgow-exts #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE OverlappingInstances #-}
+
+module Control.CP.FD.FD where 
+
+import Prelude hiding (lookup)
+import Maybe (fromJust,isJust)
+import Control.Monad.State.Lazy
+import Control.Monad.Trans
+import qualified Data.Map as Map
+import Data.Map ((!), Map)
+import Control.Monad (liftM,(<=<))
+
+import Control.CP.FD.Domain as Domain
+
+import Control.CP.Solver
+
+-- import Debug.Trace
+trace = flip const
+--------------------------------------------------------------------------------
+-- Solver instance -------------------------------------------------------------
+--------------------------------------------------------------------------------
+
+instance Solver FD where
+  type Constraint FD  = FD_Constraint
+  type Term       FD  = FD_Term
+  type Label      FD  = FDState
+
+  newvarSM 	= newVar () >>= return . FD_Var 
+  addSM    	= addFD
+  runSM p   	= runFD p
+
+  markSM	= get
+  gotoSM	= put 
+
+data FD_Term where
+  FD_Var :: FDVar -> FD_Term
+  deriving Show
+
+un_fd (FD_Var v) = v
+
+data FD_Constraint where
+  FD_Diff :: FD_Term -> FD_Term -> FD_Constraint
+  FD_Same :: FD_Term -> FD_Term -> FD_Constraint
+  FD_Less :: FD_Term  -> FD_Term -> FD_Constraint
+  FD_LT   :: FD_Term -> Int -> FD_Constraint
+  FD_GT   :: FD_Term -> Int -> FD_Constraint
+  FD_HasValue :: FD_Term -> Int -> FD_Constraint
+  FD_Eq   :: (ToExpr a, ToExpr b) => a -> b -> FD_Constraint
+  FD_NEq   :: (ToExpr a, ToExpr b) => a -> b -> FD_Constraint
+  FD_AllDiff :: [FD_Term] -> FD_Constraint
+  FD_Dom     :: FD_Term -> (Int,Int) -> FD_Constraint
+
+addFD (FD_Diff (FD_Var v1) (FD_Var v2)) = different v1 v2
+addFD (FD_Same (FD_Var v1) (FD_Var v2)) = same      v1 v2
+addFD (FD_Less (FD_Var v1) (FD_Var v2)) = v1 .<. v2     
+addFD (FD_HasValue (FD_Var v1) i)       = hasValue v1  i
+addFD (FD_Eq e1 e2)                     = e1 .==. e2
+addFD (FD_NEq e1 e2)                    = e1 ./=. e2 
+-- addFD (FD_AllDiff vs)                   = allDifferent (map un_fd vs)
+addFD (FD_Dom v (l,u))                  = v `in_range` (l-1,u+1)
+addFD (FD_LT (FD_Var v) i)              = do iv <- exprVar $ toExpr i
+                                             v .<. iv
+addFD (FD_GT (FD_Var v) i)              = do iv <- exprVar $ toExpr i
+                                             iv .<. v
+
+
+(#<) :: (To_FD_Term a, To_FD_Term b) => a -> b -> FD Bool
+x #< y =
+  do xt <- to_fd_term x
+     yt <- to_fd_term y
+     addFD (FD_Less xt yt)
+
+in_range :: FD_Term -> (Int,Int) -> FD Bool
+in_range x (l,u) =
+  do l #< x
+     x #< u
+
+all_different = addFD . FD_AllDiff
+
+instance ToExpr FD_Term where
+  toExpr (FD_Var v) = toExpr v
+
+fd_domain :: FD_Term -> FD [Int]
+fd_domain (FD_Var v)  = do d <- lookup v
+                           return $ elems d
+
+fd_objective :: FD FD_Term
+fd_objective =
+  do s <- get
+     return $ FD_Var $ objective s
+
+class To_FD_Term a where
+  to_fd_term :: a -> FD FD_Term
+
+instance To_FD_Term FD_Term where
+  to_fd_term = return . id
+
+instance To_FD_Term Int where
+  to_fd_term i =  newVar i >>= return . FD_Var
+
+instance To_FD_Term Expr  where
+  to_fd_term e = unExpr e >>= return . FD_Var
+
+--------------------------------------------------------------------------------
+
+-- The FD monad
+newtype FD a = FD { unFD :: StateT FDState Maybe a }
+    deriving (Monad, MonadState FDState, MonadPlus)
+
+-- FD variables
+newtype FDVar = FDVar { unFDVar :: Int } deriving (Ord, Eq, Show)
+
+type VarSupply = FDVar
+
+data VarInfo = VarInfo
+     { delayedConstraints :: FD Bool, domain :: Domain }
+
+instance Show VarInfo where
+  show x = show $ domain x
+
+type VarMap = Map FDVar VarInfo
+
+data FDState = FDState
+     { varSupply :: VarSupply, varMap :: VarMap, objective :: FDVar }
+     deriving Show
+
+instance Eq FDState where
+  s1 == s2 = f s1 == f s2
+           where f s = head $ elems $ domain $ varMap s ! (objective s) 
+
+instance Ord FDState where
+  compare s1 s2  = compare (f s1) (f s2)
+           where f s = head $ elems $  domain $ varMap s ! (objective s) 
+
+  -- TOM: inconsistency is not observable within the FD monad
+consistentFD :: FD Bool
+consistentFD = return True
+
+-- Run the FD monad and produce a lazy list of possible solutions.
+runFD :: FD a -> a
+runFD fd = fromJust $ evalStateT (unFD fd') initState
+           where fd' = fd -- fd' = newVar () >> fd
+
+initState :: FDState
+initState = FDState { varSupply = FDVar 0, varMap = Map.empty, objective = FDVar 0 }
+
+-- Get a new FDVar
+newVar :: ToDomain a => a -> FD FDVar
+newVar d = do
+    s <- get
+    let v = varSupply s
+    put $ s { varSupply = FDVar (unFDVar v + 1) }
+    modify $ \s ->
+        let vm = varMap s
+            vi = VarInfo {
+                delayedConstraints = return True,
+                domain = toDomain d}
+        in
+        s { varMap = Map.insert v vi vm }
+    return v
+
+newVars :: ToDomain a => Int -> a -> FD [FDVar]
+newVars n d = replicateM n (newVar d)
+
+-- Lookup the current domain of a variable.
+lookup :: FDVar -> FD Domain
+lookup x = do
+    s <- get
+    return . domain $ varMap s ! x
+
+-- Update the domain of a variable and fire all delayed constraints
+-- associated with that variable.
+update :: FDVar -> Domain -> FD Bool
+update x i = do
+    trace (show x ++ " <- " ++ show i)  (return ())
+    s <- get
+    let vm = varMap s
+    let vi = vm ! x
+    trace ("where old domain = " ++ show (domain vi)) (return ())
+    put $ s { varMap = Map.insert x (vi { domain = i}) vm }
+    delayedConstraints vi
+
+-- Add a new constraint for a variable to the constraint store.
+addConstraint :: FDVar -> FD Bool -> FD ()
+addConstraint x constraint = do
+    s <- get
+    let vm = varMap s
+    let vi = vm ! x
+    let cs = delayedConstraints vi
+    put $ s { varMap =
+        Map.insert x (vi { delayedConstraints = do b <- cs 
+                                                   if b then constraint
+                                                        else return False}) vm }
+ 
+-- Useful helper function for adding binary constraints between FDVars.
+type BinaryConstraint = FDVar -> FDVar -> FD Bool
+addBinaryConstraint :: BinaryConstraint -> BinaryConstraint 
+addBinaryConstraint f x y = do
+    let constraint  = f x y
+    b <- constraint 
+    when b $ (do addConstraint x constraint
+                 addConstraint y constraint)
+    return b
+
+-- Constrain a variable to a particular value.
+hasValue :: FDVar -> Int -> FD Bool
+var `hasValue` val = do
+    vals <- lookup var
+    if val `member` vals
+       then do let i = singleton val
+               if (i /= vals) 
+                  then update var i
+                  else return True
+       else return False
+
+-- Constrain two variables to have the same value.
+same :: FDVar -> FDVar -> FD Bool
+same = addBinaryConstraint $ \x y -> do
+    xv <- lookup x
+    yv <- lookup y
+    let i = xv `intersection` yv
+    if not $ Domain.null i
+       then whenwhen (i /= xv)  (i /= yv) (update x i) (update y i)
+       else return False
+
+whenwhen c1 c2 a1 a2  =
+  if c1
+     then do b1 <- a1
+             if b1 
+                then if c2
+                        then a2
+                        else return True
+                else return False 
+     else if c2
+             then a2
+             else return True
+
+-- Constrain two variables to have different values.
+different :: FDVar  -> FDVar  -> FD Bool
+different = addBinaryConstraint $ \x y -> do
+    xv <- lookup x
+    yv <- lookup y
+    if not (isSingleton xv) || not (isSingleton yv) || xv /= yv
+       then whenwhen (isSingleton xv && xv `isSubsetOf` yv)
+                     (isSingleton yv && yv `isSubsetOf` xv)
+                     (update y (yv `difference` xv))
+                     (update x (xv `difference` yv))
+       else return False
+
+-- Constrain a list of variables to all have different values.
+allDifferent :: [FDVar ] -> FD  ()
+allDifferent (x:xs) = do
+    mapM_ (different x) xs
+    allDifferent xs
+allDifferent _ = return ()
+
+-- Constrain one variable to have a value less than the value of another
+-- variable.
+infix 4 .<.
+(.<.) :: FDVar -> FDVar -> FD Bool
+(.<.) = addBinaryConstraint $ \x y -> do
+    xv <- lookup x
+    yv <- lookup y
+    let xv' = filterLessThan (findMax yv) xv
+    let yv' = filterGreaterThan (findMin xv) yv
+    if  not $ Domain.null xv'
+        then if not $ Domain.null yv'
+                then whenwhen (xv /= xv') (yv /= yv') (update x xv') (update y yv')
+	        else return False
+        else return False
+
+{-
+-- Get all solutions for a constraint without actually updating the
+-- constraint store.
+solutions :: FD s a -> FD s [a]
+solutions constraint = do
+    s <- get
+    return $ evalStateT (unFD constraint) s
+
+-- Label variables using a depth-first left-to-right search.
+labelling :: [FDVar s] -> FD s [Int]
+labelling = mapM label where
+    label var = do
+        vals <- lookup var
+        val <- FD . lift $ elems vals
+        var `hasValue` val
+        return val
+-}
+
+dump :: [FDVar] -> FD [Domain]
+dump = mapM lookup
+
+newtype Expr = Expr { unExpr :: FD (FDVar) }
+
+class ToExpr a where
+    toExpr :: a -> Expr
+
+instance ToExpr FDVar where
+    toExpr = Expr . return
+
+instance ToExpr Expr where
+    toExpr = id
+
+instance Integral i => ToExpr i where
+    toExpr n = Expr $ newVar n
+
+exprVar :: ToExpr a => a -> FD FDVar
+exprVar = unExpr . toExpr
+
+-- Add constraint (z = x `op` y) for new var z
+addArithmeticConstraint :: (ToExpr a, ToExpr b) =>
+    (Domain -> Domain -> Domain) ->
+    (Domain -> Domain -> Domain) ->
+    (Domain -> Domain -> Domain) ->
+    a -> b -> Expr
+addArithmeticConstraint getZDomain getXDomain getYDomain xexpr yexpr = Expr $ do
+    x <- exprVar xexpr
+    y <- exprVar yexpr
+    xv <- lookup x
+    yv <- lookup y
+    z <- newVar (getZDomain xv yv)
+    let constraint z x y getDomain = do
+        xv <- lookup x
+        yv <- lookup y
+        zv <- lookup z
+        let znew = zv `intersection` (getDomain xv yv)
+	trace (show z ++ " before: "  ++ show zv ++ show "; after: " ++ show znew) (return ())
+        if not $ Domain.null znew
+           then if (znew /= zv) 
+                   then update z znew
+                   else return True
+           else return False
+    let zConstraint = constraint z x y getZDomain
+        xConstraint = constraint x z y getXDomain
+        yConstraint = constraint y z x getYDomain
+    addConstraint z xConstraint
+    addConstraint z yConstraint
+    addConstraint x zConstraint
+    addConstraint x yConstraint
+    addConstraint y zConstraint
+    addConstraint y xConstraint
+    return z
+
+infixl 6 .+.
+(.+.) :: (ToExpr a, ToExpr b) => a -> b -> Expr
+(.+.) = addArithmeticConstraint getDomainPlus getDomainMinus getDomainMinus
+
+infixl 6 .-.
+(.-.) :: (ToExpr a, ToExpr b) => a -> b -> Expr
+(.-.) = addArithmeticConstraint getDomainMinus getDomainPlus
+    (flip getDomainMinus)
+
+infixl 7 .*.
+(.*.) :: (ToExpr a, ToExpr b) => a -> b -> Expr
+(.*.) = addArithmeticConstraint getDomainMult getDomainDiv getDomainDiv
+
+getDomainPlus :: Domain -> Domain -> Domain
+getDomainPlus xs ys = toDomain (zl, zh) where
+    zl = findMin xs + findMin ys
+    zh = findMax xs + findMax ys
+
+getDomainMinus :: Domain -> Domain -> Domain
+getDomainMinus xs ys = toDomain (zl, zh) where
+    zl = findMin xs - findMax ys
+    zh = findMax xs - findMin ys
+
+getDomainMult :: Domain -> Domain -> Domain
+getDomainMult xs ys = toDomain (zl, zh) where
+    zl = minimum products
+    zh = maximum products
+    products = [x * y |
+        x <- [findMin xs, findMax xs],
+        y <- [findMin ys, findMax ys]]
+
+getDomainDiv :: Domain -> Domain -> Domain
+getDomainDiv xs ys = toDomain (zl, zh) where
+    zl = minimum quotientsl
+    zh = maximum quotientsh
+    quotientsl = [if y /= 0 then x `div` y else minBound |
+        x <- [findMin xs, findMax xs],
+        y <- [findMin ys, findMax ys]]
+    quotientsh = [if y /= 0 then x `div` y else maxBound |
+        x <- [findMin xs, findMax xs],
+        y <- [findMin ys, findMax ys]]
+
+infix 4 .==.
+(.==.) :: (ToExpr a, ToExpr b) => a -> b -> FD Bool
+xexpr .==. yexpr = do
+    x <- exprVar xexpr
+    y <- exprVar yexpr
+    x `same` y
+
+infix 4 ./=.
+(./=.) :: (ToExpr a, ToExpr b) => a -> b -> FD Bool
+xexpr ./=. yexpr = do
+    x <- exprVar xexpr
+    y <- exprVar yexpr
+    x `different` y
diff --git a/Control/CP/FD/FDSugar.hs b/Control/CP/FD/FDSugar.hs
new file mode 100644
--- /dev/null
+++ b/Control/CP/FD/FDSugar.hs
@@ -0,0 +1,129 @@
+{- 
+ - 	Monadic Constraint Programming
+ - 	http://www.cs.kuleuven.be/~toms/Haskell/
+ - 	Tom Schrijvers
+ -}
+{-# LANGUAGE TransformListComp #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Control.CP.FD.FDSugar where 
+
+import Control.CP.SearchTree hiding (label)
+import Control.CP.Transformers
+import Control.CP.ComposableTransformers
+import Control.CP.Queue
+import Control.CP.Solver
+
+import GHC.Exts (sortWith)
+import qualified Control.CP.PriorityQueue as PriorityQueue
+import qualified Data.Sequence
+import Control.CP.FD.FD
+
+dfs = []
+bfs = Data.Sequence.empty
+pfs :: Ord a => PriorityQueue.PriorityQueue a (a,b,c)
+pfs = PriorityQueue.empty
+
+nb :: Int -> CNodeBoundedST FD a
+nb = CNBST
+db :: Int -> CDepthBoundedST FD a
+db = CDBST
+bb :: NewBound FD -> CBranchBoundST FD a
+bb = CBBST
+fs :: CFirstSolutionST FD a
+fs = CFSST
+it :: CIdentityCST FD a
+it = CIST
+ra :: Int -> CRandomST FD a
+ra = CRST
+ld :: Int -> CLimitedDiscrepancyST FD a
+ld = CLDST
+
+newBound :: NewBound FD
+newBound = do obj <- fd_objective
+              (val:_) <- fd_domain obj 
+	      l <- markSM
+              return ((\tree -> tree `insertTree` (obj @< val)) :: forall b . Tree FD b -> Tree FD b)
+
+newBoundBis :: NewBound FD 
+newBoundBis = do obj <- fd_objective
+                 (val:_) <- fd_domain obj 
+                 let m = val `div` 2
+                 return ((\tree -> (obj @< (m + 1) \/ ( obj @> m /\ obj @< val)) /\ tree) :: forall b . Tree FD b -> Tree FD b)
+
+restart :: (Queue q, Solver solver, CTransformer c, CForSolver c ~ solver,
+          Elem q ~ (Label solver,Tree solver (CForResult c),CTreeState c)) 
+      => q -> [c] -> Tree solver (CForResult c) -> (Int,[CForResult c])
+restart q cs model = runSM $ eval model q (RestartST (map Seal cs) return)
+
+restartOpt :: (Queue q, CTransformer c, CForSolver c ~ FD,
+          Elem q ~ (Label FD,Tree FD (CForResult c),CTreeState c)) 
+      => q -> [c] -> Tree FD (CForResult c) -> (Int,[CForResult c])
+restartOpt q cs model = runSM $ eval model q (RestartST (map Seal cs) opt)
+	where opt tree = newBound >>= \f -> return (f tree)
+
+--------------------------------------------------------------------------------
+-- ENUMERATION
+--------------------------------------------------------------------------------
+
+enumerate = Label . (label in_order) 
+-- enumerate = Label . (label firstfail) 
+
+label sel qs  = do qs' <- sel qs 
+                   label' qs' 
+  where label' []      = return true
+        label' (q:qs)  = do d <- fd_domain q 
+--                            return $ enum q (middleout d) /\ enumerate qs
+                            return $ enum q d /\ enumerate qs
+
+in_order :: Monad m => a -> m a
+in_order = return 
+
+firstfail qs = do ds <- mapM fd_domain qs 
+                  return [ q | (d,q) <- zip ds qs 
+                             , then sortWith by (length d) ] 
+enum queen values = 
+  disj [ queen @= value 
+       | value <- values 
+       ] 
+
+value var = do [val] <- fd_domain var
+               return val
+
+middleout l = let n = (length l) `div` 2 in
+              interleave (drop n l) (reverse $ take n l)
+
+endsout  l = let n = (length l) `div` 2 in
+              interleave (reverse $ drop n l) (take n l)
+
+interleave []     ys = ys
+interleave (x:xs) ys = x:interleave ys xs
+--------------------------------------------------------------------------------
+-- RESULT
+--------------------------------------------------------------------------------
+
+assignments = mapM assignment 
+assignment q = Label $ value q >>= (return . Return)
+--------------------------------------------------------------------------------
+-- SYNTACTIC SUGAR
+--------------------------------------------------------------------------------
+
+in_domain v (l,u)  = Add (FD_Dom v (l,u)) true
+(@\=) :: FD_Term -> FD_Term -> Tree FD ()
+v1 @\= v2  = Add (FD_NEq v1 v2) true
+
+(@=) :: FD_Term -> Int -> Tree FD ()
+v1 @= v2  = Add (FD_Eq v1 v2) true
+
+data Plus  = FD_Term :+ Int 
+(@+) = (:+)
+
+(@\==) :: FD_Term -> Plus -> Tree FD ()
+v1 @\== (v2 :+ i)  = Add (FD_NEq v1 (v2 .+. i))  true
+
+(@<) :: FD_Term -> Int -> Tree FD ()
+v @< i  = Add (FD_LT v i) true
+
+(@>) :: FD_Term -> Int -> Tree FD ()
+v @> i  = Add (FD_GT v i) true
diff --git a/Control/CP/Herbrand/Herbrand.hs b/Control/CP/Herbrand/Herbrand.hs
new file mode 100644
--- /dev/null
+++ b/Control/CP/Herbrand/Herbrand.hs
@@ -0,0 +1,113 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE PatternGuards #-}
+module Control.CP.Herbrand.Herbrand where 
+
+import Control.Monad.State.Lazy
+import Control.Applicative
+
+import Data.Map
+
+import Control.CP.Solver
+
+-- Herbrand terms
+
+type VarId = Int
+
+class HTerm t where
+  mkVar    :: VarId -> t
+  isVar    :: t   -> Maybe VarId
+  children :: t -> ([t], [t] -> t)
+  nonvar_unify
+        :: t -> t -> Herbrand t Bool
+
+-- Herbrand monad
+
+newtype Herbrand t a = Herbrand { unH :: State (HState t) a }
+  deriving (Monad, MonadState (HState t))
+
+instance Functor (Herbrand t) where
+  fmap f fa  = fa >>= return . f 
+
+
+instance Applicative (Herbrand t) where
+  pure         = return
+  (<*>) ff fa  = do f <- ff 
+                    a <- fa
+	            return $ f a
+
+type Subst t = Map VarId t
+
+data HState t = HState {var_supply :: VarId
+                       ,subst      :: Subst t
+                       }
+
+updateState :: HTerm t => (HState t -> HState t) -> Herbrand t ()
+updateState f = get >>= put . f
+
+-- Solver instance 
+
+instance HTerm t => Solver (Herbrand t) where
+  type Term       (Herbrand t)  = t
+  type Constraint (Herbrand t)  = Unify t 
+  type Label      (Herbrand t)  = HState t
+  newvarSM  = newvarH
+  addSM     = addH
+  markSM    = get
+  gotoSM    = put
+  runSM     = flip evalState initState . unH
+
+initState = HState 0 Data.Map.empty
+
+-- New variable
+
+newvarH :: HTerm t => Herbrand t t
+newvarH = do state <- get
+             let varid = var_supply state
+             put state{var_supply = varid + 1}
+             return $ mkVar varid
+
+-- Unification
+
+data Unify t = t `Unify` t
+
+addH (Unify t1 t2) = unify t1 t2
+
+unify :: HTerm t => t -> t -> Herbrand t Bool
+unify t1 t2 = 
+  do nt1 <- shallow_normalize t1
+     nt2 <- shallow_normalize t2
+     case (isVar nt1, isVar nt2) of
+       (Just v1, Just v2) 
+          | v1 == v2      -> success
+       (Just v1, _      ) -> bind v1 nt2 >> success
+       (_      , Just v2) -> bind v2 nt1 >> success
+       (_      , _      ) -> nonvar_unify nt1 nt2
+
+success, failure :: HTerm t => Herbrand t Bool
+success  = return True
+failure  = return False
+
+bind :: HTerm t => VarId -> t -> Herbrand t ()
+bind v t  = updateState $ \state -> state{subst = insert v t (subst state)}
+
+-- Normalization
+
+shallow_normalize :: HTerm t => t -> Herbrand t t
+shallow_normalize t
+  | Just v <- isVar t    
+     = do state <- get
+          case Data.Map.lookup v (subst state) of
+            Just t' -> shallow_normalize t'
+            Nothing -> return t 
+  | otherwise  
+     = return t
+
+normalize :: HTerm t => t -> Herbrand t t
+normalize t
+  | Just v <- isVar t  = do state <- get
+                            case Data.Map.lookup v (subst state) of
+                              Just t' -> normalize t'
+                              Nothing -> return t
+  | otherwise          = let (ts,mkt)  = children t
+                         in pure mkt <*> mapM normalize ts
diff --git a/Control/CP/Herbrand/PrologTerm.hs b/Control/CP/Herbrand/PrologTerm.hs
new file mode 100644
--- /dev/null
+++ b/Control/CP/Herbrand/PrologTerm.hs
@@ -0,0 +1,28 @@
+module Control.CP.Herbrand.PrologTerm  where 
+
+import Data.List (intersperse)
+import Control.CP.Herbrand.Herbrand
+
+data PrologTerm = PTerm String [PrologTerm] | PVar VarId
+
+instance HTerm PrologTerm where
+  mkVar           = PVar
+  isVar (PVar v)  = Just v
+  isVar _         = Nothing
+  children (PTerm f args) 
+                  =  (args,\args' -> PTerm f args')
+  children t      =  ([],  \[]    -> t)
+  nonvar_unify (PTerm f1 args1) (PTerm f2 args2)
+                  | f1 == f2   = unify_lists args1 args2
+                  | otherwise  = failure
+                  where unify_lists []     []      = success
+                        unify_lists (x:xs) (y:ys)  =
+                          do b <- unify x y
+                             if b then unify_lists xs ys
+                                  else failure
+                        unify_lists _      _       = failure
+
+instance Show PrologTerm where
+  show (PVar v)        = 'V' : show v
+  show (PTerm f args)  = f ++ "(" ++ (concat $ intersperse "," $ map show args) ++ ")"
+
diff --git a/Control/CP/Main.hs b/Control/CP/Main.hs
new file mode 100644
--- /dev/null
+++ b/Control/CP/Main.hs
@@ -0,0 +1,90 @@
+{- 
+ - 	Monadic Constraint Programming
+ - 	http://www.cs.kuleuven.be/~toms/Haskell/
+ - 	Tom Schrijvers
+ -}
+module Control.CP.Main where
+
+import Control.CP.ComposableTransformers
+import Control.CP.FD
+import Control.CP.FDSugar
+import List (tails)
+import Control.CP.SearchTree hiding (label)
+import System (getArgs)
+
+--------------------------------------------------------------------------------
+-- MAIN FUNCTIONS
+--------------------------------------------------------------------------------
+
+main = main1
+
+
+main1 = getArgs >>= print . solve dfs it . nqueens . read . head
+main2 = getArgs >>= print . solve dfs (nb 100 :- db  25 :- bb newBound)  . nqueens . read . head
+
+main3 = getArgs >>= print . solve dfs (db 9) . nqueens . read . head
+
+main4 = do (n1:_) <- getArgs 
+           let n = read n1
+           loop 1 n
+  where loop i n
+          | i > n     = return ()
+          | otherwise =
+              do -- print . (\(i,l) -> (i,not $ Prelude.null l)) . solve dfs (it :- fs :- ra 13 :- ld l) . nqueens $ i
+                 print . (\(i,l) -> (i, {- not $ Prelude.null-}  l)) . restart dfs (map db [3..10]) . nqueens $ i
+                 -- print . (\(i,l) -> (i, {- not $ Prelude.null-}  l)) . restartOpt dfs (replicate 10 fs) . nqueens $ i
+                 loop (i+1) n
+
+main5 = getArgs >>= loop 1 . read . head
+  where loop i n
+          | i > n     = return ()
+          | otherwise =
+              do print . (\(i,l) -> (i,minimum l)) . solve dfs (ld 5 :- bb newBoundBis) . gmodel $ i
+                 loop (i+1) n
+
+--------------------------------------------------------------------------------
+-- PATH MODEL
+--------------------------------------------------------------------------------
+
+gmodel n = NewVar $ \_ -> path 1 n 0
+
+path :: Int -> Int -> Int -> Tree FD Int
+path x y d = if x == y 
+               then Return d
+               else disj [ Label (fd_objective >>= \o -> return (o @> (d+d' - 1) /\ (path z y (d+d')))) 
+                         | (z,d') <- edge x
+                         ]
+
+edge i | i < 20     = [ (i+1,4), (i+2,1) ]
+       | otherwise  = []
+
+--------------------------------------------------------------------------------
+-- N QUEENS MODEL
+--------------------------------------------------------------------------------
+
+nqueens n = 
+  exist n $ \queens -> queens `allin` (1,n) /\ 
+                       alldifferent queens  /\ 
+                       diagonals queens     /\
+                       -- enumerate ({- middleout -} endsout queens) /\
+                       -- enumerate (middleout queens) /\
+                       enumerate (queens) /\
+		       assignments queens
+
+allin queens range  =  
+  conj [q `in_domain` range 
+       | q <- queens 
+       ] 
+
+alldifferent :: [ FD_Term ] -> Tree FD ()
+alldifferent queens =
+  conj [ qi @\= qj 
+       | qi:qjs <- tails queens 
+       , qj <- qjs 
+       ]
+ 
+diagonals queens = 
+  conj [ qi @\== (qj @+ d) /\ qj @\== (qi @+ d) 
+       | qi:qjs <- tails queens 
+       , (qj,d) <- zip qjs [1..] 
+       ]
diff --git a/Control/CP/PriorityQueue.hs b/Control/CP/PriorityQueue.hs
new file mode 100644
--- /dev/null
+++ b/Control/CP/PriorityQueue.hs
@@ -0,0 +1,110 @@
+{- Copyright (c) 2008 the authors listed at the following URL, and/or
+the authors of referenced articles or incorporated external code:
+http://en.literateprograms.org/Priority_Queue_(Haskell)?action=history&offset=20080608152146
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+Retrieved from: http://en.literateprograms.org/Priority_Queue_(Haskell)?oldid=13634
+-}
+
+module Control.CP.PriorityQueue (
+    PriorityQueue,
+    empty,
+    is_empty,
+    minKey,
+    minKeyValue,
+    insert,
+    deleteMin,
+    deleteMinAndInsert
+) where
+
+ 
+import Prelude
+
+
+-- Declare the data type constructors.
+
+data Ord k => PriorityQueue k a = Nil | Branch k a (PriorityQueue k a) (PriorityQueue k a)
+ 
+
+-- Declare the exported interface functions.
+
+-- Return an empty priority queue.
+
+is_empty Nil = True
+is_empty _   = False
+
+empty :: Ord k => PriorityQueue k a
+empty = Nil
+
+
+-- Return the highest-priority key.
+
+minKey :: Ord k => PriorityQueue k a -> k
+minKey = fst . minKeyValue
+
+
+-- Return the highest-priority key plus its associated value.
+
+minKeyValue :: Ord k => PriorityQueue k a -> (k, a)
+minKeyValue Nil              = error "empty queue"
+minKeyValue (Branch k a _ _) = (k, a)
+
+
+-- Insert a key/value pair into a queue.
+
+insert :: Ord k => k -> a -> PriorityQueue k a -> PriorityQueue k a
+insert k a q = union (singleton k a) q
+
+deleteMin :: Ord k => PriorityQueue k a -> ((k,a), PriorityQueue k a)
+deleteMin(Branch k a l r) = ((k,a),union l r)
+
+-- Delete the highest-priority key/value pair and insert a new key/value pair into the queue.
+
+deleteMinAndInsert :: Ord k => k -> a -> PriorityQueue k a -> PriorityQueue k a
+deleteMinAndInsert k a Nil              = singleton k a
+deleteMinAndInsert k a (Branch _ _ l r) = union (insert k a l) r
+
+
+
+-- Declare the private helper functions.
+
+-- Join two queues in sorted order.
+
+union :: Ord k => PriorityQueue k a -> PriorityQueue k a -> PriorityQueue k a
+union l Nil = l
+union Nil r = r
+union l@(Branch kl _ _ _) r@(Branch kr _ _ _)
+    | kl <= kr  = link l r
+    | otherwise = link r l
+
+
+-- Join two queues without regard to order.
+
+-- (This is a helper to the union helper.)
+
+link (Branch k a Nil m) r = Branch k a r m
+link (Branch k a ll lr) r = Branch k a lr (union ll r)
+
+
+-- Return a queue with a single item from a key/value pair.
+
+singleton :: Ord k => k -> a -> PriorityQueue k a
+singleton k a = Branch k a Nil Nil
diff --git a/Control/CP/Queue.hs b/Control/CP/Queue.hs
new file mode 100644
--- /dev/null
+++ b/Control/CP/Queue.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-
+ - The Queue data type, a worklist data type for search.
+ -
+ - 	Monadic Constraint Programming
+ - 	http://www.cs.kuleuven.be/~toms/Haskell/
+ - 	Tom Schrijvers
+ -}
+
+module Control.CP.Queue where
+
+import qualified Data.Sequence
+import qualified Control.CP.PriorityQueue as PriorityQueue
+
+class Queue q where   
+  type Elem q :: *
+  emptyQ   :: q -> q
+  isEmptyQ :: q -> Bool
+  popQ     :: q -> (Elem q,q)
+  pushQ    :: Elem q -> q -> q
+
+instance Queue [a] where
+  type Elem [a] = a
+  emptyQ _     = []
+  isEmptyQ     = Prelude.null
+  popQ (x:xs)  = (x,xs)
+  pushQ        = (:)
+
+instance Queue (Data.Sequence.Seq a) where
+  type Elem (Data.Sequence.Seq a)  = a
+  emptyQ _                   = Data.Sequence.empty
+  isEmptyQ                   = Data.Sequence.null 
+  popQ (Data.Sequence.viewl -> x Data.Sequence.:< xs)  = (x,xs)
+  pushQ                      = flip (Data.Sequence.|>)
+
+instance Ord a => Queue (PriorityQueue.PriorityQueue a (a,b,c)) where
+  type Elem (PriorityQueue.PriorityQueue a (a,b,c)) = (a,b,c)
+  emptyQ _ = PriorityQueue.empty
+  isEmptyQ = PriorityQueue.is_empty 
+  pushQ x@(k,_,_)  = PriorityQueue.insert k x
+  popQ q   = let ((_,x),q') = PriorityQueue.deleteMin q
+             in (x,q')
diff --git a/Control/CP/SearchTree.hs b/Control/CP/SearchTree.hs
new file mode 100644
--- /dev/null
+++ b/Control/CP/SearchTree.hs
@@ -0,0 +1,175 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+{-
+ - The Tree data type, a generic modelling language for constraint solvers.
+ -
+ - 	Monadic Constraint Programming
+ - 	http://www.cs.kuleuven.be/~toms/Haskell/
+ - 	Tom Schrijvers
+ -}
+
+module Control.CP.SearchTree  where
+
+import Monad
+import Control.CP.Solver
+
+-------------------------------------------------------------------------------
+----------------------------------- Tree --------------------------------------
+-------------------------------------------------------------------------------
+
+data Tree s a
+ 		= Fail                          -- failure
+                | Return a                      -- finished
+                | Try (Tree s a) (Tree s a)     -- disjunction
+                | Add (Constraint s) (Tree s a) -- sequentially adding a constraint to a tree
+                | NewVar (Term s -> Tree s a)   -- add a new variable to a tree
+	        | Label (s (Tree s a))      	-- label with a strategy
+
+instance Show (Tree s a)  where
+  show Fail 		= "Fail"
+  show (Return _) 	= "Return"
+  show (Try l r)        = "Try (" ++ show l ++ ") (" ++ show r ++ ")"
+  show (Add _ t)        = "Add (" ++ show t ++ ")"
+  show (NewVar _)       = "NewVar"
+  show (Label _)        = "Label"
+
+instance Solver s => Functor (Tree s) where
+	fmap  = liftM 
+ 
+instance Solver s => Monad (Tree s) where
+  return = Return
+  (>>=)  = bindTree
+  
+
+bindTree     :: Solver s => Tree s a -> (a -> Tree s b) -> Tree s b
+Fail           `bindTree` k  = Fail
+(Return x)     `bindTree` k  = k x
+(Try m n)      `bindTree` k  = Try (m `bindTree` k) (n `bindTree` k)
+(Add c m)      `bindTree` k  = Add c (m `bindTree` k)
+(NewVar f)     `bindTree` k  = NewVar (\x -> f x `bindTree` k)    
+(Label m)      `bindTree` k  = Label (m >>= \t -> return (t `bindTree` k))
+
+insertTree     :: Solver s => Tree s a -> Tree s () -> Tree s a
+(NewVar f)     `insertTree` t  = NewVar (\x -> f x `insertTree` t)    
+(Add c  o)     `insertTree` t  = Add c (o `insertTree` t)
+other 	       `insertTree` t  = t /\ other
+
+
+{- Monad laws:
+ -
+ - 1. return x >>= f  ==  f x
+ -
+ -    return a >>= f  
+ -    == Return a >>= f		(return def)
+ -    == f x			(bind def) 
+ -
+ - 2. m >>= return  =  m
+ -
+ -   By induction
+ -     case m of
+ -     1) Return x -> 
+ -          Return x >>= return
+ -          == return x			(bind def)
+ -          == Return x        		(return def)
+ -     2) Fail ->
+ -          Fail >>= return
+ -          == Fail			(bind def)
+ -     3)  Try l r >>= return
+ -         == Try (l >>= return) (r >>= return) (bind def)
+ -         == Try l r				(induction)
+ -      4) Add c m >>= return
+ -         == Add c (m >>= return) 	(bind def)
+ -         == Add c m 			(induction) 
+ - 	5) NewVar f >>= return
+ - 	   == NewVar (\v -> f v >>= return) 	(bind def) 
+ - 	   == NewVar (\v -> f v)		((co)-induction?)
+ - 	   == NewVar f				(eta reduction)
+ - 	6) Label sm >>= return
+ - 	   == Label (sm >>= \m -> return (m >>= return))	(bind def)
+ - 	   == Label (sm >>= \m -> return m)			(co-induction)
+ - 	   == Label (sm >>= return)				(eta reduction)
+ - 	   == Label sm						(2nd monad law for Monad s)
+ -
+ - 3. (m >>= f) >>= g = m >>= (\x -> f x >>= g)
+ - 
+ -   By induction
+ -     case m of
+ -     1) (Return y >>= f) >>= g 
+ -	  == f y >>= g					(bind def)
+ -	  == (\x -> f x >>= g) y			(beta expansion)
+ -	  == Return y >>= (\x -> f x >>= g)		(bind def)
+ -     2) (Fail >>= f) >>= g
+ -        == Fail >>= g					(bind def)
+ -        == Fail					(bind def)
+ -        == Fail >>= (\x -> f x >>= g)			(bind def) 
+ -     3) (Try l r >>= f) >>= g
+ -        == Try (l >>= f) (r >>= f)) >>= g 				(bind def)
+ -        == Try ((l >>= f) >>= g) ((r >>= f) >>= g)			(bind def)
+ -        == Try (l >>= (\x -> f x >>= g)) (r >>= (\x -> f x >>= g)) 	(induction)
+ -        == Try l r >>= (\x -> f x >>= g)				(bind def)
+ -     4) (NewVar m >>= f) >>= g
+ -        == NewVar (\v -> m v >>= f) >>= g			(bind def)
+ -        == NewVar (\w -> (\v -> m v >>= f) w >>= g)		(bind def)
+ -        == NewVar (\w -> (m w >>= f) >>= g)			(beta reduction)  
+ -        == NewVar (\w -> m w >>= (\x -> f x >>= g))		(co-induction)
+ -        == NewVar m >>= (\x -> f x >>= g)			(bind def)
+ -     5) (Label sm >>= f) >>= g
+ -         == Label (sm >>= \m -> return (m >>= f)) >>= g 	(bind def) 
+ -         == Label ((sm >>= \m -> return (m >>= f)) >>= \m' -> return (m' >>= g))
+ -         == Label (sm >>= (\m -> return (m >>= f) >>= \m' -> return (m' >>= g)))
+ -         == Label (sm >>= \m -> return ((m >>= f) >>= g))
+ -         == Label (sm >>= \m -> return (m >>= (\x -> f x >>= g)))
+ -         == Label sm >>= (\x -> f x >>= g)
+ -
+ -}
+
+-------------------------------------------------------------------------------
+----------------------------------- Sugar -------------------------------------
+-------------------------------------------------------------------------------
+ 
+infixr 3 /\
+(/\) :: Solver s => Tree s a -> Tree s b -> Tree s b
+(/\) = (>>)
+ 
+infixl 2 \/
+(\/) :: Solver s => Tree s a -> Tree s a -> Tree s a
+(\/) = Try
+
+false :: Tree s a
+false = Fail
+ 
+true :: Tree s ()
+true = Return ()
+
+disj :: Solver s => [Tree s a] -> Tree s a
+disj = foldr (\/) false
+
+conj :: Solver s => [Tree s ()] -> Tree s ()
+conj = foldr (/\) true
+
+disj2 :: Solver s => [Tree s a] -> Tree s a
+disj2 (x:  [])  = x
+disj2 l        = let (xs,ys)      = split l
+                     split []     = ([],[])
+                     split (a:as) = let (bs,cs) = split as
+                                    in  (a:cs,bs)
+                 in  Try (disj2 xs) (disj2 ys)
+ 
+exists :: (Term s -> Tree s a) -> Tree s a
+exists f = NewVar f
+
+exist :: Solver s => Int -> ([Term s] -> Tree s a) -> Tree s a
+exist n ftree = f n []
+         where f 0 acc  = ftree acc
+               f n acc  = exists $ \v -> f (n-1) (v:acc)
+
+forall :: Solver s => [Term s] -> (Term s -> Tree s ()) -> Tree s ()
+forall list ftree = conj $ map ftree list
+ 
+label :: Solver s => s (Tree s a) -> Tree s a
+label = Label
+
+prim :: Solver s => (s a) -> Tree s a
+prim action = Label (action >>= return . return)
+
+add :: Solver s => Constraint s -> Tree s ()
+add c = Add c true
diff --git a/Control/CP/Solver.hs b/Control/CP/Solver.hs
new file mode 100644
--- /dev/null
+++ b/Control/CP/Solver.hs
@@ -0,0 +1,28 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+{-
+ - The Solver class, a generic interface for constraint solvers.
+ -
+ - 	Monadic Constraint Programming
+ - 	http://www.cs.kuleuven.be/~toms/Haskell/
+ - 	Tom Schrijvers
+ -}
+module Control.CP.Solver where 
+
+class Monad solver => Solver solver where
+	-- the constraints
+	type Constraint solver 	:: *
+	-- the terms
+	type Term solver 	:: *
+ 	-- the labels
+	type Label solver	:: *
+	-- produce a fresh constraint variable
+	newvarSM 	:: solver (Term solver)
+	-- add a constraint to the current state, and
+	-- return whethe the resulting state is consistent
+	addSM		:: Constraint solver -> solver Bool
+	-- run a computation
+	runSM		:: solver a -> a
+	-- mark the current state, and return its label
+	markSM		:: solver (Label solver)
+	-- go to the state with given label
+	gotoSM		:: Label solver -> solver ()
diff --git a/Control/CP/Transformers.hs b/Control/CP/Transformers.hs
new file mode 100644
--- /dev/null
+++ b/Control/CP/Transformers.hs
@@ -0,0 +1,104 @@
+{- 
+ - 	Monadic Constraint Programming
+ - 	http://www.cs.kuleuven.be/~toms/Haskell/
+ - 	Tom Schrijvers
+ -}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE Rank2Types #-}
+module Control.CP.Transformers where 
+
+import Control.CP.Solver
+import Control.CP.SearchTree
+import Control.CP.Queue
+
+--------------------------------------------------------------------------------
+-- EVALUATION
+--------------------------------------------------------------------------------
+
+eval :: (Solver solver, Queue q, Elem q ~ (Label solver,Tree solver (ForResult t),TreeState t), Transformer t,
+         ForSolver t ~ solver) 
+     => Tree solver (ForResult t) -> q -> t -> solver (Int,[ForResult t])
+eval tree q t  = do (es,ts) <- initT t tree
+                    eval' 0 tree q t es ts
+
+eval' :: SearchSig solver q t (ForResult t) 
+eval' i (Return x) wl t es ts  = do (j,xs) <- returnT (i+1) wl t es
+                                    return (j,(x:xs)) 
+eval' i (Add c k)  wl t es ts = do b <- addSM c 
+                                   if b then eval' (i+1) k wl t es ts
+                                        else continue (i+1) wl t es
+eval' i (NewVar f) wl t es ts = do v <- newvarSM 
+                                   eval' (i+1) (f v) wl t es ts
+eval' i (Try l r)  wl t es ts  = 
+  do now <- markSM 
+     let wl' = pushQ (now,l,leftT t es ts) $ pushQ (now,r,rightT t es ts) wl
+     continue (i+1) wl' t es
+eval' i Fail       wl t es ts  = continue (i+1) wl t es
+eval' i (Label m)  wl t es ts  = do tree <- m
+                                    eval' (i+1) tree wl t es ts
+ 
+continue :: ContinueSig solver q t (ForResult t) 
+continue i wl t es  
+	| isEmptyQ wl  = endT i wl t es -- return (i,[])
+        | otherwise    = let ((past,tree,ts),wl') = popQ wl
+                         in  do gotoSM past
+                                nextT i tree wl' t es ts 
+
+--------------------------------------------------------------------------------
+-- TRANSFORMER
+--------------------------------------------------------------------------------
+
+type SearchSig solver q t a =
+     (Solver solver, Queue q, Transformer t,   
+          Elem q ~ (Label solver,Tree solver a,TreeState t),
+	  ForSolver t ~ solver) 
+     => Int -> Tree solver a -> q -> t -> EvalState t -> TreeState t -> solver (Int,[a])
+
+type ContinueSig solver q t a =
+     (Solver solver, Queue q, Transformer t,   
+          Elem q ~ (Label solver,Tree solver a,TreeState t),
+	  ForSolver t ~ solver) 
+     => Int -> q -> t -> EvalState t -> solver (Int,[a])
+
+class Transformer t where
+  type EvalState t :: *
+  type TreeState t :: *
+  type ForSolver t :: (* -> *)
+  type ForResult t :: *
+  leftT, rightT :: t -> EvalState t -> TreeState t -> TreeState t
+  leftT  _ _ = id
+  rightT    = leftT
+  nextT :: SearchSig (ForSolver t) q t (ForResult t)
+  nextT  = eval'
+  initT :: t -> Tree (ForSolver t) (ForResult t) -> (ForSolver t) (EvalState t,TreeState t)
+  returnT :: ContinueSig solver q t (ForResult t) 
+  returnT i wl t es  = continue i wl t es
+  endT  :: ContinueSig solver q t (ForResult t)
+  endT i wl t es     = return (i,[])
+
+newtype DepthBoundedST (solver :: * -> *) a = DBST Int
+
+instance Solver solver => Transformer (DepthBoundedST solver a) where
+  type EvalState (DepthBoundedST solver a)  = ()
+  type TreeState (DepthBoundedST solver a)  = Int
+  type ForSolver (DepthBoundedST solver a)  = solver
+  type ForResult (DepthBoundedST solver a)  = a
+  initT (DBST n) _  = return ((),n)
+  leftT _ _ ts      = ts - 1
+  nextT i tree q t es ts
+    | ts == 0    = continue i q t es
+    | otherwise  = eval' i tree q t es ts
+
+newtype NodeBoundedST (solver :: * -> *) a = NBST Int
+
+instance Solver solver => Transformer (NodeBoundedST solver a)  where
+  type EvalState (NodeBoundedST solver a) = Int
+  type TreeState (NodeBoundedST solver a) = ()
+  type ForSolver (NodeBoundedST solver a) = solver
+  type ForResult (NodeBoundedST solver a) = a
+  initT (NBST n) _  = return (n,())
+  nextT i tree q t es ts
+    | es == 0    = return (i,[])
+    | otherwise  = eval' i tree q t (es - 1) ts
+
diff --git a/Language/CP/ComposableTransformers.hs b/Language/CP/ComposableTransformers.hs
deleted file mode 100644
--- a/Language/CP/ComposableTransformers.hs
+++ /dev/null
@@ -1,274 +0,0 @@
-{- 
- - 	Monadic Constraint Programming
- - 	http://www.cs.kuleuven.be/~toms/Haskell/
- - 	Tom Schrijvers
- -}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE ImpredicativeTypes #-}
-{-# LANGUAGE FlexibleContexts #-}
-
-module Language.CP.ComposableTransformers where 
-
-import Language.CP.Transformers
-import Language.CP.SearchTree
-import Language.CP.Solver
-import Language.CP.Queue
-
-import System.Random (mkStdGen, randoms)
-
---------------------------------------------------------------------------------
--- EVALUATION
---------------------------------------------------------------------------------
-
-solve :: (Queue q, Solver solver, CTransformer c, CForSolver c ~ solver,
-          Elem q ~ (Label solver,Tree solver (CForResult c),CTreeState c)) 
-      => q -> c -> Tree solver (CForResult c) -> (Int,[CForResult c])
-solve q c model = runSM $ eval model q (TStack c)
-
---------------------------------------------------------------------------------
--- COMPOSABLE TRANSFORMERS
---------------------------------------------------------------------------------
-
-data TStack es ts (solver :: * -> *) a where
-   TStack :: (CTransformer c, CForSolver c ~ solver, CForResult c ~ a) 
-          => c -> TStack (CEvalState c) (CTreeState c) solver a
-
-instance Solver solver => Transformer (TStack es ts solver a) where
-  type EvalState (TStack es ts solver a) = es
-  type TreeState (TStack es ts solver a) = ts
-  type ForSolver (TStack es ts solver a) = solver
-  type ForResult (TStack es ts solver a) = a
-  initT  (TStack c) _  = return $ initCT c
-  leftT  (TStack c) _  = leftCT c
-  rightT (TStack c) _  = rightCT c
-  nextT = nextTStack 
-  returnT i wl t@(TStack c) es = returnCT c es (\es' -> continue i wl t es') (\es' -> endT i wl t es')
-
-nextTStack :: 
-     (Solver solver, Queue q, Elem q ~ (Label solver,Tree solver a,ts))
-     => Int -> Tree solver a -> q -> (TStack es ts solver a) -> es -> ts -> solver (Int,[a])
-nextTStack i tree q t es ts =
-    case t of
-      TStack c ->
-        nextCT tree c es ts (\tree' es' ts' -> eval' i tree' q t es' ts') 
-                            (\es'       -> continue i q t es')
-			    (\es' -> endT i q t es')
-
---------------------------------------------------------------------------------
-type CSearchSig c a =
-     (Solver (CForSolver c), CTransformer c) 
-     => Tree (CForSolver c) a -> c -> CEvalState c -> CTreeState c -> (EVAL c a) -> (CONTINUE c a) -> (EXIT c a) -> (CForSolver c) (Int,[a])
-
-type CContinueSig c a =
-     (Solver (CForSolver c), CTransformer c) 
-     => c -> CEvalState c -> (CONTINUE c a) -> (EXIT c a) -> (CForSolver c) (Int,[a])
-
-type EVAL     c a = (Tree (CForSolver c) a -> CEvalState c -> CTreeState c-> (CForSolver c) (Int,[a]))
-type CONTINUE c a = (CEvalState c -> (CForSolver c) (Int,[a]))
-type EXIT     c a = (CEvalState c) -> (CForSolver c) (Int,[a]) 
-
-class Solver (CForSolver c) => CTransformer c where
-  type CEvalState c :: *
-  type CTreeState c :: *
-  type CForSolver c :: (* -> *)
-  type CForResult c :: *
-  initCT :: c -> (CEvalState c, CTreeState c)
-  leftCT, rightCT :: c -> CTreeState c -> CTreeState c
-  leftCT  _  = id
-  rightCT    = leftCT
-  nextCT :: CSearchSig c (CForResult c)
-  nextCT   = evalCT
-  returnCT :: CContinueSig c (CForResult c) 
-  returnCT = continueCT
-  completeCT :: c -> CEvalState c -> Bool
-  completeCT _ _ = True
-
-evalCT :: CSearchSig c a
-evalCT tree c es ts eval continue exit =
-  eval tree es ts
-
-continueCT :: CContinueSig c a
-continueCT c es continue exit =
-  continue es
-
-exitCT :: CContinueSig c a
-exitCT c es continue exit =
-  exit es
-
-newtype CNodeBoundedST (solver :: * -> *) a = CNBST Int
-
-instance Solver solver => CTransformer (CNodeBoundedST solver a) where
-  type CEvalState (CNodeBoundedST solver a) = Int
-  type CTreeState (CNodeBoundedST solver a) = ()
-  type CForSolver (CNodeBoundedST solver a) = solver
-  type CForResult (CNodeBoundedST solver a) = a
-  initCT (CNBST n)  = (n,())  
-  nextCT tree c es ts eval' continue exit
-    | es == 0    = exit es
-    | otherwise  = eval' tree (es - 1) ts
-
-newtype CDepthBoundedST (solver :: * -> *) a = CDBST Int
-
-instance Solver solver => CTransformer (CDepthBoundedST solver a) where
-  type CEvalState (CDepthBoundedST solver a)  = Bool
-  type CTreeState (CDepthBoundedST solver a)  = Int
-  type CForSolver (CDepthBoundedST solver a)  = solver
-  type CForResult (CDepthBoundedST solver a)  = a
-  initCT (CDBST n)  = (True,n)
-  leftCT _ ts      = ts - 1
-  nextCT tree c es ts eval' continue exit
-    | ts == 0    = continue False
-    | otherwise  = eval' tree es ts
-  completeCT _ es  = es
-
-newtype CLimitedDiscrepancyST (solver :: * -> *) a = CLDST Int
-
-instance Solver solver => CTransformer (CLimitedDiscrepancyST solver a) where
-  type CEvalState (CLimitedDiscrepancyST solver a) = ()
-  type CTreeState (CLimitedDiscrepancyST solver a) = Int
-  type CForSolver (CLimitedDiscrepancyST solver a) = solver
-  type CForResult (CLimitedDiscrepancyST solver a) = a
-  initCT (CLDST n)  = ((),n)
-  rightCT _ n  = n - 1
-  nextCT tree c es ts eval' continue exit
-    | ts == 0    = continue es
-    | otherwise  = eval' tree es ts
-
-newtype CRandomST (solver :: * -> *) a  = CRST Int
-
-instance Solver solver => CTransformer (CRandomST solver a) where
-  type CEvalState (CRandomST solver a) = [Bool]
-  type CTreeState (CRandomST solver a) = ()
-  type CForSolver (CRandomST solver a) = solver
-  type CForResult (CRandomST solver a) = a
-  initCT (CRST n)  = (randoms $ mkStdGen n,())
-  nextCT tree@(Try l r) c (switch:es)
-    | switch        = evalCT (Try r l) c es
-    | otherwise     = evalCT tree      c es
-  nextCT tree@(Add d (Try l r)) c (switch:es)
-    | switch        = evalCT (Add d (Try r l)) c es
-    | otherwise     = evalCT tree      c es
-  nextCT tree c es  = evalCT tree      c es
-
-data CIdentityCST (solver :: * -> *) a  = CIST
-
-instance Solver solver => CTransformer (CIdentityCST solver a) where
-  type CEvalState (CIdentityCST solver a)  = ()
-  type CTreeState (CIdentityCST solver a)  = ()
-  type CForSolver (CIdentityCST solver a)  = solver
-  type CForResult (CIdentityCST solver a)  = a
-  initCT _  = ((),())
-
-data CFirstSolutionST (solver :: * -> *) a  = CFSST
-
-instance Solver solver => CTransformer (CFirstSolutionST solver a) where
-  type CEvalState (CFirstSolutionST solver a)  = Bool
-  type CTreeState (CFirstSolutionST solver a)  = ()
-  type CForSolver (CFirstSolutionST solver a)  = solver
-  type CForResult (CFirstSolutionST solver a)  = a
-  initCT _  = (True,())
-  returnCT _ es continue exit =
-    exit False
-  completeCT _ es = es 
-
-
---------------------------------------------------------------------------------
-data Composition es ts solver a where
-  (:-) :: (CTransformer c1, CTransformer c2,
-           CForSolver c1 ~ solver, CForSolver c2 ~ solver,
-           CForResult c1 ~ a,      CForResult c2 ~ a
-          ) 
-       => c1 -> c2 -> Composition (CEvalState c1,CEvalState c2) (CTreeState c1,CTreeState c2) solver a
-
-instance Solver solver => CTransformer (Composition es ts solver a) where
-  type CEvalState (Composition es ts solver a) = es
-  type CTreeState (Composition es ts solver a) = ts
-  type CForSolver (Composition es ts solver a) = solver
-  type CForResult (Composition es ts solver a) = a
-  initCT (c1 :- c2)       = let (es1,ts1) = initCT c1 
-                                (es2,ts2) = initCT c2 
-                            in ((es1,es2),(ts1,ts2))
-  leftCT (c1 :- c2) (ts1,ts2)   = (leftCT c1 ts1,leftCT c2 ts2)
-  rightCT (c1 :- c2) (ts1,ts2)  = (rightCT c1 ts1,rightCT c2 ts2)
-  nextCT tree (c1 :- c2) (es1,es2) (ts1,ts2) eval' continue exit  =
-    nextCT tree c1 es1 ts1 
-           (\tree' es1' ts1' -> nextCT tree' c2 es2 ts2 
-                                   (\tree'' es2' ts2' -> eval' tree'' (es1',es2') (ts1',ts2'))
-                                   (\es2' -> continue (es1',es2'))
-				   (\es2' -> exit (es1',es2')) ) 
-           (\es1' -> continue (es1',es2))
-           (\es1' -> exit (es1',es2))
-  returnCT (c1 :- c2) (es1,es2) continue exit =
-    returnCT c1 es1 (\es1' -> returnCT c2 es2 (\es2' -> continue (es1',es2')) (\es2' -> exit (es1',es2'))) 
-		    (\es1' -> exit (es1',es2))
-  completeCT (c1 :- c2) (es1,es2)  = completeCT c1 es1 && completeCT c2 es2
-
---------------------------------------------------------------------------------
--- BRANCH & BOUND
---------------------------------------------------------------------------------
-
-newtype CBranchBoundST (solver :: * -> *) a = CBBST (NewBound solver) 
-data    BBEvalState solver  = BBP Int (Bound solver)
-
-type Bound    solver  = forall a. Tree solver a -> Tree solver a
-type NewBound solver  = solver (Bound solver)
-
-instance Solver solver => CTransformer (CBranchBoundST solver a) where
-  type CEvalState (CBranchBoundST solver a) = BBEvalState solver
-  type CTreeState (CBranchBoundST solver a) = Int
-  type CForSolver (CBranchBoundST solver a) = solver
-  type CForResult (CBranchBoundST solver a) = a
-  initCT _  = (BBP 0 id,0)
-  nextCT tree c es@(BBP nv bound) v eval continue exit
-    | nv > v        = eval (bound tree) es nv
-    | otherwise     = eval tree         es v
-  returnCT (CBBST newBound) (BBP v bound) continue exit =
-    do bound' <- newBound
-       continue $ BBP (v + 1) bound' 
-
---------------------------------------------------------------------------------
--- RESTARTING
---------------------------------------------------------------------------------
-
-data SealedCST es ts solver a where
-  Seal :: CTransformer c => c -> SealedCST (CEvalState c) (CTreeState c) (CForSolver c) (CForResult c)
-
-instance Solver solver => CTransformer (SealedCST es ts solver a) where
-  type CEvalState (SealedCST es ts solver a) = es
-  type CTreeState (SealedCST es ts solver a) = ts
-  type CForSolver (SealedCST es ts solver a) = solver
-  type CForResult (SealedCST es ts solver a) = a
-  leftCT (Seal c) 	= leftCT c
-  rightCT (Seal c)	= rightCT c
-  initCT (Seal c)       = initCT c
-  nextCT tree (Seal c)  = nextCT tree c
-  returnCT (Seal c)     = returnCT c
-  completeCT (Seal c)   = completeCT c
-
-data RestartST es ts (solver :: * -> *) a = RestartST [SealedCST es ts solver a] (Tree solver a -> solver (Tree solver a))
-
-instance Solver solver => Transformer (RestartST es ts solver a) where
-  type EvalState (RestartST es ts solver a) = (SealedCST es ts solver a,[SealedCST es ts solver a],es,Label solver,Tree solver a)
-  type TreeState (RestartST es ts solver a) = ts
-  type ForSolver (RestartST es ts solver a) = solver
-  type ForResult (RestartST es ts solver a) = a
-  initT  (RestartST (c:cs) _) tree  = 
- 	let (es,ts) = initCT c
-        in do l <-  markSM
-	      return ((c,cs,es,l,tree),ts)
-  leftT  _ (c,_,_,_,_)      = leftCT c
-  rightT _ (c,_,_,_,_)      = rightCT c
-  nextT i tree q t es@(c,cs,es_c,l,tree0) ts = 
-        nextCT tree c es_c ts (\tree' es_c' ts' -> eval' i tree' q t (c,cs,es_c',l,tree0) ts') 
-                              (\es_c'       -> continue i q t (c,cs,es_c',l,tree0))
-			      (\es_c' -> endT i q t (c,cs,es_c',l,tree0))
-  returnT i wl t es@(c,cs,es_c,l,tree0)  = returnCT c es_c (\es_c' -> continue i wl t (c,cs,es_c',l,tree0)) (\es_c' -> endT i wl t (c,cs,es_c',l,tree0))
-  endT i wl t es@(_,[],_,_,_)      = return (i,[])
-  endT i wl t@(RestartST _ f) es@(c0,(c:cs),es_c0,l,tree0)   
-    | completeCT c0 es_c0  = return (i,[])
-    | otherwise            = let (es,ts) = initCT c
-                             in  do tree' <- f tree0
-                                    continue i (pushQ (l,tree',ts) $ emptyQ wl) t (c,cs,es,l,tree0)
- 
diff --git a/Language/CP/Domain.hs b/Language/CP/Domain.hs
deleted file mode 100644
--- a/Language/CP/Domain.hs
+++ /dev/null
@@ -1,167 +0,0 @@
-{- 
- - Origin:
- - 	Constraint Programming in Haskell 
- - 	http://overtond.blogspot.com/2008/07/pre.html
- - 	author: David Overton, Melbourne Australia
- -
- - Modifications:
- - 	Monadic Constraint Programming
- - 	http://www.cs.kuleuven.be/~toms/Haskell/
- - 	Tom Schrijvers
- -} 
-
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE OverlappingInstances #-}
-{-# LANGUAGE IncoherentInstances #-}
-{-# LANGUAGE UndecidableInstances #-}
-module Language.CP.Domain (
-    Domain,
-    ToDomain,
-    toDomain,
-    member,
-    isSubsetOf,
-    elems,
-    intersection,
-    difference,
-    union,
-    empty,
-    null,
-    singleton,
-    isSingleton,
-    filterLessThan,
-    filterGreaterThan,
-    findMax,
-    findMin,
-    size,
-    shiftDomain
-) where
-
-import qualified Data.IntSet as IntSet
-import Data.IntSet (IntSet)
-import Prelude hiding (null)
-
-data Domain
-    = Set IntSet
-    | Range Int Int
-    deriving Show
-
-size :: Domain -> Int
-size (Range l u) = u - l + 1
-size (Set set)   = IntSet.size set
-
--- Domain constructors
-class ToDomain a where
-    toDomain :: a -> Domain
-
-instance ToDomain Domain where
-    toDomain = id
-
-instance ToDomain IntSet where
-    toDomain = Set
-
-instance Integral a => ToDomain [a] where
-    toDomain = toDomain . IntSet.fromList . map fromIntegral
-
-instance (Integral a, Integral b) => ToDomain (a, b) where
-    toDomain (a, b) = Range (fromIntegral a) (fromIntegral b)
-
-instance ToDomain () where
-    toDomain () = Range minBound maxBound
-
-instance Integral a => ToDomain a where
-    toDomain a = toDomain (a, a)
-
--- Operations on Domains
-instance Eq Domain where
-    (Range xl xh) == (Range yl yh) = xl == yl && xh == yh
-    xs == ys = elems xs == elems ys
-
-member :: Int -> Domain -> Bool
-member n (Set xs) = n `IntSet.member` xs
-member n (Range xl xh) = n >= xl && n <= xh
-
-isSubsetOf :: Domain -> Domain -> Bool
-isSubsetOf (Set xs) (Set ys) = xs `IntSet.isSubsetOf` ys
-isSubsetOf (Range xl xh) (Range yl yh) = xl >= yl && xh <= yh
-isSubsetOf (Set xs) yd@(Range yl yh) =
-    isSubsetOf (Range xl xh) yd where
-        xl = IntSet.findMin xs
-        xh = IntSet.findMax xs
-isSubsetOf (Range xl xh) (Set ys) =
-    all (`IntSet.member` ys) [xl..xh]
-
-elems :: Domain -> [Int]
-elems (Set xs) = IntSet.elems xs
-elems (Range xl xh) = [xl..xh]
-
-intersection :: Domain -> Domain -> Domain
-intersection (Set xs) (Set ys) = Set (xs `IntSet.intersection` ys)
-intersection (Range xl xh) (Range yl yh) = Range (max xl yl) (min xh yh)
-intersection (Set xs) (Range yl yh) =
-    Set $ IntSet.filter (\x -> x >= yl && x <= yh) xs
-intersection x y = intersection y x
-
-union :: Domain -> Domain -> Domain
-union (Set xs) (Set ys) = Set (xs `IntSet.union` ys)
-union (Range xl xh) (Range yl yh) 
-      | xh + 1 >= yl || yh+1 >= xl = Range (min xl yl) (max xh yh)
-      | otherwise = union (Set $ IntSet.fromList [xl..xh]) 
-                          (Set $ IntSet.fromList [yl..yh]) 
-union x@(Set xs) y@(Range yl yh) =
-      if null x then y 
-      else
-      let xmin = IntSet.findMin xs
-          xmax = IntSet.findMax xs
-      in 
-      if (xmin + 1 >= yl && xmax - 1 <= yh) 
-         then Range (min xmin yl) (max xmax yh)
-         else union (Set xs) (Set $ IntSet.fromList [yl..yh])
-union x y = union y x
-
-difference :: Domain -> Domain -> Domain
-difference (Set xs) (Set ys) = Set (xs `IntSet.difference` ys)
-difference xd@(Range xl xh) (Range yl yh)
-    | yl > xh || yh < xl = xd
-    | otherwise = Set $ IntSet.fromList [x | x <- [xl..xh], x < yl || x > yh]
-difference (Set xs) (Range yl yh) =
-    Set $ IntSet.filter (\x -> x < yl || x > yh) xs
-difference (Range xl xh) (Set ys)
-    | IntSet.findMin ys > xh || IntSet.findMax ys < xl = Range xl xh
-    | otherwise = Set $
-        IntSet.fromList [x | x <- [xl..xh], not (x `IntSet.member` ys)]
-
-null :: Domain -> Bool
-null (Set xs) = IntSet.null xs
-null (Range xl xh) = xl > xh
-
-singleton :: Int -> Domain
-singleton x = Set (IntSet.singleton x)
-
-isSingleton :: Domain -> Bool
-isSingleton (Set xs) = case IntSet.elems xs of
-    [x] -> True
-    _   -> False
-isSingleton (Range xl xh) = xl == xh
-
-filterLessThan :: Int -> Domain -> Domain
-filterLessThan n (Set xs) = Set $ IntSet.filter (< n) xs
-filterLessThan n (Range xl xh) = Range xl (min (n-1) xh)
-
-filterGreaterThan :: Int -> Domain -> Domain
-filterGreaterThan n (Set xs) = Set $ IntSet.filter (> n) xs
-filterGreaterThan n (Range xl xh) = Range (max (n+1) xl) xh
-
-findMax :: Domain -> Int
-findMax (Set xs) = IntSet.findMax xs
-findMax (Range xl xh) = xh
-
-findMin :: Domain -> Int
-findMin (Set xs) = IntSet.findMin xs
-findMin (Range xl xh) = xl
-
-empty :: Domain
-empty = Range 1 0
-
-shiftDomain :: Domain -> Int -> Domain
-shiftDomain (Range l u) d = Range (l + d) (u + d)
-shiftDomain (Set xs) d = Set $ IntSet.fromList $ map (+d) (IntSet.elems xs)
diff --git a/Language/CP/FD.hs b/Language/CP/FD.hs
deleted file mode 100644
--- a/Language/CP/FD.hs
+++ /dev/null
@@ -1,412 +0,0 @@
-{- 
- - Origin:
- - 	Constraint Programming in Haskell 
- - 	http://overtond.blogspot.com/2008/07/pre.html
- - 	author: David Overton, Melbourne Australia
- -
- - Modifications:
- - 	Monadic Constraint Programming
- - 	http://www.cs.kuleuven.be/~toms/Haskell/
- - 	Tom Schrijvers
- -} 
-
-{-# OPTIONS_GHC -fglasgow-exts #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE OverlappingInstances #-}
-module Language.CP.FD where 
-
-import Prelude hiding (lookup)
-import Maybe (fromJust,isJust)
-import Control.Monad.State.Lazy
-import Control.Monad.Trans
-import qualified Data.Map as Map
-import Data.Map ((!), Map)
-import Control.Monad (liftM,(<=<))
-
-import Language.CP.Domain as Domain
-
-import Language.CP.Solver
-
--- import Debug.Trace
-trace = flip const
---------------------------------------------------------------------------------
--- Solver instance -------------------------------------------------------------
---------------------------------------------------------------------------------
-
-instance Solver FD where
-  type Constraint FD  = FD_Constraint
-  type Term       FD  = FD_Term
-  type Label      FD  = FDState
-
-  newvarSM 	= newVar () >>= return . FD_Var 
-  addSM    	= addFD
-  storeSM  	= undefined
-  runSM p   	= runFD p
-
-  markSM	= get
-  gotoSM	= put 
-
-data FD_Term where
-  FD_Var :: FDVar -> FD_Term
-  deriving Show
-
-un_fd (FD_Var v) = v
-
-data FD_Constraint where
-  FD_Diff :: FD_Term -> FD_Term -> FD_Constraint
-  FD_Same :: FD_Term -> FD_Term -> FD_Constraint
-  FD_Less :: FD_Term  -> FD_Term -> FD_Constraint
-  FD_LT   :: FD_Term -> Int -> FD_Constraint
-  FD_GT   :: FD_Term -> Int -> FD_Constraint
-  FD_HasValue :: FD_Term -> Int -> FD_Constraint
-  FD_Eq   :: (ToExpr a, ToExpr b) => a -> b -> FD_Constraint
-  FD_NEq   :: (ToExpr a, ToExpr b) => a -> b -> FD_Constraint
-  FD_AllDiff :: [FD_Term] -> FD_Constraint
-  FD_Dom     :: FD_Term -> (Int,Int) -> FD_Constraint
-
-addFD (FD_Diff (FD_Var v1) (FD_Var v2)) = different v1 v2
-addFD (FD_Same (FD_Var v1) (FD_Var v2)) = same      v1 v2
-addFD (FD_Less (FD_Var v1) (FD_Var v2)) = v1 .<. v2     
-addFD (FD_HasValue (FD_Var v1) i)       = hasValue v1  i
-addFD (FD_Eq e1 e2)                     = e1 .==. e2
-addFD (FD_NEq e1 e2)                    = e1 ./=. e2 
--- addFD (FD_AllDiff vs)                   = allDifferent (map un_fd vs)
-addFD (FD_Dom v (l,u))                  = v `in_range` (l-1,u+1)
-addFD (FD_LT (FD_Var v) i)              = do iv <- exprVar $ toExpr i
-                                             v .<. iv
-addFD (FD_GT (FD_Var v) i)              = do iv <- exprVar $ toExpr i
-                                             iv .<. v
-
-
-(#<) :: (To_FD_Term a, To_FD_Term b) => a -> b -> FD Bool
-x #< y =
-  do xt <- to_fd_term x
-     yt <- to_fd_term y
-     addFD (FD_Less xt yt)
-
-in_range :: FD_Term -> (Int,Int) -> FD Bool
-in_range x (l,u) =
-  do l #< x
-     x #< u
-
-all_different = addFD . FD_AllDiff
-
-instance ToExpr FD_Term where
-  toExpr (FD_Var v) = toExpr v
-
-fd_domain :: FD_Term -> FD [Int]
-fd_domain (FD_Var v)  = do d <- lookup v
-                           return $ elems d
-
-fd_objective :: FD FD_Term
-fd_objective =
-  do s <- get
-     return $ FD_Var $ objective s
-
-class To_FD_Term a where
-  to_fd_term :: a -> FD FD_Term
-
-instance To_FD_Term FD_Term where
-  to_fd_term = return . id
-
-instance To_FD_Term Int where
-  to_fd_term i =  newVar i >>= return . FD_Var
-
-instance To_FD_Term Expr  where
-  to_fd_term e = unExpr e >>= return . FD_Var
-
---------------------------------------------------------------------------------
-
--- The FD monad
-newtype FD a = FD { unFD :: StateT FDState Maybe a }
-    deriving (Monad, MonadState FDState, MonadPlus)
-
--- FD variables
-newtype FDVar = FDVar { unFDVar :: Int } deriving (Ord, Eq, Show)
-
-type VarSupply = FDVar
-
-data VarInfo = VarInfo
-     { delayedConstraints :: FD Bool, domain :: Domain }
-
-instance Show VarInfo where
-  show x = show $ domain x
-
-type VarMap = Map FDVar VarInfo
-
-data FDState = FDState
-     { varSupply :: VarSupply, varMap :: VarMap, objective :: FDVar }
-     deriving Show
-
-instance Eq FDState where
-  s1 == s2 = f s1 == f s2
-           where f s = head $ elems $ domain $ varMap s ! (objective s) 
-
-instance Ord FDState where
-  compare s1 s2  = compare (f s1) (f s2)
-           where f s = head $ elems $  domain $ varMap s ! (objective s) 
-
-  -- TOM: inconsistency is not observable within the FD monad
-consistentFD :: FD Bool
-consistentFD = return True
-
--- Run the FD monad and produce a lazy list of possible solutions.
-runFD :: FD a -> a
-runFD fd = fromJust $ evalStateT (unFD fd') initState
-           where fd' = fd -- fd' = newVar () >> fd
-
-initState :: FDState
-initState = FDState { varSupply = FDVar 0, varMap = Map.empty, objective = FDVar 0 }
-
--- Get a new FDVar
-newVar :: ToDomain a => a -> FD FDVar
-newVar d = do
-    s <- get
-    let v = varSupply s
-    put $ s { varSupply = FDVar (unFDVar v + 1) }
-    modify $ \s ->
-        let vm = varMap s
-            vi = VarInfo {
-                delayedConstraints = return True,
-                domain = toDomain d}
-        in
-        s { varMap = Map.insert v vi vm }
-    return v
-
-newVars :: ToDomain a => Int -> a -> FD [FDVar]
-newVars n d = replicateM n (newVar d)
-
--- Lookup the current domain of a variable.
-lookup :: FDVar -> FD Domain
-lookup x = do
-    s <- get
-    return . domain $ varMap s ! x
-
--- Update the domain of a variable and fire all delayed constraints
--- associated with that variable.
-update :: FDVar -> Domain -> FD Bool
-update x i = do
-    trace (show x ++ " <- " ++ show i)  (return ())
-    s <- get
-    let vm = varMap s
-    let vi = vm ! x
-    trace ("where old domain = " ++ show (domain vi)) (return ())
-    put $ s { varMap = Map.insert x (vi { domain = i}) vm }
-    delayedConstraints vi
-
--- Add a new constraint for a variable to the constraint store.
-addConstraint :: FDVar -> FD Bool -> FD ()
-addConstraint x constraint = do
-    s <- get
-    let vm = varMap s
-    let vi = vm ! x
-    let cs = delayedConstraints vi
-    put $ s { varMap =
-        Map.insert x (vi { delayedConstraints = do b <- cs 
-                                                   if b then constraint
-                                                        else return False}) vm }
- 
--- Useful helper function for adding binary constraints between FDVars.
-type BinaryConstraint = FDVar -> FDVar -> FD Bool
-addBinaryConstraint :: BinaryConstraint -> BinaryConstraint 
-addBinaryConstraint f x y = do
-    let constraint  = f x y
-    b <- constraint 
-    when b $ (do addConstraint x constraint
-                 addConstraint y constraint)
-    return b
-
--- Constrain a variable to a particular value.
-hasValue :: FDVar -> Int -> FD Bool
-var `hasValue` val = do
-    vals <- lookup var
-    if val `member` vals
-       then do let i = singleton val
-               if (i /= vals) 
-                  then update var i
-                  else return True
-       else return False
-
--- Constrain two variables to have the same value.
-same :: FDVar -> FDVar -> FD Bool
-same = addBinaryConstraint $ \x y -> do
-    xv <- lookup x
-    yv <- lookup y
-    let i = xv `intersection` yv
-    if not $ Domain.null i
-       then whenwhen (i /= xv)  (i /= yv) (update x i) (update y i)
-       else return False
-
-whenwhen c1 c2 a1 a2  =
-  if c1
-     then do b1 <- a1
-             if b1 
-                then if c2
-                        then a2
-                        else return True
-                else return False 
-     else if c2
-             then a2
-             else return True
-
--- Constrain two variables to have different values.
-different :: FDVar  -> FDVar  -> FD Bool
-different = addBinaryConstraint $ \x y -> do
-    xv <- lookup x
-    yv <- lookup y
-    if not (isSingleton xv) || not (isSingleton yv) || xv /= yv
-       then whenwhen (isSingleton xv && xv `isSubsetOf` yv)
-                     (isSingleton yv && yv `isSubsetOf` xv)
-                     (update y (yv `difference` xv))
-                     (update x (xv `difference` yv))
-       else return False
-
--- Constrain a list of variables to all have different values.
-allDifferent :: [FDVar ] -> FD  ()
-allDifferent (x:xs) = do
-    mapM_ (different x) xs
-    allDifferent xs
-allDifferent _ = return ()
-
--- Constrain one variable to have a value less than the value of another
--- variable.
-infix 4 .<.
-(.<.) :: FDVar -> FDVar -> FD Bool
-(.<.) = addBinaryConstraint $ \x y -> do
-    xv <- lookup x
-    yv <- lookup y
-    let xv' = filterLessThan (findMax yv) xv
-    let yv' = filterGreaterThan (findMin xv) yv
-    if  not $ Domain.null xv'
-        then if not $ Domain.null yv'
-                then whenwhen (xv /= xv') (yv /= yv') (update x xv') (update y yv')
-	        else return False
-        else return False
-
-{-
--- Get all solutions for a constraint without actually updating the
--- constraint store.
-solutions :: FD s a -> FD s [a]
-solutions constraint = do
-    s <- get
-    return $ evalStateT (unFD constraint) s
-
--- Label variables using a depth-first left-to-right search.
-labelling :: [FDVar s] -> FD s [Int]
-labelling = mapM label where
-    label var = do
-        vals <- lookup var
-        val <- FD . lift $ elems vals
-        var `hasValue` val
-        return val
--}
-
-dump :: [FDVar] -> FD [Domain]
-dump = mapM lookup
-
-newtype Expr = Expr { unExpr :: FD (FDVar) }
-
-class ToExpr a where
-    toExpr :: a -> Expr
-
-instance ToExpr FDVar where
-    toExpr = Expr . return
-
-instance ToExpr Expr where
-    toExpr = id
-
-instance Integral i => ToExpr i where
-    toExpr n = Expr $ newVar n
-
-exprVar :: ToExpr a => a -> FD FDVar
-exprVar = unExpr . toExpr
-
--- Add constraint (z = x `op` y) for new var z
-addArithmeticConstraint :: (ToExpr a, ToExpr b) =>
-    (Domain -> Domain -> Domain) ->
-    (Domain -> Domain -> Domain) ->
-    (Domain -> Domain -> Domain) ->
-    a -> b -> Expr
-addArithmeticConstraint getZDomain getXDomain getYDomain xexpr yexpr = Expr $ do
-    x <- exprVar xexpr
-    y <- exprVar yexpr
-    xv <- lookup x
-    yv <- lookup y
-    z <- newVar (getZDomain xv yv)
-    let constraint z x y getDomain = do
-        xv <- lookup x
-        yv <- lookup y
-        zv <- lookup z
-        let znew = zv `intersection` (getDomain xv yv)
-	trace (show z ++ " before: "  ++ show zv ++ show "; after: " ++ show znew) (return ())
-        if not $ Domain.null znew
-           then if (znew /= zv) 
-                   then update z znew
-                   else return True
-           else return False
-    let zConstraint = constraint z x y getZDomain
-        xConstraint = constraint x z y getXDomain
-        yConstraint = constraint y z x getYDomain
-    addConstraint z xConstraint
-    addConstraint z yConstraint
-    addConstraint x zConstraint
-    addConstraint x yConstraint
-    addConstraint y zConstraint
-    addConstraint y xConstraint
-    return z
-
-infixl 6 .+.
-(.+.) :: (ToExpr a, ToExpr b) => a -> b -> Expr
-(.+.) = addArithmeticConstraint getDomainPlus getDomainMinus getDomainMinus
-
-infixl 6 .-.
-(.-.) :: (ToExpr a, ToExpr b) => a -> b -> Expr
-(.-.) = addArithmeticConstraint getDomainMinus getDomainPlus
-    (flip getDomainMinus)
-
-infixl 7 .*.
-(.*.) :: (ToExpr a, ToExpr b) => a -> b -> Expr
-(.*.) = addArithmeticConstraint getDomainMult getDomainDiv getDomainDiv
-
-getDomainPlus :: Domain -> Domain -> Domain
-getDomainPlus xs ys = toDomain (zl, zh) where
-    zl = findMin xs + findMin ys
-    zh = findMax xs + findMax ys
-
-getDomainMinus :: Domain -> Domain -> Domain
-getDomainMinus xs ys = toDomain (zl, zh) where
-    zl = findMin xs - findMax ys
-    zh = findMax xs - findMin ys
-
-getDomainMult :: Domain -> Domain -> Domain
-getDomainMult xs ys = toDomain (zl, zh) where
-    zl = minimum products
-    zh = maximum products
-    products = [x * y |
-        x <- [findMin xs, findMax xs],
-        y <- [findMin ys, findMax ys]]
-
-getDomainDiv :: Domain -> Domain -> Domain
-getDomainDiv xs ys = toDomain (zl, zh) where
-    zl = minimum quotientsl
-    zh = maximum quotientsh
-    quotientsl = [if y /= 0 then x `div` y else minBound |
-        x <- [findMin xs, findMax xs],
-        y <- [findMin ys, findMax ys]]
-    quotientsh = [if y /= 0 then x `div` y else maxBound |
-        x <- [findMin xs, findMax xs],
-        y <- [findMin ys, findMax ys]]
-
-infix 4 .==.
-(.==.) :: (ToExpr a, ToExpr b) => a -> b -> FD Bool
-xexpr .==. yexpr = do
-    x <- exprVar xexpr
-    y <- exprVar yexpr
-    x `same` y
-
-infix 4 ./=.
-(./=.) :: (ToExpr a, ToExpr b) => a -> b -> FD Bool
-xexpr ./=. yexpr = do
-    x <- exprVar xexpr
-    y <- exprVar yexpr
-    x `different` y
diff --git a/Language/CP/FDSugar.hs b/Language/CP/FDSugar.hs
deleted file mode 100644
--- a/Language/CP/FDSugar.hs
+++ /dev/null
@@ -1,129 +0,0 @@
-{- 
- - 	Monadic Constraint Programming
- - 	http://www.cs.kuleuven.be/~toms/Haskell/
- - 	Tom Schrijvers
- -}
-{-# LANGUAGE TransformListComp #-}
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE TypeFamilies #-}
-
-module Language.CP.FDSugar where 
-
-import Language.CP.SearchTree hiding (label)
-import Language.CP.Transformers
-import Language.CP.ComposableTransformers
-import Language.CP.Queue
-import Language.CP.Solver
-
-import GHC.Exts (sortWith)
-import qualified Language.CP.PriorityQueue as PriorityQueue
-import qualified Data.Sequence
-import Language.CP.FD
-
-dfs = []
-bfs = Data.Sequence.empty
-pfs :: Ord a => PriorityQueue.PriorityQueue a (a,b,c)
-pfs = PriorityQueue.empty
-
-nb :: Int -> CNodeBoundedST FD a
-nb = CNBST
-db :: Int -> CDepthBoundedST FD a
-db = CDBST
-bb :: NewBound FD -> CBranchBoundST FD a
-bb = CBBST
-fs :: CFirstSolutionST FD a
-fs = CFSST
-it :: CIdentityCST FD a
-it = CIST
-ra :: Int -> CRandomST FD a
-ra = CRST
-ld :: Int -> CLimitedDiscrepancyST FD a
-ld = CLDST
-
-newBound :: NewBound FD
-newBound = do obj <- fd_objective
-              (val:_) <- fd_domain obj 
-	      l <- markSM
-              return ((\tree -> tree `insertTree` (obj @< val)) :: forall b . Tree FD b -> Tree FD b)
-
-newBoundBis :: NewBound FD 
-newBoundBis = do obj <- fd_objective
-                 (val:_) <- fd_domain obj 
-                 let m = val `div` 2
-                 return ((\tree -> (obj @< (m + 1) \/ ( obj @> m /\ obj @< val)) /\ tree) :: forall b . Tree FD b -> Tree FD b)
-
-restart :: (Queue q, Solver solver, CTransformer c, CForSolver c ~ solver,
-          Elem q ~ (Label solver,Tree solver (CForResult c),CTreeState c)) 
-      => q -> [c] -> Tree solver (CForResult c) -> (Int,[CForResult c])
-restart q cs model = runSM $ eval model q (RestartST (map Seal cs) return)
-
-restartOpt :: (Queue q, CTransformer c, CForSolver c ~ FD,
-          Elem q ~ (Label FD,Tree FD (CForResult c),CTreeState c)) 
-      => q -> [c] -> Tree FD (CForResult c) -> (Int,[CForResult c])
-restartOpt q cs model = runSM $ eval model q (RestartST (map Seal cs) opt)
-	where opt tree = newBound >>= \f -> return (f tree)
-
---------------------------------------------------------------------------------
--- ENUMERATION
---------------------------------------------------------------------------------
-
-enumerate = Label . (label in_order) 
--- enumerate = Label . (label firstfail) 
-
-label sel qs  = do qs' <- sel qs 
-                   label' qs' 
-  where label' []      = return true
-        label' (q:qs)  = do d <- fd_domain q 
---                            return $ enum q (middleout d) /\ enumerate qs
-                            return $ enum q d /\ enumerate qs
-
-in_order :: Monad m => a -> m a
-in_order = return 
-
-firstfail qs = do ds <- mapM fd_domain qs 
-                  return [ q | (d,q) <- zip ds qs 
-                             , then sortWith by (length d) ] 
-enum queen values = 
-  disj [ queen @= value 
-       | value <- values 
-       ] 
-
-value var = do [val] <- fd_domain var
-               return val
-
-middleout l = let n = (length l) `div` 2 in
-              interleave (drop n l) (reverse $ take n l)
-
-endsout  l = let n = (length l) `div` 2 in
-              interleave (reverse $ drop n l) (take n l)
-
-interleave []     ys = ys
-interleave (x:xs) ys = x:interleave ys xs
---------------------------------------------------------------------------------
--- RESULT
---------------------------------------------------------------------------------
-
-assignments = mapM assignment 
-assignment q = Label $ value q >>= (return . Return)
---------------------------------------------------------------------------------
--- SYNTACTIC SUGAR
---------------------------------------------------------------------------------
-
-in_domain v (l,u)  = Add (FD_Dom v (l,u)) true
-(@\=) :: FD_Term -> FD_Term -> Tree FD ()
-v1 @\= v2  = Add (FD_NEq v1 v2) true
-
-(@=) :: FD_Term -> Int -> Tree FD ()
-v1 @= v2  = Add (FD_Eq v1 v2) true
-
-data Plus  = FD_Term :+ Int 
-(@+) = (:+)
-
-(@\==) :: FD_Term -> Plus -> Tree FD ()
-v1 @\== (v2 :+ i)  = Add (FD_NEq v1 (v2 .+. i))  true
-
-(@<) :: FD_Term -> Int -> Tree FD ()
-v @< i  = Add (FD_LT v i) true
-
-(@>) :: FD_Term -> Int -> Tree FD ()
-v @> i  = Add (FD_GT v i) true
diff --git a/Language/CP/Main.hs b/Language/CP/Main.hs
deleted file mode 100644
--- a/Language/CP/Main.hs
+++ /dev/null
@@ -1,90 +0,0 @@
-{- 
- - 	Monadic Constraint Programming
- - 	http://www.cs.kuleuven.be/~toms/Haskell/
- - 	Tom Schrijvers
- -}
-module Language.CP.Main where
-
-import Language.CP.ComposableTransformers
-import Language.CP.FD
-import Language.CP.FDSugar
-import List (tails)
-import Language.CP.SearchTree hiding (label)
-import System (getArgs)
-
---------------------------------------------------------------------------------
--- MAIN FUNCTIONS
---------------------------------------------------------------------------------
-
-main = main1
-
-
-main1 = getArgs >>= print . solve dfs it . nqueens . read . head
-main2 = getArgs >>= print . solve dfs (nb 100 :- db  25 :- bb newBound)  . nqueens . read . head
-
-main3 = getArgs >>= print . solve dfs (db 9) . nqueens . read . head
-
-main4 = do (n1:_) <- getArgs 
-           let n = read n1
-           loop 1 n
-  where loop i n
-          | i > n     = return ()
-          | otherwise =
-              do -- print . (\(i,l) -> (i,not $ Prelude.null l)) . solve dfs (it :- fs :- ra 13 :- ld l) . nqueens $ i
-                 print . (\(i,l) -> (i, {- not $ Prelude.null-}  l)) . restart dfs (map db [3..10]) . nqueens $ i
-                 -- print . (\(i,l) -> (i, {- not $ Prelude.null-}  l)) . restartOpt dfs (replicate 10 fs) . nqueens $ i
-                 loop (i+1) n
-
-main5 = getArgs >>= loop 1 . read . head
-  where loop i n
-          | i > n     = return ()
-          | otherwise =
-              do print . (\(i,l) -> (i,minimum l)) . solve dfs (ld 5 :- bb newBoundBis) . gmodel $ i
-                 loop (i+1) n
-
---------------------------------------------------------------------------------
--- PATH MODEL
---------------------------------------------------------------------------------
-
-gmodel n = NewVar $ \_ -> path 1 n 0
-
-path :: Int -> Int -> Int -> Tree FD Int
-path x y d = if x == y 
-               then Return d
-               else disj [ Label (fd_objective >>= \o -> return (o @> (d+d' - 1) /\ (path z y (d+d')))) 
-                         | (z,d') <- edge x
-                         ]
-
-edge i | i < 20     = [ (i+1,4), (i+2,1) ]
-       | otherwise  = []
-
---------------------------------------------------------------------------------
--- N QUEENS MODEL
---------------------------------------------------------------------------------
-
-nqueens n = 
-  exist n $ \queens -> queens `allin` (1,n) /\ 
-                       alldifferent queens  /\ 
-                       diagonals queens     /\
-                       -- enumerate ({- middleout -} endsout queens) /\
-                       -- enumerate (middleout queens) /\
-                       enumerate (queens) /\
-		       assignments queens
-
-allin queens range  =  
-  conj [q `in_domain` range 
-       | q <- queens 
-       ] 
-
-alldifferent :: [ FD_Term ] -> Tree FD ()
-alldifferent queens =
-  conj [ qi @\= qj 
-       | qi:qjs <- tails queens 
-       , qj <- qjs 
-       ]
- 
-diagonals queens = 
-  conj [ qi @\== (qj @+ d) /\ qj @\== (qi @+ d) 
-       | qi:qjs <- tails queens 
-       , (qj,d) <- zip qjs [1..] 
-       ]
diff --git a/Language/CP/PriorityQueue.hs b/Language/CP/PriorityQueue.hs
deleted file mode 100644
--- a/Language/CP/PriorityQueue.hs
+++ /dev/null
@@ -1,110 +0,0 @@
-{- Copyright (c) 2008 the authors listed at the following URL, and/or
-the authors of referenced articles or incorporated external code:
-http://en.literateprograms.org/Priority_Queue_(Haskell)?action=history&offset=20080608152146
-
-Permission is hereby granted, free of charge, to any person obtaining
-a copy of this software and associated documentation files (the
-"Software"), to deal in the Software without restriction, including
-without limitation the rights to use, copy, modify, merge, publish,
-distribute, sublicense, and/or sell copies of the Software, and to
-permit persons to whom the Software is furnished to do so, subject to
-the following conditions:
-
-The above copyright notice and this permission notice shall be
-included in all copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
-IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
-CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
-TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
-SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-
-Retrieved from: http://en.literateprograms.org/Priority_Queue_(Haskell)?oldid=13634
--}
-
-module Language.CP.PriorityQueue (
-    PriorityQueue,
-    empty,
-    is_empty,
-    minKey,
-    minKeyValue,
-    insert,
-    deleteMin,
-    deleteMinAndInsert
-) where
-
- 
-import Prelude
-
-
--- Declare the data type constructors.
-
-data Ord k => PriorityQueue k a = Nil | Branch k a (PriorityQueue k a) (PriorityQueue k a)
- 
-
--- Declare the exported interface functions.
-
--- Return an empty priority queue.
-
-is_empty Nil = True
-is_empty _   = False
-
-empty :: Ord k => PriorityQueue k a
-empty = Nil
-
-
--- Return the highest-priority key.
-
-minKey :: Ord k => PriorityQueue k a -> k
-minKey = fst . minKeyValue
-
-
--- Return the highest-priority key plus its associated value.
-
-minKeyValue :: Ord k => PriorityQueue k a -> (k, a)
-minKeyValue Nil              = error "empty queue"
-minKeyValue (Branch k a _ _) = (k, a)
-
-
--- Insert a key/value pair into a queue.
-
-insert :: Ord k => k -> a -> PriorityQueue k a -> PriorityQueue k a
-insert k a q = union (singleton k a) q
-
-deleteMin :: Ord k => PriorityQueue k a -> ((k,a), PriorityQueue k a)
-deleteMin(Branch k a l r) = ((k,a),union l r)
-
--- Delete the highest-priority key/value pair and insert a new key/value pair into the queue.
-
-deleteMinAndInsert :: Ord k => k -> a -> PriorityQueue k a -> PriorityQueue k a
-deleteMinAndInsert k a Nil              = singleton k a
-deleteMinAndInsert k a (Branch _ _ l r) = union (insert k a l) r
-
-
-
--- Declare the private helper functions.
-
--- Join two queues in sorted order.
-
-union :: Ord k => PriorityQueue k a -> PriorityQueue k a -> PriorityQueue k a
-union l Nil = l
-union Nil r = r
-union l@(Branch kl _ _ _) r@(Branch kr _ _ _)
-    | kl <= kr  = link l r
-    | otherwise = link r l
-
-
--- Join two queues without regard to order.
-
--- (This is a helper to the union helper.)
-
-link (Branch k a Nil m) r = Branch k a r m
-link (Branch k a ll lr) r = Branch k a lr (union ll r)
-
-
--- Return a queue with a single item from a key/value pair.
-
-singleton :: Ord k => k -> a -> PriorityQueue k a
-singleton k a = Branch k a Nil Nil
diff --git a/Language/CP/Queue.hs b/Language/CP/Queue.hs
deleted file mode 100644
--- a/Language/CP/Queue.hs
+++ /dev/null
@@ -1,44 +0,0 @@
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-
- - The Queue data type, a worklist data type for search.
- -
- - 	Monadic Constraint Programming
- - 	http://www.cs.kuleuven.be/~toms/Haskell/
- - 	Tom Schrijvers
- -}
-
-module Language.CP.Queue where
-
-import qualified Data.Sequence
-import qualified Language.CP.PriorityQueue as PriorityQueue
-
-class Queue q where   
-  type Elem q :: *
-  emptyQ   :: q -> q
-  isEmptyQ :: q -> Bool
-  popQ     :: q -> (Elem q,q)
-  pushQ    :: Elem q -> q -> q
-
-instance Queue [a] where
-  type Elem [a] = a
-  emptyQ _     = []
-  isEmptyQ     = Prelude.null
-  popQ (x:xs)  = (x,xs)
-  pushQ        = (:)
-
-instance Queue (Data.Sequence.Seq a) where
-  type Elem (Data.Sequence.Seq a)  = a
-  emptyQ _                   = Data.Sequence.empty
-  isEmptyQ                   = Data.Sequence.null 
-  popQ (Data.Sequence.viewl -> x Data.Sequence.:< xs)  = (x,xs)
-  pushQ                      = flip (Data.Sequence.|>)
-
-instance Ord a => Queue (PriorityQueue.PriorityQueue a (a,b,c)) where
-  type Elem (PriorityQueue.PriorityQueue a (a,b,c)) = (a,b,c)
-  emptyQ _ = PriorityQueue.empty
-  isEmptyQ = PriorityQueue.is_empty 
-  pushQ x@(k,_,_)  = PriorityQueue.insert k x
-  popQ q   = let ((_,x),q') = PriorityQueue.deleteMin q
-             in (x,q')
diff --git a/Language/CP/SearchTree.hs b/Language/CP/SearchTree.hs
deleted file mode 100644
--- a/Language/CP/SearchTree.hs
+++ /dev/null
@@ -1,175 +0,0 @@
-{-# OPTIONS_GHC -fglasgow-exts #-}
-{-
- - The Tree data type, a generic modelling language for constraint solvers.
- -
- - 	Monadic Constraint Programming
- - 	http://www.cs.kuleuven.be/~toms/Haskell/
- - 	Tom Schrijvers
- -}
-
-module Language.CP.SearchTree  where
-
-import Monad
-import Language.CP.Solver
-
--------------------------------------------------------------------------------
------------------------------------ Tree --------------------------------------
--------------------------------------------------------------------------------
-
-data Tree s a
- 		= Fail                          -- failure
-                | Return a                      -- finished
-                | Try (Tree s a) (Tree s a)     -- disjunction
-                | Add (Constraint s) (Tree s a) -- sequentially adding a constraint to a tree
-                | NewVar (Term s -> Tree s a)   -- add a new variable to a tree
-	        | Label (s (Tree s a))      	-- label with a strategy
-
-instance Show (Tree s a)  where
-  show Fail 		= "Fail"
-  show (Return _) 	= "Return"
-  show (Try l r)        = "Try (" ++ show l ++ ") (" ++ show r ++ ")"
-  show (Add _ t)        = "Add (" ++ show t ++ ")"
-  show (NewVar _)       = "NewVar"
-  show (Label _)        = "Label"
-
-instance Solver s => Functor (Tree s) where
-	fmap  = liftM 
- 
-instance Solver s => Monad (Tree s) where
-  return = Return
-  (>>=)  = bindTree
-  
-
-bindTree     :: Solver s => Tree s a -> (a -> Tree s b) -> Tree s b
-Fail           `bindTree` k  = Fail
-(Return x)     `bindTree` k  = k x
-(Try m n)      `bindTree` k  = Try (m `bindTree` k) (n `bindTree` k)
-(Add c m)      `bindTree` k  = Add c (m `bindTree` k)
-(NewVar f)     `bindTree` k  = NewVar (\x -> f x `bindTree` k)    
-(Label m)      `bindTree` k  = Label (m >>= \t -> return (t `bindTree` k))
-
-insertTree     :: Solver s => Tree s a -> Tree s () -> Tree s a
-(NewVar f)     `insertTree` t  = NewVar (\x -> f x `insertTree` t)    
-(Add c  o)     `insertTree` t  = Add c (o `insertTree` t)
-other 	       `insertTree` t  = t /\ other
-
-
-{- Monad laws:
- -
- - 1. return x >>= f  ==  f x
- -
- -    return a >>= f  
- -    == Return a >>= f		(return def)
- -    == f x			(bind def) 
- -
- - 2. m >>= return  =  m
- -
- -   By induction
- -     case m of
- -     1) Return x -> 
- -          Return x >>= return
- -          == return x			(bind def)
- -          == Return x        		(return def)
- -     2) Fail ->
- -          Fail >>= return
- -          == Fail			(bind def)
- -     3)  Try l r >>= return
- -         == Try (l >>= return) (r >>= return) (bind def)
- -         == Try l r				(induction)
- -      4) Add c m >>= return
- -         == Add c (m >>= return) 	(bind def)
- -         == Add c m 			(induction) 
- - 	5) NewVar f >>= return
- - 	   == NewVar (\v -> f v >>= return) 	(bind def) 
- - 	   == NewVar (\v -> f v)		((co)-induction?)
- - 	   == NewVar f				(eta reduction)
- - 	6) Label sm >>= return
- - 	   == Label (sm >>= \m -> return (m >>= return))	(bind def)
- - 	   == Label (sm >>= \m -> return m)			(co-induction)
- - 	   == Label (sm >>= return)				(eta reduction)
- - 	   == Label sm						(2nd monad law for Monad s)
- -
- - 3. (m >>= f) >>= g = m >>= (\x -> f x >>= g)
- - 
- -   By induction
- -     case m of
- -     1) (Return y >>= f) >>= g 
- -	  == f y >>= g					(bind def)
- -	  == (\x -> f x >>= g) y			(beta expansion)
- -	  == Return y >>= (\x -> f x >>= g)		(bind def)
- -     2) (Fail >>= f) >>= g
- -        == Fail >>= g					(bind def)
- -        == Fail					(bind def)
- -        == Fail >>= (\x -> f x >>= g)			(bind def) 
- -     3) (Try l r >>= f) >>= g
- -        == Try (l >>= f) (r >>= f)) >>= g 				(bind def)
- -        == Try ((l >>= f) >>= g) ((r >>= f) >>= g)			(bind def)
- -        == Try (l >>= (\x -> f x >>= g)) (r >>= (\x -> f x >>= g)) 	(induction)
- -        == Try l r >>= (\x -> f x >>= g)				(bind def)
- -     4) (NewVar m >>= f) >>= g
- -        == NewVar (\v -> m v >>= f) >>= g			(bind def)
- -        == NewVar (\w -> (\v -> m v >>= f) w >>= g)		(bind def)
- -        == NewVar (\w -> (m w >>= f) >>= g)			(beta reduction)  
- -        == NewVar (\w -> m w >>= (\x -> f x >>= g))		(co-induction)
- -        == NewVar m >>= (\x -> f x >>= g)			(bind def)
- -     5) (Label sm >>= f) >>= g
- -         == Label (sm >>= \m -> return (m >>= f)) >>= g 	(bind def) 
- -         == Label ((sm >>= \m -> return (m >>= f)) >>= \m' -> return (m' >>= g))
- -         == Label (sm >>= (\m -> return (m >>= f) >>= \m' -> return (m' >>= g)))
- -         == Label (sm >>= \m -> return ((m >>= f) >>= g))
- -         == Label (sm >>= \m -> return (m >>= (\x -> f x >>= g)))
- -         == Label sm >>= (\x -> f x >>= g)
- -
- -}
-
--------------------------------------------------------------------------------
------------------------------------ Sugar -------------------------------------
--------------------------------------------------------------------------------
- 
-infixr 3 /\
-(/\) :: Solver s => Tree s a -> Tree s b -> Tree s b
-(/\) = (>>)
- 
-infixl 2 \/
-(\/) :: Solver s => Tree s a -> Tree s a -> Tree s a
-(\/) = Try
-
-false :: Tree s a
-false = Fail
- 
-true :: Tree s ()
-true = Return ()
-
-disj :: Solver s => [Tree s a] -> Tree s a
-disj = foldr (\/) false
-
-conj :: Solver s => [Tree s ()] -> Tree s ()
-conj = foldr (/\) true
-
-disj2 :: Solver s => [Tree s a] -> Tree s a
-disj2 (x:  [])  = x
-disj2 l        = let (xs,ys)      = split l
-                     split []     = ([],[])
-                     split (a:as) = let (bs,cs) = split as
-                                    in  (a:cs,bs)
-                 in  Try (disj2 xs) (disj2 ys)
- 
-exists :: (Term s -> Tree s a) -> Tree s a
-exists f = NewVar f
-
-exist :: Solver s => Int -> ([Term s] -> Tree s a) -> Tree s a
-exist n ftree = f n []
-         where f 0 acc  = ftree acc
-               f n acc  = exists $ \v -> f (n-1) (v:acc)
-
-forall :: Solver s => [Term s] -> (Term s -> Tree s ()) -> Tree s ()
-forall list ftree = conj $ map ftree list
- 
-label :: Solver s => s (Tree s a) -> Tree s a
-label = Label
-
-prim :: Solver s => (s a) -> Tree s a
-prim action = Label (action >>= return . return)
-
-add :: Solver s => Constraint s -> Tree s ()
-add c = Add c true
diff --git a/Language/CP/Solver.hs b/Language/CP/Solver.hs
deleted file mode 100644
--- a/Language/CP/Solver.hs
+++ /dev/null
@@ -1,30 +0,0 @@
-{-# OPTIONS_GHC -fglasgow-exts #-}
-{-
- - The Solver class, a generic interface for constraint solvers.
- -
- - 	Monadic Constraint Programming
- - 	http://www.cs.kuleuven.be/~toms/Haskell/
- - 	Tom Schrijvers
- -}
-module Language.CP.Solver where 
-
-class Monad solver => Solver solver where
-	-- the constraints
-	type Constraint solver 	:: *
-	-- the terms
-	type Term solver 	:: *
- 	-- the labels
-	type Label solver	:: *
-	-- produce a fresh constraint variable
-	newvarSM 	:: solver (Term solver)
-	-- add a constraint to the current state, and
-	-- return whethe the resulting state is consistent
-	addSM		:: Constraint solver -> solver Bool
-	-- reify the current state
-	storeSM		:: solver [Constraint solver]
-	-- run a computation
-	runSM		:: solver a -> a
-	-- mark the current state, and return its label
-	markSM		:: solver (Label solver)
-	-- go to the state with given label
-	gotoSM		:: Label solver -> solver ()
diff --git a/Language/CP/Transformers.hs b/Language/CP/Transformers.hs
deleted file mode 100644
--- a/Language/CP/Transformers.hs
+++ /dev/null
@@ -1,104 +0,0 @@
-{- 
- - 	Monadic Constraint Programming
- - 	http://www.cs.kuleuven.be/~toms/Haskell/
- - 	Tom Schrijvers
- -}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE Rank2Types #-}
-module Language.CP.Transformers where 
-
-import Language.CP.Solver
-import Language.CP.SearchTree
-import Language.CP.Queue
-
---------------------------------------------------------------------------------
--- EVALUATION
---------------------------------------------------------------------------------
-
-eval :: (Solver solver, Queue q, Elem q ~ (Label solver,Tree solver (ForResult t),TreeState t), Transformer t,
-         ForSolver t ~ solver) 
-     => Tree solver (ForResult t) -> q -> t -> solver (Int,[ForResult t])
-eval tree q t  = do (es,ts) <- initT t tree
-                    eval' 0 tree q t es ts
-
-eval' :: SearchSig solver q t (ForResult t) 
-eval' i (Return x) wl t es ts  = do (j,xs) <- returnT (i+1) wl t es
-                                    return (j,(x:xs)) 
-eval' i (Add c k)  wl t es ts = do b <- addSM c 
-                                   if b then eval' (i+1) k wl t es ts
-                                        else continue (i+1) wl t es
-eval' i (NewVar f) wl t es ts = do v <- newvarSM 
-                                   eval' (i+1) (f v) wl t es ts
-eval' i (Try l r)  wl t es ts  = 
-  do now <- markSM 
-     let wl' = pushQ (now,l,leftT t es ts) $ pushQ (now,r,rightT t es ts) wl
-     continue (i+1) wl' t es
-eval' i Fail       wl t es ts  = continue (i+1) wl t es
-eval' i (Label m)  wl t es ts  = do tree <- m
-                                    eval' (i+1) tree wl t es ts
- 
-continue :: ContinueSig solver q t (ForResult t) 
-continue i wl t es  
-	| isEmptyQ wl  = endT i wl t es -- return (i,[])
-        | otherwise    = let ((past,tree,ts),wl') = popQ wl
-                         in  do gotoSM past
-                                nextT i tree wl' t es ts 
-
---------------------------------------------------------------------------------
--- TRANSFORMER
---------------------------------------------------------------------------------
-
-type SearchSig solver q t a =
-     (Solver solver, Queue q, Transformer t,   
-          Elem q ~ (Label solver,Tree solver a,TreeState t),
-	  ForSolver t ~ solver) 
-     => Int -> Tree solver a -> q -> t -> EvalState t -> TreeState t -> solver (Int,[a])
-
-type ContinueSig solver q t a =
-     (Solver solver, Queue q, Transformer t,   
-          Elem q ~ (Label solver,Tree solver a,TreeState t),
-	  ForSolver t ~ solver) 
-     => Int -> q -> t -> EvalState t -> solver (Int,[a])
-
-class Transformer t where
-  type EvalState t :: *
-  type TreeState t :: *
-  type ForSolver t :: (* -> *)
-  type ForResult t :: *
-  leftT, rightT :: t -> EvalState t -> TreeState t -> TreeState t
-  leftT  _ _ = id
-  rightT    = leftT
-  nextT :: SearchSig (ForSolver t) q t (ForResult t)
-  nextT  = eval'
-  initT :: t -> Tree (ForSolver t) (ForResult t) -> (ForSolver t) (EvalState t,TreeState t)
-  returnT :: ContinueSig solver q t (ForResult t) 
-  returnT i wl t es  = continue i wl t es
-  endT  :: ContinueSig solver q t (ForResult t)
-  endT i wl t es     = return (i,[])
-
-newtype DepthBoundedST (solver :: * -> *) a = DBST Int
-
-instance Solver solver => Transformer (DepthBoundedST solver a) where
-  type EvalState (DepthBoundedST solver a)  = ()
-  type TreeState (DepthBoundedST solver a)  = Int
-  type ForSolver (DepthBoundedST solver a)  = solver
-  type ForResult (DepthBoundedST solver a)  = a
-  initT (DBST n) _  = return ((),n)
-  leftT _ _ ts      = ts - 1
-  nextT i tree q t es ts
-    | ts == 0    = continue i q t es
-    | otherwise  = eval' i tree q t es ts
-
-newtype NodeBoundedST (solver :: * -> *) a = NBST Int
-
-instance Solver solver => Transformer (NodeBoundedST solver a)  where
-  type EvalState (NodeBoundedST solver a) = Int
-  type TreeState (NodeBoundedST solver a) = ()
-  type ForSolver (NodeBoundedST solver a) = solver
-  type ForResult (NodeBoundedST solver a) = a
-  initT (NBST n) _  = return (n,())
-  nextT i tree q t es ts
-    | es == 0    = return (i,[])
-    | otherwise  = eval' i tree q t (es - 1) ts
-
diff --git a/monadiccp.cabal b/monadiccp.cabal
--- a/monadiccp.cabal
+++ b/monadiccp.cabal
@@ -1,5 +1,5 @@
 Name:                monadiccp
-Version:             0.2
+Version:             0.3
 Description:         Monadic Constraint Programming framework
 License:             BSD3
 License-file:        LICENSE
@@ -7,7 +7,8 @@
 Maintainer:          tom.schrijvers@cs.kuleuven.be
 Build-Depends:       base, containers, mtl, haskell98, random
 Build-Type:          Simple
-Exposed-modules:     Language.CP.ComposableTransformers  Language.CP.Domain  Language.CP.FD  Language.CP.FDSugar  Language.CP.PriorityQueue  Language.CP.Queue  Language.CP.Solver  Language.CP.SearchTree  Language.CP.Transformers
+Exposed-modules:     Control.CP.ComposableTransformers  Control.CP.PriorityQueue  Control.CP.Queue  Control.CP.Solver  Control.CP.SearchTree  Control.CP.Transformers Control.CP.FD.Domain Control.CP.FD.FD Control.CP.FD.FDSugar Control.CP.Herbrand.Herbrand Control.CP.Herbrand.PrologTerm
 ghc-options:         
 Category:            control
 Synopsis:	     Package for Constraint Programming
+Homepage:            http://www.cs.kuleuven.be/~toms/Haskell/